1;;; apropos.lisp 2;;; 3;;; Copyright (C) 2003-2005 Peter Graves 4;;; $Id$ 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;;; As a special exception, the copyright holders of this library give you 21;;; permission to link this library with independent modules to produce an 22;;; executable, regardless of the license terms of these independent 23;;; modules, and to copy and distribute the resulting executable under 24;;; terms of your choice, provided that you also meet, for each linked 25;;; independent module, the terms and conditions of the license of that 26;;; module. An independent module is a module which is not derived from 27;;; or based on this library. If you modify this library, you may extend 28;;; this exception to your version of the library, but you are not 29;;; obligated to do so. If you do not wish to do so, delete this 30;;; exception statement from your version. 31 32;;; Adapted from SBCL. 33 34(in-package #:system) 35 36 37(defun apropos-list (string-designator &optional package-designator 38 external-only) 39 (if package-designator 40 (let ((package (find-package package-designator)) 41 (string (string string-designator)) 42 (result nil)) 43 (dolist (symbol (package-external-symbols package)) 44 (declare (type symbol symbol)) 45 (when (search string (symbol-name symbol) :test #'char-equal) 46 (push symbol result))) 47 (unless external-only 48 (dolist (symbol (package-internal-symbols package)) 49 (declare (type symbol symbol)) 50 (when (search string (symbol-name symbol) :test #'char-equal) 51 (push symbol result)))) 52 result) 53 (mapcan (lambda (package) 54 (apropos-list string-designator package external-only)) 55 (list-all-packages)))) 56 57(defun apropos (string-designator &optional package-designator external-only) 58 (dolist (symbol (remove-duplicates (apropos-list string-designator 59 package-designator 60 external-only))) 61 (fresh-line) 62 (prin1 symbol) 63 (when (boundp symbol) 64 (write-string " (bound)")) 65 (when (fboundp symbol) 66 (write-string " (fbound)"))) 67 (values)) 68