/[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 - (hide 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 thenriksen 1.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 thenriksen 1.3 standard-input-editing-mixin
31 thenriksen 1.1 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 thenriksen 1.2 (defmethod interactive-stream-p ((stream goatee-input-editing-stream))
42     t)
43    
44 thenriksen 1.1 (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 thenriksen 1.3 (defmethod input-editing-stream-output-record ((stream goatee-input-editing-stream))
154     (area stream))

  ViewVC Help
Powered by ViewVC 1.1.5