;; 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.
;;; Code:
+(eval-when-compile (require 'cl)) ; for case macro
+
(require 'comint)
(require 'etags)
(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
- '(([refresh] "Refresh" . gud-refresh)
+ '(([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)))
+ (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
(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)))))
(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
(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
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))
(speedbar-make-tag-line 'bracket char
'gdb-speedbar-expand-node varnum
(concat (car var) "\t" (nth 3 var))
- 'gdb-var-delete
- nil nil depth)))
+ nil nil nil depth)))
(setq var-list (cdr var-list))))
(setq gdb-var-changed nil)))
(t (if (and (save-excursion
(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)))
;; 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.
;; 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.
;; 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
(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*.
(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
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)
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)))
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
;; 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.
(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)
(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 "")))
(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
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))))))
;; 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.
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>")
;; (<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))))
(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)
;; 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.
;; 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.
(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.
"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.
(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)))
(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.
(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
(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)
(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")))))))
(message "gud-find-class: class for file %s not found in gud-jdb-class-source-alist!" f)
nil))))
+\f
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; GDB script mode ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(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))
(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
(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