Import Upstream version 2c3upstream/2c3

1 files changed, 118 insertions, 0 deletions

diff --git a/Bev2slib.scm b/Bev2slib.scm
new file mode 100644
index 0000000..1198842
--- /dev/null
+++ b/Bev2slib.scm
@@ -0,0 +1,118 @@
+;; 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* ")")
+	))))