+2008-07-03 Juanma Barranquero <lekktu@gmail.com>
+
+ * nxml/nxml-glyph.el (nxml-glyph-set-hook):
+ * nxml/nxml-uchnm.el (nxml-unicode-blocks)
+ (nxml-unicode-block-char-name-set):
+ * nxml/nxml-util.el (nxml-debug, nxml-make-namespace):
+ * nxml/rng-nxml.el (rng-set-state-after):
+ * nxml/rng-uri.el (rng-file-name-uri): Fix typo in docstring.
+
+ * nxml/rng-cmpct.el (rng-c-lookup-create, rng-c-parse-primary)
+ (rng-c-parse-annotation-body):
+ * nxml/rng-dt.el (rng-dt-namespace-context-getter): Reflow docstrings.
+
+ * nxml/nxml-mode.el (nxml, nxml-mode, nxml-after-change1)
+ (nxml-extend-region, nxml-merge-indent-context-type, nxml-complete)
+ (nxml-forward-balanced-item, nxml-dynamic-markup-word)
+ (nxml-define-char-name-set, nxml-toggle-char-ref-extra-display):
+ Fix typos in docstrings.
+ (nxml-attribute-indent): Reflow docstring.
+ (nxml-bind-meta-tab-to-complete-flag, nxml-last-fontify-end)
+ (nxml-default-buffer-file-coding-system): Doc fixes.
+
+ * nxml/nxml-ns.el (nxml-ns-state, nxml-ns-initial-state)
+ (nxml-ns-set-prefix): Fix typos in docstrings.
+ (nxml-ns-push-state, nxml-ns-pop-state, nxml-ns-set-default):
+ Reflow docstring.
+ (nxml-ns-get-prefix, nxml-ns-get-default): Doc fixes.
+
+ * nxml/nxml-outln.el (nxml-hide-all-text-content)
+ (nxml-show-direct-text-content, nxml-show-direct-subheadings)
+ (nxml-hide-direct-text-content, nxml-hide-subheadings)
+ (nxml-hide-text-content, nxml-show-subheadings, nxml-hide-other)
+ (nxml-outline-display-rest, nxml-outline-set-overlay)
+ (nxml-section-tag-forward, nxml-section-tag-backward)
+ (nxml-back-to-section-start): Fix typos in docstrings.
+
+ * nxml/nxml-parse.el (nxml-validate-function, nxml-parse-file):
+ Doc fixes.
+
+ * nxml/nxml-rap.el (nxml-scan-end, nxml-move-tag-backwards)
+ (nxml-scan-element-forward, nxml-scan-element-backward): Doc fixes.
+ (nxml-scan-after-change): Fix typo in docstring.
+
+ * nxml/rng-match.el (rng-being-compiled, rng-normalize-choice-list)
+ (rng-name-class-possible-names): Doc fixes.
+ (rng-memo-map-add, rng-intern-group, rng-match-possible-namespace-uris)
+ (rng-match-possible-start-tag-names, rng-match-possible-value-strings):
+ Fix typos in docstrings.
+ (rng-intern-group-shortcut, rng-intern-choice-shortcut):
+ Reflow docstrings.
+
+ * nxml/rng-util.el (rng-uniquify-eq, rng-uniquify-equal): Doc fixes.
+ (rng-substq, rng-complete-before-point): Fix typos in docstrings.
+
+ * nxml/rng-xsd.el (rng-xsd-make-date-time-regexp)
+ (rng-xsd-convert-date-time): Reflow docstrings.
+ (rng-xsd-compile): Fix typo in docstring.
+
+ * nxml/rng-loc.el (rng-current-schema-file-name)
+ (rng-locate-schema-file-using, rng-locate-schema-file-from-type-id):
+ Doc fixes.
+ (rng-set-schema-file): Fix typo in docstring.
+
+ * nxml/rng-valid.el (rng-error-count, rng-validate-mode)
+ (rng-do-some-validation, rng-process-start-tag, rng-process-text):
+ Fix typos in docstrings.
+ (rng-message-overlay, rng-conditional-up-to-date-start)
+ (rng-conditional-up-to-date-end): Doc fixes.
+ (rng-next-error, rng-previous-error): Reflow docstrings.
+
+ * nxml/xmltok.el (xmltok-attribute-raw-normalized-value): Doc fix.
+ (xmltok-dtd, xmltok-dependent-regions, xmltok-attribute-refs)
+ (xmltok-valid-char-p, xmltok-standalone, xmltok-forward-prolog)
+ (xmltok-merge-attributes): Fix typos in docstrings.
+ (xmltok-make-attribute, xmltok-forward-special)
+ (xmltok-get-declared-encoding-position): Reflow docstrings.
+
+ * nxml/xsd-regexp.el (xsdre-char-class-to-range-list): Doc fix.
+ (xsdre-range-list-union, xsdre-check-range-list, xsdre-current-regexp):
+ Fix typos in docstrings.
+
2008-07-02 John Paul Wallington <jpw@pobox.com>
* ibuffer.el (ibuffer-buffer-file-name):
"Glyph set for TARGET3 glyph repertoire of the misc-fixed-* fonts.
This repertoire is supported for the following fonts:
6x13.bdf 8x13.bdf 9x15.bdf 9x18.bdf 10x20.bdf")
-
+
(defconst nxml-wgl4-glyph-set
[(#x0020 . #x007E)
(#x00A0 . #x017F)
(defvar nxml-glyph-set-hook nil
"*Hook for determining the set of glyphs in a face.
-The hook will receive a single argument FACE. If it can determine the
-set of glyphs representable by FACE, it must set the variable
-`nxml-glyph-set' and return non-nil. Otherwise, it must return
-nil. The hook will be run until success. The constants
+The hook will receive a single argument FACE. If it can determine
+the set of glyphs representable by FACE, it must set the variable
+`nxml-glyph-set' and return non-nil. Otherwise, it must return nil.
+The hook will be run until success. The constants
`nxml-ascii-glyph-set', `nxml-latin1-glyph-set',
`nxml-misc-fixed-1-glyph-set', `nxml-misc-fixed-2-glyph-set',
-`nxml-misc-fixed-3-glyph-set' and `nxml-wgl4-glyph-set' are predefined
-for use by `nxml-glyph-set-hook'.")
+`nxml-misc-fixed-3-glyph-set' and `nxml-wgl4-glyph-set' are
+predefined for use by `nxml-glyph-set-hook'.")
(defvar nxml-glyph-set nil
"Used by `nxml-glyph-set-hook' to return set of glyphs in a FACE.
(nxml-glyph-set-contains-p n nxml-glyph-set)
(let ((ch (decode-char 'ucs n)))
(and ch (string ch))))))
-
+
(defun nxml-glyph-set-contains-p (n v)
(let ((start 0)
(end (length v))
;;; Customization
(defgroup nxml nil
- "New XML editing mode"
+ "New XML editing mode."
:group 'languages
:group 'wp)
(defcustom nxml-attribute-indent 4
"*Indentation for the attributes of an element relative to the start-tag.
-This only applies when the first attribute of a tag starts a line. In other
-cases, the first attribute on one line is indented the same as the first
-attribute on the previous line."
+This only applies when the first attribute of a tag starts a line.
+In other cases, the first attribute on one line is indented the same
+as the first attribute on the previous line."
:group 'nxml
:type 'integer)
C-return will be bound to `nxml-complete' in any case.
M-TAB gets swallowed by many window systems/managers, and
`documentation' will show M-TAB rather than C-return as the
-binding `rng-complete' when both are bound. So it's better
+binding for `nxml-complete' when both are bound. So it's better
to bind M-TAB only when it will work."
:group 'nxml
:set (lambda (sym flag)
(defcustom nxml-default-buffer-file-coding-system nil
"*Default value for `buffer-file-coding-system' for a buffer for a new file.
-Nil means use the default value of `buffer-file-coding-system' as normal.
+A value of nil means use the default value of `buffer-file-coding-system' as normal.
A buffer's `buffer-file-coding-system' affects what \\[nxml-insert-xml-declaration] inserts."
:group 'nxml
:type 'coding-system)
'((t (:inherit nxml-delimiter)))
"Face used for the colon in attribute names."
:group 'nxml-faces)
-
+
(defface nxml-attribute-local-name
'((t (:inherit font-lock-variable-name-face)))
"Face used for the local name of attributes."
:foreground
"black"
:weight
- normal
+ normal
:slant
normal))
(t
:foreground
"black"
:weight
- normal
+ normal
:slant
normal)))
"Face used for glyph for char references."
(defvar nxml-last-fontify-end nil
"Position where fontification last ended.
-Nil if the buffer changed since the last fontification.")
+It is nil if the buffer changed since the last fontification.")
(make-variable-buffer-local 'nxml-last-fontify-end)
(defvar nxml-degraded nil
(define-key map "\C-c\C-o" nxml-outline-prefix-map)
(define-key map [S-mouse-2] 'nxml-mouse-hide-direct-text-content)
(define-key map "/" 'nxml-electric-slash)
- (define-key map [C-return] 'nxml-complete)
+ (define-key map [C-return] 'nxml-complete)
(when nxml-bind-meta-tab-to-complete-flag
(define-key map "\M-\t" 'nxml-complete))
map)
\\[nxml-finish-element] finishes the current element by inserting an end-tag.
C-c C-i closes a start-tag with `>' and then inserts a balancing end-tag
-leaving point between the start-tag and end-tag.
+leaving point between the start-tag and end-tag.
\\[nxml-balanced-close-start-tag-block] is similar but for block rather than inline elements:
the start-tag, point, and end-tag are all left on separate lines.
If `nxml-slash-auto-complete-flag' is non-nil, then inserting a `</'
Validation is provided by the related minor-mode `rng-validate-mode'.
This also makes completion schema- and context- sensitive. Element
names, attribute names, attribute values and namespace URIs can all be
-completed. By default, `rng-validate-mode' is automatically enabled. You
-can toggle it using \\[rng-validate-mode] or change the default by
+completed. By default, `rng-validate-mode' is automatically enabled.
+You can toggle it using \\[rng-validate-mode] or change the default by
customizing `rng-nxml-auto-validate-flag'.
\\[indent-for-tab-command] indents the current line appropriately.
and the variable `nxml-attribute-indent'.
\\[nxml-insert-named-char] inserts a character reference using
-the character's name (by default, the Unicode name). \\[universal-argument] \\[nxml-insert-named-char]
-inserts the character directly.
+the character's name (by default, the Unicode name).
+\\[universal-argument] \\[nxml-insert-named-char] inserts the character directly.
The Emacs commands that normally operate on balanced expressions will
operate on XML markup items. Thus \\[forward-sexp] will move forward
start end pre-change-length)))))))))
(defun nxml-after-change1 (start end pre-change-length)
- "After-change bookkeeping. Returns a cons cell containing a
-possibly-enlarged change region. You must call
-nxml-extend-region on this expanded region to obtain the full
-extent of the area needing refontification.
+ "After-change bookkeeping.
+Returns a cons cell containing a possibly-enlarged change region.
+You must call `nxml-extend-region' on this expanded region to obtain
+the full extent of the area needing refontification.
For bookkeeping, call this function even when fontification is
disabled."
(setq suitable-coding-systems (cdr suitable-coding-systems))))
ret)))
-(defun nxml-choose-utf-coding-system ()
+(defun nxml-choose-utf-coding-system ()
(let ((cur (and (local-variable-p 'buffer-file-coding-system)
buffer-file-coding-system
(coding-system-base buffer-file-coding-system))))
(defvar font-lock-beg) (defvar font-lock-end)
(defun nxml-extend-region ()
"Extend the region to hold the minimum area we can fontify with nXML.
-Called with font-lock-beg and font-lock-end dynamically bound."
+Called with `font-lock-beg' and `font-lock-end' dynamically bound."
(let ((start font-lock-beg)
(end font-lock-end))
(insert "\n")
(indent-line-to (+ nxml-child-indent indent)))
(goto-char pos)))))
-
+
(defun nxml-finish-element ()
"Finish the current element by inserting an end-tag."
(interactive "*")
(defun nxml-merge-indent-context-type (context)
"Merge the indent context type CONTEXT with the token in `xmltok-type'.
Return the merged indent context type. An indent context type is
-either nil or one of the symbols start-tag, end-tag, markup, comment,
-mixed."
+either nil or one of the symbols `start-tag', `end-tag', `markup',
+`comment', `mixed'."
(cond ((memq xmltok-type '(start-tag partial-start-tag))
(if (memq context '(nil start-tag comment))
'start-tag
(setq atts nil))
(t (setq atts (cdr atts)))))
value-boundary))
-
+
(defun nxml-compute-indent-in-delimited-token (pos open-delim close-delim)
"Return the indent for a line that starts inside a token with delimiters.
OPEN-DELIM and CLOSE-DELIM are strings giving the opening and closing
Inserts as many characters as can be completed. However, if not even
one character can be completed, then a buffer with the possibilities
is popped up and the symbol is read from the minibuffer with
-completion. If the symbol is complete, then any characters that must
+completion. If the symbol is complete, then any characters that must
follow the symbol are also inserted.
The name space used for completion and what is treated as a symbol
An element contains as items strings with no markup, tags, processing
instructions, comments, CDATA sections, entity references and
-characters references. However, if the variable
+characters references. However, if the variable
`nxml-sexp-element-flag' is non-nil, then an element is treated as a
single markup item. A start-tag contains an element name followed by
-one or more attributes. An end-tag contains just an element name. An
-attribute value literals contains strings with no markup, entity
+one or more attributes. An end-tag contains just an element name.
+An attribute value literals contains strings with no markup, entity
references and character references. A processing instruction
consists of a target and a content string. A comment or a CDATA
section contains a single string. An entity reference contains a
(goto-char (+ xmltok-start offset))
(and (re-search-forward "^[ \t]*$" end t)
(match-beginning 0)))))
- ((and (memq xmltok-type '(start-tag
+ ((and (memq xmltok-type '(start-tag
end-tag
empty-element
comment
(looking-at "[ \t]*$")
(not (nxml-in-mixed-content-p t)))
(save-excursion
- (or (search-forward "\n" nil t)
+ (or (search-forward "\n" nil t)
(point-max))))))
(defun nxml-paragraph-start-pos (had-data offset)
(goto-char (- (point) offset))
(and (re-search-backward "^[ \t]*$" xmltok-start t)
(match-beginning 0))))
- ((and (memq xmltok-type '(start-tag
+ ((and (memq xmltok-type '(start-tag
end-tag
empty-element
comment
entity-ref))
(nxml-token-ends-line-p)
(nxml-token-begins-line-p))
- (or (search-forward "\n" nil t)
+ (or (search-forward "\n" nil t)
(point-max)))
((and (eq xmltok-type 'start-tag)
(nxml-token-begins-line-p)
(fill-region-as-paragraph start end arg))
(skip-line-prefix fill-prefix)
fill-prefix))
-
+
(defun nxml-newline-and-indent (soft)
(delete-horizontal-space)
(if soft (insert-and-inherit ?\n) (newline 1))
the word before point; the contents of the current buffer is used to
decide where.
-It works in a similar way to \\[dabbrev-expand]. It searches first
+It works in a similar way to \\[dabbrev-expand]. It searches first
backwards from point, then forwards from point for an element whose
content is a string which matches the contents of the buffer before
-point and which includes at least the word before point. It then
+point and which includes at least the word before point. It then
copies the start- and end-tags from that element and uses them to
surround the matching string before point.
(- start-tag-close-pos xmltok-start)))
(insert "</" name ">")
(setq nxml-dynamic-markup-prev-pos (point))))))))))
-
+
;;; Character names
(defvar nxml-autoload-char-name-set-list nil
"List of char namesets that can be autoloaded.")
-(defun nxml-enable-char-name-set (nameset)
+(defun nxml-enable-char-name-set (nameset)
(put nameset 'nxml-char-name-set-enabled t))
-(defun nxml-disable-char-name-set (nameset)
+(defun nxml-disable-char-name-set (nameset)
(put nameset 'nxml-char-name-set-enabled nil))
(defun nxml-char-name-set-enabled-p (nameset)
(defun nxml-define-char-name-set (nameset alist)
"Define a set of character names.
NAMESET is a symbol identifying the set.
-Alist is a list where each member has the form (NAME CODE),
-where NAME is a string naming a character and code
-is an integer giving the Unicode scalar value of the character."
+ALIST is a list where each member has the form (NAME CODE),
+where NAME is a string naming a character and code is an
+integer giving the Unicode scalar value of the character."
(when (get nameset 'nxml-char-name-set-defined)
(error "Nameset `%s' already defined" nameset))
(let ((iter alist))
(error "Character %x is not supported by Emacs"
code))
(format "&#x%X;" code))))))
-
+
(defun nxml-maybe-load-char-name-set (sym)
(when (and (get sym 'nxml-char-name-set-enabled)
(not (get sym 'nxml-char-name-set-defined))
(load (get sym 'nxml-char-name-set-file))))
(defun nxml-toggle-char-ref-extra-display (arg)
- "*Toggle the display of extra information for character references."
+ "Toggle the display of extra information for character references."
(interactive "P")
(let ((new (if (null arg)
(not nxml-char-ref-extra-display)
(defun nxml-start-delimiter-length (type)
(or (get type 'nxml-start-delimiter-length)
0))
-
+
(put 'cdata-section 'nxml-start-delimiter-length 9)
(put 'comment 'nxml-start-delimiter-length 4)
(put 'processing-instruction 'nxml-start-delimiter-length 2)
(defun nxml-end-delimiter-length (type)
(or (get type 'nxml-end-delimiter-length)
0))
-
+
(put 'cdata-section 'nxml-end-delimiter-length 3)
(put 'comment 'nxml-end-delimiter-length 3)
(put 'processing-instruction 'nxml-end-delimiter-length 2)
(require 'nxml-util)
(defvar nxml-ns-state nil
- "Contains the state of namespace processing. The state
-is never modified destructively and so can be saved and restored
-without copying.
-
-The value is a stack represented by a list. The list has length N + 1
-where N is the number of open elements. Each member of the list
-represents the bindings in effect for a particular element. Each
-member is itself a list whose car is the default namespace
+ "Contains the state of namespace processing.
+The state is never modified destructively and so can be saved and
+restored without copying.
+
+The value is a stack represented by a list. The list has length
+N + 1 where N is the number of open elements. Each member of the
+list represents the bindings in effect for a particular element.
+Each member is itself a list whose car is the default namespace
\(a symbol or nil) and whose cdr is an alist of (PREFIX . NS) pairs
where PREFIX is a string (never nil) and NS is the namespace URI
symbol.")
(defconst nxml-ns-initial-state
(list (list nil (cons "xml" nxml-xml-namespace-uri)))
- "A list to be used as the initial value of nxml-ns-state. This
-represents the state with no open elements and with the default
+ "A list to be used as the initial value of `nxml-ns-state'.
+This represents the state with no open elements and with the default
namespace bindings (no default namespace and only the xml prefix bound).")
(defsubst nxml-ns-state () nxml-ns-state)
(setq nxml-ns-state nxml-ns-initial-state))
(defun nxml-ns-push-state ()
- "Change the state by starting a new element. Namespace declarations
-are inherited from the parent state."
+ "Change the state by starting a new element.
+Namespace declarations are inherited from the parent state."
(setq nxml-ns-state (cons (car nxml-ns-state) nxml-ns-state)))
(defun nxml-ns-pop-state ()
- "Change the state by ending an element. The behavior is undefined
-if there is no open element."
+ "Change the state by ending an element.
+The behavior is undefined if there is no open element."
(setq nxml-ns-state (cdr nxml-ns-state)))
(defun nxml-ns-get-prefix (prefix)
- "Return the symbol for namespace bound to PREFIX, or nil if PREFIX
-is unbound. PREFIX is a string, never nil."
+ "Return the symbol for namespace bound to PREFIX.
+Return nil if PREFIX is unbound. PREFIX is a string, never nil."
(let ((binding (assoc prefix (cdar nxml-ns-state))))
(and binding (cdr binding))))
(defun nxml-ns-set-prefix (prefix ns)
- "Change the binding of PREFIX. PREFIX is a string (never nil). NS
-is a symbol (never nil). The change will be in effect until the end of
-the current element."
+ "Change the binding of PREFIX.
+PREFIX is a string (never nil). NS is a symbol (never nil).
+The change will be in effect until the end of the current element."
(setq nxml-ns-state
(let ((bindings (car nxml-ns-state)))
(cons (cons (car bindings)
(cdr nxml-ns-state)))))
(defun nxml-ns-get-default ()
- "Return the current default namespace as a symbol, or nil
-if there is no default namespace."
+ "Return the current default namespace as a symbol.
+Return nil if there is no default namespace."
(caar nxml-ns-state))
(defun nxml-ns-set-default (ns)
- "Changes the current default namespace. The change
-will be in effect until the end of the current element.
+ "Changes the current default namespace.
+The change will be in effect until the end of the current element.
NS is a symbol or nil."
(setq nxml-ns-state
(cons (cons ns (cdar nxml-ns-state))
(cons (caar new) changed))
(setq new (cdr new))))
changed))
-
+
(provide 'nxml-ns)
;; arch-tag: 5968e4b7-fb37-46ce-8621-c65db9793028
(defun nxml-hide-all-text-content ()
"Hide all text content in the buffer.
Anything that is in a section but is not a heading will be hidden.
-The visibility of headings at any level will not be changed. See the
+The visibility of headings at any level will not be changed. See the
variable `nxml-section-element-name-regexp' for more details on how to
customize which elements are recognized as sections and headings."
(interactive)
(defun nxml-show-direct-text-content ()
"Show the text content that is directly part of the section containing point.
Each subsection will be shown according to its individual state, which
-will not be changed. The section containing point is the innermost
-section that contains the character following point. See the variable
+will not be changed. The section containing point is the innermost
+section that contains the character following point. See the variable
`nxml-section-element-name-regexp' for more details on how to
customize which elements are recognized as sections and headings."
(interactive)
(defun nxml-show-direct-subheadings ()
"Show the immediate subheadings of the section containing point.
The section containing point is the innermost section that contains
-the character following point. See the variable
+the character following point. See the variable
`nxml-section-element-name-regexp' for more details on how to
customize which elements are recognized as sections and headings."
(interactive)
"Hide the text content that is directly part of the section containing point.
The heading of the section will remain visible. The state of
subsections will not be changed. The section containing point is the
-innermost section that contains the character following point. See the
+innermost section that contains the character following point. See the
variable `nxml-section-element-name-regexp' for more details on how to
customize which elements are recognized as sections and headings."
(interactive)
The text content will also be hidden, leaving only the heading of the
section itself visible. The state of the subsections will also be
changed to hide their headings, so that \\[nxml-show-direct-text-content]
-would show only the heading of the subsections. The section containing
+would show only the heading of the subsections. The section containing
point is the innermost section that contains the character following
point. See the variable `nxml-section-element-name-regexp' for more
details on how to customize which elements are recognized as sections
(defun nxml-hide-text-content ()
"Hide text content at all levels in the section containing point.
The section containing point is the innermost section that contains
-the character following point. See the variable
+the character following point. See the variable
`nxml-section-element-name-regexp' for more details on how to
customize which elements are recognized as sections and headings."
(interactive)
"Show the subheadings at all levels of the section containing point.
The visibility of the text content at all levels in the section is not
changed. The section containing point is the innermost section that
-contains the character following point. See the variable
+contains the character following point. See the variable
`nxml-section-element-name-regexp' for more details on how to
customize which elements are recognized as sections and headings."
(interactive)
"Hide text content other than that directly in the section containing point.
Hide headings other than those of ancestors of that section and their
immediate subheadings. The section containing point is the innermost
-section that contains the character following point. See the variable
+section that contains the character following point. See the variable
`nxml-section-element-name-regexp' for more details on how to
customize which elements are recognized as sections and headings."
(interactive)
(when change
(nxml-set-outline-state section-start-pos
(cdr change)))))
-
+
(defun nxml-section-tag-transform-outline-state (startp
section-start-pos
&optional
(or (eq xmltok-type 'end-tag)
(eq xmltok-type 'partial-end-tag)))
-(defun nxml-refresh-outline ()
+(defun nxml-refresh-outline ()
"Refresh the outline to correspond to the current XML element structure."
(interactive)
(save-excursion
indent of the start-tag of the current element, or nil if no
containing element has a non-nil OUTLINE-STATE. TAG-QNAMES is a list
of the qnames of the open elements. Point is after the title content.
-Leave point after the closing end-tag Return t if we had a
+Leave point after the closing end-tag. Return t if we had a
non-transparent child section."
(let ((last-pos (point))
(transparent-depth 0)
t)
'display
nxml-highlighted-empty-end-tag))
-
+
(defun nxml-outline-display-multi-line-end-tag (last-pos start-tag-indent)
(let ((indentp (save-excursion
(goto-char last-pos)
&optional
front-advance
rear-advance)
- "Replace any nxml-outline-display overlays between START and END.
+ "Replace any `nxml-outline-display' overlays between START and END.
Overlays are removed if they overlay the region between START and END,
-and have a non-nil nxml-outline-display property (typically via their
-category). If CATEGORY is non-nil, they will be replaced with a new overlay
-with that category from START to END. If CATEGORY is nil, no new
-overlay will be created."
+and have a non-nil `nxml-outline-display' property (typically via their
+category). If CATEGORY is non-nil, they will be replaced with a new
+overlay with that category from START to END. If CATEGORY is nil,
+no new overlay will be created."
(when (< start end)
(let ((overlays (overlays-in start end))
overlay)
(defun nxml-section-tag-forward ()
"Move forward past the first tag that is a section start- or end-tag.
-Return xmltok-type for tag.
+Return `xmltok-type' for tag.
If no tag found, return nil and move to the end of the buffer."
(let ((case-fold-search nil)
(tag-regexp (nxml-make-section-tag-regexp))
nil)
(t))))
xmltok-type)
-
+
(defun nxml-section-tag-backward ()
"Move backward to the end of a tag that is a section start- or end-tag.
-The position of the end of the tag must be <= point
+The position of the end of the tag must be <= point.
Point is at the end of the tag. `xmltok-start' is the start."
(let ((case-fold-search nil)
(start (point))
"Try to move back to the start of the section containing point.
The start of the section must be <= point.
Only visible sections are included unless INVISIBLE-OK is non-nil.
-If found, return t. Otherwise move to point-min and return nil.
+If found, return t. Otherwise move to `point-min' and return nil.
If unbalanced section tags are found, signal an `nxml-outline-error'."
(when (or (nxml-after-section-start-tag)
(nxml-section-tag-backward))
(heading-regexp (concat "\\`\\("
nxml-heading-element-name-regexp
"\\)\\'"))
-
+
(section-regexp (concat "\\`\\("
nxml-section-element-name-regexp
"\\)\\'"))
(defvar nxml-parse-file-name nil)
(defvar nxml-validate-function nil
- "Nil or a function to be called by `nxml-parse-file' to perform validation.
+ "Either nil or a function called by `nxml-parse-file' to perform validation.
The function will be called once for each start-tag or end-tag. The
function is passed two arguments TEXT and START-TAG. For a start-tag,
START-TAG is a list (NAME ATTRIBUTES) where NAME and ATTRIBUTES are in
-the same form as returned by `nxml-parse-file. For an end-tag,
+the same form as returned by `nxml-parse-file'. For an end-tag,
START-TAG is nil. TEXT is a string containing the text immediately
preceding the tag, or nil if there was no such text. An empty element
is treated as a start-tag followed by an end-tag.
For a start-tag, the namespace state will be the state after
-processing the namespace declarations in the start-tag. For an
+processing the namespace declarations in the start-tag. For an
end-tag, the namespace state will be the state before popping the
namespace declarations for the corresponding start-tag.
NAME is either a string, in the case where the name does not have a
namespace, or a cons (NAMESPACE . LOCAL-NAME), where NAMESPACE is a
symbol and LOCAL-NAME is a string, in the case where the name does
-have a namespace. NAMESPACE is a keyword whose name is `:URI', where
+have a namespace. NAMESPACE is a keyword whose name is `:URI', where
URI is the namespace name. ATTRIBUTES is an alist of attributes where
each attribute has the form (NAME . VALUE), where NAME has the same
form as an element name, and VALUE is a string. A namespace
If the XML document is not well-formed, an error having the condition
`nxml-file-parse-error' will be signaled; the error data will be a
-list of the \(FILE POSITION MESSAGE), where POSITION is an integer
-specifying the position where the error was detected, and MESSAGE is a
-string describing the error.
+list of the form \(FILE POSITION MESSAGE), where POSITION is an
+integer specifying the position where the error was detected, and
+MESSAGE is a string describing the error.
The current contents of FILE will be parsed even if there is a
modified buffer currently visiting FILE.
-If the variable `nxml-validation-function' is non-nil, it will be
-called twice for each element, and any reported error will be signaled
-in the same way as well-formedness error."
+If the variable `nxml-validate-function' is non-nil, it will be called
+twice for each element, and any reported error will be signaled in the
+same way as well-formedness error."
(save-excursion
(set-buffer (nxml-parse-find-file file))
(unwind-protect
(let ((set-auto-coding-function 'nxml-set-xml-coding))
(insert-file-contents file))
(current-buffer)))
-
+
(defun nxml-parse-instance ()
(let (xmltok-dtd)
(xmltok-save
(defvar nxml-scan-end nil
"Marker giving position up to which we have scanned.
nxml-scan-end must be >= nxml-prolog-end. Furthermore, nxml-scan-end
-must not an inside position in the following sense. A position is
+must not be an inside position in the following sense. A position is
inside if the following character is a part of, but not the first
character of, a CDATA section, comment or processing instruction.
Furthermore all positions >= nxml-prolog-end and < nxml-scan-end that
-are inside positions must have a non-nil nxml-inside property whose
-value is a symbol specifying what it is inside. Any characters with a
-non-nil fontified property must have position < nxml-scan-end and the
-correct face. Dependent regions must also be established for any
+are inside positions must have a non-nil `nxml-inside' property whose
+value is a symbol specifying what it is inside. Any characters with a
+non-nil `fontified' property must have position < nxml-scan-end and
+the correct face. Dependent regions must also be established for any
unclosed constructs starting before nxml-scan-end.
-There must be no nxml-inside properties after nxml-scan-end.")
+There must be no `nxml-inside' properties after nxml-scan-end.")
(make-variable-buffer-local 'nxml-scan-end)
(defsubst nxml-get-inside (pos)
"Restore `nxml-scan-end' invariants after a change.
The change happened between START and END.
Return position after which lexical state is unchanged.
-END must be > nxml-prolog-end. START must be outside
+END must be > `nxml-prolog-end'. START must be outside
any 'inside' regions and at the beginning of a token."
(if (>= start nxml-scan-end)
nxml-scan-end
xmltok-type))
(defun nxml-move-tag-backwards (bound)
- "Move point backwards outside any 'inside' regions or tags, up
-to nxml-prolog-end. Point will either be at bound or a '<'
-character starting a tag outside any 'inside' regions. Ignores
-dependent regions. As a precondition, point must be >= bound."
+ "Move point backwards outside any 'inside' regions or tags.
+Point will not move past `nxml-prolog-end'.
+Point will either be at BOUND or a '<' character starting a tag
+outside any 'inside' regions. Ignores dependent regions.
+As a precondition, point must be >= BOUND."
(nxml-move-outside-backwards)
(when (not (equal (char-after) ?<))
(if (search-backward "<" bound t)
(defun nxml-scan-element-forward (from &optional up)
"Scan forward from FROM over a single balanced element.
-Point must between tokens. Return the position of the end of the tag
-that ends the element. `xmltok-start' will contain the position of the
-start of the tag. If UP is non-nil, then scan past end-tag of element
-containing point. If no element is found, return nil. If a
-well-formedness error prevents scanning, signal an nxml-scan-error.
-Point is not moved."
+Point must be between tokens. Return the position of the end of
+the tag that ends the element. `xmltok-start' will contain the
+position of the start of the tag. If UP is non-nil, then scan
+past end-tag of element containing point. If no element is
+found, return nil. If a well-formedness error prevents scanning,
+signal an `nxml-scan-error'. Point is not moved."
(let ((open-tags (and up t))
found)
(save-excursion
(defun nxml-scan-element-backward (from &optional up bound)
"Scan backward from FROM over a single balanced element.
-Point must between tokens. Return the position of the end of the tag
-that starts the element. `xmltok-start' will contain the position of
-the start of the tag. If UP is non-nil, then scan past start-tag of
-element containing point. If BOUND is non-nil, then don't scan back
-past BOUND. If no element is found, return nil. If a well-formedness
-error prevents scanning, signal an nxml-scan-error. Point is not
-moved."
+Point must be between tokens. Return the position of the end of
+the tag that starts the element. `xmltok-start' will contain the
+position of the start of the tag. If UP is non-nil, then scan
+past start-tag of element containing point. If BOUND is non-nil,
+then don't scan back past BOUND. If no element is found, return
+nil. If a well-formedness error prevents scanning, signal an
+`nxml-scan-error'. Point is not moved."
(let ((open-tags (and up t))
token-end found)
(save-excursion
)
"List of Unicode blocks.
For each block there is a list (NAME FIRST LAST), where
-NAME is a string giving the offical name of the block,
+NAME is a string giving the official name of the block,
FIRST is the first code-point and LAST is the last code-point.
Blocks containing only characters with algorithmic names or no names
are omitted.")
(defun nxml-unicode-block-char-name-set (name)
- "Return a symbol for a block whose offical Unicode name is NAME.
+ "Return a symbol for a block whose official Unicode name is NAME.
The symbol is generated by downcasing and replacing each space
by a hyphen."
(intern (replace-regexp-in-string " " "-" (downcase name))))
nxml-unicode-blocks)
;; Internal flag to control whether customize reloads the character tables.
-;; Should be set the first time the
+;; Should be set the first time the
(defvar nxml-internal-unicode-char-name-sets-enabled nil)
(defcustom nxml-enabled-unicode-blocks nxml-enabled-unicode-blocks-default
;;; Code:
(defconst nxml-debug nil
- "enable nxml debugging. effective only at compile time")
+ "Enable nxml debugging. Effective only at compile time.")
(defsubst nxml-debug (format &rest args)
(when nxml-debug
(defun nxml-make-namespace (str)
"Return a symbol for the namespace URI STR.
-STR must be a string. If STR is the empty string, return nil.
+STR must be a string. If STR is the empty string, return nil.
Otherwise, return the symbol whose name is STR prefixed with a colon."
(if (string-equal str "")
nil
(defconst rng-c-about-combine-slot 1)
(defun rng-c-lookup-create (name grammar)
- "Return a def object for NAME. A def object is a pair
-\(ABOUT . REF) where REF is returned by `rng-make-ref'. ABOUT is a
-two-element vector [OVERRIDE COMBINE]. COMBINE is either nil, choice
-or interleave. OVERRIDE is either nil, require or t."
+ "Return a def object for NAME.
+A def object is a pair \(ABOUT . REF) where REF is returned by
+`rng-make-ref'.
+ABOUT is a two-element vector [OVERRIDE COMBINE].
+COMBINE is either nil, choice or interleave.
+OVERRIDE is either nil, require or t."
(let ((def (gethash name grammar)))
(if def
def
- (progn
+ (progn
(setq def (cons (vector nil nil) (rng-make-ref name)))
(puthash name def grammar)
def))))
(cons (cons prefix
(rng-make-datatypes-uri (rng-c-parse-literal)))
rng-c-datatype-decls))))
-
+
(defun rng-c-parse-namespace ()
(rng-c-declare-namespace nil
(rng-c-parse-identifier-or-keyword)))
(defun rng-c-parse-default ()
(rng-c-expect "namespace")
- (rng-c-declare-namespace t
+ (rng-c-declare-namespace t
(if (string-equal rng-c-current-token "=")
nil
(rng-c-parse-identifier-or-keyword))))
p)))
(defun rng-c-parse-primary ()
- "Parse a primary expression. The current token must be the first
-token of the expression. After parsing the current token should be
-token following the primary expression."
+ "Parse a primary expression.
+The current token must be the first token of the expression.
+After parsing the current token should be the token following
+the primary expression."
(cond ((rng-c-current-token-keyword-p)
(let ((parse-function (get (intern rng-c-current-token)
'rng-c-pattern)))
((rng-c-current-token-quoted-identifier-p)
(rng-c-advance-with (substring rng-c-current-token 1)))
(t (rng-c-error "Expected identifier or keyword"))))
-
+
(put 'string 'rng-c-pattern 'rng-c-parse-string)
(put 'token 'rng-c-pattern 'rng-c-parse-token)
(put 'element 'rng-c-pattern 'rng-c-parse-element)
(string-equal rng-c-current-token "|")))
(rng-make-choice-name-class name-classes))
name-class)))
-
+
(defun rng-c-parse-primary-name-class (attribute)
(cond ((rng-c-current-token-ncname-p)
(rng-c-advance-with
;; XXX don't allow attributes after text
(defun rng-c-parse-annotation-body (&optional allow-text)
- "Current token is [. Parse up to matching ]. Current token after
-parse is token following ]."
+ "Current token is [. Parse up to matching ].
+Current token after parse is token following ]."
(or (string-equal rng-c-current-token "[")
(rng-c-error "Expected ["))
(rng-c-advance)
(rng-c-parse-literal))
(t (rng-c-error "Expected = or ["))))))
(rng-c-advance))
-
+
(defun rng-c-advance-with (pattern)
(rng-c-advance)
pattern)
nil))
(defvar rng-dt-namespace-context-getter nil
- "A list used by datatype libraries to expand names. The car of the
-list is a symbol which is the name of a function. This function is
-applied to the cdr of the list. The function must return a list whose
-car is the default namespace and whose cdr is an alist of (PREFIX
-. NAMESPACE) pairs, where PREFIX is a string and NAMESPACE is a
-symbol. This must be dynamically bound before calling a datatype
-library.")
+ "A list used by datatype libraries to expand names.
+The car of the list is a symbol which is the name of a function.
+This function is applied to the cdr of the list. The function must
+return a list whose car is the default namespace and whose cdr is an
+alist of (PREFIX . NAMESPACE) pairs, where PREFIX is a string and
+NAMESPACE is a symbol. This must be dynamically bound before calling
+a datatype library.")
(defsubst rng-dt-make-value (dt str)
(apply (car dt) (cons str (cdr dt))))
(defvar rng-current-schema-file-name nil
"Filename of schema being used for current buffer.
-Nil if using a vacuous schema.")
+It is nil if using a vacuous schema.")
(make-variable-buffer-local 'rng-current-schema-file-name)
(defvar rng-schema-locating-files-default
FILENAME must be the name of a file containing a schema.
The extension of FILENAME is used to determine what kind of schema it
is. The variable `rng-schema-loader-alist' maps from schema
-extensions to schema loader functions. The function
+extensions to schema loader functions. The function
`rng-c-load-schema' is the loader for RELAX NG compact syntax. The
association is between the buffer and the schema: the association is
lost when the buffer is killed."
rng-any-element))
(setq rng-current-schema-file-name filename)
(run-hooks 'rng-schema-change-hook))
-
+
(defun rng-load-schema (filename)
(let* ((extension (file-name-extension filename))
(loader (cdr (assoc extension rng-schema-loader-alist))))
"Display a message saying what schema `rng-validate-mode' is using."
(interactive)
(if rng-current-schema-file-name
- (message "Using schema %s"
+ (message "Using schema %s"
(abbreviate-file-name rng-current-schema-file-name))
(message "Using vacuous schema")))
(defun rng-locate-schema-file-using (files)
"Locate a schema using the schema locating files FILES.
FILES is a list of file-names.
-Return either a URI, a list (TYPE-ID) where TYPE-ID is a string
+Return either a URI, a list (TYPE-ID) where TYPE-ID is a string,
or nil."
(let (rules
;; List of types that override normal order-based
(defun rng-locate-schema-file-from-type-id (type-id file)
"Locate the schema for type id TYPE-ID using schema locating file FILE.
-Return either a URI, a list (TYPE-ID) where TYPE-ID is a string
+Return either a URI, a list (TYPE-ID) where TYPE-ID is a string,
or nil."
(let ((rules (rng-get-parsed-schema-locating-file file))
schema rule)
(cons (list file mtime parsed)
rng-schema-locating-file-alist)))
parsed))))
-
+
(defconst rng-locate-namespace-uri
(nxml-make-namespace "http://thaiopensource.com/ns/locating-rules/1.0"))
(defvar rng-being-compiled nil
"Contains a list of ref patterns currently being compiled.
-Used to detect illegal recursive references.")
+Used to detect invalid recursive references.")
(defvar rng-ipattern-table nil)
(defun rng-ipattern-slot-accessor-name (slot-name)
(intern (concat "rng-ipattern-get-"
(symbol-name slot-name))))
-
+
(defun rng-ipattern-slot-setter-name (slot-name)
(intern (concat "rng-ipattern-set-"
(symbol-name slot-name)))))
"Associate KEY with VALUE in memo-map MM and return the new memo-map.
The new memo-map may or may not be a different object from MM.
-Alists are better for small maps. Hash tables are better for large
+Alists are better for small maps. Hash tables are better for large
maps. A memo-map therefore starts off as an alist and switches to a
-hash table for large memo-maps. A memo-map is always a list. An empty
-memo-map is represented by nil. A large memo-map is represented by a
+hash table for large memo-maps. A memo-map is always a list. An empty
+memo-map is represented by nil. A large memo-map is represented by a
list containing just a hash-table. A small memo map is represented by
a list whose cdr is an alist and whose car is the number of entries in
-the alist. The complete memo-map can be passed to assoc without
+the alist. The complete memo-map can be passed to `assoc' without
problems: assoc ignores any members that are not cons cells. There is
therefore minimal overhead in successful lookups on small lists
\(which is the most common case)."
(t (cons (1+ head)
(cons (cons key value)
(cdr mm))))))))
-
+
(defsubst rng-make-ipattern (type index name-class child nullable)
(vector type index name-class child nullable
;; 5 memo-text-typed
after
child
nil)))))
-
+
(defun rng-intern-attribute (name-class ipattern)
(if (eq ipattern rng-not-allowed-ipattern)
rng-not-allowed-ipattern
nil)))))
(defun rng-intern-group (ipatterns)
- "Return a ipattern for the list of group members in IPATTERNS."
+ "Return an ipattern for the list of group members in IPATTERNS."
(or (rng-intern-group-shortcut ipatterns)
(let* ((tem (rng-normalize-group-list ipatterns))
(normalized (cdr tem)))
(car tem))))))))
(defun rng-intern-group-shortcut (ipatterns)
- "Try to shortcut interning a group list. If successful, return the
-interned pattern. Otherwise return nil."
+ "Try to shortcut interning a group list.
+If successful, return the interned pattern. Otherwise return nil."
(while (and ipatterns
(eq (car ipatterns) rng-empty-ipattern))
(setq ipatterns (cdr ipatterns)))
nil
normalized
nullable))))
-
+
(defun rng-intern-choice-shortcut (ipatterns)
- "Try to shortcut interning a choice list. If successful, return the
-interned pattern. Otherwise return nil."
+ "Try to shortcut interning a choice list.
+If successful, return the interned pattern. Otherwise return nil."
(while (and ipatterns
(eq (car ipatterns)
rng-not-allowed-ipattern))
rng-not-allowed-ipattern))
(defun rng-normalize-choice-list (ipatterns)
- "Normalize a list of choices, expanding nested choices, removing
-not-allowed members, sorting by index and removing duplicates. Return
-a pair whose car says whether the list is nullable and whose cdr is
-the normalized list."
+ "Normalize a list of choices.
+Expands nested choices, removes not-allowed members, sorts by index
+and removes duplicates. Return a pair whose car says whether the
+list is nullable and whose cdr is the normalized list."
(let ((sorted t)
(nullable nil)
(head (cons nil ipatterns)))
Each possible name should be returned as a (NAMESPACE . LOCAL-NAME)
pair, where NAMESPACE is a symbol or nil and LOCAL-NAME is a string.
-nil for NAMESPACE matches the absent namespace. ACCUM is a list of
-names which should be appended to the returned list. The returned list
-may contain duplicates."
+NAMESPACE, if nil, matches the absent namespace. ACCUM is a list of
+names which should be appended to the returned list. The returned
+list may contain duplicates."
(if (consp nc)
(cons nc accum)
(when (eq (aref nc 0) 'choice)
(rng-compile pattern)
(setq rng-being-compiled
(cdr rng-being-compiled))))
-
+
(defun rng-compile-one-or-more (pattern)
(rng-intern-one-or-more (rng-compile pattern)))
(rng-compile-error "Value %s is not a valid instance of the datatype %s"
str
name))))
-
+
(defun rng-compile-name-class (nc)
(let ((type (car nc)))
(cond ((eq type 'name) (nth 1 nc))
((eq type 'after)
(rng-ipattern-text-typed-p (rng-ipattern-get-child ipattern)))
(t (and (memq type '(value list data data-except)) t)))))
-
+
(defun rng-start-tag-open-deriv (ipattern nm)
(or (rng-memo-map-get
nm
(rng-ipattern-get-memo-map-start-tag-open-deriv ipattern))
(rng-ipattern-memo-start-tag-open-deriv
ipattern
- nm
+ nm
(rng-compute-start-tag-open-deriv ipattern nm))))
-
+
(defun rng-ipattern-memo-start-tag-open-deriv (ipattern nm deriv)
(or (memq ipattern rng-const-ipatterns)
(rng-ipattern-set-memo-map-start-tag-open-deriv
((eq type 'group)
(rng-transform-group-nullable
`(lambda (p) (rng-start-tag-open-deriv p ',nm))
- 'rng-cons-group-after
+ 'rng-cons-group-after
ipattern))
((eq type 'interleave)
(rng-transform-interleave-single
(rng-ipattern-get-memo-map-start-attribute-deriv ipattern))
(rng-ipattern-memo-start-attribute-deriv
ipattern
- nm
+ nm
(rng-compute-start-attribute-deriv ipattern nm))))
-
+
(defun rng-ipattern-memo-start-attribute-deriv (ipattern nm deriv)
(or (memq ipattern rng-const-ipatterns)
(rng-ipattern-set-memo-map-start-attribute-deriv
((eq type 'group)
(rng-transform-interleave-single
`(lambda (p) (rng-start-attribute-deriv p ',nm))
- 'rng-subst-group-after
+ 'rng-subst-group-after
ipattern))
((eq type 'interleave)
(rng-transform-interleave-single
'rng-ignore-attributes-deriv
ipattern)
ipattern)))))
-
+
(defun rng-text-only-deriv (ipattern)
(or (rng-ipattern-get-memo-text-only-deriv ipattern)
(rng-ipattern-set-memo-text-only-deriv
(setq list1 (cdr list1))
(setq list2 (cdr list2)))
(and (null list1) (null list2)))
-
+
(defun rng-ipattern-after (ipattern)
(let ((type (rng-ipattern-get-type ipattern)))
(defsubst rng-set-match-state (state)
(setq rng-match-state state))
-
+
(defsubst rng-match-state-equal (state)
(eq state rng-match-state))
(defun rng-match-possible-namespace-uris ()
"Return a list of all the namespace URIs used in the current schema.
-The absent URI is not included, so the result is always list of symbols."
+The absent URI is not included, so the result is always a list of symbols."
(rng-map-element-attribute (lambda (pattern accum)
(rng-find-name-class-uris (nth 1 pattern)
accum))
Each possible name is returned as a (NAMESPACE . LOCAL-NAME) pair,
where NAMESPACE is a symbol or nil (meaning the absent namespace) and
-LOCAL-NAME is a string. The returned list may contain duplicates."
+LOCAL-NAME is a string. The returned list may contain duplicates."
(rng-ipattern-possible-start-tags rng-match-state nil))
;; This is no longer used. It might be useful so leave it in for now.
(defun rng-match-possible-value-strings ()
"Return a list of strings that would be valid as content.
-The list may contain duplicates. Typically, the list will not
+The list may contain duplicates. Typically, the list will not
be exhaustive."
(rng-ipattern-possible-values rng-match-state nil))
(def-edebug-spec rng-match-with-schema t)
(provide 'rng-match)
-
+
;; arch-tag: c8c50733-edcf-49fb-85e2-0aac8749b7f8
;;; rng-match.el ends here
(defun rng-set-state-after (&optional pos)
"Set the state for after parsing the first token with endpoint >= POS.
This does not change the xmltok state or point. However, it does
-set `xmltok-dtd'. Returns the position of the end of the token."
+set `xmltok-dtd'. Returns the position of the end of the token."
(unless pos (setq pos (point)))
(when (< rng-validate-up-to-date-end pos)
(message "Parsing...")
(rng-process-start-tag 'stop)
(rng-find-undeclared-prefixes)
t)))))
-
+
(defun rng-find-undeclared-prefixes ()
;; Start with the newly effective namespace declarations.
;; (Includes declarations added during recovery.)
(list (cdr name))))
rng-complete-target-names)))
'string<))))
-
+
(defun rng-get-preferred-unused-prefix (ns)
(let ((ns-prefix (assoc (symbol-name ns) rng-preferred-prefix-alist))
iter prefix)
(defun rng-file-name-uri (f)
"Return a URI for the filename F.
-Multibyte characters are left as is. Use `rng-uri-escape-multibyte' to
+Multibyte characters are left as is. Use `rng-uri-escape-multibyte' to
escape them using %HH."
(setq f (expand-file-name f))
(let ((url
(setq path (substring path 1)))
(when (and pattern (string-match "\\`\\./" path))
(setq path (substring path 2)))
- (setq path
+ (setq path
(cond ((eq pattern 'match)
(rng-uri-unescape-unibyte-match path))
((eq pattern 'replace)
(cons scheme
(cons ":" parts))))
(apply 'concat parts))))
-
+
(defun rng-uri-resolve (uri-ref base-uri)
"Resolve a possibly relative URI reference into absolute form.
URI-REF is the URI reference to be resolved.
(mapcar (lambda (h) (string-to-number h 16))
(split-string str "%")))
'utf-8))
-
+
(defun rng-uri-unescape-unibyte (str)
(replace-regexp-in-string "%[0-7][0-9a-fA-F]"
(lambda (h)
(defconst rng-builtin-datatypes-uri (rng-make-datatypes-uri ""))
(defun rng-uniquify-eq (list)
- "Destructively remove any element from LIST that is eq to
-its predecessor."
+ "Destructively remove `eq' duplicates from LIST."
(and list
(let ((head list))
(while (cdr head)
list)))
(defun rng-uniquify-equal (list)
- "Destructively remove any element from LIST that is equal to
-its predecessor."
+ "Destructively remove `equal' duplicates from LIST."
(and list
(let ((head list))
(while (cdr head)
(defun rng-blank-p (str) (string-match "\\`[ \t\n\r]*\\'" str))
(defun rng-substq (new old list)
- "Replace first member of LIST (if any) that is eq to OLD by NEW.
+ "Replace first member of LIST (if any) that is `eq' to OLD by NEW.
LIST is not modified."
(cond ((null list) nil)
((eq (car list) old)
completion table and, when needed, input read from the user with the
minibuffer.
Returns the new string if either a complete and unique completion was
-determined automatically or input was read from the user. Otherwise,
+determined automatically or input was read from the user. Otherwise,
returns nil.
TABLE is an alist, a symbol bound to a function or an obarray as with
the function `completing-read'.
(put 'rng-validate-quick-timer 'permanent-local t)
(defvar rng-error-count nil
- "Number of errors in the current buffer. Always equal to number of
-overlays with category rng-error.")
+ "Number of errors in the current buffer.
+Always equal to number of overlays with category `rng-error'.")
(make-variable-buffer-local 'rng-error-count)
(defvar rng-message-overlay nil
- "Overlay in this buffer whose help-echo property was last printed.
-Nil if none.")
+ "Overlay in this buffer whose `help-echo' property was last printed.
+It is nil if none.")
(make-variable-buffer-local 'rng-message-overlay)
(defvar rng-message-overlay-inhibit-point nil
(defvar rng-conditional-up-to-date-start nil
"Marker for the start of the conditionally up-to-date region.
-Nil if there is no conditionally up-to-date region. The conditionally
-up-to-date region must be such that for any cached state S with
-position P in the conditionally up-to-date region, if at some point it
-is determined that S becomes correct for P, then all states with
-position >= P in the conditionally up to date region must also then be
-correct and all errors between P and the end of the region must then
-be correctly marked.")
+It is nil if there is no conditionally up-to-date region. The
+conditionally up-to-date region must be such that for any cached
+state S with position P in the conditionally up-to-date region,
+if at some point it is determined that S becomes correct for P,
+then all states with position >= P in the conditionally up to
+date region must also then be correct and all errors between P
+and the end of the region must then be correctly marked.")
(make-variable-buffer-local 'rng-conditional-up-to-date-start)
(defvar rng-conditional-up-to-date-end nil
"Marker for the end of the conditionally up-to-date region.
-Nil if there is no conditionally up-to-date region. See the variable
-`rng-conditional-up-to-date-start'.")
+It is nil if there is no conditionally up-to-date region.
+See the variable `rng-conditional-up-to-date-start'.")
(make-variable-buffer-local 'rng-conditional-up-to-date-end)
(defvar rng-parsing-for-state nil
Checks whether the buffer is a well-formed XML 1.0 document,
conforming to the XML Namespaces Recommendation and valid against a
-RELAX NG schema. The mode-line indicates whether it is or not. Any
+RELAX NG schema. The mode-line indicates whether it is or not. Any
parts of the buffer that cause it not to be are considered errors and
-are highlighted with face `rng-error'. A description of each error is
+are highlighted with face `rng-error'. A description of each error is
available as a tooltip. \\[rng-next-error] goes to the next error
-after point. Clicking mouse-1 on the word `Invalid' in the mode-line
-goes to the first error in the buffer. If the buffer changes, then it
+after point. Clicking mouse-1 on the word `Invalid' in the mode-line
+goes to the first error in the buffer. If the buffer changes, then it
will be automatically rechecked when Emacs becomes idle; the
-rechecking will be paused whenever there is input pending..
+rechecking will be paused whenever there is input pending.
By default, uses a vacuous schema that allows any well-formed XML
-document. A schema can be specified explictly using
+document. A schema can be specified explictly using
\\[rng-set-schema-file-and-validate], or implicitly based on the buffer's
file name or on the root element name. In each case the schema must
be a RELAX NG schema using the compact schema \(such schemas
(interactive (list (rng-read-type-id)))
(and (rng-set-document-type type-id)
(or rng-validate-mode (rng-validate-mode))))
-
+
(defun rng-auto-set-schema-and-validate ()
"Set the schema for this buffer automatically and turn on `rng-validate-mode'.
The schema is set like `rng-auto-set-schema'."
'mouse-1
'rng-mouse-first-error))))
(t " Valid")))
-
+
(defun rng-cancel-timers ()
(let ((inhibit-quit t))
(when rng-validate-timer
(when rng-validate-quick-timer
(cancel-timer rng-validate-quick-timer))
(kill-local-variable 'rng-validate-quick-timer)))
-
+
(defun rng-activate-timers ()
(unless rng-validate-timer
(let ((inhibit-quit t))
(defun rng-validate-done ()
(when (or (not (current-message))
(rng-current-message-from-error-overlay-p))
- (rng-error-overlay-message (or (rng-error-overlay-after (point))
+ (rng-error-overlay-message (or (rng-error-overlay-after (point))
(rng-error-overlay-after (1- (point))))))
(rng-cancel-timers)
(force-mode-line-update))
(defun rng-do-some-validation (&optional continue-p-function)
- "Do some validation work. Return t if more to do, nil otherwise."
+ "Do some validation work. Return t if more to do, nil otherwise."
(save-excursion
(save-restriction
(widen)
(set-marker rng-conditional-up-to-date-start
pos)))))))))
have-remaining-chars))
-
+
(defun rng-clear-conditional-region ()
(when rng-conditional-up-to-date-start
(set-marker rng-conditional-up-to-date-start nil)
(setq rng-message-overlay-current nil))
;;; Error navigation
-
+
(defun rng-maybe-echo-error-at-point ()
(when (or (not (current-message))
(rng-current-message-from-error-overlay-p))
(defun rng-next-error (arg)
"Go to the next validation error after point.
Turn on `rng-validate-mode' if it is not already on.
-A prefix ARG specifies how many errors to move. A negative ARG
-moves backwards. Just \\[universal-argument] as a prefix
+A prefix ARG specifies how many errors to move.
+A negative ARG moves backwards. Just \\[universal-argument] as a prefix
means goto the first error."
(interactive "P")
(if (consp arg)
(defun rng-previous-error (arg)
"Go to the previous validation error before point.
Turn on `rng-validate-mode' if it is not already on.
-A prefix ARG specifies how many errors to move. A negative ARG
-moves forwards. Just \\[universal-argument] as a prefix
+A prefix ARG specifies how many errors to move.
+A negative ARG moves forwards. Just \\[universal-argument] as a prefix
means goto the first error."
(interactive "P")
(if (consp arg)
(setq last-err err)
(setq pos (overlay-start err)))
(when (> arg 0)
- (setq pos (max pos (1- rng-validate-up-to-date-end)))
+ (setq pos (max pos (1- rng-validate-up-to-date-end)))
(when (< rng-validate-up-to-date-end (point-max))
(message "Parsing...")
(while (let ((more-to-do (rng-do-some-validation)))
(rng-goto-error-overlay last-err)
(message "No previous errors")
nil)))
-
+
(defun rng-goto-error-overlay (err)
"Goto the start of error overlay ERR and print its message."
(goto-char (overlay-start err))
(defun rng-process-start-tag (tag-type)
"TAG-TYPE is `start-tag' for a start-tag, `empty-element' for
-an empty element. partial-empty-element should be passed
+an empty element. `partial-empty-element' should be passed
as empty-element."
(and rng-collecting-text (rng-flush-text))
(setq rng-collecting-text nil)
(rng-name-to-string nm t)))
required-attributes
", "))))))
-
+
(defun rng-process-end-tag (&optional partial)
(cond ((not rng-open-elements)
(rng-mark-not-well-formed "Extra end-tag"
(defun rng-process-text (start end whitespace &optional value)
"Process characters between position START and END as text.
-END nil means point. WHITESPACE t means known to be whitespace, nil
+END nil means point. WHITESPACE t means known to be whitespace, nil
means known not to be, anything else means unknown whether whitespace
-or not. END must not be nil if WHITESPACE is neither t nor nil.
+or not. END must not be nil if WHITESPACE is neither t nor nil.
VALUE is a string or nil; nil means the value is equal to the
string between START and END."
(cond (rng-collecting-text
;;;###autoload
(defun rng-xsd-compile (name params)
- "Provides W3C XML Schema as a RELAX NG datatypes library. NAME is a
-symbol giving the local name of the datatype. PARAMS is a list of
-pairs (PARAM-NAME . PARAM-VALUE) where PARAM-NAME is a symbol giving
-the name of the parameter and PARAM-VALUE is a string giving its
-value. If NAME or PARAMS are invalid, it calls rng-dt-error passing
-it arguments in the same style as format; the value from rng-dt-error
-will be returned. Otherwise, it returns a list. The first member of
-the list is t if any string is a legal value for the datatype and nil
-otherwise. The second argument is a symbol; this symbol will be
-called as a function passing it a string followed by the remaining
-members of the list. The function must return an object representing
-the value of the datatype that was represented by the string, or nil
-if the string is not a representation of any value. The object
-returned can be any convenient non-nil value, provided that, if two
-strings represent the same value, the returned objects must be equal."
+ "Provides W3C XML Schema as a RELAX NG datatypes library.
+NAME is a symbol giving the local name of the datatype. PARAMS is a
+list of pairs (PARAM-NAME . PARAM-VALUE) where PARAM-NAME is a symbol
+giving the name of the parameter and PARAM-VALUE is a string giving
+its value. If NAME or PARAMS are invalid, it calls rng-dt-error
+passing it arguments in the same style as format; the value from
+rng-dt-error will be returned. Otherwise, it returns a list. The
+first member of the list is t if any string is a legal value for the
+datatype and nil otherwise. The second argument is a symbol; this
+symbol will be called as a function passing it a string followed by
+the remaining members of the list. The function must return an object
+representing the value of the datatype that was represented by the
+string, or nil if the string is not a representation of any value.
+The object returned can be any convenient non-nil value, provided
+that, if two strings represent the same value, the returned objects
+must be equal."
(let ((convert (get name 'rng-xsd-convert)))
(if (not convert)
(rng-dt-error "There is no XSD datatype named %s" name)
((memq param-name '(enumeration whiteSpace))
(rng-dt-error "Facet %s cannot be used in RELAX NG" param-name))
(t (rng-dt-error "Unknown facet %s" param-name))))))
-
+
(defun rng-xsd-string-to-non-negative-integer (str)
(and (rng-xsd-convert-integer str)
(let ((n (string-to-number str)))
(and (string-match regexp str)
(apply convert (cons str args))))
-
+
(defun rng-xsd-convert-boolean (string)
(and (string-match "\\`[ \t\n\r]*\\(?:\\(true\\|1\\)\\|false\\|0\\)[ \t\n\r]*\\'" string)
(if (match-beginning 1) 'true 'false)))
(defun rng-xsd-convert-decimal (string)
- "Convert a string representing a decimal to an object representing
-its values. A decimal value is represented by a vector [SIGN
-INTEGER-DIGITS FRACTION-DIGITS] where SIGN is 1 or -1, INTEGER-DIGITS
-is a string containing zero or more digits, with no leading zero, and
+ "Convert a string representing a decimal to an object representing it values.
+A decimal value is represented by a vector [SIGN INTEGER-DIGITS
+FRACTION-DIGITS] where SIGN is 1 or -1, INTEGER-DIGITS is a string
+containing zero or more digits, with no leading zero, and
FRACTION-DIGITS is a string containing zero or more digits with no
trailing digits. For example, -0021.0430 would be represented by [-1
\"21\" \"043\"]."
((match-beginning 3) -1.0e+INF)
;; Don't use a NaN float because we want NaN to be equal to NaN
((match-beginning 4) 'NaN)))
-
+
(defun rng-xsd-float< (f1 f2)
(and (not (eq f1 'NaN))
(not (eq f2 'NaN))
(< f1 f2)))
-
+
(defun rng-xsd-convert-token (string regexp)
(and (string-match regexp string)
(match-string 1 string)))
(B16 "[AEIMQUYcgkosw048]")
(B64 "[A-Za-z0-9+/]"))
(concat "\\`" S "\\(?:\\(?:" B64 S "\\)\\{4\\}\\)*"
- "\\(?:" B64 S B64 S B16 S "=" S
+ "\\(?:" B64 S B64 S B16 S "=" S
"\\|" B64 S B04 S "=" S "=" S "\\)?\\'")))
(defun rng-xsd-convert-base64-binary (string)
string))
(defun rng-xsd-make-date-time-regexp (template)
- "Returns a regular expression matching a ISO 8601 date/time. The
-template is a string with Y standing for years field, M standing for
-months, D standing for day of month, T standing for a literal T, t
+ "Returns a regular expression matching a ISO 8601 date/time.
+The template is a string with Y standing for years field, M standing
+for months, D standing for day of month, T standing for a literal T, t
standing for time and - standing for a literal hyphen. A time zone is
-always allowed at the end. Regardless of the fields appearing in the
+always allowed at the end. Regardless of the fields appearing in the
template, the regular expression will have twelve groups matching the
year sign, year, month, day of month, hours, minutes, integer seconds,
fractional seconds (including leading period), time zone, time zone
(aset v i total)
(setq i (1+ i)))
v))
-
+
(defun rng-xsd-convert-date-time (string regexp)
- "Converts an XML Schema date/time to a list. Returns nil if
-invalid. REGEXP is a regexp for parsing the date time as returned by
-`rng-xsd-make-date-time-regexp'. The list has 4 members (HAS-TIME-ZONE
-DAY SECOND SECOND-FRACTION), where HAS-TIME-ZONE is t or nil depending
-on whether a time zone was specified, DAY is an integer giving a day
-number (with Jan 1 1AD being day 1), SECOND is the second within that
-day, and SECOND-FRACTION is a float giving the fractional part of the
-second."
+ "Converts an XML Schema date/time to a list.
+Returns nil if invalid. REGEXP is a regexp for parsing the date time
+as returned by `rng-xsd-make-date-time-regexp'. The list has 4 members
+\(HAS-TIME-ZONE DAY SECOND SECOND-FRACTION), where HAS-TIME-ZONE is t
+or nil depending on whether a time zone was specified, DAY is an
+integer giving a day number (with Jan 1 1AD being day 1), SECOND is the
+second within that day, and SECOND-FRACTION is a float giving the
+fractional part of the second."
(and (string-match regexp string)
(let ((year-sign (match-string 1 string))
(year (match-string 2 string))
(setq numbers2 (cdr numbers2)))
(and numbers1
(< (car numbers1) (car numbers2))))
-
+
(defun rng-xsd-date-to-days (year month day)
"Return a unique day number where Jan 1 1 AD is day 1"
(if (> year 0) ; AD
(let ((start (match-beginning (+ i 2))))
(when start
(aset v i (* sign
- (string-to-number
+ (string-to-number
(substring string
start
(1- (match-end (+ i 2)))))))))
;; Force seconds to be float so that equal works properly.
(aset v 5 (float (aref v 5)))
v)))
-
+
(defconst rng-xsd-min-seconds-per-month (* 28 rng-xsd-seconds-per-day))
(defun rng-xsd-duration< (d1 d2)
(+ (* (/ months rng-xsd-months-per-gregorian-cycle)
rng-xsd-days-per-gregorian-cycle)
days)))
-
+
(defun rng-xsd-duration-months (d)
(+ (* (aref d 0) 12)
(aref d 1)))
(aref d 4))
60.0)
(aref d 5)))
-
+
(defun rng-xsd-convert-qname (string)
(and (string-match "\\`[ \r\n\t]*\\([_[:alpha:]][-._[:alnum:]]*\\(:[_[:alpha:]][-._[:alnum:]]*\\)?\\)[ \r\n\t]*\\'" string)
(let ((colon (match-beginning 2))
(match-end 1)))))
(cons (car context)
(match-string 1 string))))))
-
+
(defun rng-xsd-convert-list (string convert &rest args)
(let* ((tokens (split-string string "[ \t\n\r]+"))
(tem tokens))
(defun rng-xsd-def-integer-type (name min max)
(put name 'rng-xsd-less-than 'rng-xsd-decimal<)
(put name
- 'rng-xsd-convert
+ 'rng-xsd-convert
(cdr (rng-xsd-compile 'integer
(append (and min `((minInclusive . ,min)))
(and max `((maxInclusive . ,max))))))))
alist are well-formed \(e.g. because there's an external subset that
wasn't parsed).
-Each general entity name is a string. The definition is either nil, a
-symbol, a string, a cons cell. If the definition is nil, then it
+Each general entity name is a string. The definition is either nil,
+a symbol, a string, a cons cell. If the definition is nil, then it
means that it's an internal entity but the result of parsing it is
unknown. If it is a symbol, then the symbol is either `unparsed',
meaning the entity is an unparsed entity, `external', meaning the
entity includes one or more elements, or `not-well-formed', meaning
the replacement text is not well-formed. If the definition is a
string, then the replacement text of the entity is that string; this
-happens only during the parsing of the prolog. If the definition is a
-cons cell \(ER . AR), then ER specifies the string that results from
-referencing the entity in element content and AR is either nil,
+happens only during the parsing of the prolog. If the definition is
+a cons cell \(ER . AR), then ER specifies the string that results
+from referencing the entity in element content and AR is either nil,
meaning the replacement text included a <, or a string which is the
normalized attribute value.")
the start of the changed area in the region, the position of the end
of the changed area in the region, the length of the changed area
before the change, the position of the start of the region, the
-position of the end of the region. FUN must return non-nil if the
-region needs reparsing. FUN will be called in a save-excursion with
-match-data saved.
+position of the end of the region. FUN must return non-nil if the
+region needs reparsing. FUN will be called in a `save-excursion'
+with match-data saved.
`xmltok-forward', `xmltok-forward-special' and `xmltok-forward-prolog'
may add entries to the beginning of this list, but will not clear it.
(defsubst xmltok-attribute-raw-normalized-value (att)
"Return an object representing the normalized value of ATT.
-This can t indicating that the normalized value is the same as the
-buffer substring from the start to the end of the value or nil
+This can be t indicating that the normalized value is the same as
+the buffer substring from the start to the end of the value, or nil
indicating that the value is not well-formed or a string."
(aref att 5))
(defsubst xmltok-attribute-refs (att)
"Return a list of the entity and character references in ATT.
Each member is a vector [TYPE START END] where TYPE is either char-ref
-or entity-ref and START and END are integers giving the start and end
-of the reference. Nested entity references are not included in the list."
+or entity-ref and START and END are integers giving the start and end of
+the reference. Nested entity references are not included in the list."
(aref att 6))
(defun xmltok-attribute-prefix (att)
value-begin
value-end
raw-normalized-value)
- "Make an attribute. RAW-NORMALIZED-VALUE is nil if the value is
-not well-formed, t if the normalized value is the string between
-VALUE-BEGIN and VALUE-END, otherwise a STRING giving the value."
+ "Make an attribute.
+RAW-NORMALIZED-VALUE is nil if the value is not well-formed,
+t if the normalized value is the string between VALUE-BEGIN
+and VALUE-END, otherwise a STRING giving the value."
(vector name-begin
name-colon
name-end
"Scan forward past the first special token starting at or after point.
Return nil if there is no special token that starts before BOUND.
CDATA sections, processing instructions and comments (and indeed
-anything starting with < following by ? or !) count
-as special. Return the type of the token."
+anything starting with < following by ? or !) count as special.
+Return the type of the token."
(when (re-search-forward "<[?!]" (1+ bound) t)
(setq xmltok-start (match-beginning 0))
(goto-char (1+ xmltok-start))
(cons (concat "\\(" ,sym "\\)") (cons ',name nil))
(cons (concat "\\(" (car ,sym) "\\)") (cons ',name (cdr ,sym)))))))
- (defun xmltok-p (&rest r) (xmltok+ "\\(?:"
+ (defun xmltok-p (&rest r) (xmltok+ "\\(?:"
(apply 'xmltok+ r)
"\\)"))
(list 'match-string-no-properties
(xmltok-get-index group-name ',(cdr r))))
(t (error "Invalid action: %s" action))))))))
-
+
(eval-when-compile
(let* ((or "\\|")
(+ xmltok-start 2)
(+ xmltok-start 5))))
(setq xmltok-type 'processing-instruction))))
-
+
(defun xmltok-scan-after-comment-open ()
(setq xmltok-type
(cond ((not (search-forward "--" nil t))
(cons att xmltok-attributes)))
(and needs-normalizing
att)))
-
+
(defun xmltok-normalize-attribute (att)
(let ((end (xmltok-attribute-value-end att))
(well-formed t)
delimiter)))
(defun xmltok-valid-char-p (n)
- "Return non-nil if n is the Unicode code of a valid XML character."
+ "Return non-nil if N is the Unicode code of a valid XML character."
(cond ((< n #x20) (memq n '(#xA #xD #x9)))
((< n #xD800) t)
((< n #xE000) nil)
(defvar xmltok-had-param-entity-ref nil)
(defvar xmltok-prolog-regions nil)
(defvar xmltok-standalone nil
- "Non-nil if there was an XML declaration specifying standalone=\"yes\",")
+ "Non-nil if there was an XML declaration specifying standalone=\"yes\".")
(defvar xmltok-markup-declaration-doctype-flag nil)
(defconst xmltok-predefined-entity-alist
that type. TYPE can be one of xml-declaration,
xml-declaration-attribute-name, xml-declaration-attribute-value,
comment, processing-instruction-left, processing-instruction-right,
-markup-declaration-open. markup-declaration-close,
+markup-declaration-open, markup-declaration-close,
internal-subset-open, internal-subset-close, hash-name, keyword,
literal, encoding-name.
Adds to `xmltok-errors' and `xmltok-dependent-regions' as appropriate."
where START and END are the positions of the start and the end
of the encoding name; if there is no encoding declaration return
the position where and encoding declaration could be inserted.
-If there is XML that is not well-formed that looks like an XML declaration,
-return nil. Otherwise, return t.
+If there is XML that is not well-formed that looks like an XML
+declaration, return nil. Otherwise, return t.
If LIMIT is non-nil, then do not consider characters beyond LIMIT."
(cond ((let ((case-fold-search nil))
(and (looking-at (xmltok-xml-declaration regexp))
(+ (point) 5)))))
((not (let ((case-fold-search t))
(looking-at xmltok-bad-xml-decl-regexp))))))
-
+
(defun xmltok-scan-xml-declaration ()
(when (looking-at (xmltok-xml-declaration regexp))
(xmltok-add-prolog-region 'xml-declaration (point) (match-end 0))
(when (string= (xmltok-current-token-string) "#FIXED")
(xmltok-require-next-token 'literal))
t))))
-
+
(defun xmltok-parse-nmtoken-group ()
(while (progn
(xmltok-require-next-token 'nmtoken 'prefixed-name 'name)
'close-paren-star
'close-paren-occur)
(eq xmltok-type connector))))))
-
+
(defun xmltok-parse-model-group-member ()
(xmltok-require-token 'name
'prefixed-name
(when (eq xmltok-type ?\()
(xmltok-next-prolog-token)
(xmltok-parse-model-group)))
-
+
(defun xmltok-parse-entity-declaration ()
(let (paramp name)
(xmltok-require-next-token 'name ?%)
(not (assoc name xmltok-dtd)))
(setq xmltok-dtd
(cons (cons name value) xmltok-dtd))))
-
+
(defun xmltok-parse-entity-value ()
(let ((lim (1- (point)))
(well-formed t)
(apply 'concat
(nreverse (cons (buffer-substring-no-properties start lim)
value-parts))))))
-
+
(defun xmltok-parse-notation-declaration ()
(xmltok-require-next-token 'name)
(xmltok-require-next-token "SYSTEM" "PUBLIC")
(hash-name . hash-name)))))
((and (stringp required) (eq xmltok-type 'name))
'keyword)))
-
+
;; Return new token type.
-
+
(defun xmltok-next-prolog-token ()
(skip-chars-forward " \t\r\n")
(setq xmltok-start (point))
(unless (looking-at "[ \t\r\n>),|[%]")
(xmltok-add-error "Missing space after name token"))
(setq xmltok-type 'nmtoken))
- ((xmltok-prolog start name)
+ ((xmltok-prolog start name)
(setq xmltok-name-end (point))
(setq xmltok-name-colon nil)
(unless (looking-at "[ \t\r\n>),|[%]")
(xmltok-add-error "Missing space after name"))
(setq xmltok-type 'name))
- ((xmltok-prolog start hash-name)
+ ((xmltok-prolog start hash-name)
(setq xmltok-name-end (point))
(unless (looking-at "[ \t\r\n>)|%]")
(xmltok-add-error "Missing space after name"))
(while todo
(xmltok-parse-entity (car todo))
(setq todo (cdr todo)))))
-
+
(defun xmltok-parse-entity (name-def)
(let ((def (cdr name-def))
- ;; in case its value is buffer local
+ ;; in case its value is buffer local
(xmltok-dtd xmltok-dtd)
buf)
(when (stringp def)
'not-well-formed))
((eq def 'unparsed) 'not-well-formed)
(t def)))))
-
+
(defun xmltok-append-entity-def (d1 d2)
(cond ((consp d1)
(if (consp d2)
xmltok-prolog-regions)))
(defun xmltok-merge-attributes ()
- "Return a list merging `xmltok-attributes' and 'xmltok-namespace-attributes'.
+ "Return a list merging `xmltok-attributes' and `xmltok-namespace-attributes'.
The members of the merged list are in order of occurrence in the
document. The list may share list structure with `xmltok-attributes'
and `xmltok-namespace-attributes'."
(defun xsdre-translate (regexp)
"Translate a W3C XML Schema Datatypes regexp to an Emacs regexp.
-Returns a string. REGEXP is a string. If REGEXP is not a valid XSD
+Returns a string. REGEXP is a string. If REGEXP is not a valid XSD
regexp, signal an `xsdre-invalid-regexp' condition."
(xsdre-from-symbolic
(xsdre-to-symbolic regexp)))
canonical form, in which ranges are in increasing order, and adjacent
ranges are merged wherever possible."
(when list
- (setq list
+ (setq list
(sort list 'xsdre-range-less-than))
(let* ((next (cdr list))
(tail list)
(setcar tail (xsdre-make-range first last))
(setcdr tail nil)
list)))
-
+
(defun xsdre-range-list-union (range-lists)
- "Return a range-list the union of a list of range-lists."
+ "Return a range-list, the union of a list of range-lists."
(xsdre-make-range-list (apply 'append range-lists)))
(defun xsdre-range-list-difference (orig subtract)
(<= (xsdre-range-first (car subtract)) last))
(when (< first (xsdre-range-first (car subtract)))
(setq new
- (cons (xsdre-make-range
+ (cons (xsdre-make-range
first
(1- (xsdre-range-first (car subtract))))
new)))
(< (xsdre-range-last r1) (xsdre-range-last r2)))))
(defun xsdre-check-range-list (range-list)
- "Check that range-list is a range-list.
+ "Check that RANGE-LIST is a range-list.
Signal an error if it is not."
(let ((last nil))
(while range-list
(setq last (xsdre-range-last head)))
(setq range-list (cdr range-list))))
t)
-
+
;;; Compiling symbolic regexps to Emacs regexps
(defun xsdre-from-symbolic (re)
(xsdre-range-first (car ranges))))
(t (xsdre-range-list-to-char-alternative ranges)))))
accum))
-
+
(defun xsdre-compile-single-char (ch)
(if (memq ch '(?. ?* ?+ ?? ?\[ ?\] ?^ ?$ ?\\))
(string ?\\ ch)
(string (decode-char 'ucs ch))))
-
+
(defun xsdre-char-class-to-range-list (cc)
- "Return a range-list for a symbolic char-class."
+ "Return a range-list for a symbolic char-class CC."
(cond ((integerp cc) (list cc))
((symbolp cc)
(or (get cc 'xsdre-ranges)
(setq chars '(?- ?^ ?\])))
(setq chars (cons ?\[ chars))
(apply 'string chars)))
-
+
;;; Parsing
(defvar xsdre-current-regexp nil
- "List of characters remaining to be parsed. Dynamically bound.")
+ "List of characters remaining to be parsed. Dynamically bound.")
(defun xsdre-to-symbolic (str)
"Convert a W3C XML Schema datatypes regexp to a symbolic form.
(cons lower upper)))))
(t (xsdre-parse-error "Expected , or }")))))
(t nil))))
-
+
(defun xsdre-parse-bound ()
(let ((n 0))
(while (progn
(xsdre-advance)
(not (memq (car xsdre-current-regexp) '(?} ?,)))))
n))
-
+
(defun xsdre-try-parse-atom ()
(let ((ch (car xsdre-current-regexp)))
(t (if ch
(xsdre-parse-error "Missing char after \\")
(xsdre-parse-error "Bad escape %c" ch))))))
-
+
(defun xsdre-parse-prop ()
(xsdre-expect ?{)
(let ((name nil))
(if (eq (car xsdre-current-regexp) ch)
(xsdre-advance)
(xsdre-parse-error "Expected %c" ch)))
-
+
(defun xsdre-advance ()
(setq xsdre-current-regexp
(cdr xsdre-current-regexp)))
(put 'xsdre-parse-error
'error-message
"Internal error in parsing XSD regexp")
-
+
;;; Character class data
(put 'dot 'xsdre-char-class '(difference any (union #xA #xD)))
(goto-char start)
(down-list 2)
(while (condition-case err
- (progn
+ (progn
(forward-sexp)
t)
(error nil))
(xsdre-def-derived-category 'name-continue '(union name-initial
name-continue-not-initial))
-
-(xsdre-def-primitive-category
+
+(xsdre-def-primitive-category
'name-continue-not-initial
'((#x002d . #x002e)
(#x0030 . #x0039)
(976 . 977)
(981 . 983)
987 989 991 993 995 997 999 1001 1003 1005
-
+
(1007 . 1011)
1013
(1072 . 1119)
7877 7879 7881 7883 7885 7887 7889 7891 7893
7895 7897 7899 7901 7903 7905 7907 7909 7911
7913 7915 7917 7919 7921 7923 7925 7927 7929
-
+
(7936 . 7943)
(7952 . 7957)
(7968 . 7975)