← Back to branch summary

~ubuntu-branches/ubuntu/lucid/sawfish/lucid-updates

« back to all changes in this revision

Viewing changes to src/fonts.c

  • Committer: Bazaar Package Importer
  • Author(s): Christian Marillat
  • Date: 2005-02-23 16:16:46 UTC
  • mfrom: (1.2.1 upstream) (2.1.2 hoary)
  • Revision ID: james.westby@ubuntu.com-20050223161646-4id6qyw4h9lkvb0v
Tags: 1:1.3+cvs20050222-1
http://bugs.debian.org/295290
* New cvs release.
* Add an emacs initialisation script to load sawfish.el (Closes: #295290)
* Updated sawfish.el to 1.32

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/fonts.c
1
1
/* fonts.c -- font manipulation
2
 
   $Id: fonts.c,v 1.33 2001/03/26 19:35:03 jsh Exp $
 
2
   $Id: fonts.c,v 1.43 2004/10/17 22:58:17 jsh Exp $
3
3
 
4
4
   Copyright (C) 1999 John Harper <john@dcs.warwick.ac.uk>
5
5
 
42
42
#include <X11/Xlocale.h>
43
43
#include <ctype.h>
44
44
 
 
45
#ifdef HAVE_X11_XFT_XFT_H
 
46
# include <X11/Xft/Xft.h>
 
47
#else
 
48
# undef HAVE_PANGO
 
49
#endif
 
50
 
 
51
#ifdef HAVE_PANGO
 
52
# include <glib.h>
 
53
# define PANGO_ENABLE_BACKEND
 
54
# include <pango/pango.h>
 
55
# undef PANGO_ENABLE_BACKEND
 
56
# ifdef HAVE_PANGO_X
 
57
#  include <pango/pangox.h>
 
58
# endif
 
59
# ifdef HAVE_PANGO_XFT
 
60
#  define PANGO_ENABLE_ENGINE
 
61
#  include <pango/pangoxft.h>
 
62
#  undef PANGO_ENABLE_ENGINE
 
63
# endif
 
64
#endif
 
65
 
45
66
static Lisp_Font *font_list;
46
67
int font_type;
47
68
 
48
69
DEFSYM(default_font, "default-font");
49
70
 
50
 
static XFontSet x_create_font_set (char *xlfd, char ***missing,
51
 
                                   int *nmissing, char **def_string);
52
 
 
53
 
 
54
 
DEFUN("get-font", Fget_font, Sget_font, (repv name), rep_Subr1) /*
55
 
::doc:sawfish.wm.fonts#get-font::
56
 
get-font NAME
57
 
 
58
 
Return the font object representing the font named NAME (a standard X
59
 
font specifier string).
60
 
::end:: */
61
 
{
62
 
    Lisp_Font *f;
63
 
    rep_DECLARE1(name, rep_STRINGP);
64
 
 
65
 
    if (dpy == 0)
66
 
        return Qnil;
67
 
 
68
 
    f = font_list;
69
 
    while (f != 0 && strcmp (rep_STR(name), rep_STR(f->name)) != 0)
70
 
        f = f->next;
71
 
    if (f == 0)
72
 
    {
73
 
        repv tem = global_symbol_value (Qfonts_are_fontsets);
74
 
 
75
 
        XFontSet font_set = 0;
76
 
        XFontStruct *font_struct = 0;
77
 
        int ascent, descent;
78
 
        char **missing_charset_list, *def_string;
79
 
        int num_missing_charset_list;
80
 
 
81
 
        if (tem != Qnil)
82
 
        {
83
 
            font_set = x_create_font_set (rep_STR(name),
84
 
                                          &missing_charset_list,
85
 
                                          &num_missing_charset_list,
86
 
                                          &def_string);
87
 
        }
88
 
        if (font_set != 0)
89
 
        {
90
 
            XFontStruct **fstrs;
91
 
            char **font_names;
92
 
            int i, num_fonts;
93
 
            num_fonts = XFontsOfFontSet (font_set, &fstrs, &font_names);
94
 
            ascent = descent = 0;
95
 
            for (i = 0; i < num_fonts; i++)
96
 
            {
97
 
                if (fstrs[i]->ascent > ascent)
98
 
                    ascent = fstrs[i]->ascent;
99
 
                if (fstrs[i]->descent > descent)
100
 
                    descent = fstrs[i]->descent;
101
 
            }
102
 
            if (num_missing_charset_list > 0)
103
 
            {
104
 
                int i;
105
 
                fprintf (stderr, "Missing charsets in FontSet creation\n");
106
 
                for (i = 0; i < num_missing_charset_list; i++)
107
 
                    fprintf (stderr, "\t%s\n", missing_charset_list[i]);
108
 
                XFreeStringList (missing_charset_list);
109
 
            }
110
 
        }
111
 
        else
112
 
        {
113
 
            /* can't load a FontSet, try falling back to a FontStruct */
114
 
 
115
 
            font_struct = XLoadQueryFont (dpy, rep_STR (name));
116
 
            if (font_struct != 0)
117
 
            {
118
 
                ascent = font_struct->ascent;
119
 
                descent = font_struct->descent;
120
 
            }
121
 
            else
122
 
            {
123
 
                return Fsignal (Qerror,
124
 
                                rep_list_2 (rep_string_dup("no such font"),
125
 
                                            name));
126
 
            }
127
 
        }
128
 
 
129
 
        f = rep_ALLOC_CELL(sizeof(Lisp_Font));
130
 
        rep_data_after_gc += sizeof (Lisp_Font);
131
 
        f->car = font_type;
132
 
        f->next = font_list;
133
 
        font_list = f;
134
 
        f->name = name;
135
 
        f->plist = Qnil;
136
 
        f->ascent = ascent;
137
 
        f->descent = descent;
138
 
        if (font_set != 0)
139
 
            f->font.set = font_set;
140
 
        else
141
 
        {
142
 
            f->font.str = font_struct;
143
 
            f->car |= FF_FONT_STRUCT;
144
 
        }
145
 
    }
146
 
    return rep_VAL(f);
147
 
}
148
 
 
149
 
DEFUN("font-get", Ffont_get, Sfont_get, (repv win, repv prop), rep_Subr2) /*
150
 
::doc:sawfish.wm.fonts#font-get::
151
 
font-get FONT PROPERTY
152
 
 
153
 
Return the property PROPERTY (a symbol) associated with FONT.
154
 
::end:: */
155
 
{
156
 
    repv plist;
157
 
    rep_DECLARE1(win, FONTP);
158
 
    plist = VFONT(win)->plist;
159
 
    while (rep_CONSP(plist) && rep_CONSP(rep_CDR(plist)))
160
 
    {
161
 
        if (rep_CAR(plist) == prop
162
 
            || (!rep_SYMBOLP(prop)
163
 
                && rep_value_cmp (rep_CAR(plist), prop) == 0))
164
 
        {
165
 
            return rep_CAR(rep_CDR(plist));
166
 
        }
167
 
        plist = rep_CDR(rep_CDR(plist));
168
 
    }
169
 
    return Qnil;
170
 
}
171
 
 
172
 
DEFUN("font-put", Ffont_put, Sfont_put, (repv win, repv prop, repv val), rep_Subr3) /*
173
 
::doc:sawfish.wm.fonts#font-put::
174
 
font-put FONT PROPERTY VALUE
175
 
 
176
 
Set the property PROPERTY (a symbol) associated with FONT to VALUE.
177
 
::end:: */
178
 
{
179
 
    repv plist;
180
 
    rep_DECLARE1(win, FONTP);
181
 
    plist = VFONT(win)->plist;
182
 
    while (rep_CONSP(plist) && rep_CONSP(rep_CDR(plist)))
183
 
    {
184
 
        if (rep_CAR(plist) == prop
185
 
            || (!rep_SYMBOLP(prop)
186
 
                && rep_value_cmp (rep_CAR(plist), prop) == 0))
187
 
        {
188
 
            rep_CAR(rep_CDR(plist)) = val;
189
 
            return val;
190
 
        }
191
 
        plist = rep_CDR(rep_CDR(plist));
192
 
    }
193
 
    plist = Fcons(prop, Fcons(val, VFONT(win)->plist));
194
 
    if (plist != rep_NULL)
195
 
        VFONT(win)->plist = plist;
196
 
    return val;
197
 
}
198
 
 
199
 
DEFUN("font-name", Ffont_name, Sfont_name, (repv font), rep_Subr1) /*
200
 
::doc:sawfish.wm.fonts#font-name::
201
 
font-name FONT
202
 
 
203
 
Return the name of the font represented by the font object FONT.
204
 
::end:: */
205
 
{
206
 
    rep_DECLARE1(font, FONTP);
207
 
    return VFONT(font)->name;
208
 
}
209
 
 
210
 
DEFUN("fontp", Ffontp, Sfontp, (repv win), rep_Subr1) /*
211
 
::doc:sawfish.wm.fonts#fontp::
212
 
fontp ARG
213
 
 
214
 
Return t if ARG is a font object.
215
 
::end:: */
216
 
{
217
 
    return FONTP(win) ? Qt : Qnil;
218
 
}
219
 
 
220
 
int
221
 
x_text_width (repv font, u_char *string, size_t len)
222
 
{
223
 
    if (FONT_STRUCT_P (font))
224
 
        return XTextWidth (VFONT(font)->font.str, string, len);
225
 
    else
226
 
        return XmbTextEscapement (VFONT(font)->font.set, string, len);
227
 
}
228
 
 
229
 
void
230
 
x_draw_string (Window id, repv font, GC gc,
231
 
               int x, int y, u_char *string, size_t len)
232
 
{
233
 
    if (FONT_STRUCT_P (font))
234
 
    {
235
 
        XSetFont (dpy, gc, VFONT(font)->font.str->fid);
236
 
        XDrawString (dpy, id, gc, x, y, string, len);
237
 
    }
238
 
    else
239
 
        XmbDrawString (dpy, id, VFONT(font)->font.set, gc, x, y, string, len);
240
 
}
241
 
 
242
 
DEFUN("text-width", Ftext_width, Stext_width, (repv string, repv font), rep_Subr2) /*
243
 
::doc:sawfish.wm.fonts#text-width::
244
 
text-width STRING [FONT]
245
 
 
246
 
Return the number of horizontal pixels that would be required to display
247
 
the text STRING using font object FONT (or the default-font).
248
 
::end:: */
249
 
{
250
 
    rep_DECLARE1(string, rep_STRINGP);
251
 
    if (font == Qnil)
252
 
        font = global_symbol_value (Qdefault_font);
253
 
    rep_DECLARE2(font, FONTP);
254
 
    return rep_MAKE_INT (x_text_width (font, rep_STR(string),
255
 
                                       rep_STRING_LEN(string)));
256
 
}
257
 
 
258
 
DEFUN("font-height", Ffont_height, Sfont_height, (repv font), rep_Subr1) /*
259
 
::doc:sawfish.wm.fonts#font-height::
260
 
font-height [FONT]
261
 
 
262
 
Return the bounding height of glyphs rendered using FONT (or the
263
 
default-font).
264
 
::end:: */
265
 
{
266
 
    if (font == Qnil)
267
 
        font = global_symbol_value (Qdefault_font);
268
 
    rep_DECLARE1(font, FONTP);
269
 
    return rep_MAKE_INT(VFONT(font)->ascent + VFONT(font)->descent);
270
 
}
271
 
 
272
 
DEFUN("font-ascent", Ffont_ascent, Sfont_ascent, (repv font), rep_Subr1) /*
273
 
::doc:sawfish.wm.fonts#font-ascent::
274
 
font-ascent [FONT]
275
 
 
276
 
Return the ascent of glyphs rendered using FONT (or the
277
 
default-font).
278
 
::end:: */
279
 
{
280
 
    if (font == Qnil)
281
 
        font = global_symbol_value (Qdefault_font);
282
 
    rep_DECLARE1(font, FONTP);
283
 
    return rep_MAKE_INT(VFONT(font)->ascent);
284
 
}
285
 
 
286
 
DEFUN("font-descent", Ffont_descent, Sfont_descent, (repv font), rep_Subr1) /*
287
 
::doc:sawfish.wm.fonts#font-descent::
288
 
font-descent [FONT]
289
 
 
290
 
Return the descent of glyphs rendered using FONT (or the
291
 
default-font).
292
 
::end:: */
293
 
{
294
 
    if (font == Qnil)
295
 
        font = global_symbol_value (Qdefault_font);
296
 
    rep_DECLARE1(font, FONTP);
297
 
    return rep_MAKE_INT(VFONT(font)->descent);
298
 
}
299
 
 
300
 
 
301
 
/* XLFD pattern matching */
 
71
struct Lisp_Font_Class_struct {
 
72
    const char *type;
 
73
    bool (*load) (Lisp_Font *f);
 
74
    void (*finalize) (Lisp_Font *f);
 
75
    int (*measure) (Lisp_Font *f, u_char *string, size_t length);
 
76
    void (*draw) (Lisp_Font *f, u_char *string, size_t length,
 
77
                  Window id, GC gc, Lisp_Color *fg, int x, int y);
 
78
};
 
79
 
 
80
 
 
81
/* Xlib font structs */
 
82
 
 
83
static bool
 
84
fontstruct_load (Lisp_Font *f)
 
85
{
 
86
    XFontStruct *font_struct;
 
87
 
 
88
    font_struct = XLoadQueryFont (dpy, rep_STR (f->name));
 
89
 
 
90
    if (font_struct == 0)
 
91
        return FALSE;
 
92
 
 
93
    f->font = font_struct;
 
94
    f->ascent = font_struct->ascent;
 
95
    f->descent = font_struct->descent;
 
96
 
 
97
    return TRUE;
 
98
}
 
99
 
 
100
static void
 
101
fontstruct_finalize (Lisp_Font *f)
 
102
{
 
103
    XFreeFont (dpy, f->font);
 
104
}
 
105
 
 
106
static int
 
107
fontstruct_measure (Lisp_Font *f, u_char *string, size_t length)
 
108
{
 
109
    return XTextWidth (f->font, string, length);
 
110
}
 
111
 
 
112
static void
 
113
fontstruct_draw (Lisp_Font *f, u_char *string, size_t length,
 
114
                 Window id, GC gc, Lisp_Color *fg, int x, int y)
 
115
{
 
116
    XFontStruct *fs;
 
117
    XGCValues gcv;
 
118
 
 
119
    fs = f->font;
 
120
 
 
121
    gcv.foreground = fg->pixel;
 
122
    gcv.font = fs->fid;
 
123
    XChangeGC (dpy, gc, GCForeground | GCFont, &gcv);
 
124
 
 
125
    XDrawString (dpy, id, gc, x, y, string, length);
 
126
}
 
127
 
 
128
static const Lisp_Font_Class fontstruct_class = {
 
129
    "xlfd",
 
130
    fontstruct_load, fontstruct_finalize,
 
131
    fontstruct_measure, fontstruct_draw,
 
132
};
 
133
 
 
134
 
 
135
/* Xlib font sets */
302
136
 
303
137
static char *
304
138
xlfd_get_element (const char *xlfd, int idx)
361
195
}
362
196
 
363
197
static XFontSet
364
 
x_create_font_set (char *xlfd, char ***missing,
 
198
x_create_fontset (char *xlfd, char ***missing,
365
199
                   int *nmissing, char **def_string)
366
200
{
367
201
    XFontSet fs = XCreateFontSet (dpy, xlfd, missing, nmissing, def_string);
421
255
    return fs;
422
256
}
423
257
 
 
258
static bool
 
259
fontset_load (Lisp_Font *f)
 
260
{
 
261
    XFontSet font_set;
 
262
    int ascent, descent;
 
263
 
 
264
    char **missing_charset_list, *def_string;
 
265
    int num_missing_charset_list;
 
266
 
 
267
    font_set = x_create_fontset (rep_STR (f->name),
 
268
                                 &missing_charset_list,
 
269
                                 &num_missing_charset_list,
 
270
                                 &def_string);
 
271
 
 
272
    if (font_set != 0)
 
273
    {
 
274
        XFontStruct **fstrs;
 
275
        char **font_names;
 
276
        int i, j, num_fonts;
 
277
 
 
278
        f->font = font_set;
 
279
 
 
280
        num_fonts = XFontsOfFontSet (font_set, &fstrs, &font_names);
 
281
        ascent = descent = 0;
 
282
 
 
283
        for (i = 0; i < num_fonts; i++)
 
284
        {
 
285
            if (fstrs[i]->ascent > ascent)
 
286
                f->ascent = fstrs[i]->ascent;
 
287
            if (fstrs[i]->descent > descent)
 
288
                f->descent = fstrs[i]->descent;
 
289
        }
 
290
 
 
291
        if (num_missing_charset_list > 0)
 
292
        {
 
293
            fprintf (stderr, "Missing charsets in FontSet creation\n");
 
294
            for (j = 0; j < num_missing_charset_list; j++)
 
295
                fprintf (stderr, "\t%s\n", missing_charset_list[j]);
 
296
            XFreeStringList (missing_charset_list);
 
297
        }
 
298
 
 
299
        return TRUE;
 
300
    }
 
301
 
 
302
    return FALSE;
 
303
}
 
304
 
 
305
static void
 
306
fontset_finalize (Lisp_Font *f)
 
307
{
 
308
    XFreeFontSet (dpy, f->font);
 
309
}
 
310
 
 
311
static int
 
312
fontset_measure (Lisp_Font *f, u_char *string, size_t length)
 
313
{
 
314
    return XmbTextEscapement (f->font, string, length);
 
315
}
 
316
 
 
317
static void
 
318
fontset_draw (Lisp_Font *f, u_char *string, size_t length,
 
319
              Window id, GC gc, Lisp_Color *fg, int x, int y)
 
320
{
 
321
    XGCValues gcv;
 
322
 
 
323
    gcv.foreground = fg->pixel;
 
324
    XChangeGC (dpy, gc, GCForeground, &gcv);
 
325
 
 
326
    XmbDrawString (dpy, id, f->font, gc, x, y, string, length);
 
327
}
 
328
 
 
329
static const Lisp_Font_Class fontset_class = {
 
330
    "xlfd",
 
331
    fontset_load, fontset_finalize,
 
332
    fontset_measure, fontset_draw,
 
333
};
 
334
 
 
335
 
 
336
/* Xft fonts */
 
337
 
 
338
#ifdef HAVE_X11_XFT_XFT_H
 
339
 
 
340
static bool
 
341
xft_load (Lisp_Font *f)
 
342
{
 
343
    XftFont *xft_font;
 
344
 
 
345
    xft_font = XftFontOpenName (dpy, screen_num, rep_STR (f->name));
 
346
 
 
347
    if (xft_font == 0)
 
348
        return FALSE;
 
349
 
 
350
    f->font = xft_font;
 
351
    f->ascent = xft_font->ascent;
 
352
    f->descent = xft_font->descent;
 
353
 
 
354
    return TRUE;
 
355
}
 
356
 
 
357
static void
 
358
xft_finalize (Lisp_Font *f)
 
359
{
 
360
    XftFontClose (dpy, f->font);
 
361
}
 
362
 
 
363
static int
 
364
xft_measure (Lisp_Font *f, u_char *string, size_t length)
 
365
{
 
366
    XGlyphInfo info;
 
367
 
 
368
    XftTextExtents8 (dpy, f->font, string, length, &info);
 
369
 
 
370
    return info.xOff; 
 
371
}
 
372
 
 
373
static void
 
374
xft_draw (Lisp_Font *f, u_char *string, size_t length,
 
375
          Window id, GC gc, Lisp_Color *fg, int x, int y)
 
376
{
 
377
    static XftDraw *draw;
 
378
 
 
379
    XftColor xft_color;
 
380
 
 
381
    if (draw == 0)
 
382
        draw = XftDrawCreate (dpy, id, image_visual, image_cmap);
 
383
    else
 
384
        XftDrawChange (draw, id);
 
385
 
 
386
    xft_color.pixel = fg->pixel;
 
387
    xft_color.color.red = fg->red;
 
388
    xft_color.color.green = fg->green;
 
389
    xft_color.color.blue = fg->blue;
 
390
    xft_color.color.alpha = fg->alpha;
 
391
 
 
392
    XftDrawString8 (draw, &xft_color, f->font,
 
393
                    x, y, string, length);
 
394
}
 
395
 
 
396
static const Lisp_Font_Class xft_class = {
 
397
    "Xft",
 
398
    xft_load, xft_finalize,
 
399
    xft_measure, xft_draw,
 
400
};
 
401
 
 
402
#endif /* HAVE_X11_XFT_XFT_H */
 
403
 
 
404
 
 
405
/* Pango fonts */
 
406
 
 
407
#ifdef HAVE_PANGO
 
408
 
 
409
static PangoContext *pango_context;
 
410
 
 
411
static bool
 
412
pango_load (Lisp_Font *f)
 
413
{
 
414
    PangoLanguage *language;
 
415
    PangoFontDescription *fontdesc;
 
416
    PangoFont *font;
 
417
    PangoFontMetrics *metrics;
 
418
 
 
419
    if (pango_context)
 
420
    {
 
421
        language = pango_context_get_language (pango_context);
 
422
    }
 
423
    else
 
424
    {
 
425
        char *langname, *p;
 
426
 
 
427
#ifdef HAVE_PANGO_XFT
 
428
        pango_context = pango_xft_get_context (dpy, screen_num);
 
429
#else
 
430
        pango_context = pango_x_get_context (dpy, screen_num);
 
431
#endif
 
432
 
 
433
        langname = g_strdup (setlocale (LC_CTYPE, NULL));
 
434
        p = strchr (langname, '.');
 
435
        if (p)
 
436
            *p = 0;
 
437
        p = strchr (langname, '@');
 
438
        if (p)
 
439
            *p = 0;
 
440
        language = pango_language_from_string (langname);
 
441
        pango_context_set_language (pango_context, language);
 
442
        g_free (langname);
 
443
    }
 
444
 
 
445
    fontdesc = pango_font_description_from_string (rep_STR (f->name));
 
446
 
 
447
    if (!pango_font_description_get_family (fontdesc))
 
448
        pango_font_description_set_family (fontdesc, "Sans");
 
449
    if (pango_font_description_get_size (fontdesc) <= 0)
 
450
        pango_font_description_set_size (fontdesc, 12 * PANGO_SCALE);
 
451
 
 
452
    pango_context_set_font_description (pango_context, fontdesc);
 
453
    font = pango_context_load_font (pango_context, fontdesc);
 
454
 
 
455
    if (!font)
 
456
        return FALSE;
 
457
 
 
458
    metrics = pango_font_get_metrics (font, language);
 
459
 
 
460
    f->font = font;
 
461
    f->ascent = metrics->ascent / PANGO_SCALE;
 
462
    f->descent = metrics->descent / PANGO_SCALE;
 
463
 
 
464
    pango_font_metrics_unref (metrics);
 
465
 
 
466
    return TRUE;
 
467
}
 
468
 
 
469
static void
 
470
pango_finalize (Lisp_Font *f)
 
471
{
 
472
    g_object_unref (f->font);
 
473
}
 
474
 
 
475
static int
 
476
pango_measure (Lisp_Font *f, u_char *string, size_t length)
 
477
{
 
478
    gsize r, w;
 
479
    u_char *utf8str;
 
480
    PangoLayout *layout;
 
481
    PangoRectangle rect;
 
482
 
 
483
    utf8str = g_locale_to_utf8 (string, length, &r, &w, NULL);
 
484
    if (utf8str != NULL)
 
485
    {
 
486
        string = utf8str;
 
487
        length = w;
 
488
    }
 
489
 
 
490
    layout = pango_layout_new (pango_context);
 
491
    pango_layout_set_text (layout, string, length);
 
492
 
 
493
    pango_layout_get_extents (layout, NULL, &rect);
 
494
 
 
495
    g_free (utf8str);
 
496
    g_object_unref (layout);
 
497
 
 
498
    return rect.width / PANGO_SCALE;
 
499
}
 
500
 
 
501
static void
 
502
pango_draw_line (XftDraw *draw, Window id, GC gc, XftColor *xft_color,
 
503
                 PangoLayoutLine *line, int x, int y)
 
504
{
 
505
    GSList *p;
 
506
 
 
507
    for (p = line->runs; p != NULL; p = p->next)
 
508
    {
 
509
        PangoLayoutRun *run = p->data;
 
510
        PangoFont *font = run->item->analysis.font;
 
511
        PangoGlyphString *glyphs = run->glyphs;
 
512
        PangoRectangle rect;
 
513
 
 
514
        pango_glyph_string_extents (glyphs, font, NULL, &rect);
 
515
#ifdef HAVE_PANGO_XFT
 
516
        if (PANGO_XFT_IS_FONT (font))
 
517
            pango_xft_render (draw, xft_color, font, glyphs, x, y);
 
518
        else
 
519
#endif
 
520
            pango_x_render (dpy, id, gc, font, glyphs, x, y);
 
521
 
 
522
        x += rect.width / PANGO_SCALE;
 
523
    }
 
524
}
 
525
 
 
526
static void
 
527
pango_draw (Lisp_Font *f, u_char *string, size_t length,
 
528
            Window id, GC gc, Lisp_Color *fg, int x, int y)
 
529
{
 
530
    static XftDraw *draw;
 
531
    XftColor xft_color;
 
532
    gsize r, w;
 
533
    u_char *utf8str;
 
534
    PangoLayout *layout;
 
535
    PangoLayoutIter *iter;
 
536
 
 
537
    if (draw == 0)
 
538
        draw = XftDrawCreate (dpy, id, image_visual, image_cmap);
 
539
    else
 
540
        XftDrawChange (draw, id);
 
541
 
 
542
    xft_color.pixel = fg->pixel;
 
543
    xft_color.color.red = fg->red;
 
544
    xft_color.color.green = fg->green;
 
545
    xft_color.color.blue = fg->blue;
 
546
    xft_color.color.alpha = fg->alpha;
 
547
 
 
548
    utf8str = g_locale_to_utf8 (string, length, &r, &w, NULL);
 
549
    if (utf8str != NULL)
 
550
    {
 
551
        string = utf8str;
 
552
        length = w;
 
553
    }
 
554
 
 
555
    layout = pango_layout_new (pango_context);
 
556
    pango_layout_set_text (layout, string, length);
 
557
    iter = pango_layout_get_iter (layout);
 
558
 
 
559
    do {
 
560
        PangoLayoutLine *line = pango_layout_iter_get_line (iter);
 
561
        PangoRectangle rect;
 
562
 
 
563
        pango_layout_iter_get_line_extents (iter, NULL, &rect);
 
564
        pango_draw_line (draw, id, gc, &xft_color,
 
565
                         line, x + rect.x / PANGO_SCALE, y);
 
566
    } while (pango_layout_iter_next_line (iter));
 
567
 
 
568
    g_free (utf8str);
 
569
    g_object_unref (layout);
 
570
    pango_layout_iter_free (iter);
 
571
}
 
572
 
 
573
static const Lisp_Font_Class pango_class = {
 
574
    "pango",
 
575
    pango_load, pango_finalize,
 
576
    pango_measure, pango_draw,
 
577
};
 
578
 
 
579
#endif /* HAVE_PANGO */
 
580
 
 
581
 
 
582
/* All classes */
 
583
 
 
584
static const Lisp_Font_Class *classes[] = {
 
585
    &fontstruct_class,
 
586
    &fontset_class,
 
587
#ifdef HAVE_X11_XFT_XFT_H
 
588
    &xft_class,
 
589
#endif
 
590
#ifdef HAVE_PANGO
 
591
    &pango_class,
 
592
#endif
 
593
    0,
 
594
};
 
595
 
 
596
 
 
597
/* Entry points */
 
598
 
 
599
DEFUN ("font-type-exists-p", Ffont_type_exists_p,
 
600
       Sfont_type_exists_p, (repv type), rep_Subr1) /*
 
601
::doc:sawfish.wm.fonts#font-type-exists-p::
 
602
font-type-exists-p TYPE
 
603
 
 
604
Returns true if fonts with the type described by the string TYPE can be
 
605
loaded.
 
606
::end:: */
 
607
{
 
608
    int i;
 
609
 
 
610
    rep_DECLARE1 (type, rep_STRINGP);
 
611
 
 
612
    for (i = 0; classes[i] != 0; i++)
 
613
    {
 
614
        if (strcasecmp (rep_STR (type), classes[i]->type) == 0)
 
615
            return Qt;
 
616
    }
 
617
 
 
618
    return Qnil;
 
619
}
 
620
 
 
621
DEFUN("get-font-typed", Fget_font_typed, Sget_font_typed,
 
622
      (repv type, repv name), rep_Subr2) /*
 
623
::doc:sawfish.wm.fonts#get-font-typed::
 
624
get-font-typed TYPE NAME
 
625
 
 
626
Return the font object representing the font named NAME. NAME is
 
627
interpreted based on the value of the string TYPE.
 
628
::end:: */
 
629
{
 
630
    Lisp_Font *f;
 
631
    const Lisp_Font_Class *class;
 
632
    repv tem;
 
633
    int i;
 
634
 
 
635
    rep_DECLARE1(name, rep_STRINGP);
 
636
    rep_DECLARE2(type, rep_STRINGP);
 
637
 
 
638
    if (dpy == 0)
 
639
        return Qnil;
 
640
 
 
641
    for (f = font_list; f != NULL; f = f->next)
 
642
    {
 
643
        if (strcmp (rep_STR(name), rep_STR(f->name)) == 0
 
644
            && strcmp (rep_STR (type), rep_STR (f->type)) == 0)
 
645
        {
 
646
            return rep_VAL (f);
 
647
        }
 
648
    }
 
649
 
 
650
    class = 0;
 
651
 
 
652
    if (strcasecmp (rep_STR (type), "xlfd") == 0)
 
653
    {
 
654
        /* Boring old X core fonts */
 
655
 
 
656
        tem = global_symbol_value (Qfonts_are_fontsets);
 
657
        if (tem != Qnil)
 
658
            class = &fontset_class;
 
659
        else
 
660
            class = &fontstruct_class;
 
661
    }
 
662
    else
 
663
    {
 
664
        for (i = 0; classes[i] != 0; i++)
 
665
        {
 
666
            if (strcasecmp (rep_STR (type), classes[i]->type) == 0)
 
667
            {
 
668
                class = classes[i];
 
669
                break;
 
670
            }
 
671
        }
 
672
    }
 
673
 
 
674
    if (class == 0)
 
675
    {
 
676
        DEFSTRING (err, "unknown font type");
 
677
        return Fsignal (Qerror, rep_list_2 (rep_VAL (&err), type));
 
678
    }
 
679
        
 
680
    f = rep_ALLOC_CELL(sizeof(Lisp_Font));
 
681
 
 
682
    f->car = font_type;
 
683
    f->class = class;
 
684
    f->type = type;
 
685
    f->name = name;
 
686
    f->plist = Qnil;
 
687
 
 
688
    if (!(*class->load) (f))
 
689
    {
 
690
        DEFSTRING (err, "unknown font");
 
691
 
 
692
        rep_FREE_CELL (f);
 
693
        return Fsignal (Qerror, rep_list_2 (rep_VAL (&err), name));
 
694
    }
 
695
 
 
696
    rep_data_after_gc += sizeof (Lisp_Font);
 
697
 
 
698
    f->next = font_list;
 
699
    font_list = f;
 
700
 
 
701
    return rep_VAL (f);
 
702
}
 
703
 
 
704
DEFUN("get-font", Fget_font, Sget_font, (repv name), rep_Subr1) /*
 
705
::doc:sawfish.wm.fonts#get-font::
 
706
get-font NAME
 
707
 
 
708
Return the font object representing the font named NAME (a standard X
 
709
font specifier string).
 
710
::end:: */
 
711
{
 
712
    DEFSTRING (type, "xlfd");
 
713
 
 
714
    return Fget_font_typed (rep_VAL (&type), name);
 
715
}
 
716
 
 
717
DEFUN("font-get", Ffont_get, Sfont_get, (repv win, repv prop), rep_Subr2) /*
 
718
::doc:sawfish.wm.fonts#font-get::
 
719
font-get FONT PROPERTY
 
720
 
 
721
Return the property PROPERTY (a symbol) associated with FONT.
 
722
::end:: */
 
723
{
 
724
    repv plist;
 
725
    rep_DECLARE1(win, FONTP);
 
726
    plist = VFONT(win)->plist;
 
727
    while (rep_CONSP(plist) && rep_CONSP(rep_CDR(plist)))
 
728
    {
 
729
        if (rep_CAR(plist) == prop
 
730
            || (!rep_SYMBOLP(prop)
 
731
                && rep_value_cmp (rep_CAR(plist), prop) == 0))
 
732
        {
 
733
            return rep_CAR(rep_CDR(plist));
 
734
        }
 
735
        plist = rep_CDR(rep_CDR(plist));
 
736
    }
 
737
    return Qnil;
 
738
}
 
739
 
 
740
DEFUN("font-put", Ffont_put, Sfont_put, (repv win, repv prop, repv val), rep_Subr3) /*
 
741
::doc:sawfish.wm.fonts#font-put::
 
742
font-put FONT PROPERTY VALUE
 
743
 
 
744
Set the property PROPERTY (a symbol) associated with FONT to VALUE.
 
745
::end:: */
 
746
{
 
747
    repv plist;
 
748
    rep_DECLARE1(win, FONTP);
 
749
    plist = VFONT(win)->plist;
 
750
    while (rep_CONSP(plist) && rep_CONSP(rep_CDR(plist)))
 
751
    {
 
752
        if (rep_CAR(plist) == prop
 
753
            || (!rep_SYMBOLP(prop)
 
754
                && rep_value_cmp (rep_CAR(plist), prop) == 0))
 
755
        {
 
756
            rep_CAR(rep_CDR(plist)) = val;
 
757
            return val;
 
758
        }
 
759
        plist = rep_CDR(rep_CDR(plist));
 
760
    }
 
761
    plist = Fcons(prop, Fcons(val, VFONT(win)->plist));
 
762
    if (plist != rep_NULL)
 
763
        VFONT(win)->plist = plist;
 
764
    return val;
 
765
}
 
766
 
 
767
DEFUN("font-type", Ffont_type, Sfont_type, (repv font), rep_Subr1) /*
 
768
::doc:sawfish.wm.fonts#font-type::
 
769
font-type FONT
 
770
 
 
771
Return the type of the font represented by the font object FONT.
 
772
::end:: */
 
773
{
 
774
    rep_DECLARE1(font, FONTP);
 
775
    return VFONT(font)->type;
 
776
}
 
777
 
 
778
DEFUN("font-name", Ffont_name, Sfont_name, (repv font), rep_Subr1) /*
 
779
::doc:sawfish.wm.fonts#font-name::
 
780
font-name FONT
 
781
 
 
782
Return the name of the font represented by the font object FONT.
 
783
::end:: */
 
784
{
 
785
    rep_DECLARE1(font, FONTP);
 
786
    return VFONT(font)->name;
 
787
}
 
788
 
 
789
DEFUN("fontp", Ffontp, Sfontp, (repv win), rep_Subr1) /*
 
790
::doc:sawfish.wm.fonts#fontp::
 
791
fontp ARG
 
792
 
 
793
Return t if ARG is a font object.
 
794
::end:: */
 
795
{
 
796
    return FONTP(win) ? Qt : Qnil;
 
797
}
 
798
 
 
799
int
 
800
x_text_width (repv font, u_char *string, size_t len)
 
801
{
 
802
    return (*VFONT (font)->class->measure) (VFONT (font), string, len);
 
803
}
 
804
 
 
805
/* The foreground pixel of GC is undefined after this function returns. */
 
806
void
 
807
x_draw_string (Window id, repv font, GC gc, Lisp_Color *fg_color,
 
808
               int x, int y, u_char *string, size_t len)
 
809
{
 
810
    (*VFONT (font)->class->draw) (VFONT (font), string, len,
 
811
                                  id, gc, fg_color, x, y);
 
812
}
 
813
 
 
814
DEFUN("text-width", Ftext_width, Stext_width, (repv string, repv font), rep_Subr2) /*
 
815
::doc:sawfish.wm.fonts#text-width::
 
816
text-width STRING [FONT]
 
817
 
 
818
Return the number of horizontal pixels that would be required to display
 
819
the text STRING using font object FONT (or the default-font).
 
820
::end:: */
 
821
{
 
822
    rep_DECLARE1(string, rep_STRINGP);
 
823
    if (font == Qnil)
 
824
        font = global_symbol_value (Qdefault_font);
 
825
    rep_DECLARE2(font, FONTP);
 
826
    return rep_MAKE_INT (x_text_width (font, rep_STR(string),
 
827
                                       rep_STRING_LEN(string)));
 
828
}
 
829
 
 
830
DEFUN("font-height", Ffont_height, Sfont_height, (repv font), rep_Subr1) /*
 
831
::doc:sawfish.wm.fonts#font-height::
 
832
font-height [FONT]
 
833
 
 
834
Return the bounding height of glyphs rendered using FONT (or the
 
835
default-font).
 
836
::end:: */
 
837
{
 
838
    if (font == Qnil)
 
839
        font = global_symbol_value (Qdefault_font);
 
840
    rep_DECLARE1(font, FONTP);
 
841
    return rep_MAKE_INT(VFONT(font)->ascent + VFONT(font)->descent);
 
842
}
 
843
 
 
844
DEFUN("font-ascent", Ffont_ascent, Sfont_ascent, (repv font), rep_Subr1) /*
 
845
::doc:sawfish.wm.fonts#font-ascent::
 
846
font-ascent [FONT]
 
847
 
 
848
Return the ascent of glyphs rendered using FONT (or the
 
849
default-font).
 
850
::end:: */
 
851
{
 
852
    if (font == Qnil)
 
853
        font = global_symbol_value (Qdefault_font);
 
854
    rep_DECLARE1(font, FONTP);
 
855
    return rep_MAKE_INT(VFONT(font)->ascent);
 
856
}
 
857
 
 
858
DEFUN("font-descent", Ffont_descent, Sfont_descent, (repv font), rep_Subr1) /*
 
859
::doc:sawfish.wm.fonts#font-descent::
 
860
font-descent [FONT]
 
861
 
 
862
Return the descent of glyphs rendered using FONT (or the
 
863
default-font).
 
864
::end:: */
 
865
{
 
866
    if (font == Qnil)
 
867
        font = global_symbol_value (Qdefault_font);
 
868
    rep_DECLARE1(font, FONTP);
 
869
    return rep_MAKE_INT(VFONT(font)->descent);
 
870
}
 
871
 
424
872
 
425
873
/* type hooks */
426
874
 
434
882
font_prin (repv stream, repv obj)
435
883
{
436
884
    char buf[256];
437
 
    sprintf (buf, "#<font %s>", rep_STR(VFONT(obj)->name));
 
885
    sprintf (buf, "#<font %s:%s>",
 
886
             rep_STR(VFONT(obj)->type), rep_STR(VFONT(obj)->name));
438
887
    rep_stream_puts (stream, buf, -1, FALSE);
439
888
}
440
889
 
441
890
static void
442
891
font_mark (repv obj)
443
892
{
 
893
    rep_MARKVAL(VFONT(obj)->type);
444
894
    rep_MARKVAL(VFONT(obj)->name);
445
895
    rep_MARKVAL(VFONT(obj)->plist);
446
896
}
453
903
    while (w != 0)
454
904
    {
455
905
        Lisp_Font *next = w->next;
 
906
 
456
907
        if (!rep_GC_CELL_MARKEDP(rep_VAL(w)))
457
908
        {
458
 
            if (FONT_STRUCT_P (rep_VAL (w)))
459
 
                XFreeFont (dpy, w->font.str);
460
 
            else
461
 
                XFreeFontSet (dpy, w->font.set);
 
909
            (*w->class->finalize) (w);
462
910
            rep_FREE_CELL(w);
463
911
        }
464
912
        else
471
919
    }
472
920
}
473
921
 
 
922
static int
 
923
use_xft (void)
 
924
{
 
925
    char *val = getenv ("GDK_USE_XFT");
 
926
 
 
927
    return val == NULL || strcmp (val, "0") != 0;
 
928
}
 
929
 
474
930
 
475
931
/* initialisation */
476
932
 
481
937
    font_type = rep_register_new_type ("font", font_cmp, font_prin, font_prin,
482
938
                                       font_sweep, font_mark,
483
939
                                       0, 0, 0, 0, 0, 0, 0);
 
940
 
 
941
    rep_ADD_SUBR(Sfont_type_exists_p);
 
942
    rep_ADD_SUBR(Sget_font_typed);
484
943
    rep_ADD_SUBR(Sget_font);
485
944
    rep_ADD_SUBR(Sfont_get);
486
945
    rep_ADD_SUBR(Sfont_put);
 
946
    rep_ADD_SUBR(Sfont_type);
487
947
    rep_ADD_SUBR(Sfont_name);
488
948
    rep_ADD_SUBR(Sfontp);
489
949
    rep_ADD_SUBR(Stext_width);
494
954
    rep_INTERN_SPECIAL(default_font);
495
955
    if (!batch_mode_p ())
496
956
    {
497
 
        repv font = Fget_font (rep_string_dup("fixed"));
 
957
        DEFSTRING (xlfd_type, "xlfd");
 
958
        DEFSTRING (xlfd_name, "fixed");
 
959
        DEFSTRING (xft_type, "Xft");
 
960
        DEFSTRING (xft_name, "Sans");
 
961
        DEFSTRING (pango_type, "Pango");
 
962
        DEFSTRING (pango_name, "Sans");
 
963
 
 
964
        repv font = Qnil;
 
965
 
 
966
        if (use_xft ())
 
967
        {
 
968
#ifdef HAVE_PANGO
 
969
            font = Fget_font_typed (rep_VAL (&pango_type),
 
970
                                    rep_VAL (&pango_name));
 
971
            if (font == rep_NULL || !FONTP (font))
 
972
#endif
 
973
            {
 
974
                font = Fget_font_typed (rep_VAL (&xft_type),
 
975
                                        rep_VAL (&xft_name));
 
976
            }
 
977
        }
 
978
 
 
979
        if (font == rep_NULL || !FONTP (font))
 
980
        {
 
981
            font = Fget_font_typed (rep_VAL (&xlfd_type),
 
982
                                    rep_VAL (&xlfd_name));
 
983
        }
 
984
 
498
985
        if (font == rep_NULL || !FONTP(font))
499
986
        {
500
 
            fputs ("can't load fixed font during initialisation", stderr);
 
987
            fputs ("can't load default font during initialisation", stderr);
501
988
            rep_throw_value = rep_NULL;
502
989
            font = Qnil;
503
990
        }
 
991
 
504
992
        Fset (Qdefault_font, font);
505
993
    }
506
994
    rep_pop_structure (tem);