/[mcclim]/mcclim/repaint.lisp
ViewVC logotype

Contents of /mcclim/repaint.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.11 - (hide annotations)
Sat Jul 26 17:37:57 2003 UTC (10 years, 9 months ago) by gilbert
Branch: MAIN
Changes since 1.10: +1 -1 lines
Due to popular demand we spit FORMAT-style debugging messages out to
*trace-output* instead of *debug-io*
1 rouanet 1.1 ;;; -*- Mode: Lisp; Package: CLIM-INTERNALS -*-
2    
3     ;;; (c) copyright 1998,1999,2000 by Michael McDonald (mikemac@mikemac.com),
4     ;;; (c) copyright 2000 by
5     ;;; Iban Hatchondo (hatchond@emi.u-bordeaux.fr)
6     ;;; Julien Boninfante (boninfan@emi.u-bordeaux.fr)
7     ;;; Robert Strandh (strandh@labri.u-bordeaux.fr)
8    
9     ;;; This library is free software; you can redistribute it and/or
10     ;;; modify it under the terms of the GNU Library General Public
11     ;;; License as published by the Free Software Foundation; either
12     ;;; version 2 of the License, or (at your option) any later version.
13     ;;;
14     ;;; This library is distributed in the hope that it will be useful,
15     ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16     ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
17     ;;; Library General Public License for more details.
18     ;;;
19     ;;; You should have received a copy of the GNU Library General Public
20     ;;; License along with this library; if not, write to the
21     ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
22     ;;; Boston, MA 02111-1307 USA.
23    
24    
25    
26     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
27     ;;;
28     ;;; The Repaint Protocol
29    
30 mikemac 1.7 (in-package :clim-internals)
31 rouanet 1.1
32     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
33     ;;;
34     ;;; repaint protocol functions
35    
36     (defmethod queue-repaint ((sheet basic-sheet) (event window-repaint-event))
37     (queue-event sheet event))
38    
39 hefner1 1.10 (defmethod handle-repaint ((sheet basic-sheet) region)
40 rouanet 1.1 nil)
41    
42 moore 1.3 (defmethod repaint-sheet ((sheet basic-sheet) region)
43     (map-over-sheets-overlapping-region #'(lambda (s)
44     (handle-repaint s region))
45     sheet
46     region))
47    
48 rouanet 1.1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
49     ;;;
50     ;;; repaint protocol classes
51    
52     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
53     ;;;
54     ;;; standard repainting mixin
55    
56     (defclass standard-repainting-mixin () ())
57    
58 moore 1.3 (defmethod dispatch-event
59     ((sheet standard-repainting-mixin) (event window-repaint-event))
60     (queue-repaint sheet event))
61    
62 rouanet 1.1 (defmethod dispatch-repaint ((sheet standard-repainting-mixin) region)
63 gilbert 1.6 (when (sheet-mirror sheet) ;only dispatch repaints, when the sheet has a mirror
64     (queue-repaint sheet (make-instance 'window-repaint-event
65     :sheet sheet
66     :region (transform-region
67     (sheet-native-transformation sheet)
68     region)))))
69 rouanet 1.1
70 moore 1.3 (defmethod handle-event ((sheet standard-repainting-mixin)
71     (event window-repaint-event))
72     (handle-repaint sheet (window-event-region event)))
73    
74 rouanet 1.1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
75     ;;;
76     ;;; immediate repainting mixin
77    
78     (defclass immediate-repainting-mixin () ())
79    
80 moore 1.3 (defmethod dispatch-event
81     ((sheet immediate-repainting-mixin) (event window-repaint-event))
82     (handle-repaint sheet (window-event-region event)))
83    
84 rouanet 1.1 (defmethod dispatch-repaint ((sheet immediate-repainting-mixin) region)
85     (handle-repaint sheet region))
86    
87 moore 1.3 (defmethod handle-event ((sheet immediate-repainting-mixin)
88     (event window-repaint-event))
89     (handle-repaint sheet (window-event-region event)))
90    
91 rouanet 1.1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
92     ;;;
93     ;;; sheet mute repainting mixin
94    
95     (defclass sheet-mute-repainting-mixin () ())
96    
97     (defmethod dispatch-repaint ((sheet sheet-mute-repainting-mixin) region)
98 gilbert 1.6 (when (sheet-mirror sheet) ;only dispatch repaints, when the sheet has a mirror
99     (queue-repaint sheet (make-instance 'window-repaint-event
100     :sheet sheet
101     :region (transform-region
102     (sheet-native-transformation sheet)
103     region)))))
104 rouanet 1.1
105 moore 1.3 ;;; I know what the spec says about sheet-mute-repainting-mixin, but I don't
106     ;;; think it's right; "repaint-sheet that does nothing" makes no sense.
107     ;;; -- moore
108     #+nil
109 rouanet 1.1 (defmethod repaint-sheet ((sheet sheet-mute-repainting-mixin) region)
110     (declare (ignorable sheet region))
111 gilbert 1.11 (format *trace-output* "repaint ~S~%" sheet)
112 rouanet 1.1 (values))
113 gilbert 1.2
114 moore 1.3 (defmethod handle-repaint ((sheet sheet-mute-repainting-mixin) region)
115     (declare (ignore region))
116     nil)
117 gilbert 1.2
118 moore 1.3 (defclass clim-repainting-mixin
119     (#+clim-mp standard-repainting-mixin #-clim-mp immediate-repainting-mixin)
120     ()
121     (:documentation "Internal class that implements repainting protocol based on
122     whether or not multiprocessing is supported."))

  ViewVC Help
Powered by ViewVC 1.1.5