/[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.1 - (hide annotations)
Wed Nov 8 01:18:22 2006 UTC (7 years, 5 months ago) by thenriksen
Branch: MAIN
Committed changes necessary to support Drei (and non-Goatee input
editors at all). Also some indirection permitting run-time selection
of editor substrate and the code for :text-editor and :text-field
gadgets.
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     (rescan-queued :accessor rescan-queued :initform nil)))
47    
48     (defmethod stream-accept ((stream standard-input-editing-stream) type
49     &rest args
50     &key (view (stream-default-view stream))
51     &allow-other-keys)
52     (apply #'prompt-for-accept stream type view args)
53     (apply #'accept-1 stream type args))
54    
55     ;;; Markers for noise strings in the input buffer.
56    
57     (defclass noise-string-property ()
58     ())
59    
60     (defclass noise-string-start-property (noise-string-property)
61     ())
62    
63     (defparameter *noise-string* (make-instance 'noise-string-property))
64    
65     (defparameter *noise-string-start*
66     (make-instance 'noise-string-start-property))
67    
68     (defgeneric activate-stream (stream gesture)
69     (:documentation "Cause the input editing stream STREAM to be
70     activated with GESTURE"))
71    
72     (defmethod activate-stream ((stream standard-input-editing-stream) gesture)
73     (setf (drei::activation-gesture stream) gesture))
74    
75     ;;; These helper functions take the arguments of ACCEPT so that they
76     ;;; can be used directly by ACCEPT.
77    
78     (defun make-activation-gestures
79     (&key (activation-gestures nil activation-gestures-p)
80     (additional-activation-gestures nil additional-activations-p)
81     (existing-activation-gestures *activation-gestures*)
82     &allow-other-keys)
83     (cond (additional-activations-p
84     (append additional-activation-gestures existing-activation-gestures))
85     (activation-gestures-p
86     activation-gestures)
87     (t (or existing-activation-gestures
88     *standard-activation-gestures*))))
89    
90     (defun make-delimiter-gestures
91     (&key (delimiter-gestures nil delimiter-gestures-p)
92     (additional-delimiter-gestures nil additional-delimiters-p)
93     (existing-delimiter-gestures *delimiter-gestures*)
94     &allow-other-keys)
95     (cond (additional-delimiters-p
96     (append additional-delimiter-gestures existing-delimiter-gestures))
97     (delimiter-gestures-p
98     delimiter-gestures)
99     (t existing-delimiter-gestures)))
100    
101     (define-condition rescan-condition (condition)
102     ())
103    
104     (defun reposition-stream-cursor (stream)
105     "Moves the cursor somewhere clear of the editing area."
106     (let ((max-y 0))
107     (map-over-output-records #'(lambda (r)
108     (setf max-y (max max-y (bounding-rectangle-max-y r))))
109     (stream-output-history stream))
110     (setf (stream-cursor-position stream)
111     (values 0 max-y))))
112    
113     (defgeneric finalize (editing-stream input-sensitizer)
114     (:documentation "Do any cleanup on an editing stream, like turning off the
115     cursor, etc."))
116    
117     (defmethod finalize ((stream drei:drei-input-editing-mixin)
118     input-sensitizer)
119     (setf (cursor-visibility stream) nil)
120     (let ((real-stream (encapsulating-stream-stream stream))
121     (record (drei:drei-instance stream)))
122     (when input-sensitizer
123     (erase-output-record record real-stream)
124     (funcall input-sensitizer
125     real-stream
126     #'(lambda ()
127     (stream-add-output-record real-stream record)
128     (when (stream-drawing-p real-stream)
129     (replay record real-stream)))))
130     (reposition-stream-cursor real-stream)))
131    
132     (defgeneric invoke-with-input-editing
133     (stream continuation input-sensitizer initial-contents class))
134    
135     (defmethod invoke-with-input-editing :around ((stream extended-output-stream)
136     continuation
137     input-sensitizer
138     initial-contents
139     class)
140     (declare (ignore continuation input-sensitizer initial-contents class))
141     (letf (((cursor-visibility (stream-text-cursor stream)) nil))
142     (call-next-method)))
143    
144     (defmethod invoke-with-input-editing :around (stream
145     continuation
146     input-sensitizer
147     initial-contents
148     class)
149     (declare (ignore continuation input-sensitizer initial-contents class))
150     (with-activation-gestures (*standard-activation-gestures*)
151     (call-next-method)))
152    
153     ;; XXX: We are supposed to implement input editing for all
154     ;; "interactive streams", but that's not really reasonable. We only
155     ;; care about `clim-stream-pane's, at least for Drei, currently.
156     (defmethod invoke-with-input-editing ((stream clim-stream-pane)
157     continuation
158     input-sensitizer
159     initial-contents
160     class)
161     (let ((editing-stream (make-instance class
162     :stream stream
163     :initial-contents initial-contents)))
164     (unwind-protect
165     (loop
166     (block rescan
167     (handler-bind ((rescan-condition
168     #'(lambda (c)
169     (declare (ignore c))
170     (reset-scan-pointer editing-stream)
171     (return-from rescan nil))))
172     (return-from invoke-with-input-editing
173     (funcall continuation editing-stream)))))
174     (finalize editing-stream input-sensitizer))))
175    
176     (defmethod immediate-rescan ((stream standard-input-editing-stream))
177     (unless (stream-rescanning-p stream)
178     (signal 'rescan-condition)))
179    
180     (defmethod queue-rescan ((stream standard-input-editing-stream))
181     (setf (rescan-queued stream) t))
182    
183     (defmethod rescan-if-necessary ((stream standard-input-editing-stream)
184     &optional inhibit-activation)
185     ;; FIXME:
186     (declare (ignore inhibit-activation))
187     (when (rescan-queued stream)
188     (setf (rescan-queued stream) nil)
189     (immediate-rescan stream)))
190    
191     (defmethod input-editing-stream-bounding-rectangle ((stream standard-input-editing-stream))
192     (bounding-rectangle* (drei:drei-instance stream)))

  ViewVC Help
Powered by ViewVC 1.1.5