1 ;;; sepia-tree.el -- tree-widget-based calle[re] navigation
3 ;; Copyright (C) 2004-2008 Sean O'Rourke. All rights reserved, some
4 ;; wrongs reversed. This code is distributed under the same terms as
9 ;; See the README file that comes with the distribution.
13 (require 'tree-widget
)
16 (defvar sepia-tree-use-image nil
17 "*If non-nil, show tree-widget with icons.")
19 (defun sepia-tree-button-cb (widget &rest blah
)
20 (let* ((pw (widget-get widget
:parent
))
21 (wid-name (widget-get pw
:sepia-name
))
22 (location (and wid-name
(car (xref-location wid-name
)))))
24 ((not location
) (error "Can't find %s." wid-name
))
26 (find-file-other-window (car location
))
27 (sepia-set-found (list location
) 'function
)
29 ((widget-get widget
:sepia-shown-p
)
32 (let ((inhibit-read-only t
))
33 (delete-region (point)
34 (+ 1 (point) (widget-get widget
:sepia-shown-p
))))
35 (widget-put widget
:sepia-shown-p nil
)))
37 (let ((str (apply #'sepia-extract-def location
)))
41 (widget-put widget
:sepia-shown-p
(length str
))
42 (widget-insert "\n" str
))
43 (message "(not found)")))))))
45 (defun sepia-tree-node-cb (widget &rest blah
)
46 (let ((func (widget-get widget
:sepia-func
)))
47 (or (widget-get widget
:args
)
48 (let ((children (funcall func widget
)))
51 (lambda (x) (sepia-tree-node func x
))
53 (widget-put widget
:has-children nil
))))))
55 (defun sepia-tree-node (func name
)
56 "Make a tree node for the object specified by FILE, LINE, OBJ,
57 and MOD. The new node will have a property :sepia-X
58 corresponding to each of these values. FUNC is a function that
59 will, given a widget, generate its children."
64 :notify sepia-tree-button-cb
)
65 :dynargs sepia-tree-node-cb
70 (defun sepia-tree-tidy-buffer (name)
71 "Get/create a new, tidy buffer for the tree widget."
72 (switch-to-buffer name
)
73 (kill-all-local-variables)
74 ;; because the widget images are ugly.
75 (set (make-local-variable 'widget-image-enable
) sepia-tree-use-image
)
76 (let ((inhibit-read-only t
))
78 (let ((all (overlay-lists)))
79 (mapcar #'delete-overlay
(car all
))
80 (mapcar #'delete-overlay
(cdr all
)))
84 (defun sepia-build-tree-buffer (func defs bufname
)
86 (lexical-let ((func func
))
87 (sepia-tree-tidy-buffer bufname
)
88 (with-current-buffer bufname
93 (funcall func
(widget-get widget
:sepia-name
)))
95 (use-local-map (copy-keymap widget-keymap
))
96 ;; (local-set-key "\M-." sepia-keymap)
97 ;; (sepia-install-keys)
98 (let ((view-read-only nil
))
100 (goto-char (point-min))
101 (message "Type C-h m for usage information")))
102 (message "No items for %s" bufname
)))
105 (defun sepia-callee-tree (name)
106 "Create a tree view of a function's callees.
108 Pressing RET on a function's name displays its definition. With
109 prefix argument, RET instead visits in another window."
110 (interactive (let ((func (sepia-interactive-arg 'function
))
111 (mod (sepia-interactive-module)))
112 (list (if mod
(format "%s::%s" mod func
)
114 (let* ((defs (xref-apropos name
)))
115 (sepia-build-tree-buffer
118 (format "*%s callees*" name
))))
120 (defun sepia-caller-tree (name)
121 "Create a tree view of a function's callers.
123 Pressing RET on a function's name displays its definition. With
124 prefix argument, RET instead visits in another window."
125 (interactive (let ((func (sepia-interactive-arg 'function
))
126 (mod (sepia-interactive-module)))
127 (list (if mod
(format "%s::%s" mod func
)
129 (let* ((defs (xref-apropos name
)))
130 (sepia-build-tree-buffer
132 defs
(format "*%s callers*" name
))))
135 (defun sepia-module-callee-tree (mod)
136 "Display a callee tree for each of MOD's subroutines.
138 Pressing RET on a function's name displays its definition. With
139 prefix argument, RET instead visits in another window."
140 (interactive (list (sepia-interactive-arg 'module
)))
141 (let ((defs (xref-mod-subs mod
)))
142 (sepia-build-tree-buffer #'xref-callees defs
(format "*%s subs*" mod
))))
144 (provide 'sepia-tree
)
145 ;;; sepia.el ends here