X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~mdw/git/clg/blobdiff_plain/75689fea8b73ccc1e8cb32b671b7fd881da40cf3..72d9260f8258b525339c7241da0631ceaf9f3842:/gtk/gtktypes.lisp diff --git a/gtk/gtktypes.lisp b/gtk/gtktypes.lisp index 118b95a..2bd3f9b 100644 --- a/gtk/gtktypes.lisp +++ b/gtk/gtktypes.lisp @@ -20,7 +20,7 @@ ;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE ;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. -;; $Id: gtktypes.lisp,v 1.44 2006-02-26 15:30:01 espen Exp $ +;; $Id: gtktypes.lisp,v 1.65 2008-10-27 18:42:01 espen Exp $ (in-package "GTK") @@ -41,13 +41,13 @@ (defclass requisition (boxed) (defclass allocation (struct) ((x :allocation :alien - :accessor allocation-width + :accessor allocation-x :initarg :x :type int) (y :allocation :alien - :accessor allocation-width - :initarg :width + :accessor allocation-y + :initarg :y :type int) (width :allocation :alien @@ -84,6 +84,9 @@ (defclass border (boxed) :type int)) (:metaclass boxed-class)) +(eval-when (:compile-toplevel :load-toplevel :execute) + (register-type 'border '|gtk_border_get_type|)) + (defclass stock-item (struct) ((id :allocation :alien @@ -110,19 +113,16 @@ (defclass stock-item (struct) :accessor stock-item-translation-domain :initarg :translation-domain :type string)) - (:metaclass struct-class)) + (:metaclass struct-class) + (:ref stock-item-copy) + (:unref stock-item-free)) -;; We don't really need to access any slots in this class, so we just -;; specify the total size (defclass tree-iter (boxed) - ( -;; (stamp :allocation :alien :type int) -;; (user-data :allocation :alien :type pointer) -;; (user-data2 :allocation :alien :type pointer) -;; (user-data3 :allocation :alien :type pointer) - ) - (:metaclass boxed-class) - (:size #.(+ (size-of 'int) (* 3 (size-of 'pointer))))) + ((stamp :allocation :alien :type int) + (user-data :allocation :alien :type pointer) + (user-data2 :allocation :alien :type pointer) + (user-data3 :allocation :alien :type pointer)) + (:metaclass boxed-class)) ;; (defclass tree-path (boxed) @@ -136,19 +136,22 @@ (register-type 'tree-path '|gtk_tree_path_get_type|) (deftype position () '(or int (enum (:start 0) (:end -1) (:first 0) (:last -1)))) -(define-type-method from-alien-form ((type position) form) - (declare (ignore type)) +(define-type-method from-alien-form ((type position) form &key ref) + (declare (ignore type ref)) (from-alien-form 'int form)) -(define-type-method from-alien-function ((type position)) - (declare (ignore type)) +(define-type-method from-alien-function ((type position) &key ref) + (declare (ignore type ref)) (from-alien-function 'int)) -(define-type-method reader-function ((type position)) - (declare (ignore type)) +(define-type-method reader-function ((type position) &optional ref) + (declare (ignore type ref)) (reader-function 'int)) - +;; Register GtkObject in advance so that eg GtkTooltips, which inherits from it, +;; gets a proper supertype. TODO: This is a hack. Where is it supposed to +;; happen? +(register-type '%object "GtkObject") (define-types-by-introspection "Gtk" ;; Manually defined @@ -159,6 +162,8 @@ (define-types-by-introspection "Gtk" ("GtkTreePath" :ignore t) ; ("GtkStyle" :ignore t) + ("GtkMountOperation" :ignore t) ; Needs GIO + ;; Manual override ("GtkWidget" :slots @@ -228,21 +233,28 @@ (define-types-by-introspection "Gtk" (width-request :merge t :unbound -1) (height-request - :merge t :unbound -1))) + :merge t :unbound -1) + #?-(pkg-exists-p "gtk+-2.0" :atleast-version "2.12.0") + (tooltip-window + :allocation :virtual + :getter "gtk_widget_get_tooltip_window" + :setter "gtk_widget_set_tooltip_window" + :accessor widget-tooltip-window + :initarg :tooltip-window + :type window))) ("GtkContainer" :slots ((child :ignore t) (children :allocation :virtual - :getter container-children :setter (setf container-children) - ;; The following doesn't work because gtk_container_get_children doesn't - ;; increase the reference count of the children -; :getter "gtk_container_get_children" -; :reader container-children -; :type (glist widget) - ) + :getter "gtk_container_get_children" + :reader container-children + :type (glist (copy-of widget))) + (internal-children ; for debugging + :allocation :virtual + :getter container-internal-children) (child-type :allocation :virtual :getter "gtk_container_child_type" @@ -327,6 +339,7 @@ (default-widget :accessor window-mnemonic-modifier :initarg :mnemonic-modifier :type gdk:modifier-type) + #?-(pkg-exists-p "gtk+-2.0" :atleast-version "2.10.0") (transient-for :allocation :virtual :getter "gtk_window_get_transient_for" @@ -345,6 +358,7 @@ (default-width :merge t :unbound -1) (default-height :merge t :unbound -1))) ("GtkWindowGroup" + :dependencies (window) :slots ((grabs :allocation :alien @@ -380,6 +394,7 @@ (default-height :merge t :unbound -1))) :accessor menu-item-right-justified-p :initarg :right-justified :type boolean) + #?-(pkg-exists-p "gtk+-2.0" :atleast-version "2.12.0") (submenu :allocation :virtual :getter "gtk_menu_item_get_submenu" @@ -418,26 +433,26 @@ (default-height :merge t :unbound -1))) ("GtkScrolledWindow" :slots - (#-gtk2.8 + (#?-(pkg-exists-p "gtk+-2.0" :atleast-version "2.8.0") (hscrollbar :allocation :alien :reader scrolled-window-hscrollbar :type widget) - #-gtk2.8 + #?-(pkg-exists-p "gtk+-2.0" :atleast-version "2.8.0") (vscrollbar :allocation :alien :reader scrolled-window-vscrollbar :type widget) - #+gtk2.8 + #?(pkg-exists-p "gtk+-2.0" :atleast-version "2.8.0") (hscrollbar :allocation :virtual :getter "gtk_scrolled_window_get_hscrollbar" :reader scrolled-window-hscrollbar :type widget) - #+gtk2.8 + #?(pkg-exists-p "gtk+-2.0" :atleast-version "2.8.0") (vscrollbar :allocation :virtual - :getter "gtk_scrolled_window_get_hscrollbar" + :getter "gtk_scrolled_window_get_vscrollbar" :reader scrolled-window-vscrollbar :type widget))) @@ -486,7 +501,7 @@ (default-height :merge t :unbound -1))) :getter "gtk_menu_get_attach_widget" :reader menu-attach-widget :type widget) - #-gtk2.6 + #?-(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0") (tearoff-state :allocation :virtual :getter "gtk_menu_get_tearoff_state" @@ -495,10 +510,26 @@ (default-height :merge t :unbound -1))) :initarg :tearoff-state :type boolean))) - ("GtkToolbar" + ("GtkPlug" + :slots + ((id + :allocation :virtual + :getter "gtk_plug_get_id" + :reader plug-id + :type gdk:native-window))) + + ("GtkSocket" :slots - ((show-tooltips + ((id :allocation :virtual + :getter "gtk_socket_get_id" + :reader socket-id + :type gdk:native-window))) + + ("GtkToolbar" + :slots + ((show-tooltips ;; this slot is equivalent to the property + :allocation :virtual ;; "tooltips" in Gtk+ 2.8 :getter "gtk_toolbar_get_tooltips" :setter "gtk_toolbar_set_tooltips" :accessor toolbar-show-tooltips-p @@ -509,7 +540,7 @@ (default-height :merge t :unbound -1))) :getter "gtk_toolbar_get_tooltips_object" :reader toolbar-tooltips :type tooltips) - (toolbar-style + (toolbar-style ; defined manually to get the accesssor name correct :allocation :property :pname "toolbar-style" :initarg :toolbar-style @@ -551,7 +582,7 @@ (default-height :merge t :unbound -1))) ((active :allocation :virtual :getter "gtk_toggle_tool_button_get_active" - :setter "gtk_toggle_tool_button_get_active" + :setter "gtk_toggle_tool_button_set_active" :accessor toggle-tool-button-active-p :initarg :active :type boolean))) @@ -619,15 +650,11 @@ (default-height :merge t :unbound -1))) ("GtkTable" :slots ((column-spacing - :allocation :virtual - :getter "gtk_table_get_default_col_spacing" - :setter "gtk_table_set_col_spacings" + :allocation :property :pname "column-spacing" :initarg :column-spacing :type unsigned-int) (row-spacing - :allocation :virtual - :getter "gtk_table_get_default_row_spacing" - :setter "gtk_table_set_row_spacings" + :allocation :property :pname "row-spacing" :initarg :row-spacing :type unsigned-int))) @@ -659,8 +686,23 @@ (default-height :merge t :unbound -1))) :accessor entry-completion :type entry-completion) (max-length :merge t :unbound 0) - #+gtk2.6 - (width-chars :merge t :unbound -1))) + (alignment + :allocation :virtual + :getter "gtk_entry_get_alignment" + :setter "gtk_entry_set_alignment" + :initarg :alignment + :accessor entry-alignment + :type single-float) + #?(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0") + (width-chars :merge t :unbound -1) + #?(pkg-exists-p "gtk+-2.0" :atleast-version "2.12.0") + (cursor-adjustment + :allocation :virtual + :getter "gtk_entry_get_cursor_hadjustment" + :setter "gtk_entry_set_cursor_hadjustment" + :initarg :cursor-hadjustment + :accessor entry-cursor-hadjustment + :type adjustment))) ("GtkEntryCompletion" :slots @@ -670,8 +712,16 @@ (default-height :merge t :unbound -1))) :reader entry-completion-entry :type entry) (minimum-key-length :merge t :unbound -1) - #+gtk2.6 - (text-column :merge t :unbound -1))) + ;; Need to be manually defined, as this value through the property + ;; mechanism doesn't work + #?(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0") + (text-column + :allocation :virtual + :getter "gtk_entry_completion_get_text_column" + :setter "gtk_entry_completion_set_text_column" + :unbound -1 + :accessor entry-completion-text-column + :type int))) ("GtkRadioButton" :slots @@ -750,7 +800,7 @@ (default-height :merge t :unbound -1))) ("GtkImage" :slots ((file :ignore t) - #+gtk2.6 + #?(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0") (pixel-size :merge t :unbound -1))) ("GtkLabel" @@ -809,7 +859,7 @@ (default-height :merge t :unbound -1))) (current-folder :allocation :virtual :setter "gtk_file_chooser_set_current_folder" - :setter "gtk_file_chooser_get_current_folder" + :getter "gtk_file_chooser_get_current_folder" :accessor file-chooser-current-folder :initarg :current-folder :type string) @@ -823,7 +873,7 @@ (default-height :merge t :unbound -1))) (current-folder-uri :allocation :virtual :setter "gtk_file_chooser_set_current_folder_uri" - :setter "gtk_file_chooser_get_current_folder_uri" + :getter "gtk_file_chooser_get_current_folder_uri" :accessor file-chooser-current-folder-uri :initarg :current-folder-uri :type string))) @@ -844,7 +894,7 @@ (default-height :merge t :unbound -1))) :allocation :virtual :getter "gtk_tree_view_get_columns" :reader tree-view-columns - :type (glist tree-view-column)) + :type (glist (copy-of tree-view-column))) (selection :allocation :virtual :getter "gtk_tree_view_get_selection" @@ -859,6 +909,10 @@ (default-height :merge t :unbound -1))) :reader tree-model-n-columns :type int))) + ("GtkTreeModelFilter" + :slots + ((virtual-root :merge t :type tree-path))) + ("GtkTreeSelection" :slots ((mode @@ -870,8 +924,8 @@ (default-height :merge t :unbound -1))) :type selection-mode) (tree-view :allocation :virtual - :getter "gtk_tree_selection_get_mode" - :reader tree-selection-mode + :getter "gtk_tree_selection_get_tree_view" + :reader tree-selection-tree-view :type tree-view))) ("GtkComboBox" @@ -940,7 +994,7 @@ (default-height :merge t :unbound -1))) :allocation :virtual :getter "gtk_text_mark_get_name" :reader text-mark-name - :type string) + :type (copy-of string)) (visible :allocation :virtual :getter "gtk_text_mark_get_visible" @@ -981,13 +1035,14 @@ (default-height :merge t :unbound -1))) :allocation :user-data :initarg :accelerator :reader action-accelerator))) + #?-(pkg-exists-p "gtk+-2.0" :atleast-version "2.10.0") ("GtkToggleAction" :slots ((active :allocation :virtual :getter "gtk_toggle_action_get_active" :setter "gtk_toggle_action_set_active" - :initarg :active +; :initarg :active ;; Handled by initialize-instance :accessor toggle-action-active-p :type boolean))) @@ -1002,23 +1057,27 @@ (default-height :merge t :unbound -1))) :allocation :property :pname "value" :type int :documentation "A hack so we can use the alien function gtk_radio_action_get_current_value to retrieve the active radio action in a group.") (value - :allocation :user-data :initarg :value :accessor radio-action-value))) + :allocation :user-data :initarg :value :accessor radio-action-value) + #?(pkg-exists-p "gtk+-2.0" :atleast-version "2.10.0") + ;; Use radio-action-get-current-value to get the current value of + ;; a radio action group + (current-value :ignore t))) ("GtkColorSelection" :slots ((previous-alpha :allocation :virtual :getter "gtk_color_selection_get_previous_alpha" - :setter "gtk_color_selection_get_previous_alpha" + :setter "gtk_color_selection_set_previous_alpha" :initarg :previous-alpha :accessor color-selection-previous-alpha :type (unsigned 16)) (previous-color :allocation :virtual - :getter "gtk_color_selection_get_previous_color" - :setter "gtk_color_selection_get_previous_color" + :getter color-selection-previous-color + :setter "gtk_color_selection_set_previous_color" :initarg :previous-color - :accessor color-selection-previous-color + :writer (setf color-selection-previous-color) :type gdk:color))) ("GtkFontSelection" @@ -1034,12 +1093,60 @@ (default-height :merge t :unbound -1))) :reader clipboard-display :type gdk:display))) - #+gtk2.6 + #?(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0") ("GtkIconView" :slots - ((text-column :merge t :setter %icon-view-set-text-column) - (markup-column :merge t :setter %icon-view-set-markup-column) - (pixbuf-column :merge t :setter %icon-view-set-pixbuf-column))) + ((text-column + :allocation :virtual + :getter %icon-view-get-text-column + :setter %icon-view-set-text-column + :boundp %icon-view-text-column-boundp + :initarg :text-column + :accessor icon-view-text-column) + (markup-column + :allocation :virtual + :getter %icon-view-get-markup-column + :setter %icon-view-set-markup-column + :boundp %icon-view-markup-column-boundp + :initarg :markup-column + :accessor icon-view-markup-column) + (pixbuf-column + :allocation :virtual + :getter %icon-view-get-pixbuf-column + :setter %icon-view-set-pixbuf-column + :boundp %icon-view-pixbuf-column-boundp + :initarg :pixbuf-column + :accessor icon-view-pixbuf-column))) + + #?(pkg-exists-p "gtk+-2.0" :atleast-version "2.10.0") + ("GtkAssistant" + :slots + ((current-page + :allocation :virtual + :getter "gtk_assistant_get_current_page" + :setter "gtk_assistant_set_current_page" + :accessor assistant-current-page + :type int) + (num-pages + :allocation :virtual + :getter "gtk_assistant_get_n_page" + :reader assistant-current-page + :type int))) + + #?(pkg-exists-p "gtk+-2.0" :atleast-version "2.10.0") + ("GtkRecentChooser" + :slots + ((current-item + :allocation :virtual + :getter "gtk_recent_chooser_get_current_item" + :reader recent-chooser-current-item + :type recent-info) + (current-uri + :allocation :virtual + :getter "gtk_recent_chooser_get_current_uri" + :setter %recent-chooser-set-current-uri + :accessor recent-chooser-current-uri + :type string))) ;; Not needed ("GtkFundamentalType" :ignore t) @@ -1186,7 +1293,7 @@ (defclass accel-group-entry (struct) :type quark)) (:metaclass struct-class)) -#+gtk2.8 +#?(pkg-exists-p "gtk+-2.0" :atleast-version "2.8.0") (define-enum-type drop-position :no-drop :drop-into :drop-left :drop-right :drop-above :drop-below) @@ -1235,6 +1342,14 @@ (defclass selection-data (boxed) (:metaclass boxed-class)) +#?-(pkg-exists-p "gtk+-2.0" :atleast-version "2.10.0") (defclass target-list (proxy) () - (:metaclass proxy-class)) + (:metaclass proxy-class) + (:ref target-list-ref) + (:unref target-list-unref)) + +#?(pkg-exists-p "gtk+-2.0" :atleast-version "2.10.0") +(defclass target-list (boxed) + () + (:metaclass boxed-class))