Update of /cvsroot/scsh/scx/scheme/xlib
In directory usw-pr-cvs1:/tmp/cvs-serv20133
Modified Files:
display.scm
Log Message:
added support for colormap and gcontext. added comments.
Index: display.scm
===================================================================
RCS file: /cvsroot/scsh/scx/scheme/xlib/display.scm,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -r1.3 -r1.4
*** display.scm 2001/06/25 11:43:11 1.3
--- display.scm 2001/07/16 13:12:11 1.4
***************
*** 1,4 ****
--- 1,9 ----
;; Author: David Frese
+ ;; open-display opens the connection to the X Server. It has one optional
+ ;; argument: a string or a symbol specifying the name of the display. If it is
+ ;; not specified, it defaults to the value of the DISPLAY environment
variable.
+ ;; See XOpenDisplay.
+
(define (open-display . args)
(let ((display-name (if (null? args)
***************
*** 15,23 ****
(import-lambda-definition %open-display (name) "Open_Display")
! ;; for compatibility with elk:
(define set-after-function! display-set-after-function!)
(define after-function display-after-function)
! ;; ...
(define (display-default-root-window display)
--- 20,29 ----
(import-lambda-definition %open-display (name) "Open_Display")
! ;; for compatibility with elk: is that correct?? see error.c
(define set-after-function! display-set-after-function!)
(define after-function display-after-function)
! ;; display-default-root-window returns the root window of the default screen.
! ;; See DefaultRootWindow.
(define (display-default-root-window display)
***************
*** 26,29 ****
--- 32,36 ----
(make-window Xwindow (make-display Xdisplay))))
+ ;; for compatibility with Elk.
(define display-root-window display-default-root-window)
***************
*** 31,42 ****
"Display_Default_Root_Window")
! ;; ...
(define (display-default-colormap display)
(let* ((Xdisplay (display-Xdisplay display))
(Xcolormap (%default-colormap Xdisplay)))
! ;** (make-colormap 0 Xdisplay Xcolormap)))
! #f))
(define display-colormap display-default-colormap)
--- 38,50 ----
"Display_Default_Root_Window")
! ;; display-default-colormap return the default colormap for allocation on the
! ;; default screen of the specified display. See DefaultColormap.
(define (display-default-colormap display)
(let* ((Xdisplay (display-Xdisplay display))
(Xcolormap (%default-colormap Xdisplay)))
! (make-colormap Xcolormap display)))
+ ;; for compatibility with Elk.
(define display-colormap display-default-colormap)
***************
*** 44,58 ****
"Display_Default_Colormap")
! ;; ...
(define (display-default-gcontext display)
(let* ((Xdisplay (display-Xdisplay display))
(Xgcontext (%default-gcontext Xdisplay)))
! ;** (make-gcontext 0 Xdisplay Xgcontext)))
! #f))
(import-lambda-definition %default-gcontext (Xdisplay)
"Display_Default_Gcontext")
! ;; ...
(define (display-default-depth display)
--- 52,68 ----
"Display_Default_Colormap")
! ;; display-default-gcontext return the default graphics context for the root
! ;; window of the default screen of the specified display. See DefaultGC.
(define (display-default-gcontext display)
(let* ((Xdisplay (display-Xdisplay display))
(Xgcontext (%default-gcontext Xdisplay)))
! (make-gcontext Xgcontext display)))
!
(import-lambda-definition %default-gcontext (Xdisplay)
"Display_Default_Gcontext")
! ;; display-default-depth returns the depth (number of planes) of the default
! ;; root window of the default screen of the specified display. See
DefaultDepth.
(define (display-default-depth display)
***************
*** 63,67 ****
"Display_Default_Depth")
! ;; ...
(define (display-default-screen-number display)
--- 73,78 ----
"Display_Default_Depth")
! ;; display-default-screen-number returns the default screen number of the
given
! ;; display. See DefaultScreen.
(define (display-default-screen-number display)
***************
*** 72,77 ****
"Display_Default_Screen_Number")
! ;; ...
!
(define (check-screen-number display screen-number)
(if (or (< screen-number 0)
--- 83,87 ----
"Display_Default_Screen_Number")
! ;; internal function
(define (check-screen-number display screen-number)
(if (or (< screen-number 0)
***************
*** 79,82 ****
--- 89,95 ----
(error "invalid screen number" screen-number)))
+ ;; display-cells returns the number of entries in the default colormap of the
+ ;; specified screen. See DisplayCells.
+
(define (display-cells display screen-number)
(check-screen-number display screen-number)
***************
*** 86,90 ****
"Display_Cells")
! ;; ...
(define (display-planes display screen-number)
--- 99,104 ----
"Display_Cells")
! ;; display-planes returns the depth of the root window of the specified
screen.
! ;; See DisplayPlanes.
(define (display-planes display screen-number)
***************
*** 95,99 ****
"Display_Planes")
! ;; ...
(define (display-string display)
--- 109,114 ----
"Display_Planes")
! ;; display-string returns the name of the display as a string - the same that
! ;; was specified with open-display. See DisplayString.
(define (display-string display)
***************
*** 104,108 ****
;; Display-Vendor returns a pair, whose car is the vendor identification and
! ;; whose cdr is the release number
(define (display-vendor display)
--- 119,123 ----
;; Display-Vendor returns a pair, whose car is the vendor identification and
! ;; whose cdr is the release number. See DisplayVendor.
(define (display-vendor display)
***************
*** 121,125 ****
"Display_Protocol_Version")
! ;; ...
(define (display-screen-count display)
--- 136,141 ----
"Display_Protocol_Version")
! ;; display-screen-count returns the number of available screen on this
display.
! ;; See ScreenCount.
(define (display-screen-count display)
***************
*** 138,142 ****
"Display_Image_Byte_Order")
! ;; ...
(define (display-bitmap-unit display)
--- 154,159 ----
"Display_Image_Byte_Order")
! ;; display-bitmap-unit returns the size of a bitmap's scanline unit in bits.
! ;; See BitmapUnit.
(define (display-bitmap-unit display)
***************
*** 146,150 ****
"Display_Bitmap_Unit")
! ;; ...
(define (display-bitmap-bit-order display)
--- 163,168 ----
"Display_Bitmap_Unit")
! ;; display-bitmap-bit-order return one the symbols 'lbs-first and 'msb-first.
! ;; See BitmapBitOrder.
(define (display-bitmap-bit-order display)
***************
*** 154,160 ****
"Display_Bitmap_Bit_Order")
! ;; ...
-
(define (display-bitmap-pad display)
(%display-bitmap-pad (display-Xdisplay display)))
--- 172,178 ----
"Display_Bitmap_Bit_Order")
! ;; display-bitmap-pad returns the number of bits that each scanline must be
! ;; padded. See BitmapPad.
(define (display-bitmap-pad display)
(%display-bitmap-pad (display-Xdisplay display)))
***************
*** 163,167 ****
"Display_Bitmap_Pad")
! ;; ...
(define (display-width display)
--- 181,186 ----
"Display_Bitmap_Pad")
! ;; display-width (-height) returns the width (height) of the screen in
pixels.
! ;; See DisplayWidth (DisplayHeight).
(define (display-width display)
***************
*** 171,176 ****
"Display_Width")
- ;; ...
-
(define (display-height display)
(%display-height (display-Xdisplay display)))
--- 190,193 ----
***************
*** 178,192 ****
(import-lambda-definition %display-height (Xdisplay)
"Display_Height")
-
- ;; ...
! (define (display-width-mm display)
! (%display-width-mm (display-Xdisplay display)))
- (import-lambda-definition %display-width-mm (Xdisplay)
- "Display_Width_Mm")
-
- ;; ...
-
(define (display-width-mm display)
(%display-width-mm (display-Xdisplay display)))
--- 195,202 ----
(import-lambda-definition %display-height (Xdisplay)
"Display_Height")
! ;; display-width-mm (-height-mm) returns the width (height) of the screen in
! ;; millimeters. See DisplayWidthMM (DisplayHeightMM).
(define (display-width-mm display)
(%display-width-mm (display-Xdisplay display)))
***************
*** 195,200 ****
"Display_Width_Mm")
- ;; ...
-
(define (display-height-mm display)
(%display-height-mm (display-Xdisplay display)))
--- 205,208 ----
***************
*** 203,207 ****
"Display_Height_Mm")
! ;; ...
(define (display-motion-buffer-size display)
--- 211,215 ----
"Display_Height_Mm")
! ;; See XDisplayMotionBufferSize.
(define (display-motion-buffer-size display)
***************
*** 211,215 ****
"Display_Motion_Buffer_Size")
! ;; ... the result is unspecific
(define (display-flush-output display)
--- 219,223 ----
"Display_Motion_Buffer_Size")
! ;; The display-flush-output flushes the output buffer. See XFlush.
(define (display-flush-output display)
***************
*** 219,223 ****
"Display_Flush_Output")
! ;; ... the result is unspecific
(define (display-wait-output display discard-events?)
--- 227,233 ----
"Display_Flush_Output")
! ;; display-wait-output flushes the output buffer and then waits until all
! ;; requests have been received and processed by the X server. discard-events?
! ;; specifies whether the events in the queue are discarded or nor. See XSync.
(define (display-wait-output display discard-events?)
***************
*** 228,232 ****
"Display_Wait_Output")
! ;; ... the result is unspecific
(define (display-no-op display)
--- 238,243 ----
"Display_Wait_Output")
! ;; display-no-op sends a NoOperation protocol request to the X server, thereby
! ;; exercising the connection. See XNoOp.
(define (display-no-op display)
***************
*** 236,242 ****
"No_Op")
(define no-op display-no-op)
! ;; ... returns a vector of integers
(define (display-list-depths display screen-number)
--- 247,255 ----
"No_Op")
+ ;; for compatibility with Elk.
(define no-op display-no-op)
! ;; display-list-depths returns a vector of depths (integers) that are
available
! ;; on the specified screen. See XListDepths.
(define (display-list-depths display screen-number)
***************
*** 247,254 ****
"List_Depths")
(define list-depths display-list-depths)
! ;; ... returns a vector of lists with 3 integers (depth, bits per pixel,
! ;; scanline pad)
(define (display-list-pixmap-formats display)
--- 260,268 ----
"List_Depths")
+ ;; for compatibility with Elk.
(define list-depths display-list-depths)
! ;; display-list-pixmap-formats returns a vector of lists with 3 integers:
depth,
! ;; bits per pixel and scanline pad (See above). See XListPixmapFormats.
(define (display-list-pixmap-formats display)
|