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 (which-func-mode)
  43
  44 (delete (assoc 'which-func-mode mode-line-format) mode-line-format)
  45 (setq which-func-header-line-format
  46               '(which-func-mode
  47                 ("" which-func-format
  48                  )))
  49 (defadvice which-func-ff-hook (after header-line activate)
  50   (when which-func-mode
  51     (delete (assoc 'which-func-mode mode-line-format) mode-line-format)
  52     (setq header-line-format which-func-header-line-format)))
  53
  54 (add-to-list 'which-func-functions 'nxml-where)
  55 (add-to-list 'which-func-modes 'nxml-mode)
  56 (add-to-list 'which-func-non-auto-modes 'nxml-mode)
  57
  58 (add-to-list 'auto-mode-alist '("\\.xslt?\\'" . nxml-mode))
  59 (add-to-list 'auto-mode-alist '("\\.xsd\\'" . nxml-mode))
  60
  61 (require 'hideshow)
  62
  63 (add-to-list 'hs-special-modes-alist '(nxml-mode ("\\(<[^/>]*>\\)$" 1)
  64                                                                                                  "</[^/>]*>$"))
  65 (defun nxml-enable-hs ()
  66   (setq nxml-sexp-element-flag t)
  67   (hs-minor-mode 1))
  68
  69 (add-hook 'nxml-mode-hook 'nxml-enable-hs)
  70
  71 (defun hs-nxml-enter ()
  72   (interactive)
  73   (when (hs-already-hidden-p)
  74         (hs-show-block)
  75         (hs-hide-level 1)
  76         (nxml-forward-element)
  77         (nxml-backward-element)))
  78
  79 (defun hs-nxml-leave ()
  80   (interactive)
  81   (nxml-backward-up-element)
  82   (hs-hide-block)
  83   (nxml-backward-up-element))
  84
  85 (defun hs-nxml-hide-other ()
  86   (interactive)
  87   (let ((p (point)))
  88     (hs-hide-all)
  89     (while (progn (goto-char p) (hs-already-hidden-p))
  90       (hs-nxml-enter))
  91     (hs-show-block)
  92     (goto-char p)
  93     (recenter-top-bottom)))
  94
  95 (define-key nxml-mode-map (kbd "\C-c <left>") 'hs-nxml-leave)
  96 (define-key nxml-mode-map (kbd "\C-c <right>") 'hs-nxml-enter)
  97 (define-key nxml-mode-map (kbd "\C-c @ o") 'hs-nxml-hide-other)
  98
  99 (defun nxml-complete-and-autoclose-element (use-region)
 100   (interactive "P")
 101   (let* ((start (if use-region (setq start (set-marker (make-marker) (region-beginning)))))
 102          (end (setq use-region (set-marker (make-marker) (region-end))))
 103          (beg (and start (= (point) start))))
 104   (save-excursion
 105     (insert " "))
 106   (nxml-complete)
 107   (let ((name (xmltok-start-tag-local-name)))
 108     (delete-char 1)
 109     (if (and start end)
 110         (progn
 111           (if (not beg)
 112               (progn
 113                 (delete-char (- (1+ (length name))))
 114                 (goto-char start)
 115                 (insert "<" name ">"))
 116             (insert ">"))
 117           (goto-char end))
 118       (insert ">"))
 119     (save-excursion
 120       (insert "</" name ">")))))
 121
 122 (define-key nxml-mode-map (kbd "\C-c ." ) 'nxml-complete-and-autoclose-element)
 123 (define-key nxml-mode-map (kbd "\C-c\C-c") 'recompile)
 124
 125 (defconst nxml-docbook-common-elements
 126   '(("section" . ("para" "itemizedlist" "variablelist" "section" "bridgehead" "task" "procedure" "title"))
 127     ("para" . ("emphasis" "code" "replaceable"))
 128     ("emphasis" . ("code"))
 129     ("itemizedlist" . ("listitem"))
 130     ("orderedlist" . ("listitem"))
 131     ("variablelist" . ("varlistentry"))
 132     ("varlistentry" . ("term" "listitem"))
 133     ("term" . ("emphasis" "code" "replaceable"))
 134     ("listitem" . ("para" "itemizedlist"))
 135     ("task" . ("tasksummary" "procedure" "title"))
 136     ("tasksummary" . ("para" "itemizedlist" "variablelist"))
 137     ("procedure" . ("step"))
 138     ("step" . ("para" "procedure"))
 139     ("mathphrase" . ("replaceable" "superscript" "subscript"))
 140     ("title" . ("code" "replaceable"))
 141     ("literallayout" . ("replaceable" "emphasis" "code"))
 142     ("table" . ("title" . "tgroup"))
 143     ("tgroup" . ("colspec" "thead" "tbody"))
 144     ("thead" . ("row"))
 145     ("tbody" . ("row"))
 146     ("row". ("entry"))
 147     ("entry" . ("emphasis" "code"))))
 148
 149 (defvar nxml-docbook-common-elements-next-args nil)
 150
 151 (defun nxml-docbook-make-common-element (&optional start end kill-tag use-index old-tag valid)
 152   (interactive (cond ((and (eq real-last-command 'nxml-docbook-make-common-element)
 153                            nxml-docbook-common-elements-next-args)
 154                       nxml-docbook-common-elements-next-args)
 155                      (current-prefix-arg
 156                       (save-excursion
 157                         (nxml-backward-up-element)
 158                         (let ((tag (xmltok-start-tag-qname)))
 159                           (list (save-excursion
 160                                   (skip-chars-forward "^>")
 161                                   (forward-char 1)
 162                                   (point))
 163                                 (progn
 164                                   (nxml-forward-balanced-item)
 165                                   (skip-chars-backward "^<")
 166                                   (forward-char -1)
 167                                   (point))
 168                                 t nil tag))))
 169                      ((region-active-p)
 170                       (list (region-beginning) (region-end) nil))))
 171   (setq nxml-docbook-common-elements-next-args nil)
 172   (let ((start (set-marker (make-marker) (or start (point))))
 173         (end (set-marker (make-marker) (or end (point)))))
 174     (when kill-tag
 175       (delete-region (save-excursion (goto-char start) (skip-chars-backward "^<") (1- (point))) start)
 176       (delete-region end (save-excursion (goto-char end) (skip-chars-forward "^>") (1+ (point)))))
 177     (save-excursion
 178       (goto-char start)
 179       (let* ((token-end (nxml-token-before))
 180              (start-tag-end
 181               (save-excursion
 182                 (when (and (< (point) token-end)
 183                            (memq xmltok-type
 184                                  '(cdata-section
 185                                    processing-instruction
 186                                    comment
 187                                    start-tag
 188                                    end-tag
 189                                    empty-element)))
 190                   (error "Point is inside a %s"
 191                          (nxml-token-type-friendly-name xmltok-type)))
 192                 (nxml-scan-element-backward token-end t)))
 193              (context (xmltok-start-tag-qname))
 194              (common-elements (cdr (assoc context nxml-docbook-common-elements)))
 195              (valid-elements (or valid
 196                                  (let ((lt-pos (point)))
 197                                    (rng-set-state-after lt-pos)
 198                                    (loop for (ns . name) in (rng-match-possible-start-tag-names)
 199                                          if (not (member name elements)) collect name into elements
 200                                          finally return elements))))
 201              (elements (loop for element in common-elements
 202                              if (member element valid-elements) collect element))
 203              (index (or (and elements
 204                              (or use-index
 205                                  (and old-tag
 206                                       (loop for i from 0
 207                                             for elt in elements
 208                                             if (string= elt old-tag) return (1+ i)
 209                                             finally return 0))))
 210                         0))
 211              (element (and elements (nth index elements))))
 212         (when (not elements)
 213           (error "No common elements for %s" context))
 214         (if element
 215             (progn
 216               (goto-char start)
 217               (insert-before-markers "<" element ">")
 218               (goto-char end)
 219               (insert "</" element ">")
 220               (goto-char end)
 221               (setq nxml-docbook-common-elements-next-args (list (marker-position start)
 222                                                                  (marker-position end)
 223                                                                  t
 224                                                                  (1+ index)
 225                                                                  valid-elements)))
 226           (setq nxml-docbook-common-elements-next-args (list (marker-position start)
 227                                                              (marker-position end)
 228                                                              nil
 229                                                              0
 230                                                              valid-elements)))))))
 231
 232 (defun nxml-just-one-space-or-skip-end ()
 233   (interactive)
 234   (if (looking-at "</")
 235       (progn
 236         (skip-chars-forward "^>")
 237         (forward-char 1))
 238     (just-one-space)))
 239
 240 (define-key nxml-mode-map (kbd "M-RET") 'nxml-docbook-make-common-element)
 241 (define-key nxml-mode-map (kbd "M-SPC") 'nxml-just-one-space-or-skip-end)
 242
 243 (defun nxml-open-line ()
 244   (interactive)
 245   (if (region-active-p)
 246       (let ((start (region-beginning))
 247             (end (region-end))
 248             chars)
 249         (save-excursion
 250           (goto-char end)
 251           (newline-and-indent)
 252           (goto-char start)
 253           (setq chars (- (- (point) (progn (newline-and-indent) (point)))))
 254           (indent-region (+ start chars) (+ end chars))))
 255     (open-line 1)
 256     (save-excursion
 257       (forward-line 1)
 258       (indent-according-to-mode))
 259     (newline-and-indent)))
 260
 261 (defun nxml-split-element ()
 262   (interactive)
 263   (let (element block-p)
 264     (save-excursion
 265       (nxml-backward-up-element)
 266       (setq element (xmltok-start-tag-qname)
 267             block-p (looking-back "^\s-*" (save-excursion (beginning-of-line) (point)))))
 268     (delete-horizontal-space)
 269     (insert "</" element ">")
 270     (fill-paragraph)
 271     (insert "\n")
 272     (newline-and-indent)
 273     (insert "<" element ">")
 274     (fill-paragraph)))
 275
 276 (define-key nxml-mode-map (kbd "M-o") 'nxml-open-line)
 277 (define-key nxml-mode-map (kbd "S-<return>") 'nxml-split-element)