djavu-asus/emacs/elpa/company-20230926.32/company-nxml.el

   1 ;;; company-nxml.el --- company-mode completion backend for nxml-mode
   2
   3 ;; Copyright (C) 2009-2011, 2013-2015, 2017-2018  Free Software Foundation, Inc.
   4
   5 ;; Author: Nikolaj Schumacher
   6
   7 ;; This file is part of GNU Emacs.
   8
   9 ;; GNU Emacs is free software: you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation, either version 3 of the License, or
  12 ;; (at your option) any later version.
  13
  14 ;; GNU Emacs is distributed in the hope that it will be useful,
  15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
  21
  22
  23 ;;; Commentary:
  24 ;;
  25 ;; In Emacs >= 26, company-capf is used instead.
  26
  27 ;;; Code:
  28
  29 (require 'company)
  30 (require 'cl-lib)
  31
  32 (defvar rng-open-elements)
  33 (defvar rng-validate-mode)
  34 (defvar rng-in-attribute-regex)
  35 (defvar rng-in-attribute-value-regex)
  36 (declare-function rng-set-state-after "rng-nxml")
  37 (declare-function rng-match-possible-start-tag-names "rng-match")
  38 (declare-function rng-adjust-state-for-attribute "rng-nxml")
  39 (declare-function rng-match-possible-attribute-names "rng-match")
  40 (declare-function rng-adjust-state-for-attribute-value "rng-nxml")
  41 (declare-function rng-match-possible-value-strings "rng-match")
  42
  43 (defconst company-nxml-token-regexp
  44   "\\(?:[_[:alpha:]][-._[:alnum:]]*\\_>\\)")
  45
  46 (defvar company-nxml-in-attribute-value-regexp
  47   (replace-regexp-in-string "w" company-nxml-token-regexp
  48    "<w\\(?::w\\)?\
  49 \\(?:[ \t\r\n]+w\\(?::w\\)?[ \t\r\n]*=\
  50 \[ \t\r\n]*\\(?:\"[^\"]*\"\\|'[^']*'\\)\\)*\
  51 \[ \t\r\n]+\\(w\\(:w\\)?\\)[ \t\r\n]*=[ \t\r\n]*\
  52 \\(\"\\([^\"]*\\>\\)\\|'\\([^']*\\>\\)\\)\\="
  53    t t))
  54
  55 (defvar company-nxml-in-tag-name-regexp
  56   (replace-regexp-in-string "w" company-nxml-token-regexp
  57                             "<\\(/?w\\(?::w?\\)?\\)?\\=" t t))
  58
  59 (defun company-nxml-all-completions (prefix alist)
  60   (let ((candidates (mapcar 'cdr alist))
  61         (case-fold-search nil)
  62         filtered)
  63     (when (cdar rng-open-elements)
  64       (push (concat "/" (cdar rng-open-elements)) candidates))
  65     (setq candidates (sort (all-completions prefix candidates) 'string<))
  66     (while candidates
  67       (unless (equal (car candidates) (car filtered))
  68         (push (car candidates) filtered))
  69       (pop candidates))
  70     (nreverse filtered)))
  71
  72 (defmacro company-nxml-prepared (&rest body)
  73   (declare (indent 0) (debug t))
  74   `(let ((lt-pos (save-excursion (search-backward "<" nil t)))
  75          xmltok-dtd)
  76      (when (and lt-pos (= (rng-set-state-after lt-pos) lt-pos))
  77        ,@body)))
  78
  79 (defun company-nxml-tag (command &optional arg &rest ignored)
  80   (cl-case command
  81     (prefix (and (derived-mode-p 'nxml-mode)
  82                  rng-validate-mode
  83                  (company-grab company-nxml-in-tag-name-regexp 1)))
  84     (candidates (company-nxml-prepared
  85                  (company-nxml-all-completions
  86                   arg (rng-match-possible-start-tag-names))))
  87     (sorted t)))
  88
  89 (defun company-nxml-attribute (command &optional arg &rest ignored)
  90   (cl-case command
  91     (prefix (and (derived-mode-p 'nxml-mode)
  92                  rng-validate-mode
  93                  (memq (char-after) '(?\  ?\t ?\n)) ;; outside word
  94                  (company-grab rng-in-attribute-regex 1)))
  95     (candidates (company-nxml-prepared
  96                  (and (rng-adjust-state-for-attribute
  97                        lt-pos (- (point) (length arg)))
  98                       (company-nxml-all-completions
  99                        arg (rng-match-possible-attribute-names)))))
 100     (sorted t)))
 101
 102 (defun company-nxml-attribute-value (command &optional arg &rest ignored)
 103   (cl-case command
 104     (prefix (and (derived-mode-p 'nxml-mode)
 105                  rng-validate-mode
 106                  (and (memq (char-after) '(?' ?\" ?\  ?\t ?\n)) ;; outside word
 107                       (looking-back company-nxml-in-attribute-value-regexp nil)
 108                       (or (match-string-no-properties 4)
 109                           (match-string-no-properties 5)
 110                           ""))))
 111     (candidates (company-nxml-prepared
 112                  (let (attr-start attr-end colon)
 113                    (and (looking-back rng-in-attribute-value-regex lt-pos)
 114                         (setq colon (match-beginning 2)
 115                               attr-start (match-beginning 1)
 116                               attr-end (match-end 1))
 117                         (rng-adjust-state-for-attribute lt-pos attr-start)
 118                         (rng-adjust-state-for-attribute-value
 119                          attr-start colon attr-end)
 120                         (all-completions
 121                          arg (rng-match-possible-value-strings))))))))
 122
 123 ;;;###autoload
 124 (defun company-nxml (command &optional arg &rest ignored)
 125   "`company-mode' completion backend for `nxml-mode'."
 126   (interactive (list 'interactive))
 127   (cl-case command
 128     (interactive (company-begin-backend 'company-nxml))
 129     (prefix (or (company-nxml-tag 'prefix)
 130                 (company-nxml-attribute 'prefix)
 131                 (company-nxml-attribute-value 'prefix)))
 132     (candidates (cond
 133                  ((company-nxml-tag 'prefix)
 134                   (company-nxml-tag 'candidates arg))
 135                  ((company-nxml-attribute 'prefix)
 136                   (company-nxml-attribute 'candidates arg))
 137                  ((company-nxml-attribute-value 'prefix)
 138                   (sort (company-nxml-attribute-value 'candidates arg)
 139                         'string<))))
 140     (sorted t)))
 141
 142 (provide 'company-nxml)
 143 ;;; company-nxml.el ends here