]> code.delx.au - gnu-emacs/blobdiff - lisp/progmodes/gud.el
(gdb-force-update): Delete defvar
[gnu-emacs] / lisp / progmodes / gud.el
index 3e13d7d1c0b3e11d7ccaed983f10e17166c93e27..5be88668353af4b6447e639acd6f4ae10dca34eb 100644 (file)
@@ -5,7 +5,7 @@
 ;; Keywords: unix, tools
 
 ;; Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 2000, 2001, 2002, 2003,
-;;  2004, 2005 Free Software Foundation, Inc.
+;;  2004, 2005, 2006 Free Software Foundation, Inc.
 
 ;; This file is part of GNU Emacs.
 
 (eval-when-compile (require 'cl)) ; for case macro
 
 (require 'comint)
-(require 'font-lock)
 
 (defvar gdb-active-process)
 (defvar gdb-define-alist)
 (defvar gdb-macro-info)
 (defvar gdb-server-prefix)
 (defvar gdb-show-changed-values)
-(defvar gdb-var-changed)
 (defvar gdb-var-list)
 (defvar gdb-speedbar-auto-raise)
 (defvar tool-bar-map)
@@ -84,6 +82,8 @@ Supported debuggers include gdb, sdb, dbx, xdb, perldb, pdb (Python), jdb, and b
 (defvar gud-minor-mode nil)
 (put 'gud-minor-mode 'permanent-local t)
 
+(defvar gud-comint-buffer nil)
+
 (defvar gud-keep-buffer nil)
 
 (defun gud-symbol (sym &optional soft minor-mode)
@@ -175,7 +175,7 @@ Used to grey out relevant togolbar icons.")
                  :enable (and (not gud-running)
                               (memq gud-minor-mode
                                     '(gdbmi gdba gdb dbx xdb jdb pdb bashdb))))
-    ([pp]      menu-item "Print the emacs s-expression" gud-pp
+    ([pp]      menu-item "Print S-expression" gud-pp
                   :enable (and (not gud-running)
                                  gdb-active-process)
                  :visible (and (string-equal
@@ -189,6 +189,9 @@ Used to grey out relevant togolbar icons.")
                   :enable (not gud-running))
     ([watch]   menu-item "Watch Expression" gud-watch
                  :enable (and (not gud-running)
+                              (memq gud-minor-mode '(gdbmi gdba))))
+    ([finish]  menu-item "Finish Function" gud-finish
+                  :enable (and (not gud-running)
                               (memq gud-minor-mode
                                     '(gdbmi gdba gdb xdb jdb pdb bashdb))))
     ([stepi]   menu-item "Step Instruction" gud-stepi
@@ -232,9 +235,6 @@ Used to grey out relevant togolbar icons.")
                     (gud-run . "gud/run")
                     (gud-go . "gud/go")
                     (gud-stop-subjob . "gud/stop")
-                    ;; gud-s, gud-si etc. instead of gud-step,
-                    ;; gud-stepi, to avoid file-name clashes on DOS
-                    ;; 8+3 filesystems.
                     (gud-cont . "gud/cont")
                     (gud-until . "gud/until")
                     (gud-next . "gud/next")
@@ -302,13 +302,15 @@ Uses `gud-<MINOR-MODE>-directories' to find the source files."
 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.
-  %a    text of the hexadecimal address surrounding point
-  %p    prefix argument to the command (if any) as a number
+  %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.
+  %a -- Text of the hexadecimal address surrounding point.
+  %p -- Prefix argument to the command (if any) as a number.
+  %c -- Fully qualified class name derived from the expression
+        surrounding point (jdb only).
 
   The `current' source file is the file of the current buffer (if
 we're in a C file) or the source file current at the last break or
@@ -375,8 +377,9 @@ t means that there is no stack, and we are in display-file mode.")
 (defun gud-speedbar-item-info ()
   "Display the data type of the watch expression element."
   (let ((var (nth (- (line-number-at-pos (point)) 2) gdb-var-list)))
-    (if (nth 4 var)
-       (speedbar-message "%s" (nth 3 var)))))
+    (if (nth 6 var)
+       (speedbar-message "%s: %s" (nth 6 var) (nth 3 var))
+      (speedbar-message "%s" (nth 3 var)))))
 
 (defun gud-install-speedbar-variables ()
   "Install those variables used by speedbar to enhance gud/gdb."
@@ -397,25 +400,25 @@ t means that there is no stack, and we are in display-file mode.")
                                 gud-speedbar-key-map
                                 gud-expansion-speedbar-buttons))
 
-  (add-to-list 
+  (add-to-list
    'speedbar-mode-functions-list
    '("GUD" (speedbar-item-info . gud-speedbar-item-info)
      (speedbar-line-directory . ignore))))
 
 (defvar gud-speedbar-menu-items
   '(["Jump to stack frame" speedbar-edit-line
-     :visible (with-current-buffer gud-comint-buffer
-               (not (memq gud-minor-mode '(gdbmi gdba))))]
+     :visible (not (memq (buffer-local-value 'gud-minor-mode gud-comint-buffer)
+                   '(gdbmi gdba)))]
     ["Edit value" speedbar-edit-line
-     :visible (with-current-buffer gud-comint-buffer
-               (memq gud-minor-mode '(gdbmi gdba)))]
+     :visible (memq (buffer-local-value 'gud-minor-mode gud-comint-buffer)
+                   '(gdbmi gdba))]
     ["Delete expression" gdb-var-delete
-     (with-current-buffer gud-comint-buffer
-       (memq gud-minor-mode '(gdbmi gdba)))]
+     :visible (memq (buffer-local-value 'gud-minor-mode gud-comint-buffer)
+                   '(gdbmi gdba))]
     ["Auto raise frame" gdb-speedbar-auto-raise
      :style toggle :selected gdb-speedbar-auto-raise
-     :visible (with-current-buffer gud-comint-buffer
-       (memq gud-minor-mode '(gdbmi gdba)))])
+     :visible (memq (buffer-local-value 'gud-minor-mode gud-comint-buffer)
+                   '(gdbmi gdba))])
   "Additional menu items to add to the speedbar frame.")
 
 ;; Make sure our special speedbar mode is loaded
@@ -433,67 +436,83 @@ ZERO are not used, but are required by the caller."
 If the GUD BUFFER is not running a supported debugger, then turn
 off the specialized speedbar mode.  BUFFER is not used, but are
 required by the caller."
-  (when (and (boundp 'gud-comint-buffer)
-            gud-comint-buffer
+  (when (and gud-comint-buffer
             ;; gud-comint-buffer might be killed
             (buffer-name gud-comint-buffer))
     (let* ((minor-mode (with-current-buffer buffer gud-minor-mode))
          (window (get-buffer-window (current-buffer) 0))
+         (start (window-start window))
          (p (window-point window)))
       (cond
        ((memq minor-mode '(gdbmi gdba))
-       (when (or gdb-var-changed
-                 (not (save-excursion
+       (erase-buffer)
+       (insert "Watch Expressions:\n")
+       (if gdb-speedbar-auto-raise
+           (raise-frame speedbar-frame))
+       (let ((var-list gdb-var-list) parent)
+         (while var-list
+           (let* (char (depth 0) (start 0) (var (car var-list))
+                       (varnum (car var)) (expr (nth 1 var))
+                       (type (nth 3 var)) (value (nth 4 var))
+                       (status (nth 5 var)))
+             (put-text-property
+              0 (length expr) 'face font-lock-variable-name-face expr)
+             (put-text-property
+              0 (length type) 'face font-lock-type-face type)
+             (while (string-match "\\." varnum start)
+               (setq depth (1+ depth)
+                     start (1+ (match-beginning 0))))
+             (if (eq depth 0) (setq parent nil))
+             (if (or (equal (nth 2 var) "0")
+                     (and (equal (nth 2 var) "1")
+                          (string-match "char \\*$" type)))
+                 (speedbar-make-tag-line
+                  'bracket ?? nil nil
+                  (concat expr "\t" value)
+                  (if (or parent (eq status 'out-of-scope))
+                      nil 'gdb-edit-value)
+                  nil
+                  (if gdb-show-changed-values
+                      (or parent (case status
+                                   (changed 'font-lock-warning-face)
+                                   (out-of-scope 'shadow)
+                                   (t t)))
+                    t)
+                  depth)
+               (if (eq status 'out-of-scope) (setq parent 'shadow))
+               (if (and (nth 1 var-list)
+                        (string-match (concat varnum "\\.")
+                                      (car (nth 1 var-list))))
+                   (setq char ?-)
+                 (setq char ?+))
+               (if (string-match "\\*$" type)
+                   (speedbar-make-tag-line
+                    'bracket char
+                    'gdb-speedbar-expand-node varnum
+                    (concat expr "\t" type "\t" value)
+                    (if (or parent (eq status 'out-of-scope))
+                        nil 'gdb-edit-value)
+                    nil
+                    (if gdb-show-changed-values
+                        (or parent (case status
+                                     (changed 'font-lock-warning-face)
+                                     (out-of-scope 'shadow)
+                                     (t t)))
+                      t)
+                    depth)
+                 (speedbar-make-tag-line
+                  'bracket char
+                  'gdb-speedbar-expand-node varnum
+                  (concat expr "\t" type)
+                  nil nil
+                  (if (and (or parent status) gdb-show-changed-values)
+                      'shadow t)
+                  depth))))
+           (setq var-list (cdr var-list)))))
+       (t (unless (and (save-excursion
                         (goto-char (point-min))
-                        (let ((case-fold-search t))
-                          (looking-at "Watch Expressions:")))))
-         (erase-buffer)
-         (insert "Watch Expressions:\n")
-         (if gdb-speedbar-auto-raise
-             (raise-frame speedbar-frame))
-         (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 (or (equal (nth 2 var) "0")
-                       (and (equal (nth 2 var) "1")
-                            (string-match "char \\*$" (nth 3 var))))
-                   (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 ?-))
-                 (if (string-match "\\*$" (nth 3 var))
-                     (speedbar-make-tag-line 'bracket char
-                                             'gdb-speedbar-expand-node varnum
-                                             (concat (car var) "\t"
-                                                     (nth 3 var)"\t"
-                                                     (nth 4 var))
-                                             'gdb-edit-value nil
-                                             (if (and (nth 5 var)
-                                                      gdb-show-changed-values)
-                                                 'font-lock-warning-face
-                                               nil) depth)
-                 (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
+                        (looking-at "Current Stack:"))
+                      (equal gud-last-last-frame gud-last-speedbar-stackframe))
            (let ((gud-frame-list
            (cond ((eq minor-mode 'gdb)
                   (gud-gdb-get-stackframe buffer))
@@ -520,6 +539,7 @@ required by the caller."
                       (t (error "Should never be here")))
                 frame t))))
            (setq gud-last-speedbar-stackframe gud-last-last-frame))))
+      (set-window-start window start)
       (set-window-point window p))))
 
 \f
@@ -574,6 +594,11 @@ required by the caller."
     ;; they are found.
     (while (string-match "\n\032\032\\(.*\\)\n" gud-marker-acc)
       (let ((match (match-string 1 gud-marker-acc)))
+
+       ;; Pick up stopped annotation if attaching to process.
+       (if (string-equal match "stopped") (setq gdb-active-process t))
+
+       ;; Using annotations, switch to gud-gdba-marker-filter.
        (when (string-equal match "prompt")
          (require 'gdb-ui)
          (gdb-prompt nil))
@@ -587,6 +612,8 @@ required by the caller."
         ;; Set the accumulator to the remaining text.
 
         gud-marker-acc (substring gud-marker-acc (match-end 0)))
+
+       ;; Pick up any errors that occur before first prompt annotation.
        (if (string-equal match "error-begin")
            (put-text-property 0 (length gud-marker-acc)
                               'face font-lock-warning-face
@@ -645,10 +672,21 @@ required by the caller."
 ;;;###autoload
 (defun gdb (command-line)
   "Run gdb on program FILE in buffer *gud-FILE*.
-The directory containing FILE becomes the initial working directory
-and source-file directory for your debugger."
+The directory containing FILE becomes the initial working
+directory and source-file directory for your debugger.  By
+default this command starts GDB using a graphical interface.  See
+`gdba' for more information.
+
+To run GDB in text command mode, set `gud-gdb-command-name' to
+\"gdb --fullname\" and include the pathname, if necessary."
   (interactive (list (gud-query-cmdline 'gdb)))
 
+  (if (and gud-comint-buffer
+          (buffer-name gud-comint-buffer)
+          (get-buffer-process gud-comint-buffer)
+          (with-current-buffer gud-comint-buffer (eq gud-minor-mode 'gdba)))
+      (error "Multiple debugging is only supported with \"gdb --fullname\""))
+
   (gud-common-init command-line nil 'gud-gdb-marker-filter)
   (set (make-local-variable 'gud-minor-mode) 'gdb)
 
@@ -701,16 +739,18 @@ and source-file directory for your debugger."
 ;; The completion list is constructed by the process filter.
 (defvar gud-gdb-fetched-lines)
 
-(defvar gud-comint-buffer nil)
-
-(defun gud-gdb-complete-command ()
+(defun gud-gdb-complete-command (&optional command a b)
   "Perform completion on the GDB command preceding point.
 This is implemented using the GDB `complete' command which isn't
 available with older versions of GDB."
   (interactive)
-  (let* ((end (point))
-        (command (buffer-substring (comint-line-beginning-position) end))
-        (command-word
+  (if command
+      ;; Used by gud-watch in mini-buffer.
+      (setq command (concat "p " command))
+    ;; Used in GUD buffer.
+    (let ((end (point)))
+      (setq command (buffer-substring (comint-line-beginning-position) end))))
+  (let* ((command-word
          ;; Find the word break.  This match will always succeed.
          (and (string-match "\\(\\`\\| \\)\\([^ ]*\\)\\'" command)
               (substring command (match-beginning 2))))
@@ -829,13 +869,14 @@ It is passed through FILTER before we look at it."
 
 (defun gud-gdb-run-command-fetch-lines (command buffer &optional skip)
   "Run COMMAND, and return the list of lines it outputs.
-BUFFER is the GUD buffer in which to run the command.
+BUFFER is the current buffer which may be the GUD buffer in which to run.
 SKIP is the number of chars to skip on each lines, it defaults to 0."
-  (with-current-buffer buffer
-    (if (save-excursion
-         (goto-char (point-max))
-         (forward-line 0)
-         (not (looking-at comint-prompt-regexp)))
+  (with-current-buffer gud-comint-buffer
+    (if (and (eq gud-comint-buffer buffer)
+            (save-excursion
+              (goto-char (point-max))
+              (forward-line 0)
+              (not (looking-at comint-prompt-regexp))))
        nil
       ;; Much of this copied from GDB complete, but I'm grabbing the stack
       ;; frame instead.
@@ -844,12 +885,13 @@ SKIP is the number of chars to skip on each lines, it defaults to 0."
            (gud-gdb-fetch-lines-string nil)
            (gud-gdb-fetch-lines-break (or skip 0))
            (gud-marker-filter
-            `(lambda (string) (gud-gdb-fetch-lines-filter string ',gud-marker-filter))))
+            `(lambda (string)
+               (gud-gdb-fetch-lines-filter string ',gud-marker-filter))))
        ;; Issue the command to GDB.
        (gud-basic-call command)
        ;; Slurp the output.
        (while gud-gdb-fetch-lines-in-progress
-         (accept-process-output (get-buffer-process buffer)))
+         (accept-process-output (get-buffer-process gud-comint-buffer)))
        (nreverse gud-gdb-fetched-lines)))))
 
 \f
@@ -2116,7 +2158,7 @@ nil)
          ;; 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$_<>(),]+ \
+        "\\(\\[[0-9]+] \\)*\\([a-zA-Z0-9.$_]+\\)\\.[a-zA-Z0-9$_<>(),]+ \
 \\(([a-zA-Z0-9.$_]+:\\|line=\\)\\([0-9.,]+\\)"
         gud-marker-acc)
 
@@ -2717,7 +2759,9 @@ 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)
-                                  (display-buffer buffer))))
+                                (if (memq gud-minor-mode '(gdbmi gdba))
+                                    (gdb-display-source-buffer buffer))
+                                (display-buffer buffer))))
         (pos))
     (if buffer
        (progn
@@ -2734,7 +2778,15 @@ Obeying it means displaying in another window the specified file and line."
              (setq pos (point))
              (or gud-overlay-arrow-position
                  (setq gud-overlay-arrow-position (make-marker)))
-             (set-marker gud-overlay-arrow-position (point) (current-buffer)))
+             (set-marker gud-overlay-arrow-position (point) (current-buffer))
+             ;; If they turned on hl-line, move the hl-line highlight to
+             ;; the arrow's line.
+             (when (featurep 'hl-line)
+               (cond
+                (global-hl-line-mode
+                 (global-hl-line-highlight))
+                ((and hl-line-mode hl-line-sticky-flag)
+                 (hl-line-highlight)))))
            (cond ((or (< pos (point-min)) (> pos (point-max)))
                   (widen)
                   (goto-char pos))))
@@ -2749,7 +2801,9 @@ Obeying it means displaying in another window the specified file and line."
   (let ((insource (not (eq (current-buffer) gud-comint-buffer)))
        (frame (or gud-last-frame gud-last-last-frame))
        result)
-    (while (and str (string-match "\\([^%]*\\)%\\([adeflpc]\\)" str))
+    (while (and str
+               (let ((case-fold-search nil))
+                 (string-match "\\([^%]*\\)%\\([adefFlpc]\\)" str)))
       (let ((key (string-to-char (match-string 2 str)))
            subst)
        (cond
@@ -2834,8 +2888,11 @@ Obeying it means displaying in another window the specified file and line."
       (set-buffer gud-comint-buffer)
       (save-restriction
        (widen)
-       (goto-char (process-mark proc))
-       (forward-line 0)
+       (if (marker-position gud-delete-prompt-marker)
+           ;; We get here when printing an expression.
+           (goto-char gud-delete-prompt-marker)
+         (goto-char (process-mark proc))
+         (forward-line 0))
        (if (looking-at comint-prompt-regexp)
            (set-marker gud-delete-prompt-marker (point)))
        (if (memq gud-minor-mode '(gdbmi gdba))
@@ -2856,7 +2913,21 @@ Obeying it means displaying in another window the specified file and line."
 (defvar gud-find-expr-function 'gud-find-c-expr)
 
 (defun gud-find-expr (&rest args)
-  (apply gud-find-expr-function args))
+  (let ((expr (if (and transient-mark-mode mark-active)
+                 (buffer-substring (region-beginning) (region-end))
+               (apply gud-find-expr-function args))))
+    (save-match-data
+      (if (string-match "\n" expr)
+         (error "Expression must not include a newline"))
+      (with-current-buffer gud-comint-buffer
+       (save-excursion
+         (goto-char (process-mark (get-buffer-process gud-comint-buffer)))
+         (forward-line 0)
+         (when (looking-at comint-prompt-regexp)
+           (set-marker gud-delete-prompt-marker (point))
+           (set-marker-insertion-type gud-delete-prompt-marker t))
+         (insert (concat  expr " = ")))))
+    expr))
 
 ;; The next eight functions are hacked from gdbsrc.el by
 ;; Debby Ayers <ayers@asc.slb.com>,
@@ -3095,7 +3166,7 @@ class of the file (using s to separate nested class ids)."
 (defvar gdb-script-font-lock-keywords
   '(("^define\\s-+\\(\\(\\w\\|\\s_\\)+\\)" (1 font-lock-function-name-face))
     ("\\$\\(\\w+\\)" (1 font-lock-variable-name-face))
-    ("^\\s-*\\([a-z]+\\)" (1 font-lock-keyword-face))))
+    ("^\\s-*\\(\\(\\w\\|\\s_\\)+\\)" (1 font-lock-keyword-face))))
 
 ;; FIXME: The keyword "end" associated with "document"
 ;; should have font-lock-keyword-face (currently font-lock-doc-face).
@@ -3114,7 +3185,7 @@ class of the file (using s to separate nested class ids)."
 
 (defun gdb-script-skip-to-head ()
   "We're just in front of an `end' and we need to go to its head."
-  (while (and (re-search-backward "^\\s-*\\(\\(end\\)\\|define\\|document\\|if\\|while\\)\\>" nil 'move)
+  (while (and (re-search-backward "^\\s-*\\(\\(end\\)\\|define\\|document\\|if\\|while\\|commands\\)\\>" nil 'move)
              (match-end 2))
     (gdb-script-skip-to-head)))
 
@@ -3133,7 +3204,7 @@ class of the file (using s to separate nested class ids)."
     (forward-line 0)
     (skip-chars-forward " \t")
     (+ (current-indentation)
-       (if (looking-at "\\(if\\|while\\|define\\|else\\)\\>")
+       (if (looking-at "\\(if\\|while\\|define\\|else\\|commands\\)\\>")
           gdb-script-basic-indent 0)))))
 
 (defun gdb-script-indent-line ()
@@ -3205,10 +3276,47 @@ Treats actions as defuns."
 ;;; tooltips for GUD
 
 ;;; Customizable settings
+
+(define-minor-mode gud-tooltip-mode
+  "Toggle the display of GUD tooltips."
+  :global t
+  :group 'gud
+  :group 'tooltip
+  (require 'tooltip)
+  (if gud-tooltip-mode
+      (progn
+       (add-hook 'change-major-mode-hook 'gud-tooltip-change-major-mode)
+       (add-hook 'pre-command-hook 'tooltip-hide)
+       (add-hook 'tooltip-hook 'gud-tooltip-tips)
+       (define-key global-map [mouse-movement] 'gud-tooltip-mouse-motion))
+    (unless tooltip-mode (remove-hook 'pre-command-hook 'tooltip-hide)
+    (remove-hook 'change-major-mode-hook 'gud-tooltip-change-major-mode)
+    (remove-hook 'tooltip-hook 'gud-tooltip-tips)
+    (define-key global-map [mouse-movement] 'ignore)))
+  (gud-tooltip-activate-mouse-motions-if-enabled)
+  (if (and gud-comint-buffer
+          (buffer-name gud-comint-buffer); gud-comint-buffer might be killed
+          (memq (buffer-local-value 'gud-minor-mode gud-comint-buffer)
+                '(gdbmi gdba)))
+      (if gud-tooltip-mode
+         (progn
+           (dolist (buffer (buffer-list))
+             (unless (eq buffer gud-comint-buffer)
+               (with-current-buffer buffer
+                 (when (and (memq gud-minor-mode '(gdbmi gdba))
+                            (not (string-match "\\`\\*.+\\*\\'"
+                                               (buffer-name))))
+                   (make-local-variable 'gdb-define-alist)
+                   (gdb-create-define-alist)
+                   (add-hook 'after-save-hook
+                             'gdb-create-define-alist nil t))))))
+       (kill-local-variable 'gdb-define-alist)
+       (remove-hook 'after-save-hook 'gdb-create-define-alist t))))
+
 (defcustom gud-tooltip-modes '(gud-mode c-mode c++-mode fortran-mode)
-  "List of modes for which to enable GUD tips."
+  "List of modes for which to enable GUD tooltips."
   :type 'sexp
-  :tag "GUD modes"
+  :group 'gud
   :group 'tooltip)
 
 (defcustom gud-tooltip-display
@@ -3219,13 +3327,13 @@ Treats actions as defuns."
 Forms in the list are combined with AND.  The default is to display
 only tooltips in the buffer containing the overlay arrow."
   :type 'sexp
-  :tag "GUD buffers predicate"
+  :group 'gud
   :group 'tooltip)
 
 (defcustom gud-tooltip-echo-area nil
   "Use the echo area instead of frames for GUD tooltips."
   :type 'boolean
-  :tag "Use echo area"
+  :group 'gud
   :group 'tooltip)
 
 (define-obsolete-variable-alias 'tooltip-gud-modes
@@ -3288,53 +3396,19 @@ For C this would dereference a pointer expression.")
   "The mouse movement event that led to a tooltip display.
 This event can be examined by forms in GUD-TOOLTIP-DISPLAY.")
 
-(defun toggle-gud-tooltip-dereference ()
-  "Toggle whether tooltips should show `* expr' or `expr'."
-  (interactive)
-  (setq gud-tooltip-dereference (not gud-tooltip-dereference))
-  (when (interactive-p)
-    (message "Dereferencing is now %s."
-            (if gud-tooltip-dereference "on" "off"))))
+(defun gud-tooltip-dereference (&optional arg)
+  "Toggle whether tooltips should show `* expr' or `expr'.
+With arg, dereference expr iff arg is positive."
+ (interactive "P")
+  (setq gud-tooltip-dereference
+       (if (null arg)
+           (not gud-tooltip-dereference)
+         (> (prefix-numeric-value arg) 0)))
+  (message "Dereferencing is now %s."
+          (if gud-tooltip-dereference "on" "off")))
 
 (define-obsolete-function-alias 'tooltip-gud-toggle-dereference
-                                'toggle-gud-tooltip-dereference "22.1")
-
-;;;###autoload
-(define-minor-mode gud-tooltip-mode
-  "Toggle the display of GUD tooltips."
-  :global t
-  :group 'gud
-  (require 'tooltip)
-  (if gud-tooltip-mode
-      (progn
-       (add-hook 'change-major-mode-hook 'gud-tooltip-change-major-mode)
-       (add-hook 'pre-command-hook 'tooltip-hide)
-       (add-hook 'tooltip-hook 'gud-tooltip-tips)
-       (define-key global-map [mouse-movement] 'gud-tooltip-mouse-motion))
-    (unless tooltip-mode (remove-hook 'pre-command-hook 'tooltip-hide)
-    (remove-hook 'change-major-mode-hook 'gud-tooltip-change-major-mode)
-    (remove-hook 'tooltip-hook 'gud-tooltip-tips)
-    (define-key global-map [mouse-movement] 'ignore)))
-  (gud-tooltip-activate-mouse-motions-if-enabled)
-  (if (and
-       gud-comint-buffer
-       (buffer-name gud-comint-buffer); gud-comint-buffer might be kille
-       (with-current-buffer gud-comint-buffer
-       (memq gud-minor-mode '(gdbmi gdba))))
-      (if gud-tooltip-mode
-         (progn
-           (dolist (buffer (buffer-list))
-             (unless (eq buffer gud-comint-buffer)
-               (with-current-buffer buffer
-                 (when (and (memq gud-minor-mode '(gdbmi gdba))
-                            (not (string-match "\\`\\*.+\\*\\'"
-                                               (buffer-name))))
-                   (make-local-variable 'gdb-define-alist)
-                   (gdb-create-define-alist)
-                   (add-hook 'after-save-hook
-                             'gdb-create-define-alist nil t))))))
-       (kill-local-variable 'gdb-define-alist)
-       (remove-hook 'after-save-hook 'gdb-create-define-alist t))))
+                                'gud-tooltip-dereference "22.1")
 
 ; This will only display data that comes in one chunk.
 ; Larger arrays (say 400 elements) are displayed in
@@ -3349,10 +3423,7 @@ This event can be examined by forms in GUD-TOOLTIP-DISPLAY.")
                (or gud-tooltip-echo-area tooltip-use-echo-area)))
 
 (defun gud-tooltip-print-command (expr)
-  "Return a suitable command to print the expression EXPR.
-If GUD-TOOLTIP-DEREFERENCE is t, also prepend a `*' to EXPR."
-  (when gud-tooltip-dereference
-    (setq expr (concat "*" expr)))
+  "Return a suitable command to print the expression EXPR."
   (case gud-minor-mode
        (gdba (concat "server print " expr))
        ((dbx gdbmi) (concat "print " expr))
@@ -3372,9 +3443,8 @@ This function must return nil if it doesn't handle EVENT."
   (let (process)
     (when (and (eventp event)
               gud-tooltip-mode
-              (boundp 'gud-comint-buffer)
               gud-comint-buffer
-              (buffer-name gud-comint-buffer); gud-comint-buffer might be killed
+              (buffer-name gud-comint-buffer); might be killed
               (setq process (get-buffer-process gud-comint-buffer))
               (posn-point (event-end event))
               (or (and (eq gud-minor-mode 'gdba) (not gdb-active-process))
@@ -3395,6 +3465,8 @@ This function must return nil if it doesn't handle EVENT."
                       (cdr define-elt)
                       (or gud-tooltip-echo-area tooltip-use-echo-area))
                      expr))))
+           (when gud-tooltip-dereference
+             (setq expr (concat "*" expr)))
            (let ((cmd (gud-tooltip-print-command expr)))
              (when (and gud-tooltip-mode (eq gud-minor-mode 'gdb))
                (gud-tooltip-mode -1)