1 ;; Common Lisp bindings for GTK+ v2.0
2 ;; Copyright (C) 1999-2000 Espen S. Johnsen <espejohn@online.no>
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.
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.
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
18 ;; $Id: gtk.lisp,v 1.2 2000-09-04 22:23:34 espen Exp $
25 (define-foreign check-version () string
26 (required-major unsigned-int)
27 (required-minor unsigned-int)
28 (required-micro unsigned-int))
30 (define-foreign query-version () nil
31 (major unsigned-int :out)
32 (minor unsigned-int :out)
33 (micro unsigned-int :out))
36 (multiple-value-bind (major minor micro)
39 (format nil "Gtk+ v~A.~A" major minor)
40 (format nil "Gtk+ v~A.~A.~A" major minor micro))))
44 ;;; should be moved to gobject
50 (define-foreign label-new () label
53 (define-foreign label-parse-uline () unsigned-int
61 (define-foreign accel-label-new () accel-label
64 (define-foreign accel-label-refetch () boolean
65 (accel-label accel-label))
71 (define-foreign tips-query-new () tips-query)
73 (define-foreign tips-query-start-query () nil
74 (tips-query tips-query))
76 (define-foreign tips-query-stop-query () nil
77 (tips-query tips-query))
83 (define-foreign arrow-new () arrow
84 (arrow-type arrow-type)
85 (shadow-type shadow-type))
91 (defmethod initialize-instance ((pixmap pixmap) &rest initargs
93 (declare (ignore initargs))
95 (if (typep source 'gdk:pixmap)
96 (pixmap-set pixmap source mask)
97 (multiple-value-bind (source mask) (gdk:pixmap-create source)
98 (pixmap-set pixmap source mask))))
100 (defun pixmap-new (source &optional mask)
101 (make-instance 'pixmap :source source :mask mask))
103 (define-foreign pixmap-set () nil
106 (mask (or null gdk:bitmap)))
108 (defun (setf pixmap-source) (source pixmap)
109 (if (typep source 'gdk:pixmap)
110 (pixmap-set pximap source (pixmap-mask pixmap))
111 (multiple-value-bind (source mask) (gdk:pixmap-create source)
112 (pixmap-set pixmap source mask)))
115 (defun (setf pixmap-mask) (mask pixmap)
116 (pixmap-set pximap (pixmap-source pixmap) mask)
119 (define-foreign ("gtk_pixmap_get" pixmap-source) () nil
121 (val gdk:pixmap :out)
124 (define-foreign ("gtk_pixmap_get" pixmap-mask) () nil
127 (mask gdk:bitmap :out))
133 (defun bin-child (bin)
134 (first (container-children bin)))
136 (defun (setf bin-child) (child bin)
137 (let ((old-child (bin-child bin)))
139 (container-remove bin old-child)))
140 (container-add bin child)
147 (define-foreign alignment-new () alignment
148 (xalign single-float)
150 (xscale single-float)
151 (yscale single-float))
157 (define-foreign frame-new (&optional label) frame
164 (define-foreign aspect-frame-new () alignment
165 (xalign single-float)
168 (obey-child boolean))
174 (define-foreign %button-new () button)
176 (define-foreign %button-new-with-label () button
179 (defun button-new (&optional label)
181 (%button-new-with-label label)
184 (defgeneric button-label (button))
185 (defgeneric (setf button-label) (label button))
187 (defmethod button-label ((button button))
188 (object-arg button "GtkButton::label"))
190 (defmethod (setf button-label) ((label string) (button button))
191 (setf (object-arg button "GtkButton::label") label))
194 (define-foreign button-pressed () nil
197 (define-foreign button-released () nil
200 (define-foreign button-clicked () nil
203 (define-foreign button-enter () nil
206 (define-foreign button-leave () nil
213 (define-foreign %toggle-button-new () toggle-button)
215 (define-foreign %toggle-button-new-with-label () toggle-button
218 (defun toggle-button-new (&optional label)
220 (%toggle-button-new-with-label label)
221 (%toggle-button-new)))
223 (define-foreign toggle-button-toggled () nil
224 (toggle-button toggle-button))
230 (define-foreign %check-button-new () check-button)
232 (define-foreign %check-button-new-with-label () check-button
235 (defun check-button-new (&optional label)
237 (%check-button-new-with-label label)
238 (%check-button-new)))
240 (defmethod (setf button-label) ((label string) (button check-button))
242 (setf (misc-xalign (bin-child button)) 0.0)
249 (define-foreign %radio-button-new () radio-button
250 (group (or null radio-button-group)))
252 (define-foreign %radio-button-new-with-label-from-widget () radio-button
253 (widget (or null widget))
256 (define-foreign %radio-button-new-from-widget () radio-button
257 (widget (or null widget)))
259 (define-foreign %radio-button-new-with-label () radio-button
260 (group (or null radio-button-group))
263 (defun radio-button-new (group &key label from-widget)
265 ((and from-widget label)
266 (%radio-button-new-with-label-from-widget group label))
268 (%radio-button-new-from-widget group))
270 (%radio-button-new-with-label group label))
272 (%radio-button-new group))))
274 ; (define-foreign radio-button-group () radio-button-group
275 ; (radio-button radio-button))
281 (define-foreign option-menu-new () option-menu)
283 (define-foreign %option-menu-set-menu () nil
284 (option-menu option-menu)
287 (define-foreign %option-menu-remove-menu () nil
288 (option-menu option-menu))
290 (defun (setf option-menu-menu) (menu option-menu)
292 (%option-menu-remove-menu option-menu)
293 (%option-menu-set-menu option-menu menu))
300 (define-foreign item-select () nil
303 (define-foreign item-deselect () nil
306 (define-foreign item-toggle () nil
313 (define-foreign %menu-item-new () menu-item)
315 (define-foreign %menu-item-new-with-label () menu-item
318 (defun menu-item-new (&optional label)
320 (%menu-item-new-with-label label)
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)
329 (define-foreign %menu-item-set-submenu () nil
330 (menu-item menu-item)
333 (define-foreign %menu-item-remove-submenu () nil
334 (menu-item menu-item))
336 (defun (setf menu-item-submenu) (submenu menu-item)
338 (%menu-item-remove-submenu menu-item)
339 (%menu-item-set-submenu menu-item submenu))
342 (define-foreign %menu-item-configure () nil
343 (menu-item menu-item)
344 (show-toggle-indicator boolean)
345 (show-submenu-indicator boolean))
347 (defun (setf menu-item-toggle-indicator-p) (show menu-item)
348 (%menu-item-configure
351 (menu-item-submenu-indicator-p menu-item))
354 (defun (setf menu-item-submenu-indicator-p) (show menu-item)
355 (%menu-item-configure
357 (menu-item-toggle-indicator-p menu-item)
360 (define-foreign menu-item-select () nil
361 (menu-item menu-item))
363 (define-foreign menu-item-deselect () nil
364 (menu-item menu-item))
366 (define-foreign menu-item-activate () nil
367 (menu-item menu-item))
369 (define-foreign menu-item-right-justify () nil
370 (menu-item menu-item))
376 (define-foreign %check-menu-item-new
379 (define-foreign %check-menu-item-new-with-label () check-menu-item
382 (defun check-menu-item-new (&optional label)
384 (%check-menu-item-new-with-label label)
385 (%check-menu-item-new)))
387 (define-foreign check-menu-item-toggled () nil
388 (check-menu-item check-menu-item))
394 (define-foreign %radio-menu-item-new
396 (group (or null radio-menu-item-group)))
398 (define-foreign %radio-menu-item-new-with-label () radio-menu-item
399 (group (or null radio-menu-item-group))
402 (defun radio-menu-item-new (group &optional label)
404 (%radio-menu-item-new-with-label group label)
405 (%radio-menu-item-new group)))
409 ;;; Tearoff menu item
411 (define-foreign tearoff-menu-item-new () tearoff-menu-item)
417 (define-foreign %list-item-new () list-item)
419 (define-foreign %list-item-new-with-label () list-item
422 (defun list-item-new (&optional label)
424 (%list-item-new-with-label label)
427 (define-foreign list-item-select () nil
428 (list-item list-item))
430 (define-foreign list-item-deselect () nil
431 (list-item list-item))
437 (define-foreign %tree-item-new () tree-item)
439 (define-foreign %tree-item-new-with-label () tree-item
442 (defun tree-item-new (&optional label)
444 (%tree-item-new-with-label label)
447 (define-foreign %tree-item-set-subtree () nil
448 (tree-item tree-item)
451 (define-foreign %tree-item-remove-subtree () nil
452 (tree-item tree-item))
454 (defun (setf tree-item-subtree) (subtree tree-item)
456 (%tree-item-set-subtree tree-item subtree)
457 (%tree-item-remove-subtree tree-item))
460 (define-foreign tree-item-select () nil
461 (tree-item tree-item))
463 (define-foreign tree-item-deselect () nil
464 (tree-item tree-item))
466 (define-foreign tree-item-expand () nil
467 (tree-item tree-item))
469 (define-foreign tree-item-collapse () nil
470 (tree-item tree-item))
476 (define-foreign window-new () window
479 (define-foreign %window-set-wmclass () nil
481 (wmclass-name string)
482 (wmclass-class string))
484 (defun (setf window-wmclass) (wmclass window)
485 (%window-set-wmclass window (svref wmclass 0) (svref wmclass 1))
486 (values (svref wmclass 0) (svref wmclass 1)))
489 (define-foreign window-wmclass () nil
491 (wmclass-name string :out)
492 (wmclass-class string :out))
494 (define-foreign window-add-accel-group () nil
496 (accel-group accel-group))
498 (define-foreign window-remove-accel-group () nil
500 (accel-group accel-group))
502 (define-foreign window-activate-focus () int
505 (define-foreign window-activate-default () int
508 (define-foreign window-set-transient-for () nil
512 ;(define-foreign window-set-geometry-hints)
516 ;;; Color selection dialog
518 ; (define-foreign color-selection-dialog-new () color-selection-dialog
525 (define-foreign dialog-new () dialog)
531 (define-foreign input-dialog-new () dialog)
537 ; (define-foreign file-selection-new () file-selection
540 ; (define-foreign file-selection-complete () nil
541 ; (file-selection file-selection)
544 ; (define-foreign file-selection-show-fileop-buttons () nil
545 ; (file-selection file-selection))
547 ; (define-foreign file-selection-hide-fileop-buttons () nil
548 ; (file-selection file-selection))
554 (define-foreign handle-box-new () handle-box)
560 (define-foreign scrolled-window-new
561 (&optional hadjustment vadjustment) scrolled-window
562 (hadjustment (or null adjustment))
563 (vadjustment (or null adjustment)))
565 (defun (setf scrolled-window-scrollbar-policy) (policy window)
566 (setf (scrolled-window-hscrollbar-policy window) policy)
567 (setf (scrolled-window-vscrollbar-policy window) policy))
569 (define-foreign scrolled-window-add-with-viewport () nil
570 (scrolled-window scrolled-window)
577 (define-foreign viewport-new () viewport
578 (hadjustment adjustment)
579 (vadjustment adjustment))
585 (define-foreign box-pack-start () nil
590 (padding unsigned-int))
592 (define-foreign box-pack-end () nil
597 (padding unsigned-int))
599 (defun box-pack (box child &key (pack :start) (expand t) (fill t) (padding 0))
601 (box-pack-start box child expand fill padding)
602 (box-pack-end box child expand fill padding)))
604 (define-foreign box-reorder-child () nil
609 (define-foreign box-query-child-packing () nil
612 (expand boolean :out)
614 (padding unsigned-int :out)
615 (pack-type pack-type :out))
617 (define-foreign box-set-child-packing () nil
622 (padding unsigned-int)
623 (pack-type pack-type))
629 (define-foreign ("gtk_button_box_get_child_size_default"
630 button-box-default-child-size) () nil
632 (min-height int :out))
634 (define-foreign ("gtk_button_box_get_child_ipadding_default"
635 button-box-default-child-ipadding) () nil
639 (define-foreign %button-box-set-child-size-default () nil
643 (defun (setf button-box-default-child-size) (size)
644 (%button-box-set-child-size-default (svref size 0) (svref size 1))
645 (values (svref size 0) (svref size 1)))
647 (define-foreign %button-box-set-child-ipadding-default () nil
651 (defun (setf button-box-default-child-ipadding) (ipad)
652 (%button-box-set-child-ipadding-default (svref ipad 0) (svref ipad 1))
653 (values (svref ipad 0) (svref ipad 1)))
656 ("gtk_button_box_get_child_size" button-box-child-size) () nil
657 (button-box button-box)
659 (min-height int :out))
662 ("gtk_button_box_get_child_ipadding" button-box-child-ipadding) () nil
663 (button-box button-box)
667 (define-foreign %button-box-set-child-size () nil
668 (button-box button-box)
672 (defun (setf button-box-child-size) (size button-box)
673 (%button-box-set-child-size button-box (svref size 0) (svref size 1))
674 (values (svref size 0) (svref size 1)))
676 (define-foreign %button-box-set-child-ipadding () nil
677 (button-box button-box)
681 (defun (setf button-box-child-ipadding) (ipad button-box)
682 (%button-box-set-child-ipadding button-box (svref ipad 0) (svref ipad 1))
683 (values (svref ipad 0) (svref ipad 1)))
689 (define-foreign hbutton-box-new () hbutton-box)
691 (define-foreign ("gtk_hbutton_box_get_spacing_default"
692 hbutton-box-default-spacing) () int)
694 (define-foreign ("gtk_hbutton_box_set_spacing_default"
695 (setf hbutton-box-default-spacing)) () nil
698 (define-foreign ("gtk_hbutton_box_get_layout_default"
699 hbutton-box-default-layout) () button-box-style)
701 (define-foreign ("gtk_hbutton_box_set_layout_default"
702 (setf hbutton-box-default-layout)) () nil
703 (layout button-box-style))
709 (define-foreign vbutton-box-new () vbutton-box)
711 (define-foreign ("gtk_vbutton_box_get_spacing_default"
712 vbutton-box-default-spacing) () int)
714 (define-foreign ("gtk_vbutton_box_set_spacing_default"
715 (setf vbutton-box-default-spacing)) () nil
718 (define-foreign ("gtk_vbutton_box_get_layout_default"
719 vbutton-box-default-layout) () button-box-style)
721 (define-foreign ("gtk_vbutton_box_set_layout_default"
722 (setf vbutton-box-default-layout)) () nil
723 (layout button-box-style))
729 (define-foreign vbox-new () vbox
730 (homogeneous boolean)
737 ; (define-foreign color-selection-new () color-selection)
740 ; (define-foreign %color-selection-set-color-by-values () nil
741 ; (colorsel color-selection)
743 ; (green double-float)
744 ; (blue double-float)
745 ; (opacity double-float))
747 ; (defun (setf color-selection-color) (color colorsel)
748 ; (%color-selection-set-color-by-values
750 ; (svref color 0) (svref color 1) (svref color 2)
751 ; (if (> (length color) 3)
757 ; (define-foreign %color-selection-get-color-as-values () nil
758 ; (colorsel color-selection)
759 ; (red double-float :out)
760 ; (green double-float :out)
761 ; (blue double-float :out)
762 ; (opacity double-float :out))
764 ; (defun color-selection-color (colorsel)
765 ; (multiple-value-bind (red green blue opacity)
766 ; (%color-selection-get-color-as-values colorsel)
767 ; (if (color-selection-use-opacity-p colorsel)
768 ; (vector red green blue opacity)
769 ; (vector red green blue))))
776 ; (define-foreign gamma-curve-new () gamma-curve)
782 (define-foreign hbox-new () hbox
783 (homogeneous boolean)
790 (define-foreign combo-new () combo)
792 (define-foreign combo-set-value-in-list () nil
795 (ok-if-empty boolean))
797 ; (define-foreign ("gtk_combo_set_item_string" (setf combo-item-string)) () nil
800 ; (item-value string))
802 (define-foreign %combo-set-popdown-strings () nil
804 (strings (double-list string)))
806 (defun (setf combo-popdown-strings) (strings combo)
807 (%combo-set-popdown-strings combo strings)
810 (define-foreign combo-disable-activate () nil
817 (define-foreign statusbar-new () statusbar)
820 ("gtk_statusbar_get_context_id" statusbar-context-id) () unsigned-int
821 (statusbar statusbar)
822 (context-description string))
824 (define-foreign statusbar-push () unsigned-int
825 (statusbar statusbar)
826 (context-id unsigned-int)
829 (define-foreign statusbar-pop () nil
830 (statusbar statusbar)
831 (context-id unsigned-int))
833 (define-foreign statusbar-remove () nil
834 (statusbar statusbar)
835 (context-id unsigned-int)
836 (message-id unsigned-int))
842 (define-foreign fixed-new () fixed)
844 (define-foreign fixed-put () nil
850 (define-foreign fixed-move () nil
860 (define-foreign notebook-new () notebook)
862 (define-foreign ("gtk_notebook_insert_page_menu" notebook-insert-page)
863 (notebook position child tab-label &optional menu-label) nil
866 ((if (stringp tab-label)
867 (label-new tab-label)
869 ((if (stringp menu-label)
870 (label-new menu-label)
871 menu-label) (or null widget))
874 (defun notebook-append-page (notebook child tab-label &optional menu-label)
875 (notebook-insert-page notebook -1 child tab-label menu-label))
877 (defun notebook-prepend-page (notebook child tab-label &optional menu-label)
878 (notebook-insert-page notebook 0 child tab-label menu-label))
880 (define-foreign notebook-remove-page () nil
884 ; (defun notebook-current-page-num (notebook)
885 ; (let ((page-num (notebook-current-page notebook)))
886 ; (if (= page-num -1)
890 (define-foreign ("gtk_notebook_get_nth_page" notebook-nth-page-child) () widget
894 (defun notebook-page-child (notebook)
895 (notebook-nth-page-child notebook (notebook-page notebook)))
897 (define-foreign %notebook-page-num () int
901 (defun notebook-child-num (notebook child)
902 (let ((page-num (%notebook-page-num notebook child)))
907 (define-foreign notebook-next-page () nil
910 (define-foreign notebook-prev-page () nil
913 (define-foreign notebook-popup-enable () nil
916 (define-foreign notebook-popup-disable () nil
920 ("gtk_notebook_get_tab_label" notebook-tab-label) (notebook ref) widget
922 ((if (typep ref 'widget)
924 (notebook-nth-page-child notebook ref))
927 (define-foreign %notebook-set-tab-label () nil
932 (defun (setf notebook-tab-label) (tab-label notebook reference)
933 (let ((tab-label-widget (if (stringp tab-label)
934 (label-new tab-label)
936 (%notebook-set-tab-label
938 (if (typep reference 'widget)
940 (notebook-nth-page-child notebook reference))
942 (when (stringp tab-label)
943 (widget-unref tab-label-widget))
947 ("gtk_notebook_get_menu_label" notebook-menu-label) (notebook ref) widget
949 ((if (typep ref 'widget)
951 (notebook-nth-page-child notebook ref))
954 (define-foreign %notebook-set-menu-label () nil
959 (defun (setf notebook-menu-label) (menu-label notebook reference)
960 (let ((menu-label-widget (if (stringp menu-label)
961 (label-new menu-label)
963 (%notebook-set-menu-label
965 (if (typep reference 'widget)
967 (notebook-nth-page-child notebook reference))
969 (when (stringp menu-label)
970 (widget-unref menu-label-widget))
973 (define-foreign notebook-query-tab-label-packing (notebook ref) nil
975 ((if (typep ref 'widget)
977 (notebook-nth-page-child notebook ref))
979 (expand boolean :out)
981 (pack-type pack-type :out))
984 notebook-set-tab-label-packing (notebook ref expand fill pack-type) nil
986 ((if (typep ref 'widget)
988 (notebook-nth-page-child notebook ref))
992 (pack-type pack-type))
994 (define-foreign notebook-reorder-child () nil
1001 ; ;;; Font selection
1008 ; (define-foreign paned-add1 () nil
1012 ; (define-foreign paned-add2 () nil
1016 ; (define-foreign paned-pack1 () nil
1022 ; (define-foreign paned-pack2 () nil
1028 ; ; (define-foreign ("gtk_paned_set_position" (setf paned-position)) () nil
1033 ; (define-foreign paned-child1 () widget
1035 ; (resize boolean :out)
1036 ; (shrink boolean :out))
1039 ; (define-foreign paned-child2 () widget
1041 ; (resize boolean :out)
1042 ; (shrink boolean :out))
1044 ; (define-foreign vpaned-new () vpaned)
1046 ; (define-foreign hpaned-new () hpaned)
1052 ; (define-foreign layout-new (&optional hadjustment vadjustment) layout
1053 ; (hadjustment (or null adjustment))
1054 ; (vadjustment (or null adjustment)))
1056 ; (define-foreign layout-put () nil
1061 ; (define-foreign layout-move () nil
1066 ; (define-foreign %layout-set-size () nil
1071 ; (defun (setf layout-size) (size layout)
1072 ; (%layout-set-size layout (svref size 0) (svref size 1))
1073 ; (values (svref size 0) (svref size 1)))
1076 ; (define-foreign layout-size () nil
1079 ; (height int :out))
1081 ; (define-foreign layout-freeze () nil
1084 ; (define-foreign layout-thaw () nil
1087 ; (define-foreign layout-offset () nil
1096 ; (define-foreign list-new () list-widget)
1098 ; (define-foreign list-insert-items () nil
1099 ; (list list-widget)
1100 ; (items (list list-item))
1103 ; (define-foreign list-append-items () nil
1104 ; (list list-widget)
1105 ; (items (double-list list-item)))
1107 ; (define-foreign list-prepend-items () nil
1108 ; (list list-widget)
1109 ; (items (double-list list-item)))
1111 ; (define-foreign %list-remove-items () nil
1112 ; (list list-widget)
1113 ; (items (double-list list-item)))
1115 ; (define-foreign %list-remove-items-no-unref () nil
1116 ; (list list-widget)
1117 ; (items (double-list list-item)))
1119 ; (defun list-remove-items (list items &key no-unref)
1121 ; (%list-remove-items-no-unref list items)
1122 ; (%list-remove-items list items)))
1124 ; (define-foreign list-clear-items () nil
1125 ; (list list-widget)
1129 ; (define-foreign list-select-item () nil
1130 ; (list list-widget)
1133 ; (define-foreign list-unselect-item () nil
1134 ; (list list-widget)
1137 ; (define-foreign list-select-child () nil
1138 ; (list list-widget)
1141 ; (define-foreign list-unselect-child () nil
1142 ; (list list-widget)
1145 ; (define-foreign list-child-position () int
1146 ; (list list-widget)
1149 ; (define-foreign list-extend-selection () nil
1150 ; (list list-widget)
1151 ; (scroll-type scroll-type)
1152 ; (position single-float)
1153 ; (auto-start-selection boolean))
1155 ; (define-foreign list-start-selection () nil
1156 ; (list list-widget))
1158 ; (define-foreign list-end-selection () nil
1159 ; (list list-widget))
1161 ; (define-foreign list-select-all () nil
1162 ; (list list-widget))
1164 ; (define-foreign list-unselect-all () nil
1165 ; (list list-widget))
1167 ; (define-foreign list-scroll-horizontal () nil
1168 ; (list list-widget)
1169 ; (scroll-type scroll-type)
1170 ; (position single-float))
1172 ; (define-foreign list-scroll-vertical () nil
1173 ; (list list-widget)
1174 ; (scroll-type scroll-type)
1175 ; (position single-float))
1177 ; (define-foreign list-toggle-add-mode () nil
1178 ; (list list-widget))
1180 ; (define-foreign list-toggle-focus-row () nil
1181 ; (list list-widget))
1183 ; (define-foreign list-toggle-row () nil
1184 ; (list list-widget)
1187 ; (define-foreign list-undo-selection () nil
1188 ; (list list-widget))
1190 ; (define-foreign list-end-drag-selection () nil
1191 ; (list list-widget))
1194 ; (define-foreign list-selection () (double-list list-item)
1195 ; (list list-widget))
1201 (define-foreign menu-shell-insert () nil
1202 (menu-shell menu-shell)
1203 (menu-item menu-item)
1206 (defun menu-shell-append (menu-shell menu-item)
1207 (menu-shell-insert menu-shell menu-item -1))
1209 (defun menu-shell-prepend (menu-shell menu-item)
1210 (menu-shell-insert menu-shell menu-item 0))
1212 (define-foreign menu-shell-deactivate () nil
1213 (menu-shell menu-shell))
1215 (define-foreign menu-shell-select-item () nil
1216 (menu-shell menu-shell)
1217 (menu-item menu-item))
1219 (define-foreign menu-shell-deselect () nil
1220 (menu-shell menu-shell))
1222 (define-foreign menu-shell-activate-item () nil
1223 (menu-shell menu-shell)
1224 (menu-item menu-item)
1225 (fore-deactivate boolean))
1231 (define-foreign menu-bar-new () menu-bar)
1233 ; (define-foreign menu-bar-insert () nil
1234 ; (menu-bar menu-bar)
1238 ; (defun menu-bar-append (menu-bar menu)
1239 ; (menu-bar-insert menu-bar menu -1))
1241 ; (defun menu-bar-prepend (menu-bar menu)
1242 ; (menu-bar-insert menu-bar menu 0))
1248 (define-foreign menu-new () menu)
1250 ; (defun menu-insert (menu menu-item position)
1251 ; (menu-shell-insert menu menu-item position))
1253 ; (defun menu-append (menu menu-item)
1254 ; (menu-shell-append menu menu-item))
1256 ; (defun menu-prepend (menu menu-item)
1257 ; (menu-shell-prepend menu menu-item))
1259 ;(defun menu-popup ...)
1261 (define-foreign menu-reposition () nil
1264 (define-foreign menu-popdown () nil
1267 (define-foreign ("gtk_menu_get_active" menu-active) () widget
1270 (define-foreign ("gtk_menu_set_active" (setf menu-active)) () nil
1272 (index unsigned-int))
1274 ;(defun menu-attach-to-widget ...)
1276 (define-foreign menu-detach () nil
1279 (define-foreign ("gtk_menu_get_attach_widget" menu-attach-widget) () widget
1282 (define-foreign menu-reorder-child () nil
1284 (menu-item menu-item)
1291 (define-foreign packer-new () packer)
1293 (define-foreign packer-add
1294 (packer child side anchor
1297 (border-width (packer-default-border-width packer))
1298 (pad-x (packer-default-pad-x packer))
1299 (pad-y (packer-default-pad-y packer))
1300 (ipad-x (packer-default-ipad-x packer))
1301 (ipad-y (packer-default-ipad-y packer))) nil
1305 (anchor anchor-type)
1306 (options packer-options)
1307 (border-width unsigned-int)
1308 (pad-x unsigned-int)
1309 (pad-y unsigned-int)
1310 (ipad-x unsigned-int)
1311 (ipad-y unsigned-int))
1313 (define-foreign packer-set-child-packing () nil
1317 (anchor anchor-type)
1318 (options packer-options)
1319 (border-width unsigned-int)
1320 (pad-x unsigned-int)
1321 (pad-y unsigned-int)
1322 (ipad-x unsigned-int)
1323 (ipad-y unsigned-int))
1325 (define-foreign packer-reorder-child () nil
1334 (define-foreign table-new () table
1336 (columns unsigned-int)
1337 (homogeneous boolean))
1339 (define-foreign table-resize () nil
1342 (columns unsigned-int))
1344 (define-foreign table-attach (table child left right top bottom
1345 &key (x-options '(:expand :fill))
1346 (y-options '(:expand :fill))
1347 (x-padding 0) (y-padding 0)) nil
1351 (right unsigned-int)
1353 (bottom unsigned-int)
1354 (x-options attach-options)
1355 (y-options attach-options)
1356 (x-padding unsigned-int)
1357 (y-padding unsigned-int))
1359 (define-foreign %table-set-row-spacing () nil
1362 (spacing unsigned-int))
1364 (defun (setf table-row-spacing) (spacing table row)
1365 (%table-set-row-spacing table row spacing)
1369 (define-foreign table-row-spacing (table row) unsigned-int
1372 (assert (and (>= row 0) (< row (table-rows table))))
1375 (define-foreign %table-set-col-spacing () nil
1378 (spacing unsigned-int))
1380 (defun (setf table-column-spacing) (spacing table column)
1381 (%table-set-column-spacing table column spacing)
1385 (define-foreign table-column-spacing (table col) unsigned-int
1388 (assert (and (>= col 0) (< col (table-columns table))))
1392 (defun %set-table-child-option (object slot flag value)
1393 (let ((options (container-child-slot-value object slot)))
1395 ((and value (not (member flag options)))
1396 (setf (container-child-slot-value object slot) (cons flag options)))
1397 ((and (not value) (member flag options))
1399 (container-child-slot-value object slot) (delete flag options))))))
1401 (macrolet ((define-option-accessor (name slot flag)
1403 (defun ,name (object)
1404 (member ,flag (container-child-slot-value object ,slot)))
1405 (defun (setf ,name) (value object)
1406 (%set-table-child-option object ,slot ,flag value)))))
1407 (define-option-accessor table-child-x-expand-p :x-options :expand)
1408 (define-option-accessor table-child-y-expand-p :y-options :expand)
1409 (define-option-accessor table-child-x-shrink-p :x-options :shrink)
1410 (define-option-accessor table-child-y-shrink-p :y-options :shrink)
1411 (define-option-accessor table-child-x-fill-p :x-options :fill)
1412 (define-option-accessor table-child-y-fill-p :y-options :fill))
1418 (define-foreign toolbar-new () toolbar
1419 (orientation orientation)
1420 (style toolbar-style))
1423 (define-foreign toolbar-num-children () int
1426 (defun %toolbar-position-num (toolbar position)
1429 (:append (toolbar-num-children toolbar))
1431 (assert (and (>= position 0) (< position (toolbar-num-children toolbar))))
1434 (define-foreign %toolbar-insert-element () widget
1436 (type toolbar-child-type)
1437 (widget (or null widget))
1439 (tooltip-text string)
1440 (tooltip-private-text string)
1441 (icon (or null widget))
1446 (defun toolbar-insert-element (toolbar position
1447 &key tooltip-text tooltip-private-text
1448 type widget icon text callback)
1449 (let* ((icon-widget (typecase icon
1450 ((or null widget) icon)
1451 (t (pixmap-new icon))))
1453 (%toolbar-insert-element
1454 toolbar (or type (and widget :widget) :button)
1455 widget text tooltip-text tooltip-private-text icon-widget
1456 (%toolbar-position-num toolbar position))))
1458 (signal-connect toolbar-child 'clicked callback))
1461 (defun toolbar-append-element (toolbar &key tooltip-text tooltip-private-text
1462 type widget icon text callback)
1463 (toolbar-insert-element
1464 toolbar :append :type type :widget widget :icon icon :text text
1465 :tooltip-text tooltip-text :tooltip-private-text tooltip-private-text
1466 :callback callback))
1468 (defun toolbar-prepend-element (toolbar &key tooltip-text tooltip-private-text
1469 type widget icon text callback)
1470 (toolbar-insert-element
1471 toolbar :prepend :type type :widget widget :icon icon :text text
1472 :tooltip-text tooltip-text :tooltip-private-text tooltip-private-text
1473 :callback callback))
1475 (defun toolbar-insert-space (toolbar position)
1476 (toolbar-insert-element toolbar position :type :space))
1478 (defun toolbar-append-space (toolbar)
1479 (toolbar-insert-space toolbar :append))
1481 (defun toolbar-prepend-space (toolbar)
1482 (toolbar-insert-space toolbar :prepend))
1484 (defun toolbar-insert-widget (toolbar widget position &key tooltip-text
1485 tooltip-private-text callback)
1486 (toolbar-insert-element
1487 toolbar position :widget widget :tooltip-text tooltip-text
1488 :tooltip-private-text tooltip-private-text :callback callback))
1490 (defun toolbar-append-widget (toolbar widget &key tooltip-text
1491 tooltip-private-text callback)
1492 (toolbar-insert-widget
1493 toolbar widget :append :tooltip-text tooltip-text
1494 :tooltip-private-text tooltip-private-text :callback callback))
1496 (defun toolbar-prepend-widget (toolbar widget &key tooltip-text
1497 tooltip-private-text callback)
1498 (toolbar-insert-widget
1499 toolbar widget :prepend :tooltip-text tooltip-text
1500 :tooltip-private-text tooltip-private-text :callback callback))
1502 (defun toolbar-insert-item (toolbar text icon position &key tooltip-text
1503 tooltip-private-text callback)
1504 (toolbar-insert-element
1505 toolbar position :text text :icon icon :callback callback
1506 :tooltip-text tooltip-text :tooltip-private-text tooltip-private-text))
1508 (defun toolbar-append-item (toolbar text icon &key tooltip-text
1509 tooltip-private-text callback)
1510 (toolbar-insert-item
1511 toolbar text icon :append :callback callback
1512 :tooltip-text tooltip-text :tooltip-private-text tooltip-private-text))
1515 (defun toolbar-prepend-item (toolbar text icon &key tooltip-text
1516 tooltip-private-text callback)
1517 (toolbar-insert-item
1518 toolbar text icon :prepend :callback callback
1519 :tooltip-text tooltip-text :tooltip-private-text tooltip-private-text))
1521 (defun toolbar-enable-tooltips (toolbar)
1522 (setf (toolbar-tooltips-p toolbar) t))
1524 (defun toolbar-disable-tooltips (toolbar)
1525 (setf (toolbar-tooltips-p toolbar) nil))
1531 (define-foreign tree-new () tree)
1533 (define-foreign tree-append () nil
1535 (tree-item tree-item))
1537 (define-foreign tree-prepend () nil
1539 (tree-item tree-item))
1541 (define-foreign tree-insert () nil
1543 (tree-item tree-item)
1546 (define-foreign tree-remove-items () nil
1548 (items (double-list tree-item)))
1550 (define-foreign tree-clear-items () nil
1555 (define-foreign tree-select-item () nil
1559 (define-foreign tree-unselect-item () nil
1563 (define-foreign tree-select-child () nil
1565 (tree-item tree-item))
1567 (define-foreign tree-unselect-child () nil
1569 (tree-item tree-item))
1571 (define-foreign tree-child-position () int
1573 (tree-item tree-item))
1575 (defun root-tree-p (tree)
1576 (eq (tree-root-tree tree) tree))
1579 (define-foreign tree-selection () (double-list tree-item)
1586 (define-foreign calendar-new () calendar)
1588 (define-foreign calendar-select-month () int
1590 (month unsigned-int)
1591 (year unsigned-int))
1593 (define-foreign calendar-select-day () nil
1597 (define-foreign calendar-mark-day () int
1601 (define-foreign calendar-unmark-day () int
1605 (define-foreign calendar-clear-marks () nil
1606 (calendar calendar))
1608 (define-foreign calendar-display-options () nil
1610 (options calendar-display-options))
1612 (define-foreign ("gtk_calendar_get_date" calendar-date) () nil
1614 (year unsigned-int :out)
1615 (month unsigned-int :out)
1616 (day unsigned-int :out))
1618 (define-foreign calendar-freeze () nil
1619 (calendar calendar))
1621 (define-foreign calendar-thaw () nil
1622 (calendar calendar))
1628 ; (define-foreign drawing-area-new () drawing-area)
1630 ; (define-foreign ("gtk_drawing_area_size" %drawing-area-set-size) () nil
1631 ; (drawing-area drawing-area)
1635 ; (defun (setf drawing-area-size) (size drawing-area)
1636 ; (%drawing-area-set-size drawing-area (svref size 0) (svref size 1))
1637 ; (values (svref size 0) (svref size 1)))
1640 ; (define-foreign ("gtk_drawing_area_get_size" drawing-area-size) () nil
1641 ; (drawing-area drawing-area)
1643 ; (height int :out))
1653 (define-foreign editable-select-region (editable &optional (start 0) end) nil
1658 (define-foreign editable-insert-text
1659 (editable text &optional (position 0)) nil
1663 ((or position -1) int :in-out))
1665 (defun editable-append-text (editable text)
1666 (editable-insert-text editable text nil))
1668 (defun editable-prepend-text (editable text)
1669 (editable-insert-text editable text 0))
1671 (define-foreign editable-delete-text (editable &optional (start 0) end) nil
1676 (define-foreign ("gtk_editable_get_chars" editable-text)
1677 (editable &optional (start 0) end) string
1682 (defun (setf editable-text) (text editable)
1684 (editable-delete-text
1686 (editable-insert-text editable text))
1687 (editable-delete-text editable))
1690 (define-foreign editable-cut-clipboard () nil
1691 (editable editable))
1693 (define-foreign editable-copy-clipboard () nil
1694 (editable editable))
1696 (define-foreign editable-paste-clipboard () nil
1697 (editable editable))
1699 (define-foreign editable-claim-selection () nil
1702 (time unsigned-int))
1704 (define-foreign editable-delete-selection () nil
1705 (editable editable))
1707 (define-foreign editable-changed () nil
1708 (editable editable))
1714 (define-foreign %entry-new() entry)
1716 (define-foreign %entry-new-with-max-length () entry
1717 (max (unsigned 16)))
1719 (defun entry-new (&optional max)
1721 (%entry-new-with-max-length max)
1727 (define-foreign spin-button-new () spin-button
1728 (adjustment adjustment)
1729 (climb-rate single-float)
1730 (digits unsigned-int))
1732 (defun spin-button-value-as-int (spin-button)
1733 (round (spin-button-value spin-button)))
1735 (define-foreign spin-button-spin () nil
1736 (spin-button spin-button)
1737 (direction spin-type)
1738 (increment single-float))
1740 (define-foreign spin-button-update () nil
1741 (spin-button spin-button))
1747 (define-foreign ruler-set-range () nil
1749 (lower single-float)
1750 (upper single-float)
1751 (position single-float)
1752 (max-size single-float))
1754 (define-foreign ruler-draw-ticks () nil
1757 (define-foreign ruler-draw-pos () nil
1764 ; (define-foreign range-draw-background () nil
1767 ; (define-foreign range-clear-background () nil
1770 ; (define-foreign range-draw-trough () nil
1773 ; (define-foreign range-draw-slider () nil
1776 ; (define-foreign range-draw-step-forw () nil
1779 ; (define-foreign range-slider-update () nil
1782 ; (define-foreign range-trough-click () int
1786 ; (jump-perc single-float :out))
1788 ; (define-foreign range-default-hslider-update () nil
1791 ; (define-foreign range-default-vslider-update () nil
1794 ; (define-foreign range-default-htrough-click () int
1798 ; (jump-perc single-float :out))
1800 ; (define-foreign range-default-vtrough-click () int
1804 ; (jump-perc single-float :out))
1806 ; (define-foreign range-default-hmotion () int
1811 ; (define-foreign range-default-vmotion () int
1820 ; (define-foreign scale-draw-value () nil
1823 ; (define-foreign hscale-new () hscale
1824 ; (adjustment adjustment))
1826 ; (define-foreign vscale-new () hscale
1827 ; (adjustment adjustment))
1833 ; (define-foreign hscrollbar-new () hscrollbar
1834 ; (adjustment adjustment))
1836 ; (define-foreign vscrollbar-new () vscrollbar
1837 ; (adjustment adjustment))
1843 (define-foreign vseparator-new () vseparator)
1845 (define-foreign hseparator-new () hseparator)
1855 ; (define-foreign progress-configure () adjustment
1856 ; (progress progress)
1857 ; (value single-float)
1858 ; (min single-float)
1859 ; (max single-float))
1861 ; (define-foreign ("gtk_progress_get_text_from_value"
1862 ; progress-text-from-value) () string
1863 ; (progress progress))
1865 ; (define-foreign ("gtk_progress_get_percentage_from_value"
1866 ; progress-percentage-from-value) () single-float
1867 ; (progress progress))
1873 ; (define-foreign %progress-bar-new () progress-bar)
1875 ; (define-foreign %progress-bar-new-with-adjustment () progress-bar
1876 ; (adjustment adjustment))
1878 ; (defun progress-bar-new (&optional adjustment)
1880 ; (%progress-bar-new-with-adjustment adjustment)
1881 ; (%progress-bar-new)))
1883 ; (define-foreign progress-bar-update () nil
1884 ; (progress-bar progress-bar)
1885 ; (percentage single-float))
1891 (define-foreign adjustment-new () adjustment
1892 (value single-float)
1893 (lower single-float)
1894 (upper single-float)
1895 (step-increment single-float)
1896 (page-increment single-float)
1897 (page-size single-float))
1899 (define-foreign adjustment-changed () nil
1900 (adjustment adjustment))
1902 (define-foreign adjustment-value-changed () nil
1903 (adjustment adjustment))
1905 (define-foreign adjustment-clamp-page () nil
1906 (adjustment adjustment)
1907 (lower single-float)
1908 (upper single-float))
1914 ; (define-foreign tooltips-new () tooltips)
1916 ; (define-foreign tooltips-enable () nil
1917 ; (tooltips tooltips))
1919 ; (define-foreign tooltips-disable () nil
1920 ; (tooltips tooltips))
1922 ; (define-foreign tooltips-set-tip () nil
1923 ; (tooltips tooltips)
1926 ; (tip-private string))
1928 ; (declaim (inline tooltips-set-colors-real))
1929 ; (define-foreign ("gtk_tooltips_set_colors" tooltips-set-colors-real) () nil
1930 ; (tooltips tooltips)
1931 ; (background gdk:color)
1932 ; (foreground gdk:color))
1934 ; (defun tooltips-set-colors (tooltips background foreground)
1935 ; (gdk:with-colors ((background background)
1936 ; (foreground foreground))
1937 ; (tooltips-set-colors-real tooltips background foreground)))
1939 ; (define-foreign tooltips-force-window () nil
1940 ; (tooltips tooltips))
1947 ; (define-foreign rc-add-default-file (filename) nil
1948 ; ((namestring (truename filename)) string))
1950 ; (define-foreign rc-parse (filename) nil
1951 ; ((namestring (truename filename)) string))
1953 ; (define-foreign rc-parse-string () nil
1954 ; (rc-string string))
1956 ; (define-foreign rc-reparse-all () nil)
1958 ; ;(define-foreign rc-get-style () style
1959 ; ; (widget widget))
1963 ;;; Accelerator Groups
1965 (define-foreign accel-group-new () accel-group)
1967 (define-foreign accel-group-get-default () accel-group)
1969 (deftype-method alien-ref accel-group (type-spec)
1970 (declare (ignore type-spec))
1973 (deftype-method alien-unref accel-group (type-spec)
1974 (declare (ignore type-spec))
1975 '%accel-group-unref)
1977 (define-foreign %accel-group-ref () accel-group
1978 (accel-group (or accel-group pointer)))
1980 (define-foreign %accel-group-unref () nil
1981 (accel-group (or accel-group pointer)))
1983 (define-foreign accel-group-activate (accel-group key modifiers) boolean
1984 (accel-group accel-group)
1985 ((gdk:keyval-from-name key) unsigned-int)
1986 (modifiers gdk:modifier-type))
1988 (define-foreign accel-groups-activate (object key modifiers) boolean
1990 ((gdk:keyval-from-name key) unsigned-int)
1991 (modifiers gdk:modifier-type))
1993 (define-foreign accel-group-attach () nil
1994 (accel-group accel-group)
1997 (define-foreign accel-group-detach () nil
1998 (accel-group accel-group)
2001 (define-foreign accel-group-lock () nil
2002 (accel-group accel-group))
2004 (define-foreign accel-group-unlock () nil
2005 (accel-group accel-group))
2008 ;;; Accelerator Groups Entries
2010 (define-foreign accel-group-get-entry (accel-group key modifiers) accel-entry
2011 (accel-group accel-group)
2012 ((gdk:keyval-from-name key) unsigned-int)
2013 (modifiers gdk:modifier-type))
2015 (define-foreign accel-group-lock-entry (accel-group key modifiers) nil
2016 (accel-group accel-group)
2017 ((gdk:keyval-from-name key) unsigned-int)
2018 (modifiers gdk:modifier-type))
2020 (define-foreign accel-group-unlock-entry (accel-group key modifiers) nil
2021 (accel-group accel-group)
2022 ((gdk:keyval-from-name key) unsigned-int)
2023 (modifiers gdk:modifier-type))
2025 (define-foreign accel-group-add
2026 (accel-group key modifiers flags object signal) nil
2027 (accel-group accel-group)
2028 ((gdk:keyval-from-name key) unsigned-int)
2029 (modifiers gdk:modifier-type)
2032 ((name-to-string signal) string))
2034 (define-foreign accel-group-add (accel-group key modifiers object) nil
2035 (accel-group accel-group)
2036 ((gdk:keyval-from-name key) unsigned-int)
2037 (modifiers gdk:modifier-type)
2041 ;;; Accelerator Signals
2043 (define-foreign accel-group-handle-add
2044 (object signal-id accel-group key modifiers flags) nil
2046 (signal-id unsigned-int)
2047 (accel-group accel-group)
2048 ((gdk:keyval-from-name key) unsigned-int)
2049 (modifiers gdk:modifier-type)
2050 (flags accel-flags))
2052 (define-foreign accel-group-handle-remove
2053 (object accel-group key modifiers) nil
2055 (accel-group accel-group)
2056 ((gdk:keyval-from-name key) unsigned-int)
2057 (modifiers gdk:modifier-type))
2063 ; (define-foreign style-new () style)
2065 ; (define-foreign style-copy () style
2068 ; (define-foreign style-ref () style
2071 ; (define-foreign style-unref () nil
2074 ; (define-foreign style-get-color () gdk:color
2076 ; (color-type color-type)
2077 ; (state-type state-type))
2080 ; ("gtk_style_set_color" style-set-color-from-color) () gdk:color
2082 ; (color-type color-type)
2083 ; (state-type state-type)
2084 ; (color gdk:color))
2086 ; (defun style-set-color (style color-type state-type color)
2087 ; (gdk:with-colors ((color color))
2088 ; (style-set-color-from-color style color-type state-type color)))
2090 ; (define-foreign ("gtk_style_get_font" style-font) () gdk:font
2093 ; (define-foreign style-set-font () gdk:font
2097 ; (defun (setf style-font) (font style)
2098 ; (let ((font (gdk:ensure-font font)))
2099 ; (gdk:font-unref (style-font style))
2100 ; (style-set-font style font)))
2102 ; (defun style-fg (style state)
2103 ; (style-get-color style :foreground state))
2105 ; (defun (setf style-fg) (color style state)
2106 ; (style-set-color style :foreground state color))
2108 ; (defun style-bg (style state)
2109 ; (style-get-color style :background state))
2111 ; (defun (setf style-bg) (color style state)
2112 ; (style-set-color style :background state color))
2114 ; (defun style-text (style state)
2115 ; (style-get-color style :text state))
2117 ; (defun (setf style-text) (color style state)
2118 ; (style-set-color style :text state color))
2120 ; (defun style-base (style state)
2121 ; (style-get-color style :base state))
2123 ; (defun (setf style-base) (color style state)
2124 ; (style-set-color style :base state color))
2126 ; (defun style-white (style)
2127 ; (style-get-color style :white :normal))
2129 ; (defun (setf style-white) (color style)
2130 ; (style-set-color style :white :normal color))
2132 ; (defun style-black (style)
2133 ; (style-get-color style :black :normal))
2135 ; (defun (setf style-black) (color style)
2136 ; (style-set-color style :black :normal color))
2138 ; (define-foreign style-get-gc
2139 ; (style color-type &optional (state-type :normal)) gdk:gc
2141 ; (color-type color-type)
2142 ; (state-type state-type))