Function: rng-save-schema-location-1
rng-save-schema-location-1 is a byte-compiled function defined in
rng-loc.el.gz.
Signature
(rng-save-schema-location-1 PROMPT &optional TYPE-ID)
Source Code
;; Defined in /usr/src/emacs/lisp/nxml/rng-loc.el.gz
(defun rng-save-schema-location-1 (prompt &optional type-id)
(unless (or rng-current-schema-file-name type-id)
(error "Buffer is using a vacuous schema"))
(let ((files rng-schema-locating-files)
(document-file-name (buffer-file-name))
(schema-file-name rng-current-schema-file-name)
file)
(while (and files (not file))
(if (file-writable-p (car files))
(setq file (expand-file-name (car files)))
(setq files (cdr files))))
(cond ((not file)
(if prompt
nil
(error "No writable schema locating file configured")))
((not document-file-name)
(if prompt
nil
(error "Buffer does not have a filename")))
((and prompt
(not (y-or-n-p (format "Save %s to %s?"
(if type-id
"type identifier"
"schema location")
file)))))
(t
(with-current-buffer (find-file-noselect file)
(let ((modified (buffer-modified-p)))
(if (> (buffer-size) 0)
(let (xmltok-dtd)
(goto-char (point-min))
(xmltok-save
(xmltok-forward-prolog)
(xmltok-forward)
(unless (eq xmltok-type 'start-tag)
(error "Locating file `%s' invalid" file))))
(insert "<?xml version=\"1.0\"?>\n"
"<locatingRules xmlns=\""
(nxml-namespace-name rng-locate-namespace-uri)
"\">")
(let ((pos (point)))
(insert "\n</locatingRules>\n")
(goto-char pos)))
(insert "\n")
(insert (let ((locating-file-uri (rng-file-name-uri file)))
(format "<uri resource=\"%s\" %s=\"%s\"/>"
(rng-escape-string
(rng-relative-uri
(rng-file-name-uri document-file-name)
locating-file-uri))
(if type-id "typeId" "uri")
(rng-escape-string
(or type-id
(rng-relative-uri
(rng-file-name-uri schema-file-name)
locating-file-uri))))))
(indent-according-to-mode)
(when (or (not modified)
(y-or-n-p (format "Save file %s?"
(buffer-file-name))))
(save-buffer))))))))