tools/uniset - R - Git at Google

 #!/usr/bin/perl
 # Uniset -- Unicode subset manager -- Markus Kuhn
 # http://www.cl.cam.ac.uk/~mgk25/download/uniset.tar.gz

 # slightly modified for R to produce single-column output in
 # the style previously used (l/c a-f, no leading zeroes).

 require 5.014;
 use open ':utf8';
 use FindBin qw($RealBin);  # to find directory where this file is located

 binmode(STDOUT, ":utf8");
 binmode(STDIN, ":utf8");

 my (%name, %invname, %category, %comment);

 print <<End if $#ARGV < 0;
 Uniset -- Unicode subset manager -- Markus Kuhn

 Uniset merges and subtracts Unicode subsets. It can output and
 analyse the resulting character set in various formats.

 Uniset understand the following command-line arguments:

 Commands to define a set of characters:

   + filename   add the character set described in the file to the set
   - filename   remove the character set described in the file from the set
   +: filename  add the characters in the UTF-8 file to the set
   -: filename  remove the characters in the UTF-8 file from the set
   +xxxx..yyyy  add the range to the set (xxxx and yyyy are hex numbers)
   -xxxx..yyyy  remove the range from the set (xxxx and yyyy are hex numbers)
   +cat=Xx      add all Unicode characters with category code Xx
   -cat=Xx      remove all Unicode characters with category code Xx
   -cat!=Xx     remove all Unicode characters without category code Xx
   clean        remove any elements that do not appear in the Unicode database
   unknown      remove any elements that do appear in the Unicode database

 Command to output descriptions of the constructed set of characters:

   table        write a full table with one line per character
   compact      output the set in compact MES format
   c            output the set as C interval array
   nr           output the number of characters
   sources      output a table that shows the number of characters contributed
                by the various combinations of input sets added with +.
   utf8-list    output a list of all characters encoded in UTF-8

 Commands to tailor the following output commands:

   html         write HTML tables instead of plain text
   ucs          add the unicode character itself to the table (UTF-8 in
                plain table, numeric character reference in HTML)

 Formats of character set input files read by the + and - command:

 Empty lines, white space at the start and end of the line and any
 comment text following a \# are ignored. The following formats are
 recognized

 xx yyyy             xx is the hex code in an 8-bit character set and yyyy
                     is the corresponding Unicode value. Both can optionally
                     be prefixed by 0x. This is the format used in the
                     files on <ftp://ftp.unicode.org/Public/MAPPINGS/>.

 yyyy                yyyy (optionally prefixed with 0x) is a Unicode character
                     belonging to the specified subset.

 yyyy-yyyy           a range of Unicode characters belonging to
 yyyy..yyyy          the specified subset.

 xx yy yy yy-yy yy   xx denotes a row (high-byte) and the yy specify
                     corresponding low bytes or with a hyphen also ranges of
                     low bytes in the Unicode values that belong to this
                     subset. This is also the format that is generated by
                     the compact command.
 End
 exit 1 if $#ARGV < 0;


 # Subroutine to identify whether the ISO 10646/Unicode character code
 # ucs belongs into the East Asian Wide (W) or East Asian FullWidth
 # (F) category as defined in Unicode Technical Report #11.

 sub iswide ($) {
     my $ucs = shift(@_);

     return ($ucs >= 0x1100 &&
 	    ($ucs <= 0x115f ||                     # Hangul Jamo
 	     $ucs == 0x2329 || $ucs == 0x232a ||
 	     ($ucs >= 0x2e80 && $ucs <= 0xa4cf &&
 	      $ucs != 0x303f) ||                   # CJK .. Yi
 	     ($ucs >= 0xac00 && $ucs <= 0xd7a3) || # Hangul Syllables
 	     ($ucs >= 0xf900 && $ucs <= 0xfaff) || # CJK Comp. Ideographs
 	     ($ucs >= 0xfe30 && $ucs <= 0xfe6f) || # CJK Comp. Forms
 	     ($ucs >= 0xff00 && $ucs <= 0xff60) || # Fullwidth Forms
 	     ($ucs >= 0xffe0 && $ucs <= 0xffe6) ||
 	     ($ucs >= 0x20000 && $ucs <= 0x2fffd) ||
 	     ($ucs >= 0x30000 && $ucs <= 0x3fffd)));
 }

 # Return the Unicode name that belongs to a given character code

 # Jamo short names, see Unicode 3.0, table 4-4, page 86

 my @lname = ('G', 'GG', 'N', 'D', 'DD', 'R', 'M', 'B', 'BB', 'S', 'SS', '',
 	     'J', 'JJ', 'C', 'K', 'T', 'P', 'H'); # 1100..1112
 my @vname = ('A', 'AE', 'YA', 'YAE', 'EO', 'E', 'YEO', 'YE', 'O',
 	     'WA', 'WAE', 'OE', 'YO', 'U', 'WEO', 'WE', 'WI', 'YU',
 	     'EU', 'YI', 'I'); # 1161..1175
 my @tname = ('G', 'GG', 'GS', 'N', 'NJ', 'NH', 'D', 'L', 'LG', 'LM',
 	     'LB', 'LS', 'LT', 'LP', 'LH', 'M', 'B', 'BS', 'S', 'SS',
 	     'NG', 'J', 'C', 'K', 'T', 'P', 'H'); # 11a8..11c2

 sub name {
     my $ucs = shift(@_);

     # The intervals used here reflect Unicode Version 3.2
     if (($ucs >=  0x3400 && $ucs <=  0x4db5) ||
 	($ucs >=  0x4e00 && $ucs <=  0x9fa5) ||
 	($ucs >= 0x20000 && $ucs <= 0x2a6d6)) {
 	return "CJK UNIFIED IDEOGRAPH-" . sprintf("%04X", $ucs);
     }

     if ($ucs >= 0xac00 && $ucs <= 0xd7a3) {
 	my $s = $ucs - 0xac00;
 	my $l = 0x1100 + int($s / (21 * 28));
 	my $v = 0x1161 + int(($s % (21 * 28)) / 28);
 	my $t = 0x11a7 + $s % 28;
 	return "HANGUL SYLLABLE " .
 	    ($lname[int($s / (21 * 28))] .
 	     $vname[int(($s % (21 * 28)) / 28)] .
 	     $tname[$s % 28 - 1]);
     }

     return $name{$ucs};
 }

 sub is_unicode {
     my $ucs = shift(@_);

     # The intervals used here reflect Unicode Version 3.2
     if (($ucs >=  0x3400 && $ucs <=  0x4db5) ||
 	($ucs >=  0x4e00 && $ucs <=  0x9fa5) ||
 	($ucs >=  0xac00 && $ucs <=  0xd7a3) ||
 	($ucs >= 0x20000 && $ucs <= 0x2a6d6)) {
 	return 1;
     }

     return exists $name{$ucs};
 }

 my @search_path = ();
 if ($RealBin =~ m|^(.*)/bin\z| && -d "$1/share/uniset") {
     push @search_path, "$1/share/uniset";
 } else {
     push @search_path, $RealBin;
 }

 sub search_open {
     my ($mode, $fn) = @_;
     my $file;
     return $file if open($file, $mode, $fn);
     return undef if $fn =~ m|/|;
     for my $path (@search_path) {
 	return $file if open($file, $mode, "$path/$fn");
     }
     return undef;
 }

 my $html = 0;
 my $image = 0;
 my $adducs = 0;
 my $unicodedata = "UnicodeData.txt";
 my $blockdata = "Blocks.txt";

 # read list of all Unicode names
 my $data = search_open('<', $unicodedata);
 unless ($data) {
     die ("Can't open Unicode database '$unicodedata':\n$!\n\n" .
 	 "Please make sure that you have downloaded the file\n" .
 	 "http://www.unicode.org/Public/UNIDATA/UnicodeData.txt\n");
 }
 while (<$data>) {
     if (/^([0-9,A-F]{4,8});([^;]*);([^;]*);([^;]*);([^;]*);([^;]*);([^;]*);([^;]*);([^;]*);([^;]*);([^;]*);([^;]*);([^;]*);([^;]*);([^;]*)$/) {
 	next if $2 ne '<control>' && substr($2, 0, 1) eq '<';
 	$ucs = hex($1);
         $name{$ucs} = $2;
 	$invname{$2} = $ucs;
 	$category{$ucs} = $3;
         $comment{$ucs} = $12;
     } else {
         die("Syntax error in line '$_' in file '$unicodedata'\n");
     }
 }
 close($data);

 # read list of all Unicode blocks
 $data = search_open('<', $blockdata);
 unless ($data) {
     die ("Can't open Unicode blockname list '$blockdata':\n$!\n\n" .
 	 "Please make sure that you have downloaded the file\n" .
 	 "http://www.unicode.org/Public/UNIDATA/Blocks.txt\n");
 }
 my $blocks = 0;
 my (@blockstart, @blockend, @blockname);
 while (<$data>) {
     if (/^\s*([0-9,A-F]{4,8})\s*\.\.\s*([0-9,A-F]{4,8})\s*;\s*(.*)$/) {
         $blockstart[$blocks] = hex($1);
 	$blockend  [$blocks] = hex($2);
         $blockname [$blocks] = $3;
 	$blocks++;
     } elsif (/^\s*\#/ || /^\s*$/) {
 	# ignore comments and empty lines
     } else {
         die("Syntax error in line '$_' in file '$blockdata'\n");
     }
 }
 close($data);
 if ($blockend[$blocks-1] < 0x110000) {
     $blockstart[$blocks] = 0x110000;
     $blockend  [$blocks] = 0x7FFFFFFF;
     $blockname [$blocks] = "Beyond Plane 16";
     $blocks++;
 }

 # process command line arguments
 while ($_ = shift(@ARGV)) {
     if (/^html$/) {
 	$html = 1;
     } elsif (/^ucs$/) {
 	$adducs = 1;
     } elsif (/^img$/) {
 	$html = 1;
 	$image = 1;
     } elsif (/^template$/) {
 	$template = shift(@ARGV);
 	open(TEMPLATE, $template) || die("Can't open template file '$template': $!\n");
 	while (<TEMPLATE>) {
 	    if (/^\#\s*include\s+\"([^\"]*)\"\s*$/) {
 		open(INCLUDE, $1) || die("Can't open template include file '$1': $!\n");
 		while (<INCLUDE>) {
 		    print $_;
 		}
 		close(INCLUDE);
 	    } elsif (/^\#\s*quote\s+\"([^\"]*)\"\s*$/) {
 		open(INCLUDE, $1) || die("Can't open template include file '$1': $!\n");
 		while (<INCLUDE>) {
 		    s/&/&amp;/g;
 		    s/</&lt;/g;
 		    print $_;
 		}
 		close(INCLUDE);
 	    } else {
 		print $_;
 	    }
 	}
 	close(TEMPLATE);
     } elsif (/^\+cat=(.+)$/) {
 	# add characters with given category
 	$cat = $1;
 	for $i (keys(%category)) {
 	    $used{$i} = "[${cat}]" if $category{$i} eq $cat;
 	}
     } elsif (/^\-cat=(.+)$/) {
 	# remove characters with given category
 	$cat = $1;
 	for $i (keys(%category)) {
 	    delete $used{$i} if $category{$i} eq $cat;
 	}
     } elsif (/^\-cat!=(.+)$/) {
 	# remove characters without given category
 	$cat = $1;
 	for $i (keys(%category)) {
 	    delete $used{$i} unless $category{$i} eq $cat;
 	}
     } elsif (/^([+-]):(.*)/) {
 	$remove = $1 eq "-";
 	$setfile = $2;
 	$setfile = shift(@ARGV) if $setfile eq "";
 	push(@SETS, $setfile);
 	open(SET, $setfile) || die("Can't open set file '$setfile': $!\n");
 	$setname = $setfile;
 	while (<SET>) {
 	    while ($_) {
 		$i = ord($_);
 		$used{$i} .= "[${setname}]" unless $remove;
 		delete $used{$i} if $remove;
 		$_ = substr($_, 1);
 	    }
 	}
 	close SET;
     } elsif (/^([+-])(.*)/) {
 	$remove = $1 eq "-";
 	$setfile = $2;
 	$setfile = "$setfile..$setfile" if $setfile =~ /^([0-9A-Fa-f]{4,8})$/;
 	if ($setfile =~ /^([0-9A-Fa-f]{4,8})(-|\.\.)([0-9A-Fa-f]{4,8})$/) {
 	    # handle intervall specification on command line
 	    $first = hex($1);
 	    $last = hex($3);
 	    for ($i = $first; $i <= $last; $i++) {
 		$used{$i} .= "[ARG]" unless $remove;
 		delete $used{$i} if $remove;
 	    }
 	    next;
 	}
 	$setfile = shift(@ARGV) if $setfile eq "";
 	push(@SETS, $setfile);
 	my $setf = search_open('<', $setfile);
 	die("Can't open set file '$setfile': $!\n") unless $setf;
 	$cedf = ($setfile =~ /cedf/); # detect Kosta Kosti's trans CEDF format by path name
 	$setname = $setfile;
 	$setname =~ s/([^.\[\]]*)\..*/$1/;
 	while (<$setf>) {
 	    if (/^<code_set_name>/) {
 		# handle ISO 15897 (POSIX registry) charset mapping format
 		undef $comment_char;
 		undef $escape_char;
 		while (<$setf>) {
 		    if ($comment_char && /^$comment_char/) {
 			# remove comments
 			$_ = $`;
 		    }
 		    next if (/^\032?\s*$/);                                             # skip empty lines
 		    if (/^<comment_char> (\S)$/) {
 			$comment_char = $1;
 		    } elsif (/^<escape_char> (\S)$/) {
 			$escape_char = $1;
 		    } elsif (/^(END )?CHARMAP$/) {
 			#ignore
 		    } elsif (/^<.*>\s*\/x([0-9A-F]{2})\s*<U([0-9A-F]{4,8})>/) {
 			$used{hex($2)} .= "[${setname}{$1}]" unless $remove;
 			delete $used{hex($2)} if $remove;
 		    } else {
 			die("Syntax error in line $. in file '$setfile':\n'$_'\n");
 		    }
 		}
 		next;
 	    } elsif (/^STARTFONT /) {
 		# handle X11 BDF file
 		while (<$setf>) {
 		    if (/^ENCODING\s+([0-9]+)/) {
 			$used{$1} .= "[${setname}]" unless $remove;
 			delete $used{$1} if $remove;
 		    }
 		}
 		next;
 	    }
 	    tr/a-z/A-Z/;           # make input uppercase
 	    if ($cedf) {
 		if ($. > 4) {
 		    if (/^([0-9A-F]{2})\t.?\t(.*)$/) {
 			# handle Kosta Kosti's trans CEDF format
 			next if (hex($1) < 32 || (hex($1) > 0x7e && hex($1) < 0xa0));
 			$ucs = $invname{$2};
 			die "unknown ISO 10646 name '$2' in '$setfile' line $..\n" if ! $ucs;
 			$used{$ucs} .= "[${setname}{$1}]" unless $remove;
 			delete $used{$ucs} if $remove;
 		    } else {
 			die("Syntax error in line $. in CEDF file '$setfile':\n'$_'\n");
 		    }
 		}
 		next;
 	    }
 	    if (/^\s*(0X|U\+|U-)?([0-9A-F]{2})\s+\#\s*UNDEFINED\s*$/) {
 		# ignore ftp.unicode.org mapping file lines with #UNDEFINED
 		next;
 	    }
 	    s/^([^\#]*)\#.*$/$1/;  # remove comments
 	    next if (/^\032?\s*$/);     # skip empty lines
 	    if (/^\s*(0X)?([0-9A-F-]{2})\s+(0X|U\+|U-)?([0-9A-F]{4,8})\s*$/) {
 		# handle entry from a ftp.unicode.org mapping file
 		$used{hex($4)} .= "[${setname}{$2}]" unless $remove;
 		delete $used{hex($4)} if $remove;
 	    } elsif (/^\s*(0X|U\+|U-)?([0-9A-F]{4,8})(\s*-\s*|\s*\.\.\s*|\s+)(0X|U\+|U-)?([0-9A-F]{4,8})\s*$/) {
 		# handle interval specification
 		$first = hex($2);
 		$last = hex($5);
 		for ($i = $first; $i <= $last; $i++) {
 		    $used{$i} .= "[${setname}]" unless $remove;
 		    delete $used{$i} if $remove;
 		}
 	    } elsif (/^\s*([0-9A-F]{2,6})(\s+[0-9A-F]{2},?|\s+[0-9A-F]{2}-[0-9A-F]{2},?)+/) {
 		# handle lines from P10 MES draft
 		$row = $1;
 		$cols = $_;
 		$cols =~ s/^\s*([0-9A-F]{2,6})\s*(.*)\s*$/$2/;
 		$cols =~ tr/,//d;
 		@cols = split(/\s+/, $cols);
 		for (@cols) {
 		    if (/^(..)$/) {
 			$first = hex("$row$1");
 			$last  = $first;
 		    } elsif (/^(..)-(..)$/) {
 			$first = hex("$row$1");
 			$last  = hex("$row$2");
 		    } else {
 			die ("this should never happen '$_'");
 		    }
 		    for ($i = $first; $i <= $last; $i++) {
 			$used{$i} .= "[${setname}]" unless $remove;
 			delete $used{$i} if $remove;
 		    }
 		}
 	    } elsif (/^\s*(0X|U\+|U-)?([0-9A-F]{4,8})\s*/) {
 		# handle single character
 		$used{hex($2)} .= "[${setname}]" unless $remove;
 		delete $used{hex($2)} if $remove;
 	    } else {
 		die("Syntax error in line $. in file '$setfile':\n'$_'\n") unless /^\s*(\#.*)?$/;
 	    }
 	}
 	close $setf;
     } elsif (/^loadimages$/ || /^loadbigimages$/) {
 	if (/^loadimages$/) {
 	    $prefix = "Small.Glyphs";
 	} else {
 	    $prefix = "Glyphs";
 	}
 	$total = 0;
 	for $i (keys(%used)) {
 	    next if ($name{$i} eq "<control>");
 	    $total++;
 	}
 	$count = 0;
 	$| = 1;
 	for $i (sort({$a <=> $b} keys(%used))) {
 	    next if ($name{$i} eq "<control>");
 	    $count++;
 	    $j = sprintf("%04X", $i);
 	    $j =~ /(..)(..)/;
 	    $gif = "http://charts.unicode.org/Unicode.charts/$prefix/$1/U$j.gif";
 	    print("\r$count/$total: $gif");
 	    system("mkdir -p $prefix/$1; cd $prefix/$1; webcopy -u -s $gif &");
 	    select(undef, undef, undef, 0.2);
 	}
 	print("\n");
 	exit 0;
     } elsif (/^giftable/) {
 	# form a table of glyphs (requires pbmtools installed)
 	$count = 0;
 	for $i (keys(%used)) {
 	    $count++ unless $name{$i} eq "<control>";
 	}
 	$width = int(sqrt($count/sqrt(2)) + 0.5);
 	$width = $1 if /^giftable([0-9]+)$/;
 	system("rm -f tmp-*.pnm table.pnm~ table.pnm");
 	$col = 0;
 	$row = 0;
 	for $i (sort({$a <=> $b} keys(%used))) {
 	    next if ($name{$i} eq "<control>");
 	    $j = sprintf("%04X", $i);
 	    $j =~ /(..)(..)/;
 	    $gif = "Small.Glyphs/$1/U$j.gif";
 	    $pnm = sprintf("tmp-%02x.pnm", $col);
 	    $fallback = "Small.Glyphs/FF/UFFFD.gif";
 	    system("giftopnm $gif >$pnm || { rm $pnm ; giftopnm $fallback >$pnm ; }");
 	    if (++$col == $width) {
 		system("pnmcat -lr tmp-*.pnm | cat >tmp-row.pnm");
 		if ($row == 0) {
 		    system("mv tmp-row.pnm table.pnm");
 		} else {
 		    system("mv table.pnm table.pnm~; pnmcat -tb table.pnm~ tmp-row.pnm >table.pnm");
 		}
 		$row++;
 		$col = 0;
 		system("rm -f tmp-*.pnm table.pnm~");
 	    }
 	}
 	if ($col > 0) {
 	    system("pnmcat -lr tmp-*.pnm | cat >tmp-row.pnm");
 	    if ($row == 0) {
 		system("mv tmp-row.pnm table.pnm");
 	    } else {
 		system("mv table.pnm table.pnm~; pnmcat -tb -jleft -black table.pnm~ tmp-row.pnm >table.pnm");
 	    }
 	}
 	system("rm -f table.gif ; ppmtogif table.pnm > table.gif");
 	system("rm -f tmp-*.pnm table.pnm~ table.pnm");
     } elsif (/^table$/) {
 	# go through all used names to print full table
 	print "<TABLE border=2>\n" if $html;
 	for $i (sort({$a <=> $b} keys(%used))) {
 	    next if ($name{$i} eq "<control>");
 	    if ($html) {
 		$sources = $used{$i};
 		$sources =~ s/\]\[/, /g;
 		$sources =~ s/^\[//g;
 		$sources =~ s/\]$//g;
 		$sources =~ s/\{(..)\}/<SUB>$1<\/SUB>/g;
 		$j = sprintf("%04X", $i);
 		$j =~ /(..)(..)/;
 		$gif = "Small.Glyphs/$1/U$j.gif";
 		print "<TR>";
 		print "<TD><img width=32 height=32 src=\"$gif\">" if $image;
 		printf("<TD>&#%d;", $i) if $adducs;
 		print "<TD><SAMP>$j</SAMP><TD><SAMP>" . name($i);
 		print " ($comment{$i})" if $comment{$i};
 		print "</SAMP><TD><SMALL>$sources</SMALL>\n";
 	    } else {
 		printf("%04X \# ", $i);
 		print pack("U", $i) . " " if $adducs;
 		print name($i) ."\n";
 	    }
 	}
 	print "</TABLE>\n" if $html;
     } elsif (/^imgblock$/) {
 	$width = 16;
 	$width = $1 if /giftable([0-9]+)/;
 	$col = 0;
 	$subline = "";
 	print "\n<P><TABLE cellspacing=0 cellpadding=0>";
 	for $i (sort({$a <=> $b} keys(%used))) {
 	    print "<TR>" if $col == 0;
 	    $j = sprintf("%04X", $i);
 	    $j =~ /(..)(..)/;
 	    $gif = "Small.Glyphs/$1/U$j.gif";
 	    $alt = name($i);
 	    print "<TD><img width=32 height=32 src=\"$gif\" alt=\"$alt\">";
 	    $subline .= "<TD><SMALL><SAMP>$j</SAMP></SMALL>";
 	    if (++$col == $width) {
 		print "<TR align=center>$subline";
 		$col = 0;
 		$subline = "";
 	    }
 	}
 	print "<TR align=center>$subline" if ($col > 0);
 	print "</TABLE>\n";
     } elsif (/^sources$/) {
 	# count how many characters are attributed to the various source set combinations
 	print "<P>Number of occurences of source character set combinations:\n<TABLE border=2>" if $html;
 	for $i (keys(%used)) {
 	    next if ($name{$i} eq "<control>");
 	    $sources = $used{$i};
 	    $sources =~ s/\]\[/, /g;
 	    $sources =~ s/^\[//g;
 	    $sources =~ s/\]$//g;
 	    $sources =~ s/\{(..)\}//g;
 	    $contribs{$sources} += 1;
 	}
 	for $j (keys(%contribs)) {
 	    print "<TR><TD>$contribs{$j}<TD>$j\n" if $html;
 	}
 	print "</TABLE>\n" if $html;
     } elsif (/^compact$/) {
 	# print compact table in P10 MES format
 	print "<P>Compact representation of this character set:\n<TABLE border=2>" if $html;
 	print "<TR><TD><B>Rows</B><TD><B>Positions (Cells)</B>" if $html;
 	print "\n# Plane 00\n# Rows\tPositions (Cells)\n" unless $html;
 	$current_row = '';
 	$start_col = '';
 	$last_col = '';
 	for $i (sort({$a <=> $b} keys(%used))) {
 	    next if ($name{$i} eq "<control>");
 	    $row = sprintf("%02X", $i >> 8);
 	    $col = sprintf("%02X", $i & 0xff);
 	    if ($row ne $current_row) {
 		if (($last_col ne '') and ($last_col ne $start_col)) {
 		    print "-$last_col";
 		    print "</SAMP>" if $html;
 		}
 		print "<TR><TD><SAMP>$row</SAMP><TD><SAMP>" if $html;
 		print "\n  $row\t" unless $html;
 		$len = 0;
 		$current_row = $row;
 		$start_col = '';
 	    }
 	    if ($start_col eq '') {
 		print "$col";
 		$len += 2;
 		$start_col = $col;
 		$last_col = $col;
 	    } elsif (hex($col) == hex($last_col) + 1) {
 		$last_col = $col;
 	    } else {
 		if ($last_col ne $start_col) {
 		    print "-$last_col";
 		    $len += 3;
 		}
 		if ($len > 60 && !$html) {
 		    print "\n  $row\t";
 		    $len = 0;
 		};
 		print " " if $len;
 		print "$col";
 		$len += 2 + !! $len;
 		$start_col = $col;
 		$last_col = $col;
 	    }
 	}
 	if (($last_col ne '') and ($last_col ne $start_col)) {
 	    print "-$last_col";
 	    print "</SAMP>" if $html;
 	}
 	print "\n" if ($current_row ne '');
 	print "</TABLE>\n" if $html;
 	print "\n";
     } elsif (/^c$/) {
 	# print table as C interval array
 	print "{";
 	$last_i = '';
 	$columns = 1;
 	$col = $columns;
 	for $i (sort({$a <=> $b} keys(%used))) {
 	    next if ($name{$i} eq "<control>");
 	    if ($last_i eq '') {
 		if (++$col > $columns) { $col = 1; print "\n "; }
 		printf("   { 0x%x, ", $i);
 		$last_i = $i;
 	    } elsif ($i == $last_i + 1) {
 		$last_i = $i;
 	    } else {
 		printf("0x%x },", $last_i);
 		if (++$col > $columns) { $col = 1; print "\n "; }
 		printf("   { 0x%x, ", $i);
 		$last_i = $i;
 	    }
 	}
 	if ($last_i ne '') {
 	    printf("0x%x }", $last_i);
 	}
 	print "\n};\n";
     } elsif (/^utf8-list$/) {
 	$col = 0;
 	$block = 0;
 	$last = -1;
 	for $i (sort({$a <=> $b} keys(%used))) {
 	    next if ($name{$i} eq "<control>");
 	    while ($blockend[$block] < $i && $block < $blocks - 1) {
 		$block++;
 	    }
 	    if ($last <= $blockend[$block-1] &&
 		$i < $blockstart[$block]) {
 		print "\n" if ($col);
 		printf "\nFree block (U+%04X-U+%04X):\n\n",
 		    $blockend[$block-1] + 1, $blockstart[$block] - 1;
 		$col = 0;
 	    }
 	    if ($last < $blockstart[$block] && $i >= $blockstart[$block]) {
 		print "\n" if ($col);
 		printf "\n$blockname[$block] (U+%04X-U+%04X):\n\n",
 		$blockstart[$block], $blockend[$block];
 		$col = 0;
 	    }
 	    if ($category{$i} eq 'Mn') {
 		# prefix non-spacing character with U+25CC DOTTED CIRCLE
 		print "\x{25CC}";
 	    } elsif ($category{$i} eq 'Me') {
 		# prefix enclosing non-spacing character with space
 		print " ";
 	    }
 	    print pack("U", $i);
 	    $col += 1 + iswide($i);
 	    if ($col >= 64) {
 		print "\n";
 		$col = 0;
 	    }
 	    $last = $i;
 	}
 	print "\n" if ($col);
     } elsif (/^collections$/) {
 	$block = 0;
 	$last = -1;
 	for $i (sort({$a <=> $b} keys(%used))) {
 	    next if ($name{$i} eq "<control>");
 	    while ($blockend[$block] < $i && $block < $blocks - 1) {
 		$block++;
 	    }
 	    if ($last < $blockstart[$block] && $i >= $blockstart[$block]) {
 		print $blockname[$block],
 		  " " x (40 - length($blockname[$block]));
 		printf "%04X-%04X\n",
 		  $blockstart[$block], $blockend[$block];
 	    }
 	    $last = $i;
 	}
     } elsif (/^nr$/) {
 	print "<P>" if $html;
 	print "# " unless $html;
 	print "Number of characters in above table: ";
 	$count = 0;
 	for $i (keys(%used)) {
 	    $count++ unless $name{$i} eq "<control>";
 	}
 	print $count;
 	print "\n";
     } elsif (/^clean$/) {
 	# remove characters from set that are not in $unicodedata
 	for $i (keys(%used)) {
 	    delete $used{$i} unless is_unicode($i);
 	}
     } elsif (/^unknown$/) {
 	# remove characters from set that are in $unicodedata
 	for $i (keys(%used)) {
 	    delete $used{$i} if is_unicode($i);
 	}
     } else {
 	die("Unknown command line command '$_'\n");
     };
 }
	#!/usr/bin/perl
	# Uniset -- Unicode subset manager -- Markus Kuhn
	# http://www.cl.cam.ac.uk/~mgk25/download/uniset.tar.gz

	# slightly modified for R to produce single-column output in
	# the style previously used (l/c a-f, no leading zeroes).

	require 5.014;
	use open ':utf8';
	use FindBin qw($RealBin); # to find directory where this file is located

	binmode(STDOUT, ":utf8");
	binmode(STDIN, ":utf8");

	my (%name, %invname, %category, %comment);

	print <<End if $#ARGV < 0;
	Uniset -- Unicode subset manager -- Markus Kuhn

	Uniset merges and subtracts Unicode subsets. It can output and
	analyse the resulting character set in various formats.

	Uniset understand the following command-line arguments:

	Commands to define a set of characters:

	+ filename add the character set described in the file to the set
	- filename remove the character set described in the file from the set
	+: filename add the characters in the UTF-8 file to the set
	-: filename remove the characters in the UTF-8 file from the set
	+xxxx..yyyy add the range to the set (xxxx and yyyy are hex numbers)
	-xxxx..yyyy remove the range from the set (xxxx and yyyy are hex numbers)
	+cat=Xx add all Unicode characters with category code Xx
	-cat=Xx remove all Unicode characters with category code Xx
	-cat!=Xx remove all Unicode characters without category code Xx
	clean remove any elements that do not appear in the Unicode database
	unknown remove any elements that do appear in the Unicode database

	Command to output descriptions of the constructed set of characters:

	table write a full table with one line per character
	compact output the set in compact MES format
	c output the set as C interval array
	nr output the number of characters
	sources output a table that shows the number of characters contributed
	by the various combinations of input sets added with +.
	utf8-list output a list of all characters encoded in UTF-8

	Commands to tailor the following output commands:

	html write HTML tables instead of plain text
	ucs add the unicode character itself to the table (UTF-8 in
	plain table, numeric character reference in HTML)

	Formats of character set input files read by the + and - command:

	Empty lines, white space at the start and end of the line and any
	comment text following a \# are ignored. The following formats are
	recognized

	xx yyyy xx is the hex code in an 8-bit character set and yyyy
	is the corresponding Unicode value. Both can optionally
	be prefixed by 0x. This is the format used in the
	files on <ftp://ftp.unicode.org/Public/MAPPINGS/>.

	yyyy yyyy (optionally prefixed with 0x) is a Unicode character
	belonging to the specified subset.

	yyyy-yyyy a range of Unicode characters belonging to
	yyyy..yyyy the specified subset.

	xx yy yy yy-yy yy xx denotes a row (high-byte) and the yy specify
	corresponding low bytes or with a hyphen also ranges of
	low bytes in the Unicode values that belong to this
	subset. This is also the format that is generated by
	the compact command.
	End
	exit 1 if $#ARGV < 0;


	# Subroutine to identify whether the ISO 10646/Unicode character code
	# ucs belongs into the East Asian Wide (W) or East Asian FullWidth
	# (F) category as defined in Unicode Technical Report #11.

	sub iswide ($) {
	my $ucs = shift(@_);

	return ($ucs >= 0x1100 &&
	($ucs <= 0x115f \|\| # Hangul Jamo
	$ucs == 0x2329 \|\| $ucs == 0x232a \|\|
	($ucs >= 0x2e80 && $ucs <= 0xa4cf &&
	$ucs != 0x303f) \|\| # CJK .. Yi
	($ucs >= 0xac00 && $ucs <= 0xd7a3) \|\| # Hangul Syllables
	($ucs >= 0xf900 && $ucs <= 0xfaff) \|\| # CJK Comp. Ideographs
	($ucs >= 0xfe30 && $ucs <= 0xfe6f) \|\| # CJK Comp. Forms
	($ucs >= 0xff00 && $ucs <= 0xff60) \|\| # Fullwidth Forms
	($ucs >= 0xffe0 && $ucs <= 0xffe6) \|\|
	($ucs >= 0x20000 && $ucs <= 0x2fffd) \|\|
	($ucs >= 0x30000 && $ucs <= 0x3fffd)));
	}

	# Return the Unicode name that belongs to a given character code

	# Jamo short names, see Unicode 3.0, table 4-4, page 86

	my @lname = ('G', 'GG', 'N', 'D', 'DD', 'R', 'M', 'B', 'BB', 'S', 'SS', '',
	'J', 'JJ', 'C', 'K', 'T', 'P', 'H'); # 1100..1112
	my @vname = ('A', 'AE', 'YA', 'YAE', 'EO', 'E', 'YEO', 'YE', 'O',
	'WA', 'WAE', 'OE', 'YO', 'U', 'WEO', 'WE', 'WI', 'YU',
	'EU', 'YI', 'I'); # 1161..1175
	my @tname = ('G', 'GG', 'GS', 'N', 'NJ', 'NH', 'D', 'L', 'LG', 'LM',
	'LB', 'LS', 'LT', 'LP', 'LH', 'M', 'B', 'BS', 'S', 'SS',
	'NG', 'J', 'C', 'K', 'T', 'P', 'H'); # 11a8..11c2

	sub name {
	my $ucs = shift(@_);

	# The intervals used here reflect Unicode Version 3.2
	if (($ucs >= 0x3400 && $ucs <= 0x4db5) \|\|
	($ucs >= 0x4e00 && $ucs <= 0x9fa5) \|\|
	($ucs >= 0x20000 && $ucs <= 0x2a6d6)) {
	return "CJK UNIFIED IDEOGRAPH-" . sprintf("%04X", $ucs);
	}

	if ($ucs >= 0xac00 && $ucs <= 0xd7a3) {
	my $s = $ucs - 0xac00;
	my $l = 0x1100 + int($s / (21 * 28));
	my $v = 0x1161 + int(($s % (21 * 28)) / 28);
	my $t = 0x11a7 + $s % 28;
	return "HANGUL SYLLABLE " .
	($lname[int($s / (21 * 28))] .
	$vname[int(($s % (21 * 28)) / 28)] .
	$tname[$s % 28 - 1]);
	}

	return $name{$ucs};
	}

	sub is_unicode {
	my $ucs = shift(@_);

	# The intervals used here reflect Unicode Version 3.2
	if (($ucs >= 0x3400 && $ucs <= 0x4db5) \|\|
	($ucs >= 0x4e00 && $ucs <= 0x9fa5) \|\|
	($ucs >= 0xac00 && $ucs <= 0xd7a3) \|\|
	($ucs >= 0x20000 && $ucs <= 0x2a6d6)) {
	return 1;
	}

	return exists $name{$ucs};
	}

	my @search_path = ();
	if ($RealBin =~ m\|^(.*)/bin\z\| && -d "$1/share/uniset") {
	push @search_path, "$1/share/uniset";
	} else {
	push @search_path, $RealBin;
	}

	sub search_open {
	my ($mode, $fn) = @_;
	my $file;
	return $file if open($file, $mode, $fn);
	return undef if $fn =~ m\|/\|;
	for my $path (@search_path) {
	return $file if open($file, $mode, "$path/$fn");
	}
	return undef;
	}

	my $html = 0;
	my $image = 0;
	my $adducs = 0;
	my $unicodedata = "UnicodeData.txt";
	my $blockdata = "Blocks.txt";

	# read list of all Unicode names
	my $data = search_open('<', $unicodedata);
	unless ($data) {
	die ("Can't open Unicode database '$unicodedata':\n$!\n\n" .
	"Please make sure that you have downloaded the file\n" .
	"http://www.unicode.org/Public/UNIDATA/UnicodeData.txt\n");
	}
	while (<$data>) {
	if (/^([0-9,A-F]{4,8});([^;]);([^;]);([^;]);([^;]);([^;]);([^;]);([^;]);([^;]);([^;]);([^;]);([^;]);([^;]);([^;]);([^;])$/) {
	next if $2 ne '<control>' && substr($2, 0, 1) eq '<';
	$ucs = hex($1);
	$name{$ucs} = $2;
	$invname{$2} = $ucs;
	$category{$ucs} = $3;
	$comment{$ucs} = $12;
	} else {
	die("Syntax error in line '$_' in file '$unicodedata'\n");
	}
	}
	close($data);

	# read list of all Unicode blocks
	$data = search_open('<', $blockdata);
	unless ($data) {
	die ("Can't open Unicode blockname list '$blockdata':\n$!\n\n" .
	"Please make sure that you have downloaded the file\n" .
	"http://www.unicode.org/Public/UNIDATA/Blocks.txt\n");
	}
	my $blocks = 0;
	my (@blockstart, @blockend, @blockname);
	while (<$data>) {
	if (/^\s([0-9,A-F]{4,8})\s\.\.\s([0-9,A-F]{4,8})\s;\s(.)$/) {
	$blockstart[$blocks] = hex($1);
	$blockend [$blocks] = hex($2);
	$blockname [$blocks] = $3;
	$blocks++;
	} elsif (/^\s\#/ \|\| /^\s$/) {
	# ignore comments and empty lines
	} else {
	die("Syntax error in line '$_' in file '$blockdata'\n");
	}
	}
	close($data);
	if ($blockend[$blocks-1] < 0x110000) {
	$blockstart[$blocks] = 0x110000;
	$blockend [$blocks] = 0x7FFFFFFF;
	$blockname [$blocks] = "Beyond Plane 16";
	$blocks++;
	}

	# process command line arguments
	while ($_ = shift(@ARGV)) {
	if (/^html$/) {
	$html = 1;
	} elsif (/^ucs$/) {
	$adducs = 1;
	} elsif (/^img$/) {
	$html = 1;
	$image = 1;
	} elsif (/^template$/) {
	$template = shift(@ARGV);
	open(TEMPLATE, $template) \|\| die("Can't open template file '$template': $!\n");
	while (<TEMPLATE>) {
	if (/^\#\sinclude\s+\"([^\"])\"\s*$/) {
	open(INCLUDE, $1) \|\| die("Can't open template include file '$1': $!\n");
	while (<INCLUDE>) {
	print $_;
	}
	close(INCLUDE);
	} elsif (/^\#\squote\s+\"([^\"])\"\s*$/) {
	open(INCLUDE, $1) \|\| die("Can't open template include file '$1': $!\n");
	while (<INCLUDE>) {
	s/&/&/g;
	s/</</g;
	print $_;
	}
	close(INCLUDE);
	} else {
	print $_;
	}
	}
	close(TEMPLATE);
	} elsif (/^\+cat=(.+)$/) {
	# add characters with given category
	$cat = $1;
	for $i (keys(%category)) {
	$used{$i} = "[${cat}]" if $category{$i} eq $cat;
	}
	} elsif (/^\-cat=(.+)$/) {
	# remove characters with given category
	$cat = $1;
	for $i (keys(%category)) {
	delete $used{$i} if $category{$i} eq $cat;
	}
	} elsif (/^\-cat!=(.+)$/) {
	# remove characters without given category
	$cat = $1;
	for $i (keys(%category)) {
	delete $used{$i} unless $category{$i} eq $cat;
	}
	} elsif (/^([+-]):(.*)/) {
	$remove = $1 eq "-";
	$setfile = $2;
	$setfile = shift(@ARGV) if $setfile eq "";
	push(@SETS, $setfile);
	open(SET, $setfile) \|\| die("Can't open set file '$setfile': $!\n");
	$setname = $setfile;
	while (<SET>) {
	while ($_) {
	$i = ord($_);
	$used{$i} .= "[${setname}]" unless $remove;
	delete $used{$i} if $remove;
	$_ = substr($_, 1);
	}
	}
	close SET;
	} elsif (/^([+-])(.*)/) {
	$remove = $1 eq "-";
	$setfile = $2;
	$setfile = "$setfile..$setfile" if $setfile =~ /^([0-9A-Fa-f]{4,8})$/;
	if ($setfile =~ /^([0-9A-Fa-f]{4,8})(-\|\.\.)([0-9A-Fa-f]{4,8})$/) {
	# handle intervall specification on command line
	$first = hex($1);
	$last = hex($3);
	for ($i = $first; $i <= $last; $i++) {
	$used{$i} .= "[ARG]" unless $remove;
	delete $used{$i} if $remove;
	}
	next;
	}
	$setfile = shift(@ARGV) if $setfile eq "";
	push(@SETS, $setfile);
	my $setf = search_open('<', $setfile);
	die("Can't open set file '$setfile': $!\n") unless $setf;
	$cedf = ($setfile =~ /cedf/); # detect Kosta Kosti's trans CEDF format by path name
	$setname = $setfile;
	$setname =~ s/([^.\[\]])\../$1/;
	while (<$setf>) {
	if (/^<code_set_name>/) {
	# handle ISO 15897 (POSIX registry) charset mapping format
	undef $comment_char;
	undef $escape_char;
	while (<$setf>) {
	if ($comment_char && /^$comment_char/) {
	# remove comments
	$_ = $`;
	}
	next if (/^\032?\s*$/); # skip empty lines
	if (/^<comment_char> (\S)$/) {
	$comment_char = $1;
	} elsif (/^<escape_char> (\S)$/) {
	$escape_char = $1;
	} elsif (/^(END )?CHARMAP$/) {
	#ignore
	} elsif (/^<.>\s\/x([0-9A-F]{2})\s*<U([0-9A-F]{4,8})>/) {
	$used{hex($2)} .= "[${setname}{$1}]" unless $remove;
	delete $used{hex($2)} if $remove;
	} else {
	die("Syntax error in line $. in file '$setfile':\n'$_'\n");
	}
	}
	next;
	} elsif (/^STARTFONT /) {
	# handle X11 BDF file
	while (<$setf>) {
	if (/^ENCODING\s+([0-9]+)/) {
	$used{$1} .= "[${setname}]" unless $remove;
	delete $used{$1} if $remove;
	}
	}
	next;
	}
	tr/a-z/A-Z/; # make input uppercase
	if ($cedf) {
	if ($. > 4) {
	if (/^([0-9A-F]{2})\t.?\t(.*)$/) {
	# handle Kosta Kosti's trans CEDF format
	next if (hex($1) < 32 \|\| (hex($1) > 0x7e && hex($1) < 0xa0));
	$ucs = $invname{$2};
	die "unknown ISO 10646 name '$2' in '$setfile' line $..\n" if ! $ucs;
	$used{$ucs} .= "[${setname}{$1}]" unless $remove;
	delete $used{$ucs} if $remove;
	} else {
	die("Syntax error in line $. in CEDF file '$setfile':\n'$_'\n");
	}
	}
	next;
	}
	if (/^\s(0X\|U\+\|U-)?([0-9A-F]{2})\s+\#\sUNDEFINED\s*$/) {
	# ignore ftp.unicode.org mapping file lines with #UNDEFINED
	next;
	}
	s/^([^\#])\#.$/$1/; # remove comments
	next if (/^\032?\s*$/); # skip empty lines
	if (/^\s(0X)?([0-9A-F-]{2})\s+(0X\|U\+\|U-)?([0-9A-F]{4,8})\s$/) {
	# handle entry from a ftp.unicode.org mapping file
	$used{hex($4)} .= "[${setname}{$2}]" unless $remove;
	delete $used{hex($4)} if $remove;
	} elsif (/^\s(0X\|U\+\|U-)?([0-9A-F]{4,8})(\s-\s\|\s\.\.\s\|\s+)(0X\|U\+\|U-)?([0-9A-F]{4,8})\s$/) {
	# handle interval specification
	$first = hex($2);
	$last = hex($5);
	for ($i = $first; $i <= $last; $i++) {
	$used{$i} .= "[${setname}]" unless $remove;
	delete $used{$i} if $remove;
	}
	} elsif (/^\s*([0-9A-F]{2,6})(\s+[0-9A-F]{2},?\|\s+[0-9A-F]{2}-[0-9A-F]{2},?)+/) {
	# handle lines from P10 MES draft
	$row = $1;
	$cols = $_;
	$cols =~ s/^\s([0-9A-F]{2,6})\s(.)\s$/$2/;
	$cols =~ tr/,//d;
	@cols = split(/\s+/, $cols);
	for (@cols) {
	if (/^(..)$/) {
	$first = hex("$row$1");
	$last = $first;
	} elsif (/^(..)-(..)$/) {
	$first = hex("$row$1");
	$last = hex("$row$2");
	} else {
	die ("this should never happen '$_'");
	}
	for ($i = $first; $i <= $last; $i++) {
	$used{$i} .= "[${setname}]" unless $remove;
	delete $used{$i} if $remove;
	}
	}
	} elsif (/^\s(0X\|U\+\|U-)?([0-9A-F]{4,8})\s/) {
	# handle single character
	$used{hex($2)} .= "[${setname}]" unless $remove;
	delete $used{hex($2)} if $remove;
	} else {
	die("Syntax error in line $. in file '$setfile':\n'$_'\n") unless /^\s(\#.)?$/;
	}
	}
	close $setf;
	} elsif (/^loadimages$/ \|\| /^loadbigimages$/) {
	if (/^loadimages$/) {
	$prefix = "Small.Glyphs";
	} else {
	$prefix = "Glyphs";
	}
	$total = 0;
	for $i (keys(%used)) {
	next if ($name{$i} eq "<control>");
	$total++;
	}
	$count = 0;
	$\| = 1;
	for $i (sort({$a <=> $b} keys(%used))) {
	next if ($name{$i} eq "<control>");
	$count++;
	$j = sprintf("%04X", $i);
	$j =~ /(..)(..)/;
	$gif = "http://charts.unicode.org/Unicode.charts/$prefix/$1/U$j.gif";
	print("\r$count/$total: $gif");
	system("mkdir -p $prefix/$1; cd $prefix/$1; webcopy -u -s $gif &");
	select(undef, undef, undef, 0.2);
	}
	print("\n");
	exit 0;
	} elsif (/^giftable/) {
	# form a table of glyphs (requires pbmtools installed)
	$count = 0;
	for $i (keys(%used)) {
	$count++ unless $name{$i} eq "<control>";
	}
	$width = int(sqrt($count/sqrt(2)) + 0.5);
	$width = $1 if /^giftable([0-9]+)$/;
	system("rm -f tmp-*.pnm table.pnm~ table.pnm");
	$col = 0;
	$row = 0;
	for $i (sort({$a <=> $b} keys(%used))) {
	next if ($name{$i} eq "<control>");
	$j = sprintf("%04X", $i);
	$j =~ /(..)(..)/;
	$gif = "Small.Glyphs/$1/U$j.gif";
	$pnm = sprintf("tmp-%02x.pnm", $col);
	$fallback = "Small.Glyphs/FF/UFFFD.gif";
	system("giftopnm $gif >$pnm \|\| { rm $pnm ; giftopnm $fallback >$pnm ; }");
	if (++$col == $width) {
	system("pnmcat -lr tmp-*.pnm \| cat >tmp-row.pnm");
	if ($row == 0) {
	system("mv tmp-row.pnm table.pnm");
	} else {
	system("mv table.pnm table.pnm~; pnmcat -tb table.pnm~ tmp-row.pnm >table.pnm");
	}
	$row++;
	$col = 0;
	system("rm -f tmp-*.pnm table.pnm~");
	}
	}
	if ($col > 0) {
	system("pnmcat -lr tmp-*.pnm \| cat >tmp-row.pnm");
	if ($row == 0) {
	system("mv tmp-row.pnm table.pnm");
	} else {
	system("mv table.pnm table.pnm~; pnmcat -tb -jleft -black table.pnm~ tmp-row.pnm >table.pnm");
	}
	}
	system("rm -f table.gif ; ppmtogif table.pnm > table.gif");
	system("rm -f tmp-*.pnm table.pnm~ table.pnm");
	} elsif (/^table$/) {
	# go through all used names to print full table
	print "<TABLE border=2>\n" if $html;
	for $i (sort({$a <=> $b} keys(%used))) {
	next if ($name{$i} eq "<control>");
	if ($html) {
	$sources = $used{$i};
	$sources =~ s/\]\[/, /g;
	$sources =~ s/^\[//g;
	$sources =~ s/\]$//g;
	$sources =~ s/\{(..)\}/<SUB>$1<\/SUB>/g;
	$j = sprintf("%04X", $i);
	$j =~ /(..)(..)/;
	$gif = "Small.Glyphs/$1/U$j.gif";
	print "<TR>";
	print "<TD><img width=32 height=32 src=\"$gif\">" if $image;
	printf("<TD>&#%d;", $i) if $adducs;
	print "<TD><SAMP>$j</SAMP><TD><SAMP>" . name($i);
	print " ($comment{$i})" if $comment{$i};
	print "</SAMP><TD><SMALL>$sources</SMALL>\n";
	} else {
	printf("%04X \# ", $i);
	print pack("U", $i) . " " if $adducs;
	print name($i) ."\n";
	}
	}
	print "</TABLE>\n" if $html;
	} elsif (/^imgblock$/) {
	$width = 16;
	$width = $1 if /giftable([0-9]+)/;
	$col = 0;
	$subline = "";
	print "\n<P><TABLE cellspacing=0 cellpadding=0>";
	for $i (sort({$a <=> $b} keys(%used))) {
	print "<TR>" if $col == 0;
	$j = sprintf("%04X", $i);
	$j =~ /(..)(..)/;
	$gif = "Small.Glyphs/$1/U$j.gif";
	$alt = name($i);
	print "<TD><img width=32 height=32 src=\"$gif\" alt=\"$alt\">";
	$subline .= "<TD><SMALL><SAMP>$j</SAMP></SMALL>";
	if (++$col == $width) {
	print "<TR align=center>$subline";
	$col = 0;
	$subline = "";
	}
	}
	print "<TR align=center>$subline" if ($col > 0);
	print "</TABLE>\n";
	} elsif (/^sources$/) {
	# count how many characters are attributed to the various source set combinations
	print "<P>Number of occurences of source character set combinations:\n<TABLE border=2>" if $html;
	for $i (keys(%used)) {
	next if ($name{$i} eq "<control>");
	$sources = $used{$i};
	$sources =~ s/\]\[/, /g;
	$sources =~ s/^\[//g;
	$sources =~ s/\]$//g;
	$sources =~ s/\{(..)\}//g;
	$contribs{$sources} += 1;
	}
	for $j (keys(%contribs)) {
	print "<TR><TD>$contribs{$j}<TD>$j\n" if $html;
	}
	print "</TABLE>\n" if $html;
	} elsif (/^compact$/) {
	# print compact table in P10 MES format
	print "<P>Compact representation of this character set:\n<TABLE border=2>" if $html;
	print "<TR><TD><B>Rows</B><TD><B>Positions (Cells)</B>" if $html;
	print "\n# Plane 00\n# Rows\tPositions (Cells)\n" unless $html;
	$current_row = '';
	$start_col = '';
	$last_col = '';
	for $i (sort({$a <=> $b} keys(%used))) {
	next if ($name{$i} eq "<control>");
	$row = sprintf("%02X", $i >> 8);
	$col = sprintf("%02X", $i & 0xff);
	if ($row ne $current_row) {
	if (($last_col ne '') and ($last_col ne $start_col)) {
	print "-$last_col";
	print "</SAMP>" if $html;
	}
	print "<TR><TD><SAMP>$row</SAMP><TD><SAMP>" if $html;
	print "\n $row\t" unless $html;
	$len = 0;
	$current_row = $row;
	$start_col = '';
	}
	if ($start_col eq '') {
	print "$col";
	$len += 2;
	$start_col = $col;
	$last_col = $col;
	} elsif (hex($col) == hex($last_col) + 1) {
	$last_col = $col;
	} else {
	if ($last_col ne $start_col) {
	print "-$last_col";
	$len += 3;
	}
	if ($len > 60 && !$html) {
	print "\n $row\t";
	$len = 0;
	};
	print " " if $len;
	print "$col";
	$len += 2 + !! $len;
	$start_col = $col;
	$last_col = $col;
	}
	}
	if (($last_col ne '') and ($last_col ne $start_col)) {
	print "-$last_col";
	print "</SAMP>" if $html;
	}
	print "\n" if ($current_row ne '');
	print "</TABLE>\n" if $html;
	print "\n";
	} elsif (/^c$/) {
	# print table as C interval array
	print "{";
	$last_i = '';
	$columns = 1;
	$col = $columns;
	for $i (sort({$a <=> $b} keys(%used))) {
	next if ($name{$i} eq "<control>");
	if ($last_i eq '') {
	if (++$col > $columns) { $col = 1; print "\n "; }
	printf(" { 0x%x, ", $i);
	$last_i = $i;
	} elsif ($i == $last_i + 1) {
	$last_i = $i;
	} else {
	printf("0x%x },", $last_i);
	if (++$col > $columns) { $col = 1; print "\n "; }
	printf(" { 0x%x, ", $i);
	$last_i = $i;
	}
	}
	if ($last_i ne '') {
	printf("0x%x }", $last_i);
	}
	print "\n};\n";
	} elsif (/^utf8-list$/) {
	$col = 0;
	$block = 0;
	$last = -1;
	for $i (sort({$a <=> $b} keys(%used))) {
	next if ($name{$i} eq "<control>");
	while ($blockend[$block] < $i && $block < $blocks - 1) {
	$block++;
	}
	if ($last <= $blockend[$block-1] &&
	$i < $blockstart[$block]) {
	print "\n" if ($col);
	printf "\nFree block (U+%04X-U+%04X):\n\n",
	$blockend[$block-1] + 1, $blockstart[$block] - 1;
	$col = 0;
	}
	if ($last < $blockstart[$block] && $i >= $blockstart[$block]) {
	print "\n" if ($col);
	printf "\n$blockname[$block] (U+%04X-U+%04X):\n\n",
	$blockstart[$block], $blockend[$block];
	$col = 0;
	}
	if ($category{$i} eq 'Mn') {
	# prefix non-spacing character with U+25CC DOTTED CIRCLE
	print "\x{25CC}";
	} elsif ($category{$i} eq 'Me') {
	# prefix enclosing non-spacing character with space
	print " ";
	}
	print pack("U", $i);
	$col += 1 + iswide($i);
	if ($col >= 64) {
	print "\n";
	$col = 0;
	}
	$last = $i;
	}
	print "\n" if ($col);
	} elsif (/^collections$/) {
	$block = 0;
	$last = -1;
	for $i (sort({$a <=> $b} keys(%used))) {
	next if ($name{$i} eq "<control>");
	while ($blockend[$block] < $i && $block < $blocks - 1) {
	$block++;
	}
	if ($last < $blockstart[$block] && $i >= $blockstart[$block]) {
	print $blockname[$block],
	" " x (40 - length($blockname[$block]));
	printf "%04X-%04X\n",
	$blockstart[$block], $blockend[$block];
	}
	$last = $i;
	}
	} elsif (/^nr$/) {
	print "<P>" if $html;
	print "# " unless $html;
	print "Number of characters in above table: ";
	$count = 0;
	for $i (keys(%used)) {
	$count++ unless $name{$i} eq "<control>";
	}
	print $count;
	print "\n";
	} elsif (/^clean$/) {
	# remove characters from set that are not in $unicodedata
	for $i (keys(%used)) {
	delete $used{$i} unless is_unicode($i);
	}
	} elsif (/^unknown$/) {
	# remove characters from set that are in $unicodedata
	for $i (keys(%used)) {
	delete $used{$i} if is_unicode($i);
	}
	} else {
	die("Unknown command line command '$_'\n");
	};
	}