diff --git a/scsh/CSAN/packages.scm b/scsh/CSAN/packages.scm index 36b1899..51dfd6a 100644 --- a/scsh/CSAN/packages.scm +++ b/scsh/CSAN/packages.scm @@ -3,7 +3,7 @@ CSAN-question~)) (define-structure CSAN - schemedoc-interface + CSAN-interface (open scheme) (files CSAN-client CSAN-server CSAN load CSAN-util)) diff --git a/scsh/snow/AUTHORS b/scsh/snow/AUTHORS new file mode 100644 index 0000000..7ade9bb --- /dev/null +++ b/scsh/snow/AUTHORS @@ -0,0 +1 @@ +Copyright (C) 2012 Johan Ceuppens diff --git a/scsh/snow/BLURB b/scsh/snow/BLURB new file mode 100644 index 0000000..f95ef6b --- /dev/null +++ b/scsh/snow/BLURB @@ -0,0 +1 @@ +Snow : Scheme remote packaging system diff --git a/scsh/snow/NEWS b/scsh/snow/NEWS new file mode 100644 index 0000000..e46532d --- /dev/null +++ b/scsh/snow/NEWS @@ -0,0 +1,2 @@ +version 0.1 +* client-server functionality diff --git a/scsh/snow/README b/scsh/snow/README new file mode 100644 index 0000000..38f7c92 --- /dev/null +++ b/scsh/snow/README @@ -0,0 +1,2 @@ +A client-server system for getting scsh packages over the net. +Snow isin the r7rs scheme working group diff --git a/scsh/snow/htmldump.scm b/scsh/snow/htmldump.scm new file mode 100644 index 0000000..cae9d2b --- /dev/null +++ b/scsh/snow/htmldump.scm @@ -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))) diff --git a/scsh/snow/load.scm b/scsh/snow/load.scm new file mode 100644 index 0000000..3ac4399 --- /dev/null +++ b/scsh/snow/load.scm @@ -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. + diff --git a/scsh/snow/packages.scm b/scsh/snow/packages.scm new file mode 100644 index 0000000..482f797 --- /dev/null +++ b/scsh/snow/packages.scm @@ -0,0 +1,9 @@ +(define-interface snow-interface + (export + parse-for snow-repository)) + +(define-structure snow + snow-interface + (open scheme) + (files snow)) + diff --git a/scsh/snow/pkg-def.scm b/scsh/snow/pkg-def.scm new file mode 100644 index 0000000..b9a3a1a --- /dev/null +++ b/scsh/snow/pkg-def.scm @@ -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)) diff --git a/scsh/snow/snow-repository.scm b/scsh/snow/snow-repository.scm new file mode 100644 index 0000000..98df317 --- /dev/null +++ b/scsh/snow/snow-repository.scm @@ -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) + )))))))))))) + +