setup/nxml.el

   1 (defvar nxml-where-elements-to-id 3)
   2 (defvar nxml-where-max-elements 6)
   3
   4 (require 'cl)
   5 (require 'nxml-mode)
   6
   7 (defun nxml-where ()
   8   "Display the hierarchy of XML elements the point is on as a path."
   9   (and (eq major-mode 'nxml-mode)
  10            (let (path-to-id path-rest)
  11                  (save-excursion
  12                    (save-restriction
  13                          (widen)
  14                          (while (and (not (bobp))
  15                                      (condition-case nil (progn (nxml-backward-up-element) t)
  16                                        (error nil)))
  17                            (multiple-value-bind
  18                                (has-id step)
  19                                (loop with has-id = nil
  20                                          with step = (xmltok-start-tag-local-name)
  21                                          for att in xmltok-attributes
  22                                          if (string= (xmltok-attribute-local-name att) "id")
  23                                          return (values t (concat "\""
  24                                                                   (xmltok-attribute-value att)
  25                                                                   "\""))
  26                                          else if (string= (xmltok-attribute-local-name att) "name")
  27                                          do (setq has-id t
  28                                                   step (concat "\""
  29                                                                (xmltok-attribute-value att)
  30                                                                "\""))
  31                                          finally return (values has-id step ))
  32                              (if (or path-to-id has-id)
  33                                  (setq path-to-id (cons step path-to-id))
  34                                (setq path-rest (cons step path-rest)))))))
  35                  (let ((path-to-id-len (length path-to-id))
  36                            (path-rest-len (length path-rest)))
  37                    (if (> path-to-id-len nxml-where-elements-to-id)
  38                            (progn
  39                                  (setq path-to-id (nthcdr (- path-to-id-len
  40                                                              nxml-where-elements-to-id
  41                                                              -1) path-to-id))
  42                                  (setq path-to-id (cons "..." path-to-id))
  43                                  (setq path-to-id-len nxml-where-elements-to-id))
  44                          (setq path-to-id (cons "" path-to-id)))
  45                    (when (> (+ path-to-id-len path-rest-len) nxml-where-max-elements)
  46                          (setq path-rest (nbutlast path-rest (- path-rest-len
  47                                                                 (- nxml-where-max-elements
  48                                                                    path-to-id-len)
  49                                                                 -1)))
  50                          (setq path-rest (nconc path-rest (list "...")))))
  51                  (mapconcat 'identity (nconc path-to-id path-rest) "/"))))
  52
  53 (require 'which-func)
  54 (which-func-mode)
  55
  56 (delete (assoc 'which-func-mode mode-line-format) mode-line-format)
  57 (setq which-func-header-line-format
  58               '(which-func-mode
  59                 ("" which-func-format
  60                  )))
  61 (defadvice which-func-ff-hook (after header-line activate)
  62   (when which-func-mode
  63     (delete (assoc 'which-func-mode mode-line-format) mode-line-format)
  64     (setq header-line-format which-func-header-line-format)))
  65
  66 (add-to-list 'which-func-functions 'nxml-where)
  67 (add-to-list 'which-func-modes 'nxml-mode)
  68 (add-to-list 'which-func-non-auto-modes 'nxml-mode)
  69
  70 (add-to-list 'auto-mode-alist '("\\.xslt?\\'" . nxml-mode))
  71 (add-to-list 'auto-mode-alist '("\\.xsd\\'" . nxml-mode))
  72
  73 (require 'hideshow)
  74
  75 (add-to-list 'hs-special-modes-alist '(nxml-mode ("\\(<[^/>]*>\\)$" 1) "</[^/>]*>$"))
  76
  77 (defun nxml-setup ()
  78   (setq nxml-sexp-element-flag t)
  79   (hs-minor-mode 1)
  80   (setq tab-width 2)
  81   (toggle-whitespace-mode 'tabs))
  82
  83 (add-hook 'nxml-mode-hook 'nxml-setup)
  84
  85 (defun hs-nxml-enter ()
  86   (interactive)
  87   (when (hs-already-hidden-p)
  88         (hs-show-block)
  89         (hs-hide-level 1)
  90         (nxml-forward-element)
  91         (nxml-backward-element)))
  92
  93 (defun hs-nxml-leave ()
  94   (interactive)
  95   (nxml-backward-up-element)
  96   (hs-hide-block)
  97   (nxml-backward-up-element))
  98
  99 (defun hs-nxml-hide-other ()
 100   (interactive)
 101   (let ((p (point)))
 102     (hs-hide-all)
 103     (while (progn (goto-char p) (hs-already-hidden-p))
 104       (hs-nxml-enter))
 105     (hs-show-block)
 106     (goto-char p)
 107     (recenter-top-bottom)))
 108
 109 (define-key nxml-mode-map (kbd "\C-c <left>") 'hs-nxml-leave)
 110 (define-key nxml-mode-map (kbd "\C-c <right>") 'hs-nxml-enter)
 111 (define-key nxml-mode-map (kbd "\C-c @ o") 'hs-nxml-hide-other)
 112
 113 (defun nxml-complete-and-autoclose-element (use-region)
 114   (interactive "P")
 115   (let* ((start (if use-region (setq start (set-marker (make-marker) (region-beginning)))))
 116          (end (setq use-region (set-marker (make-marker) (region-end))))
 117          (beg (and start (= (point) start))))
 118   (save-excursion
 119     (insert " "))
 120   (nxml-complete)
 121   (let ((name (xmltok-start-tag-local-name)))
 122     (delete-char 1)
 123     (if (and start end)
 124         (progn
 125           (if (not beg)
 126               (progn
 127                 (delete-char (- (1+ (length name))))
 128                 (goto-char start)
 129                 (insert "<" name ">"))
 130             (insert ">"))
 131           (goto-char end))
 132       (insert ">"))
 133     (save-excursion
 134       (insert "</" name ">")))))
 135
 136 (define-key nxml-mode-map (kbd "\C-c .") 'nxml-complete-and-autoclose-element)
 137 (define-key nxml-mode-map (kbd "\C-c ,") 'nxml-complete)
 138
 139 (define-key nxml-mode-map (kbd "\C-c\C-c") 'recompile)
 140
 141 (defconst nxml-docbook-common-elements
 142   '(("section" . ("para" "itemizedlist" "variablelist" "section" "bridgehead" "task" "procedure"
 143                   "title"))
 144     ("refsect1" . ("title" "para" "itemizedlist" "variablelist" "screen" "refsect2"))
 145     ("refsect2" . ("title" "para" "itemizedlilst" "variablelist" "screen"))
 146     ("para" . ("emphasis" "code" "replaceable" "literal"))
 147     ("emphasis" . ("code"))
 148     ("itemizedlist" . ("listitem"))
 149     ("orderedlist" . ("listitem"))
 150     ("variablelist" . ("varlistentry"))
 151     ("varlistentry" . ("term" "listitem"))
 152     ("term" . ("emphasis" "literal" "replaceable" "option"))
 153     ("listitem" . ("para" "itemizedlist"))
 154     ("task" . ("tasksummary" "procedure" "title"))
 155     ("tasksummary" . ("para" "itemizedlist" "variablelist"))
 156     ("procedure" . ("step"))
 157     ("step" . ("para" "procedure"))
 158     ("mathphrase" . ("replaceable" "superscript" "subscript"))
 159     ("title" . ("code" "replaceable"))
 160     ("literallayout" . ("replaceable" "emphasis" "code"))
 161     ("table" . ("title" . "tgroup"))
 162     ("tgroup" . ("colspec" "thead" "tbody"))
 163     ("thead" . ("row"))
 164     ("tbody" . ("row"))
 165     ("row". ("entry"))
 166     ("entry" . ("emphasis" "code"))))
 167
 168 (defvar nxml-docbook-common-elements-next-args nil)
 169
 170 (defun nxml-docbook-make-common-element (&optional start end kill-tag use-index old-tag valid)
 171   (interactive (cond ((and (eq real-last-command 'nxml-docbook-make-common-element)
 172                            nxml-docbook-common-elements-next-args)
 173                       nxml-docbook-common-elements-next-args)
 174                      (current-prefix-arg
 175                       (save-excursion
 176                         (nxml-backward-up-element)
 177                         (let ((tag (xmltok-start-tag-qname)))
 178                           (list (save-excursion
 179                                   (skip-chars-forward "^>")
 180                                   (forward-char 1)
 181                                   (point))
 182                                 (progn
 183                                   (nxml-forward-balanced-item)
 184                                   (skip-chars-backward "^<")
 185                                   (forward-char -1)
 186                                   (point))
 187                                 t nil tag))))
 188                      ((region-active-p)
 189                       (list (region-beginning) (region-end) nil))))
 190   (setq nxml-docbook-common-elements-next-args nil)
 191   (let ((start (set-marker (make-marker) (or start (point))))
 192         (end (set-marker (make-marker) (or end (point)))))
 193     (when kill-tag
 194       (delete-region (save-excursion
 195                        (goto-char start) (skip-chars-backward "^<") (1- (point))) start)
 196       (delete-region end (save-excursion
 197                            (goto-char end) (skip-chars-forward "^>") (1+ (point)))))
 198     (save-excursion
 199       (goto-char start)
 200       (let* ((token-end (nxml-token-before))
 201              (start-tag-end
 202               (save-excursion
 203                 (when (and (< (point) token-end)
 204                            (memq xmltok-type
 205                                  '(cdata-section
 206                                    processing-instruction
 207                                    comment
 208                                    start-tag
 209                                    end-tag
 210                                    empty-element)))
 211                   (error "Point is inside a %s"
 212                          (nxml-token-type-friendly-name xmltok-type)))
 213                 (nxml-scan-element-backward token-end t)))
 214              (context (xmltok-start-tag-qname))
 215              (common-elements (cdr (assoc context nxml-docbook-common-elements)))
 216              (valid-elements (or valid
 217                                  (let ((lt-pos (point)))
 218                                    (rng-set-state-after lt-pos)
 219                                    (loop for (ns . name) in (rng-match-possible-start-tag-names)
 220                                          if (not (member name elements)) collect name into elements
 221                                          finally return elements))))
 222              (elements (loop for element in common-elements
 223                              if (member element valid-elements) collect element))
 224              (index (or (and elements
 225                              (or use-index
 226                                  (and old-tag
 227                                       (loop for i from 0
 228                                             for elt in elements
 229                                             if (string= elt old-tag) return (1+ i)
 230                                             finally return 0))))
 231                         0))
 232              (element (and elements (nth index elements))))
 233         (when (not elements)
 234           (error "No common elements for %s" context))
 235         (if element
 236             (progn
 237               (goto-char start)
 238               (insert-before-markers "<" element ">")
 239               (goto-char end)
 240               (insert "</" element ">")
 241               (goto-char end)
 242               (setq nxml-docbook-common-elements-next-args (list (marker-position start)
 243                                                                  (marker-position end)
 244                                                                  t
 245                                                                  (1+ index)
 246                                                                  valid-elements)))
 247           (setq nxml-docbook-common-elements-next-args (list (marker-position start)
 248                                                              (marker-position end)
 249                                                              nil
 250                                                              0
 251                                                              valid-elements)))))))
 252
 253 (defun nxml-just-one-space-or-skip-end ()
 254   (interactive)
 255   (if (looking-at "</")
 256       (progn
 257         (skip-chars-forward "^>")
 258         (forward-char 1))
 259     (just-one-space)))
 260
 261 (define-key nxml-mode-map (kbd "M-RET") 'nxml-docbook-make-common-element)
 262 (define-key nxml-mode-map (kbd "M-SPC") 'nxml-just-one-space-or-skip-end)
 263
 264 (defun nxml-open-line ()
 265   (interactive)
 266   (if (region-active-p)
 267       (let ((start (region-beginning))
 268             (end (region-end))
 269             chars)
 270         (save-excursion
 271           (goto-char end)
 272           (newline-and-indent)
 273           (goto-char start)
 274           (setq chars (- (- (point) (progn (newline-and-indent) (point)))))
 275           (indent-region (+ start chars) (+ end chars))))
 276     (open-line 1)
 277     (save-excursion
 278       (forward-line 1)
 279       (indent-according-to-mode))
 280     (newline-and-indent)))
 281
 282 (defun nxml-split-element ()
 283   (interactive)
 284   (let (element block-p)
 285     (save-excursion
 286       (nxml-backward-up-element)
 287       (setq element (xmltok-start-tag-qname)
 288             block-p (looking-back "^\s-*" (save-excursion (beginning-of-line) (point)))))
 289     (delete-horizontal-space)
 290     (insert "</" element ">")
 291     (fill-paragraph)
 292     (insert "\n")
 293     (newline-and-indent)
 294     (insert "<" element ">")
 295     (fill-paragraph)))
 296
 297 (defun my-nxml-reformat-region (begin end)
 298   (interactive "r")
 299   (save-excursion
 300       (nxml-mode)
 301       (goto-char begin)
 302       (while (search-forward-regexp "\>[ \\t]*\<" nil t)
 303         (backward-char) (insert "\n"))
 304       (indent-region begin end nil)))
 305
 306 (define-key nxml-mode-map (kbd "M-o") 'nxml-open-line)
 307 (define-key nxml-mode-map (kbd "S-<return>") 'nxml-split-element)