1
0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-11-27 07:37:33 +00:00

(require): CL no longer needed to compile case.

(tooltip-mode): Do not toggle functions for GUD tooltips.
(tooltip-gud-tips-p): Remove. Replace with minor mode
gud-tooltip-mode in gud.el.
(tooltip-gud-modes, tooltip-gud-display, tooltip-gud-echo-area)
(tooltip-gud-toggle-dereference): Rename in gud.el by replacing
tooltip-gud prefix with gud-tooltip and obsolete.
(tooltip-change-major-mode, tooltip-activate-mouse-motions-if-enabled)
(tooltip-mouse-motions-active, tooltip-activate-mouse-motions)
(tooltip-mouse-motion): Mouse movement functions/variable.
Rename in gud.el by adding gud prefix.
(tooltip-gud-original-filter, tooltip-gud-dereference)
(tooltip-gud-event, tooltip-toggle-gud-tips)
(tooltip-gud-process-output, tooltip-gud-print-command)
(tooltip-gud-tips): GUD tooltip functions/variables. Rename in
gud.el by replacing tooltip-gud prefix with gud-tooltip.
(gdb-tooltip-print): Move to gdb-ui.el.
This commit is contained in:
Nick Roberts 2005-05-06 22:11:35 +00:00
parent ce38ddb8ae
commit a93d834478

View File

@ -27,9 +27,6 @@
;;; Code: ;;; Code:
(eval-when-compile (require 'cl)) ; for case macro
;;; Customizable settings ;;; Customizable settings
(defgroup tooltip nil (defgroup tooltip nil
@ -116,42 +113,6 @@ position to pop up the tooltip."
"Face for tooltips." "Face for tooltips."
:group 'tooltip) :group 'tooltip)
(defcustom tooltip-gud-tips-p nil
"*Non-nil means show tooltips in GUD sessions.
This allows you to display a variable's value in a tooltip simply
by pointing at it with the mouse. In the case of a C program
controlled by GDB, it shows the associated #define directives
when program is not executing."
:type 'boolean
:tag "GUD"
:group 'tooltip)
(defcustom tooltip-gud-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 tooltip-gud-display
'((eq (tooltip-event-buffer tooltip-gud-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 tooltip-gud-echo-area nil
"Use the echo area instead of frames for GUD tooltips."
:type 'boolean
:tag "Use echo area"
:group 'tooltip)
(defvaralias 'tooltip-use-echo-area 'tooltip-gud-echo-area)
(make-obsolete-variable 'tooltip-use-echo-area 'tooltip-gud-echo-area "22.1")
;;; Variables that are not customizable. ;;; Variables that are not customizable.
@ -169,7 +130,6 @@ the last mouse movement event that occurred.")
(defvar tooltip-hide-time nil (defvar tooltip-hide-time nil
"Time when the last tooltip was hidden.") "Time when the last tooltip was hidden.")
;;; Event accessors ;;; Event accessors
(defun tooltip-event-buffer (event) (defun tooltip-event-buffer (event)
@ -178,7 +138,6 @@ This might return nil if the event did not occur over a buffer."
(let ((window (posn-window (event-end event)))) (let ((window (posn-window (event-end event))))
(and window (window-buffer window)))) (and window (window-buffer window))))
;;; Switching tooltips on/off ;;; Switching tooltips on/off
;; We don't set track-mouse globally because this is a big redisplay ;; We don't set track-mouse globally because this is a big redisplay
@ -202,16 +161,15 @@ With ARG, turn tooltip mode on if and only if ARG is positive."
:group 'tooltip :group 'tooltip
(unless (or (null tooltip-mode) (fboundp 'x-show-tip)) (unless (or (null tooltip-mode) (fboundp 'x-show-tip))
(error "Sorry, tooltips are not yet available on this system")) (error "Sorry, tooltips are not yet available on this system"))
(let ((hook-fn (if tooltip-mode 'add-hook 'remove-hook))) (if tooltip-mode
(funcall hook-fn 'change-major-mode-hook 'tooltip-change-major-mode) (progn
(tooltip-activate-mouse-motions-if-enabled) (add-hook 'pre-command-hook 'tooltip-hide)
(funcall hook-fn 'pre-command-hook 'tooltip-hide) (add-hook 'tooltip-hook 'tooltip-help-tips))
(funcall hook-fn 'tooltip-hook 'tooltip-gud-tips) (unless (and (boundp 'gud-tooltip-mode) gud-tooltip-mode)
(funcall hook-fn 'tooltip-hook 'tooltip-help-tips) (remove-hook 'pre-command-hook 'tooltip-hide))
(setq show-help-function (if tooltip-mode 'tooltip-show-help-function nil)) (remove-hook 'tooltip-hook 'tooltip-help-tips))
;; `ignore' is the default binding for mouse movements. (setq show-help-function
(define-key global-map [mouse-movement] (if tooltip-mode 'tooltip-show-help-function nil)))
(if tooltip-mode 'tooltip-mouse-motion 'ignore))))
;;; Timeout for tooltip display ;;; Timeout for tooltip display
@ -241,49 +199,6 @@ With ARG, turn tooltip mode on if and only if ARG is positive."
(run-hook-with-args-until-success 'tooltip-hook (run-hook-with-args-until-success 'tooltip-hook
tooltip-last-mouse-motion-event)) tooltip-last-mouse-motion-event))
;;; Reacting on mouse movements
(defun tooltip-change-major-mode ()
"Function added to `change-major-mode-hook' when tooltip mode is on."
(add-hook 'post-command-hook 'tooltip-activate-mouse-motions-if-enabled))
(defun tooltip-activate-mouse-motions-if-enabled ()
"Reconsider for all buffers whether mouse motion events are desired."
(remove-hook 'post-command-hook 'tooltip-activate-mouse-motions-if-enabled)
(dolist (buffer (buffer-list))
(save-excursion
(set-buffer buffer)
(if (and tooltip-mode
tooltip-gud-tips-p
(memq major-mode tooltip-gud-modes))
(tooltip-activate-mouse-motions t)
(tooltip-activate-mouse-motions nil)))))
(defvar tooltip-mouse-motions-active nil
"Locally t in a buffer if tooltip processing of mouse motion is enabled.")
(defun 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 'tooltip-mouse-motions-active)
(setq tooltip-mouse-motions-active t)
(make-local-variable 'track-mouse)
(setq track-mouse t))
(when tooltip-mouse-motions-active
(kill-local-variable 'tooltip-mouse-motions-active)
(kill-local-variable 'track-mouse))))
(defun 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)))
;;; Displaying tips ;;; Displaying tips
@ -395,114 +310,6 @@ of PROCESS."
(setq output (substring output 0 (match-beginning 0))))) (setq output (substring output 0 (match-beginning 0)))))
output)) output))
;;; Tips for `gud'
(defvar tooltip-gud-original-filter nil
"Process filter to restore after GUD output has been received.")
(defvar tooltip-gud-dereference nil
"Non-nil means print expressions with a `*' in front of them.
For C this would dereference a pointer expression.")
(defvar tooltip-gud-event nil
"The mouse movement event that led to a tooltip display.
This event can be examined by forms in TOOLTIP-GUD-DISPLAY.")
(defun tooltip-gud-toggle-dereference ()
"Toggle whether tooltips should show `* expr' or `expr'."
(interactive)
(setq tooltip-gud-dereference (not tooltip-gud-dereference))
(when (interactive-p)
(message "Dereferencing is now %s."
(if tooltip-gud-dereference "on" "off"))))
(defun tooltip-toggle-gud-tips ()
"Toggle the display of GUD tooltips."
(interactive)
(setq tooltip-gud-tips-p (not tooltip-gud-tips-p))
;; Reconsider for all buffers whether mouse motion events are desired.
(tooltip-change-major-mode)
(when (interactive-p)
(message (format "GUD tooltips %sabled"
(if tooltip-gud-tips-p "en" "dis")))))
; 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 tooltip-gud-process-output (process output)
"Process debugger output and show it in a tooltip window."
(set-process-filter process tooltip-gud-original-filter)
(tooltip-show (tooltip-strip-prompt process output)
tooltip-gud-echo-area))
(defun tooltip-gud-print-command (expr)
"Return a suitable command to print the expression EXPR.
If TOOLTIP-GUD-DEREFERENCE is t, also prepend a `*' to EXPR."
(when tooltip-gud-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 tooltip-gud-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 tooltip-gud-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)
tooltip-gud-tips-p
(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 (eq gud-minor-mode 'gdba)
(progn (setq tooltip-gud-event event)
(eval (cons 'and tooltip-gud-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 (tooltip-gud-print-command expr)))
(unless (null cmd) ; CMD can be nil if unknown debugger
(case gud-minor-mode
(gdba (gdb-enqueue-input
(list (concat cmd "\n") 'gdb-tooltip-print)))
(t
(setq tooltip-gud-original-filter (process-filter process))
(set-process-filter process 'tooltip-gud-process-output)
(gud-basic-call cmd)))
expr))))))))
(defun gdb-tooltip-print ()
(tooltip-show
(with-current-buffer (gdb-get-buffer 'gdb-partial-output-buffer)
(let ((string (buffer-string)))
;; remove newline for tooltip-gud-echo-area
(substring string 0 (- (length string) 1))))
tooltip-gud-echo-area))
;;; Tooltip help. ;;; Tooltip help.