;; Copyright (C) 1997 Free Software Foundation, Inc.
;;
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this software; see the file COPYING.  If not, write to
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
;;
;; As a special exception, the Free Software Foundation gives permission
;; for additional uses of the text contained in its release of GUILE.
;;
;; The exception is that, if you link the GUILE library with other files
;; to produce an executable, this does not by itself cause the
;; resulting executable to be covered by the GNU General Public License.
;; Your use of that executable is in no way restricted on account of
;; linking the GUILE library code into it.
;;
;; This exception does not however invalidate any other reasons why
;; the executable file might be covered by the GNU General Public License.
;;
;; This exception applies only to the code released by the
;; Free Software Foundation under the name GUILE.  If you copy
;; code from other Free Software Foundation releases into a copy of
;; GUILE, as the General Public License permits, the exception does
;; not apply to the code that you add in this way.  To avoid misleading
;; anyone as to the status of such modified files, you must delete
;; this exception notice from them.
;;
;; If you write modifications of your own for GUILE, it is your choice
;; whether to permit this exception to apply to your modifications.
;; If you do not wish that, delete this exception notice.

;;;; "Bev2slib.scm" Build SLIB catalogs for Stephen Bevan's libraries.
;;; Author: Aubrey Jaffer.

;;; Put this file into the implementation-vicinity directory for your
;;; scheme implementation.

;;; Add the line
;;;	(load (in-vicinity (implementation-vicinity) "Bev2slib.scm"))
;;; to "mkimpcat.scm"

;;; Delete "slibcat" in your implementation-vicinity.

;;; Bind `Bevan-dir' to the directory containing directories "bawk",
;;; "mawk", "pathname", etc.  Bev2slib.scm will put entries into the
;;; catalog only for those directories and files which exist.

(let ((Bevan-dir (in-vicinity (library-vicinity) "../"));"/usr/local/lib/Bevan/"
      (catname "sitecat"))
  (call-with-output-file (in-vicinity (implementation-vicinity) catname)
    (lambda (op)
      (define (display* . args)
	(for-each (lambda (arg) (display arg op)) args)
	(newline op))
      (define (add-alias from to)
	(display " " op)
	(write (cons from to) op)
	(newline op))

      (begin
	(display* ";\"" catname "\" Site-specific SLIB catalog for "
		  (scheme-implementation-type) (scheme-implementation-version)
		  ".  -*-scheme-*-")
	(display* ";")
	(display* ";			DO NOT EDIT THIS FILE")
	(display* "; it is automagically generated by \"Bev2slib.scm\"")
	(newline op)
	)

      ;; Output association lists to file "sitecat"

      (for-each
       (lambda (dir)
	 (let* ((vic (in-vicinity Bevan-dir (string-append dir "/")))
		(map-file (in-vicinity vic (string-append dir ".map"))))

	   (display* ";;; from " map-file)
	   (display* "(")

	   (and
	    (file-exists? map-file)
	    (call-with-input-file map-file
	      (lambda (ip)
		(define files '())
		(do ((feature (read ip) (read ip)))
		    ((eof-object? feature))
		  (let* ((type (read ip))
			 (file (read ip))
			 (fsym (string->symbol (string-append "Req::" file))))
		    (and (not (assq fsym files))
			 (set! files (cons (cons fsym file) files)))
		    (add-alias feature fsym)))
		(for-each
		 (lambda (pr) (add-alias (car pr) (in-vicinity vic (cdr pr))))
		 files)
		)))

	   (display* ")")))

       '("char-set" "conc-string" "string" "string-03"
		    "avl-tree" "avl-trie"
		    "bawk" "mawk" "pathname"))

      (begin
	(display* "(")
	(add-alias 'btree (in-vicinity Bevan-dir "bawk/btree"))
	(add-alias 'read-line 'line-i/o)
	(display* ")")
	))))