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