|
Warning: this is an htmlized version!
The original is here, and the conversion rules are here. |
;; esvg-append.el. -*- lexical-binding: nil; -*-
;; This file:
;; https://anggtwu.net/elisp/esvg-append.el.html
;; https://anggtwu.net/elisp/esvg-append.el
;; (find-angg "elisp/esvg-append.el")
;; Author: Eduardo Ochs <eduardoochs@gmail.com>
;; Version: 2026aug12
;;
;; This is the third lowest-level file in esvg - edrx's (REPL for) SVG.
;;
;; The file svg.el defines lots of functions that "create SVG objects",
;; like `svg-rectangle'. Each call to one of these functions calls
;; `svg--append', that in some cases does a "replace" instead of an
;; "append", and `svg--append' always calls `svg-possibly-update-image'.
;;
;; Here are some things that I don't like in those functions:
;;
;; 1. They only append and replace child nodes to the top-level SVG
;; object - and to work in a REPL we sometimes need to append and
;; replace child nodes in subobjects, like groups and clippaths.
;;
;; 2. They don't let us get and set attributes - only child nodes.
;;
;; 3. They are not `setf'-based.
;;
;; 4. The code of functions like `svg--append' and `svg--arguments'
;; have lots of special cases and weird design decisions - with
;; no documentation, and no tests.
;;
;; This file implements `esvg-append', that is a variant of
;; `svg--append' that is factored in a more Forth-ish way. Note that
;; `esvg-append' only does the "append but in some cases do a replace
;; instead of an append" part; the "update image" is done elsewhere.
;;
;; See:
;; (find-efile "svg.el" "(defun svg--append ")
;; (find-efile "svg.el" "(defun svg--arguments ")
;;
;; Links to some obscure lisp features that I used here:
;; (find-efunctiondescr 'alist-get "nil 'remove")
;; (find-elfile "gv.el" "(gv-define-simple-setter car setcar)")
;; (find-elnode "Adding Generalized Variables")
;; (find-kla-intro "clauses in a row")
;;
;; (defun e () (interactive) (find-angg "elisp/esvg-append.el"))
;; (defun o () (interactive) (find-angg "elisp/2026-esvg-get-set.el"))
;;
;; Index:
;; «.esvg-get-attribute» (to "esvg-get-attribute")
;; «.esvg-set-attribute» (to "esvg-set-attribute")
;; «.esvg-replace-child» (to "esvg-replace-child")
;; «.esvg-append-child» (to "esvg-append-child")
;; «.esvg-get-child-by-id» (to "esvg-get-child-by-id")
;; «.esvg-set-child-by-id» (to "esvg-set-child-by-id")
;; «.esvg-append» (to "esvg-append")
;; «esvg-get-attribute» (to ".esvg-get-attribute")
;; «esvg-set-attribute» (to ".esvg-set-attribute")
;; Test: (setq svg '(svg))
;; (esvg-set-attribute svg 'a 1)
;; (setf (esvg-get-attribute svg 'b) 2)
;; (esvg-set-attribute svg 'c 3)
;; (esvg-get-attribute svg 'b)
;; (esvg-get-attribute svg 'd)
;; (esvg-set-attribute svg 'a nil)
;; (esvg-set-attribute svg 'b nil)
;; (esvg-set-attribute svg 'c nil)
;; (esvg-set-attribute svg 'd nil)
;;
(defun esvg-get-attribute (svgnode key)
(alist-get key (nth 1 svgnode)))
(defun esvg-set-attribute (svgnode key newvalue)
(if (null (cdr svgnode))
(setf (cdr svgnode) '(())))
(setf (alist-get key (nth 1 svgnode)
nil 'remove)
newvalue)
svgnode)
(gv-define-simple-setter esvg-get-attribute esvg-set-attribute 'fix-return)
;; «esvg-replace-child» (to ".esvg-replace-child")
;; «esvg-append-child» (to ".esvg-append-child")
;; Test: (setq svg '(svg ((a . 1)) (rect) (circle) (ellipse)))
;; (esvg-nchildren svg)
;; (esvg-replace-child svg 1 '(cyrcle))
;; (esvg-replace-child svg 3 '(ignored))
;; (esvg-remove-child svg 4)
;; (esvg-remove-child svg 1)
;; (esvg-append-child svg '(foo))
;;
(defun esvg-nchildren (svgnode) (length (cddr svgnode)))
(defun esvg-replace-child (svgnode n newnode)
(if (< n (esvg-nchildren svgnode))
(setf (nth (+ 2 n) svgnode) newnode))
svgnode)
(defun esvg-remove-child (svgnode n)
(if (<= n (esvg-nchildren svgnode))
(setf (nthcdr (+ 2 n) svgnode)
(nthcdr (+ 3 n) svgnode)))
svgnode)
(defun esvg-append-child (svgnode newnode)
(if (null (cdr svgnode))
(setf (cdr svgnode) '(())))
(setf (cdr (last svgnode)) (list newnode))
svgnode)
;; «esvg-get-child-by-id» (to ".esvg-get-child-by-id")
;; «esvg-set-child-by-id» (to ".esvg-set-child-by-id")
;; (setq svg '(svg () (rect ((id . "r"))) (circle ((id . "c")))))
;; (esvg-id-to-child-number svg "r")
;; (esvg-id-to-child-number svg "c")
;; (esvg-id-to-child-number svg "foo")
;; (esvg-get-child-by-id svg "r")
;; (esvg-get-child-by-id svg "c")
;; (esvg-get-child-by-id svg "foo")
;; (esvg-set-child-by-id svg "c" '(cyrcle ((id . "c"))))
;; (esvg-set-child-by-id svg "foo" '(foo ((id . "f"))))
;;
(defun esvg-id-to-child-number (svgnode id)
(cl-loop for child in (cddr svgnode)
for n from 0
if (equal id (esvg-get-attribute child 'id))
do (cl-return n)))
(defun esvg-get-child-by-id (svgnode id)
(let ((n (esvg-id-to-child-number svgnode id)))
(if n (nth (+ 2 n) svgnode))))
(defun esvg-set-child-by-id (svgnode id newnode)
(let ((n (esvg-id-to-child-number svgnode id)))
(if n (esvg-replace-child svgnode n newnode)
(esvg-append-child svgnode newnode))))
(gv-define-simple-setter esvg-get-child-by-id esvg-set-child-by-id)
;; «esvg-append» (to ".esvg-append")
;; Tests: (setq svg '(s))
;; (esvg-append svg '(a ((id . 1))))
;; (esvg-append svg '(b ((id . 2))))
;; (esvg-append svg '(c ((id . 1))))
;; (esvg-append svg '(d))
;; This is esvg's replacement for:
;; (find-efile "svg.el" "(defun svg--append ")
(defun esvg-append (svgnode newnode)
(let ((id (esvg-get-attribute newnode 'id)))
(if id (esvg-set-child-by-id svgnode id newnode)
(esvg-append-child svgnode newnode)))
svgnode)
(provide 'esvg-append)
;; Local Variables:
;; coding: utf-8-unix
;; End: