Compare commits
4 Commits
Author | SHA1 | Date |
---|---|---|
![]() |
c119353a9f | 11 years ago |
![]() |
a72aeafd7b | 11 years ago |
|
77f142e4c2 | 11 years ago |
![]() |
afbb7d9b6b | 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)
|
@ -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))
|
||||
|
@ -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…
Reference in New Issue