*** e:/GlobalSource/gnu/global-5.7-4/gtags.el	Wed Feb 11 11:09:27 2009
--- e:/emacs/.emacs.d/site-list/gtags.el	Tue Feb 17 18:23:44 2009
***************
*** 63,68 ****
--- 63,71 ----
  
  ;;; Code
  
+ (eval-when-compile 
+   (require 'cl))
+ 
  (defvar gtags-mode nil
    "Non-nil if Gtags mode is enabled.")
  (make-variable-buffer-local 'gtags-mode)
***************
*** 111,116 ****
--- 114,146 ----
    "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.
  ;
***************
*** 198,207 ****
  (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
--- 228,235 ----
  (defun gtags-pop-context ()
    (if (not gtags-buffer-stack) nil
      (let (buffer point)
!       (setq buffer (car gtags-buffer-stack) gtags-buffer-stack (cdr gtags-buffer-stack)
!             point  (car gtags-point-stack)  gtags-point-stack  (cdr gtags-point-stack))
        (list buffer point))))
  
  ;; if the buffer exist in the stack
***************
*** 293,333 ****
      (if (not (equal "" input))
        (setq tagname input))
      (gtags-push-context)
!     (gtags-goto-tag tagname "" other-win)))
  
  (defun gtags-find-tag-other-window ()
    "Input tag name and move to the definition in other window."
    (interactive)
    (gtags-find-tag t))
  
! (defun gtags-find-rtag ()
    "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))
!     (gtags-push-context)
!     (gtags-goto-tag tagname "r")))
  
! (defun gtags-find-symbol ()
    "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))
      (gtags-push-context)
!     (gtags-goto-tag tagname "s")))
  
  (defun gtags-find-pattern ()
    "Input pattern, search with grep(1) and move to the locations."
--- 321,368 ----
      (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."
***************
*** 337,378 ****
  (defun gtags-find-with-grep ()
    "Input pattern, search with grep(1) and move to the locations."
    (interactive)
!   (gtags-find-with "g"))
  
  (defun gtags-find-with-idutils ()
    "Input pattern, search with idutils(1) and move to the locations."
    (interactive)
!   (gtags-find-with "I"))
  
! (defun gtags-find-file ()
    "Input pattern and move to the top of the file."
!   (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")))
  
! (defun gtags-parse-file ()
    "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))
!     (gtags-push-context)
!     (gtags-goto-tag tagname "f")))
  
! (defun gtags-find-tag-from-here ()
    "Get the expression as a tagname around here and move there."
!   (interactive)
!   (let (tagname flag)
!     (setq tagname (gtags-current-token))
!     (if (not tagname)
!         nil
!       (gtags-push-context)
!       (gtags-goto-tag tagname "C"))))
  
  ; This function doesn't work with mozilla.
  ; But I will support it in the near future.
--- 372,416 ----
  (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.
***************
*** 393,411 ****
    (interactive "e")
    (let (tagname flag)
      (if (= 0 (count-lines (point-min) (point-max)))
!         (progn (setq tagname "main")
!                (setq flag ""))
        (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 "C"))
      (if (not tagname)
          nil
        (gtags-push-context)
!       (gtags-goto-tag tagname flag))))
  
  (defun gtags-select-tag (&optional other-win)
    "Select a tag in [GTAGS SELECT MODE] and move there."
--- 431,448 ----
    (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."
***************
*** 455,461 ****
  ;;
  
  ;; find with grep or idutils.
! (defun gtags-find-with (flag)
    (let (tagname prompt input)
      (setq tagname (gtags-current-token))
      (if tagname
--- 492,498 ----
  ;;
  
  ;; find with grep or idutils.
! (defun gtags-find-with (flags)
    (let (tagname prompt input)
      (setq tagname (gtags-current-token))
      (if tagname
***************
*** 465,545 ****
                   nil nil nil gtags-history-list))
      (if (not (equal "" input)) (setq tagname input))
      (gtags-push-context)
!     (gtags-goto-tag tagname flag)))
  
  ;; goto tag's point
! (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.
      (setq option "-x")
!     (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)")))
      ;; load tag
      (setq buffer (generate-new-buffer (generate-new-buffer-name (concat "*GTAGS SELECT* " prefix tagname))))
!     (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)))))
      (message "Searching %s ..." tagname)
!     (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))))))
  
  ;; select a tag line from lines
  (defun gtags-select-it (delete &optional other-win)
--- 502,570 ----
                   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)
!   (message "!!!!!(gtags-goto-tag %s %s %s)" tagname flags other-win)
!   (let (option context prefix buffer process-result lines rootdir) ;;prev-buf
!     ;; Always use 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)))
!            (setq rootdir (or gtags-rootdir (gtags-get-rootpath)))
!            (message "changing dir to: %s" rootdir)
!            (message "default-dir: %s" default-directory)
!            (if rootdir (cd rootdir))))
! 
      (message "Searching %s ..." tagname)
! 
!     (message "(start-process \"gtags\" \"%s\" \"global\" \"%s\" \"%s\"  \"%s\")" buffer option context 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) (prev-buf (current-buffer)) (flags flags)
!                   (tagname tagname) (rootdir rootdir) gtags-process-sentinel)
!       (defun gtags-process-sentinel (process event)
!         (message "(gtags-process-sentinel %s %s)" process event)
!         (let ((buf (process-buffer process)))
!         (cond ((string-match "finished" event)
!                (set-buffer buf)
!                ;; must change to rootdir once we change buffers
!                (if rootdir (cd rootdir)) 
!                (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)