From: Chris Hanson Date: Wed, 27 Sep 1995 16:24:28 +0000 (+0000) Subject: Implement X selection mechanism for doing cut and paste between Edwin X-Git-Tag: 20090517-FFI~5934 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=824dcf5097963f4dcc04c79d5580ce898a26755c;p=mit-scheme.git Implement X selection mechanism for doing cut and paste between Edwin and other X windows. This change requires recent changes to the microcode. There appears to be a bug in the implementation of the INCR protocol for receiving large selections -- after working on this for a day, I'm giving up and leaving it broken, since it will probably never be used. --- diff --git a/v7/src/edwin/edwin.pkg b/v7/src/edwin/edwin.pkg index ab420475c..91a12acc9 100644 --- a/v7/src/edwin/edwin.pkg +++ b/v7/src/edwin/edwin.pkg @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: edwin.pkg,v 1.178 1995/09/15 19:28:42 cph Exp $ +$Id: edwin.pkg,v 1.179 1995/09/27 16:24:28 cph Exp $ Copyright (c) 1989-95 Massachusetts Institute of Technology @@ -990,8 +990,11 @@ MIT in each case. |# (files "xterm") (parent (edwin screen)) (export (edwin) + os/interprogram-cut + os/interprogram-paste x-screen-auto-raise x-screen-ignore-focus-button? + x-selection-timeout xterm-screen/flush! xterm-screen/grab-focus!) (export (edwin x-commands) diff --git a/v7/src/edwin/unix.scm b/v7/src/edwin/unix.scm index e012b6ac3..d26eeb108 100644 --- a/v7/src/edwin/unix.scm +++ b/v7/src/edwin/unix.scm @@ -1,6 +1,6 @@ ;;; -*-Scheme-*- ;;; -;;; $Id: unix.scm,v 1.53 1995/09/13 23:01:05 cph Exp $ +;;; $Id: unix.scm,v 1.54 1995/09/27 16:23:56 cph Exp $ ;;; ;;; Copyright (c) 1989-95 Massachusetts Institute of Technology ;;; @@ -730,11 +730,4 @@ Otherwise, messages remain on the server and will be re-fetched later." (ns (decoded-time/minute dt) 2 #\0)) (string-append " " (number->string - (decoded-time/year dt))))))) - -(define (os/interprogram-cut string push?) - string push? - unspecific) - -(define (os/interprogram-paste) - #f) \ No newline at end of file + (decoded-time/year dt))))))) \ No newline at end of file diff --git a/v7/src/edwin/xterm.scm b/v7/src/edwin/xterm.scm index 7b1e03406..cafb13940 100644 --- a/v7/src/edwin/xterm.scm +++ b/v7/src/edwin/xterm.scm @@ -1,6 +1,6 @@ ;;; -*-Scheme-*- ;;; -;;; $Id: xterm.scm,v 1.47 1995/09/15 19:28:51 cph Exp $ +;;; $Id: xterm.scm,v 1.48 1995/09/27 16:24:07 cph Exp $ ;;; ;;; Copyright (c) 1989-95 Massachusetts Institute of Technology ;;; @@ -48,18 +48,32 @@ (declare (usual-integrations)) (define-primitives - (x-open-display 1) + (x-change-property 7) (x-close-all-displays 0) (x-close-display 1) (x-close-window 1) + (x-convert-selection 6) + (x-delete-property 3) (x-display-descriptor 1) (x-display-flush 1) (x-display-process-events 2) (x-display-sync 2) + (x-get-atom-name 2) + (x-get-selection-owner 2) + (x-get-window-property 7) + (x-intern-atom 3) + (x-max-request-size 1) + (x-open-display 1) + (x-select-input 3) + (x-send-selection-notify 6) + (x-set-selection-owner 4) + (x-window-andc-event-mask 2) (x-window-beep 1) (x-window-display 1) (x-window-flush 1) + (x-window-id 1) (x-window-map 1) + (x-window-or-event-mask 2) (x-window-raise 1) (x-window-set-event-mask 2) (x-window-set-icon-name 2) @@ -71,8 +85,8 @@ (xterm-enable-cursor 2) (xterm-erase-cursor 1) (xterm-map-x-coordinate 2) - (xterm-map-y-coordinate 2) (xterm-map-x-size 2) + (xterm-map-y-coordinate 2) (xterm-map-y-size 2) (xterm-open-window 3) (xterm-reconfigure 3) @@ -86,7 +100,7 @@ (xterm-write-substring! 7) (xterm-x-size 1) (xterm-y-size 1)) - + ;; These constants must match "microcode/x11base.c" (define-integrable event:process-output -2) (define-integrable event:process-status -3) @@ -106,11 +120,17 @@ (define-integrable event-type:unmap 12) (define-integrable event-type:take-focus 13) (define-integrable event-type:visibility 14) -(define-integrable number-of-event-types 15) +(define-integrable event-type:selection-clear 15) +(define-integrable event-type:selection-notify 16) +(define-integrable event-type:selection-request 17) +(define-integrable event-type:property-notify 18) +(define-integrable number-of-event-types 19) ;; This mask contains button-down, button-up, configure, focus-in, -;; key-press, expose, destroy, map, unmap, and visibility. -(define-integrable event-mask #x5e57) +;; key-press, expose, destroy, map, unmap, visibility, +;; selection-clear, selection-notify, selection-request, and +;; property-notify. +(define-integrable event-mask #x7de57) (define-structure (xterm-screen-state (constructor make-xterm-screen-state (xterm display)) @@ -510,7 +530,7 @@ ((PROCESS-STATUS-CHANGE) event:process-status) ((INTERRUPT) (loop)) (else (read-event-1 display block?)))))))))) - + (define (preview-event-stream) (set! previewer-registration (permanently-register-input-thread-event @@ -520,16 +540,32 @@ (if (not reading-event?) (let ((event (x-display-process-events x-display-data 2))) (if event - (if (and signal-interrupts? - (fix:= event-type:key-press (vector-ref event 0)) - (string-find-next-char (vector-ref event 2) - #\BEL)) - (begin - (clean-event-queue x-display-events) - (signal-interrupt!)) - (enqueue!/unsafe x-display-events event)))))))) + (preview-event event))))))) unspecific) - + +(define (wait-for-event interval predicate process-event) + (let ((timeout (+ (real-time-clock) interval))) + (fluid-let ((reading-event? #t)) + (let loop () + (let ((event (x-display-process-events x-display-data 2))) + (if event + (if (and (vector? event) (predicate event)) + (or (process-event event) (loop)) + (begin (preview-event event) (loop))) + (and (< (real-time-clock) timeout) + (loop)))))))) + +(define (preview-event event) + (cond ((not (vector? event)) + (enqueue!/unsafe x-display-events event)) + ((and signal-interrupts? + (fix:= event-type:key-press (vector-ref event 0)) + (string-find-next-char (vector-ref event 2) #\BEL)) + (clean-event-queue x-display-events) + (signal-interrupt!)) + ((vector-ref event-handlers (vector-ref event 0)) + (enqueue!/unsafe x-display-events event)))) + (define (clean-event-queue queue) ;; Flush keyboard and mouse events from the input queue. Other ;; events are harmless and must be processed regardless. @@ -548,7 +584,7 @@ (cdr events))) ((null? events)) (enqueue!/unsafe queue (car events)))) - + (define (process-change-event event) (cond ((fix:= event event:process-output) (accept-process-output)) ((fix:= event event:process-status) (handle-process-status-changes)) @@ -556,11 +592,13 @@ (else (error "Illegal change event:" event)))) (define (process-special-event event) - (let ((handler (vector-ref event-handlers (vector-ref event 0))) - (screen (xterm->screen (vector-ref event 1)))) + (let ((handler (vector-ref event-handlers (vector-ref event 0)))) (and handler - screen - (handler screen event)))) + (if (vector-ref event 1) + (let ((screen (xterm->screen (vector-ref event 1)))) + (and screen + (handler screen event))) + (handler #f event))))) (define event-handlers (make-vector number-of-event-types false)) @@ -576,12 +614,13 @@ (set! ignore-button-state 'IGNORE-BUTTON-UP) #f) (let ((xterm (screen-xterm screen))) - (make-input-event 'BUTTON - execute-button-command - screen - (make-down-button (vector-ref event 4)) - (xterm-map-x-coordinate xterm (vector-ref event 2)) - (xterm-map-y-coordinate xterm (vector-ref event 3))))))) + (make-input-event + 'BUTTON + execute-button-command + screen + (make-down-button (vector-ref event 4)) + (xterm-map-x-coordinate xterm (vector-ref event 2)) + (xterm-map-y-coordinate xterm (vector-ref event 3))))))) (define-event-handler event-type:button-up (lambda (screen event) @@ -591,12 +630,13 @@ (set! ignore-button-state #f) #f) (let ((xterm (screen-xterm screen))) - (make-input-event 'BUTTON - execute-button-command - screen - (make-up-button (vector-ref event 4)) - (xterm-map-x-coordinate xterm (vector-ref event 2)) - (xterm-map-y-coordinate xterm (vector-ref event 3))))))) + (make-input-event + 'BUTTON + execute-button-command + screen + (make-up-button (vector-ref event 4)) + (xterm-map-x-coordinate xterm (vector-ref event 2)) + (xterm-map-y-coordinate xterm (vector-ref event 3))))))) (define-event-handler event-type:configure (lambda (screen event) @@ -670,6 +710,534 @@ (set! last-focus-time (vector-ref event 2)) (make-input-event 'SELECT-SCREEN select-screen screen))) +;;;; Atoms + +(define built-in-atoms + '#(#F + PRIMARY + SECONDARY + ARC + ATOM + BITMAP + CARDINAL + COLORMAP + CURSOR + CUT_BUFFER0 + CUT_BUFFER1 + CUT_BUFFER2 + CUT_BUFFER3 + CUT_BUFFER4 + CUT_BUFFER5 + CUT_BUFFER6 + CUT_BUFFER7 + DRAWABLE + FONT + INTEGER + PIXMAP + POINT + RECTANGLE + RESOURCE_MANAGER + RGB_COLOR_MAP + RGB_BEST_MAP + RGB_BLUE_MAP + RGB_DEFAULT_MAP + RGB_GRAY_MAP + RGB_GREEN_MAP + RGB_RED_MAP + STRING + VISUALID + WINDOW + WM_COMMAND + WM_HINTS + WM_CLIENT_MACHINE + WM_ICON_NAME + WM_ICON_SIZE + WM_NAME + WM_NORMAL_HINTS + WM_SIZE_HINTS + WM_ZOOM_HINTS + MIN_SPACE + NORM_SPACE + MAX_SPACE + END_SPACE + SUPERSCRIPT_X + SUPERSCRIPT_Y + SUBSCRIPT_X + SUBSCRIPT_Y + UNDERLINE_POSITION + UNDERLINE_THICKNESS + STRIKEOUT_ASCENT + STRIKEOUT_DESCENT + ITALIC_ANGLE + X_HEIGHT + QUAD_WIDTH + WEIGHT + POINT_SIZE + RESOLUTION + COPYRIGHT + NOTICE + FONT_NAME + FAMILY_NAME + FULL_NAME + CAP_HEIGHT + WM_CLASS + WM_TRANSIENT_FOR)) + +(define (intern-atom display name soft?) + (or (hash-table/get built-in-atoms-table name #f) + (let ((table (car (display/cached-atoms-tables display)))) + (or (hash-table/get table name #f) + (let ((atom + (x-intern-atom display + (string-upcase (symbol->string name)) + soft?))) + (if (not (= atom 0)) + (hash-table/put! table name atom)) + atom))))) + +(define (get-atom-name display atom) + (if (< atom (vector-length built-in-atoms)) + (vector-ref built-in-atoms atom) + (let ((table (cdr (display/cached-atoms-tables display)))) + (or (hash-table/get table atom #f) + (let ((symbol + (let ((string (x-get-atom-name display atom))) + (if (not (string? string)) + (error "X error (XGetAtomName):" string atom)) + (intern string)))) + (hash-table/put! table atom symbol) + symbol))))) + +(define built-in-atoms-table + (let ((n (vector-length built-in-atoms))) + (let ((table (make-eq-hash-table n))) + (do ((i 0 (fix:+ i 1))) + ((fix:= i n)) + (hash-table/put! table (vector-ref built-in-atoms i) i)) + table))) + +(define display/cached-atoms-tables + (let ((table (make-eq-hash-table))) + (lambda (display) + (or (hash-table/get table display #f) + (let ((result (cons (make-eq-hash-table) (make-eqv-hash-table)))) + (hash-table/put! table display result) + result))))) + +;;;; Properties + +(define (get-xterm-property xterm property type delete?) + (get-window-property (x-window-display xterm) + (x-window-id xterm) + property + type + delete?)) + +(define (get-window-property display window property type delete?) + (let ((property (intern-atom display property #f)) + (type-atom (intern-atom display type #f))) + (let ((v (x-get-window-property display window property 0 0 #f type-atom))) + (and v + (vector-ref v 3) + (let ((data + (get-window-property-1 display window property delete? + (vector-ref v 0) + (vector-ref v 1) + (vector-ref v 2)))) + (if type + data + (cons (get-atom-name display (vector-ref v 0)) + data))))))) + +(define (get-window-property-1 display window property delete? + type format bytes) + (let ((read-once + (lambda (offset bytes n delete?) + (let ((v + (x-get-window-property display window property + (quotient offset 4) + (integer-ceiling n 4) + delete? type))) + (if (not (and v + (= type (vector-ref v 0)) + (= format (vector-ref v 1)) + (= (- bytes n) (vector-ref v 2)) + (vector-ref v 3) + (= n + (if (= format 8) + (string-length (vector-ref v 3)) + (* (vector-length (vector-ref v 3)) + (quotient format 8)))))) + (error "Window property changed:" v)) + (vector-ref v 3)))) + (qb (* (property-quantum display) 4))) + (if (<= bytes qb) + (read-once 0 bytes bytes delete?) + (let ((b/w (quotient format 8))) + (let ((result + (if (= b/w 1) + (make-string bytes) + (make-vector (quotient bytes b/w)))) + (move! + (if (= b/w 1) + substring-move-right! + subvector-move-right!))) + (let loop ((offset 0) (bytes bytes)) + (if (<= bytes qb) + (move! (read-once offset bytes bytes delete?) + 0 (quotient bytes b/w) + result (quotient offset b/w)) + (begin + (move! (read-once offset bytes qb #f) 0 (quotient qb b/w) + result (quotient offset b/w)) + (loop (+ offset qb) (- bytes qb))))) + result))))) + +(define (put-window-property display window property type format data) + (let ((put-1 + (let ((property (intern-atom display property #f)) + (type (intern-atom display type #f))) + (lambda (mode data) + (let ((status + (x-change-property display window property type format + mode data))) + (cond ((= status x-status:success) + #t) + ((= status x-status:bad-alloc) + (x-delete-property display window property) + #f) + (else + (error "X error (XChangeProperty):" status))))))) + (qw (property-quantum display)) + (i/w (quotient 32 format)) + (subpart (if (= format 8) substring subvector)) + (end (if (= format 8) (string-length data) (vector-length data))) + (mode:replace 0) + (mode:append 2)) + (let loop ((start 0) (nw (integer-ceiling end i/w)) (mode mode:replace)) + (if (<= nw qw) + (put-1 mode (if (= start 0) data (subpart data start end))) + (let ((end (+ start (* qw i/w)))) + (and (put-1 mode (subpart data start end)) + (loop end (- nw qw) mode:append))))))) + +(define-integrable (property-quantum display) + ;; The limit on the size of a property quantum is the maximum + ;; request size less the size of the largest header needed. The + ;; relevant packets are the GetProperty reply packet (header size 8) + ;; and the ChangeProperty request packet (header size 6). The magic + ;; number 8 is the larger of these two header sizes. + (fix:- (x-max-request-size display) 8)) + +(define (delete-xterm-property xterm property) + (delete-window-property (x-window-display xterm) + (x-window-id xterm) + property)) + +(define (delete-window-property display window property) + (x-delete-property display window (intern-atom display property #f))) + +(define-integrable x-status:success 0) +(define-integrable x-status:bad-request 1) +(define-integrable x-status:bad-value 2) +(define-integrable x-status:bad-window 3) +(define-integrable x-status:bad-pixmap 4) +(define-integrable x-status:bad-atom 5) +(define-integrable x-status:bad-cursor 6) +(define-integrable x-status:bad-font 7) +(define-integrable x-status:bad-match 8) +(define-integrable x-status:bad-drawable 9) +(define-integrable x-status:bad-access 10) +(define-integrable x-status:bad-alloc 11) +(define-integrable x-status:bad-color 12) +(define-integrable x-status:bad-gc 13) +(define-integrable x-status:bad-id-choice 14) +(define-integrable x-status:bad-name 15) +(define-integrable x-status:bad-length 16) +(define-integrable x-status:bad-implementation 17) + +;;;; Selection Source + +(define (os/interprogram-cut string push?) + push? + (if (eq? x-display-type (current-display-type)) + (let ((xterm (screen-xterm (selected-screen)))) + (own-selection (x-window-display xterm) + 'PRIMARY + (x-window-id xterm) + last-focus-time + string)))) + +(define (own-selection display selection window time value) + (and (eqv? window + (let ((selection (intern-atom display selection #f))) + (x-set-selection-owner display selection window time) + (x-get-selection-owner display selection))) + (begin + (hash-table/put! (display/selection-records display) + selection + (make-selection-record window time value)) + #t))) + +(define display/selection-records + (let ((table (make-eq-hash-table))) + (lambda (display) + (or (hash-table/get table display #f) + (let ((result (make-eq-hash-table))) + (hash-table/put! table display result) + result))))) + +(define (display/selection-record display name time) + (let ((record (hash-table/get (display/selection-records display) name #f))) + (and record + (<= (selection-record/time record) time) + record))) + +(define (display/delete-selection-record! display name time) + (let ((records (display/selection-records display))) + (if (let ((record (hash-table/get records name #f))) + (and record + (<= (selection-record/time record) time))) + (hash-table/remove! records name)))) + +(define-structure (selection-record (conc-name selection-record/)) + (window #f read-only #t) + (time #f read-only #t) + (value #f read-only #t)) + +(define-event-handler event-type:selection-request + (lambda (screen event) + screen + (let ((display x-display-data)) + (let ((requestor (selection-request/requestor event)) + (selection + (get-atom-name display (selection-request/selection event))) + (target + (get-atom-name display (selection-request/target event))) + (property + (get-atom-name display (selection-request/property event))) + (time (selection-request/time event))) + (let ((reply + (lambda (property) + (x-send-selection-notify display + requestor + (selection-request/selection event) + (selection-request/target event) + (intern-atom display property #f) + time) + (x-display-flush display)))) + (if (let ((record (display/selection-record display selection time))) + (and record + property + (process-selection-request display requestor property + target time record #f))) + (reply property) + (reply #f))))) + #f)) + +(define-structure (selection-request (type vector) + (initial-offset 2) + (conc-name selection-request/)) + (requestor #f read-only #t) + (selection #f read-only #t) + (target #f read-only #t) + (property #f read-only #t) + (time #f read-only #t)) + +(define-event-handler event-type:selection-clear + (lambda (screen event) + screen + (let ((display x-display-data)) + (display/delete-selection-record! + display + (get-atom-name display (selection-clear/selection event)) + (selection-clear/time event))) + #f)) + +(define-structure (selection-clear (type vector) + (initial-offset 2) + (conc-name selection-clear/)) + (selection #f read-only #t) + (time #f read-only #t)) + +(define (process-selection-request display requestor property target time + record multiple?) + (let ((win + (lambda (format data) + (and (put-window-property display requestor property target format + data) + target)))) + (case target + ((STRING) + (win 8 (selection-record/value record))) + ((TARGETS) + (win 32 (atoms->property-data '(STRING TIMESTAMP) display))) + ((TIMESTAMP) + (win 32 (timestamp->property-data (selection-record/time record)))) + ((MULTIPLE) + (and multiple? + (let ((alist + (property-data->atom-alist + (or (get-window-property display requestor property + 'MULTIPLE #f) + (error "Missing MULTIPLE property:" property)) + display))) + (for-each (lambda (entry) + (set-car! entry + (process-selection-request display + requestor + (cdr entry) + (car entry) + time + record + #t))) + alist) + (win 32 (atom-alist->property-data alist display))))) + (else #f)))) + +(define (atoms->property-data names display) + (list->vector (map (lambda (name) (intern-atom display name #f)) names))) + +(define (timestamp->property-data time) + (vector time)) + +(define (property-data->atom-alist data display) + (if (not (even? (vector-length data))) + (error:bad-range-argument data 'PROPERTY-DATA->ATOM-ALIST)) + (let loop ((atoms + (map (lambda (atom) (get-atom-name display atom)) + (vector->list data)))) + (if (null? atoms) + '() + (cons (cons (car atoms) (cadr atoms)) + (loop (cddr atoms)))))) + +(define (atom-alist->property-data alist display) + (atoms->property-data (let loop ((alist alist)) + (if (null? alist) + '() + (cons (caar alist) + (cons (cdar alist) + (loop (cdr alist)))))) + display)) + +;;;; Selection Sink + +(define (os/interprogram-paste) + (and (eq? x-display-type (current-display-type)) + (xterm/interprogram-paste (screen-xterm (selected-screen))))) + +(define (xterm/interprogram-paste xterm) + (with-thread-events-blocked + (lambda () + (let ((selection 'PRIMARY) + (property '_EDWIN_TMP_) + (time last-focus-time)) + (cond ((display/selection-record (x-window-display xterm) + selection time) + => selection-record/value) + ((request-selection xterm selection 'STRING property time) + (receive-selection xterm property 'STRING time)) + ((request-selection xterm selection 'C_STRING property time) + (receive-selection xterm property 'C_STRING time)) + (else #f)))))) + +(define (with-thread-events-blocked thunk) + (let ((block-events?)) + (dynamic-wind (lambda () + (set! block-events? (block-thread-events)) + unspecific) + thunk + (lambda () + (if (not block-events?) (unblock-thread-events)))))) + +(define (request-selection xterm selection target property time) + (let ((display (x-window-display xterm)) + (window (x-window-id xterm))) + (let ((selection (intern-atom display selection #f)) + (target (intern-atom display target #f)) + (property (intern-atom display property #f))) + (x-delete-property display window property) + (x-convert-selection display selection target property window time) + (x-display-flush display) + (eq? 'REQUEST-GRANTED + (wait-for-event x-selection-timeout + (lambda (event) + (fix:= event-type:selection-notify (vector-ref event 0))) + (lambda (event) + (and (= window (selection-notify/requestor event)) + (= selection (selection-notify/selection event)) + (= target (selection-notify/target event)) + (= time (selection-notify/time event)) + (if (= property (selection-notify/property event)) + 'REQUEST-GRANTED + 'REQUEST-DENIED)))))))) + +(define-structure (selection-notify (type vector) + (initial-offset 2) + (conc-name selection-notify/)) + (requestor #f read-only #t) + (selection #f read-only #t) + (target #f read-only #t) + (property #f read-only #t) + (time #f read-only #t)) + +(define (receive-selection xterm property target time) + (let ((value (get-xterm-property xterm property #f #t))) + (if (not value) + (error "Missing selection value.")) + (if (eq? 'INCR (car value)) + (receive-incremental-selection xterm property target time) + (and (eq? target (car value)) + (cdr value))))) + +(define (receive-incremental-selection xterm property target time) + ;; I have been unable to get this to work, after a day of hacking, + ;; and I don't have any idea why it won't work. Given that this + ;; will only be used for selections of size exceeding ~230kb, I'm + ;; going to leave it broken. -- cph + (x-window-flush xterm) + (let loop ((time time) (accum '())) + (let ((time + (wait-for-window-property-change xterm property time + x-property-state:new-value))) + (if (not time) + (error "Timeout waiting for PROPERTY-NOTIFY event.")) + (let ((value (get-xterm-property xterm property target #t))) + (if (not value) + (error "Missing property after PROPERTY-NOTIFY event.")) + (if (string-null? value) + (apply string-append (reverse! accum)) + (loop time (cons value accum))))))) + +(define (wait-for-window-property-change xterm property time state) + (wait-for-event x-selection-timeout + (lambda (event) + (fix:= event-type:property-notify (vector-ref event 0))) + (let ((property (intern-atom (x-window-display xterm) property #f)) + (window (x-window-id xterm))) + (lambda (event) + (and (= window (property-notify/window event)) + (= property (property-notify/property event)) + (< time (property-notify/time event)) + (= state (property-notify/state event)) + (property-notify/time event)))))) + +(define-structure (property-notify (type vector) + (initial-offset 2) + (conc-name property-notify/)) + (window #f read-only #t) + (property #f read-only #t) + (time #f read-only #t) + (state #f read-only #t)) + +(define-integrable x-property-state:new-value 0) +(define-integrable x-property-state:delete 1) + +(define x-selection-timeout 5000) + +;;;; Initialization + (define reading-event?) (define signal-interrupts?) (define last-focus-time)