;;; -*- Mode:LISP; IBase:10.; -*-
;;;
;;; IMPDEF: A library for selectively including a definition from a file of definitions

(HERALD IMPDEF /15)

(EVAL-WHEN (EVAL COMPILE)
           (COND ((NOT (STATUS FEATURE IOTA))
                  (LOAD '((DSK LIBLSP) IOTA FASL)))))

;;; (IMPORT-DEFINITION function filename)
;;;  Gets the definition of the function from filename and includes just
;;;  that one function in current file.
;;;
;;;  Works for DEFUNs, DEFMACROs, DEFUN&s, and recursive IMPORT-DEFINITIONs.

(DEFMACRO IMPORT-DEFINITION (NAME FILE)
	  (TERPRI MSGFILES)
	  (PRINC '|;IMPORT-DEFINITION looking for | MSGFILES)
	  (PRIN1 NAME MSGFILES)
	  (PRINC '| in /"| MSGFILES)
	  (PRINC (NAMESTRING FILE) MSGFILES)
	  (PRINC '/" MSGFILES)
	  (COND ((NOT (PROBEF FILE))
		 (TERPRI MSGFILES)
		 (PRINC '|;File not found. -- IMPORT-DEFINITION| MSGFILES)
		 '`(FILE ,FILE NOT FOUND WHEN LOOKING FOR DEFINITION
			 OF ,NAME))
		(T
		 (IOTA ((STREAM FILE 'IN))
		       (DO ((FORM (READ STREAM STREAM)
				  (READ STREAM STREAM)))
			   ((EQ FORM STREAM)
			    (TERPRI MSGFILES)
			    (PRINC '|;Definition of function | MSGFILES)
			    (PRIN1 NAME MSGFILES)
			    (PRINC '| not found. -- IMPORT-DEFINITION|
				   MSGFILES)
			    `'(FUNCTION ,NAME NOT FOUND IN ,FILE))
			   (COND ((AND (NOT (ATOM FORM))
				       (MEMQ (CAR FORM)
					     '(DEFUN DEFMACRO MACRO DEFUN/&
					       IMPORT-DEFINITION))
				       (OR (AND (ATOM (CADR FORM))
						(EQ (CADR FORM) NAME))
					   (AND (NOT (ATOM (CADR FORM)))
						(EQ (CAADR FORM) NAME))))
				  (TERPRI MSGFILES)
				  (PRINC '|;Using | MSGFILES)
				  ((LAMBDA (PRINLENGTH)
					   (PRIN1 FORM MSGFILES)) 2.)
				  (PRINC '| -- IMPORT-DEFINITION| MSGFILES)
				  (RETURN FORM))))))))