]> code.delx.au - gnu-emacs/blobdiff - lisp/progmodes/gud.el
(which-function): Be robust in the face of an
[gnu-emacs] / lisp / progmodes / gud.el
index b4fdc682e6fa323784999111aa20517221f25de7..0988599ed54f9fda3acece979be37748099fc176 100644 (file)
@@ -4,7 +4,7 @@
 ;; Maintainer: FSF
 ;; Keywords: unix, tools
 
-;; Copyright (C) 1992,93,94,95,96,1998,2000,02,2003 Free Software Foundation, Inc.
+;; Copyright (C) 1992,93,94,95,96,1998,2000,02,03,04 Free Software Foundation, Inc.
 
 ;; This file is part of GNU Emacs.
 
@@ -91,45 +91,53 @@ If SOFT is non-nil, returns nil if the symbol doesn't already exist."
   "Non-nil if debuggee is running.
 Used to grey out relevant toolbar icons.")
 
+(defun gud-goto-info ()
+  "Go to relevant Emacs info node."
+  (interactive)
+  (select-frame (make-frame))
+  (require 'info)
+  (if (memq gud-minor-mode '(gdbmi gdba))
+      (Info-goto-node "(emacs)GDB Graphical Interface")
+    (Info-goto-node "(emacs)Debuggers")))
+
 (easy-mmode-defmap gud-menu-map
-  '(([refresh] "Refresh" . gud-refresh)
+  '(([help]     "Info" . gud-goto-info)
+    ([refresh] "Refresh" . gud-refresh)
     ([run]     menu-item "Run" gud-run
-                     :enable (and (not gud-running)
-                                 (memq gud-minor-mode '(gdba gdb dbx jdb))))
-    ([goto]    menu-item "Continue to selection" gud-until
-                     :enable (and (not gud-running)
-                                 (memq gud-minor-mode '(gdba gdb))))
+                  :enable (and (not gud-running)
+                              (memq gud-minor-mode '(gdbmi gdba gdb dbx jdb))))
+    ([until]   menu-item "Continue to selection" gud-until
+                  :enable (and (not gud-running)
+                              (memq gud-minor-mode '(gdbmi gdba gdb perldb))))
     ([remove]  menu-item "Remove Breakpoint" gud-remove
-                     :enable (not gud-running))
+                  :enable (not gud-running))
     ([tbreak]  menu-item "Temporary Breakpoint" gud-tbreak
-                    :enable (memq gud-minor-mode '(gdba gdb sdb xdb bashdb)))
+                 :enable (memq gud-minor-mode '(gdbmi gdba gdb sdb xdb bashdb)))
     ([break]   menu-item "Set Breakpoint" gud-break
-                     :enable (not gud-running))
+                  :enable (not gud-running))
     ([up]      menu-item "Up Stack" gud-up
-                    :enable (and (not gud-running)
-                                 (memq gud-minor-mode
-                                       '(gdba gdb dbx xdb jdb pdb bashdb))))
+                 :enable (and (not gud-running)
+                              (memq gud-minor-mode
+                                    '(gdbmi gdba gdb dbx xdb jdb pdb bashdb))))
     ([down]    menu-item "Down Stack" gud-down
-                    :enable (and (not gud-running)
-                                 (memq gud-minor-mode
-                                       '(gdba gdb dbx xdb jdb pdb bashdb))))
+                 :enable (and (not gud-running)
+                              (memq gud-minor-mode
+                                    '(gdbmi gdba gdb dbx xdb jdb pdb bashdb))))
     ([print]   menu-item "Print Expression" gud-print
                      :enable (not gud-running))
-    ([display] menu-item "Display Expression" gud-display
+    ([watch]   menu-item "Watch Expression" gud-watch
                     :enable (and (not gud-running)
-                                 (eq gud-minor-mode 'gdba)))
+                                 (memq gud-minor-mode '(gdbmi gdba))))
     ([finish]  menu-item "Finish Function" gud-finish
                     :enable (and (not gud-running)
                                  (memq gud-minor-mode
-                                       '(gdba gdb xdb jdb pdb bashdb))))
+                                       '(gdbmi gdba gdb xdb jdb pdb bashdb))))
     ([stepi]   menu-item "Step Instruction" gud-stepi
                      :enable (and (not gud-running)
-                                 (memq gud-minor-mode
-                                       '(gdba gdb dbx))))
+                                 (memq gud-minor-mode '(gdbmi gdba gdb dbx))))
     ([nexti]   menu-item "Next Instruction" gud-nexti
                      :enable (and (not gud-running)
-                                 (memq gud-minor-mode
-                                       '(gdba gdb dbx))))
+                                 (memq gud-minor-mode '(gdbmi gdba gdb dbx))))
     ([step]    menu-item "Step Line" gud-step
                      :enable (not gud-running))
     ([next]    menu-item "Next Line" gud-next
@@ -158,17 +166,21 @@ Used to grey out relevant toolbar icons.")
        (dolist (x '((gud-break . "gud-break")
                     (gud-remove . "gud-remove")
                     (gud-print . "gud-print")
-                    (gud-display . "gud-display")
+                    (gud-watch . "gud-watch")
                     (gud-run . "gud-run")
                     (gud-until . "gud-until")
                     (gud-cont . "gud-cont")
-                    (gud-step . "gud-step")
-                    (gud-next . "gud-next")
+                    ;; gud-s, gud-si etc. instead of gud-step,
+                    ;; gud-stepi, to avoid file-name clashes on DOS
+                    ;; 8+3 filesystems.
+                    (gud-step . "gud-s")
+                    (gud-next . "gud-n")
                     (gud-finish . "gud-finish")
-                    (gud-stepi . "gud-stepi")
-                    (gud-nexti . "gud-nexti")
+                    (gud-stepi . "gud-si")
+                    (gud-nexti . "gud-ni")
                     (gud-up . "gud-up")
-                    (gud-down . "gud-down"))
+                    (gud-down . "gud-down")
+                    (gud-goto-info . "info"))
                   map)
          (tool-bar-local-item-from-menu
           (car x) (cdr x) map gud-minor-mode-map)))))
@@ -302,11 +314,21 @@ t means that there is no stack, and we are in display-file mode.")
 
     (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)))
+    (define-key gud-speedbar-key-map "\C-m" 'speedbar-edit-line)
+    (define-key gud-speedbar-key-map "D" 'gdb-var-delete)))
+
 
 (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])
+  '(["Jump to stack frame" speedbar-edit-line 
+     (with-current-buffer gud-comint-buffer
+       (not (memq gud-minor-mode '(gdbmi gdba))))]
+    ["Edit value" speedbar-edit-line 
+     (with-current-buffer gud-comint-buffer
+       (not (memq gud-minor-mode '(gdbmi gdba))))]
+    ["Delete expression" gdb-var-delete 
+     (with-current-buffer gud-comint-buffer
+       (not (memq gud-minor-mode '(gdbmi gdba))))])
   "Additional menu items to add to the speedbar frame.")
 
 ;; Make sure our special speedbar mode is loaded
@@ -318,52 +340,85 @@ t means that there is no stack, and we are in display-file mode.")
   "Create a speedbar display based on the current state of GUD.
 If the GUD BUFFER is not running a supported debugger, then turn
 off the specialized speedbar mode."
-  (if (and (save-excursion (goto-char (point-min))
-                          (looking-at "Current Stack"))
-          (equal gud-last-last-frame gud-last-speedbar-stackframe))
-      nil
-    (setq gud-last-speedbar-buffer buffer)
-    (let* ((minor-mode (with-current-buffer buffer gud-minor-mode))
-          (frames
-           (cond ((memq minor-mode '(gdba gdb))
-                  (gud-gdb-get-stackframe buffer))
-                 ;; Add more debuggers here!
-                 (t
-                  (speedbar-remove-localized-speedbar-support buffer)
-                  nil))))
-      (erase-buffer)
-      (if (not frames)
-         (insert "No Stack frames\n")
-       (insert "Current Stack:\n"))
-      (while frames
-       (insert (nth 1 (car frames)) ":\n")
-       (if (= (length (car frames)) 2)
-           (progn
-;            (speedbar-insert-button "[?]"
+  (let ((minor-mode (with-current-buffer buffer gud-minor-mode)))
+    (cond
+     ((memq minor-mode '(gdbmi gdba))
+      (when (or gdb-var-changed
+               (not (save-excursion
+                      (goto-char (point-min))
+                      (let ((case-fold-search t))
+                        (looking-at "Watch Expressions:")))))
+       (erase-buffer)
+       (insert "Watch Expressions:\n")
+       (let ((var-list gdb-var-list))
+         (while var-list
+           (let* ((depth 0) (start 0) (char ?+)
+                  (var (car var-list)) (varnum (nth 1 var)))
+             (while (string-match "\\." varnum start)
+               (setq depth (1+ depth)
+                     start (1+ (match-beginning 0))))
+             (if (equal (nth 2 var) "0")
+                 (speedbar-make-tag-line 'bracket ?? nil nil
+                                         (concat (car var) "\t" (nth 4 var))
+                                         'gdb-edit-value
+                                         nil
+                                         (if (and (nth 5 var)
+                                                  gdb-show-changed-values)
+                                             'font-lock-warning-face
+                                           nil) depth)
+               (if (and (cadr var-list)
+                        (string-match varnum (cadr (cadr var-list))))
+                   (setq char ?-))
+               (speedbar-make-tag-line 'bracket char
+                                       'gdb-speedbar-expand-node varnum
+                                       (concat (car var) "\t" (nth 3 var))
+                                       nil nil nil depth)))
+           (setq var-list (cdr var-list))))
+       (setq gdb-var-changed nil)))
+     (t (if (and (save-excursion
+                  (goto-char (point-min))
+                  (looking-at "Current Stack"))
+                (equal gud-last-last-frame gud-last-speedbar-stackframe))
+           nil
+         (setq gud-last-speedbar-buffer buffer)
+         (let ((gud-frame-list
+                (cond ((eq minor-mode 'gdb)
+                       (gud-gdb-get-stackframe buffer))
+                      ;; Add more debuggers here!
+                      (t (speedbar-remove-localized-speedbar-support buffer)
+                         nil))))
+           (erase-buffer)
+           (if (not gud-frame-list)
+               (insert "No Stack frames\n")
+             (insert "Current Stack:\n"))
+           (dolist (frame gud-frame-list)
+             (insert (nth 1 frame) ":\n")
+             (if (= (length frame) 2)
+                 (progn
+;                  (speedbar-insert-button "[?]"
+;                                          'speedbar-button-face
+;                                          nil nil nil t)
+                   (speedbar-insert-button (car frame)
+                                            'speedbar-directory-face
+                                            nil nil nil t))
+;            (speedbar-insert-button "[+]"
 ;                                    'speedbar-button-face
-;                                    nil nil nil t)
-             (speedbar-insert-button (car (car frames))
-                                     'speedbar-directory-face
-                                     nil nil nil t))
-;        (speedbar-insert-button "[+]"
-;                                'speedbar-button-face
-;                                'speedbar-highlight-face
-;                                'gud-gdb-get-scope-data
-;                                (car frames) t)
-         (speedbar-insert-button (car (car frames))
-                                 'speedbar-file-face
-                                 'speedbar-highlight-face
-                                 (cond ((memq minor-mode '(gdba gdb))
-                                        'gud-gdb-goto-stackframe)
-                                       (t (error "Should never be here")))
-                                 (car frames) t))
-       (setq frames (cdr frames)))
-;      (let ((selected-frame
-;           (cond ((eq ff 'gud-gdb-find-file)
-;                  (gud-gdb-selected-frame-info buffer))
-;                 (t (error "Should never be here"))))))
-      )
-    (setq gud-last-speedbar-stackframe gud-last-last-frame)))
+;                                    'speedbar-highlight-face
+;                                    'gud-gdb-get-scope-data
+;                                    frame t)
+             (speedbar-insert-button (car frame)
+                                     'speedbar-file-face
+                                     'speedbar-highlight-face
+                                     (cond ((memq minor-mode '(gdbmi gdba gdb))
+                                            'gud-gdb-goto-stackframe)
+                                           (t (error "Should never be here")))
+                                       frame t)))
+;            (let ((selected-frame
+;                 (cond ((eq ff 'gud-gdb-find-file)
+;                        (gud-gdb-selected-frame-info buffer))
+;                       (t (error "Should never be here"))))))
+           )
+         (setq gud-last-speedbar-stackframe gud-last-last-frame))))))
 
 \f
 ;; ======================================================================
@@ -372,7 +427,7 @@ off the specialized speedbar mode."
 ;; History of argument lists passed to gdb.
 (defvar gud-gdb-history nil)
 
-(defcustom gud-gdb-command-name "gdb --fullname"
+(defcustom gud-gdb-command-name "gdb --annotate=3"
   "Default command to execute an executable under the GDB debugger."
    :type 'string
    :group 'gud)
@@ -413,12 +468,28 @@ off the specialized speedbar mode."
        ;; Set the accumulator to the remaining text.
        gud-marker-acc (substring gud-marker-acc (match-end 0))))
 
+    ;; Check for annotations and change gud-minor-mode to 'gdba if
+    ;; they are found.
+    (while (string-match "\n\032\032\\(.*\\)\n" gud-marker-acc)
+      (when (string-equal (match-string 1 gud-marker-acc) "prompt")
+       (require 'gdb-ui)
+       (gdb-prompt nil))
+
+      (setq
+       ;; Append any text before the marker to the output we're going
+       ;; to return - we don't include the marker in this text.
+       output (concat output
+                     (substring gud-marker-acc 0 (match-beginning 0)))
+
+       ;; Set the accumulator to the remaining text.
+       gud-marker-acc (substring gud-marker-acc (match-end 0))))
+
     ;; Does the remaining text look like it might end with the
     ;; beginning of another marker?  If it does, then keep it in
     ;; gud-marker-acc until we receive the rest of it. Since we
     ;; know the full marker regexp above failed, it's pretty simple to
     ;; test for marker starts.
-    (if (string-match "\032.*\\'" gud-marker-acc)
+    (if (string-match "\n\\(\032.*\\)?\\'" gud-marker-acc)
        (progn
          ;; Everything before the potential marker start can be output.
          (setq output (concat output (substring gud-marker-acc
@@ -458,6 +529,8 @@ off the specialized speedbar mode."
      gud-minibuffer-local-map nil
      hist-sym)))
 
+(defvar gdb-first-prompt t)
+
 ;;;###autoload
 (defun gdb (command-line)
   "Run gdb on program FILE in buffer *gud-FILE*.
@@ -488,8 +561,8 @@ and source-file directory for your debugger."
   (local-set-key "\C-i" 'gud-gdb-complete-command)
   (setq comint-prompt-regexp "^(.*gdb[+]?) *")
   (setq paragraph-start comint-prompt-regexp)
-  (run-hooks 'gdb-mode-hook)
-  )
+  (setq gdb-first-prompt t)
+  (run-hooks 'gdb-mode-hook))
 
 ;; One of the nice features of GDB is its impressive support for
 ;; context-sensitive command completion.  We preserve that feature
@@ -1254,14 +1327,16 @@ and source-file directory for your debugger."
   (set (make-local-variable 'gud-minor-mode) 'perldb)
 
   (gud-def gud-break  "b %l"         "\C-b" "Set breakpoint at current line.")
-  (gud-def gud-remove "d %l"         "\C-d" "Remove breakpoint at current line")
+  (gud-def gud-remove "B %l"         "\C-d" "Remove breakpoint at current line")
   (gud-def gud-step   "s"            "\C-s" "Step one source line with display.")
   (gud-def gud-next   "n"            "\C-n" "Step one line (skip functions).")
   (gud-def gud-cont   "c"            "\C-r" "Continue with display.")
 ;  (gud-def gud-finish "finish"       "\C-f" "Finish executing current function.")
 ;  (gud-def gud-up     "up %p"        "<" "Up N stack frames (numeric arg).")
 ;  (gud-def gud-down   "down %p"      ">" "Down N stack frames (numeric arg).")
-  (gud-def gud-print  "%e"           "\C-p" "Evaluate perl expression at point.")
+  (gud-def gud-print  "p %e"          "\C-p" "Evaluate perl expression at point.")
+  (gud-def gud-until  "c %l"          "\C-u" "Continue to current line.")
+
 
   (setq comint-prompt-regexp "^  DB<+[0-9]+>+ ")
   (setq paragraph-start comint-prompt-regexp)
@@ -1338,7 +1413,7 @@ and source-file directory for your debugger."
 
     output))
 
-(defcustom gud-pdb-command-name "pdb"
+(defcustom gud-pdb-command-name "pydb"
   "File name for executing the Python debugger.
 This should be an executable on your path, or an absolute file name."
   :type 'string
@@ -1913,14 +1988,14 @@ nil)
         ;; FIXME: Java ID's are UNICODE strings, this matches ASCII
         ;; ID's only.
          ;;
-         ;; The "," in the last square-bracket is necessary because of
-         ;; Sun's total disrespect for backwards compatibility in
+         ;; The ".," in the last square-bracket are necessary because
+         ;; of Sun's total disrespect for backwards compatibility in
          ;; reported line numbers from jdb - starting in 1.4.0 they
-         ;; introduced a comma at the thousands position (how
-         ;; ingenious!)
+         ;; print line numbers using LOCALE, inserting a comma or a
+         ;; period at the thousands positions (how ingenious!).
 
         "\\(\[[0-9]+\] \\)*\\([a-zA-Z0-9.$_]+\\)\\.[a-zA-Z0-9$_<>(),]+ \
-\\(([a-zA-Z0-9.$_]+:\\|line=\\)\\([0-9,]+\\)"
+\\(([a-zA-Z0-9.$_]+:\\|line=\\)\\([0-9.,]+\\)"
         gud-marker-acc)
 
       ;; A good marker is one that:
@@ -1947,7 +2022,7 @@ nil)
                          (string-to-int
                           (let
                                ((numstr (match-string 4 gud-marker-acc)))
-                             (if (string-match "," numstr)
+                             (if (string-match "[.,]" numstr)
                                  (replace-match "" nil nil numstr)
                                numstr)))))
            (message "Could not find source file.")))
@@ -2276,7 +2351,8 @@ comint mode, which see."
   ;; Don't put repeated commands in command history many times.
   (set (make-local-variable 'comint-input-ignoredups) t)
   (make-local-variable 'paragraph-start)
-  (set (make-local-variable 'gud-delete-prompt-marker) (make-marker)))
+  (set (make-local-variable 'gud-delete-prompt-marker) (make-marker))
+  (add-hook 'kill-buffer-hook 'gud-kill-buffer-hook nil t))
 
 ;; Cause our buffers to be displayed, by default,
 ;; in the selected window.
@@ -2321,8 +2397,11 @@ comint mode, which see."
                    (if (file-name-directory file-subst)
                        (expand-file-name file-subst)
                      file-subst)))
-        (filepart (and file-word (concat "-" (file-name-nondirectory file)))))
+        (filepart (and file-word (concat "-" (file-name-nondirectory file))))
+        (existing-buffer (get-buffer (concat "*gud" filepart "*"))))
     (pop-to-buffer (concat "*gud" filepart "*"))
+    (when (and existing-buffer (get-buffer-process existing-buffer))
+      (error "This program is already running under gdb"))
     ;; Set the dir, in case the buffer already existed with a different dir.
     (setq default-directory dir)
     ;; Set default-directory to the file's directory.
@@ -2444,14 +2523,14 @@ It is saved for when this flag is not set.")
         ;; Stop displaying an arrow in a source file.
         (setq overlay-arrow-position nil)
         (set-process-buffer proc nil)
-        (if (eq gud-minor-mode-type 'gdba)
+        (if (memq gud-minor-mode-type '(gdbmi gdba))
             (gdb-reset)
           (gud-reset)))
        ((memq (process-status proc) '(signal exit))
         ;; Stop displaying an arrow in a source file.
         (setq overlay-arrow-position nil)
         (with-current-buffer gud-comint-buffer
-          (if (eq gud-minor-mode 'gdba)
+          (if (memq gud-minor-mode-type '(gdbmi gdba))
               (gdb-reset)
             (gud-reset)))
         (let* ((obuf (current-buffer)))
@@ -2480,19 +2559,18 @@ It is saved for when this flag is not set.")
             (set-buffer obuf))))))
 
 (defun gud-kill-buffer-hook ()
-  (if gud-minor-mode
-      (setq gud-minor-mode-type gud-minor-mode)))
-
-(add-hook 'kill-buffer-hook 'gud-kill-buffer-hook)
+  (setq gud-minor-mode-type gud-minor-mode)
+  (condition-case nil
+      (kill-process (get-buffer-process gud-comint-buffer))
+    (error nil)))
 
 (defun gud-reset ()
   (dolist (buffer (buffer-list))
-    (if (not (eq buffer gud-comint-buffer))
-       (save-excursion
-         (set-buffer buffer)
-         (when gud-minor-mode
-           (setq gud-minor-mode nil)
-           (kill-local-variable 'tool-bar-map))))))
+    (unless (eq buffer gud-comint-buffer)
+      (with-current-buffer buffer
+       (when gud-minor-mode
+         (setq gud-minor-mode nil)
+         (kill-local-variable 'tool-bar-map))))))
 
 (defun gud-display-frame ()
   "Find and obey the last filename-and-line marker from the debugger.
@@ -2517,9 +2595,7 @@ Obeying it means displaying in another window the specified file and line."
          (with-current-buffer gud-comint-buffer
            (gud-find-file true-file)))
         (window (and buffer (or (get-buffer-window buffer)
-                                (if (eq gud-minor-mode 'gdba)
-                                    (gdb-display-source-buffer buffer)
-                                  (display-buffer buffer)))))
+                                  (display-buffer buffer))))
         (pos))
     (if buffer
        (progn
@@ -2641,7 +2717,7 @@ Obeying it means displaying in another window the specified file and line."
        (forward-line 0)
        (if (looking-at comint-prompt-regexp)
            (set-marker gud-delete-prompt-marker (point)))
-       (if (eq gud-minor-mode 'gdba)
+       (if (memq gud-minor-mode '(gdbmi gdba))
            (apply comint-input-sender (list proc command))
          (process-send-string proc (concat command "\n")))))))
 
@@ -2957,6 +3033,27 @@ class of the file (using s to separate nested class ids)."
          (save-excursion (indent-line-to indent))
        (indent-line-to indent)))))
 
+;; Derived from cfengine.el.
+(defun gdb-script-beginning-of-defun ()
+  "`beginning-of-defun' function for Gdb script mode.
+Treats actions as defuns."
+  (unless (<= (current-column) (current-indentation))
+    (end-of-line))
+  (if (re-search-backward "^define \\|^document " nil t)
+      (beginning-of-line)
+    (goto-char (point-min)))
+  t)
+
+;; Derived from cfengine.el.
+(defun gdb-script-end-of-defun ()
+  "`end-of-defun' function for Gdb script mode.
+Treats actions as defuns."
+  (end-of-line)
+  (if (re-search-forward "^end" nil t)
+      (beginning-of-line)
+    (goto-char (point-max)))
+  t)
+
 ;;;###autoload
 (add-to-list 'auto-mode-alist '("/\\.gdbinit" . gdb-script-mode))
 
@@ -2969,6 +3066,10 @@ class of the file (using s to separate nested class ids)."
   (set (make-local-variable 'imenu-generic-expression)
        '((nil "^define[ \t]+\\(\\w+\\)" 1)))
   (set (make-local-variable 'indent-line-function) 'gdb-script-indent-line)
+  (set (make-local-variable 'beginning-of-defun-function)
+       #'gdb-script-beginning-of-defun)
+  (set (make-local-variable 'end-of-defun-function)
+       #'gdb-script-end-of-defun)
   (set (make-local-variable 'font-lock-defaults)
        '(gdb-script-font-lock-keywords nil nil ((?_ . "w")) nil
         (font-lock-syntactic-keywords