]> git.madduck.net Git - etc/xsession.git/blob - .urxvt/ext/font-size

madduck's git repository

Every one of the projects in this repository is available at the canonical URL git://git.madduck.net/madduck/pub/<projectpath> — see each project's metadata for the exact URL.

All patches and comments are welcome. Please squash your changes to logical commits before using git-format-patch and git-send-email to patches@git.madduck.net. If you'd read over the Git project's submission guidelines and adhered to them, I'd be especially grateful.

SSH access, as well as push access can be individually arranged.

If you use my repositories frequently, consider adding the following snippet to ~/.gitconfig and using the third clone URL listed for each project:

[url "git://git.madduck.net/madduck/"]
  insteadOf = madduck:

enable compose on prtsc
[etc/xsession.git] / .urxvt / ext / font-size
1 #!/usr/bin/env perl
2 #
3 # On-the-fly adjusting of the font size in urxvt
4 #
5 # Copyright (c) 2008 David O'Neill
6 #               2012 Noah K. Tilton <noahktilton@gmail.com>
7 #               2009-2012 Simon Lundström <simmel@soy.se>
8 #               2012-2016 Jan Larres <jan@majutsushi.net>
9 #
10 # Permission is hereby granted, free of charge, to any person obtaining a copy
11 # of this software and associated documentation files (the "Software"), to
12 # deal in the Software without restriction, including without limitation the
13 # rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
14 # sell copies of the Software, and to permit persons to whom the Software is
15 # furnished to do so, subject to the following conditions:
16 #
17 # The above copyright notice and this permission notice shall be included in
18 # all copies or substantial portions of the Software.
19 #
20 # THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
21 # IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
22 # FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
23 # AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
24 # LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
25 # FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
26 # IN THE SOFTWARE.
27 #
28 # URL: https://github.com/majutsushi/urxvt-font-size
29 #
30 # Based on:
31 # https://github.com/dave0/urxvt-font-size
32 # https://github.com/noah/urxvt-font
33 # https://github.com/simmel/urxvt-resize-font
34 #
35
36 #:META:X_RESOURCE:%.step:interger:font size increase/decrease step
37
38 =head1 NAME
39
40 font-size - interactive font size setter
41
42 =head1 USAGE
43
44 Put the font-size script into $HOME/.urxvt/ext/ and add it to the list
45 of enabled perl-extensions in ~/.Xresources:
46
47   URxvt.perl-ext-common: ...,font-size
48
49 Add some keybindings:
50
51   URxvt.keysym.C-Up:     font-size:increase
52   URxvt.keysym.C-Down:   font-size:decrease
53   URxvt.keysym.C-S-Up:   font-size:incglobal
54   URxvt.keysym.C-S-Down: font-size:decglobal
55   URxvt.keysym.C-equal:  font-size:reset
56   URxvt.keysym.C-slash:  font-size:show
57
58 Note that for urxvt versions older than 9.21 the resources have to look like this:
59
60   URxvt.keysym.C-Up:     perl:font-size:increase
61   URxvt.keysym.C-Down:   perl:font-size:decrease
62   URxvt.keysym.C-S-Up:   perl:font-size:incglobal
63   URxvt.keysym.C-S-Down: perl:font-size:decglobal
64   URxvt.keysym.C-equal   perl:font-size:reset
65   URxvt.keysym.C-slash   perl:font-size:show
66
67 Supported functions:
68
69 =over 2
70
71 =item * increase/decrease:
72
73       increase or decrease the font size of the current terminal.
74
75 =item * incglobal/decglobal:
76
77       same as above and also adjust the X server values so all newly
78       started terminals will use the same fontsize.
79
80 =item * incsave/decsave:
81
82       same as incglobal/decglobal and also modify the ~/.Xresources
83       file so the changed font sizes will persist over a restart of
84       the X server or a reboot.
85
86 =item * reset:
87
88       reset the font size to the value of the resource when starting
89       the terminal.
90
91 =item * show
92
93       show the current value of the 'font' resource in a popup.
94
95 =back
96
97 You can also change the step size that the script will use to increase
98 the font size:
99
100   URxvt.font-size.step: 4
101
102 The default step size is 1. This means that with this setting a
103 size change sequence would be for example 8->12->16->20 instead of
104 8->9->10->11->12 etc. Please note that many X11 fonts are only
105 available in specific sizes, though, and odd sizes are often not
106 available, resulting in an effective step size of 2 instead of 1
107 in that case.
108 =cut
109
110 use strict;
111 use warnings;
112
113 my %escapecodes = (
114     "font"           => 710,
115     "boldFont"       => 711,
116     "italicFont"     => 712,
117     "boldItalicFont" => 713
118 );
119
120 sub on_start
121 {
122     my ($self) = @_;
123
124     $self->{step} = $self->x_resource("%.step") || 1;
125
126     foreach my $type (qw(font boldFont italicFont boldItalicFont)) {
127         $self->{$type} = $self->x_resource($type) || "undef";
128     }
129 }
130
131 # Needed for backwards compatibility with < 9.21
132 sub on_user_command
133 {
134     my ($self, $cmd) = @_;
135
136     my $step = $self->{step};
137
138     if ($cmd eq "font-size:increase") {
139         fonts_change_size($self,  $step, 0);
140     } elsif ($cmd eq "font-size:decrease") {
141         fonts_change_size($self, -$step, 0);
142     } elsif ($cmd eq "font-size:incglobal") {
143         fonts_change_size($self,  $step, 1);
144     } elsif ($cmd eq "font-size:decglobal") {
145         fonts_change_size($self, -$step, 1);
146     } elsif ($cmd eq "font-size:incsave") {
147         fonts_change_size($self,  $step, 2);
148     } elsif ($cmd eq "font-size:decsave") {
149         fonts_change_size($self, -$step, 2);
150     } elsif ($cmd eq "font-size:reset") {
151         fonts_reset($self);
152     } elsif ($cmd eq "font-size:show") {
153         fonts_show($self);
154     }
155 }
156
157 sub on_action
158 {
159     my ($self, $action) = @_;
160
161     my $step = $self->{step};
162
163     if ($action eq "increase") {
164         fonts_change_size($self,  $step, 0);
165     } elsif ($action eq "decrease") {
166         fonts_change_size($self, -$step, 0);
167     } elsif ($action eq "incglobal") {
168         fonts_change_size($self,  $step, 1);
169     } elsif ($action eq "decglobal") {
170         fonts_change_size($self, -$step, 1);
171     } elsif ($action eq "incsave") {
172         fonts_change_size($self,  $step, 2);
173     } elsif ($action eq "decsave") {
174         fonts_change_size($self, -$step, 2);
175     } elsif ($action eq "reset") {
176         fonts_reset($self);
177     } elsif ($action eq "show") {
178         fonts_show($self);
179     }
180 }
181
182 sub fonts_change_size
183 {
184     my ($term, $delta, $save) = @_;
185
186     my @newfonts = ();
187
188     my $curres = $term->resource('font');
189     if (!$curres) {
190         $term->scr_add_lines("\r\nWarning: No font configured, trying a default.\r\nPlease set a font with the 'URxvt.font' resource.");
191         $curres = "fixed";
192     }
193     my @curfonts = split(/\s*,\s*/, $curres);
194
195     my $basefont = shift(@curfonts);
196     my ($newbasefont, $newbasedelta, $newbasesize) = handle_font($term, $basefont, $delta, 0, 0);
197     push @newfonts, $newbasefont;
198
199     # Only adjust other fonts if base font changed
200     if ($newbasefont ne $basefont) {
201         foreach my $font (@curfonts) {
202             my ($newfont, $newdelta, $newsize) = handle_font($term, $font, $delta, $newbasedelta, $newbasesize);
203             push @newfonts, $newfont;
204         }
205         my $newres = join(",", @newfonts);
206         font_apply_new($term, $newres, "font", $save);
207
208         handle_type($term, "boldFont",       $delta, $newbasedelta, $newbasesize, $save);
209         handle_type($term, "italicFont",     $delta, $newbasedelta, $newbasesize, $save);
210         handle_type($term, "boldItalicFont", $delta, $newbasedelta, $newbasesize, $save);
211     }
212
213     if ($save > 1) {
214         # write the new values back to the file
215         my $xresources = readlink $ENV{"HOME"} . "/.Xresources";
216         system("xrdb -edit " . $xresources);
217     }
218 }
219
220 sub fonts_reset
221 {
222     my ($term) = @_;
223
224     foreach my $type (qw(font boldFont italicFont boldItalicFont)) {
225         my $initial = $term->{$type};
226         if ($initial ne "undef") {
227             font_apply_new($term, $initial, $type, 0);
228         }
229     }
230 }
231
232 sub fonts_show
233 {
234     my ($term) = @_;
235
236     my $out = $term->resource('font');
237     $out =~ s/\s*,\s*/\n/g;
238
239     $term->{'font-size'}{'overlay'} = {
240         overlay => $term->overlay_simple(0, -1, $out),
241         timer => urxvt::timer->new->start(urxvt::NOW + 5)->cb(
242             sub {
243                 delete $term->{'font-size'}{'overlay'};
244             }
245         ),
246     };
247 }
248
249 sub handle_type
250 {
251     my ($term, $type, $delta, $basedelta, $basesize, $save) = @_;
252
253     my $curres = $term->resource($type);
254     if (!$curres) {
255         return;
256     }
257     my @curfonts = split(/\s*,\s*/, $curres);
258     my @newfonts = ();
259
260     foreach my $font (@curfonts) {
261         my ($newfont, $newdelta, $newsize) = handle_font($term, $font, $delta, $basedelta, $basesize);
262         push @newfonts, $newfont;
263     }
264
265     my $newres = join(",", @newfonts);
266     font_apply_new($term, $newres, $type, $save);
267 }
268
269 sub handle_font
270 {
271     my ($term, $font, $delta, $basedelta, $basesize) = @_;
272
273     my $newfont;
274     my $newdelta;
275     my $newsize;
276     my $prefix = 0;
277
278     if ($font =~ /^\s*x:/) {
279         $font =~ s/^\s*x://;
280         $prefix = 1;
281     }
282     if ($font =~ /^\s*(\[.*\])?xft:/) {
283         ($newfont, $newdelta, $newsize) = font_change_size_xft($term, $font, $delta, $basedelta, $basesize);
284     } elsif ($font =~ /^\s*-/) {
285         ($newfont, $newdelta, $newsize) = font_change_size_xlfd($term, $font, $delta, $basedelta, $basesize);
286     } else {
287         # check whether the font is a valid alias and if yes resolve it to the
288         # actual font
289         my $lsfinfo = `xlsfonts -l $font 2>/dev/null`;
290
291         if ($lsfinfo eq "") {
292             # not a valid alias, ring the bell if it is the base font and just
293             # return the current font
294             if ($basesize == 0) {
295                 $term->scr_bell;
296             }
297             return ($font, $basedelta, $basesize);
298         }
299
300         my $fontinfo = (split(/\n/, $lsfinfo))[-1];
301         my ($fontfull) = ($fontinfo =~ /\s+([-a-z0-9]+$)/);
302         ($newfont, $newdelta, $newsize) = font_change_size_xlfd($term, $fontfull, $delta, $basedelta, $basesize);
303     }
304
305     # $term->scr_add_lines("\r\nNew font is $newfont\n");
306     if ($prefix) {
307         $newfont = "x:$newfont";
308     }
309     return ($newfont, $newdelta, $newsize);
310 }
311
312 sub font_change_size_xft
313 {
314     my ($term, $fontstring, $delta, $basedelta, $basesize) = @_;
315
316     my @pieces   = split(/:/, $fontstring);
317     my @resized  = ();
318     my $size     = 0;
319     my $new_size = 0;
320
321     foreach my $piece (@pieces) {
322         if ($piece =~ /^(?:(?:pixel)?size=|[^=-]+-)(\d+(\.\d*)?)$/) {
323             $size = $1;
324
325             if ($basedelta != 0) {
326                 $new_size = $size + $basedelta;
327             } else {
328                 $new_size = $size + $delta;
329             }
330
331             $piece =~ s/(=|-)$size/$1$new_size/;
332         }
333         push @resized, $piece;
334     }
335
336     my $resized_str = join(":", @resized);
337
338     # don't make fonts too small
339     if ($new_size >= 6) {
340         return ($resized_str, $new_size - $size, $new_size);
341     } else {
342         if ($basesize == 0) {
343             $term->scr_bell;
344         }
345         return ($fontstring, 0, $size);
346     }
347 }
348
349 sub font_change_size_xlfd
350 {
351     my ($term, $fontstring, $delta, $basedelta, $basesize) = @_;
352
353     #-xos4-terminus-medium-r-normal-*-12-*-*-*-*-*-*-1
354
355     my @fields = qw(foundry family weight slant setwidth style pixelSize pointSize Xresolution Yresolution spacing averageWidth registry encoding);
356
357     my %font;
358     $fontstring =~ s/^-//;  # Strip leading - before split
359     @font{@fields} = split(/-/, $fontstring);
360
361     if ($font{pixelSize} eq '*') {
362         $term->scr_add_lines("\r\nWarning: Font size undefined, assuming 12.\r\nPlease set the 'URxvt.font' resource to a font with a concrete size.");
363         $font{pixelSize} = '12'
364     }
365     if ($font{registry} eq '*') {
366         $font{registry} ='iso8859';
367     }
368
369     # Blank out the size for the pattern
370     my %pattern = %font;
371     $pattern{foundry} = '*';
372     $pattern{setwidth} = '*';
373     $pattern{pixelSize} = '*';
374     $pattern{pointSize} = '*';
375     # if ($basesize != 0) {
376     #     $pattern{Xresolution} = '*';
377     #     $pattern{Yresolution} = '*';
378     # }
379     $pattern{averageWidth} = '*';
380     # make sure there are no empty fields
381     foreach my $field (@fields) {
382         $pattern{$field} = '*' unless defined($pattern{$field});
383     }
384     my $new_fontstring = '-' . join('-', @pattern{@fields});
385
386     my @candidates;
387     # $term->scr_add_lines("\r\nPattern is $new_fontstring\n");
388     open(FOO, "xlsfonts -fn '$new_fontstring' | sort -u |") or die $!;
389     while (<FOO>) {
390         chomp;
391         s/^-//;  # Strip leading '-' before split
392         my @fontdata = split(/-/, $_);
393
394         push @candidates, [$fontdata[6], "-$_"];
395         # $term->scr_add_lines("\r\npossibly $fontdata[6] $_\n");
396     }
397     close(FOO);
398
399     if (!@candidates) {
400         die "No possible fonts!";
401     }
402
403     if ($basesize != 0) {
404         # sort by font size, descending
405         @candidates = sort {$b->[0] <=> $a->[0]} @candidates;
406
407         # font is not the base font, so find the largest font that is at most
408         # as large as the base font. If the largest possible font is smaller
409         # than the base font bail and hope that a 0-size font can be found at
410         # the end of the function
411         if ($candidates[0]->[0] > $basesize) {
412             foreach my $candidate (@candidates) {
413                 if ($candidate->[0] <= $basesize) {
414                     return ($candidate->[1], $candidate->[0] - $font{pixelSize}, $candidate->[0]);
415                 }
416             }
417         }
418     } elsif ($delta > 0) {
419         # sort by font size, ascending
420         @candidates = sort {$a->[0] <=> $b->[0]} @candidates;
421
422         foreach my $candidate (@candidates) {
423             if ($candidate->[0] >= $font{pixelSize} + $delta) {
424                 return ($candidate->[1], $candidate->[0] - $font{pixelSize}, $candidate->[0]);
425             }
426         }
427     } elsif ($delta < 0) {
428         # sort by font size, descending
429         @candidates = sort {$b->[0] <=> $a->[0]} @candidates;
430
431         foreach my $candidate (@candidates) {
432             if ($candidate->[0] <= $font{pixelSize} + $delta && $candidate->[0] != 0) {
433                 return ($candidate->[1], $candidate->[0] - $font{pixelSize}, $candidate->[0]);
434             }
435         }
436     }
437
438     # no fitting font available, check whether a 0-size font can be used to
439     # fit the size of the base font
440     @candidates = sort {$a->[0] <=> $b->[0]} @candidates;
441     if ($basesize != 0 && $candidates[0]->[0] == 0) {
442         return ($candidates[0]->[1], $basedelta, $basesize);
443     } else {
444         # if there is absolutely no smaller/larger font that can be used
445         # return the current one, and beep if this is the base font
446         if ($basesize == 0) {
447             $term->scr_bell;
448         }
449         return ("-$fontstring", 0, $font{pixelSize});
450     }
451 }
452
453 sub font_apply_new
454 {
455     my ($term, $newfont, $type, $save) = @_;
456
457     # $term->scr_add_lines("\r\nnew font is $newfont\n");
458
459     $term->cmd_parse("\033]" . $escapecodes{$type} . ";" . $newfont . "\033\\");
460
461     # load the xrdb db
462     # system("xrdb -load " . X_RESOURCES);
463
464     if ($save > 0) {
465         # merge the new values
466         open(XRDB_MERGE, "| xrdb -merge") || die "can't fork: $!";
467         local $SIG{PIPE} = sub { die "xrdb pipe broken" };
468         print XRDB_MERGE "URxvt." . $type . ": " . $newfont;
469         close(XRDB_MERGE) || die "bad xrdb: $! $?";
470     }
471 }