[nongnu] elpa/macrostep 3757ec4 033/110: Extend macrostep-environment while printing macrolet body forms

[ELPA Syncer]

branch: elpa/macrostep
commit 3757ec49975e2d6ffbe05ed59a811edb9ab22394
Author: joddie <jonxfield@gmail.com>
Commit: joddie <jonxfield@gmail.com>

    Extend macrostep-environment while printing macrolet body forms
    
    This correctly handles macros like the following:
    
    (defmacro with-local-do-something (&rest forms)
      (declare (indent 0))
      `(cl-macrolet ((do-something (arg) ...))
         ,@forms))
    
    When the following form is expanded, `(do-something ...)` should be 
correctly
    highlighted as a macro form:
    
    (with-local-do-something
      (do-something (here)))
    
    See `with-js` in `js.el.gz` for a real example.
---
 macrostep-test.el | 57 ++++++++++++++++++++++++++++++++++++++
 macrostep.el      | 82 +++++++++++++++++++++++++++++++++++--------------------
 2 files changed, 110 insertions(+), 29 deletions(-)

diff --git a/macrostep-test.el b/macrostep-test.el
index 7fda05e..3363c9b 100644
--- a/macrostep-test.el
+++ b/macrostep-test.el
@@ -161,7 +161,64 @@
         (apply (cdr (assq 'get env)) '(:begin))
         '(plist-get list :begin))))))
 
+(ert-deftest macrostep-print-sexp ()
+  (cl-macrolet ((should-print (form string)
+                  `(should (equal
+                            (with-temp-buffer
+                              (macrostep-print-sexp ,form)
+                              (buffer-string))
+                            ,string))))
+    (should-print 'symbol "symbol")
+    (should-print '(single-element-list) "(single-element-list)")
+    (should-print '(two-element list) "(two-element list)")
+    (should-print '(three element list) "(three element list)")
+    (should-print '(dotted . list) "(dotted . list)")
+    (should-print '(four element dotted . list) "(four element dotted . list)")
+    (should-print '(nested (list (elements))) "(nested (list (elements)))")
+    (should-print '((deeply (nested)) (list (elements)))
+                  "((deeply (nested)) (list (elements)))")
+    (should-print '(quote fishes) "'fishes")
+    (should-print '`(backquoted form) "`(backquoted form)")
+    (should-print '`(backquoted (form) ,with ,@splices)
+                  "`(backquoted (form) ,with ,@splices)")))
+
+(ert-deftest macrostep-print-sexp-macrolet-environment ()
+  (with-temp-buffer
+    (emacs-lisp-mode)
+    (save-excursion
+      (macrostep-print-sexp
+       '(macrolet ((some-macro (&rest forms) (cons 'progn forms)))
+         (some-macro with (arguments))
+         (intervening body forms)
+         (some-macro with (more) (arguments))))
+      (cl-flet ((search (text)
+                  (goto-char (point-min))
+                  (search-forward text)
+                  (goto-char (match-beginning 0))
+                  ;; Leave point on the head of the form
+                  (forward-char)))
+        ;; The occurrence of "(some-macro" in the binding list should
+        ;; not be fontified as a macro form
+        (search "(some-macro (&rest")
+        (should-not
+         (eq (get-char-property (point) 'font-lock-face)
+             'macrostep-macro-face))
+
+        ;; However, the two occurrences in the body of the macrolet should be.
+        (search "(some-macro with (arguments)")
+        (should
+         (eq (get-char-property (point) 'font-lock-face)
+             'macrostep-macro-face))
+
+        (search "(some-macro with (more)")
+        (should
+         (eq (get-char-property (point) 'font-lock-face)
+             'macrostep-macro-face))))))
+
+
 (when noninteractive
   (load-file (expand-file-name "macrostep.el"
                                (file-name-directory load-file-name)))
   (ert-run-tests-batch "^macrostep"))
+
+
diff --git a/macrostep.el b/macrostep.el
index b920402..c5a3621 100644
--- a/macrostep.el
+++ b/macrostep.el
@@ -709,36 +709,60 @@ expansion will not be fontified.  See also
             (macrostep-print-sexp (cadr sexp)))
 
            (t                          ; other list form
-             ;; Is it an (unquoted) macro form?
-            (if (and (not quoted-form-p)
-                      (macrostep-macro-form-p sexp))
-                 (progn
-                   ;; Save the real expansion as a text property on the
-                   ;; opening paren
-                   (macrostep-propertize
-                       (insert "(")
-                     'macrostep-expanded-text sexp)
-                   ;; Fontify the head of the macro
-                   (macrostep-propertize
-                       (prin1 head (current-buffer))
-                     'font-lock-face 'macrostep-macro-face)
-                   (when (cdr sexp) (insert " "))
-                   (setq sexp (cdr sexp)))
-               ;; Not a macro form
-               (insert "("))
-
-            ;; Print remaining list elements
-             (while sexp
-               (if (listp sexp)
+             ;; If the sexp is a (cl-)macrolet form, the
+             ;; macro-expansion environment should be extended using
+             ;; its bindings while printing the body forms in order to
+             ;; correctly mark any uses of locally-bound macros. (See
+             ;; `with-js' in `js.el.gz' for an example of a macro that
+             ;; works this way).
+             (let ((extended-environment
+                    (pcase sexp
+                      (`(,(or `cl-macrolet `macrolet) ,bindings . ,_)
+                        (append (macrostep-bindings-to-environment bindings)
+                                macrostep-environment))
+                      (_ macrostep-environment))))
+               
+               ;; Is it an (unquoted) macro form?
+               (if (and (not quoted-form-p)
+                        (macrostep-macro-form-p sexp))
                    (progn
-                     (macrostep-print-sexp (car sexp) quoted-form-p)
-                     (when (cdr sexp) (insert " "))
-                     (setq sexp (cdr sexp)))
-                 ;; Print tail of dotted list
-                 (insert ". ")
-                 (macrostep-print-sexp sexp)
-                 (setq sexp nil)))
-            (insert ")")))))
+                     ;; Save the real expansion as a text property on the
+                     ;; opening paren
+                     (macrostep-propertize
+                         (insert "(")
+                       'macrostep-expanded-text sexp)
+                     ;; Fontify the head of the macro
+                     (macrostep-propertize
+                         (prin1 head (current-buffer))
+                       'font-lock-face 'macrostep-macro-face))
+                 ;; Not a macro form
+                 (insert "(")
+                 (prin1 head (current-buffer)))
+
+               ;; Print remaining list elements
+               (setq sexp (cdr sexp))
+               (when sexp (insert " "))
+               ;; macrostep-environment will be setq'd after printing
+               ;; the second element of the list (i.e., the binding
+               ;; list in a macrolet form)
+               (let ((macrostep-environment macrostep-environment))
+                 (while sexp
+                   (if (listp sexp)
+                       (progn
+                         (macrostep-print-sexp (car sexp) quoted-form-p)
+                         (when (cdr sexp) (insert " "))
+                         (setq sexp (cdr sexp))
+                         ;; At this point the first and second
+                         ;; elements of the list have been printed, so
+                         ;; it is time to extend the macro-expansion
+                         ;; environment inside a macrolet for the body
+                         ;; forms.
+                         (setq macrostep-environment extended-environment))
+                     ;; Print tail of dotted list
+                     (insert ". ")
+                     (macrostep-print-sexp sexp)
+                     (setq sexp nil))))
+               (insert ")"))))))
 
    ;; Print everything except symbols and lists as normal
    (t (prin1 sexp (current-buffer)))))