anything-gtags.el

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