[Emacs-diffs] scratch/last-cedet-merge 742013b 05/11: semantic: Improve grammar-mode

[David Engster]

branch: scratch/last-cedet-merge
commit 742013bd66934edd7d9953790986acbdab463287
Author: Eric Ludlam <address@hidden>
Commit: David Engster <address@hidden>

    semantic: Improve grammar-mode
    
    * lisp/cedet/semantic/grammar.el (semantic-grammar-create-package):
     Get the setupfcn and mode before switching to other buffers. Don't
     special eval defvar, we generate defconst now. Be more aggressive
     reparsing open buffers of the mode being updated.
     (semantic-grammar-mode-map): Don't bind M-TAB.
     (semantic-grammar-menu): Use `completion-at-point' instead of grammar
     version.
     (semantic-grammar-mode): Remove type relation character.
     (semantic-grammar-complete): Delete.
     (semantic-ctxt-current-class-list): Also support 'token' class.
     (semantic-analyze-possible-completions): Support the optional FLAGS
     that are passed in for other languages. Reverse the found prefix.
---
 lisp/cedet/semantic/grammar.el |   96 ++++++++++++++--------------------------
 1 file changed, 33 insertions(+), 63 deletions(-)

diff --git a/lisp/cedet/semantic/grammar.el b/lisp/cedet/semantic/grammar.el
index 3260ddd..e71832f 100644
--- a/lisp/cedet/semantic/grammar.el
+++ b/lisp/cedet/semantic/grammar.el
@@ -940,29 +940,32 @@ Lisp code."
                 (make-backup-files t)
                 (vc-make-backup-files t))
             (kill-buffer (current-buffer)))
-        ;; If running interactively, eval declarations and epilogue
-        ;; code, then pop to the buffer visiting the generated file.
-        (eval-region (point) (point-max))
-       ;; Loop over the defvars and eval them explicitly to force
-       ;; them to be evaluated and ready to use.
-        (goto-char (point-min))
-       (while (re-search-forward "(defvar " nil t)
-         (eval-defun nil))
-       ;; Move cursor to a logical spot in the generated code.
-        (goto-char (point-min))
-        (pop-to-buffer (current-buffer))
-        ;; The generated code has been evaluated and updated into
-        ;; memory.  Now find all buffers that match the major modes we
-        ;; have created this language for, and force them to call our
-        ;; setup function again, refreshing all semantic data, and
-        ;; enabling them to work with the new code just created.
-;;;; FIXME?
-        ;; At this point, I don't know any user's defined setup code :-(
-        ;; At least, what I can do for now, is to run the generated
-        ;; parser-install function.
-        (semantic-map-mode-buffers
-         (semantic-grammar-setupfunction)
-         (semantic-grammar-languagemode)))
+
+       (let ((setupfcn (with-current-buffer semantic--grammar-input-buffer
+                         (intern (semantic-grammar-setupfunction))))
+             (mode (with-current-buffer semantic--grammar-input-buffer
+                     (semantic-grammar-languagemode))))
+         ;; If running interactively, eval declarations and epilogue
+         ;; code, then pop to the buffer visiting the generated file.
+         (eval-region (point) (point-max))
+         ;; Move cursor to a logical spot in the generated code.
+         (goto-char (point-min))
+         (pop-to-buffer (current-buffer))
+         ;; The generated code has been evaluated and updated into
+         ;; memory.  Now find all buffers that match the major modes we
+         ;; have created this language for, and force them to call our
+         ;; setup function again, refreshing all semantic data, and
+         ;; enabling them to work with the new code just created.
+
+         ;; At this point, I don't know any user's defined setup code :-(
+         ;; At least, what I can do for now, is to run the generated
+         ;; parser-install function.
+         (semantic-map-mode-buffers
+          (lambda ()
+            (semantic-clear-toplevel-cache)
+            (funcall setupfcn))
+          mode)
+         ))
       )
     ;; Return the name of the generated package file.
     output))
@@ -1201,7 +1204,6 @@ END is the limit of the search."
     (define-key km ":" 'semantic-grammar-electric-punctuation)
 
     (define-key km "\t"       'semantic-grammar-indent)
-    (define-key km "\M-\t"    'semantic-grammar-complete)
     (define-key km "\C-c\C-c" 'semantic-grammar-create-package)
     (define-key km "\C-c\C-m" 'semantic-grammar-find-macro-expander)
     (define-key km "\C-c\C-k" 'semantic-grammar-insert-keyword)
@@ -1214,7 +1216,7 @@ END is the limit of the search."
 (defvar semantic-grammar-menu
   '("Grammar"
     ["Indent Line" semantic-grammar-indent]
-    ["Complete Symbol" semantic-grammar-complete]
+    ["Complete Symbol" completion-at-point]
     ["Find Macro" semantic-grammar-find-macro-expander]
     "--"
     ["Insert %keyword" semantic-grammar-insert-keyword]
@@ -1322,7 +1324,7 @@ the change bounds to encompass the whole nonterminal tag."
   (semantic-grammar-wy--install-parser)
   (setq semantic-lex-comment-regex ";;"
         semantic-lex-analyzer 'semantic-grammar-lexer
-        semantic-type-relation-separator-character '(":")
+        semantic-type-relation-separator-character '()
         semantic-symbol->name-assoc-list
         '(
           (code         . "Setup Code")
@@ -1490,39 +1492,6 @@ Use the Lisp or grammar indenter depending on point 
location."
   (save-excursion
     (semantic-grammar-indent)))
 
-(defun semantic-grammar-complete ()
-  "Attempt to complete the symbol under point.
-Completion is position sensitive.  If the cursor is in a match section of
-a rule, then nonterminals symbols are scanned.  If the cursor is in a Lisp
-expression then Lisp symbols are completed."
-  (interactive)
-  (if (semantic-grammar-in-lisp-p)
-      ;; We are in lisp code.  Do lisp completion.
-      (let ((completion-at-point-functions
-             (append '(lisp-completion-at-point)
-                     completion-at-point-functions)))
-        (completion-at-point))
-    ;; We are not in lisp code.  Do rule completion.
-    (let* ((nonterms (semantic-find-tags-by-class 'nonterminal 
(current-buffer)))
-           (sym (car (semantic-ctxt-current-symbol)))
-           (ans (try-completion sym nonterms)))
-      (cond ((eq ans t)
-             ;; All done
-             (message "Symbols is already complete"))
-            ((and (stringp ans) (string= ans sym))
-             ;; Max matchable.  Show completions.
-            (with-output-to-temp-buffer "*Completions*"
-              (display-completion-list (all-completions sym nonterms)))
-            )
-            ((stringp ans)
-             ;; Expand the completions
-             (forward-sexp -1)
-             (delete-region (point) (progn (forward-sexp 1) (point)))
-             (insert ans))
-            (t (message "No Completions."))
-            ))
-    ))
-
 (defun semantic-grammar-insert-keyword (name)
   "Insert a new %keyword declaration with NAME.
 Assumes it is typed in with the correct casing."
@@ -1784,7 +1753,7 @@ Only tags of type 'nonterminal will be so marked."
     (if (semantic-grammar-in-lisp-p)
         (with-mode-local emacs-lisp-mode
           (semantic-ctxt-current-class-list))
-      '(nonterminal keyword))))
+      '(nonterminal token keyword))))
 
 (define-mode-local-override semantic-ctxt-current-mode
   semantic-grammar-mode (&optional point)
@@ -1924,14 +1893,15 @@ Optional argument COLOR determines if color is added to 
the text."
       context-return)))
 
 (define-mode-local-override semantic-analyze-possible-completions
-  semantic-grammar-mode (context)
-  "Return a list of possible completions based on CONTEXT."
+  semantic-grammar-mode (context &rest flags)
+  "Return a list of possible completions based on CONTEXT.
+Optional FLAGS are ignored."
   (require 'semantic/analyze/complete)
   (if (semantic-grammar-in-lisp-p)
       (with-mode-local emacs-lisp-mode
        (semantic-analyze-possible-completions context))
     (with-current-buffer (oref context buffer)
-      (let* ((prefix (car (oref context :prefix)))
+      (let* ((prefix (car (reverse (oref context :prefix))))
             (completetext (cond ((semantic-tag-p prefix)
                                  (semantic-tag-name prefix))
                                 ((stringp prefix)