scsh-conservatory
/
sunterlib
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

init snow

This commit is contained in:
erana 2012-01-28 02:05:43 +09:00
parent 8bd7a8994e
commit e5eccd8ef7
10 changed files with 171 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
scsh/CSAN/packages.scm
View File

@ -3,7 +3,7 @@
CSAN-question~))
(define-structure CSAN
schemedoc-interface
CSAN-interface
(open scheme)
(files CSAN-client CSAN-server CSAN load CSAN-util))

1
scsh/snow/AUTHORS Normal file
View File

@ -0,0 +1 @@
Copyright (C) 2012 Johan Ceuppens

1
scsh/snow/BLURB Normal file
View File

@ -0,0 +1 @@
Snow : Scheme remote packaging system

2
scsh/snow/NEWS Normal file
View File

@ -0,0 +1,2 @@
version 0.1
* client-server functionality

2
scsh/snow/README Normal file
View File

@ -0,0 +1,2 @@
A client-server system for getting scsh packages over the net.
Snow isin the r7rs scheme working group

53
scsh/snow/htmldump.scm Normal file
View File

@ -0,0 +1,53 @@
;;; load.scm - a scheme CSAN
;;;
;;; Copyright (c) 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 (html-dump htmlfile)
(let ((in (open-input-file htmlfile))
(contents ""))
(define (f c tagged)
(if (= tagged 0) (string c) ""))
(define (read-html-file contents)
(let ((tagged 0))
(do ((c (read-char in) (read-char in)))
((eof-object? c)contents)
(cond ((and (= tagged 0)(eq? c #\<))
(set! tagged (+ tagged 1)))
((and (> tagged 0)(eq? c #\<))
(set! tagged (+ tagged 1)))
((and (= tagged 0)(eq? c #\>))
(set! tagged (- tagged 1)))
((and (> tagged 0)(eq? c #\>))
(set! tagged (- tagged 1)))
((< tagged 0)
(display "html-dump : bad html.")(newline)
(set! tagged 0))
)
(set! contents (string-append contents (f c tagged))))))
(read-html-file contents)))

28
scsh/snow/load.scm Normal file
View File

@ -0,0 +1,28 @@
;;; load.scm - a scheme CSAN
;;;
;;; Copyright (c) 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.

9
scsh/snow/packages.scm Normal file
View File

@ -0,0 +1,9 @@
(define-interface snow-interface
(export
parse-for snow-repository))
(define-structure snow
snow-interface
(open scheme)
(files snow))

13
scsh/snow/pkg-def.scm Normal file
View File

@ -0,0 +1,13 @@
(define-package "snow"
(0 1)
((install-lib-version (1 3 0)))
(write-to-load-script
`((config)
(load ,(absolute-file-name "packages.scm"
(get-directory 'scheme #f)))))
(install-file "README" 'doc)
(install-file "NEWS" 'doc)
(install-string (COPYING) "COPYING" 'doc)
(install-file "packages.scm" 'scheme)
(install-file "load.scm" 'scheme)
(install-file "snow.scm" 'scheme))

61
scsh/snow/snow-repository.scm Normal file
View File

@ -0,0 +1,61 @@
;;; Snow-repository.scm - Snow implementation
;;;
;;; Copyright (c) 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 (parse-for s index)
(let ((word "("))
(do ((i index (+ i 1)))
((cond ((string=? s word)
;;(set! index i))
i)
((eq? (string-ref s i) #\newline)
#t));;(string-set! s i ""
(set! word (string-append word (string (string-ref s i))))))))
(define (parse-for-url s index)
(let ((word "")
(index (+ index 1)))
(if (eq? (string-ref s (- index 1))
#\")
(do ((i index (+ i 1)))
((eq? (string-ref s i) #\")
(string-append s (string #\")))
(set! word (string-append word (string (string-ref s i)))))
(error "parse-for-url : malformed url string"))))
(define (snow-repository db)
(let ((index 0)
(db db))
(cond ((let ((index2 (parse-for "repository" index)))
(cond ((let ((index3 (parse-for "package" index2))))
(cond ((let ((index4 (parse-for "url" index3))))
((cond (let ((url parse-for-url index4))))
(set! db (append db (cons "url" url)
))))))))))))