Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 325 lines (283 sloc) 12.789 kb
9cf92b4 @markhepburn Initial commit; currently fairly hackish, but functional for browsing…
authored
1 ;;; tags-view.el --- Display and navigate tags browsing history.
2
3 ;; Copyright (C) 2009 Mark Hepburn
4
5 ;; Author: Mark Hepburn <Mark.Hepburn@gmail.com>
6 ;; Keywords: extensions, tools, convenience, files
7
8 ;; This program is free software; you can redistribute it and/or modify
9 ;; it under the terms of the GNU General Public License as published by
10 ;; the Free Software Foundation, either version 3 of the License, or
11 ;; (at your option) any later version.
12
13 ;; This program is distributed in the hope that it will be useful,
14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 ;; GNU General Public License for more details.
17
18 ;; You should have received a copy of the GNU General Public License
19 ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
20
21 ;;; Commentary:
22
23 ;;; Functionality to supplement the different tags operations, usually
24 ;;; bound to M-./M-* Currently supports etags.el and gtags.el; any
25 ;;; others?
26
27 ;;; As you navigate through a source tree it can become easy to forget
28 ;;; how you got to your current location -- you could call M-*
29 ;;; repeatedly to pop back up the stack, but this would lose your
30 ;;; current location. This module allows you to view the path taken,
31 ;;; and if desired to jump immediately back to any intermediate
fc8a452 @markhepburn Mostly done now; operations completed (albeit, not tested for gtags y…
authored
32 ;;; location, delete any extranous locations, etc.
9cf92b4 @markhepburn Initial commit; currently fairly hackish, but functional for browsing…
authored
33
34 ;;; I don't think this exists, but I haven't looked too hard -- I'd
fa8cba9 @markhepburn Calm flycheck down.
authored
35 ;;; like the practice of writing something to completion for Emacs for
fc8a452 @markhepburn Mostly done now; operations completed (albeit, not tested for gtags y…
authored
36 ;;; once, before realising someone else has already provided it!
37 ;;; Update: ok, I went looking, and of course it exists:
38 ;;; http://www.emacswiki.org/emacs/EtagsStack
39 ;;; I'd like to think this offers a little bit different; it supports
40 ;;; gtags as well out of the box and in theory at least can be
41 ;;; extended to others, and it offers a few more operations on the
42 ;;; chronological trace. Of course, if you need any of that is up to
43 ;;; you :)
44
45 ;;; Bugs: Most probably. The gtags backend in particular really
46 ;;; hasn't copped much testing yet.
bcb3eb3 @markhepburn More hacking; jump to the location of the current tag.
authored
47
9cf92b4 @markhepburn Initial commit; currently fairly hackish, but functional for browsing…
authored
48 ;;; Code:
49
04f77e8 Notes about structure of gtags.el
Mark Hepburn authored
50
cfbd97b @markhepburn Flycheck appeasement: prevent warnings about requiring 'cl.
authored
51 (with-no-warnings
52 (require 'cl))
9cf92b4 @markhepburn Initial commit; currently fairly hackish, but functional for browsing…
authored
53
54 (defvar tv-separator-string "----"
55 "Text used to separate entries in the browser window. May be nil.")
56
57 (defvar tv-context-lines 0
d888c13 @markhepburn Fixing checkdoc grumblings.
authored
58 "The number of lines to include around each location displayed.")
9cf92b4 @markhepburn Initial commit; currently fairly hackish, but functional for browsing…
authored
59
60 (defface tv-header-face
ce6f3cb defface attribute values don't need to be quoted (I think)
Mark Hepburn authored
61 '((t (:foreground "gray" :weight light)))
9cf92b4 @markhepburn Initial commit; currently fairly hackish, but functional for browsing…
authored
62 "Face used to display the header of each tag entry.")
63
acfeffb @markhepburn Adding customisable strategies (with one default) for determining whi…
authored
64 (defvar tv-determine-backend-function 'tv-determine-backend-directory-search
d888c13 @markhepburn Fixing checkdoc grumblings.
authored
65 "Function to determine which backend to use.
66 Value should be a function of no arguments that returns a symbol
67 indicating which backend should be used, or 'none if not
75508b4 @markhepburn Docstring indentation cleanups (make flycheck happier)
authored
68 applicable.")
acfeffb @markhepburn Adding customisable strategies (with one default) for determining whi…
authored
69
8e68440 @markhepburn Adding a symbol-based generic backend, plus sample implementation (in…
authored
70 (defvar tv-backend-list
71 '((etags
fc8a452 @markhepburn Mostly done now; operations completed (albeit, not tested for gtags y…
authored
72 (get-tags-list . tv-get-tags-list-for-etags)
73 (clear-tag . tv-delete-tag-for-etags))
8e68440 @markhepburn Adding a symbol-based generic backend, plus sample implementation (in…
authored
74 (gtags
fc8a452 @markhepburn Mostly done now; operations completed (albeit, not tested for gtags y…
authored
75 (get-tags-list . tv-get-tags-list-for-gtags)
76 (clear-tag . tv-delete-tag-for-gtags)))
d888c13 @markhepburn Fixing checkdoc grumblings.
authored
77 "Assoc list specifying key implementations per backend.
78 It is keyed by the symbol returned by `tv-determine-backend', and
79 values are also assoc lists mapping the functionality keys to
80 functions implementing that functionality for that backend.")
8e68440 @markhepburn Adding a symbol-based generic backend, plus sample implementation (in…
authored
81
b09d5da @markhepburn Switching from using markers as the basic data type to a custom one (…
authored
82 ;;; Use a datastructure containing point and buffer instead of
83 ;;; markers, for backends such as gtags that don't use markers:
84 (defun tv--make-pb (point buffer) (cons point buffer))
85 (defun tv--pb-from-marker (marker)
86 (tv--make-pb (marker-position marker) (marker-buffer marker)))
87 (defun tv--pb-point (pb) (car pb))
88 (defun tv--pb-buffer (pb) (cdr pb))
89
acfeffb @markhepburn Adding customisable strategies (with one default) for determining whi…
authored
90 (defun tv-determine-backend ()
d888c13 @markhepburn Fixing checkdoc grumblings.
authored
91 "Determine which backend should be used (eg,'etags, 'gtags, etc).
92 This will be used as the key in to `tv-backend-list'"
acfeffb @markhepburn Adding customisable strategies (with one default) for determining whi…
authored
93 (funcall tv-determine-backend-function))
94
95 (defun tv-determine-backend-directory-search ()
d888c13 @markhepburn Fixing checkdoc grumblings.
authored
96 "Deduce the backend by searching up directories looking for clues."
acfeffb @markhepburn Adding customisable strategies (with one default) for determining whi…
authored
97 ;; Try just looking through parent directories for tell-tale files:
98 (let ((working-dir (or (and (buffer-file-name)
99 (file-name-directory (buffer-file-name)))
100 (pwd))))
101 (labels
102 ((rec (dir)
103 (cond
104 ((file-exists-p (concat dir "GTAGS"))
105 (throw 'exit 'gtags))
106 ((file-exists-p (concat dir "TAGS"))
107 (throw 'exit 'etags))
108 ;; if we've reached the end of the road, we're done:
109 ((string= dir (file-name-directory (directory-file-name dir)))
110 (throw 'exit 'none))
111 ;; else, keep recursing:
112 (t (rec (file-name-directory (directory-file-name dir)))))))
113 (catch 'exit (rec working-dir)))))
114
8e68440 @markhepburn Adding a symbol-based generic backend, plus sample implementation (in…
authored
115 (defun tv--call-fn-for-backend (fn-sym backend &rest args)
116 (condition-case nil
117 (let* ((backend-list (cdr (assoc backend tv-backend-list)))
118 (impl (cdr (assoc fn-sym backend-list))))
119 (apply impl args))
120 (error
121 (error "Couldn't find implementation of %s for backend %s" fn-sym backend))))
122
bce62ed Refactor so that get-tags-list takes the backend as an argument.
Mark Hepburn authored
123 (defun tv-get-tags-list (backend)
124 (tv--call-fn-for-backend 'get-tags-list backend))
b09d5da @markhepburn Switching from using markers as the basic data type to a custom one (…
authored
125 (defun tv-get-tags-list-for-etags ()
126 (mapcar 'tv--pb-from-marker (ring-elements tags-location-ring)))
127 (defun tv-get-tags-list-for-gtags ()
de96d36 Oops, gtags backend was still returning markers not pb instances -- m…
Mark Hepburn authored
128 (map 'list 'tv--make-pb gtags-point-stack gtags-buffer-stack))
80da4b7 @markhepburn "Generic" backends to return a list of markers for either etags or gt…
authored
129
9cf92b4 @markhepburn Initial commit; currently fairly hackish, but functional for browsing…
authored
130 (defun tv-view-history ()
d888c13 @markhepburn Fixing checkdoc grumblings.
authored
131 "Open a buffer listing locations on the tag stack.
132 These can then optionally be operated on (eg, jumping to that
133 location, deleting it from the list, etc). The following options
134 will be available:
acfeffb @markhepburn Adding customisable strategies (with one default) for determining whi…
authored
135
136 \\{tags-history-mode-map}"
9cf92b4 @markhepburn Initial commit; currently fairly hackish, but functional for browsing…
authored
137 (interactive)
bce62ed Refactor so that get-tags-list takes the backend as an argument.
Mark Hepburn authored
138 (let* ((buf (get-buffer-create "*tags history*"))
139 (backend (tv-determine-backend))
140 (tag-items (tv-get-tags-list backend)))
9cf92b4 @markhepburn Initial commit; currently fairly hackish, but functional for browsing…
authored
141 (pop-to-buffer buf)
142 (setq buffer-read-only nil)
143 (let ((inhibit-read-only t))
144 (erase-buffer))
145 (tags-history-mode)
de217f6 Right, fixed some battle-testing bugs. The main issue is when/how of…
Mark Hepburn authored
146 (set (make-local-variable 'tv-tags-backend) backend)
f77bf7f Calculate list of tags before popping to history buffer, because the …
Mark Hepburn authored
147 (tv-insert-items tag-items)
9cf92b4 @markhepburn Initial commit; currently fairly hackish, but functional for browsing…
authored
148 (setq buffer-read-only t)
149 (goto-char 0)))
150
b09d5da @markhepburn Switching from using markers as the basic data type to a custom one (…
authored
151 (defun tv-what-line (pb)
d888c13 @markhepburn Fixing checkdoc grumblings.
authored
152 "Return the line number of a point-buffer structure (PB)."
b09d5da @markhepburn Switching from using markers as the basic data type to a custom one (…
authored
153 (with-current-buffer (tv--pb-buffer pb)
154 (line-number-at-pos (tv--pb-point pb))))
9cf92b4 @markhepburn Initial commit; currently fairly hackish, but functional for browsing…
authored
155
bcb3eb3 @markhepburn More hacking; jump to the location of the current tag.
authored
156 (defun tv-insert-items (items &optional count)
d888c13 @markhepburn Fixing checkdoc grumblings.
authored
157 "Insert the formatted list of tags (ITEMS) with COUNT context lines."
bcb3eb3 @markhepburn More hacking; jump to the location of the current tag.
authored
158 (unless count (setq count 0))
9cf92b4 @markhepburn Initial commit; currently fairly hackish, but functional for browsing…
authored
159 (if items
160 (progn
bcb3eb3 @markhepburn More hacking; jump to the location of the current tag.
authored
161 (tv-insert-single-item (car items) count)
9cf92b4 @markhepburn Initial commit; currently fairly hackish, but functional for browsing…
authored
162 (if (cdr items)
163 (progn
164 (if tv-separator-string
bcb3eb3 @markhepburn More hacking; jump to the location of the current tag.
authored
165 (insert tv-separator-string "\n"))
166 (tv-insert-items (cdr items) (1+ count)))))))
9cf92b4 @markhepburn Initial commit; currently fairly hackish, but functional for browsing…
authored
167
b09d5da @markhepburn Switching from using markers as the basic data type to a custom one (…
authored
168 (defun tv-insert-single-item (pb posn)
d888c13 @markhepburn Fixing checkdoc grumblings.
authored
169 "Insert a single formatted item listing, including context etc.
170 Argument PB is a marker that will be displayed, along with
171 `tv-context-lines' of context, if non-zero. POSN refers to the
172 position in the stack occupied by that item."
9cf92b4 @markhepburn Initial commit; currently fairly hackish, but functional for browsing…
authored
173 (let ((beg (point)))
174 (insert (propertize (format "Buffer %s, line %d:\n"
b09d5da @markhepburn Switching from using markers as the basic data type to a custom one (…
authored
175 (buffer-name (tv--pb-buffer pb))
176 (tv-what-line pb))
9cf92b4 @markhepburn Initial commit; currently fairly hackish, but functional for browsing…
authored
177 'face 'tv-header-face))
b09d5da @markhepburn Switching from using markers as the basic data type to a custom one (…
authored
178 (insert (tv-get-lines-with-context pb tv-context-lines) "\n")
bcb3eb3 @markhepburn More hacking; jump to the location of the current tag.
authored
179 (let ((o (make-overlay beg (point))))
180 (overlay-put o 'mouse-face 'highlight)
fc8a452 @markhepburn Mostly done now; operations completed (albeit, not tested for gtags y…
authored
181 (overlay-put o 'tv-stack-posn posn)
b09d5da @markhepburn Switching from using markers as the basic data type to a custom one (…
authored
182 (overlay-put o 'tv-buffer (tv--pb-buffer pb))
183 (overlay-put o 'tv-point (tv--pb-point pb)))))
9cf92b4 @markhepburn Initial commit; currently fairly hackish, but functional for browsing…
authored
184
b09d5da @markhepburn Switching from using markers as the basic data type to a custom one (…
authored
185 (defun tv-get-lines-with-context (pb &optional num-context)
d888c13 @markhepburn Fixing checkdoc grumblings.
authored
186 "Grab the line and context of the specified point-and-buffer.
187 PB is a point-buffer structure. If optional NUM-CONTEXT is
188 specified, it will also grab that number of preceding and
189 following lines, assuming sufficient lines exist. For example,
190 if 2 context lines are specified, a total of 5 lines wil lbe
191 returned: 2 preceding, the line the marker is located on, and 2
192 following lines. If not enough context lines exist in either
193 direction, as many as possible will be used."
9cf92b4 @markhepburn Initial commit; currently fairly hackish, but functional for browsing…
authored
194 (unless num-context (setq num-context 0))
64810e5 @markhepburn Bugfix: extra parentheses!
authored
195 (if (< num-context 0) (setq num-context (- num-context)))
b09d5da @markhepburn Switching from using markers as the basic data type to a custom one (…
authored
196 (with-current-buffer (tv--pb-buffer pb)
197 (save-excursion
198 (let (start end)
199 (goto-char (tv--pb-point pb))
200 (forward-line (- num-context))
201 (setq start (point))
202 (goto-char (tv--pb-point pb))
203 (forward-line num-context)
204 (end-of-line)
205 (setq end (point))
206 (buffer-substring start end)))))
9cf92b4 @markhepburn Initial commit; currently fairly hackish, but functional for browsing…
authored
207
208 ;;; to implement; different methods of operating on the current selection:
fc8a452 @markhepburn Mostly done now; operations completed (albeit, not tested for gtags y…
authored
209
210 (defmacro with-tag-info (locn args &rest body)
d888c13 @markhepburn Fixing checkdoc grumblings.
authored
211 "Macro to facilitate writing tag-stack operations.
212 First argument LOCN is the location (point) in the buffer, the
213 second ARGS is an \"argument list\" of buffer, position, and
214 stack position, all taken from the tag under point, and the
215 remainder is the BODY. The arg-list args will be bound within
216 the BODY to the values corresponding to the tag under point."
fc8a452 @markhepburn Mostly done now; operations completed (albeit, not tested for gtags y…
authored
217 (declare (indent 2))
218 (let ((o (gensym "tv-overlay-")))
219 `(let* ((,o (or (car-safe (overlays-at ,locn))
220 (car (overlays-at (next-overlay-change ,locn)))))
221 (,(car args) (overlay-get ,o 'tv-buffer))
222 (,(cadr args) (overlay-get ,o 'tv-point))
223 (,(caddr args) (overlay-get ,o 'tv-stack-posn)))
224 ,@body)))
225
226 (defun tv-display-tag-other-window (location)
227 (interactive "d")
228 (with-tag-info location (buf posn stack)
229 (let ((tags-win (selected-window)))
230 (with-current-buffer (pop-to-buffer buf)
231 (goto-char posn)
232 (recenter))
233 (select-window tags-win))))
bcb3eb3 @markhepburn More hacking; jump to the location of the current tag.
authored
234 (defun tv-jump-to-tag-and-quit (location)
235 (interactive "d")
fc8a452 @markhepburn Mostly done now; operations completed (albeit, not tested for gtags y…
authored
236 (with-tag-info location (buf posn stack)
bcb3eb3 @markhepburn More hacking; jump to the location of the current tag.
authored
237 (switch-to-buffer buf)
238 (goto-char posn)
239 (delete-other-windows)))
fc8a452 @markhepburn Mostly done now; operations completed (albeit, not tested for gtags y…
authored
240 (defun tv-delete-tag-at-point (location)
241 (interactive "d")
242 (with-tag-info location (buf posn stack-pos)
de217f6 Right, fixed some battle-testing bugs. The main issue is when/how of…
Mark Hepburn authored
243 (tv--call-fn-for-backend 'clear-tag tv-tags-backend stack-pos)
244 ;; redraw; hack here to make sure the same backend is used. I
245 ;; don't like this, and will probably refactor to fix it soon. It
246 ;; smells, to me:
247 (let ((tv-determine-backend-function (lambda () tv-tags-backend)))
248 (tv-view-history))))
fc8a452 @markhepburn Mostly done now; operations completed (albeit, not tested for gtags y…
authored
249 ;;; implementations:
250 (defun tv-delete-tag-for-etags (stack-position)
251 (ring-remove tags-location-ring stack-position))
252 (defun tv-delete-tag-for-gtags (stack-position)
89838f5 Fixing bug where front of the list wouldn't be deleted (oops, thought…
Mark Hepburn authored
253 (macrolet
fc8a452 @markhepburn Mostly done now; operations completed (albeit, not tested for gtags y…
authored
254 ((delete-nth (n lst)
89838f5 Fixing bug where front of the list wouldn't be deleted (oops, thought…
Mark Hepburn authored
255 `(if (zerop ,n)
256 (setq ,lst (cdr ,lst))
257 (setcdr (nthcdr (1- ,n) ,lst) (nthcdr (1+ ,n) ,lst)))))
fc8a452 @markhepburn Mostly done now; operations completed (albeit, not tested for gtags y…
authored
258 (delete-nth stack-position gtags-point-stack)
259 (delete-nth stack-position gtags-buffer-stack)))
260
261 ;;; Navigation (mostly borrowed from browse-kill-ring):
9cf92b4 @markhepburn Initial commit; currently fairly hackish, but functional for browsing…
authored
262 (defun tv-next-tag (&optional arg)
d888c13 @markhepburn Fixing checkdoc grumblings.
authored
263 "Move point forward to the next tag listing.
264 Optional numeric ARG moves forward that many tags."
9cf92b4 @markhepburn Initial commit; currently fairly hackish, but functional for browsing…
authored
265 (interactive "p")
266 (beginning-of-line)
267 (while (not (zerop arg))
268 (if (> arg 0)
269 (progn
270 (decf arg)
271 (if (overlays-at (point))
272 (progn
273 (goto-char (overlay-end (car (overlays-at (point)))))
274 (goto-char (next-overlay-change (point))))
275 (goto-char (next-overlay-change (point)))
276 (unless (eobp)
277 (goto-char (overlay-start (car (overlays-at (point))))))))
278 (progn
279 (incf arg)
280 (if (overlays-at (point))
281 (progn
282 (goto-char (overlay-start (car (overlays-at (point)))))
283 (goto-char (previous-overlay-change (point)))
284 (goto-char (previous-overlay-change (point))))
285 (progn
286 (goto-char (previous-overlay-change (point)))
287 (unless (bobp)
288 (goto-char (overlay-start (car (overlays-at (point))))))))))))
289
290 (defun tv-previous-tag (&optional arg)
d888c13 @markhepburn Fixing checkdoc grumblings.
authored
291 "Move point backwards to the previous tag listing.
292 Optional numeric ARG moves backwards that many tags."
9cf92b4 @markhepburn Initial commit; currently fairly hackish, but functional for browsing…
authored
293 (interactive "p")
294 (tv-next-tag (- arg)))
295
296 ;;; major mode for displaying the history:
297 (define-derived-mode tags-history-mode
298 nil "Tags-History"
299 "View history of tags locations, with the most recent on the top.
300
301 \\{tags-history-mode-map}"
302 (let ((km tags-history-mode-map))
303 ;; first, clear all other bindings:
304 (suppress-keymap km)
305
306 ;; navigation:
307 (define-key km "n" 'tv-next-tag)
308 (define-key km "\C-n" 'tv-next-tag)
309 (define-key km "j" 'tv-next-tag)
fa8cba9 @markhepburn Calm flycheck down.
authored
310
9cf92b4 @markhepburn Initial commit; currently fairly hackish, but functional for browsing…
authored
311 (define-key km "p" 'tv-previous-tag)
312 (define-key km "\C-p" 'tv-previous-tag)
313 (define-key km "k" 'tv-previous-tag)
314
bcb3eb3 @markhepburn More hacking; jump to the location of the current tag.
authored
315 ;; operation:
fc8a452 @markhepburn Mostly done now; operations completed (albeit, not tested for gtags y…
authored
316 (define-key km "\C-m" 'tv-jump-to-tag-and-quit)
317 (define-key km "o" 'tv-display-tag-other-window)
318 (define-key km "d" 'tv-delete-tag-at-point)
bcb3eb3 @markhepburn More hacking; jump to the location of the current tag.
authored
319
9cf92b4 @markhepburn Initial commit; currently fairly hackish, but functional for browsing…
authored
320 ;; cleanup:
321 (define-key km "q" 'delete-window)))
322
fa8cba9 @markhepburn Calm flycheck down.
authored
323 (provide 'tags-view)
324 ;;; tags-view.el ends here
Something went wrong with that request. Please try again.