feature/pkg c8d6819512: do-symbols, do-external-symbols, do-all-symbols

[Gerd Moellmann]

branch: feature/pkg
commit c8d6819512383252735ee49d90bea7822b765d71
Author: Gerd Möllmann <gerd@gnu.org>
Commit: Gerd Möllmann <gerd@gnu.org>

    do-symbols, do-external-symbols, do-all-symbols
    
    * lisp/emacs-lisp/pkg.el (do-symbols): New macro.
    (do-external-symbols): New macro.
    (do-all-symbols): New macro.
---
 lisp/emacs-lisp/pkg.el | 70 ++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 70 insertions(+)

diff --git a/lisp/emacs-lisp/pkg.el b/lisp/emacs-lisp/pkg.el
index f5d067727a..08cb3d8304 100644
--- a/lisp/emacs-lisp/pkg.el
+++ b/lisp/emacs-lisp/pkg.el
@@ -422,6 +422,76 @@ Value is the renamed package object."
                            unuse))
     t))
 
+;;;###autoload
+(cl-defmacro do-symbols ((var &optional (package '*package*) result-form)
+                        &body body)
+  "Loop over symbols in a package.
+
+Evaluate BODY with VAR bound to each symbol accessible in the given
+PACKAGE, or the current package if PACKAGE is not specified.
+
+Return what RESULT-FORM evaluates to, if specified, and the loop ends
+normally, or else if an explcit return occurs the value it transfers."
+  (declare (indent 1))
+  (let ((flet-name (gensym "do-symbols-")))
+    `(cl-block nil
+       (cl-flet ((,flet-name (,var)
+                  (cl-tagbody ,@body)))
+        (let* ((package (pkg--package-or-lose ,package))
+               (shadows (package-%shadowing-symbols package)))
+          (maphash (lambda (k v) (,flet-name k))
+                   (package-%symbols package))
+          (dolist (p (package-%use-list package))
+            (maphash (lambda (k v)
+                       (when (eq v :external)
+                         (,flet-name k)))
+                     (package-%symbols p))
+       (let ((,var nil))
+        ,result-form)))))))
+
+;;;###autoload
+(cl-defmacro do-external-symbols ((var &optional (package '*package*) 
result-form)
+                                 &body body)
+  "Loop over external symbols in a package.
+
+Evaluate BODY with VAR bound to each symbol accessible in the given
+PACKAGE, or the current package if PACKAGE is not specified.
+
+Return what RESULT-FORM evaluates to, if specified, and the loop ends
+normally, or else if an explcit return occurs the value it transfers."
+  (let ((flet-name (gensym "do-symbols-")))
+    `(cl-block nil
+       (cl-flet ((,flet-name (,var)
+                  (cl-tagbody ,@body)))
+        (let* ((package (pkg--package-or-lose ,package))
+               (shadows (package-%shadowing-symbols package)))
+          (maphash (lambda (k v)
+                     (when (eq v :external)
+                       (,flet-name k)))
+                   (package-%symbols package))))
+       (let ((,var nil))
+        ,result-form))))
+
+;;;###autoload
+(cl-defmacro do-all-symbols ((var &optional result-form) &body body)
+  "Loop over all symbols in all registered packages.
+
+Evaluate BODY with VAR bound to each symbol accessible in the given
+PACKAGE, or the current package if PACKAGE is not specified.
+
+Return what RESULT-FORM evaluates to, if specified, and the loop ends
+normally, or else if an explcit return occurs the value it transfers."
+  (let ((flet-name (gensym "do-symbols-")))
+    `(cl-block nil
+       (cl-flet ((,flet-name (,var)
+                  (cl-tagbody ,@body)))
+         (dolist (package (list-all-packages))
+          (maphash (lambda (k _v)
+                     (,flet-name k))
+                   (package-%symbols package))))
+       (let ((,var nil))
+        ,result-form))))
+
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;                            defpackage
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;