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

   1 ;;; company-nxml.el --- a company-mode completion back-end for nxml-mode
   2
   3 ;; Copyright (C) 2009, 2010 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 <http://www.gnu.org/licenses/>.
  21
  22 ;;; Code:
  23
  24 (require 'company)
  25 (require 'nxml-mode)
  26 (require 'rng-nxml)
  27 (eval-when-compile (require 'cl))
  28
  29 (defconst company-nxml-token-regexp
  30   "\\(?:[_[:alpha:]][-._[:alnum:]]*\\_>\\)")
  31
  32 (defvar company-nxml-in-attribute-value-regexp
  33   (replace-regexp-in-string "w" company-nxml-token-regexp
  34    "<w\\(?::w\\)?\
  35 \\(?:[ \t\r\n]+w\\(?::w\\)?[ \t\r\n]*=\
  36 [ \t\r\n]*\\(?:\"[^\"]*\"\\|'[^']*'\\)\\)*\
  37 [ \t\r\n]+\\(w\\(:w\\)?\\)[ \t\r\n]*=[ \t\r\n]*\
  38 \\(\"\\([^\"]*\\>\\)\\|'\\([^']*\\>\\)\\)\\="
  39    t t))
  40
  41 (defvar company-nxml-in-tag-name-regexp
  42   (replace-regexp-in-string "w" company-nxml-token-regexp
  43                             "<\\(/?w\\(?::w?\\)?\\)?\\=" t t))
  44
  45 (defun company-nxml-all-completions (prefix alist)
  46   (let ((candidates (mapcar 'cdr alist))
  47         (case-fold-search nil)
  48         filtered)
  49     (when (cdar rng-open-elements)
  50       (push (concat "/" (cdar rng-open-elements)) candidates))
  51     (setq candidates (sort (all-completions prefix candidates) 'string<))
  52     (while candidates
  53       (unless (equal (car candidates) (car filtered))
  54         (push (car candidates) filtered))
  55       (pop candidates))
  56     (nreverse filtered)))
  57
  58 (defmacro company-nxml-prepared (&rest body)
  59   (declare (indent 0) (debug t))
  60   `(let ((lt-pos (save-excursion (search-backward "<" nil t)))
  61          xmltok-dtd)
  62      (when (and lt-pos (= (rng-set-state-after lt-pos) lt-pos))
  63        ,@body)))
  64
  65 (defun company-nxml-tag (command &optional arg &rest ignored)
  66   (case command
  67     ('prefix (and (derived-mode-p 'nxml-mode)
  68                   rng-validate-mode
  69                   (company-grab company-nxml-in-tag-name-regexp 1)))
  70     ('candidates (company-nxml-prepared
  71                    (company-nxml-all-completions arg
  72                     (rng-match-possible-start-tag-names))))
  73     ('sorted t)))
  74
  75 (defun company-nxml-attribute (command &optional arg &rest ignored)
  76   (case command
  77     ('prefix (and (derived-mode-p 'nxml-mode)
  78                   rng-validate-mode
  79                   (memq (char-after) '(?\  ?\t ?\n)) ;; outside word
  80                   (company-grab rng-in-attribute-regex 1)))
  81     ('candidates (company-nxml-prepared
  82                    (and (rng-adjust-state-for-attribute
  83                          lt-pos (- (point) (length arg)))
  84                         (company-nxml-all-completions arg
  85                          (rng-match-possible-attribute-names)))))
  86     ('sorted t)))
  87
  88 (defun company-nxml-attribute-value (command &optional arg &rest ignored)
  89   (case command
  90     ('prefix (and (derived-mode-p 'nxml-mode)
  91                   rng-validate-mode
  92                   (and (memq (char-after) '(?' ?\" ?\  ?\t ?\n)) ;; outside word
  93                        (looking-back company-nxml-in-attribute-value-regexp)
  94                        (or (match-string-no-properties 4)
  95                            (match-string-no-properties 5)
  96                            ""))))
  97     ('candidates (company-nxml-prepared
  98                    (let (attr-start attr-end colon)
  99                      (and (looking-back rng-in-attribute-value-regex lt-pos)
 100                           (setq colon (match-beginning 2)
 101                                 attr-start (match-beginning 1)
 102                                 attr-end (match-end 1))
 103                           (rng-adjust-state-for-attribute lt-pos attr-start)
 104                           (rng-adjust-state-for-attribute-value
 105                            attr-start colon attr-end)
 106                           (all-completions arg
 107                            (rng-match-possible-value-strings))))))))
 108
 109 ;;;###autoload
 110 (defun company-nxml (command &optional arg &rest ignored)
 111   "A `company-mode' completion back-end for `nxml-mode'."
 112   (interactive (list 'interactive))
 113   (case command
 114     ('interactive (company-begin-backend 'company-nxml))
 115     ('prefix (or (company-nxml-tag 'prefix)
 116                  (company-nxml-attribute 'prefix)
 117                  (company-nxml-attribute-value 'prefix)))
 118     ('candidates (cond
 119                   ((company-nxml-tag 'prefix)
 120                    (company-nxml-tag 'candidates arg))
 121                   ((company-nxml-attribute 'prefix)
 122                    (company-nxml-attribute 'candidates arg))
 123                   ((company-nxml-attribute-value 'prefix)
 124                    (sort (company-nxml-attribute-value 'candidates arg)
 125                          'string<))))
 126     ('sorted t)))
 127
 128 (provide 'company-nxml)
 129 ;;; company-nxml.el ends here