Файловый менеджер - Редактировать - /var/www/iplanru/data/www/intesco.ru/d59ed/defoma.tar
Назад
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;
| ver. 1.4 |
Github
|
.
| PHP 5.4.45-1~dotdeb+6.1 | Генерация страницы: 0 |
proxy
|
phpinfo
|
Настройка