diff options
Diffstat (limited to 'Bev2slib.scm')
-rw-r--r-- | Bev2slib.scm | 118 |
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* ")") + )))) |