Enhance macro expansion stepper hiding

Add customization variable racket-expand-hiding, which is an Emacs
Lisp equivalent of macro-debugger/model/hiding-policies. Allows the
same level of macro hiding customization as in DrRacket.

racket-custom.el

@@ -572,6 +572,19 @@ ignore POS. Examples: `racket-show-echo-area' and
   :risky t
   :group 'racket-other)
 
+(defcustom racket-expand-hiding 'standard
+  "The macro hiding policy for commands like `racket-expand-file'.
+
+Although any macro-debugger/model/hiding-policies value may be
+used, frequently used values include:
+
+  - \\='standard
+  - \\='disabled
+  - (list \\='custom hide-racket? hide-libs? hide-contracts? hide-phase1? rules)"
+  :tag "Racket Expand Hiding"
+  :type 'sexpr
+  :group 'racket-other)
+
 ;;; Faces
 
 (defgroup racket-faces nil

racket-stepper.el

@@ -59,7 +59,7 @@ Used by the commands `racket-expand-file',
 
 ;;; commands
 
-(defun racket-expand-file (&optional into-base)
+(defun racket-expand-file (&optional no-hiding)
   "Expand the `racket-mode' buffer's file in `racket-stepper-mode'.
 
 Uses the `macro-debugger` package to do the expansion.
@@ -71,70 +71,80 @@ If the file is non-trivial and/or is not compiled to a .zo
 bytecode file, then it might take many seconds before the
 original form is displayed and you can start stepping.
 
-With \\[universal-argument] also expands syntax from racket/base
--- which can result in very many expansion steps."
+With \\[universal-argument] behaves as if `racket-expand-hiding'
+were \\='disabled."
   (interactive "P")
   (racket--assert-edit-mode)
   (racket--save-if-changed)
-  (racket-stepper--start 'file (racket--buffer-file-name) into-base))
+  (racket-stepper--start 'file
+                         (racket--buffer-file-name)
+                         no-hiding))
 
-(defun racket-expand-region (start end &optional into-base)
+(defun racket-expand-region (start end &optional no-hiding)
   "Expand the active region using `racket-stepper-mode'.
 
 Uses Racket's `expand-once` in the namespace from the most recent
-`racket-run'."
+`racket-run'.
+
+With \\[universal-argument] behaves as if `racket-expand-hiding'
+were \\='disabled."
   (interactive "rP")
   (unless (region-active-p)
     (user-error "No region"))
   (racket--assert-sexp-edit-mode)
-  (racket-stepper--expand-text into-base
+  (racket-stepper--expand-text no-hiding
                                (lambda ()
                                  (cons start end))))
 
-(defun racket-expand-definition (&optional into-base)
+(defun racket-expand-definition (&optional no-hiding)
   "Expand the definition around point using `racket-stepper-mode'.
 
 Uses Racket's `expand-once` in the namespace from the most recent
-`racket-run'."
+`racket-run'.
+
+With \\[universal-argument] behaves as if `racket-expand-hiding'
+were \\='disabled."
   (interactive "P")
   (racket--assert-sexp-edit-mode)
-  (racket-stepper--expand-text into-base
+  (racket-stepper--expand-text no-hiding
                                (lambda ()
                                  (save-excursion
                                    (cons (progn (beginning-of-defun) (point))
                                          (progn (end-of-defun)       (point)))))))
 
-(defun racket-expand-last-sexp (&optional into-base)
+(defun racket-expand-last-sexp (&optional no-hiding)
   "Expand the sexp before point using `racket-stepper-mode'.
 
 Uses Racket's `expand-once` in the namespace from the most recent
-`racket-run'."
+`racket-run'.
+
+With \\[universal-argument] behaves as if `racket-expand-hiding'
+were \\='disabled."
   (interactive "P")
   (racket--assert-sexp-edit-mode)
-  (racket-stepper--expand-text into-base
+  (racket-stepper--expand-text no-hiding
                                (lambda ()
                                  (save-excursion
                                    (cons (progn (backward-sexp) (point))
                                          (progn (forward-sexp)  (point)))))))
 
-(defun racket-stepper--expand-text (prefix get-region)
+(defun racket-stepper--expand-text (no-hiding get-region)
   (pcase (funcall get-region)
     (`(,beg . ,end)
      (racket-stepper--start 'expr
                             (buffer-substring-no-properties beg end)
-                            prefix))))
+                            no-hiding))))
 
 (defvar racket--stepper-repl-session-id nil
   "The REPL session used when stepping.
 
 May be nil for \"file\" stepping, but must be valid for \"expr\"
 stepping.")
 
-(defun racket-stepper--start (which str into-base)
+(defun racket-stepper--start (which str no-hiding)
   "Ensure buffer and issue initial command.
 WHICH should be \"expr\" or \"file\".
-STR should be the expression or pathname.
-INTO-BASE is treated as a raw command prefix arg and converted to boolp."
+STR should be the expression or pathname."
   (racket--assert-edit-mode)
   (setq racket--stepper-repl-session-id (racket--repl-session-id))
   (unless (or racket--stepper-repl-session-id
@@ -157,7 +167,9 @@ INTO-BASE is treated as a raw command prefix arg and converted to boolp."
                        `(macro-stepper (,which . ,(if (eq which 'file)
                                                       (racket-file-name-front-to-back str)
                                                     str))
-                                       ,(and into-base t))
+                                       ,(if no-hiding
+                                            'disable
+                                          racket-expand-hiding))
                        #'racket-stepper--insert)))
 
 (defun racket-stepper--insert (nothing-or-steps)

racket/commands/macro.rkt

@@ -5,6 +5,8 @@
 
 (require (only-in macro-debugger/stepper-text
                   stepper-text)
+         (only-in macro-debugger/model/hiding-policies
+                  policy->predicate)
          racket/contract
          racket/file
          racket/format
@@ -64,19 +66,20 @@
              [v v])]))
   step)
 
-(define/contract (make-file-stepper path into-base?)
-  (-> (and/c path-string? absolute-path?) boolean? step-proc/c)
+(define/contract (make-file-stepper path elisp-policy)
+  (-> (and/c path-string? absolute-path?) any/c step-proc/c)
   (assert-file-stepper-works)
   (define stx (file->syntax path))
   (define dir (path-only path))
   (define ns (make-base-namespace))
+  (define policy (elisp-policy->policy elisp-policy))
+  (define predicate (policy->predicate policy))
   (define raw-step (parameterize ([current-load-relative-directory dir]
                                   [current-namespace               ns])
-                     (stepper-text stx
-                                   (if into-base? (λ _ #t) (not-in-base)))))
+                     (stepper-text stx predicate)))
   (define step-num #f)
   (define step-last-after (pretty-format-syntax stx))
-  (log-racket-mode-debug "~v ~v ~v" path into-base? raw-step)
+  (log-racket-mode-debug "~v ~v ~v" path policy raw-step)
   (define/contract (step what) step-proc/c
     (cond [(not step-num)
            (set! step-num 0)
@@ -105,6 +108,27 @@
                   (list (cons 'final step-last-after))])]))
   step)
 
+(define (elisp-policy->policy e)
+  ;; See macro-debugger/model/hiding-policies.rkt):
+  ;;
+  ;; A Policy is one of
+  ;;   'disable
+  ;;   'standard
+  ;;   (list 'custom boolean boolean boolean boolean (listof Entry))
+  ;;
+  ;; Of the Entry rules, although the free=? one can't work because it
+  ;; needs a live syntax object identifier, I think most of the rest
+  ;; should be fine.
+  (match e
+    [(or 'disable 'standard) e]
+    [(list 'custom
+           (app as-racket-bool hide-racket?)
+           (app as-racket-bool hide-libs?)
+           (app as-racket-bool hide-contracts?)
+           (app as-racket-bool hide-phase1?)
+           rules)
+     (list 'custom hide-racket? hide-libs? hide-contracts? hide-phase1? rules)]))
+
 (define (read-step)
   (define title (read-line))
   (define before (read))
@@ -123,13 +147,13 @@
     (error 'macro-debugger/stepper-text
            "does not work in your version of Racket.\nPlease try an older or newer version.")))
 
-(define/contract (macro-stepper what into-base?)
-  (-> (or/c (cons/c 'expr string?) (cons/c 'file path-string?)) elisp-bool/c
+(define/contract (macro-stepper what policy)
+  (-> (or/c (cons/c 'expr string?) (cons/c 'file path-string?)) any/c
       (list/c step/c))
   (set! step-proc
         (match what
           [(cons 'expr str)  (make-expr-stepper str)]
-          [(cons 'file path) (make-file-stepper path (as-racket-bool into-base?))]))
+          [(cons 'file path) (make-file-stepper path policy)]))
   (macro-stepper/next 'next))
 
 (define/contract (macro-stepper/next what) step-proc/c
@@ -139,17 +163,6 @@
     [_ (void)])
   v)
 
-;; Borrowed from xrepl.
-(define not-in-base
-  (λ () (let ([base-stxs #f])
-          (unless base-stxs
-            (set! base-stxs ; all ids that are bound to a syntax in racket/base
-                  (parameterize ([current-namespace (make-base-namespace)])
-                    (let-values ([(vals stxs) (module->exports 'racket/base)])
-                      (map (λ (s) (namespace-symbol->identifier (car s)))
-                           (cdr (assq 0 stxs)))))))
-          (λ (id) (not (ormap (λ (s) (free-identifier=? id s)) base-stxs))))))
-
 (define (diff-text before-text after-text #:unified [-U 3])
   (define template "racket-mode-syntax-diff-~a")
   (define (make-temporary-file-with-text str)