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

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