--- rxvt-unicode/src/urxvt.pm 2014/10/13 12:17:48 1.244 +++ rxvt-unicode/src/urxvt.pm 2021/11/26 18:49:47 1.270 @@ -6,24 +6,24 @@ =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 resource are loaded and associated with it. -Scripts are compiled in a 'use strict "vars"' and 'use utf8' environment, and -thus must be encoded as UTF-8. +Scripts are compiled in a 'use strict qw(vars subs)' and 'use utf8' +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. @@ -47,11 +47,10 @@ Extensions may add additional resources and C, i.e., methods which can be bound to a key and invoked by the user. An extension can -define the resources it support and also default bindings for one or -more actions it provides using so called META comments, described -below. Similarly to builtin resources, extension resources can also be -specified on the command line as long options (with C<.> replaced by -C<->), in which case the corresponding extension is loaded +define the resources it support using so called META comments, +described below. Similarly to builtin resources, extension resources +can also be specified on the command line as long options (with C<.> +replaced by C<->), in which case the corresponding extension is loaded automatically. For this to work the extension B define META comments for its resources. @@ -73,7 +72,7 @@ Argument names also often indicate the type of a parameter. Here are some hints on what they mean: -=over 4 +=over =item $text @@ -117,10 +116,16 @@ =head2 META comments -rxvt-unicode recognizes special comments in extensions that define -different types of metadata: +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 these comments below. Individual components are +separated by colons (C<:>), and should not contain colons themselves - +there is also currently no escaping mechanism provided for this. -=over 4 +=over =item #:META:RESOURCE:name:type:desc @@ -128,13 +133,53 @@ C is the resource name, C is the resource type, C or C, and C is the resource description. -=item #:META:BINDING:sym:action +The extension will be autoloaded when this resource is specified or used +as a command line parameter. -The BINDING comment defines a default binding for an action provided -by the extension, where C is the key combination that triggers -the action, whose format is defined in the description of the -B resource in the urxvt(1) manpage, and C is the name -of the action method. +Example: matcher provides the C resource 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 is the +numerical OSC code and C 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 cannot really protect itself against malicious +sources of command sequences, therefore relying on the programs running +I 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 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 @@ -152,7 +197,19 @@ I<< When in doubt, return a false value (preferably C<()>). >> -=over 4 +=over + +=item on_attach $term + +Called when an extension package is attached to a running terminal +instance. Must return true in all cases, and runs with the same +limitations as C. + +Unlike C or C, this is called when the extension is +attached to a terminal, regardless of whether the extension is loaded +before or after the terminal is started. Extensions that need to do +something before they work can do it in this callback, as opposed to e.g. +C, which might not be called. =item on_init $term @@ -244,12 +301,12 @@ =item on_osc_seq_perl $term, $args, $resp -Called whenever the B command sequence (OSC = -operating system command) is processed. Cursor position and other state -information is up-to-date when this happens. For interoperability, the -string should start with the extension name (sans -osc) and a semicolon, -to distinguish it from commands for other extensions, and this might be -enforced in the future. +Called whenever the B command sequence +(OSC = operating system command) is processed. Cursor position and other +state information is up-to-date when this happens. For interoperability, +the argument should start with the extension name (sans -osc) or some +other suitable prefix, and a semicolon, to distinguish it from commands +for other extensions. For example, C uses this: @@ -404,7 +461,7 @@ package urxvt; use utf8; -use strict 'vars'; +use strict qw(vars subs); use Carp (); use Scalar::Util (); use List::Util (); @@ -426,7 +483,7 @@ =head2 Variables in the C Package -=over 4 +=over =item $urxvt::LIBDIR @@ -466,7 +523,7 @@ =head2 Functions in the C Package -=over 4 +=over =item urxvt::fatal $errormessage @@ -521,6 +578,18 @@ Various constants for use in X calls and event processing. +=item urxvt::PrivMode_132, PrivMode_132OK, PrivMode_rVideo, PrivMode_relOrigin, +PrivMode_Screen, PrivMode_Autowrap, PrivMode_aplCUR, PrivMode_aplKP, +PrivMode_HaveBackSpace, PrivMode_BackSpace, PrivMode_ShiftKeys, +PrivMode_VisibleCursor, PrivMode_MouseX10, PrivMode_MouseX11, +PrivMode_scrollBar, PrivMode_TtyOutputInh, PrivMode_Keypress, +PrivMode_smoothScroll, PrivMode_vt52, PrivMode_LFNL, PrivMode_MouseBtnEvent, +PrivMode_MouseAnyEvent, PrivMode_BracketPaste, PrivMode_ExtMouseUTF8, +PrivMode_ExtMouseUrxvt, PrivMode_BlinkingCursor, PrivMode_mouse_report, +PrivMode_Default + +Constants for checking DEC private modes. + =back =head2 RENDITION @@ -533,7 +602,7 @@ as they contain important information required for correct operation of rxvt-unicode. -=over 4 +=over =item $rend = urxvt::DEFAULT_RSTYLE @@ -597,6 +666,8 @@ $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) { @@ -613,6 +684,8 @@ push @{ $term->{perl_ext_3} }, $v->[0]; + return 1 unless $isarg; + if ($v->[1] eq "boolean") { $term->put_option_db ($name, $flag ? "true" : "false"); return 1; @@ -654,7 +727,7 @@ } } -my $verbosity = $ENV{URXVT_PERL_VERBOSITY}; +my $verbosity = $ENV{URXVT_PERL_VERBOSITY} // 2; sub verbose { my ($level, $msg) = @_; @@ -681,7 +754,7 @@ 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"; @@ -701,8 +774,6 @@ my $htype = shift; if ($htype == HOOK_INIT) { - my @dirs = $TERM->perl_libdirs; - $TERM->scan_extensions; my %ext_arg; @@ -717,15 +788,13 @@ } 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), - map $_->[0], values %{ $TERM->{meta}{binding} }; + for qw(selection option-popup selection-popup readline searchable-scrollback confirm-paste); for ($TERM->_keysym_resources) { next if /^(?:string|command|builtin|builtin-string|perl)/; @@ -736,31 +805,31 @@ $ext_arg{$ext} = []; } - } elsif (/^-(.*)$/) { + } elsif (/^-(.*)$/) { # remove from set delete $ext_arg{$1}; - } elsif (/^([^<]+)<(.*)>$/) { - push @{ $ext_arg{$1} }, $2; + } elsif (/^\/(.*)$/) { # prohibit loading + undef $TERM->{ext_prohibit}{$1}; + + } elsif (/^([^<]+)(?:<(.*)>)?$/) { # add to set, clear prohibit status + delete $TERM->{ext_prohibit}{$1}; + push @{ $ext_arg{$1} }, defined $2 ? $2 : (); } else { - $ext_arg{$_} ||= []; + verbose 2, "cannot parse extension specification '$_', ignoring."; } } - # now register default key bindings - for my $ext (sort keys %ext_arg) { - while (my ($k, $v) = each %{ $TERM->{meta}{ext}{$ext}{binding} }) { - $TERM->bind_action ($k, "$v->[0]:$v->[1]"); - } - } + $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) { - $TERM->register_package (extension_package $files[0], $ext_arg{$ext}); + if (defined $path) { + $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"; } } @@ -768,6 +837,16 @@ warn $@ if $@; } + 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; + } + } + $retval = undef; if (my $cb = $TERM->{_hook}[$htype]) { @@ -855,7 +934,7 @@ objects, in addition to call methods documented for the class. -=over 4 +=over =item $urxvt_term = $self->{term} @@ -983,16 +1062,25 @@ bless \%disable, "urxvt::extension::on_disable" } +=item $self->bind_action ($hotkey, $action) + =item $self->x_resource ($pattern) =item $self->x_resource_boolean ($pattern) -These methods support an additional C<%> prefix when called on an -extension object - see the description of these methods in the -C class for details. +These methods support an additional C<%> prefix for C<$action> or +C<$pattern> when called on an extension object, compared to the +C methods of the same name - see the description of these +methods in the C class for details. =cut +sub bind_action { + my ($self, $hotkey, $action) = @_; + $action =~ s/^%:/$_[0]{_name}:/; + $self->{term}->bind_action ($hotkey, $action) +} + sub x_resource { my ($self, $name) = @_; $name =~ s/^%(\.|$)/$_[0]{_name}$1/; @@ -1097,7 +1185,7 @@ =head2 The C Class -=over 4 +=over =cut @@ -1106,6 +1194,8 @@ sub register_package { my ($self, $pkg, $argv) = @_; + return if $self->{_pkg}{$pkg}; + no strict 'refs'; urxvt::verbose 6, "register package $pkg to $self"; @@ -1126,6 +1216,35 @@ $proxy->enable ($name => $ref); } } + + if (my $attach_hook = $pkg->can ("on_attach")) { + $attach_hook->($proxy) + or urxvt::verbose 1, "$pkg->on_attach returned false, extension failed to attach"; + } +} + +# map extension name to filesystem 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 { @@ -1142,23 +1261,33 @@ return if exists $self->{meta}; - my @libdirs = perl_libdirs $self; - -# return if $self->{meta_libdirs} eq join "\x00", @libdirs;#d# + my @urxvtdirs = perl_libdirs $self; +# my @cpandirs = grep -d, map "$_/URxvt/Ext", @INC; -# $self->{meta_libdirs} = join "\x00", @libdirs;#d# - $self->{meta} = \my %meta; + $self->{meta} = \my %allmeta; # first gather extensions - for my $dir (reverse @libdirs) { + + my $gather = sub { + my ($dir, $core) = @_; + opendir my $fh, $dir - or next; + or return; + for my $ext (readdir $fh) { $ext !~ /^\./ - and open my $fh, "<", "$dir/$ext" or next; - my %ext = (dir => $dir); + open my $fh, "<", "$dir/$ext" + or next; + + -f $fh + or next; + + $ext =~ s/\.uext$// or $core + or next; + + my %meta = (dir => $dir); while (<$fh>) { if (/^#:META:(?:X_)?RESOURCE:(.*)/) { @@ -1167,27 +1296,37 @@ 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:BINDING:(.*)/) { - my ($keysym, $action) = split /:/, $1; - $ext{binding}{$keysym} = [$ext, $action]; + + } 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 - # and now merge resources and bindings - while (my ($k, $v) = each %{ $meta{ext} }) { + $allmeta{resource} = \my %resource; + + while (my ($k, $v) = each %{ $allmeta{ext} }) { #TODO: should check for extensions overriding each other - %{ $meta{resource} } = (%{ $meta{resource} }, %{ $v->{resource} }); - %{ $meta{binding} } = (%{ $meta{binding} }, %{ $v->{binding} }); + %resource = (%resource, %{ $v->{resource} }); } } @@ -1260,7 +1399,7 @@ 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]) @@ -1296,7 +1435,7 @@ scrollTtyKeypress scrollTtyOutput scrollWithBuffer scrollstyle secondaryScreen secondaryScroll shade skipBuiltinGlyphs skipScroll term_name title transient_for transparent tripleclickwords urgentOnBell - utmpInhibit visualBell + utmpInhibit visualBell rewrapMode disablePasteBrackets =cut @@ -1343,11 +1482,31 @@ $res =~ /^\s*(?:true|yes|on|1)\s*$/i ? 1 : defined $res && 0 } -=item $success = $term->bind_action ($key, $octets) +=item $action = $term->lookup_keysym ($keysym, $state) + +Returns the action bound to key combination C<($keysym, $state)>, +if a binding for it exists, and C otherwise. + +=item $success = $term->bind_action ($key, $action) Adds a key binding exactly as specified via a C resource. See the C resource in the urxvt(1) manpage. +To add default bindings for actions, an extension should call C<< +->bind_action >> in its C hook for every such binding. Doing it +in the C hook allows users to override or remove the binding +again. + +Example: the C by default binds itself +on C, using C<< $self->bind_action >>, which calls C<< +$term->bind_action >>. + + sub init { + my ($self) = @_; + + $self->bind_action ("M-s" => "%:start"); + } + =item $rend = $term->rstyle ([$new_rstyle]) Return and optionally change the current rendition. Text that is output by @@ -1433,7 +1592,7 @@ The methods currently supported on C objects are: -=over 4 +=over =item $overlay->set ($x, $y, $text[, $rend]) @@ -1487,11 +1646,13 @@ =item $octets = $term->locale_encode ($string) -Convert the given text string into the corresponding locale encoding. +Convert the given text string into the corresponding locale +encoding. Returns C if C<$string> is C. =item $string = $term->locale_decode ($octets) -Convert the given locale-encoded octets into a perl string. +Convert the given locale-encoded octets into a perl string. Returns +C if C<$octets> is C. =item $term->scr_xor_span ($beg_row, $beg_col, $end_row, $end_col[, $rstyle]) @@ -1514,8 +1675,9 @@ Write the given text string to the screen, as if output by the application running inside the terminal. It may not contain command sequences (escape -codes), but is free to use line feeds, carriage returns and tabs. The -string is a normal text string, not in locale-dependent encoding. +codes - see C for that), but is free to use line feeds, +carriage returns and tabs. The string is a normal text string, not in +locale-dependent encoding. Normally its not a good idea to use this function, as programs might be confused by changes in cursor position or scrolling. Its useful inside a @@ -1533,9 +1695,10 @@ =item $term->tt_write ($octets) -Write the octets given in C<$octets> to the tty (i.e. as program input). To -pass characters instead of octets, you should convert your strings first -to the locale-specific encoding using C<< $term->locale_encode >>. +Write the octets given in C<$octets> to the tty (i.e. as user input +to the program, see C for the opposite direction). To pass +characters instead of octets, you should convert your strings first to the +locale-specific encoding using C<< $term->locale_encode >>. =item $term->tt_write_user_input ($octets) @@ -1592,31 +1755,32 @@ Deliver various fake events to to terminal. -=item $window_width = $term->width +=item $window_width = $term->width ([$new_value]) -=item $window_height = $term->height +=item $window_height = $term->height ([$new_value]) -=item $font_width = $term->fwidth +=item $font_width = $term->fwidth ([$new_value]) -=item $font_height = $term->fheight +=item $font_height = $term->fheight ([$new_value]) -=item $font_ascent = $term->fbase +=item $font_ascent = $term->fbase ([$new_value]) -=item $terminal_rows = $term->nrow +=item $terminal_rows = $term->nrow ([$new_value]) -=item $terminal_columns = $term->ncol +=item $terminal_columns = $term->ncol ([$new_value]) -=item $has_focus = $term->focus +=item $has_focus = $term->focus ([$new_value]) -=item $is_mapped = $term->mapped +=item $is_mapped = $term->mapped ([$new_value]) -=item $max_scrollback = $term->saveLines +=item $max_scrollback = $term->saveLines ([$new_value]) -=item $nrow_plus_saveLines = $term->total_rows +=item $nrow_plus_saveLines = $term->total_rows ([$new_value]) -=item $topmost_scrollback_row = $term->top_row +=item $topmost_scrollback_row = $term->top_row ([$new_value]) -Return various integers describing terminal characteristics. +Return various integers describing terminal characteristics. If an +argument is given, changes the value and returns the previous one. =item $x_display = $term->display_id @@ -1663,11 +1827,22 @@ Returns whether the cursor is currently hidden or not. +=item $priv_modes = $term->priv_modes + +Returns a bitset with the state of DEC private modes. + +Example: + + if ($term->priv_modes & urxvt::PrivMode_mouse_report) { + # mouse reporting is turned on + } + =item $view_start = $term->view_start ([$newvalue]) -Returns the row number of the topmost displayed line. Maximum value is -C<0>, which displays the normal terminal contents. Lower values scroll -this many lines into the scrollback buffer. +Returns the row number of the topmost displayed line and changes it, +if an argument is given. Values greater than or equal to C<0> display +the terminal contents. Lower values scroll this many lines into the +scrollback buffer. =item $term->want_refresh @@ -1677,6 +1852,10 @@ Used after changing terminal contents to display them. +=item $term->refresh_check + +Checks if a refresh has been requested and, if so, schedules one. + =item $text = $term->ROW_t ($row_number[, $new_text[, $start_col]]) Returns the text of the entire row with number C<$row_number>. Row C<< $term->top_row >> @@ -1731,7 +1910,7 @@ 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]) @@ -1845,7 +2024,7 @@ =item $string = $term->special_decode $text -Converts rxvt-unicodes text representation into a perl string. See +Converts rxvt-unicode's text representation into a perl string. See C<< $term->ROW_t >> for details. =item $success = $term->grab_button ($button, $modifiermask[, $window = $term->vt]) @@ -1921,7 +2100,7 @@ =head2 The C Class -=over 4 +=over =cut @@ -2067,7 +2246,7 @@ sprintf "%2d:%02d:%02d", (localtime urxvt::NOW)[2,1,0]); }); -=over 4 +=over =item $timer = new urxvt::timer @@ -2126,7 +2305,7 @@ }); -=over 4 +=over =item $iow = new urxvt::iow @@ -2163,7 +2342,7 @@ the process is idle. They should return as fast as possible, after doing some useful work. -=over 4 +=over =item $iw = new urxvt::iw @@ -2198,7 +2377,7 @@ ... }); -=over 4 +=over =item $pw = new urxvt::pw @@ -2225,9 +2404,11 @@ This variable controls the verbosity level of the perl extension. Higher numbers indicate more verbose output. -=over 4 +=over + +=item == 0 - fatal messages only -=item == 0 - fatal messages +=item >= 2 - general warnings (default level) =item >= 3 - script loading and management