X-Git-Url: https://git.distorted.org.uk/~mdw/clg/blobdiff_plain/580820d8044f45eb58f39b9d52d185d2efd16bcd..8bc1cf79b862f73f475199118fd1b75e7cc3f083:/gdk/gdk.lisp diff --git a/gdk/gdk.lisp b/gdk/gdk.lisp index d449a13..d6b7f6e 100644 --- a/gdk/gdk.lisp +++ b/gdk/gdk.lisp @@ -1,21 +1,26 @@ -;; Common Lisp bindings for GTK+ v2.0 -;; Copyright (C) 1999-2005 Espen S. Johnsen +;; Common Lisp bindings for GTK+ v2.x +;; Copyright 2000-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: gdk.lisp,v 1.16 2005-04-21 12:28:20 espen Exp $ +;; $Id: gdk.lisp,v 1.21 2006-02-09 22:31:28 espen Exp $ (in-package "GDK") @@ -417,14 +422,12 @@ ;;; Cursor -(defmethod initialize-instance ((cursor cursor) &key type mask fg bg - (x 0) (y 0) (display (display-get-default))) - (setf - (slot-value cursor 'location) - (etypecase type - (keyword (%cursor-new-for-display display type)) - (pixbuf (%cursor-new-from-pixbuf display type x y)) - (pixmap (%cursor-new-from-pixmap type mask fg bg x y))))) +(defmethod allocate-foreign ((cursor cursor) &key type mask fg bg + (x 0) (y 0) (display (display-get-default))) + (etypecase type + (keyword (%cursor-new-for-display display type)) + (pixbuf (%cursor-new-from-pixbuf display type x y)) + (pixmap (%cursor-new-from-pixmap type mask fg bg x y)))) (defbinding %cursor-new-for-display () pointer @@ -700,3 +703,35 @@ (defbinding (keyval-is-lower-p "gdk_keyval_is_lower") () boolean (keyval unsigned-int)) +;;; Cairo interaction + +#+gtk2.8 +(progn + (defbinding cairo-create () cairo:context + (drawable drawable)) + + (defmacro with-cairo-context ((cr drawable) &body body) + `(let ((,cr (cairo-create ,drawable))) + (unwind-protect + (progn ,@body) + (unreference-foreign 'cairo:context (foreign-location ,cr)) + (invalidate-instance ,cr)))) + + (defbinding cairo-set-source-color () nil + (cr cairo:context) + (color color)) + + (defbinding cairo-set-source-pixbuf () nil + (cr cairo:context) + (pixbuf pixbuf) + (x double-float) + (y double-float)) + + (defbinding cairo-rectangle () nil + (cr cairo:context) + (rectangle rectangle)) + +;; (defbinding cairo-region () nil +;; (cr cairo:context) +;; (region region)) +)