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

   1 (require 'company)
   2 (require 'nxml-mode)
   3 (require 'rng-nxml)
   4 (eval-when-compile (require 'cl))
   5
   6 (defconst company-nxml-token-regexp
   7   "\\(?:[_[:alpha:]][-._[:alnum:]]*\\_>\\)")
   8
   9 (defvar company-nxml-in-attribute-value-regexp
  10   (replace-regexp-in-string "w" company-nxml-token-regexp
  11    "<w\\(?::w\\)?\
  12 \\(?:[ \t\r\n]+w\\(?::w\\)?[ \t\r\n]*=\
  13 [ \t\r\n]*\\(?:\"[^\"]*\"\\|'[^']*'\\)\\)*\
  14 [ \t\r\n]+\\(w\\(:w\\)?\\)[ \t\r\n]*=[ \t\r\n]*\
  15 \\(\"\\([^\"]*\\>\\)\\|'\\([^']*\\>\\)\\)\\="
  16    t t))
  17
  18 (defvar company-nxml-in-tag-name-regexp
  19   (replace-regexp-in-string "w" company-nxml-token-regexp
  20                             "<\\(/?w\\(?::w?\\)?\\)?\\=" t t))
  21
  22 (defun company-nxml-all-completions (prefix alist)
  23   (let ((candidates (mapcar 'cdr alist))
  24         (case-fold-search nil)
  25         filtered)
  26     (when (cdar rng-open-elements)
  27       (push (concat "/" (cdar rng-open-elements)) candidates))
  28     (setq candidates (sort (all-completions prefix candidates) 'string<))
  29     (while candidates
  30       (unless (equal (car candidates) (car filtered))
  31         (push (car candidates) filtered))
  32       (pop candidates))
  33     (nreverse filtered)))
  34
  35 (defmacro company-nxml-prepared (&rest body)
  36   (declare (indent 0) (debug t))
  37   `(let ((lt-pos (save-excursion (search-backward "<" nil t)))
  38          xmltok-dtd)
  39      (when (and lt-pos (= (rng-set-state-after lt-pos) lt-pos))
  40        ,@body)))
  41
  42 (defun company-nxml-tag (command &optional arg &rest ignored)
  43   (case command
  44     ('prefix (and (eq major-mode 'nxml-mode)
  45                   rng-validate-mode
  46                   (company-grab company-nxml-in-tag-name-regexp 1)))
  47     ('candidates (company-nxml-prepared
  48                    (company-nxml-all-completions arg
  49                     (rng-match-possible-start-tag-names))))
  50     ('sorted t)))
  51
  52 (defun company-nxml-attribute (command &optional arg &rest ignored)
  53   (case command
  54     ('prefix (and (eq major-mode 'nxml-mode)
  55                   rng-validate-mode
  56                   (memq (char-after) '(?\  ?\t ?\n)) ;; outside word
  57                   (company-grab rng-in-attribute-regex 1)))
  58     ('candidates (company-nxml-prepared
  59                    (and (rng-adjust-state-for-attribute
  60                          lt-pos (- (point) (length arg)))
  61                         (company-nxml-all-completions arg
  62                          (rng-match-possible-attribute-names)))))
  63     ('sorted t)))
  64
  65 (defun company-nxml-attribute-value (command &optional arg &rest ignored)
  66   (case command
  67     ('prefix (and (eq major-mode 'nxml-mode)
  68                   rng-validate-mode
  69                   (and (memq (char-after) '(?' ?\" ?\  ?\t ?\n)) ;; outside word
  70                        (looking-back company-nxml-in-attribute-value-regexp)
  71                        (or (match-string-no-properties 4)
  72                            (match-string-no-properties 5)
  73                            ""))))
  74     ('candidates (company-nxml-prepared
  75                    (let (attr-start attr-end colon)
  76                      (and (looking-back rng-in-attribute-value-regex lt-pos)
  77                           (setq colon (match-beginning 2)
  78                                 attr-start (match-beginning 1)
  79                                 attr-end (match-end 1))
  80                           (rng-adjust-state-for-attribute lt-pos attr-start)
  81                           (rng-adjust-state-for-attribute-value
  82                            attr-start colon attr-end)
  83                           (all-completions arg
  84                            (rng-match-possible-value-strings))))))))
  85
  86 (defun company-nxml (command &optional arg &rest ignored)
  87   (case command
  88     ('prefix (or (company-nxml-tag 'prefix)
  89                  (company-nxml-attribute 'prefix)
  90                  (company-nxml-attribute-value 'prefix)))
  91     ('candidates (cond
  92                   ((company-nxml-tag 'prefix)
  93                    (company-nxml-tag 'candidates arg))
  94                   ((company-nxml-attribute 'prefix)
  95                    (company-nxml-attribute 'candidates arg))
  96                   ((company-nxml-attribute-value 'prefix)
  97                    (sort (company-nxml-attribute-value 'candidates arg)
  98                          'string<))))
  99     ('sorted t)))
 100
 101 (provide 'company-nxml)
 102 ;;; company-nxml.el ends here