;;; semantic/complete.el --- Routines for performing tag completion
-;; Copyright (C) 2003-2005, 2007-2014 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2005, 2007-2016 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: syntax
"Display the string FMT formatted with ARGS at the end of the minibuffer."
(if semantic-complete-inline-overlay
(apply 'message fmt args)
- (message (concat (buffer-string) (apply 'format fmt args)))))
+ (apply 'message (concat "%s" fmt) (buffer-string) args)))
;;; ------------------------------------------------------------
;;; MINIBUFFER: Option Selection harnesses
"Default history variable for any unhistoried prompt.
Keeps STRINGS only in the history.")
+(defvar semantic-complete-active-default)
+(defvar semantic-complete-current-matched-tag)
(defun semantic-complete-read-tag-engine (collector displayor prompt
default-tag initial-input
The only options available for completion are those which can be logically
inserted into the current context.")
-(defmethod semantic-collector-calculate-completions-raw
+(cl-defmethod semantic-collector-calculate-completions-raw
((obj semantic-collector-analyze-completions) prefix completionlist)
"calculate the completions for prefix from completionlist."
;; if there are no completions yet, calculate them.
prefix
(oref obj first-pass-completions)))))
-(defmethod semantic-collector-cleanup ((obj semantic-collector-abstract))
+(cl-defmethod semantic-collector-cleanup ((obj semantic-collector-abstract))
"Clean up any mess this collector may have."
nil)
-(defmethod semantic-collector-next-action
+(cl-defmethod semantic-collector-next-action
((obj semantic-collector-abstract) partial)
"What should we do next? OBJ can be used to determine the next action.
PARTIAL indicates if we are doing a partial completion."
'complete-whitespace)))
'complete))
-(defmethod semantic-collector-last-prefix= ((obj semantic-collector-abstract)
+(cl-defmethod semantic-collector-last-prefix= ((obj semantic-collector-abstract)
last-prefix)
"Return non-nil if OBJ's prefix matches PREFIX."
(and (slot-boundp obj 'last-prefix)
(string= (oref obj last-prefix) last-prefix)))
-(defmethod semantic-collector-get-cache ((obj semantic-collector-abstract))
+(cl-defmethod semantic-collector-get-cache ((obj semantic-collector-abstract))
"Get the raw cache of tags for completion.
Calculate the cache if there isn't one."
(or (oref obj cache)
(semantic-collector-calculate-cache obj)))
-(defmethod semantic-collector-calculate-completions-raw
+(cl-defmethod semantic-collector-calculate-completions-raw
((obj semantic-collector-abstract) prefix completionlist)
"Calculate the completions for prefix from completionlist.
Output must be in semanticdb Find result format."
(if result
(list (cons table result)))))
-(defmethod semantic-collector-calculate-completions
+(cl-defmethod semantic-collector-calculate-completions
((obj semantic-collector-abstract) prefix partial)
"Calculate completions for prefix as setup for other queries."
(let* ((case-fold-search semantic-case-fold)
)))
))
-(defmethod semantic-collector-try-completion-whitespace
+(cl-defmethod semantic-collector-try-completion-whitespace
((obj semantic-collector-abstract) prefix)
"For OBJ, do whitespace completion based on PREFIX.
This implies that if there are two completions, one matching
)))
-(defmethod semantic-collector-current-exact-match ((obj semantic-collector-abstract))
+(cl-defmethod semantic-collector-current-exact-match ((obj semantic-collector-abstract))
"Return the active valid MATCH from the semantic collector.
For now, just return the first element from our list of available
matches. For semanticdb based results, make sure the file is loaded
(when (slot-boundp obj 'current-exact-match)
(oref obj current-exact-match)))
-(defmethod semantic-collector-current-whitespace-completion ((obj semantic-collector-abstract))
+(cl-defmethod semantic-collector-current-whitespace-completion ((obj semantic-collector-abstract))
"Return the active whitespace completion value."
(when (slot-boundp obj 'last-whitespace-completion)
(oref obj last-whitespace-completion)))
-(defmethod semantic-collector-get-match ((obj semantic-collector-abstract))
+(cl-defmethod semantic-collector-get-match ((obj semantic-collector-abstract))
"Return the active valid MATCH from the semantic collector.
For now, just return the first element from our list of available
matches. For semanticdb based results, make sure the file is loaded
(when (slot-boundp obj 'current-exact-match)
(semanticdb-find-result-nth-in-buffer (oref obj current-exact-match) 0)))
-(defmethod semantic-collector-all-completions
+(cl-defmethod semantic-collector-all-completions
((obj semantic-collector-abstract) prefix)
"For OBJ, retrieve all completions matching PREFIX.
The returned list consists of all the tags currently
(when (slot-boundp obj 'last-all-completions)
(oref obj last-all-completions)))
-(defmethod semantic-collector-try-completion
+(cl-defmethod semantic-collector-try-completion
((obj semantic-collector-abstract) prefix)
"For OBJ, attempt to match PREFIX.
See `try-completion' for details on how this works.
(if (slot-boundp obj 'last-completion)
(oref obj last-completion)))
-(defmethod semantic-collector-calculate-cache
+(cl-defmethod semantic-collector-calculate-cache
((obj semantic-collector-abstract))
"Calculate the completion cache for OBJ."
nil
)
-(defmethod semantic-collector-flush ((this semantic-collector-abstract))
+(cl-defmethod semantic-collector-flush ((this semantic-collector-abstract))
"Flush THIS collector object, clearing any caches and prefix."
(oset this cache nil)
(slot-makeunbound this 'last-prefix)
These collectors track themselves on a per-buffer basis."
:abstract t)
-(defmethod constructor :STATIC ((this semantic-collector-buffer-abstract)
+(cl-defmethod constructor ((this (subclass semantic-collector-buffer-abstract))
newname &rest fields)
"Reuse previously created objects of this type in buffer."
(let ((old nil)
(if (eq (eieio-object-class (car bl)) this)
(setq old (car bl))))
(unless old
- (let ((new (call-next-method)))
+ (let ((new (cl-call-next-method)))
(add-to-list 'semantic-collector-per-buffer-list new)
(setq old new)))
(slot-makeunbound old 'last-completion)
When searching for a tag, uses semantic deep search functions.
Basics search only in the current buffer.")
-(defmethod semantic-collector-calculate-cache
+(cl-defmethod semantic-collector-calculate-cache
((obj semantic-collector-buffer-deep))
"Calculate the completion cache for OBJ.
Uses `semantic-flatten-tags-table'"
"Completion engine for tags in a project.")
-(defmethod semantic-collector-calculate-completions-raw
+(cl-defmethod semantic-collector-calculate-completions-raw
((obj semantic-collector-project) prefix completionlist)
"Calculate the completions for prefix from completionlist."
(semanticdb-find-tags-for-completion prefix (oref obj path)))
(declare-function semanticdb-brute-deep-find-tags-for-completion
"semantic/db-find")
-(defmethod semantic-collector-calculate-completions-raw
+(cl-defmethod semantic-collector-calculate-completions-raw
((obj semantic-collector-project-brutish) prefix completionlist)
"Calculate the completions for prefix from completionlist."
(require 'semantic/db-find)
"The scope the local members are being completed from."))
"Completion engine for tags in a project.")
-(defmethod semantic-collector-calculate-completions-raw
+(cl-defmethod semantic-collector-calculate-completions-raw
((obj semantic-collector-local-members) prefix completionlist)
"Calculate the completions for prefix from completionlist."
(let* ((scope (or (oref obj scope)
a collector, and tracking tables of completion to display."
:abstract t)
-(defmethod semantic-displayor-cleanup ((obj semantic-displayor-abstract))
+(cl-defmethod semantic-displayor-cleanup ((obj semantic-displayor-abstract))
"Clean up any mess this displayor may have."
nil)
-(defmethod semantic-displayor-next-action ((obj semantic-displayor-abstract))
+(cl-defmethod semantic-displayor-next-action ((obj semantic-displayor-abstract))
"The next action to take on the minibuffer related to display."
(if (and (slot-boundp obj 'last-prefix)
(or (eq this-command 'semantic-complete-inline-TAB)
'scroll
'display))
-(defmethod semantic-displayor-set-completions ((obj semantic-displayor-abstract)
+(cl-defmethod semantic-displayor-set-completions ((obj semantic-displayor-abstract)
table prefix)
"Set the list of tags to be completed over to TABLE."
(oset obj table table)
(oset obj last-prefix prefix))
-(defmethod semantic-displayor-show-request ((obj semantic-displayor-abstract))
+(cl-defmethod semantic-displayor-show-request ((obj semantic-displayor-abstract))
"A request to show the current tags table."
(ding))
-(defmethod semantic-displayor-focus-request ((obj semantic-displayor-abstract))
+(cl-defmethod semantic-displayor-focus-request ((obj semantic-displayor-abstract))
"A request to for the displayor to focus on some tag option."
(ding))
-(defmethod semantic-displayor-scroll-request ((obj semantic-displayor-abstract))
+(cl-defmethod semantic-displayor-scroll-request ((obj semantic-displayor-abstract))
"A request to for the displayor to scroll the completion list (if needed)."
(scroll-other-window))
-(defmethod semantic-displayor-focus-previous ((obj semantic-displayor-abstract))
+(cl-defmethod semantic-displayor-focus-previous ((obj semantic-displayor-abstract))
"Set the current focus to the previous item."
nil)
-(defmethod semantic-displayor-focus-next ((obj semantic-displayor-abstract))
+(cl-defmethod semantic-displayor-focus-next ((obj semantic-displayor-abstract))
"Set the current focus to the next item."
nil)
-(defmethod semantic-displayor-current-focus ((obj semantic-displayor-abstract))
+(cl-defmethod semantic-displayor-current-focus ((obj semantic-displayor-abstract))
"Return a single tag currently in focus.
This object type doesn't do focus, so will never have a focus object."
nil)
Completions are showin in a new buffer and listed with the ability
to click on the items to aid in completion.")
-(defmethod semantic-displayor-show-request ((obj semantic-displayor-traditional))
+(cl-defmethod semantic-displayor-show-request ((obj semantic-displayor-traditional))
"A request to show the current tags table."
;; NOTE TO SELF. Find the character to type next, and emphasize it.
which have the same name."
:abstract t)
-(defmethod semantic-displayor-next-action ((obj semantic-displayor-focus-abstract))
+(cl-defmethod semantic-displayor-next-action ((obj semantic-displayor-focus-abstract))
"The next action to take on the minibuffer related to display."
(if (and (slot-boundp obj 'last-prefix)
(string= (oref obj last-prefix) (semantic-completion-text))
'focus)
'display))
-(defmethod semantic-displayor-set-completions ((obj semantic-displayor-focus-abstract)
+(cl-defmethod semantic-displayor-set-completions ((obj semantic-displayor-focus-abstract)
table prefix)
"Set the list of tags to be completed over to TABLE."
- (call-next-method)
+ (cl-call-next-method)
(slot-makeunbound obj 'focus))
-(defmethod semantic-displayor-focus-previous ((obj semantic-displayor-focus-abstract))
+(cl-defmethod semantic-displayor-focus-previous ((obj semantic-displayor-focus-abstract))
"Set the current focus to the previous item.
Not meaningful return value."
(when (and (slot-boundp obj 'table) (oref obj table))
)
)))
-(defmethod semantic-displayor-focus-next ((obj semantic-displayor-focus-abstract))
+(cl-defmethod semantic-displayor-focus-next ((obj semantic-displayor-focus-abstract))
"Set the current focus to the next item.
Not meaningful return value."
(when (and (slot-boundp obj 'table) (oref obj table))
(oset obj focus 0))
)))
-(defmethod semantic-displayor-focus-tag ((obj semantic-displayor-focus-abstract))
+(cl-defmethod semantic-displayor-focus-tag ((obj semantic-displayor-focus-abstract))
"Return the next tag OBJ should focus on."
(when (and (slot-boundp obj 'table) (oref obj table))
(with-slots (table) obj
(semanticdb-find-result-nth table (oref obj focus)))))
-(defmethod semantic-displayor-current-focus ((obj semantic-displayor-focus-abstract))
+(cl-defmethod semantic-displayor-current-focus ((obj semantic-displayor-focus-abstract))
"Return the tag currently in focus, or call parent method."
(if (and (slot-boundp obj 'focus)
(slot-boundp obj 'table)
;; database.
(car (semanticdb-find-result-nth (oref obj table) (oref obj focus))))
;; Do whatever
- (call-next-method)))
+ (cl-call-next-method)))
;;; Simple displayor which performs traditional display completion,
;; and also focuses with highlighting.
"Display completions in *Completions* buffer, with focus highlight.
A traditional displayor which can focus on a tag by showing it.
Same as `semantic-displayor-traditional', but with selection between
-multiple tags with the same name done by 'focusing' on the source
+multiple tags with the same name done by focusing on the source
location of the different tags to differentiate them.")
-(defmethod semantic-displayor-focus-request
+(cl-defmethod semantic-displayor-focus-request
((obj semantic-displayor-traditional-with-focus-highlight))
"Focus in on possible tag completions.
Focus is performed by cycling through the tags and highlighting
"Display completions options in a tooltip.
Display mechanism using tooltip for a list of possible completions.")
-(defmethod initialize-instance :AFTER ((obj semantic-displayor-tooltip) &rest args)
+(cl-defmethod initialize-instance :after ((obj semantic-displayor-tooltip) &rest args)
"Make sure we have tooltips required."
(condition-case nil
(require 'tooltip)
(defvar tooltip-mode)
-(defmethod semantic-displayor-show-request ((obj semantic-displayor-tooltip))
+(cl-defmethod semantic-displayor-show-request ((obj semantic-displayor-tooltip))
"A request to show the current tags table."
(if (or (not (featurep 'tooltip)) (not tooltip-mode))
;; If we cannot use tooltips, then go to the normal mode with
;; a traditional completion buffer.
- (call-next-method)
+ (cl-call-next-method)
(let* ((tablelong (semanticdb-strip-find-results (oref obj table)))
(table (semantic-unique-tag-table-by-name tablelong))
(completions (mapcar semantic-completion-displayor-format-tag-function table))
(when (>= (oref obj typing-count) 5)
(oset obj mode 'standard)
(setq mode 'standard)
- (message "Resetting inline-mode to 'standard'."))
+ (message "Resetting inline-mode to `standard'."))
(when (and (> numcompl max-tags)
(< (oref obj typing-count) 2))
;; Discretely hint at completion availability.
(setq msg-tail (concat "\n[<TAB> " (number-to-string (- numcompl max-tags)) " more]"))
(setq msg-tail (concat "\n[<n/a> " (number-to-string (- numcompl max-tags)) " more]"))
(when (>= (oref obj typing-count) 2)
- (message "Refine search to display results beyond the '%s' limit"
+ (message "Refine search to display results beyond the `%s' limit"
(symbol-name 'semantic-complete-inline-max-tags-extended)))))
((= numcompl 1)
;; two possible cases
;;; Compatibility
;;
-(eval-and-compile
- (if (fboundp 'window-inside-edges)
- ;; Emacs devel.
- (defalias 'semantic-displayor-window-edges
- 'window-inside-edges)
- ;; Emacs 21
- (defalias 'semantic-displayor-window-edges
- 'window-edges)
- ))
(defun semantic-displayor-point-position ()
"Return the location of POINT as positioned on the selected frame.
tooltip-frame-parameters)
(tooltip-show text)))
-(defmethod semantic-displayor-scroll-request ((obj semantic-displayor-tooltip))
+(cl-defmethod semantic-displayor-scroll-request ((obj semantic-displayor-tooltip))
"A request to for the displayor to scroll the completion list (if needed)."
;; Do scrolling in the tooltip.
(oset obj max-tags-initial 30)
Whichever completion is currently in focus will be displayed as ghost
text using overlay options.")
-(defmethod semantic-displayor-next-action ((obj semantic-displayor-ghost))
+(cl-defmethod semantic-displayor-next-action ((obj semantic-displayor-ghost))
"The next action to take on the inline completion related to display."
- (let ((ans (call-next-method))
+ (let ((ans (cl-call-next-method))
(table (when (slot-boundp obj 'table)
(oref obj table))))
(if (and (eq ans 'displayend)
nil
ans)))
-(defmethod semantic-displayor-cleanup ((obj semantic-displayor-ghost))
+(cl-defmethod semantic-displayor-cleanup ((obj semantic-displayor-ghost))
"Clean up any mess this displayor may have."
(when (slot-boundp obj 'ghostoverlay)
(semantic-overlay-delete (oref obj ghostoverlay)))
)
-(defmethod semantic-displayor-set-completions ((obj semantic-displayor-ghost)
+(cl-defmethod semantic-displayor-set-completions ((obj semantic-displayor-ghost)
table prefix)
"Set the list of tags to be completed over to TABLE."
- (call-next-method)
+ (cl-call-next-method)
(semantic-displayor-cleanup obj)
)
-(defmethod semantic-displayor-show-request ((obj semantic-displayor-ghost))
+(cl-defmethod semantic-displayor-show-request ((obj semantic-displayor-ghost))
"A request to show the current tags table."
; (if (oref obj first-show)
; (progn
;; Only do the traditional thing if the first show request
;; has been seen. Use the first one to start doing the ghost
;; text display.
-; (call-next-method)
+; (cl-call-next-method)
; )
)
-(defmethod semantic-displayor-focus-request
+(cl-defmethod semantic-displayor-focus-request
((obj semantic-displayor-ghost))
"Focus in on possible tag completions.
Focus is performed by cycling through the tags and showing a possible
(list 'const
:tag doc1
C)))
- (eieio-build-class-alist semantic-displayor-abstract t))
+ (eieio-build-class-alist 'semantic-displayor-abstract t))
)
"Possible options for inline completion displayors.
Use this to enable custom editing.")
;; input.
(when (save-window-excursion
(save-excursion
+ ;; FIXME: Use `while-no-input'?
(and (not (semantic-exit-on-input 'csi
(semantic-fetch-tags)
(semantic-throw-on-input 'csi)