summaryrefslogtreecommitdiff
path: root/lisp/cedet/semantic
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/cedet/semantic')
-rw-r--r--lisp/cedet/semantic/analyze.el121
-rw-r--r--lisp/cedet/semantic/analyze/complete.el12
-rw-r--r--lisp/cedet/semantic/bovine/c.el10
-rw-r--r--lisp/cedet/semantic/bovine/grammar.el19
-rw-r--r--lisp/cedet/semantic/bovine/scm.el2
-rw-r--r--lisp/cedet/semantic/complete.el1
-rw-r--r--lisp/cedet/semantic/db-el.el4
-rw-r--r--lisp/cedet/semantic/db.el16
-rw-r--r--lisp/cedet/semantic/debug.el13
-rw-r--r--lisp/cedet/semantic/doc.el3
-rw-r--r--lisp/cedet/semantic/ia.el80
-rw-r--r--lisp/cedet/semantic/lex-spp.el5
-rw-r--r--lisp/cedet/semantic/symref.el202
-rw-r--r--lisp/cedet/semantic/wisent/comp.el26
14 files changed, 336 insertions, 178 deletions
diff --git a/lisp/cedet/semantic/analyze.el b/lisp/cedet/semantic/analyze.el
index ffc2c327c5a..77e091721c8 100644
--- a/lisp/cedet/semantic/analyze.el
+++ b/lisp/cedet/semantic/analyze.el
@@ -226,8 +226,8 @@ Optional argument DESIRED-TYPE may be a non-type tag to analyze."
;; by an application that doesn't need to calculate the full
;; context.
-(define-overloadable-function semantic-analyze-find-tag-sequence (sequence &optional
- scope typereturn throwsym)
+(define-overloadable-function semantic-analyze-find-tag-sequence
+ (sequence &optional scope typereturn throwsym &rest flags)
"Attempt to find all tags in SEQUENCE.
Optional argument LOCALVAR is the list of local variables to use when
finding the details on the first element of SEQUENCE in case
@@ -237,53 +237,67 @@ scoped. These are not local variables, but symbols available in a structure
which doesn't need to be dereferenced.
Optional argument TYPERETURN is a symbol in which the types of all found
will be stored. If nil, that data is thrown away.
-Optional argument THROWSYM specifies a symbol the throw on non-recoverable error.")
+Optional argument THROWSYM specifies a symbol the throw on non-recoverable error.
+Remaining arguments FLAGS are additional flags to apply when searching.")
-(defun semantic-analyze-find-tag-sequence-default (sequence &optional
- scope typereturn
- throwsym)
+(defun semantic-analyze-find-tag-sequence-default
+ ;; Note: overloadable fcn uses &rest, but it is a list already, so we don't need
+ ;; to do that in the -default.
+ (sequence &optional scope typereturn throwsym flags)
"Attempt to find all tags in SEQUENCE.
SCOPE are extra tags which are in scope.
TYPERETURN is a symbol in which to place a list of tag classes that
are found in SEQUENCE.
-Optional argument THROWSYM specifies a symbol the throw on non-recoverable error."
+Optional argument THROWSYM specifies a symbol the throw on non-recoverable error.
+Remaining arguments FLAGS are additional flags to apply when searching.
+This function knows of flags:
+ 'mustbeclassvariable"
(let ((s sequence) ; copy of the sequence
(tmp nil) ; tmp find variable
(tag nil) ; tag return list
(tagtype nil) ; tag types return list
(fname nil)
(miniscope (when scope (clone scope)))
+ (tagclass (if (memq 'mustbeclassvariable flags)
+ 'variable nil))
)
;; First order check. Is this wholly contained in the typecache?
(setq tmp (semanticdb-typecache-find sequence))
-
- (if tmp
- (progn
+
+ (when tmp
+ (if (or (not tagclass) (semantic-tag-of-class-p tmp tagclass))
;; We are effectively done...
- (setq s nil)
- (setq tag (list tmp)))
-
- ;; For the first entry, it better be a variable, but it might
- ;; be in the local context too.
- ;; NOTE: Don't forget c++ namespace foo::bar.
- (setq tmp (or
- ;; Is this tag within our scope. Scopes can sometimes
- ;; shadow other things, so it goes first.
- (and scope (semantic-scope-find (car s) nil scope))
- ;; Find the tag out there... somewhere, but not in scope
- (semantic-analyze-find-tag (car s))
- ))
-
- (if (and (listp tmp) (semantic-tag-p (car tmp)))
- (setq tmp (semantic-analyze-select-best-tag tmp)))
- (if (not (semantic-tag-p tmp))
- (if throwsym
- (throw throwsym "Cannot find definition")
- (error "Cannot find definition for \"%s\"" (car s))))
- (setq s (cdr s))
- (setq tag (cons tmp tag)) ; tag is nil here...
- (setq fname (semantic-tag-file-name tmp))
- )
+ (setq s nil
+ tag (list tmp))
+ ;; tagclass doesn't match, so fail this.
+ (setq tmp nil)))
+
+ (unless tmp
+ ;; For tag class filtering, only apply the filter if the first entry
+ ;; is also the only entry.
+ (let ((lftagclass (if (= (length s) 1) tagclass)))
+
+ ;; For the first entry, it better be a variable, but it might
+ ;; be in the local context too.
+ ;; NOTE: Don't forget c++ namespace foo::bar.
+ (setq tmp (or
+ ;; Is this tag within our scope. Scopes can sometimes
+ ;; shadow other things, so it goes first.
+ (and scope (semantic-scope-find (car s) lftagclass scope))
+ ;; Find the tag out there... somewhere, but not in scope
+ (semantic-analyze-find-tag (car s) lftagclass)
+ ))
+
+ (if (and (listp tmp) (semantic-tag-p (car tmp)))
+ (setq tmp (semantic-analyze-select-best-tag tmp lftagclass)))
+ (if (not (semantic-tag-p tmp))
+ (if throwsym
+ (throw throwsym "Cannot find definition")
+ (error "Cannot find definition for \"%s\"" (car s))))
+ (setq s (cdr s))
+ (setq tag (cons tmp tag)) ; tag is nil here...
+ (setq fname (semantic-tag-file-name tmp))
+ ))
;; For the middle entries
(while s
@@ -382,7 +396,8 @@ searches use the same arguments."
;; Search in the typecache. First entries in a sequence are
;; often there.
(setq retlist (semanticdb-typecache-find name))
- (if retlist
+ (if (and retlist (or (not tagclass)
+ (semantic-tag-of-class-p retlist 'tagclass)))
retlist
(semantic-analyze-select-best-tag
(semanticdb-strip-find-results
@@ -647,7 +662,7 @@ Returns an object based on symbol `semantic-analyze-context'."
;; We have some sort of an assignment
(condition-case err
(setq asstag (semantic-analyze-find-tag-sequence
- assign scope))
+ assign scope nil nil 'mustbeclassvariable))
(error (semantic-analyze-push-error err)
nil)))
@@ -746,22 +761,26 @@ Some useful functions are found in `semantic-format-tag-functions'."
"Send the tag SEQUENCE to standard out.
Use PREFIX as a label.
Use BUFF as a source of override methods."
+ ;; If there is no sequence, at least show the field as being empty.
+ (unless sequence (princ prefix) (princ "<none>\n"))
+
+ ;; Display the sequence column aligned.
(while sequence
- (princ prefix)
- (cond
- ((semantic-tag-p (car sequence))
- (princ (funcall semantic-analyze-summary-function
- (car sequence))))
- ((stringp (car sequence))
- (princ "\"")
- (princ (semantic--format-colorize-text (car sequence) 'variable))
- (princ "\""))
- (t
- (princ (format "'%S" (car sequence)))))
- (princ "\n")
- (setq sequence (cdr sequence))
- (setq prefix (make-string (length prefix) ? ))
- ))
+ (princ prefix)
+ (cond
+ ((semantic-tag-p (car sequence))
+ (princ (funcall semantic-analyze-summary-function
+ (car sequence))))
+ ((stringp (car sequence))
+ (princ "\"")
+ (princ (semantic--format-colorize-text (car sequence) 'variable))
+ (princ "\""))
+ (t
+ (princ (format "'%S" (car sequence)))))
+ (princ "\n")
+ (setq sequence (cdr sequence))
+ (setq prefix (make-string (length prefix) ? ))
+ ))
(defmethod semantic-analyze-show ((context semantic-analyze-context))
"Insert CONTEXT into the current buffer in a nice way."
diff --git a/lisp/cedet/semantic/analyze/complete.el b/lisp/cedet/semantic/analyze/complete.el
index 0d2d5f998b5..9fa400122f7 100644
--- a/lisp/cedet/semantic/analyze/complete.el
+++ b/lisp/cedet/semantic/analyze/complete.el
@@ -112,8 +112,9 @@ in a buffer."
Argument CONTEXT is an object specifying the locally derived context.
The optional argument FLAGS changes which return options are returned.
FLAGS can be any number of:
- 'no-tc - do not apply data-type constraint.
- 'no-unique - do not apply unique by name filtering."
+ 'no-tc - do not apply data-type constraint.
+ 'no-longprefix - ignore long multi-symbol prefixes.
+ 'no-unique - do not apply unique by name filtering."
(let* ((a context)
(desired-type (semantic-analyze-type-constraint a))
(desired-class (oref a prefixclass))
@@ -127,9 +128,16 @@ FLAGS can be any number of:
(c nil)
(any nil)
(do-typeconstraint (not (memq 'no-tc flags)))
+ (do-longprefix (not (memq 'no-longprefix flags)))
(do-unique (not (memq 'no-unique flags)))
)
+ (when (not do-longprefix)
+ ;; If we are not doing the long prefix, shorten all the key
+ ;; elements.
+ (setq prefix (list (car (reverse prefix)))
+ prefixtypes nil))
+
;; Calculate what our prefix string is so that we can
;; find all our matching text.
(setq completetext (car (reverse prefix)))
diff --git a/lisp/cedet/semantic/bovine/c.el b/lisp/cedet/semantic/bovine/c.el
index e9715cc1bb0..9aceca8af1b 100644
--- a/lisp/cedet/semantic/bovine/c.el
+++ b/lisp/cedet/semantic/bovine/c.el
@@ -270,7 +270,7 @@ Return the defined symbol as a special spp lex token."
(if (looking-back "/\\*.*" beginning-of-define)
(progn
(goto-char (match-beginning 0))
- (1- (point)))
+ (point))
(point)))))
)
@@ -501,7 +501,13 @@ code to parse."
(hif-canonicalize)
(error nil))))
- (let ((eval-form (eval parsedtokelist)))
+ (let ((eval-form (condition-case err
+ (eval parsedtokelist)
+ (error
+ (semantic-push-parser-warning
+ (format "Hideif forms produced an error. Assuming false.\n%S" err)
+ (point) (1+ (point)))
+ nil))))
(if (or (not eval-form)
(and (numberp eval-form)
(equal eval-form 0)));; ifdef line resulted in false
diff --git a/lisp/cedet/semantic/bovine/grammar.el b/lisp/cedet/semantic/bovine/grammar.el
index 46765789351..55df00245ff 100644
--- a/lisp/cedet/semantic/bovine/grammar.el
+++ b/lisp/cedet/semantic/bovine/grammar.el
@@ -395,16 +395,33 @@ manual."
(insert ")\n")
(buffer-string))))
+(defun bovine-grammar-calculate-source-on-path ()
+ "Calculate the location of the source for current buffer.
+The source directory is relative to some root in the load path."
+ (condition-case nil
+ (let* ((dir (nreverse (split-string (buffer-file-name) "/")))
+ (newdir (car dir)))
+ (setq dir (cdr dir))
+ ;; Keep trying the file name until it is on the path.
+ (while (and (not (locate-library newdir)) dir)
+ (setq newdir (concat (car dir) "/" newdir)
+ dir (cdr dir)))
+ (if (not dir)
+ (buffer-name)
+ newdir))
+ (error (buffer-name))))
+
(defun bovine-grammar-setupcode-builder ()
"Return the text of the setup code."
(format
"(setq semantic--parse-table %s\n\
semantic-debug-parser-source %S\n\
semantic-debug-parser-class 'semantic-bovine-debug-parser
+ semantic-debug-parser-debugger-source 'semantic/bovine/debug
semantic-flex-keywords-obarray %s\n\
%s)"
(semantic-grammar-parsetable)
- (buffer-name)
+ (bovine-grammar-calculate-source-on-path)
(semantic-grammar-keywordtable)
(let ((mode (semantic-grammar-languagemode)))
;; Is there more than one major mode?
diff --git a/lisp/cedet/semantic/bovine/scm.el b/lisp/cedet/semantic/bovine/scm.el
index 4fa34dfcc36..4e01c33cf6d 100644
--- a/lisp/cedet/semantic/bovine/scm.el
+++ b/lisp/cedet/semantic/bovine/scm.el
@@ -69,7 +69,7 @@ Attempts a simple prototype for calling or using TAG."
;; Note: Analyzer from Henry S. Thompson
(define-lex-regex-analyzer semantic-lex-scheme-symbol
"Detect and create symbol and keyword tokens."
- "\\(\\sw\\([:]\\|\\sw\\|\\s_\\)+\\)"
+ "\\(\\sw\\([:]\\|\\sw\\|\\s_\\)*\\)"
;; (message (format "symbol: %s" (match-string 0)))
(semantic-lex-push-token
(semantic-lex-token
diff --git a/lisp/cedet/semantic/complete.el b/lisp/cedet/semantic/complete.el
index ff9bc25b458..91f9daf7547 100644
--- a/lisp/cedet/semantic/complete.el
+++ b/lisp/cedet/semantic/complete.el
@@ -118,6 +118,7 @@
(eval-when-compile
;; For the semantic-find-tags-for-completion macro.
(require 'semantic/find))
+(require 'semantic/db-find) ;For type semanticdb-find-result-with-nil.
;;; Code:
diff --git a/lisp/cedet/semantic/db-el.el b/lisp/cedet/semantic/db-el.el
index 7ff1538dd2b..f37aa07ebe6 100644
--- a/lisp/cedet/semantic/db-el.el
+++ b/lisp/cedet/semantic/db-el.el
@@ -223,7 +223,9 @@ TOKTYPE is a hint to the type of tag desired."
(symbol-name sym)
"class"
(semantic-elisp-desymbolify
- (eieio--class-public-a (class-v semanticdb-project-database))) ;; slots
+ ;; FIXME: This only gives the instance slots and ignores the
+ ;; class-allocated slots.
+ (eieio--class-public-a (find-class semanticdb-project-database))) ;; slots ;FIXME: eieio--
(semantic-elisp-desymbolify (eieio-class-parents sym)) ;; parents
))
((not toktype)
diff --git a/lisp/cedet/semantic/db.el b/lisp/cedet/semantic/db.el
index 76a49ddc548..0732f225779 100644
--- a/lisp/cedet/semantic/db.el
+++ b/lisp/cedet/semantic/db.el
@@ -124,6 +124,18 @@ for a new table not associated with a buffer."
If the buffer is not in memory, load it with `find-file-noselect'."
nil)
+;; This generic method allows for sloppier coding. Many
+;; functions treat "table" as something that could be a buffer,
+;; file name, or other. This makes use of table more robust.
+(defmethod semanticdb-full-filename (buffer-or-string)
+ "Fetch the full filename that BUFFER-OR-STRING refers to.
+This uses semanticdb to get a better file name."
+ (cond ((bufferp buffer-or-string)
+ (with-current-buffer buffer-or-string
+ (semanticdb-full-filename semanticdb-current-table)))
+ ((and (stringp buffer-or-string) (file-exists-p buffer-or-string))
+ (expand-file-name buffer-or-string))))
+
(defmethod semanticdb-full-filename ((obj semanticdb-abstract-table))
"Fetch the full filename that OBJ refers to.
Abstract tables do not have file names associated with them."
@@ -469,7 +481,7 @@ other than :table."
(let ((cache (oref table cache))
(obj nil))
(while (and (not obj) cache)
- (if (eq (eieio--object-class (car cache)) desired-class)
+ (if (eq (eieio-object-class (car cache)) desired-class)
(setq obj (car cache)))
(setq cache (cdr cache)))
(if obj
@@ -520,7 +532,7 @@ other than :table."
(let ((cache (oref db cache))
(obj nil))
(while (and (not obj) cache)
- (if (eq (eieio--object-class (car cache)) desired-class)
+ (if (eq (eieio-object-class (car cache)) desired-class)
(setq obj (car cache)))
(setq cache (cdr cache)))
(if obj
diff --git a/lisp/cedet/semantic/debug.el b/lisp/cedet/semantic/debug.el
index 80081efd239..91819b89bd1 100644
--- a/lisp/cedet/semantic/debug.el
+++ b/lisp/cedet/semantic/debug.el
@@ -57,6 +57,12 @@ to one of the parser generators.")
;;;###autoload
(make-variable-buffer-local 'semantic-debug-parser-class)
+;;;###autoload
+(defvar semantic-debug-parser-debugger-source nil
+ "Location of the debug parser class.")
+;;;###autoload
+(make-variable-buffer-local 'semantic-debug-parser-source)
+
(defvar semantic-debug-enabled nil
"Non-nil when debugging a parser.")
@@ -104,6 +110,7 @@ These buffers are brought into view when layout occurs.")
"The currently displayed frame.")
(overlays :type list
:initarg nil
+ :initform nil
:documentation
"Any active overlays being used to show the debug position.")
)
@@ -323,15 +330,18 @@ Argument ONOFF is non-nil when we are entering debug mode.
(oref semantic-debug-current-interface parser-buffer)
(use-local-map
(oref semantic-debug-current-interface parser-local-map))
+ (setq buffer-read-only nil)
)
(with-current-buffer
(oref semantic-debug-current-interface source-buffer)
(use-local-map
(oref semantic-debug-current-interface source-local-map))
+ (setq buffer-read-only nil)
)
(run-hooks 'semantic-debug-exit-hook)
)))
+;;;###autoload
(defun semantic-debug ()
"Parse the current buffer and run in debug mode."
(interactive)
@@ -341,6 +351,9 @@ Argument ONOFF is non-nil when we are entering debug mode.
(error "This major mode does not support parser debugging"))
;; Clear the cache to force a full reparse.
(semantic-clear-toplevel-cache)
+ ;; Load in the debugger for this file.
+ (when semantic-debug-parser-debugger-source
+ (require semantic-debug-parser-debugger-source))
;; Do the parse
(let ((semantic-debug-enabled t)
;; Create an interface
diff --git a/lisp/cedet/semantic/doc.el b/lisp/cedet/semantic/doc.el
index 2f9a570eb31..fdaeb95d001 100644
--- a/lisp/cedet/semantic/doc.el
+++ b/lisp/cedet/semantic/doc.el
@@ -118,7 +118,8 @@ If NOSNARF is 'lex, then return the lex token."
(setq ct (concat (substring ct 0 (match-beginning 0))
(substring ct (match-end 0)))))
;; Remove comment delimiter at the end of the string.
- (when (string-match (concat (regexp-quote comment-end) "$") ct)
+ (when (and comment-end (not (string= comment-end ""))
+ (string-match (concat (regexp-quote comment-end) "$") ct))
(setq ct (substring ct 0 (match-beginning 0)))))
;; Now return the text.
ct))))
diff --git a/lisp/cedet/semantic/ia.el b/lisp/cedet/semantic/ia.el
index 10e84880ab6..8a5cbac4129 100644
--- a/lisp/cedet/semantic/ia.el
+++ b/lisp/cedet/semantic/ia.el
@@ -150,45 +150,47 @@ Completion options are calculated with `semantic-analyze-possible-completions'."
:group 'semantic
:type semantic-format-tag-custom-list)
-;; Disabled - see http://debbugs.gnu.org/14522
-;; ;;;###autoload
-;; (defun semantic-ia-complete-symbol-menu (point)
-;; "Complete the current symbol via a menu based at POINT.
-;; Completion options are calculated with `semantic-analyze-possible-completions'."
-;; (interactive "d")
-;; (require 'imenu)
-;; (let* ((a (semantic-analyze-current-context point))
-;; (syms (semantic-analyze-possible-completions a))
-;; )
-;; ;; Complete this symbol.
-;; (if (not syms)
-;; (progn
-;; (message "No smart completions found. Trying Senator.")
-;; (when (semantic-analyze-context-p a)
-;; ;; This is a quick way of getting a nice completion list
-;; ;; in the menu if the regular context mechanism fails.
-;; (senator-completion-menu-popup)))
-;;
-;; (let* ((menu
-;; (mapcar
-;; (lambda (tag)
-;; (cons
-;; (funcall semantic-ia-completion-menu-format-tag-function tag)
-;; (vector tag)))
-;; syms))
-;; (ans
-;; (imenu--mouse-menu
-;; ;; XEmacs needs that the menu has at least 2 items. So,
-;; ;; include a nil item that will be ignored by imenu.
-;; (cons nil menu)
-;; (senator-completion-menu-point-as-event)
-;; "Completions")))
-;; (when ans
-;; (if (not (semantic-tag-p ans))
-;; (setq ans (aref (cdr ans) 0)))
-;; (delete-region (car (oref a bounds)) (cdr (oref a bounds)))
-;; (semantic-ia-insert-tag ans))
-;; ))))
+;;;###autoload
+(defun semantic-ia-complete-symbol-menu (point)
+ "Complete the current symbol via a menu based at POINT.
+Completion options are calculated with `semantic-analyze-possible-completions'."
+ (interactive "d")
+ (require 'imenu)
+ (let* ((a (semantic-analyze-current-context point))
+ (syms (semantic-analyze-possible-completions a))
+ )
+ ;; Complete this symbol.
+ (if (not syms)
+ (progn
+ (message "No smart completions found.")
+ ;; Disabled - see http://debbugs.gnu.org/14522
+ ;; (message "No smart completions found. Trying Senator.")
+ ;; (when (semantic-analyze-context-p a)
+ ;; ;; This is a quick way of getting a nice completion list
+ ;; ;; in the menu if the regular context mechanism fails.
+ ;; (senator-completion-menu-popup))
+ )
+
+ (let* ((menu
+ (mapcar
+ (lambda (tag)
+ (cons
+ (funcall semantic-ia-completion-menu-format-tag-function tag)
+ (vector tag)))
+ syms))
+ (ans
+ (imenu--mouse-menu
+ ;; XEmacs needs that the menu has at least 2 items. So,
+ ;; include a nil item that will be ignored by imenu.
+ (cons nil menu)
+ `(down-mouse-1 ,(posn-at-point))
+ "Completions")))
+ (when ans
+ (if (not (semantic-tag-p ans))
+ (setq ans (aref (cdr ans) 0)))
+ (delete-region (car (oref a bounds)) (cdr (oref a bounds)))
+ (semantic-ia-insert-tag ans))
+ ))))
;;; Completions Tip
;;
diff --git a/lisp/cedet/semantic/lex-spp.el b/lisp/cedet/semantic/lex-spp.el
index 67f944a09ae..164454c481c 100644
--- a/lisp/cedet/semantic/lex-spp.el
+++ b/lisp/cedet/semantic/lex-spp.el
@@ -823,7 +823,7 @@ ARGVALUES are values for any arg list, or nil."
;; An analyzer that will push tokens from a macro in place
;; of the macro symbol.
;;
-(defun semantic-lex-spp-anlyzer-do-replace (sym val beg end)
+(defun semantic-lex-spp-analyzer-do-replace (sym val beg end)
"Do the lexical replacement for SYM with VAL.
Argument BEG and END specify the bounds of SYM in the buffer."
(if (not val)
@@ -863,6 +863,9 @@ Argument BEG and END specify the bounds of SYM in the buffer."
(setq semantic-lex-end-point end)
)
))
+(define-obsolete-function-alias
+ 'semantic-lex-spp-anlyzer-do-replace
+ 'semantic-lex-spp-analyzer-do-replace "25.1")
(defvar semantic-lex-spp-replacements-enabled t
"Non-nil means do replacements when finding keywords.
diff --git a/lisp/cedet/semantic/symref.el b/lisp/cedet/semantic/symref.el
index 994d85c7b2c..d9513981bc0 100644
--- a/lisp/cedet/semantic/symref.el
+++ b/lisp/cedet/semantic/symref.el
@@ -333,6 +333,25 @@ Use the `semantic-symref-hit-tags' method to get this list.")
)
))
+(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)
+ )
+
(defmethod semantic-symref-result-get-tags ((result semantic-symref-result)
&optional open-buffers)
"Get the list of tags from the symref result RESULT.
@@ -347,75 +366,19 @@ already."
(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)))
@@ -429,6 +392,111 @@ already."
;; 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
+ (when (re-search-forward (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
diff --git a/lisp/cedet/semantic/wisent/comp.el b/lisp/cedet/semantic/wisent/comp.el
index 9e25b52e8ce..2e5d2a43395 100644
--- a/lisp/cedet/semantic/wisent/comp.el
+++ b/lisp/cedet/semantic/wisent/comp.el
@@ -41,6 +41,7 @@
;;; Code:
(require 'semantic/wisent)
+(eval-when-compile (require 'cl))
;;;; -------------------
;;;; Misc. useful things
@@ -66,18 +67,23 @@
(defmacro wisent-defcontext (name &rest vars)
"Define a context NAME that will bind variables VARS."
+ (declare (indent 1))
(let* ((context (wisent-context-name name))
- (bindings (mapcar #'(lambda (v) (list 'defvar v)) vars)))
- `(eval-when-compile
- ,@bindings
- (defvar ,context ',vars))))
-(put 'wisent-defcontext 'lisp-indent-function 1)
+ (declarations (mapcar #'(lambda (v) (list 'defvar v)) vars)))
+ `(progn
+ ,@declarations
+ (eval-when-compile
+ (defvar ,context ',vars)))))
(defmacro wisent-with-context (name &rest body)
"Bind variables in context NAME then eval BODY."
- `(let* ,(wisent-context-bindings name)
- ,@body))
-(put 'wisent-with-context 'lisp-indent-function 1)
+ (declare (indent 1))
+ (let ((bindings (wisent-context-bindings name)))
+ `(progn
+ ,@(mapcar (lambda (binding) `(defvar ,(or (car-safe binding) binding)))
+ bindings)
+ (let* ,bindings
+ ,@body))))
;; A naive implementation of data structures! But it suffice here ;-)
@@ -2896,7 +2902,7 @@ references found in BODY, and XBODY is BODY expression with
(progn
(if (wisent-check-$N body n)
;; Accumulate $i symbol
- (add-to-list 'found body))
+ (pushnew body found :test #'equal))
(cons found body))
;; BODY is a list, expand inside it
(let (xbody sexpr)
@@ -2916,7 +2922,7 @@ references found in BODY, and XBODY is BODY expression with
;; $i symbol
((wisent-check-$N sexpr n)
;; Accumulate $i symbol
- (add-to-list 'found sexpr))
+ (pushnew sexpr found :test #'equal))
)
;; Accumulate expanded forms
(setq xbody (nconc xbody (list sexpr))))
generated by cgit v1.2.3 (git 2.39.1) at 2025-04-28 00:15:55 +0000