Re: [CEDET-devel] CEDET completion-at-point-function

[Stefan Monnier <monnier@iro.umontreal.ca>]

> 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 <monnier@iro.umontreal.ca>
+;; 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.