changeset 698: | 96958d3eb5b0 |
parent: | 6856c021d084 |
author: | Richard Westhaver <ellis@rwest.io> |
date: | Fri, 04 Oct 2024 22:04:59 -0400 |
permissions: | -rw-r--r-- |
description: | fixes |
277
10faf95f90dd
stream and basic type upgrades. fixed some bugs and improved csv parsing
Richard Westhaver <ellis@rwest.io>
parents:
diff
changeset
|
1 | ;;; std/stream.lisp --- Standard Streams |
10faf95f90dd
stream and basic type upgrades. fixed some bugs and improved csv parsing
Richard Westhaver <ellis@rwest.io>
parents:
diff
changeset
|
2 | |
10faf95f90dd
stream and basic type upgrades. fixed some bugs and improved csv parsing
Richard Westhaver <ellis@rwest.io>
parents:
diff
changeset
|
3 | ;; |
10faf95f90dd
stream and basic type upgrades. fixed some bugs and improved csv parsing
Richard Westhaver <ellis@rwest.io>
parents:
diff
changeset
|
4 | |
10faf95f90dd
stream and basic type upgrades. fixed some bugs and improved csv parsing
Richard Westhaver <ellis@rwest.io>
parents:
diff
changeset
|
5 | ;;; Code: |
291 | 6 | (in-package :std/stream) |
277
10faf95f90dd
stream and basic type upgrades. fixed some bugs and improved csv parsing
Richard Westhaver <ellis@rwest.io>
parents:
diff
changeset
|
7 | |
10faf95f90dd
stream and basic type upgrades. fixed some bugs and improved csv parsing
Richard Westhaver <ellis@rwest.io>
parents:
diff
changeset
|
8 | (defun copy-stream (input output &key (element-type (stream-element-type input)) |
10faf95f90dd
stream and basic type upgrades. fixed some bugs and improved csv parsing
Richard Westhaver <ellis@rwest.io>
parents:
diff
changeset
|
9 | (buffer-size 4096) |
10faf95f90dd
stream and basic type upgrades. fixed some bugs and improved csv parsing
Richard Westhaver <ellis@rwest.io>
parents:
diff
changeset
|
10 | (buffer (make-array buffer-size :element-type element-type)) |
10faf95f90dd
stream and basic type upgrades. fixed some bugs and improved csv parsing
Richard Westhaver <ellis@rwest.io>
parents:
diff
changeset
|
11 | (start 0) end |
10faf95f90dd
stream and basic type upgrades. fixed some bugs and improved csv parsing
Richard Westhaver <ellis@rwest.io>
parents:
diff
changeset
|
12 | finish-output) |
10faf95f90dd
stream and basic type upgrades. fixed some bugs and improved csv parsing
Richard Westhaver <ellis@rwest.io>
parents:
diff
changeset
|
13 | "Reads data from INPUT and writes it to OUTPUT. Both INPUT and OUTPUT must |
10faf95f90dd
stream and basic type upgrades. fixed some bugs and improved csv parsing
Richard Westhaver <ellis@rwest.io>
parents:
diff
changeset
|
14 | be streams, they will be passed to READ-SEQUENCE and WRITE-SEQUENCE and must have |
10faf95f90dd
stream and basic type upgrades. fixed some bugs and improved csv parsing
Richard Westhaver <ellis@rwest.io>
parents:
diff
changeset
|
15 | compatible element-types." |
10faf95f90dd
stream and basic type upgrades. fixed some bugs and improved csv parsing
Richard Westhaver <ellis@rwest.io>
parents:
diff
changeset
|
16 | (check-type start non-negative-integer) |
10faf95f90dd
stream and basic type upgrades. fixed some bugs and improved csv parsing
Richard Westhaver <ellis@rwest.io>
parents:
diff
changeset
|
17 | (check-type end (or null non-negative-integer)) |
10faf95f90dd
stream and basic type upgrades. fixed some bugs and improved csv parsing
Richard Westhaver <ellis@rwest.io>
parents:
diff
changeset
|
18 | (check-type buffer-size positive-integer) |
10faf95f90dd
stream and basic type upgrades. fixed some bugs and improved csv parsing
Richard Westhaver <ellis@rwest.io>
parents:
diff
changeset
|
19 | (when (and end |
10faf95f90dd
stream and basic type upgrades. fixed some bugs and improved csv parsing
Richard Westhaver <ellis@rwest.io>
parents:
diff
changeset
|
20 | (< end start)) |
10faf95f90dd
stream and basic type upgrades. fixed some bugs and improved csv parsing
Richard Westhaver <ellis@rwest.io>
parents:
diff
changeset
|
21 | (error "END is smaller than START in ~S" 'copy-stream)) |
10faf95f90dd
stream and basic type upgrades. fixed some bugs and improved csv parsing
Richard Westhaver <ellis@rwest.io>
parents:
diff
changeset
|
22 | (let ((output-position 0) |
10faf95f90dd
stream and basic type upgrades. fixed some bugs and improved csv parsing
Richard Westhaver <ellis@rwest.io>
parents:
diff
changeset
|
23 | (input-position 0)) |
10faf95f90dd
stream and basic type upgrades. fixed some bugs and improved csv parsing
Richard Westhaver <ellis@rwest.io>
parents:
diff
changeset
|
24 | (unless (zerop start) |
10faf95f90dd
stream and basic type upgrades. fixed some bugs and improved csv parsing
Richard Westhaver <ellis@rwest.io>
parents:
diff
changeset
|
25 | ;; FIXME add platform specific optimization to skip seekable streams |
10faf95f90dd
stream and basic type upgrades. fixed some bugs and improved csv parsing
Richard Westhaver <ellis@rwest.io>
parents:
diff
changeset
|
26 | (loop while (< input-position start) |
10faf95f90dd
stream and basic type upgrades. fixed some bugs and improved csv parsing
Richard Westhaver <ellis@rwest.io>
parents:
diff
changeset
|
27 | do (let ((n (read-sequence buffer input |
10faf95f90dd
stream and basic type upgrades. fixed some bugs and improved csv parsing
Richard Westhaver <ellis@rwest.io>
parents:
diff
changeset
|
28 | :end (min (length buffer) |
10faf95f90dd
stream and basic type upgrades. fixed some bugs and improved csv parsing
Richard Westhaver <ellis@rwest.io>
parents:
diff
changeset
|
29 | (- start input-position))))) |
10faf95f90dd
stream and basic type upgrades. fixed some bugs and improved csv parsing
Richard Westhaver <ellis@rwest.io>
parents:
diff
changeset
|
30 | (when (zerop n) |
10faf95f90dd
stream and basic type upgrades. fixed some bugs and improved csv parsing
Richard Westhaver <ellis@rwest.io>
parents:
diff
changeset
|
31 | (error "~@<Could not read enough bytes from the input to fulfill ~ |
10faf95f90dd
stream and basic type upgrades. fixed some bugs and improved csv parsing
Richard Westhaver <ellis@rwest.io>
parents:
diff
changeset
|
32 | the :START ~S requirement in ~S.~:@>" 'copy-stream start)) |
10faf95f90dd
stream and basic type upgrades. fixed some bugs and improved csv parsing
Richard Westhaver <ellis@rwest.io>
parents:
diff
changeset
|
33 | (incf input-position n)))) |
10faf95f90dd
stream and basic type upgrades. fixed some bugs and improved csv parsing
Richard Westhaver <ellis@rwest.io>
parents:
diff
changeset
|
34 | (assert (= input-position start)) |
10faf95f90dd
stream and basic type upgrades. fixed some bugs and improved csv parsing
Richard Westhaver <ellis@rwest.io>
parents:
diff
changeset
|
35 | (loop while (or (null end) (< input-position end)) |
10faf95f90dd
stream and basic type upgrades. fixed some bugs and improved csv parsing
Richard Westhaver <ellis@rwest.io>
parents:
diff
changeset
|
36 | do (let ((n (read-sequence buffer input |
10faf95f90dd
stream and basic type upgrades. fixed some bugs and improved csv parsing
Richard Westhaver <ellis@rwest.io>
parents:
diff
changeset
|
37 | :end (when end |
10faf95f90dd
stream and basic type upgrades. fixed some bugs and improved csv parsing
Richard Westhaver <ellis@rwest.io>
parents:
diff
changeset
|
38 | (min (length buffer) |
10faf95f90dd
stream and basic type upgrades. fixed some bugs and improved csv parsing
Richard Westhaver <ellis@rwest.io>
parents:
diff
changeset
|
39 | (- end input-position)))))) |
10faf95f90dd
stream and basic type upgrades. fixed some bugs and improved csv parsing
Richard Westhaver <ellis@rwest.io>
parents:
diff
changeset
|
40 | (when (zerop n) |
10faf95f90dd
stream and basic type upgrades. fixed some bugs and improved csv parsing
Richard Westhaver <ellis@rwest.io>
parents:
diff
changeset
|
41 | (if end |
10faf95f90dd
stream and basic type upgrades. fixed some bugs and improved csv parsing
Richard Westhaver <ellis@rwest.io>
parents:
diff
changeset
|
42 | (error "~@<Could not read enough bytes from the input to fulfill ~ |
10faf95f90dd
stream and basic type upgrades. fixed some bugs and improved csv parsing
Richard Westhaver <ellis@rwest.io>
parents:
diff
changeset
|
43 | the :END ~S requirement in ~S.~:@>" 'copy-stream end) |
10faf95f90dd
stream and basic type upgrades. fixed some bugs and improved csv parsing
Richard Westhaver <ellis@rwest.io>
parents:
diff
changeset
|
44 | (return))) |
670
6856c021d084
add dir-locals to skel, fix package lock violation in castable, move .sk files
Richard Westhaver <ellis@rwest.io>
parents:
435
diff
changeset
|
45 | (incf input-position n) |
277
10faf95f90dd
stream and basic type upgrades. fixed some bugs and improved csv parsing
Richard Westhaver <ellis@rwest.io>
parents:
diff
changeset
|
46 | (write-sequence buffer output :end n) |
670
6856c021d084
add dir-locals to skel, fix package lock violation in castable, move .sk files
Richard Westhaver <ellis@rwest.io>
parents:
435
diff
changeset
|
47 | (incf output-position n))) |
277
10faf95f90dd
stream and basic type upgrades. fixed some bugs and improved csv parsing
Richard Westhaver <ellis@rwest.io>
parents:
diff
changeset
|
48 | (when finish-output |
10faf95f90dd
stream and basic type upgrades. fixed some bugs and improved csv parsing
Richard Westhaver <ellis@rwest.io>
parents:
diff
changeset
|
49 | (finish-output output)) |
10faf95f90dd
stream and basic type upgrades. fixed some bugs and improved csv parsing
Richard Westhaver <ellis@rwest.io>
parents:
diff
changeset
|
50 | output-position)) |
289
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
51 | |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
52 | ;; from SBCL manual |
393
6b87df03cdaf
init cli/tools/cc.lisp for grovel experiments, add zstd tests
Richard Westhaver <ellis@rwest.io>
parents:
291
diff
changeset
|
53 | ;;; Wrapped Streams |
289
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
54 | (defclass wrapped-stream (fundamental-stream) |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
55 | ((stream :initarg :stream :reader stream-of))) |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
56 | |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
57 | (defmethod stream-element-type ((stream wrapped-stream)) |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
58 | (stream-element-type (stream-of stream))) |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
59 | |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
60 | (defmethod close ((stream wrapped-stream) &key abort) |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
61 | (close (stream-of stream) :abort abort)) |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
62 | |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
63 | (defclass wrapped-character-input-stream (wrapped-stream fundamental-character-input-stream) |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
64 | ()) |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
65 | |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
66 | (defmethod stream-read-char ((stream wrapped-character-input-stream)) |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
67 | (read-char (stream-of stream) nil :eof)) |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
68 | |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
69 | (defmethod stream-unread-char ((stream wrapped-character-input-stream) |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
70 | char) |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
71 | (unread-char char (stream-of stream))) |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
72 | |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
73 | #| example: |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
74 | (with-input-from-string (input "1 2 |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
75 | 3 :foo ") |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
76 | (let ((counted-stream (make-instance 'counting-character-input-stream |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
77 | :stream input))) |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
78 | (loop for thing = (read counted-stream) while thing |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
79 | unless (numberp thing) do |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
80 | (error "Non-number ~S (line ~D, column ~D)" thing |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
81 | (line-count-of counted-stream) |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
82 | (- (col-count-of counted-stream) |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
83 | (length (format nil "~S" thing)))) |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
84 | end |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
85 | do (print thing)))) |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
86 | 1 |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
87 | 2 |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
88 | 3 |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
89 | Non-number :FOO (line 2, column 5) |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
90 | [Condition of type SIMPLE-ERROR] |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
91 | |# |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
92 | (defclass counting-character-input-stream |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
93 | (wrapped-character-input-stream) |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
94 | ((char-count :initform 1 :accessor char-count-of) |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
95 | (line-count :initform 1 :accessor line-count-of) |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
96 | (col-count :initform 1 :accessor col-count-of) |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
97 | (prev-col-count :initform 1 :accessor prev-col-count-of))) |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
98 | |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
99 | (defmethod stream-read-char ((stream counting-character-input-stream)) |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
100 | (with-accessors ((inner-stream stream-of) (chars char-count-of) |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
101 | (lines line-count-of) (cols col-count-of) |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
102 | (prev prev-col-count-of)) stream |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
103 | (let ((char (call-next-method))) |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
104 | (cond ((eql char :eof) |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
105 | :eof) |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
106 | ((char= char #\Newline) |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
107 | (incf lines) |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
108 | (incf chars) |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
109 | (setf prev cols) |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
110 | (setf cols 1) |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
111 | char) |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
112 | (t |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
113 | (incf chars) |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
114 | (incf cols) |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
115 | char))))) |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
116 | |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
117 | (defmethod stream-unread-char ((stream counting-character-input-stream) |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
118 | char) |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
119 | (with-accessors ((inner-stream stream-of) (chars char-count-of) |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
120 | (lines line-count-of) (cols col-count-of) |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
121 | (prev prev-col-count-of)) stream |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
122 | (cond ((char= char #\Newline) |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
123 | (decf lines) |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
124 | (decf chars) |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
125 | (setf cols prev)) |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
126 | (t |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
127 | (decf chars) |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
128 | (decf cols) |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
129 | char)) |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
130 | (call-next-method))) |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
131 | |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
132 | (defclass wrapped-character-output-stream (wrapped-stream fundamental-character-output-stream) |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
133 | ((col-index :initform 0 :accessor col-index-of))) |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
134 | |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
135 | (defmethod stream-line-column ((stream wrapped-character-output-stream)) |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
136 | (col-index-of stream)) |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
137 | |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
138 | (defmethod stream-write-char ((stream wrapped-character-output-stream) |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
139 | char) |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
140 | (with-accessors ((inner-stream stream-of) (cols col-index-of)) stream |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
141 | (write-char char inner-stream) |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
142 | (if (char= char #\Newline) |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
143 | (setf cols 0) |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
144 | (incf cols)))) |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
145 | |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
146 | #| example: |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
147 | (flet ((format-timestamp (stream) |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
148 | (apply #'format stream "[~2@*~2,' D:~1@*~2,'0D:~0@*~2,'0D] " |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
149 | (multiple-value-list (get-decoded-time))))) |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
150 | (let ((output (make-instance 'prefixed-character-output-stream |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
151 | :stream *standard-output* |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
152 | :prefix #'format-timestamp))) |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
153 | (loop for string in '("abc" "def" "ghi") do |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
154 | (write-line string output) |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
155 | (sleep 1)))) |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
156 | [ 0:30:05] abc |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
157 | [ 0:30:06] def |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
158 | [ 0:30:07] ghi |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
159 | NIL |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
160 | |# |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
161 | (defclass prefixed-character-output-stream |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
162 | (wrapped-character-output-stream) |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
163 | ((prefix :initarg :prefix :reader prefix-of))) |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
164 | |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
165 | (defgeneric write-prefix (prefix stream) |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
166 | (:method ((prefix string) stream) (write-string prefix stream)) |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
167 | (:method ((prefix function) stream) (funcall prefix stream))) |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
168 | |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
169 | (defmethod stream-write-char ((stream prefixed-character-output-stream) |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
170 | char) |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
171 | (with-accessors ((inner-stream stream-of) (cols col-index-of) |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
172 | (prefix prefix-of)) stream |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
173 | (when (zerop cols) |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
174 | (write-prefix prefix inner-stream)) |
c4682fedd73d
added krypt lib, will probably add homer too
Richard Westhaver <ellis@rwest.io>
parents:
279
diff
changeset
|
175 | (call-next-method))) |