branch: externals/svg-lib
commit 04fdd1a49910d5a38f59328c951f200bfdff159d
Author: Nicolas P. Rougier <nicolas.roug...@inria.fr>
Commit: Nicolas P. Rougier <nicolas.roug...@inria.fr>
Added svg-lib-concat function for org-mode demo
---
README.org | 3 ++-
svg-lib-demo.org | 65 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
svg-lib.el | 40 ++++++++++++++++++++++++++++++++++
3 files changed, 107 insertions(+), 1 deletion(-)
diff --git a/README.org b/README.org
index fc8478c..ac6cb9a 100644
--- a/README.org
+++ b/README.org
@@ -6,8 +6,9 @@ namely tags, progress bars and icons. Each object is guaranteed
to fit
nicely in a text buffer ensuring width is an integer multiple of
charater width.
-
*** Usage example
+[[file:screenshot-2.png]]
+
[[file:screenshot.png]]
diff --git a/svg-lib-demo.org b/svg-lib-demo.org
new file mode 100644
index 0000000..0019c54
--- /dev/null
+++ b/svg-lib-demo.org
@@ -0,0 +1,65 @@
+
+* Code
+#+begin_src lisp
+(require 'svg-lib)
+
+(defvar svg-font-lock-keywords
+ `(("TODO"
+ (0 (list 'face nil 'display (svg-font-lock-todo))))
+ ("DONE"
+ (0 (list 'face nil 'display (svg-font-lock-done))))
+ ("\\[\\([0-9]\\{1,3\\}\\)%\\]"
+ (0 (list 'face nil 'display (svg-font-lock-progress_percent (match-string
1)))))
+ ("\\[\\([0-9]+/[0-9]+\\)\\]"
+ (0 (list 'face nil 'display (svg-font-lock-progress_count (match-string
1)))))))
+
+(defun svg-font-lock-todo ()
+ (svg-lib-tag "TODO" nil :margin 0
+ :font-family "Roboto Mono" :font-weight 500
+ :foreground "#FFFFFF" :background "#673AB7"))
+
+(defun svg-font-lock-done ()
+ (svg-lib-tag "DONE" nil :margin 0
+ :font-family "Roboto Mono" :font-weight 400
+ :foreground "#B0BEC5" :background "white"))
+
+(defun svg-font-lock-progress_percent (value)
+ (svg-image (svg-lib-concat
+ (svg-lib-progress (/ (string-to-number value) 100.0)
+ nil :margin 0 :stroke 2 :radius 3 :padding 2
:width 12)
+ (svg-lib-tag (concat value "%")
+ nil :stroke 0 :margin 0)) :ascent 'center))
+
+(defun svg-font-lock-progress_count (value)
+ (let* ((seq (mapcar #'string-to-number (split-string value "/")))
+ (count (float (car seq)))
+ (total (float (cadr seq))))
+ (svg-image (svg-lib-concat
+ (svg-lib-progress (/ count total)
+ nil :stroke 2 :radius 3 :padding 2 :width 12)
+ (svg-lib-tag value
+ nil :stroke 0 :margin 0)) :ascent 'center)))
+
+;; Activate
+(push 'display font-lock-extra-managed-props)
+(font-lock-add-keywords nil svg-font-lock-keywords)
+(font-lock-flush (point-min) (point-max))
+
+;; Deactivate
+;; (font-lock-remove-keywords nil svg-font-lock-keywords)
+;; (font-lock-flush (point-min) (point-max))
+
+#+end_src
+
+
+* Progress count: [1/3]
+
+ - [X] DONE Sub-task 1
+ - [ ] TODO Sub-task 2
+ - [ ] TODO Sub-task 5
+
+* Progress percent: [100%]
+
+ - [X] DONE Sub-task 1
+ - [X] DONE Sub-task 2
+ - [X] TODO Sub-task 3
diff --git a/svg-lib.el b/svg-lib.el
index 93ff745..5ee0bba 100644
--- a/svg-lib.el
+++ b/svg-lib.el
@@ -68,6 +68,9 @@
;;; Code:
(require 'svg)
+(require 'xml)
+(require 'cl-lib)
+
(defgroup svg-lib nil
"SVG tags, bars & icons."
@@ -482,5 +485,42 @@ and style elements ARGS."
+(defun svg-lib-concat (svg-image-1 svg-image-2)
+ "Concatenate two svg images horizontally."
+
+ (let* ((svg (car (with-temp-buffer
+ (insert (plist-get (cdr svg-image-1) :data))
+ (xml-parse-region (point-min) (point-max)))))
+ (attrs (xml-node-attributes svg))
+ (width-1 (string-to-number (cdr (assq 'width attrs))))
+ (height-1 (string-to-number (cdr (assq 'height attrs))))
+ (children-1 (xml-node-children svg))
+
+ (svg (car (with-temp-buffer
+ (insert (plist-get (cdr svg-image-2) :data))
+ (xml-parse-region (point-min) (point-max)))))
+ (attrs (xml-node-attributes svg))
+ (width-2 (string-to-number (cdr (assq 'width attrs))))
+ (height-2 (string-to-number (cdr (assq 'height attrs))))
+ (children-2 (xml-node-children svg))
+
+ (width (+ width-1 width-2))
+ (height (max height-1 height-2))
+ (transform (format "translate(%f,0)" width-1))
+ (svg (svg-create width height)))
+
+ (dolist (child children-1)
+ (dom-append-child svg child))
+
+ (dolist (child children-2)
+ (if (not (stringp child))
+ (dom-set-attribute child 'transform transform))
+ (dom-append-child svg child))
+ svg))
+
(provide 'svg-lib)
;;; svg-lib.el ends here
+
+
+
+
