diff --git a/scheme/xt/widget-type.scm b/scheme/xt/widget-type.scm new file mode 100644 index 0000000..dd12322 --- /dev/null +++ b/scheme/xt/widget-type.scm @@ -0,0 +1,55 @@ +;--- the widget-datatype --- + +;; the free-field in the record-type indicates whether the widget is alive or +;; not. It's set by a XtNdestroyCallback (see callback.c) +;; Is's neccessary to know if the XtWidged is still there or not. + +(define-record-type widget :widget + (really-make-widget free Xwidget) + widget? + (free get-free set-free!) + (Xwidget real-widget-Xwidget widget-set-Xwidget!)) + +(define (widget-Xwidget widget) + (if (none-resource? widget) + 0 + (real-widget-Xwidget widget))) + +(define (make-widget XWidget) + (if (= 0 XWidget) + none-resource + (let ((maybe-widget (widget-list-find Xwidget))) + (if maybe-widget + maybe-widget + (let ((widget (really-make-widget #f Xwidget))) + (add-finalizer! widget finalize-widget) + (atom-list-set! Xwidget widget) + widget))))) + + +;; finalize-widget is called, when the garbage collector removes the last +;; reference to the widget from the heap. Then we can savely close the +;; widget and remove the weak-pointer from our list. + +(define (finalize-widget widget) + (let ((Xwidget (widget-Xwidget widget))) + (widget-list-delete! Xwidget))) + + +;; All widget records need to be saved in a weak-list, to have only one record +;; for the same XLib widget + +(define *weak-widget-list* (make-integer-table)) + +(define (atom-list-find Xwidget) + (let ((r (table-ref *weak-widget-list* Xwidget))) + (if r + (weak-pointer-ref r) + r))) + +(define (widget-list-set! Xwidget widget) + (let ((p (make-weak-pointer widget))) + (table-set! *weak-widget-list* Xwidget p))) + +(define (widget-list-delete! Xwidget) + (table-set! *weak-widget-list* Xwidget #f)) \ No newline at end of file