xref: /freebsd/contrib/less/mkutable (revision a15691bf119a9d4b1ec5a237d2f7eda79cbf01ce)
1*a15691bfSXin LI#! /usr/bin/perl
2*a15691bfSXin LIuse strict;
3*a15691bfSXin LI
4*a15691bfSXin LImy $USAGE = <<__EOF__;
5*a15691bfSXin LI   usage: mkutable [-n] [-f#] type... [--] [<] UnicodeData.txt
6*a15691bfSXin LI          -n = take non-matching types
7*a15691bfSXin LI	  -f = zero-based type field (default 2)
8*a15691bfSXin LI__EOF__
9*a15691bfSXin LI
10*a15691bfSXin LIuse vars qw( $opt_f $opt_n );
11*a15691bfSXin LIuse Getopt::Std;
12*a15691bfSXin LImy $type_field = 2;
13*a15691bfSXin LI
14*a15691bfSXin LIexit (main() ? 1 : 0);
15*a15691bfSXin LI
16*a15691bfSXin LIsub main {
17*a15691bfSXin LI    my $date = `date`;
18*a15691bfSXin LI    chomp $date;
19*a15691bfSXin LI    my $args = join ' ', @ARGV;
20*a15691bfSXin LI    my $header = "/* Generated by \"$0 $args\" on $date */\n";
21*a15691bfSXin LI
22*a15691bfSXin LI    die $USAGE if not getopts('f:n');
23*a15691bfSXin LI    $type_field = $opt_f if $opt_f;
24*a15691bfSXin LI    my %types;
25*a15691bfSXin LI    my $arg;
26*a15691bfSXin LI    while ($arg = shift @ARGV) {
27*a15691bfSXin LI        last if $arg eq '--';
28*a15691bfSXin LI        $types{$arg} = 1;
29*a15691bfSXin LI    }
30*a15691bfSXin LI    my %out = ( 'types' => \%types );
31*a15691bfSXin LI    my $last_code = 0;
32*a15691bfSXin LI
33*a15691bfSXin LI    print $header;
34*a15691bfSXin LI    while (<>) {
35*a15691bfSXin LI        chomp;
36*a15691bfSXin LI        s/#.*//;
37*a15691bfSXin LI        my @fields = split /;/;
38*a15691bfSXin LI        next if not @fields;
39*a15691bfSXin LI        my $code = hex $fields[0];
40*a15691bfSXin LI        my $type = $fields[$type_field];
41*a15691bfSXin LI        $type =~ s/\s//g;
42*a15691bfSXin LI        while (++$last_code < $code) {
43*a15691bfSXin LI            output(\%out, $last_code, '?');
44*a15691bfSXin LI        }
45*a15691bfSXin LI        output(\%out, $code, $type);
46*a15691bfSXin LI    }
47*a15691bfSXin LI    output(\%out, $last_code+1, '?');
48*a15691bfSXin LI}
49*a15691bfSXin LI
50*a15691bfSXin LIsub output {
51*a15691bfSXin LI    my ($out, $code, $type) = @_;
52*a15691bfSXin LI    my $match = ${${$out}{types}}{$type};
53*a15691bfSXin LI    my $type_change = (not $$out{start_type} or $type ne $$out{start_type});
54*a15691bfSXin LI    $match = not $match if $opt_n;
55*a15691bfSXin LI    if ($match and (not $$out{in_run} or $type_change)) {
56*a15691bfSXin LI        end_run($out, $code-1);
57*a15691bfSXin LI        start_run($out, $code, $type);
58*a15691bfSXin LI    } elsif (not $match and $$out{in_run}) {
59*a15691bfSXin LI        end_run($out, $code-1);
60*a15691bfSXin LI    }
61*a15691bfSXin LI}
62*a15691bfSXin LI
63*a15691bfSXin LIsub start_run {
64*a15691bfSXin LI    my ($out, $code, $type) = @_;
65*a15691bfSXin LI    $$out{start_code} = $code;
66*a15691bfSXin LI    $$out{start_type} = $type;
67*a15691bfSXin LI    $$out{in_run} = 1;
68*a15691bfSXin LI}
69*a15691bfSXin LI
70*a15691bfSXin LIsub end_run {
71*a15691bfSXin LI    my ($out, $code) = @_;
72*a15691bfSXin LI    return if not $$out{in_run};
73*a15691bfSXin LI    printf "\t{ 0x%04x, 0x%04x }, /* %s */\n", $$out{start_code}, $code, $$out{start_type};
74*a15691bfSXin LI    $$out{in_run} = 0;
75*a15691bfSXin LI}
76