wip

foo.scm

@@ -0,0 +1,3 @@
+(import chicken scheme)
+
+(print (eval (read)))

hiss-old.scm

@@ -0,0 +1,60 @@
+;;; documentation at http://thintz.com/chicken-scheme-shell
+(use readline srfi-1)
+(include "macros.scm")
+
+(define (getenv2 e)
+ ;; handles exorcism of getenv from 4.6.4 onwards
+ (handle-exceptions
+  exn
+  (get-environment-variable e)
+  (getenv e)))
+
+(current-input-port (make-gnu-readline-port))
+(gnu-history-install-file-manager
+ (string-append (or (getenv2 "HOME") ".") "/.csi.history"))
+(repl-prompt (lambda () "$ "))
+
+(define config-file
+ (make-parameter (string-append (or (getenv2 "HOME") ".") "/.hiss")))
+(when (file-exists? (config-file))
+  (load (config-file)))
+
+(define exit? (make-parameter #f))
+(define (exit) (exit? #t))
+
+(define (%run-cmd cmd) (with-input-from-pipe cmd read-file))
+
+; now we can can actually use things in a more lispy way
+; #;1> (cmd->list "ls" read-line)
+; (file1 file2 file3)
+; #;2> (map (lambda (file) (run (string-append "cat " file)))
+;             (cmd->list "ls" read-line))
+; ...contents of all the files in the current directory
+(define (cmd->list cmd read-func)
+  (with-input-from-pipe
+   cmd
+   (lambda ()
+     (letrec ((get-next (lambda (o)
+			  (let ((v (read-func)))
+			    (if (not (eof-object? v))
+				(get-next (cons v o))
+				(reverse o))))))
+       (get-next '())))))
+
+(define (run cmd) (process-wait (process-run cmd)))
+
+(define (_ . r) (cmd->list (fold (lambda (e o) (++ o " " e)) "" r) read-line))
+
+(define (shell-repl)
+  (if (exit?)
+      #t
+      (begin (handle-exceptions
+	      exn
+	      (begin (print-error-message exn)
+		     (display (with-output-to-string (lambda () (print-call-chain)))))
+	      (let ((x (read)))
+		(write (eval x))))
+	     (newline)
+	     (shell-repl))))
+
+(shell-repl)

hiss.scm

@@ -1,49 +1,49 @@
-;;; documentation at http://thintz.com/chicken-scheme-shell
+(import chicken scheme)
-(use readline srfi-1)
+(use parley parley-auto-completion srfi-1 apropos posix)
-(include "macros.scm")
+
-
+(set-read-syntax!
-(define (getenv2 e)
+ #\[
- ;; handles exorcism of getenv from 4.6.4 onwards
+ (lambda (port)
- (handle-exceptions
+   (letrec ((read-cmd (lambda (cmd)
-  exn
+                        (let ((c (peek-char port)))
-  (get-environment-variable e)
+                          (cond ((eof-object? c)
-  (getenv e)))
+                                 (error "EOF encountered while parsing { ... } clause"))
-
+                                ((char=? c #\])
-(current-input-port (make-gnu-readline-port))
+                                 (read-char port)
-(gnu-history-install-file-manager
+                                 cmd)
- (string-append (or (getenv2 "HOME") ".") "/.csi.history"))
+                                ((or (char=? c #\') (char=? c #\())
-(repl-prompt (lambda () "$ "))
+                                 (read-cmd (string-append cmd (->string (eval (read port))))))
-
+                                (else
-(define config-file
+                                 (read-char port)
- (make-parameter (string-append (or (getenv2 "HOME") ".") "/.hiss")))
+                                 (read-cmd (string-append cmd (->string c)))))))))
-(when (file-exists? (config-file))
+     `(begin (let ((result (with-input-from-pipe ,(read-cmd "") read-lines)))
-  (load (config-file)))
+               ;(for-each (cut print <>) result)
+               (for-each (lambda (l) (print l)) result)
+               (values #t result))))))
+
+; match (foo or foo
+(word-class '($ (: (& (~ "(") (~ whitespace)) (+ (~ whitespace)))))
+
+(define (get-completions)
+  (map (lambda (s) (string-append (symbol->string s) " ")) (delete-duplicates! (apropos-list "" macros?: #t))))
+
+(completion-choices (lambda (input position last-word) (get-completions)))
+
+(add-key-binding! #\tab auto-completion-handler)
+
+(let ((old (current-input-port)))
+     (current-input-port (make-parley-port old)))
 
 (define exit? (make-parameter #f))
 (define (exit) (exit? #t))
 
-(define (%run-cmd cmd) (with-input-from-pipe cmd read-file))
+(define line-num (make-parameter 0))
-
+(define repl-prompt (make-parameter (lambda () (string-append "#;" (number->string (line-num)) "> "))))
-; now we can can actually use things in a more lispy way
+
-; #;1> (cmd->list "ls" read-line)
+(define config-file
-; (file1 file2 file3)
+ (make-parameter (string-append (or (get-environment-variable "HOME") ".") "/.hiss")))
-; #;2> (map (lambda (file) (run (string-append "cat " file)))
+(when (file-exists? (config-file))
-;             (cmd->list "ls" read-line))
+  (load (config-file)))
-; ...contents of all the files in the current directory
-(define (cmd->list cmd read-func)
-  (with-input-from-pipe
-   cmd
-   (lambda ()
-     (letrec ((get-next (lambda (o)
-			  (let ((v (read-func)))
-			    (if (not (eof-object? v))
-				(get-next (cons v o))
-				(reverse o))))))
-       (get-next '())))))
-
-(define (run cmd) (process-wait (process-run cmd)))
-
-(define (_ . r) (cmd->list (fold (lambda (e o) (++ o " " e)) "" r) read-line))
 
 (define (shell-repl)
   (if (exit?)
@@ -52,8 +52,9 @@
 	      exn
 	      (begin (print-error-message exn)
 		     (display (with-output-to-string (lambda () (print-call-chain)))))
-	      (let ((x (read)))
+	      (let ((x (with-input-from-string (parley ((repl-prompt))) (lambda () (read)))))
-		(write (eval x))))
+		(write (eval x))
+                (line-num (+ (line-num) 1))))
 	     (newline)
 	     (shell-repl))))