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 (define-key nxml-mode-map (kbd "\C-c <left>") 'hs-nxml-leave)
  75 (define-key nxml-mode-map (kbd "\C-c <right>") 'hs-nxml-enter)