X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/ab5796a9f97180707734a81320e3eb81937281fe..797d92ed1f986579ab155e1f2df346eb31cc4085:/lisp/tooltip.el diff --git a/lisp/tooltip.el b/lisp/tooltip.el index 6ff86b4cf0..59f07df008 100644 --- a/lisp/tooltip.el +++ b/lisp/tooltip.el @@ -1,6 +1,7 @@ ;;; tooltip.el --- show tooltip windows -;; Copyright (C) 1997, 1999, 2000, 2001 Free Software Foundation, Inc. +;; Copyright (C) 1997, 1999, 2000, 2001, 2002, 2003, 2004, +;; 2005 Free Software Foundation, Inc. ;; Author: Gerd Moellmann ;; Keywords: help c mouse tools @@ -19,20 +20,13 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. ;;; Commentary: ;;; Code: -(eval-when-compile - (require 'cl) - (require 'comint) - (require 'gud) - (require 'gdb-ui)) - - ;;; Customizable settings (defgroup tooltip nil @@ -44,8 +38,6 @@ :version "21.1" :tag "Tool Tips") -(defvar tooltip-mode) - (defcustom tooltip-delay 0.7 "Seconds to wait before displaying a tooltip the first time." :tag "Delay" @@ -121,35 +113,8 @@ position to pop up the tooltip." "Face for tooltips." :group 'tooltip) -(defcustom tooltip-gud-tips-p nil - "*Non-nil means show tooltips in GUD sessions." - :type 'boolean - :tag "GUD" - :set #'(lambda (symbol on) - (setq tooltip-gud-tips-p on)) - :group 'tooltip) - -(defcustom tooltip-gud-modes '(gud-mode c-mode c++-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 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-use-echo-area nil - "Use the echo area instead of tooltip frames. -This is only relevant GUD display, since otherwise it is equivalent to -turning off Tooltip mode." + "Use the echo area instead of tooltip frames for help and GUD tooltips." :type 'boolean :tag "Use echo area" :group 'tooltip) @@ -171,7 +136,8 @@ the last mouse movement event that occurred.") (defvar tooltip-hide-time nil "Time when the last tooltip was hidden.") - +(defvar gud-tooltip-mode) ;; Prevent warning. + ;;; Event accessors (defun tooltip-event-buffer (event) @@ -180,7 +146,6 @@ This might return nil if the event did not occur over a buffer." (let ((window (posn-window (event-end event)))) (and window (window-buffer window)))) - ;;; Switching tooltips on/off ;; We don't set track-mouse globally because this is a big redisplay @@ -189,27 +154,27 @@ This might return nil if the event did not occur over a buffer." ;; set-buffer prevents redisplay optimizations, so every mouse motion ;; would be accompanied by a full redisplay. -;;;###autoload -(defun tooltip-mode (&optional arg) - "Mode for tooltip display. +(define-minor-mode tooltip-mode + "Toggle Tooltip display. With ARG, turn tooltip mode on if and only if ARG is positive." - (interactive "P") - (unless (fboundp 'x-show-tip) + :global t + :init-value (not (or noninteractive + emacs-basic-display + (not (display-graphic-p)) + (not (fboundp 'x-show-tip)))) + :initialize 'custom-initialize-safe-default + :group 'tooltip + (unless (or (null tooltip-mode) (fboundp 'x-show-tip)) (error "Sorry, tooltips are not yet available on this system")) - (let* ((on (if arg - (> (prefix-numeric-value arg) 0) - (not tooltip-mode))) - (hook-fn (if on 'add-hook 'remove-hook))) - (setq tooltip-mode on) - (funcall hook-fn 'change-major-mode-hook 'tooltip-change-major-mode) - (tooltip-activate-mouse-motions-if-enabled) - (funcall hook-fn 'pre-command-hook 'tooltip-hide) - (funcall hook-fn 'tooltip-hook 'tooltip-gud-tips) - (funcall hook-fn 'tooltip-hook 'tooltip-help-tips) - (setq show-help-function (if on 'tooltip-show-help-function nil)) - ;; `ignore' is the default binding for mouse movements. - (define-key global-map [mouse-movement] - (if on 'tooltip-mouse-motion 'ignore)))) + (if tooltip-mode + (progn + (add-hook 'pre-command-hook 'tooltip-hide) + (add-hook 'tooltip-hook 'tooltip-help-tips)) + (unless (and (boundp 'gud-tooltip-mode) gud-tooltip-mode) + (remove-hook 'pre-command-hook 'tooltip-hide)) + (remove-hook 'tooltip-hook 'tooltip-help-tips)) + (setq show-help-function + (if tooltip-mode 'tooltip-show-help nil))) ;;; Timeout for tooltip display @@ -230,60 +195,15 @@ With ARG, turn tooltip mode on if and only if ARG is positive." (setq tooltip-timeout-id nil))) (defun tooltip-start-delayed-tip () - "Add a one-shot timeout to call function tooltip-timeout." + "Add a one-shot timeout to call function `tooltip-timeout'." (setq tooltip-timeout-id (add-timeout (tooltip-delay) 'tooltip-timeout nil))) (defun tooltip-timeout (object) - "Function called when timer with id tooltip-timeout-id fires." + "Function called when timer with id `tooltip-timeout-id' fires." (run-hook-with-args-until-success 'tooltip-hook 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) - (let ((buffers (buffer-list))) - (save-excursion - (while buffers - (set-buffer (car buffers)) - (if (and tooltip-mode - tooltip-gud-tips-p - (memq major-mode tooltip-gud-modes)) - (tooltip-activate-mouse-motions t) - (tooltip-activate-mouse-motions nil)) - (setq buffers (cdr buffers)))))) - -(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 @@ -297,17 +217,20 @@ change the existing association. Value is the resulting alist." (push (cons key value) alist)) alist)) -(defun tooltip-show (text) +(defun tooltip-show (text &optional use-echo-area) "Show a tooltip window displaying TEXT. -Text larger than `x-max-tooltip-size' (which see) is clipped. +Text larger than `x-max-tooltip-size' is clipped. If the alist in `tooltip-frame-parameters' includes `left' and `top' parameters, they determine the x and y position where the tooltip is displayed. Otherwise, the tooltip pops at offsets specified by `tooltip-x-offset' and `tooltip-y-offset' from the current mouse -position." - (if tooltip-use-echo-area +position. + +Optional second arg USE-ECHO-AREA non-nil means to show tooltip +in echo area." + (if use-echo-area (message "%s" text) (condition-case error (let ((params (copy-sequence tooltip-frame-parameters)) @@ -372,8 +295,8 @@ where the mouse is." (defun tooltip-process-prompt-regexp (process) "Return regexp matching the prompt of PROCESS at the end of a string. -The prompt is taken from the value of COMINT-PROMPT-REGEXP in the buffer -of PROCESS." +The prompt is taken from the value of `comint-prompt-regexp' in +the buffer of PROCESS." (let ((prompt-regexp (save-excursion (set-buffer (process-buffer process)) comint-prompt-regexp))) @@ -392,92 +315,13 @@ of PROCESS." (setq output (substring output 0 (match-beginning 0))))) 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")))) - -; 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. gdba 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))) - -(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. - -This function must return nil if it doesn't handle EVENT." - (let (gud-buffer process) - (when (and (eventp event) - tooltip-gud-tips-p - (boundp 'gud-comint-buffer) - (setq gud-buffer gud-comint-buffer) - (setq process (get-buffer-process gud-buffer)) - (posn-point (event-end event)) - (progn (setq tooltip-gud-event event) - (eval (cons 'and tooltip-gud-display)))) - (let ((expr (tooltip-expr-to-print event))) - (when 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) - (buffer-string)))) - ;;; Tooltip help. (defvar tooltip-help-message nil - "The last help message received via `tooltip-show-help-function'.") + "The last help message received via `tooltip-show-help'.") -(defun tooltip-show-help-function (msg) +(defun tooltip-show-help (msg) "Function installed as `show-help-function'. MSG is either a help string to display, or nil to cancel the display." (let ((previous-help tooltip-help-message)) @@ -499,30 +343,13 @@ MSG is either a help string to display, or nil to cancel the display." (defun tooltip-help-tips (event) "Hook function to display a help tooltip. This is installed on the hook `tooltip-hook', which is run when -the timer with ID `tooltip-timeout-id' fires. +the timer with id `tooltip-timeout-id' fires. Value is non-nil if this function handled the tip." (when (stringp tooltip-help-message) - (tooltip-show tooltip-help-message) + (tooltip-show tooltip-help-message tooltip-use-echo-area) t)) - -;;; Do this after all functions have been defined that are called from -;;; `tooltip-mode'. The actual default value of `tooltip-mode' is set -;;; in startup.el. - -;;;###autoload -(defcustom tooltip-mode nil - "Toggle tooltip-mode. -Setting this variable directly does not take effect; -use either \\[customize] or the function `tooltip-mode'." - :set (lambda (symbol value) - (tooltip-mode (or value 0))) - :initialize 'custom-initialize-default - :type 'boolean - :require 'tooltip - :group 'tooltip) - (provide 'tooltip) -;;; arch-tag: 3d61135e-4618-4a78-af28-183f6df5636f +;; arch-tag: 3d61135e-4618-4a78-af28-183f6df5636f ;;; tooltip.el ends here