scx/scheme/xlib/property.scm

146 lines
3.6 KiB
Scheme

; --- author : Norbert Freudemann ---
; --- cr-date : 09.07.2001 ---
; --- last-mod: 11.07.2001 ---
; --- RETURN: atom
(define (intern-atom display name)
(make-atom (%intern_atom (display-Xdisplay display)
(if (symbol? name)
(symbol->string name)
name))))
(import-lambda-definition %intern-atom (Xdisplay name)
"scx_Intern_Atom")
; --- RETURN: atom or symbol: none
(define (find-atom display name)
(%find-atom (display-Xdisplay display)
(if (symbol? name)
(symbol->string name)
name)))
(import-lambda-definition %find-atom (Xdisplay name)
"scx_Find_Atom")
; --- RETURN: string
(define (atom-name display atom)
(%atom-name (display-Xdisplay display)
(atom-Xatom atom)))
(import-lambda-definition %atom-name (Xdisplay atom)
"scx_Atom_Name")
; --- RETURN: vector of atoms
(define (list-properties window)
(let ((atom (%list-properties (display-Xdisplay (window-display window))
(window-Xwindow window))))
(vector-map! make-atom atom)))
(import-lambda-definition %list-properties (Xdisplay Xwindow)
"scx_List_Properties")
; --- Return: list consisting: '(atom integer data integer)
(define (get-property window property request-type offset length delete?)
(%get-property (window-Xwindow window)
(display-Xdisplay (window-display window))
(atom-Xatom property)
(atom-Xatom request-type)
offset length delete?))
(import-lambda-definition %get-property (Xwindow Xdisplay Xatom_prop Xatom_type
start len deletep)
"scx_Get_Property")
; --- RETURN -> "void"
(define (change-property window property type format mode data)
(%change-property (display-Xdisplay (window-display window))
(window-Xwindow window)
(atom-Xatom property)
(atom-Xatom type)
format mode data))
(import-lambda-definition %change-property (Xdisplay Xwindow Xatom_prop
Xatom_type format mode data)
"scx_Change_Property")
; --- RETURN -> "void"
(define (delete-property window property)
(%delete-property (display-Xdisplay (window-display window))
(window-Xwindow window)
(atom-Xatom property)))
(import-lambda-definition %delete-property (Xdisplay Xwindow Xatom_prop)
"scx_Delete_Property")
; --- RETURN -> "void"
(define (rotate-properties window vector-of-atoms delta)
(%rotate-properties (display-Xdisplay (window-display window))
(window-Xwindow window)
(vector-map! atom-Xatom vector-of-atoms)
delta))
(import-lambda-definition %rotate-properties (Xdisplay Xwindow Xatom_vec delta)
"scx_Rotate_Properties")
; --- RETURN -> "void"
(define (set-selection-owner! display selection owner time)
(%set-selection-owner! (display-Xdisplay display)
(atom-Xatom selection)
(window-Xwindow owner)
time))
(import-lambda-definition %set-selection-owner! (Xdisplay Xatom_s Xwindow_owner
time)
"scx_Set_Selection_Owner")
; --- RETURN -> Window (s48 record)
(define (selection-owner display selection)
(make-window (%get-selection-owner (display-Xdisplay display)
(atom-Xatom selection))
display
#f))
(import-lambda-definition %get-selection-owner (Xdisplay Xatom_s)
"scx_Get_Selection_Owner")
; --- RETURN -> "void"
(define (convert-selection selection target property requestor-window time)
(%convert-selection (display-Xdisplay (window-display requestor-windw))
(atom-Xatom selection)
(atom-Xatom target)
(if (eq? 'none property)
0
(atom-Xatom property))
(window-Xwindow requestor-window)
time))
(import-lambda-definition %convert-selection (Xdisplay Xatom_s Xatom_t
Xwindow time)
"scx_Convert_Selection")