*** empty log message ***
[emacs.git] / lisp / gud.el
blob172781e0fea37d8e965eb8048934bb871d89ee7e
1 ;; Grand Unified Debugger mode --- run gdb, sdb, dbx under Emacs control
2 ;; @(#)gud.el 1.10
4 ;; This file is part of GNU Emacs.
6 ;; GNU Emacs is free software; you can redistribute it and/or modify
7 ;; it under the terms of the GNU General Public License as published by
8 ;; the Free Software Foundation; either version 1, or (at your option)
9 ;; any later version.
11 ;; GNU Emacs is distributed in the hope that it will be useful,
12 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
13 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 ;; GNU General Public License for more details.
16 ;; You should have received a copy of the GNU General Public License
17 ;; along with GNU Emacs; see the file COPYING. If not, write to
18 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
20 ;; The ancestral gdb.el was by W. Schelter <wfs@rascal.ics.utexas.edu>
21 ;; It was later ewritten by rms. Some ideas were due to Masanobu.
22 ;; Grand Unification (sdb/dbx support) by Eric S. Raymond <eric@thyrsus.com>
23 ;; The overloading code was then rewritten by Barry Warsaw <bwarsaw@cen.com>,
24 ;; who also hacked the mode to use comint.el.
26 ;; Note: use of this package with sdb requires that your tags.el support
27 ;; the find-tag-noselect entry point. Stock distributions up to 18.57 do
28 ;; *not* include this feature; if it's not included with this file, email
29 ;; eric@snark.thyrsus.com for it or get 18.58.
31 (require 'comint)
32 (require 'tags)
34 ;; ======================================================================
35 ;; the overloading mechanism
37 (defun gud-overload-functions (gud-overload-alist)
38 "Overload functions defined in GUD-OVERLOAD-ALIST.
39 This association list has elements of the form
41 (ORIGINAL-FUNCTION-NAME OVERLOAD-FUNCTION)"
42 (let ((binding nil)
43 (overloads gud-overload-alist))
44 (while overloads
45 (setq binding (car overloads)
46 overloads (cdr overloads))
47 (fset (car binding) (symbol-function (car (cdr binding))))
48 )))
50 (defun gud-debugger-startup (f d)
51 (error "GUD not properly entered."))
53 (defun gud-marker-filter (proc s)
54 (error "GUD not properly entered."))
56 (defun gud-visit-file (f)
57 (error "GUD not properly entered."))
59 (defun gud-set-break (proc f n)
60 (error "GUD not properly entered."))
62 ;; This macro is used below to define some basic debugger interface commands.
63 ;; Of course you may use `def-gud' with any other debugger command, including
64 ;; user defined ones.
66 (defmacro def-gud (func name key &optional doc)
67 (let* ((cstr (list 'if '(not (= 1 arg))
68 (list 'format "%s %s" name 'arg) name)))
69 (list 'progn
70 (list 'defun func '(arg)
71 (or doc "")
72 '(interactive "p")
73 (list 'gud-call cstr))
74 (list 'define-key 'gud-mode-map key (list 'quote func)))))
76 ;; All debugger-specific information is collected here
77 ;; Here's how it works, in case you ever need to add a debugger to the table.
79 ;; Each entry must define the following at startup:
81 ;;<name>
82 ;; comint-prompt-regexp
83 ;; gud-<name>-startup-command
84 ;; gud-<name>-marker-filter
85 ;; gud-<name>-file-visit
86 ;; gud-<name>-set-break
88 ;; The job of the startup-command method is to fire up a copy of the debugger,
89 ;; given an object file and source directory.
91 ;; The job of the marker-filter method is to detect file/line markers in
92 ;; strings and set the global gud-last-frame to indicate what display
93 ;; action (if any) should be triggered by the marker. Note that only
94 ;; whetever the method *returns* is displayed in the buffer; thus, you
95 ;; can filter the debugger's output, interpreting some and passing on
96 ;; the rest.
98 ;; The job of the visit-file method is to visit and return the buffer indicated
99 ;; by the car of gud-tag-frame. This may be a file name, a tag name, or
100 ;; something else.
102 ;; The job of the gud-set-break method is to send the commands necessary
103 ;; to set a breakpoint at a given line in a given source file.
105 ;; Debugger-specific information begins here:
107 ;; ======================================================================
108 ;; gdb functions
110 (defun gud-gdb-debugger-startup (f d)
111 (make-comint (concat "gud-" f) "gdb" nil "-fullname" "-cd" d f))
113 (defun gud-gdb-marker-filter (proc s)
114 (if (string-match "\032\032\\([^:\n]*\\):\\([0-9]*\\):.*\n" s)
115 (progn
116 (setq gud-last-frame
117 (cons
118 (substring string (match-beginning 1) (match-end 1))
119 (string-to-int
120 (substring string (match-beginning 2) (match-end 2)))))
121 ;; this computation means the ^Z^Z-initiated marker in the
122 ;; input string is never emitted.
123 (concat
124 (substring string 0 (match-beginning 0))
125 (substring string (match-end 0))
127 string))
129 (defun gud-gdb-visit-file (f)
130 (find-file-noselect f))
132 (defun gud-gdb-set-break (proc f n)
133 (gud-call "break %s:%d" f n))
135 ;;;###autoload
136 (defun gdb (path)
137 "Run gdb on program FILE in buffer *gud-FILE*.
138 The directory containing FILE becomes the initial working directory
139 and source-file directory for your debugger."
140 (interactive "fRun gdb on file: ")
141 (gud-overload-functions '((gud-debugger-startup gud-gdb-debugger-startup)
142 (gud-marker-filter gud-gdb-marker-filter)
143 (gud-visit-file gud-gdb-visit-file)
144 (gud-set-break gud-gdb-set-break)))
146 (def-gud gud-step "step" "\C-cs" "Step one source line with display")
147 (def-gud gud-stepi "stepi" "\C-ci" "Step one instruction with display")
148 (def-gud gud-next "next" "\C-cn" "Step one line (skip functions)")
149 (def-gud gud-cont "cont" "\C-c\C-c" "Continue with display")
151 (def-gud gud-finish "finish" "\C-c\C-f" "Finish executing current function")
152 (def-gud gud-up "up" "\C-c<" "Up N stack frames (numeric arg)")
153 (def-gud gud-down "down" "\C-c>" "Down N stack frames (numeric arg)")
155 (gud-common-init path)
157 (setq comint-prompt-regexp "^(.*gdb[+]?) *")
158 (run-hooks 'gdb-mode-hook)
162 ;; ======================================================================
163 ;; sdb functions
165 (defun gud-sdb-debugger-startup (f d)
166 (make-comint (concat "gud-" f) "sdb" nil f "-" d))
168 (defun gud-sdb-marker-filter (proc str)
169 (if (string-match "\\(^0x\\w* in \\|^\\|\n\\)\\([^:\n]*\\):\\([0-9]*\\):.*\n"
170 str)
171 (setq gud-last-frame
172 (cons
173 (substring string (match-beginning 2) (match-end 2))
174 (string-to-int
175 (substring string (match-beginning 3) (match-end 3))))))
176 string)
178 (defun gud-sdb-visit-file (f)
179 (find-tag-noselect f t))
181 (defun gud-sdb-set-break (proc f n)
182 (gud-queue-send (format "e %s" f) (format "%d b" n)))
184 ;;;###autoload
185 (defun sdb (path)
186 "Run sdb on program FILE in buffer *gud-FILE*.
187 The directory containing FILE becomes the initial working directory
188 and source-file directory for your debugger."
189 (if (not (and (boundp 'tags-file-name) (file-exists-p tags-file-name)))
190 (error "The sdb support requires a valid tags table to work."))
191 (interactive "fRun sdb on file: ")
192 (gud-overload-functions '((gud-debugger-startup gud-sdb-debugger-startup)
193 (gud-marker-filter gud-sdb-marker-filter)
194 (gud-visit-file gud-sdb-visit-file)
195 (gud-set-break gud-sdb-set-break)))
197 (def-gud gud-step "s" "\C-cs" "Step one source line with display")
198 (def-gud gud-stepi "i" "\C-ci" "Step one instruction with display")
199 (def-gud gud-next "S" "\C-cn" "Step one source line (skip functions)")
200 (def-gud gud-cont "c" "\C-cc" "Continue with display")
202 (gud-common-init path)
204 (setq comint-prompt-pattern "\\(^\\|\n\\)\\*")
205 (run-hooks 'sdb-mode-hook)
208 ;; ======================================================================
209 ;; dbx functions
211 (defun gud-dbx-debugger-startup (f d)
212 (make-comint (concat "gud-" file) "dbx" nil f))
214 (defun gud-dbx-marker-filter (proc str)
215 (if (string-match
216 "stopped in .* at line \\([0-9]*\\) in file \"\\([^\"]*\\)\"" str)
217 (setq gud-last-frame
218 (cons
219 (substring string (match-beginning 2) (match-end 2))
220 (string-to-int
221 (substring string (match-beginning 1) (match-end 1))))))
222 string)
224 (defun gud-dbx-visit-file (f)
225 (find-file-noselect f))
227 (defun gud-dbx-set-break (proc f n)
228 (gud-call "stop at \"%s\":%d" f n))
230 ;;;###autoload
231 (defun dbx (path)
232 "Run dbx on program FILE in buffer *gud-FILE*.
233 The directory containing FILE becomes the initial working directory
234 and source-file directory for your debugger."
235 (interactive "fRun dbx on file: ")
236 (gud-overload-functions '((gud-debugger-startup gud-dbx-debugger-startup)
237 (gud-marker-filter gud-dbx-marker-filter)
238 (gud-visit-file gud-dbx-visit-file)
239 (gud-set-break gud-dbx-set-break)))
241 (make-local-variable 'comint-prompt-regexp)
242 (setq comint-prompt-regexp "^[^)]*dbx) *")
244 (gud-common-init path)
246 (run-hooks 'dbx-mode-hook)
250 ;; End of debugger-specific information
253 (defvar gud-mode-map nil
254 "Keymap for gud-mode.")
256 (defvar gud-command-queue nil)
258 (if gud-mode-map
260 (setq gud-mode-map (copy-keymap comint-mode-map))
261 (define-key gud-mode-map "\C-l" 'gud-refresh))
263 (define-key ctl-x-map " " 'gud-break)
264 (define-key ctl-x-map "&" 'send-gud-command)
267 (defun gud-mode ()
268 "Major mode for interacting with an inferior debugger process.
269 The following commands are available:
271 \\{gud-mode-map}
273 \\[gud-display-frame] displays in the other window
274 the last line referred to in the gud buffer.
276 \\[gud-step],\\[gud-next], and \\[gud-nexti] in the gud window,
277 do a step-one-line, step-one-line (not entering function calls), and
278 step-one-instruction and then update the other window
279 with the current file and position. \\[gud-cont] continues
280 execution.
282 If you are in a source file, you may set a breakpoint at the current
283 line in the current source file by doing \\[gud-break].
285 Commands:
286 Many commands are inherited from comint mode.
287 Additionally we have:
289 \\[gud-display-frame] display frames file in other window
290 \\[gud-step] advance one line in program
291 \\[gud-next] advance one line in program (skip over calls).
292 \\[send-gud-command] used for special printing of an arg at the current point.
293 C-x SPACE sets break point at current line."
294 (interactive)
295 (comint-mode)
296 ; (kill-all-local-variables)
297 (setq major-mode 'gud-mode)
298 (setq mode-name "Debugger")
299 (setq mode-line-process '(": %s"))
300 (use-local-map gud-mode-map)
301 (make-local-variable 'gud-last-frame)
302 (setq gud-last-frame nil)
303 (make-local-variable 'comint-prompt-regexp)
304 (run-hooks 'gud-mode-hook)
307 (defvar current-gud-buffer nil)
309 (defun gud-common-init (path)
310 ;; perform initializations common to all debuggers
311 (setq path (expand-file-name path))
312 (let ((file (file-name-nondirectory path)))
313 (switch-to-buffer (concat "*gud-" file "*"))
314 (setq default-directory (file-name-directory path))
315 (or (bolp) (newline))
316 (insert "Current directory is " default-directory "\n")
317 (gud-debugger-startup file default-directory))
318 (gud-mode)
319 (set-process-filter (get-buffer-process (current-buffer)) 'gud-filter)
320 (set-process-sentinel (get-buffer-process (current-buffer)) 'gud-sentinel)
321 (setq gud-command-queue nil)
322 (gud-set-buffer)
325 (defun gud-set-buffer ()
326 (cond ((eq major-mode 'gud-mode)
327 (setq current-gud-buffer (current-buffer)))))
329 (defun gud-filter (proc string)
330 ;; This function is responsible for inserting output from your debugger
331 ;; into the buffer. The hard work is done by the method that is
332 ;; the value of gud-marker-filter.
333 (let ((inhibit-quit t))
334 (gud-filter-insert proc (gud-marker-filter proc string))
335 ;; If we've got queued commands and we see a prompt, pop one and send it.
336 ;; In theory we should check that a prompt has been issued before sending
337 ;; queued commands. In practice, command responses from the first through
338 ;; penultimate elements of a command sequence are short enough that we
339 ;; don't really have to bother.
340 (if gud-command-queue
341 (progn
342 (gud-call (car gud-command-queue))
343 (setq gud-command-queue (cdr gud-command-queue))
347 (defun gud-filter-insert (proc string)
348 ;; Here's where the actual buffer insertion is done
349 (let ((moving (= (point) (process-mark proc)))
350 (output-after-point (< (point) (process-mark proc)))
351 (old-buffer (current-buffer))
352 start)
353 (set-buffer (process-buffer proc))
354 (unwind-protect
355 (save-excursion
356 ;; Insert the text, moving the process-marker.
357 (goto-char (process-mark proc))
358 (setq start (point))
359 (insert-before-markers string)
360 (set-marker (process-mark proc) (point))
361 ;; Check for a filename-and-line number.
362 ;; Don't display the specified file
363 ;; unless (1) point is at or after the position where output appears
364 ;; and (2) this buffer is on the screen.
365 (if (and gud-last-frame (not output-after-point)
366 (get-buffer-window (current-buffer)))
367 (gud-display-frame))
369 (set-buffer old-buffer))
370 (if moving (goto-char (process-mark proc)))))
372 (defun gud-sentinel (proc msg)
373 (cond ((null (buffer-name (process-buffer proc)))
374 ;; buffer killed
375 ;; Stop displaying an arrow in a source file.
376 (setq overlay-arrow-position nil)
377 (set-process-buffer proc nil))
378 ((memq (process-status proc) '(signal exit))
379 ;; Stop displaying an arrow in a source file.
380 (setq overlay-arrow-position nil)
381 ;; Fix the mode line.
382 (setq mode-line-process
383 (concat ": "
384 (symbol-name (process-status proc))))
385 (let* ((obuf (current-buffer)))
386 ;; save-excursion isn't the right thing if
387 ;; process-buffer is current-buffer
388 (unwind-protect
389 (progn
390 ;; Write something in *compilation* and hack its mode line,
391 (set-buffer (process-buffer proc))
392 ;; Force mode line redisplay soon
393 (set-buffer-modified-p (buffer-modified-p))
394 (if (eobp)
395 (insert ?\n mode-name " " msg)
396 (save-excursion
397 (goto-char (point-max))
398 (insert ?\n mode-name " " msg)))
399 ;; If buffer and mode line will show that the process
400 ;; is dead, we can delete it now. Otherwise it
401 ;; will stay around until M-x list-processes.
402 (delete-process proc))
403 ;; Restore old buffer, but don't restore old point
404 ;; if obuf is the gud buffer.
405 (set-buffer obuf))))))
408 (defun gud-refresh (&optional arg)
409 "Fix up a possibly garbled display, and redraw the arrow."
410 (interactive "P")
411 (recenter arg)
412 (gud-display-frame))
414 (defun gud-display-frame ()
415 "Find and obey the last filename-and-line marker from the debugger.
416 Obeying it means displaying in another window the specified file and line."
417 (interactive)
418 (if gud-last-frame
419 (progn
420 (gud-set-buffer)
421 (gud-display-line (car gud-last-frame) (cdr gud-last-frame))
422 (setq gud-last-frame nil))))
424 ;; Make sure the file named TRUE-FILE is in a buffer that appears on the screen
425 ;; and that its line LINE is visible.
426 ;; Put the overlay-arrow on the line LINE in that buffer.
428 (defun gud-display-line (true-file line)
429 (let* ((buffer (gud-visit-file true-file))
430 (window (display-buffer buffer t))
431 (pos))
432 (save-excursion
433 (set-buffer buffer)
434 (save-restriction
435 (widen)
436 (goto-line line)
437 (setq pos (point))
438 (setq overlay-arrow-string "=>")
439 (or overlay-arrow-position
440 (setq overlay-arrow-position (make-marker)))
441 (set-marker overlay-arrow-position (point) (current-buffer)))
442 (cond ((or (< pos (point-min)) (> pos (point-max)))
443 (widen)
444 (goto-char pos))))
445 (set-window-point window overlay-arrow-position)))
447 (defun gud-call (command &rest args)
448 "Invoke the debugger COMMAND displaying source in other window."
449 (interactive)
450 (gud-set-buffer)
451 (goto-char (point-max))
452 (let ((command (concat (apply 'format command args) "\n"))
453 (proc (get-buffer-process current-gud-buffer)))
454 (gud-filter-insert proc command)
455 (send-string proc command)
458 (defun gud-queue-send (&rest cmdlist)
459 ;; Send the first command, queue the rest for send after successive
460 ;; send on subsequent prompts
461 (interactive)
462 (gud-call (car cmdlist))
463 (setq gud-command-queue (append gud-command-queue (cdr cmdlist))))
465 (defun gud-apply-from-source (func)
466 ;; Apply a method from the gud buffer environment, passing it file and line.
467 ;; This is intended to be used for gud commands called from a source file.
468 (if (not buffer-file-name)
469 (error "There is no file associated with this buffer"))
470 (let ((file (file-name-nondirectory buffer-file-name))
471 (line (save-restriction (widen) (1+ (count-lines 1 (point))))))
472 (save-excursion
473 (gud-set-buffer)
474 (funcall func
475 (get-buffer-process current-gud-buffer)
476 file
477 line)
480 (defun gud-break ()
481 "Set breakpoint at this source line."
482 (interactive)
483 (gud-apply-from-source 'gud-set-break))
485 (defun gud-read-address()
486 "Return a string containing the core-address found in the buffer at point."
487 (save-excursion
488 (let ((pt (dot)) found begin)
489 (setq found (if (search-backward "0x" (- pt 7) t)(dot)))
490 (cond (found (forward-char 2)
491 (setq result
492 (buffer-substring found
493 (progn (re-search-forward "[^0-9a-f]")
494 (forward-char -1)
495 (dot)))))
496 (t (setq begin (progn (re-search-backward "[^0-9]") (forward-char 1)
497 (dot)))
498 (forward-char 1)
499 (re-search-forward "[^0-9]")
500 (forward-char -1)
501 (buffer-substring begin (dot)))))))
504 (defvar gud-commands nil
505 "List of strings or functions used by send-gud-command.
506 It is for customization by you.")
508 (defun send-gud-command (arg)
510 "This command reads the number where the cursor is positioned. It
511 then inserts this ADDR at the end of the debugger buffer. A numeric arg
512 selects the ARG'th member COMMAND of the list gud-print-command. If
513 COMMAND is a string, (format COMMAND ADDR) is inserted, otherwise
514 (funcall COMMAND ADDR) is inserted. eg. \"p (rtx)%s->fld[0].rtint\"
515 is a possible string to be a member of gud-commands. "
518 (interactive "P")
519 (let (comm addr)
520 (if arg (setq comm (nth arg gud-commands)))
521 (setq addr (gud-read-address))
522 (if (eq (current-buffer) current-gud-buffer)
523 (set-mark (point)))
524 (cond (comm
525 (setq comm
526 (if (stringp comm) (format comm addr) (funcall comm addr))))
527 (t (setq comm addr)))
528 (switch-to-buffer current-gud-buffer)
529 (goto-char (dot-max))
530 (insert-string comm)))
532 ;; gud.e ends here