Download
(eval-when-compile
(require 'cl))
(require 'easymenu)
(defconst xgtags-running-xemacs (featurep 'xemacs)
"Whether we are running XEmacs/Lucid Emacs")
(defgroup xgtags nil
"Using gtags and global for crossrefencing"
:group 'tools)
(defvar xgtags-mode-map nil
"Keymap used in xgtags minor mode.")
(defface xgtags-match-face
'((((class color) (background dark))
(:foreground "cyan"))
(((class color) (background light))
(:foreground "magenta"))
(t (:bold t)))
"Face used to highlight function name in the *xgtags* buffer."
:group 'xgtags)
(defface xgtags-match-selected-face
'((((class color) (background dark))
(:foreground "cyan" :bold t))
(((class color) (background light))
(:foreground "magenta" :bold t))
(t (:bold t)))
"Face used to highlight selected function name in the *xgtags* buffer."
:group 'xgtags)
(defface xgtags-file-face
'((((class color) (background dark))
(:foreground "yellow"))
(((class color) (background light))
(:foreground "blue"))
(t (:bold t)))
"Face used to highlight file name in the *xgtags* buffer."
:group 'xgtags)
(defface xgtags-file-selected-face
'((((class color) (background dark))
(:foreground "yellow" :bold t))
(((class color) (background light))
(:foreground "blue" :bold t))
(t (:bold t)))
"Face used to highlight selected file name in the *xgtags* buffer."
:group 'xgtags)
(defface xgtags-line-number-face
'((((class color) (background dark))
(:foreground "red"))
(((class color) (background light))
(:foreground "red"))
(t (:bold t)))
"Face used to highlight line number in the *xgtags* buffer."
:group 'xgtags)
(defface xgtags-line-number-selected-face
'((((class color) (background dark))
(:foreground "red" :bold t))
(((class color) (background light))
(:foreground "red" :bold t))
(t (:bold t)))
"Face used to highlight selected line number in the *xgtags* buffer."
:group 'xgtags)
(defface xgtags-line-face
'((((class color) (background dark))
(:foreground "green"))
(((class color) (background light))
(:foreground "black"))
(t (:bold nil)))
"Face used to highlight the rest of line in the *xgtags* buffer."
:group 'xgtags)
(defface xgtags-line-selected-face
'((((class color) (background dark))
(:foreground "green" :bold t))
(((class color) (background light))
(:foreground "black" :bold t))
(t (:bold nil)))
"Face used to highlight the rest of line in the *xgtags* buffer."
:group 'xgtags)
(defun xgtags--set-overwrite-global-bindings (flag &optional keymap)
(let ((map (or keymap (and (boundp 'xgtags-mode-map) xgtags-mode-map))))
(cond
((not (keymapp map)))
(flag (define-key map "\e*" 'xgtags-pop-stack)
(define-key map "\e." 'xgtags-find-tag))
(t (define-key map "\e*" nil)
(define-key map "\e." nil)))))
(defun xgtags--set-overwrite-complete-bindings (flag &optional keymap)
(let ((map (or keymap (and (boundp 'xgtags-mode-map) xgtags-mode-map))))
(cond
((not (keymapp map)))
(flag (define-key map "\e\t" 'xgtags-complete-tag))
(t (define-key map "\e\t" nil)))))
(defun xgtags--set-support-mouse (flag &optional keymap)
(let ((map (or keymap (and (boundp 'xgtags-mode-map) xgtags-mode-map))))
(cond
((not (keymapp map)))
(xgtags-running-xemacs
(define-key map 'button3 (when flag 'xgtags-pop-stack))
(define-key map 'button2 (when flag 'xgtags-find-tag-by-event)))
(t
(define-key map [mouse-3] (when flag 'xgtags-pop-stack))
(define-key map [mouse-2] (when flag 'xgtags-find-tag-by-event))))))
(defcustom xgtags-overwrite-global-bindings t
"*Should the default keybindings for tags, that is \M-. e.a., be
overwritten with the corresponding xgtags functionality?"
:type 'boolean
:group 'xgtags
:set (lambda (symbol value)
(set symbol value)
(xgtags--set-overwrite-global-bindings value)))
(defcustom xgtags-overwrite-complete-bindings nil
"*Should the default keybindings for symbol completition, that is
\M-<TAB>, be overwritten with the corresponding xgtags functionality?"
:type 'boolean
:group 'xgtags
:set (lambda (symbol value)
(set symbol value)
(xgtags--set-overwrite-complete-bindings value)))
(defcustom xgtags-support-mouse t
"*Should there be some default bindings for mouse-2 and mouse-3."
:type 'boolean
:group 'xgtags
:set (lambda (symbol value)
(set symbol value)
(xgtags--set-support-mouse value)))
(defcustom xgtags-read-only nil
"*When set to true, new files are opened in read only mode."
:type 'boolean
:group 'xgtags)
(defcustom xgtags-goto-tag 'always
"*Whether to jump to the first query result."
:type '(radio (const :tag "always" always)
(const :tag "when unique" unique)
(const :tag "never" never))
:group 'xgtags)
(defcustom xgtags-show-paths 'absolute
"*how to show paths in the selection buffer."
:type '(radio (const :tag "Show absolute paths" absolute)
(const :tag "Show relative paths" relative)
(const :tag "Show expanded paths (true filename)" expanded))
:group 'xgtags)
(defcustom xgtags-update-db nil
"*Use this option when you like to automatically update your
database before calling 'global'. The options are no update at all, a
command to be called or an elisp function, that will be called with
the current rootdir."
:type '(radio (const :tag "No update.")
(string :tag "Command and options.")
(function :tag "Elisp function to be called."))
:group 'xgtags)
(defcustom xgtags-find-multiple-db nil
"*When bound to a function this function is called with one
argument, namely the current directory, and should return a list of
directories with GTAGS databases. All databases are searched one after
another."
:type 'function
:group 'xgtags)
(defcustom xgtags-kill-buffers t
"*Should the current buffer be killed when the stack entry is
popped? Be careful: even buffers not opened by xgtags itself will be
killed!"
:type 'boolean
:group 'xgtags)
(defcustom xgtags-select-buffer-name "*xgtags*"
"*Name to use as the select buffer."
:type 'string
:group 'xgtags)
(defcustom xgtags-rootdir nil
"*Root directory of source tree."
:type 'string
:group 'xgtags)
(defconst xgtags--symbol-regexp "[A-Za-z_][A-Za-z_0-9]*"
"Regexp matching tag name.")
(defconst xgtags--definition-regexp "#[ \t]*define[ \t]+\\|ENTRY(\\|ALTENTRY("
"Regexp matching tag definition name.")
(defconst xgtags--tag-regexp "\\([^ \t]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([^ \t]+\\)[ \t]+\\([^\n]+\\)"
"Regex matching the current output line for a tag.")
(defconst xgtags--file-regexp "\\([^ \t]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([^ \t\n]+\\)"
"Regex matching the current output line for a tag.")
(defvar xgtags--completition-table nil
"xgtags complete obarray.")
(defvar xgtags--history-list nil
"xgtags history list.")
(defvar xgtags-minor-mode-text " xgtags"
"xgtags text to be shown in the mode line.")
(setq xgtags-mode-map
(let ((keymap (make-sparse-keymap))
(sub-keymap (make-sparse-keymap)))
(define-key keymap "\C-cw" sub-keymap)
(define-key sub-keymap "d" 'xgtags-find-tag)
(define-key sub-keymap "c" 'xgtags-find-rtag)
(define-key sub-keymap "s" 'xgtags-find-symbol)
(define-key sub-keymap "g" 'xgtags-find-with-grep)
(define-key sub-keymap "i" 'xgtags-find-with-idutils)
(define-key sub-keymap "n" 'xgtags-select-next-tag)
(define-key sub-keymap "p" 'xgtags-select-prev-tag)
(define-key sub-keymap "\t" 'xgtags-make-complete-list)
(define-key sub-keymap "u" 'xgtags-pop-stack)
(define-key sub-keymap "f" 'xgtags-find-file)
(define-key sub-keymap "x" 'xgtags-switch-to-buffer)
(define-key sub-keymap "\C-x" 'xgtags-switch-to-buffer-other-window)
(define-key sub-keymap "r" 'xgtags-query-replace-regexp)
(when xgtags-overwrite-global-bindings
(xgtags--set-overwrite-global-bindings t keymap))
(when xgtags-overwrite-complete-bindings
(xgtags--set-overwrite-complete-bindings t keymap))
(when xgtags-support-mouse
(xgtags--set-support-mouse t keymap))
keymap))
(defvar xgtags-select-mode-name "xgtags-select"
"xgtags-select text to be shown in the mode line.")
(defvar xgtags-select-mode-map nil
"Keymap used in xgtags select mode.")
(setq xgtags-select-mode-map
(let ((keymap (make-sparse-keymap)))
(define-key keymap "\e*" 'xgtags-pop-stack)
(if (not xgtags-running-xemacs) nil
(define-key keymap 'button3 'xgtags-pop-stack)
(define-key keymap 'button2 'xgtags-select-tag-by-event))
(if xgtags-running-xemacs nil
(define-key keymap [mouse-3] 'xgtags-pop-stack)
(define-key keymap [mouse-2] 'xgtags-select-tag-by-event))
(define-key keymap "\^?" 'scroll-down)
(define-key keymap " " 'scroll-up)
(define-key keymap "\C-b" 'scroll-down)
(define-key keymap "\C-f" 'scroll-up)
(define-key keymap "k" 'previous-line)
(define-key keymap "j" 'next-line)
(define-key keymap "p" 'previous-line)
(define-key keymap "n" 'next-line)
(define-key keymap "q" 'xgtags-pop-stack)
(define-key keymap "u" 'xgtags-pop-stack)
(define-key keymap "\C-t" 'xgtags-pop-stack)
(define-key keymap "\C-m" 'xgtags-select-tag-near-point)
(define-key keymap "\e." 'xgtags-select-tag-near-point)
keymap))
(defvar xgtags--tags nil
"List of current tags.")
(defvar xgtags--selected-tag nil
"The currently selected tag.")
(defvar xgtags--stack nil
"Stack for tag browsing.")
(defmacro with-xgtags-environment (&rest body)
`(let ((process-environment (copy-alist process-environment)))
(when xgtags-rootdir
(setenv "GTAGSROOT" xgtags-rootdir))
,@body))
(put 'with-xgtags-environment 'lisp-indent-function 0)
(defmacro* with-xgtags-buffer ((&key buffer save-excursion (read-only t))
&rest body)
(let ((buffer-var (or buffer (gensym "buffer-"))))
`(let ((,buffer-var (xgtags--get-buffer)))
(,(if save-excursion 'save-excursion 'progn)
(set-buffer ,buffer-var)
(let ((buffer-read-only ,read-only))
,@body)))))
(put 'with-xgtags-buffer 'lisp-indent-function 1)
(defun xgtags--list-sans-nil (&rest args)
"Build a list from ARGS but leave nils out."
(let ((result nil))
(dolist (arg args (nreverse result))
(when arg
(push arg result)))))
(defun xgtags--token-at-point ()
"Return a default tag to search for, based on the text at point."
(save-excursion
(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))))
(when (and (bolp) (looking-at xgtags--definition-regexp))
(goto-char (match-end 0)))
(when (looking-at xgtags--symbol-regexp)
(match-string-no-properties 0))))
(defun xgtags--file-at-point ()
"Return a default tag to search for, based on the text at point."
(save-excursion
(cond
((looking-at "[0-9A-Za-z_\.]")
(while (looking-at "[0-9A-Za-z_\.]")
(forward-char -1))
(forward-char 1)))
(when (looking-at "[0-9A-Za-z_\.]+")
(match-string-no-properties 0))))
(defun xgtags--function-p ()
"Is it a function?"
(save-excursion
(while (and (not (eolp)) (looking-at "[0-9A-Za-z_]"))
(forward-char 1))
(while (and (not (eolp)) (looking-at "[ \t]"))
(forward-char 1))
(looking-at "(")))
(defun xgtags--definition-p ()
"Is it a definition?"
(save-excursion
(if (or (and (string-match "\.java$" buffer-file-name)
(looking-at "[^(]+([^)]*)[ \t]*{"))
(bolp))
t
(forward-word -1)
(cond
((looking-at "define")
(forward-char -1)
(while (and (not (bolp)) (looking-at "[ \t]"))
(forward-char -1))
(and (bolp) (looking-at "#")))
((looking-at "ENTRY\\|ALTENTRY")
(bolp))))))
(defun xgtags--insert-with-face (string face)
(let ((start (point)))
(insert string)
(put-text-property start (point) 'face face)))
(defun xgtags--update-minor-mode-text ()
(let ((length (length xgtags--stack)))
(if (zerop length)
(setq xgtags-minor-mode-text " xgtags")
(setq xgtags-minor-mode-text (format " xgtags[%d]" length)))))
(defstruct xgtags--tag
query abs-file file line match)
(defun xgtags--make-tag (&rest args)
(let* ((tag (apply 'make-xgtags--tag args))
(abs-file (expand-file-name (xgtags--tag-file tag))))
(if (eq xgtags-show-paths 'expanded)
(let ((expanded (file-truename abs-file)))
(setf (xgtags--tag-abs-file tag) expanded
(xgtags--tag-file tag) expanded))
(setf (xgtags--tag-abs-file tag) abs-file))
tag))
(defun xgtags--tag-position (tag)
"Returns the position index of TAG in the tag-list."
(let ((pos 0)
(found nil)
(tags xgtags--tags))
(while (and tags (not (setq found (eq (car tags) tag))))
(setq pos (1+ pos))
(setq tags (cdr tags)))
(when found
pos)))
(defun* xgtags--next-tag (tag &optional (n 1))
"Returns the N-th tag that follows TAG in the tag list or nil."
(assert tag nil "No tag in call to xgtags--next-tag")
(let ((pos (xgtags--tag-position tag)))
(when (and (>= pos 0) (>= (+ pos n) 0))
(nth (+ pos n) xgtags--tags))))
(defun xgtags--insert-tags (tags)
"This function recieves a list of tags, erases the current buffer
and then inserts the tags nicely."
(erase-buffer)
(let ((current-file nil))
(dolist (tag tags)
(let ((file (xgtags--tag-file tag)))
(unless (equal current-file file)
(when current-file
(insert "\n"))
(setq current-file file)
(xgtags--insert-tag-file tag)
(insert "\n")))
(xgtags--insert-tag tag)
(insert "\n"))))
(defun xgtags--insert-tag-file (tag)
"Insert the file entry TAG into the current buffer."
(xgtags--insert-with-face (xgtags--tag-file tag) 'xgtags-file-face))
(defun xgtags--insert-tag (tag)
"Insert a single tag TAG at point in the current buffer"
(let ((start (point))
(query (xgtags--tag-query tag))
(line (xgtags--tag-line tag))
(match (xgtags--tag-match tag))
(selected-p (eq tag xgtags--selected-tag)))
(xgtags--insert-with-face query
(if selected-p
'xgtags-match-selected-face
'xgtags-match-face))
(insert "[")
(xgtags--insert-with-face (number-to-string line)
(if selected-p
'xgtags-line-number-selected-face
'xgtags-line-number-face))
(when match
(insert "]\t\t")
(xgtags--insert-with-face match (if selected-p
'xgtags-line-selected-face
'xgtags-line-face)))
(put-text-property start (point) 'xgtags-tag tag)))
(defun xgtags--update-tag (tag)
"Searches the tag TAG in the current buffer and replaces the current
representation with an updated one."
(let ((region (xgtags--find-tag-region tag)))
(when region
(delete-region (car region) (cdr region))
(goto-char (car region))
(xgtags--insert-tag tag))))
(defun xgtags--find-tag-region (tag)
"If TAG is found in the current buffer this functions returns a
list with the start and end positions, otherwise it returns nil"
(when tag
(let ((start (text-property-any (point-min) (point-max) 'xgtags-tag tag)))
(when start
(cons start (next-single-property-change start 'xgtags-tag))))))
(defun xgtags--select-tag (tag &optional update)
"Make TAG the selected tag. If UPDATE is not nil, try to find the
previous selected tag and TAG in the current buffer, update their
representation and move point to the beginning of TAG."
(let ((old-sel xgtags--selected-tag))
(setq xgtags--selected-tag tag)
(when update
(xgtags--update-tag old-sel)
(xgtags--update-tag xgtags--selected-tag)
(goto-char (car (xgtags--find-tag-region xgtags--selected-tag)))
(when (get-buffer-window (current-buffer))
(set-window-point (get-buffer-window (current-buffer)) (point))))))
(defun xgtags--find-tag-near-point (&optional backwards)
"Find the next selectable tag and move point to its beginning. If
there is none at the current line, step a line forward or backward to
find one."
(beginning-of-line)
(while (when (not (get-text-property (point) 'xgtags-tag))
(zerop (forward-line (and backwards -1)))))
(get-text-property (point) 'xgtags-tag))
(defun xgtags--follow-tag (tag)
"Jump to the place that TAG points to."
(interactive)
(find-file (xgtags--tag-abs-file tag))
(setq buffer-read-only (or buffer-read-only xgtags-read-only))
(xgtags-mode 1)
(goto-line (xgtags--tag-line tag))
(let ((match (xgtags--tag-query tag))
(found nil)
(lines 0))
(while (and (not found) (< lines 5))
(let ((start (save-excursion (forward-line (- lines))
(point)))
(end (save-excursion (forward-line lines)
(end-of-line)
(point))))
(save-excursion
(goto-char start)
(setq found (search-forward-regexp match end t))))
(setq lines (1+ lines)))
(when found
(goto-char (match-beginning 0)))))
(defun xgtags--map-tags (func)
"Maps over all tags in the *xgtags* buffer, jumps to the tag and
funcalls FUNC with the match as argument."
(mapc (lambda (tag)
(with-xgtags-buffer (:read-only nil)
(xgtags--select-and-follow-tag tag)
(funcall func (xgtags--tag-query tag))))
xgtags--tags))
(defun xgtags--test-map-tags ()
(interactive)
(xgtags--map-tags
(lambda (match)
(message "foo: %s" match)
(when (search-forward-regexp match
(save-excursion (end-of-line) (point))
t)
(goto-char (match-beginning 0))
(set-mark (match-end 0))
(unless (y-or-n-p "More? ")
(return-from xgtags--test-map-tags))))))
(defstruct xgtags--context
buffer point tags selected-tag)
(defun xgtags--make-context ()
"Create a context object."
(make-xgtags--context :buffer (current-buffer)
:point (point-marker)
:tags xgtags--tags
:selected-tag xgtags--selected-tag))
(defun xgtags--stacked-p (buffer)
"If BUFFER exists on the xgtags stack."
(memq buffer (mapcar 'xgtags--context-buffer xgtags--stack)))
(defun xgtags--push-context ()
(first (push (xgtags--make-context) xgtags--stack)))
(defun xgtags--pop-context ()
"Pop context from stack and return it."
(pop xgtags--stack))
(defun xgtags--get-buffer ()
"Return the selection buffer. If it was kill recreate and fill it
with the previous query results."
(let ((buffer (get-buffer xgtags-select-buffer-name)))
(unless buffer
(setq buffer (get-buffer-create xgtags-select-buffer-name))
(save-excursion
(set-buffer buffer)
(when xgtags--stack
(xgtags--insert-tags xgtags--tags))
(xgtags-select-mode)))
buffer))
(defun xgtags--select-update-mode-text (tag)
(let ((pos (xgtags--tag-position tag)))
(if pos
(setq mode-name (format "%s[%d/%d]"
xgtags-select-mode-name
(1+ pos) (length xgtags--tags)))
(setq mode-name (format "%s[%d]"
xgtags-select-mode-name
(length xgtags--tags))))))
(defun xgtags--update-buffer (context)
(let ((tags (xgtags--context-tags context))
(selected-tag (xgtags--context-selected-tag context)))
(xgtags--update-minor-mode-text)
(when tags
(with-xgtags-buffer (:save-excursion t :read-only nil)
(setq xgtags--tags tags)
(xgtags--insert-tags tags)
(xgtags--select-tag selected-tag t)
(xgtags--select-update-mode-text selected-tag)))))
(defun xgtags--select-and-follow-tag (tag)
"Select TAG and follow the link."
(when tag
(with-xgtags-buffer (:read-only nil)
(xgtags--select-tag tag t)
(xgtags--select-update-mode-text tag))
(xgtags--follow-tag tag)))
(defvar xgtags--gtags-options
'((path . "%s: path not found")
(grep . "%s: pattern not found")
(idutils . "%s: token not found")
(symbol . "%s: symbol not found")
(reference . "%s: reference not found")
(file . "%s: file not found")
(absolute)))
(defun xgtags--option-string (symbol)
(when symbol
(assert (assoc symbol xgtags--gtags-options) t
"Unknown gtags option symbol: %s" symbol)
(concat "--" (symbol-name symbol))))
(defun xgtags--option-error-msg (symbol)
(let ((opt (assoc symbol xgtags--gtags-options)))
(if (and opt (cdr opt))
(cdr opt)
"%s: tag not found")))
(defun xgtags--call-global (buffer-dir option tagname)
(message "Searching %s ..." tagname)
(let ((tags nil))
(xgtags--do-in-all-directories
buffer-dir
(lambda (dir)
(when dir
(message "Searching %s in %s ..." tagname dir))
(let ((xgtags-rootdir (and dir (file-name-as-directory dir))))
(with-xgtags-environment
(when xgtags-update-db
(xgtags--update-db xgtags-rootdir))
(with-temp-buffer
(if (zerop (apply #'call-process "global" nil t nil
(xgtags--list-sans-nil
"--cxref"
(xgtags--option-string option)
(unless (eq xgtags-show-paths 'relative)
"--absolute")
tagname)))
(setq tags (append tags (xgtags--collect-tags-in-buffer)))
(message (buffer-substring (point-min)(1- (point-max))))))))))
(message "Searching %s done" tagname)
tags))
(defun xgtags--do-in-all-directories (buffer-dir func)
(let ((dirs (if xgtags-find-multiple-db
(funcall xgtags-find-multiple-db buffer-dir)
(list xgtags-rootdir))))
(dolist (dir dirs)
(funcall func dir))))
(defun xgtags--update-db (directory)
(cond
((stringp xgtags-update-db)
(let ((default-directory directory)
(split (split-string xgtags-update-db)))
(apply #'call-process (car split) nil nil nil (cdr split))))
((functionp xgtags-update-db)
(funcall xgtags-update-db directory))
(t (error "xgtags-update-db has an unsupported type"))))
(defun xgtags--collect-tags-in-buffer ()
"This function searches the current buffer for tag items and returns
a list with those."
(save-excursion
(goto-char (point-min))
(let ((tags nil))
(while (not (eobp))
(cond
((looking-at xgtags--tag-regexp)
(let* ((query (match-string-no-properties 1))
(line (string-to-number (match-string-no-properties 2)))
(file (match-string-no-properties 3))
(match (match-string-no-properties 4)))
(push (xgtags--make-tag :query query
:file file
:line line
:match match) tags)))
((looking-at xgtags--file-regexp)
(let* ((query (match-string-no-properties 1))
(line (string-to-number (match-string-no-properties 2)))
(file (match-string-no-properties 3)))
(push (xgtags--make-tag :query query
:file file
:line line) tags))))
(forward-line))
(nreverse tags))))
(defun xgtags--select-next-prev-tag (arg)
"Select the next or previous tag in the previous select buffer."
(let ((tag (xgtags--next-tag xgtags--selected-tag arg)))
(assert tag nil "The %s of the *xgtags* buffer has been reached"
(if (> arg 0) "end" "beginning"))
(xgtags--select-and-follow-tag tag)))
(defun xgtags-select-next-tag (&optional arg)
"Select the next tag in the previous select buffer."
(interactive "p")
(xgtags--select-next-prev-tag arg))
(defun xgtags-select-prev-tag (&optional arg)
"Select the previous tag in the previous select buffer."
(interactive "p")
(xgtags--select-next-prev-tag (- arg)))
(defun xgtags-select-tag-by-event (event)
"Select a tag in [XGTAGS SELECT MODE] and move there."
(interactive "e")
(if xgtags-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))))
(xgtags-select-tag-near-point))
(defun xgtags--goto-tag (tagname &optional option)
(let* ((window (selected-window))
(file-name (buffer-file-name))
(buffer-dir (and file-name (file-name-directory file-name)))
(tags (xgtags--call-global buffer-dir option tagname))
(num-tags (length tags)))
(if (= num-tags 0)
(message (xgtags--option-error-msg option) tagname)
(xgtags--push-context)
(xgtags--update-minor-mode-text)
(with-xgtags-buffer (:save-excursion t :read-only nil)
(setq xgtags--tags tags)
(xgtags--insert-tags tags))
(cond
((eq xgtags-goto-tag 'always)
(when (/= num-tags 1)
(xgtags-switch-to-buffer-other-window nil))
(select-window window)
(xgtags--select-and-follow-tag (first tags)))
((eq xgtags-goto-tag 'unique)
(if (/= num-tags 1)
(xgtags-switch-to-buffer-other-window t)
(xgtags--select-and-follow-tag (first tags))))
((eq xgtags-goto-tag 'never)
(xgtags-switch-to-buffer-other-window t))
(t
(error "Unrecognized value for xgtags-goto-tag: %s"
xgtags-goto-tag))))))
(defun xgtags-select-tag-near-point ()
"Select the tag near point and follow it."
(interactive)
(xgtags--select-and-follow-tag (xgtags--find-tag-near-point)))
(defun xgtags-visit-rootdir ()
"Tell tags commands the root directory of source tree."
(interactive)
(unless xgtags-rootdir
(with-temp-buffer
(setq xgtags-rootdir
(if (zerop (call-process "global" nil t nil "-pr"))
(file-name-as-directory (buffer-substring (point-min)
(1- (point-max))))
default-directory))))
(let ((input (read-file-name "Visit root directory: "
xgtags-rootdir xgtags-rootdir t)))
(unless (equal "" input)
(assert (file-directory-p input) t "%s is not directory" input)
(setq xgtags-rootdir (expand-file-name input)))))
(defun* xgtags--find-with (dflt-prompt &key option
(get-token 'xgtags--token-at-point)
(history xgtags--history-list))
(let* ((tagname (funcall get-token))
(prompt (if tagname
(concat dflt-prompt " (default " tagname ") ")
(concat dflt-prompt " ")))
(input (completing-read prompt xgtags--completition-table
nil nil nil history tagname)))
(xgtags--goto-tag input option)))
(defun xgtags-find-tag ()
"Input tag name and move to the definition."
(interactive)
(xgtags--find-with "Find tag:"))
(defun xgtags-find-rtag ()
"Input tag name and move to the referenced point."
(interactive)
(xgtags--find-with "Find tag (reference):" :option 'reference))
(defun xgtags-find-symbol ()
"Input symbol and move to the locations."
(interactive)
(xgtags--find-with "Find symbol:" :option 'symbol))
(defun xgtags-find-with-grep ()
"Input pattern, search with grep(1) and move to the locations."
(interactive)
(xgtags--find-with "Find pattern:" :option 'grep))
(defalias 'xgtags-find-pattern 'xgtags-find-with-grep)
(defun xgtags-find-with-idutils ()
"Input pattern, search with id-utils(1) and move to the locations."
(interactive)
(xgtags--find-with "Find pattern:" :option 'idutils))
(defun xgtags-find-file ()
"Input pattern and move to the top of the file."
(interactive)
(xgtags--find-with "Find file:"
:option 'path
:get-token 'xgtags--file-at-point
:history nil))
(defun xgtags-find-tag-from-here ()
"Get the expression as a tagname around here and move there."
(interactive)
(let ((tagname (xgtags--token-at-point)))
(when tagname
(xgtags--goto-tag tagname (cond ((not (xgtags--function-p)) 'symbol)
((xgtags--definition-p) 'reference)
(t nil))))))
(defun xgtags-find-tag-by-event (event)
"Get the expression as a tagname around here and move there."
(interactive "e")
(if xgtags-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))))
(let ((tagname (xgtags--token-at-point)))
(when tagname
(xgtags--goto-tag tagname (cond ((not (xgtags--function-p)) 'symbol)
((xgtags--definition-p) 'reference)
(t nil))))))
(defun xgtags-pop-stack ()
"Move to previous point on the stack."
(interactive)
(let ((delete (and xgtags-kill-buffers
(not (xgtags--stacked-p (current-buffer)))))
(context (xgtags--pop-context)))
(assert context nil "The tags stack is empty")
(when delete
(kill-buffer (current-buffer)))
(xgtags--update-buffer context)
(switch-to-buffer (xgtags--context-buffer context))
(goto-char (xgtags--context-point context))))
(defun xgtags-query-replace-regexp (to-string)
"Run over the current *xgtags* buffer and to `query-replace-regexp'
for each tag."
(interactive
(list (read-from-minibuffer (format "Replace <%s> with: "
(xgtags--tag-query
(save-excursion
(set-buffer (xgtags--get-buffer))
(get-text-property (point) 'xgtags-tag))))
nil nil nil
query-replace-to-history-variable nil t)))
(xgtags--map-tags
(lambda (match)
(query-replace-regexp match to-string nil
(point)
(save-excursion (end-of-line) (point))))))
(defun xgtags-parse-file ()
"Input file name, parse it and show object list."
(interactive)
(let ((input (read-file-name "Parse file: "
nil nil t
(file-name-nondirectory buffer-file-name))))
(assert (not (equal input "")) nil "No file speciafied")
(xgtags--goto-tag (expand-file-name input) 'file)))
(defun xgtags-display-browser ()
"Display current screen on hypertext browser."
(interactive)
(unless (and (not (equal (point-min) (point-max)))
buffer-file-name)
(let ((lno (save-excursion
(end-of-line)
(max 1 (count-lines (point-min) (point))))))
(with-temp-buffer
(unless (zerop (call-process "gozilla" nil t nil
(concat "+" (number-to-string lno))
buffer-file-name))
(message "%s" (buffer-string)))))))
(defun xgtags-make-complete-list ()
"Make tag name list for completion."
(interactive)
(let* ((file-name (buffer-file-name))
(buffer-dir (and file-name (file-name-directory file-name))))
(message "Making completion list ...")
(setq xgtags--completition-table (make-vector 511 0))
(xgtags--do-in-all-directories
buffer-dir
(lambda (dir)
(message "Making completion list in %s" dir)
(let ((xgtags-rootdir (and dir (file-name-as-directory dir))))
(with-xgtags-environment
(with-temp-buffer
(call-process "global" nil t nil "-c")
(goto-char (point-min))
(while (looking-at xgtags--symbol-regexp)
(intern (match-string-no-properties 0) xgtags--completition-table)
(forward-line)))))))
(message "Making completion list ... Done")))
(defun xgtags-complete-tag ()
(interactive)
(unless xgtags--completition-table
(error "No xgtags--completition-table created"))
(while (looking-at "[ \t\n]")
(backward-char 1))
(let ((pattern (xgtags--token-at-point))
(beg (match-beginning 0))
(end (match-end 0))
completion)
(unless pattern
(error "Nothing to complete"))
(goto-char end)
(setq completion (try-completion pattern xgtags--completition-table nil))
(cond ((eq completion t))
((null completion)
(message "Can't find completion for \"%s\"" pattern)
(ding))
((not (string= pattern completion))
(delete-region beg (point))
(insert completion))
(t
(message "Making completion list...")
(with-output-to-temp-buffer "*Completions*"
(display-completion-list
(all-completions pattern xgtags--completition-table)))
(message "Making completion list...%s" "done")))))
(defun xgtags--switch-buffer (other-window jump-to-start-p)
(with-xgtags-buffer (:buffer buffer)
(when jump-to-start-p
(goto-char (point-min)))
(if other-window
(switch-to-buffer-other-window buffer)
(switch-to-buffer buffer))))
(defun xgtags-switch-to-buffer (&optional jump-to-start-p)
(interactive "P")
(xgtags--switch-buffer nil jump-to-start-p))
(defun xgtags-switch-to-buffer-other-window (&optional jump-to-start-p)
(interactive "P")
(xgtags--switch-buffer t jump-to-start-p))
(easy-menu-define xgtags-menu
xgtags-mode-map
"xgtags menu"
'("XGtags"
[ "Find Tag" xgtags-find-tag t ]
[ "Find Tag Reference" xgtags-find-rtag t ]
[ "Find Symbol" xgtags-find-symbol t ]
[ "Find Pattern With grep" xgtags-find-with-grep t ]
[ "Find Pattern With idutils" xgtags-find-with-idutils t ]
"-----------"
[ "Find Previous Tag" xgtags-select-prev-tag t ]
[ "Find Next Tag" xgtags-select-next-tag t ]
[ "Query-replace Tag" xgtags-query-replace-regexp t ]
"-----------"
[ "Make Completion List" xgtags-make-complete-list t ]
[ "Find File" xgtags-find-file t ]
[ "Display in Browser" xgtags-display-browser t ]
"-----------"
[ "Parse File" xgtags-parse-file t ]
[ "Visit Tags Directory" xgtags-visit-rootdir t ]))
(define-minor-mode xgtags-mode
"Toggle xgtags-mode, a minor mode for browsing source code using GLOBAL.
Input tag name and move to the definition.
\\[xgtags-find-tag]
Input tag name and move to the referenced point.
\\[xgtags-find-rtag]
Input symbol and move to the locations.
\\[xgtags-find-symbol]
Input pattern, search with grep(1) and move to the locations.
\\[xgtags-find-with-grep]
Input pattern, search with id-utils(1) and move to the locations.
\\[xgtags-find-with-idutils]
Input pattern and move to the top of the file.
\\[xgtags-find-file]
Get the expression as a tagname around here and move there.
\\[xgtags-find-tag-from-here]
Display current screen on hypertext browser.
\\[xgtags-display-browser]
Get the expression as a tagname around here and move there.
\\[xgtags-find-tag-by-event]
Move to previous point on the stack.
\\[xgtags-pop-stack]
Make tag name list for completion.
\\[xgtags-make-complete-list]
Key definitions:
\\{xgtags-mode-map}
Turning on xgtags-mode calls the value of the variable `xgtags-mode-hook'
with no args, if that value is non-nil."
nil
xgtags-minor-mode-text
'xgtags-mode-map)
(define-derived-mode xgtags-select-mode fundamental-mode xgtags-select-mode-name
"Major mode for choosing a tag from tags list.
Select a tag in tags list and move there.
\\[xgtags-select-tag-near-point]
Move to previous point on the stack.
\\[xgtags-pop-stack]
Key definitions:
\\{xgtags-select-mode-map}
Turning on xgtags-select mode calls the value of the variable
`xgtags-select-mode-hook' with no args, if that value is non-nil."
(setq buffer-read-only t
truncate-lines t)
(goto-char (point-min)))
(provide 'xgtags)