X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/ffe832ea680b4820f5ff399191f7f2d41350ee2e..0b22a5e17ba44f559664af2d59c4828bfe56baaa:/lisp/tooltip.el diff --git a/lisp/tooltip.el b/lisp/tooltip.el index 253ce48e8e..d30579a704 100644 --- a/lisp/tooltip.el +++ b/lisp/tooltip.el @@ -8,10 +8,10 @@ ;; This file is part of GNU Emacs. -;; GNU Emacs is free software; you can redistribute it and/or modify +;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of @@ -19,9 +19,7 @@ ;; GNU General Public License for more details. ;; 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., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -67,7 +65,7 @@ the help text in the echo area, and does not make a pop-up window." (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))) + (if tooltip-mode 'tooltip-show-help 'tooltip-show-help-non-mode))) ;;; Customizable settings @@ -178,12 +176,10 @@ This might return nil if the event did not occur over a buffer." (defun tooltip-delay () "Return the delay in seconds for the next tooltip." - (let ((delay tooltip-delay) - (now (float-time))) - (when (and tooltip-hide-time - (< (- now tooltip-hide-time) tooltip-recent-seconds)) - (setq delay tooltip-short-delay)) - delay)) + (if (and tooltip-hide-time + (< (- (float-time) tooltip-hide-time) tooltip-recent-seconds)) + tooltip-short-delay + tooltip-delay)) (defun tooltip-cancel-delayed-tip () "Disable the tooltip timeout." @@ -214,6 +210,9 @@ change the existing association. Value is the resulting alist." (push (cons key value) alist)) alist)) +(declare-function x-show-tip "xfns.c" + (string &optional frame parms timeout dx dy)) + (defun tooltip-show (text &optional use-echo-area) "Show a tooltip window displaying TEXT. @@ -228,7 +227,7 @@ position. Optional second arg USE-ECHO-AREA non-nil means to show tooltip in echo area." (if use-echo-area - (message "%s" text) + (tooltip-show-help-non-mode text) (condition-case error (let ((params (copy-sequence tooltip-frame-parameters)) (fg (face-attribute 'tooltip :foreground)) @@ -249,6 +248,8 @@ in echo area." (sit-for 1) (message "%s" text))))) +(declare-function x-hide-tip "xfns.c" ()) + (defun tooltip-hide (&optional ignored-arg) "Hide a tooltip, if one is displayed. Value is non-nil if tooltip was open." @@ -280,8 +281,7 @@ is based on the current syntax table." If a region is active and the mouse is inside the region, print the region. Otherwise, figure out the identifier around the point where the mouse is." - (save-excursion - (set-buffer (tooltip-event-buffer event)) + (with-current-buffer (tooltip-event-buffer event) (let ((point (posn-point (event-end event)))) (if (tooltip-region-active-p) (when (and (<= (region-beginning) point) (<= point (region-end))) @@ -292,23 +292,22 @@ where the mouse is." "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." - (let ((prompt-regexp (save-excursion - (set-buffer (process-buffer process)) + (let ((prompt-regexp (with-current-buffer (process-buffer process) comint-prompt-regexp))) - ;; Most start with `^' but the one for `sdb' cannot be easily - ;; stripped. Code the prompt for `sdb' fixed here. - (if (= (aref prompt-regexp 0) ?^) - (setq prompt-regexp (substring prompt-regexp 1)) - (setq prompt-regexp "\\*")) - (concat "\n*" prompt-regexp "$"))) + (concat "\n*" + ;; Most start with `^' but the one for `sdb' cannot be easily + ;; stripped. Code the prompt for `sdb' fixed here. + (if (= (aref prompt-regexp 0) ?^) + (substring prompt-regexp 1) + "\\*") + "$"))) (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))) - (save-match-data - (when (string-match prompt-regexp output) - (setq output (substring output 0 (match-beginning 0))))) - output)) + (save-match-data + (if (string-match (tooltip-process-prompt-regexp process) output) + (substring output 0 (match-beginning 0)) + output))) ;;; Tooltip help. @@ -316,6 +315,31 @@ the buffer of PROCESS." (defvar tooltip-help-message nil "The last help message received via `tooltip-show-help'.") +(defvar tooltip-previous-message nil + "The previous content of the echo area.") + +(defun tooltip-show-help-non-mode (help) + "Function installed as `show-help-function' when tooltip is off." + (when (and (not (window-minibuffer-p)) ;Don't overwrite minibuffer contents. + ;; Don't know how to reproduce it in Elisp: + ;; Don't overwrite a keystroke echo. + ;; (NILP (echo_message_buffer) || ok_to_overwrite_keystroke_echo) + (not cursor-in-echo-area)) ;Don't overwrite a prompt. + (cond + ((stringp help) + (unless tooltip-previous-message + (setq tooltip-previous-message (current-message))) + (let ((message-truncate-lines t) + (message-log-max nil)) + (message "%s" (replace-regexp-in-string "\n" ", " help)))) + ((stringp tooltip-previous-message) + (let ((message-log-max nil)) + (message "%s" tooltip-previous-message) + (setq tooltip-previous-message nil))) + (t + (message nil))))) + + (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."