X-Git-Url: https://git.distorted.org.uk/~mdw/clg/blobdiff_plain/14eaa563872280feb58a39027fbb35c0ea4b4b70..1239e395b06382bac5150314c14e733f3da5a65d:/gtk/gtk.lisp diff --git a/gtk/gtk.lisp b/gtk/gtk.lisp index f8baf82..c337d48 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.28 2004/12/29 21:17:36 espen Exp $ +;; $Id: gtk.lisp,v 1.33 2005/02/04 13:15:15 espen Exp $ (in-package "GTK") @@ -56,15 +56,115 @@ (gtk-init) (prog1 (gdk:display-open display) - (system:add-fd-handler - (gdk:display-connection-number) :input #'main-iterate-all) - (setq lisp::*periodic-polling-function* #'main-iterate-all) - (setq lisp::*max-event-to-sec* 0) - (setq lisp::*max-event-to-usec* 1000)))) + (add-fd-handler (gdk:display-connection-number) :input #'main-iterate-all) + (setq *periodic-polling-function* #'main-iterate-all) + (setq *max-event-to-sec* 0) + (setq *max-event-to-usec* 1000)))) + + +;;; About dialog + +#+gtk2.6 +(progn + (def-callback-marshal %about-dialog-activate-link-func + (nil (dialog about-dialog) (link (copy-of string)))) + + (defbinding about-dialog-set-email-hook (function) nil + ((callback %about-dialog-activate-link-func) pointer) + ((register-callback-function function) unsigned-int) + ((callback user-data-destroy-func) pointer)) + + (defbinding about-dialog-set-url-hook (function) nil + ((callback %about-dialog-activate-link-func) pointer) + ((register-callback-function function) unsigned-int) + ((callback user-data-destroy-func) pointer))) ;;; Acccel group +(defbinding %accel-group-connect () nil + (accel-group accel-group) + (key unsigned-int) + (modifiers gdk:modifier-type) + (flags accel-flags) + (gclosure gclosure)) + +(defun accel-group-connect (group accelerator function &optional flags) + (multiple-value-bind (key modifiers) (accelerator-parse accelerator) + (let ((gclosure (make-callback-closure function))) + (%accel-group-connect group key modifiers flags gclosure) + gclosure))) + +(defbinding accel-group-connect-by-path (group path function) nil + (group accel-group) + (path string) + ((make-callback-closure function) gclosure :return)) + +(defbinding %accel-group-disconnect (group gclosure) boolean + (group accel-group) + (gclosure gclosure)) + +(defbinding %accel-group-disconnect-key () boolean + (group accel-group) + (key unsigned-int) + (modifiers gdk:modifier-type)) + +(defun accel-group-disconnect (group accelerator) + (etypecase accelerator + (gclosure (%accel-group-disconnect group accelerator)) + (string + (multiple-value-bind (key modifiers) (accelerator-parse accelerator) + (%accel-group-disconnect-key group key modifiers))))) + +(defbinding accel-group-lock () nil + (accel-group accel-group)) + +(defbinding accel-group-unlock () nil + (accel-group accel-group)) + +(defbinding %accel-groups-activate () boolean + (object gobject) + (key unsigned-int) + (modifiers gdk:modifier-type)) + +(defun accel-groups-activate (object accelerator) + (multiple-value-bind (key modifiers) (accelerator-parse accelerator) + (%accel-groups-activate object key modifiers))) + +(defbinding accel-groups-from-object () (gslist accel-groups) + (object gobject)) + +(defbinding accelerator-valid-p (key &optional modifiers) boolean + (key unsigned-int) + (modifiers gdk:modifier-type)) + +(defbinding %accelerator-parse () nil + (accelerator string) + (key unsigned-int :out) + (modifiers gdk:modifier-type :out)) + +(defun accelerator-parse (accelerator) + (multiple-value-bind (key modifiers) (%accelerator-parse accelerator) + (if (zerop key) + (error "Invalid accelerator: ~A" accelerator) + (values key modifiers)))) + +(defbinding accelerator-name () string + (key unsigned-int) + (modifiers gdk:modifier-type)) + +#+gtk2.6 +(defbinding accelerator-get-label () string + (key unsigned-int) + (modifiers gdk:modifier-type)) + +(defbinding %accelerator-set-default-mod-mask () nil + (default-modifiers gdk:modifier-type)) + +(defun (setf accelerator-default-modifier-mask) (default-modifiers) + (%accelerator-set-default-mod-mask default-modifiers)) + +(defbinding (accelerator-default-modifier-mask "gtk_accelerator_get_default_mod_mask") () gdk:modifier-type) ;;; Acccel label @@ -73,6 +173,48 @@ (accel-label accel-label)) + +;;; Accel map + +(defbinding %accel-map-add-entry () nil + (path string) + (key unsigned-int) + (modifiers gdk:modifier-type)) + +(defun accel-map-add-entry (path accelerator) + (multiple-value-bind (key modifiers) (accelerator-parse accelerator) + (%accel-map-add-entry path key modifiers))) + +(defbinding accel-map-lookup-entry () boolean + (path string) + (key pointer)) ;accel-key)) + +(defbinding %accel-map-change-entry () boolean + (path string) + (key unsigned-int) + (modifiers gdk:modifier-type) + (replace boolean)) + +(defun accel-map-change-entry (path accelerator &optional replace) + (multiple-value-bind (key modifiers) (accelerator-parse accelerator) + (%accel-map-change-entry path key modifiers replace))) + +(defbinding accel-map-load () nil + (filename pathname)) + +(defbinding accel-map-save () nil + (filename pathname)) + +(defbinding accel-map-get () accel-map) + +(defbinding accel-map-lock-path () nil + (path string)) + +(defbinding accel-map-unlock-path () nil + (path string)) + + + ;;; Accessible (defbinding accessible-connect-widget-destroyed () nil @@ -102,6 +244,30 @@ (upper single-float)) +;;; Alignment + +(defbinding alignment-set () nil + (alognment alignment) + (x-align single-float) + (y-align single-float) + (x-scale single-float) + (y-scale single-float)) + +(defbinding alignment-get-padding () nil + (alognment alignment) + (top unsigned-int :out) + (bottom unsigned-int :out) + (left unsigned-int :out) + (right unsigned-int :out)) + +(defbinding alignment-set-padding () nil + (alognment alignment) + (top unsigned-int) + (bottom unsigned-int) + (left unsigned-int) + (right unsigned-int)) + + ;;; Aspect frame @@ -113,9 +279,11 @@ (container-add bin child) child) - -;;; Binding - +(defmethod create-callback-function ((bin bin) function arg1) + (if (eq arg1 :child) + #'(lambda (&rest args) + (apply function (bin-child bin) (rest args))) + (call-next-method))) ;;; Box @@ -228,10 +396,6 @@ (check-menu-item check-menu-item)) - -;;; Clipboard - - ;;; Color selection (defbinding (color-selection-is-adjusting-p @@ -419,8 +583,8 @@ (sensitive boolean)) #+gtk2.6 -(defbinding alternative-dialog-button-order-p(&optional screen) - (screen (or null screen))) +(defbinding alternative-dialog-button-order-p (&optional screen) boolean + (screen (or null gdk:screen))) #+gtk2.6 (defbinding (dialog-set-alternative-button-order @@ -471,7 +635,7 @@ (completion entry-completion) ((callback %entry-completion-match-func) pointer) ((register-callback-function function) unsigned-int) - ((callback %destroy-user-data) pointer)) + ((callback user-data-destroy-func) pointer)) (defbinding entry-completion-complete () nil (completion entry-completion)) @@ -495,6 +659,137 @@ (index int)) +;;; File Chooser + +(defmethod initialize-instance ((file-chooser file-chooser) &rest initargs + &key filter filters shortcut-folder + shortcut-folders shortcut-folder-uti + shortcut-folder-uris) + (declare (ignore filter filters shortcut-folder shortcut-folders + shortcut-folder-uti shortcut-folder-uris)) + (prog1 + (call-next-method) + (initial-add file-chooser #'file-chooser-add-filter + initargs :filer :filters) + (initial-add file-chooser #'file-chooser-add-shortcut-folder + initargs :shortcut-folder :shortcut-folders) + (initial-add file-chooser #'file-chooser-add-shortcut-folder-uri + initargs :shortcut-folder-uri :shortcut-folders-uris))) + + +(defbinding file-chooser-select-filename () boolean + (file-chooser file-chooser) + (filename string)) + +(defbinding file-chooser-unselect-filename () nil + (file-chooser file-chooser) + (filename string)) + +(defbinding file-chooser-select-all () boolean + (file-chooser file-chooser)) + +(defbinding file-chooser-unselect-all () boolean + (file-chooser file-chooser)) + +(defbinding file-chooser-get-filenames () (gslist string) + (file-chooser file-chooser)) + +(defbinding file-chooser-select-uri () boolean + (file-chooser file-chooser) + (uri string)) + +(defbinding file-chooser-unselect-uri () nil + (file-chooser file-chooser) + (uri string)) + +(defbinding file-chooser-get-uris () (gslist string) + (file-chooser file-chooser)) + +(defbinding file-chooser-add-filter () nil + (file-chooser file-chooser) + (filter file-filter)) + +(defbinding file-chooser-remove-filter () nil + (file-chooser file-chooser) + (filter file-filter)) + +(defbinding file-chooser-list-filters () (gslist file-filter) + (file-chooser file-chooser)) + +(defbinding file-chooser-add-shortcut-folder () boolean + (file-chooser file-chooser) + (folder string) + (nil null)) + +(defbinding file-chooser-remove-shortcut-folder () nil + (file-chooser file-chooser) + (folder string) + (nil null)) + +(defbinding file-chooser-list-shortcut-folders () (gslist string) + (file-chooser file-chooser)) + +(defbinding file-chooser-add-shortcut-folder-uri () boolean + (file-chooser file-chooser) + (uri string) + (nil null)) + +(defbinding file-chooser-remove-shortcut-folder-uri () nil + (file-chooser file-chooser) + (uri string) + (nil null)) + +(defbinding file-chooser-list-shortcut-folder-uris () (gslist string) + (file-chooser file-chooser)) + + +;;; File Filter + +(defmethod initialize-instance ((file-filter file-filter) &rest initargs + &key mime-type mime-types pattern patterns + pixbuf-formats) + (declare (ignore mime-type mime-types pattern patterns)) + (prog1 + (call-next-method) + (when pixbuf-formats + #-gtk2.6(warn "Initarg :PIXBUF-FORMATS not supportet in this version of Gtk") + #+gtk2.6(file-filter-add-pixbuf-formats file-filter)) + (initial-add file-filter #'file-filter-add-mime-type + initargs :mime-type :mime-types) + (initial-add file-filter #'file-filter-add-pattern + initargs :pattern :patterns))) + + +(defbinding file-filter-add-mime-type () nil + (filter file-filter) + (mime-type string)) + +(defbinding file-filter-add-pattern () nil + (filter file-filter) + (pattern string)) + +#+gtk2.6 +(defbinding file-filter-add-pixbuf-formats () nil + (filter file-filter)) + +(def-callback-marshal %file-filter-func (boolean file-filter-info)) + +(defbinding file-filter-add-custom (filter needed function) nil + (filter file-filter) + (needed file-filter-flags) + ((callback %file-filter-func) pointer) + ((register-callback-function function) unsigned-int) + ((callback user-data-destroy-func) pointer)) + +(defbinding file-filter-get-needed () file-filter-flags + (filter file-filter)) + +(defbinding file-filter-filter () boolean + (filter file-filter) + (filter-info file-filter-info)) + + + ;;; Image (defbinding image-set-from-file () nil @@ -517,7 +812,7 @@ (image-set-from-file image file))) ((call-next-method)))) -(defun create-image (source &optional mask) +(defun create-image-widget (source &optional mask) (etypecase source (gdk:pixbuf (make-instance 'image :pixbuf source)) (string (make-instance 'image :stock source)) @@ -530,7 +825,7 @@ (defmethod initialize-instance ((item image-menu-item) &rest initargs &key image) (if (and image (not (typep image 'widget))) - (apply #'call-next-method item :image (create-image image) initargs) + (apply #'call-next-method item :image (create-image-widget image) initargs) (call-next-method))) @@ -538,7 +833,7 @@ (setf (slot-value item 'image) widget)) (defmethod (setf image-menu-item-image) (image (item image-menu-item)) - (setf (image-menu-item-image item) (create-image image))) + (setf (image-menu-item-image item) (create-image-widget image))) ;;; Label @@ -569,16 +864,15 @@ (radio-button radio-button) (group pointer)) -(defun radio-button-add-to-group (button1 button2) +(defmethod add-to-radio-group ((button1 radio-button) (button2 radio-button)) "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) &key group) (prog1 (call-next-method) (when group - (radio-button-add-to-group button group)))) + (add-to-radio-group button group)))) ;;; Item @@ -643,7 +937,7 @@ ;;; Menu tool button #+gtk2.6 -(defbinding menu-tool-button-set-arrow-tip () nil +(defbinding menu-tool-button-set-arrow-tooltip () nil (menu-tool-button menu-tool-button) (tooltips tooltips) (tip-text string) @@ -702,7 +996,7 @@ (radio-menu-item radio-menu-item) (group pointer)) -(defun radio-menu-item-add-to-group (item1 item2) +(defmethod add-to-radio-group ((item1 radio-menu-item) (item2 radio-menu-item)) "Add ITEM1 to the group which ITEM2 belongs to." (%radio-menu-item-set-group item1 (%radio-menu-item-get-group item2))) @@ -710,7 +1004,8 @@ (prog1 (call-next-method) (when group - (radio-menu-item-add-to-group item group)))) + (add-to-radio-group item group)))) + ;;; Radio tool button @@ -722,16 +1017,29 @@ (radio-tool-button radio-tool-button) (group pointer)) -(defun radio-tool-button-add-to-group (button1 button2) +(defmethod add-to-radio-group ((button1 radio-tool-button) (button2 radio-tool-button)) "Add BUTTON1 to the group which BUTTON2 belongs to." (%radio-tool-button-set-group button1 (%radio-tool-button-get-group button2))) +(defmethod add-activate-callback ((widget widget) function &key object after) + (if object + (signal-connect widget 'clicked + #'(lambda (object) + (when (slot-value widget 'active) + (funcall function object (slot-value widget 'value)))) + :object object :after after) + (signal-connect widget 'clicked + #'(lambda () + (when (slot-value widget 'active) + (funcall function (slot-value widget 'value)))) + :after after))) (defmethod initialize-instance ((button radio-tool-button) &key group) (prog1 (call-next-method) (when group - (radio-tool-button-add-to-group button group)))) + (add-to-radio-group button group)))) + ;;; Toggle button @@ -1071,20 +1379,15 @@ ;;; Notebook -(defun %notebook-position (notebook page) +(defun %ensure-notebook-position (notebook page) (etypecase page - (int page) - (keyword (case page - (:first 0) - (:last -1) - (t (error "Invalid position keyword: ~A" page)))) + (position page) (widget (notebook-page-num notebook page t)))) -(defun %notebook-child (notebook position) +(defun %ensure-notebook-child (notebook position) (typecase position (widget position) - (t (notebook-nth-page-child notebook position)))) - + (t (notebook-get-nth-page notebook position)))) (defbinding (notebook-insert "gtk_notebook_insert_page_menu") (notebook position child tab-label &optional menu-label) nil @@ -1096,7 +1399,7 @@ ((if (stringp menu-label) (make-instance 'label :label menu-label) menu-label) (or null widget)) - ((%notebook-position notebook position) int)) + ((%ensure-notebook-position notebook position) position)) (defun notebook-append (notebook child tab-label &optional menu-label) (notebook-insert notebook :last child tab-label menu-label)) @@ -1106,7 +1409,7 @@ (defbinding notebook-remove-page (notebook page) nil (notebook notebook) - ((%notebook-position notebook page) int)) + ((%ensure-notebook-position notebook page) position)) (defbinding %notebook-page-num () int (notebook notebook) @@ -1116,7 +1419,7 @@ (let ((page-num (%notebook-page-num notebook child))) (if (= page-num -1) (when error-p - (error "~A is not a child of ~A" child notebook)) + (error "~A is not a page in ~A" child notebook)) page-num))) (defbinding notebook-next-page () nil @@ -1136,46 +1439,26 @@ (defbinding notebook-popup-disable () nil (notebook notebook)) -(defbinding (notebook-nth-page-child "gtk_notebook_get_nth_page") - (notebook page) widget +(defbinding notebook-get-nth-page () widget (notebook notebook) - ((case page - (:first 0) - (:last -1) - (t page)) int)) + (page position)) - -(defbinding %notebook-get-current-page () int - (notebook notebook)) - -(defun notebook-current-page-num (notebook) - (let ((num (%notebook-get-current-page notebook))) - (when (>= num 0) - num))) - -(defun notebook-current-page (notebook) - (let ((page-num (notebook-current-page-num notebook))) - (when page-num - (notebook-nth-page-child notebook page-num)))) - -(defbinding %notebook-set-current-page () nil - (notebook notebook) - (page-num int)) +(defun %notebook-current-page (notebook) + (when (slot-boundp notebook 'current-page-num) + (notebook-get-nth-page notebook (notebook-current-page-num notebook)))) (defun (setf notebook-current-page) (page notebook) - (%notebook-set-current-page notebook (%notebook-position notebook page)) - page) - + (setf (notebook-current-page notebook) (notebook-page-num notebook page))) (defbinding (notebook-tab-label "gtk_notebook_get_tab_label") (notebook page) widget (notebook notebook) - ((%notebook-child notebook page) widget)) + ((%ensure-notebook-child notebook page) widget)) (defbinding (notebook-tab-label-text "gtk_notebook_get_tab_label_text") (notebook page) (copy-of string) (notebook notebook) - ((%notebook-child notebook page) widget)) + ((%ensure-notebook-child notebook page) widget)) (defbinding %notebook-set-tab-label () nil (notebook notebook) @@ -1186,19 +1469,19 @@ (let ((widget (if (stringp tab-label) (make-instance 'label :label tab-label) tab-label))) - (%notebook-set-tab-label notebook (%notebook-child notebook page) widget) + (%notebook-set-tab-label notebook (%ensure-notebook-child notebook page) widget) widget)) (defbinding (notebook-menu-label "gtk_notebook_get_menu_label") (notebook page) widget (notebook notebook) - ((%notebook-child notebook page) widget)) + ((%ensure-notebook-child notebook page) widget)) (defbinding (notebook-menu-label-text "gtk_notebook_get_menu_label_text") (notebook page) (copy-of string) (notebook notebook) - ((%notebook-child notebook page) widget)) + ((%ensure-notebook-child notebook page) widget)) (defbinding %notebook-set-menu-label () nil (notebook notebook) @@ -1209,7 +1492,7 @@ (let ((widget (if (stringp menu-label) (make-instance 'label :label menu-label) menu-label))) - (%notebook-set-menu-label notebook (%notebook-child notebook page) widget) + (%notebook-set-menu-label notebook (%ensure-notebook-child notebook page) widget) widget)) @@ -1249,16 +1532,25 @@ (defbinding layout-put () nil (layout layout) - (widget widget) + (child widget) (x int) (y int)) (defbinding layout-move () nil (layout layout) - (widget widget) + (child widget) (x int) (y int)) +(defbinding layout-set-size () nil + (layout layout) + (width unsigned-int) + (height unsigned-int)) + +(defbinding layout-get-size () nil + (layout layout) + (width unsigned-int :out) + (height unsigned-int :out)) ;;; Menu shell @@ -1475,119 +1767,83 @@ ;;; Toolbar -(defbinding %toolbar-insert-element () widget - (toolbar toolbar) - (type toolbar-child-type) - (widget (or null widget)) - (text string) - (tooltip-text string) - (tooltip-private-text string) - (icon (or null widget)) - (nil null) - (nil null) - (position int)) +(defmethod initialize-instance ((toolbar toolbar) &rest initargs &key tooltips) + (if (eq tooltips t) + (apply #'call-next-method toolbar + :tooltips (make-instance 'tooltips) initargs) + (call-next-method))) -(defbinding %toolbar-insert-stock () widget +(defbinding %toolbar-insert () nil (toolbar toolbar) - (stock-id string) - (tooltip-text string) - (tooltip-private-text string) - (nil null) - (nil null) - (position int)) - -(defun toolbar-insert (toolbar position element - &key tooltip-text tooltip-private-text - type icon group callback object) - (let* ((numpos (case position - (:first -1) - (:last 0) - (t position))) - (widget - (cond - ((or - (eq type :space) - (and (not type) (eq element :space))) - (%toolbar-insert-element - toolbar :space nil nil - tooltip-text tooltip-private-text nil numpos)) - ((or - (eq type :widget) - (and (not type) (typep element 'widget))) - (%toolbar-insert-element - toolbar :widget element nil - tooltip-text tooltip-private-text nil numpos)) - ((or - (eq type :stock) - (and - (not type) - (typep element 'string) - (stock-lookup element))) - (%toolbar-insert-stock - toolbar element tooltip-text tooltip-private-text numpos)) - ((typep element 'string) - (%toolbar-insert-element - toolbar (or type :button) (when (eq type :radio-button) group) - element tooltip-text tooltip-private-text - (etypecase icon - (null nil) - (widget icon) - (string (make-instance 'image :stock icon)) - (pathname (make-instance 'image :file icon)) - ((or list vector) - (make-instance 'image - :pixmap icon ; :icon-size (toolbar-icon-size toolbar) - ))) - numpos)) - ((error "Invalid element type: ~A" element))))) - (when callback - (signal-connect widget 'clicked callback :object object)) - widget)) - -(defun toolbar-append (toolbar element &key tooltip-text tooltip-private-text - type icon group callback object) - (toolbar-insert - toolbar :first element :type type :icon icon :group group - :tooltip-text tooltip-text :tooltip-private-text tooltip-private-text - :callback callback :object object)) + (tool-item tool-item) + (position position)) -(defun toolbar-prepend (toolbar element &key tooltip-text tooltip-private-text - type icon group callback object) - (toolbar-insert - toolbar :last element :type type :icon icon :group group - :tooltip-text tooltip-text :tooltip-private-text tooltip-private-text - :callback callback :object object)) +(defun toolbar-insert (toolbar tool-item &optional (position :end)) + (%toolbar-insert toolbar tool-item position) + (%tool-item-update-tooltips tool-item)) +(defbinding toolbar-get-item-index () int + (toolbar toolbar) + (item tool-item)) -(defun toolbar-insert-space (toolbar position) - (toolbar-insert toolbar position :space)) +(defbinding toolbar-get-nth-item () tool-item + (toolbar toolbar) + (n int)) -(defun toolbar-append-space (toolbar) - (toolbar-append toolbar :space)) +(defbinding toolbar-get-drop-index () int + (toolbar toolbar) + (x int) (y int)) -(defun toolbar-prepend-space (toolbar) - (toolbar-prepend toolbar :space)) +(defbinding toolbar-set-drop-highlight-item () nil + (toolbar toolbar) + (tool-item tool-item) + (index int)) -(defun toolbar-enable-tooltips (toolbar) - (setf (toolbar-tooltips-p toolbar) t)) +;;; Tool button -(defun toolbar-disable-tooltips (toolbar) - (setf (toolbar-tooltips-p toolbar) nil)) +(defmethod initialize-instance ((button tool-button) &rest initargs &key icon) + (if (and icon (not (typep icon 'widget))) + (apply #'call-next-method button :icon (create-image-widget icon) initargs) + (call-next-method))) -(defbinding toolbar-remove-space () nil - (toolbar toolbar) - (position int)) +;;; Tool item -(defbinding toolbar-unset-icon-size () nil - (toolbar toolbar)) +(defbinding tool-item-set-tooltip () nil + (tool-item tool-item) + (tooltips tooltips) + (tip-text string) + (tip-private string)) -(defbinding toolbar-unset-style () nil - (toolbar toolbar)) +(defun %tool-item-update-tooltips (tool-item) + (when (and + (slot-boundp tool-item 'parent) + (or + (user-data-p tool-item 'tip-text) + (user-data-p tool-item 'tip-private))) + (tool-item-set-tooltip + tool-item (toolbar-tooltips (widget-parent tool-item)) + (or (user-data tool-item 'tip-text) "") + (or (user-data tool-item 'tip-private) "")))) + +(defmethod (setf tool-item-tip-text) ((tip-text string) (tool-item tool-item)) + (setf (user-data tool-item 'tip-text) tip-text) + (%tool-item-update-tooltips tool-item) + tip-text) + +(defmethod (setf tool-item-tip-private) ((tip-private string) (tool-item tool-item)) + (setf (user-data tool-item 'tip-private) tip-private) + (%tool-item-update-tooltips tool-item) + tip-private) + +(defmethod container-add ((toolbar toolbar) (tool-item tool-item) &rest args) + (declare (ignore args)) + (prog1 + (call-next-method) + (%tool-item-update-tooltips tool-item))) -;;; Tool item (defbinding tool-item-retrieve-proxy-menu-item () widget (tool-item tool-item)) @@ -1627,7 +1883,7 @@ (editable editable) (text string) ((length text) int) - (position editable-position :in-out)) + (position position-type :in-out)) (defun editable-append-text (editable text) (editable-insert-text editable text nil)) @@ -1708,11 +1964,12 @@ (position single-float) (max-size single-float)) -(defbinding ruler-draw-ticks () nil - (ruler ruler)) - -(defbinding ruler-draw-pos () nil - (ruler ruler)) +(defbinding ruler-get-range () nil + (ruler ruler) + (lower single-float :out) + (upper single-float :out) + (position single-float :out) + (max-size single-float :out)) @@ -1755,9 +2012,10 @@ ;;; Scale -; (defbinding scale-draw-value () nil -; (scale scale)) - +(defbinding scale-get-layout-offsets () nil + (scale scale) + (x int :out) + (y int :out)) ;;; Progress bar @@ -1865,84 +2123,3 @@ (defbinding rc-get-style () style (widget widget)) - - - -;;; Accelerator Groups -#| -(defbinding accel-group-activate (accel-group key modifiers) boolean - (accel-group accel-group) - ((gdk:keyval-from-name key) unsigned-int) - (modifiers gdk:modifier-type)) - -(defbinding accel-groups-activate (object key modifiers) boolean - (object object) - ((gdk:keyval-from-name key) unsigned-int) - (modifiers gdk:modifier-type)) - -(defbinding accel-group-attach () nil - (accel-group accel-group) - (object object)) - -(defbinding accel-group-detach () nil - (accel-group accel-group) - (object object)) - -(defbinding accel-group-lock () nil - (accel-group accel-group)) - -(defbinding accel-group-unlock () nil - (accel-group accel-group)) - - -;;; Accelerator Groups Entries - -(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)) - -(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)) - -(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)) - -(defbinding accel-group-add - (accel-group key modifiers flags object signal) nil - (accel-group accel-group) - ((gdk:keyval-from-name key) unsigned-int) - (modifiers gdk:modifier-type) - (flags accel-flags) - (object object) - ((name-to-string signal) string)) - -(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) - (object object)) - - -;;; Accelerator Signals - -(defbinding accel-group-handle-add - (object signal-id accel-group key modifiers flags) nil - (object object) - (signal-id unsigned-int) - (accel-group accel-group) - ((gdk:keyval-from-name key) unsigned-int) - (modifiers gdk:modifier-type) - (flags accel-flags)) - -(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)) -|#