New :use-from clause in defpackage.

* share/txr/stdlib/package.tl (defpackage): Implemented
new :use-from clause.

* txr.1: Documented :use-from and made some improvements
to the defpackage documentation.

2 files changed, 48 insertions, 4 deletions

diff --git a/share/txr/stdlib/package.tl b/share/txr/stdlib/package.tl
index 4c423145..1827628f 100644
--- a/share/txr/stdlib/package.tl
+++ b/share/txr/stdlib/package.tl
@@ -37,6 +37,23 @@
          (name-str (sys:name-str 'package name))
          (exp-clauses (append-each ((c clauses))
                         (tree-case c
+                          ((keyword package . rest)
+                            (caseql keyword
+                              (:use-from
+                                ^((let ((p (find-package ',package)))
+                                    (unless p
+                                      (throwf 'eval-error
+                                              "~s: no such package: ~s"
+                                              'defpackage ',package))
+                                    (each ((n ',(mapcar (op sys:name-str 'symbol)
+                                                        rest)))
+                                      (let ((s (intern n p)))
+                                        (unless (eq (symbol-package s) p)
+                                          (throwf 'eval-error
+                                                  "~s: won't use non-local ~s from ~s"
+                                                  'defpackage s p))
+                                        (use-sym s ,pkg))))))
+                              (t :)))
                           ((keyword . rest)
                             (caseql keyword
                               (:use
@@ -50,7 +67,12 @@
                                     (let ((s (intern n ,pkg)))
                                       (unless (eq (symbol-package s) ,pkg)
                                         (unuse-sym s ,pkg)
-                                        (intern n ,pkg))))))))
+                                        (intern n ,pkg))))))
+                              (:use-from
+                                 (throwf 'eval-error
+                                         "~s: :use-from clause needs package argument"
+                                          'defpackage))
+                              (t :)))
                           (atom
                             (throwf 'eval-error "~s: invalid clause: ~s"
                                     'defpackage atom))))))
diff --git a/txr.1 b/txr.1
index a7831d2e..1e6013ed 100644
--- a/txr.1
+++ b/txr.1
@@ -39459,7 +39459,10 @@ If a package called
 already exists, then
 .code defpackage
 selects that package for further operations. Otherwise, a new,
-empty package is created.
+empty package is created. In either case, this package is referred
+to as the
+.I "present package"
+in the following descriptions.
 
 The
 .code name
@@ -39477,7 +39480,7 @@ The supported clauses are as follows:
 The
 .code :use
 clause specifies packages whose local symbols are to be interned
-into the package as foreign symbols. Each
+into the present package as foreign symbols. Each
 .meta package-name
 may be a string or symbol naming an existing package.
 The list of package names is processed as if by a call to
@@ -39485,8 +39488,27 @@ The list of package names is processed as if by a call to
 .meIP (:use-syms << symbol *)
 The
 .code :use-syms
-clause specifies individual symbols to be interned in the new package.
+clause specifies individual symbols to be interned in the present package.
 The arguments are symbols.
+.meIP (:use-from < package-name << symbol-name *)
+The
+.code :use-from
+clause specifies the names of local symbols in a package denoted by
+.meta package-name
+to be used in the present package. All arguments of
+.code :use-from
+are either strings or symbols which are reduced to strings by mapping
+to their names. Each
+.meta symbol-name
+is interned in the package identified by
+.metn package-name ,
+which may have the effect of creating that symbol.
+This symbol is expected to be a local symbol of that package. If
+that is so, the symbol is brought into the present package via
+.codn use-symbol .
+Otherwise if the symbol is foreign to package identified by
+.metn package-name ,
+then an error exception is thrown.
 .meIP (:local << symbol-name *)
 The
 .code :local