source: project/release/5/chicken-belt/trunk/chicken-hatch.scm @ 35758

Last change on this file since 35758 was 35758, checked in by evhan, 2 years ago

chicken-belt: Add C5 port

  • Property svn:executable set to *
File size: 4.5 KB
Line 
1#!/bin/sh
2#| -*- mode: scheme -*-
3exec csi -s $0 "$@"
4|#
5
6(import (chicken file)
7        (except (chicken io) write-string)
8        (chicken pathname)
9        (chicken port)
10        (chicken process-context)
11        (matchable)
12        (srfi 1)
13        (srfi 13))
14
15(include "utils.scm")
16
17(define egg-name #f)
18(define egg-dir #f)
19(define egg-category #f)
20(define egg-license #f)
21(define egg-author #f)
22(define egg-synopsis #f)
23
24(define available-categories
25  '((lang-exts . "Language extensions")
26    (graphics . "Graphics")
27    (debugging . "Debugging tools")
28    (logic . "Logic programming")
29    (net . "Networking")
30    (io . "Input/Output")
31    (db . "Databases")
32    (os . "OS interface")
33    (ffi . "Interfacing to other languages")
34    (web . "Web programming")
35    (xml . "XML processing")
36    (doc-tools . "Documentation tools")
37    (egg-tools . "Egg tools")
38    (math . "Mathematical libraries")
39    (oop . "Object-oriented programming")
40    (data . "Algorithms and data-structures")
41    (parsing . "Data formats and parsing")
42    (tools . "Tools")
43    (sound . "Sound")
44    (testing . "Unit-testing")
45    (crypt . "Cryptography")
46    (ui . "User interface toolkits")
47    (code-generation . "Code generation")
48    (macros . "Macros and meta-syntax")
49    (misc . "Miscellaneous")
50    (hell . "Concurrency and parallelism")
51    (obsolete . "Unsupported or redundant")))
52
53(define (usage #!optional (print printf-newline) message)
54  (print "~AUsage: ~A [OPTION ...] EGG-NAME
55Create an egg directory named EGG-NAME in the current directory.
56
57Options:
58  -c, --category
59    the egg's category
60
61  -l, --license
62    the license the egg can be copied and used under
63
64  -h, --help
65    show this help"
66         (if message
67             (string-append message "\n\n")
68             "")
69         (pathname-file (program-name))))
70
71(let loop ((args (command-line-arguments)))
72  (match args
73    (()
74     (unless egg-name
75       (usage fail "Missing EGG-NAME")))
76    (((or "-h" "--help") rest ...)
77     (usage)
78     (exit))
79    (((or "-c" "--category") rest ...)
80     (when (null? rest)
81       (fail "Missing category option argument"))
82     (set! egg-category (string->symbol (car rest)))
83     (loop (cdr rest)))
84    (((or "-l" "--license") rest ...)
85     (when (null? rest)
86       (fail "Missing license argument"))
87     (set! egg-license (car rest))
88     (loop (cdr rest)))
89    ((name rest ...)
90     (set! egg-name name)
91     (loop rest))))
92
93(unless egg-dir
94  (set! egg-dir (make-pathname (current-directory) egg-name)))
95
96(when (file-exists? egg-name)
97  (fail "Egg directory already exists: ~A" egg-dir))
98
99(unless egg-category
100  (let loop ()
101    (for-each
102     (lambda (idx cat)
103       (printf "~A) ~A (~A)~%" idx (car cat) (cdr cat)))
104     (iota (length available-categories))
105     available-categories)
106    (newline)
107    (display "Choose egg category: ")
108    (let* ((choice (read-line))
109           (choice (and (not (eof-object? choice))
110                        (string->number choice)))
111           (choice (and choice
112                        (< choice (length available-categories))
113                        (list-ref available-categories choice))))
114      (if choice
115          (set! egg-category (car choice))
116          (loop)))))
117
118(unless (assq egg-category available-categories)
119  (fail "Invalid egg category: ~A" egg-category))
120
121(define (prompt-for prompt #!optional default)
122  (let loop ()
123    (newline)
124    (display prompt)
125    (let ((input (read-line)))
126      (if (or (eof-object? input)
127              (equal? (string-trim-both input) ""))
128          (or default (loop))
129          (string-trim-both input)))))
130
131(unless egg-license
132  (set! egg-license
133    (prompt-for "License (default is \"BSD\", same as CHICKEN): " "BSD")))
134
135(unless egg-author
136  (set! egg-author (prompt-for "Your name: ")))
137
138(unless egg-synopsis
139  (set! egg-synopsis (prompt-for "Egg synopsis: ")))
140
141(define egg-symbol
142  (string->symbol egg-name))
143
144(define (write-egg-file extension content)
145  (call-with-output-file (make-pathname egg-dir egg-name extension)
146    (lambda (out)
147      (display content out)
148      (newline out))))
149
150(define (write-string x)
151  (with-output-to-string (lambda () (write x))))
152
153(create-directory egg-dir #t)
154
155(write-egg-file "egg"
156#<#EOF
157((synopsis #(write-string egg-synopsis))
158 (author #(write-string egg-author))
159 (license #(write-string egg-license))
160 (category #egg-category)
161 (dependencies)
162 (test-dependencies)
163 (components (extension #egg-symbol)))
164EOF
165)
166
167(write-egg-file "scm"
168#<#EOF
169(module #egg-symbol ()
170
171(import (scheme) (chicken base))
172
173)
174EOF
175)
176
177(newline)
178(print "Successfully hatched " egg-name "!")
Note: See TracBrowser for help on using the repository browser.