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 Mark Hepburn Initial commit; currently fairly hackish, but functional for browsing wi...
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 Mark Hepburn Mostly done now; operations completed (albeit, not tested for gtags yet)...
authored
32 ;;; location, delete any extranous locations, etc.
9cf92b4 Mark Hepburn Initial commit; currently fairly hackish, but functional for browsing wi...
authored
33
34 ;;; I don't think this exists, but I haven't looked too hard -- I'd
fa8cba9 Mark Hepburn Calm flycheck down.
authored
35 ;;; like the practice of writing something to completion for Emacs for
fc8a452 Mark Hepburn Mostly done now; operations completed (albeit, not tested for gtags yet)...
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 Mark Hepburn More hacking; jump to the location of the current tag.
authored
47
9cf92b4 Mark Hepburn Initial commit; currently fairly hackish, but functional for browsing wi...
authored
48 ;;; Code:
49
04f77e8 Notes about structure of gtags.el
Mark Hepburn authored
50
cfbd97b Mark Hepburn Flycheck appeasement: prevent warnings about requiring 'cl.
authored
51 (with-no-warnings
52 (require 'cl))
9cf92b4 Mark Hepburn Initial commit; currently fairly hackish, but functional for browsing wi...
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 Mark Hepburn Fixing checkdoc grumblings.
authored
58 "The number of lines to include around each location displayed.")
9cf92b4 Mark Hepburn Initial commit; currently fairly hackish, but functional for browsing wi...
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 Mark Hepburn Initial commit; currently fairly hackish, but functional for browsing wi...
authored
62 "Face used to display the header of each tag entry.")
63
acfeffb Mark Hepburn Adding customisable strategies (with one default) for determining which ...
authored
64 (defvar tv-determine-backend-function 'tv-determine-backend-directory-search
d888c13 Mark Hepburn 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 Mark Hepburn Docstring indentation cleanups (make flycheck happier)
authored
68 applicable.")
acfeffb Mark Hepburn Adding customisable strategies (with one default) for determining which ...
authored
69
8e68440 Mark Hepburn Adding a symbol-based generic backend, plus sample implementation (in th...
authored
70 (defvar tv-backend-list
71 '((etags
fc8a452 Mark Hepburn Mostly done now; operations completed (albeit, not tested for gtags yet)...
authored
72 (get-tags-list . tv-get-tags-list-for-etags)
73 (clear-tag . tv-delete-tag-for-etags))
8e68440 Mark Hepburn Adding a symbol-based generic backend, plus sample implementation (in th...
authored
74 (gtags
fc8a452 Mark Hepburn Mostly done now; operations completed (albeit, not tested for gtags yet)...
authored
75 (get-tags-list . tv-get-tags-list-for-gtags)
76 (clear-tag . tv-delete-tag-for-gtags)))
d888c13 Mark Hepburn 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 Mark Hepburn Adding a symbol-based generic backend, plus sample implementation (in th...
authored
81
b09d5da Mark Hepburn Switching from using markers as the basic data type to a custom one (jus...
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 Mark Hepburn Adding customisable strategies (with one default) for determining which ...
authored
90 (defun tv-determine-backend ()
d888c13 Mark Hepburn 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 Mark Hepburn Adding customisable strategies (with one default) for determining which ...
authored
93 (funcall tv-determine-backend-function))
94
95 (defun tv-determine-backend-directory-search ()
d888c13 Mark Hepburn Fixing checkdoc grumblings.
authored
96 "Deduce the backend by searching up directories looking for clues."
acfeffb Mark Hepburn Adding customisable strategies (with one default) for determining which ...
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 Mark Hepburn Adding a symbol-based generic backend, plus sample implementation (in th...
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 Mark Hepburn Switching from using markers as the basic data type to a custom one (jus...
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 -- much...
Mark Hepburn authored
128 (map 'list 'tv--make-pb gtags-point-stack gtags-buffer-stack))
80da4b7 Mark Hepburn "Generic" backends to return a list of markers for either etags or gtags...
authored
129
9cf92b4 Mark Hepburn Initial commit; currently fairly hackish, but functional for browsing wi...
authored
130 (defun tv-view-history ()
d888c13 Mark Hepburn 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 Mark Hepburn Adding customisable strategies (with one default) for determining which ...
authored
135
136 \\{tags-history-mode-map}"
9cf92b4 Mark Hepburn Initial commit; currently fairly hackish, but functional for browsing wi...
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 Mark Hepburn Initial commit; currently fairly hackish, but functional for browsing wi...
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 often...
Mark Hepburn authored
146 (set (make-local-variable 'tv-tags-backend) backend)
f77bf7f Calculate list of tags before popping to history buffer, because the cur...
Mark Hepburn authored
147 (tv-insert-items tag-items)
9cf92b4 Mark Hepburn Initial commit; currently fairly hackish, but functional for browsing wi...
authored
148 (setq buffer-read-only t)
149 (goto-char 0)))
150
b09d5da Mark Hepburn Switching from using markers as the basic data type to a custom one (jus...
authored
151 (defun tv-what-line (pb)
d888c13 Mark Hepburn Fixing checkdoc grumblings.
authored
152 "Return the line number of a point-buffer structure (PB)."
b09d5da Mark Hepburn Switching from using markers as the basic data type to a custom one (jus...
authored
153 (with-current-buffer (tv--pb-buffer pb)
154 (line-number-at-pos (tv--pb-point pb))))
9cf92b4 Mark Hepburn Initial commit; currently fairly hackish, but functional for browsing wi...
authored
155
bcb3eb3 Mark Hepburn More hacking; jump to the location of the current tag.
authored
156 (defun tv-insert-items (items &optional count)
d888c13 Mark Hepburn Fixing checkdoc grumblings.
authored
157 "Insert the formatted list of tags (ITEMS) with COUNT context lines."
bcb3eb3 Mark Hepburn More hacking; jump to the location of the current tag.
authored
158 (unless count (setq count 0))
9cf92b4 Mark Hepburn Initial commit; currently fairly hackish, but functional for browsing wi...
authored
159 (if items
160 (progn
bcb3eb3 Mark Hepburn More hacking; jump to the location of the current tag.
authored
161 (tv-insert-single-item (car items) count)
9cf92b4 Mark Hepburn Initial commit; currently fairly hackish, but functional for browsing wi...
authored
162 (if (cdr items)
163 (progn
164 (if tv-separator-string
bcb3eb3 Mark Hepburn 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 Mark Hepburn Initial commit; currently fairly hackish, but functional for browsing wi...
authored
167
b09d5da Mark Hepburn Switching from using markers as the basic data type to a custom one (jus...
authored
168 (defun tv-insert-single-item (pb posn)
d888c13 Mark Hepburn 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 Mark Hepburn Initial commit; currently fairly hackish, but functional for browsing wi...
authored
173 (let ((beg (point)))
174 (insert (propertize (format "Buffer %s, line %d:\n"
b09d5da Mark Hepburn Switching from using markers as the basic data type to a custom one (jus...
authored
175 (buffer-name (tv--pb-buffer pb))
176 (tv-what-line pb))
9cf92b4 Mark Hepburn Initial commit; currently fairly hackish, but functional for browsing wi...
authored
177 'face 'tv-header-face))
b09d5da Mark Hepburn Switching from using markers as the basic data type to a custom one (jus...
authored
178 (insert (tv-get-lines-with-context pb tv-context-lines) "\n")
bcb3eb3 Mark Hepburn 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 Mark Hepburn Mostly done now; operations completed (albeit, not tested for gtags yet)...
authored
181 (overlay-put o 'tv-stack-posn posn)
b09d5da Mark Hepburn Switching from using markers as the basic data type to a custom one (jus...
authored
182 (overlay-put o 'tv-buffer (tv--pb-buffer pb))
183 (overlay-put o 'tv-point (tv--pb-point pb)))))
9cf92b4 Mark Hepburn Initial commit; currently fairly hackish, but functional for browsing wi...
authored
184
b09d5da Mark Hepburn Switching from using markers as the basic data type to a custom one (jus...
authored
185 (defun tv-get-lines-with-context (pb &optional num-context)
d888c13 Mark Hepburn 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 Mark Hepburn Initial commit; currently fairly hackish, but functional for browsing wi...
authored
194 (unless num-context (setq num-context 0))
64810e5 Mark Hepburn Bugfix: extra parentheses!
authored
195 (if (< num-context 0) (setq num-context (- num-context)))
b09d5da Mark Hepburn Switching from using markers as the basic data type to a custom one (jus...
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 Mark Hepburn Initial commit; currently fairly hackish, but functional for browsing wi...
authored
207
208 ;;; to implement; different methods of operating on the current selection:
fc8a452 Mark Hepburn Mostly done now; operations completed (albeit, not tested for gtags yet)...
authored
209
210 (defmacro with-tag-info (locn args &rest body)
d888c13 Mark Hepburn 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 Mark Hepburn Mostly done now; operations completed (albeit, not tested for gtags yet)...
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 Mark Hepburn More hacking; jump to the location of the current tag.
authored
234 (defun tv-jump-to-tag-and-quit (location)
235 (interactive "d")
fc8a452 Mark Hepburn Mostly done now; operations completed (albeit, not tested for gtags yet)...
authored
236 (with-tag-info location (buf posn stack)
bcb3eb3 Mark Hepburn 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 Mark Hepburn Mostly done now; operations completed (albeit, not tested for gtags yet)...
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 often...
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 Mark Hepburn Mostly done now; operations completed (albeit, not tested for gtags yet)...
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 I'...
Mark Hepburn authored
253 (macrolet
fc8a452 Mark Hepburn Mostly done now; operations completed (albeit, not tested for gtags yet)...
authored
254 ((delete-nth (n lst)
89838f5 Fixing bug where front of the list wouldn't be deleted (oops, thought I'...
Mark Hepburn authored
255 `(if (zerop ,n)
256 (setq ,lst (cdr ,lst))
257 (setcdr (nthcdr (1- ,n) ,lst) (nthcdr (1+ ,n) ,lst)))))
fc8a452 Mark Hepburn Mostly done now; operations completed (albeit, not tested for gtags yet)...
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 Mark Hepburn Initial commit; currently fairly hackish, but functional for browsing wi...
authored
262 (defun tv-next-tag (&optional arg)
d888c13 Mark Hepburn Fixing checkdoc grumblings.
authored
263 "Move point forward to the next tag listing.
264 Optional numeric ARG moves forward that many tags."
9cf92b4 Mark Hepburn Initial commit; currently fairly hackish, but functional for browsing wi...
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 Mark Hepburn Fixing checkdoc grumblings.
authored
291 "Move point backwards to the previous tag listing.
292 Optional numeric ARG moves backwards that many tags."
9cf92b4 Mark Hepburn Initial commit; currently fairly hackish, but functional for browsing wi...
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 Mark Hepburn Calm flycheck down.
authored
310
9cf92b4 Mark Hepburn Initial commit; currently fairly hackish, but functional for browsing wi...
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 Mark Hepburn More hacking; jump to the location of the current tag.
authored
315 ;; operation:
fc8a452 Mark Hepburn Mostly done now; operations completed (albeit, not tested for gtags yet)...
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 Mark Hepburn More hacking; jump to the location of the current tag.
authored
319
9cf92b4 Mark Hepburn Initial commit; currently fairly hackish, but functional for browsing wi...
authored
320 ;; cleanup:
321 (define-key km "q" 'delete-window)))
322
fa8cba9 Mark Hepburn Calm flycheck down.
authored
323 (provide 'tags-view)
324 ;;; tags-view.el ends here
Something went wrong with that request. Please try again.