SPAN - refactor help

scsh/SPAN/SPAN-server-daemon.scm

@@ -26,6 +26,8 @@
 ;;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
 ;;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
+;; NOTE : files stored on this server are retrieved from its runtime directory
+
 (load "SPAN-server-daemon-record.scm")
 
 (define (errormsg) (display " message not understood. "))
@@ -72,7 +74,7 @@
                  (cond ((eq? 'get answer)
                         (let ((answer2 (read (make-string-input-port in))))
                           (write (get-package answer2) out)))
-                       ((eq? 'QUIT answer)
+                       ((or (eq? 'QUIT answer)(eq? 'quit answer))
                         (write *bye out)
                         (close-input-port in)
                         (close-socket *socket)

scsh/SPAN/SPAN-util.scm

@@ -29,15 +29,23 @@
 (define (url-bite-off url)
   (let ((s "")
         (do ((i 0 (+ i 1)))
-            ((>= i (string-length url))
-             ;;(if (= (string-ref url i) #\/)
-             ;;    (set!
+            ((or (>= i (string-length url))
+                 (eq? (string-ref url i) #\/)
+                 (eq? (string-ref url i) #\\)) ;; needs scheme URL parsing (e.g. with regexps or other perl things
              s)
           (set! s (string-append s (string (string-ref url i)))))
         (if (or (eq? s "http://")(eq? s "ftp://"))
             (set! s "")))))
 
-(define (SPAN-shell-spawn mirror)
+(define SPAN-generators (make-table))
+(table-set! SPAN-generators "helpfile" (lambda ()
+                                         (display "Type in your helpfile : commands are 'get <filename-on-server>' and 'h'")
+                                         (let ((*out (open-outputfile (string-append "/help"))))
+                                           (do ((s (read)(read)))
+                                               ((eof-object? s)0)
+                                             (write s)(write " ")))))
+
+(define (SPAN-shell-spawn SPAN-dir mirror)
   (newline)
   (display "span> ")
   (do ((s (read)(read)))
@@ -48,7 +56,14 @@
            (cond ((string<=? (symbol->string s)(string #\return))
                   0)
                  ((string=? "h" (symbol->string s))
-                  (display "Commands : get ")
+                  (display "Generating helpfile...")(newline)
+                  (let ((*helpfilename (string-append SPAN-dir "/help")))
+                    (let ((*in (if (file-exists? *helpfilename)
+                                   (open-input-file *helpfilename)
+                                   (begin
+                                     (display "no helpfile...")
+                                     ((SPAN-generate "helpfile"))))))
+                      (for-each write (read *in))))
                   0)
                  ((string<=? "get" (symbol->string s))
                   (display "enter package to fetch : ")

scsh/SPAN/SPAN.scm

@@ -252,7 +252,7 @@ Enter 'h' for help.")
               (file-exists? (string-append SPAN-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)))
+        (SPAN-shell-spawn SPAN-dir SPAN-mirror-url)))
      (else
 ;;;;;;;;prototype (define (SPAN-question~ droptext question answer defaultchoice)
       ((SPAN-question~ (question? 1)
@@ -370,6 +370,6 @@ Enter 'h' for help.")
                          #f)) answer)
 
       (display (question? 22))
-      (SPAN-shell-spawn SPAN-mirror-url))
+      (SPAN-shell-spawn SPAN-dir SPAN-mirror-url))
      )))
 

scsh/SPAN/load.scm

@@ -31,11 +31,11 @@
 (load "SPAN-client.scm")
 
 ;; initialization
-
+;;
 ;; Commands:
 ;; h : display help
-;; get : fetch file
+;; get <filename> : fetch file
 (define SPAN-dir (string-append (getenv "HOME") "/.span"))
 (questionaire SPAN-dir) ;; this changes the SPAN-dir
 ;; NOTE : after init of questionaire, you can spawn a shell:
-;; (SPAN-shell-spawn (string-append SPAN-dir "/mirror"))
+;; (SPAN-shell-spawn SPAN-dir (string-append SPAN-dir "/mirror"))