(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 --git a/lisp/tooltip.el b/lisp/tooltip.el
index e02eec718846b489a0fe98ba223f460898db6228..408943f0048ce5ee856a15ceb31b768e4196abd7 100644 (file)
--- a/lisp/tooltip.el
+++ b/lisp/tooltip.el
@@ -100,10 +100,7 @@ when it pops up."
 
 (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 @@ when it pops up."
   :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 @@ ACTIVATEP non-nil means activate mouse motion events."
 \f
 ;;; 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)