mirror of
https://github.com/PDP-10/its.git
synced 2026-02-23 15:52:10 +00:00
85994ed770
Resolves #284. Commented out uses of time-origin in maxtul; mcldmp (init) until we can figure out why it gives arithmetic overflows under the emulators. Updated the expect script statements in build_macsyma_portion to not attempt to match expected strings, but simply sleep for some time since in some cases the matching appears not to work.
43 lines
1.5 KiB
Common Lisp
43 lines
1.5 KiB
Common Lisp
;;;;;;;;;;;;;;;;;;; -*- 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)))))
|
||
|