]> code.delx.au - gnu-emacs/blobdiff - lisp/gud.el
(toplevel): Support faces on tty's.
[gnu-emacs] / lisp / gud.el
index 66cd552c7a8283a313f9048b5b1d3e7553db5651..c2e9994895494c38c6a04b62d34610ab7dbecb37 100644 (file)
@@ -110,6 +110,7 @@ optional doc string DOC.  Certain %-escapes in the string arguments
 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.
@@ -174,6 +175,8 @@ we're in the GUD buffer)."
 \f
 ;; ======================================================================
 ;; speedbar support functions and variables.
+(eval-when-compile (require 'speedbar))
+
 (defvar gud-last-speedbar-buffer nil
   "The last GUD buffer used.")
 
@@ -181,11 +184,29 @@ we're in the GUD buffer)."
   "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
@@ -310,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]
@@ -339,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)
@@ -487,15 +508,16 @@ available with older versions of GDB."
   (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
@@ -648,7 +670,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)
@@ -982,7 +1004,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
@@ -1131,7 +1153,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)
@@ -1162,14 +1184,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
@@ -1248,7 +1304,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)
@@ -1377,7 +1433,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)
@@ -1489,16 +1545,33 @@ 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)
 
+;; Association list of fully qualified class names (package + class name) and
+;; their source files.
+(defvar gud-jdb-class-source-alist nil)
+
+;; This is used to hold a source file during analysis.
+(defvar gud-jdb-analysis-buffer nil)
+
 ;; Return a list of java source files.  PATH gives the directories in
 ;; 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 ()
@@ -1546,11 +1619,10 @@ The file names should be absolute, or relative to the current directory.")
 ;; 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))
 
@@ -1695,18 +1767,11 @@ The file names should be absolute, or relative to the current directory.")
      (cons c file))
    (gud-jdb-analyze-source gud-jdb-analysis-buffer file)))
 
-;; Association list of fully qualified class names (package + class name) and
-;; their source files.
-(defvar gud-jdb-class-source-alist nil)
-
-;; This is used to hold a source file during analysis.
-(defvar gud-jdb-analysis-buffer nil)
-
 ;; Return an alist of fully qualified classes and the source files
 ;; 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
@@ -1745,7 +1810,7 @@ The file names should be absolute, or relative to the current directory.")
        (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
@@ -1855,18 +1920,18 @@ 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)
 
-  (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)
 
@@ -2021,6 +2086,10 @@ comint mode, which see."
        (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.
@@ -2051,7 +2120,7 @@ comint mode, which see."
                        (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.
@@ -2136,22 +2205,22 @@ It is saved for when this flag is not set.")
 
              ;; Let the comint filter do the actual insertion.
              ;; That lets us inherit various comint features.
-             (comint-output-filter proc output)))
-
-         ;; Put the arrow on the source line.
-         ;; This must be outside of the save-excursion
-         ;; in case the source file is our current buffer.
-         (if process-window
-             (save-selected-window
-               (select-window process-window)
-               (gud-display-frame))
-           ;; We have to be in the proper buffer, (process-buffer proc),
-           ;; but not in a save-excursion, because that would restore point.
-           (let ((old-buf (current-buffer)))
-             (set-buffer (process-buffer proc))
-             (unwind-protect
-                 (gud-display-frame)
-               (set-buffer old-buf))))
+             (comint-output-filter proc output))
+
+           ;; Put the arrow on the source line.
+           ;; This must be outside of the save-excursion
+           ;; in case the source file is our current buffer.
+           (if process-window
+               (save-selected-window
+                 (select-window process-window)
+                 (gud-display-frame))
+             ;; We have to be in the proper buffer, (process-buffer proc),
+             ;; but not in a save-excursion, because that would restore point.
+             (let ((old-buf (current-buffer)))
+               (set-buffer (process-buffer proc))
+               (unwind-protect
+                   (gud-display-frame)
+                 (set-buffer old-buf)))))
 
          ;; If we deferred text that arrived during this processing,
          ;; handle it now.
@@ -2254,6 +2323,11 @@ Obeying it means displaying in another window the specified file and line."
          (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)
@@ -2262,18 +2336,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)))
@@ -2335,12 +2408,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))))
 \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.