X-Git-Url: https://git.distorted.org.uk/~mdw/clg/blobdiff_plain/4ea1303500a59d61d755399e8df1af84241c7d7c..8b70d56024b8c55a52e045c0ec29352a63c12d32:/examples/testgtk.lisp diff --git a/examples/testgtk.lisp b/examples/testgtk.lisp index ab95809..1bc85c2 100644 --- a/examples/testgtk.lisp +++ b/examples/testgtk.lisp @@ -1,21 +1,35 @@ -;; Common Lisp bindings for GTK+ v2.0 -;; Copyright (C) 1999-2005 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: testgtk.lisp,v 1.28 2005-04-19 08:17:06 espen Exp $ +;; Parts of this file are direct translations of code from 'testgtk.c' +;; distributed with the Gtk+ library, and thus covered by the GNU +;; Lesser General Public License and copyright Peter Mattis, Spencer +;; Kimball, Josh MacDonald and others. + + +;; $Id: testgtk.lisp,v 1.32 2005-04-25 21:45:05 espen Exp $ + +#+sbcl(require :gtk) +#+cmu(asdf:oos 'asdf:load-op :gtk) (defpackage "TESTGTK" (:use "COMMON-LISP" "GTK")) @@ -1255,12 +1269,13 @@ This one is underlined ( (grab-add window) (gdk:pointer-grab (widget-window window) :events '(:button-release :button-motion :pointer-motion-hint) - :owner-events t :time event)))) + :owner-events t)))) (signal-connect window 'button-release-event #'(lambda (event) + (declare (ignore event)) (grab-remove window) - (gdk:pointer-ungrab event))) + (gdk:pointer-ungrab))) (signal-connect window 'motion-notify-event #'(lambda (event) @@ -1837,7 +1852,7 @@ This one is underlined ( (ui-manager-get-widget ui "/ToolBar") :expand nil :fill nil) :child (make-instance 'label - :label "Type to start" + :label "Type Ctrl+Q to quit" :xalign 0.5 :yalign 0.5 :width-request 200 :height-request 200)))) @@ -1920,7 +1935,7 @@ This one is underlined ( :parent main-window :child-args '(:expand nil) :child (list (make-instance 'label :label (gtk-version)) :fill nil) - :child (list (make-instance 'label :label "clg CVS version") :fill nil) + :child (list (make-instance 'label :label (clg-version)) :fill nil) :child (list (make-instance 'label :label #-cmu(format nil "~A (~A)" (lisp-implementation-type)