[elpa] master 8919acd 05/47: Add lambda coloring.

[Jackson Ray Hamilton]

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

    Add lambda coloring.
---
 context-coloring.el           |   76 ++++++++++++++++++++++-------------------
 test/context-coloring-test.el |   11 ++++++
 test/fixtures/lambda.el       |    3 ++
 3 files changed, 55 insertions(+), 35 deletions(-)

diff --git a/context-coloring.el b/context-coloring.el
index 6954b10..5f443dd 100644
--- a/context-coloring.el
+++ b/context-coloring.el
@@ -344,6 +344,7 @@ generated by `js2-mode'."
              (scope-stack `(,(context-coloring-make-scope -1 0))) ; -1 never 
matches a depth
              one-word-found-p
              in-defun-p
+             in-lambda-p
              function-call-p
              defun-arglist
              defun-arg
@@ -390,15 +391,18 @@ generated by `js2-mode'."
               (setq child-0-string (buffer-substring-no-properties child-0-pos 
child-0-end))
               (cond
                ((string-match-p "defun\\|defmacro" child-0-string)
-                (setq in-defun-p t)
-                (setq scope-stack (cons (context-coloring-make-scope
-                                         (nth 0 ppss)
-                                         (1+ (context-coloring-scope-get-level
-                                              (car scope-stack))))
-                                        scope-stack)))
+                (setq in-defun-p t))
+               ((string-match-p "lambda" child-0-string)
+                (setq in-lambda-p t))
                ;; Assume a global function call
                (t
                 (setq function-call-p t)))))
+            (when (or in-defun-p in-lambda-p)
+              (setq scope-stack (cons (context-coloring-make-scope
+                                       (nth 0 ppss)
+                                       (1+ (context-coloring-scope-get-level
+                                            (car scope-stack))))
+                                      scope-stack)))
             ;; TODO: Probably redundant and wasteful
             (context-coloring-colorize-region token-pos
                                               (scan-sexps token-pos 1)
@@ -408,38 +412,40 @@ generated by `js2-mode'."
               (context-coloring-colorize-region child-0-pos child-0-end 0)
               (setq function-call-p nil))
             (cond
-             (in-defun-p
+             ((or in-defun-p in-lambda-p)
               (goto-char child-0-end)
-              ;; Lookahead for defun name
-              (skip-syntax-forward " " end)
-              (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
-               ;; Word
-               ((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)
-                ;; Lookahead for parameters
+              (when in-defun-p
+                ;; Lookahead for defun name
                 (skip-syntax-forward " " end)
-                (when (= 4 (logand #xFFFF (car (syntax-after (point)))))
-                  (setq child-2-end (scan-sexps (point) 1))
-                  (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 "\\`[^&:]" (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))))
+                (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
+                 ;; Word
+                 ((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))))
+              ;; Lookahead for parameters
+              (skip-syntax-forward " " end)
+              (when (= 4 (logand #xFFFF (car (syntax-after (point)))))
+                (setq child-2-end (scan-sexps (point) 1))
+                (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 "\\`[^&:]" (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-defun-p nil)
+              (setq in-lambda-p nil))
              (t
               (goto-char (cond
                           ;; If there was a word, continue parsing after it.
diff --git a/test/context-coloring-test.el b/test/context-coloring-test.el
index 393b4c7..1c2147a 100644
--- a/test/context-coloring-test.el
+++ b/test/context-coloring-test.el
@@ -1021,6 +1021,17 @@ see that function."
   (context-coloring-test-assert-region-level 82 83 1)  ; )
   (context-coloring-test-assert-region-level 84 94 1)) ; (defun ())
 
+(context-coloring-test-deftest-emacs-lisp-mode lambda
+  (context-coloring-test-assert-region-level 1 10 0)     ; (funcall
+  (context-coloring-test-assert-region-level 10 35 1)    ; (lambda (fn) (
+  (context-coloring-test-assert-region-level 35 42 0)    ; funcall
+  (context-coloring-test-assert-region-level 42 46 1)    ; fn
+  (context-coloring-test-assert-region-level 46 85 2)    ; (lambda (fn) (
+  (context-coloring-test-assert-region-level 85 87 0)    ; fn
+  (context-coloring-test-assert-region-level 87 98 2)    ; fn fn) fn)
+  (context-coloring-test-assert-region-level 98 103 1)   ; ) fn)
+  (context-coloring-test-assert-region-level 103 106 0)) ; 0)
+
 (provide 'context-coloring-test)
 
 ;;; context-coloring-test.el ends here
diff --git a/test/fixtures/lambda.el b/test/fixtures/lambda.el
new file mode 100644
index 0000000..f844ff0
--- /dev/null
+++ b/test/fixtures/lambda.el
@@ -0,0 +1,3 @@
+(funcall (lambda (fn)
+           (funcall fn (lambda (fn)
+                         (fn fn fn) fn)) fn) 0)