;; Maintainer: FSF
;; Keywords: unix, tools
-;; Copyright (C) 1992, 93, 94, 95, 96, 1998 Free Software Foundation, Inc.
+;; Copyright (C) 1992, 93, 94, 95, 96, 1998, 2000 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
are interpreted specially if present. These are:
%f name (without directory) of current source file.
+ %F name (without directory or extension) of current source file.
%d directory of current source file.
%l number of current source line
%e text of the C lvalue or function-call expression surrounding point.
\f
;; ======================================================================
;; speedbar support functions and variables.
+(eval-when-compile (require 'speedbar))
+
(defvar gud-last-speedbar-buffer nil
"The last GUD buffer used.")
"Description of the currently displayed GUD stack.
t means that there is no stack, and we are in display-file mode.")
+(defvar gud-speedbar-key-map nil
+ "Keymap used when in the buffers display mode.")
+
+(defun gud-install-speedbar-variables ()
+ "Install those variables used by speedbar to enhance gud/gdb."
+ (if gud-speedbar-key-map
+ nil
+ (setq gud-speedbar-key-map (speedbar-make-specialized-keymap))
+
+ (define-key gud-speedbar-key-map "j" 'speedbar-edit-line)
+ (define-key gud-speedbar-key-map "e" 'speedbar-edit-line)
+ (define-key gud-speedbar-key-map "\C-m" 'speedbar-edit-line)))
+
(defvar gud-speedbar-menu-items
;; Note to self. Add expand, and turn off items when not available.
'(["Jump to stack frame" speedbar-edit-line t])
"Additional menu items to add the the speedbar frame.")
+;; Make sure our special speedbar mode is loaded
+(if (featurep 'speedbar)
+ (gud-install-speedbar-variables)
+ (add-hook 'speedbar-load-hook 'gud-install-speedbar-variables))
+
(defun gud-speedbar-buttons (buffer)
"Create a speedbar display based on the current state of GUD.
If the GUD BUFFER is not running a supported debugger, then turn
(defun gud-gdb-find-file (f)
(save-excursion
- (let ((buf (find-file-noselect f)))
+ (let ((buf (find-file-noselect f 'nowarn)))
(set-buffer buf)
(gud-make-debug-menu)
(local-set-key [menu-bar debug tbreak]
(car gud-gdb-history)
"gdb ")
gdb-minibuffer-local-map nil
- '(gud-gdb-history . 1))))
+ 'gud-gdb-history)))
(gud-common-init command-line 'gud-gdb-massage-args
'gud-gdb-marker-filter 'gud-gdb-find-file)
available with older versions of GDB."
(interactive)
(let* ((end (point))
- (command (save-excursion
- (beginning-of-line)
- (and (looking-at comint-prompt-regexp)
- (goto-char (match-end 0)))
- (buffer-substring (point) end)))
+ (command (buffer-substring (comint-line-beginning-position) end))
command-word)
;; Find the word break. This match will always succeed.
(string-match "\\(\\`\\| \\)\\([^ ]*\\)\\'" command)
(let ((newlst nil)
(gud-gdb-fetched-stack-frame-list nil))
(gud-gdb-run-command-fetch-lines "backtrace" buffer)
- (if (string-match "No stack" (car gud-gdb-fetched-stack-frame-list))
+ (if (and (car gud-gdb-fetched-stack-frame-list)
+ (string-match "No stack" (car gud-gdb-fetched-stack-frame-list)))
;; Go into some other mode???
nil
(while gud-gdb-fetched-stack-frame-list
(let ((e (car gud-gdb-fetched-stack-frame-list))
(name nil) (num nil))
(if (not (or
- (string-match "^#\\([0-9]+\\) +[0-9a-fx]+ in \\([0-9a-zA-Z_]+\\) (" e)
- (string-match "^#\\([0-9]+\\) +\\([0-9a-zA-Z_]+\\) (" e)))
+ (string-match "^#\\([0-9]+\\) +[0-9a-fx]+ in \\([:0-9a-zA-Z_]+\\) (" e)
+ (string-match "^#\\([0-9]+\\) +\\([:0-9a-zA-Z_]+\\) (" e)))
(if (not (string-match
"at \\([-0-9a-zA-Z_.]+\\):\\([0-9]+\\)$" e))
nil
(car gud-sdb-history)
"sdb ")
nil nil
- '(gud-sdb-history . 1))))
+ 'gud-sdb-history)))
(if (and gud-sdb-needs-tags
(not (and (boundp 'tags-file-name)
(stringp tags-file-name)
(car gud-dbx-history)
"dbx ")
nil nil
- '(gud-dbx-history . 1))))
+ 'gud-dbx-history)))
(cond
(gud-mips-p
(car gud-xdb-history)
"xdb ")
nil nil
- '(gud-xdb-history . 1))))
+ 'gud-xdb-history)))
(gud-common-init command-line 'gud-xdb-massage-args
'gud-xdb-marker-filter 'gud-xdb-find-file)
;;; History of argument lists passed to perldb.
(defvar gud-perldb-history nil)
+;; Convert a command line as would be typed normally to run a script
+;; into one that invokes an Emacs-enabled debugging session.
+;; "-d" in inserted as the first switch, and "-emacs" is inserted where
+;; it will be $ARGV[0] (see perl5db.pl).
(defun gud-perldb-massage-args (file args)
- (cond ((equal (car args) "-e")
- (cons "-d"
- (cons (car args)
- (cons (nth 1 args)
- (cons "--" (cons "-emacs" (cdr (cdr args))))))))
- (t
- (cons "-d" (cons (car args) (cons "-emacs" (cdr args)))))))
+ (let* ((new-args '("-d"))
+ (seen-e nil)
+ (shift (lambda ()
+ (setq new-args (cons (car args) new-args))
+ (setq args (cdr args)))))
+
+ ;; Pass all switches and -e scripts through.
+ (while (and args
+ (string-match "^-" (car args))
+ (not (equal "-" (car args)))
+ (not (equal "--" (car args))))
+ (when (equal "-e" (car args))
+ ;; -e goes with the next arg, so shift one extra.
+ (or (funcall shift)
+ ;; -e as the last arg is an error in Perl.
+ (error "No code specified for -e."))
+ (setq seen-e t))
+ (funcall shift))
+
+ (when (not seen-e)
+ (if (or (not args)
+ (string-match "^-" (car args)))
+ (error "Can't use stdin as the script to debug."))
+ ;; This is the program name.
+ (funcall shift))
+
+ ;; If -e specified, make sure there is a -- so -emacs is not taken
+ ;; as -e macs.
+ (if (and args (equal "--" (car args)))
+ (funcall shift)
+ (and seen-e (setq new-args (cons "--" new-args))))
+
+ (setq new-args (cons "-emacs" new-args))
+ (while args
+ (funcall shift))
+
+ (nreverse new-args)))
;; There's no guarantee that Emacs will hand the filter the entire
;; marker at once; it could be broken up across several strings. We
"-e 0")
" "))
nil nil
- '(gud-perldb-history . 1))))
+ 'gud-perldb-history)))
(gud-common-init command-line 'gud-perldb-massage-args
'gud-perldb-marker-filter 'gud-perldb-find-file)
(car gud-pdb-history)
(concat gud-pdb-command-name " "))
pdb-minibuffer-local-map nil
- '(gud-pdb-history . 1))))
+ 'gud-pdb-history)))
(gud-common-init command-line 'gud-pdb-massage-args
'gud-pdb-marker-filter 'gud-pdb-find-file)
;; List of Java source file directories.
(defvar gud-jdb-directories (list ".")
"*A list of directories that gud jdb should search for source code.
-The file names should be absolute, or relative to the current directory.")
+The file names should be absolute, or relative to the current
+directory.
+
+The set of .java files residing in the directories listed are
+syntactically analyzed to determine the classes they define and the
+packages in which these classes belong. In this way gud jdb maps the
+package-qualified class names output by the jdb debugger to the source
+file from which the class originated. This allows gud mode to keep
+the source code display in sync with the debugging session.")
;; List of the java source files for this debugging session.
(defvar gud-jdb-source-files nil)
;; which to search for files with extension EXTN. Normally EXTN is
;; given as the regular expression "\\.java$" .
(defun gud-jdb-build-source-files-list (path extn)
- (apply 'nconc (mapcar (lambda (d) (directory-files d t extn nil)) path)))
+ (apply 'nconc (mapcar (lambda (d)
+ (when (file-directory-p d)
+ (directory-files d t extn nil)) path))))
;; Move point past whitespace.
(defun gud-jdb-skip-whitespace ()
;; Move point past a string literal.
(defun gud-jdb-skip-string-literal ()
(forward-char)
- (while
- (progn
- (if (eq (following-char) ?\\)
- (forward-char 2))
- (not (eq (following-char) ?\042)))
+ (while (not (cond
+ ((eq (following-char) ?\\)
+ (forward-char))
+ ((eq (following-char) ?\042))))
(forward-char))
(forward-char))
;; holding their definitions. SOURCES holds a list of all the source
;; files to examine.
(defun gud-jdb-build-class-source-alist (sources)
- (setq gud-jdb-analysis-buffer (get-buffer-create "*gud-jdb-scratch*"))
+ (setq gud-jdb-analysis-buffer (get-buffer-create " *gud-jdb-scratch*"))
(prog1
(apply
'nconc
(if user-error
(progn
(kill-buffer (current-buffer))
- (error "Error: Omit whitespace between '-classpath' and it's value")))
+ (error "Error: Omit whitespace between '-classpath' and its value")))
(if args
(setq massaged-args
(car gud-jdb-history)
(concat gud-jdb-command-name " "))
nil nil
- '(gud-jdb-history . 1))))
+ 'gud-jdb-history)))
(gud-common-init command-line 'gud-jdb-massage-args
'gud-jdb-marker-filter 'gud-jdb-find-file)
- (gud-def gud-break "stop at %l" "\C-b" "Set breakpoint at current line.")
+ (gud-def gud-break "stop at %F:%l" "\C-b" "Set breakpoint at current line.")
(gud-def gud-remove "clear %l" "\C-d" "Remove breakpoint at current line")
(gud-def gud-step "step" "\C-s" "Step one source line with display.")
(gud-def gud-next "next" "\C-n" "Step one line (skip functions).")
(gud-def gud-cont "cont" "\C-r" "Continue with display.")
- (setq comint-prompt-regexp "^> \|^.+\[[0-9]+\] ")
+ (setq comint-prompt-regexp "^> \\|^.+\\[[0-9]+\\] ")
(setq paragraph-start comint-prompt-regexp)
(run-hooks 'jdb-mode-hook)
(setq words (cons (substring string beg) words)))
(nreverse words)))
+;; Cause our buffers to be displayed, by default,
+;; in the selected window.
+;;;###autoload (add-hook 'same-window-regexps "\\*gud-.*\\*\\(\\|<[0-9]+>\\)")
+
;; Perform initializations common to all debuggers.
;; The first arg is the specified command line,
;; which starts with the program to debug.
(expand-file-name file-subst)
file-subst)))
(filepart (and file-word (concat "-" (file-name-nondirectory file)))))
- (switch-to-buffer (concat "*gud" filepart "*"))
+ (pop-to-buffer (concat "*gud" filepart "*"))
;; Set default-directory to the file's directory.
(and file-word
;; Don't set default-directory if no directory was specified.
(if gud-filter-pending-text
(setq string (concat gud-filter-pending-text string)
gud-filter-pending-text nil))
- (save-excursion
- (set-buffer (process-buffer proc))
+
+ (with-current-buffer (process-buffer proc)
;; If we have been so requested, delete the debugger prompt.
- (if (marker-buffer gud-delete-prompt-marker)
- (progn
- (delete-region (process-mark proc) gud-delete-prompt-marker)
- (set-marker gud-delete-prompt-marker nil)))
- ;; Save the process output, checking for source file markers.
- (setq output (gud-marker-filter string))
- ;; Check for a filename-and-line number.
- ;; Don't display the specified file
- ;; unless (1) point is at or after the position where output appears
- ;; and (2) this buffer is on the screen.
- (setq process-window
- (and gud-last-frame
- (>= (point) (process-mark proc))
- (get-buffer-window (current-buffer))))
+ (save-restriction
+ (widen)
+ (if (marker-buffer gud-delete-prompt-marker)
+ (progn
+ (delete-region (process-mark proc)
+ gud-delete-prompt-marker)
+ (set-marker gud-delete-prompt-marker nil)))
+ ;; Save the process output, checking for source file markers.
+ (setq output (gud-marker-filter string))
+ ;; Check for a filename-and-line number.
+ ;; Don't display the specified file
+ ;; unless (1) point is at or after the position where output appears
+ ;; and (2) this buffer is on the screen.
+ (setq process-window
+ (and gud-last-frame
+ (>= (point) (process-mark proc))
+ (get-buffer-window (current-buffer)))))
;; Let the comint filter do the actual insertion.
;; That lets us inherit various comint features.
(setq subst (file-name-nondirectory (if insource
(buffer-file-name)
(car frame)))))
+ ((eq key ?F)
+ (setq subst (file-name-sans-extension
+ (file-name-nondirectory (if insource
+ (buffer-file-name)
+ (car frame))))))
((eq key ?d)
(setq subst (file-name-directory (if insource
(buffer-file-name)
(setq subst (if insource
(save-excursion
(beginning-of-line)
- (save-restriction (widen)
- (1+ (count-lines 1 (point)))))
+ (save-restriction
+ (widen)
+ (int-to-string (1+ (count-lines 1 (point))))))
(cdr frame))))
((eq key ?e)
(setq subst (gud-find-c-expr)))
((eq key ?a)
(setq subst (gud-read-address)))
((eq key ?p)
- (setq subst (if arg (int-to-string arg) ""))))
- (setq result (concat result
- (substring str (match-beginning 1) (match-end 1))
- subst)))
+ (setq subst (if arg (int-to-string arg)))))
+ (setq result (concat result (match-string 1 str) subst)))
(setq str (substring str (match-end 2))))
;; There might be text left in STR when the loop ends.
(concat result str)))
;; Arrange for the current prompt to get deleted.
(save-excursion
(set-buffer gud-comint-buffer)
- (goto-char (process-mark proc))
- (beginning-of-line)
- (if (looking-at comint-prompt-regexp)
- (set-marker gud-delete-prompt-marker (point))))
+ (save-restriction
+ (widen)
+ (goto-char (process-mark proc))
+ (forward-line 0)
+ (if (looking-at comint-prompt-regexp)
+ (set-marker gud-delete-prompt-marker (point)))))
(process-send-string proc command)))
(defun gud-refresh (&optional arg)
"Make sure the current local map has a [menu-bar debug] submap.
If it doesn't, replace it with a new map that inherits it,
and create such a submap in that new map."
- (if (and (current-local-map)
- (lookup-key (current-local-map) [menu-bar debug]))
- nil
- (use-local-map (gud-new-keymap (current-local-map)))
- (define-key (current-local-map) [menu-bar debug]
- (cons "Gud" (gud-new-keymap gud-menu-map)))))
+ (use-local-map (gud-new-keymap (current-local-map)))
+ (define-key (current-local-map) [menu-bar]
+ (gud-new-keymap (lookup-key (current-local-map) [menu-bar])))
+ (define-key (current-local-map) [menu-bar debug]
+ (cons "Gud" (gud-new-keymap gud-menu-map))))
\f
;;; Code for parsing expressions out of C code. The single entry point is
;;; find-c-expr, which tries to return an lvalue expression from around point.