code.delx.au - gnu-emacs-elpa/blob - packages/realgud/realgud/common/run.el

   1 ;;; Copyright (C) 2014-2015 Rocky Bernstein <rocky@gnu.org>
   2 ; (require 'term)
   3
   4 (require 'shell)
   5 (require 'list-utils)
   6 (require 'load-relative)
   7 (require-relative-list '("core" "track" "utils") "realgud-")
   8 (require-relative-list '("buffer/command") "realgud-buffer-")
   9
  10 (declare-function realgud-cmdbuf-info-in-debugger?=   'realgud-buffer-command)
  11 (declare-function realgud-cmdbuf-info-cmd-args=       'realgud-buffer-command)
  12 (declare-function realgud:track-set-debugger          'realgud-track)
  13 (declare-function realgud-parse-command-arg           'realgud-core)
  14 (declare-function realgud:expand-file-name-if-exists  'realgud-core)
  15
  16 (defun realgud:parse-cmd-args(args two-args opt-two-args interp-regexp debugger-regexp
  17                                    path-args-list annotate-args)
  18   "Parse command line ARGS for the annotate level and name of script to debug.
  19
  20 ARGS should contain a tokenized list of the command line to run.
  21
  22 We return the a list containing:
  23 * the command processor (e.g. bash) and it's arguments if any - a list of strings
  24 * the name of the debugger given (e.g. bashdb) and its arguments - a list of strings.
  25   If there is no debugger, for example gdb, nodejs then nil is returned.
  26 * the script name and its arguments - list of strings
  27 * whether the annotate or emacs option was given ('-A', '--annotate' or '--emacs) - a boolean
  28
  29 The script name and options mentioning paths are file expanded
  30
  31 For example for the following input
  32   (map 'list 'symbol-name
  33    '(bash --norc bashdb -l . --emacs ./gcd.sh a b))
  34
  35 we might return:
  36    ((\"bash\" \"--norc\") (\"bashdb\" \"-l\" \"/tmp\" \"--emacs\") (\"/tmp/gcd.sh\" \"a\" \"b\") t)
  37
  38 Note that path elements have been expanded via `expand-file-name'.
  39 "
  40   ;; Parse the following kind of pattern:
  41   ;;  [bash bash-options] bashdb bashdb-options script-name script-options
  42   (let (
  43         (pair)
  44         ;; Things returned
  45         (script-name nil)
  46         (debugger-name nil)
  47         (interpreter-args '())
  48         (debugger-args '())
  49         (script-args '())
  50         (annotate-p nil))
  51
  52     (if (not (and args))
  53         ;; Got nothing: return '(nil, nil nil nil)
  54         (list interpreter-args debugger-args script-args annotate-p)
  55       ;; else
  56       ;; Strip off optional interpreter name
  57       (when (and interp-regexp
  58                  (string-match interp-regexp
  59                                (file-name-sans-extension
  60                                 (file-name-nondirectory (car args)))))
  61         (setq interpreter-args (list (pop args)))
  62
  63         ;; Strip off compiler/intepreter-specific options
  64         (while (and args
  65                     (string-match "^-" (car args)))
  66           (setq pair (realgud-parse-command-arg
  67                       args two-args opt-two-args))
  68           (nconc interpreter-args (car pair))
  69           (setq args (cadr pair))))
  70
  71       ;; Skip to the first non-option argument.
  72       (while (and args (not script-name))
  73         (let ((arg (car args)))
  74           (cond
  75            ;; path-like options
  76            ((member arg path-args-list)
  77             (setq arg (pop args))
  78             (nconc debugger-args
  79                    (list arg (realgud:expand-file-name-if-exists
  80                               (pop args)))))
  81            ;; Other options with arguments.
  82            ((string-match "^-" arg)
  83             (setq pair (realgud-parse-command-arg
  84                         args two-args opt-two-args))
  85             (nconc debugger-args (car pair))
  86             (setq args (cadr pair)))
  87            ;; Anything else must be the script to debug.
  88            (t (setq script-name (realgud:expand-file-name-if-exists arg))
  89               (setq script-args (cons script-name (cdr args))))
  90            )))
  91       (list interpreter-args debugger-args script-args annotate-p))))
  92
  93 (defun realgud:run-process(debugger-name script-filename cmd-args
  94                                          minibuffer-history
  95                                          &optional no-reset)
  96   "Runs `realgud-exec-shell' with DEBUGGER-NAME SCRIPT-FILENAME
  97 and CMD-ARGS If this succeeds, we save CMD-ARGS in command-buffer
  98 for use if we want to restart.  If we don't succeed in running
  99 the program, we will switch to the command buffer which shows
 100 details of the error. The command buffer or nil is returned."
 101
 102   (let ((cmd-buf))
 103     (condition-case nil
 104         (setq cmd-buf
 105               (apply 'realgud-exec-shell debugger-name script-filename
 106                      (car cmd-args) no-reset (cdr cmd-args)))
 107       (error nil))
 108     ;; FIXME: Is there probably is a way to remove the
 109     ;; below test and combine in condition-case?
 110     (let ((process (get-buffer-process cmd-buf)))
 111       (if (and process (eq 'run (process-status process)))
 112           (progn
 113             (switch-to-buffer cmd-buf)
 114             (realgud:track-set-debugger debugger-name)
 115             (realgud-cmdbuf-info-in-debugger?= 't)
 116             (realgud-cmdbuf-info-cmd-args= cmd-args)
 117             (when cmd-buf
 118               (switch-to-buffer cmd-buf)
 119               (when realgud-cmdbuf-info
 120                 (let* ((info realgud-cmdbuf-info)
 121                        (cmd-args (realgud-cmdbuf-info-cmd-args info))
 122                        (cmd-str  (mapconcat 'identity  cmd-args " ")))
 123                   (set minibuffer-history
 124                        (list-utils-uniq (cons cmd-str
 125                                               (eval minibuffer-history)))
 126                        ))
 127                 )))
 128         ;; else
 129         (progn
 130           (if cmd-buf (switch-to-buffer cmd-buf))
 131           (message "Error running command: %s" (mapconcat 'identity cmd-args " "))
 132           )
 133         )
 134       )
 135     cmd-buf
 136     )
 137   )
 138
 139 (defun realgud:run-debugger (debugger-name query-cmdline-fn parse-cmd-args-fn
 140                                            minibuffer-history
 141                                            &optional opt-command-line
 142                                            no-reset)
 143   "Invoke the a debugger and start the Emacs user interface.
 144
 145 String OPT-COMMAND-LINE specifies how to run DEBUGGER-NAME. You
 146 will be prompted for a command line using QUERY-CMDLINE-FN is one
 147 isn't supplied.
 148
 149 OPT-COMMAND-LINE is treated like a shell string; arguments are
 150 tokenized by `split-string-and-unquote'. The tokenized string is
 151 parsed by PARSE-CMD-FN and path elements found by that
 152 are expanded using `expand-file-name'.
 153
 154 If successful, The command buffer of the debugger process is returned.
 155 Otherwise nil is returned.
 156 "
 157   (let* ((cmd-str (or opt-command-line (funcall query-cmdline-fn debugger-name)))
 158          (cmd-args (split-string-and-unquote cmd-str))
 159          (parsed-args (funcall parse-cmd-args-fn cmd-args))
 160          (script-args (caddr parsed-args))
 161          (script-name (car script-args))
 162          (parsed-cmd-args
 163           (remove-if 'nil (realgud:flatten parsed-args)))
 164          )
 165     (realgud:run-process debugger-name script-name parsed-cmd-args
 166                          minibuffer-history no-reset)
 167     )
 168   )
 169
 170 (provide-me "realgud:")
 171
 172 ;; Local Variables:
 173 ;; byte-compile-warnings: (not cl-functions)
 174 ;; End: