digraphs: css update, cell groups
[sheet.git] / rfc1345convert
1 #!/usr/bin/env perl
2
3 use strict;
4 use warnings;
5
6 use Data::Dumper;
7
8 our $VERSION = '1.00';
9
10 if (0) {
11         #TODO: automatic download if not specified on stdin
12         require LWP::Simple;
13         LWP::Simple::get('http://www.ietf.org/rfc/rfc1345.txt');
14 }
15
16 # skip everything until a character indented by 1 space (table start)
17 do {$_ = <>} until /^\s\S/;
18
19 my @t = $_;  # add first line (already read, assume it's ok)
20
21 # read the rest of the character table
22 while ($_ = <>) {
23         # check for table end (chapter 4)
24         last if /^4/;
25
26         # parse table lines (ignore (unindented) page break)
27         next unless s/^ //;
28         chomp;
29
30         # add the line to @t
31         if (s/^ {15}/ /) {
32                 # continuation line (add to last entry)
33                 $t[-1] .= $_;
34         }
35         else {
36                 # add a new entry
37                 push @t, $_;
38         }
39 }
40
41 # create a hash of desired input
42 my %di;
43 for (@t) {
44         my ($mnem, $char, $name) = split / +/, $_, 3;
45         next if length $mnem != 2;
46         $di{$mnem} = hex $char;
47 }
48
49 # personal addendums
50 my @extra;
51 if (-r 'shiar.inc.txt') {
52         open my $include, '<:utf8', 'shiar.inc.txt';
53         for (readline $include) {
54                 m{^([!"%'-Z_a-z]{2}) (.)} or next;
55                 warn("$1 already defined"), next if defined $di{$1};
56                 $di{$1} = ord $2;
57                 push @extra, $1;
58         }
59 }
60 warn $@ if $@;
61
62 # optionally get unicode character information
63 my %info = eval {
64         require Unicode::UCD;
65         map {
66                 $_ => Unicode::UCD::charinfo($di{$_})
67                         || { block => '?', category => 'Xn', name => '', script => '' }
68         } keys %di;
69 };
70
71 # add custom categories for certain blocks
72 for (values %info) {
73         $_->{category} .= ' Xa' if $_->{block} eq 'Basic Latin';
74         $_->{category} .= ' Xl' if $_->{block} eq 'Latin-1 Supplement';
75 }
76
77 # mark unofficial extras as such
78 $info{$_}->{category} .= ' Xz' for @extra;
79
80 # output perl code of hash
81 # (assume no backslashes or curlies, so we can just q{} w/o escaping)
82 print "{\n";
83 printf "q{%s}=>[%s],\n", $_, join(',',
84         $di{$_},       # glyph code point
85         $info{$_}  # optional additional arguments
86                 ? map {"'$_'"} @{ $info{$_} }{qw/name category script/}
87                 : ()
88 ) for sort keys %di;
89 print "}\n";
90