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

   1 ;;; Copyright (C) 2010, 2013-2015 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:trepan3k-")
  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 realgud:trepan3k-minibuffer-history nil
  19   "minibuffer history list for the command `realgud:trepan3k'.")
  20
  21 (easy-mmode-defmap trepan3k-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 trepan3k-query-cmdline (&optional opt-debugger)
  29   (realgud-query-cmdline
  30    'trepan3k-suggest-invocation
  31    trepan3k-minibuffer-local-map
  32    'realgud-trepan3k-minibuffer-history
  33    opt-debugger))
  34
  35 (defun trepan3k-parse-cmd-args (orig-args)
  36   "Parse command line ARGS for the annotate level and name of script to debug.
  37
  38 ARGS should contain a tokenized list of the command line to run.
  39
  40 We return the a list containing
  41 - the command processor (e.g. python) and it's arguments if any - a list of strings
  42 - the name of the debugger given (e.g. trepan3k) and its arguments - a list of strings
  43 - the script name and its arguments - list of strings
  44 - whether the annotate or emacs option was given ('-A', '--annotate' or '--emacs) - a boolean
  45
  46 For example for the following input
  47   (map 'list 'symbol-name
  48    '(python2.6 -O -Qold --emacs ./gcd.py a b))
  49
  50 we might return:
  51    ((python2.6 -O -Qold) (trepan3k --emacs) (./gcd.py a b) 't)
  52
  53 NOTE: the above should have each item listed in quotes.
  54 "
  55
  56   ;; Parse the following kind of pattern:
  57   ;;  [python python-options] trepan3k trepan3k-options script-name script-options
  58   (let (
  59         (args orig-args)
  60         (pair)          ;; temp return from
  61         (python-opt-two-args '("c" "m" "Q" "W"))
  62         ;; Python doesn't have mandatory 2-arg options in our sense,
  63         ;; since the two args can be run together, e.g. "-C/tmp" or "-C /tmp"
  64         ;;
  65         (python-two-args '())
  66         ;; One dash is added automatically to the below, so
  67         ;; h is really -h and -host is really --host.
  68         (trepan3k-two-args '("x" "-command" "e" "-execute"
  69                            "o" "-output"  "t" "-target"
  70                            "a" "-annotate"))
  71         (trepan3k-opt-two-args '())
  72         (interp-regexp
  73          (if (member system-type (list 'windows-nt 'cygwin 'msdos))
  74              "^python[-0-9.]*\\(.exe\\)?$"
  75            "^python[-0-9.]*$"))
  76
  77         ;; Things returned
  78         (annotate-p nil)
  79         (debugger-args '())
  80         (debugger-name nil)
  81         (interpreter-args '())
  82         (script-args '())
  83         (script-name nil)
  84         )
  85
  86     (if (not (and args))
  87         ;; Got nothing: return '(nil, nil)
  88         (list interpreter-args debugger-args script-args annotate-p)
  89       ;; else
  90       ;; Strip off optional "python" or "python182" etc.
  91       (when (string-match interp-regexp
  92                           (file-name-sans-extension
  93                            (file-name-nondirectory (car args))))
  94         (setq interpreter-args (list (pop args)))
  95
  96         ;; Strip off Python-specific options
  97         (while (and args
  98                     (string-match "^-" (car args)))
  99           (setq pair (realgud-parse-command-arg
 100                       args python-two-args python-opt-two-args))
 101           (nconc interpreter-args (car pair))
 102           (setq args (cadr pair))))
 103
 104       ;; Remove "trepan3k" from "trepan3k --trepan3k-options script
 105       ;; --script-options"
 106       (setq debugger-name (file-name-sans-extension
 107                            (file-name-nondirectory (car args))))
 108       (unless (string-match "^\\(trepan3k\\|cli.py\\)$" debugger-name)
 109         (message
 110          "Expecting debugger name `%s' to be `trepan3k' or `cli.py'"
 111          debugger-name))
 112       (setq debugger-args (list (pop args)))
 113
 114       ;; Skip to the first non-option argument.
 115       (while (and args (not script-name))
 116         (let ((arg (car args)))
 117           (cond
 118            ;; Annotation or emacs option with level number.
 119            ((or (member arg '("--annotate" "-A"))
 120                 (equal arg "--emacs"))
 121             (setq annotate-p t)
 122             (nconc debugger-args (list (pop args))))
 123            ;; Combined annotation and level option.
 124            ((string-match "^--annotate=[0-9]" arg)
 125             (nconc debugger-args (list (pop args)) )
 126             (setq annotate-p t))
 127            ;; Options with arguments.
 128            ((string-match "^-" arg)
 129             (setq pair (realgud-parse-command-arg
 130                         args trepan3k-two-args trepan3k-opt-two-args))
 131             (nconc debugger-args (car pair))
 132             (setq args (cadr pair)))
 133            ;; Anything else must be the script to debug.
 134            (t (setq script-name (realgud:expand-file-name-if-exists arg))
 135               (setq script-args (cons script-name (cdr args))))
 136            )))
 137       (list interpreter-args debugger-args script-args annotate-p))))
 138
 139 ;; To silence Warning: reference to free variable
 140 (defvar realgud:trepan3k-command-name)
 141
 142 (defun trepan3k-suggest-invocation (debugger-name)
 143   "Suggest a trepan3k command invocation via `realgud-suggest-invocaton'"
 144   (realgud-suggest-invocation realgud:trepan3k-command-name
 145                               realgud:trepan3k-minibuffer-history
 146                               "python" "\\.py"
 147                               realgud:trepan3k-command-name))
 148
 149 (defun trepan3k-reset ()
 150   "Trepan3k cleanup - remove debugger's internal buffers (frame,
 151 breakpoints, etc.)."
 152   (interactive)
 153   ;; (trepan3k-breakpoint-remove-all-icons)
 154   (dolist (buffer (buffer-list))
 155     (when (string-match "\\*trepan3k-[a-z]+\\*" (buffer-name buffer))
 156       (let ((w (get-buffer-window buffer)))
 157         (when w
 158           (delete-window w)))
 159       (kill-buffer buffer))))
 160
 161 ;; (defun trepan3k-reset-keymaps()
 162 ;;   "This unbinds the special debugger keys of the source buffers."
 163 ;;   (interactive)
 164 ;;   (setcdr (assq 'trepan3k-debugger-support-minor-mode minor-mode-map-alist)
 165 ;;        trepan3k-debugger-support-minor-mode-map-when-deactive))
 166
 167
 168 (defun realgud:trepan3k-customize ()
 169   "Use `customize' to edit the settings of the `trepan3k' debugger."
 170   (interactive)
 171   (customize-group 'realgud:trepan3k))
 172
 173 (provide-me "realgud:trepan3k-")