chiark / gitweb /
CLISP port marked as done
[clg] / pango / pango.lisp
index b230e54e0db293f8c5a1df442853e5061f9df269..04d90c536968755edbea421e73c24e223c2397e4 100644 (file)
-;; Common Lisp bindings for GTK+ v2.0
-;; Copyright (C) 2001 Espen S. Johnsen <esj@stud.cs.uit.no>
+;; Common Lisp bindings for GTK+ v2.x
+;; Copyright 2001-2006 Espen S. Johnsen <espen@users.sf.net>
 ;;
-;; 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: pango.lisp,v 1.1 2001-05-20 23:13:08 espen Exp $
+;; $Id: pango.lisp,v 1.12 2006-08-30 11:08:13 espen Exp $
 
 (in-package "PANGO")
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
-  (init-types-in-library
-   "/opt/gnome/lib/libpango.so"
-   :ignore ("_pango_fribidi_get_type")))
+  (init-types-in-library #.(concatenate 'string 
+                           (pkg-variable "pango" "libdir")
+                           "/libpango-1.0." asdf:*dso-extension*) 
+                        :prefix "pango_")
+  (init-types-in-library #.(concatenate 'string 
+                           (pkg-variable "pango" "libdir")
+                           "/libpangoxft-1.0." asdf:*dso-extension*) 
+                        :prefix "pango_xft")
+  (init-types-in-library #.(concatenate 'string 
+                           (pkg-variable "pango" "libdir")
+                           "/libpangoft2-1.0." asdf:*dso-extension*) 
+                        :prefix "pango_fc"))
 
-(define-types-by-introspection "Pango")
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (define-types-by-introspection "Pango")
+
+  (defclass font-description (boxed)
+    ((family
+      :allocation :virtual
+      :initarg :family
+      :getter "pango_font_description_get_family"
+      :setter "pango_font_description_set_family"
+      :boundp %font-description-family-boundp
+      :makunbound %font-description-family-makunbound
+      :accessor font-description-family
+      :type string)
+     (style
+      :allocation :virtual
+      :initarg :style
+      :getter "pango_font_description_get_style"
+      :setter "pango_font_description_set_style"
+      :boundp %font-description-style-boundp
+      :makunbound %font-description-style-makunbound
+      :accessor font-description-style
+      :type style)
+     (variant
+      :allocation :virtual
+      :initarg :variant
+      :getter "pango_font_description_get_variant"
+      :setter "pango_font_description_set_variant"
+      :boundp %font-description-variant-boundp
+      :makunbound %font-description-variant-makunbound
+      :accessor font-description-variant
+      :type variant)
+     (weight
+      :allocation :virtual
+      :initarg :weight
+      :getter "pango_font_description_get_weight"
+      :setter "pango_font_description_set_weight"
+      :boundp %font-description-weight-boundp
+      :makunbound %font-description-weight-makunbound
+      :accessor font-description-weight
+      :type weight)
+     (stretch
+      :allocation :virtual
+      :initarg :stretch
+      :getter "pango_font_description_get_stretch"
+      :setter "pango_font_description_set_stretch"
+      :boundp %font-description-stretch-boundp
+      :makunbound %font-description-stretch-makbound
+      :accessor font-description-stretch
+      :type stretch)
+     (size
+      :allocation :virtual
+      :initarg :size
+      :setter (setf font-description-size)
+      :getter "pango_font_description_get_size"
+      :boundp %font-description-size-boundp
+      :makunbound %font-description-size-makunbound
+      :reader font-description-size
+      :type integer)
+     #?(pkg-exists-p "pango" :atleast-version "1.8.0")
+     (absolute-size-p
+      :allocation :virtual
+      :getter "pango_font_description_get_size_is_absolute"
+      :boundp %font-description-size-boundp
+      :reader font-description-size-is-absolute-p
+      :type boolean))
+    (:metaclass boxed-class)))
+
+
+(defmethod initialize-instance ((desc font-description) &key absolute-size)
+  (call-next-method)
+  (when absolute-size
+    (setf (font-description-size desc t) absolute-size)))
+
+(defbinding %font-description-new () pointer)
+
+(defmethod allocate-foreign ((desc font-description) &rest initargs)
+  (declare (ignore initargs))
+  (%font-description-new))
+
+(defbinding %font-description-get-set-fields () font-mask
+  (desc font-description))
+
+(defun %font-description-family-boundp (desc)
+  (find :family (%font-description-get-set-fields desc)))
+
+(defun %font-description-style-boundp (desc)
+  (find :style (%font-description-get-set-fields desc)))
+
+(defun %font-description-variant-boundp (desc)
+  (find :variant (%font-description-get-set-fields desc)))
+
+(defun %font-description-weight-boundp (desc)
+  (find :weight (%font-description-get-set-fields desc)))
+
+(defun %font-description-stretch-boundp (desc)
+  (find :stretch (%font-description-get-set-fields desc)))
+
+(defun %font-description-size-boundp (desc)
+  (find :size (%font-description-get-set-fields desc)))
+
+(defbinding %font-description-unset-fields () nil
+  (desc font-description)
+  (mask font-mask))
+
+(defun %font-description-family-makunbound (desc)
+  (%font-description-unset-fields desc :family))
+
+(defun %font-description-style-makunbound (desc)
+  (%font-description-unset-fields desc :style))
+
+(defun %font-description-variant-makunbound (desc)
+  (%font-description-unset-fields desc :variant))
+
+(defun %font-description-weight-makunbound (desc)
+  (%font-description-unset-fields desc :weight))
+
+(defun %font-description-stretch-makunbound (desc)
+  (%font-description-unset-fields desc :stretch))
+
+(defun %font-description-size-makunbound (desc)
+  (%font-description-unset-fields desc :size))
+
+(defbinding %font-description-set-size () nil
+  (desc font-description)
+  (size int))
+
+#?(pkg-exists-p "pango" :atleast-version "1.8.0")
+(defbinding %font-description-set-absolute-size () nil
+  (desc font-description)
+  (size double-float))
+
+(defun (setf font-description-size) (size desc &optional absolute-p)
+  (if absolute-p
+      #?(pkg-exists-p "pango" :atleast-version "1.8.0")
+      (%font-description-set-absolute-size desc size)
+      #?-(pkg-exists-p "pango" :atleast-version "1.8.0")
+      (error "Setting of absolute font size requires at least Pango 1.8.0")
+    (%font-description-set-size desc size)))
+
+(defbinding font-description-merge (desc merge-desc &optional replace-p) nil
+  (desc font-description)
+  (merge-desc font-description)
+  (replace-p boolean))
+
+(defbinding font-description-better-match () boolean
+  (desc font-description)
+  (old-math font-description)
+  (new-math font-description))
+
+(defbinding font-description-from-string () font-description
+  (desc string))
+
+(defbinding font-description-to-string () string
+  (desc font-description))