summaryrefslogtreecommitdiffstats
path: root/Bev2slib.scm
diff options
context:
space:
mode:
authorBryan Newbold <bnewbold@robocracy.org>2017-02-20 00:05:27 -0800
committerBryan Newbold <bnewbold@robocracy.org>2017-02-20 00:05:27 -0800
commitfa3f23105ddcf07c5900de47f19af43d1db1b597 (patch)
treeb2c6cce6b97698098f50cbc78c23fdc0f8d401ab /Bev2slib.scm
parentf24b9140d6f74804d5599ec225717d38ca443813 (diff)
downloadslib-fa3f23105ddcf07c5900de47f19af43d1db1b597.tar.gz
slib-fa3f23105ddcf07c5900de47f19af43d1db1b597.zip
Import Upstream version 2c3upstream/2c3
Diffstat (limited to 'Bev2slib.scm')
-rw-r--r--Bev2slib.scm118
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* ")")
+ ))))