source: trunk/j/src/org/armedbear/lisp/with-package-iterator.lisp @ 3763

Last change on this file since 3763 was 3763, checked in by piso, 19 years ago

+ (unless (consp package-list)
+ (setq package-list (list package-list)))

File size: 2.5 KB
Line 
1;;; with-package-iterator.lisp
2;;;
3;;; Copyright (C) 2003 Peter Graves
4;;; $Id: with-package-iterator.lisp,v 1.2 2003-09-14 16:04:38 piso Exp $
5;;;
6;;; This program is free software; you can redistribute it and/or
7;;; modify it under the terms of the GNU General Public License
8;;; as published by the Free Software Foundation; either version 2
9;;; of the License, or (at your option) any later version.
10;;;
11;;; This program is distributed in the hope that it will be useful,
12;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
13;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14;;; GNU General Public License for more details.
15;;;
16;;; You should have received a copy of the GNU General Public License
17;;; along with this program; if not, write to the Free Software
18;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
19
20(in-package "SYSTEM")
21
22(defun package-iterator-function (package-list symbol-types)
23  (unless (consp package-list)
24    (setq package-list (list package-list)))
25  (let ((results ()))
26    (dolist (pkg package-list)
27      (unless (packagep pkg)
28        (setq pkg (find-package pkg))
29        (unless pkg
30          (error "not a package")))
31      (when (memq :internal symbol-types)
32        (dolist (sym (package-internal-symbols pkg))
33          (push (list sym :internal pkg) results)))
34      (when (memq :external symbol-types)
35        (dolist (sym (package-external-symbols pkg))
36          (push (list sym :external pkg) results)))
37      (when (memq :inherited symbol-types)
38        (dolist (sym (package-inherited-symbols pkg))
39          (push (list sym :inherited pkg) results))))
40    #'(lambda () (let ((item (car results)))
41                   (setq results (cdr results))
42                   (if item
43                       (values t (first item) (second item) (third item))
44                       nil)))))
45
46(defmacro with-package-iterator ((name package-list &rest symbol-types)
47                                 &body body)
48  (unless symbol-types
49    (error 'program-error
50           "WITH-PACKAGE-ITERATOR: no symbol types specified"))
51  (dolist (symbol-type symbol-types)
52    (unless (memq symbol-type '(:internal :external :inherited))
53      (error 'program-error
54             "WITH-PACKAGE-ITERATOR: invalid symbol type: %S" symbol-type)))
55  (let ((iter (gensym)))
56    `(let ((,iter (package-iterator-function ,package-list ',(remove-duplicates symbol-types))))
57       (macrolet ((,name () '(funcall ,iter)))
58                 ,@body))))
Note: See TracBrowser for help on using the repository browser.