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 [email protected] http://lists.gnu.org/mailman/listinfo/bug-global
