X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/dea87733323f44f5e665cd7fb23cd78f853a699c..86f0d417c40387dadcba585b37911c86c4a1c56c:/lisp/tooltip.el diff --git a/lisp/tooltip.el b/lisp/tooltip.el index 98aae2e041..59f82c12e3 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 @@ -26,12 +27,7 @@ ;;; Code: -(eval-when-compile - (require 'cl) - (require 'comint) - (require 'gud)) - -(provide 'tooltip) +(eval-when-compile (require 'cl)) ; for case macro ;;; Customizable settings @@ -45,22 +41,18 @@ :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" :type 'number :group 'tooltip) - (defcustom tooltip-short-delay 0.1 "Seconds to wait between subsequent tooltips on different items." :tag "Short delay" :type 'number :group 'tooltip) - (defcustom tooltip-recent-seconds 1 "Display tooltips if changing tip items within this many seconds. Do so after `tooltip-short-delay'." @@ -68,14 +60,12 @@ Do so after `tooltip-short-delay'." :type 'number :group 'tooltip) - (defcustom tooltip-hide-delay 10 "Hide tooltips automatically after this many seconds." :tag "Hide delay" :type 'number :group 'tooltip) - (defcustom tooltip-x-offset nil "X offset, in pixels, for the display of tooltips. The offset is relative to the position of the mouse. It must @@ -90,7 +80,6 @@ the value of `tooltip-x-offset' is ignored." (integer :tag "Offset" :value 1)) :group 'tooltip) - (defcustom tooltip-y-offset nil "Y offset, in pixels, for the display of tooltips. The offset is relative to the position of the mouse. It must @@ -105,7 +94,6 @@ the value of `tooltip-y-offset' is ignored." (integer :tag "Offset" :value 1)) :group 'tooltip) - (defcustom tooltip-frame-parameters '((name . "tooltip") (internal-border-width . 5) @@ -118,34 +106,31 @@ position to pop up the tooltip." :tag "Frame Parameters" :group 'tooltip) - (defface tooltip '((((class color)) - (:background "lightyellow" :foreground "black")) - (t ())) + :background "lightyellow" + :foreground "black" + :inherit variable-pitch) + (t + :inherit variable-pitch)) "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) +(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 overlay-arrow-position))) + (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 @@ -154,7 +139,6 @@ only tooltips in the buffer containing the overlay arrow." :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 @@ -171,19 +155,15 @@ turning off Tooltip mode." Each function is called with one argument EVENT which is a copy of the last mouse movement event that occurred.") - (defvar tooltip-timeout-id nil "The id of the timeout started when Emacs becomes idle.") - (defvar tooltip-last-mouse-motion-event nil "A copy of the last mouse motion event seen.") - (defvar tooltip-hide-time nil "Time when the last tooltip was hidden.") - ;;; Event accessors @@ -193,7 +173,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 @@ -204,27 +183,23 @@ This might return nil if the event did not occur over a buffer." ;; 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 + :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) + (let ((hook-fn (if tooltip-mode 'add-hook 'remove-hook))) (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)) + (setq show-help-function (if tooltip-mode '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 'tooltip-mouse-motion 'ignore)))) ;;; Timeout for tooltip display @@ -238,26 +213,22 @@ With ARG, turn tooltip mode on if and only if ARG is positive." (setq delay tooltip-short-delay)) delay)) - (defun tooltip-cancel-delayed-tip () "Disable the tooltip timeout." (when tooltip-timeout-id (disable-timeout tooltip-timeout-id) (setq tooltip-timeout-id nil))) - (defun tooltip-start-delayed-tip () "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." (run-hook-with-args-until-success 'tooltip-hook tooltip-last-mouse-motion-event)) - ;;; Reacting on mouse movements @@ -265,20 +236,17 @@ With ARG, turn tooltip mode on if and only if ARG is positive." "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))) + (dolist (buffer (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)))))) + (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.") @@ -304,13 +272,12 @@ ACTIVATEP non-nil means activate mouse motion events." (setq tooltip-last-mouse-motion-event (copy-sequence event)) (tooltip-start-delayed-tip))) - ;;; Displaying tips (defun tooltip-set-param (alist key value) "Change the value of KEY in alist ALIST to VALUE. -If there's no association for KEY in ALIST, add one, otherwise +If there's no association for KEY in ALIST, add one, otherwise change the existing association. Value is the resulting alist." (let ((param (assq key alist))) (if (consp param) @@ -318,7 +285,6 @@ change the existing association. Value is the resulting alist." (push (cons key value) alist)) alist)) - (defun tooltip-show (text) "Show a tooltip window displaying TEXT. @@ -346,12 +312,11 @@ position." tooltip-hide-delay tooltip-x-offset tooltip-y-offset)) - (error + (error (message "Error while displaying tooltip: %s" error) (sit-for 1) (message "%s" text))))) - (defun tooltip-hide (&optional ignored-arg) "Hide a tooltip, if one is displayed. Value is non-nil if tooltip was open." @@ -359,7 +324,6 @@ Value is non-nil if tooltip was open." (when (x-hide-tip) (setq tooltip-hide-time (float-time)))) - ;;; Debugger-related functions @@ -375,14 +339,12 @@ is based on the current syntax table." (when (> (point) start) (buffer-substring start (point))))))) - (defmacro tooltip-region-active-p () "Value is non-nil if the region is currently active." (if (string-match "^GNU" (emacs-version)) `(and transient-mark-mode mark-active) `(region-active-p))) - (defun tooltip-expr-to-print (event) "Return an expression that should be printed for EVENT. If a region is active and the mouse is inside the region, print @@ -396,7 +358,6 @@ where the mouse is." (buffer-substring (region-beginning) (region-end))) (tooltip-identifier-from-point point))))) - (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 @@ -411,7 +372,6 @@ of PROCESS." (setq prompt-regexp "\\*")) (concat "\n*" prompt-regexp "$"))) - (defun tooltip-strip-prompt (process output) "Return OUTPUT with any prompt of PROCESS stripped from its end." (let ((prompt-regexp (tooltip-process-prompt-regexp process))) @@ -420,24 +380,20 @@ 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) @@ -446,13 +402,17 @@ This event can be examined by forms in TOOLTIP-GUD-DISPLAY.") (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." @@ -465,7 +425,6 @@ If TOOLTIP-GUD-DEREFERENCE is t, also prepend a `*' to 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 @@ -473,12 +432,11 @@ 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) + (let (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)) + (setq process (get-buffer-process gud-comint-buffer)) (posn-point (event-end event)) (progn (setq tooltip-gud-event event) (eval (cons 'and tooltip-gud-display)))) @@ -486,10 +444,21 @@ This function must return nil if it doesn't handle EVENT." (when expr (let ((cmd (tooltip-gud-print-command expr))) (unless (null cmd) ; CMD can be nil if unknown debugger - (setq tooltip-gud-original-filter (process-filter process)) - (set-process-filter process 'tooltip-gud-process-output) - (gud-basic-call cmd) - expr))))))) + (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-use-echo-area + (substring string 0 (- (length string) 1)))))) ;;; Tooltip help. @@ -497,7 +466,6 @@ This function must return nil if it doesn't handle EVENT." (defvar tooltip-help-message nil "The last help message received via `tooltip-show-help-function'.") - (defun tooltip-show-help-function (msg) "Function installed as `show-help-function'. MSG is either a help string to display, or nil to cancel the display." @@ -512,12 +480,11 @@ MSG is either a help string to display, or nil to cancel the display." ;; Keep what we have. ) (t - ;; A different help. Remove a previous tooltip, and + ;; A different help. Remove a previous tooltip, and ;; display a new one, with some delay. (tooltip-hide) (tooltip-start-delayed-tip))))) - (defun tooltip-help-tips (event) "Hook function to display a help tooltip. This is installed on the hook `tooltip-hook', which is run when @@ -527,23 +494,7 @@ Value is non-nil if this function handled the tip." (tooltip-show tooltip-help-message) t)) +(provide 'tooltip) - -;;; 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) - - +;; arch-tag: 3d61135e-4618-4a78-af28-183f6df5636f ;;; tooltip.el ends here