module/slib/mklibcat.scm

   1 ;"mklibcat.scm" Build catalog for SLIB
   2 ;Copyright (C) 1997 Aubrey Jaffer
   3 ;
   4 ;Permission to copy this software, to redistribute it, and to use it
   5 ;for any purpose is granted, subject to the following restrictions and
   6 ;understandings.
   7 ;
   8 ;1.  Any copy made of this software must include this copyright notice
   9 ;in full.
  10 ;
  11 ;2.  I have made no warrantee or representation that the operation of
  12 ;this software will be error-free, and I am under no obligation to
  13 ;provide any services, by way of maintenance, update, or otherwise.
  14 ;
  15 ;3.  In conjunction with products arising from the use of this
  16 ;material, there shall be no use of my name in any advertising,
  17 ;promotional, or sales literature without prior written consent in
  18 ;each case.
  19
  20 (call-with-output-file (in-vicinity (implementation-vicinity) "slibcat")
  21   (lambda (op)
  22     (display ";\"slibcat\" SLIB catalog for " op)
  23     (display (scheme-implementation-type) op)
  24     (display (scheme-implementation-version) op)
  25     (display ".        -*-scheme-*-" op) (newline op)
  26     (display ";" op) (newline op)
  27     (display "; DO NOT EDIT THIS FILE -- it is automagically generated" op)
  28     (newline op) (newline op)
  29
  30     (display "(" op) (newline op)
  31     (for-each
  32      (lambda (asp) (display " " op) (write asp op) (newline op))
  33      (append
  34       (list (cons 'schelog
  35                   (in-vicinity (sub-vicinity (library-vicinity) "schelog")
  36                                "schelog"))
  37             (cons 'portable-scheme-debugger
  38                   (in-vicinity (sub-vicinity (library-vicinity) "psd")
  39                                "psd-slib"))
  40             (cons 'jfilter
  41                   (in-vicinity (sub-vicinity (library-vicinity) "jfilter")
  42                                "jfilter")))
  43       (map (lambda (p)
  44              (if (symbol? (cdr p)) p
  45                  (cons
  46                   (car p)
  47                   (if (pair? (cdr p))
  48                       (cons
  49                        (cadr p)
  50                        (in-vicinity (library-vicinity) (cddr p)))
  51                       (in-vicinity (library-vicinity) (cdr p))))))
  52            '(
  53              (rev4-optional-procedures  .       "sc4opt")
  54              (rev2-procedures           .       "sc2")
  55              (multiarg/and-             .       "mularg")
  56              (multiarg-apply            .       "mulapply")
  57              (rationalize               .       "ratize")
  58              (transcript                .       "trnscrpt")
  59              (with-file                 .       "withfile")
  60              (dynamic-wind              .       "dynwind")
  61              (dynamic                   .       "dynamic")
  62              (fluid-let         defmacro        .       "fluidlet")
  63              (alist                     .       "alist")
  64              (hash                      .       "hash")
  65              (sierpinski                .       "sierpinski")
  66              (soundex                   .       "soundex")
  67              (hash-table                .       "hashtab")
  68              (logical                   .       "logical")
  69              (random                    .       "random")
  70              (random-inexact            .       "randinex")
  71              (modular                   .       "modular")
  72              (factor                    .       "factor")
  73              (primes                    .       factor)
  74              (charplot                  .       "charplot")
  75              (sort                      .       "sort")
  76              (tsort                     .       topological-sort)
  77              (topological-sort          .       "tsort")
  78              (common-list-functions     .       "comlist")
  79              (tree                      .       "tree")
  80              (coerce                    .       "coerce")
  81              (format                    .       "format")
  82              (generic-write             .       "genwrite")
  83              (pretty-print              .       "pp")
  84              (pprint-file               .       "ppfile")
  85              (object->string            .       "obj2str")
  86              (string-case               .       "strcase")
  87              (stdio                     .       "stdio")
  88              (printf                    .       "printf")
  89              (scanf                     .       "scanf")
  90              (line-i/o                  .       "lineio")
  91              (string-port               .       "strport")
  92              (getopt                    .       "getopt")
  93              (debug                     .       "debug")
  94              (qp                        .       "qp")
  95              (break     defmacro        .       "break")
  96              (trace     defmacro        .       "trace")
  97              (eval                      .       "eval")
  98              (record                    .       "record")
  99              (promise                   .       "promise")
 100              (synchk                    .       "synchk")
 101              (defmacroexpand            .       "defmacex")
 102              (macro-by-example  defmacro        .       "mbe")
 103              (syntax-case               .       "scainit")
 104              (syntactic-closures        .       "scmacro")
 105              (macros-that-work          .       "macwork")
 106              (macro                     .       macro-by-example)
 107              (object                    .       "object")
 108              (yasos             macro   .       "yasyn")
 109              (oop                       .       yasos)
 110              (collect           macro   .       "collect")
 111              (struct    defmacro        .       "struct")
 112              (structure syntax-case     .       "structure")
 113              (values                    .       "values")
 114              (queue                     .       "queue")
 115              (priority-queue            .       "priorque")
 116              (array                     .       "array")
 117              (array-for-each            .       "arraymap")
 118              (repl                      .       "repl")
 119              (process                   .       "process")
 120              (chapter-order             .       "chap")
 121              (posix-time                .       "psxtime")
 122              (common-lisp-time          .       "cltime")
 123              (time-zone                 .       "timezone")
 124              (relational-database       .       "rdms")
 125              (database-utilities        .       "dbutil")
 126              (database-browse           .       "dbrowse")
 127              (html-form                 .       "htmlform")
 128              (alist-table               .       "alistab")
 129              (parameters                .       "paramlst")
 130              (getopt-parameters         .       "getparam")
 131              (read-command              .       "comparse")
 132              (batch                     .       "batch")
 133              (glob                      .       "glob")
 134              (filename                  .       glob)
 135              (make-crc                  .       "makcrc")
 136              (fft                       .       "fft")
 137              (wt-tree                   .       "wttree")
 138              (string-search             .       "strsrch")
 139              (root                      .       "root")
 140              (minimize                  .       "minimize")
 141              (precedence-parse          .       "prec")
 142              (parse                     .       precedence-parse)
 143              (commutative-ring          .       "cring")
 144              (self-set                  .       "selfset")
 145              (determinant               .       "determ")
 146              (byte                      .       "byte")
 147              (tzfile                    .       "tzfile")
 148              (schmooz                   .       "schmooz")
 149              (net-clients               .       "nclients")
 150              (db->html                  .       "db2html")
 151              (http                      .       "http-cgi")
 152              (cgi                       .       http)
 153              (uri                       .       "uri")
 154              (uniform-resource-identifier .     uri)
 155              (pnm                       .       "pnm")
 156              (metric-units              .       "simetrix")
 157              (new-catalog               .       "mklibcat")
 158              ))))
 159     (display " " op)
 160
 161     (let* ((req (in-vicinity (library-vicinity)
 162                              (string-append "require" (scheme-file-suffix)))))
 163       (write (cons '*SLIB-VERSION* (or (require:version req) *SLIB-VERSION*))
 164              op))
 165     (newline op)
 166     (display ")" op) (newline op)
 167
 168     (let ((load-if-exists
 169            (lambda (path)
 170              (cond ((not (file-exists? path))
 171                     (set! path (string-append path (scheme-file-suffix)))))
 172              (cond ((file-exists? path)
 173                     (slib:load-source path))))))
 174       ;;(load-if-exists (in-vicinity (implementation-vicinity) "mksitcat"))
 175       (load-if-exists (in-vicinity (implementation-vicinity) "mkimpcat")))
 176
 177     (let ((catcat
 178            (lambda (vicinity name specificity)
 179              (let ((path (in-vicinity vicinity name)))
 180                (and (file-exists? path)
 181                     (call-with-input-file path
 182                       (lambda (ip)
 183                         (newline op)
 184                         (display "; " op)
 185                         (write path op)
 186                         (display " SLIB " op)
 187                         (display specificity op)
 188                         (display "-specific catalog additions" op)
 189                         (newline op) (newline op)
 190                         (do ((c (read-char ip) (read-char ip)))
 191                             ((eof-object? c))
 192                           (write-char c op)))))))))
 193       (catcat (library-vicinity) "sitecat" "site")
 194       (catcat (implementation-vicinity) "implcat" "implementation")
 195       (catcat (implementation-vicinity) "sitecat" "site"))
 196     ))
 197
 198 (set! *catalog* #f)