Your IP : 216.73.216.170
xenc-cset.data 0000666 00000002462 15077033244 0007305 0 ustar 00 # This file describes the correspondences between X encodings and Standard
# charsets.
# The first item of each line is X encoding, and the second is Standard
# charset. These items are separated by space.
# Lines starting with '#' are considered as comment.
# Regular expressions used in shell scripts are permitted.
# Legend:
#<X encoding> <std charset>
jisx0208.????-0 JISX0208
jisx0201.????-0 JISX0201
jisx0212.????-0 JISX0212
iso8859-1 ISO8859-1
iso8859-2 ISO8859-2
iso8859-3 ISO8859-3
iso8859-4 ISO8859-4
iso8859-5 ISO8859-5
iso8859-6 ISO8859-6
iso8859-7 ISO8859-7
iso8859-8 ISO8859-8
iso8859-9 ISO8859-9
iso8859-10 ISO8859-10
iso8859-11 ISO8859-11
iso8859-12 ISO8859-12
iso8859-13 ISO8859-13
iso8859-14 ISO8859-14
iso8859-15 ISO8859-15
iso10646-1 ISO10646-1
koi8-r KOI8-R
koi8-u KOI8-U
gb2312.1980-0 GB2312
gbk-0 GBK
gb18030-0 GB18030
gb18030.2000-0 GB18030
gb18030.2000-1 GB18030
ksc5601.1987-0 KSX1001
big5-0 BIG5
big5.eten-0 BIG5
big5hkscs-0 BIG5-HKSCS
hkscs-1 BIG5-HKSCS
cns11643.1992-1 CNS11643-1
cns11643.1992-2 CNS11643-2
cns11643.1992-3 CNS11643-3
cns11643.1992-4 CNS11643-4
cns11643.1992-5 CNS11643-5
cns11643.1992-6 CNS11643-6
cns11643.1992-7 CNS11643-7
fontspecific-0 font-specific
adobe-fontspecific font-specific
microsoft-cp1251 CP1251
tis620-0 TIS620
fontconfig.subst-rule 0000666 00000001767 15077033244 0010753 0 ustar 00 # Debian Font Manager: Substitute Rule for fontconfig
#
# DO NOT EDIT THIS FILE DIRECTLY! IF YOU WANT TO EDIT, TYPE
# defoma-subst edit-rule fontconfig
# INSTEAD.
#
# This file describes identifiers that other fonts must substitute for and
# their information.
# Each line contains one identifier of a font and some hints about the font.
# Syntax of hints is:
# --<HintTypeA>[,Score] <hint1> .. --<HintTypeB>[,Score] <hintA>..
# HintType specifies the type of hint, like Family, Weight and Charset.
# Score specifies the degree of importance of the HintType and is either of
# 1, 2, 3 or *. The larger number, the more important. '*' means the
# specified HintType is required to match.
#
# Each item in a line is separated by space.
# Lines starting with '#' are ignored.
#
serif --GeneralFamily,* Roman --Shape Serif Upright --Weight Medium
sans-serif --GeneralFamily,* SansSerif --Shape NoSerif Upright --Weight Medium
monospace --Width,* Fixed --GeneralFamily,2 Typewriter --Shape Upright --Weight Medium
loc-cset.data 0000666 00000002355 15077033244 0007126 0 ustar 00 # loc-cset.data
# This file describes which standard charset corresponds to a certain
# Location, represented in Language-Region style.
# Each line consists of two items. The first is Location, and the last
# is standard charset. If a certain Location corresponds to multiple
# charsets, separate them with comma.
Russian* KOI8-R,CP1251,ISO8859-5
Ukrainian* KOI8-U,CP1251,ISO8859-5
Icelandic*|Italian*|English*|Dutch*|German*|Norwegian* ISO8859-1
Portuguese*|Finnish*|French* ISO8859-1
Albanian*|Slovak*|Slovenian*|Czech*|Hungarian*|Magyar*|Polish* ISO8859-2
Romanian*|English*|SerboCroatian-Croatian|SerboCroatian-Serb.Roman ISO8859-2
German* ISO8859-2
Afrikaans*|Turkish*|Maltese*|Italian*|English*|Esperanto*|Spanish* ISO8859-3
German* ISO8859-3
Icelandic*|English*|Estonian*|Greenlandic*|Swedish*|Danish*|German* ISO8859-10
Finnish*|Latvian*|Lithuanian* ISO8859-10
SerboCroatian-Serb.Cyrillic|Bulgarian*|Macedonian* ISO8859-5
Byelorussian* ISO8859-5
Arabic* ISO8859-6
Greek* ISO8859-7
Hebrew* ISO8859-8
Chinese-China|Chinese-Singapore GB2312,GBK,GB18030
Chinese-Taiwan BIG5,CNS11643-1,CNS11643-2,CNS11643-3,CNS11643-4,CNS11643-5,CNS11643-6,CNS11643-7
Chinese-HongKong|Chinese-Macau BIG5-HKSCS
Japanese* JISX0208,JISX0201,JISX0212
Korean* KSX1001
csetenc-xenc.data2 0000666 00000003053 15077033244 0010052 0 ustar 00 # This file describes which X encoding corresponds to a certain Standard
# Charset and Encoding.
# The first item of each line is Standard Charset,
# the second is Standard Encoding,
# and the last is X encoding which corresponds to the Standard
# Charset and Encoding. Each item is separated by whitespace.
#
# Lines starting with '#' character are considered as comment.
#Legend:
#<std charset> <std encoding> <X encoding>
* EUC ignore
JISX0208 |ISO2022-JP jisx0208.1983-0
JISX0208 * ignore
JISX0201 * jisx0201.1976-0
JISX0212 |ISO2022-JP jisx0212.1990-0
JISX0212 * ignore
ISO8859-1 * iso8859-1
ISO8859-2 * iso8859-2
ISO8859-3 * iso8859-3
ISO8859-4 * iso8859-4
ISO8859-5 * iso8859-5
ISO8859-6 * iso8859-6
ISO8859-7 * iso8859-7
ISO8859-8 * iso8859-8
ISO8859-9 * iso8859-9
ISO8859-10 * iso8859-10
ISO8859-11 * iso8859-11
ISO8859-12 * iso8859-12
ISO8859-13 * iso8859-13
ISO8859-14 * iso8859-14
ISO8859-15 * iso8859-15
ISO10646-1 * iso10646-1
KOI8-R * koi8-r
KOI8-U * koi8-u
font-specific * fontspecific-0
GB2312 |ISO2022 gb2312.1980-0
GB2312 * ignore
GBK |GBK gbk-0
GB18030 |GBK gb18030.2000-0
GB18030 |GBK2K gb18030.2000-1
GB18030 * gb18030-0
KSX1001 |ISO2022-KR ksc5601.1987-0
BIG5 |BIG5 big5-0
BIG5-HKSCS |BIG5 big5hkscs-0
CNS11643-1 |ISO2022 cns11643.1992-1
CNS11643-2 |ISO2022 cns11643.1992-2
CNS11643-3 |ISO2022 cns11643.1992-3
CNS11643-4 |ISO2022 cns11643.1992-4
CNS11643-5 |ISO2022 cns11643.1992-5
CNS11643-6 |ISO2022 cns11643.1992-6
CNS11643-7 |ISO2022 cns11643.1992-7
CP1251 * microsoft-cp1251
TIS620 * tis620-0
ps-cset-enc.data 0000666 00000007617 15077033244 0007544 0 ustar 00 # ps-cset-enc.data
# This file describes what standard (national) charset corresponds to
# Adobe-defined charsets/encodings.
# Each line consists of three items, the first is Adobe-defined charset,
# the second is Adobe-defined encoding, the third is standard (national)
# charset, and the fourth is standard encoding. If Adobe-defined
# charset/encoding corresponds to multiple standard charsets, write
# them all by separating comma, in order of major to minor.
#Legend:
#<Adobe charset> <Adobe encoding> <std charset> <std encoding>
Standard Standard ISO8859-1
Special Special font-specific
* ISO8859-1 ISO8859-1
* ISO8859-2 ISO8859-2
* ISO8859-3 ISO8859-3
* ISO8859-4 ISO8859-4
* ISO8859-5 ISO8859-5
* ISO8859-6 ISO8859-6
* ISO8859-7 ISO8859-7
* ISO8859-8 ISO8859-8
* ISO8859-9 ISO8859-9
* ISO8859-10 ISO8859-10
# Following is information of the CJK charsets. You should refer to
# Technical Note #5094 released by Adobe for details.
# Japanese charsets note:
#
# Adobe-Japan1-0 corresponds to a combination of JIS X 0208-1983 (new JIS),
# JIS X 0201-1997, JIS C 6226-1978 (old JIS, aka JIS X 0208-1978) and some
# local extended characters.
# Adobe-Japan1-1 corresponds to JIS X 0208-1990.
# Adobe-Japan1-2 corresponds to Microsoft Windows charset, which consists of
# JIS X 0208-1997 and some local extended characters.
# Adobe-Japan2-0 corresponds to JIS X 0212-1990 charset.
# Families of JIS X 0208 can be regarded as the same charset except
# JIS C 6226-1978.
JIS-83 JIS JISX0208 ISO2022-JP
JIS-83 EUC JISX0208 EUC
JIS-78 JIS JISC6226 ISO2022-JP
JIS-78 EUC JISC6226 EUC
JIS-83|JIS-78 * ignore
* RKSJ ignore
83pv * ignore
Ext * ignore
Add * ignore
NWP * ignore
Adobe-Japan1* H|V JISX0208 ISO2022-JP
Adobe-Japan1* EUC-? JISX0208,JISX0201 EUC
Adobe-Japan1* RKSJ-? JISX0208,JISX0201 SHIFT-JIS
Adobe-Japan1* UniJIS-UCS2-? JISX0208 UCS2
Adobe-Japan1* |UniJIS-UTF8-? JISX0208 UTF8
Adobe-Japan1* 78-? JISC6226 ISO2022-JP
Adobe-Japan1* 78-EUC-? JISC6226,JISX0201 EUC
Adobe-Japan1* Hankaku JISX0201
Adobe-Japan1* * ignore
Adobe-Japan2* Hojo-? JISX0212 ISO2022-JP
Adobe-Japan2* Hojo-EUC-? JISX0212 EUC
Adobe-Japan2* UniHojo-UCS2-? JISX0212 UCS2
Adobe-Japan2* UniHojo-UTF8-? JISX0212 UTF8
Adobe-Japan2* * ignore
# Simplified Chinese charsets note:
#
# Adobe-GB1-0 corresponds to a combination of GB2312-80, GB1988 and others.
# Adobe-GB1-1 corresponds to GBT12345-90 charset.
# Adobe-GB1-2 corresponds to GBK charset. GBK consists of all CJK ideographs
# included in UCS BMP and some local extentions.
# Adobe-GB1-4 corresponds to GBK2K charset. GBK2K corresponds to the
# CJK Extension A area.
Adobe-GB1* GB-? GB2312 ISO2022
Adobe-GB1* GB-EUC-? GB2312,GB1988 EUC
Adobe-GB1* GBT-? GBT12345 ISO2022
Adobe-GB1* GBT-EUC-? GBT12345,GB1988 EUC
Adobe-GB1* GBK-EUC-? GB18030,GBK GBK
Adobe-GB1* GBK2K-? GB18030 GBK2K
Adobe-GB1* UniGB-UCS2-? GBK UCS2
Adobe-GB1* UniGB-UTF8-? GBK UTF8
Adobe-GB1* * ignore
# Korean charsets note:
#
# Adobe-Korea1-0 corresponds to a combination of KS X 1001:1992,
# KS X 1003:1993 (aka KS C 5601 and KS C 5636, respectively) and some local
# extentions.
# Adobe-Korea1-1 corresponds to a combination of KS X 1001:1992 with
# Johab extentions and with Microsoft extentions (aka Unified Hangul Code).
Adobe-Korea1* KSC-? KSX1001 ISO2022-KR
Adobe-Korea1* KSC-EUC-? KSX1001,KSX1003 EUC
Adobe-Korea1* UniKS-UCS2-? KSX1001 UCS2
Adobe-Korea1* UniKS-UTF8-? KSX1001 UTF8
Adobe-Korea1* * ignore
# Traditional Chinese charsets note:
#
# Adobe-CNS1-0 corresponds to a combination of ETen-extended Big5 charset
# and CNS11643 (plane 1 and 2) charsets.
# Adobe-CNS1-1 corresponds to Government Common Character Set (GCCS)
# and Hong Kong Supplementary Character Set (HKSCS).
Adobe-CNS1* CNS1-? CNS11643-1 ISO2022
Adobe-CNS1* CNS2-? CNS11643-2 ISO2022
Adobe-CNS1* B5-?|ETen-B5-? BIG5 BIG5
Adobe-CNS1* HKscs-B5-?|HKgccs-B5-? BIG5-HKSCS BIG5
Adobe-CNS1* * ignore
scripts/fontconfig.defoma 0000666 00000011771 15077146621 0011570 0 ustar 00 # -*- perl -*-
# Defoma configuration script for fontconfig
# Copyright © 2003 Angus Lees <gus@debian.org>
# This file is hereby placed into the public domain.
@ACCEPT_CATEGORIES = qw(type1 truetype cid);
# .. and any other categories supported by freetype
package fontconfig;
use Debian::Defoma::Common;
use Debian::Defoma::Id;
use Debian::Defoma::Subst;
use strict;
use warnings;
my $PkgDir = "$ROOTDIR/fontconfig.d";
my ($Id, $Sb);
my %UpdatedDirectories = ();
sub init {
$Id ||= defoma_id_open_cache() or return 1;
$Sb ||= defoma_subst_open(rulename => 'fontconfig',
threshold => 70,
idobject => $Id) or return 1;
return 0;
}
sub register {
my $font = shift;
my $hints = parse_hints_start(@_);
return 1 unless $hints->{FontName};
my $priority = $hints->{Priority} || 20;
my ($fontname) = split / +/, $hints->{FontName};
my @alias = split / +/, $hints->{Alias} if $hints->{Alias};
defoma_id_register($Id, type => 'real', font => $font,
id => $fontname, priority => $priority,
hints => join(' ', @_));
foreach my $alias (@alias) {
defoma_id_register($Id, type => 'alias', font => $font,
id => $alias, priority => $priority,
origin => $fontname);
}
defoma_subst_register($Sb, $font, $fontname);
return 0;
}
sub unregister {
my $font = shift;
defoma_subst_unregister($Sb, $font);
defoma_id_unregister($Id, type => 'alias', font => $font);
defoma_id_unregister($Id, type => 'real', font => $font);
return 0;
}
sub dirname {
my $path = shift;
$path =~ s/\/[^\/]*$//;
return $path;
}
sub do_install_real {
my $font = shift;
my $id = shift;
my $dir = dirname ($font);
$UpdatedDirectories{$dir} = 1;
return 0;
}
sub do_remove_real {
my $font = shift;
my $id = shift;
my $dir = dirname ($font);
$UpdatedDirectories{$dir} = 1;
return 0;
}
sub fontconfig_dirs {
my %dirs = ();
system ('fc-cache', '-s');
open my $file, "fc-list : file |" or return ();
while (<$file>) {
my $dir = dirname ($_);
if (!exists $dirs{$dir}) {
$dirs{$dir} = 1;
}
}
close $file;
return %dirs;
}
#
# Clean up from old fontconfig defoma mechanism which
# placed symlinks to each fontfile in the fontconfig.d directory
#
sub clean_oldstyle_dirs {
opendir (DIR, $PkgDir) or return 1;
my @dirs = grep { /^[^.]/ && -d "$PkgDir/$_" } readdir (DIR);
closedir DIR;
foreach my $dir (@dirs) {
my $subdir = "$PkgDir/$dir";
if (opendir (DIR, $subdir)) {
my @files = grep { /^[^.]/ && -l "$subdir/$_" } readdir (DIR);
closedir DIR;
foreach my $file (@files) {
if ( -l "$subdir/$file" ) {
unlink "$subdir/$file";
}
}
rmdir $subdir;
}
}
}
sub term {
return unless $Id;
-e "/etc/fonts/fonts.conf" or return 0;
clean_oldstyle_dirs ();
#
# Update modified directories
#
my @dirs = keys (%UpdatedDirectories);
if (@dirs) {
print "Updating fontconfig cache for @dirs\n";
system ("fc-cache", "-f", @dirs);
#
# make sure caches leading to new directories are updated
#
system ("fc-cache", "-s");
}
# Empty our config file to see
# which directories are reachable without it
open my $smash_fh, '>', "$PkgDir/fonts.conf" or return 1;
print $smash_fh <<EOF;
<?xml version="1.0"?>
<!DOCTYPE fontconfig SYSTEM "/etc/fonts/fonts.dtd">
<!-- autogenerated by fontconfig.defoma -->
<fontconfig>
</fontconfig>
EOF
close $smash_fh;
my %dirs = fontconfig_dirs ();
open my $fh, '>', "$PkgDir/fonts.conf" or return 1;
print $fh <<EOF;
<?xml version="1.0"?>
<!DOCTYPE fontconfig SYSTEM "/etc/fonts/fonts.dtd">
<!-- autogenerated by fontconfig.defoma -->
<fontconfig>
EOF
# directories
my %newdirs = ();
foreach (defoma_id_get_font($Id, installed => type => 'SrI')) {
my $dir = dirname($Id->{e_font}->[$_]);
if (!exists $dirs{$dir} && !exists $newdirs{$dir}) {
print $fh " <dir>$dir</dir>\n";
$newdirs{$dir} = 1;
}
}
# aliases
foreach (defoma_id_get_font($Id, installed => type => 'SaI')) {
print $fh <<EOF
<alias>
<family>$Id->{e_id}->[$_]</family>
<accept><family>$Id->{e_depid}->[$_]</family></accept>
</alias>
EOF
}
# substituded fonts
foreach (defoma_id_get_font($Id, installed => type => 'SSI')) {
print $fh <<EOF
<alias>
<family>$Id->{e_id}->[$_]</family>
<default><family>$Id->{e_depid}->[$_]</family></default>
</alias>
EOF
}
print $fh "</fontconfig>\n";
close $fh;
defoma_subst_close($Sb);
defoma_id_close_cache($Id);
system ("fc-cache", "-s");
return 0;
}
sub main {
my $cmd = shift;
if ($cmd eq 'init') {
init();
} elsif ($cmd eq 'register') {
return register(@_);
} elsif ($cmd eq 'unregister') {
return unregister(@_);
} elsif ($cmd eq 'do-install-real') {
return do_install_real(@_);
} elsif ($cmd eq 'do-remove-real') {
return do_remove_real(@_);
} elsif ($cmd eq 'term') {
return term(@_);
}
0;
}
no warnings;
*truetype = \&main;
*type1 = \&main;
*cid = \&main;
1;
status-cache 0000666 00000000033 15077146621 0007064 0 ustar 00 defoma-last-run 1349368971
libdefoma-subst.pl 0000666 00000006512 15077204524 0010177 0 ustar 00 sub com_subst_edit_rule {
usage_and_exit if (@ARGV == 0);
my $rulename = shift(@ARGV);
mylock(1);
init_all();
my $sb = defoma_subst_open(rulename => $rulename);
unless ($sb) {
printw("Cannot open $rulename");
term_all();
mylock(0);
exit ERROR;
}
my $rulefile = $sb->{rulefile};
unless (-f $rulefile) {
printw("No rulefile is found for $rulename");
term_all();
mylock(0);
exit ERROR;
}
my $newfile = `/bin/tempfile`;
chomp($newfile);
copy($rulefile, $newfile);
system('/usr/bin/sensible-editor', $newfile);
my @new = ();
if (open(F, $newfile)) {
while (<F>) {
chomp($_);
push(@new, $_) if ($_ ne '' && $_ !~ /^\#/);
}
my ($i, $j);
my $max = $sb->{rule_cnt};
for ($i = 0; $i < $max; $i++) {
$j = $sb->{rule}->[$i];
next if ($j eq '' || $j =~ /^\#/);
unless (grep($_ eq $j, @new)) {
defoma_subst_remove_rule_by_num($sb, $i);
}
}
foreach $i (@new) {
unless (grep($_ eq $i, @{$sb->{rule}})) {
defoma_subst_add_rule($sb, split(' ', $i));
}
}
}
defoma_subst_close($sb);
term_all();
copy($newfile, $rulefile);
unlink($newfile, $newfile.'~');
mylock(0);
exit 0;
}
sub com_subst_add_rule {
usage_and_exit if (@ARGV <= 1);
my $rulename = shift(@ARGV);
mylock(1);
init_all();
my $sb = defoma_subst_open(rulename => $rulename);
unless ($sb) {
printw("Cannot open $rulename");
term_all();
mylock(0);
exit ERROR;
}
my $rulefile = $sb->{rulefile};
unless (-f $rulefile) {
printw("No rulefile is found for $rulename");
term_all();
mylock(0);
exit ERROR;
}
foreach my $i (@ARGV) {
my @rule = split(/[ \t]+/, $i);
my $rulestr = join(' ', @rule);
unless (grep($_ eq $rulestr, @{$sb->{rule}})) {
defoma_subst_add_rule($sb, @rule);
}
}
defoma_subst_close($sb);
term_all();
mylock(0);
exit 0;
}
sub com_subst_remove_rule {
usage_and_exit if (@ARGV <= 1);
my $rulename = shift(@ARGV);
mylock(1);
init_all();
my $sb = defoma_subst_open(rulename => $rulename);
unless ($sb) {
printw("Cannot open $rulename");
term_all();
mylock(0);
exit ERROR;
}
my $rulefile = $sb->{rulefile};
unless (-f $rulefile) {
printw("No rulefile is found for $rulename");
term_all();
mylock(0);
exit ERROR;
}
foreach my $i (@ARGV) {
my @rule = split(/[ \t]+/, $i);
defoma_subst_remove_rule($sb, @rule);
}
defoma_subst_close($sb);
term_all();
mylock(0);
exit 0;
}
sub com_subst_new_rule {
usage_and_exit if (@ARGV == 0);
my $rulename = shift(@ARGV);
my $rulefile = SUBSTRULEDIR . '/' . $rulename . '.subst-rule';
defoma_subst_newrule($rulefile, $rulename, @ARGV);
exit 0;
}
sub com_subst_check_rule {
usage_and_exit if (@ARGV == 0);
my $rulename = shift(@ARGV);
my $rulefile = SUBSTRULEDIR . '/' . $rulename . '.subst-rule';
if (-f $rulefile) {
exit 0;
} else {
exit 1;
}
}
sub main {
my $command = shift;
if ($command eq 'new-rule') {
com_subst_new_rule();
} elsif ($command eq 'edit-rule') {
com_subst_edit_rule();
} elsif ($command eq 'add-rule') {
com_subst_add_rule();
} elsif ($command eq 'remove-rule') {
com_subst_remove_rule();
} elsif ($command eq 'check-rule') {
com_subst_check_rule();
}
}
1;
libdefoma-font.pl 0000666 00000012701 15077204524 0010002 0 ustar 00 sub hintfile_convert_hints {
my @ret = ();
while (@_ > 0) {
my $line = shift(@_);
while ($line =~ /\\$/ && @_ > 0) {
$line =~ s/\\$/ /;
$line .= shift(@_);
}
if ($line =~ /^[ \t]*([^= \t]+)[ \t]*=[ \t]*(.*)[ \t]*$/) {
my $hinttype = $1;
my @hints = split(/[ \t]+/, $2);
push(@ret, "--$hinttype");
push(@ret, @hints) if (@hints > 0);
} elsif ($line =~ /^[ \t]*([^= \t]+)[ \t]*$/) {
my $hinttype = $1;
push(@ret, "--$hinttype");
}
}
return @ret;
}
sub hintfile_read {
my $hintfile = shift;
my @file = readfile($hintfile);
unless (@file) {
printm("$hintfile: Unable to open, or empty.");
return undef;
}
my @hints = ();
my $font = '';
my @l_font = ();
my @l_hints = ();
my @l_category = ();
my $lnum = 0;
my $category = '';
while (@file) {
my $line = shift(@file);
$lnum++;
next if ($line =~ /^\#/);
if ($line =~ /^begin[ \t]+([^ \t]+)/) {
if ($category eq '') {
printe("$hintfile: syntax error in line $lnum. ",
"'begin' before 'category'.");
return undef;
}
if ($font ne '') {
printe("$hintfile: syntax error in line $lnum. ",
"Another 'begin' between 'begin' .. 'end'.");
return undef;
}
$font = $1;
@hints = ();
foreach my $lfont (@l_font) {
if ($font eq $lfont) {
printw("$hintfile: Serious warning in line $lnum. ",
"Duplicated font definition.");
last;
}
}
} elsif ($line =~ /^end[ \t]*$/) {
if ($font eq '') {
printe("$hintfile: syntax error in line $lnum. ",
"'end' without 'begin'.");
return undef;
} else {
my @lhints = hintfile_convert_hints(@hints);
my $lhintstr = (@lhints > 0) ? join(' ', @lhints) : '';
push(@l_font, $font);
push(@l_hints, $lhintstr);
push(@l_category, $category);
$font = '';
@hints = ();
}
} elsif ($line =~ /^category[ \t]+([^ \t]+)/) {
$category = $1;
} elsif ($line =~ /^obsolete[ \t]+([^ \t]+)/) {
if ($font ne '') {
printe("$hintfile: syntax error in line $lnum. ",
"'obsolete' between 'begin' .. 'end'.");
return undef;
}
push(@l_font, $1);
push(@l_hints, '');
push(@l_category, 'obsoleted');
} elsif ($font ne '') {
push(@hints, $line);
}
}
my $hashptr = {};
my $cnt = @l_font;
for (my $i = 0; $i < $cnt; $i++) {
$hashptr->{$l_font[$i]} = {};
$hashptr->{$l_font[$i]}->{category} = $l_category[$i];
$hashptr->{$l_font[$i]}->{hints} = $l_hints[$i];
}
return $hashptr;
}
sub com_register {
usage_and_exit if (@ARGV < 2);
mylock(1);
init_all();
my $ret = defoma_font_register(@ARGV);
$ret = $ret ? ERROR : 0;
term_all();
mylock(0);
exit $ret;
}
sub com_unregister {
usage_and_exit if (@ARGV < 2);
mylock(1);
init_all();
my $ret = defoma_font_unregister(@ARGV);
term_all();
mylock(0);
exit $ret;
}
sub com_reregister {
usage_and_exit if (@ARGV < 2);
mylock(1);
init_all();
my $ret = defoma_font_reregister(@ARGV);
term_all();
mylock(0);
exit $ret;
}
sub com_purge {
$Debian::Defoma::Id::Purge = 1;
com_unregister();
}
sub com_all {
my $funcptr = shift;
my $hintfile = shift;
my $onefont = shift; # for <command>-one
mylock(1);
init_all();
my $hashptr = hintfile_read($hintfile);
unless (defined($hashptr)) {
term_all();
mylock(0);
exit ERROR;
}
if (defined($onefont) && ! exists($hashptr->{$onefont})) {
term_all();
mylock(0);
printw("$onefont isn't defined in $hintfile.");
exit ERROR;
}
my ($i, $max, $category);
my @hints;
my $ret = 0;
foreach my $font (keys(%{$hashptr})) {
next if (defined($onefont) && $font ne $onefont);
@hints = split(' ', $hashptr->{$font}->{hints});
$category = $hashptr->{$font}->{category};
$ret += &{$funcptr}($category, $font, @hints);
}
$ret = $ret ? ERROR : 0;
term_all();
mylock(0);
exit $ret;
}
sub com_register_all {
usage_and_exit if (@ARGV == 0);
com_all(\&defoma_font_register, shift(@ARGV));
}
sub com_unregister_all {
usage_and_exit if (@ARGV == 0);
com_all(\&defoma_font_unregister, shift(@ARGV));
}
sub com_reregister_all {
usage_and_exit if (@ARGV == 0);
com_all(\&defoma_font_reregister, shift(@ARGV));
}
sub com_purge_all {
$Debian::Defoma::Id::Purge = 1;
com_unregister_all();
}
sub com_register_one {
usage_and_exit if (@ARGV < 2);
com_all(\&defoma_font_register, @ARGV);
}
sub com_unregister_one {
usage_and_exit if (@ARGV < 2);
com_all(\&defoma_font_unregister, @ARGV);
}
sub com_reregister_one {
usage_and_exit if (@ARGV < 2);
com_all(\&defoma_font_reregister, @ARGV);
}
sub com_purge_one {
$Debian::Defoma::Id::Purge = 1;
com_unregister_one();
}
sub main {
my $command = shift;
my %fonthash = ( 'register' => \&com_register,
'unregister' => \&com_unregister,
'reregister' => \&com_reregister,
'purge' => \&com_purge,
'register-all' => \&com_register_all,
'unregister-all' => \&com_unregister_all,
'reregister-all' => \&com_reregister_all,
'purge-all' => \&com_purge_all,
'register-one' => \&com_register_one,
'unregister-one' => \&com_unregister_one,
'reregister-one' => \&com_reregister_one,
'purge-one' => \&com_purge_one );
if (exists($fonthash{$command})) {
&{$fonthash{$command}}();
}
}
1;
libhint-cid.pl 0000666 00000007200 15077204524 0007300 0 ustar 00 sub sethint_cid {
my $font = shift;
my $flag = 0;
my $line;
my $fontname = '';
my $cidregistry = '';
my $cidordering = '';
my $cidsupplement = '';
my $family;
my $generalfamily;
my $weight;
my $width;
my $shape;
my $slant;
my $serif;
my $swidth;
my $text;
my $fontfilename = $font;
$fontfilename =~ s/^(.*)\/(.*)$/$2/;
my $fontdir = $1;
open(F, $font) || exitfunc(1, "$font: Unable to open.");
while (<F>) {
$line = $_;
chomp($line);
if ($line =~ /\/CIDFontName[ \t]/) {
$fontname = $line;
$fontname =~ s/.*\/CIDFontName[ \t]+\/([^ \t]+).*/$1/;
} elsif ($line =~ /\/CIDSystemInfo[ \t]/) {
$flag = 1;
} elsif ($flag == 1 && $line =~ /end[ \t]+def/) {
$flag = 0;
} elsif ($flag == 1 && $line =~ /\/Registry[ \t]/) {
$cidregistry = $line;
$cidregistry =~ s/.*\/Registry[ \t]+\((.*)\).*/$1/;
} elsif ($flag == 1 && $line =~ /\/Ordering[ \t]/) {
$cidordering = $line;
$cidordering =~ s/.*\/Ordering[ \t]+\((.*)\).*/$1/;
} elsif ($flag == 1 && $line =~ /\/Supplement[ \t]/) {
$cidsupplement = $line;
$cidsupplement =~ s/.*\/Supplement[ \t]+(.).*/$1/;
}
if ($fontname ne '' && $cidordering ne '' && $cidregistry ne '' &&
$cidsupplement ne '') {
last;
}
}
close F;
if ($fontname eq '' || $cidordering eq '' || $cidregistry eq '') {
exitfunc(1, "Some information aren't found in $fontfilename.\nAborting..");
}
$family = $fontname;
$family =~ s/([^-]+).*/$1/;
$weight = 'Medium';
$weight = 'Semibold' if ($fontname =~ /Semibold/);
$weight = 'Semibold' if ($fontname =~ /Demi/);
$weight = 'Bold' if ($fontname =~ /Bold/);
$weight = 'Light' if ($fontname =~ /Light/);
$width = 'Variable';
$slant = 'Upright';
$slant = 'Italic' if ($fontname =~ /Italic/);
$slant = 'Oblique' if ($fontname =~ /Oblique/);
$swidth = '';
$swidth = 'Expanded' if ($fontname =~ /Expanded/);
$swidth = 'Condensed' if ($fontname =~ /Condensed/);
$swidth = 'Condensed' if ($fontname =~ /Narrow/);
$serif = '';
$serif = 'Serif';
$family = input_family($fontname, $family);
return if ($result != 0);
$generalfamily = input_generalfamily($fontname, $family);
return if ($result != 0);
$serif = 'NoSerif' if ($generalfamily eq 'SansSerif');
$width = 'Fixed' if ($generalfamily eq 'Typewriter');
$weight = input_weight($fontname, $weight);
return if ($result != 0);
$width = input_width($fontname, $width);
return if ($result != 0);
$shape = input_shape($fontname, "$slant $serif $swidth");
return if ($result != 0);
my $alias = input_alias($fontname, '');
return if ($result != 0);
my $priority = input_priority($fontname, 20);
return if ($result != 0);
my $afm = $font;
$afm =~ s/\.cid$//;
$afm .= ".afm";
unless (-f $afm) {
$afm = input_afm($fontname, $afm);
} else {
$afm = "$SUFFIXPATH" . $afm;
}
my $hints = "--FontName $fontname";
$hints .= " --CIDRegistry $cidregistry";
$hints .= " --CIDOrdering $cidordering";
$hints .= " --CIDSupplement $cidsupplement" if ($cidsupplement =~ /\S/);
$hints .= " --Family $family";
$hints .= " --GeneralFamily $generalfamily" if ($generalfamily =~ /\S/);
$hints .= " --Weight $weight" if ($weight =~ /\S/);
$hints .= " --Width $width" if ($width =~ /\S/);
$hints .= " --Shape $shape" if ($shape =~ /\S/);
$hints .= " --Alias $alias" if ($alias =~ /\S/);
$hints .= " --Priority $priority";
$hints .= " --AFM $afm" if ($afm =~ /\S/);
$hints =~ s/\s+/ /g;
return $hints;
}
1;
libdefoma-user.pl 0000666 00000002202 15077204524 0010005 0 ustar 00 require("/usr/share/defoma/libdefoma-user2.pl");
my $Arg0 = $ARG0;
sub com_reconf {
mylock(0);
@ds = get_files("\\.d\$", ROOTDIR);
foreach my $d (@ds) {
$d =~ s/\.d$//;
system("/usr/bin/defoma-app", "-u", OPTIONS, "purge", $d);
}
system("/bin/rm", "-r", ROOTDIR);
exec("/usr/bin/defoma-user", "-u", OPTIONS, "update");
exit 0;
}
sub user_update_font {
mylock(1);
init_all();
term_all();
mylock(0);
}
sub com_update_font {
user_update_font();
exit 0;
}
sub com_update {
user_update_font();
user_update();
exit 0;
}
sub user_update_invoke {
system("/usr/bin/defoma-app", OPTIONS, @_);
}
sub user_update_message {
printm(@_);
}
sub user_update_question {
print @_, "[Y/n] ";
my $a = <STDIN>;
chomp($a);
return 1 if ($a eq 'Y' || $a eq 'y' || $a eq '');
return 0;
}
sub main {
my $command = shift;
unless (USERSPACE) {
exec($Arg0, "-u", ARGS);
}
if ($command eq 'reconfigure') {
com_reconf();
} elsif ($command eq 'update') {
com_update();
} elsif ($command eq 'update-font') {
com_update_font();
}
}
1;
libdefoma-user2.pl 0000666 00000001637 15077204524 0010102 0 ustar 00 sub user_update {
my @apps = &Debian::Defoma::Configure::get_apps();
unless (@apps) {
user_update_message("No application is ready for userlevel font ",
"autoconfiguration.");
return;
}
user_update_message("Following applications are ready for userlevel font ",
"autoconfiguration: @apps.");
foreach my $app (@apps) {
my $appinfo = &Debian::Defoma::Configure::get_app_info($app);
my $ch = $appinfo->{script_change};
if ($ch eq 'new') {
my $r = user_update_question(" $app is not configured for ",
USERLOGIN, ". ",
"Do you want to configure? ");
if ($r) {
user_update_invoke("update", $app);
}
} elsif ($ch eq 'updated') {
user_update_invoke("update", $app);
} elsif ($ch eq 'obsoleted') {
user_update_invoke("purge", $app);
} elsif ($ch eq 'same') {
user_update_message("font configuration for $app is up-to-date.");
}
}
}
1;
libconsole.pl 0000666 00000015427 15077204524 0007255 0 ustar 00 use POSIX;
my $dialog = '/usr/bin/whiptail';
$dialog = '/usr/bin/dialog' unless (-x $dialog);
# code from dialog.pl(return_output)
sub safe_redirect {
pipe(PARENT_READER, CHILD_WRITER);
my $pid = fork();
if ($pid == 0) {
close(PARENT_READER);
dup2(fileno(CHILD_WRITER),3);
open(STDOUT, ">&STDERR");
exec(@_);
die("exec failure: $_[0]");
}
my $ret = '';
if ($pid > 0) {
close(CHILD_WRITER);
$ret .= <PARENT_READER>;
close(PARENT_READER);
waitpid($pid, 0);
$result = $?; #GLOBAL Variable: result
}
return $ret;
}
sub linecount {
my $text = shift;
my $lines = 0;
my $cnt = 0;
my @words = split(/ /, $text);
my($i, $len, $space);
foreach $i (@words) {
if ($i eq '\n') {
$cnt = 0;
next;
}
$len = length($i);
while (1) {
$lines++ if ($cnt == 0);
$space = ($cnt > 0);
if ($cnt + $space + $len > $DWIDTH) {
if ($cnt == 0) {
$len -= $DWIDTH;
} else {
$cnt = 0;
}
} else {
$cnt += $len;
last;
}
}
}
return $lines;
}
# code from pppconfig.
#
# Copyright (C) 1999 John G. Hasler (john@dhh.gt.org)
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
sub dialogbox(@) {
my $type=shift(@_);
my $optionstr = (@_ > 0) ? shift(@_) : '';
my @vars=@_;
my $text=shift( @vars );
my $height = shift( @vars );
my $title = $DIALOGTITLE;
my @options = split(' ', $optionstr) if ($optionstr ne '');
# $result = callsystem_output('2>&1', '/usr/bin/dialog', '--clear', '--title',
# $title, @options, $type, $text, $height, 80,
# @vars);
# my $item=$output;
# chomp $item; # For gdialog, which returns strings with newlines.
my $item = safe_redirect($dialog, '--output-fd', '3', '--clear', '--title',
$title, @options, $type, $text, $height, 80, @vars);
$result = ($result >> 8);
exitfunc(255) if ($result == 255);
exitfunc(255, "Internal error") unless($result == 0 || $result == 1);
return $item;
}
sub msgbox(@) {
my $text = shift;
my $lines = linecount($text);
$lines += 7;
dialogbox("\-\-msgbox", '', $text, $lines);
return $result;
}
sub infobox(@) {
my $text = shift;
my $lines = linecount($text);
$lines += 7;
dialogbox("\-\-infobox", '', $text, $lines);
return $result;
}
sub yesnobox(@) {
my $text = shift;
my $lines = linecount($text);
$lines += 7;
dialogbox( "\-\-yesno", '', $text, $lines);
return $result;
}
sub inputbox(@) {
my $text = shift;
my $default = shift;
my $pattern = shift;
my $allowempty = shift;
my $lines = linecount($text);
my @args;
my $ret;
$lines += 7;
while(1) {
@args = ();
push(@args, $text);
push(@args, $lines);
push(@args, $default) if ($default ne '');
$ret = dialogbox( "\-\-inputbox", '', @args);
return '' if ($result != 0);
return '' if ($ret eq '' && $allowempty != 0);
return $ret if ($ret =~ /^$pattern+$/);
if ($ret eq '') {
$text = "Empty is not allowed.";
} else {
$default = $ret;
$ret =~ s/$pattern//g;
$default =~ s/[^$ret]/_/g;
$text = "Illegal characters: \"$ret\".";
if ($ret =~ / /) {
$text .= "\n you can use underscore in place of space.";
}
}
$lines = 8;
}
}
sub menu(@) {
my $text = shift( @_ );
my $menu_height = shift( @_ );
my $options = shift;
my $lines = linecount($text);
$lines += 6 + $menu_height;
return dialogbox( '--menu', $options, $text, $lines, $menu_height, @_ );
}
sub menu_single(@) {
my $text = shift;
my $menu_height = shift;
my $options = shift;
my $lines = linecount($text);
$lines += 6 + $menu_height;
my @args = @_;
my @pass = ();
my $i;
for ($i = 0; $i < @args; $i++) {
if ($args[$i] ne '') {
$pass[$i * 2] = $args[$i];
$pass[$i * 2 + 1] = ' ';
}
}
return dialogbox( '--menu', $options, $text, $lines, $menu_height,
@pass );
}
sub checklist_single_onargs(@) {
my $text = shift( @_ );
my $menu_height = shift( @_ );
my $onargs = shift;
my $lines = linecount($text);
$lines += 6 + $menu_height;
my @args = @_;
my @pass = ();
my $i;
my $j;
my @ons = split(' ', $onargs);
for ($i = $j = 0; $i < @args; $i++) {
if ($args[$i] ne '') {
$pass[$j++] = $args[$i];
$pass[$j++] = ' ';
$pass[$j++] = (grep($_ eq $args[$i], @ons)) ? 'on' : 'off';
}
}
return dialogbox('--checklist', '--separate-output', $text, $lines,
$menu_height, @pass );
}
$INPUTCOMMON_MENU = 1;
sub input_menu {
my $input_text = shift;
my $default = shift;
my $input_pattern = shift;
my $input_allowempty = shift;
my $input_menu_item = '';
my $menu_text = '';
my @menu_list = ();
if (@_ >= 3) {
$input_menu_item = shift;
$menu_text = shift;
@menu_list = @_;
}
while (1) {
if (@menu_list > 0) {
chomp($menu_text);
my $lines = 1;
while ($menu_text =~ /\n/m) {
$menu_text =~ s/\n/\\n/m;
$lines++;
}
my $menu_items = @menu_list;
my $mlines = 15 - $lines;
my $items = ($menu_items > $mlines) ? $mlines : $menu_items;
my $default_item = '';
$default_item = "--default-item $default" if ($default ne '' and $dialog =~ /(^|\/)dialog/);
my $ret;
if ($INPUTCOMMON_MENU == 1) {
$ret = menu_single($menu_text, $items, $default_item,
@menu_list);
} else {
$ret = menu($menu_text, $items, $default_item, @menu_list);
}
return '' if ($result != 0);
return $ret if ($ret ne $input_menu_item);
}
chomp($input_text);
$input_text =~ s/\n/\\n/gm;
$ret = inputbox($input_text, $default, $input_pattern,
$input_allowempty);
return $ret if ($result == 0 || $menu_text eq '');
}
}
sub input_checklist {
my $input_text = shift;
my $default = shift;
my $input_pattern = shift;
my $input_allowempty = shift;
my $clist_text = '';
my @clist_list = ();
if (@_ > 0) {
$clist_text = shift;
@clist_list = @_;
}
while (1) {
chomp($clist_text);
my $lines = 1;
while ($clist_text =~ /\n/m) {
$clist_text =~ s/\n/\\n/m;
$lines++;
}
my $clist_items = @clist_list;
my $clines = 15 - $lines;
my $items = ($clist_items > $clines) ? $clines : $clist_items;
my $ret;
$ret = checklist_single_onargs($clist_text, $items, $default,
@clist_list);
return '' if ($result != 0);
chomp($ret);
$ret =~ s/\n/ /g;
$ret = inputbox($input_text, $ret, $input_pattern, $input_allowempty);
return $ret if ($result == 0);
}
}
sub input_menu2 {
$INPUTCOMMON_MENU = 2;
my $ret = input_menu(@_);
$INPUTCOMMON_MENU = 1;
return $ret;
}
1;
libdefoma-app.pl 0000666 00000007115 15077204524 0007617 0 ustar 00 my $ProcessID = $$;
my $Arg0 = $ARG0;
sub com_app {
usage_and_exit if (@ARGV == 0);
my $command = shift;
my $app = shift(@ARGV);
my $upapp = ($command eq 'update') ? $app : undef;
my @category = @ARGV;
my @ocategory = @category;
arg_check($app) || exit ERROR;
mylock(1);
init_all($upapp);
my $appinfo = &Debian::Defoma::Configure::get_app_info($app);
unless($appinfo) {
term_all();
mylock(0);
printw("$app: Application not found.");
exit ERROR;
}
my @cs = &Debian::Defoma::Configure::get_app_categories($app);
@cs = reverse(@cs);
@category = @cs unless (@category);
unless (exists($appinfo->{ignore_category})) {
$appinfo->{ignore_category} = {};
}
my $ics = $appinfo->{ignore_category};
my $clean = 1;
my $update = 0;
my $purge = 0;
my $onlyupdate = 0;
my $reexec = 0;
my $ignore = 0;
my $cleanstr = "Cleaning up";
if ($command eq 'purge') {
$Debian::Defoma::Id::Purge = 1;
@category = @cs;
$purge = 1;
$cleanstr = "Purging";
} elsif ($command eq 'update') {
my $ppid = $ENV{DEFOMA_PREVIOUS_PROCESS_ID} || 0;
if ($ppid != $ProcessID) {
$update = 1;
if ($appinfo->{script_change} eq 'updated') {
$reexec = 1;
}
} else {
$onlyupdate = 1;
$clean = 0;
}
} elsif ($command eq 'ignore') {
$ignore = 1;
}
if ($update) {
printm("Updating font configuration of $app...");
} elsif ($clean) {
printm("$cleanstr font configuration of $app...");
}
my $fobjs = \%Debian::Defoma::Font::Fobjs;
my $fobj;
my @hints;
my @list;
my ($c, $max, $i, $font);
foreach $c (@cs) {
next unless ($clean);
next unless (grep($_ eq $c, @category));
if (exists($ics->{$c})) {
printm("Skipping category $c; it's ignored.");
next;
}
printm("$cleanstr category $c..");
next unless (exists($fobjs->{$c}));
$fobj = $fobjs->{$c};
@list = keys(%{$fobj->{cache_list}});
foreach $font (@list) {
@hints = split(' ', $fobj->{cache_list}->{$font});
printv(" $cleanstr $font...");
&Debian::Defoma::Configure::call_1($fobj, $app, 'unregister', $c,
$font, @hints);
$fobj->remove_failed($font, $app);
}
}
if ($reexec) {
term_all();
&Debian::Defoma::Configure::remove_script($app);
$ENV{DEFOMA_PREVIOUS_PROCESS_ID} = $ProcessID;
mylock(0);
exec($Arg0, ARGS);
}
if (($update || $onlyupdate) && @ocategory) {
my @rics;
foreach $c (@ocategory) {
if (exists($ics->{$c})) {
delete($ics->{$c});
push(@rics, $c);
}
}
if (@rics) {
printm("Releasing 'ignore' on following categories: @rics");
}
}
if ($ignore) {
foreach $c (@category) {
$ics->{$c} = undef;
}
printm("Setting 'ignore' on following categories: @category");
}
@cs = reverse(@cs);
foreach $c (@cs) {
next unless ($update || $onlyupdate);
next unless (grep($_ eq $c, @category));
if (exists($ics->{$c})) {
printm("Skipping category $c; it's ignored.");
next;
}
printm("Updating category $c..");
next unless (exists($fobjs->{$c}));
$fobj = $fobjs->{$c};
@list = keys(%{$fobj->{cache_list}});
foreach $font (@list) {
@hints = split(' ', $fobj->{cache_list}->{$font});
printv(" Updating $font...");
&Debian::Defoma::Configure::call_1($fobj, $app, 'register',
$c, $font, @hints);
}
}
if ($purge) {
&Debian::Defoma::Configure::purge_script($app);
}
term_all();
mylock(0);
exit 0;
}
sub main {
my $command = shift;
if ($command =~ /^(clean|update|purge|ignore)$/) {
com_app($command);
}
}
1;
libhint-type1.pl 0000666 00000006742 15077204524 0007615 0 ustar 00 sub sethint_type1 {
my $font = shift;
my $flag = 0;
my $line;
my @lines;
my $fontname = '';
my $fullname = '';
my @fullnamelist = ();
my $family = '';
my $generalfamily;
my $weight = '';
my $width = '';
my $shape;
my $slant;
my $serif = '';
my $swidth;
my $text;
my $encoding = '';
my $charset;
my $fontfilename = $font;
$fontfilename =~ s/^(.*)\/(.*)$/$2/;
my $fontdir = $1;
open(F, $font) || exitfunc(1, "$font: Unable to open.");
LINE: while (<F>) {
foreach $line (split('\r', $_)) {
if ($line =~ /\/FullName[ \t]*\(([^)]+)/) {
$fullname = $1;
@fullnamelist = split(' ', $fullname);
} elsif ($line =~ /\/FamilyName[ \t]*\(([^)]+)/) {
$family = $1;
} elsif ($line =~ /\/Weight[ \t]*\(([^)]+)/) {
$weight = $1;
} elsif ($line =~ /\/isFixedPitch[ \t]+true[ \t]/) {
$width = 'Fixed';
} elsif ($line =~ /\/isFixedPitch[ \t]+false[ \t]/) {
$width = 'Variable';
} elsif ($line =~ /\/FontName[ \t]*\/([^ \t]+)[ \t]/) {
$fontname = $1;
} elsif ($line =~ /\/Encoding[ \t]+([^ \t]+)[ \t]/) {
$encoding = $1;
}
last LINE if ($line =~ /currentdict[ \t]+end/);
}
}
if ($fontname eq '') {
exitfunc(1, "Some information aren't found in $fontfilename.\nAborting..");
}
$fontname =~ s/ /_/g;
$family =~ s/ /_/g;
$weight =~ s/ /_/g;
$slant = 'Upright';
$swidth = '';
for (my $i = 0; $i < @fullnamelist; $i++) {
$slant = 'Italic' if ($fullnamelist[$i] eq 'Italic');
$slant = 'Oblique' if ($fullnamelist[$i] eq 'Oblique');
$swidth = 'Condensed' if ($fullnamelist[$i] eq 'Condensed');
$swidth = 'Expanded' if ($fullnamelist[$i] eq 'Expanded');
}
$encoding =~ s/Encoding$//;
$charset = 'font-specific';
$charset = 'ISO8859-1' if ($encoding =~ /^(Standard|ISOLatin1)$/);
msgbox_q("Charset of $fontname is $charset.");
$family = input_family($fontname, $family);
return if ($result != 0);
$generalfamily = input_generalfamily($fontname, $family);
return if ($result != 0);
$serif = 'Serif' if ($generalfamily eq 'Roman');
$serif = 'NoSerif' if ($generalfamily eq 'SansSerif');
$width = 'Fixed' if ($generalfamily eq 'Typewriter');
$weight = input_weight($fontname, $weight);
return if ($result != 0);
$width = input_width($fontname, $width);
return if ($result != 0);
$shape = "$swidth $slant $serif";
$shape = input_shape($fontname, "$slant $serif $swidth");
return if ($result != 0);
my $alias = input_alias($fontname, '');
return if ($result != 0);
my $priority = input_priority($fontname, 20);
return if ($result != 0);
my $xlfd = input_xlfd($fontname);
return if ($result != 0);
my $afm = $font;
$afm =~ s/\.pf[ab]$//;
$afm .= ".afm";
unless (-f $afm) {
$afm = input_afm($fontname, $afm);
} else {
$afm = "$SUFFIXPATH" . $afm;
}
my $hints = "--FontName $fontname";
$hints .= " --Charset $charset";
$hints .= " --Family $family";
$hints .= " --GeneralFamily $generalfamily" if ($generalfamily =~ /\S/);
$hints .= " --Weight $weight" if ($weight =~ /\S/);
$hints .= " --Width $width" if ($width =~ /\S/);
$hints .= " --Shape $shape" if ($shape =~ /\S/);
$hints .= " --Alias $alias" if ($alias =~ /\S/);
$hints .= " --Priority $priority";
$hints .= " --X-FontName $xlfd" if ($xlfd =~ /\S/);
$hints .= " --AFM $afm" if ($afm =~ /\S/);
$hints =~ s/\s+/ /g;
return $hints;
}
1;
libdefoma-id.pl 0000666 00000005461 15077204524 0007435 0 ustar 00 sub com_id_list_cache {
usage_and_exit if (@ARGV == 0);
my $app = shift(@ARGV);
my @caches = get_files("id-cache.*", $ROOTDIR . "/$app.d");
foreach my $i (@caches) {
if ($i eq 'id-cache') {
$i = '#DEFAULT#';
} else {
$i =~ s/id-cache\.//;
}
}
printm("Id Cache: " . join(' ', @caches));
exit 0;
}
sub com_id_common {
my $com = shift;
usage_and_exit if (@ARGV < 3);
my $appcache = shift(@ARGV);
my $id = shift(@ARGV);
my $font = shift(@ARGV);
my $app;
my $cache;
if ($appcache =~ /^([^\/]+)\/(.*)/) {
$app = $1;
$cache = $2;
$cache = '' if ($cache eq '#DEFAULT#');
} else {
$app = $appcache;
$cache = '';
}
my $obj = defoma_id_open_cache($cache, $app);
unless ($obj) {
$cache = '#DEFAULT#' if ($cache eq '');
printw("id-cache $app/$cache not found.");
exit ERROR;
}
mylock(1);
init_all();
if ($com eq 'unset') {
defoma_id_unset($obj, $id, $font);
} else {
defoma_id_set($obj, $id, $font, $com);
}
term_all();
defoma_id_close_cache($obj);
mylock(0);
exit 0;
}
sub com_id_alias {
my $com = shift;
usage_and_exit if ($com eq 'add-alias' && @ARGV < 4);
usage_and_exit if ($com eq 'remove-alias' && @ARGV < 3);
my $appcache = shift(@ARGV);
my $id = shift(@ARGV);
my $font = shift(@ARGV);
my $alias = shift(@ARGV);
my $app;
my $cache;
if ($appcache =~ /^([^\/]+)\/(.*)/) {
$app = $1;
$cache = $2;
$cache = '' if ($cache eq '#DEFAULT#');
} else {
$app = $appcache;
$cache = '';
}
my $obj = defoma_id_open_cache($cache, $app);
unless ($obj) {
$cache = '#DEFAULT#' if ($cache eq '');
printw("id-cache $app/$cache not found.");
exit ERROR;
}
unless (exists($obj->{hash01}->{$id . ' ' . $font})) {
printw("id/font $id/$font not found.");
exit ERROR;
}
my $i = $obj->{hash01}->{$id . ' ' . $font};
if ($com eq 'add-alias') {
my $pri = $obj->{3}->[$i];
my $ctg = $obj->{4}->[$i];
mylock(1);
init_all();
defoma_id_register($obj, type => 'useralias', id => $alias,
font => $font, priority => $pri,
category => $ctg, origin => $id);
} else {
if ($obj->{2}->[$i] !~ /^Ua/) {
printw("id $id is not user-defined alias.");
exit ERROR;
}
mylock(1);
init_all();
defoma_id_unregister($obj, type => 'useralias', id => $id,
font => $font);
}
term_all();
defoma_id_close_cache($obj);
mylock(0);
exit 0;
}
sub main {
my $command = shift;
if ($command eq 'list-cache') {
com_id_list_cache();
} elsif ($command eq 'install' || $command eq 'exclude') {
com_id_common($command);
} elsif ($command eq 'unset') {
com_id_common('unset');
} elsif ($command eq 'add-alias' || $command eq 'remove-alias') {
com_id_alias($command);
}
}
1;
libhint-cmap.pl 0000666 00000004715 15077204524 0007471 0 ustar 00 sub sethint_cmap {
my $font = shift;
my $line;
my $flag = 0;
my $cmapname = '';
my $cidregistry = '';
my $cidordering = '';
my $cidsupplement = '';
my $fontfilename = $font;
$fontfilename =~ s/.*\/(.*)/$1/;
open(F, $font) || exitfunc(1, "$font: Unable to open.");
while (<F>) {
$line = $_;
chomp($line);
if ($line =~ /\/CMapName[ \t]/) {
$cmapname = $line;
$cmapname =~ s/.*\/CMapName[ \t]+\/([^ \t]+).*/$1/;
} elsif ($line =~ /\/CIDSystemInfo[ \t]/) {
$flag = 1;
} elsif ($flag == 1 && $line =~ /end[ \t]+def/) {
$flag = 0;
} elsif ($flag == 1 && $line =~ /\/Registry[ \t]/) {
$cidregistry = $line;
$cidregistry =~ s/.*\/Registry[ \t]+\((.*)\).*/$1/;
} elsif ($flag == 1 && $line =~ /\/Ordering[ \t]/) {
$cidordering = $line;
$cidordering =~ s/.*\/Ordering[ \t]+\((.*)\).*/$1/;
} elsif ($flag == 1 && $line =~ /\/Supplement[ \t]/) {
$cidsupplement = $line;
$cidsupplement =~ s/.*\/Supplement[ \t]+(.).*/$1/;
}
if ($cmapname ne '' && $cidordering ne '' && $cidregistry ne '' &&
$cidsupplement ne '') {
last;
}
}
close F;
if ($cmapname eq '' || $cidordering eq '' || $cidregistry eq '' ||
$cidsupplement eq '') {
exitfunc(1, "Some information aren't found in $fontfilename.\nAborting..");
}
my $charset = '';
my $encoding = '';
if (open(F, "$DEFOMA_TEST_DIR/etc/defoma/ps-cset-enc.data")) {
while (<F>) {
$line = $_;
chomp($line);
next if ($line =~ /^\#/);
my @list = split(' ', $line);
next if (@list < 3);
$list[0] =~ s/\*/\.\*/g;
$list[0] =~ s/\?/\./g;
$list[1] =~ s/\*/\.\*/g;
$list[1] =~ s/\?/\./g;
if ("$cidregistry-$cidordering-$cidsupplement" =~ /^($list[0])$/) {
if ($cmapname =~ /^($list[1])$/) {
if ($list[2] ne 'ignore') {
$charset = $list[2];
$charset =~ s/,/ /g;
$encoding = $list[3] if (@list >= 4);
}
last;
}
}
}
close F;
}
my $hints = "--CMapName $cmapname";
$hints .= " --CIDRegistry $cidregistry";
$hints .= " --CIDOrdering $cidordering";
$hints .= " --CIDSupplement $cidsupplement";
$hints .= " --Charset $charset" if ($charset =~ /\S/);
$hints .= " --Encoding $encoding" if ($encoding =~ /\S/);
$hints .= " --Direction Horizontal"
if ($cmapname =~ /\-H$/ || $cmapname eq 'H');
$hints .= " --Direction Vertical"
if ($cmapname =~ /\-V$/ || $cmapname eq 'V');
return $hints;
}
1;
libperl-hint.pl 0000666 00000025003 15077204524 0007504 0 ustar 00 my @GENERALFAMILY_LIST;
my @WEIGHT_LIST;
my @SHAPE_LIST;
$DIALOGTITLE = '';
$DWIDTH = 70;
$SUFFIXPATH = '';
$result = 0;
my %PARSEHINTS;
my %F2G = ();
my $NOQUESTION = 0;
sub parse_all_hints_conf {
my $key = shift;
my $listptr = shift;
$PARSEHINTS{$key} = $listptr;
}
sub parse_all_hints_init {
@GENERALFAMILY_LIST = ('Roman', 'SansSerif', 'Typewriter', 'Symbol',
'Gothic', 'Mincho');
@WEIGHT_LIST = ('Medium', 'Bold', 'Semibold', 'Light', 'Semilight');
@SHAPE_LIST = ('Serif', 'NoSerif', 'Upright', 'Oblique', 'Italic',
'Condensed', 'Expanded');
%PARSEHINTS = ();
parse_all_hints_conf('GeneralFamily', \@GENERALFAMILY_LIST);
parse_all_hints_conf('Weight', \@WEIGHT_LIST);
parse_all_hints_conf('Shape', \@SHAPE_LIST);
}
sub parse_all_hints {
my @hints = ();
foreach my $c (keys(%Debian::Defoma::Font::Fobjs)) {
foreach my $f (defoma_font_get_fonts($c)) {
my @h = defoma_font_get_hints($c, $f);
next unless (@h);
while ($h[0] !~ /^--/) {
shift(@h);
}
push(@hints, @h);
}
}
my $h = parse_hints_start(@hints);
foreach my $k (keys(%PARSEHINTS)) {
my $listptr = $PARSEHINTS{$k};
my %kso = ();
foreach my $i (@{$listptr}) {
$kso{$i} = undef;
}
foreach my $i (split(' ', $h->{$k})) {
push(@{$listptr}, $i) unless (exists($kso{$i}));
$kso{$i} = undef;
}
}
}
sub fileselector {
my $text = shift;
my $origdir = `/bin/pwd`;
chomp($origdir);
my $file;
my $retfile = '';
my $dtitle = $DIALOGTITLE;
$DIALOGTITLE = 'File Selector';
while (1) {
my $dir=`/bin/pwd`;
chomp($dir);
my @dirs = ();
my @files = ();
my @list;
opendir(DIR, '.');
@list = readdir(DIR);
closedir(DIR);
foreach $file (@list) {
next if ($file eq '.');
if (-d $file) {
push(@dirs, "$file/");
} else {
push(@files, $file);
}
}
@files = sort { $a cmp $b } (@files);
@dirs = sort { $a cmp $b } (@dirs);
my $ddir = $dir;
my $len = length($ddir);
if ($len > 60) {
$len -= 60;
$ddir =~ s/^.{$len}//;
}
my $desc = "$text\\n\\nDir: $ddir";
$file = menu_single($desc, 10, '', @dirs, @files);
$file =~ s@/$@@;
last if ($result != 0);
if (-d $file) {
chdir $file;
} else {
$retfile = "$dir/$file";
last;
}
}
$DIALOGTITLE = $dtitle;
chdir $origdir;
return $retfile;
}
sub msgbox_q {
unless ($NOQUESTION) {
msgbox(@_);
}
}
sub input_checklist_q {
if ($NOQUESTION) {
return $_[1];
} else {
return input_checklist(@_);
}
}
sub input_menu_q {
if ($NOQUESTION) {
return $_[1] if ($_[1] ne '');
return $_[6] if (@_ >= 7);
return '';
} else {
return input_menu(@_);
}
}
sub input_fontname {
my $default = shift;
my $text = <<EOF
Input the FontName of the font.
* FontName should be and must be a font-specific identifier. For example,
* a font of FooBar family, Bold weight and Italic shape should have
* FooBar-BoldItalic as the FontName.
EOF
;
return input_menu_q($text, $default, '[^ \t]', 0);
}
sub input_family {
my $font = shift;
my $default = shift;
my $text = <<EOF
Input the Family of $font.
* Family of the font is similar to a family name of a person. A font
* often has some decorated derivative fonts, but all of the derivative
* fonts and its original font share a common name. Family is exactly
* the shared common name. For example, Times-Roman has three decorated
* versions, Times-Italic, Times-Bold and Times-BoldItalic, and Family
* of them is Times.
EOF
;
return input_menu_q($text, $default, '[^ \t]', 0);
}
sub input_generalfamily {
my $font = shift;
my $family = shift;
my $text = <<EOF
Choose the GeneralFamily of $font.
* GeneralFamily represents the rough group which the font belongs to.
* This hint is useful for substitution of fonts, because fonts which
* belong to the same GeneralFamily are supposed to have more similar
* font faces than those which do not.
Following is a list of standard General Families (Roman, SansSerif,
Typewriter, Symbol, Gothic, and Mincho) and already registered General
Families. Please choose GeneralFamily from the list, or None if you
want to input a new GeneralFamily manually.
EOF
;
my $default = exists($F2G{$family}) ? $F2G{$family} : '';
my $ret = input_menu_q('Input the GeneralFamily of the font manually.',
$default, '[^ \t]', 0, '<None>', $text,
@GENERALFAMILY_LIST, '<None>');
if ($result == 0) {
$F2G{$family} = $ret;
}
return $ret;
}
sub input_weight {
my $font = shift;
my $default = shift;
my $menutext = <<EOF
Choose the Weight of $font.
* Weight represends the heaviness of the appearance, or the thickness
* of lines of glyphs, of the font.
Following is a list of standard Weights (Medium, Bold, Semibold, Light,
and Semilight) and already registered Weights. Please choose Weight from
the list, or None if you want to input a new Weight manually.
EOF
;
return input_menu_q('Input the Weight of the font manually.', $default,
'[^ \t]', 0, '<None>', $menutext, @WEIGHT_LIST,
'<None>');
}
sub input_width {
my $font = shift;
my $default = shift;
my $menutext = <<EOF
Choose the Width of $font.
* Width specifies whether the width of glyphs of the font varies, or is
* fixed. Typewriter fonts are maybe famous fixed width fonts. Most Latin
* fonts are variable width ones. Kanji fonts are also regarded as fixed
* width.
EOF
;
return input_menu_q('', $default, '', 0, '', $menutext, 'Variable', 'Fixed');
}
sub input_shape {
my $font = shift;
my $default = shift;
my @dlist = split(' ', $default);
my $slant = '';
my $serif = '';
my $width = '';
my $ret;
for (my $i = 0; $i < @dlist; $i++) {
$slant = $dlist[$i] if ($dlist[$i] =~ /^(Upright|Italic|Oblique)$/);
$width = $dlist[$i] if ($dlist[$i] =~ /^(Condensed|Expanded)$/);
$serif = $dlist[$i] if ($dlist[$i] =~ /^(Serif|NoSerif)$/);
}
$width = 'Normal' if ($width eq '');
$slant = 'Upright' if ($slant eq '');
my $text = <<EOF
Choose the Shapes of $font.
* Shape represents additional information about the appearance of glyphs
* of the font. This Hint category consists of several types of font faces,
* including Serif, Slant, and the extent of Width. The last one, Width
* hint here is absolutely different from Fixed/Variable Width hint, which
* is supposed to be already chosen.
Following is a list of candidates of hints about Shape of the font. Mark
the hints applicable to the font, by Space key.
EOF
;
$text =~ s/\n/\\n/gm;
my @hlist;
unless ($NOQUESTION) {
$ret = checklist_single_onargs($text, 9, "$width $slant $serif",
@SHAPE_LIST);
@hlist = split(/\n/, $ret);
} else {
@hlist = split(' ', "$width $slant $serif");
}
$slant = '';
$width = '';
$serif = '';
for ($i = 0; $i < @hlist; $i++) {
if ($hlist[$i] =~ /^(Upright|Oblique|Italic)$/) {
if ($slant eq '') {
$slant = $hlist[$i];
} elsif ($slant =~ /^(Oblique|Italic)$/ &&
$hlist[$i] =~ /^(Oblique|Italic)$/) {
$slant = 'Italic';
} else {
$text = "$slant and $hlist[$i] confclicts. ";
$text .= "Which is correct?";
$slant = menu_single($text, 2, '', $slant, $hlist[$i]);
}
$hlist[$i] = '';
}
if ($hlist[$i] =~ /^(Expanded|Condensed)$/) {
if ($width eq '') {
$width = $hlist[$i];
} else {
$text = "$width and $hlist[$i] confclicts.";
$text .= "Which is correct?";
$width = menu_single($text, 2, '', $width, $hlist[$i]);
}
$hlist[$i] = '';
}
if ($hlist[$i] =~ /^(Serif|NoSerif)$/) {
if ($serif eq '') {
$serif = $hlist[$i];
} else {
$text = "$serif and $hlist[$i] conflict.";
$text .= "Which is correct?";
$serif = menu_single($text, 2, '', $serif, $hlist[$i]);
}
$hlist[$i] = '';
}
}
$default = join(' ', @hlist, $serif, $slant, $width);
$default =~ s/\s+/ /g;
return input_menu_q('Add the Shapes of the font.', $default, '.', 1);
}
sub input_alias {
my $font = shift;
my $default = shift;
my $text = <<EOF
Input the Alias(es) of $font, if exists.
* Alias represents other FontName(s) of a font. Specifying them will
* make the font accessible by the alias(es).
You can specify more than one aliases by separating them by space.
EOF
;
return input_menu_q($text, $default, '[^ \t]', 1);
}
sub input_priority {
my $font = shift;
my $default = shift;
my $text = <<EOF
Input the Priority of $font between 0 and 99.
* Priority is used when more than one fonts provide the same identifier
* in ID cache. The font which has the largest Priority of them will
* actually get installed.
EOF
;
return input_menu_q($text, $default, '[0-9]', 0);
}
sub input_xlfd {
my $font = shift;
my $text = <<EOF
Input the X-FontName of $font.
* X-FontName specifies the XLFD(s) of the font in case if it is used
* in X. Defoma does not touch the configuration of X so X-FontName
* does not affect the actual XLFD(s) of the font, but is worth setting
* for applications which want to know available XLFDs with their
* detailed hints.
You can set more than one XLFDs by separating them by space. If XLFD
contains spaces, replace them with underscore(_).
EOF
;
return input_menu_q($text, '', '.', 1);
}
sub input_afm {
my $font = shift;
my $dir = shift;
my $text = <<EOF
Select the AFM file of $font.
* AFM file represents font metrics in ascii format. It is used
* for typesetting.
Select Cancel if AFM file is missing.
EOF
;
return '' if $NOQUESTION;
my $odir = `/bin/pwd`;
chomp($odir);
chdir($dir) if (defined($dir));
my $ret = fileselector($text);
chdir($odir);
return '' if ($result == 1);
return $ret unless ($result);
return;
}
sub lhints2hints {
my $lhints = shift;
my @list = split(' ', $lhints);
my $i;
my $line;
my @lines;
my $flag = 0;
foreach $i (@list) {
if ($i =~ /^--/) {
$i =~ s/^--//;
push(@lines, $line) if ($flag);
$line = " $i";
$flag = 1;
} elsif ($flag) {
$line .= ($flag > 1) ? ' ' : ' = ';
$line .= $i;
$flag = 2;
}
}
push(@lines, $line) if ($flag);
return @lines;
}
sub hint_beginlib {
$DIALOGTITLE = shift;
$DWIDTH = shift;
my $mode = shift;
$SUFFIXPATH = shift || '';
$NOQUESTION = shift;
parse_all_hints_init();
parse_all_hints();
if ($ENV{'DISPLAY'} && -f "$LIBDIR/libgtk.pl" && $mode ne 'c') {
require("$LIBDIR/libgtk.pl");
if ($@) {
require("$LIBDIR/libconsole.pl");
}
} else {
require("$LIBDIR/libconsole.pl");
}
}
1;
libperl-file.pl 0000666 00000001651 15077204524 0007464 0 ustar 00 sub get_file_category {
my $file = shift;
my $ret = `/usr/bin/file $file`;
chomp($ret);
$ret = substr($ret, length($file) + 2);
if ($ret eq 'ASCII text') {
if ($file =~ /\.hints$/) {
return 'hintfile';
}
} elsif ($ret =~ /PostScript/) {
if ($ret =~ /PostScript Type 1 font/) {
return 'type1';
} else {
if (open(F, $file)) {
my $l = scalar(<F>);
close F;
chomp($l);
if ($l =~ /Resource-CMap/) {
return 'cmap';
} elsif ($l =~ /Resource-Font/) {
return 'psfont';
} elsif ($l =~ /Resource-CIDFont/) {
return 'cid';
}
}
return 'unknown';
}
} elsif ($ret eq 'MS Windows TrueType font') {
return 'truetype';
} elsif ($ret eq 'data' && $file =~ /\.ttc/i) {
if (open(F, $file)) {
my $l = substr(scalar(<F>), 0, 4);
close F;
if ($l eq 'ttcf') {
return 'truetype';
}
}
return 'unknown';
}
return 'unknown';
}
1;
defoma-test.sh 0000666 00000000715 15077204524 0007325 0 ustar 00 #! /bin/sh
mkdir -p var/lib/defoma/scripts
mkdir -p usr/share/defoma/scripts
mkdir -p etc/defoma
cp -r /usr/share/defoma/* usr/share/defoma
cp /etc/defoma/*.subst-rule etc/defoma
SYSTEM="postscript\npspreview\npsprint\nx-postscript\nxfont"
for i in /var/lib/defoma/*.font-cache; do
s=${i##*/}
s=${s%.font-cache}
if ! echo -e "$SYSTEM" | fgrep -q -x -e "$s"; then
cp $i var/lib/defoma
fi
done
echo "export DEFOMA_TEST_DIR=`pwd`; ${SHELL:-bash}"
libhint-truetype.pl 0000666 00000021364 15077204524 0010431 0 ustar 00 my @ENCODING;
my @ID_LANG;
my %ID_Region;
BEGIN {
eval ("use Font::FreeType");
exitfunc(255, "libfont-freetype-perl is needed.") if ($@ ne '');
@ENCODING = qw(Symbol Unicode ShiftJIS GB2312 BIG5 WanSung Johab);
@ID_LANG =
qw(- Arabic Bulgarian Catalan Chinese Czech Danish German
Greek English Spanish Finnish French Hebrew Magyar Icelandic
Italian Japanese Korean Dutch Norwegian Polish Portuguese -
Romania Russian SerboCroatian Slovak Albanian Swedish Thai Turkish
? Indonesian Ukrainian Byelorussian Slovenian Estonian Latvian Lithuanian
- Persian Vietnamese Armenian Azerbaijan Basque - Macedonian
- - - - - - Afrikaans ?
? Hindi - - - - Malay Kazak
- Swahili - Uzbek TarTar Bengali Punjabi -
- Tamil - - - - - Sanskrit);
%ID_Region =
( 'Chinese' => 'Taiwan China HongKong Singapore Macau',
'SerboCroatian' => 'Croatian Serb.Roman Serb.Cyrillic',
'Azerbaijan' => 'Roman Cyrillic',
'Uzbek' => 'Roman Cyrillic',
);
}
sub get_standard_charset {
my $charset = shift;
my $i;
open(F, "$DEFOMA_TEST_DIR/etc/defoma/loc-cset.data") || return '';
while (<F>) {
my $line = $_;
chomp($line);
my @list = split(' ', $line);
next if (@list < 2);
$list[0] =~ s/\*/\.\*/g;
$list[0] =~ s/\?/\./g;
if ($charset =~ /^($list[0])$/) {
close F;
return $list[1];
}
}
close F;
return '';
}
sub freetype_init {
my $fontpath = shift;
my $facenum;
my $Face=Font::FreeType->new->face($fontpath);
$facenum=$Face->number_of_faces;
$facenum = 1 if ($facenum == 0);
return $facenum;
}
sub sethint_truetype {
my $font = shift;
my $fontfile = $font;
$fontfile =~ s/.*\///;
my $text;
my $facenum = freetype_init($font);
if ($facenum > 1) {
$text = <<EOF
$fontfile is a TrueType Collection, which has multiple faces in a single
font. Answer "Yes" if you want to specify hints for every face, otherwise
answer "No" and specify hints only for the first face. In most cases, each
face has similar look, so only the first face is needed for regular use,
which means "No" is the recommended answer.
$fontfile has $facenum faces.
EOF
;
$facenum = 1 if (yesnobox($text));
}
my $hints = ($facenum > 1) ? "--FaceNum $facenum" : '';
for (my $j = 0; $j < $facenum; $j++) {
my $fname = ($facenum > 1) ? "$fontfile,face\#$j" : "$fontfile";
my $cnt;
my $Face=Font::FreeType->new->face($font, index => $j);
$cnt = 1; #One name
my %langs = ();
my @family_list = $Face->family_name;
my @subfamily_list = $Face->style_name;
my @psfontname_list = $Face->postscript_name;
my @encoding_list = ();
my @foundry_list = ();
$text = <<EOF
Choose the Family of $fname.
* Family of the font is similar to a family name of a person. A font
* often has some decorated derivative fonts, but all of the derivative
* fonts and its original font share a common name. Family is exactly
* the shared common name. For example, Times-Roman has three decorated
* versions, Times-Italic, Times-Bold and Times-BoldItalic, and Family
* of them is Times.
EOF
;
my $family;
my $subfamily = '';
my $psfontname;
foreach my $i (@psfontname_list) {
$psfontname = $i;
$psfontname =~ s/-.*//;
push(@family_list, $psfontname) unless (grep($_ eq $psfontname,
@family_list));
}
$family = input_menu_q("Input the Family of $fname manually.", '',
'[^ \t]', 0, '<None>', $text, @family_list,
'<None>');
return if ($result != 0);
if (@subfamily_list > 1) {
$text = <<EOF
Choose the Subfamily of $fname.
* Subfamily is just a TrueType-specific information and only used for
* generating standard hints such as Weight and Shape.
EOF
;
$subfamily = input_menu_q('', '', '', 0, '', $text,
@subfamily_list);
return if ($result != 0);
} elsif (@subfamily_list == 1) {
$subfamily = $subfamily_list[0];
msgbox_q("Subfamily of $fname is $subfamily.");
} else {
$subfamily = '';
}
$psfontname = "$family-$subfamily";
$psfontname =~ s/[^a-zA-Z0-9-]//g;
push(@psfontname_list, $psfontname) unless(grep($_ eq $psfontname,
@psfontname_list));
$text = "the PostScript FontName of $fname";
$psfontname = input_menu_q("Input $text manually.", $psfontname,
'[a-zA-Z0-9-]', 0, '<None>',
"Choose $text.", @psfontname_list,
'<None>');
return if ($result != 0);
my $foundry = '';
if (@foundry_list > 1) {
$foundry = input_menu_q("Input the Foundry of $fname manually.",
'', '[^ \t]', 1, '<None>',
"Choose the Foundry of $fname.",
@foundry_list, '<None>');
return if ($result != 0);
} elsif (@foundry_list == 1) {
$foundry = $foundry_list[0];
msgbox_q("Foundry of $fname is $foundry.");
} else {
$text = "No Foundry information is found in $fname.\n";
$text .= "Please input the Foundry manually.";
$foundry = input_menu_q($text, '', '[^ \t]', 1);
}
my $encoding;
if (@encoding_list > 1) {
$text = <<EOF
Unfortunately, multiple encodings are registered in the information
record of $fname. It means only one of them is actually used to
encode the font. Please choose the correct one if you know which is
correct, otherwise choose Unicode. (In most cases Unicode is the correct
encoding.)
EOF
;
$encoding = input_menu_q('', 'Unicode', '', 0, '', $text,
@encoding_list);
return if ($result != 0);
} elsif (@encoding_list == 0) {
$text = "No encoding information is registered.";
$text .= " Assuming that the encoding is Unicode.";
msgbox_q($text);
$encoding = 'Unicode';
} else {
$encoding = $encoding_list[0];
}
my %location = ();
my $loc = '';
foreach my $i (keys(%langs)) {
my $lang_id = $i & 0xff;
my $region_id = ($i & 0xff00) >> 11;
if ($lang_id > @ID_LANG || $ID_LANG[$lang_id] =~ /^[\?-]$/) {
$loc = sprintf("Unknown(0x%02x)", $lang_id);
} else {
$loc = $ID_LANG[$lang_id];
if (exists($ID_Region{"$loc"})) {
my @region = split(' ', $ID_Region{"$loc"});
$loc .= '-';
$loc .= $region[$region_id];
}
}
$location{$loc} = 1;
}
$text = <<EOF
Mark the Locations of $fname.
* Location represents which language and which region characters of a font
* belongs to. This information is recorded in a TrueType font file in
* number as Language ID, and converted to string as <Language>-<Region> or
* just <Language> format by this program.
EOF
;
my @list = keys(%location);
if (@list > 1) {
$loc = input_checklist_q('Modify the Locations if necessary.',
join(' ', @list), '.', 1, $text, @list);
return if ($result != 0);
} elsif (@list == 1) {
$loc = $list[0];
msgbox_q("Location of $fname is:\n $loc");
} else {
msgbox_q('No Language ID(used for Location hint) is found.');
$loc = '';
}
my %charset = ();
my $cset;
@list = split(' ', $loc);
foreach $i (@list) {
$cset = get_standard_charset($i);
if ($cset eq '') {
$text = <<EOF
No Standard Charset for $i is found in
/etc/defoma/loc-cset.data. Input it manually, or just press return.
EOF
;
$cset = input_menu_q($text, '', '.', 1, '');
return if ($result != 0);
}
$charset{$cset} = undef;
}
$cset = join(' ', sort { $a cmp $b } keys(%charset));
$cset =~ s/,/ /g;
msgbox_q("Standard Charset of $fname is:\n$cset");
my $generalfamily = input_generalfamily($fname, $family);
return if ($result != 0);
my $weight = 'Medium';
my $slant = 'Upright';
$weight = 'Bold' if ($subfamily =~ /Bold/);
$weight = 'Light' if ($subfamily =~ /Light/);
$slant = 'Oblique Italic' if ($subfamily =~ /Italic/);
$slant = 'Oblique' if ($subfamily =~ /Oblique/);
$subfamily =~ s/^(Bold|Light|Italic|Oblique)$//g;
$subfamily =~ s/\s+/ /g;
$subfamily =~ s/^\s+//;
$subfamily =~ s/\s+$//;
$weight = input_weight($fname, $weight);
return if ($result != 0);
my $width = ($Face->is_fixed_width) ? 'Fixed' : 'Variable';
my $shape = $slant;
$shape .= " $subfamily" if ($subfamily ne '');
$shape = input_shape($fname, $shape);
return if ($result != 0);
my $alias = input_alias($fname, '');
return if ($result != 0);
my $priority = input_priority($fname, 20);
return if ($result != 0);
my $m = ($j > 0) ? $j : '';
$hints .= " --Family$m $family --FontName$m $psfontname";
$hints .= " --Encoding$m $encoding";
$hints .= " --Location$m $loc" if ($loc =~ /\S/);
$hints .= " --Charset$m $cset" if ($cset =~ /\S/);
$hints .= " --GeneralFamily$m $generalfamily"
if ($generalfamily =~ /\S/);
$hints .= " --Weight$m $weight" if ($weight =~ /\S/);
$hints .= " --Width$m $width" if ($width =~ /\S/);
$hints .= " --Shape$m $shape" if ($shape =~ /\S/);
$hints .= " --Alias$m $alias" if ($alias =~ /\S/);
$hints .= " --Foundry$m $foundry" if ($foundry =~ /\S/);
$hints .= " --Priority$m $priority";
}
return $hints;
}
1;