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