tjhintz/chicken-scheme-shell
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

wip

Browse Source
This commit is contained in:
thintz
2014-04-11 10:35:27 -07:00
parent 77f142e4c2
commit a72aeafd7b
2 changed files with 44 additions and 23 deletions
Download Patch File Download Diff File Expand all files Collapse all files

3
foo.scm
View File

@@ -1,3 +1,4 @@
(import chicken scheme) (import chicken scheme)
(use chicken-syntax)
(print (eval (read))) (print (eval `(begin (import chicken) ,(read))))

50
hiss.scm
View File

@@ -1,33 +1,54 @@
(import chicken scheme) (import chicken scheme)
(use parley parley-auto-completion srfi-1 apropos posix) (use parley parley-auto-completion srfi-1 apropos posix chicken-syntax)
(set-read-syntax! (set-read-syntax!
#\[ #\[
(lambda (port) (lambda (port)
(letrec ((read-cmd (lambda (cmd) (letrec ((read-cmd (lambda (exps)
(let ((c (peek-char port))) (let ((c (peek-char port)))
(cond ((eof-object? c) (cond ((eof-object? c)
(error "EOF encountered while parsing { ... } clause")) (error "EOF encountered while parsing [ ... ] clause"))
((char=? c #\]) ((char=? c #\])
(read-char port) (read-char port)
cmd) exps)
((or (char=? c #\') (char=? c #\()) ((or (char=? c #\') (char=? c #\())
(read-cmd (string-append cmd (->string (eval (read port)))))) (read-cmd (cons (read port) exps)))
(else (else
(read-char port) (read-char port)
(read-cmd (string-append cmd (->string c))))))))) (read-cmd (cons (->string c) exps))))))))
`(begin (let ((result (with-input-from-pipe ,(read-cmd "") read-lines))) `(lambda ()
;(for-each (cut print <>) result) (let ((result (with-input-from-pipe (string-append ,@(reverse (read-cmd '()))) read-lines)))
(for-each (lambda (l) (print l)) result) (for-each (cut print <>) result)
(values #t result)))))) (values #t result))))))
; match (foo or foo ; match (foo or foo
(word-class '($ (: (& (~ "(") (~ whitespace)) (+ (~ whitespace))))) (word-class '($ (: (& (~ (or "(" "[")) (~ whitespace)) (+ (~ whitespace)))))
(define (get-completions) (define (get-scheme-completions)
(map (lambda (s) (string-append (symbol->string s) " ")) (delete-duplicates! (apropos-list "" macros?: #t)))) (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)))))
(completion-choices (lambda (input position last-word) (get-completions))) (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) (add-key-binding! #\tab auto-completion-handler)
@@ -53,8 +74,7 @@
(begin (print-error-message exn) (begin (print-error-message exn)
(display (with-output-to-string (lambda () (print-call-chain))))) (display (with-output-to-string (lambda () (print-call-chain)))))
(let ((x (with-input-from-string (parley ((repl-prompt))) (lambda () (read))))) (let ((x (with-input-from-string (parley ((repl-prompt))) (lambda () (read)))))
(write (eval x)) (write (eval x))))
(line-num (+ (line-num) 1))))
(newline) (newline)
(shell-repl)))) (shell-repl))))