Update of /cvsroot/scsh/scx/scheme/xlib
In directory usw-pr-cvs1:/tmp/cvs-serv32695
Added Files:
atom-type.scm
Log Message:
--- NEW FILE ---
;; the atom-datatype ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-record-type atom :atom
(really-make-atom tag Xatom)
atom?
(tag atom-tag atom-set-tag!)
(Xatom real-atom-Xatom atom-set-Xatom!))
(define (atom-Xatom atom)
(if (none-resource? atom)
0
(real-atom-Xatom atom)))
(define (make-atom Xatom)
(if (= 0 Xatom)
none-resource
(let ((maybe-atom (atom-list-find Xatom)))
(if maybe-atom
maybe-atom
(let ((atom (really-make-atom #f Xatom)))
(add-finalizer! atom finalize-atom)
(atom-list-set! Xatom atom)
atom)))))
(define (intern-atom display name)
(let ((Xatom (%intern-atom (display-Xdisplay display)
(if (symbol? name)
(symbol->string name)
name))))
(make-atom Xatom)))
(import-lambda-definition %intern-atom (Xdisplay name)
"Intern_Atom")
;; finalize-atom is called, when the garbage collector removes the last
;; reference to the atom from the heap. Then we can savely close the
;; atom and remove the weak-pointer from our list.
(define (finalize-atom atom)
(let ((Xatom (atom-Xatom atom)))
;(atom-set-Xatom! atom 'already-freed)
(atom-list-delete! Xatom)))
;; All atom records need to be saved in a weak-list, to have only one record
;; for the same XLib atom
(define *weak-atom-list* (make-integer-table))
(define (atom-list-find Xatom)
(let ((r (table-ref *weak-atom-list* Xatom)))
(if r
(weak-pointer-ref r)
r)))
(define (atom-list-set! Xatom atom)
(let ((p (make-weak-pointer atom)))
(table-set! *weak-atom-list* Xatom p)))
(define (atom-list-delete! Xatom)
(table-set! *weak-atom-list* Xatom #f))
|