.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 }