+#!/usr/bin/env perl
+#
+# On-the-fly adjusting of the font size in urxvt
+#
+# Copyright (c) 2008 David O'Neill
+# 2012 Noah K. Tilton <noahktilton@gmail.com>
+# 2009-2012 Simon Lundström <simmel@soy.se>
+# 2012-2016 Jan Larres <jan@majutsushi.net>
+#
+# Permission is hereby granted, free of charge, to any person obtaining a copy
+# of this software and associated documentation files (the "Software"), to
+# deal in the Software without restriction, including without limitation the
+# rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
+# sell copies of the Software, and to permit persons to whom the Software is
+# furnished to do so, subject to the following conditions:
+#
+# The above copyright notice and this permission notice shall be included in
+# all copies or substantial portions of the Software.
+#
+# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
+# IN THE SOFTWARE.
+#
+# URL: https://github.com/majutsushi/urxvt-font-size
+#
+# Based on:
+# https://github.com/dave0/urxvt-font-size
+# https://github.com/noah/urxvt-font
+# https://github.com/simmel/urxvt-resize-font
+#
+
+#:META:X_RESOURCE:%.step:interger:font size increase/decrease step
+
+=head1 NAME
+
+font-size - interactive font size setter
+
+=head1 USAGE
+
+Put the font-size script into $HOME/.urxvt/ext/ and add it to the list
+of enabled perl-extensions in ~/.Xresources:
+
+ URxvt.perl-ext-common: ...,font-size
+
+Add some keybindings:
+
+ URxvt.keysym.C-Up: font-size:increase
+ URxvt.keysym.C-Down: font-size:decrease
+ URxvt.keysym.C-S-Up: font-size:incglobal
+ URxvt.keysym.C-S-Down: font-size:decglobal
+ URxvt.keysym.C-equal: font-size:reset
+ URxvt.keysym.C-slash: font-size:show
+
+Note that for urxvt versions older than 9.21 the resources have to look like this:
+
+ URxvt.keysym.C-Up: perl:font-size:increase
+ URxvt.keysym.C-Down: perl:font-size:decrease
+ URxvt.keysym.C-S-Up: perl:font-size:incglobal
+ URxvt.keysym.C-S-Down: perl:font-size:decglobal
+ URxvt.keysym.C-equal perl:font-size:reset
+ URxvt.keysym.C-slash perl:font-size:show
+
+Supported functions:
+
+=over 2
+
+=item * increase/decrease:
+
+ increase or decrease the font size of the current terminal.
+
+=item * incglobal/decglobal:
+
+ same as above and also adjust the X server values so all newly
+ started terminals will use the same fontsize.
+
+=item * incsave/decsave:
+
+ same as incglobal/decglobal and also modify the ~/.Xresources
+ file so the changed font sizes will persist over a restart of
+ the X server or a reboot.
+
+=item * reset:
+
+ reset the font size to the value of the resource when starting
+ the terminal.
+
+=item * show
+
+ show the current value of the 'font' resource in a popup.
+
+=back
+
+You can also change the step size that the script will use to increase
+the font size:
+
+ URxvt.font-size.step: 4
+
+The default step size is 1. This means that with this setting a
+size change sequence would be for example 8->12->16->20 instead of
+8->9->10->11->12 etc. Please note that many X11 fonts are only
+available in specific sizes, though, and odd sizes are often not
+available, resulting in an effective step size of 2 instead of 1
+in that case.
+=cut
+
+use strict;
+use warnings;
+
+my %escapecodes = (
+ "font" => 710,
+ "boldFont" => 711,
+ "italicFont" => 712,
+ "boldItalicFont" => 713
+);
+
+sub on_start
+{
+ my ($self) = @_;
+
+ $self->{step} = $self->x_resource("%.step") || 1;
+
+ foreach my $type (qw(font boldFont italicFont boldItalicFont)) {
+ $self->{$type} = $self->x_resource($type) || "undef";
+ }
+}
+
+# Needed for backwards compatibility with < 9.21
+sub on_user_command
+{
+ my ($self, $cmd) = @_;
+
+ my $step = $self->{step};
+
+ if ($cmd eq "font-size:increase") {
+ fonts_change_size($self, $step, 0);
+ } elsif ($cmd eq "font-size:decrease") {
+ fonts_change_size($self, -$step, 0);
+ } elsif ($cmd eq "font-size:incglobal") {
+ fonts_change_size($self, $step, 1);
+ } elsif ($cmd eq "font-size:decglobal") {
+ fonts_change_size($self, -$step, 1);
+ } elsif ($cmd eq "font-size:incsave") {
+ fonts_change_size($self, $step, 2);
+ } elsif ($cmd eq "font-size:decsave") {
+ fonts_change_size($self, -$step, 2);
+ } elsif ($cmd eq "font-size:reset") {
+ fonts_reset($self);
+ } elsif ($cmd eq "font-size:show") {
+ fonts_show($self);
+ }
+}
+
+sub on_action
+{
+ my ($self, $action) = @_;
+
+ my $step = $self->{step};
+
+ if ($action eq "increase") {
+ fonts_change_size($self, $step, 0);
+ } elsif ($action eq "decrease") {
+ fonts_change_size($self, -$step, 0);
+ } elsif ($action eq "incglobal") {
+ fonts_change_size($self, $step, 1);
+ } elsif ($action eq "decglobal") {
+ fonts_change_size($self, -$step, 1);
+ } elsif ($action eq "incsave") {
+ fonts_change_size($self, $step, 2);
+ } elsif ($action eq "decsave") {
+ fonts_change_size($self, -$step, 2);
+ } elsif ($action eq "reset") {
+ fonts_reset($self);
+ } elsif ($action eq "show") {
+ fonts_show($self);
+ }
+}
+
+sub fonts_change_size
+{
+ my ($term, $delta, $save) = @_;
+
+ my @newfonts = ();
+
+ my $curres = $term->resource('font');
+ if (!$curres) {
+ $term->scr_add_lines("\r\nWarning: No font configured, trying a default.\r\nPlease set a font with the 'URxvt.font' resource.");
+ $curres = "fixed";
+ }
+ my @curfonts = split(/\s*,\s*/, $curres);
+
+ my $basefont = shift(@curfonts);
+ my ($newbasefont, $newbasedelta, $newbasesize) = handle_font($term, $basefont, $delta, 0, 0);
+ push @newfonts, $newbasefont;
+
+ # Only adjust other fonts if base font changed
+ if ($newbasefont ne $basefont) {
+ foreach my $font (@curfonts) {
+ my ($newfont, $newdelta, $newsize) = handle_font($term, $font, $delta, $newbasedelta, $newbasesize);
+ push @newfonts, $newfont;
+ }
+ my $newres = join(",", @newfonts);
+ font_apply_new($term, $newres, "font", $save);
+
+ handle_type($term, "boldFont", $delta, $newbasedelta, $newbasesize, $save);
+ handle_type($term, "italicFont", $delta, $newbasedelta, $newbasesize, $save);
+ handle_type($term, "boldItalicFont", $delta, $newbasedelta, $newbasesize, $save);
+ }
+
+ if ($save > 1) {
+ # write the new values back to the file
+ my $xresources = readlink $ENV{"HOME"} . "/.Xresources";
+ system("xrdb -edit " . $xresources);
+ }
+}
+
+sub fonts_reset
+{
+ my ($term) = @_;
+
+ foreach my $type (qw(font boldFont italicFont boldItalicFont)) {
+ my $initial = $term->{$type};
+ if ($initial ne "undef") {
+ font_apply_new($term, $initial, $type, 0);
+ }
+ }
+}
+
+sub fonts_show
+{
+ my ($term) = @_;
+
+ my $out = $term->resource('font');
+ $out =~ s/\s*,\s*/\n/g;
+
+ $term->{'font-size'}{'overlay'} = {
+ overlay => $term->overlay_simple(0, -1, $out),
+ timer => urxvt::timer->new->start(urxvt::NOW + 5)->cb(
+ sub {
+ delete $term->{'font-size'}{'overlay'};
+ }
+ ),
+ };
+}
+
+sub handle_type
+{
+ my ($term, $type, $delta, $basedelta, $basesize, $save) = @_;
+
+ my $curres = $term->resource($type);
+ if (!$curres) {
+ return;
+ }
+ my @curfonts = split(/\s*,\s*/, $curres);
+ my @newfonts = ();
+
+ foreach my $font (@curfonts) {
+ my ($newfont, $newdelta, $newsize) = handle_font($term, $font, $delta, $basedelta, $basesize);
+ push @newfonts, $newfont;
+ }
+
+ my $newres = join(",", @newfonts);
+ font_apply_new($term, $newres, $type, $save);
+}
+
+sub handle_font
+{
+ my ($term, $font, $delta, $basedelta, $basesize) = @_;
+
+ my $newfont;
+ my $newdelta;
+ my $newsize;
+ my $prefix = 0;
+
+ if ($font =~ /^\s*x:/) {
+ $font =~ s/^\s*x://;
+ $prefix = 1;
+ }
+ if ($font =~ /^\s*(\[.*\])?xft:/) {
+ ($newfont, $newdelta, $newsize) = font_change_size_xft($term, $font, $delta, $basedelta, $basesize);
+ } elsif ($font =~ /^\s*-/) {
+ ($newfont, $newdelta, $newsize) = font_change_size_xlfd($term, $font, $delta, $basedelta, $basesize);
+ } else {
+ # check whether the font is a valid alias and if yes resolve it to the
+ # actual font
+ my $lsfinfo = `xlsfonts -l $font 2>/dev/null`;
+
+ if ($lsfinfo eq "") {
+ # not a valid alias, ring the bell if it is the base font and just
+ # return the current font
+ if ($basesize == 0) {
+ $term->scr_bell;
+ }
+ return ($font, $basedelta, $basesize);
+ }
+
+ my $fontinfo = (split(/\n/, $lsfinfo))[-1];
+ my ($fontfull) = ($fontinfo =~ /\s+([-a-z0-9]+$)/);
+ ($newfont, $newdelta, $newsize) = font_change_size_xlfd($term, $fontfull, $delta, $basedelta, $basesize);
+ }
+
+ # $term->scr_add_lines("\r\nNew font is $newfont\n");
+ if ($prefix) {
+ $newfont = "x:$newfont";
+ }
+ return ($newfont, $newdelta, $newsize);
+}
+
+sub font_change_size_xft
+{
+ my ($term, $fontstring, $delta, $basedelta, $basesize) = @_;
+
+ my @pieces = split(/:/, $fontstring);
+ my @resized = ();
+ my $size = 0;
+ my $new_size = 0;
+
+ foreach my $piece (@pieces) {
+ if ($piece =~ /^(?:(?:pixel)?size=|[^=-]+-)(\d+(\.\d*)?)$/) {
+ $size = $1;
+
+ if ($basedelta != 0) {
+ $new_size = $size + $basedelta;
+ } else {
+ $new_size = $size + $delta;
+ }
+
+ $piece =~ s/(=|-)$size/$1$new_size/;
+ }
+ push @resized, $piece;
+ }
+
+ my $resized_str = join(":", @resized);
+
+ # don't make fonts too small
+ if ($new_size >= 6) {
+ return ($resized_str, $new_size - $size, $new_size);
+ } else {
+ if ($basesize == 0) {
+ $term->scr_bell;
+ }
+ return ($fontstring, 0, $size);
+ }
+}
+
+sub font_change_size_xlfd
+{
+ my ($term, $fontstring, $delta, $basedelta, $basesize) = @_;
+
+ #-xos4-terminus-medium-r-normal-*-12-*-*-*-*-*-*-1
+
+ my @fields = qw(foundry family weight slant setwidth style pixelSize pointSize Xresolution Yresolution spacing averageWidth registry encoding);
+
+ my %font;
+ $fontstring =~ s/^-//; # Strip leading - before split
+ @font{@fields} = split(/-/, $fontstring);
+
+ if ($font{pixelSize} eq '*') {
+ $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.");
+ $font{pixelSize} = '12'
+ }
+ if ($font{registry} eq '*') {
+ $font{registry} ='iso8859';
+ }
+
+ # Blank out the size for the pattern
+ my %pattern = %font;
+ $pattern{foundry} = '*';
+ $pattern{setwidth} = '*';
+ $pattern{pixelSize} = '*';
+ $pattern{pointSize} = '*';
+ # if ($basesize != 0) {
+ # $pattern{Xresolution} = '*';
+ # $pattern{Yresolution} = '*';
+ # }
+ $pattern{averageWidth} = '*';
+ # make sure there are no empty fields
+ foreach my $field (@fields) {
+ $pattern{$field} = '*' unless defined($pattern{$field});
+ }
+ my $new_fontstring = '-' . join('-', @pattern{@fields});
+
+ my @candidates;
+ # $term->scr_add_lines("\r\nPattern is $new_fontstring\n");
+ open(FOO, "xlsfonts -fn '$new_fontstring' | sort -u |") or die $!;
+ while (<FOO>) {
+ chomp;
+ s/^-//; # Strip leading '-' before split
+ my @fontdata = split(/-/, $_);
+
+ push @candidates, [$fontdata[6], "-$_"];
+ # $term->scr_add_lines("\r\npossibly $fontdata[6] $_\n");
+ }
+ close(FOO);
+
+ if (!@candidates) {
+ die "No possible fonts!";
+ }
+
+ if ($basesize != 0) {
+ # sort by font size, descending
+ @candidates = sort {$b->[0] <=> $a->[0]} @candidates;
+
+ # font is not the base font, so find the largest font that is at most
+ # as large as the base font. If the largest possible font is smaller
+ # than the base font bail and hope that a 0-size font can be found at
+ # the end of the function
+ if ($candidates[0]->[0] > $basesize) {
+ foreach my $candidate (@candidates) {
+ if ($candidate->[0] <= $basesize) {
+ return ($candidate->[1], $candidate->[0] - $font{pixelSize}, $candidate->[0]);
+ }
+ }
+ }
+ } elsif ($delta > 0) {
+ # sort by font size, ascending
+ @candidates = sort {$a->[0] <=> $b->[0]} @candidates;
+
+ foreach my $candidate (@candidates) {
+ if ($candidate->[0] >= $font{pixelSize} + $delta) {
+ return ($candidate->[1], $candidate->[0] - $font{pixelSize}, $candidate->[0]);
+ }
+ }
+ } elsif ($delta < 0) {
+ # sort by font size, descending
+ @candidates = sort {$b->[0] <=> $a->[0]} @candidates;
+
+ foreach my $candidate (@candidates) {
+ if ($candidate->[0] <= $font{pixelSize} + $delta && $candidate->[0] != 0) {
+ return ($candidate->[1], $candidate->[0] - $font{pixelSize}, $candidate->[0]);
+ }
+ }
+ }
+
+ # no fitting font available, check whether a 0-size font can be used to
+ # fit the size of the base font
+ @candidates = sort {$a->[0] <=> $b->[0]} @candidates;
+ if ($basesize != 0 && $candidates[0]->[0] == 0) {
+ return ($candidates[0]->[1], $basedelta, $basesize);
+ } else {
+ # if there is absolutely no smaller/larger font that can be used
+ # return the current one, and beep if this is the base font
+ if ($basesize == 0) {
+ $term->scr_bell;
+ }
+ return ("-$fontstring", 0, $font{pixelSize});
+ }
+}
+
+sub font_apply_new
+{
+ my ($term, $newfont, $type, $save) = @_;
+
+ # $term->scr_add_lines("\r\nnew font is $newfont\n");
+
+ $term->cmd_parse("\033]" . $escapecodes{$type} . ";" . $newfont . "\033\\");
+
+ # load the xrdb db
+ # system("xrdb -load " . X_RESOURCES);
+
+ if ($save > 0) {
+ # merge the new values
+ open(XRDB_MERGE, "| xrdb -merge") || die "can't fork: $!";
+ local $SIG{PIPE} = sub { die "xrdb pipe broken" };
+ print XRDB_MERGE "URxvt." . $type . ": " . $newfont;
+ close(XRDB_MERGE) || die "bad xrdb: $! $?";
+ }
+}
projects / etc / xsession.git / commitdiff