;;; semantic/symref.el --- Symbol Reference API
-;; Copyright (C) 2008-2015 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2016 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
(defun semantic-symref-calculate-rootdir ()
"Calculate the root directory for a symref search.
-Start with and EDE project, or use the default directory."
+Start with an EDE project, or use the default directory."
(let* ((rootproj (when (and (featurep 'ede) ede-minor-mode)
(ede-toplevel)))
(rootdirbase (if rootproj
;;;###autoload
(defun semantic-symref-find-references-by-name (name &optional scope tool-return)
"Find a list of references to NAME in the current project.
-Optional SCOPE specifies which file set to search. Defaults to 'project.
+Optional SCOPE specifies which file set to search. Defaults to `project'.
Refers to `semantic-symref-tool', to determine the reference tool to use
for the current buffer.
Returns an object of class `semantic-symref-result'.
;;;###autoload
(defun semantic-symref-find-tags-by-name (name &optional scope)
"Find a list of tags by NAME in the current project.
-Optional SCOPE specifies which file set to search. Defaults to 'project.
+Optional SCOPE specifies which file set to search. Defaults to `project'.
Refers to `semantic-symref-tool', to determine the reference tool to use
for the current buffer.
Returns an object of class `semantic-symref-result'."
;;;###autoload
(defun semantic-symref-find-tags-by-regexp (name &optional scope)
"Find a list of references to NAME in the current project.
-Optional SCOPE specifies which file set to search. Defaults to 'project.
+Optional SCOPE specifies which file set to search. Defaults to `project'.
Refers to `semantic-symref-tool', to determine the reference tool to use
for the current buffer.
Returns an object of class `semantic-symref-result'."
;;;###autoload
(defun semantic-symref-find-tags-by-completion (name &optional scope)
"Find a list of references to NAME in the current project.
-Optional SCOPE specifies which file set to search. Defaults to 'project.
+Optional SCOPE specifies which file set to search. Defaults to `project'.
Refers to `semantic-symref-tool', to determine the reference tool to use
for the current buffer.
Returns an object of class `semantic-symref-result'."
;;;###autoload
(defun semantic-symref-find-file-references-by-name (name &optional scope)
"Find a list of references to NAME in the current project.
-Optional SCOPE specifies which file set to search. Defaults to 'project.
+Optional SCOPE specifies which file set to search. Defaults to `project'.
Refers to `semantic-symref-tool', to determine the reference tool to use
for the current buffer.
Returns an object of class `semantic-symref-result'."
;;;###autoload
(defun semantic-symref-find-text (text &optional scope)
"Find a list of occurrences of TEXT in the current project.
-TEXT is a regexp formatted for use with egrep.
-Optional SCOPE specifies which file set to search. Defaults to 'project.
+TEXT is a regexp formatted for use with grep -E.
+Optional SCOPE specifies which file set to search. Defaults to `project'.
Refers to `semantic-symref-tool', to determine the reference tool to use
for the current buffer.
Returns an object of class `semantic-symref-result'."
)
"The results from a symbol reference search.")
-(defmethod semantic-symref-result-get-files ((result semantic-symref-result))
+(cl-defmethod semantic-symref-result-get-files ((result semantic-symref-result))
"Get the list of files from the symref result RESULT."
(if (slot-boundp result :hit-files)
(oref result hit-files)
)
))
-(defmethod semantic-symref-result-get-tags ((result semantic-symref-result)
+(defvar semantic-symref-recently-opened-buffers nil
+ "List of buffers opened by `semantic-symref-result-get-tags'.")
+
+(defun semantic-symref-cleanup-recent-buffers-fcn ()
+ "Hook function to be used in `post-command-hook' to cleanup buffers.
+Buffers collected during symref can result in some files being
+opened multiple times for one operation. This will keep buffers open
+until the next command is executed."
+ ;;(message "To Clean Up: %S" semantic-symref-recently-opened-buffers)
+ (mapc (lambda (buff)
+ ;; Don't delete any buffers which are being used
+ ;; upon completion of some command.
+ (when (not (get-buffer-window buff))
+ (kill-buffer buff)))
+ semantic-symref-recently-opened-buffers)
+ (setq semantic-symref-recently-opened-buffers nil)
+ (remove-hook 'post-command-hook 'semantic-symref-cleanup-recent-buffers-fcn)
+ )
+
+(cl-defmethod semantic-symref-result-get-tags ((result semantic-symref-result)
&optional open-buffers)
"Get the list of tags from the symref result RESULT.
Optional OPEN-BUFFERS indicates that the buffers that the hits are
(txt (oref (oref result :created-by) :searchfor))
(searchtype (oref (oref result :created-by) :searchtype))
(ans nil)
- (out nil)
- (buffs-to-kill nil))
+ (out nil))
(save-excursion
- (setq
- ans
- (mapcar
- (lambda (hit)
- (let* ((line (car hit))
- (file (cdr hit))
- (buff (find-buffer-visiting file))
- (tag nil)
- )
- (cond
- ;; We have a buffer already. Check it out.
- (buff
- (set-buffer buff))
-
- ;; We have a table, but it needs a refresh.
- ;; This means we should load in that buffer.
- (t
- (let ((kbuff
- (if open-buffers
- ;; Even if we keep the buffers open, don't
- ;; let EDE ask lots of questions.
- (let ((ede-auto-add-method 'never))
- (find-file-noselect file t))
- ;; When not keeping the buffers open, then
- ;; don't setup all the fancy froo-froo features
- ;; either.
- (semantic-find-file-noselect file t))))
- (set-buffer kbuff)
- (setq buffs-to-kill (cons kbuff buffs-to-kill))
- (semantic-fetch-tags)
- ))
- )
-
- ;; Too much baggage in goto-line
- ;; (goto-line line)
- (goto-char (point-min))
- (forward-line (1- line))
-
- ;; Search forward for the matching text
- (when (re-search-forward (regexp-quote txt)
- (point-at-eol)
- t)
- (goto-char (match-beginning 0))
- )
-
- (setq tag (semantic-current-tag))
-
- ;; If we are searching for a tag, but bound the tag we are looking
- ;; for, see if it resides in some other parent tag.
- ;;
- ;; If there is no parent tag, then we still need to hang the originator
- ;; in our list.
- (when (and (eq searchtype 'symbol)
- (string= (semantic-tag-name tag) txt))
- (setq tag (or (semantic-current-tag-parent) tag)))
-
- ;; Copy the tag, which adds a :filename property.
- (when tag
- (setq tag (semantic-tag-copy tag nil t))
- ;; Ad this hit to the tag.
- (semantic--tag-put-property tag :hit (list line)))
- tag))
- lines)))
+ (setq ans (mapcar
+ (lambda (hit)
+ (semantic-symref-hit-to-tag-via-buffer
+ hit txt searchtype open-buffers))
+ lines)))
;; Kill off dead buffers, unless we were requested to leave them open.
- (when (not open-buffers)
- (mapc 'kill-buffer buffs-to-kill))
+ (if (not open-buffers)
+ (add-hook 'post-command-hook 'semantic-symref-cleanup-recent-buffers-fcn)
+ ;; Else, just clear the saved buffers so they aren't deleted later.
+ (setq semantic-symref-recently-opened-buffers nil)
+ )
;; Strip out duplicates.
(dolist (T ans)
(if (and T (not (semantic-equivalent-tag-p (car out) T)))
;; Out is reversed... twice
(oset result :hit-tags (nreverse out)))))
+(defun semantic-symref-hit-to-tag-via-db (hit searchtxt searchtype)
+ "Convert the symref HIT into a TAG by looking up the tag via a database.
+Return the Semantic tag associated with HIT.
+SEARCHTXT is the text that is being searched for.
+Used to narrow the in-buffer search.
+SEARCHTYPE is the type of search (such as 'symbol or 'tagname).
+If there is no database, of if the searchtype is wrong, return nil."
+ ;; Allowed search types for this mechanism:
+ ;; tagname, tagregexp, tagcompletions
+ (if (not (memq searchtype '(tagname tagregexp tagcompletions)))
+ nil
+ (let* ((line (car hit))
+ (file (cdr hit))
+ ;; FAIL here vv - don't load is not obeyed if no table found.
+ (db (semanticdb-file-table-object file t))
+ (found nil)
+ (hit nil)
+ )
+ (cond ((eq searchtype 'tagname)
+ (setq found (semantic-find-tags-by-name searchtxt db)))
+ ((eq searchtype 'tagregexp)
+ (setq found (semantic-find-tags-by-name-regexp searchtxt db)))
+ ((eq searchtype 'tagcompletions)
+ (setq found (semantic-find-tags-for-completion searchtxt db)))
+ )
+ ;; Loop over FOUND to see if we can line up a match with a line number.
+ (when (= (length found) 1)
+ (setq hit (car found)))
+
+ ;; FAIL here ^^ - symref finds line numbers, but our DB uses character locations.
+ ;; as such, this is a cheat and we will need to give up.
+ hit)))
+
+(defun semantic-symref-hit-to-tag-via-buffer (hit searchtxt searchtype &optional open-buffers)
+ "Convert the symref HIT into a TAG by looking up the tag via a buffer.
+Return the Semantic tag associated with HIT.
+SEARCHTXT is the text that is being searched for.
+Used to narrow the in-buffer search.
+SEARCHTYPE is the type of search (such as 'symbol or 'tagname).
+Optional OPEN-BUFFERS, when nil will use a faster version of
+`find-file' when a file needs to be opened. If non-nil, then
+normal buffer initialization will be used.
+This function will leave buffers loaded from a file open, but
+will add buffers that must be opened to `semantic-symref-recently-opened-buffers'.
+Any caller MUST deal with that variable, either clearing it, or deleting the
+buffers that were opened."
+ (let* ((line (car hit))
+ (file (cdr hit))
+ (buff (find-buffer-visiting file))
+ (tag nil)
+ )
+ (cond
+ ;; We have a buffer already. Check it out.
+ (buff
+ (set-buffer buff))
+
+ ;; We have a table, but it needs a refresh.
+ ;; This means we should load in that buffer.
+ (t
+ (let ((kbuff
+ (if open-buffers
+ ;; Even if we keep the buffers open, don't
+ ;; let EDE ask lots of questions.
+ (let ((ede-auto-add-method 'never))
+ (find-file-noselect file t))
+ ;; When not keeping the buffers open, then
+ ;; don't setup all the fancy froo-froo features
+ ;; either.
+ (semantic-find-file-noselect file t))))
+ (set-buffer kbuff)
+ (push kbuff semantic-symref-recently-opened-buffers)
+ (semantic-fetch-tags)
+ ))
+ )
+
+ ;; Too much baggage in goto-line
+ ;; (goto-line line)
+ (goto-char (point-min))
+ (forward-line (1- line))
+
+ ;; Search forward for the matching text.
+ ;; FIXME: This still fails if the regexp uses something specific
+ ;; to the extended syntax, like grouping.
+ (when (re-search-forward (if (memq searchtype '(regexp tagregexp))
+ searchtxt
+ (regexp-quote searchtxt))
+ (point-at-eol)
+ t)
+ (goto-char (match-beginning 0))
+ )
+
+ (setq tag (semantic-current-tag))
+
+ ;; If we are searching for a tag, but bound the tag we are looking
+ ;; for, see if it resides in some other parent tag.
+ ;;
+ ;; If there is no parent tag, then we still need to hang the originator
+ ;; in our list.
+ (when (and (eq searchtype 'symbol)
+ (string= (semantic-tag-name tag) searchtxt))
+ (setq tag (or (semantic-current-tag-parent) tag)))
+
+ ;; Copy the tag, which adds a :filename property.
+ (when tag
+ (setq tag (semantic-tag-copy tag nil t))
+ ;; Ad this hit to the tag.
+ (semantic--tag-put-property tag :hit (list line)))
+ tag))
+
;;; SYMREF TOOLS
;;
;; The base symref tool provides something to hang new tools off of
(searchtype :initarg :searchtype
:type symbol
:documentation "The type of search to do.
-Values could be `symbol, `regexp, 'tagname, or 'completion.")
+Values could be 'symbol, 'regexp, 'tagname, or 'completion.")
(searchscope :initarg :searchscope
:type symbol
:documentation
`semantic-symref-tool'"
:abstract t)
-(defmethod semantic-symref-get-result ((tool semantic-symref-tool-baseclass))
+(cl-defmethod semantic-symref-get-result ((tool semantic-symref-tool-baseclass))
"Calculate the results of a search based on TOOL.
The symref TOOL should already contain the search criteria."
(let ((answer (semantic-symref-perform-search tool))
)
))
-(defmethod semantic-symref-perform-search ((tool semantic-symref-tool-baseclass))
+(cl-defmethod semantic-symref-perform-search ((tool semantic-symref-tool-baseclass))
"Base search for symref tools should throw an error."
(error "Symref tool objects must implement `semantic-symref-perform-search'"))
-(defmethod semantic-symref-parse-tool-output ((tool semantic-symref-tool-baseclass)
+(cl-defmethod semantic-symref-parse-tool-output ((tool semantic-symref-tool-baseclass)
outputbuffer)
"Parse the entire OUTPUTBUFFER of a symref tool.
Calls the method `semantic-symref-parse-tool-output-one-line' over and
(nreverse result)))
)
-(defmethod semantic-symref-parse-tool-output-one-line ((tool semantic-symref-tool-baseclass))
+(cl-defmethod semantic-symref-parse-tool-output-one-line ((tool semantic-symref-tool-baseclass))
"Base tool output parser is not implemented."
(error "Symref tool objects must implement `semantic-symref-parse-tool-output-one-line'"))