summaryrefslogtreecommitdiff
path: root/lisp/nxml
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/nxml')
-rw-r--r--lisp/nxml/nxml-mode.el13
-rw-r--r--lisp/nxml/nxml-outln.el2
-rw-r--r--lisp/nxml/rng-cmpct.el10
-rw-r--r--lisp/nxml/rng-loc.el2
-rw-r--r--lisp/nxml/rng-match.el2
-rw-r--r--lisp/nxml/rng-nxml.el18
-rw-r--r--lisp/nxml/rng-uri.el4
-rw-r--r--lisp/nxml/rng-util.el28
-rw-r--r--lisp/nxml/rng-xsd.el6
-rw-r--r--lisp/nxml/xmltok.el47
10 files changed, 68 insertions, 64 deletions
diff --git a/lisp/nxml/nxml-mode.el b/lisp/nxml/nxml-mode.el
index 0602943db20..405f803325c 100644
--- a/lisp/nxml/nxml-mode.el
+++ b/lisp/nxml/nxml-mode.el
@@ -540,13 +540,15 @@ Many aspects this mode can be customized using
(nxml-scan-prolog)))))
(setq-local syntax-ppss-table sgml-tag-syntax-table)
(setq-local syntax-propertize-function #'nxml-syntax-propertize)
+ (add-function :filter-return (local 'filter-buffer-substring-function)
+ #'nxml--buffer-substring-filter)
(add-hook 'change-major-mode-hook #'nxml-cleanup nil t)
(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)))
(setq buffer-file-coding-system nxml-default-buffer-file-coding-system))
- ;; When starting a new file, insert the XML declaraction.
+ ;; When starting a new file, insert the XML declaration.
(when (and nxml-auto-insert-xml-declaration-flag
(zerop (buffer-size)))
(nxml-insert-xml-declaration)))
@@ -564,6 +566,15 @@ Many aspects this mode can be customized using
(with-demoted-errors (rng-nxml-mode-init)))
+(defun nxml--buffer-substring-filter (string)
+ ;; The `rng-state' property is huge, so don't copy it to the kill ring.
+ ;; This avoids problems when saving the kill ring with savehist.
+ (when (seq-find (lambda (elem)
+ (plist-get (nth 2 elem) 'rng-state))
+ (object-intervals string))
+ (remove-text-properties 0 (length string) '(rng-state nil) string))
+ string)
+
(defun nxml-cleanup ()
"Clean up after nxml-mode."
;; Disable associated minor modes.
diff --git a/lisp/nxml/nxml-outln.el b/lisp/nxml/nxml-outln.el
index 6dca34a80f2..c265b19cf05 100644
--- a/lisp/nxml/nxml-outln.el
+++ b/lisp/nxml/nxml-outln.el
@@ -633,7 +633,7 @@ non-transparent child section."
tag-qnames))))
(defun nxml-highlighted-qname (qname)
- (let ((colon (string-match ":" qname)))
+ (let ((colon (string-search ":" qname)))
(if colon
(concat (propertize (substring qname 0 colon)
'face
diff --git a/lisp/nxml/rng-cmpct.el b/lisp/nxml/rng-cmpct.el
index 45a69a73f35..dd3000773fd 100644
--- a/lisp/nxml/rng-cmpct.el
+++ b/lisp/nxml/rng-cmpct.el
@@ -26,7 +26,7 @@
;; specified in rng-pttrn.el.
;;
;; RELAX NG Compact Syntax is specified by
-;; http://relaxng.org/compact.html
+;; https://relaxng.org/compact.html
;;
;; This file uses the prefix "rng-c-".
@@ -100,7 +100,7 @@ Return a pattern."
"Regular expression to match a single-quoted literal.")
(defconst rng-c-literal-2-re
- (replace-regexp-in-string "'" "\"" rng-c-literal-1-re)
+ (string-replace "'" "\"" rng-c-literal-1-re)
"Regular expression to match a double-quoted literal.")
(defconst rng-c-ncname-re "\\w+")
@@ -179,7 +179,7 @@ Return a pattern."
(setq rng-c-default-namespace rng-c-inherit-namespace)))
(defun rng-c-expand-name (prefixed-name)
- (let ((i (string-match ":" prefixed-name)))
+ (let ((i (string-search ":" prefixed-name)))
(rng-make-name (rng-c-lookup-prefix (substring prefixed-name
0
i))
@@ -222,7 +222,7 @@ and URI is a symbol.")
(cdr binding)))
(defun rng-c-expand-datatype (prefixed-name)
- (let ((i (string-match ":" prefixed-name)))
+ (let ((i (string-search ":" prefixed-name)))
(rng-make-datatype
(rng-c-lookup-datatype-prefix (substring prefixed-name 0 i))
(substring prefixed-name (+ i 1)))))
@@ -922,4 +922,4 @@ Current token after parse is token following ]."
(provide 'rng-cmpct)
-;;; rng-cmpct.el
+;;; rng-cmpct.el ends here
diff --git a/lisp/nxml/rng-loc.el b/lisp/nxml/rng-loc.el
index d5a608d6ff2..a38da794226 100644
--- a/lisp/nxml/rng-loc.el
+++ b/lisp/nxml/rng-loc.el
@@ -182,7 +182,7 @@ If TYPE-ID is non-nil, then locate the schema for this TYPE-ID."
(while files
(setq type-ids (rng-possible-type-ids-using (car files) type-ids))
(setq files (cdr files)))
- (rng-uniquify-equal (sort type-ids 'string<))))
+ (seq-uniq (sort type-ids 'string<))))
(defun rng-locate-schema-file-using (files)
"Locate a schema using the schema locating files FILES.
diff --git a/lisp/nxml/rng-match.el b/lisp/nxml/rng-match.el
index 4fc6727d0e6..7a2739c0616 100644
--- a/lisp/nxml/rng-match.el
+++ b/lisp/nxml/rng-match.el
@@ -472,7 +472,7 @@ list is nullable and whose cdr is the normalized list."
(cons nullable
(if sorted
head
- (rng-uniquify-eq (sort head 'rng-compare-ipattern))))))
+ (seq-uniq (sort head 'rng-compare-ipattern) #'eq)))))
(defun rng-compare-ipattern (p1 p2)
(< (rng--ipattern-index p1)
diff --git a/lisp/nxml/rng-nxml.el b/lisp/nxml/rng-nxml.el
index 7d74fd3c8a7..d70a346159a 100644
--- a/lisp/nxml/rng-nxml.el
+++ b/lisp/nxml/rng-nxml.el
@@ -24,7 +24,6 @@
;;; Code:
-(require 'easymenu)
(require 'xmltok)
(require 'nxml-util)
(require 'nxml-ns)
@@ -180,7 +179,8 @@ Validation will be enabled if `rng-nxml-auto-validate-flag' is non-nil."
;; attributes are required
(insert " "))))
((member completion extra-strings)
- (insert ">")))))))))
+ (insert ">"))))
+ :company-kind ,(lambda () 'property))))))
(defconst rng-in-end-tag-name-regex
(replace-regexp-in-string
@@ -255,7 +255,8 @@ Validation will be enabled if `rng-nxml-auto-validate-flag' is non-nil."
(when (and (eq status 'finished)
(not (looking-at "=")))
(insert "=\"\"")
- (forward-char -1)))))))))
+ (forward-char -1)))
+ :company-kind ,(lambda (_) 'enum-member)))))))
(defconst rng-in-attribute-value-regex
(replace-regexp-in-string
@@ -280,7 +281,8 @@ Validation will be enabled if `rng-nxml-auto-validate-flag' is non-nil."
(lambda (_completion status)
(when (eq status 'finished)
(let ((delim (char-before value-start)))
- (unless (eq (char-after) delim) (insert delim)))))))
+ (unless (eq (char-after) delim) (insert delim))))))
+ (kind-function (lambda (_) 'value)))
(and (rng-adjust-state-for-attribute lt-pos
name-start)
(if (string= (buffer-substring-no-properties name-start
@@ -291,14 +293,16 @@ Validation will be enabled if `rng-nxml-auto-validate-flag' is non-nil."
(rng-possible-namespace-uris
(and colon
(buffer-substring-no-properties (1+ colon) name-end))))
- :exit-function ,exit-function)
+ :exit-function ,exit-function
+ :company-kind ,kind-function)
(rng-adjust-state-for-attribute-value name-start
colon
name-end)
`(,value-start ,(point)
,(rng-strings-to-completion-table
(rng-match-possible-value-strings))
- :exit-function ,exit-function))))))
+ :exit-function ,exit-function
+ :company-kind ,kind-function))))))
(defun rng-possible-namespace-uris (prefix)
(let ((ns (if prefix (nxml-ns-get-prefix prefix)
@@ -523,7 +527,7 @@ set `xmltok-dtd'. Returns the position of the end of the token."
(unless attribute-flag
(setcdr ns-prefixes (cons nil (cdr ns-prefixes))))))
(setq iter (cdr iter)))
- (rng-uniquify-equal
+ (seq-uniq
(sort (apply #'append
(cons extra-strings
(mapcar (lambda (name)
diff --git a/lisp/nxml/rng-uri.el b/lisp/nxml/rng-uri.el
index fda481fa281..24f4d2ec443 100644
--- a/lisp/nxml/rng-uri.el
+++ b/lisp/nxml/rng-uri.el
@@ -93,7 +93,7 @@ Signal an error if URI is not a valid file URL."
(rng-uri-error "`?' not escaped in file URI `%s'" uri))
(when fragment-id
(rng-uri-error "URI `%s' has a fragment identifier" uri))
- (when (string-match ";" path)
+ (when (string-search ";" path)
(rng-uri-error "`;' not escaped in URI `%s'" uri))
(when (string-match "%2[fF]" path) ;; 2f is hex code of slash
(rng-uri-error "Escaped slash in URI `%s'" uri))
@@ -110,7 +110,7 @@ Signal an error if URI is not a valid file URL."
(rng-uri-unescape-unibyte-replace path 2))
(t
(rng-uri-unescape-unibyte path))))
- (when (string-match "\000" path)
+ (when (string-search "\000" path)
(rng-uri-error "URI `%s' has NUL character in path" uri))
(when (eq pattern 'match)
(setq path
diff --git a/lisp/nxml/rng-util.el b/lisp/nxml/rng-util.el
index a20e95086cb..67e2ee9f1e3 100644
--- a/lisp/nxml/rng-util.el
+++ b/lisp/nxml/rng-util.el
@@ -36,26 +36,6 @@
(defconst rng-builtin-datatypes-uri (rng-make-datatypes-uri ""))
-(defun rng-uniquify-eq (list)
- "Destructively remove `eq' duplicates from LIST."
- (and list
- (let ((head list))
- (while (cdr head)
- (if (eq (car head) (cadr head))
- (setcdr head (cddr head)))
- (setq head (cdr head)))
- list)))
-
-(defun rng-uniquify-equal (list)
- "Destructively remove `equal' duplicates from LIST."
- (and list
- (let ((head list))
- (while (cdr head)
- (if (equal (car head) (cadr head))
- (setcdr head (cddr head)))
- (setq head (cdr head)))
- list)))
-
(defun rng-blank-p (str) (string-match "\\`[ \t\n\r]*\\'" str))
(defun rng-substq (new old list)
@@ -104,6 +84,14 @@ LIST is not modified."
(define-error 'rng-error nil)
+;; Obsolete.
+
+(defun rng-uniquify-eq (list)
+ (declare (obsolete seq-uniq "28.1"))
+ (seq-uniq list #'eq))
+
+(define-obsolete-function-alias 'rng-uniquify-equal #'seq-uniq "28.1")
+
(provide 'rng-util)
;;; rng-util.el ends here
diff --git a/lisp/nxml/rng-xsd.el b/lisp/nxml/rng-xsd.el
index 81314b85ca9..9941aba6eb1 100644
--- a/lisp/nxml/rng-xsd.el
+++ b/lisp/nxml/rng-xsd.el
@@ -24,14 +24,14 @@
;; The main entry point is `rng-xsd-compile'. The validator
;; knows to use this for the datatype library with URI
-;; http://www.w3.org/2001/XMLSchema-datatypes because it
+;; https://www.w3.org/2001/XMLSchema-datatypes because it
;; is the value of the rng-dt-compile property on that URI
;; as a symbol.
;;
;; W3C XML Schema Datatypes are specified by
-;; http://www.w3.org/TR/xmlschema-2/
+;; https://www.w3.org/TR/xmlschema-2/
;; Guidelines for using them with RELAX NG are described in
-;; http://relaxng.org/xsd.html
+;; https://relaxng.org/xsd.html
;;; Code:
diff --git a/lisp/nxml/xmltok.el b/lisp/nxml/xmltok.el
index 8f89598a5ad..38bc2e141e6 100644
--- a/lisp/nxml/xmltok.el
+++ b/lisp/nxml/xmltok.el
@@ -324,8 +324,8 @@ and VALUE-END, otherwise a STRING giving the value."
(setq strs (cons (car arg) strs))
(setq names (cons (cdr arg) names)))
(setq args (cdr args))))
- (cons (apply 'concat (nreverse strs))
- (apply 'append (nreverse names))))))
+ (cons (apply #'concat (nreverse strs))
+ (apply #'append (nreverse names))))))
(eval-when-compile
;; Make a symbolic group named NAME from the regexp R.
@@ -338,7 +338,7 @@ and VALUE-END, otherwise a STRING giving the value."
(cons (concat "\\(" (car ,sym) "\\)") (cons ',name (cdr ,sym)))))))
(defun xmltok-p (&rest r) (xmltok+ "\\(?:"
- (apply 'xmltok+ r)
+ (apply #'xmltok+ r)
"\\)"))
;; Get the group index of ELEM in a LIST of symbols.
@@ -372,22 +372,23 @@ and VALUE-END, otherwise a STRING giving the value."
(defmacro xmltok-defregexp (sym r)
`(defalias ',sym
(let ((r ,r))
- `(macro lambda (action &optional group-name)
- (cond ((eq action 'regexp)
- ,(car r))
- ((or (eq action 'start) (eq action 'beginning))
- (list 'match-beginning (xmltok-get-index group-name
- ',(cdr r))))
- ((eq action 'end)
- (list 'match-end (xmltok-get-index group-name
- ',(cdr r))))
- ((eq action 'string)
- (list 'match-string
- (xmltok-get-index group-name ',(cdr r))))
- ((eq action 'string-no-properties)
- (list 'match-string-no-properties
- (xmltok-get-index group-name ',(cdr r))))
- (t (error "Invalid action: %s" action))))))))
+ `(macro
+ . ,(lambda (action &optional group-name)
+ (cond ((eq action 'regexp)
+ (car r))
+ ((or (eq action 'start) (eq action 'beginning))
+ (list 'match-beginning (xmltok-get-index group-name
+ (cdr r))))
+ ((eq action 'end)
+ (list 'match-end (xmltok-get-index group-name
+ (cdr r))))
+ ((eq action 'string)
+ (list 'match-string
+ (xmltok-get-index group-name (cdr r))))
+ ((eq action 'string-no-properties)
+ (list 'match-string-no-properties
+ (xmltok-get-index group-name (cdr r))))
+ (t (error "Invalid action: %s" action)))))))))
(eval-when-compile
@@ -478,7 +479,7 @@ and VALUE-END, otherwise a STRING giving the value."
"[^<'&\r\n\t]*"
(xmltok-g complex1 "[&\r\n\t][^<']*") opt
"'"))
- (lit2 (cons (replace-regexp-in-string "'" "\"" (car lit1))
+ (lit2 (cons (string-replace "'" "\"" (car lit1))
'(complex2)))
(literal (xmltok-g literal lit1 or lit2))
(name (xmltok+ open (xmltok-g xmlns "xmlns") or ncname close
@@ -878,7 +879,7 @@ and VALUE-END, otherwise a STRING giving the value."
(cons " " value-parts)))))
(< (point) end))))
(when well-formed
- (aset att 5 (apply 'concat (nreverse value-parts))))
+ (aset att 5 (apply #'concat (nreverse value-parts))))
(aset att 6 (nreverse refs))))
(defun xmltok-scan-after-amp (entity-handler)
@@ -1333,7 +1334,7 @@ If LIMIT is non-nil, then do not consider characters beyond LIMIT."
t))))
(if (not well-formed)
nil
- (apply 'concat
+ (apply #'concat
(nreverse (cons (buffer-substring-no-properties start lim)
value-parts))))))
@@ -1358,7 +1359,7 @@ If LIMIT is non-nil, then do not consider characters beyond LIMIT."
(defun xmltok-require-next-token (&rest types)
(xmltok-next-prolog-token)
- (apply 'xmltok-require-token types))
+ (apply #'xmltok-require-token types))
(defun xmltok-require-token (&rest types)
;; XXX Generate a more helpful error message
generated by cgit v1.2.3 (git 2.39.1) at 2024-05-18 00:38:15 +0000