GopherProxy

	tio.lisp - clic - Clic is an command line interactive client for gopher written…
	git clone git://bitreich.org/clic/ git://hg6vgqziawt5s4dj.onion/clic/
	Log
	Files
	Refs
	Tags
	LICENSE
	---
	tio.lisp (8280B)
	---
	1 ;; Copyright (c) 2002-2006, Edward Marco Baringer
	2 ;; All rights reserved.
	3
	4 (in-package :alexandria)
	5
	6 (defmacro with-open-file* ((stream filespec &key direction element-type
	7 if-exists if-does-not-exist external-…
	8 &body body)
	9 "Just like WITH-OPEN-FILE, but NIL values in the keyword arguments mea…
	10 the default value specified for OPEN."
	11 (once-only (direction element-type if-exists if-does-not-exist externa…
	12 `(with-open-stream
	13 (,stream (apply #'open ,filespec
	14 (append
	15 (when ,direction
	16 (list :direction ,direction))
	17 (when ,element-type
	18 (list :element-type ,element-type))
	19 (when ,if-exists
	20 (list :if-exists ,if-exists))
	21 (when ,if-does-not-exist
	22 (list :if-does-not-exist ,if-does-not-exist))
	23 (when ,external-format
	24 (list :external-format ,external-format)))))
	25 ,@body)))
	26
	27 (defmacro with-input-from-file ((stream-name file-name &rest args
	28 &key (direction nil directi…
	29 &allow-other-keys)
	30 &body body)
	31 "Evaluate BODY with STREAM-NAME to an input stream on the file
	32 FILE-NAME. ARGS is sent as is to the call to OPEN except EXTERNAL-FORMAT,
	33 which is only sent to WITH-OPEN-FILE when it's not NIL."
	34 (declare (ignore direction))
	35 (when direction-p
	36 (error "Can't specify :DIRECTION for WITH-INPUT-FROM-FILE."))
	37 `(with-open-file* (,stream-name ,file-name :direction :input ,@args)
	38 ,@body))
	39
	40 (defmacro with-output-to-file ((stream-name file-name &rest args
	41 &key (direction nil directio…
	42 &allow-other-keys)
	43 &body body)
	44 "Evaluate BODY with STREAM-NAME to an output stream on the file
	45 FILE-NAME. ARGS is sent as is to the call to OPEN except EXTERNAL-FORMAT,
	46 which is only sent to WITH-OPEN-FILE when it's not NIL."
	47 (declare (ignore direction))
	48 (when direction-p
	49 (error "Can't specify :DIRECTION for WITH-OUTPUT-TO-FILE."))
	50 `(with-open-file* (,stream-name ,file-name :direction :output ,@args)
	51 ,@body))
	52
	53 (defun read-stream-content-into-string (stream &key (buffer-size 4096))
	54 "Return the \"content\" of STREAM as a fresh string."
	55 (check-type buffer-size positive-integer)
	56 (let ((print-pretty nil))
	57 (with-output-to-string (datum)
	58 (let ((buffer (make-array buffer-size :element-type 'character)))
	59 (loop
	60 :for bytes-read = (read-sequence buffer stream)
	61 :do (write-sequence buffer datum :start 0 :end bytes-read)
	62 :while (= bytes-read buffer-size))))))
	63
	64 (defun read-file-into-string (pathname &key (buffer-size 4096) external-…
	65 "Return the contents of the file denoted by PATHNAME as a fresh string.
	66
	67 The EXTERNAL-FORMAT parameter will be passed directly to WITH-OPEN-FILE
	68 unless it's NIL, which means the system default."
	69 (with-input-from-file
	70 (file-stream pathname :external-format external-format)
	71 (read-stream-content-into-string file-stream :buffer-size buffer-siz…
	72
	73 (defun write-string-into-file (string pathname &key (if-exists :error)
	74 if-does-not-exist
	75 external-format)
	76 "Write STRING to PATHNAME.
	77
	78 The EXTERNAL-FORMAT parameter will be passed directly to WITH-OPEN-FILE
	79 unless it's NIL, which means the system default."
	80 (with-output-to-file (file-stream pathname :if-exists if-exists
	81 :if-does-not-exist if-does-not-exist
	82 :external-format external-format)
	83 (write-sequence string file-stream)))
	84
	85 (defun read-stream-content-into-byte-vector (stream &key ((%length lengt…
	86 (initial-size 4…
	87 "Return \"content\" of STREAM as freshly allocated (unsigned-byte 8) v…
	88 (check-type length (or null non-negative-integer))
	89 (check-type initial-size positive-integer)
	90 (do ((buffer (make-array (or length initial-size)
	91 :element-type '(unsigned-byte 8)))
	92 (offset 0)
	93 (offset-wanted 0))
	94 ((or (/= offset-wanted offset)
	95 (and length (>= offset length)))
	96 (if (= offset (length buffer))
	97 buffer
	98 (subseq buffer 0 offset)))
	99 (unless (zerop offset)
	100 (let ((new-buffer (make-array (* 2 (length buffer))
	101 :element-type '(unsigned-byte 8))))
	102 (replace new-buffer buffer)
	103 (setf buffer new-buffer)))
	104 (setf offset-wanted (length buffer)
	105 offset (read-sequence buffer stream :start offset))))
	106
	107 (defun read-file-into-byte-vector (pathname)
	108 "Read PATHNAME into a freshly allocated (unsigned-byte 8) vector."
	109 (with-input-from-file (stream pathname :element-type '(unsigned-byte 8…
	110 (read-stream-content-into-byte-vector stream '%length (file-length s…
	111
	112 (defun write-byte-vector-into-file (bytes pathname &key (if-exists :erro…
	113 if-does-not-exist)
	114 "Write BYTES to PATHNAME."
	115 (check-type bytes (vector (unsigned-byte 8)))
	116 (with-output-to-file (stream pathname :if-exists if-exists
	117 :if-does-not-exist if-does-not-exist
	118 :element-type '(unsigned-byte 8))
	119 (write-sequence bytes stream)))
	120
	121 (defun copy-file (from to &key (if-to-exists :supersede)
	122 (element-type '(unsigned-byte 8)) finish-…
	123 (with-input-from-file (input from :element-type element-type)
	124 (with-output-to-file (output to :element-type element-type
	125 :if-exists if-to-exists)
	126 (copy-stream input output
	127 :element-type element-type
	128 :finish-output finish-output))))
	129
	130 (defun copy-stream (input output &key (element-type (stream-element-type…
	131 (buffer-size 4096)
	132 (buffer (make-array buffer-size :element-type elemen…
	133 (start 0) end
	134 finish-output)
	135 "Reads data from INPUT and writes it to OUTPUT. Both INPUT and OUTPUT …
	136 be streams, they will be passed to READ-SEQUENCE and WRITE-SEQUENCE and …
	137 compatible element-types."
	138 (check-type start non-negative-integer)
	139 (check-type end (or null non-negative-integer))
	140 (check-type buffer-size positive-integer)
	141 (when (and end
	142 (< end start))
	143 (error "END is smaller than START in ~S" 'copy-stream))
	144 (let ((output-position 0)
	145 (input-position 0))
	146 (unless (zerop start)
	147 ;; FIXME add platform specific optimization to skip seekable strea…
	148 (loop while (< input-position start)
	149 do (let ((n (read-sequence buffer input
	150 :end (min (length buffer)
	151 (- start input-position…
	152 (when (zerop n)
	153 (error "~@<Could not read enough bytes from the input…
	154 the :START ~S requirement in ~S.~:@>" 'copy-s…
	155 (incf input-position n))))
	156 (assert (= input-position start))
	157 (loop while (or (null end) (< input-position end))
	158 do (let ((n (read-sequence buffer input
	159 :end (when end
	160 (min (length buffer)
	161 (- end input-position))…
	162 (when (zerop n)
	163 (if end
	164 (error "~@<Could not read enough bytes from the inp…
	165 the :END ~S requirement in ~S.~:@>" 'copy-stre…
	166 (return)))
	167 (incf input-position n)
	168 (write-sequence buffer output :end n)
	169 (incf output-position n)))
	170 (when finish-output
	171 (finish-output output))
	172 output-position))