# HG changeset patch # User Gerd Moellmann # Date 978617257 0 # Node ID f7ca93e40e16c73d728bde98f4dc3853bf17fa6e # Parent 3088c9745e92bccb510211f83de2a27a76ee18ca (tooltip-frame-parameters): Remove colors. (tooltip): New face (tooltip-set-param): New function. (tooltip-show): Set up color frame parameters from face `tooltip'. Display the tooltip text in face `tooltip'. diff -r 3088c9745e92 -r f7ca93e40e16 lisp/tooltip.el --- a/lisp/tooltip.el Thu Jan 04 13:55:37 2001 +0000 +++ b/lisp/tooltip.el Thu Jan 04 14:07:37 2001 +0000 @@ -100,10 +100,7 @@ (defcustom tooltip-frame-parameters '((name . "tooltip") - (foreground-color . "black") - (background-color . "lightyellow") (internal-border-width . 5) - (border-color . "lightyellow") (border-width . 1)) "Frame parameters used for tooltips." :type 'sexp @@ -111,6 +108,14 @@ :group 'tooltip) +(defface tooltip + '((((class color)) + (:background "lightyellow" :foreground "black")) + (t ())) + "Face for tooltips." + :group 'tooltip) + + (defcustom tooltip-gud-tips-p nil "*Non-nil means show tooltips in GUD sessions." :type 'boolean @@ -306,17 +311,36 @@ ;;; Displaying tips +(defun tooltip-set-param (alist key value) + "Change the value of KEY in alist ALIAS to VALUE. +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) + (setcdr param value) + (push (cons key value) alist)) + alist)) + + (defun tooltip-show (text) "Show a tooltip window at the current mouse position displaying TEXT." (if tooltip-use-echo-area (message "%s" text) (condition-case error - (x-show-tip text - (selected-frame) - tooltip-frame-parameters - nil - tooltip-x-offset - tooltip-y-offset) + (let ((params (copy-sequence tooltip-frame-parameters)) + (fg (face-attribute 'tooltip :foreground)) + (bg (face-attribute 'tooltip :background))) + (unless (eq 'unspecified fg) + (tooltip-set-param params 'foreground-color fg)) + (unless (eq 'unspecified bg) + (tooltip-set-param params 'background-color bg) + (tooltip-set-param params 'border-color bg)) + (x-show-tip (propertize text 'face 'tooltip) + (selected-frame) + tooltip-frame-parameters + nil + tooltip-x-offset + tooltip-y-offset)) (error (message "Error while displaying tooltip: %s" error) (sit-for 1)