Re: [CEDET-devel] CEDET completion-at-point-function
Stefan Monnier <[email protected]>
| Newsgroups | gmane.emacs.devel,gmane.emacs.cedet |
|---|---|
| Message-ID | <[email protected]> |
> Of course, semantic-ia-complete-symbol calls into other parts of the system
> for calculating completions, and I am not familiar enough with the
> lexical-binding topic to know if they would be negatively affected or not.
> Is there a brief reference I could read about the topic?
The issue of lexical-binding is just that it's a feature that was
introduced in Emacs-24.1, so code that relies on it won't work in
older Emacsen.
Anyway, I've since figured that it's simpler to use a new file.
Here is my work-in-progress code. I'd welcome comments on it, since
I don't know much about Semantic I've had to make a few changes to it
(see the overloaded methods I had to change in semantic/analyze.el and
semantic/ia.el, meaning that the "overloadability" was moved to a new
method) as well as make some assumptions about some of its code (see
comment in semantic/analyze/complete.el).
Stefan
=== modified file 'lisp/cedet/semantic.el'
--- lisp/cedet/semantic.el 2014-01-01 07:43:34 +0000
+++ lisp/cedet/semantic.el 2014-05-23 02:47:18 +0000
@@ -1155,9 +1157,6 @@
;; re-activated.
(setq semantic-new-buffer-fcn-was-run nil)))
-(defun semantic-completion-at-point-function ()
- 'semantic-ia-complete-symbol)
-
;;; Autoload some functions that are not in semantic/loaddefs
(autoload 'global-semantic-idle-completions-mode "semantic/idle"
=== modified file 'lisp/cedet/semantic/analyze.el'
--- lisp/cedet/semantic/analyze.el 2014-01-01 07:43:34 +0000
+++ lisp/cedet/semantic/analyze.el 2014-06-15 02:47:17 +0000
@@ -466,32 +466,24 @@
;;
;; Create a full-up context analysis.
;;
+
;;;###autoload
-(define-overloadable-function semantic-analyze-current-context (&optional position)
- "Analyze the current context at optional POSITION.
-If called interactively, display interesting information about POSITION
-in a separate buffer.
+(define-overloadable-function semantic-analyze-sab-context (sab)
+ "Analyze the current context at SAB.
Returns an object based on symbol `semantic-analyze-context'.
+SAB is an object as returned by `semantic-ctxt-current-symbol-and-bounds'.
-This function can be overridden with the symbol `analyze-context'.
-When overriding this function, your override will be called while
-cursor is at POSITION. In addition, your function will not be called
-if a cached copy of the return object is found."
- (interactive "d")
- ;; Only do this in a Semantic enabled buffer.
- (when (not (semantic-active-p))
- (error "Cannot analyze buffers not supported by Semantic"))
+If a cached copy of the return object is found for symbol `current-context',
+it takes precedence."
+ (cl-assert (semantic-active-p))
;; Always refresh out tags in a safe way before doing the
;; context.
(semantic-refresh-tags-safe)
- ;; Do the rest of the analysis.
- (if (not position) (setq position (point)))
(save-excursion
- (goto-char position)
- (let* ((answer (semantic-get-cache-data 'current-context)))
+ (goto-char (car (nth 2 sab)))
+ (or (semantic-get-cache-data 'current-context)
(with-syntax-table semantic-lex-syntax-table
- (when (not answer)
- (setq answer (:override))
+ (let ((answer (:override)))
(when (and answer (oref answer bounds))
(with-slots (bounds) answer
(semantic-cache-data-to-buffer (current-buffer)
@@ -500,27 +492,19 @@
answer
'current-context
'exit-cache-zone)))
- ;; Check for interactivity
- (when (called-interactively-p 'any)
- (if answer
- (semantic-analyze-pop-to-context answer)
- (message "No Context."))
- ))
-
- answer))))
+ answer)))))
-(defun semantic-analyze-current-context-default (position)
- "Analyze the current context at POSITION.
+(defun semantic-analyze-sab-context-default (sab)
+ "Analyze the current context SAB.
Returns an object based on symbol `semantic-analyze-context'."
(let* ((semantic-analyze-error-stack nil)
- (context-return nil)
- (prefixandbounds (semantic-ctxt-current-symbol-and-bounds (or position (point))))
+ (prefixandbounds sab)
(prefix (car prefixandbounds))
(bounds (nth 2 prefixandbounds))
;; @todo - vv too early to really know this answer! vv
(prefixclass (semantic-ctxt-current-class-list))
(prefixtypes nil)
- (scope (semantic-calculate-scope position))
+ (scope (semantic-calculate-scope (car bounds)))
(function nil)
(fntag nil)
arg fntagend argtag
@@ -596,6 +580,8 @@
;; Only do work if we have bounds (meaning a prefix to complete)
(when bounds
+ ;; FIXME: Code duplication! This should use something like
+ ;; condition-case-unless-debug!
(if debug-on-error
(catch 'unfindable
(setq prefix (semantic-analyze-find-tag-sequence
@@ -628,7 +614,6 @@
;; If we found a tag for our function, we can go into
;; functional context analysis mode, meaning we have a type
;; for the argument.
- (setq context-return
(semantic-analyze-context-functionarg
"functionargument"
:buffer (current-buffer)
@@ -640,7 +625,7 @@
:prefixclass prefixclass
:bounds bounds
:prefixtypes prefixtypes
- :errors semantic-analyze-error-stack)))
+ :errors semantic-analyze-error-stack))
;; No function, try assignment
((and (setq assign (semantic-ctxt-current-assignment))
@@ -651,7 +636,6 @@
(error (semantic-analyze-push-error err)
nil)))
- (setq context-return
(semantic-analyze-context-assignment
"assignment"
:buffer (current-buffer)
@@ -661,7 +645,7 @@
:prefix prefix
:prefixclass prefixclass
:prefixtypes prefixtypes
- :errors semantic-analyze-error-stack)))
+ :errors semantic-analyze-error-stack))
;; TODO: Identify return value condition.
;;((setq return .... what to do?)
@@ -669,7 +653,6 @@
(bounds
;; Nothing in particular
- (setq context-return
(semantic-analyze-context
"context"
:buffer (current-buffer)
@@ -678,13 +661,34 @@
:prefix prefix
:prefixclass prefixclass
:prefixtypes prefixtypes
- :errors semantic-analyze-error-stack)))
+ :errors semantic-analyze-error-stack))
- (t (setq context-return nil))
- )
+ (t nil)
+ )))
- ;; Return our context.
- context-return))
+;;;###autoload
+(defun semantic-analyze-current-context (&optional position interactive)
+ "Analyze the current context at optional POSITION.
+If called interactively, display interesting information about POSITION
+in a separate buffer.
+Returns an object based on symbol `semantic-analyze-context'.
+
+This function can be overridden with the symbol `analyze-context'.
+When overriding this function, your override will be called while
+cursor is at POSITION. In addition, your function will not be called
+if a cached copy of the return object is found."
+ ;; FIXME: Shouldn't `analyze-context' above be `current-context'?
+ (interactive "d\np")
+ ;; Only do this in a Semantic enabled buffer.
+ (when (not (semantic-active-p))
+ (error "Cannot analyze buffers not supported by Semantic"))
+ (let* ((sab (semantic-ctxt-current-symbol-and-bounds position))
+ (answer (when sab (semantic-analyze-sab-context sab))))
+ (when interactive
+ (if answer
+ (semantic-analyze-pop-to-context answer)
+ (message "No Context.")))
+ answer))
(defun semantic-analyze-dereference-alias (taglist)
"Dereference first tag in TAGLIST if it is an alias.
@@ -742,7 +746,7 @@
:group 'semantic
:type semantic-format-tag-custom-list)
-(defun semantic-analyze-princ-sequence (sequence &optional prefix buff)
+(defun semantic-analyze-princ-sequence (sequence &optional prefix _buff)
"Send the tag SEQUENCE to standard out.
Use PREFIX as a label.
Use BUFF as a source of override methods."
@@ -760,8 +764,7 @@
(princ (format "'%S" (car sequence)))))
(princ "\n")
(setq sequence (cdr sequence))
- (setq prefix (make-string (length prefix) ? ))
- ))
+ (setq prefix (make-string (length prefix) ?\s))))
(defmethod semantic-analyze-show ((context semantic-analyze-context))
"Insert CONTEXT into the current buffer in a nice way."
=== modified file 'lisp/cedet/semantic/analyze/complete.el'
--- lisp/cedet/semantic/analyze/complete.el 2014-01-01 07:43:34 +0000
+++ lisp/cedet/semantic/analyze/complete.el 2014-06-15 03:00:28 +0000
@@ -129,6 +129,14 @@
(do-typeconstraint (not (memq 'no-tc flags)))
(do-unique (not (memq 'no-unique flags)))
)
+ ;; If the buffer text is "p->f_a", this code will only give us the fields
+ ;; of "p" which start with "f_a". But we may want to complete it to
+ ;; "p->fastmap_accurate".
+ ;; In semantic/capf.el we hack around it by fudging `prefix' so it doesn't
+ ;; exactly contain the buffer text (e.g. it might pretend the user only
+ ;; typed "p->f" and let the generic completion code take responsibility for
+ ;; filtering out completions which don't contain the "_a").
+ ;; So don't assume that `prefix' really reflects the content of the buffer.
;; Calculate what our prefix string is so that we can
;; find all our matching text.
=== added file 'lisp/cedet/semantic/capf.el'
--- lisp/cedet/semantic/capf.el 1970-01-01 00:00:00 +0000
+++ lisp/cedet/semantic/capf.el 2014-06-15 03:03:44 +0000
@@ -0,0 +1,139 @@
+;;; capf.el --- Completion at point function for Semantic -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2014 Free Software Foundation, Inc.
+
+;; Author: Stefan Monnier <[email protected]>
+;; Keywords:
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+(require 'semantic/fw)
+(require 'semantic/ia)
+
+;; FIXME: compared to company-semantic:
+;; - we don't distinguish string-or-comment from code.
+;; - missing support for :company-docsig, :company-doc-buffer.
+
+;;;###autoload
+(defun semantic-completion-at-point-function ()
+ (when (semantic-active-p)
+ (let ((sab (semantic-ctxt-current-symbol-and-bounds)))
+ (when (nth 2 sab)
+ (let* ((bounds (nth 2 sab))
+ (cache (list nil))
+ (current (buffer-substring (car bounds) (cdr bounds)))
+ (table (semantic-capf-completion-table sab cache)))
+ (when (eq completion-ignore-case
+ (string= (downcase current) current))
+ (setq table
+ (completion-table-case-fold table completion-ignore-case)))
+ (list (car (nth 2 sab)) (cdr (nth 2 sab)) table
+ :exit-function
+ ;; FIXME: Use lexical-binding!
+ (lambda (str status)
+ (when (eq status 'finished)
+ (let* ((as (semantic-capf-context-and-syms str sab cache))
+ (syms (cdr as))
+ (tag (semantic-find-first-tag-by-name str syms)))
+ (when tag
+ (semantic-ia-completion-completed tag)))))
+ :company-location
+ (apply-partially #'semantic-capf-company-location sab cache)
+ ;; :company-doc-buffer
+ ;; (apply-partially #'semantic-capf-company-docbuffer sab cache)
+ ;; :company-docsig
+ ;; (apply-partially #'semantic-capf-company-docsig sab cache)
+ ))))))
+
+(defun semantic-capf-context-and-syms (prefix sab cache)
+ (unless (and (car cache)
+ (string-prefix-p (car cache) prefix))
+ (let* ((a (if (car cache) (cadr cache)
+ (semantic-analyze-sab-context sab)))
+ ;; `sab' and `a' embed the current buffer's "completion text", and
+ ;; semantic-analyze-possible-completions will compute the completion
+ ;; of that text, so replace it with the `prefix' which we want to
+ ;; complete. Otherwise partial or substring completion can't work.
+ (_ (setf (car (last (oref a prefix))) prefix))
+ (syms (semantic-analyze-possible-completions a)))
+ (setcar cache prefix)
+ (setcdr cache (cons a syms))))
+ (cdr cache))
+
+
+(defun semantic-capf-completion-table (sab cache)
+ ;; Calculating completions is a two step process.
+ ;;
+ ;; The first analyzes the current context, which finds tags for
+ ;; all the stuff that may be referenced by the code around POS.
+ ;;
+ ;; The second step derives completions from that context.
+ (let ((buf (current-buffer)))
+ (completion-table-dynamic
+ (lambda (pre)
+ (with-current-buffer buf
+ ;; FIXME: Figure out how to use completion-boundaries to be able to do
+ ;; partial completion of "p->f" to "port->fastmap".
+ (let* ((as (semantic-capf-context-and-syms pre sab cache))
+ (a (car as))
+ (syms (cdr as)))
+ ;; Complete this symbol.
+ (or syms
+ (if (semantic-analyze-context-p a)
+ ;; This is a clever hack. If we were unable to find any
+ ;; smart completions, let's divert to how senator derives
+ ;; completions.
+ ;;
+ ;; This is a way of making this fcn more useful since
+ ;; the smart completion engine sometimes fails.
+ (all-completions pre
+ (semantic--completion-table
+ buf sab))))))))))
+
+(defun semantic-capf-company-location (sab cache str)
+ (let* ((as (semantic-capf-context-and-syms str sab cache))
+ (syms (cdr as))
+ (tag (assoc arg syms)))
+ (when (buffer-live-p (semantic-tag-buffer tag))
+ (cons (semantic-tag-buffer tag)
+ (semantic-tag-start tag)))))
+
+;; (defun semantic-capf-company-docbuffer (sab cache str)
+;; (let* ((as (semantic-capf-context-and-syms str sab cache))
+;; (syms (cdr as))
+;; (tag (assoc arg syms))
+;; (doc (company-semantic-documentation-for-tag tag)))
+;; (when doc
+;; (with-current-buffer (help-buffer)
+;; (help-setup-xref `(semantic-capf-company-docbuffer ,sab ,cache)
+;; (company-doc-buffer
+;; (concat (funcall semantic-idle-summary-function tag nil t)
+;; "\n"
+;; doc)))))
+;; (when (buffer-live-p (semantic-tag-buffer tag))
+;; (cons (semantic-tag-buffer tag)
+;; (semantic-tag-start tag)))))
+
+;; Local variables:
+;; generated-autoload-file: "loaddefs.el"
+;; End:
+
+(provide 'semantic/capf)
+;;; capf.el ends here
=== modified file 'lisp/cedet/semantic/ctxt.el'
--- lisp/cedet/semantic/ctxt.el 2014-01-01 07:43:34 +0000
+++ lisp/cedet/semantic/ctxt.el 2014-05-03 15:15:20 +0000
@@ -519,7 +519,7 @@
(error nil)))
symlist))))
-
+;;;###autoload
(define-overloadable-function semantic-ctxt-current-symbol-and-bounds (&optional point)
"Return the current symbol and bounds the cursor is on at POINT.
The symbol should be the same as returned by `semantic-ctxt-current-symbol'.
=== modified file 'lisp/cedet/semantic/ia.el'
--- lisp/cedet/semantic/ia.el 2014-01-13 20:04:08 +0000
+++ lisp/cedet/semantic/ia.el 2014-06-14 14:39:27 +0000
@@ -68,22 +68,30 @@
;; character after function names. For Lisp, it might check
;; to put a "(" in front of a function name.
-(define-overloadable-function semantic-ia-insert-tag (tag)
- "Insert TAG into the current buffer based on completion.")
+(define-overloadable-function semantic-ia-completion-completed (tag)
+ "Add extra text once completion is completed.")
-(defun semantic-ia-insert-tag-default (tag)
- "Insert TAG into the current buffer based on completion."
- (insert (semantic-tag-name tag))
+(defun semantic-ia-completion-completed-default (tag)
(let ((tt (semantic-tag-class tag)))
- (cond ((eq tt 'function)
- (insert "("))
+ (cond ((and (eq tt 'function)
+ (not (looking-at "[ \t]*(")))
+ ;; FIXME: GNU style (among others) wants a space before the
+ ;; open paren!
+ (let ((last-command-event ?\())
+ (call-interactively #'self-insert-command)))
(t nil))))
+(defun semantic-ia-insert-tag (tag)
+ (insert (semantic-tag-name tag))
+ (semantic-ia-completion-completed tag))
+(make-obsolete 'semantic-ia-insert-tag
+ 'semantic-ia-completion-completed "24.5")
+
(defalias 'semantic-ia-get-completions 'semantic-ia-get-completions-deprecated
"`Semantic-ia-get-completions' is obsolete.
Use `semantic-analyze-possible-completions' instead.")
-(defun semantic-ia-get-completions-deprecated (context point)
+(defun semantic-ia-get-completions-deprecated (context _point)
"A function to help transition away from `semantic-ia-get-completions'.
Return completions based on CONTEXT at POINT.
You should not use this, nor the aliased version.