+++ /dev/null
-#!/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>
-# 2012-2013 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
-#
-
-#: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
-
-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
-
-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.
-
-=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);
- }
-}
-
-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);
- }
-}
-
-sub fonts_change_size
-{
- my ($term, $change, $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, $newbasesize) = handle_font($term, $basefont, $change, 0);
- push @newfonts, $newbasefont;
-
- # Only adjust other fonts if base font changed
- if ($newbasefont ne $basefont) {
- foreach my $font (@curfonts) {
- my ($newfont, $newsize) = handle_font($term, $font, $change, $newbasesize);
- push @newfonts, $newfont;
- }
- my $newres = join(",", @newfonts);
- font_apply_new($term, $newres, "font", $save);
-
- handle_type($term, "boldFont", $change, $newbasesize, $save);
- handle_type($term, "italicFont", $change, $newbasesize, $save);
- handle_type($term, "boldItalicFont", $change, $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 handle_type
-{
- my ($term, $type, $change, $basesize, $save) = @_;
-
- my $curres = $term->resource($type);
- if (!$curres) {
- return;
- }
- my @curfonts = split(/\s*,\s*/, $curres);
- my @newfonts = ();
-
- foreach my $font (@curfonts) {
- my ($newfont, $newsize) = handle_font($term, $font, $change, $basesize);
- push @newfonts, $newfont;
- }
-
- my $newres = join(",", @newfonts);
- font_apply_new($term, $newres, $type, $save);
-}
-
-sub handle_font
-{
- my ($term, $font, $change, $basesize) = @_;
-
- my $newfont;
- my $newsize;
- my $prefix = 0;
-
- if ($font =~ /^\s*x:/) {
- $font =~ s/^\s*x://;
- $prefix = 1;
- }
- if ($font =~ /^\s*(\[.*\])?xft:/) {
- ($newfont, $newsize) = font_change_size_xft($term, $font, $change, $basesize);
- } elsif ($font =~ /^\s*-/) {
- ($newfont, $newsize) = font_change_size_xlfd($term, $font, $change, $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, $basesize);
- }
-
- my $fontinfo = (split(/\n/, $lsfinfo))[-1];
- my ($fontfull) = ($fontinfo =~ /\s+([-a-z0-9]+$)/);
- ($newfont, $newsize) = font_change_size_xlfd($term, $fontfull, $change, $basesize);
- }
-
- # $term->scr_add_lines("\r\nNew font is $newfont\n");
- if ($prefix) {
- $newfont = "x:$newfont";
- }
- return ($newfont, $newsize);
-}
-
-sub font_change_size_xft
-{
- my ($term, $fontstring, $change, $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 ($basesize != 0) {
- $new_size = $basesize;
- } else {
- $new_size = $size + $change
- }
-
- $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);
- } else {
- if ($basesize == 0) {
- $term->scr_bell;
- }
- return ($fontstring, $size);
- }
-}
-
-sub font_change_size_xlfd
-{
- my ($term, $fontstring, $change, $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 @possible;
- # $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 @possible, [$fontdata[6], "-$_"];
- # $term->scr_add_lines("\r\npossibly $fontdata[6] $_\n");
- }
- close(FOO);
-
- if (!@possible) {
- die "No possible fonts!";
- }
-
- if ($basesize != 0) {
- # sort by font size, descending
- @possible = sort {$b->[0] <=> $a->[0]} @possible;
-
- # 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 ($possible[0]->[0] > $basesize) {
- foreach my $candidate (@possible) {
- if ($candidate->[0] <= $basesize) {
- return ($candidate->[1], $candidate->[0]);
- }
- }
- }
- } elsif ($change > 0) {
- # sort by font size, ascending
- @possible = sort {$a->[0] <=> $b->[0]} @possible;
-
- foreach my $candidate (@possible) {
- if ($candidate->[0] >= $font{pixelSize} + $change) {
- return ($candidate->[1], $candidate->[0]);
- }
- }
- } elsif ($change < 0) {
- # sort by font size, descending
- @possible = sort {$b->[0] <=> $a->[0]} @possible;
-
- foreach my $candidate (@possible) {
- if ($candidate->[0] <= $font{pixelSize} + $change && $candidate->[0] != 0) {
- return ($candidate->[1], $candidate->[0]);
- }
- }
- }
-
- # no fitting font available, check whether a 0-size font can be used to
- # fit the size of the base font
- @possible = sort {$a->[0] <=> $b->[0]} @possible;
- if ($basesize != 0 && $possible[0]->[0] == 0) {
- return ($possible[0]->[1], $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", $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: $! $?";
- }
-}
repositories / dotfiles.git / commitdiff