changeset 35043:f7ca93e40e16

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

--- 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)