|
Warning: this is an htmlized version!
The original is here, and the conversion rules are here. |
;; 2026-eepitch-svg.el. -*- lexical-binding: nil; -*-
;; This file:
;; https://anggtwu.net/elisp/2026-eepitch-svg.el.html
;; https://anggtwu.net/elisp/2026-eepitch-svg.el
;; (find-angg "elisp/2026-eepitch-svg.el")
;; See: https://anggtwu.net/2026-eepitch-svg.html
;; Author: Eduardo Ochs <eduardoochs@gmail.com>
;; Version: 2026aug08
;;
;; This is an EXPERIMENTAL variant of eepitch that:
;; 1) only works for elisp,
;; 2) supports multi-line commands (sexps),
;; 3) highlights each executed sexp (for 0.75s by default),
;; 4) doesn't support red stars (`*'s),
;; 5) uses <f9> instead of <f8>,
;; 6) overrides my default use for <f9> (see `eepitch-b'),
;; 7) is usually used to test/learn/showcase SVG.
;;
;; The main docs for svg.el are in these places:
;; (find-efile "svg.el" "updated \"on the fly\"")
;; (find-efile "svg.el" "Here are some usage examples:")
;; (find-elnode "SVG Images")
;; «.binding» (to "binding")
;; «.eepitch-svg-skip-blanks» (to "eepitch-svg-skip-blanks")
;; «.eepitch-this-line-svg» (to "eepitch-this-line-svg")
;; «.esvg-to-string» (to "esvg-to-string")
;; «.find-4a» (to "find-4a")
;; «.show-svg» (to "show-svg")
;; «.eeit-svg» (to "eeit-svg")
;; «.demo-svg-el» (to "demo-svg-el")
;; «.svg-el-usage-examples» (to "svg-el-usage-examples")
;; «.demo-svg-append» (to "demo-svg-append")
;; «.demo-rectangles» (to "demo-rectangles")
;; «.demo-dom» (to "demo-dom")
;; «.demo-get-property» (to "demo-get-property")
;; «.demo-card-game» (to "demo-card-game")
;; «.demo-svg-arguments» (to "demo-svg-arguments")
;; «.demo-windows» (to "demo-windows")
(require 'svg)
(defvar svg)
;; «binding» (to ".binding")
;; Overrides this: (find-eev "eepitch.el" "eepitch-b" "<f9>")
(define-key eev-mode-map (kbd "<f9>") 'eepitch-this-line-svg)
;; «eepitch-svg-skip-blanks» (to ".eepitch-svg-skip-blanks")
;; See: (find-elnode "Rx Constructs" "Match at point")
;; (find-elnode "Rx Constructs" "(regexp EXPR)")
;; (find-elnode "Extending Rx" "Macro: rx-let")
;; (find-eev "eepitch.el" "eepitch" "eepitch-regexp")
;;
(defvar eepitch-svg-skip-blanks
(rx-let ((blankline (regexp "[ \t]*\n"))
(commentline (regexp "[ \t]*;[^\n]*\n"))
(starstarline (regexp "[*•][*•][^\n]*\n"))
(skiplines (0+ (or blankline commentline starstarline)))
(lastleft (seq (optional (regexp "[*•] "))
(regexp "[ \t]*"))))
(rx (seq point skiplines lastleft)))
"A regexp used by `eepitch-this-line-svg' to skip comments and some red stars.")
;; «eepitch-this-line-svg» (to ".eepitch-this-line-svg")
;; Based on: (find-eevfile "eepitch.el" "(defun eepitch-this-line ")
(defun eepitch-this-line-svg ()
(interactive)
(move-beginning-of-line nil)
(let* ((before (point)))
(re-search-forward eepitch-svg-skip-blanks) ; skip red stars
(let* ((end (ee-forward-sexp))
(start (ee-backward-sexp))
(after (progn (goto-char end) (next-line 1) (ee-bol)))
(sexp (buffer-substring-no-properties start end)))
(goto-char before)
(eeflash start end ee-highlight-spec)
(prin1 (ee-eval (ee-read sexp))) ; may fail
(goto-char after))))
;; «esvg-to-string» (to ".esvg-to-string")
;; Tests: (esvg-to-string (svg-create 1 2))
;; (esvg-to-string '(svg))
;; (esvg-to-string '(svg nil))
;; (esvg-to-string '(svg nil (rect)))
;; (esvg-to-string '(svg ((w . 1) (h . 2)) (rect)))
;; (esvg-to-string '(svg ((w . 1) (h . 2)) (rect) (rect)))
;; (esvg-to-string '(svg ((w . 1) (h . 2)) (rect nil)))
;; (esvg-to-string '(svg ((w . 1) (h . 2)) (rect nil (subrect))))
;; (esvg-to-string '(svg ((w . 1) (h . 2)) (foo ((a . 3) (b . 4)) (bar))))
;; (esvg-to-string "<svg></svg>\n\n")
;;
(defun esvg-to-string (o)
"Convert O to a multi-line string.
If O is string, treat it as XML, split it into lines, and indent it.
If O is not a list convert it to XML first by using `esvg--svg-print',
that is a wrapper around `svg-print'."
(if (not (stringp o))
(setq o (esvg--svg-print o)))
(setq o (replace-regexp-in-string "[ \t\n]+" " " o))
(setq o (replace-regexp-in-string ">[ \t\n]*<" ">\n<" o))
(setq o (esvg--xml-indent o))
(setq o (replace-regexp-in-string "[ \t\n]*\\'" "" o)))
;; Two low-level functions used by `esvg-to-string'.
;; Tests: (esvg--svg-print (svg-create 1 2))
;; (esvg--svg-print '(svg nil))
;; (esvg--svg-print '(svg ((w . 1) (h . 2))))
;; (esvg--svg-print '(svg ((w . 1) (h . 2)) (rect)))
;; See: (find-efunction 'svg-print)
(defun esvg--svg-print (o)
"An internal function used by `esvg-to-string'."
(with-temp-buffer
(svg-print o)
(buffer-string)))
(defun esvg--xml-indent (xmlstr)
"An internal function used by `esvg-to-string'."
(with-temp-buffer
(insert xmlstr)
(xml-mode)
(indent-region (point-min) (point-max))
(buffer-string)))
;; «find-4a» (to ".find-4a")
;; Based on: (find-efunction 'find-3a)
;; See: (find-multiwindow-intro "3. High-level words")
;; Test: (find-4a nil nil nil nil)
(defun find-4a (a b c d) (find-wset "13_o22+_o_o_o" a b c d))
;; «show-svg» (to ".show-svg")
;; Tests: (show-svg)
;; (show-svg-pp)
;; (show-svg-pp-xml)
;; See: (find-efile "svg.el" "svg-insert-image")
;; (find-efile "svg.el" "(defun svg-possibly-update-image ")
;; (find-efile "svg.el" "(defun svg--append " "svg-possibly-update-image")
;;
(defun show-svg-1 ()
(find-ebuffer "*svg*")
(delete-region (point-min) (point-max))
(if svg (svg-insert-image svg))
(goto-char (point-min))
(setq cursor-type nil))
(defun show-pp-1 ()
(let ((ee-buffer-name (or ee-buffer-name "*svg-pp*")))
(find-epp svg)))
(defun show-xml-1 ()
(let ((ee-buffer-name (or ee-buffer-name "*svg-xml*")))
(find-estring (esvg-to-string svg))))
(defun show-svg ()
(interactive)
(find-2a nil '(show-svg-1)))
(defun show-svg-pp ()
(interactive)
(find-3a nil '(show-svg-1) '(find-pp-1)))
(defun show-svg-pp-xml ()
(interactive)
(find-4a nil '(show-svg-1) '(show-pp-1) '(show-xml-1)))
(defun show-pp-xml ()
(interactive)
(find-3a nil '(show-pp-1) '(show-xml-1)))
;; «eeit-svg» (to ".eeit-svg")
;; Inspired by `eeit', but much dumber.
;; See: (find-eev "eev-testblocks.el" "eeit")
(defun eeit-svg ()
(interactive)
(insert "\
'(\"This is a test block for `eepitch-svg'! Use <f9>s!\"\n
* (load (buffer-file-name))\n
\"--\")
"))
;; «demo-svg-el» (to ".demo-svg-el")
;; «svg-el-usage-examples» (to ".svg-el-usage-examples")
;; This is the test from the "Commentary:" section
;; of svg.el, practically unchanged. See:
;; (find-efile "svg.el" "Commentary:")
;; (find-efile "svg.el" "Here are some usage examples:")
;;
;; ... but the version in svg.el inserts the SVG object at
;; the end of svg.el itself, and here we use `show-svg' to
;; draw it at the window at the right.
;;
'("This is a test block for `eepitch-svg'! Use <f9>s!"
* (load (buffer-file-name))
* (setq svg (svg-create 800 800 :stroke "orange" :stroke-width 5))
* (show-svg)
(svg-gradient svg "gradient" 'linear '((0 . "red") (100 . "blue")))
(svg-rectangle svg 100 100 500 500 :gradient "gradient" :id "rec1")
;; Note that `svg-rectangle', `svg-circle',
;; and friends all call `svg--append', that
;; calls `svg-possibly-update-image'...
;;
(svg-circle svg 500 500 100 :id "circle1")
(svg-ellipse svg 100 100 50 90 :stroke "red" :id "ellipse1")
(svg-line svg 100 190 50 100 :stroke "yellow" :id "line1")
(svg-polyline svg '((200 . 100) (500 . 450) (80 . 100))
:stroke "green" :id "polyline1")
(svg-polygon svg '((100 . 100) (200 . 150) (150 . 90))
:fill "red" :stroke "blue" :id "polygon1")
;; The two sexps below switch between a 2-window setting, that shows
;; only this file at the left and the "*svg*" buffer at the right,
;; and a 4-window setting that shows three windows at the right:
;; "*svg*", "*svg-pp*", and "*svg-xml*"
;;
(show-svg-pp-xml)
(show-svg)
;; Note that the line 2 in "*svg-pp*" has this,
;; (:image . #<marker at 1 in *svg*>)
;; that disappears in the conversion to XML in "*svg-xml*"...
;; Look at the code:
;; (find-efile "svg.el" "(defun svg-rectangle")
;; (find-efile "svg.el" "(defun svg-rectangle" "svg--append")
;; (find-efile "svg.el" "(defun svg--append")
;; (find-efile "svg.el" "(defun svg--append" "svg-possibly-update-image")
;; (find-efile "svg.el" "(defun svg-possibly-update-image")
;;
;; The function `svg-possibly-update-image' does something VERY
;; tricky. It looks at the marker in the cdr of (:image . `HERE') in
;; the SVG object, and if the buffer with that marker is live then
;; the "display" text property at the character at that position is
;; updated.
"--")
;; «demo-svg-append» (to ".demo-svg-append")
;; (find-efile "svg.el" "(defun svg--append ")
'("This is a test block for `eepitch-svg'! Use <f9>s!"
* (load (buffer-file-name))
(setq attrs1 '((a . 1) (id . 2)))
(setq attrs2 '((b . 3) (id . 4)))
(setq svg `(svg ,attrs1 (foo ,attrs2)))
(show-pp-xml)
"--")
;; «demo-rectangles» (to ".demo-rectangles")
'("This is a test block for `eepitch-svg'! Use <f9>s!"
* (load (buffer-file-name))
(setq svg (svg-create 400 400 :stroke "orange" :stroke-width 5))
(svg-rectangle svg 100 100 20 40 :fill "red")
(show-svg-pp-xml)
(svg-rectangle svg 110 120 20 40 :fill "green" :id "obj1")
(show-svg-pp-xml)
(svg-rectangle svg 120 140 20 40 :fill "blue")
(show-svg-pp-xml)
(show-svg)
(svg-rectangle svg 115 120 20 40 :fill "green" :id "obj1")
(svg-rectangle svg 110 120 20 40 :fill "green" :id "obj1")
(svg-rectangle svg 110 120 20 40 :id "obj1")
(show-svg-pp-xml)
(show-svg)
"--")
;; «demo-dom» (to ".demo-dom")
'("This is a test block for `eepitch-svg'! Use <f9>s!"
* (load (buffer-file-name))
(setq svg (svg-create 400 400 :stroke "orange" :stroke-width 5))
(show-pp-xml)
(setq svg (svg-create 400 400))
(show-pp-xml)
(setq svg (svg-create nil nil))
(show-pp-xml)
(svg-circle svg 1 1 1 :id "circle1")
(svg-circle svg 2 2 2 :id "circle2")
(svg-circle svg 3 3 3 :id "circle3")
(show-pp-xml)
(svg-circle svg 2 2 20 :id "circle2") ; replace circle2
(show-pp-xml)
(setq svg '(svg ((width . 400) (height . 400))))
(svg-circle svg 1 1 1 :id "circle1")
(svg-circle svg 2 2 2 :id "circle2")
(svg-circle svg 3 3 3 :id "circle3")
(show-pp-xml)
(svg-circle svg 2 2 20 :id "circle2") ; replace circle2
(show-pp-xml)
;; See: (find-efile "dom.el")
;; (find-efile "dom.el" "(defun dom-by-id")
;; (find-efile "dom.el" "(defun dom-remove-node")
(dom-by-id svg "circle2")
(car (dom-by-id svg "circle2"))
(dom-remove-node svg (car (dom-by-id svg "circle2"))) ; delete circle2
(show-pp-xml)
"--")
;; «demo-get-property» (to ".demo-get-property")
'("This is a test block for `eepitch-svg'! Use <f9>s!"
* (load (buffer-file-name))
(setq svg (svg-create 400 400 :stroke "orange" :stroke-width 5))
(show-svg)
(svg-rectangle svg 100 100 20 40 :fill "red")
(svg-rectangle svg 110 120 20 40 :fill "green" :id "obj1")
(svg-rectangle svg 120 140 20 40 :fill "blue")
(show-svg)
(setq o
(with-current-buffer "*svg*"
(get-text-property (point-min) 'display))
)
(cdr o)
(plist-get (cdr o) :data)
(ee-xml-indent (plist-get (cdr o) :data))
;; This part needs dash.el!
;; (require 'dash)
;; (find-epackage-links 'dash)
;; (find-dashnode "Threading macros" "-->")
;; (find-node "(dash)Threading macros" "-->")
(--> o)
(--> o cdr)
(--> o cdr (plist-get it :data))
(--> o cdr (plist-get it :data) ee-xml-indent)
"--")
;; «demo-svg-arguments» (to ".demo-svg-arguments")
;; (find-efile "svg.el" "updated \"on the fly\"")
;; (find-efile "svg.el" "(defun svg--arguments ")
;; (find-efile "svg.el" "(cl-loop for (key value) on args by #'cddr")
'("This is a test block for `eepitch-svg'! Use <f9>s!"
* (load (buffer-file-name))
(setq svg (svg-create 400 400 :stroke "red" :stroke-width 5))
(setq svg (svg-create 400 400 :stroke-color "red" :stroke-width 5))
(setq svg (svg-create 400 400 :stroke-color "blue" :stroke-width 5))
(svg--arguments svg '())
(svg--arguments svg '(:stroke-color "orange"))
(svg--arguments svg '(:stroke-color "orange" :foo "bar"))
(svg--arguments svg '(:stroke "orange" :foo "bar"))
(svg--arguments svg '(:stroke "orange" :foo "bar" :gradient "abcd"))
"--")
;; «demo-windows» (to ".demo-windows")
'("This is a test block for `eepitch-svg'! Use <f9>s!"
"--")
;; «demo-card-game» (to ".demo-card-game")
;; This block is not self-contained! It needs:
;; (find-es "svg" "card-game.el")
'("This is a test block for `eepitch-svg'! Use <f9>s!"
* (load (buffer-file-name))
* (setq svg (card-games-svg-cards-svg '(("A" 1))))
* (show-svg-pp-xml)
"--")
;; (defun e () (interactive) (find-angg "elisp/2026-eepitch-svg.el"))
;; Local Variables:
;; coding: utf-8-unix
;; End: