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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.8 - (show annotations)
Wed Jan 30 17:08:01 2008 UTC (6 years, 2 months ago) by thenriksen
Branch: MAIN
Changes since 1.7: +12 -8 lines
Replay used input-editing streams whether they have an input-sensitizer or not.
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 ;;; Finalize input editing code by defining the stuff that actually
24 ;;; needs a working Drei loaded.
25
26 (in-package :clim-internals)
27
28 (defclass empty-input-mixin ()
29 ()
30 (:documentation "A mixin class used for detecting empty input"))
31
32 (defclass standard-input-editing-stream (drei:drei-input-editing-mixin
33 empty-input-mixin
34 input-editing-stream
35 standard-encapsulating-stream)
36 ((scan-pointer :accessor stream-scan-pointer :initform 0)
37 (rescan-queued :accessor rescan-queued :initform nil))
38 (:documentation "The instantiable class that implements CLIM's
39 standard input editor. This is the class of stream created by
40 calling `with-input-editing'.
41
42 Members of this class are mutable."))
43
44 (defmethod interactive-stream-p ((stream standard-input-editing-stream))
45 t)
46
47 (defmethod stream-accept ((stream standard-input-editing-stream) type
48 &rest args
49 &key (view (stream-default-view stream))
50 &allow-other-keys)
51 (apply #'prompt-for-accept stream type view args)
52 (apply #'accept-1 stream type args))
53
54 ;;; Markers for noise strings in the input buffer.
55
56 (defclass noise-string-property ()
57 ())
58
59 (defclass noise-string-start-property (noise-string-property)
60 ())
61
62 (defparameter *noise-string* (make-instance 'noise-string-property))
63
64 (defparameter *noise-string-start*
65 (make-instance 'noise-string-start-property))
66
67 (defgeneric activate-stream (stream gesture)
68 (:documentation "Cause the input editing stream STREAM to be
69 activated with GESTURE"))
70
71 (defmethod activate-stream ((stream standard-input-editing-stream) gesture)
72 (setf (drei::activation-gesture stream) gesture))
73
74 ;;; These helper functions take the arguments of ACCEPT so that they
75 ;;; can be used directly by ACCEPT.
76
77 (defun make-activation-gestures
78 (&key (activation-gestures nil activation-gestures-p)
79 (additional-activation-gestures nil additional-activations-p)
80 (existing-activation-gestures *activation-gestures*)
81 &allow-other-keys)
82 (cond (additional-activations-p
83 (append additional-activation-gestures existing-activation-gestures))
84 (activation-gestures-p
85 activation-gestures)
86 (t (or existing-activation-gestures
87 *standard-activation-gestures*))))
88
89 (defun make-delimiter-gestures
90 (&key (delimiter-gestures nil delimiter-gestures-p)
91 (additional-delimiter-gestures nil additional-delimiters-p)
92 (existing-delimiter-gestures *delimiter-gestures*)
93 &allow-other-keys)
94 (cond (additional-delimiters-p
95 (append additional-delimiter-gestures existing-delimiter-gestures))
96 (delimiter-gestures-p
97 delimiter-gestures)
98 (t existing-delimiter-gestures)))
99
100 (define-condition rescan-condition (condition)
101 ())
102
103 (defgeneric finalize (editing-stream input-sensitizer)
104 (:documentation "Do any cleanup on an editing stream, like turning off the
105 cursor, etc."))
106
107 (defmethod finalize ((stream drei:drei-input-editing-mixin)
108 input-sensitizer)
109 (setf (cursor-visibility stream) nil)
110 (let ((real-stream (encapsulating-stream-stream stream))
111 (record (drei:drei-instance stream)))
112 (cond (input-sensitizer
113 (erase-output-record record real-stream)
114 (funcall input-sensitizer
115 real-stream
116 #'(lambda ()
117 (stream-add-output-record real-stream record)
118 (when (stream-drawing-p real-stream)
119 (replay record real-stream)))))
120 ;; We still want to replay it for the cursor visibility
121 ;; change...
122 ((stream-drawing-p real-stream)
123 (replay record real-stream) ))
124 (setf (stream-cursor-position real-stream)
125 (values 0 (nth-value 3 (input-editing-stream-bounding-rectangle stream))))))
126
127 (defgeneric invoke-with-input-editing
128 (stream continuation input-sensitizer initial-contents class))
129
130 (defmethod invoke-with-input-editing :around ((stream extended-output-stream)
131 continuation
132 input-sensitizer
133 initial-contents
134 class)
135 (declare (ignore continuation input-sensitizer initial-contents class))
136 (letf (((cursor-visibility (stream-text-cursor stream)) nil))
137 (call-next-method)))
138
139 (defmethod invoke-with-input-editing :around (stream
140 continuation
141 input-sensitizer
142 initial-contents
143 class)
144 (declare (ignore continuation input-sensitizer initial-contents class))
145 (with-activation-gestures (*standard-activation-gestures*)
146 (call-next-method)))
147
148 ;; XXX: We are supposed to implement input editing for all
149 ;; "interactive streams", but that's not really reasonable. We only
150 ;; care about `clim-stream-pane's, at least for Drei, currently.
151 (defmethod invoke-with-input-editing ((stream clim-stream-pane)
152 continuation
153 input-sensitizer
154 initial-contents
155 class)
156 (let ((editing-stream (make-instance class
157 :stream stream
158 :initial-contents initial-contents)))
159 (unwind-protect
160 (loop
161 (block rescan
162 (handler-bind ((rescan-condition
163 #'(lambda (c)
164 (declare (ignore c))
165 (reset-scan-pointer editing-stream)
166 (return-from rescan nil))))
167 (return-from invoke-with-input-editing
168 (funcall continuation editing-stream)))))
169 (finalize editing-stream input-sensitizer))))
170
171 (defmethod immediate-rescan ((stream standard-input-editing-stream))
172 (unless (stream-rescanning-p stream)
173 (signal 'rescan-condition)))
174
175 (defmethod queue-rescan ((stream standard-input-editing-stream))
176 (setf (rescan-queued stream) t))
177
178 (defmethod rescan-if-necessary ((stream standard-input-editing-stream)
179 &optional inhibit-activation)
180 ;; FIXME:
181 (declare (ignore inhibit-activation))
182 (when (rescan-queued stream)
183 (setf (rescan-queued stream) nil)
184 (immediate-rescan stream)))
185
186 (defmethod input-editing-stream-bounding-rectangle ((stream standard-input-editing-stream))
187 (bounding-rectangle* (view (drei:drei-instance stream))))
188
189 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
190 ;;;
191 ;;; Presentation type history support
192 ;;;
193 ;;; Presentation histories are pretty underspecified, so we have to
194 ;;; rely on internal features and implement input-editor support in
195 ;;; CLIM-INTERNALS (Goatee does the same trick).
196
197 (defun history-yank-next (stream input-buffer gesture numeric-argument)
198 (declare (ignore input-buffer gesture numeric-argument))
199 (let* ((accepting-type *active-history-type*)
200 (history (and accepting-type
201 (presentation-type-history accepting-type))))
202 (when history
203 (multiple-value-bind (object type)
204 (presentation-history-next history accepting-type)
205 (when type
206 (presentation-replace-input stream object type (stream-default-view stream)
207 :allow-other-keys t
208 :accept-result nil))))))
209
210 (defun history-yank-previous (stream input-buffer gesture numeric-argument)
211 (declare (ignore input-buffer gesture numeric-argument))
212 (let* ((accepting-type *active-history-type*)
213 (history (and accepting-type
214 (presentation-type-history accepting-type))))
215 (when history
216 (multiple-value-bind (object type)
217 (presentation-history-previous history accepting-type)
218 (when type
219 (presentation-replace-input stream object type (stream-default-view stream)
220 :allow-other-keys t
221 :accept-result nil))))))
222
223 (add-input-editor-command '((#\n :meta)) 'history-yank-next)
224
225 (add-input-editor-command '((#\p :meta)) 'history-yank-previous)

  ViewVC Help
Powered by ViewVC 1.1.5