Use parley.

Minor packaging and version compatibility fix

.gitignore

@@ -0,0 +1,3 @@
+*~
+hiss
+.csi.history

.hiss

@@ -0,0 +1,15 @@
+(require-extension ansi-escape-sequences srfi-19)
+
+(repl-prompt
+ (lambda ()
+   (let ((is-root? (lambda (user) (string=? user "root")))
+         (user (car (user-information (current-user-id)))))
+     (string-append "("
+                    (set-text (if (is-root? user) '(fg-red) '(fg-green))
+                                  (string-append user "@" (or (get-host-name) "")))
+                    ")-("
+                    (current-directory)
+                    ")-("
+                    (date->string (current-date) "~T")
+                    ")"
+                    "\n$ "))))

foo.scm

@@ -0,0 +1,4 @@
+(import chicken scheme)
+(use chicken-syntax)
+
+(print (eval `(begin (import chicken) ,(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.meta

@@ -0,0 +1,6 @@
+;;; hiss.meta -*- scheme -*-
+
+((egg "hiss.egg")
+ (synopsis "hiss is a chicken scheme shell.")
+ (license "BSD")
+ (depends parley apropos scsh-process))

hiss.scm

@@ -0,0 +1,62 @@
+(import chicken scheme)
+(use parley parley-auto-completion srfi-1 apropos posix chicken-syntax scsh-process)
+
+; match (foo or foo
+(word-class '($ (: (& (~ (or "(" "[")) (~ whitespace)) (+ (~ whitespace)))))
+
+(define (get-scheme-completions)
+  (map (lambda (s)
+         (string-append s " "))
+       (delete-duplicates!
+        (map (lambda (sym)
+               (let ((string-sym (symbol->string sym)))
+                 (if (not (substring-index "#" string-sym))
+                          string-sym
+                          (cadr (string-split string-sym "#")))))
+             (apropos-list "" macros?: #t)))))
+
+(define (get-shell-completions)
+  (let ((paths (string-split (get-environment-variable "PATH") ":")))
+    (delete-duplicates!
+     (flatten
+      (map (lambda (files) (map (cut string-append <> " ") files))
+           (map (cut directory <>) paths))))))
+
+(completion-choices (lambda (input position last-word)
+                      (let* ((full-line (string-append input last-word))
+                             (paren-pos (or (substring-index "(" full-line) -1))
+                             (bracket-pos (or (substring-index "[" full-line) -1)))
+                        (if (> paren-pos bracket-pos)
+                            (get-scheme-completions)
+                            (get-shell-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 line-num (make-parameter 0))
+(define repl-prompt (make-parameter (lambda () (string-append "#;" (number->string (line-num)) "> "))))
+
+(define config-file
+ (make-parameter (string-append (or (get-environment-variable "HOME") ".") "/.hiss")))
+
+(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 (with-input-from-string (parley ((repl-prompt))) (lambda () (read)))))
+                (write (eval x))))
+             (newline)
+             (shell-repl))))
+
+(begin
+  (when (file-exists? (config-file))
+        (load (config-file)))
+  (shell-repl))

hiss.setup

@@ -0,0 +1,7 @@
+;;; hiss.setup -*- scheme -*-
+
+(compile -S -O3 -d1 hiss.scm -o hiss)
+
+(install-program 'hiss
+'("hiss")
+`((version "0.0.1")))

load.scm

@@ -1,6 +0,0 @@
-(load "shell.scm")
-
-(define scheme-dir (make-parameter "/home/teejay/thomas/programming/scheme"))
-(define ++ string-append)
-
-(load (++ (scheme-dir) "/network/network.scm"))

macros.scm

@@ -0,0 +1 @@
+(define-syntax _raw (syntax-rules () ((_raw . cmd) (run (fold (lambda (e o) (string-append o " " (->string e))) "" 'cmd)))))

new.scm

@@ -0,0 +1,28 @@
+(use parley parley-auto-completion srfi-1)
+(import foreign)
+
+(use parley readline)
+(let ((old (current-input-port)))
+     (current-input-port (make-parley-port old)))
+
+(word-class '($ (: (& (~ "(") (~ whitespace)) (+ (~ whitespace)))))
+; (completion-list '("string-append " "foobar "))
+(define foo '())
+(completion-choices
+ (lambda (input position last-word)
+   (let* ((result '())
+          (symbols (car (map (lambda (pair) ((cdr pair) "")) (gnu-readline-completions)))))
+     (let loop ()
+       (let ((next (symbols)))
+         (if (any (cut string=? <> next) result)
+           result
+           (begin (set! result (cons next result)) (loop)))))
+     (set! result (lset-union string=?
+                              result
+                              (map (lambda (s) (symbol->string (car s))) (##sys#macro-environment))))
+     (map (cut string-append <> " ") result))))
+   ;; (if (symbol? (string->symbol last-word))
+       ;(map (lambda (s) (string-append (symbol->string (car s)) " ")) (##sys#macro-environment))))
+;   '("string-append" "strs" "foobar")))
+
+(add-key-binding! #\tab auto-completion-handler)

readme.md

@@ -0,0 +1 @@
+[documentation](http://thintz.com/chicken-scheme-shell)

shell.scm

@@ -1,30 +0,0 @@
-(use shell readline regex)
-
-(current-input-port (make-gnu-readline-port))
-(gnu-history-install-file-manager (string-append (or (getenv "HOME") ".") "/.csi.history"))
-(repl-prompt (lambda () "$ "))
-
-(define config-file (make-parameter (string-append (or (getenv "HOME") ".") "/.hintz-shellrc")))
-(when (file-exists? (config-file))
-  (load (config-file)))
-
-(define exit? (make-parameter #f))
-(define (exit) (exit? #t))
-
-(define (shell-repl)
-    (if (exit?)
-        #t
-        (let ((x (read)))
-          (begin (handle-exceptions
-                  exn
-                  (handle-exceptions
-                   exn
-                   (begin (print-error-message exn)
-                          (display (with-output-to-string (lambda () (print-call-chain)))))
-                   (execute (list x)))
-                  (display (eval x))
-                  (newline))
-                 (newline)
-                 (shell-repl)))))
-
-(shell-repl)