X-Git-Url: https://git.distorted.org.uk/~mdw/clg/blobdiff_plain/a60bd055f636fff2af1e58145b6dacea92115400..29f703048f655d6027506a94a38d8392fc1866e4:/gtk/gtk.lisp diff --git a/gtk/gtk.lisp b/gtk/gtk.lisp index 717e05d..a380f85 100644 --- a/gtk/gtk.lisp +++ b/gtk/gtk.lisp @@ -15,7 +15,7 @@ ;; 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.7 2001/11/12 22:34:28 espen Exp $ (in-package "GTK") @@ -39,15 +39,10 @@ (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 @@ -56,33 +51,88 @@ (accel-label accel-label)) +;;; Adjustment -;;; Bin +(defbinding adjustment-changed () nil + (adjustment adjustment)) -(defun bin-child (bin) - (first (container-children bin))) +(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 + + + +;;; 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 @@ -104,25 +154,253 @@ +;;; 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 initialize-instance ((dialog dialog) &rest initargs) + (apply #'call-next-method dialog (plist-remove initargs :child)) + (dolist (button-definition (get-all initargs :button)) + (apply #'dialog-add-button dialog button-definition)) + (dolist (child (get-all initargs :child)) + (apply #'dialog-add-child dialog (mklist child)))) + + +(defvar %*response-id-key* (gensym)) + +(defun %dialog-find-response-id-num (dialog response-id create-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))) + (t + (error "Invalid response id: ~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) + (case signal + (response + #'(lambda (dialog response-id-num) + (let ((response-id (%dialog-find-response-id dialog response-id-num))) + (cond + ((eq object t) (funcall function dialog response-id)) + (object (funcall function object response-id)) + (t (funcall function response-id)))))) + (t + (call-next-method)))) + + +(defbinding dialog-response (dialog response-id) nil + (dialog dialog) + ((%dialog-find-response-id-num dialog response-id nil) int)) + +(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))) + +(defbinding dialog-set-response-sensitive (dialog response-id sensitive) nil + (dialog dialog) + ((%dialog-find-response-id-num dialog response-id nil) int) + (sensitive boolean)) + + +(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)) + + +(defun dialog-add-child (dialog child &rest args) + (apply #'container-add (slot-value dialog 'vbox) child args)) + +(defmethod container-children ((dialog dialog)) + (container-children (dialog-vbox dialog))) + +(defmethod (setf container-children) (children (dialog dialog)) + (setf (container-children (dialog-vbox 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 @@ -133,11 +411,13 @@ "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 @@ -191,24 +471,6 @@ (%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)) @@ -218,22 +480,11 @@ (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 @@ -245,10 +496,11 @@ (%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))) @@ -297,12 +549,6 @@ (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 @@ -317,121 +563,14 @@ -;;; 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)) @@ -533,55 +672,55 @@ (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) @@ -664,30 +803,11 @@ (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 @@ -737,15 +857,6 @@ ; ;;; 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 @@ -754,9 +865,6 @@ (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)) @@ -764,14 +872,6 @@ (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) @@ -800,60 +900,62 @@ (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 @@ -965,63 +1067,8 @@ -;;; 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)) @@ -1176,26 +1223,8 @@ ;;; 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)) @@ -1206,19 +1235,6 @@ -;;; 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 @@ -1229,17 +1245,17 @@ (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)) @@ -1357,291 +1373,3 @@ ((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))