cl-rw

Layered streams for Common Lisp
git clone https://logand.com/git/cl-rw.git/
Log | Files | Refs

commit 1fbc2cb708c91e3260f9a1f9c7d0b0ae004ddb58
parent 2cc8e359f7f829feea53aa64fcc5170c3d2bafd6
Author: Tomas Hlavaty <tom@logand.com>
Date:   Sun, 22 Sep 2013 23:26:16 +0200

misc fixes

Diffstat:
Mcl-rw.asd | 2+-
Mconcurrency.lisp | 8++++----
Mhttp.lisp | 3++-
Mos.lisp | 56++++++++++++++++++++++++++++++--------------------------
Mui.lisp | 2+-
5 files changed, 38 insertions(+), 33 deletions(-)

diff --git a/cl-rw.asd b/cl-rw.asd @@ -33,7 +33,7 @@ :author "Tomas Hlavaty" :maintainer "Tomas Hlavaty" :licence "MIT" - :depends-on () + :depends-on (#+sbcl :sb-concurrency) :serial t :components ((:file "rw") (:file "filesystem") diff --git a/concurrency.lisp b/concurrency.lisp @@ -102,14 +102,14 @@ (let ((p (rw.os:make-program :stream :stream command args)) (wq (make-concurrent-queue))) (make-thread 'program-server-writer - (let ((s (funcall p 'input-stream))) + (let ((s (funcall p :input-stream))) (lambda () (do (x) ((not (setq x (funcall wq))) (close s)) (funcall writer x s))))) (let ((l (make-lock 'program-server-lock)) - (s (funcall p 'output-stream))) + (s (funcall p :output-stream))) (lambda (query) (with-lock (l) (when wq @@ -120,7 +120,7 @@ (t (funcall wq nil) (setq wq nil) - (funcall p 'wait) - (multiple-value-bind (status code) (funcall p 'status-and-code) + (funcall p :wait) + (multiple-value-bind (status code) (funcall p :status-and-code) (assert (eq :exited status)) (assert (zerop code))))))))))) diff --git a/http.lisp b/http.lisp @@ -1,5 +1,6 @@ ;; TODO remove all those coerce list<->string? -;; TODO file(s) upload +;; TODO !!! post parsing with multiline textarea +;; TODO !!! file(s) upload (defpackage :rw.http (:use :cl) diff --git a/os.lisp b/os.lisp @@ -40,18 +40,22 @@ :output output :error nil :sharing :external - :wait nil))) + :wait nil + ;; TODO make bivalent + ;;:character-p t + ;;:element-type '(unsigned-byte 8) + ))) (let ((status (ccl:external-process-status p))) (if input (assert (eq :running status)) (assert (member status '(:running :exited))))) (lambda (msg) (ecase msg - (status-and-code (ccl:external-process-status p)) - (input-stream (ccl:external-process-input-stream p)) - (output-stream (ccl:external-process-output-stream p)) - (wait (ccl::external-process-wait p)) - (close (flet ((finish (x) (when x (close x)))) + (:status-and-code (ccl:external-process-status p)) + (:input-stream (ccl:external-process-input-stream p)) + (:output-stream (ccl:external-process-output-stream p)) + (:wait (ccl::external-process-wait p)) + (:close (flet ((finish (x) (when x (close x)))) (finish (ccl:external-process-output-stream p)) (finish (ccl:external-process-input-stream p)) (finish (ccl:external-process-error-stream p))))))) @@ -70,10 +74,10 @@ (assert (member status '(:running :exited))))) (lambda (msg) (ecase msg - (status-and-code (ext:external-process-status p)) - (input-stream io) - (output-stream io) - (wait (ext:external-process-wait p)) + (:status-and-code (ext:external-process-status p)) + (:input-stream io) + (:output-stream io) + (:wait (ext:external-process-wait p)) (close (when io (close io)))))) ;; TODO is this the right thing to close process? #+sbcl (let ((p (sb-ext:run-program cmd @@ -89,10 +93,10 @@ (assert (member status '(:running :exited))))) (lambda (msg) (ecase msg - (status-and-code (sb-ext:process-status p)) - (input-stream (sb-ext:process-input p)) - (output-stream (sb-ext:process-output p)) - (wait (sb-ext:process-wait p)) + (:status-and-code (sb-ext:process-status p)) + (:input-stream (sb-ext:process-input p)) + (:output-stream (sb-ext:process-output p)) + (:wait (sb-ext:process-wait p)) (close (sb-ext:process-close p))))) #+cmu (let ((p (ext:run-program cmd @@ -107,10 +111,10 @@ (assert (member status '(:running :exited))))) (lambda (msg) (ecase msg - (status-and-code (sb-ext:process-status p)) - (input-stream (sb-ext:process-input p)) - (output-stream (sb-ext:process-output p)) - (wait (sb-ext:process-wait p)) + (:status-and-code (sb-ext:process-status p)) + (:input-stream (sb-ext:process-input p)) + (:output-stream (sb-ext:process-output p)) + (:wait (sb-ext:process-wait p)) (close (ext:process-close p))))) #+clisp (let ((p (ext:run-program cmd @@ -125,10 +129,10 @@ (assert (member status '(:running :exited))))) (lambda (msg) (ecase msg - (status-and-code (values :running 0)) ;; TODO - (input-stream p) - (output-stream p) - (wait (ext:process-wait p)) ;; TODO + (:status-and-code (values :running 0)) ;; TODO + (:input-stream p) + (:output-stream p) + (:wait (ext:process-wait p)) ;; TODO (close (close p)))))) (defun throw-error (cmd args code error-plist) @@ -139,16 +143,16 @@ (defun call-with-program-output (output cmd args error-plist fn) (let ((p (make-program nil output cmd args))) (unless output - (funcall p 'wait)) + (funcall p :wait)) (unwind-protect - (multiple-value-bind (status code) (funcall p 'status-and-code) + (multiple-value-bind (status code) (funcall p :status-and-code) (assert (member status '(:running :exited))) (if (member code '(nil 0)) (if (eq :stream output) - (funcall fn (funcall p 'output-stream)) + (funcall fn (funcall p :output-stream)) t) (throw-error cmd args code error-plist))) - (funcall p 'close)))) + (funcall p :close)))) (defun run-command (cmd args &optional error-plist) (call-with-program-output nil cmd args error-plist nil)) diff --git a/ui.lisp b/ui.lisp @@ -98,7 +98,7 @@ #+nil(print (list :@@@-z svals)))) ;; TODO indicate unexpected aid when not cached? (funcall fn - (lambda (k p) (declare (ignore k p))) + (lambda (k p nargs) (declare (ignore k p nargs))) (lambda ()))))))))) (defmacro with-state ((state aid actions2 dispatch clear) &body body)