aboutsummaryrefslogtreecommitdiffstats
path: root/mklibcat.scm
diff options
context:
space:
mode:
Diffstat (limited to 'mklibcat.scm')
-rw-r--r--mklibcat.scm175
1 files changed, 175 insertions, 0 deletions
diff --git a/mklibcat.scm b/mklibcat.scm
new file mode 100644
index 0000000..050a3ba
--- /dev/null
+++ b/mklibcat.scm
@@ -0,0 +1,175 @@
+;"mklibcat.scm" Build catalog for SLIB
+;Copyright (C) 1997 Aubrey Jaffer
+;
+;Permission to copy this software, to redistribute it, and to use it
+;for any purpose is granted, subject to the following restrictions and
+;understandings.
+;
+;1. Any copy made of this software must include this copyright notice
+;in full.
+;
+;2. I have made no warrantee or representation that the operation of
+;this software will be error-free, and I am under no obligation to
+;provide any services, by way of maintenance, update, or otherwise.
+;
+;3. In conjunction with products arising from the use of this
+;material, there shall be no use of my name in any advertising,
+;promotional, or sales literature without prior written consent in
+;each case.
+
+(call-with-output-file (in-vicinity (implementation-vicinity) "slibcat")
+ (lambda (op)
+ (display ";\"slibcat\" SLIB catalog for " op)
+ (display (scheme-implementation-type) op)
+ (display (scheme-implementation-version) op)
+ (display ". -*-scheme-*-" op) (newline op)
+ (display ";" op) (newline op)
+ (display "; DO NOT EDIT THIS FILE -- it is automagically generated" op)
+ (newline op) (newline op)
+
+ (display "(" op) (newline op)
+ (for-each
+ (lambda (asp) (display " " op) (write asp op) (newline op))
+ (append
+ (list (cons 'schelog
+ (in-vicinity (sub-vicinity (library-vicinity) "schelog")
+ "schelog"))
+ (cons 'portable-scheme-debugger
+ (in-vicinity (sub-vicinity (library-vicinity) "psd")
+ "psd-slib")))
+ (map (lambda (p)
+ (if (symbol? (cdr p)) p
+ (cons
+ (car p)
+ (if (pair? (cdr p))
+ (cons
+ (cadr p)
+ (in-vicinity (library-vicinity) (cddr p)))
+ (in-vicinity (library-vicinity) (cdr p))))))
+ '(
+ (rev4-optional-procedures . "sc4opt")
+ (rev2-procedures . "sc2")
+ (multiarg/and- . "mularg")
+ (multiarg-apply . "mulapply")
+ (rationalize . "ratize")
+ (transcript . "trnscrpt")
+ (with-file . "withfile")
+ (dynamic-wind . "dynwind")
+ (dynamic . "dynamic")
+ (fluid-let macro . "fluidlet")
+ (alist . "alist")
+ (hash . "hash")
+ (sierpinski . "sierpinski")
+ (soundex . "soundex")
+ (hash-table . "hashtab")
+ (logical . "logical")
+ (random . "random")
+ (random-inexact . "randinex")
+ (modular . "modular")
+ (primes . "primes")
+ (factor . "factor")
+ (charplot . "charplot")
+ (sort . "sort")
+ (tsort . topological-sort)
+ (topological-sort . "tsort")
+ (common-list-functions . "comlist")
+ (tree . "tree")
+ (format . "format")
+ (generic-write . "genwrite")
+ (pretty-print . "pp")
+ (pprint-file . "ppfile")
+ (object->string . "obj2str")
+ (string-case . "strcase")
+ (stdio . "stdio")
+ (printf . "printf")
+ (scanf . "scanf")
+ (line-i/o . "lineio")
+ (string-port . "strport")
+ (getopt . "getopt")
+ (debug . "debug")
+ (qp . "qp")
+ (break defmacro . "break")
+ (trace defmacro . "trace")
+ ;;(eval . "eval")
+ (record . "record")
+ (promise . "promise")
+ (synchk . "synchk")
+ (defmacroexpand . "defmacex")
+ (macro-by-example defmacro . "mbe")
+ (syntax-case . "scainit")
+ (syntactic-closures . "scmacro")
+ (macros-that-work . "macwork")
+ (macro . macros-that-work)
+ (yasos macro . "yasos")
+ (oop . yasos)
+ (collect macro . "collect")
+ (struct defmacro . "struct")
+ (structure syntax-case . "structure")
+ (values . "values")
+ (queue . "queue")
+ (priority-queue . "priorque")
+ (array . "array")
+ (array-for-each . "arraymap")
+ (repl . "repl")
+ (process . "process")
+ (chapter-order . "chap")
+ (posix-time . "psxtime")
+ (common-lisp-time . "cltime")
+ (time-zone . "timezone")
+ (relational-database . "rdms")
+ (database-utilities . "dbutil")
+ (database-browse . "dbrowse")
+ (alist-table . "alistab")
+ (parameters . "paramlst")
+ (read-command . "comparse")
+ (batch . "batch")
+ (make-crc . "makcrc")
+ (wt-tree . "wttree")
+ (string-search . "strsrch")
+ (root . "root")
+ (precedence-parse . "prec")
+ (parse . precedence-parse)
+ (commutative-ring . "cring")
+ (self-set . "selfset")
+ (determinant . "determ")
+ (byte . "byte")
+ (tzfile . "tzfile")
+ (new-catalog . "mklibcat")
+ ))))
+ (display " " op)
+
+ (let* ((req (in-vicinity (library-vicinity)
+ (string-append "require" (scheme-file-suffix)))))
+ (write (cons '*SLIB-VERSION* (or (require:version req) *SLIB-VERSION*))
+ op))
+ (newline op)
+ (display ")" op) (newline op)
+
+ (let ((mkimpcat (in-vicinity (implementation-vicinity) "mkimpcat")))
+ (cond ((not (file-exists? mkimpcat))
+ (set! mkimpcat (string-append mkimpcat (scheme-file-suffix)))))
+ (cond ((file-exists? mkimpcat)
+ (slib:load-source mkimpcat))))
+
+ (let ((catcat
+ (lambda (vicinity name specificity)
+ (let ((path (in-vicinity vicinity name)))
+ (and (file-exists? path)
+ (call-with-input-file path
+ (lambda (ip)
+ (newline op)
+ (display "; " op)
+ (write path op)
+ (display " SLIB " op)
+ (display specificity op)
+ (display "-specific catalog additions" op)
+ (newline op) (newline op)
+ (do ((c (read-char ip) (read-char ip)))
+ ((eof-object? c))
+ (write-char c op)))))))))
+ (catcat (library-vicinity) "sitecat" "site")
+ (catcat (implementation-vicinity) "implcat" "implementation")
+ (catcat (implementation-vicinity) "sitecat" "site"))
+ ))
+
+(set! *catalog* #f)