modified and fixed xlib-error handling/signaling
This commit is contained in:
frese
parent
5f0df79c0f
commit
0afc105e6c
|
|
@ -55,9 +55,8 @@ s48_value scx_general_after_function_binding = S48_FALSE;
|
|||
static int scx_after_function_wrapper(Display* dpy) {
|
||||
s48_value display = scx_enter_display(dpy);
|
||||
s48_value fun = S48_SHARED_BINDING_REF(scx_general_after_function_binding);
|
||||
s48_disable_interruptsB();
|
||||
|
||||
s48_call_scheme(fun, 1, display);
|
||||
s48_enable_interruptsB();
|
||||
return 0;
|
||||
}
|
||||
|
||||
|
|
@ -93,9 +92,11 @@ s48_value scx_enter_display(Display* dpy) {
|
|||
for (i = ScreenCount(dpy)-1; i >= 0; i--)
|
||||
l = s48_cons(scx_enter_screen(ScreenOfDisplay(dpy, i)), l);
|
||||
S48_RECORD_SET(d, 13, l);
|
||||
S48_RECORD_SET(d, 14, S48_FALSE);
|
||||
S48_RECORD_SET(d, 14, S48_FALSE); /* the after-function */
|
||||
XSetAfterFunction(dpy, &scx_after_function_wrapper);
|
||||
S48_RECORD_SET(d, 15, S48_FALSE);
|
||||
S48_RECORD_SET(d, 15, S48_FALSE); /* wakeup-port, set by initialize */
|
||||
S48_RECORD_SET(d, 16, S48_TRUE); /* use-warnings? */
|
||||
S48_RECORD_SET(d, 17, S48_FALSE); /* error-queue, set by initialize */
|
||||
s48_call_scheme(S48_SHARED_BINDING_REF(scx_initialize_display_binding),
|
||||
1, d);
|
||||
S48_GC_UNPROTECT();
|
||||
|
|
|
|||
|
|
@ -57,7 +57,7 @@ s48_value scx_window_changes_binding = S48_FALSE;
|
|||
s48_value s48_checked_record_ref(s48_value value, int i,
|
||||
s48_value rectype) {
|
||||
s48_check_record_type(value, rectype);
|
||||
return S48_RECORD_REF(value, i);
|
||||
return S48_UNSAFE_RECORD_REF(value, i);
|
||||
}
|
||||
|
||||
int s48_list_length(s48_value list) {
|
||||
|
|
|
|||
|
|
@ -5,7 +5,7 @@
|
|||
;; XIconifyWindow.
|
||||
|
||||
;; returns #f on error.
|
||||
(import-lambda-definition iconify-window (display window screen-num)
|
||||
(import-xlib-function iconify-window (display window screen-num)
|
||||
"scx_Iconify_Window")
|
||||
|
||||
;; withdraw-window unmaps the specified window and sends a synthetic
|
||||
|
|
@ -13,7 +13,7 @@
|
|||
;; XWithdrawWindow.
|
||||
|
||||
;; returns #f on error.
|
||||
(import-lambda-definition withdraw-window (display window scr-num)
|
||||
(import-xlib-function withdraw-window (display window scr-num)
|
||||
"scx_Withdraw_Window")
|
||||
|
||||
;; reconfigure-wm-window changes attributes of the specified window
|
||||
|
|
@ -22,7 +22,7 @@
|
|||
;; configure-window.
|
||||
|
||||
;; returns #f on error.
|
||||
(import-lambda-definition reconfigure-wm-window
|
||||
(import-xlib-function reconfigure-wm-window
|
||||
(display window scr-num changes)
|
||||
"scx_Reconfigure_Wm_Window")
|
||||
|
||||
|
|
@ -32,14 +32,14 @@
|
|||
;; window and returns it as a list of strings. See XGetCommand.
|
||||
|
||||
;; returns #f on error.
|
||||
(import-lambda-definition get-wm-command (display window)
|
||||
(import-xlib-function get-wm-command (display window)
|
||||
"scx_Get_Wm_Command")
|
||||
|
||||
;; set-wm-command! sets the WM_COMMAND property (the command and
|
||||
;; arguments used to invoke the application). The command has to be
|
||||
;; specified as a list of strings. See XSetCommand.
|
||||
|
||||
(import-lambda-definition set-wm-command! (display window command)
|
||||
(import-xlib-function set-wm-command! (display window command)
|
||||
"scx_Set_Wm_Command")
|
||||
|
||||
;; get-wm-protocols function returns the list of atoms stored in the
|
||||
|
|
@ -49,28 +49,28 @@
|
|||
;; willing to participate. See XGetWMProtocols.
|
||||
|
||||
;; returns #f on error.
|
||||
(import-lambda-definition get-wm-protocols (display window)
|
||||
(import-xlib-function get-wm-protocols (display window)
|
||||
"scx_Get_Wm_Protocols")
|
||||
|
||||
;; set-wm-protocols! sets the WM_PROTOCOLS property of the specified
|
||||
;; window. protocols has to be a list of atoms. See XSetWMProtocols.
|
||||
|
||||
;; returns #f on error.
|
||||
(import-lambda-definition set-wm-protocols! (display window protocols)
|
||||
(import-xlib-function set-wm-protocols! (display window protocols)
|
||||
"scx_Set_Wm_Protocols")
|
||||
|
||||
;; get-wm-class returns the class hint for the specified window. That
|
||||
;; is a pair of strings (name . class) See XGetClassHint.
|
||||
|
||||
;; returns #f on error.
|
||||
(import-lambda-definition get-wm-class (display window)
|
||||
(import-xlib-function get-wm-class (display window)
|
||||
"scx_Get_Wm_Class")
|
||||
|
||||
;; set-wm-class! sets the class hint for the specified window. See
|
||||
;; XSetClassHint.
|
||||
|
||||
;; returns #f on error.
|
||||
(import-lambda-definition set-wm-class! (display window name class)
|
||||
(import-xlib-function set-wm-class! (display window name class)
|
||||
"scx_Set_Wm_Class")
|
||||
|
||||
;; *** set or read a window's WM_HINTS property **********************
|
||||
|
|
@ -103,41 +103,41 @@
|
|||
;; alist mapping wm-hint types to specific values. See wm-hint. See
|
||||
;; XGetWMHints for a description.
|
||||
|
||||
(import-lambda-definition get-wm-hints (display window)
|
||||
(import-xlib-function get-wm-hints (display window)
|
||||
"scx_Get_Wm_Hints")
|
||||
|
||||
;; set-wm-hints! sets the specified window manager hints. The hints
|
||||
;; must be specified as an alist of wm-hint values (see above) mapping
|
||||
;; to the appropiate values. See XSetWMHints.
|
||||
|
||||
(import-lambda-definition set-wm-hints! (display window wm-hint-alist)
|
||||
(import-xlib-function set-wm-hints! (display window wm-hint-alist)
|
||||
"scx_Set_Wm_Hints")
|
||||
|
||||
;; get-transient-for returns the WM_TRANSIENT_FOR property for the
|
||||
;; specified window. The value of that property is a window. See
|
||||
;; XGetTransientForHint.
|
||||
|
||||
(import-lambda-definition get-transient-for (display window)
|
||||
(import-xlib-function get-transient-for (display window)
|
||||
"scx_Get_Transient_For")
|
||||
|
||||
;; set-transient-for! sets the WM_TRANSIENT_FOR property of the
|
||||
;; specified window to the specified property-window. See
|
||||
;; XSetTransientForHint.
|
||||
|
||||
(import-lambda-definition set-transient-for! (display window prop_window)
|
||||
(import-xlib-function set-transient-for! (display window prop_window)
|
||||
"scx_Set_Transient_For")
|
||||
|
||||
;; get-text-property returns the property specified by atom of the
|
||||
;; specified window as a property record. See get-window-property. See
|
||||
;; XGetTextProperty.
|
||||
|
||||
(import-lambda-definition get-text-property (display window atom)
|
||||
(import-xlib-function get-text-property (display window atom)
|
||||
"scx_Get_Text_Property")
|
||||
|
||||
;; set-text-property! sets the property specified by atom of the
|
||||
;; specified window to value - a property record.
|
||||
|
||||
(import-lambda-definition set-text-property! (display window value atom)
|
||||
(import-xlib-function set-text-property! (display window value atom)
|
||||
"scx_Set_Text_Property")
|
||||
|
||||
(define (property->string-list property)
|
||||
|
|
@ -208,10 +208,10 @@
|
|||
;; min-aspect-y max-aspect-x max-aspect-y base-width base-height
|
||||
;; gravity). See XGetWMNormalHints, XSetWMNormalHints.
|
||||
|
||||
(import-lambda-definition get-wm-normal-hints (display window)
|
||||
(import-xlib-function get-wm-normal-hints (display window)
|
||||
"scx_Get_Wm_Normal_Hints")
|
||||
|
||||
(import-lambda-definition set-wm-normal-hints! (display window alist)
|
||||
(import-xlib-function set-wm-normal-hints! (display window alist)
|
||||
"scx_Set_Wm_Normal_Hints")
|
||||
|
||||
;; get-icon-sizes returns the icon sizes specified by a window manager
|
||||
|
|
@ -230,11 +230,11 @@
|
|||
|
||||
(define-exported-binding "scx-icon-size" :icon-size)
|
||||
|
||||
(import-lambda-definition get-icon-sizes (display window)
|
||||
(import-xlib-function get-icon-sizes (display window)
|
||||
"scx_Get_Icon_Sizes")
|
||||
|
||||
;; set-icon-sizes! is used only by window managers to set the
|
||||
;; supported icon sizes. See icon-sizes, XSetIconSizes.
|
||||
|
||||
(import-lambda-definition set-icon-sizes! (display window sizes)
|
||||
(import-xlib-function set-icon-sizes! (display window sizes)
|
||||
"scx_Set_Icon_Sizes")
|
||||
|
|
|
|||
|
|
@ -25,18 +25,18 @@
|
|||
|
||||
(define-exported-binding "scx-colormap-alloc" :colormap-alloc)
|
||||
|
||||
(import-lambda-definition create-colormap (display window visual alloc)
|
||||
(import-xlib-function create-colormap (display window visual alloc)
|
||||
"scx_Create_Colormap")
|
||||
|
||||
(import-lambda-definition copy-colormap-and-free (display colormap)
|
||||
(import-xlib-function copy-colormap-and-free (display colormap)
|
||||
"scx_Copy_Colormap_And_Free")
|
||||
|
||||
(import-lambda-definition free-colormap (display colormap)
|
||||
(import-xlib-function free-colormap (display colormap)
|
||||
"scx_Free_Colormap")
|
||||
|
||||
;; *** allocate and free colors **************************************
|
||||
|
||||
(import-lambda-definition alloc-color! (display colormap color)
|
||||
(import-xlib-function alloc-color! (display colormap color)
|
||||
"scx_Alloc_Color")
|
||||
|
||||
;; red, green and blue can be a number between 0 (inclusive) and 1
|
||||
|
|
@ -46,7 +46,7 @@
|
|||
(and (alloc-color! display colormap color)
|
||||
(color:pixel color))))
|
||||
|
||||
(import-lambda-definition %alloc-named-color (display colormap color-name)
|
||||
(import-xlib-function %alloc-named-color (display colormap color-name)
|
||||
"scx_Alloc_Named_Color")
|
||||
|
||||
;; returns a pair (screen-color exact-color) or #f
|
||||
|
|
@ -58,7 +58,7 @@
|
|||
(and res (car res))))
|
||||
|
||||
;; returns a pair of two lists (plane-masks . pixels) or #f
|
||||
(import-lambda-definition alloc-color-cells/planes
|
||||
(import-xlib-function alloc-color-cells/planes
|
||||
(display colormap contig? nplanes npixels)
|
||||
"scx_Alloc_Color_Cells")
|
||||
|
||||
|
|
@ -67,16 +67,16 @@
|
|||
(and r (cdr r))))
|
||||
|
||||
;; returns a list of lists (pixels redmask greenmask bluemask) or #f
|
||||
(import-lambda-definition alloc-color-planes
|
||||
(import-xlib-function alloc-color-planes
|
||||
(display colormap contig? ncolors nreds ngreens nblues)
|
||||
"scx_Alloc_Color_Planes")
|
||||
|
||||
(import-lambda-definition free-colors (display colormap pixels planes)
|
||||
(import-xlib-function free-colors (display colormap pixels planes)
|
||||
"scx_Free_Colors")
|
||||
|
||||
;; *** obtain color values *******************************************
|
||||
|
||||
(import-lambda-definition query-colors! (display colormap colors)
|
||||
(import-xlib-function query-colors! (display colormap colors)
|
||||
"scx_Query_Colors")
|
||||
|
||||
(define (query-colors display colormap pixels)
|
||||
|
|
@ -90,21 +90,21 @@
|
|||
(define (query-color display colormap pixel)
|
||||
(car (query-colors display colormap (list pixel))))
|
||||
|
||||
(import-lambda-definition lookup-color (display colormap color-name)
|
||||
(import-xlib-function lookup-color (display colormap color-name)
|
||||
"scx_Lookup_Color")
|
||||
|
||||
(import-lambda-definition parse-color (display colormap spec)
|
||||
(import-xlib-function parse-color (display colormap spec)
|
||||
"scx_Parse_Color")
|
||||
|
||||
;; *** set colors ****************************************************
|
||||
|
||||
(import-lambda-definition store-colors (display colormap colors)
|
||||
(import-xlib-function store-colors (display colormap colors)
|
||||
"scx_Store_Colors")
|
||||
|
||||
(define (store-color display colormap color)
|
||||
(store-colors display colormap (list color)))
|
||||
|
||||
(import-lambda-definition %store-named-color
|
||||
(import-xlib-function %store-named-color
|
||||
(display colormap color-name pixel do-red do-green do-blue)
|
||||
"scx_Store_Named_Color")
|
||||
|
||||
|
|
|
|||
|
|
@ -2,17 +2,17 @@
|
|||
|
||||
;; *** create cursors ************************************************
|
||||
|
||||
(import-lambda-definition create-pixmap-cursor
|
||||
(import-xlib-function create-pixmap-cursor
|
||||
(display source mask foreground-color background-color x y)
|
||||
"scx_Create_Pixmap_Cursor")
|
||||
|
||||
;; source-char and mask-char have to be integers.
|
||||
(import-lambda-definition create-glyph-cursor
|
||||
(import-xlib-function create-glyph-cursor
|
||||
(display source-font mask-font source-char mask-char foreground-color
|
||||
background-color)
|
||||
"scx_Create_Glyph_Cursor")
|
||||
|
||||
(import-lambda-definition create-font-cursor (display shape)
|
||||
(import-xlib-function create-font-cursor (display shape)
|
||||
"scx_Create_Font_Cursor")
|
||||
|
||||
(define xc-X-cursor 0)
|
||||
|
|
@ -95,19 +95,19 @@
|
|||
|
||||
;; *** define cursors ************************************************
|
||||
|
||||
(import-lambda-definition define-cursor (display window cursor)
|
||||
(import-xlib-function define-cursor (display window cursor)
|
||||
"scx_Define_Cursor")
|
||||
|
||||
(import-lambda-definition undefine-cursor (display window)
|
||||
(import-xlib-function undefine-cursor (display window)
|
||||
"scx_Undefine_Cursor")
|
||||
|
||||
;; *** manipulate cursors ********************************************
|
||||
|
||||
(import-lambda-definition recolor-cursor
|
||||
(import-xlib-function recolor-cursor
|
||||
(display cursor foreground-color background-color)
|
||||
"scx_Recolor_Cursor")
|
||||
|
||||
(import-lambda-definition free-cursor (display cursor)
|
||||
(import-xlib-function free-cursor (display cursor)
|
||||
"scx_Free_Cursor")
|
||||
|
||||
;; query-best-cursor defined in gcontext.scm
|
||||
|
|
|
|||
|
|
@ -1,11 +1,60 @@
|
|||
;; Copyright (c) 2001-2003 by Norbert Freudemann, David Frese
|
||||
|
||||
(define-syntax import-xlib-function
|
||||
(lambda (exp rename compare)
|
||||
(let ((id (cadr exp))
|
||||
(formals (caddr exp))
|
||||
(external-id (cadddr exp))
|
||||
(%define (rename 'define))
|
||||
(%begin (rename 'begin))
|
||||
(%lambda (rename 'lambda))
|
||||
(%binding (rename 'binding))
|
||||
(%import (rename 'import-lambda-definition))
|
||||
(%call-xlib-function (rename 'call-xlib-function)))
|
||||
`(,%begin
|
||||
(,%import ,%binding ,formals ,external-id)
|
||||
(,%define ,id
|
||||
(,%lambda ,formals
|
||||
(,%call-xlib-function ,(car formals) ,id
|
||||
(,%lambda ()
|
||||
(,%binding . ,formals)))))))))
|
||||
|
||||
(define (call-xlib-function display name thunk)
|
||||
(if (display? display)
|
||||
(if (display:warnings? display)
|
||||
(call-critical
|
||||
(lambda ()
|
||||
(let* ((queue (display:error-queue display))
|
||||
(result (thunk)))
|
||||
(if (not (eq? queue (display:error-queue display)))
|
||||
(let* ((next (next-x-error-queue queue))
|
||||
(error (x-error-queue:this next)))
|
||||
(signal-x-warning error))
|
||||
result))))
|
||||
(thunk))
|
||||
(error "first argument of an xlib-function must be a display object"
|
||||
name display)))
|
||||
|
||||
(define (call-critical thunk)
|
||||
(let ((old-enabled (set-enabled-interrupts! no-interrupts))
|
||||
(result (call-with-current-continuation
|
||||
(lambda (return)
|
||||
(cons #t
|
||||
(with-handler (lambda (condition punt)
|
||||
(return (cons #f condition)))
|
||||
thunk))))))
|
||||
(set-enabled-interrupts! old-enabled)
|
||||
(if (car result)
|
||||
(cdr result)
|
||||
(signal-condition (cdr result)))))
|
||||
|
||||
;; TODO: pixmap-formats (XListPixmapFormats)
|
||||
(define-record-type display :display
|
||||
(make-display cpointer connection-number protocol-version protocol-revision
|
||||
server-vendor image-byte-order bitmap-unit bitmap-pad
|
||||
bitmap-bit-order vendor-release queue-length name
|
||||
default-screen screens after-function wakeup)
|
||||
default-screen screens after-function wakeup
|
||||
warnings? error-queue)
|
||||
display?
|
||||
(cpointer display:cpointer)
|
||||
(connection-number display:connection-number)
|
||||
|
|
@ -22,7 +71,9 @@
|
|||
(default-screen display:default-screen)
|
||||
(screens display:screens)
|
||||
(after-function display:after-function set-display:after-function!)
|
||||
(wakeup display:wakeup set-display:wakeup!))
|
||||
(wakeup display:wakeup set-display:wakeup!)
|
||||
(warnings? display:warnings? set-display:warnings?!)
|
||||
(error-queue display:error-queue set-display:error-queue!))
|
||||
|
||||
(define-exported-binding "scx-display" :display)
|
||||
|
||||
|
|
@ -33,6 +84,7 @@
|
|||
(car (display:wakeup dpy)))
|
||||
|
||||
(define (initialize-display dpy)
|
||||
(set-display:error-queue! dpy (empty-x-error-queue))
|
||||
(call-with-values pipe
|
||||
(lambda (r w)
|
||||
(set-display:wakeup! dpy (cons r w)))))
|
||||
|
|
@ -112,7 +164,7 @@
|
|||
(error "invalid arguments" (cdr args))))));; TODO
|
||||
(%open-display display-name)))
|
||||
|
||||
(import-lambda-definition close-display (display)
|
||||
(import-xlib-function close-display (display)
|
||||
"scx_Close_Display")
|
||||
|
||||
(define none 0)
|
||||
|
|
@ -176,19 +228,19 @@
|
|||
|
||||
;; *** handle output buffer or event queue ***************************
|
||||
|
||||
(import-lambda-definition display-flush (display)
|
||||
(import-xlib-function display-flush (display)
|
||||
"scx_Display_Flush")
|
||||
|
||||
(import-lambda-definition display-sync (display discard?)
|
||||
(import-xlib-function display-sync (display discard?)
|
||||
"scx_Display_Sync")
|
||||
|
||||
;; display-no-op sends a NoOperation protocol request to the X server, thereby
|
||||
;; exercising the connection. See XNoOp.
|
||||
|
||||
(import-lambda-definition display-no-op (display)
|
||||
(import-xlib-function display-no-op (display)
|
||||
"scx_No_Op")
|
||||
|
||||
;; *** select input events *******************************************
|
||||
|
||||
(import-lambda-definition display-select-input (display window event-mask)
|
||||
(import-xlib-function display-select-input (display window event-mask)
|
||||
"scx_Display_Select_Input")
|
||||
|
|
|
|||
|
|
@ -161,32 +161,24 @@
|
|||
(define (x-warning:x-error w)
|
||||
(cadr (condition-stuff w)))
|
||||
(define (signal-x-warning x-error)
|
||||
(signal 'x-warning (x-error->string x-error) x-error))
|
||||
(signal 'x-warning (x-error:text x-error)
|
||||
(opcode->string (x-error:major-opcode x-error))
|
||||
(x-error:resource-id x-error)
|
||||
x-error))
|
||||
|
||||
;; Call synchronize to have the warnings signaled where they belong to.
|
||||
|
||||
(define (use-x-error-warnings!)
|
||||
(set-error-handler! (lambda (display error)
|
||||
(signal-x-warning error))))
|
||||
(define (use-x-error-warnings! display on?)
|
||||
(let ((was (display:warnings? display))) ;; lock??
|
||||
(set-display:warnings?! display on?)
|
||||
was))
|
||||
|
||||
;; *** error-queue ***************************************************
|
||||
|
||||
;; Interface:
|
||||
;; (use-x-error-queue!) returns a thunk that returns the most recent queue
|
||||
;; element.
|
||||
;; (empty-x-error-queue? q) return #t only for the initial queue.
|
||||
;; (next-x-error-queue q) returns the next queue element, blocks if necessary.
|
||||
;; (x-error-queue:this q) returns the x-error of that queue.
|
||||
|
||||
(define (use-x-error-queue!) ;; exp
|
||||
(let* ((most-recent-x-error-queue empty-x-error-queue)
|
||||
(handler (lambda (display error)
|
||||
(set-next-x-error-queue! most-recent-x-error-queue
|
||||
(make-x-error-queue error))
|
||||
(set! most-recent-x-error-queue
|
||||
(next-x-error-queue most-recent-x-error-queue)))))
|
||||
(set-error-handler! handler)
|
||||
(lambda () most-recent-x-error-queue)))
|
||||
|
||||
(define-record-type x-error-queue :x-error-queue
|
||||
(really-make-x-error-queue this next)
|
||||
|
|
@ -197,7 +189,9 @@
|
|||
(define (make-x-error-queue error)
|
||||
(really-make-x-error-queue error (make-placeholder)))
|
||||
|
||||
(define empty-x-error-queue (make-x-error-queue #f))
|
||||
(define (empty-x-error-queue)
|
||||
(make-x-error-queue #f))
|
||||
|
||||
(define (empty-x-error-queue? obj)
|
||||
(eq? obj empty-x-error-queue))
|
||||
|
||||
|
|
@ -210,30 +204,13 @@
|
|||
|
||||
;; *** default error handlers ****************************************
|
||||
|
||||
(define *x-error-handler* #f)
|
||||
(define (internal-x-error-handler display error)
|
||||
(if *x-error-handler*
|
||||
(*x-error-handler* display error)
|
||||
#f))
|
||||
(let ((queue (make-x-error-queue error)))
|
||||
(set-next-x-error-queue! (display:error-queue display) queue)
|
||||
(set-display:error-queue! display queue)))
|
||||
|
||||
(define-exported-binding "internal-x-error-handler" internal-x-error-handler)
|
||||
|
||||
(define (set-error-handler! handler)
|
||||
(let ((old-handler *x-error-handler*))
|
||||
(set! *x-error-handler* handler)
|
||||
old-handler))
|
||||
|
||||
;(import-lambda-definition %set-error-handler (handler)
|
||||
; "scx_Set_Error_Handler")
|
||||
|
||||
;(import-lambda-definition call-c-error-handler (pointer display event)
|
||||
; "scx_Call_C_Error_Handler")
|
||||
|
||||
;(define (set-error-handler! handler)
|
||||
; (let ((res (%set-error-handler handler)))
|
||||
; (if (number? res)
|
||||
; (lambda (display event) (call-c-error-handler (res display event)))
|
||||
; res)))
|
||||
|
||||
(import-lambda-definition get-error-text (display code)
|
||||
"scx_Get_Error_Text")
|
||||
|
||||
|
|
@ -256,7 +233,3 @@
|
|||
(let ((old-handler *x-fatal-error-handler*))
|
||||
(set! *x-fatal-error-handler* handler)
|
||||
old-handler))
|
||||
|
||||
;; *** The default is to use warnings ********************************
|
||||
|
||||
(use-x-error-warnings!)
|
||||
|
|
|
|||
|
|
@ -39,7 +39,7 @@
|
|||
|
||||
(define-exported-binding "scx-queued-mode" :queued-mode)
|
||||
|
||||
(import-lambda-definition events-queued (display mode)
|
||||
(import-xlib-function events-queued (display mode)
|
||||
"scx_Events_Queued")
|
||||
|
||||
(define (event-ready? display)
|
||||
|
|
@ -49,22 +49,22 @@
|
|||
;; events-pending is identical to events-queued with after-flush
|
||||
;; mode.
|
||||
|
||||
(import-lambda-definition events-pending (display)
|
||||
(import-xlib-function events-pending (display)
|
||||
"scx_Events_Pending")
|
||||
|
||||
;; Other event reading ***********************************************
|
||||
|
||||
(import-lambda-definition next-event (display)
|
||||
(import-xlib-function next-event (display)
|
||||
"scx_Next_Event")
|
||||
|
||||
(import-lambda-definition peek-event (display)
|
||||
(import-xlib-function peek-event (display)
|
||||
"scx_Peek_Event")
|
||||
|
||||
;; returns a list of (time . (x . y)) elements
|
||||
(import-lambda-definition get-motion-events (display window from to)
|
||||
(import-xlib-function get-motion-events (display window from to)
|
||||
"scx_Get_Motion_Events")
|
||||
|
||||
;; Sending events ****************************************************
|
||||
|
||||
(import-lambda-definition send-event (display window propagate mask event)
|
||||
(import-xlib-function send-event (display window propagate mask event)
|
||||
"scx_Send_Event")
|
||||
|
|
|
|||
|
|
@ -48,21 +48,21 @@
|
|||
|
||||
;; *** load or unload fonts ******************************************
|
||||
|
||||
(import-lambda-definition load-font (display name)
|
||||
(import-xlib-function load-font (display name)
|
||||
"scx_Load_Font")
|
||||
|
||||
(import-lambda-definition unload-font (display font)
|
||||
(import-xlib-function unload-font (display font)
|
||||
"scx_Unload_Font")
|
||||
|
||||
;; returns a font-struct record or #f
|
||||
(import-lambda-definition query-font (display font-id)
|
||||
(import-xlib-function query-font (display font-id)
|
||||
"scx_Query_Font")
|
||||
|
||||
;; returns a font-struct record or #f
|
||||
(import-lambda-definition load-query-font (display name)
|
||||
(import-xlib-function load-query-font (display name)
|
||||
"scx_Load_Query_Font")
|
||||
|
||||
(import-lambda-definition free-font (display font-struct)
|
||||
(import-xlib-function free-font (display font-struct)
|
||||
"scx_Free_Font")
|
||||
|
||||
(define (get-font-property font-struct atom)
|
||||
|
|
@ -71,19 +71,19 @@
|
|||
|
||||
;; *** obtain or free font names and information *********************
|
||||
|
||||
(import-lambda-definition list-fonts (display pattern maxnames)
|
||||
(import-xlib-function list-fonts (display pattern maxnames)
|
||||
"scx_List_Fonts")
|
||||
|
||||
;; returns an alist mapping name -> font-struct
|
||||
(import-lambda-definition list-fonts-with-info (display pattern maxnames)
|
||||
(import-xlib-function list-fonts-with-info (display pattern maxnames)
|
||||
"scx_List_Fonts_With_Info")
|
||||
|
||||
;; *** set or get the font search path *******************************
|
||||
|
||||
(import-lambda-definition set-font-path (display directories)
|
||||
(import-xlib-function set-font-path (display directories)
|
||||
"scx_Set_Font_Path")
|
||||
|
||||
(import-lambda-definition get-font-path (display)
|
||||
(import-xlib-function get-font-path (display)
|
||||
"scx_Get_Font_Path")
|
||||
|
||||
;; TODO: ??
|
||||
|
|
|
|||
|
|
@ -103,10 +103,10 @@
|
|||
|
||||
;; *** create or free graphics contexts ******************************
|
||||
|
||||
(import-lambda-definition create-gc (display drawable gc-value-alist)
|
||||
(import-xlib-function create-gc (display drawable gc-value-alist)
|
||||
"scx_Create_Gc")
|
||||
|
||||
(import-lambda-definition copy-gc! (display srck dest mask)
|
||||
(import-xlib-function copy-gc! (display srck dest mask)
|
||||
"scx_Copy_Gc")
|
||||
|
||||
(define (copy-gc display drawable src)
|
||||
|
|
@ -114,7 +114,7 @@
|
|||
(copy-gc! display src all-gc-values gc)
|
||||
gc))
|
||||
|
||||
(import-lambda-definition change-gc (display gc values)
|
||||
(import-xlib-function change-gc (display gc values)
|
||||
"scx_Change_Gc")
|
||||
|
||||
(define (make-gc-setter name)
|
||||
|
|
@ -146,7 +146,7 @@
|
|||
(define set-gc-dash-offset! (make-gc-setter (gc-value dash-offset)))
|
||||
(define set-gc-dashes! (make-gc-setter (gc-value dashes)))
|
||||
|
||||
(import-lambda-definition get-gc-values (display gc values)
|
||||
(import-xlib-function get-gc-values (display gc values)
|
||||
"scx_Get_Gc_Values")
|
||||
|
||||
(define (make-gc-getter name)
|
||||
|
|
@ -178,7 +178,7 @@
|
|||
(define gc-dash-offset (make-gc-getter (gc-value dash-offset)))
|
||||
(define gc-dashes (make-gc-getter (gc-value dashes)))
|
||||
|
||||
(import-lambda-definition free-gc (display gc)
|
||||
(import-xlib-function free-gc (display gc)
|
||||
"scx_Free_Gc")
|
||||
|
||||
(import-lambda-definition gcontext-from-gc (gc)
|
||||
|
|
@ -194,7 +194,7 @@
|
|||
(cap-style cap-style)
|
||||
(join-style join-style))))
|
||||
|
||||
(import-lambda-definition set-dashes! (display gc dashoffset dashlist)
|
||||
(import-xlib-function set-dashes! (display gc dashoffset dashlist)
|
||||
"scx_Set_Dashes")
|
||||
|
||||
(define (set-clip-origin display gc x-origin y-origin)
|
||||
|
|
@ -211,16 +211,21 @@
|
|||
(define-exported-binding "scx-rectangle-orderings" rectangle-orderings)
|
||||
|
||||
;; rectangles has to be list of (x y width height) lists.
|
||||
(import-lambda-definition set-clip-rectangles!
|
||||
(import-xlib-function set-clip-rectangles!
|
||||
(display gc x-origin y-origin rectangles ordering)
|
||||
"scx_Set_Clip_Rectangles")
|
||||
|
||||
;; *** determine efficient sizes *************************************
|
||||
|
||||
;; returns a pair (width . height)
|
||||
(import-lambda-definition %query-best-size (screen class width height)
|
||||
(import-lambda-definition %%query-best-size (screen class width height)
|
||||
"scx_Query_Best_Size")
|
||||
|
||||
(define (%query-best-size screen class width height)
|
||||
(call-xlib-function (screen:display screen) 'query-best-size
|
||||
(lambda ()
|
||||
(%%query-best-size screen class width height))))
|
||||
|
||||
(define (query-best-cursor screen width height)
|
||||
(%query-best-size screen 0 width height))
|
||||
|
||||
|
|
|
|||
|
|
@ -14,15 +14,15 @@
|
|||
|
||||
(define-exported-binding "scx-grab-states" grab-states)
|
||||
|
||||
(import-lambda-definition grab-pointer
|
||||
(import-xlib-function grab-pointer
|
||||
(display grab-window owner-events? events ptr-mode kbd-mode
|
||||
confine-to cursor time)
|
||||
"scx_Grab_Pointer")
|
||||
|
||||
(import-lambda-definition ungrab-pointer (display time)
|
||||
(import-xlib-function ungrab-pointer (display time)
|
||||
"scx_Ungrab_Pointer")
|
||||
|
||||
(import-lambda-definition change-active-pointer-grab
|
||||
(import-xlib-function change-active-pointer-grab
|
||||
(display events cursor time)
|
||||
"scx_Change_Active_Pointer_Grab")
|
||||
|
||||
|
|
@ -51,30 +51,30 @@
|
|||
(define-exported-binding "scx-button" :button)
|
||||
(define-exported-binding "scx-buttons" buttons)
|
||||
|
||||
(import-lambda-definition grab-button
|
||||
(import-xlib-function grab-button
|
||||
(display button modifiers grab-window owner-events? events ptr-mode
|
||||
kbd-mode confine-to cursor)
|
||||
"scx_Grab_Button")
|
||||
|
||||
(import-lambda-definition ungrab-button (display button modifiers grab-window)
|
||||
(import-xlib-function ungrab-button (display button modifiers grab-window)
|
||||
"scx_Ungrab_Button")
|
||||
|
||||
;; *** grab the keyboard *********************************************
|
||||
|
||||
(import-lambda-definition grab-keyboard
|
||||
(import-xlib-function grab-keyboard
|
||||
(display grab-window owner-events? ptr-mode kbd-mode time)
|
||||
"scx_Grab_Keyboard")
|
||||
|
||||
(import-lambda-definition ungrab-keyboard (display time)
|
||||
(import-xlib-function ungrab-keyboard (display time)
|
||||
"scx_Ungrab_Keyboard")
|
||||
|
||||
;; *** grab keyboard keys ********************************************
|
||||
|
||||
(import-lambda-definition grab-key
|
||||
(import-xlib-function grab-key
|
||||
(display keycode modifiers grab-window owner-events? ptr-mode kbd-mode)
|
||||
"scx_Grab_Key")
|
||||
|
||||
(import-lambda-definition ungrab-key (display keycode modifiers grab-window)
|
||||
(import-xlib-function ungrab-key (display keycode modifiers grab-window)
|
||||
"scx_Ungrab_Key")
|
||||
|
||||
;; *** release queued events *****************************************
|
||||
|
|
@ -86,7 +86,7 @@
|
|||
|
||||
(define-exported-binding "scx-event-mode" :event-mode)
|
||||
|
||||
(import-lambda-definition allow-events (display event-mode time)
|
||||
(import-xlib-function allow-events (display event-mode time)
|
||||
"scx_Allow_Events")
|
||||
|
||||
;; *** grab the server ***********************************************
|
||||
|
|
@ -96,12 +96,12 @@
|
|||
;; not grab the X server any more than is absolutely necessary. See
|
||||
;; XGrabServer.
|
||||
|
||||
(import-lambda-definition grab-server (display)
|
||||
(import-xlib-function grab-server (display)
|
||||
"scx_Grab_Server")
|
||||
|
||||
;; ungrab-server restarts processing of requests and close downs on
|
||||
;; other connections. You should avoid grabbing the X server as much
|
||||
;; as possible. See XUngrabServer.
|
||||
|
||||
(import-lambda-definition ungrab-server (display)
|
||||
(import-xlib-function ungrab-server (display)
|
||||
"scx_Ungrab_Server")
|
||||
|
|
|
|||
|
|
@ -2,11 +2,11 @@
|
|||
|
||||
;; *** copy areas ****************************************************
|
||||
|
||||
(import-lambda-definition copy-area
|
||||
(import-xlib-function copy-area
|
||||
(display src dest gc src-x src-y width height dest-x dest-y)
|
||||
"scx_Copy_Area")
|
||||
|
||||
(import-lambda-definition copy-plane
|
||||
(import-xlib-function copy-plane
|
||||
(display src dest gc src-x src-y width height dest-x dest-y plane)
|
||||
"scx_Copy_Plane")
|
||||
|
||||
|
|
@ -18,23 +18,23 @@
|
|||
|
||||
(define-exported-binding "scx-coord-mode" :coord-mode)
|
||||
|
||||
(import-lambda-definition draw-point (display drawable gc x y)
|
||||
(import-xlib-function draw-point (display drawable gc x y)
|
||||
"scx_Draw_Point")
|
||||
|
||||
;; points has to be a list of (x . y) pairs
|
||||
(import-lambda-definition draw-points (display drawable gc points mode)
|
||||
(import-xlib-function draw-points (display drawable gc points mode)
|
||||
"scx_Draw_Points")
|
||||
|
||||
;; *** draw lines, polygons ******************************************
|
||||
|
||||
(import-lambda-definition draw-line (display drawable gc x1 y1 x2 y2)
|
||||
(import-xlib-function draw-line (display drawable gc x1 y1 x2 y2)
|
||||
"scx_Draw_Line")
|
||||
|
||||
;; points has to be a list of (x . y) pairs
|
||||
(import-lambda-definition draw-lines (display drawable gc points mode)
|
||||
(import-xlib-function draw-lines (display drawable gc points mode)
|
||||
"scx_Draw_Lines")
|
||||
|
||||
(import-lambda-definition draw-segments (display drawable gc segments)
|
||||
(import-xlib-function draw-segments (display drawable gc segments)
|
||||
"scx_Draw_Segments")
|
||||
|
||||
(define-record-type segment :segment
|
||||
|
|
@ -49,7 +49,7 @@
|
|||
|
||||
;; *** draw rectangles ***********************************************
|
||||
|
||||
(import-lambda-definition draw-rectangle
|
||||
(import-xlib-function draw-rectangle
|
||||
(display drawable gc x y width height)
|
||||
"scx_Draw_Rectangle")
|
||||
|
||||
|
|
@ -68,12 +68,12 @@
|
|||
|
||||
(define-exported-binding "scx-rectangle" :rectangle)
|
||||
|
||||
(import-lambda-definition draw-rectangles (display drawable gc rectangles)
|
||||
(import-xlib-function draw-rectangles (display drawable gc rectangles)
|
||||
"scx_Draw_Rectangles")
|
||||
|
||||
;; *** draw arcs *****************************************************
|
||||
|
||||
(import-lambda-definition draw-arc
|
||||
(import-xlib-function draw-arc
|
||||
(display drawable gc x y width height angle1 angle2)
|
||||
"scx_Draw_Arc")
|
||||
|
||||
|
|
@ -89,16 +89,16 @@
|
|||
|
||||
(define-exported-binding "scx-arc" :arc)
|
||||
|
||||
(import-lambda-definition draw-arcs (display drawable gc arcs)
|
||||
(import-xlib-function draw-arcs (display drawable gc arcs)
|
||||
"scx_Draw_Arcs")
|
||||
|
||||
;; *** fill rectangles, polygons, or arcs ****************************
|
||||
|
||||
(import-lambda-definition fill-rectangle
|
||||
(import-xlib-function fill-rectangle
|
||||
(display drawable gc x y width height)
|
||||
"scx_Fill_Rectangle")
|
||||
|
||||
(import-lambda-definition fill-rectangles (display drawable gc rectangles)
|
||||
(import-xlib-function fill-rectangles (display drawable gc rectangles)
|
||||
"scx_Fill_Rectangles")
|
||||
|
||||
(define-enumerated-type polygon-shape :polygon-shape
|
||||
|
|
@ -107,15 +107,15 @@
|
|||
|
||||
(define-exported-binding "scx-polygon-shape" :polygon-shape)
|
||||
|
||||
(import-lambda-definition fill-polygon (display drawable gc points shape mode)
|
||||
(import-xlib-function fill-polygon (display drawable gc points shape mode)
|
||||
"scx_Fill_Polygon")
|
||||
|
||||
(import-lambda-definition fill-arc
|
||||
(import-xlib-function fill-arc
|
||||
(display drawable gc x y width height angle1 angle2)
|
||||
"scx_Fill_Arc")
|
||||
|
||||
;; arcs has to be a list of (x y width height angle1 angle2) lists.
|
||||
(import-lambda-definition fill-arcs (display drawable gc arcs)
|
||||
(import-xlib-function fill-arcs (display drawable gc arcs)
|
||||
"scx_Fill_Arcs")
|
||||
|
||||
;; *** auxiliary functions *******************************************
|
||||
|
|
|
|||
|
|
@ -9,17 +9,17 @@
|
|||
|
||||
;; a keyboard mapping is a list of lists of keysyms
|
||||
|
||||
(import-lambda-definition change-keyboard-mapping
|
||||
(import-xlib-function change-keyboard-mapping
|
||||
(display first-keycode keysyms-lists)
|
||||
"scx_Change_Keyboard_Mapping")
|
||||
|
||||
;; returns keycode-count lists of keysyms
|
||||
(import-lambda-definition get-keyboard-mapping
|
||||
(import-xlib-function get-keyboard-mapping
|
||||
(display first-keycode keycode-count)
|
||||
"scx_Get_Keyboard_Mapping")
|
||||
|
||||
;; returns a pair (min-keycodes . max-keycodes)
|
||||
(import-lambda-definition display-keycodes (display)
|
||||
(import-xlib-function display-keycodes (display)
|
||||
"scx_Display_Keycodes")
|
||||
|
||||
;; a modmap is an alist mapping a modifier to a list of
|
||||
|
|
@ -27,10 +27,10 @@
|
|||
;; control) (state mod1) (state mod2) (state mod3) (state mod4)
|
||||
;; (state mod5)
|
||||
|
||||
(import-lambda-definition set-modifier-mapping (display modmap)
|
||||
(import-xlib-function set-modifier-mapping (display modmap)
|
||||
"scx_Set_Modifier_Mapping")
|
||||
|
||||
(import-lambda-definition get-modifier-mapping (display)
|
||||
(import-xlib-function get-modifier-mapping (display)
|
||||
"scx_Get_Modifier_Mapping")
|
||||
|
||||
;; *** convert keysyms ***********************************************
|
||||
|
|
@ -43,10 +43,10 @@
|
|||
|
||||
;; TODO include X11/keysymdef.h ??
|
||||
|
||||
(import-lambda-definition keycode->keysym (display keycode index)
|
||||
(import-xlib-function keycode->keysym (display keycode index)
|
||||
"scx_Keycode_To_Keysym")
|
||||
|
||||
(import-lambda-definition keysym->keycode (display keysym)
|
||||
(import-xlib-function keysym->keycode (display keysym)
|
||||
"scx_Keysym_To_Keycode")
|
||||
|
||||
;; returns a pair (lower . upper)
|
||||
|
|
@ -61,18 +61,32 @@
|
|||
|
||||
;; *** handle keyboard input events in Latin-1 ***********************
|
||||
|
||||
(import-lambda-definition lookup-keysym (key-event index)
|
||||
(import-lambda-definition %lookup-keysym (key-event index)
|
||||
"scx_Lookup_Keysym")
|
||||
|
||||
(import-lambda-definition refresh-keyboard-mapping (mapping-event)
|
||||
(define (lookup-keysym key-event index)
|
||||
(call-xlib-function (key-event-display key-event) 'lookup-keysym
|
||||
(lambda () (%lookup-keysym key-event index))))
|
||||
|
||||
(import-lambda-definition %refresh-keyboard-mapping (mapping-event)
|
||||
"scx_Refresh_Keyboard_Mapping")
|
||||
|
||||
(define (refresh-keyboard-mapping mapping-event)
|
||||
(call-xlib-function (mapping-event-display mapping-event)
|
||||
'refresh-keyboard-mapping
|
||||
(lambda () (%refresh-keyboard-mapping mapping-event))))
|
||||
|
||||
;; returns a pair (keysym . string)
|
||||
(import-lambda-definition lookup-string/keysym (key-event)
|
||||
(import-lambda-definition %lookup-string/keysym (key-event)
|
||||
"scx_Lookup_String")
|
||||
|
||||
(define (lookup-string/keysym key-event)
|
||||
(call-xlib-function (key-event-display key-event)
|
||||
'lookup-string/keysym
|
||||
(lambda () (%lookup-string/keysym key-event))))
|
||||
|
||||
(define (lookup-string key-event)
|
||||
(cdr (lookup-string/keysym key-event)))
|
||||
|
||||
(import-lambda-definition rebind-keysym (display keysym mod-keysyms string)
|
||||
(import-xlib-function rebind-keysym (display keysym mod-keysyms string)
|
||||
"scx_Rebind_Keysym")
|
||||
|
|
|
|||
|
|
@ -2,10 +2,10 @@
|
|||
|
||||
;; *** create or destroy pixmaps *************************************
|
||||
|
||||
(import-lambda-definition create-pixmap (display drawable width height depth)
|
||||
(import-xlib-function create-pixmap (display drawable width height depth)
|
||||
"scx_Create_Pixmap")
|
||||
|
||||
(import-lambda-definition free-pixmap (display pixmap)
|
||||
(import-xlib-function free-pixmap (display pixmap)
|
||||
"scx_Free_Pixmap")
|
||||
|
||||
;; *** manipulate bitmaps ********************************************
|
||||
|
|
@ -17,7 +17,7 @@
|
|||
((2) (error "invalid bitmap data in file" data))
|
||||
((3) (error "not enough memory to create bitmap" data))))
|
||||
|
||||
(import-lambda-definition %read-bitmap-file (display drawable filename)
|
||||
(import-xlib-function %read-bitmap-file (display drawable filename)
|
||||
"scx_Read_Bitmap_File")
|
||||
|
||||
;; returns a list (pixmap width height x-hot y-hot). May raise an error.
|
||||
|
|
@ -27,7 +27,7 @@
|
|||
(bitmap-error res filename)
|
||||
res)))
|
||||
|
||||
(import-lambda-definition %write-bitmap-file
|
||||
(import-xlib-function %write-bitmap-file
|
||||
(display filename bitmap width height x-hot y-hot)
|
||||
"scx_Write_Bitmap_File")
|
||||
|
||||
|
|
@ -40,14 +40,14 @@
|
|||
;; image found in data, which has to be a string. Such an image can be
|
||||
;; generated with write-bitmap-file. See XCreateBitmapFromData.
|
||||
|
||||
(import-lambda-definition create-bitmap-from-data (display drawable data w h)
|
||||
(import-xlib-function create-bitmap-from-data (display drawable data w h)
|
||||
"scx_Create_Bitmap_From_Data")
|
||||
|
||||
;; create-pixmap-from-bitmap-data creates a pixmap of the given depth
|
||||
;; and then does a bitmap-format XPutImage of the data into it. See
|
||||
;; XCreatePixmapFromBitmapData.
|
||||
|
||||
(import-lambda-definition create-pixmap-from-bitmap-data
|
||||
(import-xlib-function create-pixmap-from-bitmap-data
|
||||
(display drawable data width height foreground background depth)
|
||||
"scx_Create_Pixmap_From_Bitmap_Data")
|
||||
|
||||
|
|
|
|||
|
|
@ -12,14 +12,14 @@
|
|||
|
||||
;; *** create or return atom names ***********************************
|
||||
|
||||
(import-lambda-definition intern-atom (display atom-name only-if-exists?)
|
||||
(import-xlib-function intern-atom (display atom-name only-if-exists?)
|
||||
"scx_Intern_Atom")
|
||||
|
||||
;; returns a list of atoms or #f
|
||||
(import-lambda-definition intern-atoms (display names only-if-exists?)
|
||||
(import-xlib-function intern-atoms (display names only-if-exists?)
|
||||
"scx_Intern_Atoms")
|
||||
|
||||
(import-lambda-definition get-atom-name (display atom)
|
||||
(import-xlib-function get-atom-name (display atom)
|
||||
"scx_Get_Atom_Name")
|
||||
|
||||
(define (get-atom-names display atoms)
|
||||
|
|
@ -27,19 +27,19 @@
|
|||
|
||||
;; *** obtain and change window properties****************************
|
||||
|
||||
(import-lambda-definition list-properties (display window)
|
||||
(import-xlib-function list-properties (display window)
|
||||
"scx_List_Properties")
|
||||
|
||||
;; Note: This does not change the list itself.
|
||||
(import-lambda-definition rotate-window-properties
|
||||
(import-xlib-function rotate-window-properties
|
||||
(display window properties npositions)
|
||||
"scx_Rotate_Window_Properties")
|
||||
|
||||
(import-lambda-definition delete-property (display window property)
|
||||
(import-xlib-function delete-property (display window property)
|
||||
"scx_Delete_Property")
|
||||
|
||||
;; returns a pair (bytes-after . property) or #f
|
||||
(import-lambda-definition get-window-property
|
||||
(import-xlib-function get-window-property
|
||||
(display window atom offset length delete? req-type)
|
||||
"scx_Get_Window_Property")
|
||||
|
||||
|
|
@ -50,7 +50,7 @@
|
|||
|
||||
(define-exported-binding "scx-change-property-mode" :change-property-mode)
|
||||
|
||||
(import-lambda-definition change-property
|
||||
(import-xlib-function change-property
|
||||
(display window atom mode property)
|
||||
"scx_Change_Property")
|
||||
|
||||
|
|
@ -81,12 +81,12 @@
|
|||
|
||||
;; *** manipulate window selection ***********************************
|
||||
|
||||
(import-lambda-definition set-selection-owner (display selection owner time)
|
||||
(import-xlib-function set-selection-owner (display selection owner time)
|
||||
"scx_Set_Selection_Owner")
|
||||
|
||||
(import-lambda-definition get-selection-owner (display selection)
|
||||
(import-xlib-function get-selection-owner (display selection)
|
||||
"scx_Get_Selection_Owner")
|
||||
|
||||
(import-lambda-definition convert-selection
|
||||
(import-xlib-function convert-selection
|
||||
(display selection target property requestor time)
|
||||
"scx_Convert_Selection")
|
||||
|
|
|
|||
|
|
@ -2,12 +2,12 @@
|
|||
|
||||
;; *** draw image text ***********************************************
|
||||
|
||||
(import-lambda-definition draw-image-string (display drawable gc x y string)
|
||||
(import-xlib-function draw-image-string (display drawable gc x y string)
|
||||
"scx_Draw_Image_String")
|
||||
|
||||
;; string has to be a list of (byte1 . byte2) pairs, where byte1 and
|
||||
;; byte2 are characters
|
||||
(import-lambda-definition draw-image-string-16
|
||||
(import-xlib-function draw-image-string-16
|
||||
(display drawable gc x y string)
|
||||
"scx_Draw_Image_String_16")
|
||||
|
||||
|
|
@ -37,10 +37,10 @@
|
|||
((make-text-items)
|
||||
'())))
|
||||
|
||||
(import-lambda-definition draw-text (display drawable gc x y items)
|
||||
(import-xlib-function draw-text (display drawable gc x y items)
|
||||
"scx_Draw_Text")
|
||||
|
||||
(import-lambda-definition draw-text-16 (display drawable gc x y items)
|
||||
(import-xlib-function draw-text-16 (display drawable gc x y items)
|
||||
"scx_Draw_Text_16")
|
||||
|
||||
;; *** compute or query text extents *********************************
|
||||
|
|
|
|||
|
|
@ -15,14 +15,14 @@
|
|||
;; strings. On success a string is returned, otherwise #f. See
|
||||
;; XGetDefault.
|
||||
|
||||
(import-lambda-definition get-default (display program option)
|
||||
(import-xlib-function get-default (display program option)
|
||||
"scx_Get_Default")
|
||||
|
||||
;; resource-manager-string returns the RESOURCE_MANAGER property from
|
||||
;; the server's root window of screen 0, or #f if no such property
|
||||
;; exists. See XResourceManagerString.
|
||||
|
||||
(import-lambda-definition resource-manager-string (display)
|
||||
(import-xlib-function resource-manager-string (display)
|
||||
"scx_Resource_Manager_String")
|
||||
|
||||
;; parse-geometry parses a string for the standard X format for x, y,
|
||||
|
|
|
|||
|
|
@ -40,11 +40,11 @@
|
|||
;; template. #f entries in the template are ignored. Use
|
||||
;; (empty-visual-info) to create a visual-info with all entries set to
|
||||
;; #f.
|
||||
(import-lambda-definition get-visual-infos (display template)
|
||||
(import-xlib-function get-visual-infos (display template)
|
||||
"scx_Get_Visual_Info")
|
||||
|
||||
;; returns a visual-info or #f
|
||||
(import-lambda-definition match-visual-info (display screen-number depth class)
|
||||
(import-xlib-function match-visual-info (display screen-number depth class)
|
||||
"scx_Match_Visual_Info")
|
||||
|
||||
(import-lambda-definition visualid-from-visual (visual)
|
||||
|
|
|
|||
|
|
@ -50,17 +50,17 @@
|
|||
|
||||
;; *** create windows ************************************************
|
||||
|
||||
(import-lambda-definition create-window
|
||||
(import-xlib-function create-window
|
||||
(display parent x y width height border_width depth class visual attribs)
|
||||
"scx_Create_Window")
|
||||
|
||||
(import-lambda-definition create-simple-window
|
||||
(import-xlib-function create-simple-window
|
||||
(display parent x y width height border_width border background)
|
||||
"scx_Create_Simple_Window")
|
||||
|
||||
;; *** change window attributes **************************************
|
||||
|
||||
(import-lambda-definition change-window-attributes (display window attribs)
|
||||
(import-xlib-function change-window-attributes (display window attribs)
|
||||
"scx_Change_Window_Attributes")
|
||||
|
||||
(define (make-win-attr-setter attribute)
|
||||
|
|
@ -125,7 +125,7 @@
|
|||
((make-window-change-alist)
|
||||
'())))
|
||||
|
||||
(import-lambda-definition configure-window (display window changes)
|
||||
(import-xlib-function configure-window (display window changes)
|
||||
"scx_Configure_Window")
|
||||
|
||||
(define (make-win-configurer change)
|
||||
|
|
@ -207,11 +207,11 @@
|
|||
|
||||
(define-exported-binding "scx-window-attributes" :window-attributes)
|
||||
|
||||
(import-lambda-definition get-window-attributes (display window)
|
||||
(import-xlib-function get-window-attributes (display window)
|
||||
"scx_Get_Window_Attributes")
|
||||
|
||||
;; returns a vector #(root-window x y width height border-width depth) or #f
|
||||
(import-lambda-definition get-geometry (display drawable)
|
||||
(import-xlib-function get-geometry (display drawable)
|
||||
"scx_Get_Geometry")
|
||||
|
||||
(define (make-geometry-getter i)
|
||||
|
|
@ -229,37 +229,37 @@
|
|||
|
||||
;; *** map windows ***************************************************
|
||||
|
||||
(import-lambda-definition map-window (display window)
|
||||
(import-xlib-function map-window (display window)
|
||||
"scx_Map_Window")
|
||||
|
||||
(import-lambda-definition map-raised (display window)
|
||||
(import-xlib-function map-raised (display window)
|
||||
"scx_Map_Raised")
|
||||
|
||||
(import-lambda-definition map-subwindows (display window)
|
||||
(import-xlib-function map-subwindows (display window)
|
||||
"scx_Map_Subwindows")
|
||||
|
||||
;; *** unmap windows *************************************************
|
||||
|
||||
(import-lambda-definition unmap-window (display window)
|
||||
(import-xlib-function unmap-window (display window)
|
||||
"scx_Unmap_Window")
|
||||
|
||||
(import-lambda-definition unmap-subwindows (display window)
|
||||
(import-xlib-function unmap-subwindows (display window)
|
||||
"scx_Unmap_Subwindows")
|
||||
|
||||
;; *** destroy windows ***********************************************
|
||||
|
||||
(import-lambda-definition destroy-window (display window)
|
||||
(import-xlib-function destroy-window (display window)
|
||||
"scx_Destroy_Window")
|
||||
|
||||
(import-lambda-definition destroy-subwindows (display window)
|
||||
(import-xlib-function destroy-subwindows (display window)
|
||||
"scx_Destroy_Subwindows")
|
||||
|
||||
;; *** change window stacking order **********************************
|
||||
|
||||
(import-lambda-definition raise-window (display window)
|
||||
(import-xlib-function raise-window (display window)
|
||||
"scx_Raise_Window")
|
||||
|
||||
(import-lambda-definition lower-window (display window)
|
||||
(import-xlib-function lower-window (display window)
|
||||
"scx_Lower_Window")
|
||||
|
||||
(define-enumerated-type circulate-direction :circulate-direction
|
||||
|
|
@ -269,7 +269,7 @@
|
|||
|
||||
(define-exported-binding "scx-circulate-direction" :circulate-direction)
|
||||
|
||||
(import-lambda-definition circulate-subwindows (display window direction)
|
||||
(import-xlib-function circulate-subwindows (display window direction)
|
||||
"scx_Circulate_Subwindows")
|
||||
|
||||
(define (circulate-subwindows-up display window)
|
||||
|
|
@ -278,22 +278,22 @@
|
|||
(define (circulate-subwindows-down display window)
|
||||
(circulate-subwindows display window (circulate-direction lower-highest)))
|
||||
|
||||
(import-lambda-definition restack-windows (display windows)
|
||||
(import-xlib-function restack-windows (display windows)
|
||||
"scx_Restack_Windows")
|
||||
|
||||
;; *** clear area or window ******************************************
|
||||
|
||||
(import-lambda-definition clear-area
|
||||
(import-xlib-function clear-area
|
||||
(display window x y width height exposures?)
|
||||
"scx_Clear_Area")
|
||||
|
||||
(import-lambda-definition clear-window (display window)
|
||||
(import-xlib-function clear-window (display window)
|
||||
"scx_Clear_Window")
|
||||
|
||||
;; *** query window tree information *********************************
|
||||
|
||||
;; returns a list (root-window parent-window children) or #f
|
||||
(import-lambda-definition query-tree (display window)
|
||||
(import-xlib-function query-tree (display window)
|
||||
"scx_Query_Tree")
|
||||
|
||||
(define (window-root display window)
|
||||
|
|
@ -311,13 +311,13 @@
|
|||
;; *** translate window coordinates **********************************
|
||||
|
||||
;; returns a list (dest-x dest-y child) or #f
|
||||
(import-lambda-definition translate-coordinates
|
||||
(import-xlib-function translate-coordinates
|
||||
(display src-w dest-w src-x src-y)
|
||||
"scx_Translate_Coordinates")
|
||||
|
||||
;; *** get pointer coordinates ***************************************
|
||||
|
||||
(import-lambda-definition %query-pointer (display window)
|
||||
(import-xlib-function %query-pointer (display window)
|
||||
"scx_Query_Pointer")
|
||||
|
||||
(define (query-pointer-root display)
|
||||
|
|
@ -341,7 +341,8 @@
|
|||
;; *** convenience functions *****************************************
|
||||
|
||||
(define (window-exists? dpy window)
|
||||
(let ((pe (use-x-error-warnings!)))
|
||||
(display-sync dpy #f)
|
||||
(let ((before (use-x-error-warnings! dpy #t)))
|
||||
(let ((result
|
||||
(call-with-current-continuation
|
||||
(lambda (return)
|
||||
|
|
@ -351,5 +352,5 @@
|
|||
(query-tree dpy window)
|
||||
(display-sync dpy #f)
|
||||
#t))))))
|
||||
(set-error-handler! pe)
|
||||
(if (not before) (use-x-error-warnings! dpy #f))
|
||||
result)))
|
||||
|
|
|
|||
|
|
@ -7,7 +7,7 @@
|
|||
;; position in the hierarchy, and inserts it as the child of the
|
||||
;; specified parent. See XReparentWindow.
|
||||
|
||||
(import-lambda-definition reparent-window (display window parent x y)
|
||||
(import-xlib-function reparent-window (display window parent x y)
|
||||
"scx_Reparent_Window")
|
||||
|
||||
;; *** control colormaps *********************************************
|
||||
|
|
@ -15,20 +15,20 @@
|
|||
;; install-colormap function installs the specified colormap for
|
||||
;; its associated screen. See XInstallColormap.
|
||||
|
||||
(import-lambda-definition install-colormap (display colormap)
|
||||
(import-xlib-function install-colormap (display colormap)
|
||||
"scx_Install_Colormap")
|
||||
|
||||
;; uninstall-colormap removes the specified colormap from the required
|
||||
;; list for its screen. See XUninstallColormap.
|
||||
|
||||
(import-lambda-definition uninstall-colormap (display colormap)
|
||||
(import-xlib-function uninstall-colormap (display colormap)
|
||||
"scx_Uninstall_Colormap")
|
||||
|
||||
;; list-installed-colormaps function returns a list of the currently
|
||||
;; installed colormaps for the screen of the specified window. See
|
||||
;; XListInstalledColormaps.
|
||||
|
||||
(import-lambda-definition list-installed-colormaps (display window)
|
||||
(import-xlib-function list-installed-colormaps (display window)
|
||||
"scx_List_Installed_Colormaps")
|
||||
|
||||
;; *** control input focus *******************************************
|
||||
|
|
@ -36,7 +36,7 @@
|
|||
;; set-input-focus function changes the input focus and the
|
||||
;; last-focus-change time. See XSetInputFocus.
|
||||
|
||||
(import-lambda-definition set-input-focus (display window revert-to time)
|
||||
(import-xlib-function set-input-focus (display window revert-to time)
|
||||
"scx_Set_Input_Focus")
|
||||
|
||||
(define-enumerated-type revert-to :revert-to
|
||||
|
|
@ -49,7 +49,7 @@
|
|||
;; get-input-focus returns the current focus window and the current focus
|
||||
;; state (revert-to) as a pair. See XGetInputFocus.
|
||||
|
||||
(import-lambda-definition get-input-focus (display)
|
||||
(import-xlib-function get-input-focus (display)
|
||||
"scx_Get_Input_Focus")
|
||||
|
||||
(define (get-input-focus-window display)
|
||||
|
|
@ -57,7 +57,7 @@
|
|||
|
||||
;; *** move pointer **************************************************
|
||||
|
||||
(import-lambda-definition general-warp-pointer
|
||||
(import-xlib-function general-warp-pointer
|
||||
(display src dest src-x src-y src-width src-height
|
||||
dest-x dest-y)
|
||||
"scx_Warp_Pointer")
|
||||
|
|
@ -87,7 +87,7 @@
|
|||
;; possible. The optional percent argument specifies the volume in a
|
||||
;; range from -100 to 100. 0 is the default value. See XBell.
|
||||
|
||||
(import-lambda-definition %bell (display percent)
|
||||
(import-xlib-function %bell (display percent)
|
||||
"scx_Bell")
|
||||
|
||||
(define (bell display . percent)
|
||||
|
|
@ -103,7 +103,7 @@
|
|||
;; set-access-control either enables or disables the use of the access
|
||||
;; control list at each connection setup. See XSetAccessControl.
|
||||
|
||||
(import-lambda-definition set-access-control (display enable?)
|
||||
(import-xlib-function set-access-control (display enable?)
|
||||
"scx_Set_Access_Control")
|
||||
|
||||
;; *** change a client's save set ************************************
|
||||
|
|
@ -114,7 +114,7 @@
|
|||
;; BadMatch error results. mode is one of 'insert or 'delete. See
|
||||
;; XChangeSaveSet.
|
||||
|
||||
(import-lambda-definition change-save-set (display window mode)
|
||||
(import-xlib-function change-save-set (display window mode)
|
||||
"scx_Change_Save_Set")
|
||||
|
||||
(define-enumerated-type save-set :save-set
|
||||
|
|
@ -135,10 +135,10 @@
|
|||
|
||||
(define-exported-binding "scx-close-down-mode" :close-down-mode)
|
||||
|
||||
(import-lambda-definition set-close-down-mode (display mode)
|
||||
(import-xlib-function set-close-down-mode (display mode)
|
||||
"scx_Set_Close_Down_Mode")
|
||||
|
||||
(import-lambda-definition kill-client (display xid)
|
||||
(import-xlib-function kill-client (display xid)
|
||||
"scx_Kill_Client")
|
||||
|
||||
;; *** manipulate pointer settings ***********************************
|
||||
|
|
@ -147,7 +147,7 @@
|
|||
;; element the logical button number for the physical button i+1. See
|
||||
;; XGetPointerMapping.
|
||||
|
||||
(import-lambda-definition get-pointer-mapping (display)
|
||||
(import-xlib-function get-pointer-mapping (display)
|
||||
"scx_Get_Pointer_Mapping")
|
||||
|
||||
;; set-pointer-mapping sets the mapping of the pointer. mapping must
|
||||
|
|
@ -156,7 +156,7 @@
|
|||
;; down state, then #f is returned and the mapping is not changed, #t
|
||||
;; otherwise. See XSetPointerMapping.
|
||||
|
||||
(import-lambda-definition set-pointer-mapping (display mapping)
|
||||
(import-xlib-function set-pointer-mapping (display mapping)
|
||||
"scx_Set_Pointer_Mapping")
|
||||
|
||||
;; TODO: there is a lot more...
|
||||
|
|
|
|||
|
|
@ -21,6 +21,7 @@
|
|||
display:bitmap-unit display:bitmap-pad display:bitmap-bit-order
|
||||
display:vendor-release display:queue-length display:name
|
||||
display:default-screen display:screens display-message-inport
|
||||
display:error-queue
|
||||
|
||||
(byte-order :syntax) byte-order?
|
||||
(bit-order :syntax) bit-order?
|
||||
|
|
@ -178,14 +179,11 @@
|
|||
|
||||
(error-code :syntax) error-code?
|
||||
use-x-error-warnings!
|
||||
use-x-error-queue!
|
||||
|
||||
x-error-queue? x-error-queue:this
|
||||
empty-x-error-queue?
|
||||
next-x-error-queue
|
||||
|
||||
((set-error-handler!) (proc ((proc (:display :x-error) :value))
|
||||
(proc (:display :x-error) :value)))
|
||||
get-error-text
|
||||
get-error-database-text
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue