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

Contents of /mcclim/output.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.5 - (hide annotations)
Sun Apr 21 12:41:14 2002 UTC (12 years ago) by brian
Branch: MAIN
Changes since 1.4: +4 -0 lines
Sundry fixes to run without multiprocessing support.

Added images/ to hold bitmaps for tests.

Added looks/ to hold neutral look-and-feel realizer packages.

Added Examples/gadget-test to test many gadgets with a look and feel.

Added a pixie look and feel, and a pixie/clx to work with the clx backend.

Added drawing support in the CLX backend for ovals and circles.

Fixed pixmaps to work with with-output-to-pixmap with draw-image, etc.

Moved sheet-leaf-mixin to standard-gadget-pane so it doesn't break radio-box-pane, etc.

Misc fixes.
1 mikemac 1.1 ;;; -*- Mode: Lisp; Package: CLIM-INTERNALS -*-
2    
3     ;;; (c) copyright 1998,1999,2000 by Michael McDonald (mikemac@mikemac.com)
4    
5     ;;; This library is free software; you can redistribute it and/or
6     ;;; modify it under the terms of the GNU Library General Public
7     ;;; License as published by the Free Software Foundation; either
8     ;;; version 2 of the License, or (at your option) any later version.
9     ;;;
10     ;;; This library is distributed in the hope that it will be useful,
11     ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
12     ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
13     ;;; Library General Public License for more details.
14     ;;;
15     ;;; You should have received a copy of the GNU Library General Public
16     ;;; License along with this library; if not, write to the
17     ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
18     ;;; Boston, MA 02111-1307 USA.
19    
20     (in-package :CLIM-INTERNALS)
21    
22     (defclass standard-sheet-output-mixin ()
23     (
24     ))
25    
26 rouanet 1.2 (defclass sheet-mute-output-mixin ()
27 mikemac 1.1 (
28     ))
29    
30 gilbert 1.3 (defclass sheet-with-medium-mixin ()
31     ((medium :initform nil
32     :reader sheet-medium
33     :writer (setf %sheet-medium))))
34    
35     (defclass temporary-medium-sheet-output-mixin (sheet-with-medium-mixin)
36     ())
37    
38     (defclass permanent-medium-sheet-output-mixin (sheet-with-medium-mixin)
39     ())
40 mikemac 1.1
41     (defmethod initialize-instance :after ((sheet permanent-medium-sheet-output-mixin) &rest args)
42     (declare (ignore args))
43 gilbert 1.4 ;; hmm,
44     (setf (%sheet-medium sheet) (make-medium (port sheet) sheet))
45     ;; hmm...
46     (engraft-medium (sheet-medium sheet) (port sheet) sheet))
47 gilbert 1.3
48     (defmacro with-sheet-medium ((medium sheet) &body body)
49     (let ((fn (gensym)))
50     `(labels ((,fn (,medium)
51     ,@body))
52     (declare (dynamic-extent #',fn))
53     (invoke-with-sheet-medium-bound #',fn nil ,sheet))))
54    
55     (defmacro with-sheet-medium-bound ((sheet medium) &body body)
56     (let ((fn (gensym)))
57     `(labels ((,fn (,medium)
58     ,@body))
59     (declare (dynamic-extent #',fn))
60     (invoke-with-sheet-medium-bound #',fn ,medium ,sheet))))
61 mikemac 1.1
62 gilbert 1.3 (defmethod invoke-with-sheet-medium-bound (continuation (medium null) (sheet permanent-medium-sheet-output-mixin))
63     (funcall continuation (sheet-medium sheet)))
64    
65 brian 1.5 ; BTS added this. CHECKME
66     (defmethod invoke-with-sheet-medium-bound (continuation (medium null) (sheet mirrored-pixmap))
67     (funcall continuation (pixmap-medium sheet)))
68    
69 gilbert 1.3 (defmethod invoke-with-sheet-medium-bound (continuation (medium null) (sheet temporary-medium-sheet-output-mixin))
70     (let ((old-medium (sheet-medium sheet))
71     (new-medium (allocate-medium (port sheet) sheet)))
72     (unwind-protect
73     (progn
74     (engraft-medium new-medium (port sheet) sheet)
75     (setf (%sheet-medium sheet) new-medium)
76     (funcall continuation new-medium))
77     (setf (%sheet-medium sheet) old-medium)
78     (degraft-medium new-medium (port sheet) sheet)
79     (deallocate-medium (port sheet) new-medium))))
80    
81     ;; The description of WITH-SHEET-MEDIUM-BOUND in the spec, seems to be
82     ;; extremly bogus, what is its purpose?
83    
84     (defmethod invoke-with-sheet-medium-bound (continuation
85     (medium basic-medium)
86     (sheet permanent-medium-sheet-output-mixin))
87     ;; this seems to be extremly bogus to me.
88     (funcall continuation medium))
89    
90     (defmethod invoke-with-sheet-medium-bound (continuation
91     (medium basic-medium)
92     (sheet temporary-medium-sheet-output-mixin))
93     (cond ((not (null (sheet-medium sheet)))
94     (funcall continuation medium))
95     (t
96     (let ((old-medium (sheet-medium sheet))
97     (new-medium medium))
98     (unwind-protect
99     (progn
100     (engraft-medium new-medium (port sheet) sheet)
101     (setf (%sheet-medium sheet) new-medium)
102     (funcall continuation new-medium))
103     (setf (%sheet-medium sheet) old-medium)
104     (degraft-medium new-medium (port sheet) sheet) )))))

  ViewVC Help
Powered by ViewVC 1.1.5