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