improved background extension and resource parsing

2 files changed, 80 insertions, 39 deletions

diff --git a/src/perl/background b/src/perl/background
index bdc6846..e2fd4d3 100644
--- a/src/perl/background
+++ b/src/perl/background
@@ -26,8 +26,8 @@ background - manage terminal background
 
 =head1 QUICK AND DIRTY CHEAT SHEET
 
-Just load a random jpeg image and tile the background with it without
-scaling or anything else:
+Load a random jpeg image and tile the background with it without scaling
+or anything else:
 
    load "/path/to/img.jpg"
 
@@ -1151,6 +1151,13 @@ vertical radius of 0 disables blurring.
 
 =head2 OSC sequences
 
+This extension will react to the following OSC sequences. Note that
+this extension will not be autoloaded when these are used currenmtly,
+so to make urxvt recognize them, you have to enable the C<background>
+extension. One way to achieve that is to use the C<--background-expr ''>
+command line argument or by specifying an empty C<URxvt.background.expr:>>
+resource.
+
 =over 4
 
 =item B<< C<ESC ] 705 ; Pt ST> >> Change transparent background tint colour to B<< C<Pt> >>.
@@ -1216,13 +1223,23 @@ change background image
 }
 
 sub parse_expr {
-   my $expr = eval
-      "sub {\n"
-    . "package urxvt::bgdsl;\n"
-    . "#line 0 'background expression'\n"
-    . "$_[0]\n"
-    . "}";
-   die if $@;
+   my ($expr) = @_;
+
+   # an empty expression is valid and represents the default background
+   if ($expr !~ /\S/) {
+      $expr = sub {
+         undef
+      };
+   } else {
+      $expr = eval
+         "sub {\n"
+       . "package urxvt::bgdsl;\n"
+       . "#line 0 'background expression'\n"
+       . "$expr\n"
+       . "}";
+      die if $@;
+   }
+
    $expr
 }
 
@@ -1304,6 +1321,11 @@ sub recalculate {
 
    $arg_self->{next_refresh} = urxvt::NOW + $MIN_INTERVAL;
 
+   unless ($arg_self->has_render) {
+      warn "background extension needs RENDER extension 0.10 or higher, ignoring background-expr.\n";
+      return;
+   }
+
    # set environment to evaluate user expression
 
    local $self  = $arg_self;
@@ -1318,27 +1340,33 @@ sub recalculate {
    my @img = eval { $self->{expr}->() };
    die $@ if $@;
    die "background-expr did not return anything.\n" unless @img;
-   die "background-expr: expected image(s), got something else.\n"
-      if grep { !UNIVERSAL::isa $_, "urxvt::img" } @img;
 
-   my $img = urxvt::bgdsl::merge @img;
+   if ($img[0]) {
+      die "background-expr: expected image(s), got something else.\n"
+         if grep { !UNIVERSAL::isa $_, "urxvt::img" } @img;
 
-   $frame->[FR_AGAIN]{size} = 1
-      if $img->repeat_mode != urxvt::RepeatNormal;
+      my $img = urxvt::bgdsl::merge @img;
 
-   # if the expression is sensitive to external events, prepare reevaluation then
-   $self->compile_frame ($frame, sub { $arg_self->recalculate });
+      $frame->[FR_AGAIN]{size} = 1
+         if $img->repeat_mode != urxvt::RepeatNormal;
 
-   # clear stuff we no longer need
+      # if the expression is sensitive to external events, prepare reevaluation then
+      $self->compile_frame ($frame, sub { $arg_self->recalculate });
+
+      # clear stuff we no longer need
 
 #   unless (%{ $frame->[FR_STATE] }) {
 #      delete $self->{state};
 #      delete $self->{expr};
 #   }
 
-   # set background pixmap
+      # set background pixmap
+
+      $self->set_background ($img, $self->{border});
+   } else {
+      $self->clr_background;
+   }
 
-   $self->set_background ($img, $self->{border});
    $self->scr_recolor (0);
    $self->want_refresh;
 }
@@ -1355,12 +1383,12 @@ sub old_bg_opts {
    my $bg_opts = $self->{bg_opts};
 
    if ($str[0]) {
-      $bg_opts->{tile} = 0;
+      $bg_opts->{tile}        = 0;
       $bg_opts->{keep_aspect} = 0;
-      $bg_opts->{root_align} = 0;
-      $bg_opts->{h_scale} = $bg_opts->{v_scale} = 100;
-      $bg_opts->{h_align} = $bg_opts->{v_align} = 50;
-      $bg_opts->{path} = unpack "H*", $str[0];
+      $bg_opts->{root_align}  = 0;
+      $bg_opts->{h_scale}     = $bg_opts->{v_scale} = 100;
+      $bg_opts->{h_align}     = $bg_opts->{v_align} = 50;
+      $bg_opts->{path}        = $str[0];
    }
 
    my @oplist = split /:/, $str[1];
@@ -1398,9 +1426,9 @@ sub old_bg_opts {
          $bg_opts->{h_align} = $bg_opts->{v_align} = 0;
       } elsif (/op=tile/i) {
          $bg_opts->{tile} = 1;
-      } elsif (/op=keep_aspect/i) {
+      } elsif (/op=keep-aspect/i) {
          $bg_opts->{keep_aspect} = 1;
-      } elsif (/op=root_align/i) {
+      } elsif (/op=root-align/i) {
          $bg_opts->{root_align} = 1;
       } elsif (/^ =? ([0-9]+)? (?:[xX] ([0-9]+))? ([+-][0-9]+)? ([+-][0-9]+)? $/x) {
          my ($w, $h, $x, $y) = ($1, $2, $3, $4);
@@ -1419,6 +1447,14 @@ sub old_bg_opts {
    }
 }
 
+# helper function, quote string as perl without allowing
+# any code execution or other shenanigans. does not
+# support binary NULs in string.
+sub q0 {
+   (my $str = shift) =~ s/\x00//g; # make sure there really aren't any embedded NULs
+   "q\x00$str\x00"
+}
+
 sub old_bg_expr {
    my ($self) = @_;
 
@@ -1443,7 +1479,8 @@ sub old_bg_expr {
       my $tint = $bg_opts->{tint};
 
       if ($tint) {
-         $expr .= "tint $tint, ";
+         $tint = q0 $tint;
+         $expr .= "tint $tint,";
       }
 
       my $blur = $bg_opts->{blur};
@@ -1484,7 +1521,9 @@ sub old_bg_expr {
          $file_expr .= "$op TW * $h_scale, TH * $v_scale, ";
       }
 
-      $file_expr .= "keep { load pack \"H*\", \"$bg_opts->{path}\" })";
+      my $path = q0 $bg_opts->{path};
+
+      $file_expr .= "keep { load $path })";
 
       if ($expr) {
          $expr .= ", tint (\"[50]white\", $file_expr)";
@@ -1501,7 +1540,7 @@ sub on_osc_seq {
 
    $self->{bg_opts} or return;
 
-   $op =~ /^(20|705)$/ or return;
+   $op =~ /^(?:20|705)$/ or return;
 
    if ($op eq "20") {
       if ($arg eq "?") {
@@ -1542,20 +1581,15 @@ sub on_start {
       $self->{bg_opts} = { h_scale => 100, v_scale => 100,
                            h_align => 50, v_align => 50 };
 
-      $self->{bg_opts}->{shade} = $self->find_resource ("shading", "sh");
-      $self->{bg_opts}->{tint} = $self->find_resource ("tintColor", "tint");
-      $self->{bg_opts}->{blur} = $self->find_resource ("blurRadius", "blr");
-      $self->{bg_opts}->{root} = $self->find_resource ("transparent", "tr");
+      $self->{bg_opts}{shade} = $self->find_resource ("shading", "sh");
+      $self->{bg_opts}{tint}  = $self->find_resource ("tintColor", "tint");
+      $self->{bg_opts}{blur}  = $self->find_resource ("blurRadius", "blr");
+      $self->{bg_opts}{root}  = $self->find_resource ("transparent", "tr");
 
       $self->old_bg_opts ($self->find_resource ("backgroundPixmap", "pixmap"));
       $expr = $self->old_bg_expr;
    }
 
-   $expr or return;
-
-   $self->has_render
-      or die "background extension needs RENDER extension 0.10 or higher, ignoring background-expr.\n";
-
    $self->set_expr (parse_expr $expr);
    $self->{border} = $self->x_resource_boolean ("%.border");
 
diff --git a/src/urxvt.pm b/src/urxvt.pm
index 816317d..39632b2 100644
--- a/src/urxvt.pm
+++ b/src/urxvt.pm
@@ -117,7 +117,9 @@ the C<urxvt::extension> section below.
 =head2 META comments
 
 Rxvt-unicode recognizes special meta comments in extensions that define
-different types of metadata.
+different types of metadata. These comments are scanned whenever a
+terminal is created and are typically used to autoload extensions when
+their resources or command line parameters are used.
 
 Currently, it recognises only one such comment:
 
@@ -129,6 +131,9 @@ The RESOURCE comment defines a resource used by the extension, where
 C<name> is the resource name, C<type> is the resource type, C<boolean>
 or C<string>, and C<desc> is the resource description.
 
+The extension will be autoloaded when this resource is specified or used
+as a command line parameter.
+
 =back
 
 =head2 Hooks
@@ -602,6 +607,8 @@ sub parse_resource {
 
    $term->scan_extensions;
 
+   # iterating over all resources has quadratic time overhead
+   # overall, maybe this could be optimised?
    my $r = $term->{meta}{resource};
    keys %$r; # reset iterator
    while (my ($k, $v) = each %$r) {