procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Add support for user-customizable icons

Browse source 
* 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.
This commit is contained in:
Lars Ingebrigtsen 2022-07-28 14:31:33 +02:00
parent 163424e04b
commit 601737d750
9 changed files with 822 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
doc/emacs/custom.texi
View file

@ -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}.

33
doc/emacs/display.texi
View file

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

156
doc/lispref/display.texi
View file

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

5
etc/NEWS
View file

@ -2454,6 +2454,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

14
lisp/button.el
View file

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

288
lisp/cus-edit.el
View file

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

2
lisp/custom.el
View file

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

265
lisp/emacs-lisp/icons.el Normal file
View file

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

63
test/lisp/emacs-lisp/icons-tests.el Normal file
View file

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