code.delx.au - gnu-emacs-elpa/blob - realgud/debugger/remake/core.el

   1 ;;; Copyright (C) 2011, 2014 Rocky Bernstein <rocky@gnu.org>
   2 (eval-when-compile (require 'cl))
   3
   4 (require 'load-relative)
   5 (require-relative-list '("../../common/track" "../../common/core")
   6                        "realgud-")
   7 (require-relative-list '("../../common/buffer/command")
   8                        "realgud-buffer-")
   9 (require-relative-list '("init") "realgud:remake-")
  10
  11 (declare-function realgud:expand-file-name-if-exists 'realgud-core)
  12 (declare-function realgud-parse-command-arg  'realgud-core)
  13 (declare-function realgud-query-cmdline      'realgud-core)
  14 (declare-function realgud-suggest-invocation 'realgud-core)
  15 (declare-function realgud-cmdbuf-command-string
  16                                              'realgud-buffer-command)
  17 (declare-function realgud-cmdbuf-debugger-name
  18                                              'realgud-buffer-command)
  19 ;; FIXME: I think the following could be generalized and moved to
  20 ;; realgud-... probably via a macro.
  21 (defvar remake-minibuffer-history nil
  22   "minibuffer history list for the command `remake'.")
  23
  24 (easy-mmode-defmap remake-minibuffer-local-map
  25   '(("\C-i" . comint-dynamic-complete-filename))
  26   "Keymap for minibuffer prompting of gud startup command."
  27   :inherit minibuffer-local-map)
  28
  29 ;; FIXME: I think this code and the keymaps and history
  30 ;; variable chould be generalized, perhaps via a macro.
  31 (defun remake-query-cmdline (&optional opt-debugger)
  32   (realgud-query-cmdline
  33    'remake-suggest-invocation
  34    remake-minibuffer-local-map
  35    'remake-minibuffer-history
  36    opt-debugger))
  37
  38 (defun remake-parse-cmd-args (orig-args)
  39   "Parse command line ARGS for the annotate level and name of script to debug.
  40
  41 ARGS should contain a tokenized list of the command line to run.
  42
  43 We return the a list containing
  44
  45 - the command processor (e.g. make)
  46 - the Makefile name
  47 - command args (which includes the makefile name)
  48
  49 For example for the following input
  50   '(\"gmake\" \"-x\" \"/tmp/Makefile\")
  51
  52 we might return:
  53    (\"gmake\" \"/tmp/Makefile\" (\"-x\" \"/tmp/Makefile\"))
  54
  55 "
  56
  57   (let (
  58         (args orig-args)
  59         (interp-regexp
  60          (if (member system-type (list 'windows-nt 'cygwin 'msdos))
  61              "^\\(re\\)?make*\\(.exe\\)?$"
  62            "^\\(re\\)?make*$"))
  63
  64         ;; Things returned
  65         (remake-name nil)
  66         (makefile-name nil)
  67         (remake-args '())
  68         )
  69
  70     (if (not (and args))
  71         ;; Got nothing
  72         (list remake-name makefile-name remake-args)
  73       ;; else
  74       ;; Strip off "make" or "remake" etc.
  75       (when (string-match interp-regexp
  76                           (file-name-sans-extension
  77                            (file-name-nondirectory (car args))))
  78         (setq remake-name (pop args))
  79         )
  80
  81       ;; parse options
  82       (while args
  83         (let ((arg (pop args)))
  84           (cond
  85            ;; ;; Annotation or emacs option with level number.
  86            ;; ((or (member arg '("--annotate" "-A"))
  87            ;;   (equal arg "--emacs"))
  88            ;;  (setq annotate-p t)
  89            ;;  (nconc debugger-args (list (pop args))))
  90            ;; ;; Combined annotation and level option.
  91            ;; ((string-match "^--annotate=[0-9]" arg)
  92            ;;  (nconc debugger-args (list (pop args)) )
  93            ;;  (setq annotate-p t))
  94
  95            ((member arg '("--file" "--makefile" "-f"))
  96             (setq remake-args (nconc remake-args (list arg)))
  97             (setq makefile-name (realgud:expand-file-name-if-exists
  98                                  (pop args)))
  99             (setq remake-args (nconc remake-args
 100                                      (list (format "%s" makefile-name)))))
 101
 102            ;; Anything else add to remake-args
 103            ('t (setq remake-args (nconc remake-args (list arg))))
 104            )))
 105       (list remake-name makefile-name remake-args))))
 106
 107 (defconst realgud:remake-auto-suffix-regexp
 108   "\\.\\(am\\|in\\)$"
 109   "Common automake and autoconf Makefile suffixes"
 110 )
 111
 112 (defconst realgud:remake-makefile-regexp
 113   "\\(^[Mm]akefile$\\|\\.Makefile$\\|\\.mk\\)$"
 114   "Regular expression matching common Makefile names"
 115 )
 116
 117 (defun remake-suggest-file-priority(filename)
 118   (let ((priority 2)
 119         (is-not-directory)
 120         )
 121     (if (realgud-lang-mode? filename "makefile")
 122         (progn
 123           (if (string-match realgud:remake-makefile-regexp filename)
 124               (setq priority 8)
 125             (if (string-match realgud:remake-auto-suffix-regexp filename)
 126                 (setq priority 5)
 127               (setq priority 7)))
 128           ))
 129     ;; The file isn't in a makefile-mode buffer,
 130     ;; Check for an executable file with a .mk extension.
 131     (if (setq is-not-directory (not (file-directory-p filename)))
 132         (if (and (string-match realgud:remake-makefile-regexp filename))
 133             (if (< priority 6)
 134                 (progn
 135                   (setq priority 6)))))
 136     priority
 137     )
 138 )
 139
 140 (defun remake-suggest-Makefile ()
 141  "Suggest a Makefile to debug.
 142
 143 The first priority is given to the current buffer. If the major
 144 mode matches GNUMakefile and doesn't end in .am or .in, then we
 145 are done. If not, we'll set priority 2 (a low or easily
 146 overridden priority) and we keep going.  Then we will try files
 147 in the default-directory. Of those that we are visiting we check
 148 the major mode. There are demerits for a file ending in .in or
 149 .am which are used by 'configure' and 'automake' respectively.
 150
 151 If the current buffer isn't a success, we see if the file matches
 152 REGEXP. These have priority 9, 8 or 7 depending on whether there
 153 is a .in or .am sufifx and there is a REGEXP match'.  Within a
 154 given priority, we use the first one we find."
 155     (let* ((file)
 156            (file-list (directory-files default-directory))
 157            (priority 2)
 158            (is-not-directory)
 159            (result (buffer-file-name)))
 160       (if (not (realgud-lang-mode? result "makefile"))
 161           (progn
 162             (while (and (setq file (car-safe file-list)) (< priority 8))
 163               (setq file-list (cdr file-list))
 164               (let ((try-priority (remake-suggest-file-priority file)))
 165                 (if (> try-priority priority)
 166                     (progn
 167                       (setq priority try-priority)
 168                       (setq result file)))
 169                 ))
 170             ))
 171       result)
 172     )
 173
 174 (defvar remake-command-name) ; # To silence Warning: reference to free variable
 175
 176 (defun remake-suggest-invocation (debugger-name)
 177   "Suggest a remake command invocation via `realgud-suggest-invocaton'"
 178
 179   (let* ((buf (current-buffer))
 180          (cmd-str-cmdbuf (realgud-cmdbuf-command-string buf))
 181          )
 182     (cond
 183      ((and cmd-str-cmdbuf (equal debugger-name (realgud-cmdbuf-debugger-name buf)))
 184       cmd-str-cmdbuf)
 185      ((and minibuffer-history (listp minibuffer-history))
 186       (car minibuffer-history))
 187      (t (concat debugger-name " --debugger -f "
 188                 (remake-suggest-Makefile)))
 189      )))
 190
 191 ;; Convert a command line as would be typed normally to run a script
 192 ;; into one that invokes an Emacs-enabled debugging session.
 193 ;; "--debugger" in inserted as the first switch.
 194
 195 (defun realgud:remake-massage-args (command-line)
 196   (let* ((new-args (list "--debugger"))
 197          (args (split-string-and-unquote command-line))
 198          (program (car args))
 199          (seen-e nil)
 200          (shift (lambda ()
 201                   (setq new-args (cons (car args) new-args))
 202                   (setq args (cdr args)))))
 203
 204     ;; Pass all switches and -e scripts through.
 205     (while (and args
 206                 (string-match "^-" (car args))
 207                 (not (equal "-" (car args)))
 208                 (not (equal "--" (car args))))
 209       (funcall shift))
 210
 211     (if (or (not args)
 212             (string-match "^-" (car args)))
 213         (error "Can't use stdin as the script to debug"))
 214     ;; This is the program name.
 215     (funcall shift)
 216
 217     (while args
 218       (funcall shift))
 219
 220     (nreverse new-args)
 221     )
 222   )
 223
 224 (defun remake-reset ()
 225   "Remake cleanup - remove debugger's internal buffers (frame,
 226 breakpoints, etc.)."
 227   (interactive)
 228   ;; (remake-breakpoint-remove-all-icons)
 229   (dolist (buffer (buffer-list))
 230     (when (string-match "\\*remake-[a-z]+\\*" (buffer-name buffer))
 231       (let ((w (get-buffer-window buffer)))
 232         (when w
 233           (delete-window w)))
 234       (kill-buffer buffer))))
 235
 236 ;; (defun remake-reset-keymaps()
 237 ;;   "This unbinds the special debugger keys of the source buffers."
 238 ;;   (interactive)
 239 ;;   (setcdr (assq 'remake-debugger-support-minor-mode minor-mode-map-alist)
 240 ;;        remake-debugger-support-minor-mode-map-when-deactive))
 241
 242
 243 (defun remake-customize ()
 244   "Use `customize' to edit the settings of the `remake' debugger."
 245   (interactive)
 246   (customize-group 'remake))
 247
 248 (provide-me "realgud:remake-")