chiark - git - mdw - clg/blob - gtk/gtk.lisp

   1 ;; Common Lisp bindings for GTK+ v2.0
   2 ;; Copyright (C) 1999-2001 Espen S. Johnsen <esj@stud.cs.uit.no>
   3 ;;
   4 ;; This library is free software; you can redistribute it and/or
   5 ;; modify it under the terms of the GNU Lesser General Public
   6 ;; License as published by the Free Software Foundation; either
   7 ;; version 2 of the License, or (at your option) any later version.
   8 ;;
   9 ;; This library is distributed in the hope that it will be useful,
  10 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  11 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  12 ;; Lesser General Public License for more details.
  13 ;;
  14 ;; You should have received a copy of the GNU Lesser General Public
  15 ;; License along with this library; if not, write to the Free Software
  16 ;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  17
  18 ;; $Id: gtk.lisp,v 1.5 2001-05-31 21:52:57 espen Exp $
  19
  20
  21 (in-package "GTK")
  22
  23 ;;; Gtk version
  24
  25 (defbinding check-version () string
  26   (required-major unsigned-int)
  27   (required-minor unsigned-int)
  28   (required-micro unsigned-int))
  29
  30 (defbinding query-version () nil
  31   (major unsigned-int :out)
  32   (minor unsigned-int :out)
  33   (micro unsigned-int :out))
  34
  35 (defun gtk-version ()
  36   (multiple-value-bind (major minor micro)
  37       (query-version)
  38     (if (zerop micro)
  39         (format nil "Gtk+ v~A.~A" major minor)
  40       (format nil "Gtk+ v~A.~A.~A" major minor micro))))
  41
  42
  43
  44 ;;; Label
  45
  46 (defbinding label-select-region () nil
  47   (label label)
  48   (start int)
  49   (end int))
  50
  51
  52
  53 ;;; Acccel label
  54
  55 (defbinding accel-label-refetch () boolean
  56   (accel-label accel-label))
  57
  58
  59
  60 ;;; Bin
  61
  62 (defun bin-child (bin)
  63   (first (container-children bin)))
  64
  65 (defun (setf bin-child) (child bin)
  66   (let ((old-child (bin-child bin)))
  67     (when old-child
  68       (container-remove bin old-child)))
  69   (container-add bin child)
  70   child)
  71
  72 (defmethod initialize-instance ((bin bin) &rest initargs &key child)
  73   (declare (ignore initargs))
  74   (call-next-method)
  75   (cond
  76    ((consp child)
  77     (container-add bin (first child))
  78     (setf
  79      (slot-value (first child) 'child-slots)
  80      (apply
  81       #'make-instance
  82       (slot-value (class-of bin) 'child-class)
  83       :parent bin :child (first child) (cdr child))))
  84    (child
  85     (container-add bin child))))
  86
  87
  88 ;;; Button
  89
  90 (defbinding button-pressed () nil
  91   (button button))
  92
  93 (defbinding button-released () nil
  94   (button button))
  95
  96 (defbinding button-clicked () nil
  97   (button button))
  98
  99 (defbinding button-enter () nil
 100   (button button))
 101
 102 (defbinding button-leave () nil
 103   (button button))
 104
 105
 106
 107 ;;; Toggle button
 108
 109 (defbinding toggle-button-toggled () nil
 110   (toggle-button toggle-button))
 111
 112
 113
 114 ;;; Check button
 115
 116 (defmethod (setf button-label) ((label string) (button check-button))
 117   (call-next-method)
 118   (setf (misc-xalign (bin-child button)) 0.0)
 119   label)
 120
 121
 122
 123 ;;; Radio button
 124
 125 (defbinding (%radio-button-get-group "gtk_radio_button_group") () pointer
 126   (radio-button radio-button))
 127
 128 (defbinding %radio-button-set-group () nil
 129   (radio-button radio-button)
 130   (group pointer))
 131
 132 (defun radio-button-add-to-group (button1 button2)
 133   "Add BUTTON1 to the group which BUTTON2 belongs to."
 134   (%radio-button-set-group button1 (%radio-button-get-group button2)))
 135
 136 (defmethod initialize-instance ((button radio-button)
 137                                 &rest initargs &key group)
 138   (call-next-method)
 139   (when group
 140     (radio-button-add-to-group item group)))
 141
 142
 143 ;;; Option menu
 144
 145 (defbinding %option-menu-set-menu () nil
 146   (option-menu option-menu)
 147   (menu widget))
 148
 149 (defbinding %option-menu-remove-menu () nil
 150   (option-menu option-menu))
 151
 152 (defun (setf option-menu-menu) (menu option-menu)
 153   (if (not menu)
 154       (%option-menu-remove-menu option-menu)
 155     (%option-menu-set-menu option-menu menu))
 156   menu)
 157
 158
 159
 160 ;;; Item
 161
 162 (defbinding item-select () nil
 163   (item item))
 164
 165 (defbinding item-deselect () nil
 166   (item item))
 167
 168 (defbinding item-toggle () nil
 169   (item item))
 170
 171
 172
 173 ;;; Menu item
 174
 175 (defun (setf menu-item-label) (label menu-item)
 176   (make-instance 'accel-label
 177    :label label :xalign 0.0 :yalign 0.5 :accel-widget menu-item
 178    :visible t :parent menu-item)
 179   label)
 180
 181 (defbinding %menu-item-set-submenu () nil
 182   (menu-item menu-item)
 183   (submenu menu))
 184
 185 (defbinding %menu-item-remove-submenu () nil
 186   (menu-item menu-item))
 187
 188 (defun (setf menu-item-submenu) (submenu menu-item)
 189   (if (not submenu)
 190       (%menu-item-remove-submenu menu-item)
 191     (%menu-item-set-submenu menu-item submenu))
 192   submenu)
 193
 194 (defbinding %menu-item-configure () nil
 195   (menu-item menu-item)
 196   (show-toggle-indicator boolean)
 197   (show-submenu-indicator boolean))
 198
 199 (defun (setf menu-item-toggle-indicator-p) (show menu-item)
 200   (%menu-item-configure
 201    menu-item
 202    show
 203    (menu-item-submenu-indicator-p menu-item))
 204   show)
 205
 206 (defun (setf menu-item-submenu-indicator-p) (show menu-item)
 207   (%menu-item-configure
 208    menu-item
 209    (menu-item-toggle-indicator-p menu-item)
 210    show))
 211
 212 (defbinding menu-item-select () nil
 213   (menu-item menu-item))
 214
 215 (defbinding menu-item-deselect () nil
 216   (menu-item menu-item))
 217
 218 (defbinding menu-item-activate () nil
 219   (menu-item menu-item))
 220
 221 (defbinding menu-item-right-justify () nil
 222   (menu-item menu-item))
 223
 224
 225
 226 ;;; Check menu item
 227
 228 (defbinding check-menu-item-toggled () nil
 229   (check-menu-item check-menu-item))
 230
 231
 232
 233 ;;; Radio menu item
 234
 235 (defbinding (%radio-menu-item-get-group
 236              "gtk_radio_menu_item_group") () pointer
 237   (radio-menu-item radio-menu-item))
 238
 239 (defbinding %radio-menu-item-set-group () nil
 240   (radio-menu-item radio-menu-item)
 241   (group pointer))
 242
 243 (defun radio-menu-item-add-to-group (item1 item2)
 244   "Add ITEM1 to the group which ITEM2 belongs to."
 245   (%radio-menu-item-set-group item1 (%radio-menu-item-get-group item2)))
 246
 247 (defmethod initialize-instance ((item radio-menu-item)
 248                                 &rest initargs &key group)
 249   (call-next-method)
 250   (when group
 251     (radio-menu-item-add-to-group item group)))
 252
 253
 254
 255 ;;; Window
 256
 257 (defbinding %window-set-wmclass () nil
 258   (window window)
 259   (wmclass-name string)
 260   (wmclass-class string))
 261
 262 (defun (setf window-wmclass) (wmclass window)
 263   (%window-set-wmclass window (svref wmclass 0) (svref wmclass 1))
 264   (values (svref wmclass 0) (svref wmclass 1)))
 265
 266 ;; gtkglue.c
 267 (defbinding window-wmclass () nil
 268   (window window)
 269   (wmclass-name string :out)
 270   (wmclass-class string :out))
 271
 272 (defbinding window-add-accel-group () nil
 273   (window window)
 274   (accel-group accel-group))
 275
 276 (defbinding window-remove-accel-group () nil
 277   (window window)
 278   (accel-group accel-group))
 279
 280 (defbinding window-activate-focus () int
 281   (window window))
 282
 283 (defbinding window-activate-default () int
 284   (window window))
 285
 286 (defbinding window-set-transient-for () nil
 287   (window window)
 288   (parent window))
 289
 290 ;(defbinding window-set-geometry-hints)
 291
 292
 293
 294 ;;; File selection
 295
 296 (defbinding file-selection-complete () nil
 297   (file-selection file-selection)
 298   (pattern string))
 299
 300 (defbinding file-selection-show-fileop-buttons () nil
 301   (file-selection file-selection))
 302
 303 (defbinding file-selection-hide-fileop-buttons () nil
 304   (file-selection file-selection))
 305
 306
 307
 308 ;;; Scrolled window
 309
 310 (defun (setf scrolled-window-scrollbar-policy) (policy window)
 311   (setf (scrolled-window-hscrollbar-policy window) policy)
 312   (setf (scrolled-window-vscrollbar-policy window) policy))
 313
 314 (defbinding scrolled-window-add-with-viewport () nil
 315    (scrolled-window scrolled-window)
 316    (child widget))
 317
 318
 319
 320 ;;; Box
 321
 322 (defbinding box-pack-start () nil
 323   (box box)
 324   (child widget)
 325   (expand boolean)
 326   (fill boolean)
 327   (padding unsigned-int))
 328
 329 (defbinding box-pack-end () nil
 330   (box box)
 331   (child widget)
 332   (expand boolean)
 333   (fill boolean)
 334   (padding unsigned-int))
 335
 336 (defun box-pack (box child &key (pack :start) (expand t) (fill t) (padding 0))
 337   (if (eq pack :start)
 338       (box-pack-start box child expand fill padding)
 339     (box-pack-end box child expand fill padding)))
 340
 341 (defbinding box-reorder-child () nil
 342   (box box)
 343   (child widget)
 344   (position int))
 345
 346 (defbinding box-query-child-packing () nil
 347   (box box)
 348   (child widget :out)
 349   (expand boolean :out)
 350   (fill boolean :out)
 351   (padding unsigned-int :out)
 352   (pack-type pack-type :out))
 353
 354 (defbinding box-set-child-packing () nil
 355   (box box)
 356   (child widget)
 357   (expand boolean)
 358   (fill boolean)
 359   (padding unsigned-int)
 360   (pack-type pack-type))
 361
 362
 363
 364 ;;; Button box
 365
 366 (defbinding button-box-get-child-size () nil
 367   (button-box button-box)
 368   (min-width int :out)
 369   (min-height int :out))
 370
 371 (defbinding button-box-set-child-size () nil
 372   (button-box button-box)
 373   (min-width int)
 374   (min-height int))
 375
 376 (defbinding button-box-get-child-ipadding () nil
 377   (button-box button-box)
 378   (ipad-x int :out)
 379   (ipad-y int :out))
 380
 381 (defbinding button-box-set-child-ipadding () nil
 382   (button-box button-box)
 383   (ipad-x int)
 384   (ipad-y int))
 385
 386
 387
 388 ;;; Color selection
 389
 390 ; (defbinding %color-selection-get-previous-color () nil
 391 ;   (colorsel color-selection)
 392 ;   (color pointer))
 393
 394 ; (defun color-selection-previous-color (colorsel)
 395 ;   (let ((color (allocate-memory (* (size-of 'double-float) 4))))
 396 ;     (%color-selection-get-previous-color colorsel color)
 397 ;     (funcall (get-from-alien-function '(vector double-float 4)) color)))
 398
 399 ; (defbinding %color-selection-set-previous-color () nil
 400 ;   (colorsel color-selection)
 401 ;   (color (vector double-float 4)))
 402
 403 ; (defun (setf color-selection-previous-color) (color colorsel)
 404 ;   (%color-selection-set-previous-color colorsel color)
 405 ;   color)
 406
 407 (defbinding (color-selection-is-adjusting-p
 408              "gtk_color_selection_is_adjusting") () boolean
 409   (colorsel color-selection))
 410
 411
 412
 413 ;;; Combo
 414
 415 (defbinding combo-set-value-in-list () nil
 416   (combo combo)
 417   (val boolean)
 418   (ok-if-empty boolean))
 419
 420 ; (defbinding ("gtk_combo_set_item_string" (setf combo-item-string)) () nil
 421 ;   (combo combo)
 422 ;   (item item)
 423 ;   (item-value string))
 424
 425 (defbinding %combo-set-popdown-strings () nil
 426   (combo combo)
 427   (strings (glist string)))
 428
 429 (defun (setf combo-popdown-strings) (strings combo)
 430   (%combo-set-popdown-strings combo strings)
 431   strings)
 432
 433 (defbinding combo-disable-activate () nil
 434   (combo combo))
 435
 436
 437
 438 ;;; Statusbar
 439
 440 (defbinding (statusbar-context-id "gtk_statusbar_get_context_id")
 441     () unsigned-int
 442   (statusbar statusbar)
 443   (context-description string))
 444
 445 (defbinding statusbar-push () unsigned-int
 446   (statusbar statusbar)
 447   (context-id unsigned-int)
 448   (text string))
 449
 450 (defbinding statusbar-pop () nil
 451   (statusbar statusbar)
 452   (context-id unsigned-int))
 453
 454 (defbinding statusbar-remove () nil
 455   (statusbar statusbar)
 456   (context-id unsigned-int)
 457   (message-id unsigned-int))
 458
 459
 460
 461 ;;; Fixed
 462
 463 (defbinding fixed-put () nil
 464   (fixed fixed)
 465   (widget widget)
 466   (x (signed 16))
 467   (y (signed 16)))
 468
 469 (defbinding fixed-move () nil
 470   (fixed fixed)
 471   (widget widget)
 472   (x (signed 16))
 473   (y (signed 16)))
 474
 475
 476
 477 ;;; Notebook
 478
 479 (defbinding (notebook-insert-page "gtk_notebook_insert_page_menu")
 480     (notebook position child tab-label &optional menu-label) nil
 481   (notebook notebook)
 482   (child widget)
 483   ((if (stringp tab-label)
 484        (label-new tab-label)
 485      tab-label) widget)
 486   ((if (stringp menu-label)
 487        (label-new menu-label)
 488      menu-label) (or null widget))
 489   (position int))
 490
 491 (defun notebook-append-page (notebook child tab-label &optional menu-label)
 492   (notebook-insert-page notebook -1 child tab-label menu-label))
 493
 494 (defun notebook-prepend-page (notebook child tab-label &optional menu-label)
 495   (notebook-insert-page notebook 0 child tab-label menu-label))
 496
 497 (defbinding notebook-remove-page () nil
 498   (notebook notebook)
 499   (page-num int))
 500
 501 ; (defun notebook-current-page-num (notebook)
 502 ;   (let ((page-num (notebook-current-page notebook)))
 503 ;     (if (= page-num -1)
 504 ;       nil
 505 ;       page-num)))
 506
 507 (defbinding (notebook-nth-page-child "gtk_notebook_get_nth_page") () widget
 508   (notebook notebook)
 509   (page-num int))
 510
 511 (defun notebook-page-child (notebook)
 512   (notebook-nth-page-child notebook (notebook-page notebook)))
 513
 514 (defbinding %notebook-page-num () int
 515   (notebook notebook)
 516   (child widget))
 517
 518 (defun notebook-child-num (notebook child)
 519   (let ((page-num (%notebook-page-num notebook child)))
 520     (if (= page-num -1)
 521         nil
 522       page-num)))
 523
 524 (defbinding notebook-next-page () nil
 525   (notebook notebook))
 526
 527 (defbinding notebook-prev-page () nil
 528   (notebook notebook))
 529
 530 (defbinding notebook-popup-enable () nil
 531   (notebook notebook))
 532
 533 (defbinding notebook-popup-disable () nil
 534   (notebook notebook))
 535
 536 (defbinding (notebook-tab-label "gtk_notebook_get_tab_label")
 537     (notebook ref) widget
 538   (notebook notebook)
 539   ((if (typep ref 'widget)
 540        ref
 541      (notebook-nth-page-child notebook ref))
 542    widget))
 543
 544 (defbinding %notebook-set-tab-label () nil
 545   (notebook notebook)
 546   (reference widget)
 547   (tab-label widget))
 548
 549 (defun (setf notebook-tab-label) (tab-label notebook reference)
 550   (let ((tab-label-widget (if (stringp tab-label)
 551                               (label-new tab-label)
 552                             tab-label)))
 553     (%notebook-set-tab-label
 554      notebook
 555      (if (typep reference 'widget)
 556          reference
 557        (notebook-nth-page-child notebook reference))
 558      tab-label-widget)
 559     tab-label-widget))
 560
 561 (defbinding (notebook-menu-label "gtk_notebook_get_menu_label")
 562     (notebook ref) widget
 563   (notebook notebook)
 564   ((if (typep ref 'widget)
 565        ref
 566      (notebook-nth-page-child notebook ref))
 567    widget))
 568
 569 (defbinding %notebook-set-menu-label () nil
 570   (notebook notebook)
 571   (reference widget)
 572   (menu-label widget))
 573
 574 (defun (setf notebook-menu-label) (menu-label notebook reference)
 575   (let ((menu-label-widget (if (stringp menu-label)
 576                               (label-new menu-label)
 577                             menu-label)))
 578     (%notebook-set-menu-label
 579      notebook
 580      (if (typep reference 'widget)
 581          reference
 582        (notebook-nth-page-child notebook reference))
 583      menu-label-widget)
 584     menu-label-widget))
 585
 586 (defbinding notebook-query-tab-label-packing (notebook ref) nil
 587   (notebook notebook)
 588   ((if (typep ref 'widget)
 589        ref
 590      (notebook-nth-page-child notebook ref))
 591    widget)
 592   (expand boolean :out)
 593   (fill boolean :out)
 594   (pack-type pack-type :out))
 595
 596 (defbinding
 597     notebook-set-tab-label-packing (notebook ref expand fill pack-type) nil
 598   (notebook notebook)
 599   ((if (typep ref 'widget)
 600        ref
 601      (notebook-nth-page-child notebook ref))
 602    widget)
 603   (expand boolean)
 604   (fill boolean)
 605   (pack-type pack-type))
 606
 607 (defbinding notebook-reorder-child () nil
 608   (notebook notebook)
 609   (child widget)
 610   (position int))
 611
 612
 613
 614 ;;; Paned
 615
 616 (defbinding paned-pack1 () nil
 617   (paned paned)
 618   (child widget)
 619   (resize boolean)
 620   (shrink boolean))
 621
 622 (defbinding paned-pack2 () nil
 623   (paned paned)
 624   (child widget)
 625   (resize boolean)
 626   (shrink boolean))
 627
 628 ;; gtkglue.c
 629 (defbinding paned-child1 () widget
 630   (paned paned)
 631   (resize boolean :out)
 632   (shrink boolean :out))
 633
 634 ;; gtkglue.c
 635 (defbinding paned-child2 () widget
 636   (paned paned)
 637   (resize boolean :out)
 638   (shrink boolean :out))
 639
 640 (defun (setf paned-child1) (child paned)
 641   (paned-pack1 paned child nil t))
 642
 643 (defun (setf paned-child2) (child paned)
 644   (paned-pack2 paned child t t))
 645
 646
 647
 648 ;;; Layout
 649
 650 (defbinding layout-put () nil
 651   (layout layout)
 652   (widget widget)
 653   (x int)
 654   (y int))
 655
 656 (defbinding layout-move () nil
 657   (layout layout)
 658   (widget widget)
 659   (x int)
 660   (y int))
 661
 662 (defbinding layout-set-size () nil
 663   (layout layout)
 664   (width int)
 665   (height int))
 666
 667 ;; gtkglue.c
 668 (defbinding layout-get-size () nil
 669   (layout layout)
 670   (width int :out)
 671   (height int :out))
 672
 673 (defun layout-x-size (layout)
 674   (nth-value 0 (layout-get-size layout)))
 675
 676 (defun layout-y-size (layout)
 677   (nth-value 1 (layout-get-size layout)))
 678
 679 (defun (setf layout-x-size) (x layout)
 680   (layout-set-size layout x (layout-y-size layout)))
 681
 682 (defun (setf layout-y-size) (y layout)
 683   (layout-set-size layout (layout-x-size layout) y))
 684
 685 (defbinding layout-freeze () nil
 686   (layout layout))
 687
 688 (defbinding layout-thaw () nil
 689   (layout layout))
 690
 691
 692
 693 ;;; Menu shell
 694
 695 (defbinding menu-shell-insert () nil
 696   (menu-shell menu-shell)
 697   (menu-item menu-item)
 698   (position int))
 699
 700 (defun menu-shell-append (menu-shell menu-item)
 701   (menu-shell-insert menu-shell menu-item -1))
 702
 703 (defun menu-shell-prepend (menu-shell menu-item)
 704   (menu-shell-insert menu-shell menu-item 0))
 705
 706 (defbinding menu-shell-deactivate () nil
 707   (menu-shell menu-shell))
 708
 709 (defbinding menu-shell-select-item () nil
 710   (menu-shell menu-shell)
 711   (menu-item menu-item))
 712
 713 (defbinding menu-shell-deselect () nil
 714   (menu-shell menu-shell))
 715
 716 (defbinding menu-shell-activate-item () nil
 717   (menu-shell menu-shell)
 718   (menu-item menu-item)
 719   (fore-deactivate boolean))
 720
 721
 722
 723 ; ;;; Menu bar
 724
 725 ; (defbinding menu-bar-insert () nil
 726 ;   (menu-bar menu-bar)
 727 ;   (menu menu)
 728 ;   (position int))
 729
 730 ; (defun menu-bar-append (menu-bar menu)
 731 ;   (menu-bar-insert menu-bar menu -1))
 732
 733 ; (defun menu-bar-prepend (menu-bar menu)
 734 ;   (menu-bar-insert menu-bar menu 0))
 735
 736
 737
 738 ; ;;; Menu
 739
 740 ; (defun menu-insert (menu menu-item position)
 741 ;   (menu-shell-insert menu menu-item position))
 742
 743 ; (defun menu-append (menu menu-item)
 744 ;   (menu-shell-append menu menu-item))
 745
 746 ; (defun menu-prepend (menu menu-item)
 747 ;   (menu-shell-prepend menu menu-item))
 748
 749 ;(defun menu-popup ...)
 750
 751 (defbinding menu-reposition () nil
 752   (menu menu))
 753
 754 (defbinding menu-popdown () nil
 755   (menu menu))
 756
 757 (defbinding (menu-active "gtk_menu_get_active") () widget
 758   (menu menu))
 759
 760 (defbinding %menu-set-active () nil
 761   (menu menu)
 762   (index unsigned-int))
 763
 764 (defun (setf menu-active) (menu index)
 765   (%menu-set-active menu index))
 766
 767 ;(defun menu-attach-to-widget ...)
 768
 769 (defbinding menu-detach () nil
 770   (menu menu))
 771
 772 (defbinding (menu-attach-widget "gtk_menu_get_attach_widget") () widget
 773   (menu menu))
 774
 775 (defbinding menu-reorder-child () nil
 776   (menu menu)
 777   (menu-item menu-item)
 778   (position int))
 779
 780
 781 ;;; Table
 782
 783 (defbinding table-resize () nil
 784   (table table)
 785   (rows unsigned-int)
 786   (columns unsigned-int))
 787
 788 (defbinding table-attach (table child left right top bottom
 789                                &key (x-options '(:expand :fill))
 790                                     (y-options '(:expand :fill))
 791                                     (x-padding 0) (y-padding 0)) nil
 792   (table table)
 793   (child widget)
 794   (left unsigned-int)
 795   (right unsigned-int)
 796   (top unsigned-int)
 797   (bottom unsigned-int)
 798   (x-options attach-options)
 799   (y-options attach-options)
 800   (x-padding unsigned-int)
 801   (y-padding unsigned-int))
 802
 803 (defbinding %table-set-row-spacing () nil
 804   (table table)
 805   (row unsigned-int)
 806   (spacing unsigned-int))
 807
 808 (defun (setf table-row-spacing) (spacing table row)
 809   (%table-set-row-spacing table row spacing)
 810   spacing)
 811
 812 ;; gtkglue.c
 813 (defbinding table-row-spacing (table row) unsigned-int
 814   (table table)
 815   ((progn
 816      (assert (and (>= row 0) (< row (table-rows table))))
 817      row) unsigned-int))
 818
 819 (defbinding %table-set-col-spacing () nil
 820   (table table)
 821   (col unsigned-int)
 822   (spacing unsigned-int))
 823
 824 (defun (setf table-column-spacing) (spacing table column)
 825   (%table-set-col-spacing table column spacing)
 826   spacing)
 827
 828 ;; gtkglue.c
 829 (defbinding table-column-spacing (table col) unsigned-int
 830   (table table)
 831   ((progn
 832      (assert (and (>= col 0) (< col (table-columns table))))
 833      col) unsigned-int))
 834
 835
 836 (defun %set-table-child-option (object slot flag value)
 837   (let ((options (child-slot-value object slot)))
 838     (cond
 839      ((and value (not (member flag options)))
 840       (setf (child-slot-value object slot) (cons flag options)))
 841      ((and (not value) (member flag options))
 842       (setf (child-slot-value object slot) (delete flag options))))))
 843
 844 (macrolet ((define-option-accessor (name slot flag)
 845              `(progn
 846                 (defun ,name (object)
 847                   (member ,flag (child-slot-value object ,slot)))
 848                 (defun (setf ,name) (value object)
 849                   (%set-table-child-option object ,slot ,flag value)))))
 850   (define-option-accessor table-child-x-expand-p :x-options :expand)
 851   (define-option-accessor table-child-y-expand-p :y-options :expand)
 852   (define-option-accessor table-child-x-shrink-p :x-options :shrink)
 853   (define-option-accessor table-child-y-shrink-p :y-options :shrink)
 854   (define-option-accessor table-child-x-fill-p :x-options :fill)
 855   (define-option-accessor table-child-y-fill-p :y-options :fill))
 856
 857
 858
 859 ;;; Toolbar
 860
 861 ;; gtkglue.c
 862 (defbinding toolbar-num-children () int
 863   (toolbar toolbar))
 864
 865 (defun %toolbar-position-num (toolbar position)
 866   (case position
 867     (:prepend 0)
 868     (:append (toolbar-num-children toolbar))
 869     (t
 870      (assert (and (>= position 0) (< position (toolbar-num-children toolbar))))
 871      position)))
 872
 873 (defbinding %toolbar-insert-element () widget
 874   (toolbar toolbar)
 875   (type toolbar-child-type)
 876   (widget (or null widget))
 877   (text string)
 878   (tooltip-text string)
 879   (tooltip-private-text string)
 880   (icon (or null widget))
 881   (nil null)
 882   (nil null)
 883   (position int))
 884
 885 (defun toolbar-insert-element (toolbar position
 886                                &key tooltip-text tooltip-private-text
 887                                type widget icon text callback)
 888   (let* ((icon-widget (typecase icon
 889                        ((or null widget) icon)
 890                        (t (pixmap-new icon))))
 891          (toolbar-child
 892           (%toolbar-insert-element
 893            toolbar (or type (and widget :widget) :button)
 894            widget text tooltip-text tooltip-private-text icon-widget
 895            (%toolbar-position-num toolbar position))))
 896     (when callback
 897       (signal-connect toolbar-child 'clicked callback))
 898     toolbar-child))
 899
 900 (defun toolbar-append-element (toolbar &key tooltip-text tooltip-private-text
 901                                type widget icon text callback)
 902   (toolbar-insert-element
 903    toolbar :append :type type :widget widget :icon icon :text text
 904    :tooltip-text tooltip-text :tooltip-private-text tooltip-private-text
 905    :callback callback))
 906
 907 (defun toolbar-prepend-element (toolbar &key tooltip-text tooltip-private-text
 908                                 type widget icon text callback)
 909   (toolbar-insert-element
 910    toolbar :prepend :type type :widget widget :icon icon :text text
 911    :tooltip-text tooltip-text :tooltip-private-text tooltip-private-text
 912    :callback callback))
 913
 914 (defun toolbar-insert-space (toolbar position)
 915   (toolbar-insert-element toolbar position :type :space))
 916
 917 (defun toolbar-append-space (toolbar)
 918   (toolbar-insert-space toolbar :append))
 919
 920 (defun toolbar-prepend-space (toolbar)
 921   (toolbar-insert-space toolbar :prepend))
 922
 923 (defun toolbar-insert-widget (toolbar widget position &key tooltip-text
 924                               tooltip-private-text callback)
 925   (toolbar-insert-element
 926    toolbar position :widget widget :tooltip-text tooltip-text
 927    :tooltip-private-text tooltip-private-text :callback callback))
 928
 929 (defun toolbar-append-widget (toolbar widget &key tooltip-text
 930                               tooltip-private-text callback)
 931   (toolbar-insert-widget
 932    toolbar widget :append :tooltip-text tooltip-text
 933    :tooltip-private-text tooltip-private-text :callback callback))
 934
 935 (defun toolbar-prepend-widget (toolbar widget &key tooltip-text
 936                                tooltip-private-text callback)
 937   (toolbar-insert-widget
 938    toolbar widget :prepend :tooltip-text tooltip-text
 939    :tooltip-private-text tooltip-private-text :callback callback))
 940
 941 (defun toolbar-insert-item (toolbar text icon position &key tooltip-text
 942                             tooltip-private-text callback)
 943   (toolbar-insert-element
 944    toolbar position :text text :icon icon :callback callback
 945    :tooltip-text tooltip-text :tooltip-private-text tooltip-private-text))
 946
 947 (defun toolbar-append-item (toolbar text icon &key tooltip-text
 948                             tooltip-private-text callback)
 949   (toolbar-insert-item
 950    toolbar text icon :append :callback callback
 951    :tooltip-text tooltip-text :tooltip-private-text tooltip-private-text))
 952
 953
 954 (defun toolbar-prepend-item (toolbar text icon &key tooltip-text
 955                              tooltip-private-text callback)
 956   (toolbar-insert-item
 957    toolbar text icon :prepend :callback callback
 958    :tooltip-text tooltip-text :tooltip-private-text tooltip-private-text))
 959
 960 (defun toolbar-enable-tooltips (toolbar)
 961   (setf (toolbar-tooltips-p toolbar) t))
 962
 963 (defun toolbar-disable-tooltips (toolbar)
 964   (setf (toolbar-tooltips-p toolbar) nil))
 965
 966
 967
 968 ;;; Calendar
 969
 970 (defbinding calendar-select-month () int
 971   (calendar calendar)
 972   (month unsigned-int)
 973   (year unsigned-int))
 974
 975 (defbinding calendar-select-day () nil
 976   (calendar calendar)
 977   (day unsigned-int))
 978
 979 (defbinding calendar-mark-day () int
 980   (calendar calendar)
 981   (day unsigned-int))
 982
 983 (defbinding calendar-unmark-day () int
 984   (calendar calendar)
 985   (day unsigned-int))
 986
 987 (defbinding calendar-clear-marks () nil
 988   (calendar calendar))
 989
 990 (defbinding calendar-display-options () nil
 991   (calendar calendar)
 992   (options calendar-display-options))
 993
 994 (defbinding (calendar-date "gtk_calendar_get_date") () nil
 995   (calendar calendar)
 996   (year unsigned-int :out)
 997   (month unsigned-int :out)
 998   (day unsigned-int :out))
 999
1000 (defbinding calendar-freeze () nil
1001   (calendar calendar))
1002
1003 (defbinding calendar-thaw () nil
1004   (calendar calendar))
1005
1006
1007
1008 ;;; Drawing area
1009
1010
1011 ; (defbinding ("gtk_drawing_area_size" %drawing-area-set-size) () nil
1012 ;   (drawing-area drawing-area)
1013 ;   (width int)
1014 ;   (height int))
1015
1016 ; (defun (setf drawing-area-size) (size drawing-area)
1017 ;   (%drawing-area-set-size drawing-area (svref size 0) (svref size 1))
1018 ;   (values (svref size 0) (svref size 1)))
1019
1020 ; ;; gtkglue.c
1021 ; (defbinding ("gtk_drawing_area_get_size" drawing-area-size) () nil
1022 ;   (drawing-area drawing-area)
1023 ;   (width int :out)
1024 ;   (height int :out))
1025
1026
1027
1028 ;;; Editable
1029 #|
1030 (defbinding editable-select-region (editable &optional (start 0) end) nil
1031   (editable editable)
1032   (start int)
1033   ((or end -1) int))
1034
1035 (defbinding editable-insert-text
1036     (editable text &optional (position 0)) nil
1037   (editable editable)
1038   (text string)
1039   ((length text) int)
1040   ((or position -1) int :in-out))
1041
1042 (defun editable-append-text (editable text)
1043   (editable-insert-text editable text nil))
1044
1045 (defun editable-prepend-text (editable text)
1046   (editable-insert-text editable text 0))
1047
1048 (defbinding editable-delete-text (editable &optional (start 0) end) nil
1049   (editable editable)
1050   (start int)
1051   ((or end -1) int))
1052
1053 (defbinding (editable-text "gtk_editable_get_chars")
1054     (editable &optional (start 0) end) string
1055   (editable editable)
1056   (start int)
1057   ((or end -1) int))
1058
1059 (defun (setf editable-text) (text editable)
1060   (if text
1061       (editable-delete-text
1062        editable
1063        (editable-insert-text editable text))
1064     (editable-delete-text editable))
1065   text)
1066
1067 (defbinding editable-cut-clipboard () nil
1068   (editable editable))
1069
1070 (defbinding editable-copy-clipboard () nil
1071   (editable editable))
1072
1073 (defbinding editable-paste-clipboard () nil
1074   (editable editable))
1075
1076 ; (defbinding editable-claim-selection () nil
1077 ;   (editable editable)
1078 ;   (claim boolean)
1079 ;   (time unsigned-int))
1080
1081 (defbinding editable-delete-selection () nil
1082   (editable editable))
1083
1084 ; (defbinding editable-changed () nil
1085 ;   (editable editable))
1086 |#
1087
1088
1089 ;;; Spin button
1090
1091 (defun spin-button-value-as-int (spin-button)
1092   (round (spin-button-value spin-button)))
1093
1094 (defbinding spin-button-spin () nil
1095   (spin-button spin-button)
1096   (direction spin-type)
1097   (increment single-float))
1098
1099 (defbinding spin-button-update () nil
1100   (spin-button spin-button))
1101
1102
1103
1104 ; ;;; Ruler
1105
1106 (defbinding ruler-set-range () nil
1107   (ruler ruler)
1108   (lower single-float)
1109   (upper single-float)
1110   (position single-float)
1111   (max-size single-float))
1112
1113 (defbinding ruler-draw-ticks () nil
1114   (ruler ruler))
1115
1116 (defbinding ruler-draw-pos () nil
1117   (ruler ruler))
1118
1119
1120
1121 ;;; Range
1122 #|
1123 (defbinding range-draw-background () nil
1124   (range range))
1125
1126 (defbinding range-clear-background () nil
1127   (range range))
1128
1129 (defbinding range-draw-trough () nil
1130   (range range))
1131
1132 (defbinding range-draw-slider () nil
1133   (range range))
1134
1135 (defbinding range-draw-step-forw () nil
1136   (range range))
1137
1138 (defbinding range-slider-update () nil
1139   (range range))
1140
1141 (defbinding range-trough-click () int
1142   (range range)
1143   (x int)
1144   (y int)
1145   (jump-perc single-float :out))
1146
1147 (defbinding range-default-hslider-update () nil
1148   (range range))
1149
1150 (defbinding range-default-vslider-update () nil
1151   (range range))
1152
1153 (defbinding range-default-htrough-click () int
1154   (range range)
1155   (x int)
1156   (y int)
1157   (jump-perc single-float :out))
1158
1159 (defbinding range-default-vtrough-click () int
1160   (range range)
1161   (x int)
1162   (y int)
1163   (jump-perc single-float :out))
1164
1165 (defbinding range-default-hmotion () int
1166   (range range)
1167   (x-delta int)
1168   (y-delta int))
1169
1170 (defbinding range-default-vmotion () int
1171   (range range)
1172   (x-delta int)
1173   (y-delta int))
1174 |#
1175
1176
1177 ;;; Scale
1178
1179 (defbinding scale-draw-value () nil
1180   (scale scale))
1181
1182
1183
1184 ;;; Progress
1185
1186 (defbinding progress-configure () adjustment
1187   (progress progress)
1188   (value single-float)
1189   (min single-float)
1190   (max single-float))
1191
1192 (defbinding (progress-text-from-value
1193              "gtk_progress_get_text_from_value") () string
1194   (progress progress))
1195
1196 (defbinding (progress-percentage-from-value
1197              "gtk_progress_get_percentage_from_value") () single-float
1198   (progress progress))
1199
1200
1201
1202 ;;; Progress bar
1203
1204 (defbinding progress-bar-pulse () nil
1205   (progress-bar progress-bar))
1206
1207
1208
1209 ;;; Adjustment
1210
1211 (defbinding adjustment-changed () nil
1212   (adjustment adjustment))
1213
1214 (defbinding adjustment-value-changed () nil
1215   (adjustment adjustment))
1216
1217 (defbinding adjustment-clamp-page () nil
1218   (adjustment adjustment)
1219   (lower single-float)
1220   (upper single-float))
1221
1222
1223
1224 ;;; Tooltips
1225
1226 (defbinding tooltips-enable () nil
1227   (tooltips tooltips))
1228
1229 (defbinding tooltips-disable () nil
1230   (tooltips tooltips))
1231
1232 (defbinding tooltips-set-tip () nil
1233   (tooltips tooltips)
1234   (widget widget)
1235   (tip-text string)
1236   (tip-private string))
1237
1238 (defbinding tooltips-set-colors (tooltips background foreground) nil
1239   (tooltips tooltips)
1240   ((gdk:ensure-color background) gdk:color)
1241   ((gdk:ensure-color foreground) gdk:color))
1242
1243 (defbinding tooltips-force-window () nil
1244   (tooltips tooltips))
1245
1246
1247
1248 ;;; Rc
1249
1250 (defbinding rc-add-default-file (filename) nil
1251   ((namestring (truename filename)) string))
1252
1253 (defbinding rc-parse (filename) nil
1254   ((namestring (truename filename)) string))
1255
1256 (defbinding rc-parse-string () nil
1257   (rc-string string))
1258
1259 (defbinding rc-reparse-all () nil)
1260
1261 (defbinding rc-get-style () style
1262   (widget widget))
1263
1264
1265
1266 ;;; Accelerator Groups
1267 #|
1268 (defbinding accel-group-get-default () accel-group)
1269
1270 (deftype-method alien-ref accel-group (type-spec)
1271   (declare (ignore type-spec))
1272   '%accel-group-ref)
1273
1274 (deftype-method alien-unref accel-group (type-spec)
1275   (declare (ignore type-spec))
1276   '%accel-group-unref)
1277
1278 (defbinding %accel-group-ref () accel-group
1279   (accel-group (or accel-group pointer)))
1280
1281 (defbinding %accel-group-unref () nil
1282   (accel-group (or accel-group pointer)))
1283
1284 (defbinding accel-group-activate (accel-group key modifiers) boolean
1285   (accel-group accel-group)
1286   ((gdk:keyval-from-name key) unsigned-int)
1287   (modifiers gdk:modifier-type))
1288
1289 (defbinding accel-groups-activate (object key modifiers) boolean
1290   (object object)
1291   ((gdk:keyval-from-name key) unsigned-int)
1292   (modifiers gdk:modifier-type))
1293
1294 (defbinding accel-group-attach () nil
1295   (accel-group accel-group)
1296   (object object))
1297
1298 (defbinding accel-group-detach () nil
1299   (accel-group accel-group)
1300   (object object))
1301
1302 (defbinding accel-group-lock () nil
1303   (accel-group accel-group))
1304
1305 (defbinding accel-group-unlock () nil
1306   (accel-group accel-group))
1307
1308
1309 ;;; Accelerator Groups Entries
1310
1311 (defbinding accel-group-get-entry (accel-group key modifiers) accel-entry
1312   (accel-group accel-group)
1313   ((gdk:keyval-from-name key) unsigned-int)
1314   (modifiers gdk:modifier-type))
1315
1316 (defbinding accel-group-lock-entry (accel-group key modifiers) nil
1317   (accel-group accel-group)
1318   ((gdk:keyval-from-name key) unsigned-int)
1319   (modifiers gdk:modifier-type))
1320
1321 (defbinding accel-group-unlock-entry (accel-group key modifiers) nil
1322   (accel-group accel-group)
1323   ((gdk:keyval-from-name key) unsigned-int)
1324   (modifiers gdk:modifier-type))
1325
1326 (defbinding accel-group-add
1327     (accel-group key modifiers flags object signal) nil
1328   (accel-group accel-group)
1329   ((gdk:keyval-from-name key) unsigned-int)
1330   (modifiers gdk:modifier-type)
1331   (flags accel-flags)
1332   (object object)
1333   ((name-to-string signal) string))
1334
1335 (defbinding accel-group-add (accel-group key modifiers object) nil
1336   (accel-group accel-group)
1337   ((gdk:keyval-from-name key) unsigned-int)
1338   (modifiers gdk:modifier-type)
1339   (object object))
1340
1341
1342 ;;; Accelerator Signals
1343
1344 (defbinding accel-group-handle-add
1345     (object signal-id accel-group key modifiers flags) nil
1346   (object object)
1347   (signal-id unsigned-int)
1348   (accel-group accel-group)
1349   ((gdk:keyval-from-name key) unsigned-int)
1350   (modifiers gdk:modifier-type)
1351   (flags accel-flags))
1352
1353 (defbinding accel-group-handle-remove
1354     (object accel-group key modifiers) nil
1355   (object object)
1356   (accel-group accel-group)
1357   ((gdk:keyval-from-name key) unsigned-int)
1358   (modifiers gdk:modifier-type))
1359 |#
1360
1361
1362 ;;; Style
1363
1364 ; (defbinding style-new () style)
1365
1366 ; (defbinding style-copy () style
1367 ;   (style style))
1368 #|
1369 (defbinding %style-get-color () gdk:color
1370   (style style)
1371   (color-type color-type)
1372   (state-type state-type))
1373
1374 (defbinding %style-set-color () gdk:color
1375   (style style)
1376   (color-type color-type)
1377   (state-type state-type)
1378   (color gdk:color))
1379
1380 (defun style-fg (style state)
1381   (%style-get-color style :foreground state))
1382
1383 (defun (setf style-fg) (color style state)
1384   (%style-set-color style :foreground state color))
1385
1386 (defun style-bg (style state)
1387   (%style-get-color style :background state))
1388
1389 (defun (setf style-bg) (color style state)
1390   (%style-set-color style :background state color))
1391
1392 (defun style-text (style state)
1393   (%style-get-color style :text state))
1394
1395 (defun (setf style-text) (color style state)
1396   (%style-set-color style :text state color))
1397
1398 (defun style-base (style state)
1399   (%style-get-color style :base state))
1400
1401 (defun (setf style-base) (color style state)
1402   (%style-set-color style :base state color))
1403
1404 (defun style-white (style)
1405   (%style-get-color style :white :normal))
1406
1407 (defun (setf style-white) (color style)
1408   (%style-set-color style :white :normal color))
1409
1410 (defun style-black (style)
1411   (%style-get-color style :black :normal))
1412
1413 (defun (setf style-black) (color style)
1414   (%style-set-color style :black :normal color))
1415
1416 (defbinding style-get-gc () gdk:gc
1417   (style style)
1418   (color-type color-type)
1419   (state-type state-type))
1420
1421 |#
1422 (defbinding draw-hline () nil
1423   (style style)
1424   (window gdk:window)
1425   (state state-type)
1426   (x1 int)
1427   (x2 int)
1428   (y int))
1429
1430 (defbinding draw-vline () nil
1431   (style style)
1432   (window gdk:window)
1433   (state state-type)
1434   (y1 int)
1435   (y2 int)
1436   (x int))
1437
1438 (defbinding draw-shadow () nil
1439   (style style)
1440   (window gdk:window)
1441   (state state-type)
1442   (shadow shadow-type)
1443   (x int)
1444   (y int)
1445   (width int)
1446   (height int))
1447
1448 ; (defbinding draw-polygon () nil
1449 ;   (style style)
1450 ;   (window gdk:window)
1451 ;   (state state-type)
1452 ;   (shadow shadow-type)
1453 ;   (points (vector gdk:point))
1454 ;   ((length points) int)
1455 ;   (fill boolean))
1456
1457 (defbinding draw-arrow () nil
1458   (style style)
1459   (window gdk:window)
1460   (state state-type)
1461   (shadow shadow-type)
1462   (arrow arrow-type)
1463   (fill boolean)
1464   (x int)
1465   (y int)
1466   (width int)
1467   (height int))
1468
1469 (defbinding draw-diamond () nil
1470   (style style)
1471   (window gdk:window)
1472   (state state-type)
1473   (shadow shadow-type)
1474   (x int)
1475   (y int)
1476   (width int)
1477   (height int))
1478
1479 ; (defbinding draw-oval () nil
1480 ;   (style style)
1481 ;   (window gdk:window)
1482 ;   (state state-type)
1483 ;   (shadow shadow-type)
1484 ;   (x int)
1485 ;   (y int)
1486 ;   (width int)
1487 ;   (height int))
1488
1489 (defbinding draw-string () nil
1490   (style style)
1491   (window gdk:window)
1492   (state state-type)
1493   (x int)
1494   (y int)
1495   (string string))
1496
1497 (defbinding draw-box () nil
1498   (style style)
1499   (window gdk:window)
1500   (state state-type)
1501   (shadow shadow-type)
1502   (x int)
1503   (y int)
1504   (width int)
1505   (height int))
1506
1507 (defbinding draw-flat-box () nil
1508   (style style)
1509   (window gdk:window)
1510   (state state-type)
1511   (shadow shadow-type)
1512   (x int)
1513   (y int)
1514   (width int)
1515   (height int))
1516
1517 (defbinding draw-check () nil
1518   (style style)
1519   (window gdk:window)
1520   (state state-type)
1521   (shadow shadow-type)
1522   (x int)
1523   (y int)
1524   (width int)
1525   (height int))
1526
1527 (defbinding draw-option () nil
1528   (style style)
1529   (window gdk:window)
1530   (state state-type)
1531   (shadow shadow-type)
1532   (x int)
1533   (y int)
1534   (width int)
1535   (height int))
1536
1537 ; (defbinding draw-cross () nil
1538 ;   (style style)
1539 ;   (window gdk:window)
1540 ;   (state state-type)
1541 ;   (shadow shadow-type)
1542 ;   (x int)
1543 ;   (y int)
1544 ;   (width int)
1545 ;   (height int))
1546
1547 ; (defbinding draw-ramp () nil
1548 ;   (style style)
1549 ;   (window gdk:window)
1550 ;   (state state-type)
1551 ;   (shadow shadow-type)
1552 ;   (arrow arrow-type)
1553 ;   (x int)
1554 ;   (y int)
1555 ;   (width int)
1556 ;   (height int))
1557
1558 (defbinding draw-tab () nil
1559   (style style)
1560   (window gdk:window)
1561   (state state-type)
1562   (x int)
1563   (y int)
1564   (width int)
1565   (height int))
1566
1567 (defbinding draw-shadow-gap () nil
1568   (style style)
1569   (window gdk:window)
1570   (state state-type)
1571   (x int)
1572   (y int)
1573   (width int)
1574   (height int)
1575   (gap-side position-type)
1576   (gap-x int)
1577   (gap-width int))
1578
1579 (defbinding draw-box-gap () nil
1580   (style style)
1581   (window gdk:window)
1582   (state state-type)
1583   (x int)
1584   (y int)
1585   (width int)
1586   (height int)
1587   (gap-side position-type)
1588   (gap-x int)
1589   (gap-width int))
1590
1591 (defbinding draw-extension () nil
1592   (style style)
1593   (window gdk:window)
1594   (state state-type)
1595   (x int)
1596   (y int)
1597   (width int)
1598   (height int))
1599
1600 (defbinding draw-focus () nil
1601   (style style)
1602   (window gdk:window)
1603   (x int)
1604   (y int)
1605   (width int)
1606   (height int))
1607
1608 (defbinding draw-slider () nil
1609   (style style)
1610   (window gdk:window)
1611   (state state-type)
1612   (shadow shadow-type)
1613   (x int)
1614   (y int)
1615   (width int)
1616   (height int)
1617   (orientation orientation))
1618
1619 (defbinding draw-handle () nil
1620   (style style)
1621   (window gdk:window)
1622   (state state-type)
1623   (shadow shadow-type)
1624   (x int)
1625   (y int)
1626   (width int)
1627   (height int)
1628   (orientation orientation))
1629
1630 (defbinding draw-handle () nil
1631   (style style)
1632   (window gdk:window)
1633   (state state-type)
1634   (shadow shadow-type)
1635   (x int)
1636   (y int)
1637   (width int)
1638   (height int)
1639   (orientation orientation))
1640
1641 (defbinding paint-hline () nil
1642   (style style)
1643   (window gdk:window)
1644   (state state-type)
1645   (x1 int)
1646   (x2 int)
1647   (y int))