diff options
| author | Stefan Monnier | 2021-04-24 14:07:12 -0400 |
|---|---|---|
| committer | Stefan Monnier | 2021-04-24 14:07:12 -0400 |
| commit | d398eca44e119d60f21494a34050e6ca5bc9df8b (patch) | |
| tree | 40a4551eeda016b791991e6d9a31523d31f34171 | |
| parent | dec8a4775d665168d03693ef1aea99981f13b30a (diff) | |
| download | emacs-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.el | 48 |
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 | |||
| 459 | the last position, or -- initially -- to the origin." | 455 | the 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 |