*** empty log message ***
[bpt/emacs.git] / lisp / gud.el
CommitLineData
c3fd0eea 1;;; gud.el --- Grand Unified Debugger mode for running GDB and other debuggers
f961a17c 2
ee0155df 3;; Author: Eric S. Raymond <esr@snark.thyrsus.com>
8ba194fc 4;; Maintainer: FSF
f961a17c
ER
5;; Keywords: unix, tools
6
e78e1cd1 7;; Copyright (C) 1992,93,94,95,96,1998,2000,2002 Free Software Foundation, Inc.
13b80a60
ER
8
9;; This file is part of GNU Emacs.
10
11;; GNU Emacs is free software; you can redistribute it and/or modify
12;; it under the terms of the GNU General Public License as published by
24d725c2 13;; the Free Software Foundation; either version 2, or (at your option)
13b80a60
ER
14;; any later version.
15
16;; GNU Emacs is distributed in the hope that it will be useful,
17;; but WITHOUT ANY WARRANTY; without even the implied warranty of
c6094cae 18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13b80a60
ER
19;; GNU General Public License for more details.
20
21;; You should have received a copy of the GNU General Public License
c6094cae 22;; along with GNU Emacs; see the file COPYING. If not, write to the
b578f267
EN
23;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
24;; Boston, MA 02111-1307, USA.
13b80a60 25
f961a17c
ER
26;;; Commentary:
27
13b80a60 28;; The ancestral gdb.el was by W. Schelter <wfs@rascal.ics.utexas.edu>
f4b643a1 29;; It was later rewritten by rms. Some ideas were due to Masanobu.
f961a17c 30;; Grand Unification (sdb/dbx support) by Eric S. Raymond <esr@thyrsus.com>
13b80a60 31;; The overloading code was then rewritten by Barry Warsaw <bwarsaw@cen.com>,
6496f3d2 32;; who also hacked the mode to use comint.el. Shane Hartman <shane@spr.com>
0e0de659 33;; added support for xdb (HPUX debugger). Rick Sladkey <jrs@world.std.com>
f266485d 34;; wrote the GDB command completion code. Dave Love <d.love@dl.ac.uk>
2291bfaa 35;; added the IRIX kluge, re-implemented the Mips-ish variant and added
f4b643a1 36;; a menu. Brian D. Carlstrom <bdc@ai.mit.edu> combined the IRIX kluge with
c6094cae 37;; the gud-xdb-directories hack producing gud-dbx-directories. Derek L. Davies
c3fd0eea 38;; <ddavies@world.std.com> added support for jdb (Java debugger.)
13b80a60 39
f961a17c
ER
40;;; Code:
41
13b80a60 42(require 'comint)
e8a57935 43(require 'etags)
13b80a60 44
ee0155df 45;; ======================================================================
5b08a462 46;; GUD commands must be visible in C buffers visited by GUD
ee0155df 47
69c1dd37 48(defgroup gud nil
f4b643a1 49 "Grand Unified Debugger mode for gdb and other debuggers under Emacs.
d2d23393 50Supported debuggers include gdb, sdb, dbx, xdb, perldb, pdb (Python), and jdb."
69c1dd37
RS
51 :group 'unix
52 :group 'tools)
53
54
55(defcustom gud-key-prefix "\C-x\C-a"
56 "Prefix of all GUD commands valid in C buffers."
57 :type 'string
58 :group 'gud)
ee0155df 59
5b08a462 60(global-set-key (concat gud-key-prefix "\C-l") 'gud-refresh)
16776e8d 61(define-key ctl-x-map " " 'gud-break) ;; backward compatibility hack
ee0155df 62
ee97eac3
RS
63(defvar gud-marker-filter nil)
64(put 'gud-marker-filter 'permanent-local t)
65(defvar gud-find-file nil)
66(put 'gud-find-file 'permanent-local t)
67
ee97eac3
RS
68(defun gud-marker-filter (&rest args)
69 (apply gud-marker-filter args))
70
c157af51
SM
71(defvar gud-minor-mode nil)
72(put 'gud-minor-mode 'permanent-local t)
73
74(defun gud-symbol (sym &optional soft minor-mode)
75 "Return the symbol used for SYM in MINOR-MODE.
76MINOR-MODE defaults to `gud-minor-mode.
77The symbol returned is `gud-<MINOR-MODE>-<SYM>'.
78If SOFT is non-nil, returns nil if the symbol doesn't already exist."
79 (unless (or minor-mode gud-minor-mode) (error "Gud internal error"))
80 (funcall (if soft 'intern-soft 'intern)
81 (format "gud-%s-%s" (or minor-mode gud-minor-mode) sym)))
82
83(defun gud-val (sym &optional minor-mode)
84 "Return the value of `gud-symbol' SYM. Default to nil."
85 (let ((sym (gud-symbol sym t minor-mode)))
86 (if (boundp sym) (symbol-value sym))))
87
1a21c370
NR
88(defvar gdb-running nil "Used by gdba only. Non-nil if debuggee is running
89so that the relevant toolbar icons are greyed out.")
c157af51
SM
90
91(easy-mmode-defmap gud-menu-map
92 '(([refresh] "Refresh" . gud-refresh)
f36ca832 93 ([run] menu-item "Run" gud-run
1a21c370
NR
94 :enable (and (not gdb-running)
95 (memq gud-minor-mode '(gdba gdb))))
f36ca832 96 ([goto] menu-item "Continue to selection" gud-goto
1a21c370
NR
97 :enable (and (not gdb-running)
98 (memq gud-minor-mode '(gdba gdb))))
99 ([remove] menu-item "Remove Breakpoint" gud-remove
100 :enable (not gdb-running))
c157af51 101 ([tbreak] menu-item "Temporary Breakpoint" gud-tbreak
1a21c370
NR
102 :enable (memq gud-minor-mode '(gdba gdb sdb xdb)))
103 ([break] menu-item "Set Breakpoint" gud-break
104 :enable (not gdb-running))
c157af51 105 ([up] menu-item "Up Stack" gud-up
1a21c370
NR
106 :enable (and (not gdb-running)
107 (memq gud-minor-mode '(gdba gdb dbx xdb jdb))))
c157af51 108 ([down] menu-item "Down Stack" gud-down
1a21c370
NR
109 :enable (and (not gdb-running)
110 (memq gud-minor-mode '(gdba gdb dbx xdb jdb))))
111 ([print] menu-item "Print Expression" gud-print
112 :enable (not gdb-running))
f36ca832 113 ([display] menu-item "Display Expression" gud-display
1a21c370
NR
114 :enable (and (not gdb-running)
115 (eq gud-minor-mode 'gdba)))
c157af51 116 ([finish] menu-item "Finish Function" gud-finish
1a21c370
NR
117 :enable (and (not gdb-running)
118 (memq gud-minor-mode '(gdba gdb xdb jdb))))
c157af51 119 ([stepi] "Step Instruction" . gud-stepi)
1a21c370
NR
120 ([step] menu-item "Step Line" gud-step
121 :enable (not gdb-running))
122 ([next] menu-item "Next Line" gud-next
123 :enable (not gdb-running))
124 ([cont] menu-item "Continue" gud-cont
125 :enable (not gdb-running)))
c157af51
SM
126 "Menu for `gud-mode'."
127 :name "Gud")
128
129(easy-mmode-defmap gud-minor-mode-map
130 `(([menu-bar debug] . ("Gud" . ,gud-menu-map)))
131 "Map used in visited files.")
132
133(let ((m (assq 'gud-minor-mode minor-mode-map-alist)))
134 (if m (setcdr m gud-minor-mode-map)
135 (push (cons 'gud-minor-mode gud-minor-mode-map) minor-mode-map-alist)))
136
137(defvar gud-mode-map
138 ;; Will inherit from comint-mode via define-derived-mode.
139 (make-sparse-keymap)
140 "`gud-mode' keymap.")
1a21c370
NR
141
142(defvar gud-tool-bar-map
143 (if (display-graphic-p)
144 (let ((tool-bar-map (make-sparse-keymap)))
145 (tool-bar-add-item-from-menu 'gud-break "gud-break" gud-minor-mode-map)
146 (tool-bar-add-item-from-menu 'gud-remove "gud-remove" gud-minor-mode-map)
147 (tool-bar-add-item-from-menu 'gud-print "gud-print" gud-minor-mode-map)
148 (tool-bar-add-item-from-menu 'gud-display "gud-display"
149 gud-minor-mode-map)
150 (tool-bar-add-item-from-menu 'gud-run "gud-run" gud-minor-mode-map)
151 (tool-bar-add-item-from-menu 'gud-goto "gud-goto" gud-minor-mode-map)
152 (tool-bar-add-item-from-menu 'gud-cont "gud-cont" gud-minor-mode-map)
153 (tool-bar-add-item-from-menu 'gud-step "gud-step" gud-minor-mode-map)
154 (tool-bar-add-item-from-menu 'gud-next "gud-next" gud-minor-mode-map)
155 (tool-bar-add-item-from-menu 'gud-finish "gud-finish" gud-minor-mode-map)
156 (tool-bar-add-item-from-menu 'gud-up "gud-up" gud-minor-mode-map)
157 (tool-bar-add-item-from-menu 'gud-down "gud-down" gud-minor-mode-map)
158 tool-bar-map)))
159
160(defun gud-find-file (file)
161 ;; Don't get confused by double slashes in the name that comes from GDB.
162 (while (string-match "//+" file)
163 (setq file (replace-match "/" t t file)))
164 (let ((minor-mode gud-minor-mode)
165 (buf (funcall gud-find-file file)))
166 (when buf
167 ;; Copy `gud-minor-mode' to the found buffer to turn on the menu.
168 (with-current-buffer buf
169 (set (make-local-variable 'gud-minor-mode) minor-mode)
170 (set (make-local-variable 'tool-bar-map) gud-tool-bar-map))
171 buf)))
575661b1 172\f
ee0155df
ER
173;; ======================================================================
174;; command definition
13b80a60
ER
175
176;; This macro is used below to define some basic debugger interface commands.
f961a17c 177;; Of course you may use `gud-def' with any other debugger command, including
6bde8427
JB
178;; user defined ones.
179
180;; A macro call like (gud-def FUNC NAME KEY DOC) expands to a form
181;; which defines FUNC to send the command NAME to the debugger, gives
ee0155df 182;; it the docstring DOC, and binds that function to KEY in the GUD
c6094cae 183;; major mode. The function is also bound in the global keymap with the
5b08a462 184;; GUD prefix.
ee0155df
ER
185
186(defmacro gud-def (func cmd key &optional doc)
187 "Define FUNC to be a command sending STR and bound to KEY, with
188optional doc string DOC. Certain %-escapes in the string arguments
189are interpreted specially if present. These are:
190
c6094cae
EZ
191 %f name (without directory) of current source file.
192 %F name (without directory or extension) of current source file.
193 %d directory of current source file.
194 %l number of current source line
195 %e text of the C lvalue or function-call expression surrounding point.
196 %a text of the hexadecimal address surrounding point
197 %p prefix argument to the command (if any) as a number
ee0155df 198
5b08a462
ER
199 The `current' source file is the file of the current buffer (if
200we're in a C file) or the source file current at the last break or
201step (if we're in the GUD buffer).
202 The `current' line is that of the current buffer (if we're in a
203source file) or the source line number at the last break or step (if
204we're in the GUD buffer)."
ee0155df
ER
205 (list 'progn
206 (list 'defun func '(arg)
207 (or doc "")
208 '(interactive "p")
209 (list 'gud-call cmd 'arg))
210 (if key
dd8e46c7
RS
211 (list 'define-key
212 '(current-local-map)
213 (concat "\C-c" key)
214 (list 'quote func)))
215 (if key
216 (list 'global-set-key
2352cbea 217 (list 'concat 'gud-key-prefix key)
dd8e46c7 218 (list 'quote func)))))
13b80a60 219
f4b643a1
RS
220;; Where gud-display-frame should put the debugging arrow; a cons of
221;; (filename . line-number). This is set by the marker-filter, which scans
222;; the debugger's output for indications of the current program counter.
d840a865
JB
223(defvar gud-last-frame nil)
224
32ab4c10
JB
225;; Used by gud-refresh, which should cause gud-display-frame to redisplay
226;; the last frame, even if it's been called before and gud-last-frame has
227;; been set to nil.
7447c37a 228(defvar gud-last-last-frame nil)
32ab4c10 229
ee0155df
ER
230;; All debugger-specific information is collected here.
231;; Here's how it works, in case you ever need to add a debugger to the mode.
13b80a60
ER
232;;
233;; Each entry must define the following at startup:
234;;
235;;<name>
236;; comint-prompt-regexp
a223b10d 237;; gud-<name>-massage-args
13b80a60 238;; gud-<name>-marker-filter
ee0155df 239;; gud-<name>-find-file
13b80a60 240;;
a223b10d
RM
241;; The job of the massage-args method is to modify the given list of
242;; debugger arguments before running the debugger.
10a4c11f
JB
243;;
244;; The job of the marker-filter method is to detect file/line markers in
245;; strings and set the global gud-last-frame to indicate what display
246;; action (if any) should be triggered by the marker. Note that only
eb8c3be9 247;; whatever the method *returns* is displayed in the buffer; thus, you
10a4c11f
JB
248;; can filter the debugger's output, interpreting some and passing on
249;; the rest.
250;;
ee0155df 251;; The job of the find-file method is to visit and return the buffer indicated
c6094cae 252;; by the car of gud-tag-frame. This may be a file name, a tag name, or
c157af51 253;; something else.
575661b1 254\f
e9a918f9
EL
255;; ======================================================================
256;; speedbar support functions and variables.
8b5cd4d0 257(eval-when-compile (require 'speedbar)) ;For speedbar-with-attached-buffer.
acb50e3c 258
e9a918f9
EL
259(defvar gud-last-speedbar-buffer nil
260 "The last GUD buffer used.")
261
262(defvar gud-last-speedbar-stackframe nil
263 "Description of the currently displayed GUD stack.
264t means that there is no stack, and we are in display-file mode.")
265
acb50e3c
KH
266(defvar gud-speedbar-key-map nil
267 "Keymap used when in the buffers display mode.")
268
269(defun gud-install-speedbar-variables ()
270 "Install those variables used by speedbar to enhance gud/gdb."
271 (if gud-speedbar-key-map
272 nil
273 (setq gud-speedbar-key-map (speedbar-make-specialized-keymap))
274
275 (define-key gud-speedbar-key-map "j" 'speedbar-edit-line)
276 (define-key gud-speedbar-key-map "e" 'speedbar-edit-line)
277 (define-key gud-speedbar-key-map "\C-m" 'speedbar-edit-line)))
278
e9a918f9
EL
279(defvar gud-speedbar-menu-items
280 ;; Note to self. Add expand, and turn off items when not available.
281 '(["Jump to stack frame" speedbar-edit-line t])
110c171f 282 "Additional menu items to add to the speedbar frame.")
e9a918f9 283
acb50e3c
KH
284;; Make sure our special speedbar mode is loaded
285(if (featurep 'speedbar)
286 (gud-install-speedbar-variables)
287 (add-hook 'speedbar-load-hook 'gud-install-speedbar-variables))
288
e9a918f9
EL
289(defun gud-speedbar-buttons (buffer)
290 "Create a speedbar display based on the current state of GUD.
291If the GUD BUFFER is not running a supported debugger, then turn
292off the specialized speedbar mode."
293 (if (and (save-excursion (goto-char (point-min))
294 (looking-at "Current Stack"))
295 (equal gud-last-last-frame gud-last-speedbar-stackframe))
296 nil
297 (setq gud-last-speedbar-buffer buffer)
298 (let* ((ff (save-excursion (set-buffer buffer) gud-find-file))
299 ;;(lf (save-excursion (set-buffer buffer) gud-last-last-frame))
300 (frames
301 (cond ((eq ff 'gud-gdb-find-file)
302 (gud-gdb-get-stackframe buffer)
303 )
304 ;; Add more debuggers here!
305 (t
306 (speedbar-remove-localized-speedbar-support buffer)
307 nil))))
308 (erase-buffer)
309 (if (not frames)
310 (insert "No Stack frames\n")
311 (insert "Current Stack:\n"))
312 (while frames
313 (insert (nth 1 (car frames)) ":\n")
314 (if (= (length (car frames)) 2)
315 (progn
316; (speedbar-insert-button "[?]"
317; 'speedbar-button-face
318; nil nil nil t)
319 (speedbar-insert-button (car (car frames))
320 'speedbar-directory-face
321 nil nil nil t))
322; (speedbar-insert-button "[+]"
323; 'speedbar-button-face
324; 'speedbar-highlight-face
325; 'gud-gdb-get-scope-data
326; (car frames) t)
327 (speedbar-insert-button (car (car frames))
328 'speedbar-file-face
329 'speedbar-highlight-face
330 (cond ((eq ff 'gud-gdb-find-file)
331 'gud-gdb-goto-stackframe)
55535639 332 (t (error "Should never be here")))
e9a918f9
EL
333 (car frames) t))
334 (setq frames (cdr frames)))
335; (let ((selected-frame
336; (cond ((eq ff 'gud-gdb-find-file)
337; (gud-gdb-selected-frame-info buffer))
55535639 338; (t (error "Should never be here"))))))
e9a918f9
EL
339 )
340 (setq gud-last-speedbar-stackframe gud-last-last-frame)))
341
342\f
13b80a60
ER
343;; ======================================================================
344;; gdb functions
345
8b5cd4d0 346;; History of argument lists passed to gdb.
f6376199
JB
347(defvar gud-gdb-history nil)
348
8b5cd4d0
SM
349(defcustom gud-gdb-command-name "gdb --fullname"
350 "Default command to execute an executable under the GDB debugger."
351 :type 'string
352 :group 'gud)
13b80a60 353
dfb7d195 354(defvar gud-gdb-marker-regexp
1ac95fab
RS
355 ;; This used to use path-separator instead of ":";
356 ;; however, we found that on both Windows 32 and MSDOS
357 ;; a colon is correct here.
15cf3ecc 358 (concat "\032\032\\(.:?[^" ":" "\n]*\\)" ":"
1ac95fab 359 "\\([0-9]*\\)" ":" ".*\n"))
dfb7d195 360
768c29d0
JB
361;; There's no guarantee that Emacs will hand the filter the entire
362;; marker at once; it could be broken up across several strings. We
363;; might even receive a big chunk with several markers in it. If we
364;; receive a chunk of text which looks like it might contain the
365;; beginning of a marker, we save it here between calls to the
366;; filter.
f266485d 367(defvar gud-marker-acc "")
0d29cfe9 368(make-variable-buffer-local 'gud-marker-acc)
768c29d0 369
ee0155df 370(defun gud-gdb-marker-filter (string)
bed6a98d
RS
371 (setq gud-marker-acc (concat gud-marker-acc string))
372 (let ((output ""))
373
374 ;; Process all the complete markers in this chunk.
dfb7d195 375 (while (string-match gud-gdb-marker-regexp gud-marker-acc)
bed6a98d
RS
376 (setq
377
378 ;; Extract the frame position from the marker.
379 gud-last-frame
380 (cons (substring gud-marker-acc (match-beginning 1) (match-end 1))
381 (string-to-int (substring gud-marker-acc
382 (match-beginning 2)
383 (match-end 2))))
384
385 ;; Append any text before the marker to the output we're going
386 ;; to return - we don't include the marker in this text.
387 output (concat output
388 (substring gud-marker-acc 0 (match-beginning 0)))
389
390 ;; Set the accumulator to the remaining text.
391 gud-marker-acc (substring gud-marker-acc (match-end 0))))
392
393 ;; Does the remaining text look like it might end with the
394 ;; beginning of another marker? If it does, then keep it in
f5851398 395 ;; gud-marker-acc until we receive the rest of it. Since we
bed6a98d
RS
396 ;; know the full marker regexp above failed, it's pretty simple to
397 ;; test for marker starts.
398 (if (string-match "\032.*\\'" gud-marker-acc)
399 (progn
400 ;; Everything before the potential marker start can be output.
401 (setq output (concat output (substring gud-marker-acc
402 0 (match-beginning 0))))
403
404 ;; Everything after, we save, to combine with later input.
405 (setq gud-marker-acc
406 (substring gud-marker-acc (match-beginning 0))))
407
408 (setq output (concat output gud-marker-acc)
409 gud-marker-acc ""))
410
411 output))
13b80a60 412
ee0155df 413(defun gud-gdb-find-file (f)
c157af51
SM
414 (find-file-noselect f 'nowarn))
415
416(easy-mmode-defmap gud-minibuffer-local-map
417 '(("\C-i" . comint-dynamic-complete-filename))
418 "Keymap for minibuffer prompting of gud startup command."
419 :inherit minibuffer-local-map)
420
421(defun gud-query-cmdline (minor-mode &optional init)
422 (let* ((hist-sym (gud-symbol 'history nil minor-mode))
423 (cmd-name (gud-val 'command-name minor-mode)))
424 (unless (boundp hist-sym) (set hist-sym nil))
425 (read-from-minibuffer
426 (format "Run %s (like this): " minor-mode)
427 (or (car-safe (symbol-value hist-sym))
8b5cd4d0 428 (concat (or cmd-name (symbol-name minor-mode))
f36ca832 429 " " default-directory
8b5cd4d0
SM
430 (or init
431 (let ((file nil))
432 (dolist (f (directory-files default-directory) file)
433 (if (and (file-executable-p f)
434 (not (file-directory-p f))
435 (or (not file)
436 (file-newer-than-file-p f file)))
437 (setq file f)))))))
c157af51
SM
438 gud-minibuffer-local-map nil
439 hist-sym)))
e886137a 440
10a4c11f 441;;;###autoload
a223b10d 442(defun gdb (command-line)
13b80a60
ER
443 "Run gdb on program FILE in buffer *gud-FILE*.
444The directory containing FILE becomes the initial working directory
445and source-file directory for your debugger."
c157af51 446 (interactive (list (gud-query-cmdline 'gdb)))
ee0155df 447
6e7bf73c 448 (gud-common-init command-line nil
ee97eac3 449 'gud-gdb-marker-filter 'gud-gdb-find-file)
c157af51 450 (set (make-local-variable 'gud-minor-mode) 'gdb)
5b08a462 451
dd8e46c7 452 (gud-def gud-break "break %f:%l" "\C-b" "Set breakpoint at current line.")
2fb419e1 453 (gud-def gud-tbreak "tbreak %f:%l" "\C-t" "Set temporary breakpoint at current line.")
23a3aa0a 454 (gud-def gud-remove "clear %f:%l" "\C-d" "Remove breakpoint at current line")
c6094cae 455 (gud-def gud-step "step %p" "\C-s" "Step one source line with display.")
dd8e46c7 456 (gud-def gud-stepi "stepi %p" "\C-i" "Step one instruction with display.")
c6094cae
EZ
457 (gud-def gud-next "next %p" "\C-n" "Step one line (skip functions).")
458 (gud-def gud-cont "cont" "\C-r" "Continue with display.")
459 (gud-def gud-finish "finish" "\C-f" "Finish executing current function.")
38eba485
RS
460 (gud-def gud-jump "tbreak %f:%l\njump %f:%l" "\C-j" "Relocate execution address to line at point in source buffer.")
461
c6094cae
EZ
462 (gud-def gud-up "up %p" "<" "Up N stack frames (numeric arg).")
463 (gud-def gud-down "down %p" ">" "Down N stack frames (numeric arg).")
dd8e46c7 464 (gud-def gud-print "print %e" "\C-p" "Evaluate C expression at point.")
f36ca832
NR
465 (gud-def gud-goto "until %l" "\C-u" "Continue up to current line.")
466 (gud-def gud-run "run" nil "Run the program.")
ee0155df 467
0e0de659 468 (local-set-key "\C-i" 'gud-gdb-complete-command)
b3ede706
KH
469 (local-set-key [menu-bar debug tbreak] '("Temporary Breakpoint" . gud-tbreak))
470 (local-set-key [menu-bar debug finish] '("Finish Function" . gud-finish))
471 (local-set-key [menu-bar debug up] '("Up Stack" . gud-up))
472 (local-set-key [menu-bar debug down] '("Down Stack" . gud-down))
13b80a60 473 (setq comint-prompt-regexp "^(.*gdb[+]?) *")
f54877b2 474 (setq paragraph-start comint-prompt-regexp)
13b80a60
ER
475 (run-hooks 'gdb-mode-hook)
476 )
477
0e0de659
RS
478;; One of the nice features of GDB is its impressive support for
479;; context-sensitive command completion. We preserve that feature
480;; in the GUD buffer by using a GDB command designed just for Emacs.
481
482;; The completion process filter indicates when it is finished.
483(defvar gud-gdb-complete-in-progress)
484
485;; Since output may arrive in fragments we accumulate partials strings here.
486(defvar gud-gdb-complete-string)
487
488;; We need to know how much of the completion to chop off.
489(defvar gud-gdb-complete-break)
490
491;; The completion list is constructed by the process filter.
492(defvar gud-gdb-complete-list)
493
30df2a53
RS
494(defvar gud-comint-buffer nil)
495
0e0de659
RS
496(defun gud-gdb-complete-command ()
497 "Perform completion on the GDB command preceding point.
498This is implemented using the GDB `complete' command which isn't
499available with older versions of GDB."
500 (interactive)
501 (let* ((end (point))
01d8967d 502 (command (buffer-substring (comint-line-beginning-position) end))
0e0de659
RS
503 command-word)
504 ;; Find the word break. This match will always succeed.
505 (string-match "\\(\\`\\| \\)\\([^ ]*\\)\\'" command)
506 (setq gud-gdb-complete-break (match-beginning 2)
507 command-word (substring command gud-gdb-complete-break))
ee97eac3 508 ;; Temporarily install our filter function.
f36ca832
NR
509 (let ((gud-marker-filter (if (eq gud-minor-mode 'gdba)
510 'gdba-complete-filter
511 'gud-gdb-complete-filter)))
ee97eac3
RS
512 ;; Issue the command to GDB.
513 (gud-basic-call (concat "complete " command))
514 (setq gud-gdb-complete-in-progress t
515 gud-gdb-complete-string nil
516 gud-gdb-complete-list nil)
517 ;; Slurp the output.
518 (while gud-gdb-complete-in-progress
519 (accept-process-output (get-buffer-process gud-comint-buffer))))
0e0de659
RS
520 ;; Protect against old versions of GDB.
521 (and gud-gdb-complete-list
522 (string-match "^Undefined command: \"complete\""
523 (car gud-gdb-complete-list))
55535639 524 (error "This version of GDB doesn't support the `complete' command"))
0e0de659
RS
525 ;; Sort the list like readline.
526 (setq gud-gdb-complete-list
527 (sort gud-gdb-complete-list (function string-lessp)))
528 ;; Remove duplicates.
529 (let ((first gud-gdb-complete-list)
530 (second (cdr gud-gdb-complete-list)))
531 (while second
532 (if (string-equal (car first) (car second))
533 (setcdr first (setq second (cdr second)))
534 (setq first second
535 second (cdr second)))))
fd63b4f4
KH
536 ;; Add a trailing single quote if there is a unique completion
537 ;; and it contains an odd number of unquoted single quotes.
538 (and (= (length gud-gdb-complete-list) 1)
539 (let ((str (car gud-gdb-complete-list))
540 (pos 0)
541 (count 0))
542 (while (string-match "\\([^'\\]\\|\\\\'\\)*'" str pos)
543 (setq count (1+ count)
544 pos (match-end 0)))
545 (and (= (mod count 2) 1)
546 (setq gud-gdb-complete-list (list (concat str "'"))))))
0e0de659
RS
547 ;; Let comint handle the rest.
548 (comint-dynamic-simple-complete command-word gud-gdb-complete-list)))
f4b643a1 549
0e0de659
RS
550;; The completion process filter is installed temporarily to slurp the
551;; output of GDB up to the next prompt and build the completion list.
552(defun gud-gdb-complete-filter (string)
553 (setq string (concat gud-gdb-complete-string string))
554 (while (string-match "\n" string)
555 (setq gud-gdb-complete-list
556 (cons (substring string gud-gdb-complete-break (match-beginning 0))
557 gud-gdb-complete-list))
558 (setq string (substring string (match-end 0))))
e9a918f9
EL
559 (if (string-match comint-prompt-regexp string)
560 (progn
561 (setq gud-gdb-complete-in-progress nil)
562 string)
563 (progn
564 (setq gud-gdb-complete-string string)
565 "")))
566
567;; gdb speedbar functions
568
569(defun gud-gdb-goto-stackframe (text token indent)
570 "Goto the stackframe described by TEXT, TOKEN, and INDENT."
571 (speedbar-with-attached-buffer
572 (gud-basic-call (concat "frame " (nth 1 token)))
573 (sit-for 1)))
574
575(defvar gud-gdb-fetched-stack-frame nil
576 "Stack frames we are fetching from GDB.")
577
578(defvar gud-gdb-fetched-stack-frame-list nil
579 "List of stack frames we are fetching from GDB.")
580
581;(defun gud-gdb-get-scope-data (text token indent)
582; ;; checkdoc-params: (indent)
583; "Fetch data associated with a stack frame, and expand/contract it.
584;Data to do this is retrieved from TEXT and TOKEN."
585; (let ((args nil) (scope nil))
586; (gud-gdb-run-command-fetch-lines "info args")
587;
588; (gud-gdb-run-command-fetch-lines "info local")
589;
590; ))
591
592(defun gud-gdb-get-stackframe (buffer)
593 "Extract the current stack frame out of the GUD GDB BUFFER."
594 (let ((newlst nil)
595 (gud-gdb-fetched-stack-frame-list nil))
596 (gud-gdb-run-command-fetch-lines "backtrace" buffer)
acb50e3c
KH
597 (if (and (car gud-gdb-fetched-stack-frame-list)
598 (string-match "No stack" (car gud-gdb-fetched-stack-frame-list)))
e9a918f9
EL
599 ;; Go into some other mode???
600 nil
601 (while gud-gdb-fetched-stack-frame-list
602 (let ((e (car gud-gdb-fetched-stack-frame-list))
603 (name nil) (num nil))
604 (if (not (or
acb50e3c
KH
605 (string-match "^#\\([0-9]+\\) +[0-9a-fx]+ in \\([:0-9a-zA-Z_]+\\) (" e)
606 (string-match "^#\\([0-9]+\\) +\\([:0-9a-zA-Z_]+\\) (" e)))
e9a918f9
EL
607 (if (not (string-match
608 "at \\([-0-9a-zA-Z_.]+\\):\\([0-9]+\\)$" e))
609 nil
610 (setcar newlst
611 (list (nth 0 (car newlst))
612 (nth 1 (car newlst))
613 (match-string 1 e)
614 (match-string 2 e))))
615 (setq num (match-string 1 e)
616 name (match-string 2 e))
617 (setq newlst
618 (cons
619 (if (string-match
620 "at \\([-0-9a-zA-Z_.]+\\):\\([0-9]+\\)$" e)
621 (list name num (match-string 1 e)
622 (match-string 2 e))
623 (list name num))
624 newlst))))
625 (setq gud-gdb-fetched-stack-frame-list
626 (cdr gud-gdb-fetched-stack-frame-list)))
627 (nreverse newlst))))
628
629;(defun gud-gdb-selected-frame-info (buffer)
630; "Learn GDB information for the currently selected stack frame in BUFFER."
631; )
632
633(defun gud-gdb-run-command-fetch-lines (command buffer)
634 "Run COMMAND, and return when `gud-gdb-fetched-stack-frame-list' is full.
635BUFFER is the GUD buffer in which to run the command."
636 (save-excursion
637 (set-buffer buffer)
638 (if (save-excursion
639 (goto-char (point-max))
d2d1851b 640 (forward-line 0)
e9a918f9
EL
641 (not (looking-at comint-prompt-regexp)))
642 nil
643 ;; Much of this copied from GDB complete, but I'm grabbing the stack
644 ;; frame instead.
645 (let ((gud-marker-filter 'gud-gdb-speedbar-stack-filter))
646 ;; Issue the command to GDB.
647 (gud-basic-call command)
648 (setq gud-gdb-complete-in-progress t ;; use this flag for our purposes.
649 gud-gdb-complete-string nil
650 gud-gdb-complete-list nil)
651 ;; Slurp the output.
652 (while gud-gdb-complete-in-progress
653 (accept-process-output (get-buffer-process gud-comint-buffer)))
654 (setq gud-gdb-fetched-stack-frame nil
655 gud-gdb-fetched-stack-frame-list
656 (nreverse gud-gdb-fetched-stack-frame-list))))))
f4b643a1 657
e9a918f9
EL
658(defun gud-gdb-speedbar-stack-filter (string)
659 ;; checkdoc-params: (string)
660 "Filter used to read in the current GDB stack."
661 (setq string (concat gud-gdb-fetched-stack-frame string))
662 (while (string-match "\n" string)
663 (setq gud-gdb-fetched-stack-frame-list
664 (cons (substring string 0 (match-beginning 0))
665 gud-gdb-fetched-stack-frame-list))
666 (setq string (substring string (match-end 0))))
0e0de659
RS
667 (if (string-match comint-prompt-regexp string)
668 (progn
669 (setq gud-gdb-complete-in-progress nil)
670 string)
671 (progn
672 (setq gud-gdb-complete-string string)
673 "")))
674
575661b1 675\f
13b80a60
ER
676;; ======================================================================
677;; sdb functions
678
8b5cd4d0 679;; History of argument lists passed to sdb.
f6376199
JB
680(defvar gud-sdb-history nil)
681
ee0155df
ER
682(defvar gud-sdb-needs-tags (not (file-exists-p "/var"))
683 "If nil, we're on a System V Release 4 and don't need the tags hack.")
684
685(defvar gud-sdb-lastfile nil)
686
ee0155df 687(defun gud-sdb-marker-filter (string)
7f629252
RS
688 (setq gud-marker-acc
689 (if gud-marker-acc (concat gud-marker-acc string) string))
690 (let (start)
691 ;; Process all complete markers in this chunk
f4b643a1
RS
692 (while
693 (cond
7f629252 694 ;; System V Release 3.2 uses this format
bcdef904 695 ((string-match "\\(^\\|\n\\)\\*?\\(0x\\w* in \\)?\\([^:\n]*\\):\\([0-9]*\\):.*\n"
7f629252
RS
696 gud-marker-acc start)
697 (setq gud-last-frame
698 (cons
bcdef904 699 (substring gud-marker-acc (match-beginning 3) (match-end 3))
f4b643a1 700 (string-to-int
bcdef904 701 (substring gud-marker-acc (match-beginning 4) (match-end 4))))))
7f629252 702 ;; System V Release 4.0 quite often clumps two lines together
f4b643a1 703 ((string-match "^\\(BREAKPOINT\\|STEPPED\\) process [0-9]+ function [^ ]+ in \\(.+\\)\n\\([0-9]+\\):"
7f629252
RS
704 gud-marker-acc start)
705 (setq gud-sdb-lastfile
706 (substring gud-marker-acc (match-beginning 2) (match-end 2)))
707 (setq gud-last-frame
708 (cons
709 gud-sdb-lastfile
f4b643a1 710 (string-to-int
7f629252 711 (substring gud-marker-acc (match-beginning 3) (match-end 3))))))
f4b643a1 712 ;; System V Release 4.0
7f629252
RS
713 ((string-match "^\\(BREAKPOINT\\|STEPPED\\) process [0-9]+ function [^ ]+ in \\(.+\\)\n"
714 gud-marker-acc start)
715 (setq gud-sdb-lastfile
716 (substring gud-marker-acc (match-beginning 2) (match-end 2))))
717 ((and gud-sdb-lastfile (string-match "^\\([0-9]+\\):"
718 gud-marker-acc start))
719 (setq gud-last-frame
720 (cons
721 gud-sdb-lastfile
f4b643a1 722 (string-to-int
7f629252 723 (substring gud-marker-acc (match-beginning 1) (match-end 1))))))
f4b643a1 724 (t
7f629252
RS
725 (setq gud-sdb-lastfile nil)))
726 (setq start (match-end 0)))
727
728 ;; Search for the last incomplete line in this chunk
729 (while (string-match "\n" gud-marker-acc start)
730 (setq start (match-end 0)))
731
732 ;; If we have an incomplete line, store it in gud-marker-acc.
bcdef904 733 (setq gud-marker-acc (substring gud-marker-acc (or start 0))))
13b80a60
ER
734 string)
735
ee0155df 736(defun gud-sdb-find-file (f)
c157af51 737 (if gud-sdb-needs-tags (find-tag-noselect f) (find-file-noselect f)))
13b80a60 738
10a4c11f 739;;;###autoload
a223b10d 740(defun sdb (command-line)
13b80a60
ER
741 "Run sdb on program FILE in buffer *gud-FILE*.
742The directory containing FILE becomes the initial working directory
743and source-file directory for your debugger."
c157af51
SM
744 (interactive (list (gud-query-cmdline 'sdb)))
745
ee0155df 746 (if (and gud-sdb-needs-tags
e290aebb
RS
747 (not (and (boundp 'tags-file-name)
748 (stringp tags-file-name)
749 (file-exists-p tags-file-name))))
55535639 750 (error "The sdb support requires a valid tags table to work"))
13b80a60 751
8b5cd4d0 752 (gud-common-init command-line nil
ee97eac3 753 'gud-sdb-marker-filter 'gud-sdb-find-file)
c157af51 754 (set (make-local-variable 'gud-minor-mode) 'sdb)
5b08a462 755
dd8e46c7
RS
756 (gud-def gud-break "%l b" "\C-b" "Set breakpoint at current line.")
757 (gud-def gud-tbreak "%l c" "\C-t" "Set temporary breakpoint at current line.")
758 (gud-def gud-remove "%l d" "\C-d" "Remove breakpoint at current line")
759 (gud-def gud-step "s %p" "\C-s" "Step one source line with display.")
760 (gud-def gud-stepi "i %p" "\C-i" "Step one instruction with display.")
761 (gud-def gud-next "S %p" "\C-n" "Step one line (skip functions).")
762 (gud-def gud-cont "c" "\C-r" "Continue with display.")
763 (gud-def gud-print "%e/" "\C-p" "Evaluate C expression at point.")
13b80a60 764
6bde8427 765 (setq comint-prompt-regexp "\\(^\\|\n\\)\\*")
f54877b2 766 (setq paragraph-start comint-prompt-regexp)
2291bfaa 767 (local-set-key [menu-bar debug tbreak]
b3ede706 768 '("Temporary Breakpoint" . gud-tbreak))
13b80a60
ER
769 (run-hooks 'sdb-mode-hook)
770 )
575661b1 771\f
13b80a60
ER
772;; ======================================================================
773;; dbx functions
774
8b5cd4d0 775;; History of argument lists passed to dbx.
f6376199
JB
776(defvar gud-dbx-history nil)
777
69c1dd37 778(defcustom gud-dbx-directories nil
3b3703fa
RS
779 "*A list of directories that dbx should search for source code.
780If nil, only source files in the program directory
781will be known to dbx.
782
783The file names should be absolute, or relative to the directory
69c1dd37
RS
784containing the executable being debugged."
785 :type '(choice (const :tag "Current Directory" nil)
786 (repeat :value ("")
787 directory))
788 :group 'gud)
3b3703fa
RS
789
790(defun gud-dbx-massage-args (file args)
791 (nconc (let ((directories gud-dbx-directories)
792 (result nil))
793 (while directories
794 (setq result (cons (car directories) (cons "-I" result)))
795 (setq directories (cdr directories)))
796 (nreverse result))
797 args))
798
799(defun gud-dbx-file-name (f)
800 "Transform a relative file name to an absolute file name, for dbx."
801 (let ((result nil))
802 (if (file-exists-p f)
f5851398 803 (setq result (expand-file-name f))
3b3703fa 804 (let ((directories gud-dbx-directories))
f5851398
EZ
805 (while directories
806 (let ((path (concat (car directories) "/" f)))
807 (if (file-exists-p path)
808 (setq result (expand-file-name path)
809 directories nil)))
810 (setq directories (cdr directories)))))
3b3703fa 811 result))
13b80a60 812
ee0155df 813(defun gud-dbx-marker-filter (string)
7f629252
RS
814 (setq gud-marker-acc (if gud-marker-acc (concat gud-marker-acc string) string))
815
816 (let (start)
817 ;; Process all complete markers in this chunk.
818 (while (or (string-match
819 "stopped in .* at line \\([0-9]*\\) in file \"\\([^\"]*\\)\""
820 gud-marker-acc start)
821 (string-match
822 "signal .* in .* at line \\([0-9]*\\) in file \"\\([^\"]*\\)\""
823 gud-marker-acc start))
13b80a60
ER
824 (setq gud-last-frame
825 (cons
7f629252 826 (substring gud-marker-acc (match-beginning 2) (match-end 2))
f4b643a1 827 (string-to-int
7f629252
RS
828 (substring gud-marker-acc (match-beginning 1) (match-end 1))))
829 start (match-end 0)))
830
831 ;; Search for the last incomplete line in this chunk
832 (while (string-match "\n" gud-marker-acc start)
833 (setq start (match-end 0)))
834
835 ;; If the incomplete line APPEARS to begin with another marker, keep it
836 ;; in the accumulator. Otherwise, clear the accumulator to avoid an
837 ;; unnecessary concat during the next call.
f4b643a1 838 (setq gud-marker-acc
7f629252
RS
839 (if (string-match "\\(stopped\\|signal\\)" gud-marker-acc start)
840 (substring gud-marker-acc (match-beginning 0))
841 nil)))
13b80a60
ER
842 string)
843
f266485d
RS
844;; Functions for Mips-style dbx. Given the option `-emacs', documented in
845;; OSF1, not necessarily elsewhere, it produces markers similar to gdb's.
846(defvar gud-mips-p
847 (or (string-match "^mips-[^-]*-ultrix" system-configuration)
848 ;; We haven't tested gud on this system:
849 (string-match "^mips-[^-]*-riscos" system-configuration)
850 ;; It's documented on OSF/1.3
9f24ea14 851 (string-match "^mips-[^-]*-osf1" system-configuration)
7c82656b 852 (string-match "^alpha[^-]*-[^-]*-osf" system-configuration))
f266485d 853 "Non-nil to assume the MIPS/OSF dbx conventions (argument `-emacs').")
13eaa026
RS
854
855(defun gud-mipsdbx-massage-args (file args)
dfbd82a6 856 (cons "-emacs" args))
13eaa026 857
f266485d
RS
858;; This is just like the gdb one except for the regexps since we need to cope
859;; with an optional breakpoint number in [] before the ^Z^Z
13eaa026 860(defun gud-mipsdbx-marker-filter (string)
bed6a98d
RS
861 (setq gud-marker-acc (concat gud-marker-acc string))
862 (let ((output ""))
863
864 ;; Process all the complete markers in this chunk.
865 (while (string-match
866 ;; This is like th gdb marker but with an optional
867 ;; leading break point number like `[1] '
868 "[][ 0-9]*\032\032\\([^:\n]*\\):\\([0-9]*\\):.*\n"
869 gud-marker-acc)
870 (setq
871
872 ;; Extract the frame position from the marker.
873 gud-last-frame
874 (cons (substring gud-marker-acc (match-beginning 1) (match-end 1))
875 (string-to-int (substring gud-marker-acc
876 (match-beginning 2)
877 (match-end 2))))
878
879 ;; Append any text before the marker to the output we're going
880 ;; to return - we don't include the marker in this text.
881 output (concat output
882 (substring gud-marker-acc 0 (match-beginning 0)))
883
884 ;; Set the accumulator to the remaining text.
885 gud-marker-acc (substring gud-marker-acc (match-end 0))))
886
887 ;; Does the remaining text look like it might end with the
888 ;; beginning of another marker? If it does, then keep it in
c6094cae 889 ;; gud-marker-acc until we receive the rest of it. Since we
bed6a98d
RS
890 ;; know the full marker regexp above failed, it's pretty simple to
891 ;; test for marker starts.
892 (if (string-match "[][ 0-9]*\032.*\\'" gud-marker-acc)
893 (progn
894 ;; Everything before the potential marker start can be output.
895 (setq output (concat output (substring gud-marker-acc
896 0 (match-beginning 0))))
897
898 ;; Everything after, we save, to combine with later input.
899 (setq gud-marker-acc
900 (substring gud-marker-acc (match-beginning 0))))
901
902 (setq output (concat output gud-marker-acc)
903 gud-marker-acc ""))
904
905 output))
13eaa026 906
f266485d
RS
907;; The dbx in IRIX is a pain. It doesn't print the file name when
908;; stopping at a breakpoint (but you do get it from the `up' and
c6094cae 909;; `down' commands...). The only way to extract the information seems
f266485d
RS
910;; to be with a `file' command, although the current line number is
911;; available in $curline. Thus we have to look for output which
912;; appears to indicate a breakpoint. Then we prod the dbx sub-process
913;; to output the information we want with a combination of the
914;; `printf' and `file' commands as a pseudo marker which we can
915;; recognise next time through the marker-filter. This would be like
916;; the gdb marker but you can't get the file name without a newline...
917;; Note that gud-remove won't work since Irix dbx expects a breakpoint
918;; number rather than a line number etc. Maybe this could be made to
919;; work by listing all the breakpoints and picking the one(s) with the
920;; correct line number, but life's too short.
921;; d.love@dl.ac.uk (Dave Love) can be blamed for this
922
ac8da950
KH
923(defvar gud-irix-p
924 (and (string-match "^mips-[^-]*-irix" system-configuration)
925 (not (string-match "irix[6-9]\\.[1-9]" system-configuration)))
f266485d 926 "Non-nil to assume the interface appropriate for IRIX dbx.
ac8da950
KH
927This works in IRIX 4, 5 and 6, but `gud-dbx-use-stopformat-p' provides
928a better solution in 6.1 upwards.")
929(defvar gud-dbx-use-stopformat-p
930 (string-match "irix[6-9]\\.[1-9]" system-configuration)
931 "Non-nil to use the dbx feature present at least from Irix 6.1
932 whereby $stopformat=1 produces an output format compatiable with
933 `gud-dbx-marker-filter'.")
2fb419e1
RS
934;; [Irix dbx seems to be a moving target. The dbx output changed
935;; subtly sometime between OS v4.0.5 and v5.2 so that, for instance,
936;; the output from `up' is no longer spotted by gud (and it's probably
937;; not distinctive enough to try to match it -- use C-<, C->
938;; exclusively) . For 5.3 and 6.0, the $curline variable changed to
939;; `long long'(why?!), so the printf stuff needed changing. The line
ac8da950
KH
940;; number was cast to `long' as a compromise between the new `long
941;; long' and the original `int'. This is reported not to work in 6.2,
942;; so it's changed back to int -- don't make your sources too long.
943;; From Irix6.1 (but not 6.0?) dbx supports an undocumented feature
944;; whereby `set $stopformat=1' reportedly produces output compatible
945;; with `gud-dbx-marker-filter', which we prefer.
946
947;; The process filter is also somewhat
2fb419e1
RS
948;; unreliable, sometimes not spotting the markers; I don't know
949;; whether there's anything that can be done about that. It would be
950;; much better if SGI could be persuaded to (re?)instate the MIPS
951;; -emacs flag for gdb-like output (which ought to be possible as most
952;; of the communication I've had over it has been from sgi.com).]
f266485d
RS
953
954;; this filter is influenced by the xdb one rather than the gdb one
955(defun gud-irixdbx-marker-filter (string)
bed6a98d
RS
956 (let (result (case-fold-search nil))
957 (if (or (string-match comint-prompt-regexp string)
958 (string-match ".*\012" string))
959 (setq result (concat gud-marker-acc string)
960 gud-marker-acc "")
961 (setq gud-marker-acc (concat gud-marker-acc string)))
962 (if result
963 (cond
964 ;; look for breakpoint or signal indication e.g.:
c6094cae 965 ;; [2] Process 1267 (pplot) stopped at [params:338 ,0x400ec0]
bed6a98d
RS
966 ;; Process 1281 (pplot) stopped at [params:339 ,0x400ec8]
967 ;; Process 1270 (pplot) Floating point exception [._read._read:16 ,0x452188]
968 ((string-match
f4b643a1 969 "^\\(\\[[0-9]+] \\)?Process +[0-9]+ ([^)]*) [^[]+\\[[^]\n]*]\n"
bed6a98d
RS
970 result)
971 ;; prod dbx into printing out the line number and file
972 ;; name in a form we can grok as below
973 (process-send-string (get-buffer-process gud-comint-buffer)
ac8da950 974 "printf \"\032\032%1d:\",(int)$curline;file\n"))
bed6a98d
RS
975 ;; look for result of, say, "up" e.g.:
976 ;; .pplot.pplot(0x800) ["src/pplot.f":261, 0x400c7c]
977 ;; (this will also catch one of the lines printed by "where")
978 ((string-match
979 "^[^ ][^[]*\\[\"\\([^\"]+\\)\":\\([0-9]+\\), [^]]+]\n"
980 result)
981 (let ((file (substring result (match-beginning 1)
982 (match-end 1))))
983 (if (file-exists-p file)
984 (setq gud-last-frame
985 (cons
986 (substring
987 result (match-beginning 1) (match-end 1))
f4b643a1 988 (string-to-int
bed6a98d
RS
989 (substring
990 result (match-beginning 2) (match-end 2)))))))
991 result)
992 ((string-match ; kluged-up marker as above
993 "\032\032\\([0-9]*\\):\\(.*\\)\n" result)
3b3703fa
RS
994 (let ((file (gud-dbx-file-name
995 (substring result (match-beginning 2) (match-end 2)))))
996 (if (and file (file-exists-p file))
bed6a98d
RS
997 (setq gud-last-frame
998 (cons
999 file
f4b643a1 1000 (string-to-int
bed6a98d
RS
1001 (substring
1002 result (match-beginning 1) (match-end 1)))))))
1003 (setq result (substring result 0 (match-beginning 0))))))
1004 (or result "")))
f266485d 1005
34c8b673
RS
1006(defvar gud-dgux-p (string-match "-dgux" system-configuration)
1007 "Non-nil means to assume the interface approriate for DG/UX dbx.
1008This was tested using R4.11.")
1009
1010;; There are a couple of differences between DG's dbx output and normal
1011;; dbx output which make it nontrivial to integrate this into the
1012;; standard dbx-marker-filter (mainly, there are a different number of
1013;; backreferences). The markers look like:
1014;;
1015;; (0) Stopped at line 10, routine main(argc=1, argv=0xeffff0e0), file t.c
1016;;
1017;; from breakpoints (the `(0)' there isn't constant, it's the breakpoint
1018;; number), and
1019;;
1020;; Stopped at line 13, routine main(argc=1, argv=0xeffff0e0), file t.c
1021;;
1022;; from signals and
1023;;
1024;; Frame 21, line 974, routine command_loop(), file keyboard.c
1025;;
1026;; from up/down/where.
1027
1028(defun gud-dguxdbx-marker-filter (string)
1029 (setq gud-marker-acc (if gud-marker-acc
1030 (concat gud-marker-acc string)
1031 string))
1032 (let ((re (concat "^\\(\\(([0-9]+) \\)?Stopped at\\|Frame [0-9]+,\\)"
1033 " line \\([0-9]+\\), routine .*, file \\([^ \t\n]+\\)"))
1034 start)
1035 ;; Process all complete markers in this chunk.
1036 (while (string-match re gud-marker-acc start)
1037 (setq gud-last-frame
1038 (cons
1039 (substring gud-marker-acc (match-beginning 4) (match-end 4))
1040 (string-to-int (substring gud-marker-acc
1041 (match-beginning 3) (match-end 3))))
1042 start (match-end 0)))
1043
1044 ;; Search for the last incomplete line in this chunk
1045 (while (string-match "\n" gud-marker-acc start)
1046 (setq start (match-end 0)))
1047
1048 ;; If the incomplete line APPEARS to begin with another marker, keep it
1049 ;; in the accumulator. Otherwise, clear the accumulator to avoid an
1050 ;; unnecessary concat during the next call.
f4b643a1 1051 (setq gud-marker-acc
34c8b673
RS
1052 (if (string-match "Stopped\\|Frame" gud-marker-acc start)
1053 (substring gud-marker-acc (match-beginning 0))
1054 nil)))
1055 string)
1056
ee0155df 1057(defun gud-dbx-find-file (f)
9bb4544b 1058 (save-excursion
3b3703fa
RS
1059 (let ((realf (gud-dbx-file-name f)))
1060 (if realf
c157af51 1061 (find-file-noselect realf)))))
13b80a60 1062
10a4c11f 1063;;;###autoload
a223b10d 1064(defun dbx (command-line)
13b80a60
ER
1065 "Run dbx on program FILE in buffer *gud-FILE*.
1066The directory containing FILE becomes the initial working directory
1067and source-file directory for your debugger."
c157af51 1068 (interactive (list (gud-query-cmdline 'dbx)))
13eaa026 1069
ee97eac3
RS
1070 (cond
1071 (gud-mips-p
1072 (gud-common-init command-line 'gud-mipsdbx-massage-args
1073 'gud-mipsdbx-marker-filter 'gud-dbx-find-file))
1074 (gud-irix-p
1075 (gud-common-init command-line 'gud-dbx-massage-args
1076 'gud-irixdbx-marker-filter 'gud-dbx-find-file))
34c8b673
RS
1077 (gud-dgux-p
1078 (gud-common-init command-line 'gud-dbx-massage-args
1079 'gud-dguxdbx-marker-filter 'gud-dbx-find-file))
ee97eac3
RS
1080 (t
1081 (gud-common-init command-line 'gud-dbx-massage-args
1082 'gud-dbx-marker-filter 'gud-dbx-find-file)))
5b08a462 1083
c157af51
SM
1084 (set (make-local-variable 'gud-minor-mode) 'dbx)
1085
13eaa026 1086 (cond
f266485d 1087 (gud-mips-p
c6094cae 1088 (gud-def gud-up "up %p" "<" "Up (numeric arg) stack frames.")
f5851398 1089 (gud-def gud-down "down %p" ">" "Down (numeric arg) stack frames.")
c6094cae 1090 (gud-def gud-break "stop at \"%f\":%l"
13eaa026
RS
1091 "\C-b" "Set breakpoint at current line.")
1092 (gud-def gud-finish "return" "\C-f" "Finish executing current function."))
f266485d 1093 (gud-irix-p
c6094cae 1094 (gud-def gud-break "stop at \"%d%f\":%l"
f266485d
RS
1095 "\C-b" "Set breakpoint at current line.")
1096 (gud-def gud-finish "return" "\C-f" "Finish executing current function.")
f5851398 1097 (gud-def gud-up "up %p; printf \"\032\032%1d:\",(int)$curline;file\n"
2fb419e1 1098 "<" "Up (numeric arg) stack frames.")
ac8da950 1099 (gud-def gud-down "down %p; printf \"\032\032%1d:\",(int)$curline;file\n"
2fb419e1 1100 ">" "Down (numeric arg) stack frames.")
f266485d
RS
1101 ;; Make dbx give out the source location info that we need.
1102 (process-send-string (get-buffer-process gud-comint-buffer)
ac8da950 1103 "printf \"\032\032%1d:\",(int)$curline;file\n"))
13eaa026 1104 (t
c6094cae 1105 (gud-def gud-up "up %p" "<" "Up (numeric arg) stack frames.")
f5851398 1106 (gud-def gud-down "down %p" ">" "Down (numeric arg) stack frames.")
13eaa026 1107 (gud-def gud-break "file \"%d%f\"\nstop at %l"
cfcda0ba
EZ
1108 "\C-b" "Set breakpoint at current line.")
1109 (if gud-dbx-use-stopformat-p
1110 (process-send-string (get-buffer-process gud-comint-buffer)
1111 "set $stopformat=1\n"))))
13eaa026 1112
dd8e46c7 1113 (gud-def gud-remove "clear %l" "\C-d" "Remove breakpoint at current line")
c6094cae 1114 (gud-def gud-step "step %p" "\C-s" "Step one line with display.")
dd8e46c7 1115 (gud-def gud-stepi "stepi %p" "\C-i" "Step one instruction with display.")
c6094cae
EZ
1116 (gud-def gud-next "next %p" "\C-n" "Step one line (skip functions).")
1117 (gud-def gud-cont "cont" "\C-r" "Continue with display.")
dd8e46c7 1118 (gud-def gud-print "print %e" "\C-p" "Evaluate C expression at point.")
ee0155df 1119
13eaa026 1120 (setq comint-prompt-regexp "^[^)\n]*dbx) *")
f54877b2 1121 (setq paragraph-start comint-prompt-regexp)
b3ede706
KH
1122 (local-set-key [menu-bar debug up] '("Up Stack" . gud-up))
1123 (local-set-key [menu-bar debug down] '("Down Stack" . gud-down))
13b80a60
ER
1124 (run-hooks 'dbx-mode-hook)
1125 )
575661b1 1126\f
6496f3d2
RS
1127;; ======================================================================
1128;; xdb (HP PARISC debugger) functions
1129
8b5cd4d0 1130;; History of argument lists passed to xdb.
f6376199
JB
1131(defvar gud-xdb-history nil)
1132
69c1dd37 1133(defcustom gud-xdb-directories nil
fce222c7
RS
1134 "*A list of directories that xdb should search for source code.
1135If nil, only source files in the program directory
1136will be known to xdb.
1137
1138The file names should be absolute, or relative to the directory
69c1dd37
RS
1139containing the executable being debugged."
1140 :type '(choice (const :tag "Current Directory" nil)
1141 (repeat :value ("")
1142 directory))
1143 :group 'gud)
fce222c7 1144
a223b10d
RM
1145(defun gud-xdb-massage-args (file args)
1146 (nconc (let ((directories gud-xdb-directories)
1147 (result nil))
1148 (while directories
1149 (setq result (cons (car directories) (cons "-d" result)))
1150 (setq directories (cdr directories)))
dfbd82a6 1151 (nreverse result))
a223b10d 1152 args))
6496f3d2
RS
1153
1154(defun gud-xdb-file-name (f)
1155 "Transform a relative pathname to a full pathname in xdb mode"
1156 (let ((result nil))
1157 (if (file-exists-p f)
f5851398 1158 (setq result (expand-file-name f))
fce222c7 1159 (let ((directories gud-xdb-directories))
f5851398
EZ
1160 (while directories
1161 (let ((path (concat (car directories) "/" f)))
1162 (if (file-exists-p path)
1163 (setq result (expand-file-name path)
1164 directories nil)))
1165 (setq directories (cdr directories)))))
6496f3d2
RS
1166 result))
1167
1168;; xdb does not print the lines all at once, so we have to accumulate them
6496f3d2
RS
1169(defun gud-xdb-marker-filter (string)
1170 (let (result)
1171 (if (or (string-match comint-prompt-regexp string)
f5851398
EZ
1172 (string-match ".*\012" string))
1173 (setq result (concat gud-marker-acc string)
1174 gud-marker-acc "")
f266485d 1175 (setq gud-marker-acc (concat gud-marker-acc string)))
6496f3d2 1176 (if result
f5851398 1177 (if (or (string-match "\\([^\n \t:]+\\): [^:]+: \\([0-9]+\\)[: ]"
1dc9668c 1178 result)
f5851398
EZ
1179 (string-match "[^: \t]+:[ \t]+\\([^:]+\\): [^:]+: \\([0-9]+\\):"
1180 result))
8b5cd4d0
SM
1181 (let ((line (string-to-int (match-string 2 result)))
1182 (file (gud-xdb-file-name (match-string 1 result))))
f5851398
EZ
1183 (if file
1184 (setq gud-last-frame (cons file line))))))
f4b643a1
RS
1185 (or result "")))
1186
6496f3d2 1187(defun gud-xdb-find-file (f)
9bb4544b
RS
1188 (save-excursion
1189 (let ((realf (gud-xdb-file-name f)))
1190 (if realf
c157af51 1191 (find-file-noselect realf)))))
6496f3d2
RS
1192
1193;;;###autoload
a223b10d 1194(defun xdb (command-line)
6496f3d2
RS
1195 "Run xdb on program FILE in buffer *gud-FILE*.
1196The directory containing FILE becomes the initial working directory
1197and source-file directory for your debugger.
1198
fce222c7 1199You can set the variable 'gud-xdb-directories' to a list of program source
6496f3d2 1200directories if your program contains sources from more than one directory."
c157af51 1201 (interactive (list (gud-query-cmdline 'xdb)))
6496f3d2 1202
ee97eac3
RS
1203 (gud-common-init command-line 'gud-xdb-massage-args
1204 'gud-xdb-marker-filter 'gud-xdb-find-file)
c157af51 1205 (set (make-local-variable 'gud-minor-mode) 'xdb)
6496f3d2 1206
c6094cae 1207 (gud-def gud-break "b %f:%l" "\C-b" "Set breakpoint at current line.")
6496f3d2 1208 (gud-def gud-tbreak "b %f:%l\\t" "\C-t"
f5851398 1209 "Set temporary breakpoint at current line.")
c6094cae
EZ
1210 (gud-def gud-remove "db" "\C-d" "Remove breakpoint at current line")
1211 (gud-def gud-step "s %p" "\C-s" "Step one line with display.")
1212 (gud-def gud-next "S %p" "\C-n" "Step one line (skip functions).")
1213 (gud-def gud-cont "c" "\C-r" "Continue with display.")
1214 (gud-def gud-up "up %p" "<" "Up (numeric arg) stack frames.")
1215 (gud-def gud-down "down %p" ">" "Down (numeric arg) stack frames.")
1216 (gud-def gud-finish "bu\\t" "\C-f" "Finish executing current function.")
1217 (gud-def gud-print "p %e" "\C-p" "Evaluate C expression at point.")
6496f3d2
RS
1218
1219 (setq comint-prompt-regexp "^>")
f54877b2 1220 (setq paragraph-start comint-prompt-regexp)
b3ede706
KH
1221 (local-set-key [menu-bar debug tbreak] '("Temporary Breakpoint" . gud-tbreak))
1222 (local-set-key [menu-bar debug finish] '("Finish Function" . gud-finish))
1223 (local-set-key [menu-bar debug up] '("Up Stack" . gud-up))
1224 (local-set-key [menu-bar debug down] '("Down Stack" . gud-down))
6496f3d2 1225 (run-hooks 'xdb-mode-hook))
575661b1
RS
1226\f
1227;; ======================================================================
1228;; perldb functions
1229
8b5cd4d0 1230;; History of argument lists passed to perldb.
575661b1
RS
1231(defvar gud-perldb-history nil)
1232
1233(defun gud-perldb-massage-args (file args)
8b5cd4d0
SM
1234 "Convert a command line as would be typed normally to run perldb
1235into one that invokes an Emacs-enabled debugging session.
1236\"-emacs\" is inserted where it will be $ARGV[0] (see perl5db.pl)."
1237 ;; FIXME: what if the command is `make perldb' and doesn't accept those extra
1238 ;; arguments ?
1239 (let* ((new-args nil)
a09754e6 1240 (seen-e nil)
8b5cd4d0 1241 (shift (lambda () (push (pop args) new-args))))
f2eb772d 1242
a09754e6 1243 ;; Pass all switches and -e scripts through.
f2eb772d 1244 (while (and args
a09754e6
GM
1245 (string-match "^-" (car args))
1246 (not (equal "-" (car args)))
1247 (not (equal "--" (car args))))
1248 (when (equal "-e" (car args))
1249 ;; -e goes with the next arg, so shift one extra.
1250 (or (funcall shift)
1251 ;; -e as the last arg is an error in Perl.
55535639 1252 (error "No code specified for -e"))
a09754e6
GM
1253 (setq seen-e t))
1254 (funcall shift))
1255
d2d1851b 1256 (unless seen-e
a09754e6
GM
1257 (if (or (not args)
1258 (string-match "^-" (car args)))
55535639 1259 (error "Can't use stdin as the script to debug"))
a09754e6
GM
1260 ;; This is the program name.
1261 (funcall shift))
1262
1263 ;; If -e specified, make sure there is a -- so -emacs is not taken
1264 ;; as -e macs.
1265 (if (and args (equal "--" (car args)))
1266 (funcall shift)
d2d1851b 1267 (and seen-e (push "--" new-args)))
f2eb772d 1268
d2d1851b 1269 (push "-emacs" new-args)
f2eb772d 1270 (while args
a09754e6 1271 (funcall shift))
f2eb772d 1272
a09754e6 1273 (nreverse new-args)))
575661b1
RS
1274
1275;; There's no guarantee that Emacs will hand the filter the entire
1276;; marker at once; it could be broken up across several strings. We
1277;; might even receive a big chunk with several markers in it. If we
1278;; receive a chunk of text which looks like it might contain the
1279;; beginning of a marker, we save it here between calls to the
1280;; filter.
575661b1 1281(defun gud-perldb-marker-filter (string)
bed6a98d
RS
1282 (setq gud-marker-acc (concat gud-marker-acc string))
1283 (let ((output ""))
1284
1285 ;; Process all the complete markers in this chunk.
aa9063cb 1286 (while (string-match "\032\032\\(\\([a-zA-Z]:\\)?[^:\n]*\\):\\([0-9]*\\):.*\n"
bed6a98d
RS
1287 gud-marker-acc)
1288 (setq
1289
1290 ;; Extract the frame position from the marker.
1291 gud-last-frame
1292 (cons (substring gud-marker-acc (match-beginning 1) (match-end 1))
1293 (string-to-int (substring gud-marker-acc
aa9063cb
RS
1294 (match-beginning 3)
1295 (match-end 3))))
bed6a98d
RS
1296
1297 ;; Append any text before the marker to the output we're going
1298 ;; to return - we don't include the marker in this text.
1299 output (concat output
1300 (substring gud-marker-acc 0 (match-beginning 0)))
1301
1302 ;; Set the accumulator to the remaining text.
1303 gud-marker-acc (substring gud-marker-acc (match-end 0))))
1304
1305 ;; Does the remaining text look like it might end with the
1306 ;; beginning of another marker? If it does, then keep it in
f5851398 1307 ;; gud-marker-acc until we receive the rest of it. Since we
bed6a98d
RS
1308 ;; know the full marker regexp above failed, it's pretty simple to
1309 ;; test for marker starts.
1310 (if (string-match "\032.*\\'" gud-marker-acc)
1311 (progn
1312 ;; Everything before the potential marker start can be output.
1313 (setq output (concat output (substring gud-marker-acc
1314 0 (match-beginning 0))))
1315
1316 ;; Everything after, we save, to combine with later input.
1317 (setq gud-marker-acc
1318 (substring gud-marker-acc (match-beginning 0))))
1319
1320 (setq output (concat output gud-marker-acc)
1321 gud-marker-acc ""))
1322
1323 output))
575661b1
RS
1324
1325(defun gud-perldb-find-file (f)
c157af51 1326 (find-file-noselect f))
575661b1 1327
8b5cd4d0
SM
1328(defcustom gud-perldb-command-name "perl -d"
1329 "Default command to execute a Perl script under debugger."
69c1dd37
RS
1330 :type 'string
1331 :group 'gud)
9ab5d005 1332
575661b1
RS
1333;;;###autoload
1334(defun perldb (command-line)
1335 "Run perldb on program FILE in buffer *gud-FILE*.
1336The directory containing FILE becomes the initial working directory
1337and source-file directory for your debugger."
1338 (interactive
c157af51
SM
1339 (list (gud-query-cmdline 'perldb
1340 (concat (or (buffer-file-name) "-e 0") " "))))
575661b1 1341
ee97eac3
RS
1342 (gud-common-init command-line 'gud-perldb-massage-args
1343 'gud-perldb-marker-filter 'gud-perldb-find-file)
c157af51 1344 (set (make-local-variable 'gud-minor-mode) 'perldb)
575661b1 1345
c6094cae
EZ
1346 (gud-def gud-break "b %l" "\C-b" "Set breakpoint at current line.")
1347 (gud-def gud-remove "d %l" "\C-d" "Remove breakpoint at current line")
1348 (gud-def gud-step "s" "\C-s" "Step one source line with display.")
1349 (gud-def gud-next "n" "\C-n" "Step one line (skip functions).")
1350 (gud-def gud-cont "c" "\C-r" "Continue with display.")
1351; (gud-def gud-finish "finish" "\C-f" "Finish executing current function.")
1352; (gud-def gud-up "up %p" "<" "Up N stack frames (numeric arg).")
2c32e5c6 1353; (gud-def gud-down "down %p" ">" "Down N stack frames (numeric arg).")
c6094cae 1354 (gud-def gud-print "%e" "\C-p" "Evaluate perl expression at point.")
2c32e5c6 1355
f5851398 1356 (setq comint-prompt-regexp "^ DB<+[0-9]+>+ ")
f54877b2 1357 (setq paragraph-start comint-prompt-regexp)
c157af51 1358 (run-hooks 'perldb-mode-hook))
c3fd0eea 1359\f
d2d23393
RS
1360;; ======================================================================
1361;; pdb (Python debugger) functions
1362
8b5cd4d0 1363;; History of argument lists passed to pdb.
d2d23393
RS
1364(defvar gud-pdb-history nil)
1365
d2d23393
RS
1366;; Last group is for return value, e.g. "> test.py(2)foo()->None"
1367;; Either file or function name may be omitted: "> <string>(0)?()"
1368(defvar gud-pdb-marker-regexp
a385f6bf 1369 "^> \\([-a-zA-Z0-9_/.:\\]*\\|<string>\\)(\\([0-9]+\\))\\([a-zA-Z0-9_]*\\|\\?\\)()\\(->[^\n]*\\)?\n")
d2d23393
RS
1370(defvar gud-pdb-marker-regexp-file-group 1)
1371(defvar gud-pdb-marker-regexp-line-group 2)
1372(defvar gud-pdb-marker-regexp-fnname-group 3)
1373
1374(defvar gud-pdb-marker-regexp-start "^> ")
1375
1376;; There's no guarantee that Emacs will hand the filter the entire
1377;; marker at once; it could be broken up across several strings. We
1378;; might even receive a big chunk with several markers in it. If we
1379;; receive a chunk of text which looks like it might contain the
1380;; beginning of a marker, we save it here between calls to the
1381;; filter.
1382(defun gud-pdb-marker-filter (string)
1383 (setq gud-marker-acc (concat gud-marker-acc string))
1384 (let ((output ""))
1385
1386 ;; Process all the complete markers in this chunk.
1387 (while (string-match gud-pdb-marker-regexp gud-marker-acc)
1388 (setq
1389
1390 ;; Extract the frame position from the marker.
1391 gud-last-frame
1392 (let ((file (match-string gud-pdb-marker-regexp-file-group
1393 gud-marker-acc))
1394 (line (string-to-int
1395 (match-string gud-pdb-marker-regexp-line-group
1396 gud-marker-acc))))
1397 (if (string-equal file "<string>")
1398 gud-last-frame
1399 (cons file line)))
1400
1401 ;; Output everything instead of the below
1402 output (concat output (substring gud-marker-acc 0 (match-end 0)))
f5851398
EZ
1403;; ;; Append any text before the marker to the output we're going
1404;; ;; to return - we don't include the marker in this text.
1405;; output (concat output
1406;; (substring gud-marker-acc 0 (match-beginning 0)))
d2d23393
RS
1407
1408 ;; Set the accumulator to the remaining text.
1409 gud-marker-acc (substring gud-marker-acc (match-end 0))))
1410
1411 ;; Does the remaining text look like it might end with the
1412 ;; beginning of another marker? If it does, then keep it in
f5851398 1413 ;; gud-marker-acc until we receive the rest of it. Since we
d2d23393
RS
1414 ;; know the full marker regexp above failed, it's pretty simple to
1415 ;; test for marker starts.
1416 (if (string-match gud-pdb-marker-regexp-start gud-marker-acc)
1417 (progn
1418 ;; Everything before the potential marker start can be output.
1419 (setq output (concat output (substring gud-marker-acc
1420 0 (match-beginning 0))))
1421
1422 ;; Everything after, we save, to combine with later input.
1423 (setq gud-marker-acc
1424 (substring gud-marker-acc (match-beginning 0))))
1425
1426 (setq output (concat output gud-marker-acc)
1427 gud-marker-acc ""))
1428
1429 output))
1430
1431(defun gud-pdb-find-file (f)
c157af51 1432 (find-file-noselect f))
d2d23393
RS
1433
1434(defcustom gud-pdb-command-name "pdb"
1435 "File name for executing the Python debugger.
1436This should be an executable on your path, or an absolute file name."
1437 :type 'string
1438 :group 'gud)
1439
1440;;;###autoload
1441(defun pdb (command-line)
1442 "Run pdb on program FILE in buffer `*gud-FILE*'.
1443The directory containing FILE becomes the initial working directory
1444and source-file directory for your debugger."
1445 (interactive
c157af51 1446 (list (gud-query-cmdline 'pdb)))
d2d23393 1447
8b5cd4d0 1448 (gud-common-init command-line nil
d2d23393 1449 'gud-pdb-marker-filter 'gud-pdb-find-file)
c157af51 1450 (set (make-local-variable 'gud-minor-mode) 'pdb)
d2d23393
RS
1451
1452 (gud-def gud-break "break %l" "\C-b" "Set breakpoint at current line.")
a385f6bf 1453 (gud-def gud-remove "clear %f:%l" "\C-d" "Remove breakpoint at current line")
c6094cae
EZ
1454 (gud-def gud-step "step" "\C-s" "Step one source line with display.")
1455 (gud-def gud-next "next" "\C-n" "Step one line (skip functions).")
d2d23393 1456 (gud-def gud-cont "continue" "\C-r" "Continue with display.")
c6094cae
EZ
1457 (gud-def gud-finish "return" "\C-f" "Finish executing current function.")
1458 (gud-def gud-up "up" "<" "Up one stack frame.")
1459 (gud-def gud-down "down" ">" "Down one stack frame.")
1460 (gud-def gud-print "p %e" "\C-p" "Evaluate Python expression at point.")
d2d23393 1461 ;; Is this right?
c6094cae 1462 (gud-def gud-statement "! %e" "\C-e" "Execute Python statement at point.")
d2d23393
RS
1463
1464 (local-set-key [menu-bar debug finish] '("Finish Function" . gud-finish))
1465 (local-set-key [menu-bar debug up] '("Up Stack" . gud-up))
1466 (local-set-key [menu-bar debug down] '("Down Stack" . gud-down))
1467 ;; (setq comint-prompt-regexp "^(.*pdb[+]?) *")
1468 (setq comint-prompt-regexp "^(Pdb) *")
1469 (setq paragraph-start comint-prompt-regexp)
1470 (run-hooks 'pdb-mode-hook))
1471\f
c3fd0eea
RS
1472;; ======================================================================
1473;;
1474;; JDB support.
1475;;
1476;; AUTHOR: Derek Davies <ddavies@world.std.com>
f5851398 1477;; Zoltan Kemenczy <zoltan@ieee.org;zkemenczy@rim.net>
c3fd0eea
RS
1478;;
1479;; CREATED: Sun Feb 22 10:46:38 1998 Derek Davies.
f5851398 1480;; UPDATED: Nov 11, 2001 Zoltan Kemenczy
c3fd0eea
RS
1481;;
1482;; INVOCATION NOTES:
1483;;
1484;; You invoke jdb-mode with:
1485;;
1486;; M-x jdb <enter>
1487;;
1488;; It responds with:
1489;;
f4b643a1 1490;; Run jdb (like this): jdb
c3fd0eea
RS
1491;;
1492;; type any jdb switches followed by the name of the class you'd like to debug.
1493;; Supply a fully qualfied classname (these do not have the ".class" extension)
1494;; for the name of the class to debug (e.g. "COM.the-kind.ddavies.CoolClass").
1495;; See the known problems section below for restrictions when specifying jdb
1496;; command line switches (search forward for '-classpath').
1497;;
1498;; You should see something like the following:
1499;;
1500;; Current directory is ~/src/java/hello/
1501;; Initializing jdb...
1502;; 0xed2f6628:class(hello)
1503;; >
1504;;
1505;; To set an initial breakpoint try:
1506;;
1507;; > stop in hello.main
1508;; Breakpoint set in hello.main
1509;; >
1510;;
1511;; To execute the program type:
1512;;
1513;; > run
f4b643a1 1514;; run hello
c3fd0eea
RS
1515;;
1516;; Breakpoint hit: running ...
1517;; hello.main (hello:12)
1518;;
1519;; Type M-n to step over the current line and M-s to step into it. That,
1520;; along with the JDB 'help' command should get you started. The 'quit'
35dd3c55
KH
1521;; JDB command will get out out of the debugger. There is some truly
1522;; pathetic JDB documentation available at:
1523;;
1524;; http://java.sun.com/products/jdk/1.1/debugging/
c3fd0eea
RS
1525;;
1526;; KNOWN PROBLEMS AND FIXME's:
1527;;
35dd3c55 1528;; Not sure what happens with inner classes ... haven't tried them.
c3fd0eea 1529;;
c6094cae 1530;; Does not grok UNICODE id's. Only ASCII id's are supported.
c3fd0eea 1531;;
c3fd0eea
RS
1532;; You must not put whitespace between "-classpath" and the path to
1533;; search for java classes even though it is required when invoking jdb
1534;; from the command line. See gud-jdb-massage-args for details.
e78e1cd1 1535;; The same applies for "-sourcepath".
c3fd0eea 1536;;
2ef4e909
RS
1537;; Note: The following applies only if `gud-jdb-use-classpath' is nil;
1538;; refer to the documentation of `gud-jdb-use-classpath' and
e78e1cd1
EZ
1539;; `gud-jdb-classpath',`gud-jdb-sourcepath' variables for information
1540;; on using the classpath for locating java source files.
2ef4e909 1541;;
35dd3c55
KH
1542;; If any of the source files in the directories listed in
1543;; gud-jdb-directories won't parse you'll have problems. Make sure
1544;; every file ending in ".java" in these directories parses without error.
1545;;
1546;; All the .java files in the directories in gud-jdb-directories are
c6094cae 1547;; syntactically analyzed each time gud jdb is invoked. It would be
35dd3c55
KH
1548;; nice to keep as much information as possible between runs. It would
1549;; be really nice to analyze the files only as neccessary (when the
1550;; source needs to be displayed.) I'm not sure to what extent the former
1551;; can be accomplished and I'm not sure the latter can be done at all
1552;; since I don't know of any general way to tell which .class files are
1553;; defined by which .java file without analyzing all the .java files.
1554;; If anyone knows why JavaSoft didn't put the source file names in
1555;; debuggable .class files please clue me in so I find something else
1556;; to be spiteful and bitter about.
1557;;
c3fd0eea
RS
1558;; ======================================================================
1559;; gud jdb variables and functions
1560
2ef4e909
RS
1561(defcustom gud-jdb-command-name "jdb"
1562 "Command that executes the Java debugger."
1563 :type 'string
1564 :group 'gud)
1565
1566(defcustom gud-jdb-use-classpath t
1567 "If non-nil, search for Java source files in classpath directories.
1568The list of directories to search is the value of `gud-jdb-classpath'.
1569The file pathname is obtained by converting the fully qualified
1570class information output by jdb to a relative pathname and appending
1571it to `gud-jdb-classpath' element by element until a match is found.
1572
1573This method has a significant jdb startup time reduction advantage
1574since it does not require the scanning of all `gud-jdb-directories'
1575and parsing all Java files for class information.
1576
1577Set to nil to use `gud-jdb-directories' to scan java sources for
1578class information on jdb startup (original method)."
1579 :type 'boolean
1580 :group 'gud)
1581
1582(defvar gud-jdb-classpath nil
1583 "Java/jdb classpath directories list.
1584If `gud-jdb-use-classpath' is non-nil, gud-jdb derives the `gud-jdb-classpath'
1585list automatically using the following methods in sequence
8b5cd4d0 1586\(with subsequent successful steps overriding the results of previous
2ef4e909
RS
1587steps):
1588
15891) Read the CLASSPATH environment variable,
15902) Read any \"-classpath\" argument used to run jdb,
1591 or detected in jdb output (e.g. if jdb is run by a script
1592 that echoes the actual jdb command before starting jdb)
15933) Send a \"classpath\" command to jdb and scan jdb output for
1594 classpath information if jdb is invoked with an \"-attach\" (to
1595 an already running VM) argument (This case typically does not
1596 have a \"-classpath\" command line argument - that is provided
1597 to the VM when it is started).
1598
1599Note that method 3 cannot be used with oldjdb (or Java 1 jdb) since
1600those debuggers do not support the classpath command. Use 1) or 2).")
1601
e78e1cd1
EZ
1602(defvar gud-jdb-sourcepath nil
1603 "Directory list provided by an (optional) \"-sourcepath\" option to jdb.
1604This list is prepended to `gud-jdb-classpath' to form the complete
1605list of directories searched for source files.")
1606
2ef4e909
RS
1607(defvar gud-marker-acc-max-length 4000
1608 "Maximum number of debugger output characters to keep.
1609This variable limits the size of `gud-marker-acc' which holds
1610the most recent debugger output history while searching for
1611source file information.")
1612
1613(defvar gud-jdb-history nil
1614"History of argument lists passed to jdb.")
1615
c3fd0eea
RS
1616
1617;; List of Java source file directories.
1618(defvar gud-jdb-directories (list ".")
f4b643a1 1619 "*A list of directories that gud jdb should search for source code.
8050f8c8
GM
1620The file names should be absolute, or relative to the current
1621directory.
1622
1623The set of .java files residing in the directories listed are
1624syntactically analyzed to determine the classes they define and the
c6094cae 1625packages in which these classes belong. In this way gud jdb maps the
8050f8c8
GM
1626package-qualified class names output by the jdb debugger to the source
1627file from which the class originated. This allows gud mode to keep
1628the source code display in sync with the debugging session.")
c3fd0eea 1629
2ef4e909
RS
1630(defvar gud-jdb-source-files nil
1631"List of the java source files for this debugging session.")
c3fd0eea 1632
2ef4e909
RS
1633;; Association list of fully qualified class names (package + class name)
1634;; and their source files.
1635(defvar gud-jdb-class-source-alist nil
1636"Association list of fully qualified class names and source files.")
500f12df
RS
1637
1638;; This is used to hold a source file during analysis.
1639(defvar gud-jdb-analysis-buffer nil)
1640
2ef4e909
RS
1641(defvar gud-jdb-classpath-string nil
1642"Holds temporary classpath values.")
1643
c3fd0eea 1644(defun gud-jdb-build-source-files-list (path extn)
e78e1cd1 1645"Return a list of java source files (absolute paths).
2ef4e909 1646PATH gives the directories in which to search for files with
c6094cae 1647extension EXTN. Normally EXTN is given as the regular expression
2ef4e909 1648 \"\\.java$\" ."
90757bb3 1649 (apply 'nconc (mapcar (lambda (d)
471cd1d3 1650 (when (file-directory-p d)
e5ef2f5c
SM
1651 (directory-files d t extn nil)))
1652 path)))
c3fd0eea 1653
35dd3c55
KH
1654;; Move point past whitespace.
1655(defun gud-jdb-skip-whitespace ()
1656 (skip-chars-forward " \n\r\t\014"))
1657
1658;; Move point past a "// <eol>" type of comment.
1659(defun gud-jdb-skip-single-line-comment ()
1660 (end-of-line))
1661
1662;; Move point past a "/* */" or "/** */" type of comment.
1663(defun gud-jdb-skip-traditional-or-documentation-comment ()
1664 (forward-char 2)
1665 (catch 'break
f4b643a1
RS
1666 (while (not (eobp))
1667 (if (eq (following-char) ?*)
1668 (progn
1669 (forward-char)
1670 (if (not (eobp))
1671 (if (eq (following-char) ?/)
1672 (progn
1673 (forward-char)
1674 (throw 'break nil)))))
1675 (forward-char)))))
1676
35dd3c55
KH
1677;; Move point past any number of consecutive whitespace chars and/or comments.
1678(defun gud-jdb-skip-whitespace-and-comments ()
1679 (gud-jdb-skip-whitespace)
1680 (catch 'done
f4b643a1
RS
1681 (while t
1682 (cond
1683 ((looking-at "//")
1684 (gud-jdb-skip-single-line-comment)
1685 (gud-jdb-skip-whitespace))
1686 ((looking-at "/\\*")
1687 (gud-jdb-skip-traditional-or-documentation-comment)
1688 (gud-jdb-skip-whitespace))
1689 (t (throw 'done nil))))))
35dd3c55
KH
1690
1691;; Move point past things that are id-like. The intent is to skip regular
1692;; id's, such as class or interface names as well as package and interface
1693;; names.
1694(defun gud-jdb-skip-id-ish-thing ()
1695 (skip-chars-forward "^ /\n\r\t\014,;{"))
1696
1697;; Move point past a string literal.
1698(defun gud-jdb-skip-string-literal ()
1699 (forward-char)
73739399
RS
1700 (while (not (cond
1701 ((eq (following-char) ?\\)
1702 (forward-char))
1703 ((eq (following-char) ?\042))))
f4b643a1 1704 (forward-char))
35dd3c55
KH
1705 (forward-char))
1706
1707;; Move point past a character literal.
1708(defun gud-jdb-skip-character-literal ()
1709 (forward-char)
1710 (while
f4b643a1
RS
1711 (progn
1712 (if (eq (following-char) ?\\)
1713 (forward-char 2))
1714 (not (eq (following-char) ?\')))
1715 (forward-char))
35dd3c55 1716 (forward-char))
f4b643a1 1717
f5851398 1718;; Move point past the following block. There may be (legal) cruft before
35dd3c55
KH
1719;; the block's opening brace. There must be a block or it's the end of life
1720;; in petticoat junction.
1721(defun gud-jdb-skip-block ()
f4b643a1 1722
35dd3c55
KH
1723 ;; Find the begining of the block.
1724 (while
f4b643a1
RS
1725 (not (eq (following-char) ?{))
1726
1727 ;; Skip any constructs that can harbor literal block delimiter
1728 ;; characters and/or the delimiters for the constructs themselves.
1729 (cond
1730 ((looking-at "//")
1731 (gud-jdb-skip-single-line-comment))
1732 ((looking-at "/\\*")
1733 (gud-jdb-skip-traditional-or-documentation-comment))
1734 ((eq (following-char) ?\042)
1735 (gud-jdb-skip-string-literal))
1736 ((eq (following-char) ?\')
1737 (gud-jdb-skip-character-literal))
1738 (t (forward-char))))
35dd3c55 1739
35dd3c55
KH
1740 ;; Now at the begining of the block.
1741 (forward-char)
1742
1743 ;; Skip over the body of the block as well as the final brace.
1744 (let ((open-level 1))
f4b643a1
RS
1745 (while (not (eq open-level 0))
1746 (cond
1747 ((looking-at "//")
1748 (gud-jdb-skip-single-line-comment))
1749 ((looking-at "/\\*")
1750 (gud-jdb-skip-traditional-or-documentation-comment))
1751 ((eq (following-char) ?\042)
1752 (gud-jdb-skip-string-literal))
1753 ((eq (following-char) ?\')
1754 (gud-jdb-skip-character-literal))
1755 ((eq (following-char) ?{)
1756 (setq open-level (+ open-level 1))
1757 (forward-char))
1758 ((eq (following-char) ?})
1759 (setq open-level (- open-level 1))
1760 (forward-char))
1761 (t (forward-char))))))
35dd3c55
KH
1762
1763;; Find the package and class definitions in Java source file FILE. Assumes
1764;; that FILE contains a legal Java program. BUF is a scratch buffer used
1765;; to hold the source during analysis.
1766(defun gud-jdb-analyze-source (buf file)
1767 (let ((l nil))
f4b643a1
RS
1768 (set-buffer buf)
1769 (insert-file-contents file nil nil nil t)
1770 (goto-char 0)
1771 (catch 'abort
1772 (let ((p ""))
1773 (while (progn
1774 (gud-jdb-skip-whitespace)
1775 (not (eobp)))
1776 (cond
1777
c6094cae 1778 ;; Any number of semi's following a block is legal. Move point
f4b643a1
RS
1779 ;; past them. Note that comments and whitespace may be
1780 ;; interspersed as well.
1781 ((eq (following-char) ?\073)
1782 (forward-char))
1783
1784 ;; Move point past a single line comment.
1785 ((looking-at "//")
1786 (gud-jdb-skip-single-line-comment))
1787
1788 ;; Move point past a traditional or documentation comment.
1789 ((looking-at "/\\*")
1790 (gud-jdb-skip-traditional-or-documentation-comment))
1791
1792 ;; Move point past a package statement, but save the PackageName.
1793 ((looking-at "package")
1794 (forward-char 7)
1795 (gud-jdb-skip-whitespace-and-comments)
1796 (let ((s (point)))
1797 (gud-jdb-skip-id-ish-thing)
1798 (setq p (concat (buffer-substring s (point)) "."))
1799 (gud-jdb-skip-whitespace-and-comments)
1800 (if (eq (following-char) ?\073)
1801 (forward-char))))
1802
1803 ;; Move point past an import statement.
1804 ((looking-at "import")
1805 (forward-char 6)
1806 (gud-jdb-skip-whitespace-and-comments)
1807 (gud-jdb-skip-id-ish-thing)
1808 (gud-jdb-skip-whitespace-and-comments)
1809 (if (eq (following-char) ?\073)
1810 (forward-char)))
1811
1812 ;; Move point past the various kinds of ClassModifiers.
1813 ((looking-at "public")
1814 (forward-char 6))
1815 ((looking-at "abstract")
1816 (forward-char 8))
1817 ((looking-at "final")
1818 (forward-char 5))
1819
1820 ;; Move point past a ClassDeclaraction, but save the class
1821 ;; Identifier.
1822 ((looking-at "class")
1823 (forward-char 5)
1824 (gud-jdb-skip-whitespace-and-comments)
1825 (let ((s (point)))
1826 (gud-jdb-skip-id-ish-thing)
1827 (setq
1828 l (nconc l (list (concat p (buffer-substring s (point)))))))
1829 (gud-jdb-skip-block))
1830
1831 ;; Move point past an interface statement.
1832 ((looking-at "interface")
1833 (forward-char 9)
1834 (gud-jdb-skip-block))
1835
1836 ;; Anything else means the input is invalid.
1837 (t
1838 (message (format "Error parsing file %s." file))
1839 (throw 'abort nil))))))
1840 l))
35dd3c55
KH
1841
1842(defun gud-jdb-build-class-source-alist-for-file (file)
1843 (mapcar
1844 (lambda (c)
f4b643a1 1845 (cons c file))
35dd3c55 1846 (gud-jdb-analyze-source gud-jdb-analysis-buffer file)))
c3fd0eea 1847
c3fd0eea
RS
1848;; Return an alist of fully qualified classes and the source files
1849;; holding their definitions. SOURCES holds a list of all the source
1850;; files to examine.
1851(defun gud-jdb-build-class-source-alist (sources)
b2e60475 1852 (setq gud-jdb-analysis-buffer (get-buffer-create " *gud-jdb-scratch*"))
35dd3c55 1853 (prog1
f4b643a1
RS
1854 (apply
1855 'nconc
1856 (mapcar
1857 'gud-jdb-build-class-source-alist-for-file
1858 sources))
1859 (kill-buffer gud-jdb-analysis-buffer)
1860 (setq gud-jdb-analysis-buffer nil)))
c3fd0eea
RS
1861
1862;; Change what was given in the minibuffer to something that can be used to
1863;; invoke the debugger.
1864(defun gud-jdb-massage-args (file args)
1865 ;; The jdb executable must have whitespace between "-classpath" and
f4b643a1 1866 ;; its value while gud-common-init expects all switch values to
c6094cae 1867 ;; follow the switch keyword without intervening whitespace. We
c3fd0eea
RS
1868 ;; require that when the user enters the "-classpath" switch in the
1869 ;; EMACS minibuffer that they do so without the intervening
1870 ;; whitespace. This function adds it back (it's called after
c6094cae 1871 ;; gud-common-init). There are more switches like this (for
c3fd0eea
RS
1872 ;; instance "-host" and "-password") but I don't care about them
1873 ;; yet.
1874 (if args
f4b643a1
RS
1875 (let (massaged-args user-error)
1876
e78e1cd1
EZ
1877 (while (and args (not user-error))
1878 (cond
1879 ((setq user-error (string-match "-classpath$" (car args))))
1880 ((setq user-error (string-match "-sourcepath$" (car args))))
1881 ((string-match "-classpath\\(.+\\)" (car args))
1882 (setq massaged-args
1883 (append massaged-args
1884 (list "-classpath")
2c46c4c8 1885 (list
e78e1cd1
EZ
1886 (setq gud-jdb-classpath-string
1887 (substring
1888 (car args)
1889 (match-beginning 1) (match-end 1)))))))
1890 ((string-match "-sourcepath\\(.+\\)" (car args))
1891 (setq massaged-args
1892 (append massaged-args
1893 (list "-sourcepath")
2c46c4c8 1894 (list
e78e1cd1
EZ
1895 (setq gud-jdb-sourcepath
1896 (substring
1897 (car args)
1898 (match-beginning 1) (match-end 1)))))))
1899 (t (setq massaged-args (append massaged-args (list (car args))))))
f4b643a1
RS
1900 (setq args (cdr args)))
1901
1902 ;; By this point the current directory is all screwed up. Maybe we
1903 ;; could fix things and re-invoke gud-common-init, but for now I think
1904 ;; issueing the error is good enough.
1905 (if user-error
1906 (progn
1907 (kill-buffer (current-buffer))
e78e1cd1
EZ
1908 (error "Error: Omit whitespace between '-classpath or -sourcepath' and its value")))
1909 massaged-args)))
c3fd0eea
RS
1910
1911;; Search for an association with P, a fully qualified class name, in
f5851398 1912;; gud-jdb-class-source-alist. The asssociation gives the fully
c3fd0eea
RS
1913;; qualified file name of the source file which produced the class.
1914(defun gud-jdb-find-source-file (p)
1915 (cdr (assoc p gud-jdb-class-source-alist)))
1916
2ef4e909
RS
1917;; Note: Reset to this value every time a prompt is seen
1918(defvar gud-jdb-lowest-stack-level 999)
1919
1920(defun gud-jdb-find-source-using-classpath (p)
1921"Find source file corresponding to fully qualified class p.
1922Convert p from jdb's output, converted to a pathname
1923relative to a classpath directory."
1924 (save-match-data
1925 (let
1926 (;; Replace dots with slashes and append ".java" to generate file
1927 ;; name relative to classpath
1928 (filename
f5851398
EZ
1929 (concat
1930 (mapconcat (lambda (x) x)
1931 (split-string
1932 ;; Eliminate any subclass references in the class
1933 ;; name string. These start with a "$"
1934 ((lambda (x)
1935 (if (string-match "$.*" x)
1936 (replace-match "" t t x) p))
1937 p)
1938 "\\.") "/")
1939 ".java"))
e78e1cd1 1940 (cplist (append gud-jdb-sourcepath gud-jdb-classpath))
2ef4e909
RS
1941 found-file)
1942 (while (and cplist
f5851398
EZ
1943 (not (setq found-file
1944 (file-readable-p
1945 (concat (car cplist) "/" filename)))))
2ef4e909
RS
1946 (setq cplist (cdr cplist)))
1947 (if found-file (concat (car cplist) "/" filename)))))
1948
1949(defun gud-jdb-find-source (string)
1950"Alias for function used to locate source files.
1951Set to `gud-jdb-find-source-using-classpath' or `gud-jdb-find-source-file'
1952during jdb initialization depending on the value of
1953`gud-jdb-use-classpath'."
1954nil)
1955
1956(defun gud-jdb-parse-classpath-string (string)
1957"Parse the classpath list and convert each item to an absolute pathname."
e78e1cd1 1958 (mapcar (lambda (s) (if (string-match "[/\\]$" s)
f5851398
EZ
1959 (replace-match "" nil nil s) s))
1960 (mapcar 'file-truename
1961 (split-string
1962 string
1963 (concat "[ \t\n\r,\"" path-separator "]+")))))
2ef4e909 1964
c3fd0eea
RS
1965;; See comentary for other debugger's marker filters - there you will find
1966;; important notes about STRING.
1967(defun gud-jdb-marker-filter (string)
1968
1969 ;; Build up the accumulator.
1970 (setq gud-marker-acc
f4b643a1
RS
1971 (if gud-marker-acc
1972 (concat gud-marker-acc string)
1973 string))
c3fd0eea 1974
2ef4e909 1975 ;; Look for classpath information until gud-jdb-classpath-string is found
e78e1cd1
EZ
1976 ;; (interactive, multiple settings of classpath from jdb
1977 ;; not supported/followed)
2ef4e909 1978 (if (and gud-jdb-use-classpath
f5851398
EZ
1979 (not gud-jdb-classpath-string)
1980 (or (string-match "classpath:[ \t[]+\\([^]]+\\)" gud-marker-acc)
1981 (string-match "-classpath[ \t\"]+\\([^ \"]+\\)" gud-marker-acc)))
2ef4e909 1982 (setq gud-jdb-classpath
f5851398
EZ
1983 (gud-jdb-parse-classpath-string
1984 (setq gud-jdb-classpath-string
1985 (substring gud-marker-acc
1986 (match-beginning 1) (match-end 1))))))
2ef4e909
RS
1987
1988 ;; We process STRING from left to right. Each time through the
1989 ;; following loop we process at most one marker. After we've found a
1990 ;; marker, delete gud-marker-acc up to and including the match
1991 (let (file-found)
1992 ;; Process each complete marker in the input.
f4b643a1
RS
1993 (while
1994
1995 ;; Do we see a marker?
1996 (string-match
1997 ;; jdb puts out a string of the following form when it
1998 ;; hits a breakpoint:
1999 ;;
f5851398 2000 ;; <fully-qualified-class><method> (<class>:<line-number>)
f4b643a1
RS
2001 ;;
2002 ;; <fully-qualified-class>'s are composed of Java ID's
2003 ;; separated by periods. <method> and <class> are
2004 ;; also Java ID's. <method> begins with a period and
2005 ;; may contain less-than and greater-than (constructors,
2006 ;; for instance, are called <init> in the symbol table.)
2007 ;; Java ID's begin with a letter followed by letters
2008 ;; and/or digits. The set of letters includes underscore
2009 ;; and dollar sign.
2010 ;;
2011 ;; The first group matches <fully-qualified-class>,
2012 ;; the second group matches <class> and the third group
2013 ;; matches <line-number>. We don't care about using
2014 ;; <method> so we don't "group" it.
2015 ;;
2016 ;; FIXME: Java ID's are UNICODE strings, this matches ASCII
2017 ;; ID's only.
2ef4e909
RS
2018 "\\(\[[0-9]+\] \\)*\\([a-zA-Z0-9.$_]+\\)\\.[a-zA-Z0-9$_<>(),]+ \
2019\\(([a-zA-Z0-9.$_]+:\\|line=\\)\\([0-9]+\\)"
2020 gud-marker-acc)
2021
2022 ;; A good marker is one that:
2023 ;; 1) does not have a "[n] " prefix (not part of a stack backtrace)
2024 ;; 2) does have an "[n] " prefix and n is the lowest prefix seen
2025 ;; since the last prompt
f4b643a1
RS
2026 ;; Figure out the line on which to position the debugging arrow.
2027 ;; Return the info as a cons of the form:
2028 ;;
2029 ;; (<file-name> . <line-number>) .
2ef4e909
RS
2030 (if (if (match-beginning 1)
2031 (let (n)
2032 (setq n (string-to-int (substring
2033 gud-marker-acc
2034 (1+ (match-beginning 1))
2035 (- (match-end 1) 2))))
2036 (if (< n gud-jdb-lowest-stack-level)
2037 (progn (setq gud-jdb-lowest-stack-level n) t)))
f5851398 2038 t)
2ef4e909
RS
2039 (if (setq file-found
2040 (gud-jdb-find-source
2041 (substring gud-marker-acc
2042 (match-beginning 2)
2043 (match-end 2))))
2044 (setq gud-last-frame
2045 (cons file-found
2046 (string-to-int
2047 (substring gud-marker-acc
2048 (match-beginning 4)
2049 (match-end 4)))))
2050 (message "Could not find source file.")))
2051
2052 ;; Set the accumulator to the remaining text.
2053 (setq gud-marker-acc (substring gud-marker-acc (match-end 0))))
2054
2055 (if (string-match comint-prompt-regexp gud-marker-acc)
2056 (setq gud-jdb-lowest-stack-level 999)))
2057
2058 ;; Do not allow gud-marker-acc to grow without bound. If the source
2059 ;; file information is not within the last 3/4
2060 ;; gud-marker-acc-max-length characters, well,...
2061 (if (> (length gud-marker-acc) gud-marker-acc-max-length)
2062 (setq gud-marker-acc
f5851398
EZ
2063 (substring gud-marker-acc
2064 (- (/ (* gud-marker-acc-max-length 3) 4)))))
c3fd0eea
RS
2065
2066 ;; We don't filter any debugger output so just return what we were given.
2067 string)
2068
2069(defun gud-jdb-find-file (f)
2070 (and (file-readable-p f)
f4b643a1 2071 (find-file-noselect f)))
c3fd0eea 2072
c3fd0eea
RS
2073;;;###autoload
2074(defun jdb (command-line)
aa3b6a3f
PJ
2075 "Run jdb with command line COMMAND-LINE in a buffer.
2076The buffer is named \"*gud*\" if no initial class is given or
f5851398 2077\"*gud-<initial-class-basename>*\" if there is. If the \"-classpath\"
2ef4e909
RS
2078switch is given, omit all whitespace between it and its value.
2079
2080See `gud-jdb-use-classpath' and `gud-jdb-classpath' documentation for
2081information on how jdb accesses source files. Alternatively (if
2082`gud-jdb-use-classpath' is nil), see `gud-jdb-directories' for the
2083original source file access method.
2084
2085For general information about commands available to control jdb from
2086gud, see `gud-mode'."
c3fd0eea 2087 (interactive
c157af51 2088 (list (gud-query-cmdline 'jdb)))
e78e1cd1
EZ
2089 (setq gud-jdb-classpath nil)
2090 (setq gud-jdb-sourcepath nil)
c3fd0eea 2091
2ef4e909
RS
2092 ;; Set gud-jdb-classpath from the CLASSPATH environment variable,
2093 ;; if CLASSPATH is set.
2094 (setq gud-jdb-classpath-string (getenv "CLASSPATH"))
2095 (if gud-jdb-classpath-string
2096 (setq gud-jdb-classpath
f5851398
EZ
2097 (gud-jdb-parse-classpath-string gud-jdb-classpath-string)))
2098 (setq gud-jdb-classpath-string nil) ; prepare for next
2ef4e909 2099
c3fd0eea 2100 (gud-common-init command-line 'gud-jdb-massage-args
2ef4e909 2101 'gud-jdb-marker-filter 'gud-jdb-find-file)
c157af51 2102 (set (make-local-variable 'gud-minor-mode) 'jdb)
c3fd0eea 2103
2ef4e909
RS
2104 ;; If a -classpath option was provided, set gud-jdb-classpath
2105 (if gud-jdb-classpath-string
2106 (setq gud-jdb-classpath
2107 (gud-jdb-parse-classpath-string gud-jdb-classpath-string)))
f5851398 2108 (setq gud-jdb-classpath-string nil) ; prepare for next
e78e1cd1
EZ
2109 ;; If a -sourcepath option was provided, parse it
2110 (if gud-jdb-sourcepath
2111 (setq gud-jdb-sourcepath
f5851398 2112 (gud-jdb-parse-classpath-string gud-jdb-sourcepath)))
2ef4e909
RS
2113
2114 (gud-def gud-break "stop at %c:%l" "\C-b" "Set breakpoint at current line.")
2115 (gud-def gud-remove "clear %c:%l" "\C-d" "Remove breakpoint at current line")
c6094cae
EZ
2116 (gud-def gud-step "step" "\C-s" "Step one source line with display.")
2117 (gud-def gud-next "next" "\C-n" "Step one line (skip functions).")
2118 (gud-def gud-cont "cont" "\C-r" "Continue with display.")
2119 (gud-def gud-finish "step up" "\C-f" "Continue until current method returns.")
2ef4e909
RS
2120 (gud-def gud-up "up\C-Mwhere" "<" "Up one stack frame.")
2121 (gud-def gud-down "down\C-Mwhere" ">" "Up one stack frame.")
2122 (local-set-key [menu-bar debug finish] '("Finish Function" . gud-finish))
2123 (local-set-key [menu-bar debug up] '("Up Stack" . gud-up))
2124 (local-set-key [menu-bar debug down] '("Down Stack" . gud-down))
c3fd0eea 2125
2ef4e909 2126 (setq comint-prompt-regexp "^> \\|^[^ ]+\\[[0-9]+\\] ")
c3fd0eea
RS
2127 (setq paragraph-start comint-prompt-regexp)
2128 (run-hooks 'jdb-mode-hook)
2129
2ef4e909 2130 (if gud-jdb-use-classpath
e78e1cd1 2131 ;; Get the classpath information from the debugger
2ef4e909 2132 (progn
f5851398
EZ
2133 (if (string-match "-attach" command-line)
2134 (gud-call "classpath"))
2135 (fset 'gud-jdb-find-source
2136 'gud-jdb-find-source-using-classpath))
2ef4e909
RS
2137
2138 ;; Else create and bind the class/source association list as well
2139 ;; as the source file list.
2140 (setq gud-jdb-class-source-alist
f5851398
EZ
2141 (gud-jdb-build-class-source-alist
2142 (setq gud-jdb-source-files
2143 (gud-jdb-build-source-files-list gud-jdb-directories
2144 "\\.java$"))))
2ef4e909 2145 (fset 'gud-jdb-find-source 'gud-jdb-find-source-file)))
c3fd0eea 2146\f
6496f3d2 2147
13b80a60
ER
2148;;
2149;; End of debugger-specific information
10a4c11f 2150;;
13b80a60 2151
575661b1 2152\f
8b5cd4d0
SM
2153;; When we send a command to the debugger via gud-call, it's annoying
2154;; to see the command and the new prompt inserted into the debugger's
2155;; buffer; we have other ways of knowing the command has completed.
2156;;
2157;; If the buffer looks like this:
2158;; --------------------
2159;; (gdb) set args foo bar
2160;; (gdb) -!-
2161;; --------------------
2162;; (the -!- marks the location of point), and we type `C-x SPC' in a
2163;; source file to set a breakpoint, we want the buffer to end up like
2164;; this:
2165;; --------------------
2166;; (gdb) set args foo bar
2167;; Breakpoint 1 at 0x92: file make-docfile.c, line 49.
2168;; (gdb) -!-
2169;; --------------------
2170;; Essentially, the old prompt is deleted, and the command's output
2171;; and the new prompt take its place.
2172;;
2173;; Not echoing the command is easy enough; you send it directly using
2174;; process-send-string, and it never enters the buffer. However,
2175;; getting rid of the old prompt is trickier; you don't want to do it
2176;; when you send the command, since that will result in an annoying
2177;; flicker as the prompt is deleted, redisplay occurs while Emacs
2178;; waits for a response from the debugger, and the new prompt is
2179;; inserted. Instead, we'll wait until we actually get some output
2180;; from the subprocess before we delete the prompt. If the command
2181;; produced no output other than a new prompt, that prompt will most
2182;; likely be in the first chunk of output received, so we will delete
2183;; the prompt and then replace it with an identical one. If the
2184;; command produces output, the prompt is moving anyway, so the
2185;; flicker won't be annoying.
2186;;
2187;; So - when we want to delete the prompt upon receipt of the next
2188;; chunk of debugger output, we position gud-delete-prompt-marker at
2189;; the start of the prompt; the process filter will notice this, and
2190;; delete all text between it and the process output marker. If
2191;; gud-delete-prompt-marker points nowhere, we leave the current
2192;; prompt alone.
53eb3a97
JB
2193(defvar gud-delete-prompt-marker nil)
2194
13b80a60 2195\f
c47264b3
RS
2196(put 'gud-mode 'mode-class 'special)
2197
c157af51 2198(define-derived-mode gud-mode comint-mode "Debugger"
13b80a60 2199 "Major mode for interacting with an inferior debugger process.
24d725c2 2200
6496f3d2 2201 You start it up with one of the commands M-x gdb, M-x sdb, M-x dbx,
2ef4e909 2202M-x perldb, M-x xdb, or M-x jdb. Each entry point finishes by executing a
b0764b2d 2203hook; `gdb-mode-hook', `sdb-mode-hook', `dbx-mode-hook',
2ef4e909 2204`perldb-mode-hook', `xdb-mode-hook', or `jdb-mode-hook' respectively.
24d725c2 2205
ee0155df
ER
2206After startup, the following commands are available in both the GUD
2207interaction buffer and any source buffer GUD visits due to a breakpoint stop
2208or step operation:
13b80a60 2209
ee0155df
ER
2210\\[gud-break] sets a breakpoint at the current file and line. In the
2211GUD buffer, the current file and line are those of the last breakpoint or
2212step. In a source buffer, they are the buffer's file and current line.
2213
45025813
ER
2214\\[gud-remove] removes breakpoints on the current file and line.
2215
ee0155df 2216\\[gud-refresh] displays in the source window the last line referred to
24d725c2 2217in the gud buffer.
13b80a60 2218
ee0155df
ER
2219\\[gud-step], \\[gud-next], and \\[gud-stepi] do a step-one-line,
2220step-one-line (not entering function calls), and step-one-instruction
2221and then update the source window with the current file and position.
2222\\[gud-cont] continues execution.
13b80a60 2223
ee0155df
ER
2224\\[gud-print] tries to find the largest C lvalue or function-call expression
2225around point, and sends it to the debugger for value display.
24d725c2 2226
6496f3d2
RS
2227The above commands are common to all supported debuggers except xdb which
2228does not support stepping instructions.
24d725c2 2229
6496f3d2 2230Under gdb, sdb and xdb, \\[gud-tbreak] behaves exactly like \\[gud-break],
ee0155df
ER
2231except that the breakpoint is temporary; that is, it is removed when
2232execution stops on it.
24d725c2 2233
6496f3d2 2234Under gdb, dbx, and xdb, \\[gud-up] pops up through an enclosing stack
c6094cae 2235frame. \\[gud-down] drops back down through one.
24d725c2 2236
6496f3d2 2237If you are using gdb or xdb, \\[gud-finish] runs execution to the return from
ee0155df 2238the current function and stops.
24d725c2 2239
dcec1a3b
RS
2240All the keystrokes above are accessible in the GUD buffer
2241with the prefix C-c, and in all buffers through the prefix C-x C-a.
45025813 2242
ee0155df
ER
2243All pre-defined functions for which the concept make sense repeat
2244themselves the appropriate number of times if you give a prefix
2245argument.
13b80a60 2246
dcec1a3b 2247You may use the `gud-def' macro in the initialization hook to define other
ee0155df 2248commands.
13b80a60 2249
24d725c2
ER
2250Other commands for interacting with the debugger process are inherited from
2251comint mode, which see."
0b358e64 2252 (setq mode-line-process '(":%s"))
2b64612d 2253 (define-key (current-local-map) "\C-c\C-l" 'gud-refresh)
c157af51 2254 (set (make-local-variable 'gud-last-frame) nil)
f36ca832 2255 (set (make-local-variable 'tool-bar-map) gud-tool-bar-map)
13b80a60 2256 (make-local-variable 'comint-prompt-regexp)
aa9063cb 2257 ;; Don't put repeated commands in command history many times.
c157af51 2258 (set (make-local-variable 'comint-input-ignoredups) t)
f54877b2 2259 (make-local-variable 'paragraph-start)
c157af51 2260 (set (make-local-variable 'gud-delete-prompt-marker) (make-marker)))
a223b10d 2261
18aa807e
RS
2262;; Cause our buffers to be displayed, by default,
2263;; in the selected window.
2264;;;###autoload (add-hook 'same-window-regexps "\\*gud-.*\\*\\(\\|<[0-9]+>\\)")
2265
d2d1851b
SM
2266(defcustom gud-chdir-before-run t
2267 "Non-nil if GUD should `cd' to the debugged executable."
2268 :group 'gud
2269 :type 'boolean)
2270
a223b10d 2271;; Perform initializations common to all debuggers.
ee97eac3
RS
2272;; The first arg is the specified command line,
2273;; which starts with the program to debug.
2274;; The other three args specify the values to use
2275;; for local variables in the debugger buffer.
d2d1851b 2276(defun gud-common-init (command-line massage-args marker-filter &optional find-file)
c157af51 2277 (let* ((words (split-string command-line))
a223b10d 2278 (program (car words))
dfbd82a6
RS
2279 ;; Extract the file name from WORDS
2280 ;; and put t in its place.
2281 ;; Later on we will put the modified file name arg back there.
a223b10d
RM
2282 (file-word (let ((w (cdr words)))
2283 (while (and w (= ?- (aref (car w) 0)))
2284 (setq w (cdr w)))
c27c1042
KH
2285 (and w
2286 (prog1 (car w)
2287 (setcar w t)))))
0ec5b01d
RS
2288 (file-subst
2289 (and file-word (substitute-in-file-name file-word)))
dfbd82a6 2290 (args (cdr words))
0ec5b01d
RS
2291 ;; If a directory was specified, expand the file name.
2292 ;; Otherwise, don't expand it, so GDB can use the PATH.
2293 ;; A file name without directory is literally valid
2294 ;; only if the file exists in ., and in that case,
2295 ;; omitting the expansion here has no visible effect.
52b85866 2296 (file (and file-word
0ec5b01d
RS
2297 (if (file-name-directory file-subst)
2298 (expand-file-name file-subst)
2299 file-subst)))
c27c1042 2300 (filepart (and file-word (concat "-" (file-name-nondirectory file)))))
18aa807e 2301 (pop-to-buffer (concat "*gud" filepart "*"))
0ec5b01d
RS
2302 ;; Set default-directory to the file's directory.
2303 (and file-word
d2d1851b 2304 gud-chdir-before-run
0ec5b01d
RS
2305 ;; Don't set default-directory if no directory was specified.
2306 ;; In that case, either the file is found in the current directory,
2307 ;; in which case this setq is a no-op,
2308 ;; or it is found by searching PATH,
2309 ;; in which case we don't know what directory it was found in.
2310 (file-name-directory file)
2311 (setq default-directory (file-name-directory file)))
ee97eac3
RS
2312 (or (bolp) (newline))
2313 (insert "Current directory is " default-directory "\n")
dfbd82a6
RS
2314 ;; Put the substituted and expanded file name back in its place.
2315 (let ((w args))
2316 (while (and w (not (eq (car w) t)))
2317 (setq w (cdr w)))
c27c1042
KH
2318 (if w
2319 (setcar w file)))
2320 (apply 'make-comint (concat "gud" filepart) program nil
8b5cd4d0 2321 (if massage-args (funcall massage-args file args) args)))
ee97eac3 2322 ;; Since comint clobbered the mode, we don't set it until now.
13b80a60 2323 (gud-mode)
ee97eac3
RS
2324 (make-local-variable 'gud-marker-filter)
2325 (setq gud-marker-filter marker-filter)
d2d1851b 2326 (if find-file (set (make-local-variable 'gud-find-file) find-file))
ee97eac3 2327
13b80a60
ER
2328 (set-process-filter (get-buffer-process (current-buffer)) 'gud-filter)
2329 (set-process-sentinel (get-buffer-process (current-buffer)) 'gud-sentinel)
c157af51 2330 (gud-set-buffer))
13b80a60
ER
2331
2332(defun gud-set-buffer ()
c157af51
SM
2333 (when (eq major-mode 'gud-mode)
2334 (setq gud-comint-buffer (current-buffer))))
ee0155df 2335
11736488
RS
2336(defvar gud-filter-defer-flag nil
2337 "Non-nil means don't process anything from the debugger right now.
2338It is saved for when this flag is not set.")
2339
2340(defvar gud-filter-pending-text nil
2341 "Non-nil means this is text that has been saved for later in `gud-filter'.")
2342
ee0155df
ER
2343;; These functions are responsible for inserting output from your debugger
2344;; into the buffer. The hard work is done by the method that is
2345;; the value of gud-marker-filter.
13b80a60 2346
ee0155df 2347(defun gud-filter (proc string)
13b80a60 2348 ;; Here's where the actual buffer insertion is done
7f4bda7c 2349 (let (output process-window)
c561a0cb 2350 (if (buffer-name (process-buffer proc))
11736488
RS
2351 (if gud-filter-defer-flag
2352 ;; If we can't process any text now,
2353 ;; save it for later.
2354 (setq gud-filter-pending-text
2355 (concat (or gud-filter-pending-text "") string))
c7856dbe
RS
2356
2357 ;; If we have to ask a question during the processing,
2358 ;; defer any additional text that comes from the debugger
2359 ;; during that time.
2360 (let ((gud-filter-defer-flag t))
2361 ;; Process now any text we previously saved up.
2362 (if gud-filter-pending-text
2363 (setq string (concat gud-filter-pending-text string)
2364 gud-filter-pending-text nil))
f09b5567
MB
2365
2366 (with-current-buffer (process-buffer proc)
11736488 2367 ;; If we have been so requested, delete the debugger prompt.
136b4eda
MB
2368 (save-restriction
2369 (widen)
2370 (if (marker-buffer gud-delete-prompt-marker)
2371 (progn
2372 (delete-region (process-mark proc)
2373 gud-delete-prompt-marker)
2374 (set-marker gud-delete-prompt-marker nil)))
2375 ;; Save the process output, checking for source file markers.
2376 (setq output (gud-marker-filter string))
2377 ;; Check for a filename-and-line number.
2378 ;; Don't display the specified file
2379 ;; unless (1) point is at or after the position where output appears
2380 ;; and (2) this buffer is on the screen.
2381 (setq process-window
2382 (and gud-last-frame
2383 (>= (point) (process-mark proc))
2384 (get-buffer-window (current-buffer)))))
c7856dbe
RS
2385
2386 ;; Let the comint filter do the actual insertion.
2387 ;; That lets us inherit various comint features.
88be0819
RS
2388 (comint-output-filter proc output))
2389
2390 ;; Put the arrow on the source line.
2391 ;; This must be outside of the save-excursion
2392 ;; in case the source file is our current buffer.
2393 (if process-window
2394 (save-selected-window
2395 (select-window process-window)
2396 (gud-display-frame))
2397 ;; We have to be in the proper buffer, (process-buffer proc),
2398 ;; but not in a save-excursion, because that would restore point.
2399 (let ((old-buf (current-buffer)))
2400 (set-buffer (process-buffer proc))
2401 (unwind-protect
2402 (gud-display-frame)
2403 (set-buffer old-buf)))))
c7856dbe
RS
2404
2405 ;; If we deferred text that arrived during this processing,
2406 ;; handle it now.
2407 (if gud-filter-pending-text
2408 (gud-filter proc ""))))))
13b80a60
ER
2409
2410(defun gud-sentinel (proc msg)
2411 (cond ((null (buffer-name (process-buffer proc)))
2412 ;; buffer killed
2413 ;; Stop displaying an arrow in a source file.
2414 (setq overlay-arrow-position nil)
2415 (set-process-buffer proc nil))
2416 ((memq (process-status proc) '(signal exit))
2417 ;; Stop displaying an arrow in a source file.
2418 (setq overlay-arrow-position nil)
13b80a60
ER
2419 (let* ((obuf (current-buffer)))
2420 ;; save-excursion isn't the right thing if
2421 ;; process-buffer is current-buffer
2422 (unwind-protect
2423 (progn
2424 ;; Write something in *compilation* and hack its mode line,
2425 (set-buffer (process-buffer proc))
1a3ce5c4
AS
2426 ;; Fix the mode line.
2427 (setq mode-line-process
2428 (concat ":"
2429 (symbol-name (process-status proc))))
e726eb56 2430 (force-mode-line-update)
13b80a60
ER
2431 (if (eobp)
2432 (insert ?\n mode-name " " msg)
2433 (save-excursion
2434 (goto-char (point-max))
2435 (insert ?\n mode-name " " msg)))
2436 ;; If buffer and mode line will show that the process
2437 ;; is dead, we can delete it now. Otherwise it
2438 ;; will stay around until M-x list-processes.
2439 (delete-process proc))
2440 ;; Restore old buffer, but don't restore old point
2441 ;; if obuf is the gud buffer.
2442 (set-buffer obuf))))))
2443
13b80a60
ER
2444(defun gud-display-frame ()
2445 "Find and obey the last filename-and-line marker from the debugger.
2446Obeying it means displaying in another window the specified file and line."
2447 (interactive)
2448 (if gud-last-frame
ee0155df 2449 (progn
13b80a60
ER
2450 (gud-set-buffer)
2451 (gud-display-line (car gud-last-frame) (cdr gud-last-frame))
32ab4c10
JB
2452 (setq gud-last-last-frame gud-last-frame
2453 gud-last-frame nil))))
13b80a60
ER
2454
2455;; Make sure the file named TRUE-FILE is in a buffer that appears on the screen
2456;; and that its line LINE is visible.
2457;; Put the overlay-arrow on the line LINE in that buffer.
ee0155df
ER
2458;; Most of the trickiness in here comes from wanting to preserve the current
2459;; region-restriction if that's possible. We use an explicit display-buffer
2460;; to get around the fact that this is called inside a save-excursion.
13b80a60
ER
2461
2462(defun gud-display-line (true-file line)
8f6c93e2 2463 (let* ((last-nonmenu-event t) ; Prevent use of dialog box for questions.
36d6372a
RS
2464 (buffer
2465 (save-excursion
2466 (or (eq (current-buffer) gud-comint-buffer)
2467 (set-buffer gud-comint-buffer))
2468 (gud-find-file true-file)))
f55d65a1 2469 (window (and buffer (or (get-buffer-window buffer)
f36ca832
NR
2470 (if (eq gud-minor-mode 'gdba)
2471 (gdb-display-source-buffer buffer)
2472 (display-buffer buffer)))))
13b80a60 2473 (pos))
87a3fd19
RS
2474 (if buffer
2475 (progn
2476 (save-excursion
2477 (set-buffer buffer)
2478 (save-restriction
2479 (widen)
2480 (goto-line line)
2481 (setq pos (point))
2482 (setq overlay-arrow-string "=>")
2483 (or overlay-arrow-position
2484 (setq overlay-arrow-position (make-marker)))
2485 (set-marker overlay-arrow-position (point) (current-buffer)))
2486 (cond ((or (< pos (point-min)) (> pos (point-max)))
2487 (widen)
2488 (goto-char pos))))
2489 (set-window-point window overlay-arrow-position)))))
53eb3a97 2490
8b5cd4d0
SM
2491;; The gud-call function must do the right thing whether its invoking
2492;; keystroke is from the GUD buffer itself (via major-mode binding)
2493;; or a C buffer. In the former case, we want to supply data from
2494;; gud-last-frame. Here's how we do it:
13b80a60 2495
ee0155df 2496(defun gud-format-command (str arg)
13eaa026
RS
2497 (let ((insource (not (eq (current-buffer) gud-comint-buffer)))
2498 (frame (or gud-last-frame gud-last-last-frame))
2499 result)
2ef4e909 2500 (while (and str (string-match "\\([^%]*\\)%\\([adeflpc]\\)" str))
13eaa026
RS
2501 (let ((key (string-to-char (substring str (match-beginning 2))))
2502 subst)
2503 (cond
2504 ((eq key ?f)
2505 (setq subst (file-name-nondirectory (if insource
2506 (buffer-file-name)
2507 (car frame)))))
73739399
RS
2508 ((eq key ?F)
2509 (setq subst (file-name-sans-extension
2510 (file-name-nondirectory (if insource
2511 (buffer-file-name)
2512 (car frame))))))
13eaa026
RS
2513 ((eq key ?d)
2514 (setq subst (file-name-directory (if insource
7f359a21 2515 (buffer-file-name)
13eaa026
RS
2516 (car frame)))))
2517 ((eq key ?l)
38eba485
RS
2518 (setq subst (int-to-string
2519 (if insource
2520 (save-restriction
2521 (widen)
8b5cd4d0 2522 (+ (count-lines (point-min) (point))
38eba485
RS
2523 (if (bolp) 1 0)))
2524 (cdr frame)))))
13eaa026 2525 ((eq key ?e)
ab4b0d2f 2526 (setq subst (gud-find-c-expr)))
13eaa026
RS
2527 ((eq key ?a)
2528 (setq subst (gud-read-address)))
2ef4e909
RS
2529 ((eq key ?c)
2530 (setq subst (gud-find-class (if insource
2531 (buffer-file-name)
2532 (car frame)))))
13eaa026 2533 ((eq key ?p)
b2e60475
DL
2534 (setq subst (if arg (int-to-string arg)))))
2535 (setq result (concat result (match-string 1 str) subst)))
13eaa026
RS
2536 (setq str (substring str (match-end 2))))
2537 ;; There might be text left in STR when the loop ends.
2538 (concat result str)))
13b80a60 2539
6bde8427 2540(defun gud-read-address ()
13b80a60 2541 "Return a string containing the core-address found in the buffer at point."
f36ca832
NR
2542 (save-match-data
2543 (save-excursion
2544 (let ((pt (point)) found begin)
2545 (setq found (if (search-backward "0x" (- pt 7) t) (point)))
2546 (cond
2547 (found (forward-char 2)
2548 (buffer-substring found
2549 (progn (re-search-forward "[^0-9a-f]")
2550 (forward-char -1)
2551 (point))))
2552 (t (setq begin (progn (re-search-backward "[^0-9]")
2553 (forward-char 1)
2554 (point)))
2555 (forward-char 1)
2556 (re-search-forward "[^0-9]")
2557 (forward-char -1)
2558 (buffer-substring begin (point))))))))
13b80a60 2559
ee0155df
ER
2560(defun gud-call (fmt &optional arg)
2561 (let ((msg (gud-format-command fmt arg)))
2562 (message "Command: %s" msg)
2563 (sit-for 0)
2564 (gud-basic-call msg)))
13b80a60 2565
ee0155df
ER
2566(defun gud-basic-call (command)
2567 "Invoke the debugger COMMAND displaying source in other window."
2568 (interactive)
2569 (gud-set-buffer)
f36ca832 2570 (let ((proc (get-buffer-process gud-comint-buffer)))
4b8b296e 2571 (or proc (error "Current buffer has no process"))
ee0155df
ER
2572 ;; Arrange for the current prompt to get deleted.
2573 (save-excursion
2574 (set-buffer gud-comint-buffer)
136b4eda
MB
2575 (save-restriction
2576 (widen)
2577 (goto-char (process-mark proc))
2578 (forward-line 0)
2579 (if (looking-at comint-prompt-regexp)
f36ca832
NR
2580 (set-marker gud-delete-prompt-marker (point)))
2581 (if (eq gud-minor-mode 'gdba)
2582 (apply comint-input-sender (list proc command))
2583 (process-send-string proc (concat command "\n")))))))
ee0155df
ER
2584
2585(defun gud-refresh (&optional arg)
2586 "Fix up a possibly garbled display, and redraw the arrow."
13b80a60 2587 (interactive "P")
32ab4c10 2588 (or gud-last-frame (setq gud-last-frame gud-last-last-frame))
7ff24607
EZ
2589 (gud-display-frame)
2590 (recenter arg))
dcec1a3b 2591\f
8b5cd4d0
SM
2592;; Code for parsing expressions out of C code. The single entry point is
2593;; find-c-expr, which tries to return an lvalue expression from around point.
2594;;
2595;; The rest of this file is a hacked version of gdbsrc.el by
2596;; Debby Ayers <ayers@asc.slb.com>,
2597;; Rich Schaefer <schaefer@asc.slb.com> Schlumberger, Austin, Tx.
ee0155df 2598
ab4b0d2f 2599(defun gud-find-c-expr ()
ee0155df
ER
2600 "Returns the C expr that surrounds point."
2601 (interactive)
2602 (save-excursion
ab4b0d2f 2603 (let (p expr test-expr)
ee0155df 2604 (setq p (point))
ab4b0d2f
RS
2605 (setq expr (gud-innermost-expr))
2606 (setq test-expr (gud-prev-expr))
2607 (while (and test-expr (gud-expr-compound test-expr expr))
2608 (let ((prev-expr expr))
2609 (setq expr (cons (car test-expr) (cdr expr)))
2610 (goto-char (car expr))
2611 (setq test-expr (gud-prev-expr))
2612 ;; If we just pasted on the condition of an if or while,
2613 ;; throw it away again.
2614 (if (member (buffer-substring (car test-expr) (cdr test-expr))
2615 '("if" "while" "for"))
2616 (setq test-expr nil
2617 expr prev-expr))))
ee0155df 2618 (goto-char p)
ab4b0d2f
RS
2619 (setq test-expr (gud-next-expr))
2620 (while (gud-expr-compound expr test-expr)
ee0155df 2621 (setq expr (cons (car expr) (cdr test-expr)))
c157af51 2622 (setq test-expr (gud-next-expr)))
dcec1a3b 2623 (buffer-substring (car expr) (cdr expr)))))
ee0155df 2624
ab4b0d2f
RS
2625(defun gud-innermost-expr ()
2626 "Returns the smallest expr that point is in; move point to beginning of it.
ee0155df 2627The expr is represented as a cons cell, where the car specifies the point in
f4b643a1 2628the current buffer that marks the beginning of the expr and the cdr specifies
dcec1a3b 2629the character after the end of the expr."
ab4b0d2f
RS
2630 (let ((p (point)) begin end)
2631 (gud-backward-sexp)
ee0155df 2632 (setq begin (point))
ab4b0d2f 2633 (gud-forward-sexp)
ee0155df 2634 (setq end (point))
f4b643a1 2635 (if (>= p end)
ee0155df
ER
2636 (progn
2637 (setq begin p)
2638 (goto-char p)
ab4b0d2f
RS
2639 (gud-forward-sexp)
2640 (setq end (point)))
ee0155df
ER
2641 )
2642 (goto-char begin)
dcec1a3b 2643 (cons begin end)))
ee0155df 2644
ab4b0d2f 2645(defun gud-backward-sexp ()
dcec1a3b 2646 "Version of `backward-sexp' that catches errors."
ee0155df
ER
2647 (condition-case nil
2648 (backward-sexp)
2649 (error t)))
2650
ab4b0d2f 2651(defun gud-forward-sexp ()
dcec1a3b 2652 "Version of `forward-sexp' that catches errors."
ee0155df
ER
2653 (condition-case nil
2654 (forward-sexp)
2655 (error t)))
2656
ab4b0d2f 2657(defun gud-prev-expr ()
ee0155df
ER
2658 "Returns the previous expr, point is set to beginning of that expr.
2659The expr is represented as a cons cell, where the car specifies the point in
f4b643a1 2660the current buffer that marks the beginning of the expr and the cdr specifies
ee0155df
ER
2661the character after the end of the expr"
2662 (let ((begin) (end))
ab4b0d2f 2663 (gud-backward-sexp)
ee0155df 2664 (setq begin (point))
ab4b0d2f 2665 (gud-forward-sexp)
ee0155df
ER
2666 (setq end (point))
2667 (goto-char begin)
2668 (cons begin end)))
2669
ab4b0d2f 2670(defun gud-next-expr ()
ee0155df
ER
2671 "Returns the following expr, point is set to beginning of that expr.
2672The expr is represented as a cons cell, where the car specifies the point in
f4b643a1 2673the current buffer that marks the beginning of the expr and the cdr specifies
dcec1a3b 2674the character after the end of the expr."
ee0155df 2675 (let ((begin) (end))
ab4b0d2f
RS
2676 (gud-forward-sexp)
2677 (gud-forward-sexp)
ee0155df 2678 (setq end (point))
ab4b0d2f 2679 (gud-backward-sexp)
ee0155df 2680 (setq begin (point))
dcec1a3b 2681 (cons begin end)))
ee0155df 2682
ab4b0d2f
RS
2683(defun gud-expr-compound-sep (span-start span-end)
2684 "Scan from SPAN-START to SPAN-END for punctuation characters.
c6094cae 2685If `->' is found, return `?.'. If `.' is found, return `?.'.
ab4b0d2f
RS
2686If any other punctuation is found, return `??'.
2687If no punctuation is found, return `? '."
2688 (let ((result ?\ )
ee0155df
ER
2689 (syntax))
2690 (while (< span-start span-end)
2691 (setq syntax (char-syntax (char-after span-start)))
2692 (cond
ab4b0d2f 2693 ((= syntax ?\ ) t)
ee0155df 2694 ((= syntax ?.) (setq syntax (char-after span-start))
f4b643a1 2695 (cond
ee0155df
ER
2696 ((= syntax ?.) (setq result ?.))
2697 ((and (= syntax ?-) (= (char-after (+ span-start 1)) ?>))
2698 (setq result ?.)
2699 (setq span-start (+ span-start 1)))
2700 (t (setq span-start span-end)
2701 (setq result ??)))))
2702 (setq span-start (+ span-start 1)))
dcec1a3b 2703 result))
ee0155df 2704
ab4b0d2f
RS
2705(defun gud-expr-compound (first second)
2706 "Non-nil if concatenating FIRST and SECOND makes a single C expression.
f4b643a1
RS
2707The two exprs are represented as a cons cells, where the car
2708specifies the point in the current buffer that marks the beginning of the
dcec1a3b 2709expr and the cdr specifies the character after the end of the expr.
ee0155df
ER
2710Link exprs of the form:
2711 Expr -> Expr
2712 Expr . Expr
2713 Expr (Expr)
2714 Expr [Expr]
2715 (Expr) Expr
2716 [Expr] Expr"
2717 (let ((span-start (cdr first))
2718 (span-end (car second))
2719 (syntax))
ab4b0d2f 2720 (setq syntax (gud-expr-compound-sep span-start span-end))
ee0155df
ER
2721 (cond
2722 ((= (car first) (car second)) nil)
2723 ((= (cdr first) (cdr second)) nil)
2724 ((= syntax ?.) t)
ab4b0d2f 2725 ((= syntax ?\ )
ee0155df
ER
2726 (setq span-start (char-after (- span-start 1)))
2727 (setq span-end (char-after span-end))
2728 (cond
ab4b0d2f
RS
2729 ((= span-start ?)) t)
2730 ((= span-start ?]) t)
f5851398 2731 ((= span-end ?() t)
ab4b0d2f
RS
2732 ((= span-end ?[) t)
2733 (t nil)))
dcec1a3b 2734 (t nil))))
5b08a462 2735
2ef4e909
RS
2736(defun gud-find-class (f)
2737 "Find fully qualified class corresponding to file F.
e78e1cd1
EZ
2738This function uses the `gud-jdb-classpath' (and optional
2739`gud-jdb-sourcepath') list(s) to derive a file
2ef4e909
RS
2740pathname relative to its classpath directory. The values in
2741`gud-jdb-classpath' are assumed to have been converted to absolute
2742pathname standards using file-truename."
2743 ;; Convert f to a standard representation and remove suffix
e78e1cd1 2744 (if (and gud-jdb-use-classpath (or gud-jdb-classpath gud-jdb-sourcepath))
2ef4e909 2745 (save-match-data
f5851398
EZ
2746 (let ((cplist (append gud-jdb-sourcepath gud-jdb-classpath))
2747 class-found)
2748 (setq f (file-name-sans-extension (file-truename f)))
2749 ;; Search through classpath list for an entry that is
2750 ;; contained in f
2751 (while (and cplist (not class-found))
2752 (if (string-match (car cplist) f)
2753 (setq class-found
2754 (mapconcat (lambda(x) x)
2755 (split-string
2756 (substring f (+ (match-end 0) 1))
2757 "/") ".")))
2758 (setq cplist (cdr cplist)))
2759 (if (not class-found)
2760 (message "gud-find-class: class for file %s not found!" f))
2761 class-found))
e78e1cd1
EZ
2762 ;; Not using classpath - try class/source association list
2763 (let ((class-found (rassoc f gud-jdb-class-source-alist)))
2764 (if class-found
f5851398
EZ
2765 (car class-found)
2766 (message "gud-find-class: class for file %s not found in gud-jdb-class-source-alist!" f)
2767 nil))))
2ef4e909 2768
2c46c4c8 2769(provide 'gud)
96f4e22e 2770
f961a17c 2771;;; gud.el ends here