code.delx.au - gnu-emacs-elpa/blob - company-nxml.el

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