chiark / gitweb /
Removed code for deprecated tree widget
[clg] / gtk / gtk.lisp
CommitLineData
560af5c5 1;; Common Lisp bindings for GTK+ v2.0
2;; Copyright (C) 1999-2000 Espen S. Johnsen <espejohn@online.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
b9752933 18;; $Id: gtk.lisp,v 1.4 2001-01-28 14:25:48 espen Exp $
560af5c5 19
20
21(in-package "GTK")
22
23;;; Gtk version
24
25(define-foreign check-version () string
26 (required-major unsigned-int)
27 (required-minor unsigned-int)
28 (required-micro unsigned-int))
29
30(define-foreign 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
560af5c5 42
43
560af5c5 44;;; Label
45
46(define-foreign label-new () label
47 (text string))
48
49(define-foreign label-parse-uline () unsigned-int
50 (label label)
51 (string string))
52
53
54
55;;; Acccel label
56
57(define-foreign accel-label-new () accel-label
58 (text string))
59
60(define-foreign accel-label-refetch () boolean
61 (accel-label accel-label))
62
63
64
65;;; Tips query
66
67(define-foreign tips-query-new () tips-query)
68
69(define-foreign tips-query-start-query () nil
70 (tips-query tips-query))
71
72(define-foreign tips-query-stop-query () nil
73 (tips-query tips-query))
74
75
76
77;;; Arrow
78
79(define-foreign arrow-new () arrow
80 (arrow-type arrow-type)
81 (shadow-type shadow-type))
82
83
84
85;;; Pixmap
86
f36ca6af 87(defmethod initialize-instance ((pixmap pixmap) &rest initargs
88 &key source mask)
89 (declare (ignore initargs))
90 (call-next-method)
91 (if (typep source 'gdk:pixmap)
92 (pixmap-set pixmap source mask)
93 (multiple-value-bind (source mask) (gdk:pixmap-create source)
94 (pixmap-set pixmap source mask))))
560af5c5 95
f36ca6af 96(defun pixmap-new (source &optional mask)
97 (make-instance 'pixmap :source source :mask mask))
560af5c5 98
f36ca6af 99(define-foreign pixmap-set () nil
560af5c5 100 (pixmap pixmap)
f36ca6af 101 (source gdk:pixmap)
560af5c5 102 (mask (or null gdk:bitmap)))
103
f36ca6af 104(defun (setf pixmap-source) (source pixmap)
105 (if (typep source 'gdk:pixmap)
d520140e 106 (pixmap-set pixmap source (pixmap-mask pixmap))
f36ca6af 107 (multiple-value-bind (source mask) (gdk:pixmap-create source)
108 (pixmap-set pixmap source mask)))
109 source)
560af5c5 110
f36ca6af 111(defun (setf pixmap-mask) (mask pixmap)
d520140e 112 (pixmap-set pixmap (pixmap-source pixmap) mask)
f36ca6af 113 mask)
114
115(define-foreign ("gtk_pixmap_get" pixmap-source) () nil
560af5c5 116 (pixmap pixmap)
117 (val gdk:pixmap :out)
f36ca6af 118 (nil null))
119
120(define-foreign ("gtk_pixmap_get" pixmap-mask) () nil
121 (pixmap pixmap)
122 (nil null)
560af5c5 123 (mask gdk:bitmap :out))
124
125
126
127;;; Bin
128
129(defun bin-child (bin)
130 (first (container-children bin)))
131
132(defun (setf bin-child) (child bin)
133 (let ((old-child (bin-child bin)))
134 (when old-child
135 (container-remove bin old-child)))
136 (container-add bin child)
137 child)
138
d520140e 139(defmethod initialize-instance ((bin bin) &rest initargs &key child)
140 (declare (ignore initargs))
141 (call-next-method)
142 (cond
143 ((consp child)
144 (container-add bin (first child))
145 (setf
146 (slot-value (first child) 'child-slots)
147 (apply
148 #'make-instance
149 (slot-value (class-of bin) 'child-class)
150 :parent bin :child (first child) (cdr child))))
151 (child
152 (container-add bin child))))
560af5c5 153
f36ca6af 154
560af5c5 155;;; Alignment
156
157(define-foreign alignment-new () alignment
158 (xalign single-float)
159 (ylign single-float)
160 (xscale single-float)
161 (yscale single-float))
162
163
164
165;;; Frame
166
167(define-foreign frame-new (&optional label) frame
168 (label string))
169
170
171
172;;; Aspect frame
173
174(define-foreign aspect-frame-new () alignment
175 (xalign single-float)
176 (ylign single-float)
177 (ratio single-float)
178 (obey-child boolean))
179
180
181
182;;; Button
183
184(define-foreign %button-new () button)
185
186(define-foreign %button-new-with-label () button
187 (label string))
188
189(defun button-new (&optional label)
190 (if label
191 (%button-new-with-label label)
192 (%button-new)))
193
194(define-foreign button-pressed () nil
195 (button button))
196
197(define-foreign button-released () nil
198 (button button))
199
200(define-foreign button-clicked () nil
201 (button button))
202
203(define-foreign button-enter () nil
204 (button button))
205
206(define-foreign button-leave () nil
207 (button button))
208
209
210
211;;; Toggle button
212
213(define-foreign %toggle-button-new () toggle-button)
214
215(define-foreign %toggle-button-new-with-label () toggle-button
216 (label string))
217
218(defun toggle-button-new (&optional label)
219 (if label
220 (%toggle-button-new-with-label label)
221 (%toggle-button-new)))
222
223(define-foreign toggle-button-toggled () nil
224 (toggle-button toggle-button))
225
226
227
228;;; Check button
229
230(define-foreign %check-button-new () check-button)
231
232(define-foreign %check-button-new-with-label () check-button
233 (label string))
234
235(defun check-button-new (&optional label)
236 (if label
237 (%check-button-new-with-label label)
238 (%check-button-new)))
239
f36ca6af 240(defmethod (setf button-label) ((label string) (button check-button))
241 (call-next-method)
242 (setf (misc-xalign (bin-child button)) 0.0)
243 label)
244
560af5c5 245
246
247;;; Radio button
248
560af5c5 249(define-foreign %radio-button-new-with-label-from-widget () radio-button
d520140e 250 (widget (or null radio-button))
560af5c5 251 (label string))
252
253(define-foreign %radio-button-new-from-widget () radio-button
d520140e 254 (widget (or null radio-button)))
560af5c5 255
d520140e 256(defun radio-button-new (&optional label group-with)
257 (if label
258 (%radio-button-new-with-label-from-widget group-with label))
259 (%radio-button-new-from-widget group-with))
560af5c5 260
d520140e 261(define-foreign ("gtk_radio_button_group" %radio-button-get-group) () pointer
262 (radio-button radio-button))
263
264(define-foreign %radio-button-set-group () nil
265 (radio-button radio-button)
266 (group pointer))
560af5c5 267
d520140e 268(defun radio-button-add-to-group (button1 button2)
269 "Add BUTTON1 to the group which BUTTON2 belongs to."
270 (%radio-button-set-group button1 (%radio-button-get-group button2)))
271
272(defmethod initialize-instance ((button radio-button)
273 &rest initargs &key group)
274 (call-next-method)
275 (when group
276 (radio-button-add-to-group item group)))
560af5c5 277
278
279;;; Option menu
280
f36ca6af 281(define-foreign option-menu-new () option-menu)
560af5c5 282
f36ca6af 283(define-foreign %option-menu-set-menu () nil
284 (option-menu option-menu)
285 (menu widget))
560af5c5 286
f36ca6af 287(define-foreign %option-menu-remove-menu () nil
288 (option-menu option-menu))
560af5c5 289
f36ca6af 290(defun (setf option-menu-menu) (menu option-menu)
291 (if (not menu)
292 (%option-menu-remove-menu option-menu)
293 (%option-menu-set-menu option-menu menu))
294 menu)
560af5c5 295
296
297
298;;; Item
299
300(define-foreign item-select () nil
301 (item item))
302
303(define-foreign item-deselect () nil
304 (item item))
305
306(define-foreign item-toggle () nil
307 (item item))
308
309
310
311;;; Menu item
312
f36ca6af 313(define-foreign %menu-item-new () menu-item)
560af5c5 314
f36ca6af 315(define-foreign %menu-item-new-with-label () menu-item
316 (label string))
560af5c5 317
f36ca6af 318(defun menu-item-new (&optional label)
319 (if label
320 (%menu-item-new-with-label label)
321 (%menu-item-new)))
560af5c5 322
f36ca6af 323(defun (setf menu-item-label) (label menu-item)
324 (make-instance 'accel-label
325 :label label :xalign 0.0 :yalign 0.5 :accel-widget menu-item
326 :visible t :parent menu-item)
327 label)
560af5c5 328
f36ca6af 329(define-foreign %menu-item-set-submenu () nil
330 (menu-item menu-item)
331 (submenu menu))
560af5c5 332
f36ca6af 333(define-foreign %menu-item-remove-submenu () nil
334 (menu-item menu-item))
560af5c5 335
f36ca6af 336(defun (setf menu-item-submenu) (submenu menu-item)
337 (if (not submenu)
338 (%menu-item-remove-submenu menu-item)
339 (%menu-item-set-submenu menu-item submenu))
340 submenu)
560af5c5 341
f36ca6af 342(define-foreign %menu-item-configure () nil
343 (menu-item menu-item)
344 (show-toggle-indicator boolean)
345 (show-submenu-indicator boolean))
560af5c5 346
f36ca6af 347(defun (setf menu-item-toggle-indicator-p) (show menu-item)
348 (%menu-item-configure
349 menu-item
350 show
351 (menu-item-submenu-indicator-p menu-item))
352 show)
560af5c5 353
f36ca6af 354(defun (setf menu-item-submenu-indicator-p) (show menu-item)
355 (%menu-item-configure
356 menu-item
357 (menu-item-toggle-indicator-p menu-item)
358 show))
560af5c5 359
f36ca6af 360(define-foreign menu-item-select () nil
361 (menu-item menu-item))
560af5c5 362
f36ca6af 363(define-foreign menu-item-deselect () nil
364 (menu-item menu-item))
560af5c5 365
f36ca6af 366(define-foreign menu-item-activate () nil
367 (menu-item menu-item))
560af5c5 368
f36ca6af 369(define-foreign menu-item-right-justify () nil
370 (menu-item menu-item))
560af5c5 371
372
373
f36ca6af 374;;; Check menu item
560af5c5 375
f36ca6af 376(define-foreign %check-menu-item-new
377 () check-menu-item)
560af5c5 378
f36ca6af 379(define-foreign %check-menu-item-new-with-label () check-menu-item
380 (label string))
560af5c5 381
f36ca6af 382(defun check-menu-item-new (&optional label)
383 (if label
384 (%check-menu-item-new-with-label label)
385 (%check-menu-item-new)))
560af5c5 386
f36ca6af 387(define-foreign check-menu-item-toggled () nil
388 (check-menu-item check-menu-item))
560af5c5 389
390
391
f36ca6af 392;;; Radio menu item
560af5c5 393
d520140e 394(define-foreign %radio-menu-item-new () radio-menu-item
395 (group pointer))
560af5c5 396
f36ca6af 397(define-foreign %radio-menu-item-new-with-label () radio-menu-item
d520140e 398 (group pointer)
f36ca6af 399 (label string))
560af5c5 400
d520140e 401(define-foreign
402 ("gtk_radio_menu_item_group" %radio-menu-item-get-group) () pointer
403 (radio-menu-item radio-menu-item))
404
405(define-foreign %radio-menu-item-set-group () nil
406 (radio-menu-item radio-menu-item)
407 (group pointer))
408
409(defun radio-menu-item-new (&optional label group-with)
410 (let ((group
411 (if group-with
412 (%radio-menu-item-get-group group-with)
413 (make-pointer 0))))
414 (if label
415 (%radio-menu-item-new-with-label group label)
416 (%radio-menu-item-new group))))
417
418(defun radio-menu-item-add-to-group (item1 item2)
419 "Add ITEM1 to the group which ITEM2 belongs to."
420 (%radio-menu-item-set-group item1 (%radio-menu-item-get-group item2)))
421
422(defmethod initialize-instance ((item radio-menu-item)
423 &rest initargs &key group)
424 (call-next-method)
425 (when group
426 (radio-menu-item-add-to-group item group)))
427
560af5c5 428
429
f36ca6af 430;;; Tearoff menu item
560af5c5 431
f36ca6af 432(define-foreign tearoff-menu-item-new () tearoff-menu-item)
560af5c5 433
434
435
436;;; List item
437
438(define-foreign %list-item-new () list-item)
439
440(define-foreign %list-item-new-with-label () list-item
441 (label string))
442
443(defun list-item-new (&optional label)
444 (if label
445 (%list-item-new-with-label label)
446 (%list-item-new)))
447
448(define-foreign list-item-select () nil
449 (list-item list-item))
450
451(define-foreign list-item-deselect () nil
452 (list-item list-item))
453
454
560af5c5 455;;; Window
456
457(define-foreign window-new () window
458 (type window-type))
459
460(define-foreign %window-set-wmclass () nil
461 (window window)
462 (wmclass-name string)
463 (wmclass-class string))
464
465(defun (setf window-wmclass) (wmclass window)
466 (%window-set-wmclass window (svref wmclass 0) (svref wmclass 1))
467 (values (svref wmclass 0) (svref wmclass 1)))
468
f36ca6af 469;; gtkglue.c
560af5c5 470(define-foreign window-wmclass () nil
471 (window window)
472 (wmclass-name string :out)
473 (wmclass-class string :out))
474
475(define-foreign window-add-accel-group () nil
476 (window window)
477 (accel-group accel-group))
478
479(define-foreign window-remove-accel-group () nil
480 (window window)
481 (accel-group accel-group))
482
483(define-foreign window-activate-focus () int
484 (window window))
485
486(define-foreign window-activate-default () int
487 (window window))
488
489(define-foreign window-set-transient-for () nil
490 (window window)
491 (parent window))
492
493;(define-foreign window-set-geometry-hints)
494
495
496
560af5c5 497;;; Dialog
498
f36ca6af 499(define-foreign dialog-new () dialog)
560af5c5 500
501
d520140e 502;;; Color selection dialog
503
504(define-foreign color-selection-dialog-new () color-selection-dialog
505 (title string))
506
560af5c5 507
508;;; Input dialog
509
f36ca6af 510(define-foreign input-dialog-new () dialog)
560af5c5 511
512
513
514;;; File selection
515
d520140e 516(define-foreign file-selection-new () file-selection
517 (title string))
560af5c5 518
d520140e 519(define-foreign file-selection-complete () nil
520 (file-selection file-selection)
521 (pattern string))
560af5c5 522
d520140e 523(define-foreign file-selection-show-fileop-buttons () nil
524 (file-selection file-selection))
560af5c5 525
d520140e 526(define-foreign file-selection-hide-fileop-buttons () nil
527 (file-selection file-selection))
560af5c5 528
529
530
f36ca6af 531;;; Handle box
560af5c5 532
f36ca6af 533(define-foreign handle-box-new () handle-box)
560af5c5 534
535
536
f36ca6af 537;;; Scrolled window
560af5c5 538
539(define-foreign scrolled-window-new
540 (&optional hadjustment vadjustment) scrolled-window
541 (hadjustment (or null adjustment))
542 (vadjustment (or null adjustment)))
543
544(defun (setf scrolled-window-scrollbar-policy) (policy window)
545 (setf (scrolled-window-hscrollbar-policy window) policy)
546 (setf (scrolled-window-vscrollbar-policy window) policy))
547
548(define-foreign scrolled-window-add-with-viewport () nil
549 (scrolled-window scrolled-window)
550 (child widget))
551
552
553
f36ca6af 554;;; Viewport
560af5c5 555
f36ca6af 556(define-foreign viewport-new () viewport
557 (hadjustment adjustment)
558 (vadjustment adjustment))
560af5c5 559
560
561
562;;; Box
563
564(define-foreign box-pack-start () nil
565 (box box)
566 (child widget)
567 (expand boolean)
568 (fill boolean)
569 (padding unsigned-int))
570
571(define-foreign box-pack-end () nil
572 (box box)
573 (child widget)
574 (expand boolean)
575 (fill boolean)
576 (padding unsigned-int))
577
578(defun box-pack (box child &key (pack :start) (expand t) (fill t) (padding 0))
579 (if (eq pack :start)
580 (box-pack-start box child expand fill padding)
581 (box-pack-end box child expand fill padding)))
582
583(define-foreign box-reorder-child () nil
584 (box box)
585 (child widget)
586 (position int))
587
588(define-foreign box-query-child-packing () nil
589 (box box)
590 (child widget :out)
591 (expand boolean :out)
592 (fill boolean :out)
593 (padding unsigned-int :out)
594 (pack-type pack-type :out))
595
596(define-foreign box-set-child-packing () nil
597 (box box)
598 (child widget)
599 (expand boolean)
600 (fill boolean)
601 (padding unsigned-int)
602 (pack-type pack-type))
603
604
605
606;;; Button box
607
608(define-foreign ("gtk_button_box_get_child_size_default"
d520140e 609 button-box-get-default-child-size) () nil
560af5c5 610 (min-width int :out)
611 (min-height int :out))
612
d520140e 613(define-foreign ("gtk_button_box_set_child_size_default"
614 button-box-set-default-child-size) () nil
560af5c5 615 (min-width int)
616 (min-height int))
617
d520140e 618(define-foreign ("gtk_button_box_get_child_ipadding_default"
619 button-box-get-default-child-ipadding) () nil
560af5c5 620 (ipad-x int :out)
621 (ipad-y int :out))
622
560af5c5 623
d520140e 624(define-foreign ("gtk_button_box_get_child_ipadding_default"
625 button-box-set-default-child-ipadding) () nil
560af5c5 626 (ipad-x int)
627 (ipad-y int))
628
560af5c5 629
630
631;;; HButton box
632
f36ca6af 633(define-foreign hbutton-box-new () hbutton-box)
560af5c5 634
635(define-foreign ("gtk_hbutton_box_get_spacing_default"
636 hbutton-box-default-spacing) () int)
637
d520140e 638(define-foreign %hbutton-box-set-spacing-default () nil
560af5c5 639 (spacing int))
d520140e 640
641(defun (setf hbutton-box-default-spacing) (spacing)
642 (%hbutton-box-set-spacing-default spacing))
560af5c5 643
644(define-foreign ("gtk_hbutton_box_get_layout_default"
645 hbutton-box-default-layout) () button-box-style)
646
d520140e 647(define-foreign %hbutton-box-set-layout-default () nil
560af5c5 648 (layout button-box-style))
649
d520140e 650(defun (setf hbutton-box-default-layout) (layout)
651 (%hbutton-box-set-layout-default layout))
652
560af5c5 653
654
655;;; VButton Box
656
f36ca6af 657(define-foreign vbutton-box-new () vbutton-box)
560af5c5 658
659(define-foreign ("gtk_vbutton_box_get_spacing_default"
660 vbutton-box-default-spacing) () int)
661
d520140e 662(define-foreign %vbutton-box-set-spacing-default () nil
560af5c5 663 (spacing int))
d520140e 664
665(defun (setf vbutton-box-default-spacing) (spacing)
666 (%vbutton-box-set-spacing-default spacing))
560af5c5 667
668(define-foreign ("gtk_vbutton_box_get_layout_default"
669 vbutton-box-default-layout) () button-box-style)
670
d520140e 671(define-foreign %vbutton-box-set-layout-default () nil
560af5c5 672 (layout button-box-style))
673
d520140e 674(defun (setf vbutton-box-default-layout) (layout)
675 (%vbutton-box-set-layout-default layout))
676
560af5c5 677
678
679;;; VBox
680
681(define-foreign vbox-new () vbox
682 (homogeneous boolean)
683 (spacing int))
684
685
686
687;;; Color selection
688
d520140e 689(define-foreign color-selection-new () color-selection)
560af5c5 690
d520140e 691(define-foreign %color-selection-get-color () nil
692 (colorsel color-selection)
693 (color pointer))
560af5c5 694
d520140e 695(defun color-selection-color (colorsel)
696 (let ((color (allocate-memory (* (size-of 'double-float) 4))))
697 (%color-selection-get-color colorsel color)
698 (funcall (get-from-alien-function '(vector double-float 4)) color)))
699
700(define-foreign %color-selection-set-color () nil
701 (colorsel color-selection)
702 (color (vector double-float 4)))
703
704(defun (setf color-selection-color) (color colorsel)
705 (%color-selection-set-color colorsel color)
706 color)
707
708(define-foreign %color-selection-get-old-color () nil
709 (colorsel color-selection)
710 (color pointer))
560af5c5 711
d520140e 712(defun color-selection-old-color (colorsel)
713 (let ((color (allocate-memory (* (size-of 'double-float) 4))))
714 (%color-selection-get-old-color colorsel color)
715 (funcall (get-from-alien-function '(vector double-float 4)) color)))
560af5c5 716
d520140e 717(define-foreign %color-selection-set-old-color () nil
718 (colorsel color-selection)
719 (color (vector double-float 4)))
560af5c5 720
d520140e 721(defun (setf color-selection-old-color) (color colorsel)
722 (%color-selection-set-old-color colorsel color)
723 color)
560af5c5 724
d520140e 725(define-foreign %color-selection-get-palette-color () boolean
726 (colorsel color-selection)
727 (x int)
728 (y int)
729 (color (vector double-float 4) :out))
560af5c5 730
d520140e 731(defun color-selection-palette-color (colorsel x y)
732 (multiple-value-bind (color-set-p color)
733 (%color-selection-get-palette-color colorsel x y)
734 (and color-set-p color)))
560af5c5 735
d520140e 736(define-foreign %color-selection-set-palette-color () nil
737 (colorsel color-selection)
738 (x int)
739 (y int)
740 (color (vector double-float 4)))
741
742(define-foreign %color-selection-unset-palette-color () nil
743 (colorsel color-selection)
744 (x int)
745 (y int))
746
747(defun (setf color-selection-palette-color) (color colorsel x y)
748 (if color
749 (%color-selection-set-palette-color colorsel x y color)
750 (%color-selection-unset-palette-color colorsel x y))
751 color)
752
753(define-foreign ("gtk_color_selection_is_adjusting"
754 color-selection-is-adjusting-p) () boolean
755 (colorsel color-selection))
756
757
758
759;;; Gamma curve
760
761;(define-foreign gamma-curve-new () gamma-curve)
560af5c5 762
763
764
765;;; HBox
766
767(define-foreign hbox-new () hbox
768 (homogeneous boolean)
769 (spacing int))
770
771
772
773;;; Combo
774
f36ca6af 775(define-foreign combo-new () combo)
560af5c5 776
f36ca6af 777(define-foreign combo-set-value-in-list () nil
778 (combo combo)
779 (val boolean)
780 (ok-if-empty boolean))
560af5c5 781
782; (define-foreign ("gtk_combo_set_item_string" (setf combo-item-string)) () nil
783; (combo combo)
784; (item item)
785; (item-value string))
786
f36ca6af 787(define-foreign %combo-set-popdown-strings () nil
788 (combo combo)
d520140e 789 (strings (glist string)))
560af5c5 790
f36ca6af 791(defun (setf combo-popdown-strings) (strings combo)
792 (%combo-set-popdown-strings combo strings)
793 strings)
560af5c5 794
f36ca6af 795(define-foreign combo-disable-activate () nil
796 (combo combo))
560af5c5 797
560af5c5 798
560af5c5 799
f36ca6af 800;;; Statusbar
560af5c5 801
f36ca6af 802(define-foreign statusbar-new () statusbar)
560af5c5 803
f36ca6af 804(define-foreign
805 ("gtk_statusbar_get_context_id" statusbar-context-id) () unsigned-int
806 (statusbar statusbar)
807 (context-description string))
560af5c5 808
f36ca6af 809(define-foreign statusbar-push () unsigned-int
810 (statusbar statusbar)
811 (context-id unsigned-int)
812 (text string))
560af5c5 813
f36ca6af 814(define-foreign statusbar-pop () nil
815 (statusbar statusbar)
816 (context-id unsigned-int))
560af5c5 817
f36ca6af 818(define-foreign statusbar-remove () nil
819 (statusbar statusbar)
820 (context-id unsigned-int)
821 (message-id unsigned-int))
560af5c5 822
560af5c5 823
824
825;;; Fixed
826
f36ca6af 827(define-foreign fixed-new () fixed)
560af5c5 828
f36ca6af 829(define-foreign fixed-put () nil
830 (fixed fixed)
831 (widget widget)
832 (x (signed 16))
833 (y (signed 16)))
560af5c5 834
f36ca6af 835(define-foreign fixed-move () nil
836 (fixed fixed)
837 (widget widget)
838 (x (signed 16))
839 (y (signed 16)))
560af5c5 840
841
842
d520140e 843;;; Notebook
560af5c5 844
f36ca6af 845(define-foreign notebook-new () notebook)
560af5c5 846
f36ca6af 847(define-foreign ("gtk_notebook_insert_page_menu" notebook-insert-page)
848 (notebook position child tab-label &optional menu-label) nil
849 (notebook notebook)
850 (child widget)
851 ((if (stringp tab-label)
852 (label-new tab-label)
853 tab-label) widget)
854 ((if (stringp menu-label)
855 (label-new menu-label)
856 menu-label) (or null widget))
857 (position int))
560af5c5 858
f36ca6af 859(defun notebook-append-page (notebook child tab-label &optional menu-label)
860 (notebook-insert-page notebook -1 child tab-label menu-label))
560af5c5 861
f36ca6af 862(defun notebook-prepend-page (notebook child tab-label &optional menu-label)
863 (notebook-insert-page notebook 0 child tab-label menu-label))
560af5c5 864
f36ca6af 865(define-foreign notebook-remove-page () nil
866 (notebook notebook)
867 (page-num int))
560af5c5 868
869; (defun notebook-current-page-num (notebook)
870; (let ((page-num (notebook-current-page notebook)))
871; (if (= page-num -1)
872; nil
873; page-num)))
874
f36ca6af 875(define-foreign ("gtk_notebook_get_nth_page" notebook-nth-page-child) () widget
876 (notebook notebook)
877 (page-num int))
560af5c5 878
f36ca6af 879(defun notebook-page-child (notebook)
880 (notebook-nth-page-child notebook (notebook-page notebook)))
560af5c5 881
f36ca6af 882(define-foreign %notebook-page-num () int
883 (notebook notebook)
884 (child widget))
885
886(defun notebook-child-num (notebook child)
887 (let ((page-num (%notebook-page-num notebook child)))
888 (if (= page-num -1)
889 nil
890 page-num)))
891
892(define-foreign notebook-next-page () nil
893 (notebook notebook))
560af5c5 894
f36ca6af 895(define-foreign notebook-prev-page () nil
896 (notebook notebook))
897
898(define-foreign notebook-popup-enable () nil
899 (notebook notebook))
900
901(define-foreign notebook-popup-disable () nil
902 (notebook notebook))
903
904(define-foreign
905 ("gtk_notebook_get_tab_label" notebook-tab-label) (notebook ref) widget
906 (notebook notebook)
907 ((if (typep ref 'widget)
908 ref
909 (notebook-nth-page-child notebook ref))
910 widget))
911
912(define-foreign %notebook-set-tab-label () nil
913 (notebook notebook)
914 (reference widget)
915 (tab-label widget))
916
917(defun (setf notebook-tab-label) (tab-label notebook reference)
918 (let ((tab-label-widget (if (stringp tab-label)
919 (label-new tab-label)
920 tab-label)))
921 (%notebook-set-tab-label
922 notebook
923 (if (typep reference 'widget)
924 reference
925 (notebook-nth-page-child notebook reference))
926 tab-label-widget)
f36ca6af 927 tab-label-widget))
560af5c5 928
f36ca6af 929(define-foreign
930 ("gtk_notebook_get_menu_label" notebook-menu-label) (notebook ref) widget
931 (notebook notebook)
932 ((if (typep ref 'widget)
933 ref
934 (notebook-nth-page-child notebook ref))
935 widget))
936
937(define-foreign %notebook-set-menu-label () nil
938 (notebook notebook)
939 (reference widget)
940 (menu-label widget))
941
942(defun (setf notebook-menu-label) (menu-label notebook reference)
943 (let ((menu-label-widget (if (stringp menu-label)
944 (label-new menu-label)
945 menu-label)))
946 (%notebook-set-menu-label
947 notebook
948 (if (typep reference 'widget)
949 reference
950 (notebook-nth-page-child notebook reference))
951 menu-label-widget)
f36ca6af 952 menu-label-widget))
953
954(define-foreign notebook-query-tab-label-packing (notebook ref) nil
955 (notebook notebook)
956 ((if (typep ref 'widget)
957 ref
958 (notebook-nth-page-child notebook ref))
959 widget)
960 (expand boolean :out)
961 (fill boolean :out)
962 (pack-type pack-type :out))
963
964(define-foreign
965 notebook-set-tab-label-packing (notebook ref expand fill pack-type) nil
966 (notebook notebook)
967 ((if (typep ref 'widget)
968 ref
969 (notebook-nth-page-child notebook ref))
970 widget)
971 (expand boolean)
972 (fill boolean)
973 (pack-type pack-type))
974
975(define-foreign notebook-reorder-child () nil
976 (notebook notebook)
977 (child widget)
978 (position int))
560af5c5 979
980
981
d520140e 982;;; Font selection
560af5c5 983
984
985
986
d520140e 987;;; Paned
560af5c5 988
d520140e 989(define-foreign paned-pack1 () nil
990 (paned paned)
991 (child widget)
992 (resize boolean)
993 (shrink boolean))
560af5c5 994
d520140e 995(define-foreign paned-pack2 () nil
996 (paned paned)
997 (child widget)
998 (resize boolean)
999 (shrink boolean))
560af5c5 1000
d520140e 1001;; gtkglue.c
1002(define-foreign paned-child1 () widget
1003 (paned paned)
1004 (resize boolean :out)
1005 (shrink boolean :out))
560af5c5 1006
d520140e 1007;; gtkglue.c
1008(define-foreign paned-child2 () widget
1009 (paned paned)
1010 (resize boolean :out)
1011 (shrink boolean :out))
560af5c5 1012
d520140e 1013(defun (setf paned-child1) (child paned)
1014 (paned-pack1 paned child nil t))
560af5c5 1015
d520140e 1016(defun (setf paned-child2) (child paned)
1017 (paned-pack2 paned child t t))
560af5c5 1018
560af5c5 1019
d520140e 1020(define-foreign vpaned-new () vpaned)
560af5c5 1021
d520140e 1022(define-foreign hpaned-new () hpaned)
560af5c5 1023
1024
1025
d520140e 1026;;; Layout
560af5c5 1027
d520140e 1028(define-foreign layout-new (&optional hadjustment vadjustment) layout
1029 (hadjustment (or null adjustment))
1030 (vadjustment (or null adjustment)))
560af5c5 1031
d520140e 1032(define-foreign layout-put () nil
1033 (layout layout)
1034 (widget widget)
1035 (x int)
1036 (y int))
560af5c5 1037
d520140e 1038(define-foreign layout-move () nil
1039 (layout layout)
1040 (widget widget)
1041 (x int)
1042 (y int))
560af5c5 1043
d520140e 1044(define-foreign layout-set-size () nil
1045 (layout layout)
1046 (width int)
1047 (height int))
560af5c5 1048
d520140e 1049;; gtkglue.c
1050(define-foreign layout-get-size () nil
1051 (layout layout)
1052 (width int :out)
1053 (height int :out))
560af5c5 1054
d520140e 1055(defun layout-x-size (layout)
1056 (nth-value 0 (layout-get-size layout)))
1057
1058(defun layout-y-size (layout)
1059 (nth-value 1 (layout-get-size layout)))
1060
1061(defun (setf layout-x-size) (x layout)
1062 (layout-set-size layout x (layout-y-size layout)))
560af5c5 1063
d520140e 1064(defun (setf layout-y-size) (y layout)
1065 (layout-set-size layout (layout-x-size layout) y))
560af5c5 1066
d520140e 1067(define-foreign layout-freeze () nil
1068 (layout layout))
560af5c5 1069
d520140e 1070(define-foreign layout-thaw () nil
1071 (layout layout))
560af5c5 1072
1073
1074
1075;;; List
1076
1077; (define-foreign list-new () list-widget)
1078
1079; (define-foreign list-insert-items () nil
1080; (list list-widget)
1081; (items (list list-item))
1082; (position int))
1083
1084; (define-foreign list-append-items () nil
1085; (list list-widget)
d520140e 1086; (items (glist list-item)))
560af5c5 1087
1088; (define-foreign list-prepend-items () nil
1089; (list list-widget)
d520140e 1090; (items (glist list-item)))
560af5c5 1091
1092; (define-foreign %list-remove-items () nil
1093; (list list-widget)
d520140e 1094; (items (glist list-item)))
560af5c5 1095
1096; (define-foreign %list-remove-items-no-unref () nil
1097; (list list-widget)
d520140e 1098; (items (glist list-item)))
560af5c5 1099
1100; (defun list-remove-items (list items &key no-unref)
1101; (if no-unref
1102; (%list-remove-items-no-unref list items)
1103; (%list-remove-items list items)))
1104
1105; (define-foreign list-clear-items () nil
1106; (list list-widget)
1107; (start int)
1108; (end int))
1109
1110; (define-foreign list-select-item () nil
1111; (list list-widget)
1112; (item int))
1113
1114; (define-foreign list-unselect-item () nil
1115; (list list-widget)
1116; (item int))
1117
1118; (define-foreign list-select-child () nil
1119; (list list-widget)
1120; (child widget))
1121
1122; (define-foreign list-unselect-child () nil
1123; (list list-widget)
1124; (child widget))
1125
1126; (define-foreign list-child-position () int
1127; (list list-widget)
1128; (child widget))
1129
1130; (define-foreign list-extend-selection () nil
1131; (list list-widget)
1132; (scroll-type scroll-type)
1133; (position single-float)
1134; (auto-start-selection boolean))
1135
1136; (define-foreign list-start-selection () nil
1137; (list list-widget))
1138
1139; (define-foreign list-end-selection () nil
1140; (list list-widget))
1141
1142; (define-foreign list-select-all () nil
1143; (list list-widget))
1144
1145; (define-foreign list-unselect-all () nil
1146; (list list-widget))
1147
1148; (define-foreign list-scroll-horizontal () nil
1149; (list list-widget)
1150; (scroll-type scroll-type)
1151; (position single-float))
1152
1153; (define-foreign list-scroll-vertical () nil
1154; (list list-widget)
1155; (scroll-type scroll-type)
1156; (position single-float))
1157
1158; (define-foreign list-toggle-add-mode () nil
1159; (list list-widget))
1160
1161; (define-foreign list-toggle-focus-row () nil
1162; (list list-widget))
1163
1164; (define-foreign list-toggle-row () nil
1165; (list list-widget)
1166; (item list-item))
1167
1168; (define-foreign list-undo-selection () nil
1169; (list list-widget))
1170
1171; (define-foreign list-end-drag-selection () nil
1172; (list list-widget))
1173
f36ca6af 1174; ;; gtkglue.c
d520140e 1175; (define-foreign list-selection () (glist list-item)
560af5c5 1176; (list list-widget))
1177
1178
1179
1180;;; Menu shell
1181
f36ca6af 1182(define-foreign menu-shell-insert () nil
1183 (menu-shell menu-shell)
1184 (menu-item menu-item)
1185 (position int))
560af5c5 1186
f36ca6af 1187(defun menu-shell-append (menu-shell menu-item)
1188 (menu-shell-insert menu-shell menu-item -1))
560af5c5 1189
f36ca6af 1190(defun menu-shell-prepend (menu-shell menu-item)
1191 (menu-shell-insert menu-shell menu-item 0))
560af5c5 1192
f36ca6af 1193(define-foreign menu-shell-deactivate () nil
1194 (menu-shell menu-shell))
560af5c5 1195
f36ca6af 1196(define-foreign menu-shell-select-item () nil
1197 (menu-shell menu-shell)
1198 (menu-item menu-item))
560af5c5 1199
f36ca6af 1200(define-foreign menu-shell-deselect () nil
1201 (menu-shell menu-shell))
560af5c5 1202
f36ca6af 1203(define-foreign menu-shell-activate-item () nil
1204 (menu-shell menu-shell)
1205 (menu-item menu-item)
1206 (fore-deactivate boolean))
560af5c5 1207
1208
1209
1210; ;;; Menu bar
1211
f36ca6af 1212(define-foreign menu-bar-new () menu-bar)
560af5c5 1213
1214; (define-foreign menu-bar-insert () nil
1215; (menu-bar menu-bar)
1216; (menu menu)
1217; (position int))
1218
1219; (defun menu-bar-append (menu-bar menu)
1220; (menu-bar-insert menu-bar menu -1))
1221
1222; (defun menu-bar-prepend (menu-bar menu)
1223; (menu-bar-insert menu-bar menu 0))
1224
1225
1226
1227; ;;; Menu
1228
f36ca6af 1229(define-foreign menu-new () menu)
560af5c5 1230
1231; (defun menu-insert (menu menu-item position)
1232; (menu-shell-insert menu menu-item position))
1233
1234; (defun menu-append (menu menu-item)
1235; (menu-shell-append menu menu-item))
1236
1237; (defun menu-prepend (menu menu-item)
1238; (menu-shell-prepend menu menu-item))
1239
f36ca6af 1240;(defun menu-popup ...)
560af5c5 1241
f36ca6af 1242(define-foreign menu-reposition () nil
1243 (menu menu))
560af5c5 1244
f36ca6af 1245(define-foreign menu-popdown () nil
1246 (menu menu))
560af5c5 1247
f36ca6af 1248(define-foreign ("gtk_menu_get_active" menu-active) () widget
1249 (menu menu))
560af5c5 1250
d520140e 1251(define-foreign %menu-set-active () nil
f36ca6af 1252 (menu menu)
1253 (index unsigned-int))
560af5c5 1254
d520140e 1255(defun (setf menu-active) (menu index)
1256 (%menu-set-active menu index))
1257
f36ca6af 1258;(defun menu-attach-to-widget ...)
560af5c5 1259
f36ca6af 1260(define-foreign menu-detach () nil
1261 (menu menu))
560af5c5 1262
f36ca6af 1263(define-foreign ("gtk_menu_get_attach_widget" menu-attach-widget) () widget
1264 (menu menu))
560af5c5 1265
f36ca6af 1266(define-foreign menu-reorder-child () nil
1267 (menu menu)
1268 (menu-item menu-item)
1269 (position int))
560af5c5 1270
1271
1272
1273;;; Packer
1274
f36ca6af 1275(define-foreign packer-new () packer)
1276
1277(define-foreign packer-add
1278 (packer child side anchor
1279 &key
1280 options
1281 (border-width (packer-default-border-width packer))
1282 (pad-x (packer-default-pad-x packer))
1283 (pad-y (packer-default-pad-y packer))
1284 (ipad-x (packer-default-ipad-x packer))
1285 (ipad-y (packer-default-ipad-y packer))) nil
1286 (packer packer)
1287 (child widget)
1288 (side side-type)
1289 (anchor anchor-type)
1290 (options packer-options)
1291 (border-width unsigned-int)
1292 (pad-x unsigned-int)
1293 (pad-y unsigned-int)
1294 (ipad-x unsigned-int)
1295 (ipad-y unsigned-int))
1296
1297(define-foreign packer-set-child-packing () nil
1298 (packer packer)
1299 (child widget)
1300 (side side-type)
1301 (anchor anchor-type)
1302 (options packer-options)
1303 (border-width unsigned-int)
1304 (pad-x unsigned-int)
1305 (pad-y unsigned-int)
1306 (ipad-x unsigned-int)
1307 (ipad-y unsigned-int))
1308
1309(define-foreign packer-reorder-child () nil
1310 (packer packer)
1311 (child widget)
1312 (position int))
560af5c5 1313
1314
1315
f36ca6af 1316;;; Table
560af5c5 1317
f36ca6af 1318(define-foreign table-new () table
1319 (rows unsigned-int)
1320 (columns unsigned-int)
1321 (homogeneous boolean))
560af5c5 1322
f36ca6af 1323(define-foreign table-resize () nil
1324 (table table)
1325 (rows unsigned-int)
1326 (columns unsigned-int))
560af5c5 1327
f36ca6af 1328(define-foreign table-attach (table child left right top bottom
1329 &key (x-options '(:expand :fill))
1330 (y-options '(:expand :fill))
1331 (x-padding 0) (y-padding 0)) nil
1332 (table table)
1333 (child widget)
1334 (left unsigned-int)
1335 (right unsigned-int)
1336 (top unsigned-int)
1337 (bottom unsigned-int)
1338 (x-options attach-options)
1339 (y-options attach-options)
1340 (x-padding unsigned-int)
1341 (y-padding unsigned-int))
1342
1343(define-foreign %table-set-row-spacing () nil
1344 (table table)
1345 (row unsigned-int)
1346 (spacing unsigned-int))
1347
1348(defun (setf table-row-spacing) (spacing table row)
1349 (%table-set-row-spacing table row spacing)
1350 spacing)
1351
1352;; gtkglue.c
1353(define-foreign table-row-spacing (table row) unsigned-int
1354 (table table)
1355 ((progn
1356 (assert (and (>= row 0) (< row (table-rows table))))
1357 row) unsigned-int))
1358
1359(define-foreign %table-set-col-spacing () nil
1360 (table table)
1361 (col unsigned-int)
1362 (spacing unsigned-int))
1363
1364(defun (setf table-column-spacing) (spacing table column)
d520140e 1365 (%table-set-col-spacing table column spacing)
f36ca6af 1366 spacing)
1367
1368;; gtkglue.c
1369(define-foreign table-column-spacing (table col) unsigned-int
1370 (table table)
1371 ((progn
1372 (assert (and (>= col 0) (< col (table-columns table))))
1373 col) unsigned-int))
1374
1375
1376(defun %set-table-child-option (object slot flag value)
d520140e 1377 (let ((options (child-slot-value object slot)))
f36ca6af 1378 (cond
1379 ((and value (not (member flag options)))
d520140e 1380 (setf (child-slot-value object slot) (cons flag options)))
f36ca6af 1381 ((and (not value) (member flag options))
d520140e 1382 (setf (child-slot-value object slot) (delete flag options))))))
f36ca6af 1383
1384(macrolet ((define-option-accessor (name slot flag)
1385 `(progn
1386 (defun ,name (object)
d520140e 1387 (member ,flag (child-slot-value object ,slot)))
f36ca6af 1388 (defun (setf ,name) (value object)
1389 (%set-table-child-option object ,slot ,flag value)))))
1390 (define-option-accessor table-child-x-expand-p :x-options :expand)
1391 (define-option-accessor table-child-y-expand-p :y-options :expand)
1392 (define-option-accessor table-child-x-shrink-p :x-options :shrink)
1393 (define-option-accessor table-child-y-shrink-p :y-options :shrink)
1394 (define-option-accessor table-child-x-fill-p :x-options :fill)
1395 (define-option-accessor table-child-y-fill-p :y-options :fill))
1396
1397
1398
1399;;; Toolbar
1400
1401(define-foreign toolbar-new () toolbar
1402 (orientation orientation)
1403 (style toolbar-style))
1404
1405;; gtkglue.c
1406(define-foreign toolbar-num-children () int
1407 (toolbar toolbar))
1408
1409(defun %toolbar-position-num (toolbar position)
1410 (case position
1411 (:prepend 0)
1412 (:append (toolbar-num-children toolbar))
1413 (t
1414 (assert (and (>= position 0) (< position (toolbar-num-children toolbar))))
1415 position)))
1416
1417(define-foreign %toolbar-insert-element () widget
1418 (toolbar toolbar)
1419 (type toolbar-child-type)
1420 (widget (or null widget))
1421 (text string)
1422 (tooltip-text string)
1423 (tooltip-private-text string)
1424 (icon (or null widget))
1425 (nil null)
1426 (nil null)
1427 (position int))
560af5c5 1428
f36ca6af 1429(defun toolbar-insert-element (toolbar position
1430 &key tooltip-text tooltip-private-text
1431 type widget icon text callback)
1432 (let* ((icon-widget (typecase icon
1433 ((or null widget) icon)
1434 (t (pixmap-new icon))))
1435 (toolbar-child
1436 (%toolbar-insert-element
1437 toolbar (or type (and widget :widget) :button)
1438 widget text tooltip-text tooltip-private-text icon-widget
1439 (%toolbar-position-num toolbar position))))
1440 (when callback
1441 (signal-connect toolbar-child 'clicked callback))
1442 toolbar-child))
1443
1444(defun toolbar-append-element (toolbar &key tooltip-text tooltip-private-text
1445 type widget icon text callback)
1446 (toolbar-insert-element
1447 toolbar :append :type type :widget widget :icon icon :text text
1448 :tooltip-text tooltip-text :tooltip-private-text tooltip-private-text
1449 :callback callback))
1450
1451(defun toolbar-prepend-element (toolbar &key tooltip-text tooltip-private-text
1452 type widget icon text callback)
1453 (toolbar-insert-element
1454 toolbar :prepend :type type :widget widget :icon icon :text text
1455 :tooltip-text tooltip-text :tooltip-private-text tooltip-private-text
1456 :callback callback))
1457
1458(defun toolbar-insert-space (toolbar position)
1459 (toolbar-insert-element toolbar position :type :space))
1460
1461(defun toolbar-append-space (toolbar)
1462 (toolbar-insert-space toolbar :append))
1463
1464(defun toolbar-prepend-space (toolbar)
1465 (toolbar-insert-space toolbar :prepend))
1466
1467(defun toolbar-insert-widget (toolbar widget position &key tooltip-text
1468 tooltip-private-text callback)
1469 (toolbar-insert-element
1470 toolbar position :widget widget :tooltip-text tooltip-text
1471 :tooltip-private-text tooltip-private-text :callback callback))
560af5c5 1472
f36ca6af 1473(defun toolbar-append-widget (toolbar widget &key tooltip-text
1474 tooltip-private-text callback)
1475 (toolbar-insert-widget
1476 toolbar widget :append :tooltip-text tooltip-text
1477 :tooltip-private-text tooltip-private-text :callback callback))
1478
1479(defun toolbar-prepend-widget (toolbar widget &key tooltip-text
1480 tooltip-private-text callback)
1481 (toolbar-insert-widget
1482 toolbar widget :prepend :tooltip-text tooltip-text
1483 :tooltip-private-text tooltip-private-text :callback callback))
1484
1485(defun toolbar-insert-item (toolbar text icon position &key tooltip-text
1486 tooltip-private-text callback)
1487 (toolbar-insert-element
1488 toolbar position :text text :icon icon :callback callback
1489 :tooltip-text tooltip-text :tooltip-private-text tooltip-private-text))
1490
1491(defun toolbar-append-item (toolbar text icon &key tooltip-text
1492 tooltip-private-text callback)
1493 (toolbar-insert-item
1494 toolbar text icon :append :callback callback
1495 :tooltip-text tooltip-text :tooltip-private-text tooltip-private-text))
560af5c5 1496
1497
f36ca6af 1498(defun toolbar-prepend-item (toolbar text icon &key tooltip-text
1499 tooltip-private-text callback)
1500 (toolbar-insert-item
1501 toolbar text icon :prepend :callback callback
1502 :tooltip-text tooltip-text :tooltip-private-text tooltip-private-text))
560af5c5 1503
f36ca6af 1504(defun toolbar-enable-tooltips (toolbar)
1505 (setf (toolbar-tooltips-p toolbar) t))
560af5c5 1506
f36ca6af 1507(defun toolbar-disable-tooltips (toolbar)
1508 (setf (toolbar-tooltips-p toolbar) nil))
560af5c5 1509
1510
1511
560af5c5 1512;;; Calendar
1513
1514(define-foreign calendar-new () calendar)
1515
1516(define-foreign calendar-select-month () int
1517 (calendar calendar)
1518 (month unsigned-int)
1519 (year unsigned-int))
1520
1521(define-foreign calendar-select-day () nil
1522 (calendar calendar)
1523 (day unsigned-int))
1524
1525(define-foreign calendar-mark-day () int
1526 (calendar calendar)
1527 (day unsigned-int))
1528
1529(define-foreign calendar-unmark-day () int
1530 (calendar calendar)
1531 (day unsigned-int))
1532
1533(define-foreign calendar-clear-marks () nil
1534 (calendar calendar))
1535
1536(define-foreign calendar-display-options () nil
1537 (calendar calendar)
1538 (options calendar-display-options))
1539
1540(define-foreign ("gtk_calendar_get_date" calendar-date) () nil
1541 (calendar calendar)
1542 (year unsigned-int :out)
1543 (month unsigned-int :out)
1544 (day unsigned-int :out))
1545
1546(define-foreign calendar-freeze () nil
1547 (calendar calendar))
1548
1549(define-foreign calendar-thaw () nil
1550 (calendar calendar))
1551
1552
1553
1554;;; Drawing area
1555
1556; (define-foreign drawing-area-new () drawing-area)
1557
1558; (define-foreign ("gtk_drawing_area_size" %drawing-area-set-size) () nil
1559; (drawing-area drawing-area)
1560; (width int)
1561; (height int))
1562
1563; (defun (setf drawing-area-size) (size drawing-area)
1564; (%drawing-area-set-size drawing-area (svref size 0) (svref size 1))
1565; (values (svref size 0) (svref size 1)))
1566
f36ca6af 1567; ;; gtkglue.c
560af5c5 1568; (define-foreign ("gtk_drawing_area_get_size" drawing-area-size) () nil
1569; (drawing-area drawing-area)
1570; (width int :out)
1571; (height int :out))
1572
1573
1574
1575; ;;; Curve
1576
1577
1578
1579; ;;; Editable
1580
f36ca6af 1581(define-foreign editable-select-region (editable &optional (start 0) end) nil
1582 (editable editable)
1583 (start int)
1584 ((or end -1) int))
560af5c5 1585
f36ca6af 1586(define-foreign editable-insert-text
1587 (editable text &optional (position 0)) nil
1588 (editable editable)
1589 (text string)
1590 ((length text) int)
1591 ((or position -1) int :in-out))
560af5c5 1592
f36ca6af 1593(defun editable-append-text (editable text)
1594 (editable-insert-text editable text nil))
560af5c5 1595
f36ca6af 1596(defun editable-prepend-text (editable text)
1597 (editable-insert-text editable text 0))
560af5c5 1598
f36ca6af 1599(define-foreign editable-delete-text (editable &optional (start 0) end) nil
1600 (editable editable)
1601 (start int)
1602 ((or end -1) int))
560af5c5 1603
f36ca6af 1604(define-foreign ("gtk_editable_get_chars" editable-text)
1605 (editable &optional (start 0) end) string
1606 (editable editable)
1607 (start int)
1608 ((or end -1) int))
560af5c5 1609
f36ca6af 1610(defun (setf editable-text) (text editable)
1611 (if text
1612 (editable-delete-text
1613 editable
1614 (editable-insert-text editable text))
1615 (editable-delete-text editable))
1616 text)
560af5c5 1617
f36ca6af 1618(define-foreign editable-cut-clipboard () nil
1619 (editable editable))
560af5c5 1620
f36ca6af 1621(define-foreign editable-copy-clipboard () nil
1622 (editable editable))
560af5c5 1623
f36ca6af 1624(define-foreign editable-paste-clipboard () nil
1625 (editable editable))
560af5c5 1626
b9752933 1627; (define-foreign editable-claim-selection () nil
1628; (editable editable)
1629; (claim boolean)
1630; (time unsigned-int))
560af5c5 1631
f36ca6af 1632(define-foreign editable-delete-selection () nil
1633 (editable editable))
560af5c5 1634
b9752933 1635; (define-foreign editable-changed () nil
1636; (editable editable))
560af5c5 1637
560af5c5 1638
560af5c5 1639
f36ca6af 1640;;; Entry
560af5c5 1641
f36ca6af 1642(define-foreign %entry-new() entry)
560af5c5 1643
f36ca6af 1644(define-foreign %entry-new-with-max-length () entry
1645 (max (unsigned 16)))
560af5c5 1646
f36ca6af 1647(defun entry-new (&optional max)
1648 (if max
1649 (%entry-new-with-max-length max)
1650 (%entry-new)))
560af5c5 1651
560af5c5 1652
f36ca6af 1653;;; Spin button
560af5c5 1654
f36ca6af 1655(define-foreign spin-button-new () spin-button
1656 (adjustment adjustment)
1657 (climb-rate single-float)
1658 (digits unsigned-int))
560af5c5 1659
f36ca6af 1660(defun spin-button-value-as-int (spin-button)
1661 (round (spin-button-value spin-button)))
560af5c5 1662
f36ca6af 1663(define-foreign spin-button-spin () nil
1664 (spin-button spin-button)
1665 (direction spin-type)
1666 (increment single-float))
560af5c5 1667
f36ca6af 1668(define-foreign spin-button-update () nil
1669 (spin-button spin-button))
560af5c5 1670
1671
1672
1673; ;;; Ruler
1674
f36ca6af 1675(define-foreign ruler-set-range () nil
1676 (ruler ruler)
1677 (lower single-float)
1678 (upper single-float)
1679 (position single-float)
1680 (max-size single-float))
560af5c5 1681
f36ca6af 1682(define-foreign ruler-draw-ticks () nil
1683 (ruler ruler))
560af5c5 1684
f36ca6af 1685(define-foreign ruler-draw-pos () nil
1686 (ruler ruler))
560af5c5 1687
d520140e 1688(define-foreign hruler-new () hruler)
560af5c5 1689
d520140e 1690(define-foreign vruler-new () vruler)
560af5c5 1691
560af5c5 1692
d520140e 1693;;; Range
560af5c5 1694
d520140e 1695(define-foreign range-draw-background () nil
1696 (range range))
560af5c5 1697
d520140e 1698(define-foreign range-clear-background () nil
1699 (range range))
560af5c5 1700
d520140e 1701(define-foreign range-draw-trough () nil
1702 (range range))
560af5c5 1703
d520140e 1704(define-foreign range-draw-slider () nil
1705 (range range))
560af5c5 1706
d520140e 1707(define-foreign range-draw-step-forw () nil
1708 (range range))
560af5c5 1709
d520140e 1710(define-foreign range-slider-update () nil
1711 (range range))
560af5c5 1712
d520140e 1713(define-foreign range-trough-click () int
1714 (range range)
1715 (x int)
1716 (y int)
1717 (jump-perc single-float :out))
560af5c5 1718
d520140e 1719(define-foreign range-default-hslider-update () nil
1720 (range range))
560af5c5 1721
d520140e 1722(define-foreign range-default-vslider-update () nil
1723 (range range))
560af5c5 1724
d520140e 1725(define-foreign range-default-htrough-click () int
1726 (range range)
1727 (x int)
1728 (y int)
1729 (jump-perc single-float :out))
560af5c5 1730
d520140e 1731(define-foreign range-default-vtrough-click () int
1732 (range range)
1733 (x int)
1734 (y int)
1735 (jump-perc single-float :out))
560af5c5 1736
d520140e 1737(define-foreign range-default-hmotion () int
1738 (range range)
1739 (x-delta int)
1740 (y-delta int))
560af5c5 1741
d520140e 1742(define-foreign range-default-vmotion () int
1743 (range range)
1744 (x-delta int)
1745 (y-delta int))
560af5c5 1746
1747
560af5c5 1748
d520140e 1749;;; Scale
560af5c5 1750
d520140e 1751(define-foreign scale-draw-value () nil
1752 (scale scale))
560af5c5 1753
d520140e 1754(define-foreign hscale-new () hscale
1755 (adjustment adjustment))
1756
1757(define-foreign vscale-new () hscale
1758 (adjustment adjustment))
560af5c5 1759
1760
1761
d520140e 1762;;; Scrollbar
560af5c5 1763
d520140e 1764(define-foreign hscrollbar-new () hscrollbar
1765 (adjustment adjustment))
560af5c5 1766
d520140e 1767(define-foreign vscrollbar-new () vscrollbar
1768 (adjustment adjustment))
560af5c5 1769
1770
1771
d520140e 1772;;; Separator
560af5c5 1773
f36ca6af 1774(define-foreign vseparator-new () vseparator)
560af5c5 1775
f36ca6af 1776(define-foreign hseparator-new () hseparator)
560af5c5 1777
1778
1779
d520140e 1780;;; Preview
560af5c5 1781
1782
560af5c5 1783
d520140e 1784;;; Progress
560af5c5 1785
d520140e 1786(define-foreign progress-configure () adjustment
1787 (progress progress)
1788 (value single-float)
1789 (min single-float)
1790 (max single-float))
560af5c5 1791
d520140e 1792(define-foreign ("gtk_progress_get_text_from_value"
1793 progress-text-from-value) () string
1794 (progress progress))
560af5c5 1795
d520140e 1796(define-foreign ("gtk_progress_get_percentage_from_value"
1797 progress-percentage-from-value) () single-float
1798 (progress progress))
560af5c5 1799
560af5c5 1800
560af5c5 1801
d520140e 1802;;; Progress bar
560af5c5 1803
d520140e 1804(define-foreign progress-bar-new () progress-bar)
560af5c5 1805
d520140e 1806(define-foreign progress-bar-pulse () nil
1807 (progress-bar progress-bar))
560af5c5 1808
1809
1810
1811;;; Adjustment
1812
1813(define-foreign adjustment-new () adjustment
1814 (value single-float)
1815 (lower single-float)
1816 (upper single-float)
1817 (step-increment single-float)
1818 (page-increment single-float)
1819 (page-size single-float))
1820
1821(define-foreign adjustment-changed () nil
1822 (adjustment adjustment))
1823
1824(define-foreign adjustment-value-changed () nil
1825 (adjustment adjustment))
1826
1827(define-foreign adjustment-clamp-page () nil
1828 (adjustment adjustment)
1829 (lower single-float)
1830 (upper single-float))
1831
1832
1833
1834;;; Tooltips
1835
d520140e 1836(define-foreign tooltips-new () tooltips)
560af5c5 1837
d520140e 1838(define-foreign tooltips-enable () nil
1839 (tooltips tooltips))
560af5c5 1840
d520140e 1841(define-foreign tooltips-disable () nil
1842 (tooltips tooltips))
560af5c5 1843
d520140e 1844(define-foreign tooltips-set-tip () nil
1845 (tooltips tooltips)
1846 (widget widget)
1847 (tip-text string)
1848 (tip-private string))
560af5c5 1849
d520140e 1850(define-foreign tooltips-set-colors (tooltips background foreground) nil
1851 (tooltips tooltips)
1852 ((gdk:ensure-color background) gdk:color)
1853 ((gdk:ensure-color foreground) gdk:color))
560af5c5 1854
d520140e 1855(define-foreign tooltips-force-window () nil
1856 (tooltips tooltips))
560af5c5 1857
1858
1859
d520140e 1860;;; Rc
560af5c5 1861
d520140e 1862(define-foreign rc-add-default-file (filename) nil
1863 ((namestring (truename filename)) string))
560af5c5 1864
d520140e 1865(define-foreign rc-parse (filename) nil
1866 ((namestring (truename filename)) string))
560af5c5 1867
d520140e 1868(define-foreign rc-parse-string () nil
1869 (rc-string string))
560af5c5 1870
d520140e 1871(define-foreign rc-reparse-all () nil)
560af5c5 1872
d520140e 1873(define-foreign rc-get-style () style
1874 (widget widget))
560af5c5 1875
1876
1877
1878;;; Accelerator Groups
1879
1880(define-foreign accel-group-new () accel-group)
1881
1882(define-foreign accel-group-get-default () accel-group)
1883
f36ca6af 1884(deftype-method alien-ref accel-group (type-spec)
1885 (declare (ignore type-spec))
1886 '%accel-group-ref)
560af5c5 1887
f36ca6af 1888(deftype-method alien-unref accel-group (type-spec)
1889 (declare (ignore type-spec))
1890 '%accel-group-unref)
1891
1892(define-foreign %accel-group-ref () accel-group
1893 (accel-group (or accel-group pointer)))
1894
1895(define-foreign %accel-group-unref () nil
1896 (accel-group (or accel-group pointer)))
560af5c5 1897
1898(define-foreign accel-group-activate (accel-group key modifiers) boolean
1899 (accel-group accel-group)
1900 ((gdk:keyval-from-name key) unsigned-int)
1901 (modifiers gdk:modifier-type))
1902
1903(define-foreign accel-groups-activate (object key modifiers) boolean
1904 (object object)
1905 ((gdk:keyval-from-name key) unsigned-int)
1906 (modifiers gdk:modifier-type))
1907
1908(define-foreign accel-group-attach () nil
1909 (accel-group accel-group)
1910 (object object))
1911
1912(define-foreign accel-group-detach () nil
1913 (accel-group accel-group)
1914 (object object))
1915
1916(define-foreign accel-group-lock () nil
1917 (accel-group accel-group))
1918
1919(define-foreign accel-group-unlock () nil
1920 (accel-group accel-group))
1921
1922
1923;;; Accelerator Groups Entries
1924
1925(define-foreign accel-group-get-entry (accel-group key modifiers) accel-entry
1926 (accel-group accel-group)
1927 ((gdk:keyval-from-name key) unsigned-int)
1928 (modifiers gdk:modifier-type))
1929
1930(define-foreign accel-group-lock-entry (accel-group key modifiers) nil
1931 (accel-group accel-group)
1932 ((gdk:keyval-from-name key) unsigned-int)
1933 (modifiers gdk:modifier-type))
1934
1935(define-foreign accel-group-unlock-entry (accel-group key modifiers) nil
1936 (accel-group accel-group)
1937 ((gdk:keyval-from-name key) unsigned-int)
1938 (modifiers gdk:modifier-type))
1939
1940(define-foreign accel-group-add
1941 (accel-group key modifiers flags object signal) nil
1942 (accel-group accel-group)
1943 ((gdk:keyval-from-name key) unsigned-int)
1944 (modifiers gdk:modifier-type)
1945 (flags accel-flags)
1946 (object object)
1947 ((name-to-string signal) string))
1948
1949(define-foreign accel-group-add (accel-group key modifiers object) nil
1950 (accel-group accel-group)
1951 ((gdk:keyval-from-name key) unsigned-int)
1952 (modifiers gdk:modifier-type)
1953 (object object))
1954
1955
1956;;; Accelerator Signals
1957
1958(define-foreign accel-group-handle-add
1959 (object signal-id accel-group key modifiers flags) nil
1960 (object object)
1961 (signal-id unsigned-int)
1962 (accel-group accel-group)
1963 ((gdk:keyval-from-name key) unsigned-int)
1964 (modifiers gdk:modifier-type)
1965 (flags accel-flags))
1966
1967(define-foreign accel-group-handle-remove
1968 (object accel-group key modifiers) nil
1969 (object object)
1970 (accel-group accel-group)
1971 ((gdk:keyval-from-name key) unsigned-int)
1972 (modifiers gdk:modifier-type))
1973
1974
1975
1976;;; Style
1977
1978; (define-foreign style-new () style)
1979
1980; (define-foreign style-copy () style
1981; (style style))
1982
d520140e 1983(define-foreign %style-get-color () gdk:color
1984 (style style)
1985 (color-type color-type)
1986 (state-type state-type))
560af5c5 1987
d520140e 1988(define-foreign %style-set-color () gdk:color
1989 (style style)
1990 (color-type color-type)
1991 (state-type state-type)
1992 (color gdk:color))
560af5c5 1993
d520140e 1994(defun style-fg (style state)
1995 (%style-get-color style :foreground state))
560af5c5 1996
d520140e 1997(defun (setf style-fg) (color style state)
1998 (%style-set-color style :foreground state color))
560af5c5 1999
d520140e 2000(defun style-bg (style state)
2001 (%style-get-color style :background state))
560af5c5 2002
d520140e 2003(defun (setf style-bg) (color style state)
2004 (%style-set-color style :background state color))
560af5c5 2005
d520140e 2006(defun style-text (style state)
2007 (%style-get-color style :text state))
560af5c5 2008
d520140e 2009(defun (setf style-text) (color style state)
2010 (%style-set-color style :text state color))
560af5c5 2011
d520140e 2012(defun style-base (style state)
2013 (%style-get-color style :base state))
560af5c5 2014
d520140e 2015(defun (setf style-base) (color style state)
2016 (%style-set-color style :base state color))
560af5c5 2017
d520140e 2018(defun style-white (style)
2019 (%style-get-color style :white :normal))
560af5c5 2020
d520140e 2021(defun (setf style-white) (color style)
2022 (%style-set-color style :white :normal color))
560af5c5 2023
d520140e 2024(defun style-black (style)
2025 (%style-get-color style :black :normal))
560af5c5 2026
d520140e 2027(defun (setf style-black) (color style)
2028 (%style-set-color style :black :normal color))
560af5c5 2029
d520140e 2030(define-foreign style-get-gc () gdk:gc
2031 (style style)
2032 (color-type color-type)
2033 (state-type state-type))
b9752933 2034
2035
2036(define-foreign draw-hline () nil
2037 (style style)
2038 (window gdk:window)
2039 (state state-type)
2040 (x1 int)
2041 (x2 int)
2042 (y int))
2043
2044(define-foreign draw-vline () nil
2045 (style style)
2046 (window gdk:window)
2047 (state state-type)
2048 (y1 int)
2049 (y2 int)
2050 (x int))
2051
2052(define-foreign draw-shadow () nil
2053 (style style)
2054 (window gdk:window)
2055 (state state-type)
2056 (shadow shadow-type)
2057 (x int)
2058 (y int)
2059 (width int)
2060 (height int))
2061
2062; (define-foreign draw-polygon () nil
2063; (style style)
2064; (window gdk:window)
2065; (state state-type)
2066; (shadow shadow-type)
2067; (points (vector gdk:point))
2068; ((length points) int)
2069; (fill boolean))
2070
2071(define-foreign draw-arrow () nil
2072 (style style)
2073 (window gdk:window)
2074 (state state-type)
2075 (shadow shadow-type)
2076 (arrow arrow-type)
2077 (fill boolean)
2078 (x int)
2079 (y int)
2080 (width int)
2081 (height int))
2082
2083(define-foreign draw-diamond () nil
2084 (style style)
2085 (window gdk:window)
2086 (state state-type)
2087 (shadow shadow-type)
2088 (x int)
2089 (y int)
2090 (width int)
2091 (height int))
2092
2093; (define-foreign draw-oval () nil
2094; (style style)
2095; (window gdk:window)
2096; (state state-type)
2097; (shadow shadow-type)
2098; (x int)
2099; (y int)
2100; (width int)
2101; (height int))
2102
2103(define-foreign draw-string () nil
2104 (style style)
2105 (window gdk:window)
2106 (state state-type)
2107 (x int)
2108 (y int)
2109 (string string))
2110
2111(define-foreign draw-box () nil
2112 (style style)
2113 (window gdk:window)
2114 (state state-type)
2115 (shadow shadow-type)
2116 (x int)
2117 (y int)
2118 (width int)
2119 (height int))
2120
2121(define-foreign draw-flat-box () nil
2122 (style style)
2123 (window gdk:window)
2124 (state state-type)
2125 (shadow shadow-type)
2126 (x int)
2127 (y int)
2128 (width int)
2129 (height int))
2130
2131(define-foreign draw-check () nil
2132 (style style)
2133 (window gdk:window)
2134 (state state-type)
2135 (shadow shadow-type)
2136 (x int)
2137 (y int)
2138 (width int)
2139 (height int))
2140
2141(define-foreign draw-option () nil
2142 (style style)
2143 (window gdk:window)
2144 (state state-type)
2145 (shadow shadow-type)
2146 (x int)
2147 (y int)
2148 (width int)
2149 (height int))
2150
2151; (define-foreign draw-cross () nil
2152; (style style)
2153; (window gdk:window)
2154; (state state-type)
2155; (shadow shadow-type)
2156; (x int)
2157; (y int)
2158; (width int)
2159; (height int))
2160
2161; (define-foreign draw-ramp () nil
2162; (style style)
2163; (window gdk:window)
2164; (state state-type)
2165; (shadow shadow-type)
2166; (arrow arrow-type)
2167; (x int)
2168; (y int)
2169; (width int)
2170; (height int))
2171
2172(define-foreign draw-tab () nil
2173 (style style)
2174 (window gdk:window)
2175 (state state-type)
2176 (x int)
2177 (y int)
2178 (width int)
2179 (height int))
2180
2181(define-foreign draw-shadow-gap () nil
2182 (style style)
2183 (window gdk:window)
2184 (state state-type)
2185 (x int)
2186 (y int)
2187 (width int)
2188 (height int)
2189 (gap-side position-type)
2190 (gap-x int)
2191 (gap-width int))
2192
2193(define-foreign draw-box-gap () nil
2194 (style style)
2195 (window gdk:window)
2196 (state state-type)
2197 (x int)
2198 (y int)
2199 (width int)
2200 (height int)
2201 (gap-side position-type)
2202 (gap-x int)
2203 (gap-width int))
2204
2205(define-foreign draw-extension () nil
2206 (style style)
2207 (window gdk:window)
2208 (state state-type)
2209 (x int)
2210 (y int)
2211 (width int)
2212 (height int))
2213
2214(define-foreign draw-focus () nil
2215 (style style)
2216 (window gdk:window)
2217 (x int)
2218 (y int)
2219 (width int)
2220 (height int))
2221
2222(define-foreign draw-slider () nil
2223 (style style)
2224 (window gdk:window)
2225 (state state-type)
2226 (shadow shadow-type)
2227 (x int)
2228 (y int)
2229 (width int)
2230 (height int)
2231 (orientation orientation))
2232
2233(define-foreign draw-handle () nil
2234 (style style)
2235 (window gdk:window)
2236 (state state-type)
2237 (shadow shadow-type)
2238 (x int)
2239 (y int)
2240 (width int)
2241 (height int)
2242 (orientation orientation))
2243
2244(define-foreign draw-handle () nil
2245 (style style)
2246 (window gdk:window)
2247 (state state-type)
2248 (shadow shadow-type)
2249 (x int)
2250 (y int)
2251 (width int)
2252 (height int)
2253 (orientation orientation))
2254
2255(define-foreign paint-hline () nil
2256 (style style)
2257 (window gdk:window)
2258 (state state-type)
2259 (x1 int)
2260 (x2 int)
2261 (y int))