d7ed93354b08a9d546ba777827d279a91b83a327
[emacs-init.git] / 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 for att in xmltok-attributes
18                                                  if (string= (xmltok-attribute-local-name att) "id")
19                                                  return (values t (concat "\"" (xmltok-attribute-value att) "\""))
20                                                  finally return (values nil (xmltok-start-tag-local-name)))
21                                  (if (or path-to-id has-id)
22                                          (setq path-to-id (cons step path-to-id))
23                                    (setq path-rest (cons step path-rest)))))))
24                  (let ((path-to-id-len (length path-to-id))
25                            (path-rest-len (length path-rest)))
26                    (if (> path-to-id-len nxml-where-elements-to-id)
27                            (progn
28                                  (setq path-to-id (nthcdr (- path-to-id-len nxml-where-elements-to-id -1) path-to-id))
29                                  (setq path-to-id (cons "..." path-to-id))
30                                  (setq path-to-id-len nxml-where-elements-to-id))
31                          (setq path-to-id (cons "" path-to-id)))
32                    (when (> (+ path-to-id-len path-rest-len) nxml-where-max-elements)
33                          (setq path-rest (nbutlast path-rest (- path-rest-len (- nxml-where-max-elements path-to-id-len) -1)))
34                          (setq path-rest (nconc path-rest (list "...")))))
35                  (mapconcat 'identity (nconc path-to-id path-rest) "/"))))
36   
37 (require 'which-func)
38
39 (add-to-list 'which-func-functions 'nxml-where)
40 (add-to-list 'which-func-modes 'nxml-mode)