-
Notifications
You must be signed in to change notification settings - Fork 2
/
rnc-mode.el
174 lines (151 loc) · 6.1 KB
/
rnc-mode.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
;;; rnc-mode.el --- Emacs mode to edit Relax-NG Compact files -*- lexical-binding:t -*-
;; Copyright (C) 1994-1998, 2001-2022 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Keywords: xml relaxng
;; Version: 0.3
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
(require 'smie)
(require 'nxml-mode)
;;; Code:
;;;###autoload
(add-to-list 'auto-mode-alist '("\\.rnc\\'" . rnc-mode))
(defconst rnc-mode-syntax-table
(let ((st (make-syntax-table)))
(modify-syntax-entry ?# "<" st)
(modify-syntax-entry ?\n ">" st)
(modify-syntax-entry ?\" "\"" st)
(modify-syntax-entry ?\' "\"" st)
(modify-syntax-entry ?- "_" st)
(modify-syntax-entry ?. "_" st)
(modify-syntax-entry ?: "_" st)
(modify-syntax-entry ?_ "_" st)
st))
(defconst rnc--keywords
;; Taken from the grammar in http://relaxng.org/compact-20021121.html,
;; by order of appearance.
'("namespace" "default" "datatypes" "element" "attribute"
"list" "mixed" "parent" "empty" "text" "notAllowed" "external"
"grammar" "div" "include" ;; "start"
"string" "token" "inherit"))
(defconst rnc--def-regexp "^[ \t]*\\([\\[:alpha:]][[:alnum:]-._]*\\)[ \t]*=")
(defconst rnc-font-lock-keywords
`((,rnc--def-regexp (1 font-lock-function-name-face))
(,(concat "\\_<" (regexp-opt rnc--keywords) "\\_>")
(0 font-lock-keyword-face))
("attribute[ \t\n]+\\([^ ]+\\)" (1 'nxml-attribute-local-name))
;; FIXME: We'd like to use nxml-element-local-name for element names,
;; but by default this looks exactly like font-lock-function-name-face,
;; which we want to use for local pattern definitions.
;; ("element[ \t\n]+\\([^ ]+\\)" (1 'nxml-element-local-name))
))
(defconst rnc-imenu-generic-expression `((nil ,rnc--def-regexp 1)))
(defconst rnc-smie-grammar
;; The body of an RNC file is a sequence of definitions.
;; Problem is: these definitions are not separated by any special keyword.
;; It's basically a repetition of (id "=" pattern), where
;; patterns can end with:
;; "}", ")" "*", "+", "?", id, stringliteral
;; Since this is way beyond the power of SMIE, we resort to using a pseudo
;; " ; " separator which is introduced by the tokenizer.
(smie-prec2->grammar
(smie-bnf->prec2
'((id) (atom) (args)
(annota (id "[" args "]"))
(header (header "include" atom))
(decls (id "=" pattern) (id "|=" pattern) (id "&=" pattern)
(decls " ; " decls))
(pattern ("element" args) ("attribute" args)
("list" args) ("mixed" args)
("parent" id) ("external" id)
("grammar" atom)
("{" pattern "}")
(annota patterm)
(pattern "," pattern)
(pattern "&" pattern)
(pattern "|" pattern)
(pattern "?")
(pattern "*")
(pattern "+")))
;; The spec says "There is no notion of operator precedence".
'((assoc " ; "))
'((assoc "," "&" "|") (nonassoc "?" "*" "+"))
)))
(defconst rnc-smie--def-regexp
(concat "\\(?:\\(?:\\(default[ \t\n]+\\)?namespace\\|datatypes\\)[ \t\n]+\\)?"
"\\(?:\\s_\\|\\sw\\)+[ \t\n]*[|&]?=")
"Regexp matching a \"definition\".
Any line that starts with this is presumed to start a new definition,
so the preceding newline is turned into an implicit \" ; \" token.")
(defun rnc-smie-forward-token ()
(let ((start (point)))
(forward-comment (point-max))
(if (and (> (point) start)
(looking-at rnc-smie--def-regexp)
(save-excursion
(goto-char start)
(forward-comment -1)
(= (point) start)))
" ; "
(if (looking-at "\\s.")
(buffer-substring-no-properties
(point)
(progn (forward-char 1)
(point)))
(smie-default-forward-token)))))
(defun rnc-smie-backward-token ()
(let ((start (point)))
(forward-comment (- (point)))
(if (and (< (point) start)
(let ((pos (point)))
(goto-char start)
(prog1
(looking-at rnc-smie--def-regexp)
(goto-char pos))))
" ; "
(if (looking-back "\\s." (1- (point)))
(buffer-substring-no-properties
(point)
(progn (forward-char -1)
(point)))
(smie-default-backward-token)))))
(defun rnc-smie-rules (kind token)
(pcase (cons kind token)
(`(:list-intro . "element") t)
(`(:elem . empty-line-token) " ; ")
(`(:before . ,(or "include" "default" "namespace" "datatypes")) 0)
(`(:before . "{")
(save-excursion
(let ((offset (if (smie-rule-bolp) smie-indent-basic 0))
x)
(while (or (null (car-safe x))
(integerp (car-safe x)))
(setq x (smie-backward-sexp 'halfsexp)))
(goto-char (nth 1 x))
`(column . ,(+ (smie-indent-virtual) offset)))))
(`(:after . ,(or "=" "|=" "&=")) smie-indent-basic)
(`(:before . ,(or "|" "&" ","))
(and (smie-rule-bolp) (smie-rule-parent-p "(" "{") (smie-rule-parent)))
(`(,_ . " ; ") (smie-rule-separator kind))
))
;;;###autoload
(define-derived-mode rnc-mode prog-mode "RNC"
"Major mode to edit Relax-NG Compact files."
(setq-local comment-start "#")
(setq-local font-lock-defaults '(rnc-font-lock-keywords))
(setq-local imenu-generic-expression rnc-imenu-generic-expression)
(smie-setup rnc-smie-grammar #'rnc-smie-rules
:forward-token #'rnc-smie-forward-token
:backward-token #'rnc-smie-backward-token))
(provide 'rnc-mode)
;;; rnc-mode.el ends here