[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/svg-lib a1e260709e 2/8: Added face-or-style option to c
|
From: |
ELPA Syncer |
|
Subject: |
[elpa] externals/svg-lib a1e260709e 2/8: Added face-or-style option to creation functions |
|
Date: |
Sun, 31 Dec 2023 06:58:38 -0500 (EST) |
branch: externals/svg-lib
commit a1e260709ec36592c14c4062cd1748844f3f1ba8
Author: Nicolas P. Rougier <Nicolas.Rougier@inria.fr>
Commit: Nicolas P. Rougier <Nicolas.Rougier@inria.fr>
Added face-or-style option to creation functions
---
svg-lib.el | 183 ++++++++++++++++++++++---------------------------------------
1 file changed, 65 insertions(+), 118 deletions(-)
diff --git a/svg-lib.el b/svg-lib.el
index df4349595a..f57bfed533 100644
--- a/svg-lib.el
+++ b/svg-lib.el
@@ -289,7 +289,7 @@ If COLOR-NAME is unknown to Emacs, then return COLOR-NAME
as-is."
(defun svg-lib-style-from-face (face &rest args)
"Return a style from FACE and style element ARGS"
-
+
(let* ((font-family (face-attribute face :family nil 'default))
(font-weight (face-attribute face :weight nil 'default))
(font-size (face-attribute face :height nil 'default))
@@ -304,8 +304,7 @@ If COLOR-NAME is unknown to Emacs, then return COLOR-NAME
as-is."
:font-size ,font-size
:font-weight ,font-weight))
(base svg-lib-style-default)
- (keys (cl-loop for (key _value)
- on base by 'cddr collect key)))
+ (keys (cl-loop for (key _value) on base by 'cddr collect key)))
(dolist (key keys)
(cond ((plist-member args key)
@@ -315,32 +314,30 @@ If COLOR-NAME is unknown to Emacs, then return COLOR-NAME
as-is."
(svg-lib-style style)))
;; Create an image displaying LABEL in a rounded box.
-(defun svg-lib-tag (label &optional style &rest args)
- "Create an image displaying LABEL in a rounded box using given STYLE
-and style elements ARGS."
+(defun svg-lib-tag (label &optional face-or-style &rest args)
+ "Create an image displaying LABEL in a rounded box using given FACE-OR-STYLE
+and additional style elements ARGS."
(let* ((default svg-lib-style-default)
- (style (if style (apply #'svg-lib-style nil style) default))
- (style (if args (apply #'svg-lib-style style args) style))
-
+ (style (cond ((facep face-or-style)
+ (apply #'svg-lib-style-from-face face-or-style args))
+ (face-or-style
+ (apply #'svg-lib-style style args))
+ (t
+ svg-lib-style-default)))
(foreground (plist-get style :foreground))
(background (plist-get style :background))
-
(crop-left (plist-get style :crop-left))
(crop-right (plist-get style :crop-right))
-
(alignment (plist-get style :alignment))
(stroke (plist-get style :stroke))
- ;; (width (plist-get style :width))
(height (plist-get style :height))
(radius (plist-get style :radius))
- ;; (scale (plist-get style :scale))
(margin (plist-get style :margin))
(padding (plist-get style :padding))
(font-size (plist-get style :font-size))
(font-family (plist-get style :font-family))
(font-weight (plist-get style :font-weight))
-
(txt-char-width (window-font-width))
(txt-char-height (window-font-height))
(txt-char-height (if line-spacing
@@ -350,18 +347,14 @@ and style elements ARGS."
(font-size (aref font-info 2)) ;; redefine font-size
(ascent (aref font-info 8))
(tag-char-width (aref font-info 11))
- ;; (tag-char-height (aref font-info 3))
(tag-width (* (+ (length label) padding) txt-char-width))
(tag-height (* txt-char-height height))
-
(svg-width (+ tag-width (* margin txt-char-width)))
(svg-height tag-height)
(svg-ascent (plist-get style :ascent))
-
(tag-x (* (- svg-width tag-width) alignment))
(text-x (+ tag-x (/ (- tag-width (* (length label) tag-char-width))
2)))
(text-y ascent)
-
(tag-x (if crop-left (- tag-x txt-char-width) tag-x))
(tag-width (if crop-left (+ tag-width txt-char-width) tag-width))
(text-x (if crop-left (- text-x (/ stroke 2)) text-x))
@@ -382,58 +375,40 @@ and style elements ARGS."
(svg-lib--image svg :ascent svg-ascent)))
-;; Create a progress pie
-(defun svg-lib-progress-pie (value &optional style &rest args)
- "Create a progress pie image with value VALUE using given STYLE
-and style elements ARGS."
+(defun svg-lib-progress-pie (value &optional face-or-style &rest args)
+ "Create a progress pie image with value VALUE using given FACE-OR-STYLE
+and additional style elements ARGS."
(let* ((default svg-lib-style-default)
- (style (if style (apply #'svg-lib-style nil style) default))
- (style (if args (apply #'svg-lib-style style args) style))
-
+ (style (cond ((facep face-or-style)
+ (apply #'svg-lib-style-from-face face-or-style args))
+ (face-or-style
+ (apply #'svg-lib-style style args))
+ (t
+ svg-lib-style-default)))
(foreground (plist-get style :foreground))
(background (plist-get style :background))
(stroke (plist-get style :stroke))
- ;; (width (plist-get style :width))
(height (plist-get style :height))
- ;; (scale (plist-get style :scale))
(margin (plist-get style :margin))
(padding (plist-get style :padding))
- ;; (font-size (plist-get style :font-size))
- ;; (font-family (plist-get style :font-family))
- ;; (font-weight (plist-get style :font-weight))
-
(txt-char-width (window-font-width))
(txt-char-height (window-font-height))
-
- ;; (font-info (font-info (format "%s-%d" font-family
font-size)))
- ;; (ascent (aref font-info 8))
- ;; (tag-char-width (aref font-info 11))
- ;; (tag-char-height (aref font-info 3))
-
(tag-width (* 2 txt-char-width))
(tag-height (* txt-char-height height))
-
(svg-width (+ tag-width (* margin txt-char-width)))
(svg-height tag-height)
(svg-ascent (plist-get style :ascent))
-
- ;; (tag-x (/ (- svg-width tag-width) 2))
-
(cx (/ svg-width 2))
(cy (/ svg-height 2))
(radius (- (/ tag-height 2) (/ stroke 2)))
-
(iradius (- radius stroke (/ padding 2)))
-
(angle0 (- (/ float-pi 2)))
(x0 (+ cx (* iradius (cos angle0))))
(y0 (+ cy (* iradius (sin angle0))))
-
(angle1 (+ angle0 (* value 2 float-pi)))
(x1 (+ cx (* iradius (cos angle1))))
(y1 (+ cy (* iradius (sin angle1))))
-
(large-arc (>= (- angle1 angle0) float-pi))
(svg (svg-create svg-width svg-height)))
@@ -454,42 +429,32 @@ and style elements ARGS."
;; Create a progress bar
-(defun svg-lib-progress-bar (value &optional style &rest args)
- "Create a progress bar image with value VALUE using given STYLE
-and style elements ARGS."
+(defun svg-lib-progress-bar (value &optional face-or-style &rest args)
+ "Create a progress bar image with value VALUE using given FACE-OR-STYLE
+and additional style elements ARGS."
(let* ((default svg-lib-style-default)
- (style (if style (apply #'svg-lib-style nil style) default))
- (style (if args (apply #'svg-lib-style style args) style))
-
+ (style (cond ((facep face-or-style)
+ (apply #'svg-lib-style-from-face face-or-style args))
+ (face-or-style
+ (apply #'svg-lib-style style args))
+ (t
+ svg-lib-style-default)))
(foreground (plist-get style :foreground))
(background (plist-get style :background))
(stroke (plist-get style :stroke))
(width (plist-get style :width))
(height (plist-get style :height))
(radius (plist-get style :radius))
- ;; (scale (plist-get style :scale))
(margin (plist-get style :margin))
(padding (plist-get style :padding))
- ;; (font-size (plist-get style :font-size))
- ;; (font-family (plist-get style :font-family))
- ;; (font-weight (plist-get style :font-weight))
-
(txt-char-width (window-font-width))
(txt-char-height (window-font-height))
-
- ;; (font-info (font-info (format "%s-%d" font-family
font-size)))
- ;; (ascent (aref font-info 8))
- ;; (tag-char-width (aref font-info 11))
- ;; (tag-char-height (aref font-info 3))
-
(tag-width (* width txt-char-width))
(tag-height (* txt-char-height height))
-
(svg-width (+ tag-width (* margin txt-char-width)))
(svg-height tag-height)
- (svg-ascent (plist-get style :ascent))
-
+ (svg-ascent (plist-get style :ascent))
(tag-x (/ (- svg-width tag-width) 2))
(svg (svg-create svg-width svg-height)))
@@ -509,8 +474,6 @@ and style elements ARGS."
(svg-lib--image svg :ascent svg-ascent)))
-
-
;; Create a rounded box icon
(defun svg-lib--icon-get-data (collection name &optional force-reload)
"Retrieve icon NAME from COLLECTION.
@@ -536,17 +499,19 @@ Cached version is returned if it exists unless
FORCE-RELOAD is t."
(xml-parse-region (point-min) (point-max))))))
-(defun svg-lib-icon (icon &optional style &rest args)
+(defun svg-lib-icon (icon &optional face-or-style &rest args)
"Create a SVG image displaying icon NAME from COLLECTION using
-given STYLE and style elements ARGS."
+given FACE-OR-STYLE and additional style elements ARGS."
(let* ((default svg-lib-style-default)
- (style (if style (apply #'svg-lib-style nil style) default))
- (style (if args (apply #'svg-lib-style style args) style))
-
+ (style (cond ((facep face-or-style)
+ (apply #'svg-lib-style-from-face face-or-style args))
+ (face-or-style
+ (apply #'svg-lib-style style args))
+ (t
+ svg-lib-style-default)))
(collection (plist-get style :collection))
(root (svg-lib--icon-get-data collection icon))
-
(foreground (plist-get style :foreground))
(background (plist-get style :background))
(stroke (plist-get style :stroke))
@@ -555,11 +520,7 @@ given STYLE and style elements ARGS."
(scale (plist-get style :scale))
(margin (plist-get style :margin))
(padding (plist-get style :padding))
- ;; (font-size (plist-get style :font-size))
- ;; (font-family (plist-get style :font-family))
- ;; (font-weight (plist-get style :font-weight))
- (width (+ 2 padding))
-
+ (width (+ 2 padding))
(txt-char-width (window-font-width))
(txt-char-height (window-font-height))
(box-width (* width txt-char-width))
@@ -569,8 +530,6 @@ given STYLE and style elements ARGS."
(svg-ascent (plist-get style :ascent))
(box-x (/ (- svg-width box-width) 2))
(box-y 0)
-
- ;; Read original viewbox
(viewbox (cdr (assq 'viewBox (xml-node-attributes (car root)))))
(viewbox (mapcar #'string-to-number (split-string viewbox)))
(icon-x (nth 0 viewbox))
@@ -611,21 +570,22 @@ given STYLE and style elements ARGS."
;; Create an image displaying LABEL in a rounded box.
-(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."
+(defun svg-lib-icon+tag (icon label &optional face-or-style &rest args)
+ "Create an image displaying LABEL in a rounded box using given FACE-OR-STYLE
+and additional style elements ARGS."
(let* ((default svg-lib-style-default)
- (style (if style (apply #'svg-lib-style nil style) default))
- (style (if args (apply #'svg-lib-style style args) style))
-
+ (style (cond ((facep face-or-style)
+ (apply #'svg-lib-style-from-face face-or-style args))
+ (face-or-style
+ (apply #'svg-lib-style style args))
+ (t
+ svg-lib-style-default)))
(collection (plist-get style :collection))
- (root (svg-lib--icon-get-data collection icon))
-
+ (root (svg-lib--icon-get-data collection icon))
(foreground (plist-get style :foreground))
(background (plist-get style :background))
(stroke (plist-get style :stroke))
- ;; (width (plist-get style :width))
(height (plist-get style :height))
(radius (plist-get style :radius))
(scale (plist-get style :scale))
@@ -634,31 +594,21 @@ and style elements ARGS."
(font-size (plist-get style :font-size))
(font-family (plist-get style :font-family))
(font-weight (plist-get style :font-weight))
-
(label-length (+ (length label) 2))
-
(txt-char-width (window-font-width))
(txt-char-height (window-font-height))
- ;; (box-width (* width txt-char-width))
- ;; (box-height (* height txt-char-height))
-
(font-info (font-info (format "%s-%d" font-family font-size)))
(ascent (aref font-info 8))
(tag-char-width (aref font-info 11))
- ;; (tag-char-height (aref font-info 3))
(tag-width (* (+ label-length padding) txt-char-width))
(tag-height (* txt-char-height height))
-
(svg-width (+ tag-width (* margin txt-char-width)))
(svg-height tag-height)
(svg-ascent (plist-get style :ascent))
-
(tag-x (/ (- svg-width tag-width) 2))
(text-x (+ tag-x (/ (- tag-width (* (length label) tag-char-width))
2)))
(text-x (+ text-x tag-char-width))
(text-y ascent)
-
- ;; ;; Read original viewbox
(viewbox (cdr (assq 'viewBox (xml-node-attributes (car root)))))
(viewbox (mapcar 'string-to-number (split-string viewbox)))
(icon-x (nth 0 viewbox))
@@ -697,41 +647,43 @@ and style elements ARGS."
(svg-lib--image svg :ascent svg-ascent)))
-
-(defun svg-lib-date (&optional date style &rest args)
+(defun svg-lib-date (&optional date face-or-style &rest args)
"Create a two lines date icon showing given DATE, using given
-STYLE and style elements ARGS."
+FACE-OR-STYLE and additional style elements ARGS."
(let* ((date (or date (current-time)))
(month (upcase (format-time-string "%b" date)))
(day (format-time-string "%d" date)))
- (apply 'svg-lib-box month day style args)))
+ (apply 'svg-lib-box month day face-or-style args)))
-(defun svg-lib-week-date (&optional date style &rest args)
+(defun svg-lib-week-date (&optional date face-or-style &rest args)
"Create a two lines date icon showing given DATE, using given
-STYLE and style elements ARGS."
+FACE-OR-STYLE and additional style elements ARGS."
(let* ((date (or date (current-time)))
(week (format-time-string "%W" date)))
- (apply 'svg-lib-box "WEEK" week style args)))
+ (apply 'svg-lib-box "WEEK" week face-or-style args)))
-(defun svg-lib-day-date (&optional date style &rest args)
+(defun svg-lib-day-date (&optional date face-or-style &rest args)
"Create a two lines date icon showing given DATE, using given
-STYLE and style elements ARGS."
+FACE-OR-STYLE and additional style elements ARGS."
(let* ((weekday (upcase (format-time-string "%a" date)))
(day (format-time-string "%d" date)))
- (apply 'svg-lib-box weekday day style args)))
+ (apply 'svg-lib-box weekday day face-or-style args)))
-(defun svg-lib-box (top bottom &optional style &rest args)
+(defun svg-lib-box (top bottom &optional face-or-style &rest args)
"Create a two lines icon showing given TOP and BOTTOM text, using
given STYLE and style elements ARGS."
(let* ((default svg-lib-style-default)
- (style (if style (apply #'svg-lib-style nil style) default))
- (style (if args (apply #'svg-lib-style style args) style))
-
+ (style (cond ((facep face-or-style)
+ (apply #'svg-lib-style-from-face face-or-style args))
+ (face-or-style
+ (apply #'svg-lib-style style args))
+ (t
+ svg-lib-style-default)))
(foreground (plist-get style :foreground))
(background (plist-get style :background))
(stroke (plist-get style :stroke))
@@ -739,21 +691,16 @@ given STYLE and style elements ARGS."
(height (or (plist-get args :height) 2))
(radius (plist-get style :radius))
(margin (plist-get style :margin))
-
(font-size (plist-get style :font-size))
(font-family (plist-get style :font-family))
-
(txt-char-width (window-font-width))
(txt-char-height (window-font-height))
-
(tag-width (* width txt-char-width))
-
(tag-height (* height txt-char-height))
(svg-width (+ tag-width (* margin txt-char-width)))
(svg-height tag-height)
(svg-ascent (or (plist-get style :ascent) 'center))
(tag-x (/ (- svg-width tag-width) 2) )
-
(svg (svg-create svg-width svg-height)))
(when (>= stroke 0.25)
- [elpa] externals/svg-lib updated (d00a253d26 -> 84ccfb89b9), ELPA Syncer, 2023/12/31
- [elpa] externals/svg-lib 34a8b5eb4d 3/8: Fixed wrong calls to svg-lib-style, ELPA Syncer, 2023/12/31
- [elpa] externals/svg-lib a1e260709e 2/8: Added face-or-style option to creation functions,
ELPA Syncer <=
- [elpa] externals/svg-lib f5a94060f2 5/8: Fix when no face-or-style given, ELPA Syncer, 2023/12/31
- [elpa] externals/svg-lib 2f96456b73 6/8: Fix default button style, ELPA Syncer, 2023/12/31
- [elpa] externals/svg-lib 242df4055e 7/8: Make svg-lib-tag more generic (can now create tag, icon or icon+tag), ELPA Syncer, 2023/12/31
- [elpa] externals/svg-lib 84ccfb89b9 8/8: Bugfix with default style with args, ELPA Syncer, 2023/12/31
- [elpa] externals/svg-lib c4711970c9 1/8: Added function to create style from face, ELPA Syncer, 2023/12/31
- [elpa] externals/svg-lib 56265a91de 4/8: Can now specify face or style for buttons, ELPA Syncer, 2023/12/31