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

  ViewVC Help
Powered by ViewVC 1.1.5