summaryrefslogtreecommitdiff
path: root/lisp/nxml
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/nxml')
-rw-r--r--lisp/nxml/nxml-enc.el4
-rw-r--r--lisp/nxml/nxml-glyph.el423
-rw-r--r--lisp/nxml/nxml-maint.el44
-rw-r--r--lisp/nxml/nxml-mode.el347
-rw-r--r--lisp/nxml/nxml-outln.el28
-rw-r--r--lisp/nxml/nxml-parse.el2
-rw-r--r--lisp/nxml/nxml-rap.el129
-rw-r--r--lisp/nxml/nxml-uchnm.el251
-rw-r--r--lisp/nxml/nxml-util.el14
-rw-r--r--lisp/nxml/rng-cmpct.el10
-rw-r--r--lisp/nxml/rng-dt.el4
-rw-r--r--lisp/nxml/rng-loc.el15
-rw-r--r--lisp/nxml/rng-maint.el2
-rw-r--r--lisp/nxml/rng-match.el5
-rw-r--r--lisp/nxml/rng-nxml.el250
-rw-r--r--lisp/nxml/rng-parse.el2
-rw-r--r--lisp/nxml/rng-pttrn.el2
-rw-r--r--lisp/nxml/rng-uri.el2
-rw-r--r--lisp/nxml/rng-util.el63
-rw-r--r--lisp/nxml/rng-valid.el55
-rw-r--r--lisp/nxml/rng-xsd.el8
-rw-r--r--lisp/nxml/xmltok.el43
-rw-r--r--lisp/nxml/xsd-regexp.el6
23 files changed, 269 insertions, 1440 deletions
diff --git a/lisp/nxml/nxml-enc.el b/lisp/nxml/nxml-enc.el
index bcee0882aa2..6406f57ff63 100644
--- a/lisp/nxml/nxml-enc.el
+++ b/lisp/nxml/nxml-enc.el
@@ -1,4 +1,4 @@
-;;; nxml-enc.el --- XML encoding auto-detection
+;;; nxml-enc.el --- XML encoding auto-detection -*- lexical-binding:t -*-
;; Copyright (C) 2003, 2007-2016 Free Software Foundation, Inc.
@@ -68,7 +68,7 @@
(and nxml-non-xml-set-auto-coding-function
(funcall nxml-non-xml-set-auto-coding-function file-name size))))
-(defun nxml-set-xml-coding (file-name size)
+(defun nxml-set-xml-coding (_file-name size)
"Function to use as `set-auto-coding-function' when file is known to be XML."
(nxml-detect-coding-system (+ (point) (min size 1024))))
diff --git a/lisp/nxml/nxml-glyph.el b/lisp/nxml/nxml-glyph.el
deleted file mode 100644
index 4a518218c23..00000000000
--- a/lisp/nxml/nxml-glyph.el
+++ /dev/null
@@ -1,423 +0,0 @@
-;;; nxml-glyph.el --- glyph-handling for nxml-mode
-
-;; Copyright (C) 2003, 2007-2016 Free Software Foundation, Inc.
-
-;; Author: James Clark
-;; Keywords: wp, hypermedia, languages, XML
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; The entry point to this file is `nxml-glyph-display-string'.
-;; The current implementation is heuristic due to a lack of
-;; Emacs primitives necessary to implement it properly. The user
-;; can tweak the heuristics using `nxml-glyph-set-functions'.
-
-;;; Code:
-
-(defconst nxml-ascii-glyph-set
- [(#x0020 . #x007E)])
-
-(defconst nxml-latin1-glyph-set
- [(#x0020 . #x007E)
- (#x00A0 . #x00FF)])
-
-;; These were generated by using nxml-insert-target-repertoire-glyph-set
-;; on the TARGET[123] files in
-;; http://www.cl.cam.ac.uk/~mgk25/download/ucs-fonts.tar.gz
-
-(defconst nxml-misc-fixed-1-glyph-set
- [(#x0020 . #x007E)
- (#x00A0 . #x00FF)
- (#x0100 . #x017F)
- #x018F #x0192
- (#x0218 . #x021B)
- #x0259
- (#x02C6 . #x02C7)
- (#x02D8 . #x02DD)
- (#x0374 . #x0375)
- #x037A #x037E
- (#x0384 . #x038A)
- #x038C
- (#x038E . #x03A1)
- (#x03A3 . #x03CE)
- (#x0401 . #x040C)
- (#x040E . #x044F)
- (#x0451 . #x045C)
- (#x045E . #x045F)
- (#x0490 . #x0491)
- (#x05D0 . #x05EA)
- (#x1E02 . #x1E03)
- (#x1E0A . #x1E0B)
- (#x1E1E . #x1E1F)
- (#x1E40 . #x1E41)
- (#x1E56 . #x1E57)
- (#x1E60 . #x1E61)
- (#x1E6A . #x1E6B)
- (#x1E80 . #x1E85)
- (#x1EF2 . #x1EF3)
- (#x2010 . #x2022)
- #x2026 #x2030
- (#x2039 . #x203A)
- #x20AC #x2116 #x2122 #x2126
- (#x215B . #x215E)
- (#x2190 . #x2193)
- #x2260
- (#x2264 . #x2265)
- (#x23BA . #x23BD)
- (#x2409 . #x240D)
- #x2424 #x2500 #x2502 #x250C #x2510 #x2514 #x2518 #x251C #x2524 #x252C #x2534 #x253C #x2592 #x25C6 #x266A #xFFFD]
- "Glyph set for TARGET1 glyph repertoire of misc-fixed-* font.
-This repertoire is supported for the bold and oblique fonts.")
-
-(defconst nxml-misc-fixed-2-glyph-set
- [(#x0020 . #x007E)
- (#x00A0 . #x00FF)
- (#x0100 . #x017F)
- #x018F #x0192
- (#x01FA . #x01FF)
- (#x0218 . #x021B)
- #x0259
- (#x02C6 . #x02C7)
- #x02C9
- (#x02D8 . #x02DD)
- (#x0300 . #x0311)
- (#x0374 . #x0375)
- #x037A #x037E
- (#x0384 . #x038A)
- #x038C
- (#x038E . #x03A1)
- (#x03A3 . #x03CE)
- #x03D1
- (#x03D5 . #x03D6)
- #x03F1
- (#x0401 . #x040C)
- (#x040E . #x044F)
- (#x0451 . #x045C)
- (#x045E . #x045F)
- (#x0490 . #x0491)
- (#x05D0 . #x05EA)
- (#x1E02 . #x1E03)
- (#x1E0A . #x1E0B)
- (#x1E1E . #x1E1F)
- (#x1E40 . #x1E41)
- (#x1E56 . #x1E57)
- (#x1E60 . #x1E61)
- (#x1E6A . #x1E6B)
- (#x1E80 . #x1E85)
- (#x1EF2 . #x1EF3)
- (#x2010 . #x2022)
- #x2026 #x2030
- (#x2032 . #x2034)
- (#x2039 . #x203A)
- #x203C #x203E #x2044
- (#x2070 . #x2071)
- (#x2074 . #x208E)
- (#x20A3 . #x20A4)
- #x20A7 #x20AC
- (#x20D0 . #x20D7)
- #x2102 #x2105 #x2113
- (#x2115 . #x2116)
- #x211A #x211D #x2122 #x2124 #x2126 #x212E
- (#x215B . #x215E)
- (#x2190 . #x2195)
- (#x21A4 . #x21A8)
- (#x21D0 . #x21D5)
- (#x2200 . #x2209)
- (#x220B . #x220C)
- #x220F
- (#x2211 . #x2213)
- #x2215
- (#x2218 . #x221A)
- (#x221D . #x221F)
- #x2221
- (#x2224 . #x222B)
- #x222E #x223C #x2243 #x2245
- (#x2248 . #x2249)
- #x2259
- (#x225F . #x2262)
- (#x2264 . #x2265)
- (#x226A . #x226B)
- (#x2282 . #x228B)
- #x2295 #x2297
- (#x22A4 . #x22A7)
- (#x22C2 . #x22C3)
- #x22C5 #x2300 #x2302
- (#x2308 . #x230B)
- #x2310
- (#x2320 . #x2321)
- (#x2329 . #x232A)
- (#x23BA . #x23BD)
- (#x2409 . #x240D)
- #x2424 #x2500 #x2502 #x250C #x2510 #x2514 #x2518 #x251C #x2524 #x252C #x2534 #x253C
- (#x254C . #x2573)
- (#x2580 . #x25A1)
- (#x25AA . #x25AC)
- (#x25B2 . #x25B3)
- #x25BA #x25BC #x25C4 #x25C6
- (#x25CA . #x25CB)
- #x25CF
- (#x25D8 . #x25D9)
- #x25E6
- (#x263A . #x263C)
- #x2640 #x2642 #x2660 #x2663
- (#x2665 . #x2666)
- (#x266A . #x266B)
- (#xFB01 . #xFB02)
- #xFFFD]
- "Glyph set for TARGET2 glyph repertoire of the misc-fixed-* fonts.
-This repertoire is supported for the following fonts:
-5x7.bdf 5x8.bdf 6x9.bdf 6x10.bdf 6x12.bdf 7x13.bdf 7x14.bdf clR6x12.bdf")
-
-(defconst nxml-misc-fixed-3-glyph-set
- [(#x0020 . #x007E)
- (#x00A0 . #x00FF)
- (#x0100 . #x01FF)
- (#x0200 . #x0220)
- (#x0222 . #x0233)
- (#x0250 . #x02AD)
- (#x02B0 . #x02EE)
- (#x0300 . #x034F)
- (#x0360 . #x036F)
- (#x0374 . #x0375)
- #x037A #x037E
- (#x0384 . #x038A)
- #x038C
- (#x038E . #x03A1)
- (#x03A3 . #x03CE)
- (#x03D0 . #x03F6)
- (#x0400 . #x0486)
- (#x0488 . #x04CE)
- (#x04D0 . #x04F5)
- (#x04F8 . #x04F9)
- (#x0500 . #x050F)
- (#x0531 . #x0556)
- (#x0559 . #x055F)
- (#x0561 . #x0587)
- (#x0589 . #x058A)
- (#x05B0 . #x05B9)
- (#x05BB . #x05C4)
- (#x05D0 . #x05EA)
- (#x05F0 . #x05F4)
- (#x10D0 . #x10F8)
- #x10FB
- (#x1E00 . #x1E9B)
- (#x1EA0 . #x1EF9)
- (#x1F00 . #x1F15)
- (#x1F18 . #x1F1D)
- (#x1F20 . #x1F45)
- (#x1F48 . #x1F4D)
- (#x1F50 . #x1F57)
- #x1F59 #x1F5B #x1F5D
- (#x1F5F . #x1F7D)
- (#x1F80 . #x1FB4)
- (#x1FB6 . #x1FC4)
- (#x1FC6 . #x1FD3)
- (#x1FD6 . #x1FDB)
- (#x1FDD . #x1FEF)
- (#x1FF2 . #x1FF4)
- (#x1FF6 . #x1FFE)
- (#x2000 . #x200A)
- (#x2010 . #x2027)
- (#x202F . #x2052)
- #x2057
- (#x205F . #x2063)
- (#x2070 . #x2071)
- (#x2074 . #x208E)
- (#x20A0 . #x20B1)
- (#x20D0 . #x20EA)
- (#x2100 . #x213A)
- (#x213D . #x214B)
- (#x2153 . #x2183)
- (#x2190 . #x21FF)
- (#x2200 . #x22FF)
- (#x2300 . #x23CE)
- (#x2400 . #x2426)
- (#x2440 . #x244A)
- (#x2500 . #x25FF)
- (#x2600 . #x2613)
- (#x2616 . #x2617)
- (#x2619 . #x267D)
- (#x2680 . #x2689)
- (#x27E6 . #x27EB)
- (#x27F5 . #x27FF)
- (#x2A00 . #x2A06)
- #x2A1D #x2A3F #x303F
- (#xFB00 . #xFB06)
- (#xFB13 . #xFB17)
- (#xFB1D . #xFB36)
- (#xFB38 . #xFB3C)
- #xFB3E
- (#xFB40 . #xFB41)
- (#xFB43 . #xFB44)
- (#xFB46 . #xFB4F)
- (#xFE20 . #xFE23)
- (#xFF61 . #xFF9F)
- #xFFFD]
- "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)
- #x0192
- (#x01FA . #x01FF)
- (#x02C6 . #x02C7)
- #x02C9
- (#x02D8 . #x02DB)
- #x02DD
- (#x0384 . #x038A)
- #x038C
- (#x038E . #x03A1)
- (#x03A3 . #x03CE)
- (#x0401 . #x040C)
- (#x040E . #x044F)
- (#x0451 . #x045C)
- (#x045E . #x045F)
- (#x0490 . #x0491)
- (#x1E80 . #x1E85)
- (#x1EF2 . #x1EF3)
- (#x2013 . #x2015)
- (#x2017 . #x201E)
- (#x2020 . #x2022)
- #x2026 #x2030
- (#x2032 . #x2033)
- (#x2039 . #x203A)
- #x203C #x203E #x2044 #x207F
- (#x20A3 . #x20A4)
- #x20A7 #x20AC #x2105 #x2113 #x2116 #x2122 #x2126 #x212E
- (#x215B . #x215E)
- (#x2190 . #x2195)
- #x21A8 #x2202 #x2206 #x220F
- (#x2211 . #x2212)
- #x2215
- (#x2219 . #x221A)
- (#x221E . #x221F)
- #x2229 #x222B #x2248
- (#x2260 . #x2261)
- (#x2264 . #x2265)
- #x2302 #x2310
- (#x2320 . #x2321)
- #x2500 #x2502 #x250C #x2510 #x2514 #x2518 #x251C #x2524
- #x252C #x2534 #x253C
- (#x2550 . #x256C)
- #x2580 #x2584 #x2588 #x258C
- (#x2590 . #x2593)
- (#x25A0 . #x25A1)
- (#x25AA . #x25AC)
- #x25B2 #x25BA #x25BC #x25C4
- (#x25CA . #x25CB)
- #x25CF
- (#x25D8 . #x25D9)
- #x25E6
- (#x263A . #x263C)
- #x2640 #x2642 #x2660 #x2663
- (#x2665 . #x2666)
- (#x266A . #x266B)
- (#xFB01 . #xFB02)]
- "Glyph set corresponding to Windows Glyph List 4.")
-
-(defvar nxml-glyph-set-functions nil
- "Abnormal hook for determining the set of glyphs in a face.
-Each function in this hook is called in turn, unless one of them
-returns non-nil. Each function is called with 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 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-functions'.")
-
-(define-obsolete-variable-alias 'nxml-glyph-set-hook
- 'nxml-glyph-set-functions "24.3")
-
-(defvar nxml-glyph-set nil
- "Used by `nxml-glyph-set-functions' to return set of glyphs in a FACE.
-This should dynamically bound by any function that runs
-`nxml-glyph-set-functions'. The value must be either nil representing an
-empty set or a vector. Each member of the vector is either a single
-integer or a cons (FIRST . LAST) representing the range of integers
-from FIRST to LAST. An integer represents a glyph with that Unicode
-code-point. The vector must be ordered.")
-
-(defun nxml-x-set-glyph-set (face)
- (setq nxml-glyph-set
- (if (equal (face-attribute face :family) "misc-fixed")
- nxml-misc-fixed-3-glyph-set
- nxml-wgl4-glyph-set)))
-
-(defun nxml-w32-set-glyph-set (face)
- (setq nxml-glyph-set nxml-wgl4-glyph-set))
-
-(defun nxml-window-system-set-glyph-set (face)
- (setq nxml-glyph-set nxml-latin1-glyph-set))
-
-(defun nxml-terminal-set-glyph-set (face)
- (setq nxml-glyph-set nxml-ascii-glyph-set))
-
-(add-hook 'nxml-glyph-set-functions
- (or (cdr (assq window-system
- '((x . nxml-x-set-glyph-set)
- (w32 . nxml-w32-set-glyph-set)
- (nil . nxml-terminal-set-glyph-set))))
- 'nxml-window-system-set-glyph-set)
- t)
-
-;;;###autoload
-(defun nxml-glyph-display-string (n face)
- "Return a string that can display a glyph for Unicode code-point N.
-FACE gives the face that will be used for displaying the string.
-Return nil if the face cannot display a glyph for N."
- (let ((nxml-glyph-set nil))
- (run-hook-with-args-until-success 'nxml-glyph-set-functions face)
- (and nxml-glyph-set
- (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))
- found mid mid-val mid-start-val mid-end-val)
- (while (> end start)
- (setq mid (+ start
- (/ (- end start) 2)))
- (setq mid-val (aref v mid))
- (if (consp mid-val)
- (setq mid-start-val (car mid-val)
- mid-end-val (cdr mid-val))
- (setq mid-start-val mid-val
- mid-end-val mid-val))
- (cond ((and (<= mid-start-val n)
- (<= n mid-end-val))
- (setq found t)
- (setq start end))
- ((< n mid-start-val)
- (setq end mid))
- (t
- (setq start
- (if (eq start mid)
- end
- mid)))))
- found))
-
-(provide 'nxml-glyph)
-
-;;; nxml-glyph.el ends here
diff --git a/lisp/nxml/nxml-maint.el b/lisp/nxml/nxml-maint.el
index b81e3113efb..5d24d9b3138 100644
--- a/lisp/nxml/nxml-maint.el
+++ b/lisp/nxml/nxml-maint.el
@@ -1,4 +1,4 @@
-;;; nxml-maint.el --- commands for maintainers of nxml-*.el
+;;; nxml-maint.el --- commands for maintainers of nxml-*.el -*- lexical-binding:t -*-
;; Copyright (C) 2003, 2007-2016 Free Software Foundation, Inc.
@@ -24,48 +24,6 @@
;;; Code:
-;;; Generating files with Unicode char names.
-
-(require 'nxml-uchnm)
-
-(defun nxml-create-unicode-char-name-sets (file)
- "Generate files containing char names from Unicode standard."
- (interactive "fUnicodeData file: ")
- (mapc (lambda (block)
- (let ((nameset (nxml-unicode-block-char-name-set (nth 0 block))))
- (save-excursion
- (find-file (concat (get nameset 'nxml-char-name-set-file)
- ".el"))
- (erase-buffer)
- (insert "(nxml-define-char-name-set '")
- (prin1 nameset (current-buffer))
- (insert "\n '())\n")
- (goto-char (- (point) 3)))))
- nxml-unicode-blocks)
- (save-excursion
- (find-file file)
- (goto-char (point-min))
- (let ((blocks nxml-unicode-blocks)
- code name)
- (while (re-search-forward "^\\([0-9A-F]+\\);\\([^<;][^;]*\\);"
- nil
- t)
- (setq code (string-to-number (match-string 1) 16))
- (setq name (match-string 2))
- (while (and blocks
- (> code (nth 2 (car blocks))))
- (setq blocks (cdr blocks)))
- (when (and (<= (nth 1 (car blocks)) code)
- (<= code (nth 2 (car blocks))))
- (save-excursion
- (find-file (concat (get (nxml-unicode-block-char-name-set
- (nth 0 (car blocks)))
- 'nxml-char-name-set-file)
- ".el"))
- (insert "(")
- (prin1 name (current-buffer))
- (insert (format " #x%04X)\n " code))))))))
-
;;; Parsing target repertoire files from ucs-fonts.
;; This is for converting the TARGET? files in
;; http://www.cl.cam.ac.uk/~mgk25/download/ucs-fonts.tar.gz
diff --git a/lisp/nxml/nxml-mode.el b/lisp/nxml/nxml-mode.el
index 324350f591c..8c249d54073 100644
--- a/lisp/nxml/nxml-mode.el
+++ b/lisp/nxml/nxml-mode.el
@@ -26,14 +26,10 @@
;;; Code:
-(when (featurep 'mucs)
- (error "nxml-mode is not compatible with Mule-UCS"))
-
(eval-when-compile (require 'cl-lib))
(require 'xmltok)
(require 'nxml-enc)
-(require 'nxml-glyph)
(require 'nxml-util)
(require 'nxml-rap)
(require 'nxml-outln)
@@ -41,6 +37,7 @@
;; So we might as well just require it and silence the compiler.
(provide 'nxml-mode) ; avoid recursive require
(require 'rng-nxml)
+(require 'sgml-mode)
;;; Customization
@@ -55,9 +52,7 @@
(defcustom nxml-char-ref-display-glyph-flag t
"Non-nil means display glyph following character reference.
-The glyph is displayed in face `nxml-glyph'. The abnormal hook
-`nxml-glyph-set-functions' can be used to change the characters
-for which glyphs are displayed."
+The glyph is displayed in face `nxml-glyph'."
:group 'nxml
:type 'boolean)
@@ -153,16 +148,6 @@ This is not used directly, but only via inheritance by other faces."
"Face used to highlight text."
:group 'nxml-faces)
-(defface nxml-comment-content
- '((t (:inherit font-lock-comment-face)))
- "Face used to highlight the content of comments."
- :group 'nxml-faces)
-
-(defface nxml-comment-delimiter
- '((t (:inherit font-lock-comment-delimiter-face)))
- "Face used for the delimiters of comments, i.e., <!-- and -->."
- :group 'nxml-faces)
-
(defface nxml-processing-instruction-delimiter
'((t (:inherit nxml-delimiter)))
"Face used for the delimiters of processing instructions, i.e., <? and ?>."
@@ -280,15 +265,6 @@ This includes ths `x' in hex references."
"Face used for the delimiters of attribute values."
:group 'nxml-faces)
-(defface nxml-namespace-attribute-value
- '((t (:inherit nxml-attribute-value)))
- "Face used for the value of namespace attributes."
- :group 'nxml-faces)
-
-(defface nxml-namespace-attribute-value-delimiter
- '((t (:inherit nxml-attribute-value-delimiter)))
- "Face used for the delimiters of namespace attribute values."
- :group 'nxml-faces)
(defface nxml-prolog-literal-delimiter
'((t (:inherit nxml-delimited-data)))
@@ -342,22 +318,19 @@ The delimiters are <! and >."
;;; Global variables
-(defvar nxml-parent-document nil
+(defvar-local nxml-parent-document nil
"The parent document for a part of a modular document.
Use `nxml-parent-document-set' to set it.")
-(make-variable-buffer-local 'nxml-parent-document)
(put 'nxml-parent-document 'safe-local-variable 'stringp)
-(defvar nxml-prolog-regions nil
+(defvar-local nxml-prolog-regions nil
"List of regions in the prolog to be fontified.
See the function `xmltok-forward-prolog' for more information.")
-(make-variable-buffer-local 'nxml-prolog-regions)
-(defvar nxml-degraded nil
+(defvar-local nxml-degraded nil
"Non-nil if currently operating in degraded mode.
Degraded mode is enabled when an internal error is encountered in the
fontification or after-change functions.")
-(make-variable-buffer-local 'nxml-degraded)
(defvar nxml-completion-hook nil
"Hook run by `nxml-complete'.
@@ -375,13 +348,12 @@ one of the functions returns nil.")
(defvar nxml-end-tag-indent-scan-distance 4000
"Maximum distance from point to scan backwards when indenting end-tag.")
-(defvar nxml-char-ref-extra-display t
+(defvar-local nxml-char-ref-extra-display t
"Non-nil means display extra information for character references.
The extra information consists of a tooltip with the character name
and, if `nxml-char-ref-display-glyph-flag' is non-nil, a glyph
corresponding to the referenced character following the character
reference.")
-(make-variable-buffer-local 'nxml-char-ref-extra-display)
(defvar nxml-mode-map
(let ((map (make-sparse-keymap)))
@@ -415,7 +387,9 @@ reference.")
(defsubst nxml-set-face (start end face)
(when (and face (< start end))
- (font-lock-append-text-property start end 'face face)))
+ ;; Prepend, so the character reference highlighting takes precedence over
+ ;; the string highlighting applied syntactically.
+ (font-lock-prepend-text-property start end 'face face)))
(defun nxml-parent-document-set (parent-document)
"Set `nxml-parent-document' and inherit the DTD &c."
@@ -519,53 +493,39 @@ Many aspects this mode can be customized using
;; FIXME: Use the fact that we're parsing the document already
;; rather than using regex-based filtering.
(setq-local tildify-foreach-region-function
- (apply-partially 'tildify-foreach-ignore-environments
+ (apply-partially #'tildify-foreach-ignore-environments
'(("<! *--" . "-- *>") ("<" . ">"))))
- (set (make-local-variable 'mode-line-process) '((nxml-degraded "/degraded")))
+ (setq-local mode-line-process '((nxml-degraded "/degraded")))
;; We'll determine the fill prefix ourselves
- (make-local-variable 'adaptive-fill-mode)
- (setq adaptive-fill-mode nil)
- (make-local-variable 'forward-sexp-function)
- (setq forward-sexp-function 'nxml-forward-balanced-item)
- (make-local-variable 'indent-line-function)
- (setq indent-line-function 'nxml-indent-line)
- (make-local-variable 'fill-paragraph-function)
- (setq fill-paragraph-function 'nxml-do-fill-paragraph)
+ (setq-local adaptive-fill-mode nil)
+ (setq-local forward-sexp-function #'nxml-forward-balanced-item)
+ (setq-local indent-line-function #'nxml-indent-line)
+ (setq-local fill-paragraph-function #'nxml-do-fill-paragraph)
;; Comment support
;; This doesn't seem to work too well;
;; I think we should probably roll our own nxml-comment-dwim function.
- (make-local-variable 'comment-indent-function)
- (setq comment-indent-function 'nxml-indent-line)
- (make-local-variable 'comment-start)
- (setq comment-start "<!--")
- (make-local-variable 'comment-start-skip)
- (setq comment-start-skip "<!--[ \t\r\n]*")
- (make-local-variable 'comment-end)
- (setq comment-end "-->")
- (make-local-variable 'comment-end-skip)
- (setq comment-end-skip "[ \t\r\n]*-->")
- (make-local-variable 'comment-line-break-function)
- (setq comment-line-break-function 'nxml-newline-and-indent)
- (setq-local comment-quote-nested-function 'nxml-comment-quote-nested)
- (use-local-map nxml-mode-map)
+ (setq-local comment-indent-function #'nxml-indent-line)
+ (setq-local comment-start "<!--")
+ (setq-local comment-start-skip "<!--[ \t\r\n]*")
+ (setq-local comment-end "-->")
+ (setq-local comment-end-skip "[ \t\r\n]*-->")
+ (setq-local comment-line-break-function #'nxml-newline-and-indent)
+ (setq-local comment-quote-nested-function #'nxml-comment-quote-nested)
(save-excursion
(save-restriction
(widen)
- (setq nxml-scan-end (copy-marker (point-min) nil))
(with-silent-modifications
- (nxml-clear-inside (point-min) (point-max))
(nxml-with-invisible-motion
(nxml-scan-prolog)))))
- (add-hook 'completion-at-point-functions
- #'nxml-completion-at-point-function nil t)
- (setq-local syntax-propertize-function #'nxml-after-change)
- (add-hook 'change-major-mode-hook 'nxml-cleanup nil t)
+ (setq-local syntax-ppss-table sgml-tag-syntax-table)
+ (setq-local syntax-propertize-function sgml-syntax-propertize-function)
+ (add-hook 'change-major-mode-hook #'nxml-cleanup nil t)
;; Emacs 23 handles the encoding attribute on the xml declaration
;; transparently to nxml-mode, so there is no longer a need for the below
;; hook. The hook also had the drawback of overriding explicit user
;; instruction to save as some encoding other than utf-8.
- ;;(add-hook 'write-contents-hooks 'nxml-prepare-to-save)
+ ;;(add-hook 'write-contents-hooks #'nxml-prepare-to-save)
(when (not (and (buffer-file-name) (file-exists-p (buffer-file-name))))
(when (and nxml-default-buffer-file-coding-system
(not (local-variable-p 'buffer-file-coding-system)))
@@ -575,16 +535,14 @@ Many aspects this mode can be customized using
(setq font-lock-defaults
'(nxml-font-lock-keywords
- t ; keywords-only; we highlight comments and strings here
+ nil ; highlight comments and strings based on syntax-tables
nil ; font-lock-keywords-case-fold-search. XML is case sensitive
nil ; no special syntax table
- nil ; no automatic syntactic fontification
(font-lock-extend-region-functions . (nxml-extend-region))
(jit-lock-contextually . t)
(font-lock-unfontify-region-function . nxml-unfontify-region)))
- (rng-nxml-mode-init)
- (nxml-enable-unicode-char-name-sets))
+ (with-demoted-errors (rng-nxml-mode-init)))
(defun nxml-cleanup ()
"Clean up after nxml-mode."
@@ -596,7 +554,7 @@ Many aspects this mode can be customized using
(with-silent-modifications
(nxml-with-invisible-motion
(remove-text-properties (point-min) (point-max) '(face)))))
- (remove-hook 'change-major-mode-hook 'nxml-cleanup t))
+ (remove-hook 'change-major-mode-hook #'nxml-cleanup t))
(defun nxml-degrade (context err)
(message "Internal nXML mode error in %s (%s), degrading"
@@ -604,12 +562,7 @@ Many aspects this mode can be customized using
(error-message-string err))
(ding)
(setq nxml-degraded t)
- (setq nxml-prolog-end 1)
- (save-excursion
- (save-restriction
- (widen)
- (with-silent-modifications
- (nxml-clear-inside (point-min) (point-max))))))
+ (setq nxml-prolog-end 1))
;;; Change management
@@ -622,41 +575,6 @@ Many aspects this mode can be customized using
(goto-char font-lock-beg)
(set-mark font-lock-end)))
-(defun nxml-after-change (start end)
- ;; Called via syntax-propertize-function.
- (unless nxml-degraded
- (nxml-with-degradation-on-error 'nxml-after-change
- (save-restriction
- (widen)
- (nxml-with-invisible-motion
- (nxml-after-change1 start end))))))
-
-(defun nxml-after-change1 (start end)
- "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."
- ;; If the prolog might have changed, rescan the prolog.
- (when (<= start
- ;; Add 2 so as to include the < and following char that
- ;; start the instance (document element), since changing
- ;; these can change where the prolog ends.
- (+ nxml-prolog-end 2))
- (nxml-scan-prolog)
- (setq start (point-min)))
-
- (when (> end nxml-prolog-end)
- (goto-char start)
- (nxml-move-tag-backwards (point-min))
- (setq start (point))
- (setq end (max (nxml-scan-after-change start end)
- end)))
-
- (nxml-debug-change "nxml-after-change1" start end))
-
;;; Encodings
(defun nxml-insert-xml-declaration ()
@@ -982,11 +900,11 @@ faces appropriately."
[1 -1 nxml-entity-ref-name]
[-1 nil nxml-entity-ref-delimiter]))
-(put 'comment
- 'nxml-fontify-rule
- '([nil 4 nxml-comment-delimiter]
- [4 -3 nxml-comment-content]
- [-3 nil nxml-comment-delimiter]))
+;; (put 'comment
+;; 'nxml-fontify-rule
+;; '([nil 4 nxml-comment-delimiter]
+;; [4 -3 nxml-comment-content]
+;; [-3 nil nxml-comment-delimiter]))
(put 'processing-instruction
'nxml-fontify-rule
@@ -1018,7 +936,7 @@ faces appropriately."
'nxml-fontify-rule
'([nil nil nxml-attribute-local-name]))
-(put 'xml-declaration-attribute-value
+(put 'xml-declaration-attribute-value ;FIXME: What is this for?
'nxml-fontify-rule
'([nil 1 nxml-attribute-value-delimiter]
[1 -1 nxml-attribute-value]
@@ -1137,28 +1055,11 @@ faces appropriately."
'nxml-attribute-prefix
'nxml-attribute-colon
'nxml-attribute-local-name))
- (let ((start (xmltok-attribute-value-start att))
- (end (xmltok-attribute-value-end att))
- (refs (xmltok-attribute-refs att))
- (delimiter-face (if namespace-declaration
- 'nxml-namespace-attribute-value-delimiter
- 'nxml-attribute-value-delimiter))
- (value-face (if namespace-declaration
- 'nxml-namespace-attribute-value
- 'nxml-attribute-value)))
- (when start
- (nxml-set-face (1- start) start delimiter-face)
- (nxml-set-face end (1+ end) delimiter-face)
- (while refs
- (let* ((ref (car refs))
- (ref-type (aref ref 0))
- (ref-start (aref ref 1))
- (ref-end (aref ref 2)))
- (nxml-set-face start ref-start value-face)
- (nxml-apply-fontify-rule ref-type ref-start ref-end)
- (setq start ref-end))
- (setq refs (cdr refs)))
- (nxml-set-face start end value-face))))
+ (dolist (ref (xmltok-attribute-refs att))
+ (let* ((ref-type (aref ref 0))
+ (ref-start (aref ref 1))
+ (ref-end (aref ref 2)))
+ (nxml-apply-fontify-rule ref-type ref-start ref-end))))
(defun nxml-fontify-qname (start
colon
@@ -1599,30 +1500,7 @@ of the line. This expects the xmltok-* variables to be set up as by
(t (back-to-indentation)))
(current-column))
-;;; Completion
-
-(defun nxml-complete ()
- "Perform completion on the symbol preceding point.
-
-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
-follow the symbol are also inserted.
-
-The name space used for completion and what is treated as a symbol
-depends on the context. The contexts in which completion is performed
-depend on `nxml-completion-hook'."
- (interactive)
- (unless (run-hook-with-args-until-success 'nxml-completion-hook)
- ;; Eventually we will complete on entity names here.
- (ding)
- (message "Cannot complete in this context")))
-
-(defun nxml-completion-at-point-function ()
- "Call `nxml-complete' to perform completion at point."
- (when nxml-bind-meta-tab-to-complete-flag
- #'nxml-complete))
+(define-obsolete-function-alias 'nxml-complete #'completion-at-point "26.1")
;;; Movement
@@ -1643,7 +1521,7 @@ 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
single name. A character reference contains a character number."
- (interactive "p")
+ (interactive "^p")
(or arg (setq arg 1))
(cond ((> arg 0)
(while (progn
@@ -1674,7 +1552,7 @@ single name. A character reference contains a character number."
(t end)))))
(nxml-scan-error
(goto-char (cadr err))
- (apply 'error (cddr err)))))
+ (apply #'error (cddr err)))))
(defun nxml-backward-single-balanced-item ()
(condition-case err
@@ -1696,7 +1574,7 @@ single name. A character reference contains a character number."
(t xmltok-start)))))
(nxml-scan-error
(goto-char (cadr err))
- (apply 'error (cddr err)))))
+ (apply #'error (cddr err)))))
(defun nxml-scan-forward-within (end)
(setq end (- end (nxml-end-delimiter-length xmltok-type)))
@@ -1855,7 +1733,7 @@ single name. A character reference contains a character number."
ret))
(defun nxml-up-element (&optional arg)
- (interactive "p")
+ (interactive "^p")
(or arg (setq arg 1))
(if (< arg 0)
(nxml-backward-up-element (- arg))
@@ -1880,10 +1758,10 @@ single name. A character reference contains a character number."
(setq arg (1- arg)))
(nxml-scan-error
(goto-char (cadr err))
- (apply 'error (cddr err))))))
+ (apply #'error (cddr err))))))
(defun nxml-backward-up-element (&optional arg)
- (interactive "p")
+ (interactive "^p")
(or arg (setq arg 1))
(if (< arg 0)
(nxml-up-element (- arg))
@@ -1909,13 +1787,13 @@ single name. A character reference contains a character number."
(setq arg (1- arg)))
(nxml-scan-error
(goto-char (cadr err))
- (apply 'error (cddr err))))))
+ (apply #'error (cddr err))))))
(defun nxml-down-element (&optional arg)
"Move forward down into the content of an element.
With ARG, do this that many times.
Negative ARG means move backward but still down."
- (interactive "p")
+ (interactive "^p")
(or arg (setq arg 1))
(if (< arg 0)
(nxml-backward-down-element (- arg))
@@ -1933,7 +1811,7 @@ Negative ARG means move backward but still down."
(setq arg (1- arg)))))
(defun nxml-backward-down-element (&optional arg)
- (interactive "p")
+ (interactive "^p")
(or arg (setq arg 1))
(if (< arg 0)
(nxml-down-element (- arg))
@@ -1961,7 +1839,7 @@ Negative ARG means move backward but still down."
"Move forward over one element.
With ARG, do it that many times.
Negative ARG means move backward."
- (interactive "p")
+ (interactive "^p")
(or arg (setq arg 1))
(if (< arg 0)
(nxml-backward-element (- arg))
@@ -1974,13 +1852,13 @@ Negative ARG means move backward."
(setq arg (1- arg)))
(nxml-scan-error
(goto-char (cadr err))
- (apply 'error (cddr err))))))
+ (apply #'error (cddr err))))))
(defun nxml-backward-element (&optional arg)
"Move backward over one element.
With ARG, do it that many times.
Negative ARG means move forward."
- (interactive "p")
+ (interactive "^p")
(or arg (setq arg 1))
(if (< arg 0)
(nxml-forward-element (- arg))
@@ -1996,7 +1874,7 @@ Negative ARG means move forward."
(setq arg (1- arg)))
(nxml-scan-error
(goto-char (cadr err))
- (apply 'error (cddr err))))))
+ (apply #'error (cddr err))))))
(defun nxml-mark-token-after ()
(interactive)
@@ -2015,7 +1893,7 @@ The paragraph marked is the one that contains point or follows point."
(nxml-backward-paragraph))
(defun nxml-forward-paragraph (&optional arg)
- (interactive "p")
+ (interactive "^p")
(or arg (setq arg 1))
(cond ((< arg 0)
(nxml-backward-paragraph (- arg)))
@@ -2025,7 +1903,7 @@ The paragraph marked is the one that contains point or follows point."
(> (setq arg (1- arg)) 0))))))
(defun nxml-backward-paragraph (&optional arg)
- (interactive "p")
+ (interactive "^p")
(or arg (setq arg 1))
(cond ((< arg 0)
(nxml-forward-paragraph (- arg)))
@@ -2477,116 +2355,15 @@ and attempts to find another possible way to do the markup."
;;; Character names
-(defvar nxml-char-name-ignore-case t)
-
-(defvar nxml-char-name-alist nil
- "Alist of character names.
-Each member of the list has the form (NAME CODE . NAMESET),
-where NAME is a string naming a character, NAMESET is a symbol
-identifying a set of names and CODE is an integer specifying the
-Unicode scalar value of the named character.
-The NAME will only be used for completion if NAMESET has
-a non-nil `nxml-char-name-set-enabled' property.
-If NAMESET does does not have `nxml-char-name-set-defined' property,
-then it must have a `nxml-char-name-set-file' property and `load'
-will be applied to the value of this property if the nameset
-is enabled.")
-
-(defvar nxml-char-name-table (make-hash-table :test 'eq)
- "Hash table for mapping char codes to names.
-Each key is a Unicode scalar value.
-Each value is a list of pairs of the form (NAMESET . NAME),
-where NAMESET is a symbol identifying a set of names,
-and NAME is a string naming a character.")
-
-(defvar nxml-autoload-char-name-set-list nil
- "List of char namesets that can be autoloaded.")
-
-(defun nxml-enable-char-name-set (nameset)
- (put nameset 'nxml-char-name-set-enabled t))
-
-(defun nxml-disable-char-name-set (nameset)
- (put nameset 'nxml-char-name-set-enabled nil))
-
-(defun nxml-char-name-set-enabled-p (nameset)
- (get nameset 'nxml-char-name-set-enabled))
-
-(defun nxml-autoload-char-name-set (nameset file)
- (unless (memq nameset nxml-autoload-char-name-set-list)
- (setq nxml-autoload-char-name-set-list
- (cons nameset nxml-autoload-char-name-set-list)))
- (put nameset 'nxml-char-name-set-file file))
-
-(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."
- (when (get nameset 'nxml-char-name-set-defined)
- (error "Nameset `%s' already defined" nameset))
- (let ((iter alist))
- (while iter
- (let* ((name-code (car iter))
- (name (car name-code))
- (code (cadr name-code)))
- (puthash code
- (cons (cons nameset name)
- (gethash code nxml-char-name-table))
- nxml-char-name-table))
- (setcdr (cdr (car iter)) nameset)
- (setq iter (cdr iter))))
- (setq nxml-char-name-alist
- (nconc alist nxml-char-name-alist))
- (put nameset 'nxml-char-name-set-defined t))
-
-(defun nxml-get-char-name (code)
- (mapc 'nxml-maybe-load-char-name-set nxml-autoload-char-name-set-list)
- (let ((names (gethash code nxml-char-name-table))
- name)
- (while (and names (not name))
- (if (nxml-char-name-set-enabled-p (caar names))
- (setq name (cdar names))
- (setq names (cdr names))))
- name))
-
-(defvar nxml-named-char-history nil)
-
(defun nxml-insert-named-char (arg)
"Insert a character using its name.
The name is read from the minibuffer.
Normally, inserts the character as a numeric character reference.
With a prefix argument, inserts the character directly."
(interactive "*P")
- (mapc 'nxml-maybe-load-char-name-set nxml-autoload-char-name-set-list)
- (let ((name
- (let ((completion-ignore-case nxml-char-name-ignore-case))
- (completing-read "Character name: "
- nxml-char-name-alist
- (lambda (member)
- (get (cddr member) 'nxml-char-name-set-enabled))
- t
- nil
- 'nxml-named-char-history)))
- (alist nxml-char-name-alist)
- elt code)
- (while (and alist (not code))
- (setq elt (assoc name alist))
- (if (get (cddr elt) 'nxml-char-name-set-enabled)
- (setq code (cadr elt))
- (setq alist (cdr (member elt alist)))))
+ (let ((code (read-char-by-name "Character name: ")))
(when code
- (insert (if arg
- (or (decode-char 'ucs code)
- (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))
- (stringp (get sym 'nxml-char-name-set-file)))
- (load (get sym 'nxml-char-name-set-file))))
+ (insert (if arg code (format "&#x%X;" code))))))
(defun nxml-toggle-char-ref-extra-display (arg)
"Toggle the display of extra information for character references."
@@ -2602,9 +2379,11 @@ With a prefix argument, inserts the character directly."
(defun nxml-char-ref-display-extra (start end n)
(when nxml-char-ref-extra-display
- (let ((name (nxml-get-char-name n))
+ (let ((name (or (get-char-code-property n 'name)
+ (get-char-code-property n 'old-name)))
(glyph-string (and nxml-char-ref-display-glyph-flag
- (nxml-glyph-display-string n 'nxml-glyph)))
+ (char-displayable-p n)
+ (string n)))
ov)
(when (or name glyph-string)
(setq ov (make-overlay start end nil t))
diff --git a/lisp/nxml/nxml-outln.el b/lisp/nxml/nxml-outln.el
index 962160cb435..289816a1bba 100644
--- a/lisp/nxml/nxml-outln.el
+++ b/lisp/nxml/nxml-outln.el
@@ -1,4 +1,4 @@
-;;; nxml-outln.el --- outline support for nXML mode
+;;; nxml-outln.el --- outline support for nXML mode -*- lexical-binding:t -*-
;; Copyright (C) 2004, 2007-2016 Free Software Foundation, Inc.
@@ -248,6 +248,16 @@ customize which elements are recognized as sections and headings."
(interactive)
(nxml-transform-subtree-outline '((hide-children . t))))
+;; These variables are dynamically bound. They are use to pass information to
+;; nxml-section-tag-transform-outline-state.
+
+(defvar nxml-outline-state-transform-exceptions nil)
+(defvar nxml-target-section-pos nil)
+(defvar nxml-depth-in-target-section nil)
+(defvar nxml-outline-state-transform-alist nil)
+
+(defvar nxml-outline-display-section-tag-function nil)
+
(defun nxml-hide-other ()
"Hide text content other than that directly in the section containing point.
Hide headings other than those of ancestors of that section and their
@@ -275,14 +285,6 @@ customize which elements are recognized as sections and headings."
(nxml-transform-buffer-outline '((nil . hide-children)
(t . hide-children)))))
-;; These variables are dynamically bound. They are use to pass information to
-;; nxml-section-tag-transform-outline-state.
-
-(defvar nxml-outline-state-transform-exceptions nil)
-(defvar nxml-target-section-pos nil)
-(defvar nxml-depth-in-target-section nil)
-(defvar nxml-outline-state-transform-alist nil)
-
(defun nxml-transform-buffer-outline (alist)
(let ((nxml-target-section-pos nil)
(nxml-depth-in-target-section 0)
@@ -350,7 +352,7 @@ customize which elements are recognized as sections and headings."
(defun nxml-section-tag-transform-outline-state (startp
section-start-pos
&optional
- heading-start-pos)
+ _heading-start-pos)
(if (not startp)
(setq nxml-depth-in-target-section
(and nxml-depth-in-target-section
@@ -427,8 +429,6 @@ customize which elements are recognized as sections and headings."
(nxml-outline-error
(nxml-report-outline-error "Cannot display outline: %s" err)))))
-(defvar nxml-outline-display-section-tag-function nil)
-
(defun nxml-outline-display-rest (outline-state start-tag-indent tag-qnames)
"Display up to and including the end of the current element.
OUTLINE-STATE can be nil, t, hide-children. START-TAG-INDENT is the
@@ -789,7 +789,7 @@ no new overlay will be created."
(defun nxml-end-of-heading ()
"Move from the start of the content of the heading to the end.
Do not move past the end of the line."
- (let ((pos (condition-case err
+ (let ((pos (condition-case nil
(and (nxml-scan-element-forward (point) t)
xmltok-start)
(nxml-scan-error nil))))
@@ -888,7 +888,7 @@ Point is at the end of the tag. `xmltok-start' is the start."
(nxml-ensure-scan-up-to-date)
(let ((pos (nxml-inside-start (point))))
(when pos
- (goto-char (1- pos))
+ (goto-char pos)
t))))
((progn
(xmltok-forward)
diff --git a/lisp/nxml/nxml-parse.el b/lisp/nxml/nxml-parse.el
index 41b2e8ee513..edf012921a9 100644
--- a/lisp/nxml/nxml-parse.el
+++ b/lisp/nxml/nxml-parse.el
@@ -1,4 +1,4 @@
-;;; nxml-parse.el --- XML parser, sharing infrastructure with nxml-mode
+;;; nxml-parse.el --- XML parser, sharing infrastructure with nxml-mode -*- lexical-binding:t -*-
;; Copyright (C) 2003, 2007-2016 Free Software Foundation, Inc.
diff --git a/lisp/nxml/nxml-rap.el b/lisp/nxml/nxml-rap.el
index 47b23da62ad..e66289d042a 100644
--- a/lisp/nxml/nxml-rap.el
+++ b/lisp/nxml/nxml-rap.el
@@ -1,4 +1,4 @@
-;;; nxml-rap.el --- low-level support for random access parsing for nXML mode
+;;; nxml-rap.el --- low-level support for random access parsing for nXML mode -*- lexical-binding:t -*-
;; Copyright (C) 2003-2004, 2007-2016 Free Software Foundation, Inc.
@@ -46,8 +46,7 @@
;; look like it scales to large numbers of overlays in a buffer.
;;
;; We don't in fact track all these constructs, but only track them in
-;; some initial part of the instance. The variable `nxml-scan-end'
-;; contains the limit of where we have scanned up to for them.
+;; some initial part of the instance.
;;
;; Thus to parse some random point in the file we first ensure that we
;; have scanned up to that point. Then we search backwards for a
@@ -74,93 +73,33 @@
(require 'xmltok)
(require 'nxml-util)
+(require 'sgml-mode)
-(defvar nxml-prolog-end nil
+(defvar-local nxml-prolog-end nil
"Integer giving position following end of the prolog.")
-(make-variable-buffer-local 'nxml-prolog-end)
-
-(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 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
-unclosed constructs starting before 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)
- (get-text-property pos 'nxml-inside))
-
-(defsubst nxml-clear-inside (start end)
- (nxml-debug-clear-inside start end)
- (remove-text-properties start end '(nxml-inside nil)))
-
-(defsubst nxml-set-inside (start end type)
- (nxml-debug-set-inside start end)
- (put-text-property start end 'nxml-inside type))
+ (save-excursion (nth 8 (syntax-ppss pos))))
(defun nxml-inside-end (pos)
"Return the end of the inside region containing POS.
Return nil if the character at POS is not inside."
- (if (nxml-get-inside pos)
- (or (next-single-property-change pos 'nxml-inside)
- (point-max))
- nil))
+ (save-excursion
+ (let ((ppss (syntax-ppss pos)))
+ (when (nth 8 ppss)
+ (goto-char (nth 8 ppss))
+ (with-syntax-table sgml-tag-syntax-table
+ (if (nth 3 ppss)
+ (progn (forward-comment 1) (point))
+ (or (scan-sexps (point) 1) (point-max))))))))
(defun nxml-inside-start (pos)
"Return the start of the inside region containing POS.
Return nil if the character at POS is not inside."
- (if (nxml-get-inside pos)
- (or (previous-single-property-change (1+ pos) 'nxml-inside)
- (point-min))
- nil))
+ (save-excursion (nth 8 (syntax-ppss pos))))
;;; Change management
-(defun nxml-scan-after-change (start end)
- "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
-any “inside” regions and at the beginning of a token."
- (if (>= start nxml-scan-end)
- nxml-scan-end
- (let ((inside-remove-start start)
- xmltok-errors)
- (while (or (when (xmltok-forward-special (min end nxml-scan-end))
- (when (memq xmltok-type
- '(comment
- cdata-section
- processing-instruction))
- (nxml-clear-inside inside-remove-start
- (1+ xmltok-start))
- (nxml-set-inside (1+ xmltok-start)
- (point)
- xmltok-type)
- (setq inside-remove-start (point)))
- (if (< (point) (min end nxml-scan-end))
- t
- (setq end (point))
- nil))
- ;; The end of the change was inside but is now outside.
- ;; Imagine something really weird like
- ;; <![CDATA[foo <!-- bar ]]> <![CDATA[ stuff --> <!-- ]]> -->
- ;; and suppose we deleted "<![CDATA[f"
- (let ((inside-end (nxml-inside-end end)))
- (when inside-end
- (setq end inside-end)
- t))))
- (nxml-clear-inside inside-remove-start end))
- (when (> end nxml-scan-end)
- (set-marker nxml-scan-end end))
- end))
-
;; n-s-p only called from nxml-mode.el, where this variable is defined.
(defvar nxml-prolog-regions)
@@ -169,10 +108,7 @@ any “inside” regions and at the beginning of a token."
(let (xmltok-dtd
xmltok-errors)
(setq nxml-prolog-regions (xmltok-forward-prolog))
- (setq nxml-prolog-end (point))
- (nxml-clear-inside (point-min) nxml-prolog-end))
- (when (< nxml-scan-end nxml-prolog-end)
- (set-marker nxml-scan-end nxml-prolog-end)))
+ (setq nxml-prolog-end (point))))
;;; Random access parsing
@@ -223,14 +159,7 @@ Sets variables like `nxml-token-after'."
(defun nxml-tokenize-forward ()
(let (xmltok-errors)
- (when (and (xmltok-forward)
- (> (point) nxml-scan-end))
- (cond ((memq xmltok-type '(comment
- cdata-section
- processing-instruction))
- (with-silent-modifications
- (nxml-set-inside (1+ xmltok-start) (point) xmltok-type))))
- (set-marker nxml-scan-end (point)))
+ (xmltok-forward)
xmltok-type))
(defun nxml-move-tag-backwards (bound)
@@ -253,32 +182,12 @@ As a precondition, point must be >= BOUND."
Leave point unmoved if it is not inside anything special."
(let ((start (nxml-inside-start (point))))
(when start
- (goto-char (1- start))
+ (goto-char start)
(when (nxml-get-inside (point))
- (error "Char before inside-start at %s had nxml-inside property %s"
- (point)
- (nxml-get-inside (point)))))))
+ (error "Char before inside-start at %s is still \"inside\"" (point))))))
(defun nxml-ensure-scan-up-to-date ()
- (let ((pos (point)))
- (when (< nxml-scan-end pos)
- (save-excursion
- (goto-char nxml-scan-end)
- (let (xmltok-errors)
- (while (when (xmltok-forward-special pos)
- (when (memq xmltok-type
- '(comment
- processing-instruction
- cdata-section))
- (with-silent-modifications
- (nxml-set-inside (1+ xmltok-start)
- (point)
- xmltok-type)))
- (if (< (point) pos)
- t
- (setq pos (point))
- nil)))
- (set-marker nxml-scan-end pos))))))
+ (syntax-propertize (point)))
;;; Element scanning
diff --git a/lisp/nxml/nxml-uchnm.el b/lisp/nxml/nxml-uchnm.el
deleted file mode 100644
index 7d7d785f152..00000000000
--- a/lisp/nxml/nxml-uchnm.el
+++ /dev/null
@@ -1,251 +0,0 @@
-;;; nxml-uchnm.el --- support for Unicode standard cha names in nxml-mode
-
-;; Copyright (C) 2003, 2007-2016 Free Software Foundation, Inc.
-
-;; Author: James Clark
-;; Keywords: wp, hypermedia, languages, XML
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; This enables the use of the character names defined in the Unicode
-;; Standard. The use of the names can be controlled on a per-block
-;; basis, so as both to reduce memory usage and loading time,
-;; and to make completion work better.
-
-;;; Code:
-
-(require 'nxml-mode)
-
-(defconst nxml-unicode-blocks
- '(("Basic Latin" #x0000 #x007F)
- ("Latin-1 Supplement" #x0080 #x00FF)
- ("Latin Extended-A" #x0100 #x017F)
- ("Latin Extended-B" #x0180 #x024F)
- ("IPA Extensions" #x0250 #x02AF)
- ("Spacing Modifier Letters" #x02B0 #x02FF)
- ("Combining Diacritical Marks" #x0300 #x036F)
- ("Greek and Coptic" #x0370 #x03FF)
- ("Cyrillic" #x0400 #x04FF)
- ("Cyrillic Supplementary" #x0500 #x052F)
- ("Armenian" #x0530 #x058F)
- ("Hebrew" #x0590 #x05FF)
- ("Arabic" #x0600 #x06FF)
- ("Syriac" #x0700 #x074F)
- ("Thaana" #x0780 #x07BF)
- ("Devanagari" #x0900 #x097F)
- ("Bengali" #x0980 #x09FF)
- ("Gurmukhi" #x0A00 #x0A7F)
- ("Gujarati" #x0A80 #x0AFF)
- ("Oriya" #x0B00 #x0B7F)
- ("Tamil" #x0B80 #x0BFF)
- ("Telugu" #x0C00 #x0C7F)
- ("Kannada" #x0C80 #x0CFF)
- ("Malayalam" #x0D00 #x0D7F)
- ("Sinhala" #x0D80 #x0DFF)
- ("Thai" #x0E00 #x0E7F)
- ("Lao" #x0E80 #x0EFF)
- ("Tibetan" #x0F00 #x0FFF)
- ("Myanmar" #x1000 #x109F)
- ("Georgian" #x10A0 #x10FF)
- ("Hangul Jamo" #x1100 #x11FF)
- ("Ethiopic" #x1200 #x137F)
- ("Cherokee" #x13A0 #x13FF)
- ("Unified Canadian Aboriginal Syllabics" #x1400 #x167F)
- ("Ogham" #x1680 #x169F)
- ("Runic" #x16A0 #x16FF)
- ("Tagalog" #x1700 #x171F)
- ("Hanunoo" #x1720 #x173F)
- ("Buhid" #x1740 #x175F)
- ("Tagbanwa" #x1760 #x177F)
- ("Khmer" #x1780 #x17FF)
- ("Mongolian" #x1800 #x18AF)
- ("Latin Extended Additional" #x1E00 #x1EFF)
- ("Greek Extended" #x1F00 #x1FFF)
- ("General Punctuation" #x2000 #x206F)
- ("Superscripts and Subscripts" #x2070 #x209F)
- ("Currency Symbols" #x20A0 #x20CF)
- ("Combining Diacritical Marks for Symbols" #x20D0 #x20FF)
- ("Letterlike Symbols" #x2100 #x214F)
- ("Number Forms" #x2150 #x218F)
- ("Arrows" #x2190 #x21FF)
- ("Mathematical Operators" #x2200 #x22FF)
- ("Miscellaneous Technical" #x2300 #x23FF)
- ("Control Pictures" #x2400 #x243F)
- ("Optical Character Recognition" #x2440 #x245F)
- ("Enclosed Alphanumerics" #x2460 #x24FF)
- ("Box Drawing" #x2500 #x257F)
- ("Block Elements" #x2580 #x259F)
- ("Geometric Shapes" #x25A0 #x25FF)
- ("Miscellaneous Symbols" #x2600 #x26FF)
- ("Dingbats" #x2700 #x27BF)
- ("Miscellaneous Mathematical Symbols-A" #x27C0 #x27EF)
- ("Supplemental Arrows-A" #x27F0 #x27FF)
- ("Braille Patterns" #x2800 #x28FF)
- ("Supplemental Arrows-B" #x2900 #x297F)
- ("Miscellaneous Mathematical Symbols-B" #x2980 #x29FF)
- ("Supplemental Mathematical Operators" #x2A00 #x2AFF)
- ("CJK Radicals Supplement" #x2E80 #x2EFF)
- ("Kangxi Radicals" #x2F00 #x2FDF)
- ("Ideographic Description Characters" #x2FF0 #x2FFF)
- ("CJK Symbols and Punctuation" #x3000 #x303F)
- ("Hiragana" #x3040 #x309F)
- ("Katakana" #x30A0 #x30FF)
- ("Bopomofo" #x3100 #x312F)
- ("Hangul Compatibility Jamo" #x3130 #x318F)
- ("Kanbun" #x3190 #x319F)
- ("Bopomofo Extended" #x31A0 #x31BF)
- ("Katakana Phonetic Extensions" #x31F0 #x31FF)
- ("Enclosed CJK Letters and Months" #x3200 #x32FF)
- ("CJK Compatibility" #x3300 #x33FF)
- ("CJK Unified Ideographs Extension A" #x3400 #x4DBF)
- ;;("CJK Unified Ideographs" #x4E00 #x9FFF)
- ("Yi Syllables" #xA000 #xA48F)
- ("Yi Radicals" #xA490 #xA4CF)
- ;;("Hangul Syllables" #xAC00 #xD7AF)
- ;;("High Surrogates" #xD800 #xDB7F)
- ;;("High Private Use Surrogates" #xDB80 #xDBFF)
- ;;("Low Surrogates" #xDC00 #xDFFF)
- ;;("Private Use Area" #xE000 #xF8FF)
- ;;("CJK Compatibility Ideographs" #xF900 #xFAFF)
- ("Alphabetic Presentation Forms" #xFB00 #xFB4F)
- ("Arabic Presentation Forms-A" #xFB50 #xFDFF)
- ("Variation Selectors" #xFE00 #xFE0F)
- ("Combining Half Marks" #xFE20 #xFE2F)
- ("CJK Compatibility Forms" #xFE30 #xFE4F)
- ("Small Form Variants" #xFE50 #xFE6F)
- ("Arabic Presentation Forms-B" #xFE70 #xFEFF)
- ("Halfwidth and Fullwidth Forms" #xFF00 #xFFEF)
- ("Specials" #xFFF0 #xFFFF)
- ("Old Italic" #x10300 #x1032F)
- ("Gothic" #x10330 #x1034F)
- ("Deseret" #x10400 #x1044F)
- ("Byzantine Musical Symbols" #x1D000 #x1D0FF)
- ("Musical Symbols" #x1D100 #x1D1FF)
- ("Mathematical Alphanumeric Symbols" #x1D400 #x1D7FF)
- ;;("CJK Unified Ideographs Extension B" #x20000 #x2A6DF)
- ;;("CJK Compatibility Ideographs Supplement" #x2F800 #x2FA1F)
- ("Tags" #xE0000 #xE007F)
- ;;("Supplementary Private Use Area-A" #xF0000 #xFFFFF)
- ;;("Supplementary Private Use Area-B" #x100000 #x10FFFF)
- )
- "List of Unicode blocks.
-For each block there is a list (NAME FIRST LAST), where
-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 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))))
-
-;; This is intended to be a superset of the coverage
-;; of existing standard entity sets.
-(defvar nxml-enabled-unicode-blocks-default
- '(basic-latin
- latin-1-supplement
- latin-extended-a
- latin-extended-b
- ipa-extensions
- spacing-modifier-letters
- combining-diacritical-marks
- greek-and-coptic
- cyrillic
- general-punctuation
- superscripts-and-subscripts
- currency-symbols
- combining-diacritical-marks-for-symbols
- letterlike-symbols
- number-forms
- arrows
- mathematical-operators
- miscellaneous-technical
- control-pictures
- optical-character-recognition
- enclosed-alphanumerics
- box-drawing
- block-elements
- geometric-shapes
- miscellaneous-symbols
- dingbats
- miscellaneous-mathematical-symbols-a
- supplemental-arrows-a
- supplemental-arrows-b
- miscellaneous-mathematical-symbols-b
- supplemental-mathematical-operators
- cjk-symbols-and-punctuation
- alphabetic-presentation-forms
- variation-selectors
- small-form-variants
- specials
- mathematical-alphanumeric-symbols)
- "Default value for `nxml-enabled-unicode-blocks'.")
-
-(mapc (lambda (block)
- (nxml-autoload-char-name-set
- (nxml-unicode-block-char-name-set (car block))
- (expand-file-name
- (format "nxml/%05X-%05X"
- (nth 1 block)
- (nth 2 block))
- data-directory)))
- nxml-unicode-blocks)
-
-;; Internal flag to control whether customize reloads the character tables.
-;; 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
- "List of Unicode blocks for which Unicode character names are enabled.
-Each block is identified by a symbol derived from the name
-of the block by downcasing and replacing each space by a hyphen."
- :group 'nxml
- :set (lambda (sym value)
- (set-default 'nxml-enabled-unicode-blocks value)
- (when nxml-internal-unicode-char-name-sets-enabled
- (nxml-enable-unicode-char-name-sets)))
- :type (cons 'set
- (mapcar (lambda (block)
- `(const :tag ,(format "%s (%04X-%04X)"
- (nth 0 block)
- (nth 1 block)
- (nth 2 block))
- ,(nxml-unicode-block-char-name-set
- (nth 0 block))))
- nxml-unicode-blocks)))
-
-;;;###autoload
-(defun nxml-enable-unicode-char-name-sets ()
- "Enable the use of Unicode standard names for characters.
-The Unicode blocks for which names are enabled is controlled by
-the variable `nxml-enabled-unicode-blocks'."
- (interactive)
- (setq nxml-internal-unicode-char-name-sets-enabled t)
- (mapc (lambda (block)
- (nxml-disable-char-name-set
- (nxml-unicode-block-char-name-set (car block))))
- nxml-unicode-blocks)
- (mapc (lambda (nameset)
- (nxml-enable-char-name-set nameset))
- nxml-enabled-unicode-blocks))
-
-(provide 'nxml-uchnm)
-
-;;; nxml-uchnm.el ends here
diff --git a/lisp/nxml/nxml-util.el b/lisp/nxml/nxml-util.el
index 14b887ea085..282d4952bf7 100644
--- a/lisp/nxml/nxml-util.el
+++ b/lisp/nxml/nxml-util.el
@@ -36,20 +36,6 @@
`(nxml-debug "%s: %S" ,name
(buffer-substring-no-properties ,start ,end))))
-(defmacro nxml-debug-set-inside (start end)
- (when nxml-debug
- `(let ((overlay (make-overlay ,start ,end)))
- (overlay-put overlay 'face '(:background "red"))
- (overlay-put overlay 'nxml-inside-debug t)
- (nxml-debug-change "nxml-set-inside" ,start ,end))))
-
-(defmacro nxml-debug-clear-inside (start end)
- (when nxml-debug
- `(cl-loop for overlay in (overlays-in ,start ,end)
- if (overlay-get overlay 'nxml-inside-debug)
- do (delete-overlay overlay)
- finally (nxml-debug-change "nxml-clear-inside" ,start ,end))))
-
(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.
diff --git a/lisp/nxml/rng-cmpct.el b/lisp/nxml/rng-cmpct.el
index 39aee9780ff..ed88dfa98e9 100644
--- a/lisp/nxml/rng-cmpct.el
+++ b/lisp/nxml/rng-cmpct.el
@@ -1,4 +1,4 @@
-;;; rng-cmpct.el --- parsing of RELAX NG Compact Syntax schemas
+;;; rng-cmpct.el --- parsing of RELAX NG Compact Syntax schemas -*- lexical-binding:t -*-
;; Copyright (C) 2003, 2007-2016 Free Software Foundation, Inc.
@@ -674,13 +674,7 @@ the primary expression."
(substring rng-c-current-token n (- n)))))
(defun rng-c-fix-escaped-newlines (str)
- (let ((pos 0))
- (while (progn
- (let ((n (string-match "\C-@" str pos)))
- (and n
- (aset str n ?\n)
- (setq pos (1+ n)))))))
- str)
+ (subst-char-in-string ?\C-@ ?\n str))
(defun rng-c-parse-identifier-or-keyword ()
(cond ((rng-c-current-token-ncname-p)
diff --git a/lisp/nxml/rng-dt.el b/lisp/nxml/rng-dt.el
index 07166e38fea..a3cb8bc6aa5 100644
--- a/lisp/nxml/rng-dt.el
+++ b/lisp/nxml/rng-dt.el
@@ -1,4 +1,4 @@
-;;; rng-dt.el --- datatype library interface for RELAX NG
+;;; rng-dt.el --- datatype library interface for RELAX NG -*- lexical-binding:t -*-
;; Copyright (C) 2003, 2007-2016 Free Software Foundation, Inc.
@@ -57,7 +57,7 @@ a datatype library.")
(t
(rng-dt-error "There is no built-in datatype %s" name))))
-(put (rng-make-datatypes-uri "") 'rng-dt-compile 'rng-dt-builtin-compile)
+(put (rng-make-datatypes-uri "") 'rng-dt-compile #'rng-dt-builtin-compile)
(provide 'rng-dt)
diff --git a/lisp/nxml/rng-loc.el b/lisp/nxml/rng-loc.el
index 553d8ca359d..376e9169d37 100644
--- a/lisp/nxml/rng-loc.el
+++ b/lisp/nxml/rng-loc.el
@@ -1,4 +1,4 @@
-;;; rng-loc.el --- locate the schema to use for validation
+;;; rng-loc.el --- Locate the schema to use for validation -*- lexical-binding:t -*-
;; Copyright (C) 2003, 2007-2016 Free Software Foundation, Inc.
@@ -31,10 +31,9 @@
(require 'rng-util)
(require 'xmltok)
-(defvar rng-current-schema-file-name nil
+(defvar-local rng-current-schema-file-name nil
"Filename of schema being used for current buffer.
It is nil if using a vacuous schema.")
-(make-variable-buffer-local 'rng-current-schema-file-name)
(defvar rng-schema-locating-files-default
(list "schemas.xml" (expand-file-name "schema/schemas.xml" data-directory))
@@ -233,11 +232,11 @@ or nil."
rules))))))))
best-so-far))
-(put 'documentElement 'rng-rule-matcher 'rng-match-document-element-rule)
-(put 'namespace 'rng-rule-matcher 'rng-match-namespace-rule)
-(put 'uri 'rng-rule-matcher 'rng-match-uri-rule)
-(put 'transformURI 'rng-rule-matcher 'rng-match-transform-uri-rule)
-(put 'default 'rng-rule-matcher 'rng-match-default-rule)
+(put 'documentElement 'rng-rule-matcher #'rng-match-document-element-rule)
+(put 'namespace 'rng-rule-matcher #'rng-match-namespace-rule)
+(put 'uri 'rng-rule-matcher #'rng-match-uri-rule)
+(put 'transformURI 'rng-rule-matcher #'rng-match-transform-uri-rule)
+(put 'default 'rng-rule-matcher #'rng-match-default-rule)
(defun rng-match-document-element-rule (props)
(let ((document-element (rng-document-element))
diff --git a/lisp/nxml/rng-maint.el b/lisp/nxml/rng-maint.el
index 165ca8930a4..32a041e0c17 100644
--- a/lisp/nxml/rng-maint.el
+++ b/lisp/nxml/rng-maint.el
@@ -1,4 +1,4 @@
-;;; rng-maint.el --- commands for RELAX NG maintainers
+;;; rng-maint.el --- commands for RELAX NG maintainers -*- lexical-binding:t -*-
;; Copyright (C) 2003, 2007-2016 Free Software Foundation, Inc.
diff --git a/lisp/nxml/rng-match.el b/lisp/nxml/rng-match.el
index df9c0192557..d2b629e8d83 100644
--- a/lisp/nxml/rng-match.el
+++ b/lisp/nxml/rng-match.el
@@ -56,9 +56,8 @@ Used to detect invalid recursive references.")
;;; Inline functions
(defsubst rng-update-match-state (new-state)
- (if (and (eq new-state rng-not-allowed-ipattern)
- (not (eq rng-match-state rng-not-allowed-ipattern)))
- nil
+ (if (eq new-state rng-not-allowed-ipattern)
+ (eq rng-match-state rng-not-allowed-ipattern)
(setq rng-match-state new-state)
t))
diff --git a/lisp/nxml/rng-nxml.el b/lisp/nxml/rng-nxml.el
index fe90dffb555..954a1eb9599 100644
--- a/lisp/nxml/rng-nxml.el
+++ b/lisp/nxml/rng-nxml.el
@@ -1,4 +1,4 @@
-;;; rng-nxml.el --- make nxml-mode take advantage of rng-validate-mode
+;;; rng-nxml.el --- make nxml-mode take advantage of rng-validate-mode -*- lexical-binding:t -*-
;; Copyright (C) 2003, 2007-2016 Free Software Foundation, Inc.
@@ -33,6 +33,7 @@
(require 'rng-valid)
(require 'nxml-mode)
(require 'rng-loc)
+(require 'sgml-mode)
(defcustom rng-nxml-auto-validate-flag t
"Non-nil means automatically turn on validation with nxml-mode."
@@ -65,6 +66,9 @@ Complete on start-tag names regardless.")
["Validation" rng-validate-mode
:style toggle
:selected rng-validate-mode]
+ ["Electric Pairs" sgml-electric-tag-pair-mode
+ :style toggle
+ :selected sgml-electric-tag-pair-mode]
"---"
("Set Schema"
["Automatically" rng-auto-set-schema]
@@ -107,25 +111,15 @@ Validation will be enabled if `rng-nxml-auto-validate-flag' is non-nil."
'append)
(cond (rng-nxml-auto-validate-flag
(rng-validate-mode 1)
- (add-hook 'nxml-completion-hook 'rng-complete nil t)
- (add-hook 'nxml-in-mixed-content-hook 'rng-in-mixed-content-p nil t))
+ (add-hook 'completion-at-point-functions #'rng-completion-at-point nil t)
+ (add-hook 'nxml-in-mixed-content-hook #'rng-in-mixed-content-p nil t))
(t
(rng-validate-mode 0)
- (remove-hook 'nxml-completion-hook 'rng-complete t)
- (remove-hook 'nxml-in-mixed-content-hook 'rng-in-mixed-content-p t))))
-
-(defvar rng-tag-history nil)
-(defvar rng-attribute-name-history nil)
-(defvar rng-attribute-value-history nil)
-
-(defvar rng-complete-target-names nil)
-(defvar rng-complete-name-attribute-flag nil)
-(defvar rng-complete-extra-strings nil)
+ (remove-hook 'completion-at-point-functions #'rng-completion-at-point t)
+ (remove-hook 'nxml-in-mixed-content-hook #'rng-in-mixed-content-p t))))
-(defun rng-complete ()
- "Complete the string before point using the current schema.
-Return non-nil if in a context it understands."
- (interactive)
+(defun rng-completion-at-point ()
+ "Return completion data for the string before point using the current schema."
(and rng-validate-mode
(let ((lt-pos (save-excursion (search-backward "<" nil t)))
xmltok-dtd)
@@ -145,53 +139,48 @@ Return non-nil if in a context it understands."
t))
(defun rng-complete-tag (lt-pos)
- (let (rng-complete-extra-strings)
- (when (and (= lt-pos (1- (point)))
- rng-complete-end-tags-after-<
- rng-open-elements
- (not (eq (car rng-open-elements) t))
- (or rng-collecting-text
- (rng-match-save
- (rng-match-end-tag))))
- (setq rng-complete-extra-strings
- (cons (concat "/"
- (if (caar rng-open-elements)
- (concat (caar rng-open-elements)
- ":"
- (cdar rng-open-elements))
- (cdar rng-open-elements)))
- rng-complete-extra-strings)))
+ (let ((extra-strings
+ (when (and (= lt-pos (1- (point)))
+ rng-complete-end-tags-after-<
+ rng-open-elements
+ (not (eq (car rng-open-elements) t))
+ (or rng-collecting-text
+ (rng-match-save
+ (rng-match-end-tag))))
+ (list (concat "/"
+ (if (caar rng-open-elements)
+ (concat (caar rng-open-elements)
+ ":"
+ (cdar rng-open-elements))
+ (cdar rng-open-elements)))))))
(when (save-excursion
(re-search-backward rng-in-start-tag-name-regex
lt-pos
t))
(and rng-collecting-text (rng-flush-text))
- (let ((completion
- (let ((rng-complete-target-names
- (rng-match-possible-start-tag-names))
- (rng-complete-name-attribute-flag nil))
- (rng-complete-before-point (1+ lt-pos)
- 'rng-complete-qname-function
- "Tag: "
- nil
- 'rng-tag-history)))
- name)
- (when completion
- (cond ((rng-qname-p completion)
- (setq name (rng-expand-qname completion
- t
- 'rng-start-tag-expand-recover))
- (when (and name
- (rng-match-start-tag-open name)
- (or (not (rng-match-start-tag-close))
- ;; need a namespace decl on the root element
- (and (car name)
- (not rng-open-elements))))
- ;; attributes are required
- (insert " ")))
- ((member completion rng-complete-extra-strings)
- (insert ">")))))
- t)))
+ (let ((target-names (rng-match-possible-start-tag-names)))
+ `(,(1+ lt-pos)
+ ,(save-excursion (skip-chars-forward "[[:alnum:]_.-:]") (point))
+ ,(apply-partially #'rng-complete-qname-function
+ target-names nil extra-strings)
+ :exit-function
+ ,(lambda (completion status)
+ (cond
+ ((not (eq status 'finished)) nil)
+ ((rng-qname-p completion)
+ (let ((name (rng-expand-qname completion
+ t
+ #'rng-start-tag-expand-recover)))
+ (when (and name
+ (rng-match-start-tag-open name)
+ (or (not (rng-match-start-tag-close))
+ ;; need a namespace decl on the root element
+ (and (car name)
+ (not rng-open-elements))))
+ ;; attributes are required
+ (insert " "))))
+ ((member completion extra-strings)
+ (insert ">")))))))))
(defconst rng-in-end-tag-name-regex
(replace-regexp-in-string
@@ -216,29 +205,18 @@ Return non-nil if in a context it understands."
(concat (caar rng-open-elements)
":"
(cdar rng-open-elements))
- (cdar rng-open-elements)))
- (end-tag-name
- (buffer-substring-no-properties (+ (match-beginning 0) 2)
- (point))))
- (cond ((or (> (length end-tag-name)
- (length start-tag-name))
- (not (string= (substring start-tag-name
- 0
- (length end-tag-name))
- end-tag-name)))
- (message "Expected end-tag %s"
- (rng-quote-string
- (concat "</" start-tag-name ">")))
- (ding))
- (t
- (delete-region (- (point) (length end-tag-name))
- (point))
- (insert start-tag-name ">")
- (when (not (or rng-collecting-text
- (rng-match-end-tag)))
- (message "Element %s is incomplete"
- (rng-quote-string start-tag-name))))))))
- t))
+ (cdar rng-open-elements))))
+ `(,(+ (match-beginning 0) 2)
+ ,(save-excursion (skip-chars-forward "[[:alnum:]_.-:]") (point))
+ ,(list start-tag-name) ;Sole completion candidate.
+ :exit-function
+ ,(lambda (_completion status)
+ (when (eq status 'finished)
+ (unless (eq (char-after) ?>) (insert ">"))
+ (when (not (or rng-collecting-text
+ (rng-match-end-tag)))
+ (message "Element \"%s\" is incomplete"
+ start-tag-name))))))))))
(defconst rng-in-attribute-regex
(replace-regexp-in-string
@@ -260,22 +238,24 @@ Return non-nil if in a context it understands."
rng-undeclared-prefixes)
(and (rng-adjust-state-for-attribute lt-pos
attribute-start)
- (let ((rng-complete-target-names
+ (let ((target-names
(rng-match-possible-attribute-names))
- (rng-complete-extra-strings
+ (extra-strings
(mapcar (lambda (prefix)
(if prefix
(concat "xmlns:" prefix)
"xmlns"))
- rng-undeclared-prefixes))
- (rng-complete-name-attribute-flag t))
- (rng-complete-before-point attribute-start
- 'rng-complete-qname-function
- "Attribute: "
- nil
- 'rng-attribute-name-history))
- (insert "=\"")))
- t))
+ rng-undeclared-prefixes)))
+ `(,attribute-start
+ ,(save-excursion (skip-chars-forward "[[:alnum:]_.-:]") (point))
+ ,(apply-partially #'rng-complete-qname-function
+ target-names t extra-strings)
+ :exit-function
+ ,(lambda (_completion status)
+ (when (and (eq status 'finished)
+ (not (looking-at "=")))
+ (insert "=\"\"")
+ (forward-char -1)))))))))
(defconst rng-in-attribute-value-regex
(replace-regexp-in-string
@@ -292,43 +272,40 @@ Return non-nil if in a context it understands."
(defun rng-complete-attribute-value (lt-pos)
(when (save-excursion
(re-search-backward rng-in-attribute-value-regex lt-pos t))
- (let ((name-start (match-beginning 1))
- (name-end (match-end 1))
- (colon (match-beginning 2))
- (value-start (1+ (match-beginning 3))))
+ (let* ((name-start (match-beginning 1))
+ (name-end (match-end 1))
+ (colon (match-beginning 2))
+ (value-start (1+ (match-beginning 3)))
+ (exit-function
+ (lambda (_completion status)
+ (when (eq status 'finished)
+ (let ((delim (char-before value-start)))
+ (unless (eq (char-after) delim) (insert delim)))))))
(and (rng-adjust-state-for-attribute lt-pos
name-start)
(if (string= (buffer-substring-no-properties name-start
(or colon name-end))
"xmlns")
- (rng-complete-before-point
- value-start
- (rng-strings-to-completion-alist
- (rng-possible-namespace-uris
- (and colon
- (buffer-substring-no-properties (1+ colon) name-end))))
- "Namespace URI: "
- nil
- 'rng-namespace-uri-history)
+ `(,value-start ,(point)
+ ,(rng-strings-to-completion-table
+ (rng-possible-namespace-uris
+ (and colon
+ (buffer-substring-no-properties (1+ colon) name-end))))
+ :exit-function ,exit-function)
(rng-adjust-state-for-attribute-value name-start
colon
name-end)
- (rng-complete-before-point
- value-start
- (rng-strings-to-completion-alist
- (rng-match-possible-value-strings))
- "Value: "
- nil
- 'rng-attribute-value-history))
- (insert (char-before value-start))))
- t))
+ `(,value-start ,(point)
+ ,(rng-strings-to-completion-table
+ (rng-match-possible-value-strings))
+ :exit-function ,exit-function))))))
(defun rng-possible-namespace-uris (prefix)
(let ((ns (if prefix (nxml-ns-get-prefix prefix)
(nxml-ns-get-default))))
(if (and ns (memq prefix (nxml-ns-changed-prefixes)))
(list (nxml-namespace-name ns))
- (mapcar 'nxml-namespace-name
+ (mapcar #'nxml-namespace-name
(delq nxml-xml-namespace-uri
(rng-match-possible-namespace-uris))))))
@@ -349,7 +326,7 @@ Return non-nil if in a context it understands."
(recover-fun (funcall recover-fun prefix (cdr qname)))))
(cons (and defaultp (nxml-ns-get-default)) (cdr qname)))))
-(defun rng-start-tag-expand-recover (prefix local-name)
+(defun rng-start-tag-expand-recover (_prefix local-name)
(let ((ns (rng-match-infer-start-tag-namespace local-name)))
(and ns
(cons ns local-name))))
@@ -386,7 +363,7 @@ set `xmltok-dtd'. Returns the position of the end of the token."
(save-restriction
(widen)
(nxml-with-invisible-motion
- (if (= pos 1)
+ (if (= pos (point-min))
(rng-set-initial-state)
(let ((state (get-text-property (1- pos) 'rng-state)))
(cond (state
@@ -501,24 +478,21 @@ set `xmltok-dtd'. Returns the position of the end of the token."
(and (or (not prefix) ns)
(rng-match-attribute-name (cons ns local-name)))))
-(defun rng-complete-qname-function (string predicate flag)
- (let ((alist (mapcar (lambda (name) (cons name nil))
- (rng-generate-qname-list string))))
- (cond ((not flag)
- (try-completion string alist predicate))
- ((eq flag t)
- (all-completions string alist predicate))
- ((eq flag 'lambda)
- (and (assoc string alist) t)))))
-
-(defun rng-generate-qname-list (&optional string)
+(defun rng-complete-qname-function (candidates attributes-flag extra-strings
+ string predicate flag)
+ (complete-with-action flag
+ (rng-generate-qname-list
+ string candidates attributes-flag extra-strings)
+ string predicate))
+
+(defun rng-generate-qname-list (&optional string candidates attribute-flag extra-strings)
(let ((forced-prefix (and string
(string-match ":" string)
(> (match-beginning 0) 0)
(substring string
0
(match-beginning 0))))
- (namespaces (mapcar 'car rng-complete-target-names))
+ (namespaces (mapcar #'car candidates))
ns-prefixes-alist ns-prefixes iter ns prefer)
(while namespaces
(setq ns (car namespaces))
@@ -526,7 +500,7 @@ set `xmltok-dtd'. Returns the position of the end of the token."
(setq ns-prefixes-alist
(cons (cons ns (nxml-ns-prefixes-for
ns
- rng-complete-name-attribute-flag))
+ attribute-flag))
ns-prefixes-alist)))
(setq namespaces (delq ns (cdr namespaces))))
(setq iter ns-prefixes-alist)
@@ -546,12 +520,12 @@ set `xmltok-dtd'. Returns the position of the end of the token."
(setcdr ns-prefixes (list prefer)))
;; Unless it's an attribute with a non-nil namespace,
;; allow no prefix for this namespace.
- (unless rng-complete-name-attribute-flag
+ (unless attribute-flag
(setcdr ns-prefixes (cons nil (cdr ns-prefixes))))))
(setq iter (cdr iter)))
(rng-uniquify-equal
- (sort (apply 'append
- (cons rng-complete-extra-strings
+ (sort (apply #'append
+ (cons extra-strings
(mapcar (lambda (name)
(if (car name)
(mapcar (lambda (prefix)
@@ -563,7 +537,7 @@ set `xmltok-dtd'. Returns the position of the end of the token."
(cdr (assoc (car name)
ns-prefixes-alist)))
(list (cdr name))))
- rng-complete-target-names)))
+ candidates)))
'string<))))
(defun rng-get-preferred-unused-prefix (ns)
@@ -582,10 +556,8 @@ set `xmltok-dtd'. Returns the position of the end of the token."
nil))))
prefix))
-(defun rng-strings-to-completion-alist (strings)
- (mapcar (lambda (s) (cons s s))
- (rng-uniquify-equal (sort (mapcar 'rng-escape-string strings)
- 'string<))))
+(defun rng-strings-to-completion-table (strings)
+ (mapcar #'rng-escape-string strings))
(provide 'rng-nxml)
diff --git a/lisp/nxml/rng-parse.el b/lisp/nxml/rng-parse.el
index cde749db672..3ae4b5cc9c4 100644
--- a/lisp/nxml/rng-parse.el
+++ b/lisp/nxml/rng-parse.el
@@ -1,4 +1,4 @@
-;;; rng-parse.el --- parse an XML file and validate it against a schema
+;;; rng-parse.el --- parse an XML file and validate it against a schema -*- lexical-binding:t -*-
;; Copyright (C) 2003, 2007-2016 Free Software Foundation, Inc.
diff --git a/lisp/nxml/rng-pttrn.el b/lisp/nxml/rng-pttrn.el
index f358d3c87d4..e847f5e02a8 100644
--- a/lisp/nxml/rng-pttrn.el
+++ b/lisp/nxml/rng-pttrn.el
@@ -1,4 +1,4 @@
-;;; rng-pttrn.el --- RELAX NG patterns
+;;; rng-pttrn.el --- RELAX NG patterns -*- lexical-binding:t -*-
;; Copyright (C) 2003, 2007-2016 Free Software Foundation, Inc.
diff --git a/lisp/nxml/rng-uri.el b/lisp/nxml/rng-uri.el
index 75cf23f888d..8fc0a01e293 100644
--- a/lisp/nxml/rng-uri.el
+++ b/lisp/nxml/rng-uri.el
@@ -1,4 +1,4 @@
-;;; rng-uri.el --- URI parsing and manipulation
+;;; rng-uri.el --- URI parsing and manipulation -*- lexical-binding:t -*-
;; Copyright (C) 2003, 2007-2016 Free Software Foundation, Inc.
diff --git a/lisp/nxml/rng-util.el b/lisp/nxml/rng-util.el
index 4c14e2b6597..c5d4b6567ed 100644
--- a/lisp/nxml/rng-util.el
+++ b/lisp/nxml/rng-util.el
@@ -82,69 +82,6 @@ LIST is not modified."
(cons item nil))))))))
list)))
-(defun rng-complete-before-point (start table prompt &optional predicate hist)
- "Complete text between START and point.
-Replaces the text between START and point with a string chosen using a
-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,
-returns nil.
-TABLE is an alist, a symbol bound to a function or an obarray as with
-the function `completing-read'.
-PROMPT is the string to prompt with if user input is needed.
-PREDICATE is nil or a function as with `completing-read'.
-HIST, if non-nil, specifies a history list as with `completing-read'."
- (let* ((orig (buffer-substring-no-properties start (point)))
- (completion (try-completion orig table predicate)))
- (cond ((not completion)
- (if (string= orig "")
- (message "No completions available")
- (message "No completion for %s" (rng-quote-string orig)))
- (ding)
- nil)
- ((eq completion t) orig)
- ((not (string= completion orig))
- (delete-region start (point))
- (insert completion)
- (cond ((not (rng-completion-exact-p completion table predicate))
- (message "Incomplete")
- nil)
- ((eq (try-completion completion table predicate) t)
- completion)
- (t
- (message "Complete but not unique")
- nil)))
- (t
- (setq completion
- (let ((saved-minibuffer-setup-hook
- (default-value 'minibuffer-setup-hook)))
- (add-hook 'minibuffer-setup-hook
- 'minibuffer-completion-help
- t)
- (unwind-protect
- (completing-read prompt
- table
- predicate
- nil
- orig
- hist)
- (setq-default minibuffer-setup-hook
- saved-minibuffer-setup-hook))))
- (delete-region start (point))
- (insert completion)
- completion))))
-
-(defun rng-completion-exact-p (string table predicate)
- (cond ((symbolp table)
- (funcall table string predicate 'lambda))
- ((vectorp table)
- (intern-soft string table))
- (t (assoc string table))))
-
-(defun rng-quote-string (s)
- (concat "\"" s "\""))
-
(defun rng-escape-string (s)
(replace-regexp-in-string "[&\"<>]"
(lambda (match)
diff --git a/lisp/nxml/rng-valid.el b/lisp/nxml/rng-valid.el
index 1020cad2089..239b1d11db1 100644
--- a/lisp/nxml/rng-valid.el
+++ b/lisp/nxml/rng-valid.el
@@ -1,4 +1,4 @@
-;;; rng-valid.el --- real-time validation of XML using RELAX NG
+;;; rng-valid.el --- real-time validation of XML using RELAX NG -*- lexical-binding:t -*-
;; Copyright (C) 2003, 2007-2016 Free Software Foundation, Inc.
@@ -101,7 +101,7 @@
(defgroup relax-ng nil
"Validation of XML using RELAX NG."
- :group 'wp
+ :group 'text
:group 'nxml
:group 'languages)
@@ -430,13 +430,13 @@ The schema is set like `rng-auto-set-schema'."
(when (buffer-live-p buffer) ; bug#13999
(with-current-buffer buffer
(if rng-validate-mode
- (if (let ((rng-validate-display-point (point))
- (rng-validate-display-modified-p (buffer-modified-p)))
- (rng-do-some-validation 'rng-validate-while-idle-continue-p))
- (force-mode-line-update)
- (rng-validate-done))
- ;; must have done kill-all-local-variables
- (rng-kill-timers)))))
+ (if (let ((rng-validate-display-point (point))
+ (rng-validate-display-modified-p (buffer-modified-p)))
+ (rng-do-some-validation 'rng-validate-while-idle-continue-p))
+ (force-mode-line-update)
+ (rng-validate-done))
+ ;; Must have done kill-all-local-variables.
+ (rng-kill-timers)))))
(defun rng-validate-quick-while-idle (buffer)
(when (buffer-live-p buffer) ; bug#13999
@@ -709,7 +709,7 @@ Return t if there is work to do, nil otherwise."
;; If we don't do this, then the front delimiter can move
;; past the end delimiter.
-(defun rng-error-modified (overlay after-p beg end &optional pre-change-len)
+(defun rng-error-modified (overlay after-p _beg _end &optional _pre-change-len)
(when (and after-p
(overlay-start overlay) ; check not deleted
(>= (overlay-start overlay)
@@ -1138,9 +1138,8 @@ as empty-element."
(rng-match-start-tag-open required)
(rng-match-after)
(rng-match-start-tag-open name))
- (rng-mark-invalid (concat "Missing element "
- (rng-quote-string
- (rng-name-to-string required)))
+ (rng-mark-invalid (format "Missing element \"%s\""
+ (rng-name-to-string required))
xmltok-start
(1+ xmltok-start)))
((and (rng-match-optionalize-elements)
@@ -1177,16 +1176,14 @@ as empty-element."
(cond ((not required-attributes)
"Required attributes missing")
((not (cdr required-attributes))
- (concat "Missing attribute "
- (rng-quote-string
- (rng-name-to-string (car required-attributes) t))))
+ (format "Missing attribute \"%s\""
+ (rng-name-to-string (car required-attributes) t)))
(t
- (concat "Missing attributes "
+ (format "Missing attributes \"%s\""
(mapconcat (lambda (nm)
- (rng-quote-string
- (rng-name-to-string nm t)))
+ (rng-name-to-string nm t))
required-attributes
- ", "))))))
+ "\", \""))))))
(defun rng-process-end-tag (&optional partial)
(cond ((not rng-open-elements)
@@ -1229,8 +1226,7 @@ as empty-element."
(defun rng-missing-element-message ()
(let ((element (rng-match-required-element-name)))
(if element
- (concat "Missing element "
- (rng-quote-string (rng-name-to-string element)))
+ (format "Missing element \"%s\"" (rng-name-to-string element))
"Required child elements missing")))
(defun rng-recover-mismatched-end-tag ()
@@ -1258,17 +1254,16 @@ as empty-element."
(defun rng-mark-missing-end-tags (missing)
(rng-mark-not-well-formed
- (format "Missing end-tag%s %s"
+ (format "Missing end-tag%s \"%s\""
(if (null (cdr missing)) "" "s")
(mapconcat (lambda (name)
- (rng-quote-string
- (if (car name)
- (concat (car name)
- ":"
- (cdr name))
- (cdr name))))
+ (if (car name)
+ (concat (car name)
+ ":"
+ (cdr name))
+ (cdr name)))
missing
- ", "))
+ "\", \""))
xmltok-start
(+ xmltok-start 2)))
diff --git a/lisp/nxml/rng-xsd.el b/lisp/nxml/rng-xsd.el
index 378319851a0..c0989ae1073 100644
--- a/lisp/nxml/rng-xsd.el
+++ b/lisp/nxml/rng-xsd.el
@@ -1,4 +1,4 @@
-;;; rng-xsd.el --- W3C XML Schema datatypes library for RELAX NG
+;;; rng-xsd.el --- W3C XML Schema datatypes library for RELAX NG -*- lexical-binding:t -*-
;; Copyright (C) 2003, 2007-2016 Free Software Foundation, Inc.
@@ -42,7 +42,7 @@
;;;###autoload
(put 'http://www.w3.org/2001/XMLSchema-datatypes
'rng-dt-compile
- 'rng-xsd-compile)
+ #'rng-xsd-compile)
;;;###autoload
(defun rng-xsd-compile (name params)
@@ -50,9 +50,9 @@
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
+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
+`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
diff --git a/lisp/nxml/xmltok.el b/lisp/nxml/xmltok.el
index 8fc66c99a45..f12905a86d0 100644
--- a/lisp/nxml/xmltok.el
+++ b/lisp/nxml/xmltok.el
@@ -34,10 +34,7 @@
;; preceding part of the instance. This allows the instance to be
;; parsed incrementally. The main entry point is `xmltok-forward':
;; this can be called at any point in the instance provided it is
-;; between tokens. The other entry point is `xmltok-forward-special'
-;; which skips over tokens other comments, processing instructions or
-;; CDATA sections (i.e. the constructs in an instance that can contain
-;; less than signs that don't start a token).
+;; between tokens.
;;
;; This is a non-validating XML 1.0 processor. It does not resolve
;; parameter entities (including the external DTD subset) and it does
@@ -262,11 +259,10 @@ and VALUE-END, otherwise a STRING giving the value."
(vector message start end))
(defun xmltok-add-error (message &optional start end)
- (setq xmltok-errors
- (cons (xmltok-make-error message
- (or start xmltok-start)
- (or end (point)))
- xmltok-errors)))
+ (push (xmltok-make-error message
+ (or start xmltok-start)
+ (or end (point)))
+ xmltok-errors))
(defun xmltok-forward ()
(setq xmltok-start (point))
@@ -308,18 +304,6 @@ and VALUE-END, otherwise a STRING giving the value."
(goto-char (point-max))
(setq xmltok-type 'data)))))
-(defun xmltok-forward-special (bound)
- "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."
- (when (re-search-forward "<[?!]" (1+ bound) t)
- (setq xmltok-start (match-beginning 0))
- (goto-char (1+ xmltok-start))
- (let ((case-fold-search nil))
- (xmltok-scan-after-lt))))
-
(eval-when-compile
;; A symbolic regexp is represented by a list whose CAR is the string
@@ -739,19 +723,10 @@ Return the type of the token."
(setq xmltok-type 'processing-instruction))
(defun xmltok-scan-after-comment-open ()
- (let ((found-- (search-forward "--" nil 'move)))
- (setq xmltok-type
- (cond ((or (eq (char-after) ?>) (not found--))
- (goto-char (1+ (point)))
- 'comment)
- (t
- ;; just include the <!-- in the token
- (goto-char (+ xmltok-start 4))
- ;; Need do this after the goto-char because
- ;; marked error should just apply to <!--
- (xmltok-add-error "First following `--' not followed by `>'")
- (goto-char (point-max))
- 'comment)))))
+ (while (and (re-search-forward "--\\(>\\)?" nil 'move)
+ (not (match-end 1)))
+ (xmltok-add-error "`--' not followed by `>'" (match-beginning 0)))
+ (setq xmltok-type 'comment))
(defun xmltok-scan-attributes ()
(let ((recovering nil)
diff --git a/lisp/nxml/xsd-regexp.el b/lisp/nxml/xsd-regexp.el
index e91e6b77a7d..a3f476d00be 100644
--- a/lisp/nxml/xsd-regexp.el
+++ b/lisp/nxml/xsd-regexp.el
@@ -1,4 +1,4 @@
-;;; xsd-regexp.el --- translate W3C XML Schema regexps to Emacs regexps
+;;; xsd-regexp.el --- translate W3C XML Schema regexps to Emacs regexps -*- lexical-binding:t -*-
;; Copyright (C) 2003, 2007-2016 Free Software Foundation, Inc.
@@ -147,7 +147,7 @@ ranges are merged wherever possible."
(defun xsdre-range-list-difference (orig subtract)
"Return a range-list for the difference of two range-lists."
(when orig
- (let (new head next first last)
+ (let (new head first last)
(while orig
(setq head (car orig))
(setq first (xsdre-range-first head))
@@ -745,7 +745,7 @@ Code is inserted into the current buffer."
(save-excursion
(goto-char start)
(down-list 2)
- (while (condition-case err
+ (while (condition-case nil
(progn
(forward-sexp)
t)
generated by cgit v1.2.3 (git 2.39.1) at 2025-04-08 13:34:26 +0000