SPAN - client get command - 2

scsh/SPAN/SPAN.scm

@@ -42,8 +42,10 @@
            (set! answer defaultchoice))
           ((string=? (symbol->string s)(string #\return))
            (set! answer defaultchoice))
-          ((string? (symbol->string s))
+          ((and (symbol? s)(string? (symbol->string s)))
            (set! answer (symbol->string s)))
+          ((and (number? s)(string? (number->string s)))
+           (set! answer (number->string s)))
           (else (SPAN-question~ droptext question answer defaultchoice)))
     (procedure answer)))
 
@@ -213,3 +215,4 @@ a valid CPAN URL now.
 
 cpan shell -- CPAN exploration and modules installation (v1.9402)
 Enter 'h' for help.")
+

scsh/SPAN/load.scm

@@ -26,6 +26,7 @@
 ;;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
 ;;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
+(load "SPAN-util.scm")
 (load "SPAN.scm")
 (load "SPAN-client.scm")
 
@@ -35,10 +36,21 @@
 ;; h : display help
 ;; get : fetch file
 
+(define answer "")
+
 ;; question 1
 
 (define SPAN-build-and-cache-dir (string-append (getenv "HOME") "/.span"))
 (define SPAN-download-target-dir (string-append (getenv "HOME") "/.span"))
+(define SPAN-mirror-url "ask")
+
+(cond
+ ((and (file-exists? SPAN-build-and-cache-dir)
+       (file-exists? (string-append SPAN-build-and-cache-dir "/mirror")))
+  (let ((SPAN-mirror-url (make-string-input-port
+                          (open-input-file (string-append SPAN-build-and-cache-dir "/mirror")))))
+    (SPAN-shell-spawn SPAN-mirror-url)))
+ (else
   ;;prototype (define (SPAN-question~ droptext question answer defaultchoice)
   (SPAN-question~ SPAN-shell-droptext-1
                   "SPAN build and cache directory"
@@ -50,7 +62,7 @@
                           (set! SPAN-build-and-cache-dir answer)
                           #f))))
 
-(define SPAN-download-target-dir (string-append SPAN-build-and-cache-dir "/" "sources")
+  (define SPAN-download-target-dir (string-append SPAN-build-and-cache-dir "/" "sources"))
     (SPAN-question~ SPAN-shell-droptext-2
                     "Download target directory"
                     ""
@@ -61,7 +73,7 @@
                             (set! SPAN-download-target-dir answer)
                             #f))))
 
-(define SPAN-build-dir (string-append SPAN-build-and-cache-dir "/" "build")
+    (define SPAN-build-dir (string-append SPAN-build-and-cache-dir "/" "build"))
       (SPAN-question~ SPAN-shell-droptext-3
                   "Directory where the build process takes place?"
                   ""
@@ -133,13 +145,15 @@
 
       ;; ... until 20
 
-(define SPAN-mirror-url "ask")
+
       (SPAN-question~ SPAN-shell-droptext-20
                       "Please enter the URL of your CPAN mirror "
                       ""
                       SPAN-mirror-url
                       (lambda (answer)
                         (set! SPAN-mirror-url answer)
+                        (let ((out (open-output-file (string-append SPAN-build-and-cache-dir "/mirror"))))
+                          (write answer out))
                         #f))
 
       (define SPAN-mirror-url-2 "")
@@ -152,29 +166,6 @@
                         #f))
 
       (display SPAN-shell-droptext-22)
-(define (url-bite-off url)
+      (SPAN-shell-spawn SPAN-mirror-url))
-  (let ((s "")
+      ))
-        (do ((i 0 (+ i 1)))
-            ((>= i (string-length url))
-             ;;(if (= (string-ref url i) #\/)
-             ;;    (set!
-             s)
-          (set! s (string-append s (string (string-ref url i)))))
-        (if (or (eq? s "http://")(eq? s "ftp://"))
-            (set! s "")))))
 
-(do ((s (read)(read)))
-    ((null? s)0)
-  (cond ((symbol? s)
-         (cond ((string<=? (symbol->string s)(string #\return))
-                0)
-               ((string=? "h" (symbol->string s))
-                (display "Commands : get ")
-                0)
-               ((string<=? "get" (symbol->string s))
-                (display "enter package to fetch : ")
-                (SPAN-ask-server (string-append "get " (symbol->string (read)))
-                                 (url-bite-off SPAN-mirror-url) 6969))
-               ))
-        ))
-(display "Signing off.")