From 84d7b8eab7938833a7c96be97fbe7f2fbce13c51 Mon Sep 17 00:00:00 2001 From: Kaz Kylheku Date: Sat, 4 Apr 2020 19:15:28 -0700 Subject: tags: process files in anon package. Let's process each file in an anonymous package, saving and restoring the *package* special. TXR files can mess with that variable. * tags.tl (in-anon-package): New macro. (collect-tags-tl, collect-tags-txr): Wrap parsing with in-anon-package macro. --- tags.tl | 19 +++++++++++++++---- 1 file changed, 15 insertions(+), 4 deletions(-) diff --git a/tags.tl b/tags.tl index 94c52740..785aa38d 100755 --- a/tags.tl +++ b/tags.tl @@ -62,6 +62,16 @@ (tree-case (source-loc form) ((line . file) (escape [lines line])))) +(defmacro in-anon-package (. body) + (with-gensyms (pkg) + ^(let* ((,pkg (make-package "anon")) + (*package* ,pkg)) + (unwind-protect + (progn + (set-package-fallback-list *package* '(:usr)) + ,*body) + (delete-package ,pkg))))) + (defmacro with-tag-shorthand-macro ((name-sym path-var lines-var obj-var) . body) ^(macrolet ((,name-sym (type ident : parent pattern-obj) @@ -156,9 +166,10 @@ (build (add (new file-tag path path)) - (whilet ((obj (read stream *stderr* err-ret path)) - ((neq obj err-ret))) - (pend (process-form path lines obj)))))) + (in-anon-package + (whilet ((obj (read stream *stderr* err-ret path)) + ((neq obj err-ret))) + (pend (process-form path lines obj))))))) (defun collect-tags-txr (path) (let* ((text (file-get-string path)) @@ -166,7 +177,7 @@ (lines (cons "" (spl #\newline text))) (stream (make-string-byte-input-stream text)) (*rec-source-loc* t) - (syntax (txr-parse stream *stderr* nil path))) + (syntax (in-anon-package (txr-parse stream *stderr* nil path)))) (build (each ((clause syntax)) (pend (process-clause path lines clause)))))) -- cgit v1.2.3