[ViewVC] Diff of: cvs/rxvt-unicode/src/urxvt.pm

Comparing rxvt-unicode/src/urxvt.pm (file contents):
Revision 1.259 by sf-exg, Sat May 8 06:16:21 2021 UTC vs.
Revision 1.266 by root, Sat Jul 24 11:58:27 2021 UTC

 urxvtperl - rxvt-unicode's embedded perl interpreter
 =head1 SYNOPSIS
-   # create a file grab_test in $HOME:
+   # create a file grab_test in some directory:
    sub on_sel_grab {
       warn "you selected ", $_[0]->selection;
       ()
    }
-   # start a urxvt using it:
+   # start a urxvt instance using it:
-   urxvt --perl-lib $HOME -pe grab_test
+   urxvt --perl-lib path/to/somedirectory -pe grab_test
 =head1 DESCRIPTION
 Every time a terminal object gets created, extension scripts specified via
 the C<perl> resource are loaded and associated with it.
-Scripts are compiled in a 'use strict "vars"' and 'use utf8' environment, and
+Scripts are compiled in a 'use strict qw(vars subs)' and 'use utf8'
-thus must be encoded as UTF-8.
+environment, and thus must be encoded as UTF-8.
 Each script will only ever be loaded once, even in urxvtd, where
 scripts will be shared (but not enabled) for all terminals.
 You can disable the embedded perl interpreter by setting both "perl-ext"
 terminal is destroyed.
 Argument names also often indicate the type of a parameter. Here are some
 hints on what they mean:
-=over 4
+=over
 =item $text
 Rxvt-unicode's special way of encoding text, where one "unicode" character
 always represents one screen cell. See L<ROW_t> for a discussion of this format.
 Rxvt-unicode recognizes special meta comments in extensions that define
 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:
+Currently, it recognises these comments below. Individual components are
+separated by cololns (C<:>), and shoudl not contain colons themselves -
+there is also currently no escaping mechanism provided for this.
-=over 4
+=over
 =item #:META:RESOURCE:name:type:desc
 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.
+Example: matcher provides the C<matcher.launcher> ressource by having this
+comment:
+   #:META:RESOURCE:%.launcher:string:default launcher command
+Example: load this extension when the C<-tr> command line option or
+resource name is used.
+   #:META:RESOURCE:tr:boolean:set root pixmap as background
+=item #:META:OSC:number:desc
+The OSC comment specifies an OSC sequence, where C<number> is the
+numerical OSC code and C<desc> is a short description that is currently
+unused.
+This will cause the extension to be autoloaded when the OSC sequence is
+used for the first time.
+Note that autoloading carries some extra responsibilities with it:
+although the terminal cnanot really protect itself against malicious
+sources of command sequences, therefore relying on the programs running
+I<inside> to sanitize data that they output, it is very common for
+programs to emit command sequences from untrusted sources.
+While this means that extensions should, as a defense-in-depth mechanism,
+always consider whether OSC sequences are safe, autoloading automatically
+exposes any autoloaded extension in all terminal windows, so extra care
+should be taken.
+Example: the background extension registers OSC C<20> like this:
+   #:META:OSC:20:change/query background image
+=item #:META:OSC_PERL:prefix:desc
+The same as the OSC comment, but for the Perl OSC sequence (C<777>). The
+C<prefix> should be unique among extensions, of course, which is most
+easily arranged by using the extension name, although this is not
+required.
+Example: the overlay-osc extension registers its Perl OSC like this:
+   #:META:OSC_PERL:overlay:man overlay-osc
 =back
 =head2 Hooks
 The following subroutines can be declared in extension files, and will be
 hooks returns true, then the event counts as being I<consumed>, and the
 relevant action might not be carried out by the C++ code.
 I<< When in doubt, return a false value (preferably C<()>). >>
-=over 4
+=over
 =item on_init $term
 Called after a new terminal object has been initialized, but before
 windows are created or the command gets run. Most methods are unsafe to
 C<on_osc_seq_perl> should be used for new behaviour.
 =item on_osc_seq_perl $term, $args, $resp
-Called whenever the B<ESC ] 777 ; string ST> command sequence (OSC =
+Called whenever the B<ESC ] 777 ; prefix ; string ST> command sequence
-operating system command) is processed. Cursor position and other state
+(OSC = operating system command) is processed. Cursor position and other
-information is up-to-date when this happens. For interoperability, the
+state information is up-to-date when this happens. For interoperability,
-string should start with the extension name (sans -osc) and a semicolon,
+the argument should start with the extension name (sans -osc) or some
-to distinguish it from commands for other extensions, and this might be
+other suitable prefix, and a semicolon, to distinguish it from commands
-enforced in the future.
+for other extensions.
 For example, C<overlay-osc> uses this:
    sub on_osc_seq_perl {
       my ($self, $osc, $resp) = @_;
 =cut
 package urxvt;
 use utf8;
-use strict 'vars';
+use strict qw(vars subs);
 use Carp ();
 use Scalar::Util ();
 use List::Util ();
 our $VERSION = 1;
 our $NOCHAR = chr 0xffff;
 =head2 Variables in the C<urxvt> Package
-=over 4
+=over
 =item $urxvt::LIBDIR
 The rxvt-unicode library directory, where, among other things, the perl
 modules and scripts are stored.
 =back
 =head2 Functions in the C<urxvt> Package
-=over 4
+=over
 =item urxvt::fatal $errormessage
 Fatally aborts execution with the given error message (which should
 include a trailing newline). Avoid at all costs! The only time this
 The following "macros" deal with changes in rendition sets. You should
 never just create a bitset, you should always modify an existing one,
 as they contain important information required for correct operation of
 rxvt-unicode.
-=over 4
+=over
 =item $rend = urxvt::DEFAULT_RSTYLE
 Returns the default rendition, as used when the terminal is starting up or
 being reset. Useful as a base to start when creating renditions.
          urxvt::log sprintf "  %-31s %s\n", "$pattern:", $type;
       }
    }
 }
-my $verbosity = $ENV{URXVT_PERL_VERBOSITY};
+my $verbosity = $ENV{URXVT_PERL_VERBOSITY} // 2;
 sub verbose {
    my ($level, $msg) = @_;
    warn "$msg\n" if $level <= $verbosity;
 }
       open my $fh, "<:raw", $path
          or die "$path: $!";
       my $source =
-         "package $pkg; use strict 'vars'; use utf8; no warnings 'utf8';\n"
+         "package $pkg; use strict qw(vars subs); use utf8; no warnings 'utf8';\n"
          . "#line 1 \"$path\"\n{\n"
          . (do { local $/; <$fh> })
          . "\n};\n1";
       eval $source
 sub invoke {
    local $TERM = shift;
    my $htype = shift;
    if ($htype == HOOK_INIT) {
-      my @dirs = $TERM->perl_libdirs;
       $TERM->scan_extensions;
       my %ext_arg;
       {
          @TERM_EXT = ();
          $TERM->register_package ($_) for @pkg;
       }
       for (
+         @{ delete $TERM->{perl_ext_3} },
          (grep $_, map { split /,/, $TERM->resource ("perl_ext_$_") } 1, 2),
-         @{ delete $TERM->{perl_ext_3} }
       ) {
          if ($_ eq "default") {
             $ext_arg{$_} = []
-               for qw(selection option-popup selection-popup readline searchable-scrollback);
+               for qw(selection option-popup selection-popup readline searchable-scrollback confirm-paste);
             for ($TERM->_keysym_resources) {
                next if /^(?:string|command|builtin|builtin-string|perl)/;
                next unless /^([A-Za-z0-9_\-]+):/;
                my $ext = $1;
                $ext_arg{$ext} = [];
             }
-         } elsif (/^-(.*)$/) {
+         } elsif (/^-(.*)$/) { # remove from set
             delete $ext_arg{$1};
-         } elsif (/^([^<]+)<(.*)>$/) {
+         } elsif (/^\/(.*)$/) { # prohibit loading
+            undef $TERM->{ext_prohibit}{$1};
+         } elsif (/^([^<]+)(?:<(.*)>)?$/) { # add to set, clear prohibit status
+            delete $TERM->{ext_prohibit}{$1};
-            push @{ $ext_arg{$1} }, $2;
+            push @{ $ext_arg{$1} }, defined $2 ? $2 : ();
          } else {
-            $ext_arg{$_} ||= [];
+            verbose 2, "cannot parse extension specification '$_', ignoring.";
          }
       }
+      $TERM->set_should_invoke (HOOK_OSC_SEQ     , +1) if $TERM->{meta}{autoload_osc};
+      $TERM->set_should_invoke (HOOK_OSC_SEQ_PERL, +1) if $TERM->{meta}{autoload_osc_perl};
       for my $ext (sort keys %ext_arg) {
-         my @files = grep -f $_, map "$_/$ext", @dirs;
+         my $path = $TERM->extension_path ($ext);
-         if (@files) {
+         if (defined $path) {
-            $TERM->register_package (extension_package $files[0], $ext_arg{$ext});
+            $TERM->autoload_extension ($ext, $ext_arg{$ext});
          } else {
-            warn "perl extension '$ext' not found in perl library search path\n";
+            verbose 2, "perl extension '$ext' not found in perl library search path";
          }
       }
       eval "#line 1 \"--perl-eval resource/argument\"\n" . $TERM->resource ("perl_eval");
       warn $@ if $@;
    }
    $retval = undef;
+   if ($htype == HOOK_OSC_SEQ) {
+      if (my $exts = delete $TERM->{meta}{autoload_osc}{$_[0]}) {
+         $TERM->autoload_extension ($_->[0]) for @$exts;
+      }
+   } elsif ($htype == HOOK_OSC_SEQ_PERL) {
+      if ($_[0] =~ /^([^;]+)/ and (my $exts = delete $TERM->{meta}{autoload_osc_perl}{$1})) {
+         $TERM->autoload_extension ($_->[0]) for @$exts;
+      }
+   }
    if (my $cb = $TERM->{_hook}[$htype]) {
       verbose 10, "$HOOKNAME[$htype] (" . (join ", ", $TERM, @_) . ")"
          if $verbosity >= 10;
 The methods (And data members) documented below can be called on extension
 objects, in addition to call methods documented for the <urxvt::term>
 class.
-=over 4
+=over
 =item $urxvt_term = $self->{term}
 Returns the C<urxvt::term> object associated with this instance of the
 extension. This member I<must not> be changed in any way.
 package urxvt::term;
 =head2 The C<urxvt::term> Class
-=over 4
+=over
 =cut
 # find on_xxx subs in the package and register them
 # as hooks
          $proxy->enable ($name => $ref);
       }
    }
 }
+# map extension name to filesyystem path
+sub extension_path {
+   (grep -f $_, map "$_/$_[1]", $_[0]->perl_libdirs)[0]
+}
+# load an extension by name
+sub load_extension_file {
+   my ($self, $path, $argv) = @_;
+   $self->register_package (urxvt::extension_package $path, $argv);
+}
+# autoload an extension unless loading it is prohibited
+sub autoload_extension {
+   my ($self, $name, $argv) = @_;
+   return if exists $self->{ext_prohibit}{$name};
+   my $path = $self->extension_path ($name)
+      // return urxvt::verbose 2, "perl extension '$name' not found in perl library search path (during autoload)";
+   $self->load_extension_file ($path, $argv);
+}
 sub perl_libdirs {
    map { split /:/ }
       $_[0]->resource ("perl_lib"),
       $ENV{URXVT_PERL_LIB},
       "$ENV{HOME}/.urxvt/ext",
    return if exists $self->{meta};
    my @urxvtdirs = perl_libdirs $self;
 #   my @cpandirs = grep -d, map "$_/URxvt/Ext", @INC;
-   $self->{meta} = \my %meta;
+   $self->{meta} = \my %allmeta;
    # first gather extensions
    my $gather = sub {
       my ($dir, $core) = @_;
             or next;
          $ext =~ s/\.uext$// or $core
             or next;
-         my %ext = (dir => $dir);
+         my %meta = (dir => $dir);
          while (<$fh>) {
             if (/^#:META:(?:X_)?RESOURCE:(.*)/) {
                my ($pattern, $type, $desc) = split /:/, $1;
                $pattern =~ s/^%(\.|$)/$ext$1/g; # % in pattern == extension name
                if ($pattern =~ /[^a-zA-Z0-9\-\.]/) {
                   warn "$dir/$ext: meta resource '$pattern' contains illegal characters (not alphanumeric nor . nor *)\n";
                } else {
-                  $ext{resource}{$pattern} = [$ext, $type, $desc];
+                  $meta{resource}{$pattern} = [$ext, $type, $desc];
                }
+            } elsif (/^#:META:OSC:([0-9]+):(.*)/) {
+               push @{$allmeta{autoload_osc}{$1}}, [$ext, $2];
+            } elsif (/^#:META:OSC_PERL:([^:]+):(.*)/) {
+               push @{$allmeta{autoload_osc_perl}{$1}}, [$ext, $2];
             } elsif (/^\s*(?:#|$)/) {
                # skip other comments and empty lines
             } else {
                last; # stop parsing on first non-empty non-comment line
             }
          }
-         $meta{ext}{$ext} = \%ext;
+         $allmeta{ext}{$ext} = \%meta;
       }
    };
 #   $gather->($_, 0) for @cpandirs;
    $gather->($_, 1) for @urxvtdirs;
    # and now merge resources
-   $meta{resource} = \my %resource;
+   $allmeta{resource} = \my %resource;
-   while (my ($k, $v) = each %{ $meta{ext} }) {
+   while (my ($k, $v) = each %{ $allmeta{ext} }) {
       #TODO: should check for extensions overriding each other
       %resource = (%resource, %{ $v->{resource} });
    }
 }
  insecure intensityStyles iso14755 iso14755_52 jumpScroll loginShell
  mapAlert meta8 mouseWheelScrollPage override_redirect pastableTabs
  pointerBlank reverseVideo scrollBar scrollBar_floating scrollBar_right
  scrollTtyKeypress scrollTtyOutput scrollWithBuffer secondaryScreen
  secondaryScroll skipBuiltinGlyphs skipScroll transparent tripleclickwords
- urgentOnBell utmpInhibit visualBell
+ urgentOnBell utmpInhibit visualBell disablePasteBrackets
 =item $value = $term->resource ($name[, $newval])
 Returns the current resource value associated with a given name and
 optionally sets a new value. Setting values is most useful in the C<init>
   preeditType print_pipe pty_fd reverseVideo saveLines scrollBar
   scrollBar_align scrollBar_floating scrollBar_right scrollBar_thickness
   scrollTtyKeypress scrollTtyOutput scrollWithBuffer scrollstyle
   secondaryScreen secondaryScroll shade skipBuiltinGlyphs skipScroll
   term_name title transient_for transparent tripleclickwords urgentOnBell
-  utmpInhibit visualBell
+  utmpInhibit visualBell rewrapMode disablePasteBrackets
 =cut
 sub resource($$;$) {
    my ($self, $name) = (shift, shift);
 This method returns an urxvt::overlay object. The overlay will be visible
 as long as the perl object is referenced.
 The methods currently supported on C<urxvt::overlay> objects are:
-=over 4
+=over
 =item $overlay->set ($x, $y, $text[, $rend])
 Similar to C<< $term->ROW_t >> and C<< $term->ROW_r >> in that it puts
 text in rxvt-unicode's special encoding and an array of rendition values
       # mouse reporting is turned on
   }
 =item $view_start = $term->view_start ([$newvalue])
-Returns the row number of the topmost displayed line. Maximum value is
+Returns the row number of the topmost displayed line and changes it,
-C<0>, which displays the normal terminal contents. Lower values scroll
+if an argument is given. Values greater than or equal to C<0> display
-this many lines into the scrollback buffer.
+the terminal contents. Lower values scroll this many lines into the
+scrollback buffer.
 =item $term->want_refresh
 Requests a screen refresh. At the next opportunity, rxvt-unicode will
 compare the on-screen display with its stored representation. If they
 Create and return a new C<urxvt::line> object that stores information
 about the logical line that row C<$row_number> is part of. It supports the
 following methods:
-=over 4
+=over
 =item $text = $line->t ([$new_text])
 Returns or replaces the full text of the line, similar to C<ROW_t>
 package urxvt::popup;
 =head2 The C<urxvt::popup> Class
-=over 4
+=over
 =cut
 sub add_item {
    my ($self, $item) = @_;
                     ->cb (sub {
                        $term->{overlay}->set (0, 0,
                           sprintf "%2d:%02d:%02d", (localtime urxvt::NOW)[2,1,0]);
                     });
-=over 4
+=over
 =item $timer = new urxvt::timer
 Create a new timer object in started state. It is scheduled to fire
 immediately.
                    sysread $term->{socket}, my $buf, 8192
                       or end-of-file;
                  });
-=over 4
+=over
 =item $iow = new urxvt::iow
 Create a new io watcher object in stopped state.
 This class implements idle watchers, that get called automatically when
 the process is idle. They should return as fast as possible, after doing
 some useful work.
-=over 4
+=over
 =item $iw = new urxvt::iw
 Create a new idle watcher object in stopped state.
                     ->cb (sub {
                        my ($pw, $exit_status) = @_;
                        ...
                     });
-=over 4
+=over
 =item $pw = new urxvt::pw
 Create a new process watcher in stopped state.
 =head2 URXVT_PERL_VERBOSITY
 This variable controls the verbosity level of the perl extension. Higher
 numbers indicate more verbose output.
-=over 4
+=over
-=item == 0 - fatal messages
+=item == 0 - fatal messages only
+=item >= 2 - general warnings (default level)
 =item >= 3 - script loading and management
 =item >=10 - all called hooks

Diff Legend

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

Comparing rxvt-unicode/src/urxvt.pm (file contents): Revision 1.259 by sf-exg, Sat May 8 06:16:21 2021 UTC vs. Revision 1.266 by root, Sat Jul 24 11:58:27 2021 UTC

Diff Legend

Comparing rxvt-unicode/src/urxvt.pm (file contents):
Revision 1.259 by sf-exg, Sat May 8 06:16:21 2021 UTC vs.
Revision 1.266 by root, Sat Jul 24 11:58:27 2021 UTC