/[mcclim]/mcclim/Drei/buffer-streams.lisp
ViewVC logotype

Contents of /mcclim/Drei/buffer-streams.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.2 - (show annotations)
Mon Nov 19 20:28:43 2007 UTC (6 years, 5 months ago) by thenriksen
Branch: MAIN
CVS Tags: McCLIM-0-9-6, HEAD
Changes since 1.1: +2 -2 lines
Change the use of global variables in Drei to functions that query a
single global variable (*drei-instance*).

At the same time, change a few things in ESA to make Dreis use of it
less hacky.
1 ;;; -*- Mode: Lisp; Package: DREI-CORE -*-
2
3 ;;; (c) copyright 2006-2007 by
4 ;;; Troels Henriksen (athas@sigkill.dk)
5
6 ;;; This library is free software; you can redistribute it and/or
7 ;;; modify it under the terms of the GNU Library General Public
8 ;;; License as published by the Free Software Foundation; either
9 ;;; version 2 of the License, or (at your option) any later version.
10 ;;;
11 ;;; This library is distributed in the hope that it will be useful,
12 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
13 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
14 ;;; Library General Public License for more details.
15 ;;;
16 ;;; You should have received a copy of the GNU Library General Public
17 ;;; License along with this library; if not, write to the
18 ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 ;;; Boston, MA 02111-1307 USA.
20
21 (in-package :drei-core)
22
23 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
24 ;;;
25 ;;; (Gray) streams interface to buffers.
26
27 (defclass buffer-stream (fundamental-character-input-stream
28 fundamental-character-output-stream)
29 ((%buffer :initarg :buffer
30 :initform (error "A buffer must be provided")
31 :reader buffer
32 :documentation "The buffer from which this stream
33 will read data.")
34 (%start-mark :initarg :start-mark
35 :reader start-mark
36 :documentation "A mark into the buffer of the
37 stream that indicates from which point on the stream will read
38 data from the buffer. By default, the beginning of the
39 buffer. This mark should not be changed.")
40 (%end-mark :initarg :end-mark
41 :reader end-mark
42 :documentation "A mark into the buffer of the
43 stream that indicates the buffer position that the stream will
44 consider end-of-file. By default, the end of the buffer. This
45 mark should not be changed.")
46 (%point :accessor point-of
47 :documentation "A mark indicating the current position
48 in the buffer of the stream."))
49 (:documentation "A bidirectional stream that performs I/O on an
50 underlying Drei buffer. Marks can be provided to let the stream
51 operate on only a specific section of the buffer."))
52
53 (defmethod initialize-instance :after
54 ((stream buffer-stream) &key)
55 (unless (slot-boundp stream '%start-mark)
56 (setf (slot-value stream '%start-mark)
57 (clone-mark (point (buffer stream)) :left))
58 (beginning-of-buffer (start-mark stream)))
59 (unless (slot-boundp stream '%end-mark)
60 (setf (slot-value stream '%end-mark)
61 (clone-mark (start-mark stream) :right))
62 (end-of-buffer (end-mark stream)))
63 (setf (point stream)
64 (narrow-mark (clone-mark (start-mark stream) :right)
65 (start-mark stream)
66 (end-mark stream))))
67
68 ;;; Input methods.
69
70 (defmethod stream-read-char ((stream buffer-stream))
71 (if (end-of-buffer-p (point stream))
72 :eof
73 (prog1 (object-after (point stream))
74 (forward-object (point stream)))))
75
76 (defmethod stream-unread-char ((stream buffer-stream) (char character))
77 (unless (beginning-of-buffer-p (point stream))
78 (backward-object (point stream))
79 nil))
80
81 (defmethod stream-read-char-no-hang ((stream buffer-stream))
82 (stream-read-char stream))
83
84 (defmethod stream-peek-char ((stream buffer-stream))
85 (if (end-of-buffer-p (point stream))
86 :eof
87 (object-after (point stream))))
88
89 (defmethod stream-listen ((stream buffer-stream))
90 (not (end-of-buffer-p (point stream))))
91
92 (defmethod stream-read-line ((stream buffer-stream))
93 (let ((orig-offset (offset (point stream)))
94 (end-of-line-offset (offset (end-of-line (point stream)))))
95 (unless (end-of-buffer-p (point stream))
96 (forward-object (point stream)))
97 (values (buffer-substring (buffer stream)
98 orig-offset
99 end-of-line-offset)
100 (end-of-buffer-p (point stream)))))
101
102 (defmethod stream-clear-input ((stream buffer-stream))
103 nil)
104
105 ;;; Output methods.
106
107 (defmethod stream-write-char ((stream buffer-stream) char)
108 (insert-object (point stream) char))
109
110 (defmethod stream-line-column ((stream buffer-stream))
111 (column-number (point stream)))
112
113 (defmethod stream-start-line-p ((stream buffer-stream))
114 (or (mark= (point stream)
115 (start-mark stream))
116 (beginning-of-line-p (point stream))))
117
118 (defmethod stream-write-string ((stream buffer-stream) string &optional (start 0) end)
119 (insert-sequence (point stream)
120 (subseq string start end)))
121
122 (defmethod stream-terpri ((stream buffer-stream))
123 (insert-object (point stream) #\Newline))
124
125 (defmethod stream-fresh-line ((stream buffer-stream))
126 (unless (stream-start-line-p stream)
127 (stream-terpri stream)))
128
129 (defmethod stream-finish-output ((stream buffer-stream))
130 (declare (ignore stream))
131 nil)
132
133 (defmethod stream-force-output ((stream buffer-stream))
134 (declare (ignore stream))
135 nil)
136
137 (defmethod stream-clear-output ((stream buffer-stream))
138 (declare (ignore stream))
139 nil)
140
141 (defmethod stream-advance-to-column ((stream buffer-stream) (column integer))
142 (call-next-method))
143
144 (defmethod interactive-stream-p ((stream buffer-stream))
145 nil)
146
147 ;;; Interface functions.
148
149 (defun make-buffer-stream (&key (buffer (current-buffer))
150 (start-mark nil start-mark-p)
151 (end-mark nil end-mark-p))
152 "Create a buffer stream object reading data from `buffer'. By
153 default, the stream will read from the beginning of the buffer
154 and until the end of the buffer, but this can be changed via the
155 optional arguments `start-mark' and `end-mark'."
156 (apply #'make-instance 'buffer-stream
157 :buffer buffer
158 (append (when start-mark-p
159 (list :start-mark (clone-mark start-mark :left)))
160 (when end-mark-p
161 (list :end-mark (clone-mark end-mark :right))))))

  ViewVC Help
Powered by ViewVC 1.1.5