;;;;;;;;;;;;;;;;;;; -*- Mode: Lisp; Package: Macsyma -*- ;;;;;;;;;;;;;;;;;;;
;;;     (c) Copyright 1982 Massachusetts Institute of Technology         ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(macsyma-module apropos)

(declare (special list1 apr-test1 apr-test2))

; Return a list of all atoms whose pnames contain A as a substring.

(defmspec $apropos (a) (setq a (cdr a))
  (if (or (null a) (cdr a) (not (symbolp (car a))))
      (mtell "
APROPOS takes a single argument which should be a symbol.
It searches for all occurrences of this sequence of characters 
in any symbol name, and returns the list of all such found.
")
      (let ((apr-test1 (makstring* (getop (amperchk (car a)))))
	    (apr-test2 (makstring* (amperchk (car a))))
	    (list1))
	(if (equal apr-test1 apr-test2) (setq apr-test2 nil))
	(mapatoms #'(lambda (a)
		      (and (= (getcharn a 1) #/$)
			   (or (pnmemq a apr-test1)
			       (and apr-test2 (pnmemq a apr-test2)))
			   (or (boundp a) (plist a))
			   (push a list1))))
	(cons '(mlist simp) list1))))

(declare (unspecial list1 apr-test1 apr-test2))

(defun pnmemq (a test)
  (do ((i 2 (1+ i)) (c))		;ignore first $
      (nil)				;Terminate by explicit RETURN
    (cond ((null (setq c (getchar a i))) (return nil))
	  ((and (eq c (car test))
		(do ((i (1+ i) (1+ i))
		     (test test (cdr test))
		     (c (getchar a i) (getchar a i)))
		    ((null test) a)
		  (if (not (eq c (car test))) (return nil))))
	   (return T)))))