public
Created

Old enamel hack

  • Download Gist
enamel.lisp
Common Lisp
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139
;;;; Enamel - Erik Naggum's Markup Language
;;;
;;; See http://xach.com/naggum/articles/3207626455633924@naggum.net.html
;;;
 
(define-condition malformed-enamel (error) ())
 
(defun parse-enamel (in &key (case :upcase) (strip-newlines t) (distinguish-attributes nil) (package *package*))
(let ((node '()))
(labels ((skip-ws () (peek-char t in nil))
(peek () (peek-char nil in nil))
(consume ()
(or (read-char in nil nil)
(error 'malformed-enamel)))
(expect (char)
(when (not (eql (consume) char))
(error 'malformed-enamel)))
(finish ()
(return-from parse-enamel
(nreverse node)))
(correct-case (char)
(ecase case
(:upcase (char-upcase char))
(:downcase (char-downcase char))
(:preserve char)))
(read-name ()
(let ((s (with-output-to-string (out)
(block read-name-loop
(loop
(case (peek)
((#\Space #\| #\< #\> nil)
(return-from read-name-loop))
((#\\)
(consume)
(write-char (consume) out))
(t
(write-char (correct-case (consume)) out))))))))
(push (intern s package) node)))
(maybe-read-content-separator ()
(when (eql (peek) #\|)
(consume)))
(read-node ()
(push (parse-enamel in
:case case
:strip-newlines strip-newlines
:distinguish-attributes distinguish-attributes
:package package)
node))
(read-entity ()
(expect #\[)
(let ((s (with-output-to-string (out)
(block entity-name-loop
(loop
(case (peek)
((#\])
(consume)
(return-from entity-name-loop))
((#\\)
(consume)
(write-char (consume) out))
((nil)
(error 'malformed-enamel))
(t
(write-char (correct-case (consume)) out))))))))
(push (intern s package) node)))
(read-contents ()
(let ((string-out (make-string-output-stream)))
(labels ((finish-string ()
(let ((s (get-output-stream-string string-out)))
(when (plusp (length s))
(push s node)))))
(loop
(case (peek)
((nil) (error 'malformed-enamel))
((#\<) (finish-string) (read-node))
((#\>) (finish-string) (return-from read-contents))
((#\[) (finish-string) (read-entity))
((#\\) (consume) (write-char (consume) string-out))
((#\Return #\Linefeed #\Newline)
(if strip-newlines
(skip-ws)
(write-char (consume) string-out)))
(t (write-char (consume) string-out)))))))
(maybe-read-attributes ()
(loop while (eql (peek) #\<) do (read-node) (skip-ws))))
(skip-ws)
(when (null (peek)) (finish))
(expect #\<)
(read-name)
(skip-ws)
(maybe-read-attributes)
(skip-ws)
(when (maybe-read-content-separator)
(when distinguish-attributes
(push (intern "" package) node))
(read-contents))
(expect #\>)
(finish))))
 
(defun parse-enamel-from-string (string &key (start 0) end (case :upcase) (strip-newlines t) (distinguish-attributes nil) (package *package*))
(with-input-from-string (in string :start start :end end)
(parse-enamel in
:case case
:strip-newlines strip-newlines
:distinguish-attributes distinguish-attributes
:package package)))
 
(defun test ()
(macrolet ((aver (string rep &rest args)
`(let ((actual (parse-enamel-from-string ,string ,@args)))
(unless (equal actual ',rep)
(error "~S parses as ~S, but ~S was expected." ,string actual ',rep)))))
(aver "<foo>" (foo))
(aver "<foo <bar|zot>>" (foo (bar "zot")))
(aver "<foo|zot>" (foo "zot"))
(aver "<foo <bar|zot> |quux>" (foo (bar "zot") "quux"))
(aver "<foo|Hey, [quux]!>" (foo "Hey, " quux "!"))
(aver "<foo|AT&T you will>" (foo "AT&T you will"))
(aver "<foo|<bar|zot>>" (foo (bar "zot")))
(aver "<foo <bar|zot> <quux|oink>>" (foo (bar "zot") (quux "oink")))
;; The following is an apparent deviation from Naggum's syntax.
;; He says that the Enamel should translate to:
;;
;; (foo (bar "zot") || (bar "zot"))
;;
;; Presumably, "<foo|<bar|zot>>" would translate to:
;;
;; (foo (bar "zot"))
;;
;; This means we need to scan for || to know if the first bar node
;; is an attribute or not. [According to Naggum we do not need to
;; do this in the fully parsed structure, where all attributes are
;; present. This hack is useful only in the context of dealing
;; with non-fully parsed structure, however.] If we postulate
;; that content is always preceded by ||, we can assume that the
;; first bar node is an attribute without scanning forward.
(aver "<foo <bar|zot>|<bar|zot>>" (foo (bar || "zot") || (bar || "zot"))
:distinguish-attributes t))
'ok)

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.