Compare commits

...

4 Commits

Author SHA1 Message Date
Thomas c119353a9f Use parley. 11 years ago
thintz a72aeafd7b wip 11 years ago
Thomas Hintz 77f142e4c2 wip 11 years ago
thintz afbb7d9b6b parlaying 11 years ago

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

@ -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)

@ -3,4 +3,4 @@
((egg "hiss.egg")
(synopsis "hiss is a chicken scheme shell.")
(license "BSD")
(depends readline))
(depends parley apropos scsh-process))

@ -1,60 +1,62 @@
;;; 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)))
(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 (%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 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 (read)))
(write (eval x))))
(newline)
(shell-repl))))
(shell-repl)
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))

@ -4,4 +4,4 @@
(install-program 'hiss
'("hiss")
`((version "2")))
`((version "0.0.1")))

@ -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)
Loading…
Cancel
Save