5 |
6 | > Short and sweet HTML.
7 |
8 | ## Usage
9 |
10 | The `mel` function accepts any number of nodes and returns an HTML string.
11 | Each node is a list of the following form:
12 |
13 | ```emacs-lisp
14 | (TAG [attribute val...] CHILDREN...)
15 | ```
16 |
17 | ### Tags
18 |
19 | `TAG` must be a symbol staring with the name of an HTML tag.
20 |
21 | ### Classes
22 |
23 | The `.` separator can be used in a tag symbol name to indicate a class.
24 | It may be used multiple times.
25 | As a special case, if a tag symbol begins with a `.`, a div tag is implied.
26 |
27 | ### IDs
28 |
29 | A single `#` separator can be used to associate an ID with a tag.
30 | Note that the separator must be escaped with a `\` in elisp.
31 | The `@` separator is an alias for `#` which does not need to be escaped.
32 |
33 | ### Attributes
34 |
35 | An optional attribute vector may be added as the second element of a node list.
36 | Each attribute must be a symbol (optionally a keyword) followed by its value.
37 | The value will be coerced to its string representation.
38 |
39 | ### Children
40 |
41 | Any elements of a node specified after the tag and optional attribute vector are the node's children.
42 | They may be either strings or nodes.
43 |
44 | ## Tempalte Files
45 |
46 | An `htmel` file must contain an emacs-lisp program.
47 | When evaluated, the return value of the last expression must be a mel spec for a document.
48 | For example, the source for this page is stored in [./index.htmel](./index.htmel).
49 | A `mel` file is similar to an htmel file, but the return value of each top-level sexp is collected into a list.
50 | This is useful for including partial templates within other templates (see below).
51 |
52 | ## File Inclusion
53 |
54 | Content stored in other files can be included via the `mel-read` function.
55 | The `mel-read` function can be used to parse and load files into a template.
56 |
--------------------------------------------------------------------------------
/include.mel:
--------------------------------------------------------------------------------
1 | `(p "This paragraph was included from "
2 | (code ,(concat "./" (file-name-nondirectory (buffer-file-name)))))
3 |
--------------------------------------------------------------------------------
/index.htmel:
--------------------------------------------------------------------------------
1 | ;; -*- lexical-binding: t; -*-
2 | (require 'mel)
3 |
4 | (defun +mel-print-md (node)
5 | "Print NODE as markdown."
6 | (if (stringp node) node
7 | (pcase (car-safe node)
8 | ((or 'html 'body) (mapconcat #'+mel-print-md (nthcdr 2 node)))
9 | ((or 'p 'md) (concat (mapconcat #'+mel-print-md (nthcdr 2 node) "\n") "\n"))
10 | ((and 'div (guard (equal (alist-get 'class (nth 1 node)) "md")))
11 | (car (last (car (last (nthcdr 2 node))))))
12 | ('img (format "
%s
\n\n" (let ((mel-print-functions))
13 | (with-temp-buffer
14 | (dom-print node)
15 | (buffer-string)))))
16 | ('span (mapconcat #'+mel-print-md (nthcdr 2 node) " "))
17 | ('pre (concat "\n```" (car (split-string (alist-get 'class (nth 1 node)) " "))
18 | (format "\n%s\n"
19 | (with-temp-buffer
20 | (insert (mapconcat (lambda (el) (format "%s" el))
21 | (nthcdr 2 node) "\n"))
22 | (indent-region (point-min) (point-max))
23 | (buffer-substring-no-properties (point-min) (point-max))))
24 | "```\n"))
25 | ('q (concat (mapconcat (lambda (el) (format "> %s" el)) (nthcdr 2 node) "\n") "\n"))
26 | ((and heading (pred symbolp)
27 | (guard (string-match-p "h[[:digit:]]" (symbol-name heading))))
28 | (format "\n%s %s\n\n"
29 | (make-string (string-to-number (substring (symbol-name heading) 1)) ?#)
30 | (mapconcat #'+mel-print-md (nthcdr 2 node) " ")))
31 | (_ ""))))
32 |
33 | (defun +mel-write-docs ()
34 | (let ((name (buffer-file-name))
35 | (mel-spec-functions
36 | (list (mel-deftag md (.md ,(apply #'mel-markdown body)))
37 | (mel-deftag example
38 | (.example (pre.emacs-lisp ,(format "%S" (macroexp-progn body)))
39 | (p "Returns:")
40 | (pre.html ,(format "%s" (eval `(progn ,@body) t))))))))
41 | (mel-write-html name "index.html"))
42 | (let ((mel-print-functions '(+mel-print-md))
43 | (mel-spec-functions '(+mel-example)))
44 | (with-temp-buffer
45 | (insert (mel (mel-read "index.htmel")))
46 | (write-file "README.md"))))
47 |
48 | (add-hook 'after-save-hook #'+mel-write-docs nil t)
49 |
50 | `( html [:lang "en"]
51 | (head
52 | (meta[:charset UTF-8])
53 | (link [:rel "stylesheet" :href "https://cdn.simplecss.org/simple.min.css"])
54 | (style "pre { white-space: pre-line; } .center { margin: auto; }")
55 | (title "MEL: Elisp HTML Templating"))
56 | (body
57 | (h1 "MEL: Elisp HTML Templating")
58 | (img.center [ :src "./logo.png"
59 | :alt "A honeycomb with the word 'mel' written in honey in the center."])
60 | (q.center "Short and sweet HTML.")
61 | (h2 "Usage")
62 | (md "The `mel` function accepts any number of nodes and returns an HTML string."
63 | "Each node is a list of the following form:")
64 | (pre.emacs-lisp "(TAG [attribute val...] CHILDREN...)")
65 | (h3 "Tags")
66 | (md "`TAG` must be a symbol staring with the name of an HTML tag.")
67 | (example (mel '(h1 "heading")))
68 | (h3 "Classes")
69 | (md "The `.` separator can be used in a tag symbol name to indicate a class.")
70 | (example (mel '(h1.class "heading")))
71 | (p "It may be used multiple times.")
72 | (example (mel '(h1.one.two "heading")))
73 | (md "As a special case, if a tag symbol begins with a `.`, a div tag is implied.")
74 | (example (mel '(.class "content")))
75 | (h3 "IDs")
76 | (md "A single `#` separator can be used to associate an ID with a tag."
77 | "Note that the separator must be escaped with a `\\` in elisp."
78 | "The `@` separator is an alias for `#` which does not need to be escaped.")
79 | (example (mel '(h1\#one "heading") '(h2@two "heading")))
80 | (h3 "Attributes")
81 | (p "An optional attribute vector may be added as the second element of a node list."
82 | "Each attribute must be a symbol (optionally a keyword) followed by its value."
83 | "The value will be coerced to its string representation.")
84 | (example (mel '(h1 [:one "true" :two false] "heading")))
85 | (h3 "Children")
86 | (p "Any elements of a node specified after the tag and optional attribute vector are the node's children."
87 | "They may be either strings or nodes.")
88 | (example (mel '(p "example " (span "text"))))
89 | (h2 "Tempalte Files")
90 | (md "An `htmel` file must contain an emacs-lisp program."
91 | "When evaluated, the return value of the last expression must be a mel spec for a document."
92 | "For example, the source for this page is stored in [./index.htmel](./index.htmel).")
93 | (md "A `mel` file is similar to an htmel file, but the return value of each top-level sexp is collected into a list."
94 | "This is useful for including partial templates within other templates (see below).")
95 | (h2 "File Inclusion")
96 | (md "Content stored in other files can be included via the `mel-read` function.")
97 | (md "The `mel-read` function can be used to parse and load files into a template.")
98 | (example (mel-read "./include.mel"))))
99 |
--------------------------------------------------------------------------------
/index.html:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
7 | MEL: Elisp HTML Templating
8 |
9 |
10 |
MEL: Elisp HTML Templating
11 |
12 | Short and sweet HTML.
13 |
Usage
14 |
15 |
The mel function accepts any number of nodes and returns
16 | an HTML string.Each node is a list of the following form:
17 |
18 |
(TAG [attribute val...] CHILDREN...)
19 |
Tags
20 |
21 |
TAG must be a symbol staring with the name of an HTML
22 | tag.
23 |
24 |
25 |
(mel '(h1 "heading"))
26 |
Returns:
27 |
<h1>heading</h1>
28 |
29 |
Classes
30 |
31 |
The . separator can be used in a tag symbol name to
32 | indicate a class.
33 |
34 |
35 |
(mel '(h1.class "heading"))
36 |
Returns:
37 |
<h1 class="class">heading</h1>
38 |
39 |
It may be used multiple times.
40 |
41 |
(mel '(h1.one.two "heading"))
42 |
Returns:
43 |
<h1 class="one two">heading</h1>
44 |
45 |
46 |
As a special case, if a tag symbol begins with a ., a
47 | div tag is implied.
48 |
49 |
50 |
(mel '(\.class "content"))
51 |
Returns:
52 |
<div class="class">content</div>
53 |
54 |
IDs
55 |
56 |
A single # separator can be used to associate an ID with
57 | a tag.Note that the separator must be escaped with a \ in
58 | elisp.The @ separator is an alias for # which
59 | does not need to be escaped.
An optional attribute vector may be added as the second element of a node list.Each attribute must be a symbol (optionally a keyword) followed by its value.The value will be coerced to its string representation.
68 |
69 |
(mel '(h1 [:one "true" :two false] "heading"))
70 |
Returns:
71 |
<h1 one="true" two="false">heading</h1>
72 |
73 |
Children
74 |
Any elements of a node specified after the tag and optional attribute vector are the node's children.They may be either strings or nodes.
75 |
76 |
(mel '(p "example " (span "text")))
77 |
Returns:
78 |
<p>example
79 | <span>text</span>
80 | </p>
81 |
82 |
Tempalte Files
83 |
84 |
An htmel file must contain an emacs-lisp program.When
85 | evaluated, the return value of the last expression must be a mel spec
86 | for a document.For example, the source for this page is stored in ./index.htmel.
88 |
89 |
90 |
A mel file is similar to an htmel file, but the return
91 | value of each top-level sexp is collected into a list.This is useful for
92 | including partial templates within other templates (see below).
93 |
94 |
File Inclusion
95 |
96 |
Content stored in other files can be included via the
97 | mel-read function.
98 |
99 |
100 |
The mel-read function can be used to parse and load
101 | files into a template.
102 |
103 |
104 |
(mel-read "./include.mel")
105 |
Returns:
106 |
(`(p This paragraph was included from (code ,(concat ./ (file-name-nondirectory (buffer-file-name))))))
107 |
108 |
109 |
110 |
--------------------------------------------------------------------------------
/logo.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/progfolio/mel/5fc252c4e32fd635567ee166b55d40c9c6e9b218/logo.png
--------------------------------------------------------------------------------
/logo.svg:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
352 |
--------------------------------------------------------------------------------
/mel-tests.el:
--------------------------------------------------------------------------------
1 | ;;; mel-tests.el --- Tests -*- lexical-binding: t; -*-
2 |
3 | ;; Copyright (C) 2024-2025 Nicholas Vollmer
4 |
5 | ;; Author: Nicholas Vollmer
6 | ;; Keywords:
7 |
8 | ;; This program is free software; you can redistribute it and/or modify
9 | ;; it under the terms of the GNU General Public License as published by
10 | ;; the Free Software Foundation, either version 3 of the License, or
11 | ;; (at your option) any later version.
12 |
13 | ;; This program is distributed in the hope that it will be useful,
14 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
15 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 | ;; GNU General Public License for more details.
17 |
18 | ;; You should have received a copy of the GNU General Public License
19 | ;; along with this program. If not, see .
20 |
21 | ;;; Commentary:
22 |
23 | ;;
24 |
25 | ;;; Code:
26 | (require 'ert)
27 | (require 'mel)
28 |
29 | (defun mel-test-equal (a b)
30 | "Return t if alists A and B have equal set of keys and values (order independent)."
31 | (not (cl-set-difference (flatten-tree a) (flatten-tree b) :test #'equal)))
32 |
33 | (ert-deftest mel-node ()
34 | ;;@MAYBE not?
35 | ;;(should (equal (mel-node '(p nil)) '(p nil)))
36 | (should (mel-test-equal (mel-node '(p)) '((p nil))))
37 |
38 | (should (mel-test-equal (mel-node '(p.class)) '((p ((class . "class"))))))
39 | (should (mel-test-equal (mel-node '(p.class.two)) '((p ((class . "class two"))))))
40 |
41 | (should (mel-test-equal (mel-node '(p\#id)) '((p ((id . "id"))))))
42 | (should (mel-test-equal (mel-node '(p\#id.class)) '((p ((id . "id") (class . "class"))))))
43 | (should-error (mel-node '(p\#id\#again)))
44 |
45 | (should (mel-test-equal (mel-node '(p.class\#id)) '((p ((class . "class") (id . "id"))))))
46 | (should (mel-test-equal (mel-node '(p.class.two\#id)) '((p ((class . "class two") (id . "id"))))))
47 |
48 | (should (mel-test-equal (mel-node '(p [attr])) '((p ((attr . ""))))))
49 | (should (mel-test-equal (mel-node '(p.mixed [class class])) '((p ((class . "mixed class"))))))
50 | (should (mel-test-equal (mel-node '(p.class [class])) '((p ((class . "class"))))))
51 | (should (mel-test-equal (mel-node '(p.class [attr])) '((p ((class . "class") (attr . ""))))))
52 | (should (mel-test-equal (mel-node '(p.class.two [attr])) '((p ((class . "class two") (attr . ""))))))
53 | (should (mel-test-equal (mel-node '(p\#id [attr])) '((p ((id . "id") (attr . ""))))))
54 | (should (mel-test-equal (mel-node '(p\#id.class [attr]))
55 | '((p ((id . "id") (class . "class") (attr . ""))))))
56 |
57 | (should (mel-test-equal (mel-node '(p (p))) '((p nil (p nil))))))
58 |
59 | (defun mel-test-output ()
60 | (interactive)
61 | (with-current-buffer (get-buffer-create "output.html")
62 | (erase-buffer)
63 | (let ((dom (mel-read "/tmp/test.mel" t)))
64 | (insert (apply #'mel dom))
65 | (pop-to-buffer (current-buffer)))))
66 |
67 | (provide 'mel-tests)
68 | ;;; mel-tests.el ends here
69 |
--------------------------------------------------------------------------------
/mel.el:
--------------------------------------------------------------------------------
1 | ;;; mel.el --- HTML Elisp Templating -*- lexical-binding: t; -*-
2 |
3 | ;; Copyright (C) 2024-2025 Nicholas Vollmer
4 |
5 | ;; Author: Nicholas Vollmer
6 | ;; URL: https://github.com/progfolio/mel
7 | ;; Keywords: convenience, data, hypermedia
8 | ;; Created: March 15, 2024
9 | ;; Package-Requires: ((emacs "28.1"))
10 | ;; Version: 0.0.0
11 |
12 | ;; This program is free software; you can redistribute it and/or modify
13 | ;; it under the terms of the GNU General Public License as published by
14 | ;; the Free Software Foundation, either version 3 of the License, or
15 | ;; (at your option) any later version.
16 |
17 | ;; This program is distributed in the hope that it will be useful,
18 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 | ;; GNU General Public License for more details.
21 |
22 | ;; You should have received a copy of the GNU General Public License
23 | ;; along with this program. If not, see .
24 |
25 | ;;; Commentary:
26 |
27 | ;; Mel provides basic elisp HTML templating
28 |
29 | ;;; Code:
30 | (require 'cl-lib)
31 | (require 'dom)
32 |
33 | (defgroup mel nil "HTML Elisp Templating." :group 'programming :prefix "mel-")
34 | (defcustom mel-print-compact nil "When non-nil minimize HTML ouput." :type 'boolean)
35 | (defcustom mel-pandoc-executable (executable-find "pandoc")
36 | "Path to the pandoc executable." :type 'string)
37 | (defcustom mel-default-reader #'buffer-string "Default file reader." :type 'function)
38 | (defcustom mel-readers '(("\\.htmel\\'" . mel-template)
39 | ("\\.mel\\'" . mel-partial)
40 | ("\\.org\\'" . mel-org)
41 | ("\\.md\\'" . mel-markdown))
42 | "List of form ((REGEXP . PARSER)...) to associate file extensions with a reader.
43 | PARSER is called with no arguments and must return a valid mel spec."
44 | :type '(repeat (choice (string :tag "file extension") (function :tag "reader"))))
45 | (defcustom mel-spec-functions nil
46 | "List of functions which are called with a spec as their sole argument.
47 | Functions which return non-nil replaces the spec value."
48 | :type 'hook)
49 | (defcustom mel-node-functions nil
50 | "List of functions which are called with a node as their sole argument.
51 | Functions which return non-nil replaces the node value."
52 | :type 'hook)
53 | (defcustom mel-print-functions nil
54 | "List of functions which are called with a node as their sole argument.
55 | The first function to return non-nil replaces the node's print value."
56 | :type 'hook)
57 |
58 | (defvar mel-data nil)
59 |
60 | (defun mel-get (key &optional strict)
61 | "Return KEY's `mel-data' value.
62 | If STRICT is non-nil, error when key is not found."
63 | (or (alist-get key mel-data)
64 | (when strict (error "No mel-data value for %S" key))))
65 |
66 | (defun mel-set (key &optional value)
67 | "Set KEY to VALUE on `mel-data'."
68 | (setf (alist-get key mel-data) value))
69 |
70 | (defun mel-template ()
71 | "Eval `current-buffer' as elisp. Return value of last expression."
72 | (eval (read (format "(progn %s)" (buffer-substring-no-properties (point-min) (point-max))))
73 | t))
74 |
75 | (defun mel-partial ()
76 | "Eval `current-buffer'; Return list of non-nil top-level expression values."
77 | (let ((forms nil))
78 | (save-excursion
79 | (goto-char (point-min))
80 | (condition-case err
81 | (while t (push (read (current-buffer)) forms))
82 | ((end-of-file) nil)
83 | ((error) (signal (car err) (cdr err))))
84 | (delq nil (mapcar (lambda (form) (eval form t)) (nreverse forms))))))
85 |
86 | (defun mel-pandoc (format &optional string)
87 | "Convert STRING or `buffer-string' from FORMAT to HTML via pandoc."
88 | (let ((b (or string (buffer-string))))
89 | (with-temp-buffer
90 | (insert b)
91 | (goto-char (point-min))
92 | (if (zerop (call-process-region (point-min) (point-max) mel-pandoc-executable
93 | 'delete t nil "-f" format))
94 | (list :raw (buffer-substring-no-properties (point-min) (point-max)))
95 | (error "Unable to parse buffer: %s" (buffer-string))))))
96 |
97 | (defun mel-markdown (&rest strings)
98 | "Return STRINGS or `buffer-string' converted from Markdown to HTML."
99 | (mel-pandoc "Markdown" (when strings (string-join strings))))
100 |
101 | (declare-function org-html-convert-region-to-html "ox-html")
102 | (defun mel-org (&rest strings)
103 | "Return STRINGS or `buffer-string' converted from Org to HTML."
104 | (require 'ox-html)
105 | (let ((s (if strings (string-join strings) (buffer-string))))
106 | (with-temp-buffer
107 | (insert s)
108 | (set-mark (point-min))
109 | (goto-char (point-max))
110 | (org-html-convert-region-to-html)
111 | (list :raw (buffer-substring-no-properties (point-min) (point-max))))))
112 |
113 | (defun mel-reader (filename)
114 | "Call reader matching FILENAME in `mel-readers'.
115 | If no reader matches, `mel-default-reader' is used."
116 | (unless (file-exists-p filename) (error "File does not exist: %s" filename))
117 | (funcall (alist-get filename mel-readers mel-default-reader nil
118 | (lambda (k v) (string-match-p k v)))))
119 |
120 | ;;@TODO: should be determined by predicates
121 | (defun mel-read (filename &optional reader)
122 | "Read FILENAME with READER or `mel-reader'."
123 | (let ((visited (find-buffer-visiting filename)))
124 | (with-current-buffer (or visited (find-file-noselect filename))
125 | (unwind-protect
126 | (if reader (funcall reader) (mel-reader filename))
127 | (unless visited (kill-buffer))))))
128 |
129 | (defun mel--chars-to-string (chars)
130 | "Return string from CHARS."
131 | (cons (car chars) (apply #'string (nreverse (cdr chars)))))
132 |
133 | (defun mel--parse-symbol (symbol)
134 | "Return alist of form ((TYPE . VAL)) from SYMBOL.
135 | Possible types are tag, id, and class."
136 | (cl-loop with (tokens escaped)
137 | with target = 'tag
138 | for c across (symbol-name symbol)
139 | do (cond ((eq c ?\\) (setq escaped t))
140 | ((and (eq c ?.) (not escaped))
141 | (when (alist-get 'class tokens)
142 | (push ?\s (alist-get 'class tokens)))
143 | (setq target 'class))
144 | ((and (memq c '(?# ?@)) (not escaped))
145 | (and (alist-get 'id tokens) (error "More than one id in %s" symbol))
146 | (setq target 'id))
147 | (t (push c (alist-get target tokens))
148 | (setq escaped nil)))
149 | finally return (nreverse (mapcar #'mel--chars-to-string tokens))))
150 |
151 | (defun mel-tag-name (object)
152 | "Return tag name portion of OBJECT or nil if OBJECT is not a tag."
153 | (and (symbolp object)
154 | (intern (replace-regexp-in-string "[.@#].*" "" (symbol-name object)))))
155 |
156 | (defun mel-tag-attributes (object)
157 | "Return tag attribute portion of OBJECT or nil if OBJECT is not a tag."
158 | (when-let (((symbolp object))
159 | (name (symbol-name object))
160 | ((string-match-p "[#.@]" name)))
161 | (intern (replace-regexp-in-string "\\(?:[^z-a]*?\\([#.@][^z-a]*\\)\\)" "\\1" name))))
162 |
163 | (defun mel--merge-attributes (a &optional b)
164 | "Merge attribute alists A and B.
165 | Common keys have their values appended."
166 | (when (and (alist-get 'id a) (alist-get 'id b)) (signal 'duplicate-id (list a b)))
167 | (cl-loop for (k v) on (flatten-tree a) by #'cddr do
168 | (setf (alist-get k b) (string-trim (concat (alist-get k b) " " v)))
169 | finally return (nreverse b)))
170 |
171 | (defun mel--parse-attributes (vector)
172 | "Return attribute alist from VECTOR."
173 | (cl-loop for (k v) on (cl-coerce vector 'list) by #'cddr
174 | for key = (symbol-name k)
175 | collect (cons (if (string-prefix-p ":" key) (intern (substring key 1)) k)
176 | (if v (format "%s" v) ""))))
177 |
178 | (defvar mel-path nil)
179 | (defun mel-node (spec)
180 | "Return a list of nodes from mel SPEC."
181 | (let ((mel-path mel-path))
182 | (mel-set 'path mel-path)
183 | (cl-loop for fn in (ensure-list mel-spec-functions)
184 | do (when-let ((val (funcall fn spec))) (setq spec val)))
185 | (if (atom spec) (list (format "%s" spec))
186 | (cl-loop
187 | with tokens = (mel--parse-symbol (pop spec))
188 | with tag = (intern (alist-get 'tag tokens "div"))
189 | with rest = nil
190 | initially (setf (alist-get 'tag tokens nil t) nil)
191 | (push tag mel-path)
192 | for el in spec collect
193 | (if (vectorp el)
194 | (setq tokens
195 | (condition-case err
196 | (mel--merge-attributes (mel--parse-attributes el) tokens)
197 | ((duplicate-id) (error "Duplicate ID %s: %s" spec (cdr err)))))
198 | (setq rest
199 | (if (consp el)
200 | (append (cond ((eq (car-safe el) '\`)
201 | (mel-node (eval el `((self . ,(cadr el))))))
202 | ((eq (car-safe el) '\,)
203 | (mel-node (eval (cadr el) `((self . ,(cadr el))))))
204 | ((eq (car-safe el) '\,@)
205 | (reverse (apply #'mel-nodelist (eval (cadr el) `((self . ,(cadr el)))))))
206 | (t (mel-node el)))
207 | rest)
208 | (cons el rest))))
209 | finally return (let ((node `(,tag ,tokens ,@(nreverse rest))))
210 | (cl-loop for fn in (ensure-list mel-node-functions)
211 | do (when-let ((val (funcall fn node))) (setq node val)))
212 | (list node))))))
213 |
214 | (defun mel-nodelist (&rest specs)
215 | "Return List of nodes from SPECS."
216 | (apply #'append (mapcar #'mel-node specs)))
217 |
218 | (defun mel--dom-print (fn &rest args)
219 | "Advice for `dom-print' FN to handle ARGS."
220 | (let* ((node (car args))
221 | (tag (car-safe node)))
222 | (if-let ((custom (cl-loop for fn in (ensure-list mel-print-functions)
223 | thereis (funcall fn node))))
224 | (insert custom)
225 | (cond ((stringp node) (insert (url-insert-entities-in-string node)))
226 | ((eq tag :raw) (apply #'insert (nthcdr 2 node)))
227 | ((eq tag :comment)
228 | (insert (with-current-buffer (get-buffer-create " *mel-comment*")
229 | (erase-buffer)
230 | (unless (derived-mode-p 'html-mode) (delay-mode-hooks (html-mode)))
231 | (apply #'insert (nthcdr 2 node))
232 | (comment-region (point-min) (point-max))
233 | (buffer-substring-no-properties (point-min) (point-max)))))
234 | (t (funcall fn node (not mel-print-compact)))))))
235 |
236 | (defun mel--insert-node (node)
237 | "Insert NODE."
238 | (advice-add #'dom-print :around #'mel--dom-print)
239 | (unwind-protect (dom-print node (not mel-print-compact))
240 | (advice-remove #'dom-print #'mel--dom-print)))
241 |
242 | (defun mel (&rest specs)
243 | "Return HTML string from SPECS."
244 | (with-temp-buffer
245 | (unless (derived-mode-p 'html-mode) (delay-mode-hooks (html-mode)))
246 | (mapc #'mel--insert-node (apply #'mel-nodelist specs))
247 | (unless mel-print-compact
248 | (let ((inhibit-message t))
249 | (indent-region (point-min) (point-max))))
250 | (buffer-substring-no-properties (point-min) (point-max))))
251 |
252 | (defun mel-file-p (filename)
253 | "Return non-nil if FILENAME has a .mel or .htmel file extension."
254 | (when-let (((stringp filename))
255 | (ext (file-name-extension filename)))
256 | (string-match-p "\\(?:ht\\)?mel\\'" ext)))
257 |
258 | (defun mel-write-html (source output)
259 | "Write mel SOURCE file to HTML OUTPUT."
260 | (interactive
261 | (let* ((f (buffer-file-name))
262 | (source (read-file-name "MEL source file: " nil
263 | (when (mel-file-p f) f)
264 | 'must-match
265 | (when (mel-file-p f) f)
266 | #'mel-file-p)))
267 | (list source (concat (file-name-sans-extension source) ".html"))))
268 | (with-temp-buffer
269 | (insert "\n" (mel (mel-read source)))
270 | (write-file output 'confirm)))
271 |
272 | (defun mel--custom-tag-function (spec)
273 | "Return custom tag function from tag SPEC."
274 | `(lambda (spec)
275 | (when-let ((tag (car-safe spec))
276 | ((eq (mel-tag-name tag) ',(car spec))))
277 | (let ((attributes (mel-tag-attributes tag))
278 | (body (cdr spec)))
279 | `(,(intern (format ,(concat (symbol-name (cadr spec)) "%s") (or attributes "")))
280 | ,@(backquote ,(cddr spec)))))))
281 |
282 | (defmacro mel-deftag (name spec)
283 | "Define function for tag with NAME which expands to SPEC."
284 | `(defalias ',(intern (format "+mel-%s" name))
285 | (function ,(mel--custom-tag-function (cons name spec)))))
286 |
287 | (defvar html-tag-help)
288 | (define-derived-mode mel-mode emacs-lisp-mode "mel-mode"
289 | "Major mode for editing .mel files."
290 | (require 'sgml-mode)
291 | (font-lock-add-keywords
292 | nil `((,(concat "([[:space:]]*\\("
293 | (regexp-opt (mapcar #'car html-tag-help) nil)
294 | "\\)[.\\#@[) \t\n\r]")
295 | 1 font-lock-function-name-face)
296 | ("\\(?:mel-deftag[[:space:]]+?\\(\\([[:alnum:]]\\|-\\)+?[ \t\r\n]+?\\)\\)"
297 | 1 font-lock-function-name-face)
298 | ("\\(\\.[[:alpha:]-]+\\)" 1 font-lock-type-face)
299 | ("[^,]\\(\\(#\\|@\\)[[:alpha:]-]+\\)" 1 font-lock-keyword-face))))
300 |
301 | ;;;###autoload
302 | (add-to-list 'auto-mode-alist '("\\.mel\\'" . mel-mode))
303 | ;;;###autoload
304 | (add-to-list 'auto-mode-alist '("\\.htmel\\'" . mel-mode))
305 |
306 | (provide 'mel)
307 | ;;; mel.el ends here
308 |
--------------------------------------------------------------------------------
