Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100755 152 lines (113 sloc) 3.262 kb
fc8e530 @rjbs add more stuff
authored
1 #!/usr/bin/perl
2 use strict;
3 use warnings;
4
5 use Getopt::Long::Descriptive;
6 use Graphics::ColorUtils qw(name2rgb);
7 use RTF::Writer;
8 use Text::VimColor;
9
10 my ($opt, $usage) = describe_options(
11 '%c %o <filename>',
12 # no options yet, obviously
13 [ 'help|h', 'display this message' ],
14 [ 'filetype|ft|f=s', 'filetype; Vim guesses by default' ],
15 [ 'font-face|F=s', 'font face to use; defaults to Courier New',
16 { default => 'Courier New' } ],
17 [ 'font-size|Z=i', 'font size to use, in points; defaults to 14',
18 { default => 14 } ],
19 );
20
21 $usage->die if $opt->{help} or @ARGV != 1;
22
23 my $syn = Text::VimColor->new(
24 file => $ARGV[0],
25 ($opt->{filetype} ? (filetype => $opt->{filetype}) : ()),
26 );
27
28 my $rtf = RTF::Writer->new_to_string(\my $str);
29
30 # RTF::Writer "helpfully" converts - to "non-breaking hyphen," which Apple's
31 # RTF does not seem to support. This overrides that. -- rjbs, 2007-09-05
32 local $RTF::Writer::Escape[ ord('-') ] = '-';
33
34 # It's easier to human-read the RTF if the linebreaks are only in the same
35 # place. -- rjbs, 2007-09-05
36 local $RTF::Writer::AUTO_NL = 0;
37
f1f24c6 @rjbs updates made while advent calendaring
authored
38 $rtf->prolog(
39 fonts => [ $opt->{font_face} ],
40 colors => [ all_colors() ],
41 );
42
43 my $hp_size = $opt->{font_size} * 2; # RTF uses half-points for font size
44
45 # Set size, font, and background color.
46 $rtf->print(
47 \"\\fs$hp_size\\f0",
48 color_controls_for('Normal')
49 );
50
51 my $tokens = $syn->marked;
52
53 while (my $pair = shift @$tokens) {
54 my ($type, $text) = @$pair;
55
56 $rtf->print(
57 color_controls_for($type), " ",
58 $text,
59 );
60 }
61
62 $rtf->close;
63
64 print $str;
65
66 # SUBROUTINES
67
fc8e530 @rjbs add more stuff
authored
68 sub color_to_rgb {
69 my ($str) = @_;
70
71 if ($str =~ /#([0-9a-f]{6})/i) {
72 return [ map { hex } unpack "(a2)*", $1 ]
73 } else {
74 my @rgb = name2rgb($str);
75 return unless @rgb;
76 return \@rgb;
77 }
78 }
79
80 sub groups_from_file {
81 my ($filename) = @_;
82
83 open my $fh, '<', $filename or die "couldn't open $filename to read: $!";
84
85 my %color;
86
87 LINE: while (my $line = <$fh>) {
88 chomp $line;
89 $line =~ s/\A\s+//;
90 next LINE unless $line =~ /\Ahi(?:ghlight)?/;
91
92 my ($group) = $line =~ /\Ahi(?:ghlight)?\s+(\w+)/;
93
94 my %attr;
95
96 if (my ($fg) = $line =~ /guifg=(\S+)/) {
f1f24c6 @rjbs updates made while advent calendaring
authored
97 $attr{fg} = color_to_rgb($1);
fc8e530 @rjbs add more stuff
authored
98 }
99
100 if (my ($bg) = $line =~ /guibg=(\S+)/) {
101 $attr{bg} = color_to_rgb($bg);
102 }
103
104 $color{ $group } = \%attr;
105 }
106
107 return %color;
108 }
109
110 my %color_pos;
111 my @colors;
f1f24c6 @rjbs updates made while advent calendaring
authored
112 BEGIN {
113 my %color = (
114 groups_from_file("$ENV{HOME}/.vim/colors/manxome.vim"),
115 );
fc8e530 @rjbs add more stuff
authored
116
f1f24c6 @rjbs updates made while advent calendaring
authored
117 $color{Normal} ||= {};
118 $color{Normal}{bg} ||= [ 0, 0, 0 ];
119 $color{Normal}{fg} ||= [ 127, 127, 127 ];
fc8e530 @rjbs add more stuff
authored
120
f1f24c6 @rjbs updates made while advent calendaring
authored
121 for my $group (keys %color) {
122 for my $which (qw(fg bg)) {
123 next unless my $rgb = $color{ $group }{ $which };
fc8e530 @rjbs add more stuff
authored
124
f1f24c6 @rjbs updates made while advent calendaring
authored
125 my $pos = $color_pos{ join('-', @$rgb) };
fc8e530 @rjbs add more stuff
authored
126
f1f24c6 @rjbs updates made while advent calendaring
authored
127 unless (defined $pos) {
128 push @colors, $rgb;
129 $pos = $color_pos{ join('-', @$rgb) } = $#colors;
130 }
131
132 $color_pos{ "$group:$which" } = $pos;
133 }
fc8e530 @rjbs add more stuff
authored
134 }
135 }
136
137 sub color_controls_for {
138 my ($group) = @_;
139
140 my $ctrl = '';
141 for (qw(f b)) {
142 $ctrl .= "\\c$_"
143 . (defined $color_pos{"$group:${_}g"}
144 ? $color_pos{"$group:${_}g"}
145 : $color_pos{"Normal:${_}g"});
146 }
147
148 return \$ctrl;
149 }
150
f1f24c6 @rjbs updates made while advent calendaring
authored
151 sub all_colors { @colors }
Something went wrong with that request. Please try again.