scx/scheme/xlib/property.scm

; --- 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 ((atoms (%list-properties (display-Xdisplay (window-display window))
				 (window-Xwindow window))))
    (vector->list (vector-map! make-atom atoms))))


(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
		    (property-mode->integer mode)
		    data))

(define (property-mode->integer mode)
  (case mode
    ((replace) 0)
    ((prepend) 1)
    ((append) 2)
    (else (error "illegal change-property mode" mode))))

(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-window))
		      (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")