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

   1 ;;; Copyright (C) 2010, 2012, 2014 Rocky Bernstein <rocky@gnu.org>
   2 (eval-when-compile (require 'cl))
   3
   4 (require 'load-relative)
   5 (require-relative-list '("../../common/track"
   6                          "../../common/core"
   7                          "../../common/lang")
   8                        "realgud-")
   9 (require-relative-list '("init") "realgud:trepan-")
  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
  16 ;; FIXME: I think the following could be generalized and moved to
  17 ;; realgud-... probably via a macro.
  18 (defvar trepan-minibuffer-history nil
  19   "minibuffer history list for the command `trepan'.")
  20
  21 (easy-mmode-defmap trepan-minibuffer-local-map
  22   '(("\C-i" . comint-dynamic-complete-filename))
  23   "Keymap for minibuffer prompting of gud startup command."
  24   :inherit minibuffer-local-map)
  25
  26 ;; FIXME: I think this code and the keymaps and history
  27 ;; variable chould be generalized, perhaps via a macro.
  28 (defun realgud:trepan-query-cmdline (&optional opt-debugger)
  29   (realgud-query-cmdline
  30    'trepan-suggest-invocation
  31    trepan-minibuffer-local-map
  32    'trepan-minibuffer-history
  33    opt-debugger))
  34
  35 (defun realgud:trepan-parse-cmd-args (orig-args)
  36   "Parse command line ARGS for the annotate level and name of script to debug.
  37
  38 ORIG-ARGS should contain a tokenized list of the command line to run.
  39
  40 We return the a list containing
  41
  42 * the command processor (e.g. ruby) and it's arguments if any - a
  43   list of strings
  44
  45 * the name of the debugger given (e.g. trepan) and its arguments
  46   - a list of strings
  47
  48 * the script name and its arguments - list of strings
  49
  50 * whether the annotate or emacs option was given ('-A',
  51   '--annotate' or '--emacs) - a boolean
  52
  53 For example for the following input
  54   (map 'list 'symbol-name
  55    '(ruby1.9 -W -C /tmp trepan --emacs ./gcd.rb a b))
  56
  57 we might return:
  58    ((ruby1.9 -W -C) (trepan --emacs) (./gcd.rb a b) 't)
  59
  60 Note that the script name path has been expanded via `expand-file-name'.
  61 "
  62
  63   ;; Parse the following kind of pattern:
  64   ;;  [ruby ruby-options] trepan trepan-options script-name script-options
  65   (let (
  66         (args orig-args)
  67         (pair)          ;; temp return from
  68         (ruby-opt-two-args '("0" "C" "e" "E" "F" "i"))
  69         ;; Ruby doesn't have mandatory 2-arg options in our sense,
  70         ;; since the two args can be run together, e.g. "-C/tmp" or "-C /tmp"
  71         ;;
  72         (ruby-two-args '())
  73         ;; One dash is added automatically to the below, so
  74         ;; h is really -h and -host is really --host.
  75         (trepan-two-args '("h" "-host" "p" "-port"
  76                            "I" "-include" "-r" "-require"))
  77         (trepan-opt-two-args '())
  78         (interp-regexp
  79          (if (member system-type (list 'windows-nt 'cygwin 'msdos))
  80              "^ruby[-0-9]*\\(.exe\\)?$"
  81            "^ruby[-0-9]*$"))
  82
  83         ;; Things returned
  84         (script-name nil)
  85         (debugger-name nil)
  86         (interpreter-args '())
  87         (debugger-args '())
  88         (script-args '())
  89         (annotate-p nil))
  90
  91     (if (not (and args))
  92         ;; Got nothing: return '(nil, nil)
  93         (list interpreter-args debugger-args script-args annotate-p)
  94       ;; else
  95       ;; Strip off optional "ruby" or "ruby182" etc.
  96       (when (string-match interp-regexp
  97                           (file-name-sans-extension
  98                            (file-name-nondirectory (car args))))
  99         (setq interpreter-args (list (pop args)))
 100
 101         ;; Strip off Ruby-specific options
 102         (while (and args
 103                     (string-match "^-" (car args)))
 104           (setq pair (realgud-parse-command-arg
 105                       args ruby-two-args ruby-opt-two-args))
 106           (nconc interpreter-args (car pair))
 107           (setq args (cadr pair))))
 108
 109       ;; Remove "trepan" from "trepan --trepan-options script
 110       ;; --script-options"
 111       (setq debugger-name (file-name-sans-extension
 112                            (file-name-nondirectory (car args))))
 113       (unless (string-match "^trepan$" debugger-name)
 114         (message
 115          "Expecting debugger name `%s' to be `trepan'"
 116          debugger-name))
 117       (setq debugger-args (list (pop args)))
 118
 119       ;; Skip to the first non-option argument.
 120       (while (and args (not script-name))
 121         (let ((arg (car args)))
 122           (cond
 123            ;; Annotation or emacs option with level number.
 124            ((or (member arg '("--annotate" "-A"))
 125                 (equal arg "--emacs"))
 126             (setq annotate-p t)
 127             (nconc debugger-args (list (pop args))))
 128            ;; Combined annotation and level option.
 129            ((string-match "^--annotate=[0-9]" arg)
 130             (nconc debugger-args (list (pop args)) )
 131             (setq annotate-p t))
 132            ;; path-argument options
 133            ((member arg '("--include" "-I" "--require" "-I"))
 134             (setq arg (pop args))
 135             (nconc debugger-args
 136                    (list arg (realgud:expand-file-name-if-exists
 137                               (pop args)))))
 138            ;; Options with arguments.
 139            ((string-match "^-" arg)
 140             (setq pair (realgud-parse-command-arg
 141                         args trepan-two-args trepan-opt-two-args))
 142             (nconc debugger-args (car pair))
 143             (setq args (cadr pair)))
 144            ;; Anything else must be the script to debug.
 145            (t (setq script-name (realgud:expand-file-name-if-exists arg))
 146               (setq script-args (cons script-name (cdr args))))
 147            )))
 148       (list interpreter-args debugger-args script-args annotate-p))))
 149
 150 (defvar trepan-command-name) ; # To silence Warning: reference to free variable
 151 (defun trepan-suggest-invocation (debugger-name)
 152   "Suggest a trepan command invocation via `realgud-suggest-invocaton'"
 153   (realgud-suggest-invocation trepan-command-name trepan-minibuffer-history
 154                            "ruby" "\\.rb$" "trepan"))
 155
 156 (defun trepan-reset ()
 157   "Trepan cleanup - remove debugger's internal buffers (frame,
 158 breakpoints, etc.)."
 159   (interactive)
 160   ;; (trepan-breakpoint-remove-all-icons)
 161   (dolist (buffer (buffer-list))
 162     (when (string-match "\\*trepan-[a-z]+\\*" (buffer-name buffer))
 163       (let ((w (get-buffer-window buffer)))
 164         (when w
 165           (delete-window w)))
 166       (kill-buffer buffer))))
 167
 168 ;; (defun trepan-reset-keymaps()
 169 ;;   "This unbinds the special debugger keys of the source buffers."
 170 ;;   (interactive)
 171 ;;   (setcdr (assq 'trepan-debugger-support-minor-mode minor-mode-map-alist)
 172 ;;        trepan-debugger-support-minor-mode-map-when-deactive))
 173
 174
 175 (defun trepan-customize ()
 176   "Use `customize' to edit the settings of the `trepan' debugger."
 177   (interactive)
 178   (customize-group 'trepan))
 179
 180 (provide-me "realgud:trepan-")