view release on metacpan or  search on metacpan

lib/Gtk2/CV/Schnauzer.pm  view on Meta::CPAN

use base Gtk2::CV::Jobber::Client::;

my %dir;
my $dirid;
my %directory_visited;

our $UTF8_RE = qr{^
 ( ([\x00-\x7f])              # 1-byte pattern
 | ([\xc2-\xdf][\x80-\xbf])   # 2-byte pattern
 | ((([\xe0][\xa0-\xbf])|([\xed][\x80-\x9f])|([\xe1-\xec\xee-\xef][\x80-\xbf]))([\x80-\xbf])) # 3-byte pattern
 | ((([\xf0][\x90-\xbf])|([\xf1-\xf3][\x80-\xbf])|([\xf4][\x80-\x8f]))([\x80-\xbf]{2}))       # 4-byte pattern
 )*
$}x;

# this basiclaly provides an overridable hook for your .cvrc
sub filename_display_name;
*filename_display_name = \&Glib::filename_display_name;

# quote for shell, but assume it is being interactively pasted
# input is octet string, output is unicode string
sub shellquote_selection($) {
   local $_ = $_[0];

   if ($_ =~ $UTF8_RE) {
      utf8::decode $_;

      # it really is that complicated
      s/([\$`\\"])/\\$1/g;
      s/!/"\\!"/g;
      s/'/"\\'"/g;
      "\"$_\""

   } else {
      # we use bash's syntax
      s/([^\x20-\x26\x28-\x7e])/sprintf "\\x%02x", ord $1/ge;
      "\$\'$_\'"
   }
}

sub format_size($) {
   # perl doesn't support %'d
   scalar reverse join ",", unpack "(a3)*", scalar reverse "$_[0]"
}

sub regdir($) {
   $dir{$_[0]} ||= ++$dirid;
}

my $curdir = File::Spec->curdir;
my $updir  = File::Spec->updir;

sub parent_dir($) {
   my ($volume, $dirs, $file) = File::Spec->splitpath ($_[0], 1);
   my @dirs = File::Spec->splitdir ($dirs);
   pop @dirs; # oh my god
   $dirs = File::Spec->catdir (@dirs);
   File::Spec->catpath ($volume, $dirs, $file)
}

sub IW() { 80 } # must be the same as in CV.xs(!)
sub IH() { 60 } # must be the same as in CV.xs(!)

sub default_display_scale {
   init Gtk2::Gdk;

   my $screen = Gtk2::Gdk::Screen->get_default
      or return 1;

   my $rect = $screen->get_monitor_geometry (0)
      or return 1;

   no integer;

   my $dpi = $rect->width * 2.54 * 10 / $screen->get_monitor_width_mm (0);

   $dpi < 110 ? 1 : $dpi / 96
}

BEGIN {
   no integer;
   $ICONSCALE = $ENV{CV_THUMBNAIL_SCALE} || $ICONSCALE || 1;
   eval "sub IWG()    { " . (int IW * $ICONSCALE   ) . " }"; # "G"eneration
   eval "sub IHG()    { " . (int IH * $ICONSCALE   ) . " }"; # "G"eneration

   $DISPLAYSCALE = $ENV{CV_DISPLAY_SCALE} || $DISPLAYSCALE || default_display_scale;
   eval "sub IWD()    { " . (int IW * $DISPLAYSCALE) . " }"; # "D"isplay
   eval "sub IHD()    { " . (int IH * $DISPLAYSCALE) . " }"; # "D"isplay
   eval "sub IX()     { " . (int 20 * $DISPLAYSCALE) . " }"; # extra horizontal space

   my $fsize = int 12 * ($ENV{CV_SCHNAUZER_FONTSCALE} || $FONTSCALE || $ICONSCALE) * $DISPLAYSCALE;
   eval "sub FY()     { $fsize }";
   eval "sub IY()     { " . (ceil 1.25 * $fsize) . " }";
}

sub SCROLL_Y()    {  1 }
sub SCROLL_X()    { 10 }
sub SCROLL_TIME() { 500 }

sub FAST_RANGE()  { 10000 } # searching for this many entries * 2 is fast
sub SLOW_RANGE()  {    10 } # doing this many slow ops per idle callback is ok

sub F_CHECKED()  { 1 } # entry has been investigated
sub F_ISDIR()    { 2 } # entry is certainly a directory
sub F_HASXVPIC() { 4 } # entry (likely) has a thumbnail file
sub F_HASPM()    { 8 } # entry has a pixmap

# entries are arrays with these indices. the order
# is hardcoded in several places, such as chpaths.
sub E_DIR   () { 0 }
sub E_FILE  () { 1 }
sub E_FLAGS () { 2 }
sub E_PIXMAP() { 3 }

sub load_icon {
   my $pb = Gtk2::CV::require_image $_[0];

   $pb->scale_simple (IWD, IHD, "bilinear")
}

sub load_icon_pm {
   scalar +(load_icon $_[0])->render_pixmap_and_mask (0.5)