1 ;; Common Lisp bindings for GTK+ v2.x
2 ;; Copyright 2001-2006 Espen S. Johnsen <espen@users.sf.net>
4 ;; Permission is hereby granted, free of charge, to any person obtaining
5 ;; a copy of this software and associated documentation files (the
6 ;; "Software"), to deal in the Software without restriction, including
7 ;; without limitation the rights to use, copy, modify, merge, publish,
8 ;; distribute, sublicense, and/or sell copies of the Software, and to
9 ;; permit persons to whom the Software is furnished to do so, subject to
10 ;; the following conditions:
12 ;; The above copyright notice and this permission notice shall be
13 ;; included in all copies or substantial portions of the Software.
15 ;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
16 ;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
17 ;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
18 ;; IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
19 ;; CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
20 ;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
21 ;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
23 ;; $Id: pango.lisp,v 1.15 2007-09-07 07:39:59 espen Exp $
27 (eval-when (:compile-toplevel :load-toplevel :execute)
28 (init-types-in-library pango "libpango-1.0" :prefix "pango_")
29 (init-types-in-library pango "libpangoxft-1.0" :prefix "pango_xft")
30 (init-types-in-library pango "libpangoft2-1.0" :prefix "pango_fc")
31 (init-types-in-library pango "libpangocairo-1.0" :prefix "pango_cairo"))
34 (eval-when (:compile-toplevel :load-toplevel :execute)
35 (define-types-by-introspection "Pango"))
37 (defclass font-description (boxed)
40 :initarg :family :initform "Sans"
41 :getter "pango_font_description_get_family"
42 :setter "pango_font_description_set_family"
43 :boundp %font-description-family-boundp
44 :makunbound %font-description-family-makunbound
45 :accessor font-description-family
46 :type (static string))
49 :initarg :style :initform :normal
50 :getter "pango_font_description_get_style"
51 :setter "pango_font_description_set_style"
52 :boundp %font-description-style-boundp
53 :makunbound %font-description-style-makunbound
54 :accessor font-description-style
58 :initarg :variant :initform :normal
59 :getter "pango_font_description_get_variant"
60 :setter "pango_font_description_set_variant"
61 :boundp %font-description-variant-boundp
62 :makunbound %font-description-variant-makunbound
63 :accessor font-description-variant
66 :allocation :virtual :initform :normal
68 :getter "pango_font_description_get_weight"
69 :setter "pango_font_description_set_weight"
70 :boundp %font-description-weight-boundp
71 :makunbound %font-description-weight-makunbound
72 :accessor font-description-weight
75 :allocation :virtual :initform :normal
77 :getter "pango_font_description_get_stretch"
78 :setter "pango_font_description_set_stretch"
79 :boundp %font-description-stretch-boundp
80 :makunbound %font-description-stretch-makbound
81 :accessor font-description-stretch
85 ; :initarg :size :initform 16 ; handled by initialize instance
86 ; :setter (setf font-description-size)
87 :setter %set-font-description-size
88 :getter "pango_font_description_get_size"
89 :boundp %font-description-size-boundp
90 :makunbound %font-description-size-makunbound
91 :reader font-description-size
93 #?(pkg-exists-p "pango" :atleast-version "1.8.0")
96 ; :initarg :size-is-absolute :initform nil ; handled by initialize instance
97 :getter "pango_font_description_get_size_is_absolute"
98 :boundp %font-description-size-boundp
99 :reader font-description-size-is-absolute-p
101 (:metaclass boxed-class))
103 (defclass layout (gobject)
106 :getter "pango_layout_get_context"
107 :reader layout-context
112 :getter "pango_layout_get_text"
113 :setter %layout-set-text
114 :accessor layout-text
115 :type (static string))
119 :getter "pango_layout_get_attributes"
120 :setter "pango_layout_set_attributes"
121 :accessor layout-attributes
125 :initarg :font-description
126 :getter "pango_layout_get_font_description"
127 :setter "pango_layout_set_font_description"
128 :accessor layout-font-description
129 :type font-description)
133 :getter "pango_layout_get_width"
134 :setter "pango_layout_set_width"
136 :accessor layout-width
141 :getter "pango_layout_get_wrap"
142 :setter "pango_layout_set_wrap"
143 :accessor layout-wrap
148 :getter "pango_layout_get_ellipsize"
149 :setter "pango_layout_set_ellipsize"
150 :accessor layout-ellipsize
151 :type ellipsize-mode)
155 :getter "pango_layout_get_indent"
156 :setter "pango_layout_set_indetn"
157 :accessor layout-indent
162 :getter "pango_layout_get_spacing"
163 :setter "pango_layout_set_spacing"
164 :accessor layout-spacing
169 :getter "pango_layout_get_justify"
170 :setter "pango_layout_set_justify"
171 :accessor layout-justify-p
176 :getter "pango_layout_get_auto_dir"
177 :setter "pango_layout_set_auto_dir"
178 :accessor layout-auto-dir-p
183 :getter "pango_layout_get_alignment"
184 :setter "pango_layout_set_alignment"
185 :accessor layout-alignment
190 :getter "pango_layout_get_tabs"
191 :setter "pango_layout_set_tabs"
192 :accessor layout-tabs
196 :initarg :single-paragraph
197 :getter "pango_layout_get_single_paragraph_mode"
198 :setter "pango_layout_set_single_paragraph_mode"
199 :accessor layout-single-paragraph-p
201 (:metaclass gobject-class))
203 (defclass cairo-font-map (interface)
206 :getter "pango_cairo_font_map_get_resolution"
207 :setter "pango_cairo_font_map_set_resolution"
208 :accessor cairo-font-map-resolution
210 (:metaclass interface-class))
213 ;;;; Font description
215 (defmethod initialize-instance ((desc font-description) &key (size 16) size-is-absolute)
217 (setf (font-description-size desc size-is-absolute) size))
219 (defbinding %font-description-new () pointer)
221 (defmethod allocate-foreign ((desc font-description) &rest initargs)
222 (declare (ignore initargs))
223 (%font-description-new))
225 (defbinding %font-description-get-set-fields () font-mask
226 (desc font-description))
228 (defun %font-description-family-boundp (desc)
229 (find :family (%font-description-get-set-fields desc)))
231 (defun %font-description-style-boundp (desc)
232 (find :style (%font-description-get-set-fields desc)))
234 (defun %font-description-variant-boundp (desc)
235 (find :variant (%font-description-get-set-fields desc)))
237 (defun %font-description-weight-boundp (desc)
238 (find :weight (%font-description-get-set-fields desc)))
240 (defun %font-description-stretch-boundp (desc)
241 (find :stretch (%font-description-get-set-fields desc)))
243 (defun %font-description-size-boundp (desc)
244 (find :size (%font-description-get-set-fields desc)))
246 (defbinding %font-description-unset-fields () nil
247 (desc font-description)
250 (defun %font-description-family-makunbound (desc)
251 (%font-description-unset-fields desc :family))
253 (defun %font-description-style-makunbound (desc)
254 (%font-description-unset-fields desc :style))
256 (defun %font-description-variant-makunbound (desc)
257 (%font-description-unset-fields desc :variant))
259 (defun %font-description-weight-makunbound (desc)
260 (%font-description-unset-fields desc :weight))
262 (defun %font-description-stretch-makunbound (desc)
263 (%font-description-unset-fields desc :stretch))
265 (defun %font-description-size-makunbound (desc)
266 (%font-description-unset-fields desc :size))
268 (defbinding %font-description-set-size () nil
269 (desc font-description)
272 #?(pkg-exists-p "pango" :atleast-version "1.8.0")
273 (defbinding %font-description-set-absolute-size () nil
274 (desc font-description)
277 (defun (setf font-description-size) (size desc &optional (absolute-p nil absolute-given-p))
280 #?(pkg-exists-p "pango" :atleast-version "1.8.0")
281 (%font-description-set-absolute-size desc size)
282 #?-(pkg-exists-p "pango" :atleast-version "1.8.0")
283 (error "Setting of absolute font size requires at least Pango 1.8.0"))
284 (#?(pkg-exists-p "pango" :atleast-version "1.8.0") absolute-given-p
285 #?-(pkg-exists-p "pango" :atleast-version "1.8.0") t
286 (%font-description-set-size desc size))
287 #?(pkg-exists-p "pango" :atleast-version "1.8.0")
288 (t (if (font-description-size-is-absolute-p desc)
289 (%font-description-set-absolute-size desc size)
290 (%font-description-set-size desc size))))
293 (defun %set-font-description-size (size desc)
294 (setf (font-description-size desc) size))
296 (defbinding font-description-merge (desc merge-desc &optional replace-p) nil
297 (desc font-description)
298 (merge-desc font-description)
301 (defbinding font-description-better-match () boolean
302 (desc font-description)
303 (old-math font-description)
304 (new-math font-description))
306 (defbinding font-description-from-string () font-description
309 (defbinding font-description-to-string () string
310 (desc font-description))
312 (defbinding font-description-copy () font-description
313 (font-description font-description))
315 (defun ensure-font-description (font-description &optional copy-p)
316 (etypecase font-description
317 (font-description (if copy-p
318 (font-description-copy font-description)
320 (string (font-description-from-string font-description))
321 (list (apply #'make-instance 'font-description font-description))))
326 (defmethod initialize-instance ((layout layout) &key markup)
329 (layout-set-markup layout markup)))
331 (defmethod allocate-foreign ((layout layout) &key context)
333 (context (%layout-new context))
334 (cairo:context (%cairo-create-layout context))))
336 (defbinding %layout-new () pointer
339 (defbinding layout-copy () (referenced layout)
342 (defbinding layout-context-changed () nil
345 (defbinding %layout-set-text (text layout) nil
350 (defbinding layout-set-markup () nil
355 (defbinding layout-get-size () nil
360 (defbinding layout-get-pixel-size () nil
369 (defbinding (cairo-create-font-map "pango_cairo_font_map_new")
370 () (referenced font-map))
372 (defbinding cairo-font-map-get-default () font-map)
374 (defbinding cairo-font-map-create-context () (referenced context)
375 (font-map cairo-font-map))
377 (defbinding (cairo-context-resolution "pango_cairo_context_get_resolution")
381 (defbinding %cairo-context-set-resolution () nil
385 (defun (setf cairo-context-resolution) (dpi context)
386 (%cairo-context-set-resolution context dpi))
388 (defbinding (cairo-context-font-options "pango_cairo_context_get_font_options")
389 () cairo:font-options
392 (defbinding %cairo-context-set-font-options () nil
394 (font-options cairo:font-options))
396 (defun (setf cairo-context-font-options) (font-options context)
397 (%cairo-context-set-font-options context font-options))
399 (defbinding %cairo-create-layout () pointer
402 (defbinding cairo-update-layout () nil
406 (defbinding cairo-show-glyph-string () nil
409 (glyphs glyph-string))
411 (defbinding cairo-show-layout-line () nil
415 (defbinding cairo-show-layout () nil
419 (defbinding cairo-show-error-underline () nil
424 (height double-float))
426 (defbinding cairo-glyph-string-path () nil
429 (glyphs glyph-string))
431 (defbinding cairo-layout-line-path () nil
435 (defbinding cairo-layout-path () nil
439 (defbinding cairo-error-underline-path () nil
444 (height double-float))