diff --git a/uiop/run-program.lisp b/uiop/run-program.lisp index efe374deb75ce36bd8f9b48db7aca54ce6d51378..02166d73380ff3c0baa94190345c4192a29ea0f8 100644 --- a/uiop/run-program.lisp +++ b/uiop/run-program.lisp @@ -140,7 +140,7 @@ by /bin/sh in POSIX" (apply fun (first processor) stream (rest processor)) (funcall fun processor stream))) - (defgeneric slurp-input-stream (processor input-stream &key &allow-other-keys) + (defgeneric slurp-input-stream (processor input-stream &key) (:documentation "SLURP-INPUT-STREAM is a generic function with two positional arguments PROCESSOR and INPUT-STREAM and additional keyword arguments, that consumes (slurps) @@ -165,40 +165,40 @@ Built-in methods include the following: Programmers are encouraged to define their own methods for this generic function.")) #-(or gcl2.6 genera) - (defmethod slurp-input-stream ((function function) input-stream &key &allow-other-keys) + (defmethod slurp-input-stream ((function function) input-stream &key) (funcall function input-stream)) - (defmethod slurp-input-stream ((list cons) input-stream &key &allow-other-keys) + (defmethod slurp-input-stream ((list cons) input-stream &key) (apply (first list) input-stream (rest list))) #-(or gcl2.6 genera) (defmethod slurp-input-stream ((output-stream stream) input-stream - &key linewise prefix (element-type 'character) buffer-size &allow-other-keys) + &key linewise prefix (element-type 'character) buffer-size) (copy-stream-to-stream input-stream output-stream :linewise linewise :prefix prefix :element-type element-type :buffer-size buffer-size)) - (defmethod slurp-input-stream ((x (eql 'string)) stream &key &allow-other-keys) + (defmethod slurp-input-stream ((x (eql 'string)) stream &key stripped) (declare (ignorable x)) - (slurp-stream-string stream)) + (slurp-stream-string stream :stripped stripped)) - (defmethod slurp-input-stream ((x (eql :string)) stream &key &allow-other-keys) + (defmethod slurp-input-stream ((x (eql :string)) stream &key stripped) (declare (ignorable x)) - (slurp-stream-string stream)) + (slurp-stream-string stream :stripped stripped)) - (defmethod slurp-input-stream ((x (eql :lines)) stream &key count &allow-other-keys) + (defmethod slurp-input-stream ((x (eql :lines)) stream &key count) (declare (ignorable x)) (slurp-stream-lines stream :count count)) - (defmethod slurp-input-stream ((x (eql :line)) stream &key (at 0) &allow-other-keys) + (defmethod slurp-input-stream ((x (eql :line)) stream &key (at 0)) (declare (ignorable x)) (slurp-stream-line stream :at at)) - (defmethod slurp-input-stream ((x (eql :forms)) stream &key count &allow-other-keys) + (defmethod slurp-input-stream ((x (eql :forms)) stream &key count) (declare (ignorable x)) (slurp-stream-forms stream :count count)) - (defmethod slurp-input-stream ((x (eql :form)) stream &key (at 0) &allow-other-keys) + (defmethod slurp-input-stream ((x (eql :form)) stream &key (at 0)) (declare (ignorable x)) (slurp-stream-form stream :at at)) @@ -206,8 +206,8 @@ Programmers are encouraged to define their own methods for this generic function (declare (ignorable x)) (apply 'slurp-input-stream *standard-output* stream keys)) - (defmethod slurp-input-stream ((x null) stream &rest keys &key &allow-other-keys) - (declare (ignorable x stream keys)) + (defmethod slurp-input-stream ((x null) stream &key) + (declare (ignorable x stream)) nil) (defmethod slurp-input-stream ((pathname pathname) input @@ -228,8 +228,7 @@ Programmers are encouraged to define their own methods for this generic function :element-type element-type :buffer-size buffer-size :linewise linewise))) (defmethod slurp-input-stream (x stream - &key linewise prefix (element-type 'character) buffer-size - &allow-other-keys) + &key linewise prefix (element-type 'character) buffer-size) (declare (ignorable stream linewise prefix element-type buffer-size)) (cond #+(or gcl2.6 genera) @@ -244,7 +243,7 @@ Programmers are encouraged to define their own methods for this generic function (with-upgradability () - (defgeneric vomit-output-stream (processor output-stream &key &allow-other-keys) + (defgeneric vomit-output-stream (processor output-stream &key) (:documentation "VOMIT-OUTPUT-STREAM is a generic function with two positional arguments PROCESSOR and OUTPUT-STREAM and additional keyword arguments, that produces (vomits) @@ -263,20 +262,20 @@ Built-in methods include the following: Programmers are encouraged to define their own methods for this generic function.")) #-(or gcl2.6 genera) - (defmethod vomit-output-stream ((function function) output-stream &key &allow-other-keys) + (defmethod vomit-output-stream ((function function) output-stream &key) (funcall function output-stream)) - (defmethod vomit-output-stream ((list cons) output-stream &key &allow-other-keys) + (defmethod vomit-output-stream ((list cons) output-stream &key) (apply (first list) output-stream (rest list))) #-(or gcl2.6 genera) (defmethod vomit-output-stream ((input-stream stream) output-stream - &key linewise prefix (element-type 'character) buffer-size &allow-other-keys) + &key linewise prefix (element-type 'character) buffer-size) (copy-stream-to-stream input-stream output-stream :linewise linewise :prefix prefix :element-type element-type :buffer-size buffer-size)) - (defmethod vomit-output-stream ((x string) stream &key fresh-line terpri &allow-other-keys) + (defmethod vomit-output-stream ((x string) stream &key fresh-line terpri) (princ x stream) (when fresh-line (fresh-line stream)) (when terpri (terpri stream)) @@ -286,8 +285,8 @@ Programmers are encouraged to define their own methods for this generic function (declare (ignorable x)) (apply 'vomit-output-stream *standard-input* stream keys)) - (defmethod vomit-output-stream ((x null) stream &rest keys &key &allow-other-keys) - (declare (ignorable x stream keys)) + (defmethod vomit-output-stream ((x null) stream &key) + (declare (ignorable x stream)) (values)) (defmethod vomit-output-stream ((pathname pathname) input @@ -308,8 +307,7 @@ Programmers are encouraged to define their own methods for this generic function :element-type element-type :buffer-size buffer-size :linewise linewise))) (defmethod vomit-output-stream (x stream - &key linewise prefix (element-type 'character) buffer-size - &allow-other-keys) + &key linewise prefix (element-type 'character) buffer-size) (declare (ignorable stream linewise prefix element-type buffer-size)) (cond #+(or gcl2.6 genera) @@ -320,7 +318,7 @@ Programmers are encouraged to define their own methods for this generic function x stream :linewise linewise :prefix prefix :element-type element-type :buffer-size buffer-size)) (t - (error "Invalid ~S destination ~S" 'vomit-output-stream x))))) + (error "Invalid ~S source ~S" 'vomit-output-stream x))))) ;;;; ----- Running an external program ----- diff --git a/uiop/stream.lisp b/uiop/stream.lisp index fd6e6d03d8f5e8bfec3bf58f64aa27992ed4056a..5ded2687b047408ea3c75629a800ed7b62160eb4 100644 --- a/uiop/stream.lisp +++ b/uiop/stream.lisp @@ -23,6 +23,7 @@ #:read-file-string #:read-file-line #:read-file-lines #:safe-read-file-line #:read-file-forms #:read-file-form #:safe-read-file-form #:eval-input #:eval-thunk #:standard-eval-thunk + #:println #:writeln ;; Temporary files #:*temporary-directory* #:temporary-directory #:default-temporary-directory #:setup-temporary-directory @@ -39,22 +40,35 @@ "the original standard input stream at startup") (defun setup-stdin () - (setf *stdin* #+clozure ccl::*stdin* #-clozure *standard-input*)) + (setf *stdin* + #.(or #+clozure 'ccl::*stdin* + #+(or cmu scl) 'system:*stdin* + #+ecl 'ext::+process-standard-input+ + #+sbcl 'sb-sys:*stdin* + '*standard-input*))) (defvar *stdout* *standard-output* "the original standard output stream at startup") (defun setup-stdout () - (setf *stdout* #+clozure ccl::*stdout* #-clozure *standard-output*)) + (setf *stdout* + #.(or #+clozure 'ccl::*stdout* + #+(or cmu scl) 'system:*stdout* + #+ecl 'ext::+process-standard-output+ + #+sbcl 'sb-sys:*stdout* + '*standard-output*))) (defvar *stderr* *error-output* "the original error output stream at startup") (defun setup-stderr () (setf *stderr* - #+allegro excl::*stderr* - #+clozure ccl::*stderr* - #-(or allegro clozure) *error-output*)) + #.(or #+allegro excl::*stderr* + #+clozure 'ccl::*stderr* + #+(or cmu scl) 'system:*stderr* + #+ecl 'ext::+process-error-output+ + #+sbcl 'sb-sys:*stderr* + '*error-output*))) (setup-stdin) (setup-stdout) (setup-stderr)) @@ -319,11 +333,13 @@ Otherwise, using WRITE-SEQUENCE using a buffer of size BUFFER-SIZE." ;; Not available on LW personal edition or LW 6.0 on Mac: (lispworks:copy-file i f) (concatenate-files (list input) output)) - (defun slurp-stream-string (input &key (element-type 'character)) + (defun slurp-stream-string (input &key (element-type 'character) stripped) "Read the contents of the INPUT stream as a string" - (with-open-stream (input input) - (with-output-to-string (output) - (copy-stream-to-stream input output :element-type element-type)))) + (let ((string + (with-open-stream (input input) + (with-output-to-string (output) + (copy-stream-to-stream input output :element-type element-type))))) + (if stripped (stripln string) string))) (defun slurp-stream-lines (input &key count) "Read the contents of the INPUT stream as a list of lines, return those lines. @@ -454,6 +470,13 @@ If a string, repeatedly read and evaluate from it, returning the last values." (let ((*read-eval* t)) (eval-thunk thunk)))))) +(with-upgradability () + (defun println (x &optional (stream *standard-output*)) + (princ x stream) (terpri stream) (values)) + + (defun writeln (x &rest keys &key (stream *standard-output*) &allow-other-keys) + (apply 'write x keys) (terpri stream) (values))) + ;;; Using temporary files (with-upgradability () diff --git a/uiop/utility.lisp b/uiop/utility.lisp index e17f49f4802ddc50ebcf629f283f1045b231288a..6981e0c52551afb1fb4bc3a6227d25613aea8d7a 100644 --- a/uiop/utility.lisp +++ b/uiop/utility.lisp @@ -20,7 +20,7 @@ #:emptyp ;; sequences #:+non-base-chars-exist-p+ ;; characters #:base-string-p #:strings-common-element-type #:reduce/strcat #:strcat ;; strings - #:first-char #:last-char #:split-string + #:first-char #:last-char #:split-string #:stripln #:string-prefix-p #:string-enclosed-p #:string-suffix-p #:find-class* ;; CLOS #:stamp< #:stamps< #:stamp*< #:stamp<= ;; stamps @@ -248,6 +248,22 @@ starting the separation from the end, e.g. when called with arguments (incf words) (setf end start)))))) + (defvar *cr* (coerce #(#\cr) 'string)) + (defvar *lf* (coerce #(#\newline) 'string)) + (defvar *crlf* (coerce #(#\cr #\newline) 'string)) + + (defun stripln (x) + (check-type x string) + (let* ((len (length x)) + (endlfp (equal (last-char x) #\linefeed)) + (endcrlfp (and endlfp (<= 2 len) (eql (char x (- len 2)) #\return))) + (endcrp (equal (last-char x) #\return))) + (cond + (endlfp (values (subseq x 0 (- len 1)) *lf*)) + (endcrp (values (subseq x 0 (- len 1)) *cr*)) + (endcrlfp (values (subseq x 0 (- len 2)) *crlf*)) + (t (values x nil))))) + (defun string-prefix-p (prefix string) "Does STRING begin with PREFIX?" (let* ((x (string prefix))