Compare commits
15 Commits
| Author | SHA1 | Date | |
|---|---|---|---|
| 6f0b418939 | |||
|
|
27563113d9 | ||
|
|
ebaf6763e3 | ||
|
|
d79a49d13f | ||
|
|
fcd452aa10 | ||
|
|
4e9a29eac2 | ||
|
|
eb3dc0d2a4 | ||
|
|
591e4e9344 | ||
|
|
90ce2997d6 | ||
|
|
c3e712f381 | ||
|
|
9c4bb87ae8 | ||
| 8b05590440 | |||
|
|
1b8a8647e1 | ||
| a262cc5f41 | |||
| 4f5da89ea7 |
3
.gitignore
vendored
Normal file
3
.gitignore
vendored
Normal file
@@ -0,0 +1,3 @@
|
||||
*~
|
||||
hiss
|
||||
.csi.history
|
||||
15
.hiss
Normal file
15
.hiss
Normal file
@@ -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$ "))))
|
||||
6
hiss.meta
Normal file
6
hiss.meta
Normal file
@@ -0,0 +1,6 @@
|
||||
;;; hiss.meta -*- scheme -*-
|
||||
|
||||
((egg "hiss.egg")
|
||||
(synopsis "hiss is a chicken scheme shell.")
|
||||
(license "BSD")
|
||||
(depends readline))
|
||||
60
hiss.scm
Normal file
60
hiss.scm
Normal file
@@ -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)
|
||||
7
hiss.setup
Normal file
7
hiss.setup
Normal file
@@ -0,0 +1,7 @@
|
||||
;;; hiss.setup -*- scheme -*-
|
||||
|
||||
(compile -S -O3 -d1 hiss.scm -o hiss)
|
||||
|
||||
(install-program 'hiss
|
||||
'("hiss")
|
||||
`((version "2")))
|
||||
6
load.scm
6
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"))
|
||||
1
macros.scm
Normal file
1
macros.scm
Normal file
@@ -0,0 +1 @@
|
||||
(define-syntax _raw (syntax-rules () ((_raw . cmd) (run (fold (lambda (e o) (string-append o " " (->string e))) "" 'cmd)))))
|
||||
30
shell.scm
30
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)
|
||||
Reference in New Issue
Block a user