* 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)))