gtags.el suggestion

[jrwats]

Cleaned up goto-tag code with flag/options table. Also reworked many of the interactive functions to allow for searching for tags locally.

Calls global asynchronously (using start-process rather than call-process) so that if you specify a symbol that is found in many files and takes a long time to run, you can still move around and edit in emacs while you wait.

 

Thanks,

John Watson

65a66,68
> (eval-when-compile
>   (require 'cl))
>
113a117,143

>
> (defconst gtags-default-error ": tag not found")
>
> (defvar gtags-flag-table
>   ;; name <cmd-line string> <buffer-name prefix> <error-msg>
>   `((symbol    "s" "(S)" ": symbol not found")
>     (context   "c" "(CONTEXT)" ,gtags-default-error)
>     (grep      "g" "(GREP)" ": pattern not found")
>     (idutils   "I" "(IDUTILS)" ": token not found")
>     (path      "P" "(P)" ": path not found")
>     (reference "r" "(Ref)" ,gtags-default-error)
>     ;; optional flags
>     (local     "l" "(local)"))
>   " table of legitimate flags")
>
> (defmacro gtags-flag-sym (flag)
>   `(car ,flag))
>
> (defmacro gtags-flag-cmd-line-arg (flag)
>   `(cadr ,flag))
>
> (defmacro gtags-flag-prefix-msg (flag)
>   `(caddr ,flag))
>
> (defmacro gtags-flag-err-msg (flag)
>   `(cadddr ,flag))
>

296c326

<     (gtags-goto-tag tagname "" other-win)))
---
>     (gtags-goto-tag tagname nil other-win)))
303c333,336
< (defun gtags-find-rtag ()
---
> (defmacro concat-local-macro (local)
>   `(if ,local (assq 'local gtags-flag-table)))
>
> (defun gtags-find-rtag (tagname &optional local)
305,316c338,350
<   (interactive)
<   (let (tagname prompt input)
<    (setq tagname (gtags-current-token))
<    (if tagname
<      (setq prompt (concat "Find tag (reference): (default " tagname ") "))
<     (setq prompt "Find tag (reference): "))
<    (setq input (completing-read prompt 'gtags-completing-gtags
<                  nil nil nil gtags-history-list))
<    (if (not (equal "" input))
<      (setq tagname input))
<     (gtags-push-context)
<     (gtags-goto-tag tagname "r")))
---

>   (interactive
>    (let (tagname prompt input)
>      (setq tagname (gtags-current-token))
>      (if tagname
>          (setq prompt (concat "Find tag (reference): (default " tagname ") "))
>        (setq prompt "Find tag (reference): "))
>      (setq input (completing-read prompt 'gtags-completing-gtags
>                                   nil nil nil gtags-history-list))
>      (if (not (equal "" input)) (setq tagname input))
>      (list tagname current-prefix-arg)))
>   (gtags-push-context)
>   (gtags-goto-tag tagname (list (assq 'reference gtags-flag-table)
>                                 (concat-local-macro local))))

318c352

< (defun gtags-find-symbol ()
---
> (defun gtags-find-symbol (tagname &optional local)
320,328c354,363
<   (interactive)
<   (let (tagname prompt input)
<     (setq tagname (gtags-current-token))
<     (if tagname
<         (setq prompt (concat "Find symbol: (default " tagname ") "))
<       (setq prompt "Find symbol: "))
<     (setq input (completing-read prompt 'gtags-completing-gsyms
<                   nil nil nil gtags-history-list))
<     (if (not (equal "" input)) (setq tagname input))
---

>   (interactive
>    (let (tagname prompt input)
>      (setq tagname (gtags-current-token))
>      (if tagname
>          (setq prompt (concat "Find symbol: (default " tagname ") "))
>        (setq prompt "Find symbol: "))
>      (setq input (completing-read prompt 'gtags-completing-gsyms
>                                   nil nil nil gtags-history-list))
>      (if (not (equal "" input)) (setq tagname input))
>      (list tagname current-prefix-arg)))

330c365,367

<     (gtags-goto-tag tagname "s")))
---
>     (message "local: %s" local)
>     (gtags-goto-tag tagname (list (assq 'symbol gtags-flag-table)
>                                   (concat-local-macro local))))
340c377
<   (gtags-find-with "g"))
---
>   (gtags-find-with (list (assq 'grep gtags-flag-table))))
345c382
<   (gtags-find-with "I"))
---
>   (gtags-find-with (list (assq 'grep gtags-flag-table))))
347c384
< (defun gtags-find-file ()
---
> (defun gtags-find-file (tagname &optional local)
349,355c386,393
<   (interactive)
<   (let (tagname prompt input)
<     (setq prompt "Find files: ")
<     (setq input (read-string prompt))
<     (if (not (equal "" input)) (setq tagname input))
<     (gtags-push-context)
<     (gtags-goto-tag tagname "P")))
---
>   (interactive
>    (let (tagname input)
>      (setq input (read-string "Find files: "))
>      (if (not (equal "" input)) (setq tagname input))
>      (list tagname current-prefix-arg)))
>   (gtags-push-context)
>   (gtags-goto-tag tagname (list (assq 'path gtags-flag-table)
>                                 (concat-local-macro local))))
357c395
< (defun gtags-parse-file ()
---
> (defun gtags-parse-file (tagname &optional local)
359,365c397,405
<   (interactive)
<   (let (tagname prompt input)
<     (setq input (read-file-name "Parse file: "
< nil nil t (file-name-nondirectory buffer-file-name)))
<     (if (not (equal "" input)) (setq tagname input))
<     (gtags-push-context)
<     (gtags-goto-tag tagname "f")))
---
>   (interactive
>    (let (tagname prompt input)
>
>      (setq input (read-file-name "Parse file: "
>                                  nil nil t (file-name-nondirectory buffer-file-name)))
>      (if (not (equal "" input)) (setq tagname input))
>      (list tagname current-prefix-arg)))
>   (gtags-push-context)
>   (gtags-goto-tag tagname "f"))
367c407
< (defun gtags-find-tag-from-here ()
---
> (defun gtags-find-tag-from-here (tagname &optional local)
369,375c409,416
<   (interactive)
<   (let (tagname flag)
<     (setq tagname (gtags-current-token))
<     (if (not tagname)
<         nil
<       (gtags-push-context)
<       (gtags-goto-tag tagname "C"))))
---
>   (interactive
>    (let (tagname flag)
>      (setq tagname (gtags-current-token))
>      (list tagname current-prefix-arg)))
>   (when tagname
>     (gtags-push-context)
>     (gtags-goto-tag tagname (list (assq 'context gtags-flag-table)
>                                   (concat-local-macro local)))))
396,397c437
<         (progn (setq tagname "main")
<                (setq flag ""))
---
>         (setq tagname "main")
404c444
<       (setq flag "C"))
---
>       (setq flag (assq 'context gtags-flag-table)))
408c448
<       (gtags-goto-tag tagname flag))))
---
>       (gtags-goto-tag tagname (list flag)))))
458c498
< (defun gtags-find-with (flag)
---
> (defun gtags-find-with (flags)
468c508
<     (gtags-goto-tag tagname flag)))
---
>     (gtags-goto-tag tagname flags)))
471,474c511,514
< (defun gtags-goto-tag (tagname flag &optional other-win)
<   (let (option context save prefix buffer lines)
<     (setq save (current-buffer))
<     ; Use always ctags-x format.
---
> (defun gtags-goto-tag (tagname flags &optional other-win)
>   (let (option context prev-buffer prefix buffer process-result lines)
>     (setq prev-buffer (current-buffer))
>     ;; Use always ctags-x format.
476,492c516,521
<     (if (equal flag "C")
<         (setq context (concat "--from-here=" (number-to-string (gtags-current-lineno)) ":" buffer-file-name))
<         (setq option (concat option flag)))
<     (cond
<      ((equal flag "C")
<       (setq prefix "(CONTEXT)"))
<      ((equal flag "P")
<       (setq prefix "(P)"))
<      ((equal flag "g")
<       (setq prefix "(GREP)"))
<      ((equal flag "I")
<       (setq prefix "(IDUTILS)"))
<      ((equal flag "s")
<       (setq prefix "(S)"))
<      ((equal flag "r")
<       (setq prefix "(R)"))
<      (t (setq prefix "(D)")))
---
>     (dolist (flag flags)
>       (if (equal (gtags-flag-sym flag) 'context)
>           (setq context (concat "--from-here=" (number-to-string (gtags-current-lineno)) ":" buffer-file-name))
>         (setq option (concat option (gtags-flag-cmd-line-arg flag))))
>       (setq prefix (concat prefix (gtags-flag-prefix-msg flag))))
>    
495,510c524,534
<     (set-buffer buffer)
<     ;
<     ; Path style is defined in gtags-path-style:
<     ;   root: relative from the root of the project (Default)
<     ;   relative: relative from the current directory
<     ; absolute: absolute (relative from the system root directory)
<     ;
<     (cond
<      ((equal gtags-path-style 'absolute)
<       (setq option (concat option "a")))
<      ((equal gtags-path-style 'root)
<       (let (rootdir)
<         (if gtags-rootdir
<           (setq rootdir gtags-rootdir)
<          (setq rootdir (gtags-get-rootpath)))
<         (if rootdir (cd rootdir)))))
---

>
>     ;; Path style is defined in gtags-path-style:
>     ;;   root: relative from the root of the project (Default)
>     ;;   relative: relative from the current directory
>     ;; absolute: absolute (relative from the system root directory)
>     ;;
>     (cond ((equal gtags-path-style 'absolute) (setq option (concat option "a")))
>           ((and (equal gtags-path-style 'root) (not (assq 'local flags)))
>            (let ((rootdir (or gtags-rootdir (gtags-get-rootpath))))
>              (if rootdir (cd rootdir)))))
>    

512,542c536,565

<     (if (not (= 0 (if (equal flag "C")
<                       (call-process "global" nil t nil option context tagname)
<                       (call-process "global" nil t nil option tagname))))
< (progn (message (buffer-substring (point-min)(1- (point-max))))
<                (gtags-pop-context))
<       (goto-char (point-min))
<       (setq lines (count-lines (point-min) (point-max)))
<       (cond
<        ((= 0 lines)
<          (cond
<           ((equal flag "P")
<            (message "%s: path not found" tagname))
<           ((equal flag "g")
<            (message "%s: pattern not found" tagname))
<           ((equal flag "I")
<            (message "%s: token not found" tagname))
<           ((equal flag "s")
<            (message "%s: symbol not found" tagname))
<           (t
<            (message "%s: tag not found" tagname)))
< (gtags-pop-context)
< (kill-buffer buffer)
< (set-buffer save))
<        ((= 1 lines)
< (message "Searching %s ... Done" tagname)
< (gtags-select-it t other-win))
<        (t
<         (if (null other-win)
<             (switch-to-buffer buffer)
<           (switch-to-buffer-other-window buffer))
< (gtags-select-mode))))))
---

>
>     (setq process-result (if context
>                              (start-process "gtags" buffer "global" option context tagname)
>                            (start-process "gtags" buffer "global" option tagname)))
>     (lexical-let ((other-win other-win) (flags flags) (tagname tagname) gtags-process-sentinel)
>       (defun gtags-process-sentinel (process event)
>         (let ((prev-buf (current-buffer))
>               (buf (process-buffer process)))
>         (message "process: %s event: %s" process event)
>         (cond ((string-match "finished" event)
>                (set-buffer buf)
>                (goto-char (point-min))
>                (setq lines (count-lines (point-min) (point-max)))
>                (cond ((= 0 lines)
>                       (message (concat "%s" (gtags-flag-err-msg (car flags))) tagname)
>                       (gtags-pop-context)
>                       (kill-buffer buf)
>                       (set-buffer prev-buf))
>                      ((= 1 lines)
>                       (message "Searching %s ... Done" tagname)
>                       (gtags-select-it t other-win))
>                      (t (if (null other-win)
>                             (switch-to-buffer buf)
>                           (switch-to-buffer-other-window buf))
>                         (gtags-select-mode))))
>               ;; otherwise assume failure
>               (t (message "failure")
>                  (message (buffer-substring (point-min) (1- (point-max))))
>                  (gtags-pop-context)))))
>       (set-process-sentinel process-result 'gtags-process-sentinel))))

;;; gtags.el --- gtags facility for Emacs

;;
;; Copyright (c) 1997, 1998, 1999, 2000, 2006, 2007, 2008
;; Tama Communications Corporation
;;
;; This file is part of GNU GLOBAL.
;;
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
;;

;; GLOBAL home page is at: http://www.gnu.org/software/global/
;; Author: Tama Communications Corporation
;; Version: 2.5
;; Keywords: tools
;; Required version: GLOBAL 5.7 or later

;; Gtags-mode is implemented as a minor mode so that it can work with any
;; other major modes. Gtags-select mode is implemented as a major mode.
;;
;; Please copy this file into emacs lisp library directory or place it in
;; a directory (for example "~/lisp") and write $HOME/.emacs like this.
;;
;; (setq load-path (cons "~/lisp" load-path))
;;
;; If you hope gtags-mode is on in c-mode then please add c-mode-hook to your
;; $HOME/.emacs like this.
;;
;; (setq c-mode-hook
;;    '(lambda ()
;; (gtags-mode 1)
;; ))
;;
;; There are two hooks, gtags-mode-hook and gtags-select-mode-hook.
;; The usage of the hook is shown as follows.
;;
;; [Setting to reproduce old 'Gtags mode']
;;
;; (setq gtags-mode-hook
;;   '(lambda ()
;;      (setq gtags-pop-delete t)
;;      (setq gtags-path-style 'absolute)
;; ))
;;
;; [Setting to make 'Gtags select mode' easy to see]
;;
;; (setq gtags-select-mode-hook
;;   '(lambda ()
;;      (setq hl-line-face 'underline)
;;      (hl-line-mode 1)
;; ))

;;; Code

(eval-when-compile
  (require 'cl))

(defvar gtags-mode nil
  "Non-nil if Gtags mode is enabled.")
(make-variable-buffer-local 'gtags-mode)

;;;
;;; Customizing gtags-mode
;;;
(defgroup gtags nil
  "Minor mode for GLOBAL source code tag system."
  :group 'tools
  :prefix "gtags-")

(defcustom gtags-path-style 'root
  "*Controls the style of path in [GTAGS SELECT MODE]."
  :type '(choice (const :tag "Relative from the root of the current project" root)
                 (const :tag "Relative from the current directory" relative)
                 (const :tag "Absolute" absolute))
  :group 'gtags)

(defcustom gtags-read-only nil
  "Gtags read only mode"
  :type 'boolean
  :group 'gtags)

(defcustom gtags-pop-delete nil
  "*If non-nil, gtags-pop will delete the buffer."
  :group 'gtags
  :type 'boolean)

;; Variables
(defvar gtags-current-buffer nil
  "Current buffer.")
(defvar gtags-buffer-stack nil
  "Stack for tag browsing.")
(defvar gtags-point-stack nil
  "Stack for tag browsing.")
(defvar gtags-history-list nil
  "Gtags history list.")
(defconst gtags-symbol-regexp "[A-Za-z_][A-Za-z_0-9]*"
  "Regexp matching tag name.")
(defconst gtags-definition-regexp "#[ \t]*define[ \t]+\\|ENTRY(\\|ALTENTRY("
  "Regexp matching tag definition name.")
(defvar gtags-mode-map (make-sparse-keymap)
  "Keymap used in gtags mode.")
(defvar gtags-running-xemacs (string-match "XEmacs\\|Lucid" emacs-version)
  "Whether we are running XEmacs/Lucid Emacs")
(defvar gtags-rootdir nil
  "Root directory of source tree.")

(defconst gtags-default-error ": tag not found")

(defvar gtags-flag-table
  ;; name <cmd-line string> <buffer-name prefix> <error-msg>
  `((symbol    "s" "(S)" ": symbol not found")
    (context   "c" "(CONTEXT)" ,gtags-default-error)
    (grep      "g" "(GREP)" ": pattern not found")
    (idutils   "I" "(IDUTILS)" ": token not found")
    (path      "P" "(P)" ": path not found")
    (reference "r" "(Ref)" ,gtags-default-error)
    ;; optional flags
    (local     "l" "(local)"))
  " table of legitimate flags")

(defmacro gtags-flag-sym (flag)
  `(car ,flag))

(defmacro gtags-flag-cmd-line-arg (flag)
  `(cadr ,flag))

(defmacro gtags-flag-prefix-msg (flag)
  `(caddr ,flag))

(defmacro gtags-flag-err-msg (flag)
  `(cadddr ,flag))

;
; New key assignment to avoid conflicting with ordinary assignments.
;
(define-key gtags-mode-map "\e*" 'gtags-pop-stack)
(define-key gtags-mode-map "\e." 'gtags-find-tag)
(define-key gtags-mode-map "\C-x4." 'gtags-find-tag-other-window)
;
; Old key assignment.
;
; If you hope old style key assignment. Please include following code
; to your $HOME/.emacs:
;
; (setq gtags-mode-hook
;   '(lambda ()
;         (define-key gtags-mode-map "\eh" 'gtags-display-browser)
;         (define-key gtags-mode-map "\C-]" 'gtags-find-tag-from-here)
;         (define-key gtags-mode-map "\C-t" 'gtags-pop-stack)
;         (define-key gtags-mode-map "\el" 'gtags-find-file)
;         (define-key gtags-mode-map "\eg" 'gtags-find-with-grep)
;         (define-key gtags-mode-map "\eI" 'gtags-find-with-idutils)
;         (define-key gtags-mode-map "\es" 'gtags-find-symbol)
;         (define-key gtags-mode-map "\er" 'gtags-find-rtag)
;         (define-key gtags-mode-map "\et" 'gtags-find-tag)
;         (define-key gtags-mode-map "\ev" 'gtags-visit-rootdir)
; ))

(if (not gtags-running-xemacs) nil
 (define-key gtags-mode-map 'button3 'gtags-pop-stack)
 (define-key gtags-mode-map 'button2 'gtags-find-tag-by-event))
(if gtags-running-xemacs nil
 (define-key gtags-mode-map [mouse-3] 'gtags-pop-stack)
 (define-key gtags-mode-map [mouse-2] 'gtags-find-tag-by-event))

(defvar gtags-select-mode-map (make-sparse-keymap)
  "Keymap used in gtags select mode.")
(define-key gtags-select-mode-map "\e*" 'gtags-pop-stack)
(if (not gtags-running-xemacs) nil
 (define-key gtags-select-mode-map 'button3 'gtags-pop-stack)
 (define-key gtags-select-mode-map 'button2 'gtags-select-tag-by-event))
(if gtags-running-xemacs nil
 (define-key gtags-select-mode-map [mouse-3] 'gtags-pop-stack)
 (define-key gtags-select-mode-map [mouse-2] 'gtags-select-tag-by-event))
(define-key gtags-select-mode-map "\^?" 'scroll-down)
(define-key gtags-select-mode-map " " 'scroll-up)
(define-key gtags-select-mode-map "\C-b" 'scroll-down)
(define-key gtags-select-mode-map "\C-f" 'scroll-up)
(define-key gtags-select-mode-map "k" 'previous-line)
(define-key gtags-select-mode-map "j" 'next-line)
(define-key gtags-select-mode-map "p" 'previous-line)
(define-key gtags-select-mode-map "n" 'next-line)
(define-key gtags-select-mode-map "q" 'gtags-pop-stack)
(define-key gtags-select-mode-map "u" 'gtags-pop-stack)
(define-key gtags-select-mode-map "\C-t" 'gtags-pop-stack)
(define-key gtags-select-mode-map "\C-m" 'gtags-select-tag)
(define-key gtags-select-mode-map "\C-o" 'gtags-select-tag-other-window)
(define-key gtags-select-mode-map "\e." 'gtags-select-tag)

;;
;; utility
;;
(defun gtags-match-string (n)
  (buffer-substring (match-beginning n) (match-end n)))

;; Return a default tag to search for, based on the text at point.
(defun gtags-current-token ()
  (cond
   ((looking-at "[0-9A-Za-z_]")
    (while (looking-at "[0-9A-Za-z_]")
      (forward-char -1))
    (forward-char 1))
   (t
    (while (looking-at "[ \t]")
      (forward-char 1))))
  (if (and (bolp) (looking-at gtags-definition-regexp))
      (goto-char (match-end 0)))
  (if (looking-at gtags-symbol-regexp)
      (gtags-match-string 0) nil))

;; push current context to stack
(defun gtags-push-context ()
  (setq gtags-buffer-stack (cons (current-buffer) gtags-buffer-stack))
  (setq gtags-point-stack (cons (point) gtags-point-stack)))

;; pop context from stack
(defun gtags-pop-context ()
  (if (not gtags-buffer-stack) nil
    (let (buffer point)
      (setq buffer (car gtags-buffer-stack))
      (setq gtags-buffer-stack (cdr gtags-buffer-stack))
      (setq point (car gtags-point-stack))
      (setq gtags-point-stack (cdr gtags-point-stack))
      (list buffer point))))

;; if the buffer exist in the stack
(defun gtags-exist-in-stack (buffer)
  (memq buffer gtags-buffer-stack))

;; get current line number
(defun gtags-current-lineno ()
  (if (= 0 (count-lines (point-min) (point-max)))
      0
    (save-excursion
      (end-of-line)
      (if (equal (point-min) (point))
          1
        (count-lines (point-min) (point))))))

;; completsion function for completing-read.
(defun gtags-completing-gtags (string predicate code)
  (gtags-completing 'gtags string predicate code))
(defun gtags-completing-gsyms (string predicate code)
  (gtags-completing 'gsyms string predicate code))
;; common part of completing-XXXX
;;   flag: 'gtags or 'gsyms
(defun gtags-completing (flag string predicate code)
  (let ((option "-c")
        (complete-list (make-vector 63 0))
        (prev-buffer (current-buffer)))
    ; build completion list
    (set-buffer (generate-new-buffer "*Completions*"))
    (if (eq flag 'gsyms)
        (setq option (concat option "s")))
    (call-process "global" nil t nil option string)
    (goto-char (point-min))
    (while (looking-at gtags-symbol-regexp)
      (intern (gtags-match-string 0) complete-list)
      (forward-line))
    (kill-buffer (current-buffer))
    ; recover current buffer
    (set-buffer prev-buffer)
    ; execute completion
    (cond ((eq code nil)
           (try-completion string complete-list predicate))
          ((eq code t)
           (all-completions string complete-list predicate))
          ((eq code 'lambda)
           (if (intern-soft string complete-list) t nil)))))

;; get the path of gtags root directory.
(defun gtags-get-rootpath ()
  (let (path buffer)
    (save-excursion
      (setq buffer (generate-new-buffer (generate-new-buffer-name "*rootdir*")))
      (set-buffer buffer)
      (setq n (call-process "global" nil t nil "-pr"))
      (if (= n 0)
        (setq path (file-name-as-directory (buffer-substring (point-min)(1- (point-max))))))
      (kill-buffer buffer))
    path))

;;
;; interactive command
;;
(defun gtags-visit-rootdir ()
  "Tell tags commands the root directory of source tree."
  (interactive)
  (let (path input n)
    (if gtags-rootdir
      (setq path gtags-rootdir)
     (setq path (gtags-get-rootpath))
     (if (equal path nil)
       (setq path default-directory)))
    (setq input (read-file-name "Visit root directory: " path path t))
    (if (equal "" input) nil
      (if (not (file-directory-p input))
        (message "%s is not directory." input)
       (setq gtags-rootdir (expand-file-name input))
       (setenv "GTAGSROOT" gtags-rootdir)))))

(defun gtags-find-tag (&optional other-win)
  "Input tag name and move to the definition."
  (interactive)
  (let (tagname prompt input)
    (setq tagname (gtags-current-token))
    (if tagname
      (setq prompt (concat "Find tag: (default " tagname ") "))
     (setq prompt "Find tag: "))
    (setq input (completing-read prompt 'gtags-completing-gtags
                  nil nil nil gtags-history-list))
    (if (not (equal "" input))
      (setq tagname input))
    (gtags-push-context)
    (gtags-goto-tag tagname nil other-win)))

(defun gtags-find-tag-other-window ()
  "Input tag name and move to the definition in other window."
  (interactive)
  (gtags-find-tag t))

(defmacro concat-local-macro (local)
  `(if ,local (assq 'local gtags-flag-table)))

(defun gtags-find-rtag (tagname &optional local)
  "Input tag name and move to the referenced point."
  (interactive
   (let (tagname prompt input)
     (setq tagname (gtags-current-token))
     (if tagname
         (setq prompt (concat "Find tag (reference): (default " tagname ") "))
       (setq prompt "Find tag (reference): "))
     (setq input (completing-read prompt 'gtags-completing-gtags
                                  nil nil nil gtags-history-list))
     (if (not (equal "" input)) (setq tagname input))
     (list tagname current-prefix-arg)))
  (gtags-push-context)
  (gtags-goto-tag tagname (list (assq 'reference gtags-flag-table)
                                (concat-local-macro local))))

(defun gtags-find-symbol (tagname &optional local)
  "Input symbol and move to the locations."
  (interactive
   (let (tagname prompt input)
     (setq tagname (gtags-current-token))
     (if tagname
         (setq prompt (concat "Find symbol: (default " tagname ") "))
       (setq prompt "Find symbol: "))
     (setq input (completing-read prompt 'gtags-completing-gsyms
                                  nil nil nil gtags-history-list))
     (if (not (equal "" input)) (setq tagname input))
     (list tagname current-prefix-arg)))
    (gtags-push-context)
    (message "local: %s" local)
    (gtags-goto-tag tagname (list (assq 'symbol gtags-flag-table)
                                  (concat-local-macro local))))

(defun gtags-find-pattern ()
  "Input pattern, search with grep(1) and move to the locations."
  (interactive)
  (gtags-find-with-grep))

(defun gtags-find-with-grep ()
  "Input pattern, search with grep(1) and move to the locations."
  (interactive)
  (gtags-find-with (list (assq 'grep gtags-flag-table))))

(defun gtags-find-with-idutils ()
  "Input pattern, search with idutils(1) and move to the locations."
  (interactive)
  (gtags-find-with (list (assq 'grep gtags-flag-table))))

(defun gtags-find-file (tagname &optional local)
  "Input pattern and move to the top of the file."
  (interactive
   (let (tagname input)
     (setq input (read-string "Find files: "))
     (if (not (equal "" input)) (setq tagname input))
     (list tagname current-prefix-arg)))
  (gtags-push-context)
  (gtags-goto-tag tagname (list (assq 'path gtags-flag-table)
                                (concat-local-macro local))))

(defun gtags-parse-file (tagname &optional local)
  "Input file name, parse it and show object list."
  (interactive
   (let (tagname prompt input)

     (setq input (read-file-name "Parse file: "
                                 nil nil t (file-name-nondirectory buffer-file-name)))
     (if (not (equal "" input)) (setq tagname input))
     (list tagname current-prefix-arg)))
  (gtags-push-context)
  (gtags-goto-tag tagname "f"))

(defun gtags-find-tag-from-here (tagname &optional local)
  "Get the expression as a tagname around here and move there."
  (interactive
   (let (tagname flag)
     (setq tagname (gtags-current-token))
     (list tagname current-prefix-arg)))
  (when tagname
    (gtags-push-context)
    (gtags-goto-tag tagname (list (assq 'context gtags-flag-table)
                                  (concat-local-macro local)))))

; This function doesn't work with mozilla.
; But I will support it in the near future.
(defun gtags-display-browser ()
  "Display current screen on hypertext browser."
  (interactive)
  (call-process "gozilla"  nil nil nil (concat "+" (number-to-string (gtags-current-lineno))) buffer-file-name))

; Private event-point
; (If there is no event-point then we use this version.
(eval-and-compile
  (if (not (fboundp 'event-point))
      (defun event-point (event)
        (posn-point (event-start event)))))

(defun gtags-find-tag-by-event (event)
  "Get the expression as a tagname around here and move there."
  (interactive "e")
  (let (tagname flag)
    (if (= 0 (count-lines (point-min) (point-max)))
        (setq tagname "main")
      (if gtags-running-xemacs
          (goto-char (event-point event))
        (select-window (posn-window (event-end event)))
        (set-buffer (window-buffer (posn-window (event-end event))))
        (goto-char (posn-point (event-end event))))
      (setq tagname (gtags-current-token))
      (setq flag (assq 'context gtags-flag-table)))
    (if (not tagname)
        nil
      (gtags-push-context)
      (gtags-goto-tag tagname (list flag)))))

(defun gtags-select-tag (&optional other-win)
  "Select a tag in [GTAGS SELECT MODE] and move there."
  (interactive)
  (gtags-push-context)
  (gtags-select-it nil other-win))

(defun gtags-select-tag-other-window ()
  "Select a tag in [GTAGS SELECT MODE] and move there in other window."
  (interactive)
  (gtags-select-tag t))

(defun gtags-select-tag-by-event (event)
  "Select a tag in [GTAGS SELECT MODE] and move there."
  (interactive "e")
  (if gtags-running-xemacs (goto-char (event-point event))
    (select-window (posn-window (event-end event)))
    (set-buffer (window-buffer (posn-window (event-end event))))
    (goto-char (posn-point (event-end event))))
  (gtags-push-context)
  (gtags-select-it nil))

(defun gtags-pop-stack ()
  "Move to previous point on the stack."
  (interactive)
  (let (delete context buffer)
    (if (and (not (equal gtags-current-buffer nil))
             (not (equal gtags-current-buffer (current-buffer))))
         (switch-to-buffer gtags-current-buffer)
         ; By default, the buffer of the referred file is left.
         ; If gtags-pop-delete is set to t, the file is deleted.
         ; Gtags select mode buffer is always deleted.
         (if (and (or gtags-pop-delete (equal mode-name "Gtags-Select"))
                  (not (gtags-exist-in-stack (current-buffer))))
             (setq delete t))
      (setq context (gtags-pop-context))
      (if (not context)
          (message "The tags stack is empty.")
        (if delete
            (kill-buffer (current-buffer)))
        (switch-to-buffer (nth 0 context))
        (setq gtags-current-buffer (current-buffer))
        (goto-char (nth 1 context))))))

;;
;; common function
;;

;; find with grep or idutils.
(defun gtags-find-with (flags)
  (let (tagname prompt input)
    (setq tagname (gtags-current-token))
    (if tagname
        (setq prompt (concat "Find pattern: (default " tagname ") "))
      (setq prompt "Find pattern: "))
    (setq input (completing-read prompt 'gtags-completing-gtags
                 nil nil nil gtags-history-list))
    (if (not (equal "" input)) (setq tagname input))
    (gtags-push-context)
    (gtags-goto-tag tagname flags)))

;; goto tag's point
(defun gtags-goto-tag (tagname flags &optional other-win)
  (let (option context prev-buffer prefix buffer process-result lines)
    (setq prev-buffer (current-buffer))
    ;; Use always ctags-x format.
    (setq option "-x")
    (dolist (flag flags)
      (if (equal (gtags-flag-sym flag) 'context)
          (setq context (concat "--from-here=" (number-to-string (gtags-current-lineno)) ":" buffer-file-name))
        (setq option (concat option (gtags-flag-cmd-line-arg flag))))
      (setq prefix (concat prefix (gtags-flag-prefix-msg flag))))
   
    ;; load tag
    (setq buffer (generate-new-buffer (generate-new-buffer-name (concat "*GTAGS SELECT* " prefix tagname))))

    ;; Path style is defined in gtags-path-style:
    ;;   root: relative from the root of the project (Default)
    ;;   relative: relative from the current directory
    ;; absolute: absolute (relative from the system root directory)
    ;;
    (cond ((equal gtags-path-style 'absolute) (setq option (concat option "a")))
          ((and (equal gtags-path-style 'root) (not (assq 'local flags)))
           (let ((rootdir (or gtags-rootdir (gtags-get-rootpath))))
             (if rootdir (cd rootdir)))))
   
    (message "Searching %s ..." tagname)

    (setq process-result (if context
                             (start-process "gtags" buffer "global" option context tagname)
                           (start-process "gtags" buffer "global" option tagname)))
    (lexical-let ((other-win other-win) (flags flags) (tagname tagname) gtags-process-sentinel)
      (defun gtags-process-sentinel (process event)
        (let ((prev-buf (current-buffer))
              (buf (process-buffer process)))
        (message "process: %s event: %s" process event)
        (cond ((string-match "finished" event)
               (set-buffer buf)
               (goto-char (point-min))
               (setq lines (count-lines (point-min) (point-max)))
               (cond ((= 0 lines)
                      (message (concat "%s" (gtags-flag-err-msg (car flags))) tagname)
                      (gtags-pop-context)
                      (kill-buffer buf)
                      (set-buffer prev-buf))
                     ((= 1 lines)
                      (message "Searching %s ... Done" tagname)
                      (gtags-select-it t other-win))
                     (t (if (null other-win)
                            (switch-to-buffer buf)
                          (switch-to-buffer-other-window buf))
                        (gtags-select-mode))))
              ;; otherwise assume failure
              (t (message "failure")
                 (message (buffer-substring (point-min) (1- (point-max))))
                 (gtags-pop-context)))))
      (set-process-sentinel process-result 'gtags-process-sentinel))))

;; select a tag line from lines
(defun gtags-select-it (delete &optional other-win)
  (let (line file)
    ;; get context from current tag line
    (beginning-of-line)
    (if (not (looking-at "[^ \t]+[ \t]+\\([0-9]+\\)[ \t]\\([^ \t]+\\)[ \t]"))
        (gtags-pop-context)
      (setq line (string-to-number (gtags-match-string 1)))
      (setq file (gtags-match-string 2))
      ;;
      ;; Why should we load new file before killing current-buffer?
      ;;
      ;; If you kill current-buffer before loading new file, current directory
      ;; will be changed. This might cause loading error, if you use relative
      ;; path in [GTAGS SELECT MODE], because emacs's buffer has its own
      ;; current directory.
      ;;
      (let ((prev-buffer (current-buffer)))
        ;; move to the context
        (if gtags-read-only
            (if (null other-win) (find-file-read-only file)
              (find-file-read-only-other-window file))
          (if (null other-win) (find-file file)
            (find-file-other-window file)))
        (if delete (kill-buffer prev-buffer)))
      (setq gtags-current-buffer (current-buffer))
      (goto-line line)
      (gtags-mode 1))))

;; make complete list (do nothing)
(defun gtags-make-complete-list ()
  "Make tag name list for completion."
  (interactive)
  (message "gtags-make-complete-list: Deprecated. You need not call this command any longer."))

;;;###autoload
(defun gtags-mode (&optional forces)
  "Toggle Gtags mode, a minor mode for browsing source code using GLOBAL.

Specify the root directory of project.
        \\[gtags-visit-rootdir]
Input tag name and move to the definition.
        \\[gtags-find-tag]
Input tag name and move to the definition in other window.
        \\[gtags-find-tag-other-window]
Input tag name and move to the referenced point.
        \\[gtags-find-rtag]
Input symbol and move to the locations.
        \\[gtags-find-symbol]
Input pattern, search with grep(1) and move to the locations.
        \\[gtags-find-with-grep]
Input pattern, search with idutils(1) and move to the locations.
        \\[gtags-find-with-idutils]
Input pattern and move to the top of the file.
        \\[gtags-find-file]
Get the expression as a tagname around here and move there.
        \\[gtags-find-tag-from-here]
Display current screen on hypertext browser.
        \\[gtags-display-browser]
Get the expression as a tagname around here and move there.
        \\[gtags-find-tag-by-event]
Move to previous point on the stack.
        \\[gtags-pop-stack]

Key definitions:
\\{gtags-mode-map}
Turning on Gtags mode calls the value of the variable `gtags-mode-hook'
with no args, if that value is non-nil."
  (interactive)
  (or (assq 'gtags-mode minor-mode-alist)
      (setq minor-mode-alist (cons '(gtags-mode " Gtags") minor-mode-alist)))
  (or (assq 'gtags-mode minor-mode-map-alist)
      (setq minor-mode-map-alist
      (cons (cons 'gtags-mode gtags-mode-map) minor-mode-map-alist)))
  (setq gtags-mode
      (if (null forces) (not gtags-mode)
        (> (prefix-numeric-value forces) 0)))
  (run-hooks 'gtags-mode-hook))

;; make gtags select-mode
(defun gtags-select-mode ()
  "Major mode for choosing a tag from tags list.

Select a tag in tags list and move there.
        \\[gtags-select-tag]
Move to previous point on the stack.
        \\[gtags-pop-stack]

Key definitions:
\\{gtags-select-mode-map}
Turning on Gtags-Select mode calls the value of the variable
`gtags-select-mode-hook' with no args, if that value is non-nil."
  (interactive)
  (kill-all-local-variables)
  (use-local-map gtags-select-mode-map)
  (setq buffer-read-only t
        truncate-lines t
        major-mode 'gtags-select-mode
        mode-name "Gtags-Select")
  (setq gtags-current-buffer (current-buffer))
  (goto-char (point-min))
  (message "[GTAGS SELECT MODE] %d lines" (count-lines (point-min) (point-max)))
  (run-hooks 'gtags-select-mode-hook))

(provide 'gtags)

;;; gtags.el ends here

_______________________________________________
Bug-global mailing list
Bug-global@...
http://lists.gnu.org/mailman/listinfo/bug-global

[Shigio YAMAGUCHI-2]

Hi,
> Cleaned up goto-tag code with flag/options table. Also reworked many of the
> interactive functions to allow for searching for tags locally.
> Calls global asynchronously (using start-process rather than call-process)
> so that if you specify a symbol that is found in many files and takes a long
> time to run, you can still move around and edit in emacs while you wait.

It seems that there are four changes in your patch.

1. Use of flag table (gtags-flag-table)

        It's smart. But thinking about the work of debugging,
        I am hesitant to take it.

        There is a merit of using flag value itself directly.
        Because the flag value is equal to the flag value of
        the command line of global(1) except for "C"(--from-here=<...>).
        Understanding the flag value, what should be done is clear.

2. Small changes of display

        o Change the name of [GTAGS SELECT MODE] page from '...(R)' to '...(Ref)'.
        o Change the message "Searching <tag name> ..." to "!!!!! ...".

        Are these necessary? (for debugging?)

3. Asynchronous searching

        It's great.

        Since some people dislike asynchronous behavior, I would like to use
        custom variable.

        (setq gtags-mode-hook
          '(lambda ()
            (setq gtags-asynchronous-search t)
        ))

4. Adding local flag to each interactive functions

        How to use this facility?
        Which range is local?

If possible, would you please write a change in a patch?
Generally, it is difficult to apply the patch which contains many changes
which are not mutually related.
Anyway, thank you!
--
Shigio YAMAGUCHI <shigio@...>
PGP fingerprint: D1CB 0B89 B346 4AB6 5663  C4B6 3CA5 BBB3 57BE DDA3


_______________________________________________
Bug-global mailing list
Bug-global@...
http://lists.gnu.org/mailman/listinfo/bug-global

[jrwats]

I will work on cleaning it up.  The general idea is there.  I like giving people the option for a/synchronicity as well.  Will post with a patch later...

Thanks,
John Watson

On Wed, Feb 18, 2009 at 6:24 PM, Shigio YAMAGUCHI <shigio@...> wrote:

Hi,

> Cleaned up goto-tag code with flag/options table. Also reworked many of the
> interactive functions to allow for searching for tags locally.
> Calls global asynchronously (using start-process rather than call-process)
> so that if you specify a symbol that is found in many files and takes a long
> time to run, you can still move around and edit in emacs while you wait.

It seems that there are four changes in your patch.

1. Use of flag table (gtags-flag-table)

       It's smart. But thinking about the work of debugging,
       I am hesitant to take it.

       There is a merit of using flag value itself directly.
       Because the flag value is equal to the flag value of
       the command line of global(1) except for "C"(--from-here=<...>).
       Understanding the flag value, what should be done is clear.

2. Small changes of display

       o Change the name of [GTAGS SELECT MODE] page from '...(R)' to '...(Ref)'.
       o Change the message "Searching <tag name> ..." to "!!!!! ...".

       Are these necessary? (for debugging?)

3. Asynchronous searching

       It's great.

       Since some people dislike asynchronous behavior, I would like to use
       custom variable.

       (setq gtags-mode-hook
         '(lambda ()
           (setq gtags-asynchronous-search t)
       ))

4. Adding local flag to each interactive functions

       How to use this facility?
       Which range is local?

If possible, would you please write a change in a patch?
Generally, it is difficult to apply the patch which contains many changes
which are not mutually related.
Anyway, thank you!
--
Shigio YAMAGUCHI <shigio@...>
PGP fingerprint: D1CB 0B89 B346 4AB6 5663  C4B6 3CA5 BBB3 57BE DDA3

_______________________________________________
Bug-global mailing list
Bug-global@...
http://lists.gnu.org/mailman/listinfo/bug-global