93 lines
3.0 KiB
Scheme
93 lines
3.0 KiB
Scheme
;; Copyright (c) 2001-2003 by David Frese
|
|
|
|
(define-record-type property :property
|
|
(make-property type format data)
|
|
property?
|
|
(type property:type set-property:type!) ;; an atom
|
|
(format property:format set-property:format!) ;; a property-format
|
|
;; a string if format is char, or an integer list otherwise
|
|
(data property:data set-property:data!))
|
|
|
|
(define-exported-binding "scx-property" :property)
|
|
|
|
;; *** create or return atom names ***********************************
|
|
|
|
(import-lambda-definition intern-atom (display atom-name only-if-exists?)
|
|
"scx_Intern_Atom")
|
|
|
|
;; returns a list of atoms or #f
|
|
(import-lambda-definition intern-atoms (display names only-if-exists?)
|
|
"scx_Intern_Atoms")
|
|
|
|
(import-lambda-definition get-atom-name (display atom)
|
|
"scx_Get_Atom_Name")
|
|
|
|
(define (get-atom-names display atoms)
|
|
(map (lambda (atom) (get-atom-name display atom)) atoms))
|
|
|
|
;; *** obtain and change window properties****************************
|
|
|
|
(import-lambda-definition list-properties (display window)
|
|
"scx_List_Properties")
|
|
|
|
;; Note: This does not change the list itself.
|
|
(import-lambda-definition rotate-window-properties
|
|
(display window properties npositions)
|
|
"scx_Rotate_Window_Properties")
|
|
|
|
(import-lambda-definition delete-property (display window property)
|
|
"scx_Delete_Property")
|
|
|
|
;; returns a pair (bytes-after . property) or #f
|
|
(import-lambda-definition get-window-property
|
|
(display window atom offset length delete? req-type)
|
|
"scx_Get_Window_Property")
|
|
|
|
(define-enumerated-type change-property-mode :change-property-mode
|
|
change-property-mode? change-property-modes change-property-mode-name
|
|
change-property-mode-index
|
|
(replace prepend append))
|
|
|
|
(define-exported-binding "scx-change-property-mode" :change-property-mode)
|
|
|
|
(import-lambda-definition change-property
|
|
(display window atom mode property)
|
|
"scx_Change_Property")
|
|
|
|
(define (get-full-window-property display window atom delete? req-type)
|
|
(let ((res1 (get-window-property display window atom 0 0 #f req-type)))
|
|
(and res1
|
|
(let ((res2 (get-window-property display window atom 0
|
|
(car res1) #f req-type)))
|
|
(and res2 (cdr res2))))))
|
|
|
|
;; separates a string at 0 characters and returns the bits in a list.
|
|
(define (string->string-list s)
|
|
(let ((i (string-index s (ascii->char 0))))
|
|
(if i
|
|
(cons (substring s 0 i)
|
|
(string->string-list (substring s (+ i 1)
|
|
(string-length s))))
|
|
(list s))))
|
|
|
|
(define (string-list->string strings)
|
|
(if (null? strings)
|
|
""
|
|
(fold (lambda (res s)
|
|
(string-append res (make-string 1 (ascii->char 0))
|
|
s))
|
|
(car strings)
|
|
(cdr strings))))
|
|
|
|
;; *** manipulate window selection ***********************************
|
|
|
|
(import-lambda-definition set-selection-owner (display selection owner time)
|
|
"scx_Set_Selection_Owner")
|
|
|
|
(import-lambda-definition get-selection-owner (display selection)
|
|
"scx_Get_Selection_Owner")
|
|
|
|
(import-lambda-definition convert-selection
|
|
(display selection target property requestor time)
|
|
"scx_Convert_Selection")
|