/[mcclim]/mcclim/input-editing-goatee.lisp
ViewVC logotype

Contents of /mcclim/input-editing-goatee.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.3 - (show annotations)
Fri Feb 1 20:28:46 2008 UTC (6 years, 2 months ago) by thenriksen
Branch: MAIN
CVS Tags: McCLIM-0-9-6, HEAD
Changes since 1.2: +3 -2 lines
Implemented generic input-editor typeout, provided we can get an
output record for the input editor.

Theoretically, the nice typeout implementation should now also work
for Goatee, though I seem to have broken it at some other point.
1 ;;; -*- Mode: Lisp; Package: CLIM-INTERNALS -*-
2
3 ;;; (c) copyright 2001 by
4 ;;; Tim Moore (moore@bricoworks.com)
5 ;;; (c) copyright 2006 by
6 ;; Troels Henriksen (athas@sigkill.dk)
7
8 ;;; This library is free software; you can redistribute it and/or
9 ;;; modify it under the terms of the GNU Library General Public
10 ;;; License as published by the Free Software Foundation; either
11 ;;; version 2 of the License, or (at your option) any later version.
12 ;;;
13 ;;; This library is distributed in the hope that it will be useful,
14 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
15 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
16 ;;; Library General Public License for more details.
17 ;;;
18 ;;; You should have received a copy of the GNU Library General Public
19 ;;; License along with this library; if not, write to the
20 ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
21 ;;; Boston, MA 02111-1307 USA.
22
23 ;;; Finalization of the implementation of the Goatee-based
24 ;;; input-editing-stream. This probably doesn't work perfectly.
25
26 (in-package :clim-internals)
27
28 (defclass goatee-input-editing-stream (empty-input-mixin
29 goatee:goatee-input-editing-mixin
30 standard-input-editing-mixin
31 input-editing-stream
32 standard-encapsulating-stream)
33 ((buffer :reader stream-input-buffer
34 :initform (make-array 16 :adjustable t :fill-pointer 0))
35 (insertion-pointer :accessor stream-insertion-pointer :initform 0)
36 (scan-pointer :accessor stream-scan-pointer :initform 0)
37 (rescan-queued :accessor rescan-queued :initform nil)
38 (rescanning-p :reader stream-rescanning-p :initform nil)
39 (activation-gesture :accessor activation-gesture :initform nil)))
40
41 (defmethod interactive-stream-p ((stream goatee-input-editing-stream))
42 t)
43
44 (defmethod stream-accept ((stream goatee-input-editing-stream) type
45 &rest args
46 &key (view (stream-default-view stream))
47 &allow-other-keys)
48 (apply #'prompt-for-accept stream type view args)
49 (apply #'accept-1 stream type args))
50
51 ;;; Have to reexamine how many of the keyword arguments to
52 ;;; stream-read-gesture should really be passed to the encapsulated
53 ;;; stream.
54 ;;;
55 ;;; OK, now I know :) They should all be passed, except for peek-p.
56 ;;; However, the loop that calls stream-read-gesture on the
57 ;;; encapsulated stream needs to return null if we see a :timeout or
58 ;;; :eof.
59 ;;;
60 ;;; Activation gesture handling has been moved out of
61 ;;; stream-process-gesture to stream-read-gesture and
62 ;;; stream-unread-gesture. This allows a gesture to be read in while
63 ;;; it is not an activation gesture, unread, and then read again as an
64 ;;; activation gesture. This kind of game seems to be needed for
65 ;;; reading forms properly. -- moore
66 (defmethod stream-read-gesture ((stream goatee-input-editing-stream)
67 &rest rest-args &key peek-p
68 &allow-other-keys)
69 (with-keywords-removed (rest-args (:peek-p))
70 (rescan-if-necessary stream)
71 (with-slots (buffer insertion-pointer scan-pointer activation-gesture)
72 stream
73 (loop
74 (loop
75 while (< scan-pointer insertion-pointer)
76 do (let ((gesture (aref buffer scan-pointer)))
77 ;; Skip noise strings.
78 ;; XXX We should skip accept results too; I think that they
79 ;; should be consumed by ACCEPT-1. That's not happening yet.
80 (cond ((characterp gesture)
81 (unless peek-p
82 (incf scan-pointer))
83 (return-from stream-read-gesture gesture))
84 ((and (not peek-p)
85 (typep gesture 'goatee::accept-result-extent))
86 (incf scan-pointer)
87 (throw-object-ptype (goatee::object gesture)
88 (goatee::result-type gesture)))
89 (t (incf scan-pointer)))))
90 ;; The scan pointer should not be greater than the insertion pointer
91 ;; because the code that set the insertion pointer should have queued
92 ;; a rescan.
93 (when (> scan-pointer insertion-pointer)
94 (warn "scan-pointer ~S > insertion-pointer ~S; shouldn't happen"
95 scan-pointer insertion-pointer)
96 (immediate-rescan stream))
97 (when activation-gesture
98 (return-from stream-read-gesture
99 (prog1
100 activation-gesture
101 (unless peek-p
102 (setf activation-gesture nil)))))
103 (setf (slot-value stream 'rescanning-p) nil)
104 ;; In McCLIM stream-process-gesture is responsible for inserting
105 ;; characters into the buffer, changing the insertion pointer and
106 ;; possibly setting up the activation-gesture slot.
107 (loop
108 with gesture and type
109 do (setf (values gesture type)
110 (apply #'stream-read-gesture
111 (encapsulating-stream-stream stream) rest-args))
112 when (null gesture)
113 do (return-from stream-read-gesture (values gesture type))
114 when (stream-process-gesture stream gesture type)
115 do (loop-finish))))))
116
117 (defmethod stream-unread-gesture ((stream goatee-input-editing-stream)
118 gesture)
119 (with-slots (buffer scan-pointer activation-gesture)
120 stream
121 (when (> scan-pointer 0)
122 (if (and (eql scan-pointer (fill-pointer buffer))
123 (activation-gesture-p gesture))
124 (setf activation-gesture gesture)
125 (decf scan-pointer)))))
126
127 (defmethod activate-stream ((stream goatee-input-editing-stream) gesture)
128 (setf (activation-gesture stream) gesture)
129 (setf (stream-insertion-pointer stream)
130 (fill-pointer (stream-input-buffer stream)))
131 (goatee::set-editing-stream-insertion-pointer
132 stream
133 (stream-insertion-pointer stream)))
134
135 (defmethod reset-scan-pointer ((stream goatee-input-editing-stream)
136 &optional (scan-pointer 0))
137 (setf (stream-scan-pointer stream) scan-pointer)
138 (setf (slot-value stream 'rescanning-p) t))
139
140 (defmethod immediate-rescan ((stream goatee-input-editing-stream))
141 (signal 'rescan-condition))
142
143 (defmethod queue-rescan ((stream goatee-input-editing-stream))
144 (setf (rescan-queued stream) t))
145
146 (defmethod rescan-if-necessary ((stream goatee-input-editing-stream)
147 &optional inhibit-activation)
148 (declare (ignore inhibit-activation))
149 (when (rescan-queued stream)
150 (setf (rescan-queued stream) nil)
151 (immediate-rescan stream)))
152
153 (defmethod input-editing-stream-output-record ((stream goatee-input-editing-stream))
154 (area stream))

  ViewVC Help
Powered by ViewVC 1.1.5