From ef37ea005608b865a5c9c2290dffec2386e94147 Mon Sep 17 00:00:00 2001 From: Bart Trojanowski Date: Wed, 13 Feb 2013 23:38:01 -0500 Subject: [PATCH] dave0's font-size --- font-size | 339 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 339 insertions(+) create mode 100644 font-size diff --git a/font-size b/font-size new file mode 100644 index 0000000..d227b68 --- /dev/null +++ b/font-size @@ -0,0 +1,339 @@ +#!/usr/bin/perl +# +# On-the-fly adjusting of the font size in urxvt +# +# Copyright (c) 2008 David O'Neill +# 2012 Noah K. Tilton +# 2012 Jan Larres +# +# 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 +# +# +# USAGE +# +# Add font-size to the list of perl extensions: +# URxvt.perl-ext-common: ...,font-size +# +# Add some keybindings: +# 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: +# - increase/decrease: +# increase or decrease the font size of the current terminal. +# - incglobal/decglobal: +# same as above and also adjust the X server values so all newly started +# terminals will use the same fontsize. +# - 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. + +use strict; +use warnings; + +my %escapecodes = ( + "font" => 710, + "boldFont" => 711, + "italicFont" => 712, + "boldItalicFont" => 713 +); + +sub on_user_command +{ + my ($self, $cmd) = @_; + + if ($cmd eq "font-size:increase") { + fonts_change_size($self, 1, 0); + } elsif ($cmd eq "font-size:decrease") { + fonts_change_size($self, -1, 0); + } elsif ($cmd eq "font-size:incglobal") { + fonts_change_size($self, 1, 1); + } elsif ($cmd eq "font-size:decglobal") { + fonts_change_size($self, -1, 1); + } elsif ($cmd eq "font-size:incsave") { + fonts_change_size($self, 1, 2); + } elsif ($cmd eq "font-size:decsave") { + fonts_change_size($self, -1, 2); + } +} + +sub fonts_change_size +{ + my ($term, $change, $save) = @_; + + my @newfonts = (); + + my $curres = $term->resource('font'); + if (!$curres) { + return; + } + my @curfonts = split(/,/, $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 handle_type +{ + my ($term, $type, $change, $basesize, $save) = @_; + + my $curres = $term->resource($type); + if (!$curres) { + return; + } + my @curfonts = split(/,/, $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_x11($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_x11($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 =~ /pixelsize=(\d+)/) { + $size = $1; + + if ($basesize != 0) { + $new_size = $basesize; + } else { + $new_size = ($change > 0 ? ($size + 1) : ($size - 1)); + } + + $piece =~ s/pixelsize=$size/pixelsize=$new_size/; + } + push @resized, $piece; + } + + my $resized_str = join(":", @resized); + + # don't make fonts too small + if ($new_size >= 10) { + return ($resized_str, $new_size); + } else { + if ($basesize == 0) { + $term->scr_bell; + } + return ($fontstring, $size); + } +} + +sub font_change_size_x11 +{ + 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{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 () { + 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}) { + 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} && $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: $! $?"; + } +} -- 2.11.4.GIT