From be91c616f64456af6c45e6276cfe6e118584e3ad Mon Sep 17 00:00:00 2001 From: erana Date: Wed, 18 Jan 2012 00:53:57 +0900 Subject: [PATCH] SPAN - question 1 --- scsh/SPAN/SPAN.scm | 5 +- scsh/SPAN/load.scm | 6 +- scsh/SPAN/pkg-def.scm | 4 +- scsh/SPAN/schemedoc.scm | 131 ---------------------------------------- 4 files changed, 10 insertions(+), 136 deletions(-) delete mode 100644 scsh/SPAN/schemedoc.scm diff --git a/scsh/SPAN/SPAN.scm b/scsh/SPAN/SPAN.scm index 492feb6..15d9dc6 100644 --- a/scsh/SPAN/SPAN.scm +++ b/scsh/SPAN/SPAN.scm @@ -32,7 +32,7 @@ configuration. The CPAN module needs a directory of its own to cache important index files and maybe keep a temporary mirror of CPAN files. This may be a site-wide or a personal directory." -(define (SPAN-question~ droptext question answer defaultchoice) +(define (SPAN-question~ droptext question answer defaultchoice procedure) (let ((s "")) (display droptext) (newline) @@ -49,5 +49,6 @@ This may be a site-wide or a personal directory." (set! answer defaultchoice)) ((string? (symbol->string s)) (set! answer (symbol->string s))) - (else (SPAN-question~ droptext question answer defaultchoice))))) + (else (SPAN-question~ droptext question answer defaultchoice))) + (procedure answer))) diff --git a/scsh/SPAN/load.scm b/scsh/SPAN/load.scm index bc687a3..6418c31 100644 --- a/scsh/SPAN/load.scm +++ b/scsh/SPAN/load.scm @@ -31,4 +31,8 @@ (SPAN-question~ SPAN-shell-droptext-1 "SPAN build and cache directory" "" - (string-append (getenv "HOME") "/.span")) + (string-append (getenv "HOME") "/.span") + (lambda (answer) + (let ((dir (create-directory answer))) + (file-directory? answer) + ))) diff --git a/scsh/SPAN/pkg-def.scm b/scsh/SPAN/pkg-def.scm index f9f564f..ec1afbe 100644 --- a/scsh/SPAN/pkg-def.scm +++ b/scsh/SPAN/pkg-def.scm @@ -9,7 +9,7 @@ (install-file "NEWS" 'doc) (install-string (COPYING) "COPYING" 'doc) (install-file "packages.scm" 'scheme) - (install-file "client.scm" 'scheme) - (install-file "server.scm" 'scheme) + (install-file "SPAN-client.scm" 'scheme) + (install-file "SPAN-server.scm" 'scheme) (install-file "load.scm" 'scheme) (install-file "SPAN.scm" 'scheme)) diff --git a/scsh/SPAN/schemedoc.scm b/scsh/SPAN/schemedoc.scm deleted file mode 100644 index b237000..0000000 --- a/scsh/SPAN/schemedoc.scm +++ /dev/null @@ -1,131 +0,0 @@ -;;; schemedoc.scm - a scheme perldoc utility -;;; -;;; Copyright (c) 2011-2012 Johan Ceuppens -;;; -;;; All rights reserved. -;;; -;;; Redistribution and use in source and binary forms, with or without -;;; modification, are permitted provided that the following conditions -;;; are met: -;;; 1. Redistributions of source code must retain the above copyright -;;; notice, this list of conditions and the following disclaimer. -;;; 2. Redistributions in binary form must reproduce the above copyright -;;; notice, this list of conditions and the following disclaimer in the -;;; documentation and/or other materials provided with the distribution. -;;; 3. The name of the authors may not be used to endorse or promote products -;;; derived from this software without specific prior written permission. -;;; -;;; THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR -;;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES -;;; OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. -;;; IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY DIRECT, INDIRECT, -;;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT -;;; NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -;;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -;;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -;;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -;;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - - -(define (eoln)(string #\newline)) - -(define sod-regexp1 (rx (| "=item"))) - -(define (sod regexp filename) - (let ((in (open-input-file filename))) - (let ((contents "")) - (do ((s (read-char in)(read-char in))) - ((eof-object? s) contents)) - (string-match regexp contents)))) - - -(define (schemedoc-print-doc filename) - (let ((l (list (sod (if (regexp? sod-regexp1) - sod-regexp1 - (rx (""))) - filename)))) - (for-each display l))) - -(define (schemedoc-print-doc-to-file filename outfilename) - (let ((out (open-output-file outfilename))) - (let ((l (list (sod (if (regexp? sod-regexp1) - sod-regexp1 - (rx (""))) - filename)))) - (define (display-rec ll) - (do ((e ll (cdr e))) - ((null? e)0) - (display (car e) out))) - (display-rec l)))) -;; -;; parser : -;; -;; make a list of chars from filename contents -;; - -(define (schemedoc-parser-doc filename) - (define (parse in) - (let ((c (read-char in))) - (if (eof-object? c) - c - (append (list c) (parse in))))) - - (define (read-rec in) - (call-with-values - (lambda () - (parse in) - ) - (lambda (l) - ;;(write l) - l))) - - (let ((in (open-input-file filename))) ;; FIXME with- - (read-rec in))) - -(define (schemedoc-parser-grep filename) - (let ((le (schemedoc-parser-doc filename)) - (line "") - (headline "") - (itemlines '()) - (itemtext "") - (itemtexts '()) - ) - (do ((l le (cdr l))) - ((eof-object? l)0) - (cond ((and (eq? (car l) #\newline)(string<=? "=item" line)) - (set! itemlines (append itemlines (list line))) - (set! line "") - (set! itemtexts (append itemtexts (list itemtext))) - (set! itemtext "")) - ((and (eq? (car l) #\newline)(string<=? "=head" line)) - (set! headline line) - (set! line "")) - ;;((eq? (car l) #\newline) - - ) - (set! line (string-append line (string (car l)))) - (set! itemtext (string-append itemtext (string (car l)))) - ) - itemtexts - )) - -(define (schemedoc-get-env-list SCHEMEDOCDIR) - (let ((directory "") - (directories '())) - (do ((i 0 (+ i 1))) - ((>= i (string-length SCHEMEDOCDIR)) - (set! directories (append directories (list directory)))) - (if (eq? (string-ref SCHEMEDOCDIR i) #\:) - (begin - (set! directories (append directories (list directory))) - (set! directory ""))) - (set! directory (string-append directory (string (string-ref SCHEMEDOCDIR i))))) - directories)) - -(define (schemedoc-parser-get-items keyword itemtexts) - (let ((returntext "")) - (do ((l itemtexts (cdr l))) - ((null? l)0) - (cond ((string<=? keyword (car l)) - (set! returntext (string-append returntext (car l)))))) - returntext)) \ No newline at end of file