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