Fvwm Thumbnail Icons

README

####  My Iconificate module

This is how I did the thumbnail icons here : http://i.imgur.com/ryWrztC.png

Thumbnail icons are common enough in FVWM. Most times, it is done with xwd and/or 
imagemagick in a PipeRead command. I merely decided that it would be better done in
an fvwmperl module. There I could ensure the thumnail is cropped to the right
geometry, and extra imagemagick steps to add in the miniicon. And I hate the 
ugly syntax used in a large PipeRead command.

Note that the Iconificate module first gathers info from the fvwm configuration
database before starting the iconificate process with the iconic_mode()
subroutine. This way, any config info for this module can come from my ~/.fvwm/config

I believe there was at one time an FvwmThumbnail module, although I haven't looked at it.

##  On Debian, tells you which perl lib to install to provide a certain perl module
http://deb.perl.it/debian/cpan-deb/

####  MORE INFO ABOUT FVWMPERL MODULES

##  Read the hidden fvwmperl manpages 
    $ fvwm-perllib man index

##  A folder full of simple fvwmperl examples
ftp://ftp.fvwm.org/pub/fvwm/devel/sources/tests/perl/

##  An excellent fvwmperl module example
http://www.fvwmforums.org/phpBB3/viewtopic.php?f=38&t=3069&hilit=fvwmsleep

config

####  Relevant lines from within my ~/.fvwm/config

##==============================##
##     ICONS + MINI-ICONS       ##
##==============================##

#-----------------------#
#   THUMBNAIL ICONS     #
#-----------------------#

##  An fvwmperl module to do pretty thumbnailing. 
##  Used later in the Iconify function.

##  For the thumbnail icon, the blue border around the outside is from FVWM
##  but the small blue border around the inset miniicon is thanks to
##  imagemagick and the iconificate fvwmperl module.

DestroyModuleConfig Iconificate: *
*Iconificate: ThumbIconWidth 205
*Iconificate: ThumbIconHeight 120
*Iconificate: MiniIconPadding 5
*Iconificate: MiniIconBorderWidth 4
##  *Iconificate: MiniIconBorderColor rgb(54,100,139)
##  *Iconificate: MiniIconBackgroundColor rgb(38,38,38)
##  rgb(r,g,b) where each value is 0-255 with no spaces.

Style * !IconTitle
Style * IconOverride
Style * !UseIconPosition
Style * IconSize -1 -1
Style * IconBackgroundColorset 25
Style * IconBackgroundRelief 5
Style * IconBackgroundPadding 0
Style * IconBox 990x150-20-36, IconGrid 234 134, IconFill right bottom

#-------------------#
#    MINI-ICONS     #
#-------------------#

##  Additional windows styles for mini-icons.
Style WithMiniIcon EWMHMiniIconOverride, EWMHDonateMiniIcon 

##  Currently, only windows with defined miniicons will get a miniicon inset into their thumbnail icon
Style Iceweasel MiniIcon mi_iceweasel.png, UseStyle WithMiniIcon
Style URxvt MiniIcon mi_urxvt.png, UseStyle WithMiniIcon
Style Geany MiniIcon mi_geany.png, UseStyle WithMiniIcon
Style Gvim MiniIcon mi_gvim.png, UseStyle WithMiniIcon
Style Thunderbird MiniIcon mi_icedove.png, UseStyle WithMiniIcon

##  IconBackgroundColorset        # TESTME PLZ #
Colorset 25 sh #2A5E8B, hi #2A5E8B
##  For the border color around the mini-icon inset into the thumbnail.
*Iconificate: MiniIconBorderColor rgb(54,100,139)
##  For the bg color for behind the mini-icon inset into the thumbnail.
*Iconificate: MiniIconBackgroundColor rgb(38,38,38)

##  Alt + F9   :  Iconify the window.
Key F9 A M Iconificate

##  Iconify the current window, if possible.
##  Uses the Iconificate fvwmperl module to create the thumbnail icon.
##  Relates to the Alt + F9 key binding.
DestroyFunc Iconificate
AddToFunc Iconificate 
+ I ThisWindow (Iconifiable, !Iconic) \
    ModuleSynchronous Iconificate $[w.id] $[w.miniiconfile]

Iconificate

#!/usr/bin/perl

use strict ;
use warnings ;
use v5.18 ;

use lib `fvwm-perllib dir`;
use FVWM::Module;
use Data::Dump qw( dump ) ;
use Image::Magick ;             ##  libimage-magick-perl
use Path::Tiny ;
use Try::Tiny ;
use IPC::Run qw( run timeout ) ;

my $module = new FVWM::Module(
    Name => 'Iconificate', 
    Debug => 0,
    );

my $modname = $module->name ;
my @cmds ;
my ($wid, $miniicon_file) = @ARGV ;

$wid = hex($wid) if $wid =~ /^0x/ ;

##  Logfile
my $logfile = path("$ENV{FVWM_USERDIR}/log/Iconificate.log") ;
unlink $logfile ;
#my $logger = "yes" ;
my $logger = "" ;

##  These vars gain their values from the module config.
my $thumb_w ;
my $thumb_h ;
my $miniicon_padding ;
my $miniicon_backcolor ;
my $miniicon_borderwidth ;
my $miniicon_bordercolor ;

$module->add_handler(M_CONFIG_INFO, \&read_config) ;
$module->add_handler(M_END_CONFIG_INFO, sub {
        debug("[$modname] read config finished", 0) ;
        iconic_mode() ;
        $module->terminate ;
        });

$module->send("Send_ConfigInfo");
$module->event_loop ;

####  SUBROUTINES

sub iconic_mode  {

    ##  Useful webpages :-
    ##  http://www.imagemagick.org/script/command-line-processing.php
    ##  http://www.imagemagick.org/script/perl-magick.php

    logger("debug", "iconic_mode : start") ;
    logger("debug", "wid : $wid,  mini: $miniicon_file") ;

    my $aspect = $thumb_w / $thumb_h ;
    my $thumbfile = path("$ENV{FVWM_USERDIR}/tmp/$wid.png") ;
    #my $thumbfile = path("/home/nostromo/.fvwm") ;
    my $thumb = Image::Magick->New() ;
    my $err = 1  ;

    ##  3 tries to grab an image of the current window.
    ##  The retvar for IMagick is always undef except when in error.
    
    foreach (1, 2, 3) {

        logger("debug", "iconic_mode : begin screenshot") ;

        ##  A 3 second timeout on the screenshot. 
        my $t = timeout(3) ;
        my $out = my $in = my $stderr = "" ;

        my @cmd = ("xwd", "-silent", "-nobdrs", "-id", 
            $wid, "-out", "/tmp/thumbicon.xwd" ) ;

        #logger("debug", "@cmd") ;

        my $excp = try {
            run \@cmd, \$in, \$out, \$stderr, $t ;
        } catch { "" } ;

        ##  If import cmnd produced error, then repeat again.
        if ($stderr or not -r "/tmp/thumbicon.xwd")  {
            logger("debug", "iconic_mode : import failed \n$stderr") ;
            next ;
        }

        ##  If png file cannot be opened, then repeat again.
        if (not open(IMAGE, '/tmp/thumbicon.xwd')) {
            logger("debug", "iconic_mode : can't open thumbicon.xwd") ;
            next ;
        }

        ##  If PerlMagic successfully read the png, then continue.
        $err = $thumb->Read(file=>\*IMAGE);
        close(IMAGE);
        last if not $err ;
    }

    ##  Return early if the screenshot operation failed.
    if ($err)  {
        logger("debug", "iconic_mode : screenshot FAILED") ;
        return 0 ;
    }

    my $xwd_w = $thumb->Get('columns') ;
    my $xwd_h = $thumb->Get('rows') ;

    ##  Crop the window such that it can still be recognized.
    if ( $xwd_w/$xwd_h < $aspect )  {
        my $hh = int($xwd_w / $aspect) ;
        return 0 if $thumb->Crop(
            geometry => "${xwd_w}x${hh}+0+0"
        ) ;
        $xwd_h = $thumb->Get('rows') ;
    } elsif ( $xwd_w/$xwd_h > $aspect )  {
        my $ww = int($xwd_h * $aspect) ;
        return 0 if $thumb->Crop(
            geometry => "${ww}x${xwd_h}+0+0"
        ) ;
        $xwd_w = $thumb->Get('columns') ;
    }

    ##  Convert large image into a thumbnail.
    $err = $thumb->Thumbnail(geometry => "${thumb_w}x${thumb_h}!") ;
    return 0 if $err ;
    logger("debug", "iconic_mode : create small thumbnail [pass]") ;

    ##  Add a mini-icon-to thumbnail, if avail.
    my $mini = get_mini_icon() ;
    if ($mini)  {
        logger("debug", "iconic_mode : get_mini_icon [pass]") ;
        $err = $thumb->Composite(image => $mini, gravity => "SouthEast") ;
        return 0 if $err ;
        logger("debug", "iconic_mode : miniicon composite into thumbnail [pass]") ;
    } else {
        logger("debug", "iconic_mode : get_mini_icon [fail]") ;
    } ;

    ##  Save the finished thumbnail.
    open(IMAGE, ">$thumbfile") ;
    $err = $thumb->Write(
        file=>\*IMAGE, 
        filename=>$thumbfile, 
        quality => 1
        ) ;
    return 0 if $err ;
    logger("debug", "iconic_mode : IM writes finished thumb [pass] ") ;
    close IMAGE ;

    ##  Tell fvwm to iconify the window.
    addcmd("WindowStyle Icon $thumbfile ") ;
    addcmd("Iconify True") ;
    addcmd("All (CurrentDesk, Iconic) PlaceAgain Icon") ;
    sendcmds($wid) ;

    ##  Cleanup.
    undef $mini ;
    undef $thumb ;
    unlink "/tmp/thumbicon.xwd" ;

    logger("debug", "iconic_mode : Finished with success ") ;
    return 1 ;
}

sub get_mini_icon {

    logger("debug", "get_mini_icon : start") ;

    return 0 if not defined $miniicon_file ;
    return 0 if not -r $miniicon_file ;
    logger("debug", "get_mini_icon : miniicon file exits [pass] ") ;

    ##  Read in the miniicon image
    my $miniicon = Image::Magick->new ;
    return 0 if not open(IMAGE, $miniicon_file) ;
    logger("debug", "get_mini_icon : open  the miniicon_file [pass] ") ;
    my $err = $miniicon->Read(file=>\*IMAGE) ;
    return 0 if $err ;
    logger("debug", "get_mini_icon : IM reads the open miniicon [pass] ") ;
    close IMAGE ;

    ##  Create an empty canvas that is slightly larger.
    my $mini_h = $miniicon->Get('rows') + $miniicon_padding ;
    my $mini_w = $miniicon->Get('columns') + $miniicon_padding ;
    my $mini_geom = "${mini_w}x${mini_h}" ;

    my $mini = Image::Magick->New() ;
    $mini->Set(size => $mini_geom) ;
    $err = $mini->ReadImage("canvas:$miniicon_backcolor") ;
    return 0 if $err ;
    logger("debug", "get_mini_icon : IM makes an empty canvas [pass] ") ;

    ##  Place the miniicon atop the canvas.
    $mini->Composite( image => $miniicon, gravity => "Center") ;
    return 0 if $err ;
    logger("debug", "get_mini_icon : Miniicon put atop canvas [pass] ") ;

    ##  Add a border to miniicons north and west sides. 
    $err = $mini->Splice(
        gravity => "northwest",
        geometry => "${miniicon_borderwidth}x$miniicon_borderwidth",
        background => $miniicon_bordercolor,
    ) ;
    return 0 if $err ;
    logger("debug", "get_mini_icon : Partial border added [pass] ") ;

    ##  Return okay if above steps all completed correctly.
    undef $miniicon ; 
    logger("debug", "get_mini_icon : Returns with success [pass] ") ;
    return $mini ;
}

sub read_config {
    my ($module, $event) = @_;
    return unless $event->_text =~ /^\*$modname(.*)$/;
    process_config($1);
}

sub process_config {
    my ($s) = @_;
    my ($option, $args)= $s =~/\s*(\w+)\s*(.*)/;

    my %opts = (
        ThumbIconWidth => sub { $thumb_w = $args },
        ThumbIconHeight => sub { $thumb_h = $args }, 
        MiniIconPadding => sub { $miniicon_padding = $args },
        MiniIconBackgroundColor => sub { $miniicon_backcolor = $args },
        MiniIconBorderWidth => sub { $miniicon_borderwidth = $args },
        MiniIconBorderColor => sub { $miniicon_bordercolor = $args },
    ) ;

    if (defined $opts{$option}) {
        debug("[$modname] [Config] $option : $args", 0) ;
        $opts{$option}() ;
    } else {
        $module->showMessage("Unknown option \"$option\"");
    }
}

sub addcmd   { push @cmds, @_ } ;

sub sendcmds {
    foreach (@cmds) { $module->send($_, $wid) } ;
    @cmds = () ;
}

sub debug {
    my ($msg, $level) = @_ ;
    $level = 0 if not defined $level ;
    $module->debug($msg, $level) ;
}

sub logger {
    return 0 unless $logger ;
    my ($level, $msg) = @_;
    $msg = "[$level]  $msg\n" ;
    $logfile->append_utf8($msg) ; 
}