diff options
Diffstat (limited to 'mklibcat.scm')
| -rw-r--r-- | mklibcat.scm | 175 |
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) |