extensions/anything-gtags.el

   1 ;;; anything-gtags.el --- GNU GLOBAL anything.el interface
   2 ;; $Id: anything-gtags.el,v 1.27 2010-02-06 12:33:13 rubikitch Exp $
   3
   4 ;; Copyright (C) 2008, 2009, 2010  rubikitch
   5
   6 ;; Author: rubikitch <rubikitch@ruby-lang.org>
   7 ;; Keywords: global, languages
   8 ;; URL: http://www.emacswiki.org/cgi-bin/wiki/download/anything-gtags.el
   9
  10 ;; This file is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation; either version 2, or (at your option)
  13 ;; any later version.
  14
  15 ;; This file is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to
  22 ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  23 ;; Boston, MA 02110-1301, USA.
  24
  25 ;;; Commentary:
  26
  27 ;; * `anything-gtags-select' is `anything' interface of `gtags-find-tag'.
  28 ;; * `anything-c-source-gtags-select' is a source for `gtags-find-tag'.
  29 ;; * Replace *GTAGS SELECT* buffer with `anything' interface.
  30
  31 ;;; Commands:
  32 ;;
  33 ;; Below are complete command list:
  34 ;;
  35 ;;  `anything-gtags-select'
  36 ;;    Tag jump using gtags and `anything'.
  37 ;;  `anything-gtags-resume'
  38 ;;    Select previously selected anything gtags buffer.
  39 ;;
  40 ;;; Customizable Options:
  41 ;;
  42 ;; Below are customizable option list:
  43 ;;
  44 ;;  `anything-gtags-enable-initial-pattern'
  45 ;;    *If non-nil, initial input of `anything-gtags-select' is current symbol.
  46 ;;    default = nil
  47 ;;  `anything-gtags-classify'
  48 ;;    *If non-nil, use separate source file by file.
  49 ;;    default = nil
  50
  51 ;;; History:
  52
  53 ;; $Log: anything-gtags.el,v $
  54 ;; Revision 1.27  2010-02-06 12:33:13  rubikitch
  55 ;; Added more actions to `anything-c-source-gtags-select'.
  56 ;; http://d.hatena.ne.jp/shinking/20100130/1264869641
  57 ;;
  58 ;; Revision 1.26  2009/12/28 04:07:00  rubikitch
  59 ;; remove warnings
  60 ;;
  61 ;; Revision 1.25  2009/12/28 03:59:17  rubikitch
  62 ;; New command `anything-gtags-resume'
  63 ;;
  64 ;; Revision 1.24  2009/12/28 01:39:51  rubikitch
  65 ;; Support multiple anything gtags buffer (resume)
  66 ;;
  67 ;; Revision 1.23  2009/12/21 10:41:21  rubikitch
  68 ;; Use `anything-persistent-highlight-point' if available.
  69 ;;
  70 ;; Revision 1.22  2009/12/19 01:22:27  rubikitch
  71 ;; cleanup
  72 ;;
  73 ;; Revision 1.21  2009/12/19 00:45:52  rubikitch
  74 ;; Avoid `select deleted buffer' error
  75 ;;
  76 ;; Revision 1.20  2009/12/19 00:31:55  rubikitch
  77 ;; Fixed variable bug
  78 ;;
  79 ;; Revision 1.19  2009/05/06 18:37:20  rubikitch
  80 ;; Resumable
  81 ;;
  82 ;; Revision 1.18  2009/04/01 14:59:27  rubikitch
  83 ;; Disable no-filename display (`anything-gtags-classify' == t) because `aggs-select-it' needs file-name.
  84 ;;
  85 ;; Revision 1.17  2009/03/18 17:50:08  rubikitch
  86 ;; If `anything-gtags-classify' is t, enable classification and suppress filename output.
  87 ;; If it is other true symbol, enable classification and output filename.
  88 ;;
  89 ;; Revision 1.16  2009/03/18 17:35:01  rubikitch
  90 ;; refactoring
  91 ;;
  92 ;; Revision 1.15  2009/03/18 17:31:39  rubikitch
  93 ;; Apply SUGAWARA's patch to suppress filename output when `anything-gtags-classify' is non-nil.
  94 ;;
  95 ;; Revision 1.14  2009/01/27 09:51:34  rubikitch
  96 ;; * Push context when jumping with `anything-gtags-select'.
  97 ;; * New variable: `anything-gtags-enable-initial-pattern'.
  98 ;;
  99 ;; Revision 1.13  2008/12/20 22:11:04  rubikitch
 100 ;; Fixed an error in Emacs23 by Andy Stewart. Thanks.
 101 ;;
 102 ;; Revision 1.12  2008/10/24 07:14:14  rubikitch
 103 ;; use `ad-get-arg'
 104 ;;
 105 ;; Revision 1.11  2008/09/06 06:01:07  rubikitch
 106 ;; Classify candidates by file name using meta source.
 107 ;; If `anything-gtags-classify' is non-nil, classification is enabled.
 108 ;;
 109 ;; Revision 1.10  2008/08/24 20:45:07  rubikitch
 110 ;; silence byte compiler
 111 ;;
 112 ;; Revision 1.9  2008/08/24 08:22:48  rubikitch
 113 ;; Rename `anything-candidates-buffer' -> `anything-candidate-buffer'
 114 ;;
 115 ;; Revision 1.8  2008/08/23 23:01:53  rubikitch
 116 ;; *** empty log message ***
 117 ;;
 118 ;; Revision 1.7  2008/08/20 19:00:36  rubikitch
 119 ;; *** empty log message ***
 120 ;;
 121 ;; Revision 1.6  2008/08/20 18:58:42  rubikitch
 122 ;; preselect entry of current line of source code.
 123 ;;
 124 ;; Revision 1.5  2008/08/19 21:50:00  rubikitch
 125 ;; adjust to new `search' spec.
 126 ;;
 127 ;; Revision 1.4  2008/08/18 17:20:23  rubikitch
 128 ;; save c source buffer's position
 129 ;; silence byte compiler
 130 ;;
 131 ;; Revision 1.3  2008/08/16 10:26:56  rubikitch
 132 ;; adjust to argument change of `anything-candidates-in-buffer-1'
 133 ;;
 134 ;; Revision 1.2  2008/08/14 20:47:14  rubikitch
 135 ;; ag-hijack-gtags-select-mode: cleanup
 136 ;;
 137 ;; Revision 1.1  2008/08/13 14:17:41  rubikitch
 138 ;; Initial revision
 139 ;;
 140
 141 ;;; Code:
 142
 143 (require 'anything)
 144 (require 'anything-config nil t)        ; highlight line if available
 145 (require 'gtags nil t)
 146
 147 (defgroup anything-gtags nil
 148   "Gtags Anything interface"
 149   :group 'anything)
 150
 151 (defcustom anything-gtags-enable-initial-pattern nil
 152   "*If non-nil, initial input of `anything-gtags-select' is current symbol."
 153   :group 'anything-gtags
 154   :type 'boolean)
 155
 156 (defvar anything-c-source-gtags-select
 157   '((name . "GTAGS")
 158     (init
 159      . (lambda ()
 160          (call-process-shell-command
 161           "global -c" nil (anything-candidate-buffer 'global))))
 162     (candidates-in-buffer)
 163     (action
 164      ("Goto the location" . (lambda (candidate)
 165                               (gtags-push-context)
 166                               (gtags-goto-tag candidate "")))
 167      ("Goto the location (other-window)" . (lambda (candidate)
 168                                              (gtags-push-context)
 169                                              (gtags-goto-tag candidate "" t)))
 170      ("Move to the referenced point" . (lambda (candidate)
 171                                          (gtags-push-context)
 172                                          (gtags-goto-tag candidate "r"))))))
 173
 174 ;; (setq anything-sources (list anything-c-source-gtags-select))
 175
 176 (defun anything-gtags-select ()
 177   "Tag jump using gtags and `anything'."
 178   (interactive)
 179   (let* ((initial-pattern (regexp-quote (or (thing-at-point 'symbol) ""))))
 180     (anything '(anything-c-source-gtags-select)
 181               (if anything-gtags-enable-initial-pattern initial-pattern)
 182               "Find Tag: " nil)))
 183
 184 ;;;; `gtags-select-mode' replacement
 185 (defvar anything-gtags-hijack-gtags-select-mode t
 186   "Use `anything' instead of `gtags-select-mode'.")
 187 (defcustom anything-gtags-classify nil
 188   "*If non-nil, use separate source file by file.
 189 If it is t, enable classification and suppress file name output in candidates.
 190 If it is other symbol, display file name in candidates even if classification is enabled."
 191   :group 'anything-gtags
 192   :type '(choice boolean symbol))
 193 (defvar aggs-base-source
 194   '((candidates-in-buffer)
 195     (get-line . aggs-candidate-display)
 196     (display-to-real
 197      . (lambda (c) (if (string-match "^ " c) (concat "_ " c) c)))
 198     (action ("Goto the location" . aggs-select-it))))
 199 (defvar aggs-buffer "*anything gtags select*")
 200
 201 (defun aggs-candidate-display (s e)
 202   (buffer-substring-no-properties (aggs-search-not-space-point s e) e))
 203
 204 (defun aggs-search-not-space-point (s e)
 205   (save-excursion
 206     (goto-char s)
 207     (let ((space-point (search-forward " " e t)))
 208       (if (and space-point (> (- space-point s) 16))
 209           (- space-point 1) ; for buffer-substring
 210         (+ s 16)))))
 211
 212 (defun aggs-set-anything-current-position ()
 213   (declare (special c-source-file))
 214   ;; It's needed because `anything' saves
 215   ;; *GTAGS SELECT* buffer's position,
 216   (save-window-excursion
 217     (switch-to-buffer c-source-file)
 218     (setq anything-current-position (cons (point) (window-start)))))
 219
 220 (defun ag-hijack-gtags-select-mode ()
 221   ;; `save' C source file / `buffer': gtags-select-mode gtags-select-buffer
 222   ;; They are defined at `gtags-goto-tag'.
 223   (declare (special save buffer))
 224   (let* ((c-source-file save)
 225          (gtags-select-buffer buffer)
 226          (anything-candidate-number-limit 9999)
 227          (bfn (with-current-buffer c-source-file buffer-file-name))
 228          (pwd (with-current-buffer gtags-select-buffer (file-name-directory bfn)))
 229          (basename (substring bfn (length pwd)))
 230          (lineno (with-current-buffer c-source-file
 231                    (save-restriction
 232                      (widen)
 233                      (line-number-at-pos))))
 234          (sources (if anything-gtags-classify
 235                       '(((name . "GTAGS SELECT meta source")
 236                          (init . aggs-meta-source-init)))
 237                     `(((name . "GTAGS SELECT")
 238                        (init
 239                         . (lambda ()
 240                             (aggs-set-anything-current-position)
 241                             (anything-candidate-buffer gtags-select-buffer)))
 242                        ,@aggs-base-source))))
 243          (aggs-buffer (concat "*anything gtags*"
 244                               (substring (buffer-name gtags-select-buffer) 15))))
 245     (with-current-buffer (get-buffer-create aggs-buffer)
 246       (set (make-local-variable 'gtags-select-buffer) gtags-select-buffer)
 247       (set (make-local-variable 'pwd) pwd))
 248     (anything
 249      sources
 250      nil nil nil (format "\\(\\(%d\\) +%s\\)" lineno (regexp-quote basename))
 251      aggs-buffer)))
 252
 253 (defun aggs-candidate-buffer-by-filename (filename)
 254   (get-buffer-create (concat "*anything gtags*" filename)))
 255 (defun aggs-meta-source-init ()
 256   (declare (special gtags-select-buffer))
 257   (aggs-set-anything-current-position)
 258   (with-current-buffer gtags-select-buffer
 259     (goto-char (point-min))
 260     (let (files prev-filename)
 261       (loop while (re-search-forward " [0-9]+ \\([^ ]+\\) " (point-at-eol) t)
 262             for filename = (match-string 1)
 263             for bol = (point-at-bol)
 264             for eol = (point-at-eol)
 265             do
 266             (with-current-buffer (aggs-candidate-buffer-by-filename filename)
 267               (unless (equal prev-filename filename)
 268                 (setq files (cons filename files))
 269                 (erase-buffer))
 270               (save-excursion (insert-buffer-substring gtags-select-buffer bol eol))
 271               (goto-char (point-max))
 272               (insert "\n"))
 273             (forward-line 1)
 274             (setq prev-filename filename))
 275       (anything-set-sources
 276        (loop for file in (nreverse files) collect
 277              (append `((name . ,file)
 278                        (init . (lambda ()
 279                                  (anything-candidate-buffer
 280                                   ,(aggs-candidate-buffer-by-filename file)))))
 281                      aggs-base-source)))
 282       (anything-funcall-foreach 'init))))
 283
 284 (defun aggs-select-it (candidate)
 285   (with-temp-buffer
 286     ;; `pwd' is defined at `ag-hijack-gtags-select-mode'.
 287     (setq default-directory (buffer-local-value 'pwd (get-buffer anything-buffer)))
 288     (insert candidate "\n")
 289     (forward-line -1)
 290     (gtags-select-it nil)
 291     ;; TODO fboundp
 292      (when (and anything-in-persistent-action
 293                (fboundp 'anything-persistent-highlight-point))
 294       (anything-persistent-highlight-point (point-at-bol) (point-at-eol)))))
 295
 296 (defun anything-gtags-resume ()
 297   "Select previously selected anything gtags buffer."
 298   (interactive)
 299   (anything-resume nil "*anything  gtags* "))
 300
 301 (defadvice switch-to-buffer (around anything-gtags activate)
 302   "Use `anything' instead of `gtags-select-mode' when `anything-gtags-hijack-gtags-select-mode' is non-nil."
 303   (unless (and anything-gtags-hijack-gtags-select-mode
 304            (string-match "*GTAGS SELECT*"
 305                          (if (bufferp (ad-get-arg 0))
 306                              (buffer-name (ad-get-arg 0))
 307                                (or (ad-get-arg 0) ""))))
 308     ad-do-it))
 309 ;; (progn (ad-disable-advice 'switch-to-buffer 'around 'anything-gtags) (ad-update 'switch-to-buffer))
 310
 311 (defadvice gtags-select-mode (around anything-gtags activate)
 312   "Use `anything' instead of `gtags-select-mode' when `anything-gtags-hijack-gtags-select-mode' is non-nil."
 313   (if anything-gtags-hijack-gtags-select-mode
 314       (ag-hijack-gtags-select-mode)
 315     ad-do-it))
 316 ;; (progn (ad-disable-advice 'gtags-select-mode 'around 'anything-gtags) (ad-update 'gtags-select-mode))
 317
 318 (provide 'anything-gtags)
 319
 320 ;; How to save (DO NOT REMOVE!!)
 321 ;; (progn (magit-push) (emacswiki-post "anything-gtags.el"))
 322 ;;; anything-gtags.el ends here