]> code.delx.au - gnu-emacs/blobdiff - lisp/progmodes/gud.el
Move code for GUD tooltips from tooltip.el.
[gnu-emacs] / lisp / progmodes / gud.el
index 84dec78d8958f8a9020ab740b681c8d30e18dea7..544a4804639ab7e3441cd7e2db2c7cc57435bbdf 100644 (file)
@@ -39,6 +39,8 @@
 
 ;;; Code:
 
+(eval-when-compile (require 'cl)) ; for case macro
+
 (require 'comint)
 (require 'etags)
 
@@ -89,46 +91,71 @@ If SOFT is non-nil, returns nil if the symbol doesn't already exist."
 
 (defvar gud-running nil
   "Non-nil if debuggee is running.
-Used to grey out relevant toolbar icons.")
+Used to grey out relevant togolbar icons.")
+
+;; Use existing Info buffer, if possible.
+(defun gud-goto-info ()
+  "Go to relevant Emacs info node."
+  (interactive)
+  (let ((same-window-regexps same-window-regexps)
+       (display-buffer-reuse-frames t))
+    (catch 'info-found
+      (walk-windows
+       '(lambda (window)
+         (if (eq (window-buffer window) (get-buffer "*info*"))
+             (progn
+               (setq same-window-regexps nil)
+               (throw 'info-found nil))))
+       nil 0)
+      (require 'info)
+      (select-frame (make-frame)))
+    (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
-  '(([help]     menu-item "Help" gdb-goto-info
-                     :enable (eq gud-minor-mode 'gdba))
+  '(([help]     "Info" . gud-goto-info)
+    ([tooltips] menu-item "Toggle GUD tooltips" gud-tooltip-mode
+                  :enable  (and (not emacs-basic-display)
+                               (display-graphic-p)
+                               (fboundp 'x-show-tip))
+                 :button (:toggle . gud-tooltip-mode))
     ([refresh] "Refresh" . gud-refresh)
     ([run]     menu-item "Run" gud-run
-                     :enable (and (not gud-running)
-                                 (memq gud-minor-mode '(gdba gdb dbx jdb))))
+                  :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 '(gdba gdb perldb))))
+                  :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))
     ([watch]   menu-item "Watch Expression" gud-watch
-                    :enable (and (not gud-running) (eq gud-minor-mode 'gdba)))
+                    :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
-                                       '(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
@@ -171,7 +198,7 @@ Used to grey out relevant toolbar icons.")
                     (gud-nexti . "gud-ni")
                     (gud-up . "gud-up")
                     (gud-down . "gud-down")
-                    (gdb-goto-info . "help"))
+                    (gud-goto-info . "info"))
                   map)
          (tool-bar-local-item-from-menu
           (car x) (cdr x) map gud-minor-mode-map)))))
@@ -203,6 +230,11 @@ Uses `gud-<MINOR-MODE>-directories' to find the source files."
       (with-current-buffer buf
        (set (make-local-variable 'gud-minor-mode) minor-mode)
        (set (make-local-variable 'tool-bar-map) gud-tool-bar-map)
+       (when (and gud-tooltip-mode
+                  (memq gud-minor-mode '(gdbmi gdba)))
+         (make-local-variable 'gdb-define-alist)
+         (unless  gdb-define-alist (gdb-create-define-alist))
+         (add-hook 'after-save-hook 'gdb-create-define-alist nil t))
        (make-local-variable 'gud-keep-buffer))
       buf)))
 \f
@@ -312,11 +344,14 @@ t means that there is no stack, and we are in display-file mode.")
 (defvar gud-speedbar-menu-items
   ;; Note to self.  Add expand, and turn off items when not available.
   '(["Jump to stack frame" speedbar-edit-line 
-     (with-current-buffer gud-comint-buffer (not (eq gud-minor-mode 'gdba)))]
+     (with-current-buffer gud-comint-buffer
+       (not (memq gud-minor-mode '(gdbmi gdba))))]
     ["Edit value" speedbar-edit-line 
-     (with-current-buffer gud-comint-buffer (eq gud-minor-mode 'gdba))]
+     (with-current-buffer gud-comint-buffer
+       (not (memq gud-minor-mode '(gdbmi gdba))))]
     ["Delete expression" gdb-var-delete 
-     (with-current-buffer gud-comint-buffer (eq gud-minor-mode 'gdba))])
+     (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
@@ -330,7 +365,7 @@ If the GUD BUFFER is not running a supported debugger, then turn
 off the specialized speedbar mode."
   (let ((minor-mode (with-current-buffer buffer gud-minor-mode)))
     (cond
-     ((eq minor-mode 'gdba)
+     ((memq minor-mode '(gdbmi gdba))
       (when (or gdb-var-changed
                (not (save-excursion
                       (goto-char (point-min))
@@ -397,7 +432,7 @@ off the specialized speedbar mode."
              (speedbar-insert-button (car frame)
                                      'speedbar-file-face
                                      'speedbar-highlight-face
-                                     (cond ((memq minor-mode '(gdba gdb))
+                                     (cond ((memq minor-mode '(gdbmi gdba gdb))
                                             'gud-gdb-goto-stackframe)
                                            (t (error "Should never be here")))
                                        frame t)))
@@ -446,7 +481,7 @@ off the specialized speedbar mode."
 
        ;; Extract the frame position from the marker.
        gud-last-frame (cons (match-string 1 gud-marker-acc)
-                           (string-to-int (match-string 2 gud-marker-acc)))
+                           (string-to-number (match-string 2 gud-marker-acc)))
 
        ;; Append any text before the marker to the output we're going
        ;; to return - we don't include the marker in this text.
@@ -519,6 +554,9 @@ off the specialized speedbar mode."
 
 (defvar gdb-first-prompt t)
 
+(defvar gud-filter-pending-text nil
+  "Non-nil means this is text that has been saved for later in `gud-filter'.")
+
 ;;;###autoload
 (defun gdb (command-line)
   "Run gdb on program FILE in buffer *gud-FILE*.
@@ -550,6 +588,7 @@ and source-file directory for your debugger."
   (setq comint-prompt-regexp "^(.*gdb[+]?) *")
   (setq paragraph-start comint-prompt-regexp)
   (setq gdb-first-prompt t)
+  (setq gud-filter-pending-text nil)
   (run-hooks 'gdb-mode-hook))
 
 ;; One of the nice features of GDB is its impressive support for
@@ -743,14 +782,14 @@ SKIP is the number of chars to skip on each lines, it defaults to 0."
                        gud-marker-acc start)
          (setq gud-last-frame
                (cons (match-string 3 gud-marker-acc)
-                     (string-to-int (match-string 4 gud-marker-acc)))))
+                     (string-to-number (match-string 4 gud-marker-acc)))))
         ;; System V Release 4.0 quite often clumps two lines together
         ((string-match "^\\(BREAKPOINT\\|STEPPED\\) process [0-9]+ function [^ ]+ in \\(.+\\)\n\\([0-9]+\\):"
                        gud-marker-acc start)
          (setq gud-sdb-lastfile (match-string 2 gud-marker-acc))
          (setq gud-last-frame
                (cons gud-sdb-lastfile
-                     (string-to-int (match-string 3 gud-marker-acc)))))
+                     (string-to-number (match-string 3 gud-marker-acc)))))
         ;; System V Release 4.0
         ((string-match "^\\(BREAKPOINT\\|STEPPED\\) process [0-9]+ function [^ ]+ in \\(.+\\)\n"
                        gud-marker-acc start)
@@ -759,7 +798,7 @@ SKIP is the number of chars to skip on each lines, it defaults to 0."
                                              gud-marker-acc start))
               (setq gud-last-frame
                     (cons gud-sdb-lastfile
-                          (string-to-int (match-string 1 gud-marker-acc)))))
+                          (string-to-number (match-string 1 gud-marker-acc)))))
         (t
          (setq gud-sdb-lastfile nil)))
       (setq start (match-end 0)))
@@ -845,7 +884,7 @@ containing the executable being debugged."
                gud-marker-acc start))
       (setq gud-last-frame
            (cons (match-string 2 gud-marker-acc)
-                 (string-to-int (match-string 1 gud-marker-acc)))
+                 (string-to-number (match-string 1 gud-marker-acc)))
            start (match-end 0)))
 
     ;; Search for the last incomplete line in this chunk
@@ -892,7 +931,7 @@ containing the executable being debugged."
        ;; Extract the frame position from the marker.
        gud-last-frame
        (cons (match-string 1 gud-marker-acc)
-            (string-to-int (match-string 2 gud-marker-acc)))
+            (string-to-number (match-string 2 gud-marker-acc)))
 
        ;; Append any text before the marker to the output we're going
        ;; to return - we don't include the marker in this text.
@@ -1000,7 +1039,7 @@ a better solution in 6.1 upwards.")
            (if (file-exists-p file)
                (setq gud-last-frame
                      (cons (match-string 1 result)
-                           (string-to-int (match-string 2 result))))))
+                           (string-to-number (match-string 2 result))))))
          result)
         ((string-match                 ; kluged-up marker as above
           "\032\032\\([0-9]*\\):\\(.*\\)\n" result)
@@ -1008,7 +1047,7 @@ a better solution in 6.1 upwards.")
            (if (and file (file-exists-p file))
                (setq gud-last-frame
                      (cons file
-                           (string-to-int (match-string 1 result))))))
+                           (string-to-number (match-string 1 result))))))
          (setq result (substring result 0 (match-beginning 0))))))
     (or result "")))
 
@@ -1045,7 +1084,7 @@ This was tested using R4.11.")
     (while (string-match re gud-marker-acc start)
       (setq gud-last-frame
            (cons (match-string 4 gud-marker-acc)
-                 (string-to-int (match-string 3 gud-marker-acc)))
+                 (string-to-number (match-string 3 gud-marker-acc)))
            start (match-end 0)))
 
     ;; Search for the last incomplete line in this chunk
@@ -1164,7 +1203,7 @@ containing the executable being debugged."
                              result)
                 (string-match "[^: \t]+:[ \t]+\\([^:]+\\): [^:]+: \\([0-9]+\\):"
                               result))
-            (let ((line (string-to-int (match-string 2 result)))
+            (let ((line (string-to-number (match-string 2 result)))
                   (file (gud-file-name (match-string 1 result))))
               (if file
                   (setq gud-last-frame (cons file line))))))
@@ -1266,7 +1305,7 @@ into one that invokes an Emacs-enabled debugging session.
        ;; Extract the frame position from the marker.
        gud-last-frame
        (cons (match-string 1 gud-marker-acc)
-            (string-to-int (match-string 3 gud-marker-acc)))
+            (string-to-number (match-string 3 gud-marker-acc)))
 
        ;; Append any text before the marker to the output we're going
        ;; to return - we don't include the marker in this text.
@@ -1364,7 +1403,7 @@ and source-file directory for your debugger."
        gud-last-frame
        (let ((file (match-string gud-pdb-marker-regexp-file-group
                                 gud-marker-acc))
-            (line (string-to-int
+            (line (string-to-number
                    (match-string gud-pdb-marker-regexp-line-group
                                  gud-marker-acc))))
         (if (string-equal file "<string>")
@@ -1401,7 +1440,7 @@ and source-file directory for your debugger."
 
     output))
 
-(defcustom gud-pdb-command-name "pydb"
+(defcustom gud-pdb-command-name "pdb"
   "File name for executing the Python debugger.
 This should be an executable on your path, or an absolute file name."
   :type 'string
@@ -1996,7 +2035,7 @@ nil)
       ;;     (<file-name> . <line-number>) .
       (if (if (match-beginning 1)
              (let (n)
-               (setq n (string-to-int (substring
+               (setq n (string-to-number (substring
                                        gud-marker-acc
                                        (1+ (match-beginning 1))
                                        (- (match-end 1) 2))))
@@ -2007,7 +2046,7 @@ nil)
                    (gud-jdb-find-source (match-string 2 gud-marker-acc)))
              (setq gud-last-frame
                    (cons file-found
-                         (string-to-int
+                         (string-to-number
                           (let
                                ((numstr (match-string 4 gud-marker-acc)))
                              (if (string-match "[.,]" numstr)
@@ -2155,7 +2194,7 @@ gud, see `gud-mode'."
        ;; Extract the frame position from the marker.
        gud-last-frame
        (cons (match-string 2 gud-marker-acc)
-            (string-to-int (match-string 4 gud-marker-acc)))
+            (string-to-number (match-string 4 gud-marker-acc)))
 
        ;; Append any text before the marker to the output we're going
        ;; to return - we don't include the marker in this text.
@@ -2433,9 +2472,6 @@ comint mode, which see."
   "Non-nil means don't process anything from the debugger right now.
 It is saved for when this flag is not set.")
 
-(defvar gud-filter-pending-text nil
-  "Non-nil means this is text that has been saved for later in `gud-filter'.")
-
 ;; These functions are responsible for inserting output from your debugger
 ;; into the buffer.  The hard work is done by the method that is
 ;; the value of gud-marker-filter.
@@ -2504,21 +2540,23 @@ It is saved for when this flag is not set.")
              (gud-filter proc ""))))))
 
 (defvar gud-minor-mode-type nil)
+(defvar gud-overlay-arrow-position nil)
+(add-to-list 'overlay-arrow-variable-list 'gud-overlay-arrow-position)
 
 (defun gud-sentinel (proc msg)
   (cond ((null (buffer-name (process-buffer proc)))
         ;; buffer killed
         ;; Stop displaying an arrow in a source file.
-        (setq overlay-arrow-position nil)
+        (setq gud-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)
+        (setq gud-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)))
@@ -2554,12 +2592,11 @@ It is saved for when this flag is not set.")
 
 (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.
@@ -2584,9 +2621,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
@@ -2601,14 +2636,13 @@ Obeying it means displaying in another window the specified file and line."
              (widen)
              (goto-line line)
              (setq pos (point))
-             (setq overlay-arrow-string "=>")
-             (or overlay-arrow-position
-                 (setq overlay-arrow-position (make-marker)))
-             (set-marker overlay-arrow-position (point) (current-buffer)))
+             (or gud-overlay-arrow-position
+                 (setq gud-overlay-arrow-position (make-marker)))
+             (set-marker gud-overlay-arrow-position (point) (current-buffer)))
            (cond ((or (< pos (point-min)) (> pos (point-max)))
                   (widen)
                   (goto-char pos))))
-         (if window (set-window-point window overlay-arrow-position))))))
+         (if window (set-window-point window gud-overlay-arrow-position))))))
 
 ;; The gud-call function must do the right thing whether its invoking
 ;; keystroke is from the GUD buffer itself (via major-mode binding)
@@ -2708,7 +2742,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")))))))
 
@@ -2950,6 +2984,7 @@ class of the file (using s to separate nested class ids)."
        (message "gud-find-class: class for file %s not found in gud-jdb-class-source-alist!" f)
        nil))))
 
+\f
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; GDB script mode ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -3024,6 +3059,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))
 
@@ -3036,6 +3092,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
@@ -3043,6 +3103,204 @@ class of the file (using s to separate nested class ids)."
         (font-lock-syntactic-face-function
          . gdb-script-font-lock-syntactic-face))))
 
+\f
+;;; tooltips for GUD
+
+;;; Customizable settings
+(defcustom gud-tooltip-modes '(gud-mode c-mode c++-mode fortran-mode)
+  "List of modes for which to enable GUD tips."
+  :type 'sexp
+  :tag "GUD modes"
+  :group 'tooltip)
+
+(defcustom gud-tooltip-display
+  '((eq (tooltip-event-buffer gud-tooltip-event)
+       (marker-buffer gud-overlay-arrow-position)))
+  "List of forms determining where GUD tooltips are displayed.
+
+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 'tooltip)
+
+(defcustom gud-tooltip-echo-area nil
+  "Use the echo area instead of frames for GUD tooltips."
+  :type 'boolean
+  :tag "Use echo area"
+  :group 'tooltip)
+
+(define-obsolete-variable-alias 'tooltip-gud-modes
+                                'gud-tooltip-modes "22.1")
+(define-obsolete-variable-alias 'tooltip-gud-display
+                                'gud-tooltip-display "22.1")
+(define-obsolete-variable-alias 'tooltip-use-echo-area
+                                'gud-tooltip-echo-area "22.1")
+
+;;; Reacting on mouse movements
+
+(defun gud-tooltip-change-major-mode ()
+  "Function added to `change-major-mode-hook' when tooltip mode is on."
+  (add-hook 'post-command-hook 'gud-tooltip-activate-mouse-motions-if-enabled))
+
+(defun gud-tooltip-activate-mouse-motions-if-enabled ()
+  "Reconsider for all buffers whether mouse motion events are desired."
+  (remove-hook 'post-command-hook
+              'gud-tooltip-activate-mouse-motions-if-enabled)
+  (dolist (buffer (buffer-list))
+    (save-excursion
+      (set-buffer buffer)
+      (if (and gud-tooltip-mode
+              (memq major-mode gud-tooltip-modes))
+         (gud-tooltip-activate-mouse-motions t)
+       (gud-tooltip-activate-mouse-motions nil)))))
+
+(defvar gud-tooltip-mouse-motions-active nil
+  "Locally t in a buffer if tooltip processing of mouse motion is enabled.")
+
+(defun gud-tooltip-activate-mouse-motions (activatep)
+  "Activate/deactivate mouse motion events for the current buffer.
+ACTIVATEP non-nil means activate mouse motion events."
+  (if activatep
+      (progn
+       (make-local-variable 'gud-tooltip-mouse-motions-active)
+       (setq gud-tooltip-mouse-motions-active t)
+       (make-local-variable 'track-mouse)
+       (setq track-mouse t))
+    (when gud-tooltip-mouse-motions-active
+      (kill-local-variable 'gud-tooltip-mouse-motions-active)
+      (kill-local-variable 'track-mouse))))
+
+(defun gud-tooltip-mouse-motion (event)
+  "Command handler for mouse movement events in `global-map'."
+  (interactive "e")
+  (tooltip-hide)
+  (when (car (mouse-pixel-position))
+    (setq tooltip-last-mouse-motion-event (copy-sequence event))
+    (tooltip-start-delayed-tip)))
+
+;;; Tips for `gud'
+
+(defvar gud-tooltip-original-filter nil
+  "Process filter to restore after GUD output has been received.")
+
+(defvar gud-tooltip-dereference nil
+  "Non-nil means print expressions with a `*' in front of them.
+For C this would dereference a pointer expression.")
+
+(defvar gud-tooltip-event nil
+  "The mouse movement event that led to a tooltip display.
+This event can be examined by forms in GUD-TOOLTIP-DISPLAY.")
+
+(defun gud-tooltip-toggle-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"))))
+
+(define-obsolete-function-alias 'tooltip-gud-toggle-dereference
+                                'gud-tooltip-toggle-dereference "22.1")
+
+(define-minor-mode gud-tooltip-mode
+  "Toggle the display of GUD tooltips."
+  :global t
+  :group 'gud
+  (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 '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 (with-current-buffer gud-comint-buffer (eq gud-minor-mode '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))))
+
+; This will only display data that comes in one chunk.
+; Larger arrays (say 400 elements) are displayed in
+; the tootip incompletely and spill over into the gud buffer.
+; Switching the process-filter creates timing problems and
+; it may be difficult to do better. Using annotations as in
+; gdb-ui.el gets round this problem.
+(defun gud-tooltip-process-output (process output)
+  "Process debugger output and show it in a tooltip window."
+  (set-process-filter process gud-tooltip-original-filter)
+  (tooltip-show (tooltip-strip-prompt process output)
+               gud-tooltip-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)))
+  (case gud-minor-mode
+    ((gdb gdba) (concat "server print " expr))
+    (dbx (concat "print " expr))
+    (xdb (concat "p " expr))
+    (sdb (concat expr "/"))
+    (perldb expr)))
+
+(defun gud-tooltip-tips (event)
+  "Show tip for identifier or selection under the mouse.
+The mouse must either point at an identifier or inside a selected
+region for the tip window to be shown.  If gud-tooltip-dereference is t,
+add a `*' in front of the printed expression. In the case of a C program
+controlled by GDB, show the associated #define directives when program is
+not executing.
+
+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
+              (setq process (get-buffer-process gud-comint-buffer))
+              (posn-point (event-end event))
+              (or (and (eq gud-minor-mode 'gdba) (not gdb-active-process))
+                  (progn (setq gud-tooltip-event event)
+                         (eval (cons 'and gud-tooltip-display)))))
+      (let ((expr (tooltip-expr-to-print event)))
+       (when expr
+         (if (and (eq gud-minor-mode 'gdba)
+                  (not gdb-active-process))
+             (progn
+               (with-current-buffer
+                   (window-buffer (let ((mouse (mouse-position)))
+                                    (window-at (cadr mouse)
+                                               (cddr mouse))))
+                 (let ((define-elt (assoc expr gdb-define-alist)))
+                   (unless (null define-elt)
+                     (tooltip-show (cdr define-elt))
+                     expr))))
+           (let ((cmd (gud-tooltip-print-command expr)))
+             (unless (null cmd) ; CMD can be nil if unknown debugger
+               (if (eq gud-minor-mode 'gdba)
+                   (gdb-enqueue-input
+                    (list  (concat cmd "\n") 'gdb-tooltip-print))
+                 (setq gud-tooltip-original-filter (process-filter process))
+                 (set-process-filter process 'gud-tooltip-process-output)
+                 (gud-basic-call cmd))
+               expr))))))))
+
 (provide 'gud)
 
 ;;; arch-tag: 6d990948-df65-461a-be39-1c7fb83ac4c4