X-Git-Url: https://git.distorted.org.uk/~mdw/clg/blobdiff_plain/a5522de52c8dcd65783339b80de07c3413d61ffa..1143508416716e1236d7d7b772fa471716f06235:/gtk/gtkaction.lisp diff --git a/gtk/gtkaction.lisp b/gtk/gtkaction.lisp index 0ecd265..3124075 100644 --- a/gtk/gtkaction.lisp +++ b/gtk/gtkaction.lisp @@ -1,21 +1,26 @@ -;; Common Lisp bindings for GTK+ v2.0 -;; Copyright (C) 1999-2001 Espen S. Johnsen +;; Common Lisp bindings for GTK+ v2.x +;; Copyright 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: gtkaction.lisp,v 1.4 2005-04-19 08:11:39 espen Exp $ +;; $Id: gtkaction.lisp,v 1.12 2008-03-10 18:51:13 espen Exp $ (in-package "GTK") @@ -27,9 +32,6 @@ (when callback (apply #'signal-connect action 'activate (mklist callback)))) -(defmethod action-accelerator ((action action)) - (object-data action 'accelerator)) - (defbinding (action-is-sensitive-p "gtk_action_is_sensitive") () boolean (action action)) @@ -80,7 +82,7 @@ (defmethod initialize-instance ((action radio-action) &key group) (call-next-method) - (setf (slot-value action 'self) (sap-int (proxy-location action))) + (setf (slot-value action 'self) (pointer-address (foreign-location action))) (when group (add-to-radio-group action group))) @@ -107,13 +109,13 @@ (radio-action radio-action)) (defun radio-action-get-current-value (action) - (radio-value-action (radio-action-get-current action))) + (radio-action-value (radio-action-get-current action))) ;;; Toggle Action -(defmethod initialize-instance ((action toggle-action) &rest initargs &key callback) +(defmethod initialize-instance ((action toggle-action) &rest initargs &key callback #?-(pkg-exists-p "gtk+-2.0" :atleast-version "2.10.0")active) (remf initargs :callback) (apply #'call-next-method action initargs) (when callback @@ -125,7 +127,8 @@ #'(lambda () (funcall function (toggle-action-active-p action)))) :object object :after after))) - (when (toggle-action-active-p action) + #?-(pkg-exists-p "gtk+-2.0" :atleast-version "2.10.0") + (when active (action-activate action))) (defbinding toggle-action-toggled () nil @@ -175,24 +178,20 @@ (ui-manager ui-manager) (ui string) ((length ui) int) - (gerror pointer :out)) + (gerror gerror-signal :out)) + +(defgeneric ui-manager-add-ui (ui-manager ui-spec)) (defmethod ui-manager-add-ui ((ui-manager ui-manager) (ui-spec string)) - (let ((id (%ui-manager-add-ui-from-string ui-manager ui-spec))) - (when (zerop id) - (error "We need to handle GError in som way")) - id)) + (%ui-manager-add-ui-from-string ui-manager ui-spec)) (defbinding %ui-manager-add-ui-from-file () int (ui-manager ui-manager) (filename pathname) - (gerror pointer :out)) + (gerror gerror-signal :out)) (defmethod ui-manager-add-ui ((ui-manager ui-manager) (path pathname)) - (let ((id (%ui-manager-add-ui-from-file ui-manager path))) - (when (zerop id) - (error "We need to handle GError in som way")) - id)) + (%ui-manager-add-ui-from-file ui-manager path)) (defbinding %ui-manager-new-merge-id () unsigned-int (ui-manager ui-manager)) @@ -209,9 +208,9 @@ (defvar *valid-ui-elements* '((:ui :menubar :toolbar :popup :accelerator) (:menubar :menuitem :separator :placeholder :menu) - (:menu :menuitem :separator :placehoder :menu) - (:popup :menuitem :separator :placehoder :menu) - (:toolbar :toolitem :separator :placehoder) + (:menu :menuitem :separator :placeholder :menu) + (:popup :menuitem :separator :placeholder :menu) + (:toolbar :toolitem :separator :placeholder) (:placeholder :menuitem :toolitem :separator :placeholder :menu) (:menuitem) (:toolitem)