(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'.

1 files changed, 33 insertions, 9 deletions

diff --git a/lisp/tooltip.el b/lisp/tooltip.el
index e02eec71884..408943f0048 100644
--- 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."
 
 ;;; 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)