[nongnu] elpa/macrostep e3e5c12 034/110: Merge branch 'expand-macrolet'

[ELPA Syncer]

branch: elpa/macrostep
commit e3e5c12606520cf243ba90625142581fda8762c5
Merge: f026495 3757ec4
Author: joddie <jonxfield@gmail.com>
Commit: joddie <jonxfield@gmail.com>

    Merge branch 'expand-macrolet'
    
    Closes #7.
---
 Makefile          |   4 +
 macrostep-test.el | 224 ++++++++++++++++++++++++++++++++++++++++++++++++++++++
 macrostep.el      | 180 +++++++++++++++++++++++++++++++------------
 3 files changed, 359 insertions(+), 49 deletions(-)

diff --git a/Makefile b/Makefile
new file mode 100644
index 0000000..0540b44
--- /dev/null
+++ b/Makefile
@@ -0,0 +1,4 @@
+test:
+       emacs --batch --load macrostep-test.el
+
+.PHONY: test
diff --git a/macrostep-test.el b/macrostep-test.el
new file mode 100644
index 0000000..3363c9b
--- /dev/null
+++ b/macrostep-test.el
@@ -0,0 +1,224 @@
+;;; macrostep-test.el --- tests for macrostep.el
+
+;; Copyright (C) 2014 Jon Oddie <j.j.oddie@gmail.com>
+
+;; This file is NOT part of GNU Emacs.
+
+;; This program is free software: you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation, either version 3 of the
+;; License, or (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see `http://www.gnu.org/licenses/'.
+
+
+(defmacro macrostep-with-text (object &rest forms)
+  (declare (indent 1))
+  `(with-temp-buffer
+     (emacs-lisp-mode)
+     (let ((print-level nil)
+           (print-length nil)
+           (standard-output (current-buffer)))
+       (save-excursion
+         (print ,object))
+       ,@forms)))
+
+(defmacro macrostep-should-expand (form expansion)
+  `(save-excursion
+     (goto-char (point-min))
+     (let ((print-level nil)
+           (print-length nil))
+       (search-forward (prin1-to-string ,form))
+       (goto-char (match-beginning 0))
+       (unwind-protect
+            (progn
+              (macrostep-expand)
+              (should
+               (equal (read (current-buffer))
+                      ,expansion)))
+         (macrostep-collapse-all)))))
+
+(ert-deftest macrostep-expand-defmacro ()
+  (defmacro macrostep-dummy-macro (&rest args)
+    `(expansion of ,@args))
+  (macrostep-with-text
+   '(progn
+     (first body form)
+     (second body form)
+     (macrostep-dummy-macro (first (argument)) second (third argument))
+     (remaining body forms))
+   (macrostep-should-expand
+    '(macrostep-dummy-macro (first (argument)) second (third argument))
+    '(expansion of (first (argument)) second (third argument)))))
+
+(ert-deftest macrostep-expand-macrolet ()
+  (macrostep-with-text
+      '(macrolet
+        ((test (&rest args) `(expansion of ,@args)))
+        (first body form)
+        (second body form)
+        (test (strawberry pie) and (apple pie))
+        (final body form))
+    (macrostep-should-expand
+     '(test (strawberry pie) and (apple pie))
+     '(expansion of (strawberry pie) and (apple pie)))))
+
+(ert-deftest macrostep-expand-macrolet-2 ()
+  (macrostep-with-text
+      ;; Taken from org-notify.el.
+      '(macrolet ((get (k) `(plist-get list ,k))
+                  (pr (k v) `(setq result (plist-put result ,k ,v))))
+        (let* ((list (nth 1 heading))      (notify (or (get :notify) 
"default"))
+               (deadline (org-notify-convert-deadline (get :deadline)))
+               (heading (get :raw-value))
+               result)
+          (when (and (eq (get :todo-type) 'todo) heading deadline)
+            (pr :heading heading)     (pr :notify (intern notify))
+            (pr :begin (get :begin))
+            (pr :file (nth org-notify-parse-file (org-agenda-files 
'unrestricted)))
+            (pr :timestamp deadline)  (pr :uid (md5 (concat heading deadline)))
+            (pr :deadline (- (org-time-string-to-seconds deadline)
+                             (org-float-time))))
+          result))
+    (macrostep-should-expand
+     '(pr :heading heading)
+     '(setq result (plist-put result :heading heading)))
+    (macrostep-should-expand
+     '(pr :notify (intern notify))
+     '(setq result (plist-put result :notify (intern notify))))
+    (macrostep-should-expand
+     '(pr :begin (get :begin))
+     '(setq result (plist-put result :begin (get :begin))))
+    (macrostep-should-expand
+     '(get :begin)
+     '(plist-get list :begin))))
+
+(ert-deftest macrostep-expand-cl-macrolet ()
+  (macrostep-with-text
+      ;; Taken from slime.el.
+      '(cl-macrolet ((fontify (face string)
+                      `(slime-inspector-fontify ,face ,string)))
+        (slime-propertize-region
+         (list 'slime-part-number id
+          'mouse-face 'highlight
+          'face 'slime-inspector-value-face)
+         (insert title))
+        (while (eq (char-before) ?\n)
+          (backward-delete-char 1))
+        (insert "\n" (fontify label "--------------------") "\n")
+        (save-excursion
+          (slime-inspector-insert-content content))
+        (when point
+          (cl-check-type point cons)
+          (ignore-errors
+            (goto-char (point-min))
+            (forward-line (1- (car point)))
+            (move-to-column (cdr point)))))
+    (macrostep-should-expand
+     '(fontify label "--------------------")
+     '(slime-inspector-fontify label "--------------------"))))
+
+(ert-deftest macrostep-expand-shadowed-macrolet ()
+  (macrostep-with-text
+      '(macrolet
+        ((test-macro (&rest forms) (cons 'shadowed forms))
+         (test-macro (&rest forms) (cons 'outer-definition forms)))
+        (test-macro first (call))
+        (cl-macrolet
+            ((test-macro (&rest forms) (cons 'inner-definition forms)))
+          (test-macro (second (call)))))
+    (macrostep-should-expand
+     '(test-macro first (call))
+     '(outer-definition first (call)))
+    (macrostep-should-expand
+     '(test-macro (second (call)))
+     '(inner-definition (second (call))))))
+
+(ert-deftest macrostep-environnment-at-point ()
+  (macrostep-with-text
+      ;; Taken from org-notify.el.
+      '(macrolet ((get (k) `(plist-get list ,k))
+                  (pr (k v) `(setq result (plist-put result ,k ,v))))
+        (body forms))
+    (search-forward "(body")
+    (let ((env (macrostep-environment-at-point)))
+      (should (assq 'get env))
+      (should (assq 'pr env))
+      (should (functionp (cdr (assq 'get env))))
+      (should (functionp (cdr (assq 'pr env))))
+      (should
+       (equal
+        (apply (cdr (assq 'pr env)) '(:heading heading))
+        '(setq result (plist-put result :heading heading))))
+      (should
+       (equal
+        (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 1f2c741..c5a3621 100644
--- a/macrostep.el
+++ b/macrostep.el
@@ -1,11 +1,11 @@
 ;;; macrostep.el --- interactive macro stepper for Emacs Lisp
 
-;; Copyright (C) 2012 Jonathan Oddie <j.j.oddie@gmail.com>
+;; Copyright (C) 2012-2014 Jonathan Oddie <j.j.oddie@gmail.com>
 
 ;; Author:     joddie <j.j.oddie@gmail.com>
 ;; Maintainer: joddie <j.j.oddie@gmail.com>
 ;; Created:    16 January 2012
-;; Updated:    04 May 2013
+;; Updated:    05 May 2014
 ;; Version:    0.6
 ;; Keywords:   lisp, languages, macro, debugging
 ;; Url:        https://github.com/joddie/macrostep
@@ -179,7 +179,11 @@
 ;; We use `pp-buffer' to pretty-print macro expansions
 (require 'pp)
 (require 'ring)
-(eval-when-compile (require 'cl))
+;; `cl-macs' is needed at run-time to support `cl-macrolet'
+(require 'cl-macs)
+(eval-when-compile
+  (require 'cl)
+  (require 'pcase))
 
 
 ;;; Constants and dynamically bound variables
@@ -203,6 +207,10 @@
   "Saved value of buffer-read-only upon entering macrostep mode.")
 (make-variable-buffer-local 'macrostep-saved-read-only)
 
+(defvar macrostep-environment nil
+  "Local macro-expansion environment, including macros declared by 
`cl-macrolet'.")
+(make-variable-buffer-local 'macrostep-environment)
+
 ;;; Faces
 (defgroup macrostep nil
   "Interactive macro stepper for Emacs Lisp."
@@ -345,7 +353,8 @@ buffer temporarily read-only. If macrostep-mode is active 
and the
 form following point is not a macro form, search forward in the
 buffer and expand the next macro form found, if any."
   (interactive)
-  (let ((sexp (macrostep-sexp-at-point)))
+  (let ((sexp (macrostep-sexp-at-point))
+        (macrostep-environment (macrostep-environment-at-point)))
     (when (not (macrostep-macro-form-p sexp))
       (condition-case nil
          (progn
@@ -457,26 +466,34 @@ If no more macro expansions are visible after this, exit
          (eq (car form) 'lambda))      ; hack
       nil
     (condition-case err
-        (let ((fun (indirect-function (car form))))
-          (and (consp fun)
-               (or (eq (car fun) 'macro)
-                   (and
-                    (eq (car fun) 'autoload)
-                    (eq (nth 4 fun) 'macro)))))
+        (or
+         ;; Locally bound as a macro?
+         (assq (car form) macrostep-environment)
+         ;; Globally defined?
+         (let ((fun (indirect-function (car form))))
+           (and (consp fun)
+                (or (eq (car fun) 'macro)
+                    (and
+                     (eq (car fun) 'autoload)
+                     (eq (nth 4 fun) 'macro))))))
       (error nil))))
 
 (defun macrostep-macro-definition (form)
   "Return, as a function, the macro definition to apply in expanding FORM."
-  (let ((fun (indirect-function (car form))))
-    (if (consp fun)
-        (case (car fun)
-          ((macro)
-           (cdr fun))
-
-          ((autoload)
-           (load-library (nth 1 fun))
-           (macrostep-macro-definition form)))
-      (error "(%s ...) is not a macro form" form))))
+  (or
+   ;; Locally bound by `macrolet'
+   (cdr (assq (car form) macrostep-environment))
+   ;; Globally defined
+   (let ((fun (indirect-function (car form))))
+     (if (consp fun)
+         (case (car fun)
+           ((macro)
+            (cdr fun))
+
+           ((autoload)
+            (load-library (nth 1 fun))
+            (macrostep-macro-definition form)))
+       (error "(%s ...) is not a macro form" form)))))
 
 (defun macrostep-expand-1 (form)
   "Return result of macro-expanding the top level of FORM by exactly one step.
@@ -485,6 +502,47 @@ expansion until a non-macro-call results."
   (if (not (macrostep-macro-form-p form)) form
     (apply (macrostep-macro-definition form) (cdr form))))
 
+(defun macrostep-environment-at-point ()
+  "Return the local macro-expansion environment at point, if any.
+
+The local environment includes macros declared by any `macrolet'
+or `cl-macrolet' forms surrounding point.
+
+The return value is an alist of elements (NAME . FUNCTION), where
+NAME is the symbol locally bound to the macro and FUNCTION is the
+lambda expression that returns its expansion."
+  (save-excursion
+    (let
+        ((enclosing-form
+          (ignore-errors
+            (backward-up-list)
+            (read (copy-marker (point))))))
+      (pcase enclosing-form
+        (`(,(or `macrolet `cl-macrolet) ,bindings . ,_)
+          (let ((binding-environment
+                 (macrostep-bindings-to-environment bindings))
+                (enclosing-environment
+                 (macrostep-environment-at-point)))
+            (append binding-environment enclosing-environment)))
+        (`nil nil)
+        (_ (macrostep-environment-at-point))))))
+
+(defun macrostep-bindings-to-environment (bindings)
+  "Return the macro-expansion environment declared by BINDINGS as an alist.
+
+BINDINGS is a list in the form expected by `macrolet' or
+`cl-macrolet'.  The return value is an alist, as described in
+`macrostep-environment-at-point'."
+  ;; So that the later elements of bindings properly shadow the
+  ;; earlier ones in the returned environment, we must reverse the
+  ;; list before mapping over it.
+  (cl-loop for (name . forms) in (reverse bindings)
+           collect
+           ;; Adapted from the definition of `cl-macrolet':
+           (let ((res (cl--transform-lambda forms name)))
+             (eval (car res))
+             (cons name `(lambda ,@(cdr res))))))
+
 (defun macrostep-overlay-at-point ()
   "Return the innermost macro stepper overlay at point."
   (let ((result
@@ -651,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)))))