;;; -*- Mode: LISP; Package: BOXER; Syntax: Zetalisp -*-

;;; (C) Copyright 1985 Massachusetts Institute of Technology
;;;
;;; Permission to use, copy, modify, distribute, and sell this software
;;; and its documentation for any purpose is hereby granted without fee,
;;; provided that the above copyright notice appear in all copies and that
;;; both that copyright notice and this permission notice appear in
;;; supporting documentation, and that the name of M.I.T. not be used in
;;; advertising or publicity pertaining to distribution of the software
;;; without specific, written prior permission.  M.I.T. makes no
;;; representations about the suitability of this software for any
;;; purpose.  It is provided "as is" without express or implied warranty.
;;;

;;; Mapping functions for databases in Boxer.


(defboxer-function bu::for-all-boxes ((datafy doit-box-or-name) (port-to box))
  (let* ((thing (get-first-element doit-box-or-name))
	 (function (if (symbolp thing)
		       (boxer-symeval thing)
		       thing))
	 (arglist (if (box? function)
		      (boxer-arglist function)
		      (get-template function)))
	 (port-flavor? (and (listp (car arglist))
			    (or (eq 'bu::port-to (caar arglist))
				(eq :port-to (caar arglist))))))
    (map-over-inferior-boxes
      (get-port-target box)
      #'(lambda (arg)
	  (boxer-funcall function (if port-flavor? arg (copy-box arg nil)))))))

;;; this is kind of a crock.  the both predicate gets run in the lexical environment
;;; of the box if it has no inputs or gets the box as an input if it wants an input. 
;;; that's because tell is so useless.
(defboxer-function bu::collect-from-all-boxes ((datafy doit-box-or-name) (port-to box))
  (make-box
    (with-collection
      (let* ((thing (get-first-element doit-box-or-name))
	     (function (if (symbolp thing)
			   (boxer-symeval thing)
			   thing))
	     (arglist (if (box? function)
			  (boxer-arglist function)
			  (get-template function)))
	     (port-flavor? (and (listp (car arglist))
				(or (eq 'bu::port-to (caar arglist))
				    (eq :port-to (caar arglist))))))
	(map-over-inferior-boxes
	  (get-port-target box)
	  #'(lambda (arg)
	      (let ((result 
		      (if arglist
			  (boxer-funcall
			    function
			    (if port-flavor? arg (copy-box arg nil)))
			  (with-static-root-bound arg (boxer-funcall function)))))
		(unless (memq result *returned-values-not-to-print*)
		  (collect (list result))))))))))

(defboxer-function bu::collect-template-from-all-boxes ((port-to box) template)
  (make-box
    (with-collection
      (map-over-inferior-boxes
	(get-port-target box)
	#'(lambda (arg)
	    (collect
	      (let ((result (with-static-root-bound arg (build-internal template))))
		(if (evbox? result)
		    (get-evbox-elements result)
		    (box-items-list result)))))))))

;;; this is kind of a crock.  the both predicate gets run in the lexical environment
;;; of the box if it has no inputs or gets the box as an input if it wants an input. 
;;; that's because tell is so useless.
(defboxer-function bu::collect-template-from-some-boxes ((datafy predicate)
							 template
							 (port-to box))
  (let* ((predicate (get-first-element predicate))
	 (function (if (symbolp predicate)
		       (boxer-symeval predicate)
		       predicate))
	 (arglist (cond ((doit-box? function)
			 (boxer-arglist function))
			((functionp function) (get-template function))
			(t nil)))
	 (port-flavor? t))
    ;; (and (listp (car arglist))
    ;;      (or (eq 'bu::port-to (caar arglist))
    ;;          (eq :port-to (caar arglist)))))
    (make-box
      (with-collection
	(map-over-inferior-boxes
	  (get-port-target box)
	  #'(lambda (arg)
	      (when (cond ((true? predicate) t)
			  ((null arglist) 
			   (with-static-root-bound arg
			     (true? (boxer-funcall function))))
			  (t (true? (boxer-funcall
				      function
				      (if port-flavor? arg (copy-box arg nil))))))
		(collect
		  (let ((result (with-static-root-bound arg
				  (build-internal template))))
		    (if (evbox? result)
			(get-evbox-elements result)
			(box-items-list result)))))))))))

(defboxer-function bu::self ()
  (make-port-to *boxer-static-variables-root*))