From 3bd3e005981bea239d396193b9cca1f8919d25ff Mon Sep 17 00:00:00 2001
From: Po Lu <luangruo@yahoo.com>
Date: Fri, 13 May 2022 19:46:43 +0800
Subject: [PATCH] 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.
---
 etc/NEWS        |  5 +++++
 lisp/tooltip.el | 26 +++++++++++++++++++++-----
 2 files changed, 26 insertions(+), 5 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index e09834c0568..267880ef195 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -2030,6 +2030,11 @@ where 'major-mode' is 'shell-mode' or a combined with a condition like
 Use 'buffer-match-p' to gather a list of buffers that match a
 condition.
 
+---
+** New arguments 'text-face' and 'frame-face' for 'tooltip-show'.
+They allow changing the faces used for the tooltip text and frame
+colors of the resulting tooltip frame from the default 'tooltip' face.
+
 ** Text security and suspiciousness
 
 +++
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
-- 
2.39.2