X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~mdw/git/clg/blobdiff_plain/cb4bf7725c9512f1001745bdb157e4eddddb9f76..76ff9f3924bb9aa1b98b42e6e218918706e731e9:/gtk/gtktypes.lisp diff --git a/gtk/gtktypes.lisp b/gtk/gtktypes.lisp index 5a3b811..d51c181 100644 --- a/gtk/gtktypes.lisp +++ b/gtk/gtktypes.lisp @@ -1,22 +1,26 @@ -;; Common Lisp bindings for GTK+ v2.0.x -;; Copyright (C) 1999-2001 Espen S. Johnsen +;; Common Lisp bindings for GTK+ v2.x +;; Copyright 1999-2005 Espen S. Johnsen ;; -;; This library is free software; you can redistribute it and/or -;; modify it under the terms of the GNU Lesser General Public -;; License as published by the Free Software Foundation; either -;; version 2 of the License, or (at your option) any later version. +;; Permission is hereby granted, free of charge, to any person obtaining +;; a copy of this software and associated documentation files (the +;; "Software"), to deal in the Software without restriction, including +;; without limitation the rights to use, copy, modify, merge, publish, +;; distribute, sublicense, and/or sell copies of the Software, and to +;; permit persons to whom the Software is furnished to do so, subject to +;; the following conditions: ;; -;; This library is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;; Lesser General Public License for more details. +;; The above copyright notice and this permission notice shall be +;; included in all copies or substantial portions of the Software. ;; -;; You should have received a copy of the GNU Lesser General Public -;; 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: gtktypes.lisp,v 1.28 2005-01-06 21:05:46 espen Exp $ +;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. +;; IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY +;; CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, +;; 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.46 2006-04-26 12:12:37 espen Exp $ (in-package "GTK") @@ -106,16 +110,21 @@ (defclass stock-item (struct) :accessor stock-item-translation-domain :initarg :translation-domain :type string)) - (:metaclass struct-class)) - -;; We don't really need to access any of these slots, but we need to -;; specify the size of the struct somehow -(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)) + (: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))))) ;; (defclass tree-path (boxed) @@ -124,18 +133,22 @@ (defclass tree-iter (boxed) ;; (:metaclass boxed-class)) (deftype tree-path () '(vector integer)) -(register-type 'tree-path "GtkTreePath") +(register-type 'tree-path '|gtk_tree_path_get_type|) -(deftype position () '(or int (enum (:start 0) (:end -1)))) +(deftype position () + '(or int (enum (:start 0) (:end -1) (:first 0) (:last -1)))) -;; Forward definitions -(defclass widget (%object) - () - (:metaclass gobject-class)) -(defclass container (widget) - () - (:metaclass gobject-class)) +(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) &key ref) + (declare (ignore type ref)) + (from-alien-function 'int)) +(define-type-method reader-function ((type position) &optional ref) + (declare (ignore type ref)) + (reader-function 'int)) (define-types-by-introspection "Gtk" ;; Manually defined @@ -150,7 +163,7 @@ (define-types-by-introspection "Gtk" ("GtkWidget" :slots ((child-properties - :allocation :instance + :special t :accessor widget-child-properties :type container-child) (window @@ -158,6 +171,15 @@ (define-types-by-introspection "Gtk" :getter "gtk_widget_get_window" :reader widget-window :type gdk:window) + (parent :merge t :initarg nil) + (visible :merge t :initarg nil) + (parent-window + :allocation :virtual + :getter %widget-parent-window + :setter "gtk_widget_set_parent_window" + :accessor widget-parent-window + :initarg :parent-window + :type gdk:window) (state :allocation :virtual :getter "gtk_widget_get_state" @@ -190,7 +212,7 @@ (define-types-by-introspection "Gtk" :setter "gtk_widget_set_composite_name" :accessor widget-composite-name :initarg :composite-name - :type string) + :type (copy-of string)) ; will leak the string when setting (settings :allocation :virtual :getter "gtk_widget_get_settings" @@ -213,14 +235,13 @@ (define-types-by-introspection "Gtk" ((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" @@ -293,7 +314,7 @@ (default-widget :type boolean) (icon-list :allocation :virtual - :getter "gtk_window_get_icon_list" + :getter %window-get-icon-list :setter "gtk_window_set_icon_list" :accessor window-icon-list :initarg :icon-list @@ -323,6 +344,7 @@ (default-width :merge t :unbound -1) (default-height :merge t :unbound -1))) ("GtkWindowGroup" + :dependencies (window) :slots ((grabs :allocation :alien @@ -366,6 +388,15 @@ (default-height :merge t :unbound -1))) :initarg :submenu :type widget))) + ("GtkMenuShell" + :slots + ((take-focus-p + :allocation :virtual + :getter "gtk_menu_shell_get_take_focus" + :setter "gtk_menu_shell_set_take_focus" + :accessor menu-shell-take-focus-p + :type boolean))) + ("GtkColorSelectionDialog" :slots ((colorsel @@ -387,13 +418,27 @@ (default-height :merge t :unbound -1))) ("GtkScrolledWindow" :slots - ((hscrollbar - :allocation :alien + (#?-(pkg-exists-p "gtk+-2.0" :atleast-version "2.8.0") + (hscrollbar + :allocation :alien :reader scrolled-window-hscrollbar :type widget) + #?-(pkg-exists-p "gtk+-2.0" :atleast-version "2.8.0") (vscrollbar :allocation :alien :reader scrolled-window-vscrollbar + :type widget) + #?(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) + #?(pkg-exists-p "gtk+-2.0" :atleast-version "2.8.0") + (vscrollbar + :allocation :virtual + :getter "gtk_scrolled_window_get_vscrollbar" + :reader scrolled-window-vscrollbar :type widget))) ("GtkPaned" @@ -441,7 +486,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" @@ -450,6 +495,22 @@ (default-height :merge t :unbound -1))) :initarg :tearoff-state :type boolean))) + ("GtkPlug" + :slots + ((id + :allocation :virtual + :getter "gtk_plug_get_id" + :reader plug-id + :type gdk:native-window))) + + ("GtkSocket" + :slots + ((id + :allocation :virtual + :getter "gtk_socket_get_id" + :reader socket-id + :type gdk:native-window))) + ("GtkToolbar" :slots ((show-tooltips @@ -528,10 +589,19 @@ (default-height :merge t :unbound -1))) :slots ((current-page :allocation :virtual - :getter notebook-current-page + :getter %notebook-current-page :setter (setf notebook-current-page) + :reader notebook-current-page + :type widget :initarg :current-page) - (page :ignore t))) + (current-page-num + :allocation :virtual + :getter "gtk_notebook_get_current_page" + :setter "gtk_notebook_set_current_page" + :unbound -1 + :initarg :current-page-num + :accessor notebook-current-page-num + :type position))) ("GtkRuler" :slots @@ -598,14 +668,15 @@ (default-height :merge t :unbound -1))) :reader entry-layout :type pango:layout) (completion + :allocation :virtual :getter "gtk_entry_get_completion" :setter "gtk_entry_set_completion" :initarg :completion :accessor entry-completion :type entry-completion) (max-length :merge t :unbound 0) - #+gtk2.6 - (with-chars :merge t :unbound -1))) + #?(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0") + (width-chars :merge t :unbound -1))) ("GtkEntryCompletion" :slots @@ -615,7 +686,7 @@ (default-height :merge t :unbound -1))) :reader entry-completion-entry :type entry) (minimum-key-length :merge t :unbound -1) - #+gtk2.6 + #?(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0") (text-column :merge t :unbound -1))) ("GtkRadioButton" @@ -644,24 +715,6 @@ (default-height :merge t :unbound -1))) :accessor radio-menu-item-value :documentation "Value passed as argument to the activate callback"))) - ("GtkFileSelection" - :slots - ((action-area - :allocation :virtual - :getter "gtk_file_selection_get_action_area" - :reader file-selection-action-area - :type widget) - (ok-button - :allocation :virtual - :getter "gtk_file_selection_get_ok_button" - :reader file-selection-ok-button - :type widget) - (cancel-button - :allocation :virtual - :getter "gtk_file_selection_get_cancel_button" - :reader file-selection-cancel-button - :type widget))) - ("GtkLayout" :slots ((bin-window @@ -713,7 +766,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" @@ -724,6 +777,14 @@ (default-height :merge t :unbound -1))) :reader label-layout :type pango:layout))) + ("GtkScale" + :slots + ((layout + :allocation :virtual + :getter "gtk_scale_get_layout" + :reader scale-layout + :type pango:layout))) + ("GtkEditable" :slots ((editable @@ -758,31 +819,41 @@ (default-height :merge t :unbound -1))) (current-name :allocation :virtual :setter "gtk_file_chooser_set_current_name" - :accessor file-choser-current-name + :accessor file-chooser-current-name :initarg :current-name :type string) (current-folder :allocation :virtual :setter "gtk_file_chooser_set_current_folder" :setter "gtk_file_chooser_get_current_folder" - :accessor file-choser-current-folder + :accessor file-chooser-current-folder :initarg :current-folder :type string) (uri :allocation :virtual :getter "gtk_file_chooser_get_uri" :setter "gtk_file_chooser_set_uri" - :accessor file-choser-uri + :accessor file-chooser-uri :initarg :uri :type string) (current-folder-uri :allocation :virtual :setter "gtk_file_chooser_set_current_folder_uri" :setter "gtk_file_chooser_get_current_folder_uri" - :accessor file-choser-current-folder-uri + :accessor file-chooser-current-folder-uri :initarg :current-folder-uri :type string))) + ("GtkFileFilter" + :slots + ((name + :allocation :virtual + :getter "gtk_file_filter_get_name" + :setter "gtk_file_filter_set_name" + :accessor file-filter-name + :initarg :name + :type string))) + ("GtkTreeView" :slots ((columns @@ -874,6 +945,35 @@ (default-height :merge t :unbound -1))) (weight :merge t :type pango:weight))) + ("GtkTextMark" + :slots + ((buffer + :allocation :virtual + :getter "gtk_text_mark_get_buffer" + :reader text-mark-buffer + :type text-buffer) + (name + :allocation :virtual + :getter "gtk_text_mark_get_name" + :reader text-mark-name + :type string) + (visible + :allocation :virtual + :getter "gtk_text_mark_get_visible" + :setter "gtk_text_mark_set_visible" + :accessor text-mark-visible-p + :type boolean) + (deleted + :allocation :virtual + :getter "gtk_text_mark_get_deleted" + :reader text-mark-deleted-p + :type boolean) + (left-gravity + :allocation :virtual + :getter "gtk_text_mark_get_left_gravity" + :reader text-mark-left-gravity-p + :type boolean))) + ("GtkUIManager" :type ui-manager :slots @@ -891,11 +991,11 @@ (default-height :merge t :unbound -1))) ("GtkUIManagerItemType" :type ui-manager-item-type) - ("GtkToggle" + ("GtkAction" :slots ((accelerator - :allocation :virtual - :getter action-accelerator))) + :allocation :user-data :initarg :accelerator + :reader action-accelerator))) ("GtkToggleAction" :slots @@ -914,13 +1014,48 @@ (default-height :merge t :unbound -1))) :getter "gtk_radio_button_get_group" :reader radio-action-group :type (copy-of (gslist widget))) - (%value - :allocation :property :pname "value" - :readable nil :type int) + (self + :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))) + + ("GtkColorSelection" + :slots + ((previous-alpha + :allocation :virtual + :getter "gtk_color_selection_get_previous_alpha" + :setter "gtk_color_selection_get_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" + :initarg :previous-color + :accessor color-selection-previous-color + :type gdk:color))) + + ("GtkFontSelection" + :slots + ; deprecated property + ((font :ignore t))) + + ("GtkClipboard" + :slots + ((display :allocation :virtual - :getter radio-action-value))) + :getter "gtk_clipboard_get_display" + :reader clipboard-display + :type gdk:display))) + #?(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))) ;; Not needed ("GtkFundamentalType" :ignore t) @@ -944,13 +1079,13 @@ (default-height :merge t :unbound -1))) ("GtkOldEditable" :ignore t) ("GtkCombo" :ignore t) ("GtkOptionMenu" :ignore t) + ("GtkFileSelection" :ignore t) + ("GtkInputDialog") ;; What are these? ("GtkFileSystemModule" :ignore t) ("GtkIMModule" :ignore t) - ("GtkThemeEngine" :ignore t) - - ) + ("GtkThemeEngine" :ignore t)) (defclass text-iter (boxed) @@ -958,7 +1093,7 @@ (defclass text-iter (boxed) :allocation :virtual :getter "gtk_text_iter_get_buffer" :reader text-iter-buffer - :type text-buffer) + :type pointer) ;text-buffer) (offset :allocation :virtual :getter "gtk_text_iter_get_offset" @@ -994,14 +1129,9 @@ (defclass text-iter (boxed) :getter "gtk_text_iter_get_visible_line_offset" :setter "gtk_text_iter_set_visible_line_offset" :accessor text-iter-visible-line-offset - :type int) - ;; Workaround to get correct size - (dummy14 - :allocation :alien :offset #.(* 13 (size-of 'pointer)) - :type pointer)) - (:metaclass boxed-class - ;; I am pretty sure this was working in older versons on CMUCL - :size #.(* 14 (size-of 'pointer)))) + :type int)) + (:metaclass boxed-class) + (:size #.(* 14 (size-of 'pointer)))) (defclass tooltips-data (struct) @@ -1022,3 +1152,107 @@ (defclass tooltips-data (struct) :reader tooltips-data-tip-private :type string)) (:metaclass struct-class)) + +(defclass file-filter-info (struct) + ((contains + :allocation :alien + :initarg :contains + :type file-filter-flags) + (filename + :allocation :alien + :initarg :filename + :type string) + (uri + :allocation :alien + :initarg :uri + :type string) + (display-name + :allocation :alien + :initarg :display-name + :type string) + (mime-type + :allocation :alien + :initarg :mime-type + :type string)) + (:metaclass struct-class)) + + +(defclass accel-key (struct) + ((key + :allocation :alien + :type unsigned-int) + (modifiers + :allocation :alien + :type gdk:modifier-type) + (flags + :allocation :alien + :type (unsigned 16))) + (:metaclass struct-class)) + +(defclass accel-group-entry (struct) + ((key + :allocation :alien + :setter nil + :type (inlined accel-key)) + (gclosure + :allocation :alien + :type gclosure) + (accel_path_quark + :allocation :alien + :type quark)) + (:metaclass struct-class)) + +#?(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) + + +(defclass target-entry (struct) + ((target + :allocation :alien + :accessor target-entry-target + :initarg :target + :type string) + (flags + :allocation :alien + :accessor target-entry-flags + :initarg :flags + :type target-flags) + (id + :allocation :alien + :accessor target-entry-id + :initarg :id + :type unsigned-int)) + (:metaclass struct-class)) + + +(defclass selection-data (boxed) + ((selection + :allocation :alien :type gdk:atom + :reader selection-data-selection) + (target + :allocation :alien :type gdk:atom + :reader selection-data-target) + (type + :allocation :alien :type gdk:atom + :reader selection-data-type) + (format + :allocation :alien :type int + :reader selection-data-format) + (data + :allocation :alien :type pointer + :reader selection-data-data) + (length + :allocation :alien :type int + :reader selection-data-length) + (display + :allocation :alien :type gdk:display + :reader selection-data-display)) + (:metaclass boxed-class)) + + +(defclass target-list (proxy) + () + (:metaclass proxy-class) + (:ref target-list-ref) + (:unref target-list-unref))