contrib/global/gtags.el

   1 ;;; gtags.el --- gtags facility for Emacs
   2
   3 ;;
   4 ;; Copyright (c) 1997, 1998, 1999 Shigio Yamaguchi. All rights reserved.
   5 ;;
   6 ;; Redistribution and use in source and binary forms, with or without
   7 ;; modification, are permitted provided that the following conditions
   8 ;; are met:
   9 ;; 1. Redistributions of source code must retain the above copyright
  10 ;;    notice, this list of conditions and the following disclaimer.
  11 ;; 2. Redistributions in binary form must reproduce the above copyright
  12 ;;    notice, this list of conditions and the following disclaimer in the
  13 ;;    documentation and/or other materials provided with the distribution.
  14 ;; 3. All advertising materials mentioning features or use of this software
  15 ;;    must display the following acknowledgement:
  16 ;;       This product includes software developed by Shigio Yamaguchi.
  17 ;; 4. Neither the name of the author nor the names of any co-contributors
  18 ;;    may be used to endorse or promote products derived from this software
  19 ;;    without specific prior written permission.
  20 ;;
  21 ;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
  22 ;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
  23 ;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
  24 ;; ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
  25 ;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
  26 ;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
  27 ;; OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
  28 ;; HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
  29 ;; LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
  30 ;; OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
  31 ;; SUCH DAMAGE.
  32 ;;
  33 ;;      gtags.el        8-Jan-99
  34 ;;
  35
  36 ;; This file is part of GLOBAL.
  37 ;; Author: Shigio Yamaguchi <shigio@wafu.netgate.net>
  38 ;; Version: 1.5
  39 ;; Keywords: tools
  40
  41 ;;; Code
  42
  43 (defvar gtags-buffer-stack nil
  44   "Stack for tag browsing.")
  45 (defvar gtags-point-stack nil
  46   "Stack for tag browsing.")
  47 (defvar gtags-complete-list nil
  48   "Gtags complete list.")
  49 (defconst symbol-regexp "[A-Za-z_][A-Za-z_0-9]*"
  50   "Regexp matching tag name.")
  51 (defconst definition-regexp "#[ \t]*define[ \t]+\\|ENTRY(\\|ALTENTRY("
  52   "Regexp matching tag definition name.")
  53 (defvar gtags-read-only nil
  54   "Gtags read only mode")
  55 (defvar gtags-mode-map (make-sparse-keymap)
  56   "Keymap used in gtags mode.")
  57 (define-key gtags-mode-map "\et" 'gtags-find-tag)
  58 (define-key gtags-mode-map "\er" 'gtags-find-rtag)
  59 (define-key gtags-mode-map "\es" 'gtags-find-symbol)
  60 (define-key gtags-mode-map "\eg" 'gtags-find-pattern)
  61 (define-key gtags-mode-map "\C-]" 'gtags-find-tag-from-here)
  62 (define-key gtags-mode-map "\eh" 'gtags-display-browser)
  63 (define-key gtags-mode-map "\C-t" 'gtags-pop-stack)
  64 (define-key gtags-mode-map "\e." 'etags-style-find-tag)
  65 (define-key gtags-mode-map [mouse-2] 'gtags-find-tag-by-event)
  66 (define-key gtags-mode-map [mouse-3] 'gtags-pop-stack)
  67
  68 (defvar gtags-select-mode-map (make-sparse-keymap)
  69   "Keymap used in gtags select mode.")
  70 (define-key gtags-select-mode-map "q" 'gtags-pop-stack)
  71 (define-key gtags-select-mode-map "\C-t" 'gtags-pop-stack)
  72 (define-key gtags-select-mode-map "\C-m" 'gtags-select-tag)
  73 (define-key gtags-select-mode-map " " 'scroll-up)
  74 (define-key gtags-select-mode-map "\^?" 'scroll-down)
  75 (define-key gtags-select-mode-map "\C-f" 'scroll-up)
  76 (define-key gtags-select-mode-map "\C-b" 'scroll-down)
  77 (define-key gtags-select-mode-map "n" 'next-line)
  78 (define-key gtags-select-mode-map "p" 'previous-line)
  79 (define-key gtags-select-mode-map "j" 'next-line)
  80 (define-key gtags-select-mode-map "k" 'previous-line)
  81 (define-key gtags-select-mode-map [mouse-2] 'gtags-select-tag-by-event)
  82 (define-key gtags-select-mode-map [mouse-3] 'gtags-pop-stack)
  83
  84 ;;
  85 ;; utility
  86 ;;
  87 (defun util-match-string (n)
  88   (buffer-substring (match-beginning n) (match-end n)))
  89
  90 ;; Return a default tag to search for, based on the text at point.
  91 (defun gtags-current-token ()
  92   (cond
  93    ((looking-at "[0-9A-Za-z_]")
  94     (while (looking-at "[0-9A-Za-z_]")
  95       (forward-char -1))
  96     (forward-char 1))
  97    (t
  98     (while (looking-at "[ \t]")
  99       (forward-char 1))))
 100   (if (and (bolp) (looking-at definition-regexp))
 101       (goto-char (match-end 0)))
 102   (if (looking-at symbol-regexp)
 103       (util-match-string 0) nil))
 104
 105 ;; push current context to stack
 106 (defun push-context ()
 107   (setq gtags-buffer-stack (cons (current-buffer) gtags-buffer-stack))
 108   (setq gtags-point-stack (cons (point) gtags-point-stack)))
 109
 110 ;; pop context from stack
 111 (defun pop-context ()
 112   (if (not gtags-buffer-stack) nil
 113     (let (buffer point)
 114       (setq buffer (car gtags-buffer-stack))
 115       (setq gtags-buffer-stack (cdr gtags-buffer-stack))
 116       (setq point (car gtags-point-stack))
 117       (setq gtags-point-stack (cdr gtags-point-stack))
 118       (list buffer point))))
 119
 120 ;; if the buffer exist in the stack
 121 (defun exist-in-stack (buffer)
 122   (memq buffer gtags-buffer-stack))
 123
 124 ;; is it a function?
 125 (defun is-function ()
 126   (save-excursion
 127     (while (and (not (eolp)) (looking-at "[0-9A-Za-z_]"))
 128       (forward-char 1))
 129     (while (and (not (eolp)) (looking-at "[ \t]"))
 130       (forward-char 1))
 131     (if (looking-at "(") t nil)))
 132
 133 ;; is it a definition?
 134 (defun is-definition ()
 135   (save-excursion
 136     (if (and (string-match "\.java$" buffer-file-name) (looking-at "[^(]+([^)]*)[ \t]*{"))
 137         t
 138       (if (bolp)
 139           t
 140         (forward-word -1)
 141         (cond
 142          ((looking-at "define")
 143           (forward-char -1)
 144           (while (and (not (bolp)) (looking-at "[ \t]"))
 145             (forward-char -1))
 146           (if (and (bolp) (looking-at "#"))
 147               t nil))
 148          ((looking-at "ENTRY\\|ALTENTRY")
 149           (if (bolp) t nil)))))))
 150
 151 ;;
 152 ;; interactive command
 153 ;;
 154 (defun gtags-find-tag ()
 155   "Input tag name and move to the definition."
 156   (interactive)
 157   (let (tagname)
 158     (setq tagname (completing-read ":tag " gtags-complete-list))
 159     (push-context)
 160     (gtags-goto-tag tagname "")))
 161
 162 (defun etags-style-find-tag ()
 163   "Input tag name and move to the definition.(etags style)"
 164   (interactive)
 165   (let (tagname prompt input)
 166     (setq tagname (gtags-current-token))
 167     (if tagname
 168         (setq prompt (concat "Find tag: (default " tagname ") "))
 169       (setq prompt "Find tag: "))
 170     (setq input (completing-read prompt gtags-complete-list))
 171     (if (not (equal "" input)) (setq tagname input))
 172     (push-context)
 173     (gtags-goto-tag tagname "")))
 174
 175 (defun gtags-find-symbol ()
 176   "Input symbol and move to the locations."
 177   (interactive)
 178   (let (tagname prompt input)
 179     (setq tagname (gtags-current-token))
 180     (if tagname
 181         (setq prompt (concat "Find symbol: (default " tagname ") "))
 182       (setq prompt "Find symbol: "))
 183     (setq input (read-string prompt))
 184     (if (not (equal "" input)) (setq tagname input))
 185     (push-context)
 186     (gtags-goto-tag tagname "s")))
 187
 188 (defun gtags-find-pattern ()
 189   "Input pattern and move to the locations."
 190   (interactive)
 191   (let (tagname prompt input)
 192     (setq tagname (gtags-current-token))
 193     (if tagname
 194         (setq prompt (concat "Find pattern: (default " tagname ") "))
 195       (setq prompt "Find pattern: "))
 196     (setq input (read-string prompt))
 197     (if (not (equal "" input)) (setq tagname input))
 198     (push-context)
 199     (gtags-goto-tag tagname "g")))
 200
 201 (defun gtags-find-rtag ()
 202   "Input tag name and move to the referenced point."
 203   (interactive)
 204   (let (tagname)
 205     (setq tagname (completing-read ":rtag " gtags-complete-list))
 206     (push-context)
 207     (gtags-goto-tag tagname "r")))
 208
 209 (defun gtags-find-tag-from-here ()
 210   "Get the expression as a tagname around here and move there."
 211   (interactive)
 212   (let (tagname flag)
 213     (setq tagname (gtags-current-token))
 214     (if (is-function)
 215         (if (is-definition) (setq flag "r") (setq flag ""))
 216       (setq flag "s"))
 217     (if (not tagname)
 218         nil
 219       (push-context)
 220       (gtags-goto-tag tagname flag))))
 221
 222 (defun gtags-display-browser ()
 223   "Display current screen on hypertext browser."
 224   (interactive)
 225   (let (lno)
 226     (save-excursion
 227       (end-of-line)
 228       (if (equal (point-min) (point))
 229           (setq lno 1)
 230         (setq lno (count-lines (point-min) (point)))))
 231     (message (number-to-string lno))
 232     (call-process "gozilla"  nil t nil (concat "+" (number-to-string lno)) buffer-file-name)))
 233
 234 (defun gtags-find-tag-by-event (event)
 235   "Get the expression as a tagname around here and move there."
 236   (interactive "e")
 237   (select-window (posn-window (event-end event)))
 238   (set-buffer (window-buffer (posn-window (event-end event))))
 239   (goto-char (posn-point (event-end event)))
 240   (let (tagname flag)
 241     (if (= 0 (count-lines (point-min) (point-max)))
 242         (progn (setq tagname "main") (setq flag ""))
 243       (setq tagname (gtags-current-token))
 244       (if (is-function)
 245           (if (is-definition) (setq flag "r") (setq flag ""))
 246         (setq flag "s")))
 247     (if (not tagname)
 248         nil
 249       (push-context)
 250       (gtags-goto-tag tagname flag))))
 251
 252 (defun gtags-select-tag ()
 253   "Select a tagname in [GTAGS SELECT MODE] and move there."
 254   (interactive)
 255   (push-context)
 256   (gtags-select-it nil))
 257
 258 (defun gtags-select-tag-by-event (event)
 259   "Select a tagname in [GTAGS SELECT MODE] and move there."
 260   (interactive "e")
 261   (select-window (posn-window (event-end event)))
 262   (set-buffer (window-buffer (posn-window (event-end event))))
 263   (goto-char (posn-point (event-end event)))
 264   (push-context)
 265   (gtags-select-it nil))
 266
 267 (defun gtags-pop-stack ()
 268   "Move to previous point on the stack."
 269   (interactive)
 270   (let (delete context buffer)
 271     (if (not (exist-in-stack (current-buffer)))
 272         (setq delete t))
 273     (setq context (pop-context))
 274     (if (not context)
 275         (message "The tags stack is empty.")
 276       (if delete
 277           (kill-buffer (current-buffer)))
 278       (switch-to-buffer (nth 0 context))
 279       (goto-char (nth 1 context)))))
 280
 281 ;;
 282 ;; common function
 283 ;;
 284
 285 ;; goto tag's point
 286 (defun gtags-goto-tag (tagname flag)
 287   (let (save prefix buffer lines)
 288     (setq save (current-buffer))
 289     (cond
 290      ((equal flag "g")
 291       (setq prefix "(G)"))
 292      ((equal flag "s")
 293       (setq prefix "(S)"))
 294      ((equal flag "r")
 295       (setq prefix "(R)"))
 296      (t (setq prefix "(D)")))
 297     ;; load tag
 298     (setq buffer (generate-new-buffer (generate-new-buffer-name (concat prefix tagname))))
 299     (set-buffer buffer)
 300     (if (not (= 0 (call-process "global" nil t nil (concat "-ax" flag) tagname)))
 301         (progn (message (buffer-substring (point-min)(1- (point-max))))
 302                (pop-context))
 303       (goto-char (point-min))
 304       (setq lines (count-lines (point-min) (point-max)))
 305       (cond
 306        ((= 0 lines)
 307         (message "%s: tag not found" tagname)
 308         (pop-context)
 309         (kill-buffer buffer)
 310         (set-buffer save))
 311        ((= 1 lines)
 312         (gtags-select-it t))
 313        (t
 314         (switch-to-buffer buffer)
 315         (gtags-select-mode))))))
 316
 317 ;; select a tag line from lines
 318 (defun gtags-select-it (delete)
 319   (let (line file)
 320     ;; get context from current tag line
 321     (beginning-of-line)
 322 ;;    (if (not (looking-at "[A-Za-z_][A-Za-z_0-9]*[ \t]+\\([0-9]+\\)[ \t]\\([^ \t]+\\)[ \t]"))
 323     (if (not (looking-at "[^ \t]+[ \t]+\\([0-9]+\\)[ \t]\\([^ \t]+\\)[ \t]"))
 324         (pop-context)
 325       (setq line (string-to-number (util-match-string 1)))
 326       (setq file (util-match-string 2))
 327       (if delete (kill-buffer (current-buffer)))
 328       ;; move to the context
 329       (if gtags-read-only (find-file-read-only file) (find-file file))
 330       (goto-line line)
 331       (use-local-map gtags-mode-map))))
 332
 333 ;; make complete list
 334 (defun make-gtags-complete-list ()
 335 ;;  "Make tag name list for completion."
 336 ;;  (interactive)
 337   (save-excursion
 338     (setq gtags-complete-list (make-vector 63 0))
 339     (set-buffer (generate-new-buffer "*Completions*"))
 340     (call-process "global" nil t nil "-c")
 341     (goto-char (point-min))
 342     (while (looking-at symbol-regexp)
 343       (intern (util-match-string 0) gtags-complete-list)
 344       (forward-line))
 345     (kill-buffer (current-buffer))))
 346
 347 ;;;###autoload
 348 (defun gtags-mode ()
 349   "Minor mode for browsing C source using GLOBAL."
 350   (interactive)
 351   (if (y-or-n-p "Do you use function name completion?")
 352     (make-gtags-complete-list))
 353   (use-local-map gtags-mode-map)
 354   (run-hooks 'gtags-mode-hook))
 355
 356 ;; make gtags select mode
 357 (defun gtags-select-mode ()
 358   "Major mode for choosing a tag from tags list."
 359   (setq buffer-read-only t
 360         major-mode 'gtags-select-mode
 361         mode-name "Gtags Select")
 362   (use-local-map gtags-select-mode-map)
 363   (setq truncate-lines t)
 364   (goto-char (point-min))
 365   (message "[GTAGS SELECT MODE] %d lines" (count-lines (point-min) (point-max)))
 366   (run-hooks 'gtags-select-mode-hook))
 367
 368 ;;; gtags.el ends here