diff options
Diffstat (limited to 'mklibcat.scm')
| -rw-r--r-- | mklibcat.scm | 401 |
1 files changed, 222 insertions, 179 deletions
diff --git a/mklibcat.scm b/mklibcat.scm index 5b7d211..d41e2e6 100644 --- a/mklibcat.scm +++ b/mklibcat.scm @@ -1,5 +1,5 @@ ;"mklibcat.scm" Build catalog for SLIB -;Copyright (C) 1997 Aubrey Jaffer +;Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003 Aubrey Jaffer ; ;Permission to copy this software, to modify it, to redistribute it, ;to distribute modified versions, and to use it for any purpose is @@ -8,7 +8,7 @@ ;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 +;2. I have made no warranty 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. ; @@ -17,185 +17,228 @@ ;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) +(let ((catpath (in-vicinity (implementation-vicinity) "slibcat"))) + (and (file-exists? catpath) (delete-file catpath)) + (call-with-output-file catpath + (lambda (op) + (define (display* . args) + (for-each (lambda (arg) (display arg op)) args) + (newline op)) + (define (write* asp) + (display " " op) (write asp op) (newline op)) + (display* ";\"slibcat\" SLIB catalog for " + (scheme-implementation-type) (scheme-implementation-version) + ". -*-scheme-*-") + (display* ";") + (display* "; DO NOT EDIT THIS FILE -- it is automagically generated") + (display*) - (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")) - (cons 'jfilter - (in-vicinity (sub-vicinity (library-vicinity) "jfilter") - "jfilter"))) - (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 defmacro . "fluidlet") - (alist . "alist") - (hash . "hash") - (sierpinski . "sierpinski") - (soundex . "soundex") - (hash-table . "hashtab") - (logical . "logical") - (random . "random") - (random-inexact . "randinex") - (modular . "modular") - (factor . "factor") - (primes . factor) - (charplot . "charplot") - (sort . "sort") - (tsort . topological-sort) - (topological-sort . "tsort") - (common-list-functions . "comlist") - (tree . "tree") - (coerce . "coerce") - (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 . macro-by-example) - (object . "object") - (yasos macro . "yasyn") - (oop . yasos) - (collect macro . "collect") - (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") - (html-form . "htmlform") - (alist-table . "alistab") - (parameters . "paramlst") - (getopt-parameters . "getparam") - (read-command . "comparse") - (batch . "batch") - (glob . "glob") - (filename . glob) - (make-crc . "makcrc") - (fft . "fft") - (wt-tree . "wttree") - (string-search . "strsrch") - (root . "root") - (minimize . "minimize") - (precedence-parse . "prec") - (parse . precedence-parse) - (commutative-ring . "cring") - (self-set . "selfset") - (determinant . "determ") - (byte . "byte") - (tzfile . "tzfile") - (schmooz . "schmooz") - (net-clients . "nclients") - (db->html . "db2html") - (http . "http-cgi") - (cgi . http) - (uri . "uri") - (uniform-resource-identifier . uri) - (pnm . "pnm") - (metric-units . "simetrix") - (diff . "differ") - (srfi-0 . srfi) - (srfi defmacro . "srfi") - (srfi-1 . "srfi-1") - (new-catalog . "mklibcat") - )))) - (display " " op) + (display* "(") + (for-each + write* + (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")) + (cons 'jfilter + (in-vicinity (sub-vicinity (library-vicinity) "jfilter") + "jfilter"))) + (catalog:resolve + (library-vicinity) + '( + ;; null is the start of SLIB associations. + (null "null") + (aggregate "null") + (r2rs aggregate rev3-procedures rev2-procedures) + (r3rs aggregate rev3-procedures) + (r4rs aggregate rev4-optional-procedures) + (r5rs aggregate values macro eval) + (rev4-optional-procedures "sc4opt") + (rev3-procedures "null") + (rev2-procedures "sc2") + (multiarg/and- "mularg") + (multiarg-apply "mulapply") + (rationalize "ratize") + (transcript "trnscrpt") + (with-file "withfile") + (dynamic-wind "dynwind") + (dynamic "dynamic") + (fluid-let defmacro "fluidlet") + (alist "alist") + (hash "hash") + (sierpinski "sierpinski") + (hilbert-fill "phil-spc") + (soundex "soundex") + (hash-table "hashtab") + (logical "logical") + (random "random") + (random-inexact "randinex") + (modular "modular") + (factor "factor") + (primes factor) + (eps-graph "grapheps") + (charplot "charplot") + (sort "sort") + (tsort topological-sort) + (topological-sort "tsort") + (common-list-functions "comlist") + (tree "tree") + (coerce "coerce") + (format "format") + (generic-write "genwrite") + (pretty-print "pp") + (pprint-file "ppfile") + (object->string "obj2str") + (string-case "strcase") + (line-i/o "lineio") + (string-port "strport") + (getopt "getopt") + (qp "qp") + (eval "eval") + (record "record") + (synchk "synchk") + (defmacroexpand "defmacex") - (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) + (printf "printf") + (scanf defmacro "scanf") + (stdio-ports "stdio") + (stdio aggregate scanf printf stdio-ports) - (let ((load-if-exists - (lambda (path) - (cond ((not (file-exists? path)) - (set! path (string-append path (scheme-file-suffix))))) - (cond ((file-exists? path) - (slib:load-source path)))))) - ;;(load-if-exists (in-vicinity (implementation-vicinity) "mksitcat")) - (load-if-exists (in-vicinity (implementation-vicinity) "mkimpcat"))) + (break defmacro "break") + (trace defmacro "trace") + (debugf "debug") + (debug aggregate trace break debugf) - (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")) - )) + (delay promise) + (promise macro "promise") -(set! *catalog* #f) + (macro-by-example defmacro "mbe") + + (syntax-case "scainit") + (syntactic-closures "scmacro") + (macros-that-work "macwork") + (macro macro-by-example) + (object "object") + (yasos macro "yasyn") + (oop yasos) + (collect "collectx") + (structure syntax-case "structure") + (values "values") + (queue "queue") + (priority-queue "priorque") + (array "array") + (subarray "subarray") + (array-for-each "arraymap") + (repl "repl") + (process "process") + (chapter-order "chap") + (posix-time "psxtime") + (common-lisp-time "cltime") + (time-zone defmacro "timezone") + (relational-database "rdms") + (databases "dbutil") + (database-utilities databases) + (database-commands "dbcom") + (database-browse "dbrowse") + (database-interpolate "dbinterp") + (within-database macro "dbsyn") + (html-form "htmlform") + (alist-table "alistab") + (parameters "paramlst") + (getopt-parameters "getparam") + (read-command "comparse") + (batch "batch") + (glob "glob") + (filename glob) + (crc "crc") + (fft "fft") + (wt-tree "wttree") + (string-search "strsrch") + (root "root") + (minimize "minimize") + (precedence-parse defmacro "prec") + (parse precedence-parse) + (commutative-ring "cring") + (self-set "selfset") + (determinant "determ") + (byte "byte") + (byte-number "bytenumb") + (tzfile "tzfile") + (schmooz "schmooz") + (transact defmacro "transact") + (net-clients transact) + (db->html "db2html") + (http defmacro "http-cgi") + (cgi http) + (uri defmacro "uri") + (uniform-resource-identifier uri) + (pnm "pnm") + (metric-units "simetrix") + (diff "differ") + (solid "solid") + (vrml97 solid) + (vrml vrml97) + (color defmacro "color") + (color-space "colorspc") + (cie color-space) + (color-names "colornam") + (color-database defmacro "mkclrnam") + (resene color-names "clrnamdb.scm") + (saturate color-names "clrnamdb.scm") + (daylight "daylight") + (matfile "matfile") + (mat-file matfile) + (spectral-tristimulus-values color-space) + (cie1964 spectral-tristimulus-values "cie1964.xyz") + (cie1931 spectral-tristimulus-values "cie1931.xyz") + (ciexyz cie1931) + (cvs defmacro "cvs") + (html-for-each defmacro "html4each") + (directory "dirs") + (ncbi-dna defmacro "ncbi-dna") + (manifest "manifest") + (top-refs "top-refs") + (vet "vet") + (srfi-0 srfi) + (srfi defmacro "srfi") + (srfi-1 "srfi-1") + (srfi-2 defmacro "srfi-2") + (srfi-8 macro "srfi-8") + (srfi-9 macro "srfi-9") + (new-catalog "mklibcat") + )))) + (let* ((req (in-vicinity (library-vicinity) + (string-append "require" (scheme-file-suffix))))) + (write* (cons '*SLIB-VERSION* (or (slib:version req) *SLIB-VERSION*)))) + (display* ")") + + (let ((load-if-exists + (lambda (path) + (cond ((not (file-exists? path)) + (set! path (string-append path (scheme-file-suffix))))) + (cond ((file-exists? path) + (slib:load-source path)))))) + ;;(load-if-exists (in-vicinity (implementation-vicinity) "mksitcat")) + (load-if-exists (in-vicinity (implementation-vicinity) "mkimpcat"))) + + (let ((catcat + (lambda (vicinity name specificity) + (let ((path (in-vicinity vicinity name))) + (and (file-exists? path) + (call-with-input-file path + (lambda (ip) + (display*) + (display* "; " "\"" path "\"" " SLIB " + specificity "-specific catalog additions") + (display*) + (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)) |