Commit | Line | Data |
---|---|---|
8cd39fb3 MH |
1 | ;;; rng-loc.el --- locate the schema to use for validation |
2 | ||
acaf905b | 3 | ;; Copyright (C) 2003, 2007-2012 Free Software Foundation, Inc. |
8cd39fb3 MH |
4 | |
5 | ;; Author: James Clark | |
6 | ;; Keywords: XML, RelaxNG | |
7 | ||
09aa73e6 | 8 | ;; This file is part of GNU Emacs. |
8cd39fb3 | 9 | |
4936186e | 10 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
09aa73e6 | 11 | ;; it under the terms of the GNU General Public License as published by |
4936186e GM |
12 | ;; the Free Software Foundation, either version 3 of the License, or |
13 | ;; (at your option) any later version. | |
8cd39fb3 | 14 | |
09aa73e6 GM |
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. | |
19 | ||
20 | ;; You should have received a copy of the GNU General Public License | |
4936186e | 21 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
8cd39fb3 MH |
22 | |
23 | ;;; Commentary: | |
24 | ||
25 | ;;; Code: | |
26 | ||
27 | (require 'nxml-util) | |
28 | (require 'nxml-parse) | |
29 | (require 'rng-parse) | |
30 | (require 'rng-uri) | |
31 | (require 'rng-util) | |
32 | (require 'xmltok) | |
33 | ||
34 | (defvar rng-current-schema-file-name nil | |
35 | "Filename of schema being used for current buffer. | |
10545bd8 | 36 | It is nil if using a vacuous schema.") |
8cd39fb3 MH |
37 | (make-variable-buffer-local 'rng-current-schema-file-name) |
38 | ||
f98e3afa | 39 | (defvar rng-schema-locating-files-default |
418784e2 | 40 | (list "schemas.xml" (expand-file-name "schema/schemas.xml" data-directory)) |
8cd39fb3 MH |
41 | "Default value for variable `rng-schema-locating-files'.") |
42 | ||
f98e3afa | 43 | (defvar rng-schema-locating-file-schema-file |
418784e2 | 44 | (expand-file-name "schema/locate.rnc" data-directory) |
8cd39fb3 MH |
45 | "File containing schema for schema locating files.") |
46 | ||
47 | (defvar rng-schema-locating-file-schema nil | |
48 | "Schema for schema locating files or nil if not yet loaded.") | |
49 | ||
50 | (defcustom rng-schema-locating-files rng-schema-locating-files-default | |
65beee52 | 51 | "List of schema locating files." |
8cd39fb3 MH |
52 | :type '(repeat file) |
53 | :group 'relax-ng) | |
54 | ||
f98e3afa | 55 | (defvar rng-schema-loader-alist '(("rnc" . rng-c-load-schema)) |
8cd39fb3 MH |
56 | "Alist of schema extensions vs schema loader functions.") |
57 | ||
58 | (defvar rng-cached-document-element nil) | |
59 | ||
60 | (defvar rng-document-type-history nil) | |
61 | ||
62 | (defun rng-set-document-type (type-id) | |
63 | (interactive (list (rng-read-type-id))) | |
64 | (condition-case err | |
65 | (when (not (string= type-id "")) | |
66 | (let ((schema-file (rng-locate-schema-file type-id))) | |
67 | (unless schema-file | |
68 | (error "Could not locate schema for type id `%s'" type-id)) | |
69 | (rng-set-schema-file-1 schema-file)) | |
70 | (rng-save-schema-location-1 t type-id) | |
71 | (rng-what-schema)) | |
72 | (nxml-file-parse-error | |
73 | (nxml-display-file-parse-error err)))) | |
74 | ||
75 | (defun rng-read-type-id () | |
76 | (condition-case err | |
77 | (let ((type-ids (rng-possible-type-ids)) | |
78 | (completion-ignore-case nil)) | |
79 | (completing-read "Document type id: " | |
80 | (mapcar (lambda (x) (cons x nil)) | |
81 | type-ids) | |
82 | nil | |
83 | t | |
84 | nil | |
85 | 'rng-document-type-history)) | |
86 | (nxml-file-parse-error | |
87 | (nxml-display-file-parse-error err)))) | |
88 | ||
89 | (defun rng-set-schema-file (filename) | |
90 | "Set the schema for the current buffer to the schema in FILENAME. | |
91 | FILENAME must be the name of a file containing a schema. | |
92 | The extension of FILENAME is used to determine what kind of schema it | |
93 | is. The variable `rng-schema-loader-alist' maps from schema | |
10545bd8 | 94 | extensions to schema loader functions. The function |
8cd39fb3 MH |
95 | `rng-c-load-schema' is the loader for RELAX NG compact syntax. The |
96 | association is between the buffer and the schema: the association is | |
97 | lost when the buffer is killed." | |
98 | (interactive "fSchema file: ") | |
99 | (condition-case err | |
100 | (progn | |
101 | (rng-set-schema-file-1 filename) | |
102 | (rng-save-schema-location-1 t)) | |
103 | (nxml-file-parse-error | |
104 | (nxml-display-file-parse-error err)))) | |
105 | ||
106 | (defun rng-set-vacuous-schema () | |
107 | "Set the schema for the current buffer to allow any well-formed XML." | |
108 | (interactive) | |
109 | (rng-set-schema-file-1 nil) | |
110 | (rng-what-schema)) | |
111 | ||
112 | (defun rng-set-schema-file-1 (filename) | |
113 | (setq filename (and filename (expand-file-name filename))) | |
114 | (setq rng-current-schema | |
115 | (if filename | |
116 | (rng-load-schema filename) | |
117 | rng-any-element)) | |
118 | (setq rng-current-schema-file-name filename) | |
119 | (run-hooks 'rng-schema-change-hook)) | |
10545bd8 | 120 | |
8cd39fb3 MH |
121 | (defun rng-load-schema (filename) |
122 | (let* ((extension (file-name-extension filename)) | |
123 | (loader (cdr (assoc extension rng-schema-loader-alist)))) | |
124 | (or loader | |
125 | (if extension | |
126 | (error "No schema loader available for file extension `%s'" | |
127 | extension) | |
128 | (error "No schema loader available for null file extension"))) | |
129 | (funcall loader filename))) | |
130 | ||
131 | (defun rng-what-schema () | |
132 | "Display a message saying what schema `rng-validate-mode' is using." | |
133 | (interactive) | |
134 | (if rng-current-schema-file-name | |
10545bd8 | 135 | (message "Using schema %s" |
8cd39fb3 MH |
136 | (abbreviate-file-name rng-current-schema-file-name)) |
137 | (message "Using vacuous schema"))) | |
138 | ||
139 | (defun rng-auto-set-schema (&optional no-display-error) | |
140 | "Set the schema for this buffer based on the buffer's contents and file-name." | |
141 | (interactive) | |
142 | (condition-case err | |
143 | (progn | |
144 | (rng-set-schema-file-1 (rng-locate-schema-file)) | |
145 | (rng-what-schema)) | |
146 | (nxml-file-parse-error | |
147 | (if no-display-error | |
148 | (error "%s at position %s in %s" | |
149 | (nth 3 err) | |
150 | (nth 2 err) | |
151 | (abbreviate-file-name (nth 1 err))) | |
152 | (nxml-display-file-parse-error err))))) | |
153 | ||
154 | (defun rng-locate-schema-file (&optional type-id) | |
155 | "Return the file-name of the schema to use for the current buffer. | |
156 | Return nil if no schema could be located. | |
157 | If TYPE-ID is non-nil, then locate the schema for this TYPE-ID." | |
158 | (let* ((rng-cached-document-element nil) | |
159 | (schema | |
160 | (if type-id | |
161 | (cons type-id nil) | |
162 | (rng-locate-schema-file-using rng-schema-locating-files))) | |
163 | files type-ids) | |
164 | (while (consp schema) | |
165 | (setq files rng-schema-locating-files) | |
166 | (setq type-id (car schema)) | |
167 | (setq schema nil) | |
168 | (when (member type-id type-ids) | |
169 | (error "Type-id loop for type-id `%s'" type-id)) | |
170 | (setq type-ids (cons type-id type-ids)) | |
171 | (while (and files (not schema)) | |
172 | (setq schema | |
173 | (rng-locate-schema-file-from-type-id type-id | |
174 | (car files))) | |
175 | (setq files (cdr files)))) | |
176 | (and schema | |
177 | (rng-uri-file-name schema)))) | |
178 | ||
179 | (defun rng-possible-type-ids () | |
180 | "Return a list of the known type IDs." | |
181 | (let ((files rng-schema-locating-files) | |
182 | type-ids) | |
183 | (while files | |
184 | (setq type-ids (rng-possible-type-ids-using (car files) type-ids)) | |
185 | (setq files (cdr files))) | |
186 | (rng-uniquify-equal (sort type-ids 'string<)))) | |
187 | ||
188 | (defun rng-locate-schema-file-using (files) | |
189 | "Locate a schema using the schema locating files FILES. | |
190 | FILES is a list of file-names. | |
10545bd8 | 191 | Return either a URI, a list (TYPE-ID) where TYPE-ID is a string, |
8cd39fb3 MH |
192 | or nil." |
193 | (let (rules | |
194 | ;; List of types that override normal order-based | |
195 | ;; priority, most important first | |
196 | preferred-types | |
197 | ;; Best result found so far; same form as return value. | |
198 | best-so-far) | |
199 | (while (and (progn | |
200 | (while (and (not rules) files) | |
201 | (setq rules (rng-get-parsed-schema-locating-file | |
202 | (car files))) | |
203 | (setq files (cdr files))) | |
204 | rules) | |
205 | (or (not best-so-far) preferred-types)) | |
206 | (let* ((rule (car rules)) | |
207 | (rule-type (car rule)) | |
208 | (rule-matcher (get rule-type 'rng-rule-matcher))) | |
209 | (setq rules (cdr rules)) | |
210 | (cond (rule-matcher | |
211 | (when (and (or (not best-so-far) | |
212 | (memq rule-type preferred-types))) | |
213 | (setq best-so-far | |
214 | (funcall rule-matcher (cdr rule))) | |
215 | preferred-types) | |
216 | (setq preferred-types | |
217 | (nbutlast preferred-types | |
218 | (length (memq rule-type preferred-types))))) | |
219 | ((eq rule-type 'applyFollowingRules) | |
220 | (when (not best-so-far) | |
221 | (let ((prefer (cdr (assq 'ruleType (cdr rule))))) | |
222 | (when (and prefer | |
223 | (not (memq (setq prefer (intern prefer)) | |
224 | preferred-types))) | |
225 | (setq preferred-types | |
226 | (nconc preferred-types (list prefer))))))) | |
227 | ((eq rule-type 'include) | |
228 | (let ((uri (cdr (assq 'rules (cdr rule))))) | |
229 | (when uri | |
230 | (setq rules | |
231 | (append (rng-get-parsed-schema-locating-file | |
232 | (rng-uri-file-name uri)) | |
233 | rules)))))))) | |
234 | best-so-far)) | |
235 | ||
236 | (put 'documentElement 'rng-rule-matcher 'rng-match-document-element-rule) | |
237 | (put 'namespace 'rng-rule-matcher 'rng-match-namespace-rule) | |
238 | (put 'uri 'rng-rule-matcher 'rng-match-uri-rule) | |
239 | (put 'transformURI 'rng-rule-matcher 'rng-match-transform-uri-rule) | |
240 | (put 'default 'rng-rule-matcher 'rng-match-default-rule) | |
241 | ||
242 | (defun rng-match-document-element-rule (props) | |
243 | (let ((document-element (rng-document-element)) | |
244 | (prefix (cdr (assq 'prefix props))) | |
245 | (local-name (cdr (assq 'localName props)))) | |
246 | (and (or (not prefix) | |
247 | (if (= (length prefix) 0) | |
248 | (not (nth 1 document-element)) | |
249 | (string= prefix (nth 1 document-element)))) | |
250 | (or (not local-name) | |
251 | (string= local-name | |
252 | (nth 2 document-element))) | |
253 | (rng-match-default-rule props)))) | |
254 | ||
255 | (defun rng-match-namespace-rule (props) | |
256 | (let ((document-element (rng-document-element)) | |
257 | (ns (cdr (assq 'ns props)))) | |
258 | (and document-element | |
259 | ns | |
260 | (eq (nth 0 document-element) | |
261 | (if (string= ns "") | |
262 | nil | |
263 | (nxml-make-namespace ns))) | |
264 | (rng-match-default-rule props)))) | |
265 | ||
266 | (defun rng-document-element () | |
267 | "Return a list (NS PREFIX LOCAL-NAME). | |
268 | NS is t if the document has a non-nil, but not otherwise known namespace." | |
269 | (or rng-cached-document-element | |
270 | (setq rng-cached-document-element | |
271 | (save-excursion | |
272 | (save-restriction | |
273 | (widen) | |
274 | (goto-char (point-min)) | |
275 | (let (xmltok-dtd) | |
276 | (xmltok-save | |
277 | (xmltok-forward-prolog) | |
278 | (xmltok-forward) | |
279 | (when (memq xmltok-type '(start-tag | |
280 | partial-start-tag | |
281 | empty-element | |
282 | partial-empty-element)) | |
283 | (list (rng-get-start-tag-namespace) | |
284 | (xmltok-start-tag-prefix) | |
285 | (xmltok-start-tag-local-name)))))))))) | |
286 | ||
287 | (defun rng-get-start-tag-namespace () | |
288 | (let ((prefix (xmltok-start-tag-prefix)) | |
289 | namespace att value) | |
290 | (while xmltok-namespace-attributes | |
291 | (setq att (car xmltok-namespace-attributes)) | |
292 | (setq xmltok-namespace-attributes (cdr xmltok-namespace-attributes)) | |
293 | (when (if prefix | |
294 | (and (xmltok-attribute-prefix att) | |
295 | (string= (xmltok-attribute-local-name att) | |
296 | prefix)) | |
297 | (not (xmltok-attribute-prefix att))) | |
298 | (setq value (xmltok-attribute-value att)) | |
299 | (setq namespace (if value (nxml-make-namespace value) t)))) | |
300 | (if (and prefix (not namespace)) | |
301 | t | |
302 | namespace))) | |
303 | ||
304 | (defun rng-match-transform-uri-rule (props) | |
305 | (let ((from-pattern (cdr (assq 'fromPattern props))) | |
306 | (to-pattern (cdr (assq 'toPattern props))) | |
307 | (file-name (buffer-file-name))) | |
308 | (and file-name | |
309 | (setq file-name (expand-file-name file-name)) | |
310 | (rng-file-name-matches-uri-pattern-p file-name from-pattern) | |
311 | (condition-case () | |
312 | (let ((new-file-name | |
313 | (replace-match | |
314 | (save-match-data | |
315 | (rng-uri-pattern-file-name-replace-match to-pattern)) | |
316 | t | |
317 | nil | |
318 | file-name))) | |
319 | (and (file-name-absolute-p new-file-name) | |
320 | (file-exists-p new-file-name) | |
321 | (rng-file-name-uri new-file-name))) | |
322 | (rng-uri-error nil))))) | |
323 | ||
324 | (defun rng-match-uri-rule (props) | |
325 | (let ((resource (cdr (assq 'resource props))) | |
326 | (pattern (cdr (assq 'pattern props))) | |
327 | (file-name (buffer-file-name))) | |
328 | (and file-name | |
329 | (setq file-name (expand-file-name file-name)) | |
330 | (cond (resource | |
331 | (condition-case () | |
332 | (eq (compare-strings (rng-uri-file-name resource) | |
333 | 0 | |
334 | nil | |
335 | (expand-file-name file-name) | |
336 | 0 | |
337 | nil | |
338 | nxml-file-name-ignore-case) | |
339 | t) | |
340 | (rng-uri-error nil))) | |
341 | (pattern | |
342 | (rng-file-name-matches-uri-pattern-p file-name | |
343 | pattern))) | |
344 | (rng-match-default-rule props)))) | |
345 | ||
346 | (defun rng-file-name-matches-uri-pattern-p (file-name pattern) | |
347 | (condition-case () | |
348 | (and (let ((case-fold-search nxml-file-name-ignore-case)) | |
349 | (string-match (rng-uri-pattern-file-name-regexp pattern) | |
350 | file-name)) | |
351 | t) | |
352 | (rng-uri-error nil))) | |
353 | ||
354 | (defun rng-match-default-rule (props) | |
355 | (or (cdr (assq 'uri props)) | |
356 | (let ((type-id (cdr (assq 'typeId props)))) | |
357 | (and type-id | |
358 | (cons (rng-collapse-space type-id) nil))))) | |
359 | ||
360 | (defun rng-possible-type-ids-using (file type-ids) | |
361 | (let ((rules (rng-get-parsed-schema-locating-file file)) | |
362 | rule) | |
363 | (while rules | |
364 | (setq rule (car rules)) | |
365 | (setq rules (cdr rules)) | |
366 | (cond ((eq (car rule) 'typeId) | |
367 | (let ((id (cdr (assq 'id (cdr rule))))) | |
368 | (when id | |
369 | (setq type-ids | |
370 | (cons (rng-collapse-space id) | |
371 | type-ids))))) | |
372 | ((eq (car rule) 'include) | |
373 | (let ((uri (cdr (assq 'rules (cdr rule))))) | |
374 | (when uri | |
375 | (setq type-ids | |
376 | (rng-possible-type-ids-using | |
377 | (rng-get-parsed-schema-locating-file | |
378 | (rng-uri-file-name uri)) | |
379 | type-ids))))))) | |
380 | type-ids)) | |
381 | ||
382 | (defun rng-locate-schema-file-from-type-id (type-id file) | |
383 | "Locate the schema for type id TYPE-ID using schema locating file FILE. | |
10545bd8 | 384 | Return either a URI, a list (TYPE-ID) where TYPE-ID is a string, |
8cd39fb3 MH |
385 | or nil." |
386 | (let ((rules (rng-get-parsed-schema-locating-file file)) | |
387 | schema rule) | |
388 | (while (and rules (not schema)) | |
389 | (setq rule (car rules)) | |
390 | (setq rules (cdr rules)) | |
391 | (cond ((and (eq (car rule) 'typeId) | |
392 | (let ((id (assq 'id (cdr rule)))) | |
393 | (and id | |
394 | (string= (rng-collapse-space (cdr id)) type-id)))) | |
395 | (setq schema (rng-match-default-rule (cdr rule)))) | |
396 | ((eq (car rule) 'include) | |
397 | (let ((uri (cdr (assq 'rules (cdr rule))))) | |
398 | (when uri | |
399 | (setq schema | |
400 | (rng-locate-schema-file-from-type-id | |
401 | type-id | |
402 | (rng-uri-file-name uri)))))))) | |
403 | schema)) | |
404 | ||
405 | (defvar rng-schema-locating-file-alist nil) | |
406 | ||
407 | (defun rng-get-parsed-schema-locating-file (file) | |
408 | "Return a list of rules for the schema locating file FILE." | |
409 | (setq file (expand-file-name file)) | |
410 | (let ((cached (assoc file rng-schema-locating-file-alist)) | |
411 | (mtime (nth 5 (file-attributes file))) | |
412 | parsed) | |
413 | (cond ((not mtime) | |
414 | (when cached | |
415 | (setq rng-schema-locating-file-alist | |
416 | (delq cached rng-schema-locating-file-alist))) | |
417 | nil) | |
418 | ((and cached (equal (nth 1 cached) mtime)) | |
419 | (nth 2 cached)) | |
420 | (t | |
421 | (setq parsed (rng-parse-schema-locating-file file)) | |
422 | (if cached | |
423 | (setcdr cached (list mtime parsed)) | |
424 | (setq rng-schema-locating-file-alist | |
425 | (cons (list file mtime parsed) | |
426 | rng-schema-locating-file-alist))) | |
427 | parsed)))) | |
10545bd8 | 428 | |
8cd39fb3 MH |
429 | (defconst rng-locate-namespace-uri |
430 | (nxml-make-namespace "http://thaiopensource.com/ns/locating-rules/1.0")) | |
431 | ||
432 | (defun rng-parse-schema-locating-file (file) | |
433 | "Return list of rules. | |
434 | Each rule has the form (TYPE (ATTR . VAL) ...), where | |
435 | TYPE is a symbol for the element name, ATTR is a symbol for the attribute | |
436 | and VAL is a string for the value. | |
437 | Attribute values representing URIs are made absolute and xml:base | |
438 | attributes are removed." | |
439 | (when (and (not rng-schema-locating-file-schema) | |
440 | rng-schema-locating-file-schema-file) | |
441 | (setq rng-schema-locating-file-schema | |
442 | (rng-load-schema rng-schema-locating-file-schema-file))) | |
443 | (let* ((element | |
444 | (if rng-schema-locating-file-schema | |
445 | (rng-parse-validate-file rng-schema-locating-file-schema | |
446 | file) | |
447 | (nxml-parse-file file))) | |
448 | (children (cddr element)) | |
449 | (base-uri (rng-file-name-uri file)) | |
450 | child name rules atts att props prop-name prop-value) | |
451 | (when (equal (car element) | |
452 | (cons rng-locate-namespace-uri "locatingRules")) | |
453 | (while children | |
454 | (setq child (car children)) | |
455 | (setq children (cdr children)) | |
456 | (when (consp child) | |
457 | (setq name (car child)) | |
458 | (when (eq (car name) rng-locate-namespace-uri) | |
459 | (setq atts (cadr child)) | |
460 | (setq props nil) | |
461 | (while atts | |
462 | (setq att (car atts)) | |
463 | (when (stringp (car att)) | |
464 | (setq prop-name (intern (car att))) | |
465 | (setq prop-value (cdr att)) | |
466 | (when (memq prop-name '(uri rules resource)) | |
467 | (setq prop-value | |
468 | (rng-uri-resolve prop-value base-uri))) | |
469 | (setq props (cons (cons prop-name prop-value) | |
470 | props))) | |
471 | (setq atts (cdr atts))) | |
472 | (setq rules | |
473 | (cons (cons (intern (cdr name)) (nreverse props)) | |
474 | rules)))))) | |
475 | (nreverse rules))) | |
476 | ||
477 | (defun rng-save-schema-location () | |
478 | "Save the association between the buffer's file and the current schema. | |
479 | This ensures that the schema that is currently being used will be used | |
480 | if the file is edited in a future session. The association will be | |
481 | saved to the first writable file in `rng-schema-locating-files'." | |
482 | (interactive) | |
483 | (rng-save-schema-location-1 nil)) | |
484 | ||
485 | (defun rng-save-schema-location-1 (prompt &optional type-id) | |
486 | (unless (or rng-current-schema-file-name type-id) | |
487 | (error "Buffer is using a vacuous schema")) | |
488 | (let ((files rng-schema-locating-files) | |
489 | (document-file-name (buffer-file-name)) | |
490 | (schema-file-name rng-current-schema-file-name) | |
491 | file) | |
492 | (while (and files (not file)) | |
493 | (if (file-writable-p (car files)) | |
494 | (setq file (expand-file-name (car files))) | |
495 | (setq files (cdr files)))) | |
496 | (cond ((not file) | |
497 | (if prompt | |
498 | nil | |
499 | (error "No writable schema locating file configured"))) | |
500 | ((not document-file-name) | |
501 | (if prompt | |
502 | nil | |
503 | (error "Buffer does not have a filename"))) | |
504 | ((and prompt | |
505 | (not (y-or-n-p (format "Save %s to %s " | |
506 | (if type-id | |
507 | "type identifier" | |
508 | "schema location") | |
509 | file))))) | |
510 | (t | |
2adaf057 | 511 | (with-current-buffer (find-file-noselect file) |
8cd39fb3 MH |
512 | (let ((modified (buffer-modified-p))) |
513 | (if (> (buffer-size) 0) | |
514 | (let (xmltok-dtd) | |
515 | (goto-char (point-min)) | |
516 | (xmltok-save | |
517 | (xmltok-forward-prolog) | |
518 | (xmltok-forward) | |
519 | (unless (eq xmltok-type 'start-tag) | |
520 | (error "Locating file `%s' invalid" file)))) | |
521 | (insert "<?xml version=\"1.0\"?>\n" | |
522 | "<locatingRules xmlns=\"" | |
523 | (nxml-namespace-name rng-locate-namespace-uri) | |
524 | "\">") | |
525 | (let ((pos (point))) | |
526 | (insert "\n</locatingRules>\n") | |
527 | (goto-char pos))) | |
528 | (insert "\n") | |
529 | (insert (let ((locating-file-uri (rng-file-name-uri file))) | |
530 | (format "<uri resource=\"%s\" %s=\"%s\"/>" | |
531 | (rng-escape-string | |
532 | (rng-relative-uri | |
533 | (rng-file-name-uri document-file-name) | |
534 | locating-file-uri)) | |
535 | (if type-id "typeId" "uri") | |
536 | (rng-escape-string | |
537 | (or type-id | |
538 | (rng-relative-uri | |
539 | (rng-file-name-uri schema-file-name) | |
540 | locating-file-uri)))))) | |
541 | (indent-according-to-mode) | |
542 | (when (or (not modified) | |
543 | (y-or-n-p (format "Save file %s " | |
544 | (buffer-file-name)))) | |
545 | (save-buffer)))))))) | |
546 | ||
547 | (provide 'rng-loc) | |
548 | ||
549 | ;;; rng-loc.el ends here |