aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2021-04-24 14:07:12 -0400
committerStefan Monnier2021-04-24 14:07:12 -0400
commitd398eca44e119d60f21494a34050e6ca5bc9df8b (patch)
tree40a4551eeda016b791991e6d9a31523d31f34171
parentdec8a4775d665168d03693ef1aea99981f13b30a (diff)
downloademacs-d398eca44e119d60f21494a34050e6ca5bc9df8b.tar.gz
emacs-d398eca44e119d60f21494a34050e6ca5bc9df8b.zip
* lisp/svg.el: Fix typo in sample code; add minor optimization
(svg--elliptical-arc-command, svg--moveto-command) (svg--lineto-command): Use `mapcan`.
-rw-r--r--lisp/svg.el48
1 files changed, 22 insertions, 26 deletions
diff --git a/lisp/svg.el b/lisp/svg.el
index 717c84788f0..05accf4f13f 100644
--- a/lisp/svg.el
+++ b/lisp/svg.el
@@ -41,7 +41,7 @@
41;; into the buffer: 41;; into the buffer:
42;; 42;;
43;; (setq svg (svg-create 800 800 :stroke "orange" :stroke-width 5)) 43;; (setq svg (svg-create 800 800 :stroke "orange" :stroke-width 5))
44;; (svg-gradient svg "gradient" 'linear '(0 . "red") '(100 . "blue")) 44;; (svg-gradient svg "gradient" 'linear '((0 . "red") (100 . "blue")))
45;; (save-excursion (goto-char (point-max)) (svg-insert-image svg)) 45;; (save-excursion (goto-char (point-max)) (svg-insert-image svg))
46 46
47;; Then add various elements to the structure: 47;; Then add various elements to the structure:
@@ -81,7 +81,7 @@ STOPS is a list of percentage/color pairs."
81 (svg--def 81 (svg--def
82 svg 82 svg
83 (apply 83 (apply
84 'dom-node 84 #'dom-node
85 (if (eq type 'linear) 85 (if (eq type 'linear)
86 'linearGradient 86 'linearGradient
87 'radialGradient) 87 'radialGradient)
@@ -358,8 +358,7 @@ This is in contrast to merely setting it to 0."
358 (plist-get command-args :default-relative)))) 358 (plist-get command-args :default-relative))))
359 (intern (if relative (downcase char) (upcase char))))) 359 (intern (if relative (downcase char) (upcase char)))))
360 360
361(defun svg--elliptical-arc-coordinates 361(defun svg--elliptical-arc-coordinates (rx ry x y &rest args)
362 (rx ry x y &rest args)
363 (list 362 (list
364 rx ry 363 rx ry
365 (or (plist-get args :x-axis-rotation) 0) 364 (or (plist-get args :x-axis-rotation) 0)
@@ -370,21 +369,19 @@ This is in contrast to merely setting it to 0."
370(defun svg--elliptical-arc-command (coordinates-list &rest args) 369(defun svg--elliptical-arc-command (coordinates-list &rest args)
371 (cons 370 (cons
372 (svg--path-command-symbol 'a args) 371 (svg--path-command-symbol 'a args)
373 (apply 'append 372 (mapcan
374 (mapcar 373 (lambda (coordinates)
375 (lambda (coordinates) 374 (apply #'svg--elliptical-arc-coordinates
376 (apply 'svg--elliptical-arc-coordinates 375 coordinates))
377 coordinates)) 376 coordinates-list)))
378 coordinates-list))))
379 377
380(defun svg--moveto-command (coordinates-list &rest args) 378(defun svg--moveto-command (coordinates-list &rest args)
381 (cons 379 (cons
382 (svg--path-command-symbol 'm args) 380 (svg--path-command-symbol 'm args)
383 (apply 'append 381 (mapcan
384 (mapcar 382 (lambda (coordinates)
385 (lambda (coordinates) 383 (list (car coordinates) (cdr coordinates)))
386 (list (car coordinates) (cdr coordinates))) 384 coordinates-list)))
387 coordinates-list))))
388 385
389(defun svg--closepath-command (&rest args) 386(defun svg--closepath-command (&rest args)
390 (list (svg--path-command-symbol 'z args))) 387 (list (svg--path-command-symbol 'z args)))
@@ -392,11 +389,10 @@ This is in contrast to merely setting it to 0."
392(defun svg--lineto-command (coordinates-list &rest args) 389(defun svg--lineto-command (coordinates-list &rest args)
393 (cons 390 (cons
394 (svg--path-command-symbol 'l args) 391 (svg--path-command-symbol 'l args)
395 (apply 'append 392 (mapcan
396 (mapcar 393 (lambda (coordinates)
397 (lambda (coordinates) 394 (list (car coordinates) (cdr coordinates)))
398 (list (car coordinates) (cdr coordinates))) 395 coordinates-list)))
399 coordinates-list))))
400 396
401(defun svg--horizontal-lineto-command (coordinate-list &rest args) 397(defun svg--horizontal-lineto-command (coordinate-list &rest args)
402 (cons 398 (cons
@@ -411,24 +407,24 @@ This is in contrast to merely setting it to 0."
411(defun svg--curveto-command (coordinates-list &rest args) 407(defun svg--curveto-command (coordinates-list &rest args)
412 (cons 408 (cons
413 (svg--path-command-symbol 'c args) 409 (svg--path-command-symbol 'c args)
414 (apply 'append coordinates-list))) 410 (apply #'append coordinates-list)))
415 411
416(defun svg--smooth-curveto-command (coordinates-list &rest args) 412(defun svg--smooth-curveto-command (coordinates-list &rest args)
417 (cons 413 (cons
418 (svg--path-command-symbol 's args) 414 (svg--path-command-symbol 's args)
419 (apply 'append coordinates-list))) 415 (apply #'append coordinates-list)))
420 416
421(defun svg--quadratic-bezier-curveto-command (coordinates-list 417(defun svg--quadratic-bezier-curveto-command (coordinates-list
422 &rest args) 418 &rest args)
423 (cons 419 (cons
424 (svg--path-command-symbol 'q args) 420 (svg--path-command-symbol 'q args)
425 (apply 'append coordinates-list))) 421 (apply #'append coordinates-list)))
426 422
427(defun svg--smooth-quadratic-bezier-curveto-command (coordinates-list 423(defun svg--smooth-quadratic-bezier-curveto-command (coordinates-list
428 &rest args) 424 &rest args)
429 (cons 425 (cons
430 (svg--path-command-symbol 't args) 426 (svg--path-command-symbol 't args)
431 (apply 'append coordinates-list))) 427 (apply #'append coordinates-list)))
432 428
433(defun svg--eval-path-command (command default-relative) 429(defun svg--eval-path-command (command default-relative)
434 (cl-letf 430 (cl-letf
@@ -450,7 +446,7 @@ This is in contrast to merely setting it to 0."
450 #'svg--elliptical-arc-command) 446 #'svg--elliptical-arc-command)
451 (extended-command (append command (list :default-relative 447 (extended-command (append command (list :default-relative
452 default-relative)))) 448 default-relative))))
453 (mapconcat 'prin1-to-string (apply extended-command) " "))) 449 (mapconcat #'prin1-to-string (apply extended-command) " ")))
454 450
455(defun svg-path (svg commands &rest args) 451(defun svg-path (svg commands &rest args)
456 "Add the outline of a shape to SVG according to COMMANDS. 452 "Add the outline of a shape to SVG according to COMMANDS.
@@ -459,7 +455,7 @@ modifiers. If :relative is t, then coordinates are relative to
459the last position, or -- initially -- to the origin." 455the last position, or -- initially -- to the origin."
460 (let* ((default-relative (plist-get args :relative)) 456 (let* ((default-relative (plist-get args :relative))
461 (stripped-args (svg--plist-delete args :relative)) 457 (stripped-args (svg--plist-delete args :relative))
462 (d (mapconcat 'identity 458 (d (mapconcat #'identity
463 (mapcar 459 (mapcar
464 (lambda (command) 460 (lambda (command)
465 (svg--eval-path-command command 461 (svg--eval-path-command command