302 lines
9.9 KiB
Scheme
302 lines
9.9 KiB
Scheme
;; 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)
|
|
#f
|
|
(let ((dpy-name (car args)))
|
|
(cond
|
|
((symbol? dpy-name) (symbol->string dpy-name))
|
|
(else dpy-name))))))
|
|
(let ((Xdisplay (%open-display display-name)))
|
|
(if (= Xdisplay 0)
|
|
(error "cannot open display" display-name)
|
|
(make-display Xdisplay #t)))))
|
|
|
|
(import-lambda-definition %open-display (name)
|
|
"scx_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)
|
|
(let* ((Xdisplay (display-Xdisplay display))
|
|
(Xwindow (%default-root-window Xdisplay)))
|
|
(make-window Xwindow (make-display Xdisplay #f) #f)))
|
|
|
|
;; for compatibility with Elk.
|
|
(define display-root-window display-default-root-window)
|
|
|
|
(import-lambda-definition %default-root-window (Xdisplay)
|
|
"scx_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 #f)))
|
|
|
|
;; for compatibility with Elk.
|
|
(define display-colormap display-default-colormap)
|
|
|
|
(import-lambda-definition %default-colormap (Xdisplay)
|
|
"scx_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 #f)))
|
|
|
|
(import-lambda-definition %default-gcontext (Xdisplay)
|
|
"scx_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)
|
|
(let ((Xdisplay (display-Xdisplay display)))
|
|
(%default-depth Xdisplay)))
|
|
|
|
(import-lambda-definition %default-depth (Xdisplay)
|
|
"scx_Display_Default_Depth")
|
|
|
|
;; display-default-screen-number returns the default screen number of the given
|
|
;; display. See DefaultScreen.
|
|
|
|
(define (display-default-screen-number display)
|
|
(let ((Xdisplay (display-Xdisplay display)))
|
|
(%default-screen-number Xdisplay)))
|
|
|
|
(import-lambda-definition %default-screen-number (Xdisplay)
|
|
"scx_Display_Default_Screen_Number")
|
|
|
|
;; display-default-visual returns the default visual of the given
|
|
;; display. If no screen-number is specified the default screen is
|
|
;; used. See DisplayVisual.
|
|
|
|
(define (display-default-visual display . screen-number)
|
|
(make-visual
|
|
(%default-visual (display-Xdisplay display)
|
|
(if (null? screen-number)
|
|
(display-default-screen-number display)
|
|
(begin
|
|
(check-screen-number display (car screen-number))
|
|
(car screen-number))))))
|
|
|
|
(import-lambda-definition %default-visual (Xdisplay scr-num)
|
|
"scx_Display_Default_Visual")
|
|
|
|
;; internal function
|
|
(define (check-screen-number display screen-number)
|
|
(if (or (< screen-number 0)
|
|
(>= screen-number (display-screen-count display)))
|
|
(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)
|
|
(%display-cells (display-Xdisplay display) screen-number))
|
|
|
|
(import-lambda-definition %display-cells (Xdisplay screen-number)
|
|
"scx_Display_Cells")
|
|
|
|
;; display-planes returns the depth of the root window of the specified screen.
|
|
;; See DisplayPlanes.
|
|
|
|
(define (display-planes display screen-number)
|
|
(check-screen-number display screen-number)
|
|
(%display-planes (display-Xdisplay display) screen-number))
|
|
|
|
(import-lambda-definition %display-planes (Xdisplay screen-number)
|
|
"scx_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)
|
|
(%display-string (display-Xdisplay display)))
|
|
|
|
(import-lambda-definition %display-string (Xdisplay)
|
|
"scx_Display_String")
|
|
|
|
;; Display-Vendor returns a pair, whose car is the vendor identification and
|
|
;; whose cdr is the release number. See DisplayVendor.
|
|
|
|
(define (display-vendor display)
|
|
(%display-vendor (display-Xdisplay display)))
|
|
|
|
(import-lambda-definition %display-vendor (Xdisplay)
|
|
"scx_Display_Vendor")
|
|
|
|
;; Display-protocol-version return a pair of major and minor version numbers of
|
|
;; the X protocol.
|
|
|
|
(define (display-protocol-version display)
|
|
(%display-protocol-version (display-Xdisplay display)))
|
|
|
|
(import-lambda-definition %display-protocol-version (Xdisplay)
|
|
"scx_Display_Protocol_Version")
|
|
|
|
;; display-screen-count returns the number of available screen on this display.
|
|
;; See ScreenCount.
|
|
|
|
(define (display-screen-count display)
|
|
(%display-screen-count (display-Xdisplay display)))
|
|
|
|
(import-lambda-definition %display-screen-count (Xdisplay)
|
|
"scx_Display_Screen_Count")
|
|
|
|
;; display-image-byte-order returns one of the symbols 'lsb-first and
|
|
;; 'msb-first.
|
|
|
|
(define (display-image-byte-order display)
|
|
(%display-image-byte-order (display-Xdisplay display)))
|
|
|
|
(import-lambda-definition %display-image-byte-order (Xdisplay)
|
|
"scx_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)
|
|
(%display-bitmap-unit (display-Xdisplay display)))
|
|
|
|
(import-lambda-definition %display-bitmap-unit (Xdisplay)
|
|
"scx_Display_Bitmap_Unit")
|
|
|
|
;; display-bitmap-bit-order return one the symbols 'lbs-first and 'msb-first.
|
|
;; See BitmapBitOrder.
|
|
|
|
(define (display-bitmap-bit-order display)
|
|
(%display-bitmap-bit-order (display-Xdisplay display)))
|
|
|
|
(import-lambda-definition %display-bitmap-bit-order (Xdisplay)
|
|
"scx_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)))
|
|
|
|
(import-lambda-definition %display-bitmap-pad (Xdisplay)
|
|
"scx_Display_Bitmap_Pad")
|
|
|
|
;; display-width (-height) returns the width (height) of the screen in pixels.
|
|
;; See DisplayWidth (DisplayHeight).
|
|
|
|
(define (display-width display)
|
|
(%display-width (display-Xdisplay display)))
|
|
|
|
(import-lambda-definition %display-width (Xdisplay)
|
|
"scx_Display_Width")
|
|
|
|
(define (display-height display)
|
|
(%display-height (display-Xdisplay display)))
|
|
|
|
(import-lambda-definition %display-height (Xdisplay)
|
|
"scx_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)))
|
|
|
|
(import-lambda-definition %display-width-mm (Xdisplay)
|
|
"scx_Display_Width_Mm")
|
|
|
|
(define (display-height-mm display)
|
|
(%display-height-mm (display-Xdisplay display)))
|
|
|
|
(import-lambda-definition %display-height-mm (Xdisplay)
|
|
"scx_Display_Height_Mm")
|
|
|
|
;; See XDisplayMotionBufferSize.
|
|
|
|
(define (display-motion-buffer-size display)
|
|
(%display-motion-buffer-size (display-Xdisplay display)))
|
|
|
|
(import-lambda-definition %display-motion-buffer-size (Xdisplay)
|
|
"scx_Display_Motion_Buffer_Size")
|
|
|
|
;; The display-flush-output flushes the output buffer. See XFlush.
|
|
|
|
(define (display-flush-output display)
|
|
(%display-flush-output (display-Xdisplay display)))
|
|
|
|
(import-lambda-definition %display-flush-output (Xdisplay)
|
|
"scx_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?)
|
|
(%display-wait-output (display-Xdisplay display)
|
|
discard-events?))
|
|
|
|
(import-lambda-definition %display-wait-output (Xdisplay discard)
|
|
"scx_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)
|
|
(%no-op (display-Xdisplay display)))
|
|
|
|
(import-lambda-definition %no-op (Xdisplay)
|
|
"scx_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)
|
|
(%display-list-depths (display-Xdisplay display)
|
|
(check-screen-number display screen-number)))
|
|
|
|
(import-lambda-definition %display-list-depths (Xdisplay scr)
|
|
"scx_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)
|
|
(%display-list-pixmap-formats (display-Xdisplay display)))
|
|
|
|
(define list-pixmap-formats display-list-pixmap-formats) ;; compat./Elk
|
|
|
|
(import-lambda-definition %display-list-pixmap-formats (Xdisplay)
|
|
"scx_List_Pixmap_Formats")
|
|
|
|
;; synchronize just sets the after-function of the display to
|
|
;; display-wait-output (with #f for discard-events?).
|
|
|
|
(define (synchronize display)
|
|
(display-set-after-function!
|
|
display
|
|
(lambda (display)
|
|
(display-wait-output display #f))))
|
|
|