[Emacs-diffs] emacs/lisp ChangeLog progmodes/pascal.el

[Stefan Monnier]

CVSROOT:        /sources/emacs
Module name:    emacs
Changes by:     Stefan Monnier <monnier>        09/12/02 18:31:30

Modified files:
        lisp           : ChangeLog 
        lisp/progmodes : pascal.el 

Log message:
        Use completion-in-buffer and remove uses of dynamic scoping.
        * progmodes/pascal.el (pascal-str, pascal-all, pascal-pred)
        (pascal-buffer-to-use, pascal-flag): Don't declare.
        (pascal-func-completion, pascal-type-completion, pascal-var-completion)
        (pascal-get-completion-decl, pascal-keyword-completion):
        Add `pascal-str' argument, save-excursion,
        return the found completions, and don't filter with pascal-pred.
        (pascal-completion-cache): New var.
        (pascal-completion): Don't switch buffer any more (it was never
        necessary).  Don't save-excursion any more (it's done by the called
        subroutines).  Use a cache to avoid redundant computations.
        Use complete-with-action rather than pascal-completion-response and
        let it apply the predicate as well.
        (pascal-complete-word): Use completion-in-buffer when
        pascal-toggle-completions is nil.
        (pascal-show-completions): Don't bind pascal-buffer-to-use since it's
        not used any more.
        (pascal-comp-defun): Don't change buffer any more.
        Use complete-with-action rather than pascal-completion-response and
        let it apply the predicate as well.
        (pascal-goto-defun): Change buffer before calling pascal-comp-defun
        when neded.

CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/emacs/lisp/ChangeLog?cvsroot=emacs&r1=1.16799&r2=1.16800
http://cvs.savannah.gnu.org/viewcvs/emacs/lisp/progmodes/pascal.el?cvsroot=emacs&r1=1.59&r2=1.60

Patches:
Index: ChangeLog
===================================================================
RCS file: /sources/emacs/emacs/lisp/ChangeLog,v
retrieving revision 1.16799
retrieving revision 1.16800
diff -u -b -r1.16799 -r1.16800
--- ChangeLog   2 Dec 2009 08:01:02 -0000       1.16799
+++ ChangeLog   2 Dec 2009 18:31:26 -0000       1.16800
@@ -1,3 +1,28 @@
+2009-12-02  Stefan Monnier  <address@hidden>
+
+       Use completion-in-buffer and remove uses of dynamic scoping.
+       * progmodes/pascal.el (pascal-str, pascal-all, pascal-pred)
+       (pascal-buffer-to-use, pascal-flag): Don't declare.
+       (pascal-func-completion, pascal-type-completion, pascal-var-completion)
+       (pascal-get-completion-decl, pascal-keyword-completion):
+       Add `pascal-str' argument, save-excursion,
+       return the found completions, and don't filter with pascal-pred.
+       (pascal-completion-cache): New var.
+       (pascal-completion): Don't switch buffer any more (it was never
+       necessary).  Don't save-excursion any more (it's done by the called
+       subroutines).  Use a cache to avoid redundant computations.
+       Use complete-with-action rather than pascal-completion-response and
+       let it apply the predicate as well.
+       (pascal-complete-word): Use completion-in-buffer when
+       pascal-toggle-completions is nil.
+       (pascal-show-completions): Don't bind pascal-buffer-to-use since it's
+       not used any more.
+       (pascal-comp-defun): Don't change buffer any more.
+       Use complete-with-action rather than pascal-completion-response and
+       let it apply the predicate as well.
+       (pascal-goto-defun): Change buffer before calling pascal-comp-defun
+       when neded.
+
 2009-12-02  Kenichi Handa  <address@hidden>
 
        * language/indian.el: Include ZWJ and ZWNJ in the patterns to

Index: progmodes/pascal.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/progmodes/pascal.el,v
retrieving revision 1.59
retrieving revision 1.60
diff -u -b -r1.59 -r1.60
--- progmodes/pascal.el 21 Aug 2009 14:59:54 -0000      1.59
+++ progmodes/pascal.el 2 Dec 2009 18:31:30 -0000       1.60
@@ -1112,12 +1112,6 @@
 
 ;;;
 ;;; Completion
-;;;
-(defvar pascal-str nil)
-(defvar pascal-all nil)
-(defvar pascal-pred nil)
-(defvar pascal-buffer-to-use nil)
-(defvar pascal-flag nil)
 
 (defun pascal-string-diff (str1 str2)
   "Return index of first letter where STR1 and STR2 differs."
@@ -1135,8 +1129,9 @@
 ;; completions for procedures if argument is `procedure' or both functions and
 ;; procedures otherwise.
 
-(defun pascal-func-completion (type)
+(defun pascal-func-completion (type pascal-str)
   ;; Build regular expression for function/procedure names
+  (save-excursion
   (if (string= pascal-str "")
       (setq pascal-str "[a-zA-Z_]"))
   (let ((pascal-str (concat (cond
@@ -1144,6 +1139,7 @@
                             ((eq type 'function) "\\<\\(function\\)\\s +")
                             (t "\\<\\(function\\|procedure\\)\\s +"))
                            "\\<\\(" pascal-str "[a-zA-Z0-9_.]*\\)\\>"))
+          (pascal-all ())
        match)
 
     (if (not (looking-at "\\<\\(function\\|procedure\\)\\>"))
@@ -1155,16 +1151,17 @@
       (if (re-search-forward pascal-str (pascal-get-end-of-line) t)
          (progn (setq match (buffer-substring (match-beginning 2)
                                               (match-end 2)))
-                (if (or (null pascal-pred)
-                        (funcall pascal-pred match))
-                    (setq pascal-all (cons match pascal-all)))))
-      (goto-char (match-beginning 0)))))
+                   (push match pascal-all)))
+        (goto-char (match-beginning 0)))
+
+      pascal-all)))
 
-(defun pascal-get-completion-decl ()
+(defun pascal-get-completion-decl (pascal-str)
   ;; Macro for searching through current declaration (var, type or const)
   ;; for matches of `str' and adding the occurrence to `all'
   (let ((end (save-excursion (pascal-declaration-end)
                             (point)))
+        (pascal-all ())
        match)
     ;; Traverse lines
     (while (< (point) end)
@@ -1177,16 +1174,17 @@
                      (not (match-end 1)))
            (setq match (buffer-substring (match-beginning 0) (match-end 0)))
            (if (string-match (concat "\\<" pascal-str) match)
-               (if (or (null pascal-pred)
-                       (funcall pascal-pred match))
-                   (setq pascal-all (cons match pascal-all))))))
+                (push match pascal-all))))
       (if (re-search-forward "\\<record\\>" (pascal-get-end-of-line) t)
          (pascal-declaration-end)
-       (forward-line 1)))))
+       (forward-line 1)))
+
+    pascal-all))
 
-(defun pascal-type-completion ()
+(defun pascal-type-completion (pascal-str)
   "Calculate all possible completions for types."
   (let ((start (point))
+        (pascal-all ())
        goon)
     ;; Search for all reachable type declarations
     (while (or (pascal-beg-of-defun)
@@ -1200,11 +1198,17 @@
                  start t)
                 (not (match-end 1)))
            ;; Check current type declaration
-           (pascal-get-completion-decl))))))
+            (setq pascal-all
+                  (nconc (pascal-get-completion-decl pascal-str)
+                         pascal-all)))))
+
+    pascal-all))
 
-(defun pascal-var-completion ()
+(defun pascal-var-completion (prefix)
   "Calculate all possible completions for variables (or constants)."
+  (save-excursion
   (let ((start (point))
+          (pascal-all ())
        goon twice)
     ;; Search for all reachable var declarations
     (while (or (pascal-beg-of-defun)
@@ -1215,28 +1219,35 @@
            () ; Declarations not reachable
          (if (search-forward "(" (pascal-get-end-of-line) t)
              ;; Check parameterlist
-               (pascal-get-completion-decl))
+                ;; FIXME: pascal-get-completion-decl doesn't understand
+                ;; the var declarations in parameter lists :-(
+                (setq pascal-all
+                      (nconc (pascal-get-completion-decl prefix)
+                             pascal-all)))
          (setq twice 2)
          (while (>= (setq twice (1- twice)) 0)
-           (cond ((and (re-search-forward
+              (cond
+               ((and (re-search-forward
                         (concat "\\<\\(var\\|const\\)\\>\\|"
                                 "\\<\\(begin\\|function\\|procedure\\)\\>")
                         start t)
                        (not (match-end 2)))
                   ;; Check var/const declarations
-                  (pascal-get-completion-decl))
+                (setq pascal-all
+                      (nconc (pascal-get-completion-decl prefix)
+                             pascal-all)))
                  ((match-end 2)
-                  (setq twice 0)))))))))
+                (setq twice 0)))))))
+      pascal-all)))
 
 
-(defun pascal-keyword-completion (keyword-list)
+(defun pascal-keyword-completion (keyword-list pascal-str)
   "Give list of all possible completions of keywords in KEYWORD-LIST."
-  (mapcar '(lambda (s)
+  (let ((pascal-all ()))
+    (dolist (s keyword-list)
             (if (string-match (concat "\\<" pascal-str) s)
-                (if (or (null pascal-pred)
-                        (funcall pascal-pred s))
-                    (setq pascal-all (cons s pascal-all)))))
-         keyword-list))
+          (push s pascal-all)))
+    pascal-all))
 
 ;; Function passed to completing-read, try-completion or
 ;; all-completions to get completion on STR. If predicate is non-nil,
@@ -1247,16 +1258,20 @@
 ;; is 'lambda, the function returns t if STR is an exact match, nil
 ;; otherwise.
 
-(defun pascal-completion (pascal-str pascal-pred pascal-flag)
-  (save-excursion
-    (let ((pascal-all nil))
-      ;; Set buffer to use for searching labels. This should be set
-      ;; within functions which use pascal-completions
-      (set-buffer pascal-buffer-to-use)
+(defvar pascal-completion-cache nil)
 
-      ;; Determine what should be completed
+(defun pascal-completion (pascal-str pascal-pred pascal-flag)
+  (let ((all (car pascal-completion-cache)))
+    ;; Check the cache's freshness.
+    (unless (and pascal-completion-cache
+                 (string-prefix-p (nth 1 pascal-completion-cache) pascal-str)
+                 (eq (current-buffer) (nth 2 pascal-completion-cache))
+                 (eq (field-beginning) (nth 3 pascal-completion-cache)))
       (let ((state (car (pascal-calculate-indent))))
-       (cond (;--Within a declaration or parameterlist
+        (setq all
+              ;; Determine what should be completed
+              (cond
+               (              ;--Within a declaration or parameterlist
               (or (eq state 'declaration) (eq state 'paramlist)
                   (and (eq state 'defun)
                        (save-excursion
@@ -1264,9 +1279,10 @@
                                              (pascal-get-beg-of-line) t))))
               (if (or (eq state 'paramlist) (eq state 'defun))
                   (pascal-beg-of-defun))
-              (pascal-type-completion)
-              (pascal-keyword-completion pascal-type-keywords))
-             (;--Starting a new statement
+                (nconc
+                 (pascal-type-completion pascal-str)
+                 (pascal-keyword-completion pascal-type-keywords pascal-str)))
+               (                        ;--Starting a new statement
               (and (not (eq state 'contexp))
                    (save-excursion
                      (skip-chars-backward "a-zA-Z0-9_.")
@@ -1275,51 +1291,22 @@
                          (progn
                            (forward-sexp 1)
                            (looking-at "\\s *\\(;\\|:[^=]\\)")))))
-              (save-excursion (pascal-var-completion))
-              (pascal-func-completion 'procedure)
-              (pascal-keyword-completion pascal-start-keywords))
-             (t;--Anywhere else
-              (save-excursion (pascal-var-completion))
-              (pascal-func-completion 'function)
-              (pascal-keyword-completion pascal-separator-keywords))))
+                (nconc
+                 (pascal-var-completion pascal-str)
+                 (pascal-func-completion 'procedure pascal-str)
+                 (pascal-keyword-completion pascal-start-keywords pascal-str)))
+               (t                       ;--Anywhere else
+                (nconc
+                 (pascal-var-completion pascal-str)
+                 (pascal-func-completion 'function pascal-str)
+                 (pascal-keyword-completion pascal-separator-keywords
+                                            pascal-str)))))
 
-      ;; Now we have built a list of all matches. Give response to caller
-      (pascal-completion-response))))
+        (setq pascal-completion-cache
+              (list all pascal-str (current-buffer) (field-beginning)))))
 
-(defun pascal-completion-response ()
-  (cond ((or (equal pascal-flag 'lambda) (null pascal-flag))
-        ;; This was not called by all-completions
-        (if (null pascal-all)
-            ;; Return nil if there was no matching label
-            nil
-          ;; Get longest string common in the labels
-          (let* ((elm (cdr pascal-all))
-                 (match (car pascal-all))
-                 (min (length match))
-                 tmp)
-            (if (string= match pascal-str)
-                ;; Return t if first match was an exact match
-                (setq match t)
-              (while (not (null elm))
-                ;; Find longest common string
-                (if (< (setq tmp (pascal-string-diff match (car elm))) min)
-                    (progn
-                      (setq min tmp)
-                      (setq match (substring match 0 min))))
-                ;; Terminate with match=t if this is an exact match
-                (if (string= (car elm) pascal-str)
-                    (progn
-                      (setq match t)
-                      (setq elm nil))
-                  (setq elm (cdr elm)))))
-            ;; If this is a test just for exact match, return nil ot t
-            (if (and (equal pascal-flag 'lambda) (not (equal match 't)))
-                nil
-              match))))
-       ;; If flag is t, this was called by all-completions. Return
-       ;; list of all possible completions
-       (pascal-flag
-        pascal-all)))
+    ;; Now we have built a list of all matches. Give response to caller
+    (complete-with-action pascal-flag all pascal-str pascal-pred)))
 
 (defvar pascal-last-word-numb 0)
 (defvar pascal-last-word-shown nil)
@@ -1331,24 +1318,15 @@
 `pascal-start-keywords' and `pascal-separator-keywords'.)"
   (interactive)
   (let* ((b (save-excursion (skip-chars-backward "a-zA-Z0-9_") (point)))
-        (e (save-excursion (skip-chars-forward "a-zA-Z0-9_") (point)))
-        (pascal-str (buffer-substring b e))
-        ;; The following variable is used in pascal-completion
-        (pascal-buffer-to-use (current-buffer))
-        (allcomp (if (and pascal-toggle-completions
-                          (string= pascal-last-word-shown pascal-str))
-                     pascal-last-completions
-                   (all-completions pascal-str 'pascal-completion)))
-        (match (if pascal-toggle-completions
-                   "" (try-completion
-                       pascal-str (mapcar '(lambda (elm)
-                                             (cons elm 0)) allcomp)))))
-    ;; Delete old string
-    (delete-region b e)
+        (e (save-excursion (skip-chars-forward "a-zA-Z0-9_") (point))))
 
     ;; Toggle-completions inserts whole labels
     (if pascal-toggle-completions
-       (progn
+       (let* ((pascal-str (buffer-substring b e))
+               (allcomp (if (and pascal-toggle-completions
+                                 (string= pascal-last-word-shown pascal-str))
+                            pascal-last-completions
+                          (all-completions pascal-str 'pascal-completion))))
          ;; Update entry number in list
          (setq pascal-last-completions allcomp
                pascal-last-word-numb
@@ -1357,32 +1335,14 @@
                  (1+ pascal-last-word-numb)))
          (setq pascal-last-word-shown (elt allcomp pascal-last-word-numb))
          ;; Display next match or same string if no match was found
-         (if (not (null allcomp))
-             (insert "" pascal-last-word-shown)
-           (insert "" pascal-str)
+         (if allcomp
+              (progn
+                (goto-char e)
+                (insert-before-markers pascal-last-word-shown)
+                (delete-region b e))
            (message "(No match)")))
       ;; The other form of completion does not necessarily do that.
-
-      ;; Insert match if found, or the original string if no match
-      (if (or (null match) (equal match 't))
-         (progn (insert "" pascal-str)
-                (message "(No match)"))
-       (insert "" match))
-      ;; Give message about current status of completion
-      (cond ((equal match 't)
-            (if (not (null (cdr allcomp)))
-                (message "(Complete but not unique)")
-              (message "(Sole completion)")))
-           ;; Display buffer if the current completion didn't help
-           ;; on completing the label.
-           ((and (not (null (cdr allcomp))) (= (length pascal-str)
-                                               (length match)))
-            (with-output-to-temp-buffer "*Completions*"
-              (display-completion-list allcomp pascal-str))
-            ;; Wait for a keypress. Then delete *Completion*  window
-            (momentary-string-display "" (point))
-            (delete-window (get-buffer-window (get-buffer "*Completions*")))
-            )))))
+      (completion-in-region b e 'pascal-completion))))
 
 (defun pascal-show-completions ()
   "Show all possible completions at current point."
@@ -1390,8 +1350,6 @@
   (let* ((b (save-excursion (skip-chars-backward "a-zA-Z0-9_") (point)))
         (e (save-excursion (skip-chars-forward "a-zA-Z0-9_") (point)))
         (pascal-str (buffer-substring b e))
-        ;; The following variable is used in pascal-completion
-        (pascal-buffer-to-use (current-buffer))
         (allcomp (if (and pascal-toggle-completions
                           (string= pascal-last-word-shown pascal-str))
                      pascal-last-completions
@@ -1433,46 +1391,40 @@
 
 (defun pascal-comp-defun (pascal-str pascal-pred pascal-flag)
   (save-excursion
-    (let ((pascal-all nil)
-         match)
-
-      ;; Set buffer to use for searching labels. This should be set
-      ;; within functions which use pascal-completions
-      (set-buffer pascal-buffer-to-use)
+    (let ((pascal-all nil))
 
-      (let ((pascal-str pascal-str))
        ;; Build regular expression for functions
-       (if (string= pascal-str "")
-           (setq pascal-str (pascal-build-defun-re "[a-zA-Z_]"))
-         (setq pascal-str (pascal-build-defun-re pascal-str)))
+      (let ((pascal-str (pascal-build-defun-re (if (string= pascal-str "")
+                                                   "[a-zA-Z_]"
+                                                 pascal-str))))
        (goto-char (point-min))
 
        ;; Build a list of all possible completions
        (while (re-search-forward pascal-str nil t)
-         (setq match (buffer-substring (match-beginning 2) (match-end 2)))
-         (if (or (null pascal-pred)
-                 (funcall pascal-pred match))
-             (setq pascal-all (cons match pascal-all)))))
+          (push (match-string 2) pascal-all)))
 
       ;; Now we have built a list of all matches. Give response to caller
-      (pascal-completion-response))))
+      (complete-with-action pascal-flag pascal-all pascal-str pascal-pred))))
 
 (defun pascal-goto-defun ()
   "Move to specified Pascal function/procedure.
 The default is a name found in the buffer around point."
   (interactive)
   (let* ((default (pascal-get-default-symbol))
-        ;; The following variable is used in pascal-comp-function
-        (pascal-buffer-to-use (current-buffer))
         (default (if (pascal-comp-defun default nil 'lambda)
                      default ""))
-        (label (if (not (string= default ""))
+        (label 
                    ;; Do completion with default
-                   (completing-read (concat "Label (default " default "): ")
-                                    'pascal-comp-defun nil t "")
-                 ;; There is no default value. Complete without it
-                 (completing-read "Label: "
-                                  'pascal-comp-defun nil t ""))))
+          (completing-read (if (not (string= default ""))
+                               (concat "Label (default " default "): ")
+                             "Label: ")
+                           ;; Complete with the defuns found in the
+                           ;; current-buffer.
+                           (lexical-let ((buf (current-buffer)))
+                             (lambda (s p a)
+                               (with-current-buffer buf
+                                 (pascal-comp-defun s p a))))
+                           nil t "")))
     ;; If there was no response on prompt, use default value
     (if (string= label "")
        (setq label default))