;; 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.5 2001-05-31 21:52:57 espen Exp $
+;; $Id: gtk.lisp,v 1.9 2002-03-24 15:40:50 espen Exp $
(in-package "GTK")
(format nil "Gtk+ v~A.~A" major minor)
(format nil "Gtk+ v~A.~A.~A" major minor micro))))
+(defbinding get-default-language () string)
-;;; Label
-
-(defbinding label-select-region () nil
- (label label)
- (start int)
- (end int))
-
+;;; Acccel group
;;; Acccel label
(accel-label accel-label))
+;;; Adjustment
+
+(defbinding adjustment-changed () nil
+ (adjustment adjustment))
+
+(defbinding adjustment-value-changed () nil
+ (adjustment adjustment))
+
+(defbinding adjustment-clamp-page () nil
+ (adjustment adjustment)
+ (lower single-float)
+ (upper single-float))
+
+
+
+;;; Alignment -- no functions
+;;; Arrow -- no functions
+
-;;; Bin
-(defun bin-child (bin)
- (first (container-children bin)))
+;;; Aspect frame
+
+
+;;; Bin
(defun (setf bin-child) (child bin)
- (let ((old-child (bin-child bin)))
- (when old-child
- (container-remove bin old-child)))
+ (when-bind (current-child (bin-child bin))
+ (container-remove bin current-child))
(container-add bin child)
child)
-(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 box -- no functions
+
+
+;;; Binding
+
+
+
+;;; Box
+
+(defbinding box-pack-start () nil
+ (box box)
+ (child widget)
+ (expand boolean)
+ (fill boolean)
+ (padding unsigned-int))
+
+(defbinding box-pack-end () nil
+ (box box)
+ (child widget)
+ (expand boolean)
+ (fill boolean)
+ (padding unsigned-int))
+
+(defun box-pack (box child &key (pack :start) (expand t) (fill t) (padding 0))
+ (if (eq pack :start)
+ (box-pack-start box child expand fill padding)
+ (box-pack-end box child expand fill padding)))
+
+(defbinding box-reorder-child () nil
+ (box box)
+ (child widget)
+ (position int))
+
+(defbinding box-query-child-packing () nil
+ (box box)
+ (child widget)
+ (expand boolean :out)
+ (fill boolean :out)
+ (padding unsigned-int :out)
+ (pack-type pack-type :out))
+
+(defbinding box-set-child-packing () nil
+ (box box)
+ (child widget)
+ (expand boolean)
+ (fill boolean)
+ (padding unsigned-int)
+ (pack-type pack-type))
+
;;; Button
+;;; Calendar
+
+(defbinding calendar-select-month () int
+ (calendar calendar)
+ (month unsigned-int)
+ (year unsigned-int))
+
+(defbinding calendar-select-day () nil
+ (calendar calendar)
+ (day unsigned-int))
+
+(defbinding calendar-mark-day () int
+ (calendar calendar)
+ (day unsigned-int))
+
+(defbinding calendar-unmark-day () int
+ (calendar calendar)
+ (day unsigned-int))
+
+(defbinding calendar-clear-marks () nil
+ (calendar calendar))
+
+(defbinding calendar-display-options () nil
+ (calendar calendar)
+ (options calendar-display-options))
+
+(defbinding (calendar-date "gtk_calendar_get_date") () nil
+ (calendar calendar)
+ (year unsigned-int :out)
+ (month unsigned-int :out)
+ (day unsigned-int :out))
+
+(defbinding calendar-freeze () nil
+ (calendar calendar))
+
+(defbinding calendar-thaw () nil
+ (calendar calendar))
+
+
+
+;;; Cell editable
+
+
+
+;;; Cell renderer
+
+
+
+;;; Cell renderer pixbuf -- no functions
+
+
+
+;;; Cell renderer text
+
+
+
+;;; Cell renderer toggle -- no functions
+
+
+
+;;; Check button -- no functions
+
+
+
+;;; Check menu item
+
+(defbinding check-menu-item-toggled () nil
+ (check-menu-item check-menu-item))
+
+
+
+;;; Clipboard
+
+
+;;; Color selection
+
+(defbinding (color-selection-is-adjusting-p
+ "gtk_color_selection_is_adjusting") () boolean
+ (colorsel color-selection))
+
+
+
+;;; Color selection dialog -- no functions
+
+
+
+;;; Combo
+
+(defbinding combo-set-value-in-list () nil
+ (combo combo)
+ (value boolean)
+ (ok-if-empty boolean))
+
+(defbinding combo-set-item-string () nil
+ (combo combo)
+ (item item)
+ (item-value string))
+
+(defbinding combo-set-popdown-strings () nil
+ (combo combo)
+ (strings (glist string)))
+
+(defbinding combo-disable-activate () nil
+ (combo combo))
+
+
+
+;;;; Dialog
+
+(defmethod shared-initialize ((dialog dialog) names &rest initargs)
+ (call-next-method)
+ (dolist (button-definition (get-all initargs :button))
+ (apply #'dialog-add-button dialog button-definition)))
+
+
+(defvar %*response-id-key* (gensym))
+
+(defun %dialog-find-response-id-num (dialog response-id &optional create-p error-p)
+ (or
+ (cadr (assoc response-id (rest (type-expand-1 'response-type))))
+ (let* ((response-ids (object-data dialog %*response-id-key*))
+ (response-id-num (position response-id response-ids)))
+ (cond
+ (response-id-num)
+ (create-p
+ (cond
+ (response-ids
+ (setf (cdr (last response-ids)) (list response-id))
+ (1- (length response-ids)))
+ (t
+ (setf (object-data dialog %*response-id-key*) (list response-id))
+ 0)))
+ (error-p
+ (error "Invalid response: ~A" response-id))))))
+
+(defun %dialog-find-response-id (dialog response-id-num)
+ (if (< response-id-num 0)
+ (car
+ (rassoc
+ (list response-id-num)
+ (rest (type-expand-1 'response-type)) :test #'equalp))
+ (nth response-id-num (object-data dialog %*response-id-key*))))
+
+
+(defmethod signal-connect ((dialog dialog) signal function &key object after)
+ (let ((response-id-num (%dialog-find-response-id-num dialog signal)))
+ (cond
+ (response-id-num
+ (call-next-method
+ dialog 'response
+ #'(lambda (dialog id)
+ (when (= id response-id-num)
+ (cond
+ ((eq object t) (funcall function dialog))
+ (object (funcall function object))
+ (t (funcall function)))))
+ :object t :after after))
+ (t
+ (call-next-method)))))
+
+
+(defbinding dialog-run () nil
+ (dialog dialog))
+
+(defbinding dialog-response (dialog response-id) nil
+ (dialog dialog)
+ ((%dialog-find-response-id-num dialog response-id nil t) int))
+
+
+(defbinding %dialog-add-button () button
+ (dialog dialog)
+ (text string)
+ (response-id-num int))
+
+(defun dialog-add-button (dialog label &optional response-id default-p)
+ (let* ((response-id-num
+ (if response-id
+ (%dialog-find-response-id-num dialog response-id t)
+ (length (object-data dialog %*response-id-key*))))
+ (button (%dialog-add-button dialog label response-id-num)))
+ (unless response-id
+ (%dialog-find-response-id-num dialog button t))
+ (when default-p
+ (%dialog-set-default-response dialog response-id-num))
+ button))
+
+
+(defbinding %dialog-add-action-widget () button
+ (dialog dialog)
+ (action-widget widget)
+ (response-id-num int))
+
+(defun dialog-add-action-widget (dialog widget &optional (response-id widget)
+ default-p)
+ (let ((response-id-num (%dialog-find-response-id-num dialog response-id t)))
+ (%dialog-add-action-widget dialog widget response-id-num)
+ (when default-p
+ (%dialog-set-default-response dialog response-id-num))
+ widget))
+
+
+(defbinding %dialog-set-default-response () nil
+ (dialog dialog)
+ (response-id-num int))
+
+(defun dialog-set-default-response (dialog response-id)
+ (%dialog-set-default-response
+ dialog (%dialog-find-response-id-num dialog response-id nil t)))
+
+(defbinding dialog-set-response-sensitive (dialog response-id sensitive) nil
+ (dialog dialog)
+ ((%dialog-find-response-id-num dialog response-id nil t) int)
+ (sensitive boolean))
+
+
+;; Addition dialog functions
+
+(defmethod container-add ((dialog dialog) (child widget) &rest args)
+ (apply #'container-add (slot-value dialog 'main-area) child args))
+
+(defmethod container-remove ((dialog dialog) (child widget))
+ (container-remove (slot-value dialog 'main-area) child))
+
+(defmethod container-children ((dialog dialog))
+ (container-children (dialog-main-area dialog)))
+
+(defmethod (setf container-children) (children (dialog dialog))
+ (setf (container-children (dialog-main-area dialog)) children))
+
+
+
+;;; Drawing area -- no functions
+
+
+
;;; Toggle button
(defbinding toggle-button-toggled () nil
(toggle-button toggle-button))
+;;; Label
-;;; Check button
+(defbinding label-select-region () nil
+ (label label)
+ (start int)
+ (end int))
-(defmethod (setf button-label) ((label string) (button check-button))
- (call-next-method)
- (setf (misc-xalign (bin-child button)) 0.0)
- label)
;;; Radio button
-(defbinding (%radio-button-get-group "gtk_radio_button_group") () pointer
+(defbinding %radio-button-get-group () pointer
(radio-button radio-button))
(defbinding %radio-button-set-group () nil
"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)
+ &rest initargs &key group-with)
+ (declare (ignore initargs))
(call-next-method)
- (when group
- (radio-button-add-to-group item group)))
+ (when group-with
+ (radio-button-add-to-group item group-with)))
;;; Option menu
(%menu-item-set-submenu menu-item submenu))
submenu)
-(defbinding %menu-item-configure () nil
- (menu-item menu-item)
- (show-toggle-indicator boolean)
- (show-submenu-indicator boolean))
-
-(defun (setf menu-item-toggle-indicator-p) (show menu-item)
- (%menu-item-configure
- menu-item
- show
- (menu-item-submenu-indicator-p menu-item))
- show)
-
-(defun (setf menu-item-submenu-indicator-p) (show menu-item)
- (%menu-item-configure
- menu-item
- (menu-item-toggle-indicator-p menu-item)
- show))
-
(defbinding menu-item-select () nil
(menu-item menu-item))
(defbinding menu-item-activate () nil
(menu-item menu-item))
-(defbinding menu-item-right-justify () nil
- (menu-item menu-item))
-
-
-
-;;; Check menu item
-
-(defbinding check-menu-item-toggled () nil
- (check-menu-item check-menu-item))
-
;;; Radio menu item
-(defbinding (%radio-menu-item-get-group
- "gtk_radio_menu_item_group") () pointer
+(defbinding %radio-menu-item-get-group () pointer
(radio-menu-item radio-menu-item))
(defbinding %radio-menu-item-set-group () nil
(%radio-menu-item-set-group item1 (%radio-menu-item-get-group item2)))
(defmethod initialize-instance ((item radio-menu-item)
- &rest initargs &key group)
+ &rest initargs &key group-with)
+ (declare (ignore initargs))
(call-next-method)
- (when group
- (radio-menu-item-add-to-group item group)))
+ (when group-with
+ (radio-menu-item-add-to-group item group-with)))
(file-selection file-selection)
(pattern string))
-(defbinding file-selection-show-fileop-buttons () nil
- (file-selection file-selection))
-
-(defbinding file-selection-hide-fileop-buttons () nil
- (file-selection file-selection))
-
;;; Scrolled window
-;;; Box
-(defbinding box-pack-start () nil
- (box box)
- (child widget)
- (expand boolean)
- (fill boolean)
- (padding unsigned-int))
-(defbinding box-pack-end () nil
- (box box)
- (child widget)
- (expand boolean)
- (fill boolean)
- (padding unsigned-int))
-(defun box-pack (box child &key (pack :start) (expand t) (fill t) (padding 0))
- (if (eq pack :start)
- (box-pack-start box child expand fill padding)
- (box-pack-end box child expand fill padding)))
-(defbinding box-reorder-child () nil
- (box box)
- (child widget)
- (position int))
-
-(defbinding box-query-child-packing () nil
- (box box)
- (child widget :out)
- (expand boolean :out)
- (fill boolean :out)
- (padding unsigned-int :out)
- (pack-type pack-type :out))
-
-(defbinding box-set-child-packing () nil
- (box box)
- (child widget)
- (expand boolean)
- (fill boolean)
- (padding unsigned-int)
- (pack-type pack-type))
-
-
-
-;;; Button box
-
-(defbinding button-box-get-child-size () nil
- (button-box button-box)
- (min-width int :out)
- (min-height int :out))
-
-(defbinding button-box-set-child-size () nil
- (button-box button-box)
- (min-width int)
- (min-height int))
-
-(defbinding button-box-get-child-ipadding () nil
- (button-box button-box)
- (ipad-x int :out)
- (ipad-y int :out))
-
-(defbinding button-box-set-child-ipadding () nil
- (button-box button-box)
- (ipad-x int)
- (ipad-y int))
-
-
-
-;;; Color selection
-
-; (defbinding %color-selection-get-previous-color () nil
-; (colorsel color-selection)
-; (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)))
-
-; (defun (setf color-selection-previous-color) (color colorsel)
-; (%color-selection-set-previous-color colorsel color)
-; color)
-(defbinding (color-selection-is-adjusting-p
- "gtk_color_selection_is_adjusting") () boolean
- (colorsel color-selection))
-
-
-
-;;; Combo
-
-(defbinding combo-set-value-in-list () nil
- (combo combo)
- (val boolean)
- (ok-if-empty boolean))
-
-; (defbinding ("gtk_combo_set_item_string" (setf combo-item-string)) () nil
-; (combo combo)
-; (item item)
-; (item-value string))
-(defbinding %combo-set-popdown-strings () nil
- (combo combo)
- (strings (glist string)))
-(defun (setf combo-popdown-strings) (strings combo)
- (%combo-set-popdown-strings combo strings)
- strings)
-(defbinding combo-disable-activate () nil
- (combo combo))
(defbinding notebook-popup-disable () nil
(notebook notebook))
-(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))
-
-(defbinding %notebook-set-tab-label () nil
- (notebook notebook)
- (reference widget)
- (tab-label widget))
-
-(defun (setf notebook-tab-label) (tab-label notebook reference)
- (let ((tab-label-widget (if (stringp tab-label)
- (label-new tab-label)
- tab-label)))
- (%notebook-set-tab-label
- notebook
- (if (typep reference 'widget)
- reference
- (notebook-nth-page-child notebook reference))
- tab-label-widget)
- tab-label-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))
+
+; (defbinding %notebook-set-tab-label () nil
+; (notebook notebook)
+; (reference widget)
+; (tab-label widget))
+
+; (defun (setf notebook-tab-label) (tab-label notebook reference)
+; (let ((tab-label-widget (if (stringp tab-label)
+; (label-new tab-label)
+; tab-label)))
+; (%notebook-set-tab-label
+; notebook
+; (if (typep reference 'widget)
+; reference
+; (notebook-nth-page-child notebook reference))
+; tab-label-widget)
+; tab-label-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))
-
-(defbinding %notebook-set-menu-label () nil
- (notebook notebook)
- (reference widget)
- (menu-label widget))
-
-(defun (setf notebook-menu-label) (menu-label notebook reference)
- (let ((menu-label-widget (if (stringp menu-label)
- (label-new menu-label)
- menu-label)))
- (%notebook-set-menu-label
- notebook
- (if (typep reference 'widget)
- reference
- (notebook-nth-page-child notebook reference))
- menu-label-widget)
- menu-label-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))
+
+; (defbinding %notebook-set-menu-label () nil
+; (notebook notebook)
+; (reference widget)
+; (menu-label widget))
+
+; (defun (setf notebook-menu-label) (menu-label notebook reference)
+; (let ((menu-label-widget (if (stringp menu-label)
+; (label-new menu-label)
+; menu-label)))
+; (%notebook-set-menu-label
+; notebook
+; (if (typep reference 'widget)
+; reference
+; (notebook-nth-page-child notebook reference))
+; menu-label-widget)
+; menu-label-widget))
(defbinding notebook-query-tab-label-packing (notebook ref) nil
(notebook notebook)
(width int)
(height int))
-;; gtkglue.c
(defbinding layout-get-size () nil
(layout layout)
(width int :out)
(height int :out))
-(defun layout-x-size (layout)
- (nth-value 0 (layout-get-size layout)))
-
-(defun layout-y-size (layout)
- (nth-value 1 (layout-get-size layout)))
-
-(defun (setf layout-x-size) (x layout)
- (layout-set-size layout x (layout-y-size layout)))
-
-(defun (setf layout-y-size) (y layout)
- (layout-set-size layout (layout-x-size layout) y))
-
-(defbinding layout-freeze () nil
- (layout layout))
-
-(defbinding layout-thaw () nil
- (layout layout))
-
;;; Menu shell
; ;;; Menu
-; (defun menu-insert (menu menu-item position)
-; (menu-shell-insert menu menu-item position))
-
-; (defun menu-append (menu menu-item)
-; (menu-shell-append menu menu-item))
-
-; (defun menu-prepend (menu menu-item)
-; (menu-shell-prepend menu menu-item))
-
;(defun menu-popup ...)
(defbinding menu-reposition () nil
(defbinding menu-popdown () nil
(menu menu))
-(defbinding (menu-active "gtk_menu_get_active") () widget
- (menu menu))
-
(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 ...)
-
-(defbinding menu-detach () nil
- (menu menu))
-
-(defbinding (menu-attach-widget "gtk_menu_get_attach_widget") () widget
- (menu menu))
-
(defbinding menu-reorder-child () nil
(menu menu)
(menu-item menu-item)
(x-padding unsigned-int)
(y-padding unsigned-int))
+
(defbinding %table-set-row-spacing () nil
(table table)
(row unsigned-int)
(spacing unsigned-int))
-(defun (setf table-row-spacing) (spacing table row)
- (%table-set-row-spacing table row spacing)
+(defbinding %table-set-row-spacings () nil
+ (table table)
+ (spacing unsigned-int))
+
+(defun (setf table-row-spacing) (spacing table &optional row)
+ (if row
+ (%table-set-row-spacing table row spacing)
+ (%table-set-row-spacings table spacing))
spacing)
-;; gtkglue.c
-(defbinding table-row-spacing (table row) unsigned-int
+(defbinding %table-get-row-spacing () unsigned-int
(table table)
- ((progn
- (assert (and (>= row 0) (< row (table-rows table))))
- row) unsigned-int))
+ (row unsigned-int))
+
+(defbinding %table-get-default-row-spacing () unsigned-int
+ (table table))
+
+(defun table-row-spacing (table &optional row)
+ (if row
+ (%table-get-row-spacing table row)
+ (%table-get-default-row-spacing table)))
+
(defbinding %table-set-col-spacing () nil
(table table)
(col unsigned-int)
(spacing unsigned-int))
-(defun (setf table-column-spacing) (spacing table column)
- (%table-set-col-spacing table column spacing)
+(defbinding %table-set-col-spacings () nil
+ (table table)
+ (spacing unsigned-int))
+
+(defun (setf table-col-spacing) (spacing table &optional col)
+ (if col
+ (%table-set-col-spacing table col spacing)
+ (%table-set-col-spacings table spacing))
spacing)
-;; gtkglue.c
-(defbinding table-column-spacing (table col) unsigned-int
+(defbinding %table-get-col-spacing () unsigned-int
(table table)
- ((progn
- (assert (and (>= col 0) (< col (table-columns table))))
- col) unsigned-int))
+ (col unsigned-int))
+(defbinding %table-get-default-col-spacing () unsigned-int
+ (table table))
-(defun %set-table-child-option (object slot flag value)
- (let ((options (child-slot-value object slot)))
- (cond
- ((and value (not (member flag options)))
- (setf (child-slot-value object slot) (cons flag options)))
- ((and (not value) (member flag options))
- (setf (child-slot-value object slot) (delete flag options))))))
-
-(macrolet ((define-option-accessor (name slot flag)
- `(progn
- (defun ,name (object)
- (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)
- (define-option-accessor table-child-y-expand-p :y-options :expand)
- (define-option-accessor table-child-x-shrink-p :x-options :shrink)
- (define-option-accessor table-child-y-shrink-p :y-options :shrink)
- (define-option-accessor table-child-x-fill-p :x-options :fill)
- (define-option-accessor table-child-y-fill-p :y-options :fill))
-
+(defun table-col-spacing (table &optional col)
+ (if col
+ (%table-get-col-spacing table col)
+ (%table-get-default-col-spacing table)))
+
;;; Toolbar
-;;; Calendar
-
-(defbinding calendar-select-month () int
- (calendar calendar)
- (month unsigned-int)
- (year unsigned-int))
-
-(defbinding calendar-select-day () nil
- (calendar calendar)
- (day unsigned-int))
-
-(defbinding calendar-mark-day () int
- (calendar calendar)
- (day unsigned-int))
-
-(defbinding calendar-unmark-day () int
- (calendar calendar)
- (day unsigned-int))
-
-(defbinding calendar-clear-marks () nil
- (calendar calendar))
-
-(defbinding calendar-display-options () nil
- (calendar calendar)
- (options calendar-display-options))
-
-(defbinding (calendar-date "gtk_calendar_get_date") () nil
- (calendar calendar)
- (year unsigned-int :out)
- (month unsigned-int :out)
- (day unsigned-int :out))
-
-(defbinding calendar-freeze () nil
- (calendar calendar))
-
-(defbinding calendar-thaw () nil
- (calendar calendar))
-
-
-
-;;; Drawing area
-
-; (defbinding ("gtk_drawing_area_size" %drawing-area-set-size) () nil
-; (drawing-area drawing-area)
-; (width int)
-; (height int))
-; (defun (setf drawing-area-size) (size drawing-area)
-; (%drawing-area-set-size drawing-area (svref size 0) (svref size 1))
-; (values (svref size 0) (svref size 1)))
-
-; ;; gtkglue.c
-; (defbinding ("gtk_drawing_area_get_size" drawing-area-size) () nil
-; (drawing-area drawing-area)
-; (width int :out)
-; (height int :out))
;;; Scale
-(defbinding scale-draw-value () nil
- (scale scale))
-
-
-
-;;; 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))
-
-(defbinding (progress-percentage-from-value
- "gtk_progress_get_percentage_from_value") () single-float
- (progress progress))
+; (defbinding scale-draw-value () nil
+; (scale scale))
-;;; Adjustment
-
-(defbinding adjustment-changed () nil
- (adjustment adjustment))
-
-(defbinding adjustment-value-changed () nil
- (adjustment adjustment))
-
-(defbinding adjustment-clamp-page () nil
- (adjustment adjustment)
- (lower single-float)
- (upper single-float))
-
;;; Tooltips
(defbinding tooltips-disable () nil
(tooltips tooltips))
+(defun (setf tooltips-enabled-p) (enable tooltips)
+ (if enable
+ (tooltips-enable tooltips)
+ (tooltips-disable tooltips)))
+
(defbinding tooltips-set-tip () nil
(tooltips tooltips)
(widget widget)
(tip-text string)
(tip-private string))
-(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))
((gdk:keyval-from-name key) unsigned-int)
(modifiers gdk:modifier-type))
|#
-
-
-;;; Style
-
-; (defbinding style-new () style)
-
-; (defbinding style-copy () style
-; (style style))
-#|
-(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)
-; (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)
-; (window gdk:window)
-; (state state-type)
-; (shadow shadow-type)
-; (x int)
-; (y int)
-; (width int)
-; (height int))
-
-(defbinding draw-string () nil
- (style style)
- (window gdk:window)
- (state state-type)
- (x int)
- (y int)
- (string string))
-
-(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)
-; (window gdk:window)
-; (state state-type)
-; (shadow shadow-type)
-; (x int)
-; (y int)
-; (width int)
-; (height int))
-
-; (defbinding draw-ramp () nil
-; (style style)
-; (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))
~mdw / clg / blobdiff