setup/nxml.el

   1 (defvar nxml-where-elements-to-id 3)
   2 (defvar nxml-where-max-elements 6)
   3
   4 (require 'cl)
   5
   6 (defun nxml-where ()
   7   "Display the hierarchy of XML elements the point is on as a path."
   8   (and (eq major-mode 'nxml-mode)
   9            (let (path-to-id path-rest)
  10                  (save-excursion
  11                    (save-restriction
  12                          (widen)
  13                          (while (and (not (bobp))
  14                                                  (condition-case nil (progn (nxml-backward-up-element) t) (error nil)))
  15                            (multiple-value-bind
  16                                    (has-id step)
  17                                    (loop with has-id = nil
  18                          with step = (xmltok-start-tag-local-name)
  19                                              for att in xmltok-attributes
  20                                                  if (string= (xmltok-attribute-local-name att) "id")
  21                                                  return (values t (concat "\"" (xmltok-attribute-value att) "\""))
  22                                                  else if (string= (xmltok-attribute-local-name att) "name")
  23                                                  do (setq has-id t step (concat "\"" (xmltok-attribute-value att) "\""))
  24                                                  finally return (values has-id step ))
  25                                  (if (or path-to-id has-id)
  26                                          (setq path-to-id (cons step path-to-id))
  27                                    (setq path-rest (cons step path-rest)))))))
  28                  (let ((path-to-id-len (length path-to-id))
  29                            (path-rest-len (length path-rest)))
  30                    (if (> path-to-id-len nxml-where-elements-to-id)
  31                            (progn
  32                                  (setq path-to-id (nthcdr (- path-to-id-len nxml-where-elements-to-id -1) path-to-id))
  33                                  (setq path-to-id (cons "..." path-to-id))
  34                                  (setq path-to-id-len nxml-where-elements-to-id))
  35                          (setq path-to-id (cons "" path-to-id)))
  36                    (when (> (+ path-to-id-len path-rest-len) nxml-where-max-elements)
  37                          (setq path-rest (nbutlast path-rest (- path-rest-len (- nxml-where-max-elements path-to-id-len) -1)))
  38                          (setq path-rest (nconc path-rest (list "...")))))
  39                  (mapconcat 'identity (nconc path-to-id path-rest) "/"))))
  40
  41 (require 'which-func)
  42
  43 (add-to-list 'which-func-functions 'nxml-where)
  44 (add-to-list 'which-func-modes 'nxml-mode)
  45 (add-to-list 'which-func-non-auto-modes 'nxml-mode)
  46
  47 (add-to-list 'auto-mode-alist '("\\.xslt?\\'" . nxml-mode))
  48 (add-to-list 'auto-mode-alist '("\\.xsd\\'" . nxml-mode))
  49
  50 (require 'hideshow)
  51
  52 (add-to-list 'hs-special-modes-alist '(nxml-mode ("\\(<[^/>]*>\\)$" 1)
  53                                                                                                  "</[^/>]*>$"))
  54 (defun nxml-enable-hs ()
  55   (setq nxml-sexp-element-flag t)
  56   (hs-minor-mode 1))
  57
  58 (add-hook 'nxml-mode-hook 'nxml-enable-hs)
  59
  60 (defun hs-nxml-enter ()
  61   (interactive)
  62   (when (hs-already-hidden-p)
  63         (hs-show-block)
  64         (hs-hide-level 1)
  65         (nxml-forward-element)
  66         (nxml-backward-element)))
  67
  68 (defun hs-nxml-leave ()
  69   (interactive)
  70   (nxml-backward-up-element)
  71   (hs-hide-block)
  72   (nxml-backward-up-element))
  73
  74 (defun hs-nxml-hide-other ()
  75   (interactive)
  76   (let ((p (point)))
  77     (hs-hide-all)
  78     (while (progn (goto-char p) (hs-already-hidden-p))
  79       (hs-nxml-enter))
  80     (hs-show-block)
  81     (goto-char p)
  82     (recenter-top-bottom)))
  83
  84 (define-key nxml-mode-map (kbd "\C-c <left>") 'hs-nxml-leave)
  85 (define-key nxml-mode-map (kbd "\C-c <right>") 'hs-nxml-enter)
  86 (define-key nxml-mode-map (kbd "\C-c @ o") 'hs-nxml-hide-other)
  87
  88 (defun nxml-complete-and-autoclose-element (use-region)
  89   (interactive "P")
  90   (let* ((start (if use-region (setq start (set-marker (make-marker) (region-beginning)))))
  91          (end (setq use-region (set-marker (make-marker) (region-end))))
  92          (beg (and start (= (point) start))))
  93   (save-excursion
  94     (insert " "))
  95   (nxml-complete)
  96   (let ((name (xmltok-start-tag-local-name)))
  97     (delete-char 1)
  98     (if (and start end)
  99         (progn
 100           (if (not beg)
 101               (progn
 102                 (delete-char (- (1+ (length name))))
 103                 (goto-char start)
 104                 (insert "<" name ">"))
 105             (insert ">"))
 106           (goto-char end))
 107       (insert ">"))
 108     (save-excursion
 109       (insert "</" name ">")))))
 110
 111 (define-key nxml-mode-map (kbd "\C-c ." ) 'nxml-complete-and-autoclose-element)
 112 (define-key nxml-mode-map (kbd "\C-c\C-c") 'recompile)
 113
 114 (defconst nxml-docbook-common-elements
 115   '(("section" . ("para" "itemizedlist" "variablelist" "section" "bridgehead" "task" "procedure"))
 116     ("para" . ("emphasis" "code" "replaceable"))
 117     ("emphasis" . ("code"))
 118     ("itemizedlist" . ("listitem"))
 119     ("orderedlist" . ("listitem"))
 120     ("variablelist" . ("varlistentry"))
 121     ("varlistentry" . ("term" "listitem"))
 122     ("term" . ("emphasis" "code"))
 123     ("listitem" . ("para" "itemizedlist"))
 124     ("task" . ("tasksummary" "procedure"))
 125     ("tasksummary" . ("para"))
 126     ("procedure" . ("step"))
 127     ("step" . ("para" "procedure"))
 128     ("mathphrase" . ("replaceable" "superscript" "subscript"))
 129     ("title" . ("code" "replaceable"))
 130     ("literallayout" . ("replaceable" "emphasis" "code"))
 131     ("table" . ("title" . "tgroup"))
 132     ("tgroup" . ("colspec" "thead" "tbody"))
 133     ("thead" . ("row"))
 134     ("tbody" . ("row"))
 135     ("row". ("entry"))
 136     ("entry" . ("emphasis" "code"))))
 137
 138 (defvar nxml-docbook-last-common-element nil)
 139
 140 (defun nxml-docbook-make-common-element (&optional surrounding)
 141   (interactive "P")
 142   (let ((start (set-marker (make-marker) (point)))
 143         (end (set-marker (make-marker) (point)))
 144         do-region)
 145     (when (or (region-active-p)
 146               (and (eq real-last-command 'nxml-docbook-make-common-element)
 147                    (car nxml-docbook-last-common-element))
 148               surrounding)
 149       (save-excursion
 150         (set-marker start
 151                     (if (region-active-p)
 152                         (region-beginning)
 153                       (nxml-backward-up-element)
 154                       (save-excursion
 155                         (skip-chars-forward "^>")
 156                         (forward-char 1)
 157                         (point))))
 158         (set-marker end
 159                     (if (region-active-p)
 160                         (region-end)
 161                       (nxml-forward-balanced-item)
 162                       (skip-chars-backward "^<")
 163                       (forward-char -1)
 164                       (point))))
 165       (message "do-mark %s %s" start end)
 166       (setq do-region t))
 167     (message "cycle? %s %s" real-last-command nxml-docbook-last-common-element)
 168     (when (or (and (eq real-last-command 'nxml-docbook-make-common-element)
 169                    (cdr nxml-docbook-last-common-element))
 170               surrounding)
 171       (delete-region (save-excursion (skip-chars-backward "^<") (1- (point))) start)
 172       (delete-region end (save-excursion (skip-chars-forward "^>") (1+ (point)))))
 173     (let* ((token-end (nxml-token-before))
 174            (start-tag-end
 175             (save-excursion
 176               (when (and (< (point) token-end)
 177                          (memq xmltok-type
 178                                '(cdata-section
 179                                  processing-instruction
 180                                  comment
 181                                  start-tag
 182                                  end-tag
 183                                  empty-element)))
 184                 (setq nxml-docbook-last-common-element nil)
 185                 (error "Point is inside a %s"
 186                        (nxml-token-type-friendly-name xmltok-type)))
 187               (nxml-scan-element-backward token-end t)))
 188            (context (xmltok-start-tag-qname))
 189            (elements (cdr (assoc context nxml-docbook-common-elements)))
 190 ; List valid start tags at point (using schema):
 191 ; (let ((lt-pos (point))) (rng-set-state-after lt-pos) (loop for (ns . name) in (rng-match-possible-start-tag-names) collect name))
 192            (index (if (and elements
 193                            (eq real-last-command 'nxml-docbook-make-common-element)
 194                            (cdr nxml-docbook-last-common-element))
 195                       (1+ (cdr nxml-docbook-last-common-element))
 196                     0))
 197            (element (and elements (nth index elements))))
 198       (when (not elements)
 199         (setq nxml-docbook-last-common-element nil)
 200         (error "No common elements for %s" context))
 201       (if element
 202           (progn
 203             (goto-char start)
 204             (insert-before-markers "<" element ">")
 205             (goto-char end)
 206             (insert "</" element ">")
 207             (goto-char end)
 208             (setq nxml-docbook-last-common-element (cons do-region index)))
 209         (setq nxml-docbook-last-common-element (cons do-region nil)))
 210       (when do-region
 211         (set-mark start)
 212         (message  "Fiddlesticks: %s %s %s" (mark t) mark-active (region-active-p))))))
 213
 214 (defun nxml-just-one-space-or-skip-end ()
 215   (interactive)
 216   (if (looking-at "</")
 217       (progn
 218         (skip-chars-forward "^>")
 219         (forward-char 1))
 220     (just-one-space)))
 221
 222 (define-key nxml-mode-map (kbd "M-RET") 'nxml-docbook-make-common-element)
 223 (define-key nxml-mode-map (kbd "M-SPC") 'nxml-just-one-space-or-skip-end)
 224
 225 (defun nxml-open-line ()
 226   (interactive)
 227   (open-line 1)
 228   (save-excursion
 229     (forward-line 1)
 230     (indent-according-to-mode))
 231   (newline-and-indent))
 232
 233 (define-key nxml-mode-map (kbd "M-o") 'nxml-open-line)