X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/7373939990e4cf8ec7911c37a60cd65f0da50e1e..e1483c383115cc874a07ce2353567125ec36941f:/lisp/gud.el diff --git a/lisp/gud.el b/lisp/gud.el index 2de603bc07..13a8a10111 100644 --- a/lisp/gud.el +++ b/lisp/gud.el @@ -4,7 +4,7 @@ ;; 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. @@ -331,7 +331,7 @@ off the specialized speedbar mode." (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] @@ -360,7 +360,7 @@ and source-file directory for your debugger." (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) @@ -411,11 +411,7 @@ This is implemented using the GDB `complete' command which isn't 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) @@ -670,7 +666,7 @@ and source-file directory for your debugger." (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) @@ -1004,7 +1000,7 @@ and source-file directory for your debugger." (car gud-dbx-history) "dbx ") nil nil - '(gud-dbx-history . 1)))) + 'gud-dbx-history))) (cond (gud-mips-p @@ -1153,7 +1149,7 @@ directories if your program contains sources from more than one directory." (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) @@ -1184,14 +1180,48 @@ directories if your program contains sources from more than one directory." ;;; 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 @@ -1270,7 +1300,7 @@ and source-file directory for your debugger." "-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) @@ -1399,7 +1429,7 @@ and source-file directory for your debugger." (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) @@ -1511,7 +1541,15 @@ and source-file directory for your debugger." ;; 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) @@ -1527,7 +1565,9 @@ The file names should be absolute, or relative to the current directory.") ;; 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 () @@ -1727,7 +1767,7 @@ The file names should be absolute, or relative to the current directory.") ;; 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 @@ -1876,7 +1916,7 @@ between it and it's value." (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) @@ -2141,23 +2181,26 @@ It is saved for when this flag is not set.") (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. @@ -2292,18 +2335,17 @@ Obeying it means displaying in another window the specified file and line." (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))) @@ -2343,10 +2385,12 @@ Obeying it means displaying in another window the specified file and line." ;; 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) @@ -2365,12 +2409,11 @@ Obeying it means displaying in another window the specified file and line." "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)))) ;;; 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.