lqml/examples/palindrome/lisp/helper/with-qml-file.lisp
2024-04-07 11:39:02 +02:00

55 lines
2.3 KiB
Common Lisp

;;; generate indented QML file
;;;
;;; note: giving an 'id' will automatically add an 'objectName' of the same name
(in-package :pal)
(defmacro with-qml-file ((file) &body body)
(let ((text (gensym)))
`(let ((,text (with-output-to-string (s)
,@(mapcar (lambda (x) (if (stringp x) `(write-line ,x s) x))
body))))
;; stream S is intentionally not a gensym
(with-open-file (s ,file :direction :output :if-exists :supersede)
(format s "// THIS FILE IS GENERATED~%~%")
(write-string (%indent-qml ,text) s)
(qlater (lambda () (format t "~%QML file generated, see ~S~%~%" ,file)))))))
(defmacro qml (first &body body)
(if (find #\~ first)
`(progn
(format s ,first ,@body)
(terpri s))
(let ((open-close (and (upper-case-p (char first 0))
(not (find #\{ first)))))
(if body
`(progn
,(if open-close
`(write-line ,(format nil "~%~A {" first) s)
(if (find #\{ first)
`(write-line ,(format nil "~%~A" first))
`(write-line ,first s)))
,@(mapcar (lambda (x)
(if (stringp x)
(if (x:starts-with "id:" x)
`(progn
(write-line ,x s)
(write-line ,(format nil "objectName: ~S" (string-trim " " (subseq x 3))) s))
`(write-line ,x s))
x))
body)
,(when open-close `(write-line "}" s)))
(if (find #\{ first)
`(write-line ,(format nil "~%~A" first) s)
`(write-line ,first s))))))
(defun %indent-qml (text)
(with-output-to-string (out)
(let ((in (make-string-input-stream text))
(depth 0))
(x:while-it (read-line in nil nil)
(let ((open (count #\{ x:it))
(close (count #\} x:it)))
(write-string (make-string (* 2 (- depth (if (= (- open close) -1) 1 0)))) out)
(write-line (string-left-trim " " x:it) out)
(setf depth (+ depth open (- close))))))))