← Back to branch summary

~ubuntu-branches/ubuntu/trusty/sawfish/trusty

« back to all changes in this revision

Viewing changes to lisp/sawfish/gtk/widgets/font.jl

  • Committer: Bazaar Package Importer
  • Author(s): Luis Rodrigo Gallardo Cruz
  • Date: 2008-02-18 16:27:26 UTC
  • mfrom: (1.2.7 upstream) (3.1.2 lenny)
  • Revision ID: james.westby@ubuntu.com-20080218162726-3a5v48p33qaki37z
Tags: 1:1.3.3-1
http://bugs.debian.org/464139
http://bugs.debian.org/269905
* New Upstream Release.
 - Fixes encoding issues introduced by the use of UTF-8 in
  1.3.2. (Closes: #464139).
 - Fixes pango fonts handling, to allow more than one to be used at a
  time (Closes: #269905).
 - Fixes interaction with KDE systray.
* Loosen overly tight build-dependency on gettext, and tighten the one
  on quilt (We use the makefile snippet from 0.40-1)

Show diffs side-by-side

added added

removed removed

Lines of Context:
lisp/sawfish/gtk/widgets/font.jl
 
1
#| nokogiri-widgets/font.jl -- font selection widget
 
2
 
 
3
   $Id: font.jl.in,v 1.1 2003/08/16 18:35:38 jsh Exp $
 
4
 
 
5
   Copyright (C) 2000 John Harper <john@dcs.warwick.ac.uk>
 
6
 
 
7
   This file is part of sawfish.
 
8
 
 
9
   sawfish is free software; you can redistribute it and/or modify it
 
10
   under the terms of the GNU General Public License as published by
 
11
   the Free Software Foundation; either version 2, or (at your option)
 
12
   any later version.
 
13
 
 
14
   sawfish is distributed in the hope that it will be useful, but
 
15
   WITHOUT ANY WARRANTY; without even the implied warranty of
 
16
   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 
17
   GNU General Public License for more details.
 
18
 
 
19
   You should have received a copy of the GNU General Public License
 
20
   along with sawfish; see the file COPYING.  If not, write to
 
21
   the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
 
22
|#
 
23
 
 
24
(define-structure sawfish.gtk.widgets.font ()
 
25
 
 
26
    (open rep
 
27
          rep.system
 
28
          gui.gtk-2.gtk
 
29
          sawfish.gtk.widget
 
30
          sawfish.wm.util.font)
 
31
 
 
32
  ;; FIXME: this is broken, in that only if Xrender is present
 
33
  ;; does gdk use Xft. But, it's the best I can do..
 
34
  (define use-xft (let ((x (getenv "GDK_USE_XFT")))
 
35
                    (or (not x) (/= (string->number x) 0))))
 
36
 
 
37
  ;; defined by configure
 
38
  (define have-pango-xft (eq 'yes 'yes))
 
39
 
 
40
  (define default-font (if use-xft "Sans" "fixed"))
 
41
 
 
42
  (define (make-font-item changed-callback)
 
43
    (let* ((box (gtk-hbox-new nil box-spacing))
 
44
           (entry (gtk-entry-new))
 
45
           (button (gtk-button-new-with-label (_ "Browse..."))))
 
46
      (gtk-editable-set-editable entry nil)
 
47
      (gtk-box-pack-start box entry t t)
 
48
      (gtk-box-pack-start box button)
 
49
      (when changed-callback
 
50
        (g-signal-connect
 
51
         entry "changed" (make-signal-callback changed-callback)))
 
52
      (g-signal-connect
 
53
       button "clicked"
 
54
       (lambda ()
 
55
         (let ((fontsel (gtk-font-selection-dialog-new (_ "Select font"))))
 
56
           (gtk-font-selection-dialog-set-font-name
 
57
            fontsel (gtk-entry-get-text entry))
 
58
           (g-signal-connect
 
59
            (gtk-font-selection-dialog-ok-button fontsel) "clicked"
 
60
            (lambda ()
 
61
              (gtk-entry-set-text
 
62
               entry (gtk-font-selection-dialog-get-font-name fontsel))
 
63
              (gtk-widget-destroy fontsel)))
 
64
           (g-signal-connect
 
65
            (gtk-font-selection-dialog-cancel-button fontsel) "clicked"
 
66
            (lambda () (gtk-widget-destroy fontsel)))
 
67
           (g-signal-connect fontsel "delete_event"
 
68
                               (lambda () (gtk-widget-destroy fontsel)))
 
69
           (gtk-widget-show fontsel)
 
70
           (gtk-grab-add fontsel))))
 
71
      (gtk-widget-show box)
 
72
      (lambda (op)
 
73
        (case op
 
74
          ((set) (lambda (x)
 
75
                   (cond ((stringp x)
 
76
                          (gtk-entry-set-text entry x))
 
77
                         ((consp x)
 
78
                          (let ((face (cond
 
79
                                        ((string-equal (car x) "Xft")
 
80
                                         (xft-description->face (cdr x)))
 
81
                                        ((string-equal (car x) "xlfd")
 
82
                                         (xlfd-description->face (cdr x)))
 
83
                                        ((string-equal (car x) "pango")
 
84
                                         (pango-description->face (cdr x))))))
 
85
                            (when face
 
86
                              (gtk-entry-set-text
 
87
                               entry (face->pango-description face)))))
 
88
                         (t (gtk-entry-set-text entry default-font)))))
 
89
          ((clear) (lambda ()
 
90
                     (gtk-entry-set-text entry default-font)))
 
91
          ((ref) (lambda ()
 
92
                   (let* ((pango-name (gtk-entry-get-text entry))
 
93
                          (face (pango-description->face pango-name)))
 
94
                     (cond ((not face) nil)
 
95
                           (use-xft
 
96
                            (if have-pango-xft
 
97
                                (cons "Pango" (face->pango-description face))
 
98
                              (cons "Xft" (face->xft-description face))))
 
99
                           (t (cons "xlfd" (face->xlfd-description face)))))))
 
100
          ((gtk-widget) box)
 
101
          ((validp) (lambda (x) (stringp x)))))))
 
102
 
 
103
  (define-widget-type 'font make-font-item))