[mcclim-cvs] CVS mcclim/Drei
thenriksen
thenriksen at common-lisp.net
Mon Jan 15 11:35:55 UTC 2007
Update of /project/mcclim/cvsroot/mcclim/Drei
In directory clnet:/tmp/cvs-serv19991/Drei
Modified Files:
packages.lisp
Added Files:
buffer-streams.lisp
Log Message:
Added implementation of the gray streams protocol using Drei buffers
as the backend.
--- /project/mcclim/cvsroot/mcclim/Drei/packages.lisp 2006/12/22 15:34:46 1.11
+++ /project/mcclim/cvsroot/mcclim/Drei/packages.lisp 2007/01/15 11:35:54 1.12
@@ -421,7 +421,11 @@
#:replace-rectangle-line
#:insert-in-rectangle-line
#:delete-rectangle-line-whitespace
- #:with-narrowed-buffer)
+ #:with-narrowed-buffer
+
+ #:start-mark
+ #:end-mark
+ #:make-buffer-stream)
(:documentation "Implementation of much syntax-aware, yet no
syntax-specific, core functionality of Drei."))
--- /project/mcclim/cvsroot/mcclim/Drei/buffer-streams.lisp 2007/01/15 11:35:55 NONE
+++ /project/mcclim/cvsroot/mcclim/Drei/buffer-streams.lisp 2007/01/15 11:35:55 1.1
;;; -*- Mode: Lisp; Package: DREI-CORE -*-
;;; (c) copyright 2006-2007 by
;;; Troels Henriksen (athas at sigkill.dk)
;;; This library is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU Library General Public
;;; License as published by the Free Software Foundation; either
;;; version 2 of the License, or (at your option) any later version.
;;;
;;; This library is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;;; Library General Public License for more details.
;;;
;;; You should have received a copy of the GNU Library General Public
;;; License along with this library; if not, write to the
;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;;; Boston, MA 02111-1307 USA.
(in-package :drei-core)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; (Gray) streams interface to buffers.
(defclass buffer-stream (fundamental-character-input-stream
fundamental-character-output-stream)
((%buffer :initarg :buffer
:initform (error "A buffer must be provided")
:reader buffer
:documentation "The buffer from which this stream
will read data.")
(%start-mark :initarg :start-mark
:reader start-mark
:documentation "A mark into the buffer of the
stream that indicates from which point on the stream will read
data from the buffer. By default, the beginning of the
buffer. This mark should not be changed.")
(%end-mark :initarg :end-mark
:reader end-mark
:documentation "A mark into the buffer of the
stream that indicates the buffer position that the stream will
consider end-of-file. By default, the end of the buffer. This
mark should not be changed.")
(%point :accessor point
:documentation "A mark indicating the current position
in the buffer of the stream."))
(:documentation "A bidirectional stream that performs I/O on an
underlying Drei buffer. Marks can be provided to let the stream
operate on only a specific section of the buffer."))
(defmethod initialize-instance :after
((stream buffer-stream) &key)
(unless (slot-boundp stream '%start-mark)
(setf (slot-value stream '%start-mark)
(clone-mark (point (buffer stream)) :left))
(beginning-of-buffer (start-mark stream)))
(unless (slot-boundp stream '%end-mark)
(setf (slot-value stream '%end-mark)
(clone-mark (start-mark stream) :right))
(end-of-buffer (end-mark stream)))
(setf (point stream)
(narrow-mark (clone-mark (start-mark stream) :right)
(start-mark stream)
(end-mark stream))))
;;; Input methods.
(defmethod stream-read-char ((stream buffer-stream))
(if (end-of-buffer-p (point stream))
:eof
(prog1 (object-after (point stream))
(forward-object (point stream)))))
(defmethod stream-unread-char ((stream buffer-stream) (char character))
(unless (beginning-of-buffer-p (point stream))
(backward-object (point stream))
nil))
(defmethod stream-read-char-no-hang ((stream buffer-stream))
(stream-read-char stream))
(defmethod stream-peek-char ((stream buffer-stream))
(if (end-of-buffer-p (point stream))
:eof
(object-after (point stream))))
(defmethod stream-listen ((stream buffer-stream))
(not (end-of-buffer-p (point stream))))
(defmethod stream-read-line ((stream buffer-stream))
(let ((orig-offset (offset (point stream)))
(end-of-line-offset (offset (end-of-line (point stream)))))
(unless (end-of-buffer-p (point stream))
(forward-object (point stream)))
(values (buffer-substring (buffer stream)
orig-offset
end-of-line-offset)
(end-of-buffer-p (point stream)))))
(defmethod stream-clear-input ((stream buffer-stream))
nil)
;;; Output methods.
(defmethod stream-write-char ((stream buffer-stream) char)
(insert-object (point stream) char))
(defmethod stream-line-column ((stream buffer-stream))
(column-number (point stream)))
(defmethod stream-start-line-p ((stream buffer-stream))
(or (mark= (point stream)
(start-mark stream))
(beginning-of-line-p (point stream))))
(defmethod stream-write-string ((stream buffer-stream) string &optional (start 0) end)
(insert-sequence (point stream)
(subseq string start end)))
(defmethod stream-terpri ((stream buffer-stream))
(insert-object (point stream) #\Newline))
(defmethod stream-fresh-line ((stream buffer-stream))
(unless (stream-start-line-p stream)
(stream-terpri stream)))
(defmethod stream-finish-output ((stream buffer-stream))
(declare (ignore stream))
nil)
(defmethod stream-force-output ((stream buffer-stream))
(declare (ignore stream))
nil)
(defmethod stream-clear-output ((stream buffer-stream))
(declare (ignore stream))
nil)
(defmethod stream-advance-to-column ((stream buffer-stream) (column integer))
(call-next-method))
(defmethod interactive-stream-p ((stream buffer-stream))
nil)
;;; Interface functions.
(defun make-buffer-stream (&key (buffer *current-buffer*)
(start-mark nil start-mark-p)
(end-mark nil end-mark-p))
"Create a buffer stream object reading data from `buffer'. By
default, the stream will read from the beginning of the buffer
and until the end of the buffer, but this can be changed via the
optional arguments `start-mark' and `end-mark'."
(apply #'make-instance 'buffer-stream
:buffer buffer
(append (when start-mark-p
(list :start-mark (clone-mark start-mark :left)))
(when end-mark-p
(list :end-mark (clone-mark end-mark :right))))))
More information about the Mcclim-cvs
mailing list