company-nxml.el (5708B)
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