Add support for user-customizable icons

* doc/emacs/custom.texi (Specific Customization): Mention it.

* doc/emacs/display.texi (Icons): New node.

* doc/lispref/display.texi (Icons): New node.

* lisp/button.el (buttonize):
(button--properties, buttonize-region): Allow not overriding faces.

* lisp/cus-edit.el (custom-save-all): Save icons.
(custom-icon): New widget.
(custom-icon-value-create, custom-toggle-hide-icon)
(custom--icons-widget-value, custom-icon-set): Helper functions
for the widget.
(customize-icon): Main command.
(custom-icon-state-set, custom-icon-state): Helper functions.
(custom-theme-set-icons): Function to be used by theme writers.
(custom-set-icons): Function to be used in .emacs.
(custom-save-icons): New function.

* lisp/custom.el (custom-push-theme): Add icons.

* lisp/emacs-lisp/icons.el: New file.

* test/lisp/emacs-lisp/icons-tests.el: Add some tests.

9 files changed, 822 insertions, 7 deletions

diff --git a/doc/emacs/custom.texi b/doc/emacs/custom.texi
index 46a2291b74d..6ed43bcb790 100644
--- a/doc/emacs/custom.texi
+++ b/doc/emacs/custom.texi
@@ -511,6 +511,9 @@ Set up a customization buffer for just one user option, @var{option}.
 @item M-x customize-face @key{RET} @var{face} @key{RET}
 Set up a customization buffer for just one face, @var{face}.
 
+@item M-x customize-icon @key{RET} @var{face} @key{RET}
+Set up a customization buffer for just one icon, @var{icon}.
+
 @item M-x customize-group @key{RET} @var{group} @key{RET}
 Set up a customization buffer for just one group, @var{group}.
 
diff --git a/doc/emacs/display.texi b/doc/emacs/display.texi
index 96e05a902d6..b87ca81faea 100644
--- a/doc/emacs/display.texi
+++ b/doc/emacs/display.texi
@@ -24,6 +24,7 @@ the text is displayed.
 * Faces::                  How to change the display style using faces.
 * Colors::                 Specifying colors for faces.
 * Standard Faces::         The main predefined faces.
+* Icons::                  How to change how icons look.
 * Text Scale::             Increasing or decreasing text size in a buffer.
 * Font Lock::              Minor mode for syntactic highlighting using faces.
 * Highlight Interactively:: Tell Emacs what text to highlight.
@@ -851,6 +852,38 @@ This face is used to display on text-mode terminals the menu item that
 would be selected if you click a mouse or press @key{RET}.
 @end table
 
+@node Icons
+@section Icons
+
+Emacs sometimes displays clickable buttons (or other informative
+icons), and the look of these can be customized by the user.
+
+@vindex icon-preference
+The main customization point here is the @code{icon-preference} user
+option.  By using this, you can tell Emacs your overall preferences
+for icons.  This is a list of icon types, and the first icon type
+that's supported will be used.  The supported types are:
+
+@table @code
+@item image
+Use an image for the icon.
+
+@item emoji
+Use a colorful emoji for the icon.
+
+@item symbol
+Use a monochrome symbol for the icon.
+
+@item text
+Use a simple text for the icon.
+@end table
+
+In addition, each individual icon can be customized with @kbd{M-x
+customize-icon}, and themes can further alter the looks of the icons.
+
+To get a quick description of an icon, use the @kbd{M-x describe-icon}
+command.
+
 @node Text Scale
 @section Text Scale
 
diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi
index 08bf7441df0..b5e4cb41fdf 100644
--- a/doc/lispref/display.texi
+++ b/doc/lispref/display.texi
@@ -27,6 +27,7 @@ that Emacs presents to the user.
 * Window Dividers::     Separating windows visually.
 * Display Property::    Images, margins, text size, etc.
 * Images::              Displaying images in Emacs buffers.
+* Icons::               Displaying icons in Emacs buffers.
 * Xwidgets::            Displaying native widgets in Emacs buffers.
 * Buttons::             Adding clickable buttons to Emacs buffers.
 * Abstract Display::    Emacs's Widget for Object Collections.
@@ -6979,6 +6980,161 @@ bytes.  An image of size 200x100 with 24 bits per color will have a
 cache size of 60000 bytes, for instance.
 @end defun
 
+@node Icons
+@section Icons
+
+Emacs sometimes uses buttons (for clicking on) or small graphics (to
+illustrate something).  Since Emacs is available on a wide variety of
+systems with different capabilities, and users have different
+preferences, Emacs provides a facility to handle this in a convenient
+way, allowing customization, graceful degradation, accessibility, as
+well as themability: @dfn{Icons}.
+
+The central macro here is @code{define-icon}, and here's a simple
+example:
+
+@lisp
+(define-icon outline-open button
+  '((image "right.svg" "open.xpm" "open.pbm" :height line)
+    (emoji "▶️")
+    (symbol "▶" "➤")
+    (text "open" :face icon-button))
+  "Icon used for buttons for opening a section in outline buffers."
+  :version "29.1"
+  :help-echo "Open this section")
+@end lisp
+
+This is used in tandem with the @code{icon-preference} user option, as
+well as run-time checks for what the current Emacs frame can actually
+display.
+
+The macro in this example defines @code{outline-open} as an icon, and
+inherits properties from the icon called @code{button} (so this is
+meant as a clickable button to be inserted in a buffer).  We then get
+a list of @dfn{icon types} along with the actual icon shapes
+themselves.  In addition, there's a doc string and various keywords
+that contain additional information and properties.
+
+When instantiating an icon you use @code{icon-string}, and this will
+consult the current Customize theming, and the @code{icon-preference}
+user option, and finally what the Emacs is able to actually display.
+If @code{icon-preference} is @code{(image emoji symbol text)} (i.e.,
+allowing all of these forms of icons), in this case,
+@code{icon-string} will first check that Emacs is able to display
+images at all, and then whether it has support for each of those
+different image formats.  If that fails, Emacs will check whether
+Emacs can display emojis (in the current frame).  If that fails, it'll
+check whether it can display the symbol in question.  If that fails,
+it'll use the plain text version.
+
+For instance, if @code{icon-preference} doesn't contain @code{image}
+or @code{emoji}, it'll skip those entries.
+
+Code can confidently call @code{icon-string} in all circumstances and
+be confident that something readable will appear on the screen, no
+matter whether the user is on a graphical terminal or a text terminal,
+and no matter which features Emacs was built with.
+
+@defmac define-icon name parent specs doc &rest keywords
+@var{name} should be a symbol, and is the name of the resulting
+keyword.  @code{icon-string} can later be used to instantiate the
+icon.
+
+This icon will inherit specs from @var{parent}, and recursively from
+the parent's parents, and so on, and the lowest descendent element
+wins.
+
+@var{specs} is a list of specifications.  The first element of each
+specification is the type, and the rest is something that can be used
+as an icon of that type, and then optionally followed by a keyword
+list.  The following types are available:
+
+@table @code
+@item image
+In this case, there may be many images listed as candidates.  Emacs
+will choose the first one that the current Emacs instance can show.
+If an image listed is an absolute file name, it's used as is, but it's
+otherwise looked up in the image load path.
+
+@item emoji
+This should be a (possibly colorful) emoji.
+
+@item symbol
+This should be a (monochrome) symbol.
+
+@item text
+Icons should also have a textual fallback.  This can also be used for
+by the visually impaired: If @code{icon-preference} is just
+@code{(text)}, all icons will be replaced by text.
+@end table
+
+Various keywords may follow the list of icon specifications.  For
+instance:
+
+@example
+(symbol "▶" "➤" :face icon-button)
+@end example
+
+Unknown keywords are ignored.  The following keywords are allowed:
+
+@table @code
+@item :face
+The face to be used.
+
+@item :height
+This is only valid for @code{image} icons, and can be either a number
+(which specifies the height in pixels), or the symbol @code{line},
+which will use the default line height in the currently selected
+window.
+@end table
+
+@var{doc} should be a doc string.
+
+@var{keywords} is a list of keyword/value pairs.  The following
+keywords are allowed:
+
+@table @code
+@item :version
+The (approximate) Emacs version this button first appeared.  (This
+keyword is mandatory.)
+
+@item :group
+The customization group this icon belongs in.  If not present, it is
+inferred.
+
+@item :help-echo
+The help string shown when hovering over the icon with the mouse
+pointer.
+@end table
+@end defmac
+
+@defun icon-string icon
+This function returns a string suitable for display in the current
+buffer for @var{icon}.
+@end defun
+
+@defun icon-elements icon
+Alternatively, you can get a ``deconstructed'' version of @var{icon}
+with this function.  This returns a plist where the keys are
+@code{string}, @code{face} and @var{image}.  (The latter is only
+present if the icon is represented by an image.)  This can be useful
+if the icon isn't to be inserted directly in the buffer, but needs
+some sort of post-processing first.
+@end defun
+
+Icons can be customized with @kbd{M-x customize-icon}.  Themes can
+specify changes to icons with, for instance:
+
+@lisp
+(custom-theme-set-icons
+  'my-theme
+  '(outline-open ((image :height 100)
+                  (text " OPEN ")))
+  '(outline-close ((image :height 100)
+                   (text " CLOSE " :face warning))))
+@end lisp
+
+
 @node Xwidgets
 @section Embedded Native Widgets
 @cindex xwidget
diff --git a/etc/NEWS b/etc/NEWS
index 3941455efc9..3753326a19a 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -2455,6 +2455,11 @@ patcomp.el, pc-mode.el, pc-select.el, s-region.el, and sregex.el.
 * Lisp Changes in Emacs 29.1
 
 +++
+** Emacs now supports user-customizable and themable icons.
+These can be used for buttons in buffers and the like.  See
+'(elisp)Icons' and '(emacs)Icons' for details.
+
++++
 ** New arguments MESSAGE and TIMEOUT of 'set-transient-map'.
 MESSAGE specifies a message to display after activating the transient
 map, including a special formatting spec to list available keys.
diff --git a/lisp/button.el b/lisp/button.el
index 80b73033d68..21047ad5541 100644
--- a/lisp/button.el
+++ b/lisp/button.el
@@ -623,12 +623,15 @@ itself will be used instead as the function argument.
 If HELP-ECHO, use that as the `help-echo' property.
 
 Also see `buttonize-region'."
-  (apply #'propertize string
-         (button--properties callback data help-echo)))
+  (let ((string
+         (apply #'propertize string
+                (button--properties callback data help-echo))))
+    ;; Add the face to the end so that it can be overridden.
+    (add-face-text-property 0 (length string) 'button t string)
+    string))
 
 (defun button--properties (callback data help-echo)
-  (list 'face 'button
-        'font-lock-face 'button
+  (list 'font-lock-face 'button
         'mouse-face 'highlight
         'help-echo help-echo
         'button t
@@ -647,7 +650,8 @@ itself will be used instead as the function argument.
 If HELP-ECHO, use that as the `help-echo' property.
 
 Also see `buttonize'."
-  (add-text-properties start end (button--properties callback data help-echo)))
+  (add-text-properties start end (button--properties callback data help-echo))
+  (add-face-text-property start end 'button t))
 
 (provide 'button)
 
diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el
index 50dce5ee285..9b0d2a10f6b 100644
--- a/lisp/cus-edit.el
+++ b/lisp/cus-edit.el
@@ -139,6 +139,7 @@
 
 (require 'cus-face)
 (require 'wid-edit)
+(require 'icons)
 
 (defvar custom-versions-load-alist)	; from cus-load
 (defvar recentf-exclude)		; from recentf.el
@@ -4849,7 +4850,8 @@ if only the first line of the docstring is shown."))
             (print-escape-control-characters t))
         (atomic-change-group
 	  (custom-save-variables)
-	  (custom-save-faces)))
+	  (custom-save-faces)
+          (custom-save-icons)))
       (let ((file-precious-flag t))
 	(save-buffer))
       (if old-buffer
@@ -5290,6 +5292,290 @@ if that value is non-nil."
 
 (put 'Custom-mode 'mode-class 'special)
 
+;; Icons.
+
+(define-widget 'custom-icon 'custom
+  "A widget for displaying an icon.
+The following properties have special meanings for this widget:
+
+:hidden-states should be a list of widget states for which the
+  widget's initial contents are to be hidden.
+
+:custom-form should be a symbol describing how to display and
+  edit the variable---either `edit' (using edit widgets),
+  `lisp' (as a Lisp sexp), or `mismatch' (should not happen);
+  if nil, use the return value of `custom-variable-default-form'.
+
+:shown-value, if non-nil, should be a list whose `car' is the
+  variable value to display in place of the current value.
+
+:custom-style describes the widget interface style; nil is the
+  default style, while `simple' means a simpler interface that
+  inhibits the magic custom-state widget."
+  :format "%v"
+  :help-echo "Alter or reset this icon."
+  :documentation-property #'icon-documentation
+  :custom-category 'option
+  :custom-state nil
+  :custom-form nil
+  :value-create 'custom-icon-value-create
+  :hidden-states '(standard)
+  :custom-set 'custom-icon-set
+  :custom-reset-current 'custom-redraw
+  :custom-reset-saved 'custom-variable-reset-saved)
+
+(defun custom-icon-value-create (widget)
+  "Here is where you edit the icon's specification."
+  (custom-load-widget widget)
+  (unless (widget-get widget :custom-form)
+    (widget-put widget :custom-form custom-variable-default-form))
+  (let* ((buttons (widget-get widget :buttons))
+	 (children (widget-get widget :children))
+	 (form (widget-get widget :custom-form))
+	 (symbol (widget-get widget :value))
+	 (tag (widget-get widget :tag))
+	 (type '(repeat
+                 (list (choice (const :tag "Images" image)
+                               (const :tag "Colorful Emojis" emoji)
+                               (const :tag "Monochrome Symbols" symbol)
+                               (const :tag "Text Only" text))
+                       (repeat string)
+                       plist)))
+	 (prefix (widget-get widget :custom-prefix))
+	 (last (widget-get widget :custom-last))
+	 (style (widget-get widget :custom-style))
+	 (value (let ((shown-value (widget-get widget :shown-value)))
+		  (cond (shown-value
+			 (car shown-value))
+	                (t (icon-complete-spec symbol nil t)))))
+	 (state (or (widget-get widget :custom-state)
+		    (if (memq (custom-icon-state symbol value)
+			      (widget-get widget :hidden-states))
+			'hidden))))
+
+    ;; Transform the spec into something that agrees with the type.
+    (setq value
+          (mapcar
+           (lambda (elem)
+             (list (car elem)
+                   (icon-spec-values elem)
+                   (icon-spec-keywords elem)))
+           value))
+
+    ;; Now we can create the child widget.
+    (cond ((eq custom-buffer-style 'tree)
+	   (insert prefix (if last " `--- " " |--- "))
+	   (push (widget-create-child-and-convert
+		  widget 'custom-browse-variable-tag)
+		 buttons)
+	   (insert " " tag "\n")
+	   (widget-put widget :buttons buttons))
+	  ((eq state 'hidden)
+	   ;; Indicate hidden value.
+	   (push (widget-create-child-and-convert
+		  widget 'custom-visibility
+		  :help-echo "Show the value of this option."
+		  :on-glyph "down"
+		  :on "Hide"
+		  :off-glyph "right"
+		  :off "Show Value"
+		  :action 'custom-toggle-hide-icon
+		  nil)
+		 buttons)
+	   (insert " ")
+	   (push (widget-create-child-and-convert
+		  widget 'item
+		  :format "%{%t%} "
+		  :sample-face 'custom-variable-tag
+		  :tag tag
+		  :parent widget)
+		 buttons))
+	  (t
+	   ;; Edit mode.
+	   (push (widget-create-child-and-convert
+		  widget 'custom-visibility
+		  :help-echo "Hide or show this option."
+		  :on "Hide"
+		  :off "Show"
+		  :on-glyph "down"
+		  :off-glyph "right"
+		  :action 'custom-toggle-hide-icon
+		  t)
+		 buttons)
+	   (insert " ")
+	   (let* ((format (widget-get type :format))
+                  tag-format)
+             (unless (string-match ":\\s-?" format)
+	       (error "Bad format"))
+	     (setq tag-format (substring format 0 (match-end 0)))
+	     (push (widget-create-child-and-convert
+		    widget 'item
+		    :format tag-format
+		    :action 'custom-tag-action
+		    :help-echo "Change specs of this face."
+		    :mouse-down-action 'custom-tag-mouse-down-action
+		    :button-face 'custom-variable-button
+		    :sample-face 'custom-variable-tag
+		    :tag tag)
+		   buttons)
+	     (push (widget-create-child-and-convert
+		    widget type
+		    :value value)
+		   children))))
+    (unless (eq custom-buffer-style 'tree)
+      (unless (eq (preceding-char) ?\n)
+	(widget-insert "\n"))
+      ;; Create the magic button.
+      (unless (eq style 'simple)
+	(let ((magic (widget-create-child-and-convert
+		      widget 'custom-magic nil)))
+	  (widget-put widget :custom-magic magic)
+	  (push magic buttons)))
+      (widget-put widget :buttons buttons)
+      ;; Insert documentation.
+      (widget-put widget :documentation-indent 3)
+      (unless (and (eq style 'simple)
+		   (eq state 'hidden))
+	(widget-add-documentation-string-button
+	 widget :visibility-widget 'custom-visibility))
+
+      ;; Update the rest of the properties.
+      (widget-put widget :custom-form form)
+      (widget-put widget :children children)
+      ;; Now update the state.
+      (if (eq state 'hidden)
+	  (widget-put widget :custom-state state)
+	(custom-icon-state-set widget))
+      ;; See also.
+      (unless (eq state 'hidden)
+	(when (eq (widget-get widget :custom-level) 1)
+	  (custom-add-parent-links widget))
+	(custom-add-see-also widget)))))
+
+(defun custom-toggle-hide-icon (visibility-widget &rest _ignore)
+  "Toggle the visibility of a `custom-icon' parent widget.
+By default, this signals an error if the parent has unsaved
+changes."
+  (let ((widget (widget-get visibility-widget :parent)))
+    (unless (eq (widget-type widget) 'custom-icon)
+      (error "Invalid widget type"))
+    (custom-load-widget widget)
+    (let ((state (widget-get widget :custom-state)))
+      (if (eq state 'hidden)
+	  (widget-put widget :custom-state 'unknown)
+	;; In normal interface, widget can't be hidden if modified.
+	(when (memq state '(invalid modified set))
+	  (error "There are unsaved changes"))
+	(widget-put widget :custom-state 'hidden))
+      (custom-redraw widget)
+      (widget-setup))))
+
+(defun custom--icons-widget-value (widget)
+  ;; Transform back to the real format.
+  (mapcar
+   (lambda (elem)
+     (cons (nth 0 elem)
+           (append (nth 1 elem) (nth 2 elem))))
+   (widget-value widget)))
+
+(defun custom-icon-set (widget)
+  "Set the current spec for the icon being edited by WIDGET."
+  (let* ((state (widget-get widget :custom-state))
+	 (child (car (widget-get widget :children)))
+	 (symbol (widget-value widget))
+	 val)
+    (when (eq state 'hidden)
+      (user-error "Cannot update hidden icon"))
+
+    (setq val (custom--icons-widget-value child))
+    (unless (equal val (icon-complete-spec symbol))
+      (custom-variable-backup-value widget))
+    (custom-push-theme 'theme-icon symbol 'user 'set val)
+    (custom-redraw-magic widget)))
+
+;;;###autoload
+(defun customize-icon (icon)
+  "Customize ICON."
+  (interactive
+   (let* ((v (symbol-at-point))
+	  (default (and (iconp v) (symbol-name v)))
+	  val)
+     (setq val (completing-read (format-prompt "Customize icon" default)
+		                obarray 'iconp t nil nil default))
+     (list (if (equal val "")
+	       (if (symbolp v) v nil)
+	     (intern val)))))
+  (unless icon
+    (error "No icon specified"))
+  (custom-buffer-create (list (list icon 'custom-icon))
+			(format "*Customize Icon: %s*"
+				(custom-unlispify-tag-name icon))))
+
+(defun custom-icon-state-set (widget &optional state)
+  "Set the state of WIDGET to STATE."
+  (let ((value (custom--icons-widget-value
+                (car (widget-get widget :children)))))
+    (widget-put
+     widget :custom-state
+     (or state
+         (custom-icon-state (widget-value widget) value)))))
+
+(defun custom-icon-state (symbol value)
+  "Return the state of customize icon SYMBOL for VALUE.
+Possible return values are `standard', `saved', `set', `themed',
+and `changed'."
+  (cond
+   ((equal (icon-complete-spec symbol t t) value)
+    'standard)
+   ((equal (icon-complete-spec symbol nil t) value)
+    (if (eq (caar (get symbol 'theme-icon)) 'user)
+        'set
+      'themed))
+   (t 'changed)))
+
+(defun custom-theme-set-icons (theme &rest specs)
+  "Apply a list of icon specs associated with THEME.
+THEME should be a symbol, and SPECS are icon name/spec pairs.
+See `define-icon' for details."
+  (custom-check-theme theme)
+  (pcase-dolist (`(,icon ,spec) specs)
+    (custom-push-theme 'theme-icon icon theme 'set spec)))
+
+(defun custom-set-icons (&rest args)
+  "Install user customizations of icon specs specified in ARGS.
+These settings are registered as theme `user'.
+The arguments should each be a list of the form:
+
+  (SYMBOL EXP)
+
+This stores EXP (without evaluating it) as the saved spec for SYMBOL."
+  (apply #'custom-theme-set-icons 'user args))
+
+;;;###autoload
+(defun custom-save-icons ()
+  "Save all customized icons in `custom-file'."
+  (save-excursion
+    (custom-save-delete 'custom-set-icons)
+    (let ((values nil))
+      (mapatoms
+       (lambda (symbol)
+         (let ((value (car-safe (get symbol 'theme-icon))))
+	   (when (eq (car value) 'user)
+             (push (list symbol (cadr value)) values)))))
+      (ensure-empty-lines)
+      (insert "(custom-set-icons
+ ;; custom-set-icons was added by Custom.
+ ;; If you edit it by hand, you could mess it up, so be careful.
+ ;; Your init file should contain only one such instance.
+ ;; If there is more than one, they won't work right.\n")
+      (dolist (value (sort values (lambda (s1 s2)
+                                    (string< (car s1) (car s2)))))
+	(unless (bolp)
+	  (insert "\n"))
+        (insert "  '")
+        (prin1 value (current-buffer)))
+      (insert ")\n"))))
+
 (provide 'cus-edit)
 
 ;;; cus-edit.el ends here
diff --git a/lisp/custom.el b/lisp/custom.el
index bbbe70c5ea8..5ece5047a86 100644
--- a/lisp/custom.el
+++ b/lisp/custom.el
@@ -910,7 +910,7 @@ symbol `set', then VALUE is the value to use.  If it is the symbol
 `reset', then SYMBOL will be removed from THEME (VALUE is ignored).
 
 See `custom-known-themes' for a list of known themes."
-  (unless (memq prop '(theme-value theme-face))
+  (unless (memq prop '(theme-value theme-face theme-icon))
     (error "Unknown theme property"))
   (let* ((old (get symbol prop))
 	 (setting (assq theme old))  ; '(theme value)
diff --git a/lisp/emacs-lisp/icons.el b/lisp/emacs-lisp/icons.el
new file mode 100644
index 00000000000..da7f68f5231
--- /dev/null
+++ b/lisp/emacs-lisp/icons.el
@@ -0,0 +1,265 @@
+;;; icons.el --- Handling icons  -*- lexical-binding:t -*-
+
+;; Copyright (C) 2022 Free Software Foundation, Inc.
+
+;; Author: Lars Ingebrigtsen <larsi@gnus.org>
+;; Keywords: icons buttons
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Todo: describe-icon
+
+;;; Code:
+
+(require 'cl-lib)
+
+(defface icon
+  '((t :underline nil))
+  "Face for buttons."
+  :version "29.1"
+  :group 'customize)
+
+(defface icon-button
+  '((((type x w32 ns haiku pgtk) (class color))
+     :inherit icon
+     :box (:line-width (3 . -1) :color "#404040" :style flat-button)
+     :background "#808080"
+     :foreground "black"))
+  "Face for buttons."
+  :version "29.1"
+  :group 'customize)
+
+(defcustom icon-preference '(image emoji symbol text)
+  "List of icon types to use, in order of preference.
+Emacs will choose the icon of the highest preference possible
+on the current display, and \"degrade\" gracefully to an icon
+type that's available."
+  :version "29.1"
+  :group 'customize
+  :type '(repeat (const :tag "Images" image)
+                 (const :tag "Colorful Emojis" emoji)
+                 (const :tag "Monochrome Symbols" symbol)
+                 (const :tag "Text Only" text)))
+
+(defmacro define-icon (name parent specification documentation &rest keywords)
+  "Define an icon identified by NAME.
+If non-nil, inherit the specification from PARENT.  Entries from
+SPECIFICATION will override inherited specifications.
+
+SPECIFICATION is an alist of entries where the first element is
+the type, and the rest are icons of that type.  Valid types are
+`image', `emoji', `symbol' and `text'.
+
+KEYWORDS specify additional information.  Valid keywords are:
+
+`:version': The first Emacs version to include this icon; this is
+mandatory.
+
+`:group': The customization group the icon belongs in; this is
+inferred if not present.
+
+`:help-echo': Informational text that explains what happens if
+the icon is used as a button and you click it."
+  (declare (indent 2))
+  (unless (symbolp name)
+    (error "NAME must be a symbol: %S" name))
+  (unless (plist-get keywords :version)
+    (error "There must be a :version keyword in `define-icon'"))
+  `(icons--register ',name ',parent ,specification ,documentation
+                    ',keywords))
+
+(defun icons--register (name parent spec doc keywords)
+  (put name 'icon--properties (list parent spec doc keywords))
+  (custom-add-to-group
+   (or (plist-get keywords :group)
+       (custom-current-group))
+   name 'custom-icon))
+
+(defun icon-spec-keywords (spec)
+  (seq-drop-while (lambda (e) (not (keywordp e))) (cdr spec)))
+
+(defun icon-spec-values (spec)
+  (seq-take-while (lambda (e) (not (keywordp e))) (cdr spec)))
+
+(defun iconp (object)
+  "Return nil if OBJECT is not an icon.
+If OBJECT is an icon, return the icon properties."
+  (get object 'icon--properties))
+
+(defun icon-documentation (icon)
+  "Return the documentation for ICON."
+  (let ((props (iconp icon)))
+    (unless props
+      (user-error "%s is not a valid icon" icon))
+    (nth 2 props)))
+
+(defun icons--spec (icon)
+  (nth 1 (iconp icon)))
+
+(defun icons--copy-spec (spec)
+  (mapcar #'copy-sequence spec))
+
+(defun icon-complete-spec (icon &optional inhibit-theme inhibit-inheritance)
+  "Return the merged spec for ICON."
+  (pcase-let ((`(,parent ,spec _ _) (iconp icon)))
+    ;; We destructively modify `spec' when merging, so copy it.
+    (setq spec (icons--copy-spec spec))
+    ;; Let the Customize theme override.
+    (unless inhibit-theme
+      (when-let ((theme-spec (cadr (car (get icon 'theme-icon)))))
+        (setq spec (icons--merge-spec (icons--copy-spec theme-spec) spec))))
+    ;; Inherit from the parent spec (recursively).
+    (unless inhibit-inheritance
+      (while parent
+        (let ((parent-props (get parent 'icon--properties)))
+          (when parent-props
+            (setq spec (icons--merge-spec spec (cadr parent-props))))
+          (setq parent (car parent-props)))))
+    spec))
+
+(defun icon-string (name)
+  "Return a string suitable for display in the current buffer for icon NAME."
+  (let ((props (iconp name)))
+    (unless props
+      (user-error "%s is not a valid icon" name))
+    (pcase-let ((`(_ ,spec _ ,keywords) props))
+      (setq spec (icon-complete-spec name))
+      ;; We now have a full spec, so check the intersection of what
+      ;; the user wants and what this Emacs is capable of showing.
+      (let ((icon-string
+             (catch 'found
+               (dolist (type icon-preference)
+                 (let* ((type-spec (assq type spec))
+                        ;; Find the keywords at the end of the section
+                        ;; (if any).
+                        (type-keywords (icon-spec-keywords type-spec)))
+                   ;; Go through all the variations in this section
+                   ;; and return the first one we can display.
+                   (dolist (icon (icon-spec-values type-spec))
+                     (when-let ((result
+                                 (icons--create type icon type-keywords)))
+                       (throw 'found
+                              (if-let ((face (plist-get type-keywords :face)))
+                                  (propertize result 'face face)
+                                result)))))))))
+        (unless icon-string
+          (error "Couldn't find any way to display the %s icon" name))
+        (when-let ((help (plist-get keywords :help-echo)))
+          (setq icon-string (propertize icon-string 'help-echo help)))
+        (propertize icon-string 'rear-nonsticky t)))))
+
+(defun icon-elements (name)
+  "Return the elements of icon NAME.
+The elements are represented as a plist where the keys are
+`string', `face' and `display'.  The `image' element is only
+present if the icon is represented by an image."
+  (let ((string (icon-string name)))
+    (list 'face (get-text-property 0 'face string)
+          'image (get-text-property 0 'display string)
+          'string (substring-no-properties string))))
+
+(defun icons--merge-spec (merged parent-spec)
+  (dolist (elem parent-spec)
+    (let ((current (assq (car elem) merged)))
+      (if (not current)
+          ;; Just add the entry.
+          (push elem merged)
+        ;; See if there are any keywords to inherit.
+        (let ((parent-keywords (icon-spec-keywords elem))
+              (current-keywords (icon-spec-keywords current)))
+          (while parent-keywords
+            (unless (plist-get (car parent-keywords) current-keywords)
+              (nconc current (take 2 parent-keywords))
+              (setq parent-keywords (cddr parent-keywords))))))))
+  merged)
+
+(cl-defmethod icons--create ((_type (eql 'image)) icon keywords)
+  (let ((file (if (file-name-absolute-p icon)
+                  icon
+                (image-search-load-path icon))))
+    (and (display-graphic-p)
+         (image-supported-file-p file)
+         (propertize
+          " " 'display
+          (if-let ((height (plist-get keywords :height)))
+              (create-image file
+                            nil nil
+                            :height (if (eq height 'line)
+                                        (window-default-line-height)
+                                      height)
+                            :scale 1)
+            (create-image file))))))
+
+(cl-defmethod icons--create ((_type (eql 'emoji)) icon _keywords)
+  (when-let ((font (and (display-multi-font-p)
+                        (car (internal-char-font nil ?😀)))))
+    (and (font-has-char-p font (aref icon 0))
+         icon)))
+
+(cl-defmethod icons--create ((_type (eql 'symbol)) icon _keywords)
+  (and (cl-every #'char-displayable-p icon)
+       icon))
+
+(cl-defmethod icons--create ((_type (eql 'text)) icon _keywords)
+  icon)
+
+(define-icon button nil
+  '((image :face icon-button)
+    (emoji "🔵" :face icon)
+    (symbol "●" :face icon-button)
+    (text "button" :face icon-button))
+  "Base icon for buttons."
+  :version "29.1")
+
+;;;###autoload
+(defun describe-icon (icon)
+  "Pop to a buffer to describe ICON."
+  (interactive
+   (list (intern (completing-read "Describe icon: " obarray 'iconp t))))
+  (let ((help-buffer-under-preparation t))
+    (help-setup-xref (list #'describe-icon icon)
+		     (called-interactively-p 'interactive))
+    (with-help-window (help-buffer)
+      (with-current-buffer standard-output
+        (insert "Icon: " (symbol-name icon) "\n\n")
+        (insert "Documentation:\n"
+                (substitute-command-keys (icon-documentation icon)))
+        (ensure-empty-lines)
+        (let ((spec (icon-complete-spec icon))
+              (plain (icon-complete-spec icon t t)))
+          (insert "Specification including inheritance and theming:\n")
+          (icons--describe-spec spec)
+          (unless (equal spec plain)
+            (insert "\nSpecification not including inheritance and theming:\n")
+            (icons--describe-spec plain)))))))
+
+(defun icons--describe-spec (spec)
+  (dolist (elem spec)
+    (let ((type (car elem))
+          (values (icon-spec-values elem))
+          (keywords (icon-spec-keywords elem)))
+      (when (or values keywords)
+        (insert (format "\nType: %s\n" type))
+        (dolist (value values)
+          (insert (format "  %s\n" value)))
+        (while keywords
+          (insert (format "    %s: %s\n" (pop keywords) (pop keywords))))))))
+
+(provide 'icons)
+
+;;; icons.el ends here
diff --git a/test/lisp/emacs-lisp/icons-tests.el b/test/lisp/emacs-lisp/icons-tests.el
new file mode 100644
index 00000000000..e6e71a8e4fd
--- /dev/null
+++ b/test/lisp/emacs-lisp/icons-tests.el
@@ -0,0 +1,63 @@
+;;; icons-tests.el --- Tests for icons.el  -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2022 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+(require 'icons)
+(require 'ert)
+(require 'ert-x)
+(require 'cus-edit)
+
+(define-icon icon-test1 nil
+  '((symbol ">")
+    (text "great"))
+  "Test icon"
+  :version "29.1")
+
+(define-icon icon-test2 icon-test1
+  '((text "child"))
+  "Test icon"
+  :version "29.1")
+
+(deftheme test-icons-theme "")
+
+(ert-deftest test-icon-theme ()
+  (let ((icon-preference '(image emoji symbol text)))
+    (should (equal (icon-string 'icon-test1) ">")))
+  (let ((icon-preference '(text)))
+    (should (equal (icon-string 'icon-test1) "great")))
+  (custom-theme-set-icons
+   'test-icons-theme
+   '(icon-test1 ((symbol "<") (text "less"))))
+  (let ((icon-preference '(image emoji symbol text)))
+    (should (equal (icon-string 'icon-test1) ">"))
+    (enable-theme 'test-icons-theme)
+    (should (equal (icon-string 'icon-test1) "<"))))
+
+(ert-deftest test-icon-inheretance ()
+  (let ((icon-preference '(image emoji symbol text)))
+    (should (equal (icon-string 'icon-test2) ">")))
+  (let ((icon-preference '(text)))
+    (should (equal (icon-string 'icon-test2) "child"))))
+
+;;; icons-tests.el ends here