[ViewVC] Diff of: cvs/rxvt-unicode/src/perl/background

Comparing rxvt-unicode/src/perl/background (file contents):
Revision 1.53 by root, Tue Jun 12 18:25:57 2012 UTC vs.
Revision 1.55 by root, Thu Jun 14 16:48:57 2012 UTC

       return scale load "$HOME/weekday.png";
    } else {
       return scale load "$HOME/sunday.png";
    }
-This expression gets evaluated once per hour. It will set F<sunday.png> as
+This expression is evaluated once per hour. It will set F<sunday.png> as
 background on Sundays, and F<weekday.png> on all other days.
 Fortunately, we expect that most expressions will be much simpler, with
 little Perl knowledge needed.
 =back
 =cut
 our %_IMG_CACHE;
-our %_ONCE_CACHE;
 our $HOME;
 our ($self, $old, $new);
 our ($x, $y, $w, $h);
 # enforce at least this interval between updates
 =item load $path
 Loads the image at the given C<$path>. The image is set to plane tiling
 mode.
-Loaded images will be cached for one cycle.
+Loaded images will be cached for one cycle, and shared between temrinals
+running in the same process (e.g. in C<urxvtd>).
+=item load_uc $path
+Load uncached - same as load, but does not cache the image. This function
+is most useufl if you want to optimise a background expression in some
+way.
 =cut
+   sub load_uc($) {
+      my ($path) = @_;
+      $_IMG_CACHE{$path} || do {
+         my $img = $self->new_img_from_file ($path);
+         Scalar::Util::weaken ($_IMG_CACHE{$path} = $img);
+         $img
+      }
+   }
    sub load($) {
       my ($path) = @_;
-      $new->{load}{$path} = $old->{load}{$path} || $self->new_img_from_file ($path);
+      $new->{load}{$path} = $old->{load}{$path} || load_uc $path;
    }
 =item root
 Returns the root window pixmap, that is, hopefully, the background image
 reevaluated when the bg image changes.
 =cut
    sub root() {
-      $new->{rootpmap_sensitive} = 1;
+      $new->{again}{rootpmap} = 1;
       $self->new_img_from_root
    }
 =item solid $colour
 the window size to conserve memory.
 Example: take the screen background, clip it to the window size, blur it a
 bit, align it to the window position and use it as background.
-   clip move -TX, -TY, blur 5, root
+   clip move -TX, -TY, once { blur 5, root }
 =cut
-   sub TX() { $new->{position_sensitive} = 1; $x }
+   sub TX() { $new->{again}{position} = 1; $x }
-   sub TY() { $new->{position_sensitive} = 1; $y }
+   sub TY() { $new->{again}{position} = 1; $y }
-   sub TW() { $new->{size_sensitive}     = 1; $w }
+   sub TW() { $new->{again}{size}     = 1; $w }
-   sub TH() { $new->{size_sensitive}     = 1; $h }
+   sub TH() { $new->{again}{size}     = 1; $h }
 =item now
 Returns the current time as (fractional) seconds since the epoch.
 =cut
    sub now() { urxvt::NOW }
    sub again($) {
-      $new->{again} = $_[0];
+      $new->{again}{time} = $_[0];
    }
    sub counter($) {
-      $new->{again} = $_[0];
+      $new->{again}{time} = $_[0];
       $self->{counter} + 0
    }
 =back
 next call they will be reevaluated again.
 =cut
    sub once(&) {
-      $_ONCE_CACHE{$_[0]+0} ||= $_[0]()
+      my $once = $self->{once_cache}{$_[0]+0} ||= do {
+         local $new->{again};
+         my @res = $_[0]();
+         [$new->{again}, \@res]
+      };
+      $new->{again} = {
+         %{ $new->{again} },
+         %{ $once->[0] }
+      };
+      # in scalar context we always return the first original result, which
+      # is not quite how perl works.
+      wantarray
+         ? @{ $once->[1] }
+         : $once->[1][0]
    }
    sub once_again() {
-      %_ONCE_CACHE = ();
+      delete $self->{once_cache};
    }
 =back
 =cut
    my $img = eval { $self->{expr}->() };
    warn $@ if $@;#d#
    die "background-expr did not return an image.\n" if !UNIVERSAL::isa $img, "urxvt::img";
-   $state->{size_sensitive} = 1
+   # if the expression is sensitive to external events, prepare reevaluation then
+   my $again = delete $state->{again};
+   $again->{size} = 1
       if $img->repeat_mode != urxvt::RepeatNormal;
-   # if the expression is sensitive to external events, prepare reevaluation then
-   my $repeat;
-   if (my $again = $state->{again}) {
+   if (my $again = $again->{time}) {
-      $repeat = 1;
       my $self = $self;
       $state->{timer} = $again == $old->{again}
                         ? $old->{timer}
                         : urxvt::timer->new->after ($again)->interval ($again)->cb (sub {
                              ++$self->{counter};
                              $self->recalculate
                           });
    }
-   if (delete $state->{position_sensitive}) {
+   if ($again->{position}) {
-      $repeat = 1;
       $self->enable (position_change => sub { $_[0]->recalculate });
    } else {
       $self->disable ("position_change");
    }
-   if (delete $state->{size_sensitive}) {
+   if ($again->{size}) {
-      $repeat = 1;
       $self->enable (size_change => sub { $_[0]->recalculate });
    } else {
       $self->disable ("size_change");
    }
-   if (delete $state->{rootpmap_sensitive}) {
+   if ($again->{rootpmap}) {
-      $repeat = 1;
-      $self->enable (rootpmap_change => sub { $_[0]->recalculate });
+      $self->enable (rootpmap_change => sub {
+         delete $_[0]{once_cache}; # this will override once-block values from
+         $_[0]->recalculate;
+      });
    } else {
       $self->disable ("rootpmap_change");
    }
    # clear stuff we no longer need
    %$old = ();
-   unless ($repeat) {
+   unless (%$again) {
       delete $self->{state};
       delete $self->{expr};
    }
    # set background pixmap

Diff Legend

-–
+Removed lines
-+
+Added lines
-<
+Changed lines
->
+Changed lines

Comparing rxvt-unicode/src/perl/background (file contents): Revision 1.53 by root, Tue Jun 12 18:25:57 2012 UTC vs. Revision 1.55 by root, Thu Jun 14 16:48:57 2012 UTC

Diff Legend

Comparing rxvt-unicode/src/perl/background (file contents):
Revision 1.53 by root, Tue Jun 12 18:25:57 2012 UTC vs.
Revision 1.55 by root, Thu Jun 14 16:48:57 2012 UTC