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

   1 ;;; Copyright (C) 2010, 2014-2015 Rocky Bernstein <rocky@gnu.org>
   2 (eval-when-compile (require 'cl))
   3
   4 (require 'compile) ;; for compilation-find-file
   5 (require 'load-relative)
   6 (require-relative-list '("../../common/track"
   7                          "../../common/core"
   8                          "../../common/file"
   9                          "../../common/lang")
  10                        "realgud-")
  11 (require-relative-list '("init") "realgud:trepan2-")
  12
  13 (declare-function realgud:strip              'realgud)
  14 (declare-function realgud:expand-file-name-if-exists 'realgud-core)
  15 (declare-function realgud-parse-command-arg  'realgud-core)
  16 (declare-function realgud-query-cmdline      'realgud-core)
  17 (declare-function realgud-suggest-invocation 'realgud-core)
  18 (declare-function realgud:file-loc-from-line 'realgud-file)
  19
  20 ;; FIXME: I think the following could be generalized and moved to
  21 ;; realgud-... probably via a macro.
  22 (defvar realgud:trepan2-minibuffer-history nil
  23   "minibuffer history list for the command `realgud:trepan2'.")
  24
  25 (easy-mmode-defmap trepan2-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 (defvar realgud:trepan2-file-remap (make-hash-table :test 'equal)
  31   "How to remap Python files in trepan2 when we otherwise can't
  32   find in the filesystem. The hash key is the file string we saw,
  33   and the value is associated filesystem string presumably in the
  34   filesystem")
  35
  36 ;; FIXME: this code could be generalized and put in a common place.
  37 (defun realgud:trepan2-find-file(filename)
  38   "A find-file specific for python/trepan. We strip off trailing
  39 blanks. Failing that we will prompt for a mapping and save that
  40 in variable `realgud:trepan2-file-remap' when that works. In the future,
  41 we may also consult PYTHONPATH."
  42   (let* ((transformed-file)
  43          (stripped-filename (realgud:strip filename))
  44          (ignore-file-re realgud-python-ignore-file-re)
  45         )
  46     (cond
  47      ((file-exists-p filename) filename)
  48      ((file-exists-p stripped-filename) stripped-filename)
  49      ((string-match ignore-file-re filename)
  50         (message "tracking ignored for psuedo-file: %s" filename) nil)
  51      ('t
  52       ;; FIXME search PYTHONPATH if not absolute file
  53       (if (gethash filename realgud-file-remap)
  54           (let ((remapped-filename))
  55             (setq remapped-filename (gethash filename realgud:trepan2-file-remap))
  56             (if (file-exists-p remapped-filename)
  57                 remapped-filename
  58               ;; else
  59               (and (remhash filename realgud-file-remap)) nil)
  60             ;; else
  61             (let ((remapped-filename))
  62               (setq remapped-filename
  63                     (buffer-file-name
  64                      (compilation-find-file (point-marker) stripped-filename
  65                                             nil "%s.py")))
  66               (when (and remapped-filename (file-exists-p remapped-filename))
  67                 (puthash filename remapped-filename realgud-file-remap)
  68                 remapped-filename
  69                 ))
  70             ))
  71       ))
  72     ))
  73
  74 (defun realgud:trepan2-loc-fn-callback(text filename lineno source-str
  75                                             ignore-file-re cmd-mark)
  76   (realgud:file-loc-from-line filename lineno
  77                               cmd-mark source-str nil nil
  78                               'realgud:trepan2-find-file))
  79
  80 ;; FIXME: I think this code and the keymaps and history
  81 ;; variable chould be generalized, perhaps via a macro.
  82 (defun trepan2-query-cmdline (&optional opt-debugger)
  83   (realgud-query-cmdline
  84    'trepan2-suggest-invocation
  85    trepan2-minibuffer-local-map
  86    'realgud:trepan2-minibuffer-history
  87    opt-debugger))
  88
  89 (defun trepan2-parse-cmd-args (orig-args)
  90   "Parse command line ARGS for the annotate level and name of script to debug.
  91
  92 ORIG-ARGS should contain a tokenized list of the command line to run.
  93
  94 We return the a list containing
  95 - the command processor (e.g. python) and it's arguments if any - a list of strings
  96 - the name of the debugger given (e.g. trepan2) and its arguments - a list of strings
  97 - the script name and its arguments - list of strings
  98 - whether the annotate or emacs option was given ('-A', '--annotate' or '--emacs) - a boolean
  99
 100 For example for the following input
 101   (map 'list 'symbol-name
 102    '(python2.6 -O -Qold --emacs ./gcd.py a b))
 103
 104 we might return:
 105    ((python2.6 -O -Qold) (trepan2 --emacs) (./gcd.py a b) 't)
 106
 107 NOTE: the above should have each item listed in quotes.
 108 "
 109
 110   ;; Parse the following kind of pattern:
 111   ;;  [python python-options] trepan2 trepan2-options script-name script-options
 112   (let (
 113         (args orig-args)
 114         (pair)          ;; temp return from
 115         (python-opt-two-args '("c" "m" "Q" "W"))
 116         ;; Python doesn't have mandatory 2-arg options in our sense,
 117         ;; since the two args can be run together, e.g. "-C/tmp" or "-C /tmp"
 118         ;;
 119         (python-two-args '())
 120         ;; One dash is added automatically to the below, so
 121         ;; h is really -h and -host is really --host.
 122         (trepan2-two-args '("x" "-command" "e" "-execute"
 123                            "o" "-output"  "t" "-target"
 124                            "a" "-annotate"))
 125         (trepan2-opt-two-args '())
 126         (interp-regexp
 127          (if (member system-type (list 'windows-nt 'cygwin 'msdos))
 128              "^python[-0-9.]*\\(.exe\\)?$"
 129            "^python[-0-9.]*$"))
 130
 131         ;; Things returned
 132         (annotate-p nil)
 133         (debugger-args '())
 134         (debugger-name nil)
 135         (interpreter-args '())
 136         (script-args '())
 137         (script-name nil)
 138         )
 139
 140     (if (not (and args))
 141         ;; Got nothing: return '(nil, nil)
 142         (list interpreter-args debugger-args script-args annotate-p)
 143       ;; else
 144       ;; Strip off optional "python" or "python182" etc.
 145       (when (string-match interp-regexp
 146                           (file-name-sans-extension
 147                            (file-name-nondirectory (car args))))
 148         (setq interpreter-args (list (pop args)))
 149
 150         ;; Strip off Python-specific options
 151         (while (and args
 152                     (string-match "^-" (car args)))
 153           (setq pair (realgud-parse-command-arg
 154                       args python-two-args python-opt-two-args))
 155           (nconc interpreter-args (car pair))
 156           (setq args (cadr pair))))
 157
 158       ;; Remove "trepan2" from "trepan2 --trepan2-options script
 159       ;; --script-options"
 160       (setq debugger-name (file-name-sans-extension
 161                            (file-name-nondirectory (car args))))
 162       (unless (string-match "^\\(trepan2\\|cli.py\\)$" debugger-name)
 163         (message
 164          "Expecting debugger name `%s' to be `trepan2' or `cli.py'"
 165          debugger-name))
 166       (setq debugger-args (list (pop args)))
 167
 168       ;; Skip to the first non-option argument.
 169       (while (and args (not script-name))
 170         (let ((arg (car args)))
 171           (cond
 172            ;; Annotation or emacs option with level number.
 173            ((or (member arg '("--annotate" "-A"))
 174                 (equal arg "--emacs"))
 175             (setq annotate-p t)
 176             (nconc debugger-args (list (pop args))))
 177            ;; Combined annotation and level option.
 178            ((string-match "^--annotate=[0-9]" arg)
 179             (nconc debugger-args (list (pop args)) )
 180             (setq annotate-p t))
 181            ;; Options with arguments.
 182            ((string-match "^-" arg)
 183             (setq pair (realgud-parse-command-arg
 184                         args trepan2-two-args trepan2-opt-two-args))
 185             (nconc debugger-args (car pair))
 186             (setq args (cadr pair)))
 187            ;; Anything else must be the script to debug.
 188            (t (setq script-name (realgud:expand-file-name-if-exists arg))
 189               (setq script-args (cons script-name (cdr args))))
 190            )))
 191       (list interpreter-args debugger-args script-args annotate-p))))
 192
 193 ;; To silence Warning: reference to free variable
 194 (defvar realgud:trepan2-command-name)
 195
 196 (defun trepan2-suggest-invocation (debugger-name)
 197   "Suggest a trepan2 command invocation via `realgud-suggest-invocaton'"
 198   (realgud-suggest-invocation realgud:trepan2-command-name
 199                               realgud:trepan2-minibuffer-history
 200                               "python" "\\.py"
 201                               realgud:trepan2-command-name))
 202
 203 (defun trepan2-reset ()
 204   "Trepan2 cleanup - remove debugger's internal buffers (frame,
 205 breakpoints, etc.)."
 206   (interactive)
 207   ;; (trepan2-breakpoint-remove-all-icons)
 208   (dolist (buffer (buffer-list))
 209     (when (string-match "\\*trepan2-[a-z]+\\*" (buffer-name buffer))
 210       (let ((w (get-buffer-window buffer)))
 211         (when w
 212           (delete-window w)))
 213       (kill-buffer buffer))))
 214
 215 ;; (defun trepan2-reset-keymaps()
 216 ;;   "This unbinds the special debugger keys of the source buffers."
 217 ;;   (interactive)
 218 ;;   (setcdr (assq 'trepan2-debugger-support-minor-mode minor-mode-map-alist)
 219 ;;        trepan2-debugger-support-minor-mode-map-when-deactive))
 220
 221
 222 (defun realgud:trepan2-customize ()
 223   "Use `customize' to edit the settings of the `trepan2' debugger."
 224   (interactive)
 225   (customize-group 'realgud:trepan2))
 226
 227 (provide-me "realgud:trepan2-")