diff options
| author | Stefan Monnier | 2019-06-24 17:15:11 -0400 |
|---|---|---|
| committer | Stefan Monnier | 2019-06-24 17:15:11 -0400 |
| commit | d3ae5e1836eb91be4ca89c7bb83c8d73200f6036 (patch) | |
| tree | b76da525f8b7868eb438f8f3e6dc532ba5a35a7c /lisp | |
| parent | 535051db2a89a9aba615c0c4f385f70e5a77a99d (diff) | |
| download | emacs-d3ae5e1836eb91be4ca89c7bb83c8d73200f6036.tar.gz emacs-d3ae5e1836eb91be4ca89c7bb83c8d73200f6036.zip | |
* lisp/svg.el: Prepare for distribution via GNU ELPA
Add a Version: and Package-Requires:.
Don't require subr-x.
Bring Commentary: from the GNU ELPA version of the package.
(svg-remove): Don't use when-let*.
Diffstat (limited to 'lisp')
| -rw-r--r-- | lisp/svg.el | 50 |
1 files changed, 42 insertions, 8 deletions
diff --git a/lisp/svg.el b/lisp/svg.el index da779728cc1..86b56a03d56 100644 --- a/lisp/svg.el +++ b/lisp/svg.el | |||
| @@ -1,9 +1,11 @@ | |||
| 1 | ;;; svg.el --- SVG image creation functions -*- lexical-binding: t -*- | 1 | ;;; svg.el --- SVG image creation functions -*- lexical-binding: t -*- |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 2016-2019 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2014-2019 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> | 5 | ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> |
| 6 | ;; Keywords: image | 6 | ;; Keywords: image |
| 7 | ;; Version: 1.0 | ||
| 8 | ;; Package-Requires: ((emacs "25")) | ||
| 7 | 9 | ||
| 8 | ;; This file is part of GNU Emacs. | 10 | ;; This file is part of GNU Emacs. |
| 9 | 11 | ||
| @@ -22,12 +24,41 @@ | |||
| 22 | 24 | ||
| 23 | ;;; Commentary: | 25 | ;;; Commentary: |
| 24 | 26 | ||
| 27 | ;; This package allows creating SVG images in Emacs. SVG images are | ||
| 28 | ;; vector-based XML files, really, so you could create them directly | ||
| 29 | ;; as XML. However, that's really tedious, as there are some fiddly | ||
| 30 | ;; bits. | ||
| 31 | |||
| 32 | ;; In addition, the `svg-insert-image' function allows inserting an | ||
| 33 | ;; SVG image into a buffer that's updated "on the fly" as you | ||
| 34 | ;; add/alter elements to the image, which is useful when composing the | ||
| 35 | ;; images. | ||
| 36 | |||
| 37 | ;; Here are some usage examples: | ||
| 38 | |||
| 39 | ;; Create the base image structure, add a gradient spec, and insert it | ||
| 40 | ;; into the buffer: | ||
| 41 | ;; | ||
| 42 | ;; (setq svg (svg-create 800 800 :stroke "orange" :stroke-width 5)) | ||
| 43 | ;; (svg-gradient svg "gradient" 'linear '(0 . "red") '(100 . "blue")) | ||
| 44 | ;; (save-excursion (goto-char (point-max)) (svg-insert-image svg)) | ||
| 45 | |||
| 46 | ;; Then add various elements to the structure: | ||
| 47 | ;; | ||
| 48 | ;; (svg-rectangle svg 100 100 500 500 :gradient "gradient" :id "rec1") | ||
| 49 | ;; (svg-circle svg 500 500 100 :id "circle1") | ||
| 50 | ;; (svg-ellipse svg 100 100 50 90 :stroke "red" :id "ellipse1") | ||
| 51 | ;; (svg-line svg 100 190 50 100 :id "line1" :stroke "yellow") | ||
| 52 | ;; (svg-polyline svg '((200 . 100) (500 . 450) (80 . 100)) | ||
| 53 | ;; :stroke "green" :id "poly1") | ||
| 54 | ;; (svg-polygon svg '((100 . 100) (200 . 150) (150 . 90)) | ||
| 55 | ;; :stroke "blue" :fill "red" :id "gon1") | ||
| 56 | |||
| 25 | ;;; Code: | 57 | ;;; Code: |
| 26 | 58 | ||
| 27 | (require 'cl-lib) | 59 | (require 'cl-lib) |
| 28 | (require 'xml) | 60 | (require 'xml) |
| 29 | (require 'dom) | 61 | (require 'dom) |
| 30 | (eval-when-compile (require 'subr-x)) | ||
| 31 | 62 | ||
| 32 | (defun svg-create (width height &rest args) | 63 | (defun svg-create (width height &rest args) |
| 33 | "Create a new, empty SVG image with dimensions WIDTH x HEIGHT. | 64 | "Create a new, empty SVG image with dimensions WIDTH x HEIGHT. |
| @@ -102,7 +133,7 @@ X/Y denote the center of the ellipse." | |||
| 102 | ,@(svg--arguments svg args))))) | 133 | ,@(svg--arguments svg args))))) |
| 103 | 134 | ||
| 104 | (defun svg-line (svg x1 y1 x2 y2 &rest args) | 135 | (defun svg-line (svg x1 y1 x2 y2 &rest args) |
| 105 | "Create a line of starting in X1/Y1, ending at X2/Y2 in SVG." | 136 | "Create a line starting in X1/Y1, ending at X2/Y2 on SVG." |
| 106 | (svg--append | 137 | (svg--append |
| 107 | svg | 138 | svg |
| 108 | (dom-node 'line | 139 | (dom-node 'line |
| @@ -185,6 +216,9 @@ otherwise. IMAGE-TYPE should be a MIME image type, like | |||
| 185 | (concat "\\`" (regexp-quote (dom-attr node 'id)) | 216 | (concat "\\`" (regexp-quote (dom-attr node 'id)) |
| 186 | "\\'"))))) | 217 | "\\'"))))) |
| 187 | (if old | 218 | (if old |
| 219 | ;; FIXME: This was (dom-set-attributes old (dom-attributes node)) | ||
| 220 | ;; and got changed by commit f7ea7aa11f6211b5142bbcfc41c580d75485ca56 | ||
| 221 | ;; without any explanation. | ||
| 188 | (setcdr (car old) (cdr node)) | 222 | (setcdr (car old) (cdr node)) |
| 189 | (dom-append-child svg node))) | 223 | (dom-append-child svg node))) |
| 190 | (svg-possibly-update-image svg)) | 224 | (svg-possibly-update-image svg)) |
| @@ -284,11 +318,11 @@ If the SVG is later changed, the image will also be updated." | |||
| 284 | 318 | ||
| 285 | (defun svg-remove (svg id) | 319 | (defun svg-remove (svg id) |
| 286 | "Remove the element identified by ID from SVG." | 320 | "Remove the element identified by ID from SVG." |
| 287 | (when-let* ((node (car (dom-by-id | 321 | (let* ((node (car (dom-by-id |
| 288 | svg | 322 | svg |
| 289 | (concat "\\`" (regexp-quote id) | 323 | (concat "\\`" (regexp-quote id) |
| 290 | "\\'"))))) | 324 | "\\'"))))) |
| 291 | (dom-remove-node svg node))) | 325 | (when node (dom-remove-node svg node)))) |
| 292 | 326 | ||
| 293 | (provide 'svg) | 327 | (provide 'svg) |
| 294 | 328 | ||