-
Notifications
You must be signed in to change notification settings - Fork 8
/
lisp-markup.el
383 lines (335 loc) · 13.9 KB
/
lisp-markup.el
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
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
;;;; lisp-markup.el
;;;; Charles Jackson
(require 'sgml-mode)
(require 'lisp-mode)
(defvar lisp-markup-minor-mode-map
(let ((keymap (make-keymap)))
(define-key keymap (kbd "/") #'lisp-markup-/-close-tag)
(define-key keymap (kbd "C-c C-o") #'sgml-tag)
(define-key keymap (kbd "<return>") #'newline-and-indent)
keymap)
"Additional key bindings for `lisp-markup-minor-mode'.")
(defvar lisp-markup-sgml-tag-syntax-table
(let ((table (make-syntax-table sgml-tag-syntax-table)))
(modify-syntax-entry ?' "." table)
(modify-syntax-entry 40 "|" table)
(modify-syntax-entry 41 "|" table)
table)
"A modified `sgml-tag-syntax-table' that effectively ignores
content between ?( and ?) by mapping them to symbol-escape
characters. Additionally maps ?' to be a punctuation character
which separates symbols.")
(defvar *lisp-markup-mode-keywords*
'(("</?\\(:[^>/=[:space:]]+\\)" 1 font-lock-builtin-face)
;; regular tag names
("</?\\([^!>/=[:space:]]*\\)" 1 font-lock-function-name-face)
;; attribute names
("[[:space:]]\\([-[:alpha:]]+\\)=" 1 font-lock-constant-face)
;; deftag faces
("(\\(deftag\\)" 1 font-lock-keyword-face)
("(deftag \\([^ ]+\\) " 1 font-lock-function-name-face)
;; warning about single symbol lisp forms at the end of tags
("=[^[:space:]<>]+[^\"/) ]\\(/\\|>\\)" 1 font-lock-warning-face))
"`font-lock' configuration for `lisp-markup-minor-mode' to
provide highlighting to HTML code within lisp files.")
(define-minor-mode lisp-markup-minor-mode
"Enhance `lisp-mode' with additional features to support embedded HTML markup.
This changes syntax highlighting, indentation rules, and adds
some extra keybindings to make editing of markup in lisp files
easier."
:lighter " markup"
:keymap lisp-markup-minor-mode-map
(if (eq major-mode 'lisp-mode)
(if lisp-markup-minor-mode
(enter-lisp-markup-minor-mode)
(exit-lisp-markup-minor-mode))
(progn
(setf lisp-markup-minor-mode nil)
(error "lisp-markup-minor-mode only supports running in lisp-mode"))))
(defun lisp-markup--font-lock-update ()
(unless (version< emacs-version "28.1")
(font-lock-update)))
(defun enter-lisp-markup-minor-mode ()
"Perform the setup required by `lisp-markup-minor-mode'."
(font-lock-add-keywords nil *lisp-markup-mode-keywords*)
(lisp-markup--font-lock-update)
(setq-local indent-line-function #'lisp-markup-indent-line
indent-region-function #'indent-region-line-by-line ; Less efficient, but still correct
forward-sexp-function #'lisp-markup-forward-sexp
comment-region-function #'lisp-markup-comment-region
syntax-propertize-function lisp-markup-syntax-propertize-function)
(sgml-electric-tag-pair-mode 1))
(defun exit-lisp-markup-minor-mode ()
"Undo the setup performed by `enter-lisp-markup-minor-mode'."
(font-lock-remove-keywords nil *lisp-markup-mode-keywords*)
(lisp-markup--font-lock-update)
(setq-local indent-line-function #'lisp-indent-line
indent-region-function #'lisp-indent-region
forward-sexp-function nil
comment-region-function #'comment-region-default
syntax-propertize-function nil)
(sgml-electric-tag-pair-mode -1))
(defvar lisp-markup-syntax-propertize-function
(syntax-propertize-rules
("\\(<\\)!--" (1 "< b"))
("--[ \t\n]*\\(>\\)" (1 "> b"))
("\\(<\\)[?!]" (1 (prog1 "|>"
(sgml-syntax-propertize-inside end)))))
"Function to apply syntax-propertize rules for mixed Lisp and HTML.
This handles adding the required syntax properties to HTML
comments embedded in Lisp code. This is mostly just stolen from
sgml-mode.")
(defun lisp-marker-infer-comment-settings ()
"Infer the right comment characters when in `lisp-markup-minor-mode'.
This handles checking if we're in Lisp mode or HTML mode, and
setting `comment-start' and `comment-end' appropriately."
(when lisp-markup-minor-mode ; Having this lets us use this as global advice on `comment-normalize-vars'
(if (lisp-markup-in-html-p)
(setq-local comment-start "<!-- "
comment-end " -->")
(setq-local comment-start ";"
comment-end ""))))
(advice-add 'comment-normalize-vars :before #'lisp-marker-infer-comment-settings)
(defmacro lisp-markup-with-<>-as-brackets (&rest body)
"Run BODY in a context where ?< and ?> behave as brackets, and ?(
and ?) behave as string delimiters. This is useful to run SGML
functions on code that contains both Lisp and HTML."
(declare (indent 0))
`(with-syntax-table (make-syntax-table (syntax-table))
(modify-syntax-entry ?< "(")
(modify-syntax-entry ?> ")")
(modify-syntax-entry 40 "\"")
(modify-syntax-entry 41 "\"")
(progn ,@body)))
(defmacro lisp-markup-with-sgml-tag-table (&rest body)
"Run BODY in a context where `sgml-tag-syntax-table' is resolved
to be our custom syntax table. This allows us to run SGML
functions which internally change the syntax table without them
getting confused by Lisp code.."
`(let ((sgml-tag-syntax-table lisp-markup-sgml-tag-syntax-table))
,@body))
;;; Determining context
;;; ===================
(defun lisp-markup-in-html-p ()
"Check if point is currently in an HTML context."
(let ((html (lisp-markup-enclosing-html-tag)))
(when html
(let ((lisp (lisp-markup-enclosing-lisp-section)))
(and (<= (car lisp) (car html))
(<= (cdr html) (cdr lisp)))))))
(defun lisp-markup-find-enclosing (find-start goto-end not-found)
"Find the nearest enclosing \"section\" defined by FIND-START and GOTO-END.
This function looks backwards in the buffer to find the start of
the nearest section by calling FIND-START. This function defines
what the start of a section is by moving point to be before the
first character of a section. This will often involve a call to
`search-backward-regexp' or similar. If FIND-START throws an
error the search will end and NOT-FOUND will be returned.
Once the start of a section has been found, GOTO-END will be
called to move point to the end of this section. If GOTO-END
throws an error, `point-max' will be used as the end value.
Returns a pair of beginning and end points, or NOT-FOUND."
(save-excursion
(catch 'return
(let ((initial (point)))
(while t
(let* ((start (or (ignore-errors
(funcall find-start)
(while (nth 4 (syntax-ppss)) ; is in a comment
(funcall find-start)) ; so keep looking
(point))
(throw 'return not-found)))
(end (or (ignore-errors
(funcall goto-end)
(point))
(throw 'return (cons start (point-max))))))
(when (and (<= start initial)
(< initial end))
(throw 'return (cons start end)))
;; Reset for the next iteration
(goto-char start)))))))
(defun lisp-markup-enclosing-lisp-section ()
"Find the nearest enclosing Lisp section.
This function looks backwards in the buffer to find the start of
the nearest Lisp section, then looks forwards to find its end. If
no start/end is found, returns the values of `point-min' and
`point-max' as the beginning and end, respectively.
Returns a pair of beginning and end points."
(lisp-markup-find-enclosing
(lambda ()
(search-backward-regexp ",(\\|,@\\|=("))
(lambda ()
(skip-chars-forward "=,@")
(forward-sexp))
(cons (point-min) (point-max))))
(defun lisp-markup-enclosing-html-tag ()
"Find the nearest enclosing HTML tag.
This function looks backwards in the buffer to find the start of
the nearest HTML section, then looks forwards to find its end.
Returns a pair of beginning and end points. If no end is found,
returns a pair of start and `point-max'. If no start is found,
returns nil."
(lisp-markup-find-enclosing
(lambda ()
(search-backward-regexp "<[^/=![:space:]()]"))
(lambda ()
(lisp-markup-with-sgml-tag-table
(or (sgml-skip-tag-forward 1)
(error "No end tag found!"))))
nil))
;;; Indentation
;;; ===========
(defun lisp-markup-indent-line ()
"Indent a line of Lisp or HTML, according to the line's context."
(interactive)
(save-excursion
(lisp-markup-with-sgml-tag-table
(with-syntax-table (if (>= emacs-major-version 28)
lisp-mode-syntax-table
lisp--mode-syntax-table)
(back-to-indentation)
(let ((prev-html (save-excursion
(forward-line -1)
(end-of-line)
(lisp-markup-in-html-p))))
(cond
;; closing tag
((looking-at-p "</")
(let* ((indent
(save-excursion
(forward-sexp 1)
(sgml-skip-tag-backward 1)
(- (point) (progn (beginning-of-line) (point))))))
(indent-line-to (max 0 indent))))
;; after closing tag and end of lisp form
((and prev-html
(save-excursion
(forward-line -1)
(end-of-line)
(skip-chars-backward "\t\r\n ")
(and (= (char-before) 41)
(progn
(forward-sexp -1)
(skip-chars-backward ",@")
(= (char-after) ?,)))))
(indent-line-to
(save-excursion
(forward-sexp -1)
(current-indentation))))
;;
((and prev-html
(save-excursion
(forward-line -1)
(back-to-indentation)
(looking-at-p "</")))
(indent-line-to
(save-excursion
(forward-line -1)
(back-to-indentation)
(- (point) (progn (beginning-of-line) (point))))))
;; sgml indent
(prev-html
(lisp-markup-with-<>-as-brackets
(sgml-indent-line)))
;; lisp indent
(:else
(let ((indent (calculate-lisp-indent)))
(cond
((and indent (listp indent)) (indent-line-to (car indent)))
(indent (indent-line-to indent))))))))))
(when (< (point) (save-excursion (back-to-indentation) (point)))
(back-to-indentation)))
;;; Comments
;;; ========
(defun lisp-markup-comment-region (beg end &optional arg)
"Comment region in the way you'd expect, depending on the context of BEG."
(save-excursion
(goto-char beg)
(lisp-marker-infer-comment-settings))
(comment-region-default beg end arg))
;;; Forward/backward by sexp
;;; ========================
(defun lisp-markup-forward-sexp (&optional n interactive)
"Move over the next \"sexp\" in the buffer, which includes an entire HTML tag.
This mostly tries to guess if the next thing is HTML or Lisp by
looking at the beginning of it. It's not foolproof, but it's
still pretty useful."
(let ((n (or n 1)))
(cond
((< 0 n)
(if (looking-at-p "[[:space:]\n]*<[^/=\"![:space:]()]")
(lisp-markup-with-sgml-tag-table
(sgml-skip-tag-forward n))
(let ((forward-sexp-function nil))
(forward-sexp n interactive))))
((< n 0)
(if (save-excursion (let ((whitespace-chars (string-to-list " \t\r\n")))
(while (member (char-before) whitespace-chars)
(backward-char)))
(backward-char 2)
(looking-at-p "[^[:space:]'()]>"))
(lisp-markup-with-sgml-tag-table
(sgml-skip-tag-backward (- n)))
(let ((forward-sexp-function nil))
(forward-sexp n interactive)))))))
;;; Automatic tag closing
;;; =====================
(defun lisp-markup-html-closed-p ()
"Test whether the current HTML tag has a corresponding closing tag.
This method must be called with point before the opening < of a tag."
(save-excursion
(lisp-markup-with-sgml-tag-table
(when (sgml-skip-tag-forward 1)
(point)))))
(defun lisp-markup-find-unclosed-tag-name ()
"This function only looks backwards to find unclosed tags, and
thus a tag that is closed further forwards in the file will not
be considered as being closed. Hence in an example like this:
<div>
<span></span>
|
</div>
with point at |, \"div\" will be returned."
(let ((html (lisp-markup-enclosing-html-tag)))
(if html
(save-excursion
(goto-char (car html))
(buffer-substring-no-properties
(+ (point) 1)
(- (search-forward-regexp "[>/[:space:]]") 1)))
(error "No HTML tag found to close"))))
(defun lisp-markup-html-close-tag ()
"Insert a closing tag for the nearest tag before point that is unclosed.
This function only looks backwards to find unclosed tags, and
thus a tag that is closed further forwards in the file will not
be considered as being closed. Hence in an example like this:
<div>
<span></span>
|
</div>
with point at |, a </div> will be inserted."
(interactive)
(insert "</" (lisp-markup-find-unclosed-tag-name) ">"))
(defun lisp-markup-/-close-tag ()
"Automatically insert a closing tag if this character was typed
after a <. Otherwise, just insert a /."
(interactive)
(insert "/")
(when (save-excursion (backward-char 2)
(looking-at-p "</"))
(insert (lisp-markup-find-unclosed-tag-name))
(unless (looking-at-p ">")
(insert ">"))
(lisp-markup-indent-line)))
(defun lisp-markup--lisp-mode-hook ()
"Detect if this Lisp file looks like a markup file, if so enable
the minor mode."
(save-excursion
(goto-char (point-min))
(when (re-search-forward
"^(\\(markup:enable-reader\\|named-readtables:in-readtable.*markup:syntax\\))"
nil t)
(lisp-markup-minor-mode))))
(add-hook 'lisp-mode-hook #'lisp-markup--lisp-mode-hook)
(provide 'lisp-markup)
;;; lisp-markup.el ends here