basis/ui/backend/gtk/gtk.factor

   1 ! Copyright (C) 2010 Anton Gorenko, Philipp Brüschweiler.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors alien.accessors alien.c-types alien.data
   4 alien.strings arrays assocs classes.struct command-line
   5 destructors gdk.ffi gdk.gl.ffi glib.ffi gobject.ffi gtk.ffi
   6 gtk.gl.ffi io.backend io.backend.unix.multiplexers
   7 io.encodings.utf8 io.thread kernel libc literals locals math
   8 math.bitwise math.order math.vectors namespaces sequences
   9 strings system threads ui ui.backend ui.clipboards ui.commands
  10 ui.event-loop ui.gadgets ui.gadgets.editors ui.gadgets.menus
  11 ui.gadgets.private ui.gadgets.worlds ui.gestures
  12 ui.pixel-formats ui.pixel-formats.private ui.private ;
  13 IN: ui.backend.gtk
  14
  15 SINGLETON: gtk-ui-backend
  16
  17 TUPLE: handle ;
  18 TUPLE: window-handle < handle window fullscreen? im-context im-menu ;
  19
  20 : <window-handle> ( window im-context -- window-handle )
  21     window-handle new
  22         swap >>im-context
  23         swap >>window ;
  24
  25 TUPLE: gtk-clipboard handle ;
  26
  27 C: <gtk-clipboard> gtk-clipboard
  28
  29 PIXEL-FORMAT-ATTRIBUTE-TABLE: gl-config-attribs ${ GDK_GL_USE_GL GDK_GL_RGBA } H{
  30     { double-buffered ${ GDK_GL_DOUBLEBUFFER } }
  31     { stereo ${ GDK_GL_STEREO } }
  32     ! { offscreen ${ GDK_GL_DRAWABLE_TYPE 2 } }
  33     ! { fullscreen ${ GDK_GL_DRAWABLE_TYPE 1 } }
  34     ! { windowed ${ GDK_GL_DRAWABLE_TYPE 1 } }
  35     { color-bits ${ GDK_GL_BUFFER_SIZE } }
  36     { red-bits ${ GDK_GL_RED_SIZE } }
  37     { green-bits ${ GDK_GL_GREEN_SIZE } }
  38     { blue-bits ${ GDK_GL_BLUE_SIZE } }
  39     { alpha-bits ${ GDK_GL_ALPHA_SIZE } }
  40     { accum-red-bits ${ GDK_GL_ACCUM_RED_SIZE } }
  41     { accum-green-bits ${ GDK_GL_ACCUM_GREEN_SIZE } }
  42     { accum-blue-bits ${ GDK_GL_ACCUM_BLUE_SIZE } }
  43     { accum-alpha-bits ${ GDK_GL_ACCUM_ALPHA_SIZE } }
  44     { depth-bits ${ GDK_GL_DEPTH_SIZE } }
  45     { stencil-bits ${ GDK_GL_STENCIL_SIZE } }
  46     { aux-buffers ${ GDK_GL_AUX_BUFFERS } }
  47     { sample-buffers ${ GDK_GL_SAMPLE_BUFFERS } }
  48     { samples ${ GDK_GL_SAMPLES } }
  49 }
  50
  51 M: gtk-ui-backend (make-pixel-format)
  52     nip >gl-config-attribs-int-array gdk_gl_config_new ;
  53
  54 M: gtk-ui-backend (free-pixel-format)
  55     handle>> g_object_unref ;
  56
  57 M: gtk-ui-backend (pixel-format-attribute)
  58     [ handle>> ] [ >gl-config-attribs ] bi*
  59     { int } [ gdk_gl_config_get_attrib drop ]
  60     with-out-parameters ;
  61
  62 CONSTANT: events-mask
  63     flags{
  64         GDK_POINTER_MOTION_MASK
  65         GDK_POINTER_MOTION_HINT_MASK
  66         GDK_ENTER_NOTIFY_MASK
  67         GDK_LEAVE_NOTIFY_MASK
  68         GDK_BUTTON_PRESS_MASK
  69         GDK_BUTTON_RELEASE_MASK
  70         GDK_KEY_PRESS_MASK
  71         GDK_KEY_RELEASE_MASK
  72         GDK_FOCUS_CHANGE_MASK
  73     }
  74
  75 CONSTANT: modifiers
  76     {
  77         { S+ $ GDK_SHIFT_MASK }
  78         { C+ $ GDK_CONTROL_MASK }
  79         { A+ $ GDK_MOD1_MASK }
  80     }
  81
  82 CONSTANT: action-key-codes
  83     H{
  84         { $ GDK_BackSpace "BACKSPACE" }
  85         { $ GDK_Tab "TAB" }
  86         { $ GDK_Return "RET" }
  87         { $ GDK_KP_Enter "ENTER" }
  88         { $ GDK_Escape "ESC" }
  89         { $ GDK_Delete "DELETE" }
  90         { $ GDK_Home "HOME" }
  91         { $ GDK_Left "LEFT" }
  92         { $ GDK_Up "UP" }
  93         { $ GDK_Right "RIGHT" }
  94         { $ GDK_Down "DOWN" }
  95         { $ GDK_Page_Up "PAGE_UP" }
  96         { $ GDK_Page_Down "PAGE_DOWN" }
  97         { $ GDK_End "END" }
  98         { $ GDK_Begin "BEGIN" }
  99         { $ GDK_F1 "F1" }
 100         { $ GDK_F2 "F2" }
 101         { $ GDK_F3 "F3" }
 102         { $ GDK_F4 "F4" }
 103         { $ GDK_F5 "F5" }
 104         { $ GDK_F6 "F6" }
 105         { $ GDK_F7 "F7" }
 106         { $ GDK_F8 "F8" }
 107         { $ GDK_F9 "F9" }
 108         { $ GDK_F10 "F10" }
 109         { $ GDK_F11 "F11" }
 110         { $ GDK_F12 "F12" }
 111     }
 112
 113 : event-modifiers ( event -- seq )
 114     state>> modifiers modifier ;
 115
 116 : event-loc ( event -- loc )
 117     [ x>> ] [ y>> ] bi [ >fixnum ] bi@ 2array ;
 118
 119 : event-dim ( event -- dim )
 120     [ width>> ] [ height>> ] bi 2array ;
 121
 122 : scroll-direction ( event -- pair )
 123     direction>> {
 124         { $ GDK_SCROLL_UP { 0 -1 } }
 125         { $ GDK_SCROLL_DOWN { 0 1 } }
 126         { $ GDK_SCROLL_LEFT { -1 0 } }
 127         { $ GDK_SCROLL_RIGHT { 1 0 } }
 128     } at ;
 129
 130 : mouse-event>gesture ( event -- modifiers button loc )
 131     [ event-modifiers ] [ button>> ] [ event-loc ] tri ;
 132
 133 : on-motion ( sender event user-data -- result )
 134     drop swap
 135     [ GdkEventMotion memory>struct event-loc ] dip window
 136     move-hand fire-motion t ;
 137
 138 : on-enter ( sender event user-data -- result )
 139     on-motion ;
 140
 141 : on-leave ( sender event user-data -- result )
 142     3drop forget-rollover t ;
 143
 144 : on-button-press ( sender event user-data -- result )
 145     drop swap [
 146         GdkEventButton memory>struct
 147         mouse-event>gesture [ <button-down> ] dip
 148     ] dip window send-button-down t ;
 149
 150 : on-button-release ( sender event user-data -- result )
 151     drop swap [
 152         GdkEventButton memory>struct
 153         mouse-event>gesture [ <button-up> ] dip
 154     ] dip window send-button-up t ;
 155
 156 : on-scroll ( sender event user-data -- result )
 157     drop swap [
 158         GdkEventScroll memory>struct
 159         [ scroll-direction ] [ event-loc ] bi
 160     ] dip window send-scroll t ;
 161
 162 : key-sym ( event -- sym/f action? )
 163     keyval>> dup action-key-codes at [ t ]
 164     [ gdk_keyval_to_unicode [ f ] [ 1string ] if-zero f ] ?if ;
 165
 166 : key-event>gesture ( event -- mods sym/f action? )
 167     GdkEventKey memory>struct
 168     [ event-modifiers ] [ key-sym ] bi ;
 169
 170 : on-key-press ( sender event user-data -- result )
 171     drop swap [ key-event>gesture <key-down> ] [ window ] bi*
 172     propagate-key-gesture t ;
 173
 174 : on-key-release ( sender event user-data -- result )
 175     drop swap [ key-event>gesture <key-up> ] [ window ] bi*
 176     propagate-key-gesture t ;
 177
 178 : on-focus-in ( sender event user-data -- result )
 179     2drop window focus-world t ;
 180
 181 : on-focus-out ( sender event user-data -- result )
 182     2drop window unfocus-world t ;
 183
 184 : on-expose ( sender event user-data -- result )
 185     2drop window relayout t ;
 186
 187 : on-configure ( sender event user-data -- result )
 188     drop [ window ] dip GdkEventConfigure memory>struct
 189     [ event-loc >>window-loc ] [ event-dim >>dim  ] bi
 190     relayout-1 f ;
 191
 192 : on-delete ( sender event user-data -- result )
 193     2drop window ungraft t ;
 194
 195 : init-clipboard ( -- )
 196     selection "PRIMARY"
 197     clipboard "CLIPBOARD"
 198     [
 199         utf8 string>alien gdk_atom_intern_static_string
 200         gtk_clipboard_get <gtk-clipboard> swap set-global
 201     ] 2bi@ ;
 202
 203 : io-source-prepare ( source timeout -- result )
 204     2drop f ;
 205
 206 : io-source-check ( source -- result )
 207     poll_fds>> 0 g_slist_nth_data GPollFD memory>struct
 208     revents>> 0 = not ;
 209
 210 : io-source-dispatch ( source callback user_data -- result )
 211      3drop
 212      0 mx get wait-for-events
 213      yield t ;
 214
 215 CONSTANT: poll-fd-events
 216     flags{
 217         G_IO_IN
 218         G_IO_OUT
 219         G_IO_PRI
 220         G_IO_ERR
 221         G_IO_HUP
 222         G_IO_NVAL
 223     }
 224
 225 : create-poll-fd ( -- poll-fd )
 226     GPollFD malloc-struct &free
 227         mx get fd>> >>fd
 228         poll-fd-events >>events ;
 229
 230 HOOK: init-io-event-source io-backend ( -- )
 231
 232 M: c-io-backend init-io-event-source
 233     ;
 234
 235 M: object init-io-event-source
 236     GSourceFuncs malloc-struct &free
 237         [ io-source-prepare ] GSourceFuncsPrepareFunc >>prepare
 238         [ io-source-check ] GSourceFuncsCheckFunc >>check
 239         [ io-source-dispatch ] GSourceFuncsDispatchFunc >>dispatch
 240     GSource heap-size g_source_new &g_source_unref
 241     [ create-poll-fd g_source_add_poll ]
 242     [ f g_source_attach drop ] bi ;
 243
 244 SYMBOL: next-timeout
 245
 246 : set-timeout*-value ( alien value -- )
 247     swap 0 set-alien-signed-4 ; inline
 248
 249 : timeout-prepare ( source timeout* -- result )
 250     nip next-timeout get-global nano-count [-]
 251     [ 1,000,000 /i set-timeout*-value ] keep 0 = ;
 252
 253 : timeout-check ( source -- result )
 254     drop next-timeout get-global nano-count [-] 0 = ;
 255
 256 : timeout-dispatch ( source callback user_data -- result )
 257     3drop sleep-time [ 1,000,000,000 ] unless* nano-count +
 258     next-timeout set-global
 259     yield t ;
 260
 261 : init-timeout ( -- )
 262     GSourceFuncs malloc-struct &free
 263         [ timeout-prepare ] GSourceFuncsPrepareFunc >>prepare
 264         [ timeout-check ] GSourceFuncsCheckFunc >>check
 265         [ timeout-dispatch ] GSourceFuncsDispatchFunc >>dispatch
 266     GSource heap-size g_source_new &g_source_unref
 267     f g_source_attach drop
 268     nano-count next-timeout set-global ;
 269
 270 M: gtk-ui-backend (with-ui)
 271     [
 272         f f gtk_init
 273         f f gtk_gl_init
 274         init-clipboard
 275         start-ui
 276         stop-io-thread
 277         [
 278             init-io-event-source
 279             init-timeout
 280             gtk_main
 281         ] with-destructors
 282     ] ui-running ;
 283
 284 : connect-signal-with-data ( object signal-name callback data -- )
 285     [ utf8 string>alien ] 2dip g_signal_connect drop ;
 286
 287 : connect-signal ( object signal-name callback -- )
 288     f connect-signal-with-data ;
 289
 290 :: connect-signals ( win -- )
 291     win events-mask gtk_widget_add_events
 292
 293     win "expose-event" [ on-expose yield ]
 294     GtkWidget:expose-event connect-signal
 295     win "configure-event" [ on-configure yield ]
 296     GtkWidget:configure-event connect-signal
 297     win "motion-notify-event" [ on-motion yield ]
 298     GtkWidget:motion-notify-event connect-signal
 299     win "leave-notify-event" [ on-leave yield ]
 300     GtkWidget:leave-notify-event connect-signal
 301     win "enter-notify-event" [ on-enter yield ]
 302     GtkWidget:enter-notify-event connect-signal
 303     win "button-press-event" [ on-button-press yield ]
 304     GtkWidget:button-press-event connect-signal
 305     win "button-release-event" [ on-button-release yield ]
 306     GtkWidget:button-release-event connect-signal
 307     win "scroll-event" [ on-scroll yield ]
 308     GtkWidget:scroll-event connect-signal
 309     win "key-press-event" [ on-key-press yield ]
 310     GtkWidget:key-press-event connect-signal
 311     win "key-release-event" [ on-key-release yield ]
 312     GtkWidget:key-release-event connect-signal
 313     win "focus-in-event" [ on-focus-in yield ]
 314     GtkWidget:focus-in-event connect-signal
 315     win "focus-out-event" [ on-focus-out yield ]
 316     GtkWidget:focus-out-event connect-signal
 317     win "delete-event" [ on-delete yield ]
 318     GtkWidget:delete-event connect-signal ;
 319
 320 ! ----------------------
 321
 322 GENERIC: support-input-methods? ( gadget -- ? )
 323 GENERIC: get-cursor-surrounding ( gadget -- text cursor-pos )
 324 GENERIC: delete-cursor-surrounding ( offset count gadget -- )
 325 GENERIC: set-preedit-string ( str cursor-pos gadget -- )
 326 GENERIC: get-cursor-loc&dim ( gadget -- loc dim )
 327
 328 M: gadget support-input-methods? drop f ;
 329
 330 M: editor support-input-methods? drop t ;
 331
 332 M: editor get-cursor-surrounding
 333     dup editor-caret first2 [ swap editor-line ] dip ;
 334
 335 M: editor delete-cursor-surrounding
 336     3drop ;
 337
 338 M: editor set-preedit-string
 339     nip dup [ editor-caret ] keep
 340     [ user-input* drop ] 2dip
 341     set-caret ;
 342
 343 M: editor get-cursor-loc&dim
 344     [ caret-loc ] [ caret-dim ] bi ;
 345
 346 ! ----------------------
 347
 348 : on-retrieve-surrounding ( im-context win -- ? )
 349     window world-focus dup support-input-methods? [
 350         get-cursor-surrounding [ utf8 string>alien -1 ] dip
 351         gtk_im_context_set_surrounding t
 352     ] [ 2drop f ] if ;
 353
 354 : on-delete-surrounding ( im-context offset n win -- ? )
 355     window world-focus dup support-input-methods?
 356     [ delete-cursor-surrounding t ] [ 3drop f ] if nip ;
 357
 358 : get-preedit-string ( im-context -- str cursor-pos )
 359     { void* int } [ f swap gtk_im_context_get_preedit_string ]
 360     with-out-parameters
 361     [ [ utf8 alien>string ] [ g_free ] bi ] dip ;
 362
 363 : on-preedit-changed ( im-context user-data -- )
 364     window world-focus dup support-input-methods? [
 365         [ get-preedit-string ] dip set-preedit-string
 366     ] [ 2drop ] if ;
 367
 368 : on-commit ( sender str user_data -- )
 369     [ drop ] [ utf8 alien>string ] [ window ] tri* user-input ;
 370
 371 : gadget-location ( gadget -- loc )
 372     [ loc>> ] [ parent>> [ gadget-location v+ ] when* ] bi ;
 373
 374 : gadget-cursor-location ( gadget -- rectangle )
 375     [ gadget-location ] [ get-cursor-loc&dim ] bi [ v+ ] dip
 376     [ first2 ] bi@ GdkRectangle <struct-boa> ;
 377
 378 : update-cursor-location ( im-context gadget -- )
 379     gadget-cursor-location gtk_im_context_set_cursor_location ;
 380
 381 ! has to be called before the window signal handler
 382 :: im-on-key-event ( sender event im-context -- result )
 383     sender window world-focus :> gadget
 384     gadget support-input-methods? [
 385         im-context gadget update-cursor-location
 386         im-context event gtk_im_context_filter_keypress
 387     ] [ im-context gtk_im_context_reset f ] if ;
 388
 389 : im-on-focus-in ( sender event user-data -- result )
 390     2drop window handle>> im-context>>
 391     [ gtk_im_context_focus_in ] [ gtk_im_context_reset ] bi f ;
 392
 393 : im-on-focus-out ( sender event user-data -- result )
 394     2drop window handle>> im-context>>
 395     [ gtk_im_context_focus_out ] [ gtk_im_context_reset ] bi f ;
 396
 397 : im-on-destroy ( sender user-data -- )
 398     nip [ f gtk_im_context_set_client_window ]
 399     [ g_object_unref ] bi ;
 400
 401 ! for testing only
 402
 403 : com-input-method ( world -- )
 404     find-world handle>> im-menu>> f f f f 0
 405     gtk_get_current_event_time gtk_menu_popup ;
 406
 407 : im-menu ( world -- )
 408     { com-input-method } show-commands-menu ;
 409
 410 editor "input-method" f  {
 411     { T{ button-down f { S+ C+ } 3 } im-menu }
 412 } define-command-map
 413
 414 ! --------
 415
 416 :: configure-im ( win im -- )
 417     im win gtk_widget_get_window gtk_im_context_set_client_window
 418     im f gtk_im_context_set_use_preedit
 419
 420     gtk_menu_new :> menu
 421     im menu gtk_im_multicontext_append_menuitems
 422     menu win window handle>> im-menu<<
 423
 424     im "commit" [ on-commit yield ]
 425     GtkIMContext:commit win connect-signal-with-data
 426     im "retrieve-surrounding" [ on-retrieve-surrounding yield ]
 427     GtkIMContext:retrieve-surrounding win connect-signal-with-data
 428     im "delete-surrounding" [ on-delete-surrounding yield ]
 429     GtkIMContext:delete-surrounding win connect-signal-with-data
 430     im "preedit-changed" [ on-preedit-changed yield ]
 431     GtkIMContext:preedit-changed win connect-signal-with-data
 432
 433     win "key-press-event" [ im-on-key-event yield ]
 434     GtkWidget:key-press-event im connect-signal-with-data
 435     win "key-release-event" [ im-on-key-event yield ]
 436     GtkWidget:key-release-event im connect-signal-with-data
 437     win "focus-in-event" [ im-on-focus-in yield ]
 438     GtkWidget:focus-out-event im connect-signal-with-data
 439     win "focus-out-event" [ im-on-focus-out yield ]
 440     GtkWidget:focus-out-event im connect-signal-with-data
 441     win "destroy" [ im-on-destroy yield ]
 442     GtkObject:destroy im connect-signal-with-data ;
 443
 444 CONSTANT: window-controls>decor-flags
 445     H{
 446         { close-button 0 }
 447         { minimize-button $ GDK_DECOR_MINIMIZE }
 448         { maximize-button $ GDK_DECOR_MAXIMIZE }
 449         { resize-handles $ GDK_DECOR_RESIZEH }
 450         { small-title-bar $ GDK_DECOR_TITLE }
 451         { normal-title-bar $ GDK_DECOR_TITLE }
 452         { textured-background 0 }
 453     }
 454
 455 CONSTANT: window-controls>func-flags
 456     H{
 457         { close-button $ GDK_FUNC_CLOSE }
 458         { minimize-button $ GDK_FUNC_MINIMIZE }
 459         { maximize-button $ GDK_FUNC_MAXIMIZE }
 460         { resize-handles $ GDK_FUNC_RESIZE }
 461         { small-title-bar 0 }
 462         { normal-title-bar 0 }
 463         { textured-background 0 }
 464     }
 465
 466 : configure-window-controls ( win controls -- )
 467     [
 468         small-title-bar swap member-eq?
 469         GDK_WINDOW_TYPE_HINT_UTILITY GDK_WINDOW_TYPE_HINT_NORMAL ?
 470         gtk_window_set_type_hint
 471     ] [
 472         [ gtk_widget_get_window ] dip
 473         window-controls>decor-flags symbols>flags
 474         GDK_DECOR_BORDER bitor gdk_window_set_decorations
 475     ] [
 476         [ gtk_widget_get_window ] dip
 477         window-controls>func-flags symbols>flags
 478         GDK_FUNC_MOVE bitor gdk_window_set_functions
 479     ] 2tri ;
 480
 481 : setup-gl ( world -- ? )
 482     [
 483         [ handle>> window>> ] [ handle>> ] bi*
 484         f t GDK_GL_RGBA_TYPE gtk_widget_set_gl_capability
 485     ] with-world-pixel-format ;
 486
 487 : auto-position ( win loc -- )
 488     dup { 0 0 } = [
 489         drop dup window topmost-window =
 490         GTK_WIN_POS_CENTER GTK_WIN_POS_NONE ?
 491         gtk_window_set_position
 492     ] [ first2 gtk_window_move ] if ;
 493
 494 M:: gtk-ui-backend (open-window) ( world -- )
 495     GTK_WINDOW_TOPLEVEL gtk_window_new :> win
 496     gtk_im_multicontext_new :> im
 497
 498     win im <window-handle> world handle<<
 499
 500     world win register-window
 501
 502     win world [ window-loc>> auto-position ]
 503     [ dim>> first2 gtk_window_set_default_size ] 2bi
 504
 505     world setup-gl drop
 506
 507     win gtk_widget_realize
 508     win world window-controls>> configure-window-controls
 509
 510     win im configure-im
 511     win connect-signals
 512
 513     win gtk_widget_show_all ;
 514
 515 M: gtk-ui-backend (close-window) ( handle -- )
 516     window>> [ gtk_widget_destroy ] [ unregister-window ] bi
 517     event-loop? [ gtk_main_quit ] unless ;
 518
 519 M: gtk-ui-backend set-title
 520     swap [ handle>> window>> ] [ utf8 string>alien ] bi*
 521     gtk_window_set_title ;
 522
 523 M: gtk-ui-backend (set-fullscreen)
 524     [ handle>> ] dip [ >>fullscreen? ] keep
 525     [ window>> ] dip
 526     [ gtk_window_fullscreen ]
 527     [ gtk_window_unfullscreen ] if ;
 528
 529 M: gtk-ui-backend (fullscreen?)
 530     handle>> fullscreen?>> ;
 531
 532 M: gtk-ui-backend raise-window*
 533     handle>> window>> gtk_window_present ;
 534
 535 : set-cursor ( win cursor -- )
 536     [
 537         [ gtk_widget_get_window ] dip
 538         gdk_cursor_new &gdk_cursor_unref
 539         gdk_window_set_cursor
 540     ] with-destructors ;
 541
 542 M: gtk-ui-backend (grab-input)
 543     window>>
 544     [ gtk_grab_add ] [ GDK_BLANK_CURSOR set-cursor ] bi ;
 545
 546 M: gtk-ui-backend (ungrab-input)
 547     window>>
 548     [ gtk_grab_remove ] [ GDK_LEFT_PTR set-cursor ] bi ;
 549
 550 M: window-handle select-gl-context ( handle -- )
 551     window>>
 552     [ gtk_widget_get_gl_window ] [ gtk_widget_get_gl_context ] bi
 553     gdk_gl_drawable_make_current drop ;
 554
 555 M: window-handle flush-gl-context ( handle -- )
 556     window>> gtk_widget_get_gl_window
 557     gdk_gl_drawable_swap_buffers ;
 558
 559 M: gtk-ui-backend beep
 560     gdk_beep ;
 561
 562 M:: gtk-ui-backend system-alert ( caption text -- )
 563     f GTK_DIALOG_MODAL GTK_MESSAGE_WARNING GTK_BUTTONS_OK
 564     caption utf8 string>alien f gtk_message_dialog_new
 565     [ text utf8 string>alien f gtk_message_dialog_format_secondary_text ]
 566     [ gtk_dialog_run drop ]
 567     [ gtk_widget_destroy ] tri ;
 568
 569 M: gtk-clipboard clipboard-contents
 570     [
 571         handle>> gtk_clipboard_wait_for_text
 572         [ &g_free utf8 alien>string ] [ f ] if*
 573     ] with-destructors ;
 574
 575 M: gtk-clipboard set-clipboard-contents
 576     swap [ handle>> ] [ utf8 string>alien ] bi*
 577     -1 gtk_clipboard_set_text ;
 578
 579 gtk-ui-backend ui-backend set-global
 580
 581 [ "ui.tools" ] main-vocab-hook set-global