X-Git-Url: https://git.distorted.org.uk/~mdw/clg/blobdiff_plain/f36ca6af731aaec31d2ee56ec1cb19ce6cf8d835..18eed2a0a52c23fea78a40dccb17736419b5f931:/gtk/gtk.lisp?ds=inline diff --git a/gtk/gtk.lisp b/gtk/gtk.lisp index 7dce09d..9a86062 100644 --- a/gtk/gtk.lisp +++ b/gtk/gtk.lisp @@ -1,5 +1,5 @@ ;; Common Lisp bindings for GTK+ v2.0 -;; Copyright (C) 1999-2000 Espen S. Johnsen +;; Copyright (C) 1999-2001 Espen S. Johnsen ;; ;; This library is free software; you can redistribute it and/or ;; modify it under the terms of the GNU Lesser General Public @@ -15,19 +15,19 @@ ;; License along with this library; if not, write to the Free Software ;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -;; $Id: gtk.lisp,v 1.2 2000-09-04 22:23:34 espen Exp $ +;; $Id: gtk.lisp,v 1.5 2001-05-31 21:52:57 espen Exp $ (in-package "GTK") ;;; Gtk version -(define-foreign check-version () string +(defbinding check-version () string (required-major unsigned-int) (required-minor unsigned-int) (required-micro unsigned-int)) -(define-foreign query-version () nil +(defbinding query-version () nil (major unsigned-int :out) (minor unsigned-int :out) (micro unsigned-int :out)) @@ -41,93 +41,22 @@ -;;; should be moved to gobject - - - ;;; Label -(define-foreign label-new () label - (text string)) - -(define-foreign label-parse-uline () unsigned-int +(defbinding label-select-region () nil (label label) - (string string)) + (start int) + (end int)) ;;; Acccel label -(define-foreign accel-label-new () accel-label - (text string)) - -(define-foreign accel-label-refetch () boolean +(defbinding accel-label-refetch () boolean (accel-label accel-label)) -;;; Tips query - -(define-foreign tips-query-new () tips-query) - -(define-foreign tips-query-start-query () nil - (tips-query tips-query)) - -(define-foreign tips-query-stop-query () nil - (tips-query tips-query)) - - - -;;; Arrow - -(define-foreign arrow-new () arrow - (arrow-type arrow-type) - (shadow-type shadow-type)) - - - -;;; Pixmap - -(defmethod initialize-instance ((pixmap pixmap) &rest initargs - &key source mask) - (declare (ignore initargs)) - (call-next-method) - (if (typep source 'gdk:pixmap) - (pixmap-set pixmap source mask) - (multiple-value-bind (source mask) (gdk:pixmap-create source) - (pixmap-set pixmap source mask)))) - -(defun pixmap-new (source &optional mask) - (make-instance 'pixmap :source source :mask mask)) - -(define-foreign pixmap-set () nil - (pixmap pixmap) - (source gdk:pixmap) - (mask (or null gdk:bitmap))) - -(defun (setf pixmap-source) (source pixmap) - (if (typep source 'gdk:pixmap) - (pixmap-set pximap source (pixmap-mask pixmap)) - (multiple-value-bind (source mask) (gdk:pixmap-create source) - (pixmap-set pixmap source mask))) - source) - -(defun (setf pixmap-mask) (mask pixmap) - (pixmap-set pximap (pixmap-source pixmap) mask) - mask) - -(define-foreign ("gtk_pixmap_get" pixmap-source) () nil - (pixmap pixmap) - (val gdk:pixmap :out) - (nil null)) - -(define-foreign ("gtk_pixmap_get" pixmap-mask) () nil - (pixmap pixmap) - (nil null) - (mask gdk:bitmap :out)) - - - ;;; Bin (defun bin-child (bin) @@ -140,103 +69,50 @@ (container-add bin child) child) - - -;;; Alignment - -(define-foreign alignment-new () alignment - (xalign single-float) - (ylign single-float) - (xscale single-float) - (yscale single-float)) - - - -;;; Frame - -(define-foreign frame-new (&optional label) frame - (label string)) - - - -;;; Aspect frame - -(define-foreign aspect-frame-new () alignment - (xalign single-float) - (ylign single-float) - (ratio single-float) - (obey-child boolean)) - +(defmethod initialize-instance ((bin bin) &rest initargs &key child) + (declare (ignore initargs)) + (call-next-method) + (cond + ((consp child) + (container-add bin (first child)) + (setf + (slot-value (first child) 'child-slots) + (apply + #'make-instance + (slot-value (class-of bin) 'child-class) + :parent bin :child (first child) (cdr child)))) + (child + (container-add bin child)))) ;;; Button -(define-foreign %button-new () button) - -(define-foreign %button-new-with-label () button - (label string)) - -(defun button-new (&optional label) - (if label - (%button-new-with-label label) - (%button-new))) - -(defgeneric button-label (button)) -(defgeneric (setf button-label) (label button)) - -(defmethod button-label ((button button)) - (object-arg button "GtkButton::label")) - -(defmethod (setf button-label) ((label string) (button button)) - (setf (object-arg button "GtkButton::label") label)) - - -(define-foreign button-pressed () nil +(defbinding button-pressed () nil (button button)) -(define-foreign button-released () nil +(defbinding button-released () nil (button button)) -(define-foreign button-clicked () nil +(defbinding button-clicked () nil (button button)) -(define-foreign button-enter () nil +(defbinding button-enter () nil (button button)) -(define-foreign button-leave () nil +(defbinding button-leave () nil (button button)) ;;; Toggle button -(define-foreign %toggle-button-new () toggle-button) - -(define-foreign %toggle-button-new-with-label () toggle-button - (label string)) - -(defun toggle-button-new (&optional label) - (if label - (%toggle-button-new-with-label label) - (%toggle-button-new))) - -(define-foreign toggle-button-toggled () nil +(defbinding toggle-button-toggled () nil (toggle-button toggle-button)) ;;; Check button -(define-foreign %check-button-new () check-button) - -(define-foreign %check-button-new-with-label () check-button - (label string)) - -(defun check-button-new (&optional label) - (if label - (%check-button-new-with-label label) - (%check-button-new))) - (defmethod (setf button-label) ((label string) (button check-button)) (call-next-method) (setf (misc-xalign (bin-child button)) 0.0) @@ -246,45 +122,31 @@ ;;; Radio button -(define-foreign %radio-button-new () radio-button - (group (or null radio-button-group))) +(defbinding (%radio-button-get-group "gtk_radio_button_group") () pointer + (radio-button radio-button)) -(define-foreign %radio-button-new-with-label-from-widget () radio-button - (widget (or null widget)) - (label string)) - -(define-foreign %radio-button-new-from-widget () radio-button - (widget (or null widget))) - -(define-foreign %radio-button-new-with-label () radio-button - (group (or null radio-button-group)) - (label string)) +(defbinding %radio-button-set-group () nil + (radio-button radio-button) + (group pointer)) -(defun radio-button-new (group &key label from-widget) - (cond - ((and from-widget label) - (%radio-button-new-with-label-from-widget group label)) - (from-widget - (%radio-button-new-from-widget group)) - (label - (%radio-button-new-with-label group label)) - (t - (%radio-button-new group)))) - -; (define-foreign radio-button-group () radio-button-group -; (radio-button radio-button)) +(defun radio-button-add-to-group (button1 button2) + "Add BUTTON1 to the group which BUTTON2 belongs to." + (%radio-button-set-group button1 (%radio-button-get-group button2))) +(defmethod initialize-instance ((button radio-button) + &rest initargs &key group) + (call-next-method) + (when group + (radio-button-add-to-group item group))) ;;; Option menu -(define-foreign option-menu-new () option-menu) - -(define-foreign %option-menu-set-menu () nil +(defbinding %option-menu-set-menu () nil (option-menu option-menu) (menu widget)) -(define-foreign %option-menu-remove-menu () nil +(defbinding %option-menu-remove-menu () nil (option-menu option-menu)) (defun (setf option-menu-menu) (menu option-menu) @@ -297,40 +159,30 @@ ;;; Item -(define-foreign item-select () nil +(defbinding item-select () nil (item item)) -(define-foreign item-deselect () nil +(defbinding item-deselect () nil (item item)) -(define-foreign item-toggle () nil +(defbinding item-toggle () nil (item item)) ;;; Menu item -(define-foreign %menu-item-new () menu-item) - -(define-foreign %menu-item-new-with-label () menu-item - (label string)) - -(defun menu-item-new (&optional label) - (if label - (%menu-item-new-with-label label) - (%menu-item-new))) - (defun (setf menu-item-label) (label menu-item) (make-instance 'accel-label :label label :xalign 0.0 :yalign 0.5 :accel-widget menu-item :visible t :parent menu-item) label) -(define-foreign %menu-item-set-submenu () nil +(defbinding %menu-item-set-submenu () nil (menu-item menu-item) (submenu menu)) -(define-foreign %menu-item-remove-submenu () nil +(defbinding %menu-item-remove-submenu () nil (menu-item menu-item)) (defun (setf menu-item-submenu) (submenu menu-item) @@ -339,7 +191,7 @@ (%menu-item-set-submenu menu-item submenu)) submenu) -(define-foreign %menu-item-configure () nil +(defbinding %menu-item-configure () nil (menu-item menu-item) (show-toggle-indicator boolean) (show-submenu-indicator boolean)) @@ -357,126 +209,52 @@ (menu-item-toggle-indicator-p menu-item) show)) -(define-foreign menu-item-select () nil +(defbinding menu-item-select () nil (menu-item menu-item)) -(define-foreign menu-item-deselect () nil +(defbinding menu-item-deselect () nil (menu-item menu-item)) -(define-foreign menu-item-activate () nil +(defbinding menu-item-activate () nil (menu-item menu-item)) -(define-foreign menu-item-right-justify () nil +(defbinding menu-item-right-justify () nil (menu-item menu-item)) ;;; Check menu item -(define-foreign %check-menu-item-new - () check-menu-item) - -(define-foreign %check-menu-item-new-with-label () check-menu-item - (label string)) - -(defun check-menu-item-new (&optional label) - (if label - (%check-menu-item-new-with-label label) - (%check-menu-item-new))) - -(define-foreign check-menu-item-toggled () nil +(defbinding check-menu-item-toggled () nil (check-menu-item check-menu-item)) ;;; Radio menu item -(define-foreign %radio-menu-item-new - () radio-menu-item - (group (or null radio-menu-item-group))) - -(define-foreign %radio-menu-item-new-with-label () radio-menu-item - (group (or null radio-menu-item-group)) - (label string)) - -(defun radio-menu-item-new (group &optional label) - (if label - (%radio-menu-item-new-with-label group label) - (%radio-menu-item-new group))) - - - -;;; Tearoff menu item - -(define-foreign tearoff-menu-item-new () tearoff-menu-item) - - - -;;; List item - -(define-foreign %list-item-new () list-item) - -(define-foreign %list-item-new-with-label () list-item - (label string)) - -(defun list-item-new (&optional label) - (if label - (%list-item-new-with-label label) - (%list-item-new))) - -(define-foreign list-item-select () nil - (list-item list-item)) - -(define-foreign list-item-deselect () nil - (list-item list-item)) - - - -;;; Tree item - -(define-foreign %tree-item-new () tree-item) - -(define-foreign %tree-item-new-with-label () tree-item - (label string)) - -(defun tree-item-new (&optional label) - (if label - (%tree-item-new-with-label label) - (%tree-item-new))) - -(define-foreign %tree-item-set-subtree () nil - (tree-item tree-item) - (subtree tree)) +(defbinding (%radio-menu-item-get-group + "gtk_radio_menu_item_group") () pointer + (radio-menu-item radio-menu-item)) -(define-foreign %tree-item-remove-subtree () nil - (tree-item tree-item)) +(defbinding %radio-menu-item-set-group () nil + (radio-menu-item radio-menu-item) + (group pointer)) -(defun (setf tree-item-subtree) (subtree tree-item) - (if subtree - (%tree-item-set-subtree tree-item subtree) - (%tree-item-remove-subtree tree-item)) - subtree) - -(define-foreign tree-item-select () nil - (tree-item tree-item)) - -(define-foreign tree-item-deselect () nil - (tree-item tree-item)) - -(define-foreign tree-item-expand () nil - (tree-item tree-item)) - -(define-foreign tree-item-collapse () nil - (tree-item tree-item)) +(defun radio-menu-item-add-to-group (item1 item2) + "Add ITEM1 to the group which ITEM2 belongs to." + (%radio-menu-item-set-group item1 (%radio-menu-item-get-group item2))) +(defmethod initialize-instance ((item radio-menu-item) + &rest initargs &key group) + (call-next-method) + (when group + (radio-menu-item-add-to-group item group))) + ;;; Window -(define-foreign window-new () window - (type window-type)) - -(define-foreign %window-set-wmclass () nil +(defbinding %window-set-wmclass () nil (window window) (wmclass-name string) (wmclass-class string)) @@ -486,110 +264,69 @@ (values (svref wmclass 0) (svref wmclass 1))) ;; gtkglue.c -(define-foreign window-wmclass () nil +(defbinding window-wmclass () nil (window window) (wmclass-name string :out) (wmclass-class string :out)) -(define-foreign window-add-accel-group () nil +(defbinding window-add-accel-group () nil (window window) (accel-group accel-group)) -(define-foreign window-remove-accel-group () nil +(defbinding window-remove-accel-group () nil (window window) (accel-group accel-group)) -(define-foreign window-activate-focus () int +(defbinding window-activate-focus () int (window window)) -(define-foreign window-activate-default () int +(defbinding window-activate-default () int (window window)) -(define-foreign window-set-transient-for () nil +(defbinding window-set-transient-for () nil (window window) (parent window)) -;(define-foreign window-set-geometry-hints) - - - -;;; Color selection dialog - -; (define-foreign color-selection-dialog-new () color-selection-dialog -; (title string)) - - - -;;; Dialog - -(define-foreign dialog-new () dialog) - - - -;;; Input dialog - -(define-foreign input-dialog-new () dialog) +;(defbinding window-set-geometry-hints) ;;; File selection -; (define-foreign file-selection-new () file-selection -; (title string)) - -; (define-foreign file-selection-complete () nil -; (file-selection file-selection) -; (pattern string)) - -; (define-foreign file-selection-show-fileop-buttons () nil -; (file-selection file-selection)) - -; (define-foreign file-selection-hide-fileop-buttons () nil -; (file-selection file-selection)) - +(defbinding file-selection-complete () nil + (file-selection file-selection) + (pattern string)) +(defbinding file-selection-show-fileop-buttons () nil + (file-selection file-selection)) -;;; Handle box - -(define-foreign handle-box-new () handle-box) +(defbinding file-selection-hide-fileop-buttons () nil + (file-selection file-selection)) ;;; Scrolled window -(define-foreign scrolled-window-new - (&optional hadjustment vadjustment) scrolled-window - (hadjustment (or null adjustment)) - (vadjustment (or null adjustment))) - (defun (setf scrolled-window-scrollbar-policy) (policy window) (setf (scrolled-window-hscrollbar-policy window) policy) (setf (scrolled-window-vscrollbar-policy window) policy)) -(define-foreign scrolled-window-add-with-viewport () nil +(defbinding scrolled-window-add-with-viewport () nil (scrolled-window scrolled-window) (child widget)) -;;; Viewport - -(define-foreign viewport-new () viewport - (hadjustment adjustment) - (vadjustment adjustment)) - - - ;;; Box -(define-foreign box-pack-start () nil +(defbinding box-pack-start () nil (box box) (child widget) (expand boolean) (fill boolean) (padding unsigned-int)) -(define-foreign box-pack-end () nil +(defbinding box-pack-end () nil (box box) (child widget) (expand boolean) @@ -601,12 +338,12 @@ (box-pack-start box child expand fill padding) (box-pack-end box child expand fill padding))) -(define-foreign box-reorder-child () nil +(defbinding box-reorder-child () nil (box box) (child widget) (position int)) -(define-foreign box-query-child-packing () nil +(defbinding box-query-child-packing () nil (box box) (child widget :out) (expand boolean :out) @@ -614,7 +351,7 @@ (padding unsigned-int :out) (pack-type pack-type :out)) -(define-foreign box-set-child-packing () nil +(defbinding box-set-child-packing () nil (box box) (child widget) (expand boolean) @@ -626,211 +363,95 @@ ;;; Button box -(define-foreign ("gtk_button_box_get_child_size_default" - button-box-default-child-size) () nil +(defbinding button-box-get-child-size () nil + (button-box button-box) (min-width int :out) (min-height int :out)) -(define-foreign ("gtk_button_box_get_child_ipadding_default" - button-box-default-child-ipadding) () nil - (ipad-x int :out) - (ipad-y int :out)) - -(define-foreign %button-box-set-child-size-default () nil +(defbinding button-box-set-child-size () nil + (button-box button-box) (min-width int) (min-height int)) -(defun (setf button-box-default-child-size) (size) - (%button-box-set-child-size-default (svref size 0) (svref size 1)) - (values (svref size 0) (svref size 1))) - -(define-foreign %button-box-set-child-ipadding-default () nil - (ipad-x int) - (ipad-y int)) - -(defun (setf button-box-default-child-ipadding) (ipad) - (%button-box-set-child-ipadding-default (svref ipad 0) (svref ipad 1)) - (values (svref ipad 0) (svref ipad 1))) - -(define-foreign - ("gtk_button_box_get_child_size" button-box-child-size) () nil +(defbinding button-box-get-child-ipadding () nil (button-box button-box) - (min-width int :out) - (min-height int :out)) - -(define-foreign - ("gtk_button_box_get_child_ipadding" button-box-child-ipadding) () nil - (button-box button-box) (ipad-x int :out) (ipad-y int :out)) -(define-foreign %button-box-set-child-size () nil - (button-box button-box) - (min-width int) - (min-height int)) - -(defun (setf button-box-child-size) (size button-box) - (%button-box-set-child-size button-box (svref size 0) (svref size 1)) - (values (svref size 0) (svref size 1))) - -(define-foreign %button-box-set-child-ipadding () nil +(defbinding button-box-set-child-ipadding () nil (button-box button-box) (ipad-x int) (ipad-y int)) -(defun (setf button-box-child-ipadding) (ipad button-box) - (%button-box-set-child-ipadding button-box (svref ipad 0) (svref ipad 1)) - (values (svref ipad 0) (svref ipad 1))) - - - -;;; HButton box - -(define-foreign hbutton-box-new () hbutton-box) - -(define-foreign ("gtk_hbutton_box_get_spacing_default" - hbutton-box-default-spacing) () int) - -(define-foreign ("gtk_hbutton_box_set_spacing_default" - (setf hbutton-box-default-spacing)) () nil - (spacing int)) - -(define-foreign ("gtk_hbutton_box_get_layout_default" - hbutton-box-default-layout) () button-box-style) - -(define-foreign ("gtk_hbutton_box_set_layout_default" - (setf hbutton-box-default-layout)) () nil - (layout button-box-style)) - - - -;;; VButton Box - -(define-foreign vbutton-box-new () vbutton-box) - -(define-foreign ("gtk_vbutton_box_get_spacing_default" - vbutton-box-default-spacing) () int) - -(define-foreign ("gtk_vbutton_box_set_spacing_default" - (setf vbutton-box-default-spacing)) () nil - (spacing int)) - -(define-foreign ("gtk_vbutton_box_get_layout_default" - vbutton-box-default-layout) () button-box-style) - -(define-foreign ("gtk_vbutton_box_set_layout_default" - (setf vbutton-box-default-layout)) () nil - (layout button-box-style)) - - - -;;; VBox - -(define-foreign vbox-new () vbox - (homogeneous boolean) - (spacing int)) - ;;; Color selection -; (define-foreign color-selection-new () color-selection) - -; ;; gtkglue.c -; (define-foreign %color-selection-set-color-by-values () nil -; (colorsel color-selection) -; (red double-float) -; (green double-float) -; (blue double-float) -; (opacity double-float)) - -; (defun (setf color-selection-color) (color colorsel) -; (%color-selection-set-color-by-values -; colorsel -; (svref color 0) (svref color 1) (svref color 2) -; (if (> (length color) 3) -; (svref color 3) -; 1.0)) -; color) - -; ;; gtkglue.c -; (define-foreign %color-selection-get-color-as-values () nil +; (defbinding %color-selection-get-previous-color () nil ; (colorsel color-selection) -; (red double-float :out) -; (green double-float :out) -; (blue double-float :out) -; (opacity double-float :out)) - -; (defun color-selection-color (colorsel) -; (multiple-value-bind (red green blue opacity) -; (%color-selection-get-color-as-values colorsel) -; (if (color-selection-use-opacity-p colorsel) -; (vector red green blue opacity) -; (vector red green blue)))) - - - - -; ;;; Gamma curve - -; (define-foreign gamma-curve-new () gamma-curve) +; (color pointer)) +; (defun color-selection-previous-color (colorsel) +; (let ((color (allocate-memory (* (size-of 'double-float) 4)))) +; (%color-selection-get-previous-color colorsel color) +; (funcall (get-from-alien-function '(vector double-float 4)) color))) +; (defbinding %color-selection-set-previous-color () nil +; (colorsel color-selection) +; (color (vector double-float 4))) -;;; HBox +; (defun (setf color-selection-previous-color) (color colorsel) +; (%color-selection-set-previous-color colorsel color) +; color) -(define-foreign hbox-new () hbox - (homogeneous boolean) - (spacing int)) +(defbinding (color-selection-is-adjusting-p + "gtk_color_selection_is_adjusting") () boolean + (colorsel color-selection)) ;;; Combo -(define-foreign combo-new () combo) - -(define-foreign combo-set-value-in-list () nil +(defbinding combo-set-value-in-list () nil (combo combo) (val boolean) (ok-if-empty boolean)) -; (define-foreign ("gtk_combo_set_item_string" (setf combo-item-string)) () nil +; (defbinding ("gtk_combo_set_item_string" (setf combo-item-string)) () nil ; (combo combo) ; (item item) ; (item-value string)) -(define-foreign %combo-set-popdown-strings () nil +(defbinding %combo-set-popdown-strings () nil (combo combo) - (strings (double-list string))) + (strings (glist string))) (defun (setf combo-popdown-strings) (strings combo) (%combo-set-popdown-strings combo strings) strings) -(define-foreign combo-disable-activate () nil +(defbinding combo-disable-activate () nil (combo combo)) ;;; Statusbar -(define-foreign statusbar-new () statusbar) - -(define-foreign - ("gtk_statusbar_get_context_id" statusbar-context-id) () unsigned-int +(defbinding (statusbar-context-id "gtk_statusbar_get_context_id") + () unsigned-int (statusbar statusbar) (context-description string)) -(define-foreign statusbar-push () unsigned-int +(defbinding statusbar-push () unsigned-int (statusbar statusbar) (context-id unsigned-int) (text string)) -(define-foreign statusbar-pop () nil +(defbinding statusbar-pop () nil (statusbar statusbar) (context-id unsigned-int)) -(define-foreign statusbar-remove () nil +(defbinding statusbar-remove () nil (statusbar statusbar) (context-id unsigned-int) (message-id unsigned-int)) @@ -839,15 +460,13 @@ ;;; Fixed -(define-foreign fixed-new () fixed) - -(define-foreign fixed-put () nil +(defbinding fixed-put () nil (fixed fixed) (widget widget) (x (signed 16)) (y (signed 16))) -(define-foreign fixed-move () nil +(defbinding fixed-move () nil (fixed fixed) (widget widget) (x (signed 16)) @@ -855,11 +474,9 @@ -; ;;; Notebook +;;; Notebook -(define-foreign notebook-new () notebook) - -(define-foreign ("gtk_notebook_insert_page_menu" notebook-insert-page) +(defbinding (notebook-insert-page "gtk_notebook_insert_page_menu") (notebook position child tab-label &optional menu-label) nil (notebook notebook) (child widget) @@ -877,7 +494,7 @@ (defun notebook-prepend-page (notebook child tab-label &optional menu-label) (notebook-insert-page notebook 0 child tab-label menu-label)) -(define-foreign notebook-remove-page () nil +(defbinding notebook-remove-page () nil (notebook notebook) (page-num int)) @@ -887,14 +504,14 @@ ; nil ; page-num))) -(define-foreign ("gtk_notebook_get_nth_page" notebook-nth-page-child) () widget +(defbinding (notebook-nth-page-child "gtk_notebook_get_nth_page") () widget (notebook notebook) (page-num int)) (defun notebook-page-child (notebook) (notebook-nth-page-child notebook (notebook-page notebook))) -(define-foreign %notebook-page-num () int +(defbinding %notebook-page-num () int (notebook notebook) (child widget)) @@ -904,27 +521,27 @@ nil page-num))) -(define-foreign notebook-next-page () nil +(defbinding notebook-next-page () nil (notebook notebook)) -(define-foreign notebook-prev-page () nil +(defbinding notebook-prev-page () nil (notebook notebook)) -(define-foreign notebook-popup-enable () nil +(defbinding notebook-popup-enable () nil (notebook notebook)) -(define-foreign notebook-popup-disable () nil +(defbinding notebook-popup-disable () nil (notebook notebook)) -(define-foreign - ("gtk_notebook_get_tab_label" notebook-tab-label) (notebook ref) widget +(defbinding (notebook-tab-label "gtk_notebook_get_tab_label") + (notebook ref) widget (notebook notebook) ((if (typep ref 'widget) ref (notebook-nth-page-child notebook ref)) widget)) -(define-foreign %notebook-set-tab-label () nil +(defbinding %notebook-set-tab-label () nil (notebook notebook) (reference widget) (tab-label widget)) @@ -939,19 +556,17 @@ reference (notebook-nth-page-child notebook reference)) tab-label-widget) - (when (stringp tab-label) - (widget-unref tab-label-widget)) tab-label-widget)) -(define-foreign - ("gtk_notebook_get_menu_label" notebook-menu-label) (notebook ref) widget +(defbinding (notebook-menu-label "gtk_notebook_get_menu_label") + (notebook ref) widget (notebook notebook) ((if (typep ref 'widget) ref (notebook-nth-page-child notebook ref)) widget)) -(define-foreign %notebook-set-menu-label () nil +(defbinding %notebook-set-menu-label () nil (notebook notebook) (reference widget) (menu-label widget)) @@ -966,11 +581,9 @@ reference (notebook-nth-page-child notebook reference)) menu-label-widget) - (when (stringp menu-label) - (widget-unref menu-label-widget)) menu-label-widget)) -(define-foreign notebook-query-tab-label-packing (notebook ref) nil +(defbinding notebook-query-tab-label-packing (notebook ref) nil (notebook notebook) ((if (typep ref 'widget) ref @@ -980,7 +593,7 @@ (fill boolean :out) (pack-type pack-type :out)) -(define-foreign +(defbinding notebook-set-tab-label-packing (notebook ref expand fill pack-type) nil (notebook notebook) ((if (typep ref 'widget) @@ -991,214 +604,95 @@ (fill boolean) (pack-type pack-type)) -(define-foreign notebook-reorder-child () nil +(defbinding notebook-reorder-child () nil (notebook notebook) (child widget) (position int)) -; ;;; Font selection - - - - -; ;;; Paned +;;; Paned -; (define-foreign paned-add1 () nil -; (paned paned) -; (child widget)) - -; (define-foreign paned-add2 () nil -; (paned paned) -; (child widget)) - -; (define-foreign paned-pack1 () nil -; (paned paned) -; (child widget) -; (resize boolean) -; (shrink boolean)) - -; (define-foreign paned-pack2 () nil -; (paned paned) -; (child widget) -; (resize boolean) -; (shrink boolean)) - -; ; (define-foreign ("gtk_paned_set_position" (setf paned-position)) () nil -; ; (paned paned) -; ; (position int)) - -; ;; gtkglue.c -; (define-foreign paned-child1 () widget -; (paned paned) -; (resize boolean :out) -; (shrink boolean :out)) - -; ;; gtkglue.c -; (define-foreign paned-child2 () widget -; (paned paned) -; (resize boolean :out) -; (shrink boolean :out)) - -; (define-foreign vpaned-new () vpaned) - -; (define-foreign hpaned-new () hpaned) - - - -; ;;; Layout - -; (define-foreign layout-new (&optional hadjustment vadjustment) layout -; (hadjustment (or null adjustment)) -; (vadjustment (or null adjustment))) - -; (define-foreign layout-put () nil -; (layout layout) -; (widget widget) -; (x int) (y int)) - -; (define-foreign layout-move () nil -; (layout layout) -; (widget widget) -; (x int) (y int)) - -; (define-foreign %layout-set-size () nil -; (layout layout) -; (width int) -; (height int)) - -; (defun (setf layout-size) (size layout) -; (%layout-set-size layout (svref size 0) (svref size 1)) -; (values (svref size 0) (svref size 1))) - -; ;; gtkglue.c -; (define-foreign layout-size () nil -; (layout layout) -; (width int :out) -; (height int :out)) - -; (define-foreign layout-freeze () nil -; (layout layout)) - -; (define-foreign layout-thaw () nil -; (layout layout)) - -; (define-foreign layout-offset () nil -; (layout layout) -; (x int :out) -; (y int :out)) - - - -;;; List - -; (define-foreign list-new () list-widget) - -; (define-foreign list-insert-items () nil -; (list list-widget) -; (items (list list-item)) -; (position int)) - -; (define-foreign list-append-items () nil -; (list list-widget) -; (items (double-list list-item))) - -; (define-foreign list-prepend-items () nil -; (list list-widget) -; (items (double-list list-item))) - -; (define-foreign %list-remove-items () nil -; (list list-widget) -; (items (double-list list-item))) - -; (define-foreign %list-remove-items-no-unref () nil -; (list list-widget) -; (items (double-list list-item))) - -; (defun list-remove-items (list items &key no-unref) -; (if no-unref -; (%list-remove-items-no-unref list items) -; (%list-remove-items list items))) - -; (define-foreign list-clear-items () nil -; (list list-widget) -; (start int) -; (end int)) +(defbinding paned-pack1 () nil + (paned paned) + (child widget) + (resize boolean) + (shrink boolean)) -; (define-foreign list-select-item () nil -; (list list-widget) -; (item int)) +(defbinding paned-pack2 () nil + (paned paned) + (child widget) + (resize boolean) + (shrink boolean)) -; (define-foreign list-unselect-item () nil -; (list list-widget) -; (item int)) +;; gtkglue.c +(defbinding paned-child1 () widget + (paned paned) + (resize boolean :out) + (shrink boolean :out)) -; (define-foreign list-select-child () nil -; (list list-widget) -; (child widget)) +;; gtkglue.c +(defbinding paned-child2 () widget + (paned paned) + (resize boolean :out) + (shrink boolean :out)) -; (define-foreign list-unselect-child () nil -; (list list-widget) -; (child widget)) +(defun (setf paned-child1) (child paned) + (paned-pack1 paned child nil t)) -; (define-foreign list-child-position () int -; (list list-widget) -; (child widget)) +(defun (setf paned-child2) (child paned) + (paned-pack2 paned child t t)) -; (define-foreign list-extend-selection () nil -; (list list-widget) -; (scroll-type scroll-type) -; (position single-float) -; (auto-start-selection boolean)) -; (define-foreign list-start-selection () nil -; (list list-widget)) -; (define-foreign list-end-selection () nil -; (list list-widget)) +;;; Layout -; (define-foreign list-select-all () nil -; (list list-widget)) +(defbinding layout-put () nil + (layout layout) + (widget widget) + (x int) + (y int)) -; (define-foreign list-unselect-all () nil -; (list list-widget)) +(defbinding layout-move () nil + (layout layout) + (widget widget) + (x int) + (y int)) -; (define-foreign list-scroll-horizontal () nil -; (list list-widget) -; (scroll-type scroll-type) -; (position single-float)) +(defbinding layout-set-size () nil + (layout layout) + (width int) + (height int)) -; (define-foreign list-scroll-vertical () nil -; (list list-widget) -; (scroll-type scroll-type) -; (position single-float)) +;; gtkglue.c +(defbinding layout-get-size () nil + (layout layout) + (width int :out) + (height int :out)) -; (define-foreign list-toggle-add-mode () nil -; (list list-widget)) +(defun layout-x-size (layout) + (nth-value 0 (layout-get-size layout))) -; (define-foreign list-toggle-focus-row () nil -; (list list-widget)) +(defun layout-y-size (layout) + (nth-value 1 (layout-get-size layout))) -; (define-foreign list-toggle-row () nil -; (list list-widget) -; (item list-item)) +(defun (setf layout-x-size) (x layout) + (layout-set-size layout x (layout-y-size layout))) -; (define-foreign list-undo-selection () nil -; (list list-widget)) +(defun (setf layout-y-size) (y layout) + (layout-set-size layout (layout-x-size layout) y)) -; (define-foreign list-end-drag-selection () nil -; (list list-widget)) +(defbinding layout-freeze () nil + (layout layout)) -; ;; gtkglue.c -; (define-foreign list-selection () (double-list list-item) -; (list list-widget)) +(defbinding layout-thaw () nil + (layout layout)) ;;; Menu shell -(define-foreign menu-shell-insert () nil +(defbinding menu-shell-insert () nil (menu-shell menu-shell) (menu-item menu-item) (position int)) @@ -1209,17 +703,17 @@ (defun menu-shell-prepend (menu-shell menu-item) (menu-shell-insert menu-shell menu-item 0)) -(define-foreign menu-shell-deactivate () nil +(defbinding menu-shell-deactivate () nil (menu-shell menu-shell)) -(define-foreign menu-shell-select-item () nil +(defbinding menu-shell-select-item () nil (menu-shell menu-shell) (menu-item menu-item)) -(define-foreign menu-shell-deselect () nil +(defbinding menu-shell-deselect () nil (menu-shell menu-shell)) -(define-foreign menu-shell-activate-item () nil +(defbinding menu-shell-activate-item () nil (menu-shell menu-shell) (menu-item menu-item) (fore-deactivate boolean)) @@ -1228,9 +722,7 @@ ; ;;; Menu bar -(define-foreign menu-bar-new () menu-bar) - -; (define-foreign menu-bar-insert () nil +; (defbinding menu-bar-insert () nil ; (menu-bar menu-bar) ; (menu menu) ; (position int)) @@ -1245,8 +737,6 @@ ; ;;; Menu -(define-foreign menu-new () menu) - ; (defun menu-insert (menu menu-item position) ; (menu-shell-insert menu menu-item position)) @@ -1258,90 +748,44 @@ ;(defun menu-popup ...) -(define-foreign menu-reposition () nil +(defbinding menu-reposition () nil (menu menu)) -(define-foreign menu-popdown () nil +(defbinding menu-popdown () nil (menu menu)) -(define-foreign ("gtk_menu_get_active" menu-active) () widget +(defbinding (menu-active "gtk_menu_get_active") () widget (menu menu)) -(define-foreign ("gtk_menu_set_active" (setf menu-active)) () nil +(defbinding %menu-set-active () nil (menu menu) (index unsigned-int)) +(defun (setf menu-active) (menu index) + (%menu-set-active menu index)) + ;(defun menu-attach-to-widget ...) -(define-foreign menu-detach () nil +(defbinding menu-detach () nil (menu menu)) -(define-foreign ("gtk_menu_get_attach_widget" menu-attach-widget) () widget +(defbinding (menu-attach-widget "gtk_menu_get_attach_widget") () widget (menu menu)) -(define-foreign menu-reorder-child () nil +(defbinding menu-reorder-child () nil (menu menu) (menu-item menu-item) (position int)) - -;;; Packer - -(define-foreign packer-new () packer) - -(define-foreign packer-add - (packer child side anchor - &key - options - (border-width (packer-default-border-width packer)) - (pad-x (packer-default-pad-x packer)) - (pad-y (packer-default-pad-y packer)) - (ipad-x (packer-default-ipad-x packer)) - (ipad-y (packer-default-ipad-y packer))) nil - (packer packer) - (child widget) - (side side-type) - (anchor anchor-type) - (options packer-options) - (border-width unsigned-int) - (pad-x unsigned-int) - (pad-y unsigned-int) - (ipad-x unsigned-int) - (ipad-y unsigned-int)) - -(define-foreign packer-set-child-packing () nil - (packer packer) - (child widget) - (side side-type) - (anchor anchor-type) - (options packer-options) - (border-width unsigned-int) - (pad-x unsigned-int) - (pad-y unsigned-int) - (ipad-x unsigned-int) - (ipad-y unsigned-int)) - -(define-foreign packer-reorder-child () nil - (packer packer) - (child widget) - (position int)) - - - ;;; Table -(define-foreign table-new () table - (rows unsigned-int) - (columns unsigned-int) - (homogeneous boolean)) - -(define-foreign table-resize () nil +(defbinding table-resize () nil (table table) (rows unsigned-int) (columns unsigned-int)) -(define-foreign table-attach (table child left right top bottom +(defbinding table-attach (table child left right top bottom &key (x-options '(:expand :fill)) (y-options '(:expand :fill)) (x-padding 0) (y-padding 0)) nil @@ -1356,7 +800,7 @@ (x-padding unsigned-int) (y-padding unsigned-int)) -(define-foreign %table-set-row-spacing () nil +(defbinding %table-set-row-spacing () nil (table table) (row unsigned-int) (spacing unsigned-int)) @@ -1366,23 +810,23 @@ spacing) ;; gtkglue.c -(define-foreign table-row-spacing (table row) unsigned-int +(defbinding table-row-spacing (table row) unsigned-int (table table) ((progn (assert (and (>= row 0) (< row (table-rows table)))) row) unsigned-int)) -(define-foreign %table-set-col-spacing () nil +(defbinding %table-set-col-spacing () nil (table table) (col unsigned-int) (spacing unsigned-int)) (defun (setf table-column-spacing) (spacing table column) - (%table-set-column-spacing table column spacing) + (%table-set-col-spacing table column spacing) spacing) ;; gtkglue.c -(define-foreign table-column-spacing (table col) unsigned-int +(defbinding table-column-spacing (table col) unsigned-int (table table) ((progn (assert (and (>= col 0) (< col (table-columns table)))) @@ -1390,18 +834,17 @@ (defun %set-table-child-option (object slot flag value) - (let ((options (container-child-slot-value object slot))) + (let ((options (child-slot-value object slot))) (cond ((and value (not (member flag options))) - (setf (container-child-slot-value object slot) (cons flag options))) + (setf (child-slot-value object slot) (cons flag options))) ((and (not value) (member flag options)) - (setf - (container-child-slot-value object slot) (delete flag options)))))) + (setf (child-slot-value object slot) (delete flag options)))))) (macrolet ((define-option-accessor (name slot flag) `(progn (defun ,name (object) - (member ,flag (container-child-slot-value object ,slot))) + (member ,flag (child-slot-value object ,slot))) (defun (setf ,name) (value object) (%set-table-child-option object ,slot ,flag value))))) (define-option-accessor table-child-x-expand-p :x-options :expand) @@ -1415,12 +858,8 @@ ;;; Toolbar -(define-foreign toolbar-new () toolbar - (orientation orientation) - (style toolbar-style)) - ;; gtkglue.c -(define-foreign toolbar-num-children () int +(defbinding toolbar-num-children () int (toolbar toolbar)) (defun %toolbar-position-num (toolbar position) @@ -1431,7 +870,7 @@ (assert (and (>= position 0) (< position (toolbar-num-children toolbar)))) position))) -(define-foreign %toolbar-insert-element () widget +(defbinding %toolbar-insert-element () widget (toolbar toolbar) (type toolbar-child-type) (widget (or null widget)) @@ -1526,108 +965,50 @@ -;;; Tree - -(define-foreign tree-new () tree) - -(define-foreign tree-append () nil - (tree tree) - (tree-item tree-item)) - -(define-foreign tree-prepend () nil - (tree tree) - (tree-item tree-item)) - -(define-foreign tree-insert () nil - (tree tree) - (tree-item tree-item) - (position int)) - -(define-foreign tree-remove-items () nil - (tree tree) - (items (double-list tree-item))) - -(define-foreign tree-clear-items () nil - (tree tree) - (start int) - (end int)) - -(define-foreign tree-select-item () nil - (tree tree) - (item int)) - -(define-foreign tree-unselect-item () nil - (tree tree) - (item int)) - -(define-foreign tree-select-child () nil - (tree tree) - (tree-item tree-item)) - -(define-foreign tree-unselect-child () nil - (tree tree) - (tree-item tree-item)) - -(define-foreign tree-child-position () int - (tree tree) - (tree-item tree-item)) - -(defun root-tree-p (tree) - (eq (tree-root-tree tree) tree)) - -;; gtkglue.c -(define-foreign tree-selection () (double-list tree-item) - (tree tree)) - - - ;;; Calendar -(define-foreign calendar-new () calendar) - -(define-foreign calendar-select-month () int +(defbinding calendar-select-month () int (calendar calendar) (month unsigned-int) (year unsigned-int)) -(define-foreign calendar-select-day () nil +(defbinding calendar-select-day () nil (calendar calendar) (day unsigned-int)) -(define-foreign calendar-mark-day () int +(defbinding calendar-mark-day () int (calendar calendar) (day unsigned-int)) -(define-foreign calendar-unmark-day () int +(defbinding calendar-unmark-day () int (calendar calendar) (day unsigned-int)) -(define-foreign calendar-clear-marks () nil +(defbinding calendar-clear-marks () nil (calendar calendar)) -(define-foreign calendar-display-options () nil +(defbinding calendar-display-options () nil (calendar calendar) (options calendar-display-options)) -(define-foreign ("gtk_calendar_get_date" calendar-date) () nil +(defbinding (calendar-date "gtk_calendar_get_date") () nil (calendar calendar) (year unsigned-int :out) (month unsigned-int :out) (day unsigned-int :out)) -(define-foreign calendar-freeze () nil +(defbinding calendar-freeze () nil (calendar calendar)) -(define-foreign calendar-thaw () nil +(defbinding calendar-thaw () nil (calendar calendar)) ;;; Drawing area -; (define-foreign drawing-area-new () drawing-area) -; (define-foreign ("gtk_drawing_area_size" %drawing-area-set-size) () nil +; (defbinding ("gtk_drawing_area_size" %drawing-area-set-size) () nil ; (drawing-area drawing-area) ; (width int) ; (height int)) @@ -1637,25 +1018,21 @@ ; (values (svref size 0) (svref size 1))) ; ;; gtkglue.c -; (define-foreign ("gtk_drawing_area_get_size" drawing-area-size) () nil +; (defbinding ("gtk_drawing_area_get_size" drawing-area-size) () nil ; (drawing-area drawing-area) ; (width int :out) ; (height int :out)) -; ;;; Curve - - - -; ;;; Editable - -(define-foreign editable-select-region (editable &optional (start 0) end) nil +;;; Editable +#| +(defbinding editable-select-region (editable &optional (start 0) end) nil (editable editable) (start int) ((or end -1) int)) -(define-foreign editable-insert-text +(defbinding editable-insert-text (editable text &optional (position 0)) nil (editable editable) (text string) @@ -1668,12 +1045,12 @@ (defun editable-prepend-text (editable text) (editable-insert-text editable text 0)) -(define-foreign editable-delete-text (editable &optional (start 0) end) nil +(defbinding editable-delete-text (editable &optional (start 0) end) nil (editable editable) (start int) ((or end -1) int)) -(define-foreign ("gtk_editable_get_chars" editable-text) +(defbinding (editable-text "gtk_editable_get_chars") (editable &optional (start 0) end) string (editable editable) (start int) @@ -1687,222 +1064,157 @@ (editable-delete-text editable)) text) -(define-foreign editable-cut-clipboard () nil +(defbinding editable-cut-clipboard () nil (editable editable)) -(define-foreign editable-copy-clipboard () nil +(defbinding editable-copy-clipboard () nil (editable editable)) -(define-foreign editable-paste-clipboard () nil +(defbinding editable-paste-clipboard () nil (editable editable)) -(define-foreign editable-claim-selection () nil - (editable editable) - (claim boolean) - (time unsigned-int)) - -(define-foreign editable-delete-selection () nil - (editable editable)) +; (defbinding editable-claim-selection () nil +; (editable editable) +; (claim boolean) +; (time unsigned-int)) -(define-foreign editable-changed () nil +(defbinding editable-delete-selection () nil (editable editable)) - - -;;; Entry - -(define-foreign %entry-new() entry) - -(define-foreign %entry-new-with-max-length () entry - (max (unsigned 16))) - -(defun entry-new (&optional max) - (if max - (%entry-new-with-max-length max) - (%entry-new))) +; (defbinding editable-changed () nil +; (editable editable)) +|# ;;; Spin button -(define-foreign spin-button-new () spin-button - (adjustment adjustment) - (climb-rate single-float) - (digits unsigned-int)) - (defun spin-button-value-as-int (spin-button) (round (spin-button-value spin-button))) -(define-foreign spin-button-spin () nil +(defbinding spin-button-spin () nil (spin-button spin-button) (direction spin-type) (increment single-float)) -(define-foreign spin-button-update () nil +(defbinding spin-button-update () nil (spin-button spin-button)) ; ;;; Ruler -(define-foreign ruler-set-range () nil +(defbinding ruler-set-range () nil (ruler ruler) (lower single-float) (upper single-float) (position single-float) (max-size single-float)) -(define-foreign ruler-draw-ticks () nil +(defbinding ruler-draw-ticks () nil (ruler ruler)) -(define-foreign ruler-draw-pos () nil +(defbinding ruler-draw-pos () nil (ruler ruler)) -; ;;; Range - -; (define-foreign range-draw-background () nil -; (range range)) - -; (define-foreign range-clear-background () nil -; (range range)) - -; (define-foreign range-draw-trough () nil -; (range range)) +;;; Range +#| +(defbinding range-draw-background () nil + (range range)) -; (define-foreign range-draw-slider () nil -; (range range)) +(defbinding range-clear-background () nil + (range range)) -; (define-foreign range-draw-step-forw () nil -; (range range)) +(defbinding range-draw-trough () nil + (range range)) -; (define-foreign range-slider-update () nil -; (range range)) - -; (define-foreign range-trough-click () int -; (range range) -; (x int) -; (y int) -; (jump-perc single-float :out)) - -; (define-foreign range-default-hslider-update () nil -; (range range)) - -; (define-foreign range-default-vslider-update () nil -; (range range)) - -; (define-foreign range-default-htrough-click () int -; (range range) -; (x int) -; (y int) -; (jump-perc single-float :out)) - -; (define-foreign range-default-vtrough-click () int -; (range range) -; (x int) -; (y int) -; (jump-perc single-float :out)) +(defbinding range-draw-slider () nil + (range range)) -; (define-foreign range-default-hmotion () int -; (range range) -; (x-delta int) -; (y-delta int)) +(defbinding range-draw-step-forw () nil + (range range)) -; (define-foreign range-default-vmotion () int -; (range range) -; (x-delta int) -; (y-delta int)) +(defbinding range-slider-update () nil + (range range)) +(defbinding range-trough-click () int + (range range) + (x int) + (y int) + (jump-perc single-float :out)) +(defbinding range-default-hslider-update () nil + (range range)) -; ;;; Scale +(defbinding range-default-vslider-update () nil + (range range)) -; (define-foreign scale-draw-value () nil -; (scale scale)) +(defbinding range-default-htrough-click () int + (range range) + (x int) + (y int) + (jump-perc single-float :out)) -; (define-foreign hscale-new () hscale -; (adjustment adjustment)) +(defbinding range-default-vtrough-click () int + (range range) + (x int) + (y int) + (jump-perc single-float :out)) -; (define-foreign vscale-new () hscale -; (adjustment adjustment)) +(defbinding range-default-hmotion () int + (range range) + (x-delta int) + (y-delta int)) +(defbinding range-default-vmotion () int + (range range) + (x-delta int) + (y-delta int)) +|# -; ;;; Scrollbar +;;; Scale -; (define-foreign hscrollbar-new () hscrollbar -; (adjustment adjustment)) +(defbinding scale-draw-value () nil + (scale scale)) -; (define-foreign vscrollbar-new () vscrollbar -; (adjustment adjustment)) +;;; Progress -; ;;; Separator - -(define-foreign vseparator-new () vseparator) - -(define-foreign hseparator-new () hseparator) - - - -; ;;; Preview - - - -; ;;; Progress - -; (define-foreign progress-configure () adjustment -; (progress progress) -; (value single-float) -; (min single-float) -; (max single-float)) - -; (define-foreign ("gtk_progress_get_text_from_value" -; progress-text-from-value) () string -; (progress progress)) - -; (define-foreign ("gtk_progress_get_percentage_from_value" -; progress-percentage-from-value) () single-float -; (progress progress)) - +(defbinding progress-configure () adjustment + (progress progress) + (value single-float) + (min single-float) + (max single-float)) +(defbinding (progress-text-from-value + "gtk_progress_get_text_from_value") () string + (progress progress)) -; ;;; Progress bar +(defbinding (progress-percentage-from-value + "gtk_progress_get_percentage_from_value") () single-float + (progress progress)) -; (define-foreign %progress-bar-new () progress-bar) -; (define-foreign %progress-bar-new-with-adjustment () progress-bar -; (adjustment adjustment)) -; (defun progress-bar-new (&optional adjustment) -; (if adjustment -; (%progress-bar-new-with-adjustment adjustment) -; (%progress-bar-new))) +;;; Progress bar -; (define-foreign progress-bar-update () nil -; (progress-bar progress-bar) -; (percentage single-float)) +(defbinding progress-bar-pulse () nil + (progress-bar progress-bar)) ;;; Adjustment -(define-foreign adjustment-new () adjustment - (value single-float) - (lower single-float) - (upper single-float) - (step-increment single-float) - (page-increment single-float) - (page-size single-float)) - -(define-foreign adjustment-changed () nil +(defbinding adjustment-changed () nil (adjustment adjustment)) -(define-foreign adjustment-value-changed () nil +(defbinding adjustment-value-changed () nil (adjustment adjustment)) -(define-foreign adjustment-clamp-page () nil +(defbinding adjustment-clamp-page () nil (adjustment adjustment) (lower single-float) (upper single-float)) @@ -1911,60 +1223,49 @@ ;;; Tooltips -; (define-foreign tooltips-new () tooltips) +(defbinding tooltips-enable () nil + (tooltips tooltips)) -; (define-foreign tooltips-enable () nil -; (tooltips tooltips)) +(defbinding tooltips-disable () nil + (tooltips tooltips)) -; (define-foreign tooltips-disable () nil -; (tooltips tooltips)) - -; (define-foreign tooltips-set-tip () nil -; (tooltips tooltips) -; (widget widget) -; (tip-text string) -; (tip-private string)) - -; (declaim (inline tooltips-set-colors-real)) -; (define-foreign ("gtk_tooltips_set_colors" tooltips-set-colors-real) () nil -; (tooltips tooltips) -; (background gdk:color) -; (foreground gdk:color)) - -; (defun tooltips-set-colors (tooltips background foreground) -; (gdk:with-colors ((background background) -; (foreground foreground)) -; (tooltips-set-colors-real tooltips background foreground))) +(defbinding tooltips-set-tip () nil + (tooltips tooltips) + (widget widget) + (tip-text string) + (tip-private string)) -; (define-foreign tooltips-force-window () nil -; (tooltips tooltips)) +(defbinding tooltips-set-colors (tooltips background foreground) nil + (tooltips tooltips) + ((gdk:ensure-color background) gdk:color) + ((gdk:ensure-color foreground) gdk:color)) +(defbinding tooltips-force-window () nil + (tooltips tooltips)) -; ;;; Rc +;;; Rc -; (define-foreign rc-add-default-file (filename) nil -; ((namestring (truename filename)) string)) +(defbinding rc-add-default-file (filename) nil + ((namestring (truename filename)) string)) -; (define-foreign rc-parse (filename) nil -; ((namestring (truename filename)) string)) +(defbinding rc-parse (filename) nil + ((namestring (truename filename)) string)) -; (define-foreign rc-parse-string () nil -; (rc-string string)) +(defbinding rc-parse-string () nil + (rc-string string)) -; (define-foreign rc-reparse-all () nil) +(defbinding rc-reparse-all () nil) -; ;(define-foreign rc-get-style () style -; ; (widget widget)) +(defbinding rc-get-style () style + (widget widget)) ;;; Accelerator Groups - -(define-foreign accel-group-new () accel-group) - -(define-foreign accel-group-get-default () accel-group) +#| +(defbinding accel-group-get-default () accel-group) (deftype-method alien-ref accel-group (type-spec) (declare (ignore type-spec)) @@ -1974,55 +1275,55 @@ (declare (ignore type-spec)) '%accel-group-unref) -(define-foreign %accel-group-ref () accel-group +(defbinding %accel-group-ref () accel-group (accel-group (or accel-group pointer))) -(define-foreign %accel-group-unref () nil +(defbinding %accel-group-unref () nil (accel-group (or accel-group pointer))) -(define-foreign accel-group-activate (accel-group key modifiers) boolean +(defbinding accel-group-activate (accel-group key modifiers) boolean (accel-group accel-group) ((gdk:keyval-from-name key) unsigned-int) (modifiers gdk:modifier-type)) -(define-foreign accel-groups-activate (object key modifiers) boolean +(defbinding accel-groups-activate (object key modifiers) boolean (object object) ((gdk:keyval-from-name key) unsigned-int) (modifiers gdk:modifier-type)) -(define-foreign accel-group-attach () nil +(defbinding accel-group-attach () nil (accel-group accel-group) (object object)) -(define-foreign accel-group-detach () nil +(defbinding accel-group-detach () nil (accel-group accel-group) (object object)) -(define-foreign accel-group-lock () nil +(defbinding accel-group-lock () nil (accel-group accel-group)) -(define-foreign accel-group-unlock () nil +(defbinding accel-group-unlock () nil (accel-group accel-group)) ;;; Accelerator Groups Entries -(define-foreign accel-group-get-entry (accel-group key modifiers) accel-entry +(defbinding accel-group-get-entry (accel-group key modifiers) accel-entry (accel-group accel-group) ((gdk:keyval-from-name key) unsigned-int) (modifiers gdk:modifier-type)) -(define-foreign accel-group-lock-entry (accel-group key modifiers) nil +(defbinding accel-group-lock-entry (accel-group key modifiers) nil (accel-group accel-group) ((gdk:keyval-from-name key) unsigned-int) (modifiers gdk:modifier-type)) -(define-foreign accel-group-unlock-entry (accel-group key modifiers) nil +(defbinding accel-group-unlock-entry (accel-group key modifiers) nil (accel-group accel-group) ((gdk:keyval-from-name key) unsigned-int) (modifiers gdk:modifier-type)) -(define-foreign accel-group-add +(defbinding accel-group-add (accel-group key modifiers flags object signal) nil (accel-group accel-group) ((gdk:keyval-from-name key) unsigned-int) @@ -2031,7 +1332,7 @@ (object object) ((name-to-string signal) string)) -(define-foreign accel-group-add (accel-group key modifiers object) nil +(defbinding accel-group-add (accel-group key modifiers object) nil (accel-group accel-group) ((gdk:keyval-from-name key) unsigned-int) (modifiers gdk:modifier-type) @@ -2040,7 +1341,7 @@ ;;; Accelerator Signals -(define-foreign accel-group-handle-add +(defbinding accel-group-handle-add (object signal-id accel-group key modifiers flags) nil (object object) (signal-id unsigned-int) @@ -2049,102 +1350,298 @@ (modifiers gdk:modifier-type) (flags accel-flags)) -(define-foreign accel-group-handle-remove +(defbinding accel-group-handle-remove (object accel-group key modifiers) nil (object object) (accel-group accel-group) ((gdk:keyval-from-name key) unsigned-int) (modifiers gdk:modifier-type)) - +|# ;;; Style -; (define-foreign style-new () style) - -; (define-foreign style-copy () style -; (style style)) - -; (define-foreign style-ref () style -; (style style)) +; (defbinding style-new () style) -; (define-foreign style-unref () nil +; (defbinding style-copy () style ; (style style)) - -; (define-foreign style-get-color () gdk:color +#| +(defbinding %style-get-color () gdk:color + (style style) + (color-type color-type) + (state-type state-type)) + +(defbinding %style-set-color () gdk:color + (style style) + (color-type color-type) + (state-type state-type) + (color gdk:color)) + +(defun style-fg (style state) + (%style-get-color style :foreground state)) + +(defun (setf style-fg) (color style state) + (%style-set-color style :foreground state color)) + +(defun style-bg (style state) + (%style-get-color style :background state)) + +(defun (setf style-bg) (color style state) + (%style-set-color style :background state color)) + +(defun style-text (style state) + (%style-get-color style :text state)) + +(defun (setf style-text) (color style state) + (%style-set-color style :text state color)) + +(defun style-base (style state) + (%style-get-color style :base state)) + +(defun (setf style-base) (color style state) + (%style-set-color style :base state color)) + +(defun style-white (style) + (%style-get-color style :white :normal)) + +(defun (setf style-white) (color style) + (%style-set-color style :white :normal color)) + +(defun style-black (style) + (%style-get-color style :black :normal)) + +(defun (setf style-black) (color style) + (%style-set-color style :black :normal color)) + +(defbinding style-get-gc () gdk:gc + (style style) + (color-type color-type) + (state-type state-type)) + +|# +(defbinding draw-hline () nil + (style style) + (window gdk:window) + (state state-type) + (x1 int) + (x2 int) + (y int)) + +(defbinding draw-vline () nil + (style style) + (window gdk:window) + (state state-type) + (y1 int) + (y2 int) + (x int)) + +(defbinding draw-shadow () nil + (style style) + (window gdk:window) + (state state-type) + (shadow shadow-type) + (x int) + (y int) + (width int) + (height int)) + +; (defbinding draw-polygon () nil ; (style style) -; (color-type color-type) -; (state-type state-type)) - -; (define-foreign -; ("gtk_style_set_color" style-set-color-from-color) () gdk:color +; (window gdk:window) +; (state state-type) +; (shadow shadow-type) +; (points (vector gdk:point)) +; ((length points) int) +; (fill boolean)) + +(defbinding draw-arrow () nil + (style style) + (window gdk:window) + (state state-type) + (shadow shadow-type) + (arrow arrow-type) + (fill boolean) + (x int) + (y int) + (width int) + (height int)) + +(defbinding draw-diamond () nil + (style style) + (window gdk:window) + (state state-type) + (shadow shadow-type) + (x int) + (y int) + (width int) + (height int)) + +; (defbinding draw-oval () nil ; (style style) -; (color-type color-type) -; (state-type state-type) -; (color gdk:color)) - -; (defun style-set-color (style color-type state-type color) -; (gdk:with-colors ((color color)) -; (style-set-color-from-color style color-type state-type color))) +; (window gdk:window) +; (state state-type) +; (shadow shadow-type) +; (x int) +; (y int) +; (width int) +; (height int)) -; (define-foreign ("gtk_style_get_font" style-font) () gdk:font -; (style style)) +(defbinding draw-string () nil + (style style) + (window gdk:window) + (state state-type) + (x int) + (y int) + (string string)) -; (define-foreign style-set-font () gdk:font +(defbinding draw-box () nil + (style style) + (window gdk:window) + (state state-type) + (shadow shadow-type) + (x int) + (y int) + (width int) + (height int)) + +(defbinding draw-flat-box () nil + (style style) + (window gdk:window) + (state state-type) + (shadow shadow-type) + (x int) + (y int) + (width int) + (height int)) + +(defbinding draw-check () nil + (style style) + (window gdk:window) + (state state-type) + (shadow shadow-type) + (x int) + (y int) + (width int) + (height int)) + +(defbinding draw-option () nil + (style style) + (window gdk:window) + (state state-type) + (shadow shadow-type) + (x int) + (y int) + (width int) + (height int)) + +; (defbinding draw-cross () nil ; (style style) -; (font gdk:font)) - -; (defun (setf style-font) (font style) -; (let ((font (gdk:ensure-font font))) -; (gdk:font-unref (style-font style)) -; (style-set-font style font))) - -; (defun style-fg (style state) -; (style-get-color style :foreground state)) - -; (defun (setf style-fg) (color style state) -; (style-set-color style :foreground state color)) - -; (defun style-bg (style state) -; (style-get-color style :background state)) - -; (defun (setf style-bg) (color style state) -; (style-set-color style :background state color)) - -; (defun style-text (style state) -; (style-get-color style :text state)) - -; (defun (setf style-text) (color style state) -; (style-set-color style :text state color)) - -; (defun style-base (style state) -; (style-get-color style :base state)) - -; (defun (setf style-base) (color style state) -; (style-set-color style :base state color)) - -; (defun style-white (style) -; (style-get-color style :white :normal)) - -; (defun (setf style-white) (color style) -; (style-set-color style :white :normal color)) - -; (defun style-black (style) -; (style-get-color style :black :normal)) - -; (defun (setf style-black) (color style) -; (style-set-color style :black :normal color)) +; (window gdk:window) +; (state state-type) +; (shadow shadow-type) +; (x int) +; (y int) +; (width int) +; (height int)) -; (define-foreign style-get-gc -; (style color-type &optional (state-type :normal)) gdk:gc +; (defbinding draw-ramp () nil ; (style style) -; (color-type color-type) -; (state-type state-type)) - - - - - - - +; (window gdk:window) +; (state state-type) +; (shadow shadow-type) +; (arrow arrow-type) +; (x int) +; (y int) +; (width int) +; (height int)) +(defbinding draw-tab () nil + (style style) + (window gdk:window) + (state state-type) + (x int) + (y int) + (width int) + (height int)) + +(defbinding draw-shadow-gap () nil + (style style) + (window gdk:window) + (state state-type) + (x int) + (y int) + (width int) + (height int) + (gap-side position-type) + (gap-x int) + (gap-width int)) + +(defbinding draw-box-gap () nil + (style style) + (window gdk:window) + (state state-type) + (x int) + (y int) + (width int) + (height int) + (gap-side position-type) + (gap-x int) + (gap-width int)) + +(defbinding draw-extension () nil + (style style) + (window gdk:window) + (state state-type) + (x int) + (y int) + (width int) + (height int)) + +(defbinding draw-focus () nil + (style style) + (window gdk:window) + (x int) + (y int) + (width int) + (height int)) + +(defbinding draw-slider () nil + (style style) + (window gdk:window) + (state state-type) + (shadow shadow-type) + (x int) + (y int) + (width int) + (height int) + (orientation orientation)) + +(defbinding draw-handle () nil + (style style) + (window gdk:window) + (state state-type) + (shadow shadow-type) + (x int) + (y int) + (width int) + (height int) + (orientation orientation)) + +(defbinding draw-handle () nil + (style style) + (window gdk:window) + (state state-type) + (shadow shadow-type) + (x int) + (y int) + (width int) + (height int) + (orientation orientation)) + +(defbinding paint-hline () nil + (style style) + (window gdk:window) + (state state-type) + (x1 int) + (x2 int) + (y int))