Skip to content
This repository

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
9cf92b46 »
2009-09-07 Initial commit; currently fairly hackish, but functional for browsing…
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
fc8a452f »
2009-09-14 Mostly done now; operations completed (albeit, not tested for gtags y…
32 ;;; location, delete any extranous locations, etc.
9cf92b46 »
2009-09-07 Initial commit; currently fairly hackish, but functional for browsing…
33
34 ;;; I don't think this exists, but I haven't looked too hard -- I'd
fa8cba94 »
2013-06-04 Calm flycheck down.
35 ;;; like the practice of writing something to completion for Emacs for
fc8a452f »
2009-09-14 Mostly done now; operations completed (albeit, not tested for gtags y…
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.
bcb3eb32 »
2009-09-10 More hacking; jump to the location of the current tag.
47
9cf92b46 »
2009-09-07 Initial commit; currently fairly hackish, but functional for browsing…
48 ;;; Code:
49
04f77e8b »
2009-09-14 Notes about structure of gtags.el
50
cfbd97b9 »
2013-06-04 Flycheck appeasement: prevent warnings about requiring 'cl.
51 (with-no-warnings
52 (require 'cl))
9cf92b46 »
2009-09-07 Initial commit; currently fairly hackish, but functional for browsing…
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
d888c13d »
2013-06-04 Fixing checkdoc grumblings.
58 "The number of lines to include around each location displayed.")
9cf92b46 »
2009-09-07 Initial commit; currently fairly hackish, but functional for browsing…
59
60 (defface tv-header-face
ce6f3cb7 »
2009-09-21 defface attribute values don't need to be quoted (I think)
61 '((t (:foreground "gray" :weight light)))
9cf92b46 »
2009-09-07 Initial commit; currently fairly hackish, but functional for browsing…
62 "Face used to display the header of each tag entry.")
63
acfeffbd »
2009-09-14 Adding customisable strategies (with one default) for determining whi…
64 (defvar tv-determine-backend-function 'tv-determine-backend-directory-search
d888c13d »
2013-06-04 Fixing checkdoc grumblings.
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
75508b42 »
2013-06-04 Docstring indentation cleanups (make flycheck happier)
68 applicable.")
acfeffbd »
2009-09-14 Adding customisable strategies (with one default) for determining whi…
69
8e684403 »
2009-09-14 Adding a symbol-based generic backend, plus sample implementation (in…
70 (defvar tv-backend-list
71 '((etags
fc8a452f »
2009-09-14 Mostly done now; operations completed (albeit, not tested for gtags y…
72 (get-tags-list . tv-get-tags-list-for-etags)
73 (clear-tag . tv-delete-tag-for-etags))
8e684403 »
2009-09-14 Adding a symbol-based generic backend, plus sample implementation (in…
74 (gtags
fc8a452f »
2009-09-14 Mostly done now; operations completed (albeit, not tested for gtags y…
75 (get-tags-list . tv-get-tags-list-for-gtags)
76 (clear-tag . tv-delete-tag-for-gtags)))
d888c13d »
2013-06-04 Fixing checkdoc grumblings.
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.")
8e684403 »
2009-09-14 Adding a symbol-based generic backend, plus sample implementation (in…
81
b09d5dad »
2009-09-14 Switching from using markers as the basic data type to a custom one (…
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
acfeffbd »
2009-09-14 Adding customisable strategies (with one default) for determining whi…
90 (defun tv-determine-backend ()
d888c13d »
2013-06-04 Fixing checkdoc grumblings.
91 "Determine which backend should be used (eg,'etags, 'gtags, etc).
92 This will be used as the key in to `tv-backend-list'"
acfeffbd »
2009-09-14 Adding customisable strategies (with one default) for determining whi…
93 (funcall tv-determine-backend-function))
94
95 (defun tv-determine-backend-directory-search ()
d888c13d »
2013-06-04 Fixing checkdoc grumblings.
96 "Deduce the backend by searching up directories looking for clues."
acfeffbd »
2009-09-14 Adding customisable strategies (with one default) for determining whi…
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
8e684403 »
2009-09-14 Adding a symbol-based generic backend, plus sample implementation (in…
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
bce62edb »
2009-09-15 Refactor so that get-tags-list takes the backend as an argument.
123 (defun tv-get-tags-list (backend)
124 (tv--call-fn-for-backend 'get-tags-list backend))
b09d5dad »
2009-09-14 Switching from using markers as the basic data type to a custom one (…
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 ()
de96d36f »
2009-09-15 Oops, gtags backend was still returning markers not pb instances -- m…
128 (map 'list 'tv--make-pb gtags-point-stack gtags-buffer-stack))
80da4b7a »
2009-09-14 "Generic" backends to return a list of markers for either etags or gt…
129
9cf92b46 »
2009-09-07 Initial commit; currently fairly hackish, but functional for browsing…
130 (defun tv-view-history ()
d888c13d »
2013-06-04 Fixing checkdoc grumblings.
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:
acfeffbd »
2009-09-14 Adding customisable strategies (with one default) for determining whi…
135
136 \\{tags-history-mode-map}"
9cf92b46 »
2009-09-07 Initial commit; currently fairly hackish, but functional for browsing…
137 (interactive)
bce62edb »
2009-09-15 Refactor so that get-tags-list takes the backend as an argument.
138 (let* ((buf (get-buffer-create "*tags history*"))
139 (backend (tv-determine-backend))
140 (tag-items (tv-get-tags-list backend)))
9cf92b46 »
2009-09-07 Initial commit; currently fairly hackish, but functional for browsing…
141 (pop-to-buffer buf)
142 (setq buffer-read-only nil)
143 (let ((inhibit-read-only t))
144 (erase-buffer))
145 (tags-history-mode)
de217f61 »
2009-09-15 Right, fixed some battle-testing bugs. The main issue is when/how oft…
146 (set (make-local-variable 'tv-tags-backend) backend)
f77bf7fa »
2009-09-15 Calculate list of tags before popping to history buffer, because the …
147 (tv-insert-items tag-items)
9cf92b46 »
2009-09-07 Initial commit; currently fairly hackish, but functional for browsing…
148 (setq buffer-read-only t)
149 (goto-char 0)))
150
b09d5dad »
2009-09-14 Switching from using markers as the basic data type to a custom one (…
151 (defun tv-what-line (pb)
d888c13d »
2013-06-04 Fixing checkdoc grumblings.
152 "Return the line number of a point-buffer structure (PB)."
b09d5dad »
2009-09-14 Switching from using markers as the basic data type to a custom one (…
153 (with-current-buffer (tv--pb-buffer pb)
154 (line-number-at-pos (tv--pb-point pb))))
9cf92b46 »
2009-09-07 Initial commit; currently fairly hackish, but functional for browsing…
155
bcb3eb32 »
2009-09-10 More hacking; jump to the location of the current tag.
156 (defun tv-insert-items (items &optional count)
d888c13d »
2013-06-04 Fixing checkdoc grumblings.
157 "Insert the formatted list of tags (ITEMS) with COUNT context lines."
bcb3eb32 »
2009-09-10 More hacking; jump to the location of the current tag.
158 (unless count (setq count 0))
9cf92b46 »
2009-09-07 Initial commit; currently fairly hackish, but functional for browsing…
159 (if items
160 (progn
bcb3eb32 »
2009-09-10 More hacking; jump to the location of the current tag.
161 (tv-insert-single-item (car items) count)
9cf92b46 »
2009-09-07 Initial commit; currently fairly hackish, but functional for browsing…
162 (if (cdr items)
163 (progn
164 (if tv-separator-string
bcb3eb32 »
2009-09-10 More hacking; jump to the location of the current tag.
165 (insert tv-separator-string "\n"))
166 (tv-insert-items (cdr items) (1+ count)))))))
9cf92b46 »
2009-09-07 Initial commit; currently fairly hackish, but functional for browsing…
167
b09d5dad »
2009-09-14 Switching from using markers as the basic data type to a custom one (…
168 (defun tv-insert-single-item (pb posn)
d888c13d »
2013-06-04 Fixing checkdoc grumblings.
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."
9cf92b46 »
2009-09-07 Initial commit; currently fairly hackish, but functional for browsing…
173 (let ((beg (point)))
174 (insert (propertize (format "Buffer %s, line %d:\n"
b09d5dad »
2009-09-14 Switching from using markers as the basic data type to a custom one (…
175 (buffer-name (tv--pb-buffer pb))
176 (tv-what-line pb))
9cf92b46 »
2009-09-07 Initial commit; currently fairly hackish, but functional for browsing…
177 'face 'tv-header-face))
b09d5dad »
2009-09-14 Switching from using markers as the basic data type to a custom one (…
178 (insert (tv-get-lines-with-context pb tv-context-lines) "\n")
bcb3eb32 »
2009-09-10 More hacking; jump to the location of the current tag.
179 (let ((o (make-overlay beg (point))))
180 (overlay-put o 'mouse-face 'highlight)
fc8a452f »
2009-09-14 Mostly done now; operations completed (albeit, not tested for gtags y…
181 (overlay-put o 'tv-stack-posn posn)
b09d5dad »
2009-09-14 Switching from using markers as the basic data type to a custom one (…
182 (overlay-put o 'tv-buffer (tv--pb-buffer pb))
183 (overlay-put o 'tv-point (tv--pb-point pb)))))
9cf92b46 »
2009-09-07 Initial commit; currently fairly hackish, but functional for browsing…
184
b09d5dad »
2009-09-14 Switching from using markers as the basic data type to a custom one (…
185 (defun tv-get-lines-with-context (pb &optional num-context)
d888c13d »
2013-06-04 Fixing checkdoc grumblings.
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."
9cf92b46 »
2009-09-07 Initial commit; currently fairly hackish, but functional for browsing…
194 (unless num-context (setq num-context 0))
64810e51 »
2013-06-04 Bugfix: extra parentheses!
195 (if (< num-context 0) (setq num-context (- num-context)))
b09d5dad »
2009-09-14 Switching from using markers as the basic data type to a custom one (…
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)))))
9cf92b46 »
2009-09-07 Initial commit; currently fairly hackish, but functional for browsing…
207
208 ;;; to implement; different methods of operating on the current selection:
fc8a452f »
2009-09-14 Mostly done now; operations completed (albeit, not tested for gtags y…
209
210 (defmacro with-tag-info (locn args &rest body)
d888c13d »
2013-06-04 Fixing checkdoc grumblings.
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."
fc8a452f »
2009-09-14 Mostly done now; operations completed (albeit, not tested for gtags y…
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))))
bcb3eb32 »
2009-09-10 More hacking; jump to the location of the current tag.
234 (defun tv-jump-to-tag-and-quit (location)
235 (interactive "d")
fc8a452f »
2009-09-14 Mostly done now; operations completed (albeit, not tested for gtags y…
236 (with-tag-info location (buf posn stack)
bcb3eb32 »
2009-09-10 More hacking; jump to the location of the current tag.
237 (switch-to-buffer buf)
238 (goto-char posn)
239 (delete-other-windows)))
fc8a452f »
2009-09-14 Mostly done now; operations completed (albeit, not tested for gtags y…
240 (defun tv-delete-tag-at-point (location)
241 (interactive "d")
242 (with-tag-info location (buf posn stack-pos)
de217f61 »
2009-09-15 Right, fixed some battle-testing bugs. The main issue is when/how oft…
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))))
fc8a452f »
2009-09-14 Mostly done now; operations completed (albeit, not tested for gtags y…
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)
89838f51 »
2009-09-23 Fixing bug where front of the list wouldn't be deleted (oops, thought…
253 (macrolet
fc8a452f »
2009-09-14 Mostly done now; operations completed (albeit, not tested for gtags y…
254 ((delete-nth (n lst)
89838f51 »
2009-09-23 Fixing bug where front of the list wouldn't be deleted (oops, thought…
255 `(if (zerop ,n)
256 (setq ,lst (cdr ,lst))
257 (setcdr (nthcdr (1- ,n) ,lst) (nthcdr (1+ ,n) ,lst)))))
fc8a452f »
2009-09-14 Mostly done now; operations completed (albeit, not tested for gtags y…
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):
9cf92b46 »
2009-09-07 Initial commit; currently fairly hackish, but functional for browsing…
262 (defun tv-next-tag (&optional arg)
d888c13d »
2013-06-04 Fixing checkdoc grumblings.
263 "Move point forward to the next tag listing.
264 Optional numeric ARG moves forward that many tags."
9cf92b46 »
2009-09-07 Initial commit; currently fairly hackish, but functional for browsing…
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)
d888c13d »
2013-06-04 Fixing checkdoc grumblings.
291 "Move point backwards to the previous tag listing.
292 Optional numeric ARG moves backwards that many tags."
9cf92b46 »
2009-09-07 Initial commit; currently fairly hackish, but functional for browsing…
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)
fa8cba94 »
2013-06-04 Calm flycheck down.
310
9cf92b46 »
2009-09-07 Initial commit; currently fairly hackish, but functional for browsing…
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
bcb3eb32 »
2009-09-10 More hacking; jump to the location of the current tag.
315 ;; operation:
fc8a452f »
2009-09-14 Mostly done now; operations completed (albeit, not tested for gtags y…
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)
bcb3eb32 »
2009-09-10 More hacking; jump to the location of the current tag.
319
9cf92b46 »
2009-09-07 Initial commit; currently fairly hackish, but functional for browsing…
320 ;; cleanup:
321 (define-key km "q" 'delete-window)))
322
fa8cba94 »
2013-06-04 Calm flycheck down.
323 (provide 'tags-view)
324 ;;; tags-view.el ends here
Something went wrong with that request. Please try again.