[elpa] master fd4bc95 66/79: Add dolist support.

[Jackson Ray Hamilton]

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

    Add dolist support.
---
 context-coloring.el           |   66 +++++++++++++++++++++++++++++++++++++++++
 test/context-coloring-test.el |    7 ++++
 test/fixtures/dolist.el       |    3 ++
 3 files changed, 76 insertions(+), 0 deletions(-)

diff --git a/context-coloring.el b/context-coloring.el
index d89f844..c6a00ff 100644
--- a/context-coloring.el
+++ b/context-coloring.el
@@ -402,6 +402,10 @@ the way."
    '("condition-case"
      "condition-case-unless-debug")))
 
+(defconst context-coloring-elisp-dolist-regexp
+  (context-coloring-exact-or-regexp
+   '("dolist" "dotimes")))
+
 (defconst context-coloring-elisp-ignored-word-regexp
   (context-coloring-join (list "\\`[-+]?[0-9]"
                                "\\`[&:].+"
@@ -761,6 +765,64 @@ LET-TYPE can be one of `let' or `let*'."
     (forward-char)
     (context-coloring-elisp-pop-scope)))
 
+(defun context-coloring-elisp-colorize-scope (callback)
+  "Color the whole scope at point with its one color.  Handle a
+header in CALLBACK."
+  (let ((start (point))
+        (end (progn (forward-sexp)
+                    (point))))
+    (context-coloring-elisp-push-scope)
+    ;; Splash the whole thing in one color.
+    (context-coloring-colorize-region
+     start
+     end
+     (context-coloring-elisp-get-current-scope-level))
+    ;; Even if the parse is interrupted, this region should still be colored
+    ;; syntactically.
+    (context-coloring-elisp-colorize-comments-and-strings-in-region
+     start
+     end)
+    (goto-char start)
+    ;; Enter.
+    (forward-char)
+    (context-coloring-elisp-forward-sws)
+    ;; Skip past the function name.
+    (forward-sexp)
+    (context-coloring-elisp-forward-sws)
+    (funcall callback)
+    (context-coloring-elisp-colorize-region (point) (1- end))
+    ;; Exit.
+    (forward-char)
+    (context-coloring-elisp-pop-scope)))
+
+(defun context-coloring-elisp-colorize-dolist ()
+  "Color the `dolist' at point."
+  (let (syntax-code
+        (index 0))
+    (context-coloring-elisp-colorize-scope
+     (lambda ()
+       (setq syntax-code (context-coloring-get-syntax-code))
+       (when (= syntax-code context-coloring-OPEN-PARENTHESIS-CODE)
+         (forward-char)
+         (context-coloring-elisp-forward-sws)
+         (while (/= (setq syntax-code (context-coloring-get-syntax-code))
+                    context-coloring-CLOSE-PARENTHESIS-CODE)
+           (cond
+            ((and
+              (or (= index 0) (= index 2))
+              (context-coloring-elisp-identifier-p syntax-code))
+             ;; Add the first or third name to the scope.
+             (context-coloring-elisp-parse-bindable
+              (lambda (variable)
+                (context-coloring-elisp-add-variable variable))))
+            (t
+             ;; Color artifacts.
+             (context-coloring-elisp-colorize-sexp)))
+           (context-coloring-elisp-forward-sws)
+           (setq index (1+ index)))
+         ;; Exit.
+         (forward-char))))))
+
 (defun context-coloring-elisp-colorize-parenthesized-sexp ()
   "Color the sexp enclosed by parenthesis at point."
   (context-coloring-elisp-increment-sexp-count)
@@ -805,6 +867,10 @@ LET-TYPE can be one of `let' or `let*'."
             (goto-char start)
             (context-coloring-elisp-colorize-condition-case)
             t)
+           ((string-match-p context-coloring-elisp-dolist-regexp name-string)
+            (goto-char start)
+            (context-coloring-elisp-colorize-dolist)
+            t)
            (t
             nil)))))
      ;; Not a special form; just colorize the remaining region.
diff --git a/test/context-coloring-test.el b/test/context-coloring-test.el
index 95a081d..4393c74 100644
--- a/test/context-coloring-test.el
+++ b/test/context-coloring-test.el
@@ -1190,6 +1190,13 @@ ssssssssssss0"))
   (11111 (xxx () 222))
   sss)")))
 
+(context-coloring-test-deftest-emacs-lisp dolist
+  (lambda ()
+    (context-coloring-test-assert-coloring "
+1111111 111111
+  2222222 2222 1111 2222222
+    3333333 33 33 222 1111 2222223321")))
+
 (defun context-coloring-test-insert-unread-space ()
   "Simulate the insertion of a space as if by a user."
   (setq unread-command-events (cons '(t . 32)
diff --git a/test/fixtures/dolist.el b/test/fixtures/dolist.el
new file mode 100644
index 0000000..f103670
--- /dev/null
+++ b/test/fixtures/dolist.el
@@ -0,0 +1,3 @@
+(lambda (list)
+  (dolist (var list result)
+    (lambda () (+ var list result))))