]>
Commit | Line | Data |
---|---|---|
dc2e06ab KP |
1 | # -*- perl -*- |
2 | # Defoma configuration script for fontconfig | |
3 | # Copyright © 2003 Angus Lees <gus@debian.org> | |
4 | # This file is hereby placed into the public domain. | |
5 | ||
6 | @ACCEPT_CATEGORIES = qw(type1 truetype cid); | |
7 | # .. and any other categories supported by freetype | |
8 | ||
9 | package fontconfig; | |
10 | ||
11 | use Debian::Defoma::Common; | |
12 | use Debian::Defoma::Id; | |
13 | use Debian::Defoma::Subst; | |
14 | ||
15 | use strict; | |
16 | use warnings; | |
17 | ||
18 | my $PkgDir = "$ROOTDIR/fontconfig.d"; | |
19 | my ($Id, $Sb); | |
20 | ||
21 | sub init { | |
22 | $Id ||= defoma_id_open_cache() or return 1; | |
23 | $Sb ||= defoma_subst_open(rulename => 'fontconfig', | |
24 | threshold => 70, | |
25 | idobject => $Id) or return 1; | |
26 | ||
27 | return 0; | |
28 | } | |
29 | ||
30 | sub register { | |
31 | my $font = shift; | |
32 | my $hints = parse_hints_start(@_); | |
33 | ||
34 | return 1 unless $hints->{FontName}; | |
35 | ||
36 | my $priority = $hints->{Priority} || 20; | |
37 | my ($fontname) = split / +/, $hints->{FontName}; | |
38 | my @alias = split / +/, $hints->{Alias} if $hints->{Alias}; | |
39 | ||
40 | defoma_id_register($Id, type => 'real', font => $font, | |
41 | id => $fontname, priority => $priority, | |
42 | hints => join(' ', @_)); | |
43 | ||
44 | foreach my $alias (@alias) { | |
45 | defoma_id_register($Id, type => 'alias', font => $font, | |
46 | id => $alias, priority => $priority, | |
47 | origin => $fontname); | |
48 | } | |
49 | ||
50 | defoma_subst_register($Sb, $font, $fontname); | |
51 | ||
52 | return 0; | |
53 | } | |
54 | ||
55 | sub unregister { | |
56 | my $font = shift; | |
57 | defoma_subst_unregister($Sb, $font); | |
58 | defoma_id_unregister($Id, type => 'alias', font => $font); | |
59 | defoma_id_unregister($Id, type => 'real', font => $font); | |
60 | return 0; | |
61 | } | |
62 | ||
63 | sub do_install_real { | |
64 | my $font = shift; | |
65 | my $id = shift; | |
66 | ||
67 | my $dir = $PkgDir . '/' . substr($id, 0, 1); | |
68 | my $ext = $font =~ m|\.([^/.]+)$| ? ".$1" : ''; | |
69 | my $file = $id . $ext; | |
70 | ||
71 | mkdir $dir; | |
72 | symlink $font, "$dir/$file" or return 1; | |
73 | ||
74 | return 0; | |
75 | } | |
76 | ||
77 | sub do_remove_real { | |
78 | my $font = shift; | |
79 | my $id = shift; | |
80 | ||
81 | my $dir = $PkgDir . '/' . substr($id, 0, 1); | |
82 | my $ext = $font =~ m|\.([^/.]+)$| ? ".$1" : ''; | |
83 | my $file = $id . $ext; | |
84 | ||
85 | unlink "$dir/$file" or return 1; | |
86 | rmdir $dir; # ignore failure | |
87 | ||
88 | return 0; | |
89 | } | |
90 | ||
91 | sub term { | |
92 | return unless $Id; | |
93 | ||
94 | open my $fh, '>', "$PkgDir/fonts.conf" or return 1; | |
95 | ||
96 | print $fh <<EOF; | |
97 | <?xml version="1.0"?> | |
98 | <!DOCTYPE fontconfig SYSTEM "/etc/fonts/fonts.dtd"> | |
99 | <!-- autogenerated by fontconfig.defoma --> | |
100 | <fontconfig> | |
101 | <dir>$PkgDir</dir> | |
102 | EOF | |
103 | ||
104 | # aliases | |
105 | foreach (defoma_id_get_font($Id, installed => type => 'SaI')) { | |
106 | print $fh <<EOF | |
107 | <alias> | |
108 | <family>$Id->{e_id}->[$_]</family> | |
109 | <accept><family>$Id->{e_depid}->[$_]</family></accept> | |
110 | </alias> | |
111 | EOF | |
112 | } | |
113 | ||
114 | # substituded fonts | |
115 | foreach (defoma_id_get_font($Id, installed => type => 'SSI')) { | |
116 | print $fh <<EOF | |
117 | <alias> | |
118 | <family>$Id->{e_id}->[$_]</family> | |
119 | <default><family>$Id->{e_depid}->[$_]</family></default> | |
120 | </alias> | |
121 | EOF | |
122 | } | |
123 | ||
124 | print $fh "</fontconfig>\n"; | |
125 | ||
126 | close $fh; | |
127 | ||
128 | defoma_subst_close($Sb); | |
129 | defoma_id_close_cache($Id); | |
130 | ||
131 | system('fc-cache', $PkgDir); | |
132 | ||
133 | return 0; | |
134 | } | |
135 | ||
136 | sub main { | |
137 | my $cmd = shift; | |
138 | ||
139 | if ($cmd eq 'init') { | |
140 | init(); | |
141 | } elsif ($cmd eq 'register') { | |
142 | return register(@_); | |
143 | } elsif ($cmd eq 'unregister') { | |
144 | return unregister(@_); | |
145 | } elsif ($cmd eq 'do-install-real') { | |
146 | return do_install_real(@_); | |
147 | } elsif ($cmd eq 'do-remove-real') { | |
148 | return do_remove_real(@_); | |
149 | } elsif ($cmd eq 'term') { | |
150 | return term(@_); | |
151 | } | |
152 | ||
153 | 0; | |
154 | } | |
155 | ||
156 | no warnings; | |
157 | ||
158 | *truetype = \&main; | |
159 | *type1 = \&main; | |
160 | *cid = \&main; | |
161 | ||
162 | 1; |