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.1 2000-08-14 16:44:51 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))))
42 (export '*clg-version*)
46 ;;; InitializationInitialization, exit, mainloop and miscellaneous routines
49 (define-foreign grab-add () nil
52 (define-foreign grab-get-current () widget)
54 (define-foreign grab-remove () nil
57 (define-foreign ("gtk_timeout_add_full" timeout-add)
58 (interval function) unsigned-int
59 (interval (unsigned 32))
61 (*callback-marshal* pointer)
62 ((register-callback-function function) unsigned-long)
63 (*destroy-marshal* pointer))
65 (define-foreign timeout-remove () nil
66 (timeout-handler-id unsigned-int))
68 (define-foreign ("gtk_idle_add_full" idle-add)
69 (function &optional (priority 200)) unsigned-int
72 (*callback-marshal* pointer)
73 ((register-callback-function function) unsigned-long)
74 (*destroy-marshal* pointer))
76 (define-foreign idle-remove () nil
77 (idle-handler-id unsigned-int))
79 (define-foreign get-current-event () gdk:event)
81 (define-foreign get-event-widget () widget
85 ;;; should be moved to gobject
87 ; (define-foreign ("gtk_object_set_data_full" object-set-data)
88 ; (object key data &optional destroy-function) nil
90 ; ((string key) string)
91 ; ((register-user-data data destroy-function) unsigned-long)
92 ; (*destroy-marshal* pointer))
94 ; (defun (setf object-data) (data object key)
95 ; (object-set-data object key data)
98 ; (define-foreign %object-get-data (object key) unsigned-long
100 ; ((string key) string))
102 ; (defun object-data (object key)
103 ; (find-user-data (%object-get-data object key)))
105 ; (define-foreign object-remove-data (object key) nil
107 ; ((string key) string))
109 ; (defun object-user-data (object)
110 ; (object-data object :user-data))
112 ; (defun (setf object-user-data) (data object)
113 ; (setf (object-data object :user-data) data))
118 (define-foreign label-new () label
121 (define-foreign label-parse-uline () unsigned-int
129 (define-foreign accel-label-new () accel-label
132 (define-foreign accel-label-refetch () boolean
133 (accel-label accel-label))
139 (define-foreign tips-query-new () tips-query)
141 (define-foreign tips-query-start-query () nil
142 (tips-query tips-query))
144 (define-foreign tips-query-stop-query () nil
145 (tips-query tips-query))
151 (define-foreign arrow-new () arrow
152 (arrow-type arrow-type)
153 (shadow-type shadow-type))
159 ; (defun %pixmap-create (source)
162 ; ((typep source gdk:pixmap) source)
163 ; ((and (consp source) (typep (first source) gdk:pixmap)) (values-list source))
164 ; (t (gdk:pixmap-create source))))
166 (define-foreign %pixmap-new () pixmap
168 (mask (or null gdk:bitmap)))
170 (defun pixmap-new (source)
171 (multiple-value-bind (pixmap mask)
172 (%pixmap-create source)
173 (%pixmap-new pixmap mask)))
175 (define-foreign %pixmap-set () nil
177 (gdk:pixmap gdk:pixmap)
178 (mask (or null gdk:bitmap)))
180 (defun (setf pixmap-pixmap) (source pixmap)
181 (multiple-value-bind (gdk:pixmap mask)
182 (%pixmap-create source)
183 (%pixmap-set pixmap gdk:pixmap mask)
184 (values gdk:pixmap mask)))
186 (define-foreign ("gtk_pixmap_get" pixmap-pixmap) () nil
188 (val gdk:pixmap :out)
189 (mask gdk:bitmap :out))
195 (defun bin-child (bin)
196 (first (container-children bin)))
198 (defun (setf bin-child) (child bin)
199 (let ((old-child (bin-child bin)))
201 (container-remove bin old-child)))
202 (container-add bin child)
208 (define-foreign alignment-new () alignment
209 (xalign single-float)
211 (xscale single-float)
212 (yscale single-float))
218 (define-foreign frame-new (&optional label) frame
225 (define-foreign aspect-frame-new () alignment
226 (xalign single-float)
229 (obey-child boolean))
235 (define-foreign %button-new () button)
237 (define-foreign %button-new-with-label () button
240 (defun button-new (&optional label)
242 (%button-new-with-label label)
245 (define-foreign button-pressed () nil
248 (define-foreign button-released () nil
251 (define-foreign button-clicked () nil
254 (define-foreign button-enter () nil
257 (define-foreign button-leave () nil
264 (define-foreign %toggle-button-new () toggle-button)
266 (define-foreign %toggle-button-new-with-label () toggle-button
269 (defun toggle-button-new (&optional label)
271 (%toggle-button-new-with-label label)
272 (%toggle-button-new)))
274 (define-foreign toggle-button-toggled () nil
275 (toggle-button toggle-button))
281 (define-foreign %check-button-new () check-button)
283 (define-foreign %check-button-new-with-label () check-button
286 (defun check-button-new (&optional label)
288 (%check-button-new-with-label label)
289 (%check-button-new)))
295 (define-foreign %radio-button-new () radio-button
296 (group (or null radio-button-group)))
298 (define-foreign %radio-button-new-with-label-from-widget () radio-button
299 (widget (or null widget))
302 (define-foreign %radio-button-new-from-widget () radio-button
303 (widget (or null widget)))
305 (define-foreign %radio-button-new-with-label () radio-button
306 (group (or null radio-button-group))
309 (defun radio-button-new (group &key label from-widget)
311 ((and from-widget label)
312 (%radio-button-new-with-label-from-widget group label))
314 (%radio-button-new-from-widget group))
316 (%radio-button-new-with-label group label))
318 (%radio-button-new group))))
320 (define-foreign radio-button-group () radio-button-group
321 (radio-button radio-button))
327 ; (define-foreign option-menu-new () option-menu)
329 ; (define-foreign %option-menu-set-menu () nil
330 ; (option-menu option-menu)
333 ; (define-foreign %option-menu-remove-menu () nil
334 ; (option-menu option-menu))
336 ; (defun (setf option-menu-menu) (menu option-menu)
338 ; (%option-menu-remove-menu option-menu)
339 ; (%option-menu-set-menu option-menu menu))
346 (define-foreign item-select () nil
349 (define-foreign item-deselect () nil
352 (define-foreign item-toggle () nil
359 ; (define-foreign %menu-item-new () menu-item)
361 ; (define-foreign %menu-item-new-with-label () menu-item
364 ; (defun menu-item-new (&optional label)
366 ; (%menu-item-new-with-label label)
369 ; (defun (setf menu-item-label) (label menu-item)
370 ; (let ((accel-label (accel-label-new label)))
371 ; (setf (misc-xalign accel-label) 0.0)
372 ; (setf (misc-yalign accel-label) 0.5)
374 ; (container-add menu-item accel-label)
375 ; (setf (accel-label-accel-widget accel-label) menu-item)
376 ; (widget-show accel-label))
379 ; (define-foreign %menu-item-set-submenu () nil
380 ; (menu-item menu-item)
383 ; (define-foreign %menu-item-remove-submenu () nil
384 ; (menu-item menu-item))
386 ; (defun (setf menu-item-submenu) (submenu menu-item)
388 ; (%menu-item-remove-submenu menu-item)
389 ; (%menu-item-set-submenu menu-item submenu))
392 ; (define-foreign %menu-item-configure () nil
393 ; (menu-item menu-item)
394 ; (show-toggle-indicator boolean)
395 ; (show-submenu-indicator boolean))
397 ; (defun (setf menu-item-toggle-indicator-p) (show menu-item)
398 ; (%menu-item-configure
401 ; (menu-item-submenu-indicator-p menu-item))
404 ; (defun (setf menu-item-submenu-indicator-p) (show menu-item)
405 ; (%menu-item-configure
407 ; (menu-item-toggle-indicator-p menu-item)
410 ; (define-foreign menu-item-select () nil
411 ; (menu-item menu-item))
413 ; (define-foreign menu-item-deselect () nil
414 ; (menu-item menu-item))
416 ; (define-foreign menu-item-activate () nil
417 ; (menu-item menu-item))
419 ; (define-foreign menu-item-right-justify () nil
420 ; (menu-item menu-item))
424 ; ;;; Check menu item
426 ; (define-foreign %check-menu-item-new
427 ; () check-menu-item)
429 ; (define-foreign %check-menu-item-new-with-label () check-menu-item
432 ; (defun check-menu-item-new (&optional label)
434 ; (%check-menu-item-new-with-label label)
435 ; (%check-menu-item-new)))
437 ; (define-foreign check-menu-item-toggled () nil
438 ; (check-menu-item check-menu-item))
442 ; ;;; Radio menu item
444 ; (define-foreign %radio-menu-item-new
446 ; (group (or null radio-menu-item-group)))
448 ; (define-foreign %radio-menu-item-new-with-label () radio-menu-item
449 ; (group (or null radio-menu-item-group))
452 ; (defun radio-menu-item-new (group &optional label)
454 ; (%radio-menu-item-new-with-label group label)
455 ; (%radio-menu-item-new group)))
459 ; ;;; Tearoff menu item
461 ; (define-foreign tearoff-menu-item-new () tearoff-menu-item)
467 (define-foreign %list-item-new () list-item)
469 (define-foreign %list-item-new-with-label () list-item
472 (defun list-item-new (&optional label)
474 (%list-item-new-with-label label)
477 (define-foreign list-item-select () nil
478 (list-item list-item))
480 (define-foreign list-item-deselect () nil
481 (list-item list-item))
487 (define-foreign %tree-item-new () tree-item)
489 (define-foreign %tree-item-new-with-label () tree-item
492 (defun tree-item-new (&optional label)
494 (%tree-item-new-with-label label)
497 (define-foreign %tree-item-set-subtree () nil
498 (tree-item tree-item)
501 (define-foreign %tree-item-remove-subtree () nil
502 (tree-item tree-item))
504 (defun (setf tree-item-subtree) (subtree tree-item)
506 (%tree-item-set-subtree tree-item subtree)
507 (%tree-item-remove-subtree tree-item))
510 (define-foreign tree-item-select () nil
511 (tree-item tree-item))
513 (define-foreign tree-item-deselect () nil
514 (tree-item tree-item))
516 (define-foreign tree-item-expand () nil
517 (tree-item tree-item))
519 (define-foreign tree-item-collapse () nil
520 (tree-item tree-item))
526 (define-foreign window-new () window
529 (define-foreign %window-set-wmclass () nil
531 (wmclass-name string)
532 (wmclass-class string))
534 (defun (setf window-wmclass) (wmclass window)
535 (%window-set-wmclass window (svref wmclass 0) (svref wmclass 1))
536 (values (svref wmclass 0) (svref wmclass 1)))
539 (define-foreign window-wmclass () nil
541 (wmclass-name string :out)
542 (wmclass-class string :out))
544 (define-foreign window-add-accel-group () nil
546 (accel-group accel-group))
548 (define-foreign window-remove-accel-group () nil
550 (accel-group accel-group))
552 (define-foreign window-activate-focus () int
555 (define-foreign window-activate-default () int
558 (define-foreign window-set-transient-for () nil
562 ;(define-foreign window-set-geometry-hints)
566 ;;; Color selection dialog
568 ; (define-foreign color-selection-dialog-new () color-selection-dialog
575 ; (define-foreign dialog-new () dialog)
581 ; (define-foreign input-dialog-new () dialog)
587 ; (define-foreign file-selection-new () file-selection
590 ; (define-foreign file-selection-complete () nil
591 ; (file-selection file-selection)
594 ; (define-foreign file-selection-show-fileop-buttons () nil
595 ; (file-selection file-selection))
597 ; (define-foreign file-selection-hide-fileop-buttons () nil
598 ; (file-selection file-selection))
604 ; (define-foreign handle-box-new () handle-box)
608 ; ;;; Scrolled window
610 (define-foreign scrolled-window-new
611 (&optional hadjustment vadjustment) scrolled-window
612 (hadjustment (or null adjustment))
613 (vadjustment (or null adjustment)))
615 (defun (setf scrolled-window-scrollbar-policy) (policy window)
616 (setf (scrolled-window-hscrollbar-policy window) policy)
617 (setf (scrolled-window-vscrollbar-policy window) policy))
619 (define-foreign scrolled-window-add-with-viewport () nil
620 (scrolled-window scrolled-window)
627 ; (define-foreign viewport-new () viewport
628 ; (hadjustment adjustment)
629 ; (vadjustment adjustment))
635 (define-foreign box-pack-start () nil
640 (padding unsigned-int))
642 (define-foreign box-pack-end () nil
647 (padding unsigned-int))
649 (defun box-pack (box child &key (pack :start) (expand t) (fill t) (padding 0))
651 (box-pack-start box child expand fill padding)
652 (box-pack-end box child expand fill padding)))
654 (define-foreign box-reorder-child () nil
659 (define-foreign box-query-child-packing () nil
662 (expand boolean :out)
664 (padding unsigned-int :out)
665 (pack-type pack-type :out))
667 (define-foreign box-set-child-packing () nil
672 (padding unsigned-int)
673 (pack-type pack-type))
679 (define-foreign ("gtk_button_box_get_child_size_default"
680 button-box-default-child-size) () nil
682 (min-height int :out))
684 (define-foreign ("gtk_button_box_get_child_ipadding_default"
685 button-box-default-child-ipadding) () nil
689 (define-foreign %button-box-set-child-size-default () nil
693 (defun (setf button-box-default-child-size) (size)
694 (%button-box-set-child-size-default (svref size 0) (svref size 1))
695 (values (svref size 0) (svref size 1)))
697 (define-foreign %button-box-set-child-ipadding-default () nil
701 (defun (setf button-box-default-child-ipadding) (ipad)
702 (%button-box-set-child-ipadding-default (svref ipad 0) (svref ipad 1))
703 (values (svref ipad 0) (svref ipad 1)))
706 ("gtk_button_box_get_child_size" button-box-child-size) () nil
707 (button-box button-box)
709 (min-height int :out))
712 ("gtk_button_box_get_child_ipadding" button-box-child-ipadding) () nil
713 (button-box button-box)
717 (define-foreign %button-box-set-child-size () nil
718 (button-box button-box)
722 (defun (setf button-box-child-size) (size button-box)
723 (%button-box-set-child-size button-box (svref size 0) (svref size 1))
724 (values (svref size 0) (svref size 1)))
726 (define-foreign %button-box-set-child-ipadding () nil
727 (button-box button-box)
731 (defun (setf button-box-child-ipadding) (ipad button-box)
732 (%button-box-set-child-ipadding button-box (svref ipad 0) (svref ipad 1))
733 (values (svref ipad 0) (svref ipad 1)))
739 ;(define-foreign hbutton-box-new () hbutton-box)
741 (define-foreign ("gtk_hbutton_box_get_spacing_default"
742 hbutton-box-default-spacing) () int)
744 (define-foreign ("gtk_hbutton_box_set_spacing_default"
745 (setf hbutton-box-default-spacing)) () nil
748 (define-foreign ("gtk_hbutton_box_get_layout_default"
749 hbutton-box-default-layout) () button-box-style)
751 (define-foreign ("gtk_hbutton_box_set_layout_default"
752 (setf hbutton-box-default-layout)) () nil
753 (layout button-box-style))
759 ;(define-foreign vbutton-box-new () vbutton-box)
761 (define-foreign ("gtk_vbutton_box_get_spacing_default"
762 vbutton-box-default-spacing) () int)
764 (define-foreign ("gtk_vbutton_box_set_spacing_default"
765 (setf vbutton-box-default-spacing)) () nil
768 (define-foreign ("gtk_vbutton_box_get_layout_default"
769 vbutton-box-default-layout) () button-box-style)
771 (define-foreign ("gtk_vbutton_box_set_layout_default"
772 (setf vbutton-box-default-layout)) () nil
773 (layout button-box-style))
779 (define-foreign vbox-new () vbox
780 (homogeneous boolean)
787 ; (define-foreign color-selection-new () color-selection)
790 ; (define-foreign %color-selection-set-color-by-values () nil
791 ; (colorsel color-selection)
793 ; (green double-float)
794 ; (blue double-float)
795 ; (opacity double-float))
797 ; (defun (setf color-selection-color) (color colorsel)
798 ; (%color-selection-set-color-by-values
800 ; (svref color 0) (svref color 1) (svref color 2)
801 ; (if (> (length color) 3)
807 ; (define-foreign %color-selection-get-color-as-values () nil
808 ; (colorsel color-selection)
809 ; (red double-float :out)
810 ; (green double-float :out)
811 ; (blue double-float :out)
812 ; (opacity double-float :out))
814 ; (defun color-selection-color (colorsel)
815 ; (multiple-value-bind (red green blue opacity)
816 ; (%color-selection-get-color-as-values colorsel)
817 ; (if (color-selection-use-opacity-p colorsel)
818 ; (vector red green blue opacity)
819 ; (vector red green blue))))
826 ; (define-foreign gamma-curve-new () gamma-curve)
832 (define-foreign hbox-new () hbox
833 (homogeneous boolean)
840 ; (define-foreign combo-new () combo)
842 ; (define-foreign combo-set-value-in-list () nil
845 ; (ok-if-empty boolean))
847 ; (define-foreign ("gtk_combo_set_item_string" (setf combo-item-string)) () nil
850 ; (item-value string))
852 ; (define-foreign ("gtk_combo_set_popdown_strings"
853 ; (setf combo-popdown-strings)) () nil
855 ; (strings (double-list string)))
857 ; (define-foreign combo-disable-activate () nil
864 ; (define-foreign statusbar-new () statusbar)
867 ; ("gtk_statusbar_get_context_id" statusbar-context-id) () unsigned-int
868 ; (statusbar statusbar)
869 ; (context-description string))
871 ; (define-foreign statusbar-push () unsigned-int
872 ; (statusbar statusbar)
873 ; (context-id unsigned-int)
876 ; (define-foreign statusbar-pop () nil
877 ; (statusbar statusbar)
878 ; (context-id unsigned-int))
880 ; (define-foreign statusbar-remove () nil
881 ; (statusbar statusbar)
882 ; (context-id unsigned-int)
883 ; (message-id unsigned-int))
889 ; (define-foreign %clist-new () clist
892 ; (define-foreign %clist-new-with-titles () clist
896 ; (defun clist-new (columns)
898 ; (%clist-new columns)
899 ; (with-array (titles :initial-contents columns :free-contents t)
900 ; (%clist-new-with-titles (length columns) titles))))
902 ; (define-foreign ("gtk_clist_set_button_actions"
903 ; (setf clist-button-actions)) () nil
905 ; (button unsigned-int)
906 ; (button-actions button-actions))
908 ; (define-foreign clist-freeze () nil
911 ; (define-foreign clist-thaw () nil
914 ; (define-foreign clist-column-titles-show () nil
917 ; (define-foreign clist-column-titles-hide () nil
920 ; (defun (setf clist-titles-visible-p) (visible clist)
922 ; (clist-column-titles-hide clist)
923 ; (clist-column-titles-show clist)))
925 ; (define-foreign clist-column-title-active () nil
929 ; (define-foreign clist-column-title-passive () nil
933 ; (define-foreign clist-column-titles-active () nil
936 ; (define-foreign clist-column-titles-passive () nil
939 ; (define-foreign ("gtk_clist_set_column_title"
940 ; (setf clist-column-title)) () nil
945 ; (define-foreign ("gtk_clist_get_column_title" clist-column-title) () string
949 ; (define-foreign ("gtk_clist_set_column_widget"
950 ; (setf clist-column-widget)) () nil
955 ; (define-foreign ("gtk_clist_get_column_widget" clist-column-widget) () widget
959 ; (define-foreign ("gtk_clist_set_column_justification"
960 ; (setf clist-column-justification)) () nil
963 ; (justification justification))
965 ; (define-foreign clist-column-justification (clist column) justification
968 ; (assert (and (>= column 0) (< column (clist-n-columns clist))))
972 ; (define-foreign ("gtk_clist_set_column_visibility"
973 ; (setf clist-column-visible-p)) () nil
979 ; (define-foreign clist-column-visible-p (clist column) boolean
982 ; (assert (and (>= column 0) (< column (clist-n-columns clist))))
986 ; (define-foreign ("gtk_clist_set_column_resizeable"
987 ; (setf clist-column-resizeable-p)) () nil
990 ; (resizeable boolean))
993 ; (define-foreign clist-column-resizeable-p (clist column) boolean
996 ; (assert (and (>= column 0) (< column (clist-n-columns clist))))
1000 ; (define-foreign ("gtk_clist_set_column_auto_resize"
1001 ; (setf clist-column-auto-resize-p)) () nil
1004 ; (auto-resize boolean))
1007 ; (define-foreign clist-column-auto-resize-p (clist column) boolean
1010 ; (assert (and (>= column 0) (< column (clist-n-columns clist))))
1014 ; (define-foreign clist-columns-autosize () int
1017 ; (define-foreign clist-optimal-column-width () int
1021 ; (define-foreign ("gtk_clist_set_column_width"
1022 ; (setf clist-column-width)) () nil
1028 ; (define-foreign clist-column-width (clist column) int
1031 ; (assert (and (>= column 0) (< column (clist-n-columns clist))))
1035 ; (define-foreign ("gtk_clist_set_column_min_width"
1036 ; (setf clist-column-min-width)) (min-width clist column) nil
1039 ; ((or min-width -1) int))
1041 ; (define-foreign ("gtk_clist_set_column_max_width"
1042 ; (setf clist-column-max-width)) (max-width clist column) nil
1045 ; ((or max-width -1) int))
1047 ; (define-foreign clist-moveto () nil
1051 ; (row-align single-float)
1052 ; (columnt-align single-float))
1055 ; ("gtk_clist_row_is_visible" clist-row-visiblie-p) () visibility
1059 ; (define-foreign ("gtk_clist_get_cell_type" clist-cell-type) () cell-type
1064 ; (define-foreign ("gtk_clist_set_text" (setf clist-cell-text)) () nil
1070 ; (define-foreign %clist-set-pixmap () nil
1074 ; (gdk:pixmap gdk:pixmap)
1075 ; (mask (or null gdk:bitmap)))
1077 ; (defun (setf clist-cell-pixmap) (pixmap clist row column)
1078 ; (multiple-value-bind (gdk:pixmap mask)
1079 ; (%pixmap-create pixmap)
1080 ; (%clist-set-pixmap clist row column gdk:pixmap mask)
1081 ; (values pixmap mask)))
1083 ; (define-foreign %clist-set-pixtext () nil
1089 ; (pixmap gdk:pixmap)
1090 ; (mask (or null gdk:bitmap)))
1092 ; (defun clist-set-cell-pixtext (clist row column text spacing pixmap)
1093 ; (multiple-value-bind (gdk:pixmap mask)
1094 ; (%pixmap-create pixmap)
1095 ; (%clist-set-pixtext clist row column text spacing gdk:pixmap mask)))
1097 ; (define-foreign %clist-get-text () boolean
1101 ; (text string :out))
1103 ; (defun clist-cell-text (clist row column)
1104 ; (multiple-value-bind (success text)
1105 ; (%clist-get-text clist row column)
1108 ; "Cell at row ~D column ~D in ~A is not of type :text"
1109 ; row column clist))
1112 ; (define-foreign ("gtk_clist_get_pixmap" %clist-get-pixmap) () boolean
1116 ; (pixmap gdk:pixmap :out)
1117 ; (mask gdk:bitmap :out))
1119 ; (defun clist-cell-pixmap (clist row column)
1120 ; (multiple-value-bind (success pixmap mask)
1121 ; (%clist-get-pixmap clist row column)
1124 ; "Cell at row ~D column ~D in ~A is not of type :pixmap"
1125 ; row column clist))
1126 ; (values pixmap mask)))
1128 ; (define-foreign %clist-get-pixtext () boolean
1132 ; (text string :out)
1133 ; (spacing unsigned-int :out)
1134 ; (pixmap gdk:pixmap :out)
1135 ; (mask gdk:bitmap :out))
1137 ; (defun clist-cell-pixtext (clist row column)
1138 ; (multiple-value-bind (success text spacing pixmap mask)
1139 ; (%clist-get-pixtext clist row column)
1142 ; "Cell at row ~D column ~D in ~A is not of type :pixtext"
1143 ; row column clist))
1144 ; (values text spacing pixmap mask)))
1146 ; (define-foreign %clist-set-foreground () nil
1149 ; (color gdk:color))
1151 ; (defun (setf clist-foreground) (color clist row)
1152 ; (gdk:with-colors ((color color))
1153 ; (%clist-set-foreground clist row color))
1156 ; (define-foreign %clist-set-background () nil
1159 ; (color gdk:color))
1161 ; (defun (setf clist-background) (color clist row)
1162 ; (gdk:with-colors ((color color))
1163 ; (%clist-set-background clist row color))
1166 ; (define-foreign ("gtk_clist_set_cell_style"
1167 ; (setf clist-cell-style)) () nil
1173 ; (define-foreign ("gtk_clist_get_cell_style" clist-cell-style) () style
1178 ; (define-foreign ("gtk_clist_set_row_style"
1179 ; (setf clist-row-style)) () nil
1184 ; (define-foreign ("gtk_clist_get_row_style" clist-row-style) () style
1188 ; (define-foreign clist-set-shift () nil
1195 ; (define-foreign ("gtk_clist_set_selectable"
1196 ; (setf clist-selectable-p)) () nil
1199 ; (selectable boolean))
1201 ; (define-foreign ("gtk_clist_get_selectable" clist-selectable-p) () boolean
1205 ; (define-foreign ("gtk_clist_insert" %clist-insert) () int
1210 ; (defun clist-insert (clist row text)
1211 ; (unless (= (length text) (clist-n-columns clist))
1212 ; (error "Wrong number of elements in ~A" text))
1213 ; (with-array (data :initial-contents text :free-contents t)
1214 ; (%clist-insert clist row data)))
1216 ; (defun clist-prepend (clist text)
1217 ; (clist-insert clist 0 text))
1219 ; (defun clist-append (clist text)
1220 ; (clist-insert clist -1 text))
1222 ; (define-foreign clist-remove () nil
1226 ; (define-foreign ("gtk_clist_set_row_data_full" clist-set-row-data)
1227 ; (clist row data &optional destroy-function) nil
1230 ; ((register-user-data data destroy-function) unsigned-long)
1231 ; (*destroy-marshal* pointer))
1233 ; (defun (setf clist-row-data) (data clist row)
1234 ; (clist-set-row-data clist row data)
1237 ; (define-foreign %clist-get-row-data () unsigned-long
1241 ; (defun clist-row-data (clist row)
1242 ; (find-user-data (%clist-get-row-data clist row)))
1244 ; (define-foreign %clist-find-row-from-data () int
1246 ; (id unsigned-long))
1248 ; (define-foreign clist-select-row (clist row &optional (column -1)) nil
1253 ; (define-foreign clist-unselect-row (clist row &optional (column -1)) nil
1258 ; (define-foreign clist-undo-selection () nil
1261 ; (define-foreign clist-clear () nil
1264 ; (define-foreign ("gtk_clist_get_selection_info" clist-selection-info) () int
1269 ; (column int :out))
1271 ; (define-foreign clist-select-all () nil
1274 ; (define-foreign clist-unselect-all () nil
1277 ; (define-foreign clist-swap-rows () nil
1282 ; (define-foreign ("gtk_clist_row_move" clist-move-row) () nil
1287 ; ;(define-foreign clist-set-compare-func ...)
1289 ; (define-foreign clist-sort () nil
1292 ; (define-foreign ("gtk_clist_set_auto_sort"
1293 ; (setf clist-auto-sort-p)) () nil
1295 ; (auto-sort boolean))
1298 ; (define-foreign clist-auto-sort-p () boolean
1301 ; (defun clist-focus-row (clist)
1302 ; (let ((row (%clist-focus-row clist)))
1307 ; (define-foreign clist-selection () (list int)
1314 ; (define-foreign %ctree-new () ctree
1316 ; (tree-column int))
1318 ; (define-foreign %ctree-new-with-titles () ctree
1323 ; (defun ctree-new (columns &optional (tree-column 0))
1324 ; (if (atom columns)
1325 ; (%ctree-new columns tree-column)
1326 ; (with-array (titles :initial-contents columns :free-contents t)
1327 ; (%ctree-new-with-titles (length columns) tree-column titles))))
1329 ; (define-foreign %ctree-insert-node () ctree-node
1331 ; (parent (or null ctree-node))
1332 ; (sibling (or null ctree-node))
1335 ; (pixmap-closed (or null gdk:pixmap))
1336 ; (bitmap-closed (or null gdk:bitmap))
1337 ; (pixmap-opened (or null gdk:pixmap))
1338 ; (bitmap-opened (or null gdk:bitmap))
1340 ; (expaned boolean))
1342 ; (defun ctree-insert-node (ctree parent sibling text spacing
1343 ; &key pixmap closed opened leaf expanded)
1344 ; (multiple-value-bind (pixmap-closed mask-closed)
1345 ; (%pixmap-create (or closed pixmap))
1346 ; (multiple-value-bind (pixmap-opened mask-opened)
1347 ; (%pixmap-create (or opened (and (not leaf) pixmap)))
1348 ; (with-array (data :clear t :initial-contents text :free-contents t)
1349 ; (%ctree-insert-node
1350 ; ctree parent sibling data spacing pixmap-closed mask-closed
1351 ; pixmap-opened mask-opened leaf expanded)))))
1353 ; (define-foreign ctree-remove-node () nil
1355 ; (node ctree-node))
1357 ; (defun ctree-insert-from-list (ctree parent tree function)
1358 ; (clist-freeze ctree)
1359 ; (labels ((insert-node (node parent)
1361 ; (ctree-insert-node
1363 ; (make-list (clist-n-columns ctree) :initial-element "")
1364 ; 0 :leaf (not (rest node)))))
1365 ; (funcall function ctree-node (car node))
1366 ; (dolist (child (rest node))
1367 ; (insert-node child ctree-node)))))
1369 ; (insert-node tree parent)
1370 ; (dolist (node tree)
1371 ; (insert-node node nil))))
1372 ; (clist-thaw ctree))
1374 ; (defun ctree-map-to-list (ctree node function)
1375 ; (labels ((map-children (child)
1377 ; (let ((sibling (ctree-node-sibling child)))
1379 ; (ctree-map-to-list ctree child function)
1380 ; (map-children sibling))))))
1383 ; (funcall function node)
1384 ; (map-children (ctree-node-child node)))
1385 ; (map-children (ctree-nth-node ctree 0)))))
1388 ; (defun %ctree-apply-recursive (ctree node pre function depth)
1389 ; (when (and pre node (or (not depth) (<= (ctree-node-level node) depth)))
1390 ; (funcall function node))
1392 ; (let ((first-child (if node
1393 ; (ctree-node-child node)
1394 ; (ctree-nth-node ctree 0))))
1397 ; (or (not depth) (<= (ctree-node-level first-child) depth)))
1398 ; (labels ((foreach-child (child)
1400 ; (let ((sibling (ctree-node-sibling child)))
1401 ; (%ctree-apply-recursive ctree child pre function depth)
1402 ; (foreach-child sibling)))))
1403 ; (foreach-child first-child))))
1406 ; (not pre) node (or (not depth) (<= (ctree-node-level node) depth)))
1407 ; (funcall function node)))
1409 ; (defun ctree-apply-post-recursive (ctree node function &optional depth)
1410 ; (%ctree-apply-recursive ctree node nil function depth))
1412 ; (defun ctree-apply-pre-recursive (ctree node function &optional depth)
1413 ; (%ctree-apply-recursive ctree node t function depth))
1415 ; (define-foreign ("gtk_ctree_is_viewable" ctree-node-viewable-p) () boolean
1417 ; (node ctree-node))
1419 ; (define-foreign ctree-last () ctree-node
1422 ; (define-foreign ("gtk_ctree_node_nth" ctree-nth-node) () ctree-node
1426 ; (define-foreign ctree-find () boolean
1429 ; (child ctree-node))
1431 ; (define-foreign ("gtk_ctree_is_ancestor" ctree-ancestor-p) () boolean
1434 ; (child ctree-node))
1436 ; (define-foreign %ctree-find-by-row-data () int
1439 ; (id unsigned-long))
1441 ; (define-foreign ("gtk_ctree_is_hot_spot" ctree-hot-spot-p) () boolean
1446 ; (define-foreign ctree-move () nil
1449 ; (new-parent ctree-node)
1450 ; (new-sibling ctree-node))
1452 ; (define-foreign ctree-expand () nil
1454 ; (node ctree-node))
1456 ; (define-foreign ctree-expand-recursive () nil
1458 ; (node (or null ctree-node)))
1460 ; (define-foreign ctree-expand-to-depth () nil
1462 ; (node (or null ctree-node))
1465 ; (define-foreign ctree-collapse () nil
1467 ; (node ctree-node))
1469 ; (define-foreign ctree-collapse-recursive () nil
1471 ; (node (or null ctree-node)))
1473 ; (define-foreign ctree-collapse-to-depth () nil
1475 ; (node (or null ctree-node))
1478 ; (define-foreign ctree-toggle-expansion () nil
1480 ; (node ctree-node))
1482 ; (define-foreign ctree-toggle-expansion-recursive () nil
1484 ; (node (or null ctree-node)))
1486 ; (define-foreign ctree-select () nil
1488 ; (node ctree-node))
1490 ; (define-foreign ctree-unselect () nil
1492 ; (node ctree-node))
1494 ; (define-foreign %ctree-real-select-recursive () nil
1496 ; (node (or null ctree-node))
1499 ; (defun ctree-select-recursive (ctree node)
1500 ; (%ctree-real-select-recursive ctree node t))
1502 ; (defun ctree-unselect-recursive (ctree node)
1503 ; (%ctree-real-select-recursive ctree node nil))
1505 ; (define-foreign ("gtk_ctree_node_set_text" (setf ctree-cell-text)) () nil
1511 ; (define-foreign %ctree-node-set-pixmap () nil
1515 ; (gdk:pixmap gdk:pixmap)
1516 ; (mask (or null gdk:bitmap)))
1518 ; (defun (setf ctree-cell-pixmap) (source ctree node column)
1519 ; (multiple-value-bind (pixmap mask)
1520 ; (%pixmap-create source)
1521 ; (%ctree-node-set-pixmap ctree node column pixmap mask)
1522 ; (values pixmap mask)))
1524 ; (define-foreign %ctree-node-set-pixtext () nil
1530 ; (pixmap gdk:pixmap)
1531 ; (mask (or null gdk:bitmap)))
1533 ; (defun ctree-set-cell-pixtext (ctree node column text spacing source)
1534 ; (multiple-value-bind (pixmap mask)
1535 ; (%pixmap-create source)
1536 ; (%ctree-node-set-pixtext ctree node column text spacing pixmap mask)))
1538 ; (define-foreign %ctree-set-node-info () ctree-node
1540 ; (node (or null ctree-node))
1543 ; (pixmap-closed (or null gdk:pixmap))
1544 ; (bitmap-closed (or null gdk:bitmap))
1545 ; (pixmap-opened (or null gdk:pixmap))
1546 ; (bitmap-opened (or null gdk:bitmap))
1548 ; (expaned boolean))
1550 ; (defun ctree-set-node-info (ctree node text spacing
1551 ; &key pixmap closed opened leaf expanded)
1552 ; (multiple-value-bind (pixmap-closed mask-closed)
1553 ; (%pixmap-create (or closed pixmap))
1554 ; (multiple-value-bind (pixmap-opened mask-opened)
1555 ; (%pixmap-create (or opened (and (not leaf) pixmap)))
1556 ; (%ctree-set-node-info
1557 ; ctree node text spacing pixmap-closed mask-closed
1558 ; pixmap-opened mask-opened leaf expanded))))
1560 ; (define-foreign ("gtk_ctree_node_set_shift" ctree-set-shift) () nil
1567 ; (define-foreign ("gtk_ctree_node_set_selectable"
1568 ; (setf ctree-selectable-p)) () nil
1571 ; (selectable boolean))
1573 ; (define-foreign ("gtk_ctree_node_get_selectable"
1574 ; ctree-selectable-p) () boolean
1576 ; (node ctree-node))
1578 ; (define-foreign ("gtk_ctree_node_get_cell_type" ctree-cell-type) () cell-type
1583 ; (define-foreign %ctree-node-get-text () boolean
1587 ; (text string :out))
1589 ; (defun ctree-cell-text (ctree node column)
1590 ; (multiple-value-bind (success text)
1591 ; (%ctree-node-get-text ctree node column)
1594 ; "Cell in node ~A, column ~D in ~A is not of type :text"
1595 ; node column ctree))
1598 ; (define-foreign %ctree-node-get-pixmap () boolean
1602 ; (pixmap gdk:pixmap :out)
1603 ; (mask gdk:bitmap :out))
1605 ; (defun ctree-cell-pixmap (ctree node column)
1606 ; (multiple-value-bind (success pixmap mask)
1607 ; (%ctree-node-get-pixmap ctree node column)
1610 ; "Cell in node ~A column ~D in ~A is not of type :text"
1611 ; node column ctree))
1612 ; (values pixmap mask)))
1614 ; (define-foreign %ctree-node-get-pixtext () boolean
1618 ; (text string :out)
1619 ; (spacing unsigned-int :out)
1620 ; (pixmap gdk:pixmap :out)
1621 ; (mask gdk:bitmap :out))
1623 ; (defun ctree-cell-pixtext (ctree node column)
1624 ; (multiple-value-bind (success text spacing pixmap mask)
1625 ; (%ctree-node-get-pixtext ctree node column)
1628 ; "Cell in node ~A column ~D in ~A is not of type :text"
1629 ; node column ctree))
1630 ; (values text spacing pixmap mask)))
1632 ; (define-foreign ("gtk_ctree_get_node_info" ctree-node-info) () nil
1635 ; (text string :out)
1636 ; (spacing unsigned-int :out)
1637 ; (pixmap-closed gdk:pixmap :out)
1638 ; (mask-closed gdk:bitmap :out)
1639 ; (pixmap-opened gdk:pixmap :out)
1640 ; (mask-opened gdk:bitmap :out)
1641 ; (leaf boolean :out)
1642 ; (expanded boolean :out))
1644 ; (define-foreign ("gtk_ctree_node_set_row_style"
1645 ; (setf ctree-row-style)) () nil
1648 ; (style (or null style)))
1650 ; (define-foreign ("gtk_ctree_node_get_row_style" ctree-row-style) () style
1652 ; (node ctree-node))
1654 ; (define-foreign ("gtk_ctree_node_set_cell_style"
1655 ; (setf ctree-cell-style)) () nil
1659 ; (style (or null style)))
1661 ; (define-foreign ("gtk_ctree_node_get_cell_style"
1662 ; ctree-cell-style) () style
1667 ; (define-foreign %ctree-node-set-foreground () nil
1670 ; (color gdk:color))
1672 ; (defun (setf ctree-node-foreground) (color clist row)
1673 ; (gdk:with-colors ((color color))
1674 ; (%ctree-node-set-foreground clist row color))
1677 ; (define-foreign %ctree-node-set-background () nil
1680 ; (color gdk:color))
1682 ; (defun (setf ctree-node-background) (color clist row)
1683 ; (gdk:with-colors ((color color))
1684 ; (%ctree-node-set-background clist row color))
1687 ; (define-foreign ("gtk_ctree_node_set_row_data_full" ctree-set-node-data)
1688 ; (ctree node data &optional destroy-function) nil
1691 ; ((register-user-data data destroy-function) unsigned-long)
1692 ; (*destroy-marshal* pointer))
1694 ; (defun (setf ctree-node-data) (data ctree node)
1695 ; (ctree-set-node-data ctree node data)
1698 ; (define-foreign %ctree-node-get-row-data () unsigned-long
1700 ; (node ctree-node))
1702 ; (defun ctree-node-data (ctree node)
1703 ; (find-user-data (%ctree-node-get-row-data ctree node)))
1705 ; (define-foreign ctree-node-moveto () nil
1709 ; (row-aling single-float)
1710 ; (column-aling single-float))
1712 ; (define-foreign ("gtk_ctree_node_is_visible"
1713 ; ctree-node-visibility) () visibility
1715 ; (node ctree-node))
1717 ; (define-foreign ctree-sort-node () nil
1719 ; (node ctree-node))
1721 ; (define-foreign ctree-sort-recursive (ctree &optional node) nil
1723 ; (node (or null ctree-node)))
1726 ; (define-foreign ("gtk_clist_selection" ctree-selection) () (list ctree-node)
1730 ; (define-foreign ctree-node-leaf-p () boolean
1731 ; (node ctree-node))
1734 ; (define-foreign ctree-node-parent () ctree-node
1735 ; (node ctree-node))
1738 ; (define-foreign ctree-node-child () ctree-node
1739 ; (node ctree-node))
1742 ; (define-foreign ctree-node-sibling () ctree-node
1743 ; (node ctree-node))
1746 ; (define-foreign ctree-node-level () int
1747 ; (node ctree-node))
1752 ; (define-foreign fixed-new () fixed)
1754 ; (define-foreign fixed-put () nil
1757 ; (x int) (y int16))
1759 ; (define-foreign fixed-move () nil
1762 ; (x int16) (y int16))
1768 ; (define-foreign notebook-new () notebook)
1770 ; (define-foreign ("gtk_notebook_insert_page_menu" notebook-insert-page)
1771 ; (notebook position child tab-label &optional menu-label) nil
1772 ; (notebook notebook)
1774 ; ((if (stringp tab-label)
1775 ; (label-new tab-label)
1776 ; tab-label) widget)
1777 ; ((if (stringp menu-label)
1778 ; (label-new menu-label)
1779 ; menu-label) (or null widget))
1782 ; (defun notebook-append-page (notebook child tab-label &optional menu-label)
1783 ; (notebook-insert-page notebook -1 child tab-label menu-label))
1785 ; (defun notebook-prepend-page (notebook child tab-label &optional menu-label)
1786 ; (notebook-insert-page notebook 0 child tab-label menu-label))
1788 ; (define-foreign notebook-remove-page () nil
1789 ; (notebook notebook)
1792 ; (defun notebook-current-page-num (notebook)
1793 ; (let ((page-num (notebook-current-page notebook)))
1794 ; (if (= page-num -1)
1798 ; (define-foreign ("gtk_notebook_get_nth_page" notebook-nth-page) () widget
1799 ; (notebook notebook)
1802 ; (define-foreign %notebook-page-num () int
1803 ; (notebook notebook)
1806 ; (defun notebook-child-page-num (notebook child)
1807 ; (let ((page-num (%notebook-page-num notebook child)))
1808 ; (if (= page-num -1)
1812 ; (define-foreign notebook-next-page () nil
1813 ; (notebook notebook))
1815 ; (define-foreign notebook-prev-page () nil
1816 ; (notebook notebook))
1818 ; (define-foreign notebook-popup-enable () nil
1819 ; (notebook notebook))
1821 ; (define-foreign notebook-popup-disable () nil
1822 ; (notebook notebook))
1825 ; ("gtk_notebook_get_tab_label" notebook-tab-label) (notebook ref) widget
1826 ; (notebook notebook)
1827 ; ((if (widget-p ref)
1829 ; (notebook-nth-page notebook ref))
1832 ; (define-foreign %notebook-set-tab-label () nil
1833 ; (notebook notebook)
1834 ; (reference widget)
1835 ; (tab-label widget))
1837 ; (defun (setf notebook-tab-label) (tab-label notebook reference)
1838 ; (let ((tab-label-widget (if (stringp tab-label)
1839 ; (label-new tab-label)
1841 ; (%notebook-set-tab-label
1843 ; (if (widget-p reference)
1845 ; (notebook-nth-page notebook reference))
1847 ; (when (stringp tab-label)
1848 ; (widget-unref tab-label-widget))
1849 ; tab-label-widget))
1852 ; ("gtk_notebook_get_menu_label" notebook-menu-label) (notebook ref) widget
1853 ; (notebook notebook)
1854 ; ((if (widget-p ref)
1856 ; (notebook-nth-page notebook ref))
1859 ; (define-foreign %notebook-set-menu-label () nil
1860 ; (notebook notebook)
1861 ; (reference widget)
1862 ; (menu-label widget))
1864 ; (defun (setf notebook-menu-label) (menu-label notebook reference)
1865 ; (let ((menu-label-widget (if (stringp menu-label)
1866 ; (label-new menu-label)
1868 ; (%notebook-set-menu-label
1870 ; (if (widget-p reference)
1872 ; (notebook-nth-page notebook reference))
1873 ; menu-label-widget)
1874 ; (when (stringp menu-label)
1875 ; (widget-unref menu-label-widget))
1876 ; menu-label-widget))
1878 ; (define-foreign notebook-query-tab-label-packing (notebook ref) nil
1879 ; (notebook notebook)
1880 ; ((if (widget-p ref)
1882 ; (notebook-nth-page notebook ref))
1884 ; (expand boolean :out)
1885 ; (fill boolean :out)
1886 ; (pack-type pack-type :out))
1889 ; notebook-set-tab-label-packing (notebook ref expand fill pack-type) nil
1890 ; (notebook notebook)
1891 ; ((if (widget-p ref)
1893 ; (notebook-nth-page notebook ref))
1897 ; (pack-type pack-type))
1899 ; (define-foreign notebook-reorder-child () nil
1900 ; (notebook notebook)
1906 ; ;;; Font selection
1913 ; (define-foreign paned-add1 () nil
1917 ; (define-foreign paned-add2 () nil
1921 ; (define-foreign paned-pack1 () nil
1927 ; (define-foreign paned-pack2 () nil
1933 ; ; (define-foreign ("gtk_paned_set_position" (setf paned-position)) () nil
1938 ; (define-foreign paned-child1 () widget
1940 ; (resize boolean :out)
1941 ; (shrink boolean :out))
1944 ; (define-foreign paned-child2 () widget
1946 ; (resize boolean :out)
1947 ; (shrink boolean :out))
1949 ; (define-foreign vpaned-new () vpaned)
1951 ; (define-foreign hpaned-new () hpaned)
1957 ; (define-foreign layout-new (&optional hadjustment vadjustment) layout
1958 ; (hadjustment (or null adjustment))
1959 ; (vadjustment (or null adjustment)))
1961 ; (define-foreign layout-put () nil
1966 ; (define-foreign layout-move () nil
1971 ; (define-foreign %layout-set-size () nil
1976 ; (defun (setf layout-size) (size layout)
1977 ; (%layout-set-size layout (svref size 0) (svref size 1))
1978 ; (values (svref size 0) (svref size 1)))
1981 ; (define-foreign layout-size () nil
1984 ; (height int :out))
1986 ; (define-foreign layout-freeze () nil
1989 ; (define-foreign layout-thaw () nil
1992 ; (define-foreign layout-offset () nil
2001 ; (define-foreign list-new () list-widget)
2003 ; (define-foreign list-insert-items () nil
2004 ; (list list-widget)
2005 ; (items (list list-item))
2008 ; (define-foreign list-append-items () nil
2009 ; (list list-widget)
2010 ; (items (double-list list-item)))
2012 ; (define-foreign list-prepend-items () nil
2013 ; (list list-widget)
2014 ; (items (double-list list-item)))
2016 ; (define-foreign %list-remove-items () nil
2017 ; (list list-widget)
2018 ; (items (double-list list-item)))
2020 ; (define-foreign %list-remove-items-no-unref () nil
2021 ; (list list-widget)
2022 ; (items (double-list list-item)))
2024 ; (defun list-remove-items (list items &key no-unref)
2026 ; (%list-remove-items-no-unref list items)
2027 ; (%list-remove-items list items)))
2029 ; (define-foreign list-clear-items () nil
2030 ; (list list-widget)
2034 ; (define-foreign list-select-item () nil
2035 ; (list list-widget)
2038 ; (define-foreign list-unselect-item () nil
2039 ; (list list-widget)
2042 ; (define-foreign list-select-child () nil
2043 ; (list list-widget)
2046 ; (define-foreign list-unselect-child () nil
2047 ; (list list-widget)
2050 ; (define-foreign list-child-position () int
2051 ; (list list-widget)
2054 ; (define-foreign list-extend-selection () nil
2055 ; (list list-widget)
2056 ; (scroll-type scroll-type)
2057 ; (position single-float)
2058 ; (auto-start-selection boolean))
2060 ; (define-foreign list-start-selection () nil
2061 ; (list list-widget))
2063 ; (define-foreign list-end-selection () nil
2064 ; (list list-widget))
2066 ; (define-foreign list-select-all () nil
2067 ; (list list-widget))
2069 ; (define-foreign list-unselect-all () nil
2070 ; (list list-widget))
2072 ; (define-foreign list-scroll-horizontal () nil
2073 ; (list list-widget)
2074 ; (scroll-type scroll-type)
2075 ; (position single-float))
2077 ; (define-foreign list-scroll-vertical () nil
2078 ; (list list-widget)
2079 ; (scroll-type scroll-type)
2080 ; (position single-float))
2082 ; (define-foreign list-toggle-add-mode () nil
2083 ; (list list-widget))
2085 ; (define-foreign list-toggle-focus-row () nil
2086 ; (list list-widget))
2088 ; (define-foreign list-toggle-row () nil
2089 ; (list list-widget)
2092 ; (define-foreign list-undo-selection () nil
2093 ; (list list-widget))
2095 ; (define-foreign list-end-drag-selection () nil
2096 ; (list list-widget))
2099 ; (define-foreign list-selection () (double-list list-item)
2100 ; (list list-widget))
2106 ; (define-foreign menu-shell-insert () nil
2107 ; (menu-shell menu-shell)
2108 ; (menu-item menu-item)
2111 ; (defun menu-shell-append (menu-shell menu-item)
2112 ; (menu-shell-insert menu-shell menu-item -1))
2114 ; (defun menu-shell-prepend (menu-shell menu-item)
2115 ; (menu-shell-insert menu-shell menu-item 0))
2117 ; (define-foreign menu-shell-deactivate () nil
2118 ; (menu-shell menu-shell))
2120 ; (define-foreign menu-shell-select-item () nil
2121 ; (menu-shell menu-shell)
2122 ; (menu-item menu-item))
2124 ; (define-foreign menu-shell-deselect () nil
2125 ; (menu-shell menu-shell))
2127 ; (define-foreign menu-shell-activate-item () nil
2128 ; (menu-shell menu-shell)
2129 ; (menu-item menu-item)
2130 ; (fore-deactivate boolean))
2136 ; (define-foreign menu-bar-new () menu-bar)
2138 ; (define-foreign menu-bar-insert () nil
2139 ; (menu-bar menu-bar)
2143 ; (defun menu-bar-append (menu-bar menu)
2144 ; (menu-bar-insert menu-bar menu -1))
2146 ; (defun menu-bar-prepend (menu-bar menu)
2147 ; (menu-bar-insert menu-bar menu 0))
2153 ; (define-foreign menu-new () menu)
2155 ; (defun menu-insert (menu menu-item position)
2156 ; (menu-shell-insert menu menu-item position))
2158 ; (defun menu-append (menu menu-item)
2159 ; (menu-shell-append menu menu-item))
2161 ; (defun menu-prepend (menu menu-item)
2162 ; (menu-shell-prepend menu menu-item))
2164 ; ;(defun menu-popup ...)
2166 ; (define-foreign menu-reposition () nil
2169 ; (define-foreign menu-popdown () nil
2172 ; (define-foreign ("gtk_menu_get_active" menu-active) () widget
2175 ; (define-foreign ("gtk_menu_set_active" (setf menu-active)) () nil
2177 ; (index unsigned-int))
2179 ; ;(defun menu-attach-to-widget ...)
2181 ; (define-foreign menu-detach () nil
2184 ; (define-foreign ("gtk_menu_get_attach_widget" menu-attach-widget) () widget
2187 ; (define-foreign menu-reorder-child () nil
2189 ; (menu-item menu-item)
2196 ; (define-foreign packer-new () packer)
2198 ; (define-foreign packer-add
2199 ; (packer child side anchor
2202 ; (border-width (packer-default-border-width packer))
2203 ; (pad-x (packer-default-pad-x packer))
2204 ; (pad-y (packer-default-pad-y packer))
2205 ; (ipad-x (packer-default-ipad-x packer))
2206 ; (ipad-y (packer-default-ipad-y packer))) nil
2210 ; (anchor anchor-type)
2211 ; (options packer-options)
2212 ; (border-width unsigned-int)
2213 ; (pad-x unsigned-int)
2214 ; (pad-y unsigned-int)
2215 ; (ipad-x unsigned-int)
2216 ; (ipad-y unsigned-int))
2218 ; (define-foreign packer-set-child-packing () nil
2222 ; (anchor anchor-type)
2223 ; (options packer-options)
2224 ; (border-width unsigned-int)
2225 ; (pad-x unsigned-int)
2226 ; (pad-y unsigned-int)
2227 ; (ipad-x unsigned-int)
2228 ; (ipad-y unsigned-int))
2230 ; (define-foreign packer-reorder-child () nil
2239 ; (define-foreign table-new () table
2240 ; (rows unsigned-int)
2241 ; (columns unsigned-int)
2242 ; (homogeneous boolean))
2244 ; (define-foreign table-resize () nil
2246 ; (rows unsigned-int)
2247 ; (columns unsigned-int))
2249 ; (define-foreign table-attach (table child left right top bottom
2250 ; &key (x-options '(:expand :fill))
2251 ; (y-options '(:expand :fill))
2252 ; (x-padding 0) (y-padding 0)) nil
2255 ; (left unsigned-int)
2256 ; (right unsigned-int)
2257 ; (top unsigned-int)
2258 ; (bottom unsigned-int)
2259 ; (x-options attach-options)
2260 ; (y-options attach-options)
2261 ; (x-padding unsigned-int)
2262 ; (y-padding unsigned-int))
2264 ; (define-foreign ("gtk_table_set_row_spacing" (setf table-row-spacing)) () nil
2266 ; (row unsigned-int)
2267 ; (spacing unsigned-int))
2270 ; (define-foreign table-row-spacing (table row) unsigned-int
2273 ; (assert (and (>= row 0) (< row (table-rows table))))
2274 ; row) unsigned-int))
2276 ; (define-foreign ("gtk_table_set_col_spacing"
2277 ; (setf table-column-spacing)) () nil
2279 ; (col unsigned-int)
2280 ; (spacing unsigned-int))
2283 ; (define-foreign table-column-spacing (table col) unsigned-int
2286 ; (assert (and (>= col 0) (< col (table-columns table))))
2287 ; col) unsigned-int))
2290 ; (defun %set-table-child-option (object slot flag value)
2291 ; (let ((options (container-child-slot-value object slot)))
2293 ; ((and value (not (member flag options)))
2294 ; (setf (container-child-slot-value object slot) (cons flag options)))
2295 ; ((and (not value) (member flag options))
2297 ; (container-child-slot-value object slot) (delete flag options))))))
2300 ; (macrolet ((define-option-accessor (name slot flag)
2302 ; (defun ,name (object)
2303 ; (member ,flag (container-child-slot-value object ,slot)))
2304 ; (defun (setf ,name) (value object)
2305 ; (%set-table-child-option object ,slot ,flag value)))))
2306 ; (define-option-accessor table-child-x-expand-p :x-options :expand)
2307 ; (define-option-accessor table-child-y-expand-p :y-options :expand)
2308 ; (define-option-accessor table-child-x-shrink-p :x-options :shrink)
2309 ; (define-option-accessor table-child-y-shrink-p :y-options :shrink)
2310 ; (define-option-accessor table-child-x-fill-p :x-options :fill)
2311 ; (define-option-accessor table-child-y-fill-p :y-options :fill))
2317 ; (define-foreign toolbar-new () toolbar
2318 ; (orientation orientation)
2319 ; (style toolbar-style))
2323 ; (define-foreign toolbar-num-children () int
2324 ; (toolbar toolbar))
2326 ; (defun %toolbar-position-num (toolbar position)
2329 ; (:append (toolbar-num-children toolbar))
2331 ; (assert (and (>= position 0) (< position (toolbar-num-children toolbar))))
2334 ; (define-foreign %toolbar-insert-element () widget
2336 ; (type toolbar-child-type)
2337 ; (widget (or null widget))
2339 ; (tooltip-text string)
2340 ; (tooltip-private-text string)
2341 ; (icon (or null widget))
2346 ; (defun toolbar-insert-element (toolbar position
2347 ; &key tooltip-text tooltip-private-text
2348 ; type widget icon text callback)
2349 ; (let* ((icon-widget (typecase icon
2350 ; ((or null widget) icon)
2351 ; (t (pixmap-new icon))))
2353 ; (%toolbar-insert-element
2354 ; toolbar (or type (and widget :widget) :button)
2355 ; widget text tooltip-text tooltip-private-text icon-widget
2356 ; (%toolbar-position-num toolbar position))))
2358 ; (signal-connect toolbar-child 'clicked callback))
2361 ; (defun toolbar-append-element (toolbar &key tooltip-text tooltip-private-text
2362 ; type widget icon text callback)
2363 ; (toolbar-insert-element
2364 ; toolbar :append :type type :widget widget :icon icon :text text
2365 ; :tooltip-text tooltip-text :tooltip-private-text tooltip-private-text
2366 ; :callback callback))
2368 ; (defun toolbar-prepend-element (toolbar &key tooltip-text tooltip-private-text
2369 ; type widget icon text callback)
2370 ; (toolbar-insert-element
2371 ; toolbar :prepend :type type :widget widget :icon icon :text text
2372 ; :tooltip-text tooltip-text :tooltip-private-text tooltip-private-text
2373 ; :callback callback))
2375 ; (defun toolbar-insert-space (toolbar position)
2376 ; (toolbar-insert-element toolbar position :type :space))
2378 ; (defun toolbar-append-space (toolbar)
2379 ; (toolbar-insert-space toolbar :append))
2381 ; (defun toolbar-prepend-space (toolbar)
2382 ; (toolbar-insert-space toolbar :prepend))
2384 ; (defun toolbar-insert-widget (toolbar widget position &key tooltip-text
2385 ; tooltip-private-text callback)
2386 ; (toolbar-insert-element
2387 ; toolbar position :widget widget :tooltip-text tooltip-text
2388 ; :tooltip-private-text tooltip-private-text :callback callback))
2390 ; (defun toolbar-append-widget (toolbar widget &key tooltip-text
2391 ; tooltip-private-text callback)
2392 ; (toolbar-insert-widget
2393 ; toolbar widget :append :tooltip-text tooltip-text
2394 ; :tooltip-private-text tooltip-private-text :callback callback))
2396 ; (defun toolbar-prepend-widget (toolbar widget &key tooltip-text
2397 ; tooltip-private-text callback)
2398 ; (toolbar-insert-widget
2399 ; toolbar widget :prepend :tooltip-text tooltip-text
2400 ; :tooltip-private-text tooltip-private-text :callback callback))
2402 ; (defun toolbar-insert-item (toolbar text icon position &key tooltip-text
2403 ; tooltip-private-text callback)
2404 ; (toolbar-insert-element
2405 ; toolbar position :text text :icon icon :callback callback
2406 ; :tooltip-text tooltip-text :tooltip-private-text tooltip-private-text))
2408 ; (defun toolbar-append-item (toolbar text icon &key tooltip-text
2409 ; tooltip-private-text callback)
2410 ; (toolbar-insert-item
2411 ; toolbar text icon :append :callback callback
2412 ; :tooltip-text tooltip-text :tooltip-private-text tooltip-private-text))
2415 ; (defun toolbar-prepend-item (toolbar text icon &key tooltip-text
2416 ; tooltip-private-text callback)
2417 ; (toolbar-insert-item
2418 ; toolbar text icon :prepend :callback callback
2419 ; :tooltip-text tooltip-text :tooltip-private-text tooltip-private-text))
2421 ; (defun toolbar-enable-tooltips (toolbar)
2422 ; (setf (toolbar-tooltips-p toolbar) t))
2424 ; (defun toolbar-disable-tooltips (toolbar)
2425 ; (setf (toolbar-tooltips-p toolbar) nil))
2431 (define-foreign tree-new () tree)
2433 (define-foreign tree-append () nil
2435 (tree-item tree-item))
2437 (define-foreign tree-prepend () nil
2439 (tree-item tree-item))
2441 (define-foreign tree-insert () nil
2443 (tree-item tree-item)
2446 ; (define-foreign tree-remove-items () nil
2448 ; (items (double-list tree-item)))
2450 (define-foreign tree-clear-items () nil
2455 (define-foreign tree-select-item () nil
2459 (define-foreign tree-unselect-item () nil
2463 (define-foreign tree-select-child () nil
2465 (tree-item tree-item))
2467 (define-foreign tree-unselect-child () nil
2469 (tree-item tree-item))
2471 (define-foreign tree-child-position () int
2473 (tree-item tree-item))
2475 (defun root-tree-p (tree)
2476 (eq (tree-root-tree tree) tree))
2479 (define-foreign tree-selection () (double-list tree-item)
2486 (define-foreign calendar-new () calendar)
2488 (define-foreign calendar-select-month () int
2490 (month unsigned-int)
2491 (year unsigned-int))
2493 (define-foreign calendar-select-day () nil
2497 (define-foreign calendar-mark-day () int
2501 (define-foreign calendar-unmark-day () int
2505 (define-foreign calendar-clear-marks () nil
2506 (calendar calendar))
2508 (define-foreign calendar-display-options () nil
2510 (options calendar-display-options))
2512 (define-foreign ("gtk_calendar_get_date" calendar-date) () nil
2514 (year unsigned-int :out)
2515 (month unsigned-int :out)
2516 (day unsigned-int :out))
2518 (define-foreign calendar-freeze () nil
2519 (calendar calendar))
2521 (define-foreign calendar-thaw () nil
2522 (calendar calendar))
2528 ; (define-foreign drawing-area-new () drawing-area)
2530 ; (define-foreign ("gtk_drawing_area_size" %drawing-area-set-size) () nil
2531 ; (drawing-area drawing-area)
2535 ; (defun (setf drawing-area-size) (size drawing-area)
2536 ; (%drawing-area-set-size drawing-area (svref size 0) (svref size 1))
2537 ; (values (svref size 0) (svref size 1)))
2540 ; (define-foreign ("gtk_drawing_area_get_size" drawing-area-size) () nil
2541 ; (drawing-area drawing-area)
2543 ; (height int :out))
2553 ; (define-foreign editable-select-region () nil
2554 ; (editable editable)
2558 ; (define-foreign editable-insert-text
2559 ; (editable text &optional (position 0)) nil
2560 ; (editable editable)
2562 ; ((length text) int)
2565 ; (define-foreign editable-delete-text (editable &optional (start 0) end) nil
2566 ; (editable editable)
2568 ; ((or end -1) int))
2570 ; (define-foreign ("gtk_editable_get_chars" editable-text)
2571 ; (editable &optional (start 0) end) string
2572 ; (editable editable)
2574 ; ((or end -1) int))
2576 ; (defun (setf editable-text) (text editable)
2577 ; (editable-delete-text editable)
2579 ; (editable-insert-text editable text))
2582 ; (define-foreign editable-cut-clipboard () nil
2583 ; (editable editable))
2585 ; (define-foreign editable-copy-clipboard () nil
2586 ; (editable editable))
2588 ; (define-foreign editable-paste-clipboard () nil
2589 ; (editable editable))
2591 ; (define-foreign editable-claim-selection () nil
2592 ; (editable editable)
2594 ; (time unsigned-int))
2596 ; (define-foreign editable-delete-selection () nil
2597 ; (editable editable))
2599 ; (define-foreign editable-changed () nil
2600 ; (editable editable))
2606 ; (define-foreign %entry-new() entry)
2608 ; (define-foreign %entry-new-with-max-length () entry
2611 ; (defun entry-new (&optional max)
2613 ; (%entry-new-with-max-length max)
2616 ; (define-foreign entry-append-text () nil
2620 ; (define-foreign entry-prepend-text () nil
2624 ; (define-foreign entry-select-region () nil
2633 ; (define-foreign spin-button-new () spin-button
2634 ; (adjustment adjustment)
2635 ; (climb-rate single-float)
2636 ; (digits unsigned-int))
2638 ; (defun spin-button-value-as-int (spin-button)
2639 ; (round (spin-button-value spin-button)))
2641 ; (define-foreign spin-button-spin () nil
2642 ; (spin-button spin-button)
2643 ; (direction spin-type)
2644 ; (increment single-float))
2646 ; (define-foreign spin-button-update () nil
2647 ; (spin-button spin-button))
2653 ; (define-foreign text-new (&optional hadjustment vadjustment) text
2654 ; (hadjustment (or null adjustment))
2655 ; (vadjustment (or null adjustment)))
2657 ; (define-foreign text-freeze () nil
2660 ; (define-foreign text-thaw () nil
2663 ; (define-foreign %text-insert () nil
2665 ; (font (or null gdk:font))
2666 ; (fore (or null gdk:color))
2667 ; (back (or null gdk:color))
2671 ; (defun text-insert (text string &key font foreground background (start 0) end)
2672 ; (let ((real-font (gdk:ensure-font font)))
2673 ; (gdk:with-colors ((fore-color foreground)
2674 ; (back-color background))
2676 ; text real-font fore-color back-color (subseq string start end))
2677 ; (gdk:font-maybe-unref real-font font))))
2679 ; (define-foreign text-backward-delete () int
2681 ; (n-chars unsigned-int))
2683 ; (define-foreign text-forward-delete () nil
2685 ; (nchars unsigned-int))
2691 ; (define-foreign ruler-set-range () nil
2693 ; (lower single-float)
2694 ; (upper single-float)
2695 ; (position single-float)
2696 ; (max-size single-float))
2698 ; (define-foreign ruler-draw-ticks () nil
2701 ; (define-foreign ruler-draw-pos () nil
2704 ; (define-foreign hruler-new () hruler)
2706 ; (define-foreign vruler-new () vruler)
2712 ; (define-foreign range-draw-background () nil
2715 ; (define-foreign range-clear-background () nil
2718 ; (define-foreign range-draw-trough () nil
2721 ; (define-foreign range-draw-slider () nil
2724 ; (define-foreign range-draw-step-forw () nil
2727 ; (define-foreign range-slider-update () nil
2730 ; (define-foreign range-trough-click () int
2734 ; (jump-perc single-float :out))
2736 ; (define-foreign range-default-hslider-update () nil
2739 ; (define-foreign range-default-vslider-update () nil
2742 ; (define-foreign range-default-htrough-click () int
2746 ; (jump-perc single-float :out))
2748 ; (define-foreign range-default-vtrough-click () int
2752 ; (jump-perc single-float :out))
2754 ; (define-foreign range-default-hmotion () int
2759 ; (define-foreign range-default-vmotion () int
2768 ; (define-foreign scale-draw-value () nil
2771 ; (define-foreign hscale-new () hscale
2772 ; (adjustment adjustment))
2774 ; (define-foreign vscale-new () hscale
2775 ; (adjustment adjustment))
2781 ; (define-foreign hscrollbar-new () hscrollbar
2782 ; (adjustment adjustment))
2784 ; (define-foreign vscrollbar-new () vscrollbar
2785 ; (adjustment adjustment))
2791 ; (define-foreign vseparator-new () vseparator)
2793 ; (define-foreign hseparator-new () hseparator)
2803 ; (define-foreign progress-configure () adjustment
2804 ; (progress progress)
2805 ; (value single-float)
2806 ; (min single-float)
2807 ; (max single-float))
2809 ; (define-foreign ("gtk_progress_get_text_from_value"
2810 ; progress-text-from-value) () string
2811 ; (progress progress))
2813 ; (define-foreign ("gtk_progress_get_percentage_from_value"
2814 ; progress-percentage-from-value) () single-float
2815 ; (progress progress))
2821 ; (define-foreign %progress-bar-new () progress-bar)
2823 ; (define-foreign %progress-bar-new-with-adjustment () progress-bar
2824 ; (adjustment adjustment))
2826 ; (defun progress-bar-new (&optional adjustment)
2828 ; (%progress-bar-new-with-adjustment adjustment)
2829 ; (%progress-bar-new)))
2831 ; (define-foreign progress-bar-update () nil
2832 ; (progress-bar progress-bar)
2833 ; (percentage single-float))
2839 (define-foreign adjustment-new () adjustment
2840 (value single-float)
2841 (lower single-float)
2842 (upper single-float)
2843 (step-increment single-float)
2844 (page-increment single-float)
2845 (page-size single-float))
2847 (define-foreign adjustment-changed () nil
2848 (adjustment adjustment))
2850 (define-foreign adjustment-value-changed () nil
2851 (adjustment adjustment))
2853 (define-foreign adjustment-clamp-page () nil
2854 (adjustment adjustment)
2855 (lower single-float)
2856 (upper single-float))
2862 ; (define-foreign tooltips-new () tooltips)
2864 ; (define-foreign tooltips-enable () nil
2865 ; (tooltips tooltips))
2867 ; (define-foreign tooltips-disable () nil
2868 ; (tooltips tooltips))
2870 ; (define-foreign tooltips-set-tip () nil
2871 ; (tooltips tooltips)
2874 ; (tip-private string))
2876 ; (declaim (inline tooltips-set-colors-real))
2877 ; (define-foreign ("gtk_tooltips_set_colors" tooltips-set-colors-real) () nil
2878 ; (tooltips tooltips)
2879 ; (background gdk:color)
2880 ; (foreground gdk:color))
2882 ; (defun tooltips-set-colors (tooltips background foreground)
2883 ; (gdk:with-colors ((background background)
2884 ; (foreground foreground))
2885 ; (tooltips-set-colors-real tooltips background foreground)))
2887 ; (define-foreign tooltips-force-window () nil
2888 ; (tooltips tooltips))
2895 ; (define-foreign rc-add-default-file (filename) nil
2896 ; ((namestring (truename filename)) string))
2898 ; (define-foreign rc-parse (filename) nil
2899 ; ((namestring (truename filename)) string))
2901 ; (define-foreign rc-parse-string () nil
2902 ; (rc-string string))
2904 ; (define-foreign rc-reparse-all () nil)
2906 ; ;(define-foreign rc-get-style () style
2907 ; ; (widget widget))
2911 ;;; Accelerator Groups
2913 (define-foreign accel-group-new () accel-group)
2915 (define-foreign accel-group-get-default () accel-group)
2917 (define-foreign accel-group-ref () accel-group
2918 (accel-group accel-group))
2920 (define-foreign accel-group-unref () nil
2921 (accel-group accel-group))
2923 (define-foreign accel-group-activate (accel-group key modifiers) boolean
2924 (accel-group accel-group)
2925 ((gdk:keyval-from-name key) unsigned-int)
2926 (modifiers gdk:modifier-type))
2928 (define-foreign accel-groups-activate (object key modifiers) boolean
2930 ((gdk:keyval-from-name key) unsigned-int)
2931 (modifiers gdk:modifier-type))
2933 (define-foreign accel-group-attach () nil
2934 (accel-group accel-group)
2937 (define-foreign accel-group-detach () nil
2938 (accel-group accel-group)
2941 (define-foreign accel-group-lock () nil
2942 (accel-group accel-group))
2944 (define-foreign accel-group-unlock () nil
2945 (accel-group accel-group))
2948 ;;; Accelerator Groups Entries
2950 (define-foreign accel-group-get-entry (accel-group key modifiers) accel-entry
2951 (accel-group accel-group)
2952 ((gdk:keyval-from-name key) unsigned-int)
2953 (modifiers gdk:modifier-type))
2955 (define-foreign accel-group-lock-entry (accel-group key modifiers) nil
2956 (accel-group accel-group)
2957 ((gdk:keyval-from-name key) unsigned-int)
2958 (modifiers gdk:modifier-type))
2960 (define-foreign accel-group-unlock-entry (accel-group key modifiers) nil
2961 (accel-group accel-group)
2962 ((gdk:keyval-from-name key) unsigned-int)
2963 (modifiers gdk:modifier-type))
2965 (define-foreign accel-group-add
2966 (accel-group key modifiers flags object signal) nil
2967 (accel-group accel-group)
2968 ((gdk:keyval-from-name key) unsigned-int)
2969 (modifiers gdk:modifier-type)
2972 ((name-to-string signal) string))
2974 (define-foreign accel-group-add (accel-group key modifiers object) nil
2975 (accel-group accel-group)
2976 ((gdk:keyval-from-name key) unsigned-int)
2977 (modifiers gdk:modifier-type)
2981 ;;; Accelerator Signals
2983 (define-foreign accel-group-handle-add
2984 (object signal-id accel-group key modifiers flags) nil
2986 (signal-id unsigned-int)
2987 (accel-group accel-group)
2988 ((gdk:keyval-from-name key) unsigned-int)
2989 (modifiers gdk:modifier-type)
2990 (flags accel-flags))
2992 (define-foreign accel-group-handle-remove
2993 (object accel-group key modifiers) nil
2995 (accel-group accel-group)
2996 ((gdk:keyval-from-name key) unsigned-int)
2997 (modifiers gdk:modifier-type))
3003 ; (define-foreign style-new () style)
3005 ; (define-foreign style-copy () style
3008 ; (define-foreign style-ref () style
3011 ; (define-foreign style-unref () nil
3014 ; (define-foreign style-get-color () gdk:color
3016 ; (color-type color-type)
3017 ; (state-type state-type))
3020 ; ("gtk_style_set_color" style-set-color-from-color) () gdk:color
3022 ; (color-type color-type)
3023 ; (state-type state-type)
3024 ; (color gdk:color))
3026 ; (defun style-set-color (style color-type state-type color)
3027 ; (gdk:with-colors ((color color))
3028 ; (style-set-color-from-color style color-type state-type color)))
3030 ; (define-foreign ("gtk_style_get_font" style-font) () gdk:font
3033 ; (define-foreign style-set-font () gdk:font
3037 ; (defun (setf style-font) (font style)
3038 ; (let ((font (gdk:ensure-font font)))
3039 ; (gdk:font-unref (style-font style))
3040 ; (style-set-font style font)))
3042 ; (defun style-fg (style state)
3043 ; (style-get-color style :foreground state))
3045 ; (defun (setf style-fg) (color style state)
3046 ; (style-set-color style :foreground state color))
3048 ; (defun style-bg (style state)
3049 ; (style-get-color style :background state))
3051 ; (defun (setf style-bg) (color style state)
3052 ; (style-set-color style :background state color))
3054 ; (defun style-text (style state)
3055 ; (style-get-color style :text state))
3057 ; (defun (setf style-text) (color style state)
3058 ; (style-set-color style :text state color))
3060 ; (defun style-base (style state)
3061 ; (style-get-color style :base state))
3063 ; (defun (setf style-base) (color style state)
3064 ; (style-set-color style :base state color))
3066 ; (defun style-white (style)
3067 ; (style-get-color style :white :normal))
3069 ; (defun (setf style-white) (color style)
3070 ; (style-set-color style :white :normal color))
3072 ; (defun style-black (style)
3073 ; (style-get-color style :black :normal))
3075 ; (defun (setf style-black) (color style)
3076 ; (style-set-color style :black :normal color))
3078 ; (define-foreign style-get-gc
3079 ; (style color-type &optional (state-type :normal)) gdk:gc
3081 ; (color-type color-type)
3082 ; (state-type state-type))