* lisp/nxml: Use standard completion; it also works for company-mode

* lisp/nxml/nxml-mode.el (nxml-complete): Obsolete.
(nxml-completion-at-point-function): Remove.
(nxml-mode): Don't set completion-at-point-functions.
* lisp/nxml/rng-nxml.el (rng-nxml-mode-init): Set it here instead.
(rng-completion-at-point): Rename from rng-complete and mark it
non-interactive.  It is now to be used as completion-at-point-function.
(rng-complete-tag, rng-complete-end-tag, rng-complete-attribute-name)
(rng-complete-attribute-value): Don't perform completion, but return
completion data instead.
(rng-complete-qname-function, rng-generate-qname-list): Add a few
arguments, previously passed via dynamic coping.
(rng-strings-to-completion-table): Rename from
rng-strings-to-completion-alist.  Don't return an alist.  Don't both
sorting and uniquifying.

* lisp/nxml/rng-util.el (rng-complete-before-point): Delete function.
(rng-completion-exact-p, rng-quote-string): Delete functions.

* lisp/nxml/rng-valid.el (rng-recover-start-tag-open)
(rng-missing-attributes-message, rng-missing-element-message)
(rng-mark-missing-end-tags): Use explicit ".." in formats rather than
calling rng-quote-string everywhere.

4 files changed, 115 insertions, 234 deletions

diff --git a/lisp/nxml/nxml-mode.el b/lisp/nxml/nxml-mode.el
index b7a4e2e2469..c6600b185e6 100644
--- a/lisp/nxml/nxml-mode.el
+++ b/lisp/nxml/nxml-mode.el
@@ -535,8 +535,6 @@ Many aspects this mode can be customized using
         (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)
 
@@ -557,7 +555,6 @@ Many aspects this mode can be customized using
           t    ; keywords-only; we highlight comments and strings here
           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)))
@@ -1577,30 +1574,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
 
diff --git a/lisp/nxml/rng-nxml.el b/lisp/nxml/rng-nxml.el
index 467f7af0bb7..954a1eb9599 100644
--- a/lisp/nxml/rng-nxml.el
+++ b/lisp/nxml/rng-nxml.el
@@ -111,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 '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 'completion-at-point-functions #'rng-completion-at-point 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)
-
-(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)
@@ -149,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
@@ -220,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
@@ -264,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
@@ -296,36 +272,33 @@ 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)
@@ -505,17 +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)
-  (complete-with-action flag (rng-generate-qname-list string) string predicate))
+(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)
+(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))
@@ -523,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)
@@ -543,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
+		  (cons extra-strings
 			(mapcar (lambda (name)
 				  (if (car name)
 				      (mapcar (lambda (prefix)
@@ -560,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)
@@ -579,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-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 9b0b4df67f8..946bf791ff8 100644
--- a/lisp/nxml/rng-valid.el
+++ b/lisp/nxml/rng-valid.el
@@ -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)))