/[cl-cairo2]/xlib-context.lisp
ViewVC logotype

Diff of /xlib-context.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 13 by tpapp, Wed Aug 22 16:13:14 2007 UTC revision 15 by tpapp, Thu Dec 20 13:05:07 2007 UTC
# Line 51  meant for internal use in the cl-cairo2 Line 51  meant for internal use in the cl-cairo2
51                 0 0 width height 0 0)                 0 0 width height 0 0)
52      (xsync display 1)))      (xsync display 1)))
53    
 (defun create-window (display parent width height class visual background-pixel  
                       event-mask &optional (backing-store t))  
   "Create an x11 window, placed at 0 0, with the given attributes.  
 For internal use in the cl-cairo2 package."  
   ;; call xcreatewindow with attributes  
   (with-foreign-object (attributes 'xsetwindowattributes)  
     (setf (foreign-slot-value attributes 'xsetwindowattributes 'event-mask)  
           event-mask  
           (foreign-slot-value attributes 'xsetwindowattributes 'background-pixel)  
           background-pixel  
           (foreign-slot-value attributes 'xsetwindowattributes 'backing-store)  
           (if backing-store 1 0))  
     (xcreatewindow display parent 0 0 width height  
                    0                    ; zero border width  
                    0                    ; depth - copy from parent  
                    (ecase class  
                      (copyfromparent 0)  
                      (inputoutput 1)  
                      (inputonly 2))     ; class  
                    visual  
                    (if (eq class 'inputonly)  
                        cweventmask  
                        (logior cwbackpixel cwbackingstore cweventmask))  
                    attributes)))  
   
54  (defun create-xlib-context (width height &key  (defun create-xlib-context (width height &key
55                              (display-name nil)                              (display-name nil)
56                              (window-name (next-xlib-context-name)))                              (window-name (next-xlib-context-name)))
# Line 101  For internal use in the cl-cairo2 packag Line 76  For internal use in the cl-cairo2 packag
76                         (with-foreign-slots ((type window serial) xev xanyevent)                         (with-foreign-slots ((type window serial) xev xanyevent)
77                           ;; action based on event type                           ;; action based on event type
78                           (cond                           (cond
79                             ;; expose and configurenotify events                             ;; expose events
80                             ((and (= type 12) (= window this-window))                             ((and (= type 12) (= window this-window))
81                              (refresh-xlib-context xlib-context))                              (refresh-xlib-context xlib-context))
82                             ;; clientnotify event                             ;; clientnotify event
# Line 121  For internal use in the cl-cairo2 packag Line 96  For internal use in the cl-cairo2 packag
96                 ;; close down everything                 ;; close down everything
97                 (with-slots (display pixmap window signal-window pointer)                 (with-slots (display pixmap window signal-window pointer)
98                     xlib-context                     xlib-context
99                     (xsynchronize display 1)
100                   (let ((saved-pointer pointer))                   (let ((saved-pointer pointer))
101                     (setf pointer nil) ; invalidate first so it can't be used                     (setf pointer nil) ; invalidate first so it can't be used
102                     (cairo_destroy saved-pointer))  ;;                 (cairo_destroy saved-pointer)
103                       )
104                   (xfreepixmap display pixmap)                   (xfreepixmap display pixmap)
105                   (xdestroywindow display window)                   (xdestroywindow display window)
106                   (xdestroywindow display signal-window)                   (xdestroywindow display signal-window)
107                   (xclosedisplay display))))                   (xclosedisplay display))))
108          ;; initialize          ;; initialize
109          (xsynchronize display 1)          (xsynchronize display 1)
110          (let* ((screen (xdefaultscreen display))          (let* ((screen (xdefaultscreen display))
111                 (root (xdefaultrootwindow display))                 (root (xdefaultrootwindow display))
# Line 201  For internal use in the cl-cairo2 packag Line 178  For internal use in the cl-cairo2 packag
178    
179  (defun send-message-to-signal-window (xlib-context message)  (defun send-message-to-signal-window (xlib-context message)
180    "Send the desired message to the context window."    "Send the desired message to the context window."
181    (with-slots ((display-pointer display) signal-window) xlib-context    (with-slots (pointer (display-pointer display) signal-window) xlib-context
182        (unless pointer
183          (warn "context is not active, can't send message to window")
184          (return-from send-message-to-signal-window))
185      (with-foreign-object (xev :long 24)      (with-foreign-object (xev :long 24)
186        (with-foreign-slots        (with-foreign-slots
187            ((type display window message-type format data0)            ((type display window message-type format data0)
# Line 213  For internal use in the cl-cairo2 packag Line 193  For internal use in the cl-cairo2 packag
193          (setf format 32)          (setf format 32)
194          (setf data0 message)          (setf data0 message)
195          (xsendevent display-pointer signal-window 0 0 xev))          (xsendevent display-pointer signal-window 0 0 xev))
196        (xflush display-pointer))))        (xsync display-pointer 1))))
   
197    
198  (defmethod destroy ((object xlib-context))  (defmethod destroy ((object xlib-context))
199    (send-message-to-signal-window object +destroy-message+))    (send-message-to-signal-window object +destroy-message+))

Legend:
Removed from v.13  
changed lines
  Added in v.15

  ViewVC Help
Powered by ViewVC 1.1.5