X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~mdw/git/clg/blobdiff_plain/fa60e0a229ccf07429187357b2c2dee1b189c5a4..7ce4015bab6f4366baf5b9321fb3fad094625305:/gtk/gtktypes.lisp diff --git a/gtk/gtktypes.lisp b/gtk/gtktypes.lisp index 8d4eed0..8e0fb81 100644 --- a/gtk/gtktypes.lisp +++ b/gtk/gtktypes.lisp @@ -1,21 +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 +;; 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.32 2005-02-22 23:12:02 espen Exp $ +;; $Id: gtktypes.lisp,v 1.40 2006-02-04 12:18:12 espen Exp $ (in-package "GTK") @@ -107,14 +112,17 @@ (defclass stock-item (struct) :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)) +;; 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) @@ -123,7 +131,7 @@ (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) (:first 0) (:last -1)))) @@ -132,6 +140,8 @@ (defmethod reader-function ((type (eql 'position)) &rest args) (declare (ignore type args)) (reader-function 'int)) + + (define-types-by-introspection "Gtk" ;; Manually defined ("GtkObject" :ignore t) @@ -145,7 +155,7 @@ (define-types-by-introspection "Gtk" ("GtkWidget" :slots ((child-properties - :allocation :instance + :allocation :special :accessor widget-child-properties :type container-child) (window @@ -153,10 +163,8 @@ (define-types-by-introspection "Gtk" :getter "gtk_widget_get_window" :reader widget-window :type gdk:window) - (parent - :allocation :property :pname "parent" - :reader widget-parent - :type container) + (parent :merge t :initarg nil) + (visible :merge t :initarg nil) (parent-window :allocation :virtual :getter %widget-parent-window @@ -372,6 +380,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 @@ -393,13 +410,27 @@ (default-height :merge t :unbound -1))) ("GtkScrolledWindow" :slots - ((hscrollbar - :allocation :alien + (#-gtk2.8 + (hscrollbar + :allocation :alien :reader scrolled-window-hscrollbar :type widget) + #-gtk2.8 (vscrollbar :allocation :alien :reader scrolled-window-vscrollbar + :type widget) + #+gtk2.8 + (hscrollbar + :allocation :virtual + :getter "gtk_scrolled_window_get_hscrollbar" + :reader scrolled-window-hscrollbar + :type widget) + #+gtk2.8 + (vscrollbar + :allocation :virtual + :getter "gtk_scrolled_window_get_hscrollbar" + :reader scrolled-window-vscrollbar :type widget))) ("GtkPaned" @@ -613,6 +644,7 @@ (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 @@ -935,11 +967,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 @@ -958,12 +990,11 @@ (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 :virtual - :getter radio-action-value))) + :allocation :user-data :initarg :value :accessor radio-action-value))) ("GtkColorSelection" :slots @@ -995,6 +1026,12 @@ (default-height :merge t :unbound -1))) :reader clipboard-display :type gdk:display))) + #+gtk2.6 + ("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) @@ -1068,15 +1105,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) @@ -1120,3 +1151,55 @@ (defclass file-filter-info (struct) :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)) + +#+gtk2.8 +(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)) + +(deftype target-list () 'pointer)