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

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