diff --git a/scsh/SPAN/SPAN-server-daemon.scm b/scsh/SPAN/SPAN-server-daemon.scm index 0040f3e..6532ed8 100644 --- a/scsh/SPAN/SPAN-server-daemon.scm +++ b/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) diff --git a/scsh/SPAN/SPAN-util.scm b/scsh/SPAN/SPAN-util.scm index 9be2a10..272af51 100644 --- a/scsh/SPAN/SPAN-util.scm +++ b/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 ' 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 : ") diff --git a/scsh/SPAN/SPAN.scm b/scsh/SPAN/SPAN.scm index 67b41d6..a031d31 100644 --- a/scsh/SPAN/SPAN.scm +++ b/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)) ))) diff --git a/scsh/SPAN/load.scm b/scsh/SPAN/load.scm index ff60587..0a3b8db 100644 --- a/scsh/SPAN/load.scm +++ b/scsh/SPAN/load.scm @@ -31,11 +31,11 @@ (load "SPAN-client.scm") ;; initialization - +;; ;; Commands: ;; h : display help -;; get : fetch file +;; get : 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")) \ No newline at end of file +;; (SPAN-shell-spawn SPAN-dir (string-append SPAN-dir "/mirror")) \ No newline at end of file