1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273
|
;"mklibcat.scm" Build catalog for SLIB
;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
;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 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.
;
;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.
(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* "(")
(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)
(cons
(if (provided? 'defmacro)
'(fluid-let defmacro "fluidlet")
'(fluid-let macro "fluidlet"))
'(
;; null is the start of SLIB associations.
(null source "null")
(aggregate source "null")
(r2rs aggregate rev3-procedures rev2-procedures)
(r3rs aggregate rev3-procedures)
(r4rs aggregate rev4-optional-procedures)
(r5rs aggregate values macro eval)
(rev4-optional-procedures source "sc4opt")
(rev3-procedures source "null")
(rev2-procedures source "sc2")
(multiarg/and- source "mularg")
(multiarg-apply source "mulapply")
(rationalize source "ratize")
(transcript source "trnscrpt")
(with-file source "withfile")
(dynamic-wind source "dynwind")
(dynamic source "dynamic")
(alist source "alist")
(hash source "hash")
(sierpinski source "sierpinski")
(hilbert-fill source "phil-spc")
(peano-fill source "peanosfc")
(space-filling source "rmdsff")
(soundex source "soundex")
(hash-table source "hashtab")
(logical source "logical")
(random source "random")
(random-inexact source "randinex")
(modular source "modular")
(factor source "factor")
(primes factor)
(limit source "limit")
(eps-graph source "grapheps")
(charplot source "charplot")
(sort source "sort")
(srfi-95 sort)
(tsort topological-sort)
(topological-sort source "tsort")
(common-list-functions source "comlist")
(tree source "tree")
(coerce source "coerce")
(format source "format")
(generic-write source "genwrite")
(pretty-print source "pp")
(pprint-file source "ppfile")
(object->string source "obj2str")
(string-case source "strcase")
(line-i/o source "lineio")
(string-port source "strport")
(getopt source "getopt")
(qp source "qp")
(eval source "eval")
(record source "record")
(synchk source "synchk")
(defmacroexpand source "defmacex")
(printf source "printf")
(scanf defmacro "scanf")
(stdio-ports source "stdio")
(stdio aggregate scanf printf stdio-ports)
(break defmacro "break")
(trace defmacro "trace")
(debugf source "debug")
(debug aggregate trace break debugf)
(delay promise)
(promise macro "promise")
(macro-by-example defmacro "mbe")
(syntax-case source "scainit")
(syntactic-closures source "scmacro")
(macros-that-work source "macwork")
(macro macro-by-example)
(object source "object")
(yasos macro "yasyn")
(oop yasos)
(collect macro "collectx")
(structure syntax-case "structure")
(values source "values")
(queue source "queue")
(priority-queue source "priorque")
(array source "array")
(subarray source "subarray")
(array-for-each source "arraymap")
(array-interpolate source "linterp")
(repl source "repl")
(process source "process")
(chapter-order source "chap")
(posix-time source "psxtime")
(common-lisp-time source "cltime")
(iso-8601 source "iso8601")
(time-core source "timecore")
(time-zone defmacro "timezone")
(relational-database source "rdms")
(databases source "dbutil")
(database-utilities databases)
(database-commands source "dbcom")
(database-browse source "dbrowse")
(database-interpolate source "dbinterp")
(within-database macro "dbsyn")
(html-form source "htmlform")
(alist-table source "alistab")
(parameters source "paramlst")
(getopt-parameters source "getparam")
(read-command source "comparse")
(batch source "batch")
(glob source "glob")
(filename glob)
(crc source "crc")
(dft source "dft")
(fft dft)
(Fourier-transform dft)
(wt-tree source "wttree")
(string-search source "strsrch")
(root source "root")
(minimize source "minimize")
(precedence-parse source "prec")
(parse precedence-parse)
(commutative-ring source "cring")
(self-set source "selfset")
(determinant source "determ")
(byte source "byte")
(byte-number source "bytenumb")
(tzfile source "tzfile")
(schmooz source "schmooz")
(transact defmacro "transact")
(net-clients transact)
(db->html source "db2html")
(http defmacro "http-cgi")
(cgi http)
(uri defmacro "uri")
(uniform-resource-identifier uri)
(pnm source "pnm")
(metric-units source "simetrix")
(diff source "differ")
(solid source "solid")
(vrml97 solid)
(vrml vrml97)
(color defmacro "color")
(color-space source "colorspc")
(cie color-space)
(color-names source "colornam")
(color-database defmacro "mkclrnam")
(resene color-names "clrnamdb.scm")
(saturate color-names "clrnamdb.scm")
(nbs-iscc color-names "clrnamdb.scm")
(daylight source "daylight")
(matfile source "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 source "dirs")
(ncbi-dna defmacro "ncbi-dna")
(manifest source "manifest")
(top-refs source "top-refs")
(vet source "vet")
(srfi srfi-0)
(srfi-0 defmacro "srfi")
(srfi-1 source "srfi-1")
(and-let* srfi-2)
(srfi-2 defmacro "srfi-2")
(receive srfi-8)
(srfi-8 macro "srfi-8")
(define-record-type srfi-9)
(srfi-9 macro "srfi-9")
(let-values srfi-11)
(srfi-11 macro "srfi-11")
(srfi-28 format)
(srfi-39 macro "srfi-39")
(srfi-47 array)
(srfi-63 array)
(srfi-60 logical)
(guarded-cond-clause srfi-61)
(srfi-61 macro "srfi-61")
(srfi-23 source "srfi-23")
(math-integer source "math-integer")
(math-real source "math-real")
(srfi-94 aggregate math-integer math-real)
(ssax xml-parse)
(xml-parse source "xml-parse")
(new-catalog source "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 ((file-exists? (string-append path (scheme-file-suffix)))
(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))
|