146 lines
3.7 KiB
Scheme
146 lines
3.7 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-labmda-definition %intern-atom (Xdisplay name)
|
||
|
"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)
|
||
|
"Find_Atom")
|
||
|
|
||
|
; --- RETURN: string
|
||
|
|
||
|
(define (atom-name display atom)
|
||
|
(%atom-name (display-Xdisplay display)
|
||
|
(atom-Xatom atom)))
|
||
|
|
||
|
(import-lambda-definition %atom-name (Xdisplay atom)
|
||
|
"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)
|
||
|
"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)
|
||
|
"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)
|
||
|
"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)
|
||
|
"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)
|
||
|
"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)
|
||
|
"Set_Selection_Owner")
|
||
|
|
||
|
|
||
|
; --- (get-selection-owner instead of selection-owner)
|
||
|
; --- RETURN -> Window (s48 record)
|
||
|
|
||
|
(define (get-selection-owner display selection)
|
||
|
(make-window (%get-selection-owner (display-Xdisplay display)
|
||
|
(atom-Xatom selection))
|
||
|
display))
|
||
|
|
||
|
|
||
|
(import-lambda-definition %get-selection-owner (Xdisplay Xatom_s)
|
||
|
"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)
|
||
|
"Convert_Selection")
|
||
|
|
||
|
|
||
|
|
||
|
|
||
|
|
||
|
|
||
|
|