;; Semantic utility API for use with semantic tag tables.
;;
-(require 'assoc)
(require 'semantic)
+
(eval-when-compile
- ;; Emacs 21
- (condition-case nil
- (require 'newcomment)
- (error nil))
- ;; Semanticdb calls
- (require 'semantic/db)
- )
+ (require 'semantic/db-find)
+ ;; For semantic-find-tags-by-class, semantic--find-tags-by-function,
+ ;; and semantic-brute-find-tag-standard:
+ (require 'semantic/find))
+
+(declare-function data-debug-insert-stuff-list "data-debug")
+(declare-function data-debug-insert-thing "data-debug")
+(declare-function semantic-ctxt-current-symbol-and-bounds "semantic/ctxt")
;;; Code:
and use it to get tags from files not in memory.
If FILE is not loaded, and semanticdb is not available, find the file
and parse it."
- (if (find-buffer-visiting file)
- (save-excursion
- (set-buffer (find-buffer-visiting file))
- (semantic-fetch-tags))
- ;; File not loaded
- (if (and (fboundp 'semanticdb-minor-mode-p)
- (semanticdb-minor-mode-p))
- ;; semanticdb is around, use it.
- (semanticdb-file-stream file)
- ;; Get the stream ourselves.
- (save-excursion
- (set-buffer (find-file-noselect file))
- (semantic-fetch-tags)))))
+ (save-match-data
+ (if (find-buffer-visiting file)
+ (with-current-buffer (find-buffer-visiting file)
+ (semantic-fetch-tags))
+ ;; File not loaded
+ (if (and (require 'semantic/db-mode)
+ (semanticdb-minor-mode-p))
+ ;; semanticdb is around, use it.
+ (semanticdb-file-stream file)
+ ;; Get the stream ourselves.
+ (with-current-buffer (find-file-noselect file)
+ (semantic-fetch-tags))))))
(semantic-alias-obsolete 'semantic-file-token-stream
- 'semantic-file-tag-table)
+ 'semantic-file-tag-table "23.2")
(defun semantic-something-to-tag-table (something)
"Convert SOMETHING into a semantic tag table.
something)
;; A buffer
((bufferp something)
- (save-excursion
- (set-buffer something)
+ (with-current-buffer something
(semantic-fetch-tags)))
;; A Tag: Get that tag's buffer
((and (semantic-tag-with-position-p something)
(semantic-tag-in-buffer-p something))
- (save-excursion
- (set-buffer (semantic-tag-buffer something))
+ (with-current-buffer (semantic-tag-buffer something)
(semantic-fetch-tags)))
;; Tag with a file name in it
((and (semantic-tag-p something)
(file-exists-p something))
(semantic-file-tag-table something))
;; A Semanticdb table
- ((and (featurep 'semanticdb)
+ ((and (featurep 'semantic/db)
(semanticdb-minor-mode-p)
(semanticdb-abstract-table-child-p something))
(semanticdb-refresh-table something)
(semanticdb-get-tags something))
;; Semanticdb find-results
- ((and (featurep 'semanticdb)
+ ((and (featurep 'semantic/db)
(semanticdb-minor-mode-p)
+ (require 'semantic/db-find)
(semanticdb-find-results-p something))
(semanticdb-strip-find-results something))
;; NOTE: This commented out since if a search result returns
(t nil)))
(semantic-alias-obsolete 'semantic-something-to-stream
- 'semantic-something-to-tag-table)
+ 'semantic-something-to-tag-table "23.2")
;;; Recursive searching through dependency trees
;;
in which TOKEN (the token found to match NAME) was found.
THIS ISN'T USED IN SEMANTIC. DELETE ME SOON."
- (save-excursion
- (set-buffer buffer)
+ (with-current-buffer buffer
(let* ((stream (semantic-fetch-tags))
(includelist (or (semantic-find-tags-by-class 'include stream)
"empty.silly.thing"))
(while (and (not found) includelist)
(let ((fn (semantic-dependency-tag-file (car includelist))))
(if (and fn (not (member fn unfound)))
- (save-excursion
- (set-buffer (find-file-noselect fn))
+ (with-current-buffer (save-match-data
+ (find-file-noselect fn))
(message "Scanning %s" (buffer-file-name))
(setq stream (semantic-fetch-tags))
(setq found (semantic-find-first-tag-by-name name stream))
(setq includelist (cdr includelist)))
found)))
(make-obsolete 'semantic-recursive-find-nonterminal-by-name
- "Do not use this function.")
+ "Do not use this function." "23.2")
;;; Completion APIs
;;
(defun semantic-describe-buffer-var-helper (varsym buffer)
"Display to standard out the value of VARSYM in BUFFER."
(require 'data-debug)
- (let ((value (save-excursion
- (set-buffer buffer)
+ (let ((value (with-current-buffer buffer
(symbol-value varsym))))
(cond
((and (consp value)
)
(with-output-to-temp-buffer (help-buffer)
- (help-setup-xref (list #'semantic-describe-buffer) (interactive-p))
+ (help-setup-xref (list #'semantic-describe-buffer)
+ (called-interactively-p 'interactive))
(with-current-buffer standard-output
(princ "Semantic Configuration in ")
(princ (buffer-name buff))
(princ "\nGeneral configuration items:\n")
(let ((vars '(semantic-inhibit-functions
- semantic-init-hooks
- semantic-init-db-hooks
+ semantic-init-hook
+ semantic-init-db-hook
semantic-unmatched-syntax-hook
semantic--before-fetch-tags-hook
semantic-after-toplevel-bovinate-hook
"Display the current token.
Argument P is the point to search from in the current buffer."
(interactive "d")
+ (require 'semantic/find)
(let ((tok (semantic-brute-find-innermost-tag-by-position
p (current-buffer))))
(message (mapconcat 'semantic-abbreviate-nonterminal tok ","))
(defun semantic-hack-search ()
"Display info about something under the cursor using generic methods."
(interactive)
- (let (
- ;(name (thing-at-point 'symbol))
- (strm (cdr (semantic-fetch-tags)))
+ (require 'semantic/find)
+ (let ((strm (cdr (semantic-fetch-tags)))
(res nil))
-; (if name
- (setq res
-; (semantic-find-nonterminal-by-name name strm)
-; (semantic-find-nonterminal-by-type name strm)
-; (semantic-recursive-find-nonterminal-by-name name (current-buffer))
- (semantic-brute-find-tag-by-position (point) strm)
-
- )
-; )
+ (setq res (semantic-brute-find-tag-by-position (point) strm))
(if res
(progn
(pop-to-buffer "*SEMANTIC HACK RESULTS*")
(message "Remaining overlays: %S" o)))
over)
+;;; Interactive commands (from Senator).
+
+;; The Senator library from upstream CEDET is not included in the
+;; built-in version of Emacs. The plan is to fold it into the
+;; different parts of CEDET and Emacs, so that it works
+;; "transparently". Here are some interactive commands based on
+;; Senator.
+
+;; Symbol completion
+
+(defun semantic-find-tag-for-completion (prefix)
+ "Find all tags with name starting with PREFIX.
+This uses `semanticdb' when available."
+ (let (result ctxt)
+ ;; Try the Semantic analyzer
+ (condition-case nil
+ (and (featurep 'semantic/analyze)
+ (setq ctxt (semantic-analyze-current-context))
+ (setq result (semantic-analyze-possible-completions ctxt)))
+ (error nil))
+ (or result
+ ;; If the analyzer fails, then go into boring completion.
+ (if (and (featurep 'semantic/db)
+ (semanticdb-minor-mode-p)
+ (require 'semantic/db-find))
+ (semanticdb-fast-strip-find-results
+ (semanticdb-deep-find-tags-for-completion prefix))
+ (semantic-deep-find-tags-for-completion prefix (current-buffer))))))
+
+(defun semantic-complete-symbol (&optional predicate)
+ "Complete the symbol under point, using Semantic facilities.
+When called from a program, optional arg PREDICATE is a predicate
+determining which symbols are considered."
+ (interactive)
+ (require 'semantic/ctxt)
+ (let* ((start (car (nth 2 (semantic-ctxt-current-symbol-and-bounds
+ (point)))))
+ (pattern (regexp-quote (buffer-substring start (point))))
+ collection completion)
+ (when start
+ (if (and semantic--completion-cache
+ (eq (nth 0 semantic--completion-cache) (current-buffer))
+ (= (nth 1 semantic--completion-cache) start)
+ (save-excursion
+ (goto-char start)
+ (looking-at (nth 3 semantic--completion-cache))))
+ ;; Use cached value.
+ (setq collection (nthcdr 4 semantic--completion-cache))
+ ;; Perform new query.
+ (setq collection (semantic-find-tag-for-completion pattern))
+ (setq semantic--completion-cache
+ (append (list (current-buffer) start 0 pattern)
+ collection))))
+ (if (null collection)
+ (let ((str (if pattern (format " for \"%s\"" pattern) "")))
+ (if (window-minibuffer-p (selected-window))
+ (minibuffer-message (format " [No completions%s]" str))
+ (message "Can't find completion%s" str)))
+ (setq completion (try-completion pattern collection predicate))
+ (if (string= pattern completion)
+ (let ((list (all-completions pattern collection predicate)))
+ (setq list (sort list 'string<))
+ (if (> (length list) 1)
+ (with-output-to-temp-buffer "*Completions*"
+ (display-completion-list list pattern))
+ ;; Bury any out-of-date completions buffer.
+ (let ((win (get-buffer-window "*Completions*" 0)))
+ (if win (with-selected-window win (bury-buffer))))))
+ ;; Exact match
+ (delete-region start (point))
+ (insert completion)
+ ;; Bury any out-of-date completions buffer.
+ (let ((win (get-buffer-window "*Completions*" 0)))
+ (if win (with-selected-window win (bury-buffer))))))))
+
(provide 'semantic/util)
;;; Minor modes
;;
(require 'semantic/util-modes)
+;; arch-tag: eaa7808d-83b9-43fe-adf0-4fb742dcb956
;;; semantic/util.el ends here