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

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