[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/svg-lib f2cc9615ef 3/4: Added interactive buttons (icon
|
From: |
ELPA Syncer |
|
Subject: |
[elpa] externals/svg-lib f2cc9615ef 3/4: Added interactive buttons (icon+tag) |
|
Date: |
Fri, 29 Dec 2023 06:58:45 -0500 (EST) |
branch: externals/svg-lib
commit f2cc9615ef3a052747135d34f31c423a26592f14
Author: Nicolas P. Rougier <Nicolas.Rougier@inria.fr>
Commit: Nicolas P. Rougier <Nicolas.Rougier@inria.fr>
Added interactive buttons (icon+tag)
---
README.org | 134 ++++++++++++++++++++++++++--
svg-lib-demo.el | 10 ++-
svg-lib.el | 271 +++++++++++++++++++++++++++++++++++++++++++++++++++++++-
3 files changed, 402 insertions(+), 13 deletions(-)
diff --git a/README.org b/README.org
index 912603eba1..c640e8c071 100644
--- a/README.org
+++ b/README.org
@@ -1,18 +1,138 @@
-*** SVG Library
+* SVG Library
-A small Emacs library to create and display various SVG objects,
-namely tags, progress bars, progress pies and icons. Each object is
-guaranteed to fit nicely in a text buffer ensuring width is an integer
-multiple of character width.
+svg-lib is an Emacs library that allows to create and display various
+SVG objects, namely tags, icons, buttons, progress bars, progress pies
+and dates. Each object is guaranteed to fit nicely in a text buffer
+ensuring width is a multiple of character width and height a multiple
+of character height.
-*** Installation
+* Installation
#+begin_src elisp
M-x package-install RET svg-lib RET
#+end_src
-*** Usage example
+* Quick start
+
+For the impatient, evaluate the following expression:
+
+#+begin_src emacs-lisp
+M-: (insert-image (svg-lib-tag "TODO"))
+#+end_src
+
+This should insert a SVG tag displaying "TODO" in a rounded box whose
+size is exactly 5 characters wide (because of padding).
+
+* Usage
+
+** Objects
+
+- =svg-lib-tag LABEL=
+- =svg-lib-icon ICON=
+- =svg-lib-icon+tag ICON LABEL=
+- =svg-lib-button LABEL HOOK=
+- =svg-lib-progress-bar VALUE=
+- =svg-lib-progress-pie VALUE=
+- =svg-lib-date DATE=
+
+** Styling
+
+Each library object can be styled using a style property list that
+defines:
+
+- foreground color
+- background color
+- internal padding (tag and icon)
+- external margin (in char)
+- stroke width (in pixels)
+- corner radius (in pixels) for the rounded box
+- horizontal alignment (0 to 1) inside margins
+- width (in characters)
+- height as a scale of line height
+- scale (for icon)
+- ascent (for text)
+- crop-left to crop object on the left
+- crop-right to crop object on the right
+- collection to use for icon
+- font family
+- font size
+- font weight
+
+* Icon repositories
+
+Icons can be created by parsing remote collections whose license are
+compatibles with GNU Emacs. The default size of an icon is exactly 2x1
+characters such that it can be inserted inside a text without
+disturbing alignment.
+
+Each icon is cached locally to speed-up loading the next time you use
+it. If for some reason the cache is corrupted you can force reload
+using the svg-icon-get-data function. If you want to add new
+collections (i.e. URL), make sure the icons are monochrome, that their
+size is consistent and that they include a 'viewBox' node.
+
+** [[https://pictogrammers.com/library/mdi/][Material Design]] (7447 icons)
+
+Open-source iconography for designers and developers.
+
+- Version: 7.4.47 (December 2023)
+- Licence: Apache 2.0
+- Number of icons: 7447
+- Sources: https://github.com/Templarian/MaterialDesign
+- Collection: =material=
+
+** [[https://simpleicons.org/][Simple icons]] (2926 icons)
+
+Over 2900 Free SVG icons for popular brands.
+
+- Version: 10.4.0 (December 2023)
+- Licence: CC0-1.0 license
+- Number of icons: 2926
+- Sources: https://github.com/twbs/icons
+- Collection: =simple=
+
+** [[https://icons.getbootstrap.com/][Bootstrap]] (> 2000 icons)
+
+Official open source SVG icon library for Bootstrap.
+
+- Version: 1.11.2 (December 2023)
+- Licence: MIT License
+- Number of icons: > 2000
+- Sources: https://github.com/twbs/icons
+- Collection: =bootstrap=
+
+** [[https://boxicons.com/][Boxicons]] (1634 icons)
+
+Simple Open Source icons carefully crafted for designers & developers.
+
+- Version: 2.1.4 (September 2022)
+- Licence: MIT License
+- Number of icons: 1634
+- Sources: https://github.com/atisawd/boxicons.
+- Collection: =boxicons=
+
+** [[https://primer.style/octicons][Octicons]] (322 icons)
+
+Octicons are a set of SVG icons built by GitHub for GitHub.
+
+- Version: 19.8.0 (September 2023)
+- Licence: MIT License
+- Number of icons: 322
+- Sources: https://github.com/primer/octicons
+- Collection: =octicons=
+
+**
[[https://www.figma.com/community/file/768673354734944365/visual-studio-code-icons][VSCode]]
(209 icons)
+
+Icons used in Visual Studio Code.
+
+- Version: (September 2020)
+- Licence: CC-BY 4.0
+- Number of icons: 209
+- Sources: https://github.com/microsoft/vscode-icons
+- Collection: =vscode=
+
+* Screenshots
[[file:screenshot.png]]
diff --git a/svg-lib-demo.el b/svg-lib-demo.el
index f1350fca80..f611f41766 100644
--- a/svg-lib-demo.el
+++ b/svg-lib-demo.el
@@ -52,10 +52,10 @@
(insert-image (svg-lib-icon "star" nil :scale (/ (+ i 1) 10.0))))
-(insert-image (svg-lib-button "check-bold" "DONE" nil
+(insert-image (svg-lib-icon+tag "check-bold" "DONE" nil
:font-family "Roboto Mono"
:font-weight 500
- :stroke 0 :background "#673AB7" :foreground "white"))
+ :stroke 0 :background "#673AB7" :foreground
"white"))
(insert-image (svg-lib-icon "gnuemacs" nil :collection "simple"
@@ -65,5 +65,9 @@
(insert-image (svg-lib-date nil nil :font-family "Roboto" :radius 5
:foreground "#673AB7"))
-
+(svg-lib-button-mode 1)
+(insert (svg-lib-button "[check-bold] OK"
+ (lambda () (interactive) (message "OK"))))
+
+
diff --git a/svg-lib.el b/svg-lib.el
index a53f23dfdc..79928d6d42 100644
--- a/svg-lib.el
+++ b/svg-lib.el
@@ -4,7 +4,7 @@
;; Maintainer: Nicolas P. Rougier <Nicolas.Rougier@inria.fr>
;; URL: https://github.com/rougier/svg-lib
-;; Version: 0.2.8
+;; Version: 0.3
;; Package-Requires: ((emacs "27.1"))
;; Keywords: svg, icons, tags, convenience
@@ -67,6 +67,11 @@
;;; NEWS:
+;; Version 0.3
+;; - Renamed 'svg-lib-button' to 'svg-lib-icon+tag'
+;; - Added interactive 'svg-lib-button' with associtated 'svg-lib-button-mode'
+;; - Added proper documentation in the README
+
;; Version 0.2.8
;; - No background for icon when background color is nil
;; - Refactored date icons
@@ -114,6 +119,33 @@
:group 'convenience
:prefix "svg-lib-")
+(defface svg-lib-button-active-face
+ `((t :foreground ,(face-foreground 'default)
+ :background ,(face-background 'default)
+ :family "RobotoMono Nerd Font"
+ :weight regular
+ :box (:line-width 2 :style nil)))
+ "Default face for active button"
+ :group 'svg-lib)
+
+(defface svg-lib-button-hover-face
+ `((t :foreground ,(face-background 'font-lock-comment-face nil 'default)
+ :background ,(face-foreground 'font-lock-comment-face nil 'default)
+ :family "RobotoMono Nerd Font"
+ :weight semibold
+ :box nil))
+ "default face for when mouse is over the button"
+ :group 'svg-lib)
+
+(defface svg-lib-button-press-face
+ `((t :foreground ,(face-background 'default)
+ :background ,(face-foreground 'default)
+ :family "RobotoMono Nerd Font"
+ :weight semibold
+ :box nil))
+ "Default face for when button is prssed (mouse click or keyboard)"
+ :group 'svg-lib)
+
;; Default icon collections
;; ---------------------------------------------------------------------
(defcustom svg-lib-icon-collections
@@ -485,7 +517,6 @@ given STYLE and style elements ARGS."
(collection (plist-get style :collection))
(root (svg-lib--icon-get-data collection icon))
-
(foreground (plist-get style :foreground))
(background (plist-get style :background))
@@ -551,7 +582,7 @@ given STYLE and style elements ARGS."
;; Create an image displaying LABEL in a rounded box.
-(defun svg-lib-button (icon label &optional style &rest args)
+(defun svg-lib-icon+tag (icon label &optional style &rest args)
"Create an image displaying LABEL in a rounded box using given STYLE
and style elements ARGS."
@@ -771,6 +802,240 @@ given STYLE and style elements ARGS."
(dom-append-child svg child))
svg))
+
+(defvar svg-lib-button--id-counter 0
+ "SVG button unique id counter")
+
+(defun svg-lib-button--search (id)
+ "Return region for the button with given ID"
+
+ (save-excursion
+ (goto-char (point-min))
+ (save-match-data
+ (when-let* ((match (text-property-search-forward 'button-id id t)))
+ (cons (prop-match-beginning match)
+ (prop-match-end match))))))
+
+(defun svg-lib-button--at-point (&optional pos)
+ "Return the button at point"
+ (get-text-property (or pos (point)) 'button-id))
+
+(defun svg-lib-button--get-state (id &optional region)
+ "Return the state of button ID"
+
+ (when-let* ((region (or region (svg-lib-button--search id))))
+ (get-text-property (car region) 'button-state)))
+
+(defun svg-lib-button--set-state (id state &optional no-reset)
+ "Set the state of button ID to STATE, reset the state of any
+hovered button unless NO-RESET is t"
+
+ ;; Reset previous hover button state (if any)
+ (when (and (boundp 'svg-lib-button--hover-id) svg-lib-button--hover-id (not
no-reset))
+ (let ((prev-id svg-lib-button--hover-id))
+ (setq-local svg-lib-button--hover-id nil)
+ (svg-lib-button--set-state prev-id 'active)))
+
+ ;; Set new state
+ (when-let* ((region (svg-lib-button--search id))
+ (cur-state (svg-lib-button--get-state id region))
+ (button-list (get-text-property (car region) 'button-list))
+ (display (cdr (assoc state button-list))))
+ (put-text-property (car region) (cdr region) 'display display)
+ (put-text-property (car region) (cdr region) 'button-state state)
+ (cond ((eq state 'hover)
+ (setq-local svg-lib-button--hover-id id))
+ ((eq state 'press)
+ (setq-local svg-lib-button--press-id id)))))
+
+(defun svg-lib-button--tooltip-hide (&rest args)
+ "Set currently press or hightlighted button to default
+state (active) and hover button at point if any."
+
+ (when (boundp 'svg-lib-button--press-id)
+ (svg-lib-button--set-state svg-lib-button--press-id 'active))
+ (when (boundp 'svg-lib-button--hover-id)
+ (svg-lib-button--set-state svg-lib-button--hover-id 'active))
+
+ ;; Hover button at point (if any)
+ (svg-lib-button--set-state (svg-lib-button--at-point) 'hover)
+ (advice-remove 'tooltip-hide #'svg-lib-button--tooltip-hide))
+
+(defun svg-lib-button--tooltip-show (pos)
+ "Set button under mouse state to hover or press depending
+on whether mouse button 1 is down (press) or up (hover)"
+
+ (if (and (consp last-input-event)
+ (string-match-p "down-mouse-1" (format "%s" (car
last-input-event))))
+ (svg-lib-button--set-state (svg-lib-button--at-point pos) 'press)
+ (svg-lib-button--set-state (svg-lib-button--at-point pos) 'hover))
+ (advice-add 'tooltip-hide :before #'svg-lib-button--tooltip-hide))
+
+(defun svg-lib-button--mouse-down ()
+ "Set button under mouse state to press."
+
+ (interactive)
+ (save-excursion
+ (mouse-set-point last-input-event)
+ (svg-lib-button--set-state (svg-lib-button--at-point) 'press))
+ (advice-add 'tooltip-hide :before #'svg-lib-button--tooltip-hide))
+
+(defun svg-lib-button--mouse-press ()
+ "Set button under mouse state to default state (active) and call
+button hook. If current buffer is minibuffer, it aborts it. It
+would be better to simply exit minibuffer but this leads to focus
+problem if the hook creates a frame."
+
+ (interactive)
+
+ ;; Here we check if mouse is still over the button
+ (let ((mouse-point (save-excursion
+ (mouse-set-point last-input-event)
+ (point))))
+ (if-let ((id (svg-lib-button--at-point mouse-point)))
+ (svg-lib-button--set-state svg-lib-button--press-id 'hover)
+ (svg-lib-button--set-state svg-lib-button--press-id 'active)))
+
+ (when-let* ((region (svg-lib-button--search svg-lib-button--press-id))
+ (hook (get-text-property (car region) 'button-hook)))
+ (if (minibufferp nil t)
+ (unwind-protect
+ (abort-minibuffers)
+ (funcall hook))
+ (funcall hook))))
+
+(defun svg-lib-button--mouse-drag ()
+ "Update the state of the button under mouse"
+
+ (interactive)
+ (save-excursion
+ (mouse-set-point last-input-event)
+ (svg-lib-button--set-state (svg-lib-button--at-point) 'press)))
+
+(defun svg-lib-button--make (label &optional face)
+ "Return a svg tag with given LABEL and FACE. LABEL can be composed
+as \"[collection:icon] label\" resulting in an icon+tag button."
+
+ (save-match-data
+ (let* ((face (or face 'default))
+ (label-regex "\\[\\([a-zA-Z0-9]+:\\)?\\([a-zA-Z0-9 _-]+\\)\\]
*\\(.+\\)"))
+ (if (string-match label-regex label)
+ (let* ((collection (match-string 1 label))
+ (collection (if (stringp collection)
+ (substring collection 0 -1)
+ (plist-get svg-lib-style-default ':collection)))
+ (icon (match-string 2 label))
+ (label (match-string 3 label)))
+ (svg-lib-icon+tag icon label nil
+ :collection collection
+ :stroke (or (plist-get (face-attribute face
:box) ':line-width) 0)
+ :font-family (face-attribute face :family nil t)
+ :font-weight (face-attribute face :weight nil t)
+ :foreground (face-foreground face nil 'default)
+ :background (face-background face nil 'default)))
+ (svg-lib-tag label nil
+ :stroke (or (plist-get (face-attribute face :box)
':line-width) 0)
+ :font-family (face-attribute face :family nil t)
+ :font-weight (face-attribute face :weight nil t)
+ :foreground (face-foreground face nil 'default)
+ :background (face-background face nil 'default))))))
+
+
+(defun svg-lib-button (label &optional hook help active-face hover-face
press-face)
+ "Make a button with given LABEL that will call HOOK when
+pressed. The HELP text is displatyed when mouse is hovering the
+button. ACTIVE-FACE, HOVER-FACE and PRESS-FACE correspond to the
+different states of the button. LABEL can be composed as
+\"[collection:icon] label\" resulting in an icon+tag button.
+
+For proper highlighting, `svg-lib-button-mode' needs to be
+activated before inserting a button into a buffer."
+
+ ;; Having a SVG button highlighted when mouse cursor is hovering is
+ ;; not totally straightforward because Emacs lacks the proper
+ ;; machinery to do so. There is actually a mouse-face property but it
+ ;; only changes the face and cannot change the display property (that
+ ;; is needed for SVG). To solve the problem, we can take advantage of
+ ;; the tooltip machinery because it offers a hackable enter/exit event
+ ;; that can be used to update the display at the proper time.
+ ;;
+ ;; To make this works, a few properties needs to be removed from
+ ;; `font-lock-extra-managed-props' and `yank-excluded-properties'.
+ ;; For org-mode, another hack is necessary because when org-mode
+ ;; unfontifies a region (see `org-unfontify-region'), it removes the
+ ;; local keymap that is used. You thus need to activate the
+ ;; svg-lib-button-mode to have this set for you.
+
+ (let* ((active (svg-lib-button--make label
+ (or active-face 'svg-lib-button-active-face)))
+ (hover (svg-lib-button--make label
+ (or hover-face 'svg-lib-button-hover-face)))
+ (press (svg-lib-button--make label
+ (or press-face 'svg-lib-button-press-face)))
+ (buttons `((active . ,active)
+ (hover . ,hover)
+ (press . ,press)))
+ (state 'active))
+ (setq svg-lib-button--id-counter (1+ svg-lib-button--id-counter))
+ (propertize (concat label " ")
+ 'display (cdr (assoc state buttons))
+ 'svg-lib-button t
+ 'button-id svg-lib-button--id-counter
+ 'button-state state
+ 'button-list buttons
+ 'button-hook hook
+ 'front-sticky nil
+ 'rear-nonsticky t
+ 'keymap (define-keymap :suppress t
+ "<down-mouse-1>" #'svg-lib-button--mouse-down
+ "<mouse-1>" #'svg-lib-button--mouse-press
+ "<drag-mouse-1>" #'svg-lib-button--mouse-drag)
+ 'help-echo `(lambda (_window _object pos)
+ (svg-lib-button--tooltip-show pos)
+ ,help)
+ 'pointer 'hand)))
+
+(defun svg-lib-button--remove-text-properties (orig-fun beg end properties
&optional object)
+ "This advice function ensures keymap is not removed when in
svg-lib-button-mode"
+
+ (let ((properties (if (and svg-lib-button-mode (derived-mode-p 'org-mode))
+ (org-plist-delete properties 'keymap)
+ properties)))
+ (apply orig-fun (list beg end properties object))))
+
+(define-minor-mode svg-lib-button-mode
+ "Activate svg-lib-button-mode that takes care of activating tooltip
+mode and removing some properties from `yank-excluded-properties'
+and `font-lock-extra-managed-props' in order for highlight to
+work properly. This mode also installs an advice on
+`remove-text-properties' in org-mode in order to not delete the
+`keymap' property that is necessary to detect mouse press events."
+
+ :lighter "B"
+
+ (when svg-lib-button-mode
+ ;; This is necessary for detecting when mouse cursor enter or
+ ;; leave a button
+ (require 'tooltip)
+ (tooltip-mode 1)
+
+ ;; This is necessary for preventing org-mode to remove keymap when
+ ;; unfontiying a region
+ (advice-add #'remove-text-properties :around
#'svg-lib-button--remove-text-properties)
+
+ ;; This prevents help-echo to be removed.when button is copied/yanked
+ (dolist (property '(help-echo keymap))
+ (setq-local yank-excluded-properties
+ (remove property yank-excluded-properties)))
+
+ ;; This prevents help-echo to be removed.by font-lock
+ (dolist (property '(help-echo keymap display))
+ (setq-local font-lock-extra-managed-props
+ (remove property font-lock-extra-managed-props))))
+
+ (unless svg-lib-button-mode
+ (advice-remove #'remove-text-properties
#'svg-lib-button--remove-text-properties)))
+
(provide 'svg-lib)
;;; svg-lib.el ends here