diff --git a/scheme/xlib/property.scm b/scheme/xlib/property.scm new file mode 100644 index 0000000..d0ef419 --- /dev/null +++ b/scheme/xlib/property.scm @@ -0,0 +1,146 @@ +; --- 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") + + + + + + + \ No newline at end of file