emacs-elpa-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[elpa] master 7167e93 19/79: Pass let and let* tests with recursive colo


From: Jackson Ray Hamilton
Subject: [elpa] master 7167e93 19/79: Pass let and let* tests with recursive colorizer.
Date: Sun, 14 Jun 2015 00:05:22 +0000

branch: master
commit 7167e93410c7bfb58f22d6942ae2fe488e37b603
Author: Jackson Ray Hamilton <address@hidden>
Commit: Jackson Ray Hamilton <address@hidden>

    Pass let and let* tests with recursive colorizer.
---
 context-coloring.el           |  604 +++++++++++------------------------------
 test/context-coloring-test.el |   52 ++--
 2 files changed, 181 insertions(+), 475 deletions(-)

diff --git a/context-coloring.el b/context-coloring.el
index ec8cb4a..674d669 100644
--- a/context-coloring.el
+++ b/context-coloring.el
@@ -276,75 +276,6 @@ generated by `js2-mode'."
 
 ;;; Emacs Lisp colorization
 
-(defsubst context-coloring-make-scope (depth level)
-  (list
-   :depth depth
-   :level level
-   :variables (make-hash-table)))
-
-(defsubst context-coloring-scope-get-level (scope)
-  (plist-get scope :level))
-
-(defsubst context-coloring-scope-add-variable (scope variable)
-  (puthash variable t (plist-get scope :variables)))
-
-(defsubst context-coloring-scope-get-variable (scope variable)
-  (gethash variable (plist-get scope :variables)))
-
-(defsubst context-coloring-get-variable-level (scope-stack variable)
-  (let* (scope
-         level)
-    (while (and scope-stack (not level))
-      (setq scope (car scope-stack))
-      (cond
-       ((context-coloring-scope-get-variable scope variable)
-        (setq level (context-coloring-scope-get-level scope)))
-       (t
-        (setq scope-stack (cdr scope-stack)))))
-    ;; Assume a global variable.
-    (or level 0)))
-
-(defsubst context-coloring-make-backtick (end enabled)
-  (list
-   :end end
-   :enabled enabled))
-
-(defsubst context-coloring-backtick-get-end (backtick)
-  (plist-get backtick :end))
-
-(defsubst context-coloring-backtick-get-enabled (backtick)
-  (plist-get backtick :enabled))
-
-(defsubst context-coloring-backtick-enabled-p (backtick-stack)
-  (context-coloring-backtick-get-enabled (car backtick-stack)))
-
-(defsubst context-coloring-make-let-varlist (depth type)
-  (list
-   :depth depth
-   :type type
-   :vars '()))
-
-(defsubst context-coloring-let-varlist-get-type (let-varlist)
-  (plist-get let-varlist :type))
-
-(defsubst context-coloring-let-varlist-add-var (let-varlist var)
-  (plist-put let-varlist :vars (cons var (plist-get let-varlist :vars))))
-
-(defsubst context-coloring-let-varlist-pop-vars (let-varlist)
-  (let ((type (context-coloring-let-varlist-get-type let-varlist))
-        (vars (plist-get let-varlist :vars)))
-    (cond
-     ;; `let' binds all at once at the end.
-     ((eq type 'let)
-      (prog1
-          vars
-        (plist-put let-varlist :vars '())))
-     ;; `let*' binds incrementally.
-     ((eq type 'let*)
-      (prog1
-          (list (car vars))
-        (plist-put let-varlist :vars (cdr vars)))))))
-
 (defsubst context-coloring-forward-sws ()
   "Move forward through whitespace and comments."
   (while (forward-comment 1)))
@@ -353,7 +284,7 @@ generated by `js2-mode'."
   "Like vanilla `forward-sexp', but just return the position."
   (scan-sexps (point) 1))
 
-(defsubst context-coloring-emacs-lisp-identifier-syntax-p (syntax-code)
+(defsubst context-coloring-elisp-identifier-syntax-p (syntax-code)
   (or (= 2 syntax-code)
       (= 3 syntax-code)))
 
@@ -385,21 +316,21 @@ generated by `js2-mode'."
   (context-coloring-join
    (mapcar 'context-coloring-exact-regexp words) "\\|"))
 
-(defconst context-coloring-emacs-lisp-defun-regexp
+(defconst context-coloring-elisp-defun-regexp
   (context-coloring-exact-or-regexp
    '("defun" "defun*" "defsubst" "defmacro"
      "cl-defun" "cl-defsubst" "cl-defmacro")))
 
-(defconst context-coloring-emacs-lisp-lambda-regexp
+(defconst context-coloring-elisp-lambda-regexp
   (context-coloring-exact-regexp "lambda"))
 
-(defconst context-coloring-emacs-lisp-let-regexp
+(defconst context-coloring-elisp-let-regexp
   (context-coloring-exact-regexp "let"))
 
-(defconst context-coloring-emacs-lisp-let*-regexp
+(defconst context-coloring-elisp-let*-regexp
   (context-coloring-exact-regexp "let*"))
 
-(defconst context-coloring-emacs-lisp-arglist-arg-regexp
+(defconst context-coloring-elisp-arglist-arg-regexp
   "\\`[^&:]")
 
 (defconst context-coloring-ignored-word-regexp
@@ -423,7 +354,7 @@ generated by `js2-mode'."
 (defvar context-coloring-parse-interruptable-p t
   "Set this to nil to force parse to continue until finished.")
 
-(defconst context-coloring-emacs-lisp-iterations-per-pause 1000
+(defconst context-coloring-elisp-iterations-per-pause 1000
   "Pause after this many iterations to check for user input.
 If user input is pending, stop the parse.  This makes for a
 smoother user experience for large files.
@@ -432,6 +363,9 @@ As of this writing, emacs lisp colorization seems to run at 
about
 60,000 iterations per second.  A default value of 1000 should
 provide visually \"instant\" updates at 60 frames per second.")
 
+(defun context-coloring-get-syntax-code ()
+  (syntax-class (syntax-after (point))))
+
 (defvar context-coloring-elisp-scope-stack '())
 
 (defsubst context-coloring-elisp-make-scope (level)
@@ -482,17 +416,125 @@ provide visually \"instant\" updates at 60 frames per 
second.")
      (t
       0))))
 
-(defun context-coloring-elisp-colorize-defun (&optional anonymous-p)
+(defsubst context-coloring-elisp-make-let-varlist (type)
+  (list
+   :type type
+   :vars '()))
+
+(defsubst context-coloring-elisp-let-varlist-get-type (let-varlist)
+  (plist-get let-varlist :type))
+
+(defsubst context-coloring-elisp-let-varlist-get-vars (let-varlist)
+  (plist-get let-varlist :vars))
+
+(defsubst context-coloring-elisp-let-varlist-set-vars (let-varlist vars)
+  (plist-put let-varlist :vars vars))
+
+(defsubst context-coloring-elisp-let-varlist-add-var (let-varlist var)
+  (plist-put let-varlist :vars (cons var (plist-get let-varlist :vars))))
+
+(defsubst context-coloring-elisp-let-varlist-pop-vars (let-varlist)
+  (let* ((type (context-coloring-elisp-let-varlist-get-type let-varlist))
+         (vars (context-coloring-elisp-let-varlist-get-vars let-varlist))
+         (popped (cond
+                  ;; `let' binds all at once at the end.
+                  ((eq type 'let)
+                   (prog1
+                       vars
+                     (context-coloring-elisp-let-varlist-set-vars
+                      let-varlist '())))
+                  ;; `let*' binds incrementally.
+                  ((eq type 'let*)
+                   (prog1
+                       (list (car vars))
+                     (context-coloring-elisp-let-varlist-set-vars
+                      let-varlist (cdr vars)))))))
+    (while popped
+      (context-coloring-elisp-add-variable (car popped))
+      (setq popped (cdr popped)))))
+
+(defun context-coloring-elisp-parse-arg (callback)
+  (let (arg-pos
+        arg-end
+        arg-string)
+    (setq arg-pos (point))
+    (forward-sexp)
+    (setq arg-end (point))
+    (setq arg-string (buffer-substring-no-properties
+                      arg-pos
+                      arg-end))
+    (when (string-match-p
+           context-coloring-elisp-arglist-arg-regexp
+           arg-string)
+      (funcall callback arg-string))))
+
+(defun context-coloring-elisp-parse-let-varlist (type)
+  (let ((let-varlist (context-coloring-elisp-make-let-varlist type))
+        syntax-code)
+    ;; Enter.
+    (forward-char)
+    (while (/= (progn
+                 (setq syntax-code (context-coloring-get-syntax-code))
+                 syntax-code)
+               context-coloring-CLOSE-PARENTHESIS-CODE)
+      (cond
+       ((= syntax-code context-coloring-OPEN-PARENTHESIS-CODE)
+        (forward-char)
+        (context-coloring-forward-sws)
+        (setq syntax-code (context-coloring-get-syntax-code))
+        (when (or (= syntax-code context-coloring-WORD-CODE)
+                  (= syntax-code context-coloring-SYMBOL-CODE))
+          (context-coloring-elisp-parse-arg
+           (lambda (var)
+             (context-coloring-elisp-let-varlist-add-var let-varlist var)))
+          (context-coloring-forward-sws)
+          (setq syntax-code (context-coloring-get-syntax-code))
+          (when (/= syntax-code context-coloring-CLOSE-PARENTHESIS-CODE)
+            (context-coloring-elisp-colorize-sexp)))
+        (context-coloring-forward-sws)
+        ;; Skip past the closing parenthesis.
+        (forward-char))
+       ((or (= syntax-code context-coloring-WORD-CODE)
+            (= syntax-code context-coloring-SYMBOL-CODE))
+        (context-coloring-elisp-parse-arg
+         (lambda (var)
+           (context-coloring-elisp-let-varlist-add-var let-varlist var)))))
+      (when (eq type 'let*)
+        (context-coloring-elisp-let-varlist-pop-vars let-varlist))
+      (context-coloring-forward-sws))
+    (when (eq type 'let)
+      (context-coloring-elisp-let-varlist-pop-vars let-varlist))
+    ;; Exit.
+    (forward-char)))
+
+(defun context-coloring-elisp-parse-arglist ()
+  (let (syntax-code)
+    ;; Enter.
+    (forward-char)
+    (while (/= (progn
+                 (setq syntax-code (context-coloring-get-syntax-code))
+                 syntax-code)
+               context-coloring-CLOSE-PARENTHESIS-CODE)
+      (cond
+       ((or (= syntax-code context-coloring-WORD-CODE)
+            (= syntax-code context-coloring-SYMBOL-CODE))
+        (context-coloring-elisp-parse-arg
+         (lambda (arg)
+           (context-coloring-elisp-add-variable arg))))
+       (t
+        (forward-sexp)))
+      (context-coloring-forward-sws))
+    ;; Exit.
+    (forward-char)))
+
+(defun context-coloring-elisp-colorize-defun (&optional anonymous-p
+                                                        let-type)
   (let ((start (point))
         end
         stop
-        syntax
         syntax-code
         defun-name-pos
-        defun-name-end
-        arg-n-pos
-        arg-n-end
-        arg-n-string)
+        defun-name-end)
     (context-coloring-elisp-push-scope)
     ;; Color the whole sexp.
     (forward-sexp)
@@ -505,12 +547,11 @@ provide visually \"instant\" updates at 60 frames per 
second.")
     ;; Skip past the "defun".
     (skip-syntax-forward "^w_")
     (forward-sexp)
-    (skip-syntax-forward " ")
+    (context-coloring-forward-sws)
     (setq stop nil)
     (unless anonymous-p
       ;; Check for the defun's name.
-      (setq syntax (syntax-after (point)))
-      (setq syntax-code (syntax-class syntax))
+      (setq syntax-code (context-coloring-get-syntax-code))
       (cond
        ((or (= syntax-code context-coloring-WORD-CODE)
             (= syntax-code context-coloring-SYMBOL-CODE))
@@ -519,7 +560,7 @@ provide visually \"instant\" updates at 60 frames per 
second.")
         (forward-sexp)
         (setq defun-name-end (point))
         (context-coloring-colorize-region defun-name-pos defun-name-end 0)
-        (skip-syntax-forward " "))
+        (context-coloring-forward-sws))
        (t
         (setq stop t))))
     (cond
@@ -528,35 +569,14 @@ provide visually \"instant\" updates at 60 frames per 
second.")
       (goto-char start)
       (forward-sexp))
      (t
-      (setq syntax (syntax-after (point)))
-      (setq syntax-code (syntax-class syntax))
+      (setq syntax-code (context-coloring-get-syntax-code))
       (cond
        ((= syntax-code context-coloring-OPEN-PARENTHESIS-CODE)
-        (forward-char)
-        (skip-syntax-forward " ")
-        (while (/= (progn
-                     (setq syntax (syntax-after (point)))
-                     (setq syntax-code (syntax-class syntax))
-                     syntax-code)
-                   context-coloring-CLOSE-PARENTHESIS-CODE)
-          (cond
-           ((or (= syntax-code context-coloring-WORD-CODE)
-                (= syntax-code context-coloring-SYMBOL-CODE))
-            (setq arg-n-pos (point))
-            (forward-sexp)
-            (setq arg-n-end (point))
-            (setq arg-n-string (buffer-substring-no-properties
-                                arg-n-pos
-                                arg-n-end))
-            (when (string-match-p
-                   context-coloring-emacs-lisp-arglist-arg-regexp
-                   arg-n-string)
-              (context-coloring-elisp-add-variable arg-n-string)))
-           (t
-            (forward-sexp)))
-          (skip-syntax-forward " "))
-        ;; Skip the closing arglist paren.
-        (forward-char)
+        (cond
+         (let-type
+          (context-coloring-elisp-parse-let-varlist let-type))
+         (t
+          (context-coloring-elisp-parse-arglist)))
         ;; Colorize the rest of the function.
         (context-coloring-elisp-colorize-region (point) (1- end))
         ;; Exit the defun.
@@ -570,10 +590,15 @@ provide visually \"instant\" updates at 60 frames per 
second.")
 (defun context-coloring-elisp-colorize-lambda ()
   (context-coloring-elisp-colorize-defun t))
 
+(defun context-coloring-elisp-colorize-let ()
+  (context-coloring-elisp-colorize-defun t 'let))
+
+(defun context-coloring-elisp-colorize-let* ()
+  (context-coloring-elisp-colorize-defun t 'let*))
+
 (defun context-coloring-elisp-colorize-parenthesized-sexp ()
   (let ((start (point))
         end
-        syntax
         syntax-code
         child-0-pos
         child-0-end
@@ -582,9 +607,8 @@ provide visually \"instant\" updates at 60 frames per 
second.")
     (setq end (point))
     (goto-char start)
     (forward-char)
-    (skip-syntax-forward " ")
-    (setq syntax (syntax-after (point)))
-    (setq syntax-code (syntax-class syntax))
+    (context-coloring-forward-sws)
+    (setq syntax-code (context-coloring-get-syntax-code))
     ;; Figure out if the sexp is a special form.
     (cond
      ((or (= syntax-code context-coloring-WORD-CODE)
@@ -596,12 +620,18 @@ provide visually \"instant\" updates at 60 frames per 
second.")
                             child-0-pos
                             child-0-end))
       (cond
-       ((string-match-p context-coloring-emacs-lisp-defun-regexp 
child-0-string)
+       ((string-match-p context-coloring-elisp-defun-regexp child-0-string)
         (goto-char start)
         (context-coloring-elisp-colorize-defun))
-       ((string-match-p context-coloring-emacs-lisp-lambda-regexp 
child-0-string)
+       ((string-match-p context-coloring-elisp-lambda-regexp child-0-string)
         (goto-char start)
         (context-coloring-elisp-colorize-lambda))
+       ((string-match-p context-coloring-elisp-let-regexp child-0-string)
+        (goto-char start)
+        (context-coloring-elisp-colorize-let))
+       ((string-match-p context-coloring-elisp-let*-regexp child-0-string)
+        (goto-char start)
+        (context-coloring-elisp-colorize-let*))
        ;; Not a special form; just colorize the remaining region.
        (t
         (context-coloring-colorize-region
@@ -632,9 +662,7 @@ provide visually \"instant\" updates at 60 frames per 
second.")
        symbol-pos
        symbol-end
        (context-coloring-elisp-get-variable-level
-        (buffer-substring-no-properties
-         symbol-pos
-         symbol-end)))))))
+        symbol-string))))))
 
 (defun context-coloring-elisp-colorize-expression-prefix ()
   (let (start
@@ -654,14 +682,12 @@ provide visually \"instant\" updates at 60 frames per 
second.")
         (setq char (char-after))
         (when (= char context-coloring-COMMA-CHAR)
           (forward-char)
-          (skip-syntax-forward " ")
+          (context-coloring-forward-sws)
           (context-coloring-elisp-colorize-sexp)))))))
 
 (defun context-coloring-elisp-colorize-sexp ()
-  (let (syntax
-        syntax-code)
-    (setq syntax (syntax-after (point)))
-    (setq syntax-code (syntax-class syntax))
+  (let (syntax-code)
+    (setq syntax-code (context-coloring-get-syntax-code))
     (cond
      ((= syntax-code context-coloring-OPEN-PARENTHESIS-CODE)
       (context-coloring-elisp-colorize-parenthesized-sexp))
@@ -674,13 +700,11 @@ provide visually \"instant\" updates at 60 frames per 
second.")
       (forward-char)))))
 
 (defun context-coloring-elisp-colorize-region (start end)
-  (let (syntax
-        syntax-code)
+  (let (syntax-code)
     (goto-char start)
     (while (> end (progn (skip-syntax-forward "^()w_'" end)
                          (point)))
-      (setq syntax (syntax-after (point)))
-      (setq syntax-code (syntax-class syntax))
+      (setq syntax-code (context-coloring-get-syntax-code))
       (cond
        ((or (= syntax-code context-coloring-OPEN-PARENTHESIS-CODE)
             (= syntax-code context-coloring-WORD-CODE)
@@ -711,324 +735,6 @@ provide visually \"instant\" updates at 60 frames per 
second.")
 
 (defalias 'ccecb 'context-coloring-elisp-colorize-buffer)
 
-;; TODO: Add cases for special forms like `cond'.
-;; TODO: Backticks only go one level deep.
-;; TODO: Refactor this function into smaller, focused ones so we can parse
-;; recursively and easily.
-(defun context-coloring-emacs-lisp-colorize ()
-  "Color the current buffer by parsing emacs lisp sexps."
-  (with-silent-modifications
-    (save-excursion
-      ;; TODO: Can probably make this lazy to the nearest defun.
-      (goto-char (point-min))
-      (let* ((inhibit-point-motion-hooks t)
-             (end (point-max))
-             (iteration-count 0)
-             (last-fontified-position (point))
-             beginning-of-current-defun
-             end-of-current-defun
-             (last-ppss-pos (point))
-             (ppss (syntax-ppss))
-             ppss-depth
-             ;; -1 never matches a depth.  This is a minor optimization.
-             (scope-stack `(,(context-coloring-make-scope -1 0)))
-             (backtick-stack '())
-             (let-varlist-stack '())
-             (let-var-stack '())
-             popped-vars
-             one-word-found-p
-             in-defun-p
-             in-lambda-p
-             in-let-p
-             in-let*-p
-             defun-arglist
-             defun-arg
-             let-varlist
-             let-varlist-type
-             variable
-             variable-end
-             variable-string
-             variable-scope-level
-             token-pos
-             token-syntax
-             token-syntax-code
-             token-char
-             child-0-pos
-             child-0-end
-             child-0-syntax
-             child-0-syntax-code
-             child-0-string
-             child-1-pos
-             child-1-end
-             child-1-syntax
-             child-1-syntax-code
-             child-2-end)
-        (while (> end (progn (skip-syntax-forward "^()w_'" end)
-                             (point)))
-          ;; Sparingly-executed tasks.
-          (setq iteration-count (1+ iteration-count))
-          (when (zerop (% iteration-count
-                          context-coloring-emacs-lisp-iterations-per-pause))
-            ;; Fontify until the end of the current defun because doing it in
-            ;; chunks based soley on point could result in partial
-            ;; re-fontifications over the contents of scopes.
-            (save-excursion
-              (end-of-defun)
-              (setq end-of-current-defun (point))
-              (beginning-of-defun)
-              (setq beginning-of-current-defun (point)))
-
-            ;; Fontify in chunks.
-            (context-coloring-maybe-colorize-comments-and-strings
-             last-fontified-position
-             (cond
-              ;; We weren't actually in a defun, so don't color the next one, 
as
-              ;; that could result in `font-lock' properties being added to it.
-              ((> beginning-of-current-defun (point))
-               (point))
-              (t
-               end-of-current-defun)))
-            (setq last-fontified-position (point))
-            (when (and context-coloring-parse-interruptable-p
-                       (input-pending-p))
-              (throw 'interrupted t)))
-
-          (setq token-pos (point))
-          (setq token-syntax (syntax-after token-pos))
-          (setq token-syntax-code (logand #xFFFF (car token-syntax)))
-          (setq token-char (char-after))
-          (setq ppss (parse-partial-sexp last-ppss-pos token-pos nil nil ppss))
-          (setq last-ppss-pos token-pos)
-          (cond
-
-           ;; Resolve an invalid state.
-           ((cond
-             ;; Inside string?
-             ((nth 3 ppss)
-              (skip-syntax-forward "^\"" end)
-              (forward-char)
-              t)
-             ;; Inside comment?
-             ((nth 4 ppss)
-              (skip-syntax-forward "^>" end)
-              t)))
-
-           ;; Need to check early in case there's a comma.
-           ((context-coloring-expression-prefix-p token-syntax-code)
-            (forward-char)
-            (cond
-             ;; Skip top-level symbols.
-             ((not (or backtick-stack
-                       (= token-char context-coloring-BACKTICK-CHAR)))
-              (goto-char (context-coloring-forward-sexp-position)))
-             ;; Push a backtick state.
-             ((or (= token-char context-coloring-BACKTICK-CHAR)
-                  (= token-char context-coloring-COMMA-CHAR))
-              (setq backtick-stack (cons (context-coloring-make-backtick
-                                          
(context-coloring-forward-sexp-position)
-                                          (= token-char 
context-coloring-BACKTICK-CHAR))
-                                         backtick-stack)))))
-
-           ;; Pop a backtick state.
-           ((and backtick-stack
-                 (>= (point) (context-coloring-backtick-get-end (car 
backtick-stack))))
-            (setq backtick-stack (cdr backtick-stack)))
-
-           ;; Restricted by an enabled backtick.
-           ((and backtick-stack
-                 (context-coloring-backtick-enabled-p backtick-stack))
-            (forward-char))
-
-           ((context-coloring-open-parenthesis-p token-syntax-code)
-            (forward-char)
-            ;; Look for function calls.
-            (context-coloring-forward-sws)
-            (setq child-0-pos (point))
-            (setq child-0-syntax (syntax-after child-0-pos))
-            (setq child-0-syntax-code (logand #xFFFF (car child-0-syntax)))
-            (cond
-             ((context-coloring-emacs-lisp-identifier-syntax-p 
child-0-syntax-code)
-              (setq one-word-found-p t)
-              (setq child-0-end (scan-sexps child-0-pos 1))
-              (setq child-0-string (buffer-substring-no-properties child-0-pos 
child-0-end))
-              (cond
-               ;; Parse a var in a `let' varlist.
-               ((and
-                 let-varlist-stack
-                 (context-coloring-at-stack-depth-p
-                  let-varlist-stack
-                  ;; 1- because we're inside the varlist.
-                  (1- (context-coloring-ppss-depth ppss))))
-                (context-coloring-let-varlist-add-var
-                 (car let-varlist-stack)
-                 (intern child-0-string))
-                (setq let-var-stack (cons (context-coloring-ppss-depth ppss)
-                                          let-var-stack)))
-               ((string-match-p context-coloring-emacs-lisp-defun-regexp 
child-0-string)
-                (setq in-defun-p t))
-               ((string-match-p context-coloring-emacs-lisp-lambda-regexp 
child-0-string)
-                (setq in-lambda-p t))
-               ((string-match-p context-coloring-emacs-lisp-let-regexp 
child-0-string)
-                (setq in-let-p t)
-                (setq let-varlist-type 'let))
-               ((string-match-p context-coloring-emacs-lisp-let*-regexp 
child-0-string)
-                (setq in-let*-p t)
-                (setq let-varlist-type 'let*)))))
-            (when (or in-defun-p
-                      in-lambda-p
-                      in-let-p
-                      in-let*-p)
-              (setq scope-stack (cons (context-coloring-make-scope
-                                       (context-coloring-ppss-depth ppss)
-                                       (1+ (context-coloring-scope-get-level
-                                            (car scope-stack))))
-                                      scope-stack)))
-            ;; TODO: Maybe wasteful but doing this conditionally doesn't make
-            ;; much of a difference.
-            (context-coloring-colorize-region token-pos
-                                              (scan-sexps token-pos 1)
-                                              (context-coloring-scope-get-level
-                                               (car scope-stack)))
-            (cond
-             ((or in-defun-p
-                  in-lambda-p)
-              (goto-char child-0-end)
-              (when in-defun-p
-                ;; Look for a function name.
-                (context-coloring-forward-sws)
-                (setq child-1-pos (point))
-                (setq child-1-syntax (syntax-after child-1-pos))
-                (setq child-1-syntax-code (logand #xFFFF (car child-1-syntax)))
-                (cond
-                 ((context-coloring-emacs-lisp-identifier-syntax-p 
child-1-syntax-code)
-                  (setq child-1-end (scan-sexps child-1-pos 1))
-                  ;; Defuns are global, so use level 0.
-                  (context-coloring-colorize-region child-1-pos child-1-end 0)
-                  (goto-char child-1-end))))
-              ;; Look for an arglist.
-              (context-coloring-forward-sws)
-              (when (context-coloring-at-open-parenthesis-p)
-                ;; (Actually it should be `child-1-end' for `lambda'.)
-                (setq child-2-end (context-coloring-forward-sexp-position))
-                (setq defun-arglist (read (buffer-substring-no-properties
-                                           (point)
-                                           child-2-end)))
-                (while defun-arglist
-                  (setq defun-arg (car defun-arglist))
-                  (when (and (symbolp defun-arg)
-                             (string-match-p
-                              context-coloring-emacs-lisp-arglist-arg-regexp
-                              (symbol-name defun-arg)))
-                    (context-coloring-scope-add-variable
-                     (car scope-stack)
-                     defun-arg))
-                  (setq defun-arglist (cdr defun-arglist)))
-                (goto-char child-2-end))
-              ;; Cleanup.
-              (setq in-defun-p nil)
-              (setq in-lambda-p nil))
-             ((or in-let-p
-                  in-let*-p)
-              (goto-char child-0-end)
-              ;; Look for a varlist.
-              (context-coloring-forward-sws)
-              (setq child-1-pos (point))
-              (setq child-1-syntax (syntax-after child-1-pos))
-              (setq child-1-syntax-code (logand #xFFFF (car child-1-syntax)))
-              (when (context-coloring-open-parenthesis-p child-1-syntax-code)
-                ;; Begin parsing the varlist.
-                (forward-char)
-                (setq let-varlist-stack (cons 
(context-coloring-make-let-varlist
-                                               ;; 1+ because we parsed it at a
-                                               ;; higher depth.
-                                               (1+ 
(context-coloring-ppss-depth ppss))
-                                               let-varlist-type)
-                                              let-varlist-stack)))
-              ;; Cleanup.
-              (setq in-let-p nil)
-              (setq in-let*-p nil))
-             (t
-              (goto-char (cond
-                          ;; If there was a word, continue parsing after it.
-                          (one-word-found-p
-                           (1+ child-0-end))
-                          (t
-                           (1+ token-pos))))))
-            ;; Cleanup.
-            (setq one-word-found-p nil))
-
-           ((context-coloring-emacs-lisp-identifier-syntax-p token-syntax-code)
-            (setq variable-end (context-coloring-forward-sexp-position))
-            (setq variable-string (buffer-substring-no-properties
-                                   token-pos
-                                   variable-end))
-            (cond
-             ;; Ignore constants such as numbers, keywords, t, nil.  These 
can't
-             ;; be rebound, so they should be treated like syntax.
-             ((string-match-p context-coloring-ignored-word-regexp 
variable-string))
-             ((keywordp (read variable-string)))
-             (t
-              (setq variable (intern variable-string))
-              (cond
-               ;; Parse a `let' varlist's uninitialized var.
-               ((and
-                 let-varlist-stack
-                 (context-coloring-at-stack-depth-p
-                  let-varlist-stack
-                  ;; 1- because we're inside the varlist.
-                  (1- (context-coloring-ppss-depth ppss))))
-                (setq let-varlist (car let-varlist-stack))
-                (setq let-varlist-type (context-coloring-let-varlist-get-type 
let-varlist))
-                (cond
-                 ;; Defer `let' binding until the end of the varlist.
-                 ((eq let-varlist-type 'let)
-                  (context-coloring-let-varlist-add-var let-varlist variable))
-                 ;; Bind a `let*' right away.
-                 ((eq let-varlist-type 'let*)
-                  (context-coloring-scope-add-variable (car scope-stack) 
variable))))
-               (t
-                (setq variable-scope-level
-                      (context-coloring-get-variable-level scope-stack 
variable))
-                (when (/= variable-scope-level 
(context-coloring-scope-get-level
-                                                (car scope-stack)))
-                  (context-coloring-colorize-region
-                   token-pos
-                   variable-end
-                   variable-scope-level))))))
-            (goto-char variable-end))
-
-           ((context-coloring-close-parenthesis-p token-syntax-code)
-            (forward-char)
-            (setq ppss (parse-partial-sexp last-ppss-pos (point) nil nil ppss))
-            (setq last-ppss-pos (point))
-            (setq ppss-depth (context-coloring-ppss-depth ppss))
-            ;; TODO: Order might matter here but I'm not certain.
-            (when (context-coloring-at-stack-depth-p scope-stack ppss-depth)
-              (setq scope-stack (cdr scope-stack)))
-            (when (and
-                   let-var-stack
-                   (= (car let-var-stack) ppss-depth))
-              (setq let-var-stack (cdr let-var-stack))
-              (when (eq (context-coloring-let-varlist-get-type (car 
let-varlist-stack))
-                        'let*)
-                (setq popped-vars (context-coloring-let-varlist-pop-vars
-                                   (car let-varlist-stack)))))
-            (when (and
-                   let-varlist-stack
-                   (context-coloring-at-stack-depth-p let-varlist-stack 
ppss-depth))
-              (setq popped-vars (context-coloring-let-varlist-pop-vars
-                                 (car let-varlist-stack)))
-              (setq let-varlist-stack (cdr let-varlist-stack)))
-            (while popped-vars
-              (context-coloring-scope-add-variable (car scope-stack) (car 
popped-vars))
-              (setq popped-vars (cdr popped-vars))))
-
-           ))
-        ;; Fontify the last stretch.
-        (context-coloring-maybe-colorize-comments-and-strings
-         last-fontified-position
-         (point))))))
-
 
 ;;; Shell command scopification / colorization
 
diff --git a/test/context-coloring-test.el b/test/context-coloring-test.el
index 061ce28..f1ed4d2 100644
--- a/test/context-coloring-test.el
+++ b/test/context-coloring-test.el
@@ -1125,32 +1125,32 @@ ssssssssssss0"))
 (xxxxx x ()
   (x x 1 11 11 111 11 1 111 (1 1 1)))")))
 
-;; (context-coloring-test-deftest-emacs-lisp let
-;;   (lambda ()
-;;     (context-coloring-test-assert-coloring "
-;; 1111 11
-;;       11 01
-;;       11 00001
-;;       11 2222 22
-;;                22 02
-;;                22 000022
-;;            2222 2 2 2 00002211
-;;   1111 1 1 1 000011")))
-
-;; (context-coloring-test-deftest-emacs-lisp let*
-;;   (lambda ()
-;;     (context-coloring-test-assert-coloring "
-;; 11111 11
-;;        11 11
-;;        11 000011
-;;   1111 1 1 1 0 0 00001
-;;   22222 22
-;;          22 12
-;;          22 00002
-;;          22 02
-;;          22 222
-;;     2222 1 1 2 2 2 000022
-;;   1111 1 1 1 0 0 000011")))
+(context-coloring-test-deftest-emacs-lisp let
+  (lambda ()
+    (context-coloring-test-assert-coloring "
+1111 11
+      11 01
+      11 00001
+      11 2222 22
+               22 02
+               22 000022
+           2222 2 2 2 00002211
+  1111 1 1 1 000011")))
+
+(context-coloring-test-deftest-emacs-lisp let*
+  (lambda ()
+    (context-coloring-test-assert-coloring "
+11111 11
+       11 11
+       11 000011
+  1111 1 1 1 0 0 00001
+  22222 22
+         22 12
+         22 00002
+         22 02
+         22 222
+    2222 1 1 2 2 2 000022
+  1111 1 1 1 0 0 000011")))
 
 ;; (defun context-coloring-test-insert-unread-space ()
 ;;   "Simulate the insertion of a space as if by a user."



reply via email to

[Prev in Thread] Current Thread [Next in Thread]