Allow changing the face used for text and frame colors in tooltips

* etc/NEWS: Announce new arguments to `tooltip-show'.
* lisp/tooltip.el (tooltip-show): Accept new arguments
`text-face' and `frame-face'.  Use them to display text and
determine the foreground, background and border colors of the
tooltip frame respectively.

1 files changed, 21 insertions, 5 deletions

diff --git a/lisp/tooltip.el b/lisp/tooltip.el
index e24d03b8e87..0e7d333f974 100644
--- a/lisp/tooltip.el
+++ b/lisp/tooltip.el
@@ -230,7 +230,7 @@ change the existing association.  Value is the resulting alist."
 (declare-function x-show-tip "xfns.c"
 		  (string &optional frame parms timeout dx dy))
 
-(defun tooltip-show (text &optional use-echo-area)
+(defun tooltip-show (text &optional use-echo-area text-face frame-face)
   "Show a tooltip window displaying TEXT.
 
 Text larger than `x-max-tooltip-size' is clipped.
@@ -241,14 +241,29 @@ is displayed.  Otherwise, the tooltip pops at offsets specified by
 `tooltip-x-offset' and `tooltip-y-offset' from the current mouse
 position.
 
+The text properties of TEXT are also modified to add the
+appropriate faces before displaying the tooltip.  If your code
+depends on them, you should copy the tooltip string before
+passing it to this function.
+
 Optional second arg USE-ECHO-AREA non-nil means to show tooltip
-in echo area."
+in echo area.
+
+The third and fourth args TEXT-FACE and FRAME-FACE specify faces
+used to display the tooltip, and default to `tooltip' if not
+specified.  TEXT-FACE specifies a face used to display text in
+the tooltip, while FRAME-FACE specifies a face that provides the
+background, foreground and border colors of the tooltip frame.
+
+Note that the last two arguments are not respected when
+`use-system-tooltips' is non-nil and Emacs is built with support
+for system tooltips."
   (if use-echo-area
       (tooltip-show-help-non-mode text)
     (condition-case error
 	(let ((params (copy-sequence tooltip-frame-parameters))
-	      (fg (face-attribute 'tooltip :foreground))
-	      (bg (face-attribute 'tooltip :background)))
+	      (fg (face-attribute (or frame-face 'tooltip) :foreground))
+	      (bg (face-attribute (or frame-face 'tooltip) :background)))
 	  (when (stringp fg)
 	    (setf (alist-get 'foreground-color params) fg)
 	    (setf (alist-get 'border-color params) fg))
@@ -258,7 +273,8 @@ in echo area."
           ;; faces used in our TEXT.  Among other things, this allows
           ;; tooltips to use the `help-key-binding' face used in
           ;; `substitute-command-keys' substitutions.
-          (add-face-text-property 0 (length text) 'tooltip t text)
+          (add-face-text-property 0 (length text)
+                                  (or text-face 'tooltip) t text)
           (x-show-tip text
 		      (selected-frame)
 		      params