first V a vErx

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")
+  
+
+
+
+						     
+  
+