|
86361
|
1 ;;; rng-nxml.el --- make nxml-mode take advantage of rng-validate-mode
|
|
|
2
|
|
100908
|
3 ;; Copyright (C) 2003, 2007, 2008, 2009 Free Software Foundation, Inc.
|
|
86361
|
4
|
|
|
5 ;; Author: James Clark
|
|
|
6 ;; Keywords: XML, RelaxNG
|
|
|
7
|
|
86550
|
8 ;; This file is part of GNU Emacs.
|
|
|
9
|
|
94666
|
10 ;; GNU Emacs is free software: you can redistribute it and/or modify
|
|
86550
|
11 ;; it under the terms of the GNU General Public License as published by
|
|
94666
|
12 ;; the Free Software Foundation, either version 3 of the License, or
|
|
|
13 ;; (at your option) any later version.
|
|
86361
|
14
|
|
86550
|
15 ;; GNU Emacs is distributed in the hope that it will be useful,
|
|
|
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
18 ;; GNU General Public License for more details.
|
|
86361
|
19
|
|
86550
|
20 ;; You should have received a copy of the GNU General Public License
|
|
94666
|
21 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
|
|
86361
|
22
|
|
|
23 ;;; Commentary:
|
|
|
24
|
|
|
25 ;;; Code:
|
|
|
26
|
|
|
27 (require 'easymenu)
|
|
|
28 (require 'xmltok)
|
|
|
29 (require 'nxml-util)
|
|
|
30 (require 'nxml-ns)
|
|
|
31 (require 'rng-match)
|
|
|
32 (require 'rng-util)
|
|
|
33 (require 'rng-valid)
|
|
|
34 (require 'nxml-mode)
|
|
|
35 (require 'rng-loc)
|
|
|
36
|
|
|
37 (defcustom rng-nxml-auto-validate-flag t
|
|
|
38 "*Non-nil means automatically turn on validation with nxml-mode."
|
|
|
39 :type 'boolean
|
|
|
40 :group 'relax-ng)
|
|
|
41
|
|
87717
|
42 (defcustom rng-preferred-prefix-alist
|
|
|
43 '(("http://www.w3.org/1999/XSL/Transform" . "xsl")
|
|
|
44 ("http://www.w3.org/1999/02/22-rdf-syntax-ns#" . "rdf")
|
|
|
45 ("http://www.w3.org/1999/xlink" . "xlink")
|
|
|
46 ("http://www.w3.org/2001/XmlSchema" . "xsd")
|
|
92468
|
47 ("http://www.w3.org/2001/XMLSchema-instance" . "xsi")
|
|
|
48 ("http://purl.org/dc/elements/1.1/" . "dc")
|
|
|
49 ("http://purl.org/dc/terms/" . "dcterms"))
|
|
86361
|
50 "*Alist of namespaces vs preferred prefixes."
|
|
|
51 :type '(repeat (cons :tag "With"
|
|
|
52 (string :tag "this namespace URI")
|
|
|
53 (string :tag "use this prefix")))
|
|
|
54 :group 'relax-ng)
|
|
|
55
|
|
|
56 (defvar rng-complete-end-tags-after-< t
|
|
|
57 "*Non-nil means immediately after < complete on end-tag names.
|
|
|
58 Complete on start-tag names regardless.")
|
|
|
59
|
|
|
60 (defvar rng-nxml-easy-menu
|
|
|
61 '("XML"
|
|
|
62 ["Show Outline Only" nxml-hide-all-text-content]
|
|
|
63 ["Show Everything" nxml-show-all]
|
|
|
64 "---"
|
|
|
65 ["Validation" rng-validate-mode
|
|
|
66 :style toggle
|
|
|
67 :selected rng-validate-mode]
|
|
|
68 "---"
|
|
|
69 ("Set Schema"
|
|
|
70 ["Automatically" rng-auto-set-schema]
|
|
|
71 ("For Document Type"
|
|
|
72 :filter (lambda (menu)
|
|
|
73 (mapcar (lambda (type-id)
|
|
|
74 (vector type-id
|
|
|
75 (list 'rng-set-document-type
|
|
|
76 type-id)))
|
|
|
77 (rng-possible-type-ids))))
|
|
|
78 ["Any Well-Formed XML" rng-set-vacuous-schema]
|
|
|
79 ["File..." rng-set-schema-file])
|
|
|
80 ["Show Schema Location" rng-what-schema]
|
|
|
81 ["Save Schema Location" rng-save-schema-location :help
|
|
|
82 "Save the location of the schema currently being used for this buffer"]
|
|
|
83 "---"
|
|
|
84 ["First Error" rng-first-error :active rng-validate-mode]
|
|
|
85 ["Next Error" rng-next-error :active rng-validate-mode]
|
|
|
86 "---"
|
|
87347
|
87 ["Customize nXML" (customize-group 'nxml)]))
|
|
86361
|
88
|
|
|
89 ;;;###autoload
|
|
|
90 (defun rng-nxml-mode-init ()
|
|
|
91 "Initialize `nxml-mode' to take advantage of `rng-validate-mode'.
|
|
|
92 This is typically called from `nxml-mode-hook'.
|
|
|
93 Validation will be enabled if `rng-nxml-auto-validate-flag' is non-nil."
|
|
|
94 (interactive)
|
|
|
95 (define-key nxml-mode-map "\C-c\C-v" 'rng-validate-mode)
|
|
|
96 (define-key nxml-mode-map "\C-c\C-s\C-w" 'rng-what-schema)
|
|
|
97 (define-key nxml-mode-map "\C-c\C-s\C-a" 'rng-auto-set-schema-and-validate)
|
|
|
98 (define-key nxml-mode-map "\C-c\C-s\C-f" 'rng-set-schema-file-and-validate)
|
|
|
99 (define-key nxml-mode-map "\C-c\C-s\C-l" 'rng-save-schema-location)
|
|
|
100 (define-key nxml-mode-map "\C-c\C-s\C-t" 'rng-set-document-type-and-validate)
|
|
|
101 (define-key nxml-mode-map "\C-c\C-n" 'rng-next-error)
|
|
|
102 (easy-menu-define rng-nxml-menu nxml-mode-map
|
|
|
103 "Menu for nxml-mode used with rng-validate-mode."
|
|
|
104 rng-nxml-easy-menu)
|
87792
c689fd3b9cfd
(rng-nxml-mode-init): Don't overwrite mode-line-process.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
105 (add-to-list 'mode-line-process
|
87797
3305ad06c630
(rng-nxml-mode-init): Add status after the "degraded" indicator.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
106 '(rng-validate-mode (:eval (rng-compute-mode-line-string)))
|
3305ad06c630
(rng-nxml-mode-init): Add status after the "degraded" indicator.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
107 'append)
|
|
86361
|
108 (cond (rng-nxml-auto-validate-flag
|
|
|
109 (rng-validate-mode 1)
|
|
|
110 (add-hook 'nxml-completion-hook 'rng-complete nil t)
|
|
|
111 (add-hook 'nxml-in-mixed-content-hook 'rng-in-mixed-content-p nil t))
|
|
|
112 (t
|
|
|
113 (rng-validate-mode 0)
|
|
|
114 (remove-hook 'nxml-completion-hook 'rng-complete t)
|
|
|
115 (remove-hook 'nxml-in-mixed-content-hook 'rng-in-mixed-content-p t))))
|
|
|
116
|
|
|
117 (defvar rng-tag-history nil)
|
|
|
118 (defvar rng-attribute-name-history nil)
|
|
|
119 (defvar rng-attribute-value-history nil)
|
|
|
120
|
|
|
121 (defvar rng-complete-target-names nil)
|
|
|
122 (defvar rng-complete-name-attribute-flag nil)
|
|
|
123 (defvar rng-complete-extra-strings nil)
|
|
|
124
|
|
|
125 (defun rng-complete ()
|
|
|
126 "Complete the string before point using the current schema.
|
|
|
127 Return non-nil if in a context it understands."
|
|
|
128 (interactive)
|
|
|
129 (and rng-validate-mode
|
|
|
130 (let ((lt-pos (save-excursion (search-backward "<" nil t)))
|
|
|
131 xmltok-dtd)
|
|
|
132 (and lt-pos
|
|
|
133 (= (rng-set-state-after lt-pos) lt-pos)
|
|
|
134 (or (rng-complete-tag lt-pos)
|
|
|
135 (rng-complete-end-tag lt-pos)
|
|
|
136 (rng-complete-attribute-name lt-pos)
|
|
|
137 (rng-complete-attribute-value lt-pos))))))
|
|
|
138
|
|
|
139 (defconst rng-in-start-tag-name-regex
|
|
|
140 (replace-regexp-in-string
|
|
|
141 "w"
|
|
|
142 xmltok-ncname-regexp
|
|
|
143 "<\\(?:w\\(?::w?\\)?\\)?\\="
|
|
|
144 t
|
|
|
145 t))
|
|
|
146
|
|
|
147 (defun rng-complete-tag (lt-pos)
|
|
|
148 (let (rng-complete-extra-strings)
|
|
|
149 (when (and (= lt-pos (1- (point)))
|
|
|
150 rng-complete-end-tags-after-<
|
|
|
151 rng-open-elements
|
|
|
152 (not (eq (car rng-open-elements) t))
|
|
|
153 (or rng-collecting-text
|
|
|
154 (rng-match-save
|
|
|
155 (rng-match-end-tag))))
|
|
|
156 (setq rng-complete-extra-strings
|
|
|
157 (cons (concat "/"
|
|
|
158 (if (caar rng-open-elements)
|
|
|
159 (concat (caar rng-open-elements)
|
|
|
160 ":"
|
|
|
161 (cdar rng-open-elements))
|
|
|
162 (cdar rng-open-elements)))
|
|
|
163 rng-complete-extra-strings)))
|
|
|
164 (when (save-excursion
|
|
|
165 (re-search-backward rng-in-start-tag-name-regex
|
|
|
166 lt-pos
|
|
|
167 t))
|
|
|
168 (and rng-collecting-text (rng-flush-text))
|
|
|
169 (let ((completion
|
|
|
170 (let ((rng-complete-target-names
|
|
|
171 (rng-match-possible-start-tag-names))
|
|
|
172 (rng-complete-name-attribute-flag nil))
|
|
|
173 (rng-complete-before-point (1+ lt-pos)
|
|
|
174 'rng-complete-qname-function
|
|
|
175 "Tag: "
|
|
|
176 nil
|
|
|
177 'rng-tag-history)))
|
|
|
178 name)
|
|
|
179 (when completion
|
|
|
180 (cond ((rng-qname-p completion)
|
|
|
181 (setq name (rng-expand-qname completion
|
|
|
182 t
|
|
|
183 'rng-start-tag-expand-recover))
|
|
|
184 (when (and name
|
|
|
185 (rng-match-start-tag-open name)
|
|
|
186 (or (not (rng-match-start-tag-close))
|
|
|
187 ;; need a namespace decl on the root element
|
|
|
188 (and (car name)
|
|
|
189 (not rng-open-elements))))
|
|
|
190 ;; attributes are required
|
|
|
191 (insert " ")))
|
|
|
192 ((member completion rng-complete-extra-strings)
|
|
|
193 (insert ">")))))
|
|
|
194 t)))
|
|
|
195
|
|
|
196 (defconst rng-in-end-tag-name-regex
|
|
|
197 (replace-regexp-in-string
|
|
|
198 "w"
|
|
|
199 xmltok-ncname-regexp
|
|
|
200 "</\\(?:w\\(?::w?\\)?\\)?\\="
|
|
|
201 t
|
|
|
202 t))
|
|
|
203
|
|
|
204 (defun rng-complete-end-tag (lt-pos)
|
|
|
205 (when (save-excursion
|
|
|
206 (re-search-backward rng-in-end-tag-name-regex
|
|
|
207 lt-pos
|
|
|
208 t))
|
|
|
209 (cond ((or (not rng-open-elements)
|
|
|
210 (eq (car rng-open-elements) t))
|
|
|
211 (message "No matching start-tag")
|
|
|
212 (ding))
|
|
|
213 (t
|
|
|
214 (let ((start-tag-name
|
|
|
215 (if (caar rng-open-elements)
|
|
|
216 (concat (caar rng-open-elements)
|
|
|
217 ":"
|
|
|
218 (cdar rng-open-elements))
|
|
|
219 (cdar rng-open-elements)))
|
|
|
220 (end-tag-name
|
|
|
221 (buffer-substring-no-properties (+ (match-beginning 0) 2)
|
|
|
222 (point))))
|
|
|
223 (cond ((or (> (length end-tag-name)
|
|
|
224 (length start-tag-name))
|
|
|
225 (not (string= (substring start-tag-name
|
|
|
226 0
|
|
|
227 (length end-tag-name))
|
|
|
228 end-tag-name)))
|
|
|
229 (message "Expected end-tag %s"
|
|
|
230 (rng-quote-string
|
|
|
231 (concat "</" start-tag-name ">")))
|
|
|
232 (ding))
|
|
|
233 (t
|
|
|
234 (delete-region (- (point) (length end-tag-name))
|
|
|
235 (point))
|
|
|
236 (insert start-tag-name ">")
|
|
|
237 (when (not (or rng-collecting-text
|
|
|
238 (rng-match-end-tag)))
|
|
|
239 (message "Element %s is incomplete"
|
|
|
240 (rng-quote-string start-tag-name))))))))
|
|
|
241 t))
|
|
|
242
|
|
|
243 (defconst rng-in-attribute-regex
|
|
|
244 (replace-regexp-in-string
|
|
|
245 "w"
|
|
|
246 xmltok-ncname-regexp
|
|
|
247 "<w\\(?::w\\)?\
|
|
|
248 \\(?:[ \t\r\n]+w\\(?::w\\)?[ \t\r\n]*=\
|
|
|
249 [ \t\r\n]*\\(?:\"[^\"]*\"\\|'[^']*'\\)\\)*\
|
|
|
250 [ \t\r\n]+\\(\\(?:w\\(?::w?\\)?\\)?\\)\\="
|
|
|
251 t
|
|
|
252 t))
|
|
|
253
|
|
|
254 (defvar rng-undeclared-prefixes nil)
|
|
|
255
|
|
|
256 (defun rng-complete-attribute-name (lt-pos)
|
|
|
257 (when (save-excursion
|
|
|
258 (re-search-backward rng-in-attribute-regex lt-pos t))
|
|
|
259 (let ((attribute-start (match-beginning 1))
|
|
|
260 rng-undeclared-prefixes)
|
|
|
261 (and (rng-adjust-state-for-attribute lt-pos
|
|
|
262 attribute-start)
|
|
|
263 (let ((rng-complete-target-names
|
|
|
264 (rng-match-possible-attribute-names))
|
|
|
265 (rng-complete-extra-strings
|
|
|
266 (mapcar (lambda (prefix)
|
|
|
267 (if prefix
|
|
|
268 (concat "xmlns:" prefix)
|
|
|
269 "xmlns"))
|
|
|
270 rng-undeclared-prefixes))
|
|
|
271 (rng-complete-name-attribute-flag t))
|
|
|
272 (rng-complete-before-point attribute-start
|
|
|
273 'rng-complete-qname-function
|
|
|
274 "Attribute: "
|
|
|
275 nil
|
|
|
276 'rng-attribute-name-history))
|
|
|
277 (insert "=\"")))
|
|
|
278 t))
|
|
|
279
|
|
|
280 (defconst rng-in-attribute-value-regex
|
|
|
281 (replace-regexp-in-string
|
|
|
282 "w"
|
|
|
283 xmltok-ncname-regexp
|
|
|
284 "<w\\(?::w\\)?\
|
|
|
285 \\(?:[ \t\r\n]+w\\(?::w\\)?[ \t\r\n]*=\
|
|
|
286 [ \t\r\n]*\\(?:\"[^\"]*\"\\|'[^']*'\\)\\)*\
|
|
|
287 [ \t\r\n]+\\(w\\(:w\\)?\\)[ \t\r\n]*=[ \t\r\n]*\
|
|
|
288 \\(\"[^\"]*\\|'[^']*\\)\\="
|
|
|
289 t
|
|
|
290 t))
|
|
|
291
|
|
|
292 (defun rng-complete-attribute-value (lt-pos)
|
|
|
293 (when (save-excursion
|
|
|
294 (re-search-backward rng-in-attribute-value-regex lt-pos t))
|
|
|
295 (let ((name-start (match-beginning 1))
|
|
|
296 (name-end (match-end 1))
|
|
|
297 (colon (match-beginning 2))
|
|
|
298 (value-start (1+ (match-beginning 3))))
|
|
|
299 (and (rng-adjust-state-for-attribute lt-pos
|
|
|
300 name-start)
|
|
|
301 (if (string= (buffer-substring-no-properties name-start
|
|
|
302 (or colon name-end))
|
|
|
303 "xmlns")
|
|
|
304 (rng-complete-before-point
|
|
|
305 value-start
|
|
|
306 (rng-strings-to-completion-alist
|
|
|
307 (rng-possible-namespace-uris
|
|
|
308 (and colon
|
|
|
309 (buffer-substring-no-properties (1+ colon) name-end))))
|
|
|
310 "Namespace URI: "
|
|
|
311 nil
|
|
|
312 'rng-namespace-uri-history)
|
|
|
313 (rng-adjust-state-for-attribute-value name-start
|
|
|
314 colon
|
|
|
315 name-end)
|
|
|
316 (rng-complete-before-point
|
|
|
317 value-start
|
|
|
318 (rng-strings-to-completion-alist
|
|
|
319 (rng-match-possible-value-strings))
|
|
|
320 "Value: "
|
|
|
321 nil
|
|
|
322 'rng-attribute-value-history))
|
|
|
323 (insert (char-before value-start))))
|
|
|
324 t))
|
|
|
325
|
|
|
326 (defun rng-possible-namespace-uris (prefix)
|
|
|
327 (let ((ns (if prefix (nxml-ns-get-prefix prefix)
|
|
|
328 (nxml-ns-get-default))))
|
|
|
329 (if (and ns (memq prefix (nxml-ns-changed-prefixes)))
|
|
|
330 (list (nxml-namespace-name ns))
|
|
|
331 (mapcar 'nxml-namespace-name
|
|
|
332 (delq nxml-xml-namespace-uri
|
|
|
333 (rng-match-possible-namespace-uris))))))
|
|
|
334
|
|
|
335 (defconst rng-qname-regexp
|
|
|
336 (concat "\\`"
|
|
|
337 xmltok-ncname-regexp
|
|
|
338 "\\(?:" ":" xmltok-ncname-regexp "\\)" "?" "\\'"))
|
|
|
339
|
|
|
340 (defun rng-qname-p (string)
|
|
|
341 (and (string-match rng-qname-regexp string) t))
|
|
|
342
|
|
|
343 (defun rng-expand-qname (qname &optional defaultp recover-fun)
|
|
|
344 (setq qname (rng-split-qname qname))
|
|
|
345 (let ((prefix (car qname)))
|
|
|
346 (if prefix
|
|
|
347 (let ((ns (nxml-ns-get-prefix qname)))
|
|
|
348 (cond (ns (cons ns (cdr qname)))
|
|
|
349 (recover-fun (funcall recover-fun prefix (cdr qname)))))
|
|
|
350 (cons (and defaultp (nxml-ns-get-default)) (cdr qname)))))
|
|
|
351
|
|
|
352 (defun rng-start-tag-expand-recover (prefix local-name)
|
|
|
353 (let ((ns (rng-match-infer-start-tag-namespace local-name)))
|
|
|
354 (and ns
|
|
|
355 (cons ns local-name))))
|
|
|
356
|
|
|
357 (defun rng-split-qname (qname)
|
|
|
358 (if (string-match ":" qname)
|
|
|
359 (cons (substring qname 0 (match-beginning 0))
|
|
|
360 (substring qname (match-end 0)))
|
|
|
361 (cons nil qname)))
|
|
|
362
|
|
|
363 (defun rng-in-mixed-content-p ()
|
|
|
364 "Return non-nil if point is in mixed content.
|
|
|
365 Return nil only if point is definitely not in mixed content.
|
|
|
366 If unsure, return non-nil."
|
|
|
367 (if (eq rng-current-schema rng-any-element)
|
|
|
368 t
|
|
|
369 (rng-set-state-after)
|
|
|
370 (rng-match-mixed-text)))
|
|
|
371
|
|
|
372 (defun rng-set-state-after (&optional pos)
|
|
|
373 "Set the state for after parsing the first token with endpoint >= POS.
|
|
|
374 This does not change the xmltok state or point. However, it does
|
|
96496
|
375 set `xmltok-dtd'. Returns the position of the end of the token."
|
|
86361
|
376 (unless pos (setq pos (point)))
|
|
|
377 (when (< rng-validate-up-to-date-end pos)
|
|
|
378 (message "Parsing...")
|
|
|
379 (while (and (rng-do-some-validation)
|
|
|
380 (< rng-validate-up-to-date-end pos))
|
|
|
381 ;; Display percentage validated.
|
|
|
382 (force-mode-line-update)
|
|
|
383 ;; Force redisplay but don't allow idle timers to run.
|
|
|
384 (let ((timer-idle-list nil))
|
|
|
385 (sit-for 0)))
|
|
|
386 (message "Parsing...done"))
|
|
|
387 (save-excursion
|
|
|
388 (save-restriction
|
|
|
389 (widen)
|
|
|
390 (nxml-with-invisible-motion
|
|
|
391 (if (= pos 1)
|
|
|
392 (rng-set-initial-state)
|
|
|
393 (let ((state (get-text-property (1- pos) 'rng-state)))
|
|
|
394 (cond (state
|
|
|
395 (rng-restore-state state)
|
|
|
396 (goto-char pos))
|
|
|
397 (t
|
|
|
398 (let ((start (previous-single-property-change pos
|
|
|
399 'rng-state)))
|
|
|
400 (cond (start
|
|
|
401 (rng-restore-state (get-text-property (1- start)
|
|
|
402 'rng-state))
|
|
|
403 (goto-char start))
|
|
|
404 (t (rng-set-initial-state))))))))
|
|
|
405 (xmltok-save
|
|
|
406 (if (= (point) 1)
|
|
|
407 (xmltok-forward-prolog)
|
|
|
408 (setq xmltok-dtd rng-dtd))
|
|
|
409 (cond ((and (< pos (point))
|
|
|
410 ;; This handles the case where the prolog ends
|
|
|
411 ;; with a < without any following name-start
|
|
|
412 ;; character. This will be treated by the parser
|
|
|
413 ;; as part of the prolog, but we want to treat
|
|
|
414 ;; it as the start of the instance.
|
|
|
415 (eq (char-after pos) ?<)
|
|
|
416 (<= (point)
|
|
|
417 (save-excursion
|
|
|
418 (goto-char (1+ pos))
|
|
|
419 (skip-chars-forward " \t\r\n")
|
|
|
420 (point))))
|
|
|
421 pos)
|
|
|
422 ((< (point) pos)
|
|
|
423 (let ((rng-dt-namespace-context-getter
|
|
|
424 '(nxml-ns-get-context))
|
|
|
425 (rng-parsing-for-state t))
|
|
|
426 (rng-forward pos))
|
|
|
427 (point))
|
|
|
428 (t pos)))))))
|
|
|
429
|
|
|
430 (defun rng-adjust-state-for-attribute (lt-pos start)
|
|
|
431 (xmltok-save
|
|
|
432 (save-excursion
|
|
|
433 (goto-char lt-pos)
|
|
|
434 (when (memq (xmltok-forward)
|
|
|
435 '(start-tag
|
|
|
436 partial-start-tag
|
|
|
437 empty-element
|
|
|
438 partial-empty-element))
|
|
|
439 (when (< start (point))
|
|
|
440 (setq xmltok-namespace-attributes
|
|
|
441 (rng-prune-attribute-at start
|
|
|
442 xmltok-namespace-attributes))
|
|
|
443 (setq xmltok-attributes
|
|
|
444 (rng-prune-attribute-at start
|
|
|
445 xmltok-attributes)))
|
|
|
446 (let ((rng-parsing-for-state t)
|
|
|
447 (rng-dt-namespace-context-getter '(nxml-ns-get-context)))
|
|
|
448 (rng-process-start-tag 'stop)
|
|
|
449 (rng-find-undeclared-prefixes)
|
|
|
450 t)))))
|
|
96496
|
451
|
|
86361
|
452 (defun rng-find-undeclared-prefixes ()
|
|
|
453 ;; Start with the newly effective namespace declarations.
|
|
|
454 ;; (Includes declarations added during recovery.)
|
|
|
455 (setq rng-undeclared-prefixes (nxml-ns-changed-prefixes))
|
|
|
456 (let ((iter xmltok-attributes)
|
|
|
457 (ns-state (nxml-ns-state))
|
|
|
458 att)
|
|
|
459 ;; Add namespace prefixes used in this tag,
|
|
|
460 ;; but not declared in the parent.
|
|
|
461 (nxml-ns-pop-state)
|
|
|
462 (while iter
|
|
|
463 (setq att (car iter))
|
|
|
464 (let ((prefix (xmltok-attribute-prefix att)))
|
|
|
465 (when (and prefix
|
|
|
466 (not (member prefix rng-undeclared-prefixes))
|
|
|
467 (not (nxml-ns-get-prefix prefix)))
|
|
|
468 (setq rng-undeclared-prefixes
|
|
|
469 (cons prefix rng-undeclared-prefixes))))
|
|
|
470 (setq iter (cdr iter)))
|
|
|
471 (nxml-ns-set-state ns-state)
|
|
|
472 ;; Remove namespace prefixes explicitly declared.
|
|
|
473 (setq iter xmltok-namespace-attributes)
|
|
|
474 (while iter
|
|
|
475 (setq att (car iter))
|
|
|
476 (setq rng-undeclared-prefixes
|
|
|
477 (delete (and (xmltok-attribute-prefix att)
|
|
|
478 (xmltok-attribute-local-name att))
|
|
|
479 rng-undeclared-prefixes))
|
|
|
480 (setq iter (cdr iter)))))
|
|
|
481
|
|
|
482 (defun rng-prune-attribute-at (start atts)
|
|
|
483 (when atts
|
|
|
484 (let ((cur atts))
|
|
|
485 (while (if (eq (xmltok-attribute-name-start (car cur)) start)
|
|
|
486 (progn
|
|
|
487 (setq atts (delq (car cur) atts))
|
|
|
488 nil)
|
|
|
489 (setq cur (cdr cur)))))
|
|
|
490 atts))
|
|
|
491
|
|
|
492 (defun rng-adjust-state-for-attribute-value (name-start
|
|
|
493 colon
|
|
|
494 name-end)
|
|
|
495 (let* ((prefix (if colon
|
|
|
496 (buffer-substring-no-properties name-start colon)
|
|
|
497 nil))
|
|
|
498 (local-name (buffer-substring-no-properties (if colon
|
|
|
499 (1+ colon)
|
|
|
500 name-start)
|
|
|
501 name-end))
|
|
|
502 (ns (and prefix (nxml-ns-get-prefix prefix))))
|
|
|
503 (and (or (not prefix) ns)
|
|
|
504 (rng-match-attribute-name (cons ns local-name)))))
|
|
|
505
|
|
|
506 (defun rng-complete-qname-function (string predicate flag)
|
|
|
507 (let ((alist (mapcar (lambda (name) (cons name nil))
|
|
|
508 (rng-generate-qname-list string))))
|
|
|
509 (cond ((not flag)
|
|
|
510 (try-completion string alist predicate))
|
|
|
511 ((eq flag t)
|
|
|
512 (all-completions string alist predicate))
|
|
|
513 ((eq flag 'lambda)
|
|
|
514 (and (assoc string alist) t)))))
|
|
|
515
|
|
|
516 (defun rng-generate-qname-list (&optional string)
|
|
|
517 (let ((forced-prefix (and string
|
|
|
518 (string-match ":" string)
|
|
|
519 (> (match-beginning 0) 0)
|
|
|
520 (substring string
|
|
|
521 0
|
|
|
522 (match-beginning 0))))
|
|
|
523 (namespaces (mapcar 'car rng-complete-target-names))
|
|
|
524 ns-prefixes-alist ns-prefixes iter ns prefer)
|
|
|
525 (while namespaces
|
|
|
526 (setq ns (car namespaces))
|
|
|
527 (when ns
|
|
|
528 (setq ns-prefixes-alist
|
|
|
529 (cons (cons ns (nxml-ns-prefixes-for
|
|
|
530 ns
|
|
|
531 rng-complete-name-attribute-flag))
|
|
|
532 ns-prefixes-alist)))
|
|
|
533 (setq namespaces (delq ns (cdr namespaces))))
|
|
|
534 (setq iter ns-prefixes-alist)
|
|
|
535 (while iter
|
|
|
536 (setq ns-prefixes (car iter))
|
|
|
537 (setq ns (car ns-prefixes))
|
|
|
538 (when (null (cdr ns-prefixes))
|
|
|
539 ;; No declared prefix for the namespace
|
|
|
540 (if forced-prefix
|
|
|
541 ;; If namespace non-nil and prefix undeclared,
|
|
|
542 ;; use forced prefix.
|
|
|
543 (when (and ns
|
|
|
544 (not (nxml-ns-get-prefix forced-prefix)))
|
|
|
545 (setcdr ns-prefixes (list forced-prefix)))
|
|
|
546 (setq prefer (rng-get-preferred-unused-prefix ns))
|
|
|
547 (when prefer
|
|
|
548 (setcdr ns-prefixes (list prefer)))
|
|
|
549 ;; Unless it's an attribute with a non-nil namespace,
|
|
|
550 ;; allow no prefix for this namespace.
|
|
|
551 (unless rng-complete-name-attribute-flag
|
|
|
552 (setcdr ns-prefixes (cons nil (cdr ns-prefixes))))))
|
|
|
553 (setq iter (cdr iter)))
|
|
|
554 (rng-uniquify-equal
|
|
|
555 (sort (apply 'append
|
|
|
556 (cons rng-complete-extra-strings
|
|
|
557 (mapcar (lambda (name)
|
|
|
558 (if (car name)
|
|
|
559 (mapcar (lambda (prefix)
|
|
|
560 (if prefix
|
|
|
561 (concat prefix
|
|
|
562 ":"
|
|
|
563 (cdr name))
|
|
|
564 (cdr name)))
|
|
|
565 (cdr (assoc (car name)
|
|
|
566 ns-prefixes-alist)))
|
|
|
567 (list (cdr name))))
|
|
|
568 rng-complete-target-names)))
|
|
|
569 'string<))))
|
|
96496
|
570
|
|
86361
|
571 (defun rng-get-preferred-unused-prefix (ns)
|
|
|
572 (let ((ns-prefix (assoc (symbol-name ns) rng-preferred-prefix-alist))
|
|
|
573 iter prefix)
|
|
|
574 (when ns-prefix
|
|
|
575 (setq prefix (cdr ns-prefix))
|
|
|
576 (when (nxml-ns-get-prefix prefix)
|
|
|
577 ;; try to find an unused prefix
|
|
|
578 (setq iter (memq ns-prefix rng-preferred-prefix-alist))
|
|
|
579 (while (and iter
|
|
|
580 (setq ns-prefix (assoc ns iter)))
|
|
|
581 (if (nxml-ns-get-prefix (cdr ns-prefix))
|
|
|
582 (setq iter (memq ns-prefix iter))
|
|
|
583 (setq prefix (cdr ns-prefix))
|
|
|
584 nil))))
|
|
|
585 prefix))
|
|
|
586
|
|
|
587 (defun rng-strings-to-completion-alist (strings)
|
|
|
588 (mapcar (lambda (s) (cons s s))
|
|
|
589 (rng-uniquify-equal (sort (mapcar 'rng-escape-string strings)
|
|
|
590 'string<))))
|
|
|
591
|
|
|
592 (provide 'rng-nxml)
|
|
|
593
|
|
86379
|
594 ;; arch-tag: bec0d6ed-6be1-4540-9c2c-6f56e8e55d8b
|
|
86361
|
595 ;;; rng-nxml.el ends here
|
