;; 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: