1 ;;; Copyright (C) 2010, 2012, 2014-2015 Rocky Bernstein <rocky@gnu.org>
2 (eval-when-compile (require 'cl))
4 (require 'compile) ;; for compilation-find-file
5 (require 'load-relative)
6 (require-relative-list '("../../common/track"
10 (require-relative-list '("init") "realgud:trepan-")
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)
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'.")
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)
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
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))
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)
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)
58 (and (remhash filename realgud-file-remap)) nil)
60 (let ((remapped-filename))
61 (setq remapped-filename
63 (compilation-find-file (point-marker) stripped-filename
65 (when (and remapped-filename (file-exists-p remapped-filename))
66 (puthash filename remapped-filename realgud-file-remap)
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))
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
88 (defun realgud:trepan-parse-cmd-args (orig-args)
89 "Parse command line ARGS for the annotate level and name of script to debug.
91 ORIG-ARGS should contain a tokenized list of the command line to run.
93 We return the a list containing
95 * the command processor (e.g. ruby) and it's arguments if any - a
98 * the name of the debugger given (e.g. trepan) and its arguments
101 * the script name and its arguments - list of strings
103 * whether the annotate or emacs option was given ('-A',
104 '--annotate' or '--emacs) - a boolean
106 For example for the following input
107 (map 'list 'symbol-name
108 '(ruby1.9 -W -C /tmp trepan --emacs ./gcd.rb a b))
111 ((ruby1.9 -W -C) (trepan --emacs) (./gcd.rb a b) 't)
113 Note that the script name path has been expanded via `expand-file-name'.
116 ;; Parse the following kind of pattern:
117 ;; [ruby ruby-options] trepan trepan-options script-name script-options
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"
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 '())
132 (if (member system-type (list 'windows-nt 'cygwin 'msdos))
133 "^ruby[-0-9]*\\(.exe\\)?$"
139 (interpreter-args '())
145 ;; Got nothing: return '(nil, nil)
146 (list interpreter-args debugger-args script-args annotate-p)
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)))
154 ;; Strip off Ruby-specific options
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))))
162 ;; Remove "trepan" from "trepan --trepan-options script
164 (setq debugger-name (file-name-sans-extension
165 (file-name-nondirectory (car args))))
166 (unless (string-match "^trepan$" debugger-name)
168 "Expecting debugger name `%s' to be `trepan'"
170 (setq debugger-args (list (pop args)))
172 ;; Skip to the first non-option argument.
173 (while (and args (not script-name))
174 (let ((arg (car args)))
176 ;; Annotation or emacs option with level number.
177 ((or (member arg '("--annotate" "-A"))
178 (equal arg "--emacs"))
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)) )
185 ;; path-argument options
186 ((member arg '("--include" "-I" "--require" "-I"))
187 (setq arg (pop args))
189 (list arg (realgud:expand-file-name-if-exists
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))))
201 (list interpreter-args debugger-args script-args annotate-p))))
203 ;; To silence Warning: reference to free variable
204 (defvar realgud:trepan-command-name)
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"))
212 (defun trepan-reset ()
213 "Trepan cleanup - remove debugger's internal buffers (frame,
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)))
222 (kill-buffer buffer))))
224 ;; (defun trepan-reset-keymaps()
225 ;; "This unbinds the special debugger keys of the source buffers."
227 ;; (setcdr (assq 'trepan-debugger-support-minor-mode minor-mode-map-alist)
228 ;; trepan-debugger-support-minor-mode-map-when-deactive))
231 (defun realgud:trepan-customize ()
232 "Use `customize' to edit the settings of the `trepan' debugger."
234 (customize-group 'realgud:trepan))
236 (provide-me "realgud:trepan-")