diff options
| -rw-r--r-- | src/urxvt.pm | 2305 |
1 files changed, 2305 insertions, 0 deletions
diff --git a/src/urxvt.pm b/src/urxvt.pm new file mode 100644 index 0000000..816317d --- /dev/null +++ b/src/urxvt.pm @@ -0,0 +1,2305 @@ +=encoding utf8 + +=head1 NAME + +urxvtperl - rxvt-unicode's embedded perl interpreter + +=head1 SYNOPSIS + + # create a file grab_test in $HOME: + + sub on_sel_grab { + warn "you selected ", $_[0]->selection; + () + } + + # start a urxvt using it: + + urxvt --perl-lib $HOME -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 +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" +and "perl-ext-common" resources to the empty string. + +=head1 PREPACKAGED EXTENSIONS + +A number of extensions are delivered with this release. You can find them +in F<< <libdir>/urxvt/perl/ >>, and the documentation can be viewed using +F<< man urxvt-<EXTENSIONNAME> >>. + +You can activate them like this: + + urxvt -pe <extensionname> + +Or by adding them to the resource for extensions loaded by default: + + URxvt.perl-ext-common: default,selection-autotransform + +Extensions may add additional resources and C<actions>, i.e., methods +which can be bound to a key and invoked by the user. An extension can +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<must> define META +comments for its resources. + +=head1 API DOCUMENTATION + +=head2 General API Considerations + +All objects (such as terminals, time watchers etc.) are typical +reference-to-hash objects. The hash can be used to store anything you +like. All members starting with an underscore (such as C<_ptr> or +C<_hook>) are reserved for internal uses and B<MUST NOT> be accessed or +modified). + +When objects are destroyed on the C++ side, the perl object hashes are +emptied, so its best to store related objects such as time watchers and +the like inside the terminal object so they get destroyed as soon as the +terminal is destroyed. + +Argument names also often indicate the type of a parameter. Here are some +hints on what they mean: + +=over 4 + +=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. + +=item $string + +A perl text string, with an emphasis on I<text>. It can store all unicode +characters and is to be distinguished with text encoded in a specific +encoding (often locale-specific) and binary data. + +=item $octets + +Either binary data or - more common - a text string encoded in a +locale-specific way. + +=item $keysym + +an integer that is a valid X11 keysym code. You can convert a string +into a keysym and viceversa by using C<XStringToKeysym> and +C<XKeysymToString>. + +=back + +=head2 Extension Objects + +Every perl extension is a perl class. A separate perl object is created +for each terminal, and each terminal has its own set of extension objects, +which are passed as the first parameter to hooks. So extensions can use +their C<$self> object without having to think about clashes with other +extensions or other terminals, with the exception of methods and members +that begin with an underscore character C<_>: these are reserved for +internal use. + +Although it isn't a C<urxvt::term> object, you can call all methods of the +C<urxvt::term> class on this object. + +Additional methods only supported for extension objects are described in +the C<urxvt::extension> section below. + +=head2 META comments + +Rxvt-unicode recognizes special meta comments in extensions that define +different types of metadata. + +Currently, it recognises only one such comment: + +=over 4 + +=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. + +=back + +=head2 Hooks + +The following subroutines can be declared in extension files, and will be +called whenever the relevant event happens. + +The first argument passed to them is an extension object as described in +the in the C<Extension Objects> section. + +B<All> of these hooks must return a boolean value. If any of the called +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 + +=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 +call or deliver senseless data, as terminal size and other characteristics +have not yet been determined. You can safely query and change resources +and options, though. For many purposes the C<on_start> hook is a better +place. + +=item on_start $term + +Called at the very end of initialisation of a new terminal, just before +trying to map (display) the toplevel and returning to the main loop. + +=item on_destroy $term + +Called whenever something tries to destroy terminal, when the terminal is +still fully functional (not for long, though). + +=item on_reset $term + +Called after the screen is "reset" for any reason, such as resizing or +control sequences. Here is where you can react on changes to size-related +variables. + +=item on_child_start $term, $pid + +Called just after the child process has been C<fork>ed. + +=item on_child_exit $term, $status + +Called just after the child process has exited. C<$status> is the status +from C<waitpid>. + +=item on_sel_make $term, $eventtime + +Called whenever a selection has been made by the user, but before the +selection text is copied, so changes to the beginning, end or type of the +selection will be honored. + +Returning a true value aborts selection making by urxvt, in which case you +have to make a selection yourself by calling C<< $term->selection_grab >>. + +=item on_sel_grab $term, $eventtime + +Called whenever a selection has been copied, but before the selection is +requested from the server. The selection text can be queried and changed +by calling C<< $term->selection >>. + +Returning a true value aborts selection grabbing. It will still be highlighted. + +=item on_sel_extend $term + +Called whenever the user tries to extend the selection (e.g. with a double +click) and is either supposed to return false (normal operation), or +should extend the selection itself and return true to suppress the built-in +processing. This can happen multiple times, as long as the callback +returns true, it will be called on every further click by the user and is +supposed to enlarge the selection more and more, if possible. + +See the F<selection> example extension. + +=item on_view_change $term, $offset + +Called whenever the view offset changes, i.e. the user or program +scrolls. Offset C<0> means display the normal terminal, positive values +show this many lines of scrollback. + +=item on_scroll_back $term, $lines, $saved + +Called whenever lines scroll out of the terminal area into the scrollback +buffer. C<$lines> is the number of lines scrolled out and may be larger +than the scroll back buffer or the terminal. + +It is called before lines are scrolled out (so rows 0 .. min ($lines - 1, +$nrow - 1) represent the lines to be scrolled out). C<$saved> is the total +number of lines that will be in the scrollback buffer. + +=item on_osc_seq $term, $op, $args, $resp + +Called on every OSC sequence and can be used to suppress it or modify its +behaviour. The default should be to return an empty list. A true value +suppresses execution of the request completely. Make sure you don't get +confused by recursive invocations when you output an OSC sequence within +this callback. + +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 = +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. + +For example, C<overlay-osc> uses this: + + sub on_osc_seq_perl { + my ($self, $osc, $resp) = @_; + + return unless $osc =~ s/^overlay;//; + + ... process remaining $osc string + } + +Be careful not ever to trust (in a security sense) the data you receive, +as its source can not easily be controlled (e-mail content, messages from +other users on the same system etc.). + +For responses, C<$resp> contains the end-of-args separator used by the +sender. + +=item on_add_lines $term, $string + +Called whenever text is about to be output, with the text as argument. You +can filter/change and output the text yourself by returning a true value +and calling C<< $term->scr_add_lines >> yourself. Please note that this +might be very slow, however, as your hook is called for B<all> text being +output. + +=item on_tt_write $term, $octets + +Called whenever some data is written to the tty/pty and can be used to +suppress or filter tty input. + +=item on_tt_paste $term, $octets + +Called whenever text is about to be pasted, with the text as argument. You +can filter/change and paste the text yourself by returning a true value +and calling C<< $term->tt_paste >> yourself. C<$octets> is +locale-encoded. + +=item on_line_update $term, $row + +Called whenever a line was updated or changed. Can be used to filter +screen output (e.g. underline urls or other useless stuff). Only lines +that are being shown will be filtered, and, due to performance reasons, +not always immediately. + +The row number is always the topmost row of the line if the line spans +multiple rows. + +Please note that, if you change the line, then the hook might get called +later with the already-modified line (e.g. if unrelated parts change), so +you cannot just toggle rendition bits, but only set them. + +=item on_refresh_begin $term + +Called just before the screen gets redrawn. Can be used for overlay or +similar effects by modifying the terminal contents in refresh_begin, and +restoring them in refresh_end. The built-in overlay and selection display +code is run after this hook, and takes precedence. + +=item on_refresh_end $term + +Called just after the screen gets redrawn. See C<on_refresh_begin>. + +=item on_action $term, $string + +Called whenever an action is invoked for the corresponding extension +(e.g. via a C<extension:string> builtin action bound to a key, see +description of the B<keysym> resource in the urxvt(1) manpage). The +event is simply the action string. Note that an action event is always +associated to a single extension. + +=item on_user_command $term, $string *DEPRECATED* + +Called whenever a user-configured event is being activated (e.g. via +a C<perl:string> action bound to a key, see description of the B<keysym> +resource in the urxvt(1) manpage). + +The event is simply the action string. This interface is going away in +preference to the C<on_action> hook. + +=item on_resize_all_windows $term, $new_width, $new_height + +Called just after the new window size has been calculated, but before +windows are actually being resized or hints are being set. If this hook +returns a true value, setting of the window hints is being skipped. + +=item on_x_event $term, $event + +Called on every X event received on the vt window (and possibly other +windows). Should only be used as a last resort. Most event structure +members are not passed. + +=item on_root_event $term, $event + +Like C<on_x_event>, but is called for events on the root window. + +=item on_focus_in $term + +Called whenever the window gets the keyboard focus, before rxvt-unicode +does focus in processing. + +=item on_focus_out $term + +Called whenever the window loses keyboard focus, before rxvt-unicode does +focus out processing. + +=item on_configure_notify $term, $event + +=item on_property_notify $term, $event + +=item on_key_press $term, $event, $keysym, $octets + +=item on_key_release $term, $event, $keysym + +=item on_button_press $term, $event + +=item on_button_release $term, $event + +=item on_motion_notify $term, $event + +=item on_map_notify $term, $event + +=item on_unmap_notify $term, $event + +Called whenever the corresponding X event is received for the terminal. If +the hook returns true, then the event will be ignored by rxvt-unicode. + +The event is a hash with most values as named by Xlib (see the XEvent +manpage), with the additional members C<row> and C<col>, which are the +(real, not screen-based) row and column under the mouse cursor. + +C<on_key_press> additionally receives the string rxvt-unicode would +output, if any, in locale-specific encoding. + +=item on_client_message $term, $event + +=item on_wm_protocols $term, $event + +=item on_wm_delete_window $term, $event + +Called when various types of ClientMessage events are received (all with +format=32, WM_PROTOCOLS or WM_PROTOCOLS:WM_DELETE_WINDOW). + +=item on_bell $term + +Called on receipt of a bell character. + +=back + +=cut + +package urxvt; + +use utf8; +use strict 'vars'; +use Carp (); +use Scalar::Util (); +use List::Util (); + +our $VERSION = 1; +our $TERM; +our @TERM_INIT; # should go, prevents async I/O etc. +our @TERM_EXT; # should go, prevents async I/O etc. +our @HOOKNAME; +our %HOOKTYPE = map +($HOOKNAME[$_] => $_), 0..$#HOOKNAME; +our %OPTION; + +our $LIBDIR; +our $RESNAME; +our $RESCLASS; +our $RXVTNAME; + +our $NOCHAR = chr 0xffff; + +=head2 Variables in the C<urxvt> Package + +=over 4 + +=item $urxvt::LIBDIR + +The rxvt-unicode library directory, where, among other things, the perl +modules and scripts are stored. + +=item $urxvt::RESCLASS, $urxvt::RESCLASS + +The resource class and name rxvt-unicode uses to look up X resources. + +=item $urxvt::RXVTNAME + +The basename of the installed binaries, usually C<urxvt>. + +=item $urxvt::TERM + +The current terminal. This variable stores the current C<urxvt::term> +object, whenever a callback/hook is executing. + +=item @urxvt::TERM_INIT + +All code references in this array will be called as methods of the next newly +created C<urxvt::term> object (during the C<on_init> phase). The array +gets cleared before the code references that were in it are being executed, +so references can push themselves onto it again if they so desire. + +This complements to the perl-eval command line option, but gets executed +first. + +=item @urxvt::TERM_EXT + +Works similar to C<@TERM_INIT>, but contains perl package/class names, which +get registered as normal extensions after calling the hooks in C<@TERM_INIT> +but before other extensions. Gets cleared just like C<@TERM_INIT>. + +=back + +=head2 Functions in the C<urxvt> Package + +=over 4 + +=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 +is acceptable (and useful) is in the init hook, where it prevents the +terminal from starting up. + +=item urxvt::warn $string + +Calls C<rxvt_warn> with the given string which should include a trailing +newline. The module also overwrites the C<warn> builtin with a function +that calls this function. + +Using this function has the advantage that its output ends up in the +correct place, e.g. on stderr of the connecting urxvtc client. + +Messages have a size limit of 1023 bytes currently. + +=item @terms = urxvt::termlist + +Returns all urxvt::term objects that exist in this process, regardless of +whether they are started, being destroyed etc., so be careful. Only term +objects that have perl extensions attached will be returned (because there +is no urxvt::term object associated with others). + +=item $time = urxvt::NOW + +Returns the "current time" (as per the event loop). + +=item urxvt::CurrentTime + +=item urxvt::ShiftMask, LockMask, ControlMask, Mod1Mask, Mod2Mask, +Mod3Mask, Mod4Mask, Mod5Mask, Button1Mask, Button2Mask, Button3Mask, +Button4Mask, Button5Mask, AnyModifier + +=item urxvt::NoEventMask, KeyPressMask, KeyReleaseMask, +ButtonPressMask, ButtonReleaseMask, EnterWindowMask, LeaveWindowMask, +PointerMotionMask, PointerMotionHintMask, Button1MotionMask, Button2MotionMask, +Button3MotionMask, Button4MotionMask, Button5MotionMask, ButtonMotionMask, +KeymapStateMask, ExposureMask, VisibilityChangeMask, StructureNotifyMask, +ResizeRedirectMask, SubstructureNotifyMask, SubstructureRedirectMask, +FocusChangeMask, PropertyChangeMask, ColormapChangeMask, OwnerGrabButtonMask + +=item urxvt::KeyPress, KeyRelease, ButtonPress, ButtonRelease, MotionNotify, +EnterNotify, LeaveNotify, FocusIn, FocusOut, KeymapNotify, Expose, +GraphicsExpose, NoExpose, VisibilityNotify, CreateNotify, DestroyNotify, +UnmapNotify, MapNotify, MapRequest, ReparentNotify, ConfigureNotify, +ConfigureRequest, GravityNotify, ResizeRequest, CirculateNotify, +CirculateRequest, PropertyNotify, SelectionClear, SelectionRequest, +SelectionNotify, ColormapNotify, ClientMessage, MappingNotify + +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_ExtModeMouse, +PrivMode_ExtMouseRight, PrivMode_BlinkingCursor, PrivMode_mouse_report, +PrivMode_Default + +Constants for checking DEC private modes. + +=back + +=head2 RENDITION + +Rendition bitsets contain information about colour, font, font styles and +similar information for each screen cell. + +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 + +=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. + +=item $rend = urxvt::OVERLAY_RSTYLE + +Return the rendition mask used for overlays by default. + +=item $rendbit = urxvt::RS_Bold, urxvt::RS_Italic, urxvt::RS_Blink, +urxvt::RS_RVid, urxvt::RS_Uline + +Return the bit that enabled bold, italic, blink, reverse-video and +underline, respectively. To enable such a style, just logically OR it into +the bitset. + +=item $foreground = urxvt::GET_BASEFG $rend + +=item $background = urxvt::GET_BASEBG $rend + +Return the foreground/background colour index, respectively. + +=item $rend = urxvt::SET_FGCOLOR $rend, $new_colour + +=item $rend = urxvt::SET_BGCOLOR $rend, $new_colour + +=item $rend = urxvt::SET_COLOR $rend, $new_fg, $new_bg + +Replace the foreground/background colour in the rendition mask with the +specified one. + +=item $value = urxvt::GET_CUSTOM $rend + +Return the "custom" value: Every rendition has 5 bits for use by +extensions. They can be set and changed as you like and are initially +zero. + +=item $rend = urxvt::SET_CUSTOM $rend, $new_value + +Change the custom value. + +=back + +=cut + +BEGIN { + # overwrite perl's warn + *CORE::GLOBAL::warn = sub { + my $msg = join "", @_; + $msg .= "\n" + unless $msg =~ /\n$/; + urxvt::warn ($msg); + }; +} + +no warnings 'utf8'; + +sub parse_resource { + my ($term, $name, $isarg, $longopt, $flag, $value) = @_; + + $term->scan_extensions; + + my $r = $term->{meta}{resource}; + keys %$r; # reset iterator + while (my ($k, $v) = each %$r) { + my $pattern = $k; + $pattern =~ y/./-/ if $isarg; + my $prefix = $name; + my $suffix; + if ($pattern =~ /\-$/) { + $prefix = substr $name, 0, length $pattern; + $suffix = substr $name, length $pattern; + } + if ($pattern eq $prefix) { + $name = "$urxvt::RESCLASS.$k$suffix"; + + 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; + } else { + $term->put_option_db ($name, $value); + return 1 + 2; + } + } + } + + 0 +} + +sub usage { + my ($term, $usage_type) = @_; + + $term->scan_extensions; + + my $r = $term->{meta}{resource}; + + for my $pattern (sort keys %$r) { + my ($ext, $type, $desc) = @{ $r->{$pattern} }; + + $desc .= " (-pe $ext)"; + + if ($usage_type == 1) { + $pattern =~ y/./-/; + $pattern =~ s/-$/-.../g; + + if ($type eq "boolean") { + urxvt::log sprintf " -%-30s %s\n", "/+$pattern", $desc; + } else { + urxvt::log sprintf " -%-30s %s\n", "$pattern $type", $desc; + } + } else { + $pattern =~ s/\.$/.*/g; + urxvt::log sprintf " %-31s %s\n", "$pattern:", $type; + } + } +} + +my $verbosity = $ENV{URXVT_PERL_VERBOSITY}; + +sub verbose { + my ($level, $msg) = @_; + warn "$msg\n" if $level <= $verbosity; +} + +my %extension_pkg; + +# load a single script into its own package, once only +sub extension_package($) { + my ($path) = @_; + + $extension_pkg{$path} ||= do { + $path =~ /([^\/\\]+)$/; + my $pkg = $1; + $pkg =~ s/[^[:word:]]/_/g; + $pkg = "urxvt::ext::$pkg"; + + verbose 3, "loading extension '$path' into package '$pkg'"; + + (${"$pkg\::_NAME"} = $path) =~ s/^.*[\\\/]//; # hackish + + open my $fh, "<:raw", $path + or die "$path: $!"; + + my $source = + "package $pkg; use strict 'vars'; use utf8; no warnings 'utf8';\n" + . "#line 1 \"$path\"\n{\n" + . (do { local $/; <$fh> }) + . "\n};\n1"; + + eval $source + or die "$path: $@"; + + $pkg + } +} + +our $retval; # return value for urxvt + +# called by the rxvt core +sub invoke { + local $TERM = shift; + my $htype = shift; + + if ($htype == HOOK_INIT) { + my @dirs = $TERM->perl_libdirs; + + $TERM->scan_extensions; + + my %ext_arg; + + { + my @init = @TERM_INIT; + @TERM_INIT = (); + $_->($TERM) for @init; + my @pkg = @TERM_EXT; + @TERM_EXT = (); + $TERM->register_package ($_) for @pkg; + } + + for ( + (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 ($TERM->_keysym_resources) { + next if /^(?:string|command|builtin|builtin-string|perl)/; + next unless /^([A-Za-z0-9_\-]+):/; + + my $ext = $1; + + $ext_arg{$ext} = []; + } + + } elsif (/^-(.*)$/) { + delete $ext_arg{$1}; + + } elsif (/^([^<]+)<(.*)>$/) { + push @{ $ext_arg{$1} }, $2; + + } else { + $ext_arg{$_} ||= []; + } + } + + for my $ext (sort keys %ext_arg) { + my @files = grep -f $_, map "$_/$ext", @dirs; + + if (@files) { + $TERM->register_package (extension_package $files[0], $ext_arg{$ext}); + } else { + warn "perl extension '$ext' not found in perl library search path\n"; + } + } + + eval "#line 1 \"--perl-eval resource/argument\"\n" . $TERM->resource ("perl_eval"); + warn $@ if $@; + } + + $retval = undef; + + if (my $cb = $TERM->{_hook}[$htype]) { + verbose 10, "$HOOKNAME[$htype] (" . (join ", ", $TERM, @_) . ")" + if $verbosity >= 10; + + if ($htype == HOOK_ACTION) { + # this hook is only sent to the extension with the name + # matching the first arg + my $pkg = shift; + $pkg =~ y/-/_/; + $pkg = "urxvt::ext::$pkg"; + + $cb = $cb->{$pkg} + or return undef; #TODO: maybe warn user? + + $cb = { $pkg => $cb }; + } + + for my $pkg (keys %$cb) { + my $retval_ = eval { $cb->{$pkg}->($TERM->{_pkg}{$pkg} || $TERM, @_) }; + $retval ||= $retval_; + + if ($@) { + $TERM->ungrab; # better to lose the grab than the session + warn $@; + } + } + + verbose 11, "$HOOKNAME[$htype] returning <$retval>" + if $verbosity >= 11; + } + + if ($htype == HOOK_DESTROY) { + # clear package objects + %$_ = () for values %{ $TERM->{_pkg} }; + + # clear package + %$TERM = (); + } + + $retval +} + +sub SET_COLOR($$$) { + SET_BGCOLOR (SET_FGCOLOR ($_[0], $_[1]), $_[2]) +} + +sub rend2mask { + no strict 'refs'; + my ($str, $mask) = (@_, 0); + my %color = ( fg => undef, bg => undef ); + my @failed; + for my $spec ( split /\s+/, $str ) { + if ( $spec =~ /^([fb]g)[_:-]?(\d+)/i ) { + $color{lc($1)} = $2; + } else { + my $neg = $spec =~ s/^[-^]//; + unless ( exists &{"RS_$spec"} ) { + push @failed, $spec; + next; + } + my $cur = &{"RS_$spec"}; + if ( $neg ) { + $mask &= ~$cur; + } else { + $mask |= $cur; + } + } + } + ($mask, @color{qw(fg bg)}, \@failed) +} + +package urxvt::term::extension; + +=head2 The C<urxvt::term::extension> class + +Each extension attached to a terminal object is represented by +a C<urxvt::term::extension> object. + +You can use these objects, which are passed to all callbacks to store any +state related to the terminal and extension instance. + +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 + +=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. + +=cut + +our $AUTOLOAD; + +sub AUTOLOAD { + $AUTOLOAD =~ /:([^:]+)$/ + or die "FATAL: \$AUTOLOAD '$AUTOLOAD' unparsable"; + + eval qq{ + sub $AUTOLOAD { + my \$proxy = shift; + \$proxy->{term}->$1 (\@_) + } + 1 + } or die "FATAL: unable to compile method forwarder: $@"; + + goto &$AUTOLOAD; +} + +sub DESTROY { + # nop +} + +# urxvt::destroy_hook (basically a cheap Guard:: implementation) + +sub urxvt::destroy_hook::DESTROY { + ${$_[0]}->(); +} + +sub urxvt::destroy_hook(&) { + bless \shift, urxvt::destroy_hook:: +} + +=item $self->enable ($hook_name => $cb[, $hook_name => $cb..]) + +Dynamically enable the given hooks (named without the C<on_> prefix) for +this extension, replacing any hook previously installed via C<enable> in +this extension. + +This is useful when you want to overwrite time-critical hooks only +temporarily. + +To install additional callbacks for the same hook, you can use the C<on> +method of the C<urxvt::term> class. + +=item $self->disable ($hook_name[, $hook_name..]) + +Dynamically disable the given hooks. + +=cut + +sub enable { + my ($self, %hook) = @_; + my $pkg = $self->{_pkg}; + + while (my ($name, $cb) = each %hook) { + my $htype = $HOOKTYPE{uc $name}; + defined $htype + or Carp::croak "unsupported hook type '$name'"; + + $self->set_should_invoke ($htype, +1) + unless exists $self->{term}{_hook}[$htype]{$pkg}; + + $self->{term}{_hook}[$htype]{$pkg} = $cb; + } +} + +sub disable { + my ($self, @hook) = @_; + my $pkg = $self->{_pkg}; + + for my $name (@hook) { + my $htype = $HOOKTYPE{uc $name}; + defined $htype + or Carp::croak "unsupported hook type '$name'"; + + $self->set_should_invoke ($htype, -1) + if delete $self->{term}{_hook}[$htype]{$pkg}; + } +} + +=item $guard = $self->on ($hook_name => $cb[, $hook_name => $cb..]) + +Similar to the C<enable> enable, but installs additional callbacks for +the given hook(s) (that is, it doesn't replace existing callbacks), and +returns a guard object. When the guard object is destroyed the callbacks +are disabled again. + +=cut + +sub urxvt::extension::on_disable::DESTROY { + my $disable = shift; + + my $term = delete $disable->{""}; + + while (my ($htype, $id) = each %$disable) { + delete $term->{_hook}[$htype]{$id}; + $term->set_should_invoke ($htype, -1); + } +} + +sub on { + my ($self, %hook) = @_; + + my $term = $self->{term}; + + my %disable = ( "" => $term ); + + while (my ($name, $cb) = each %hook) { + my $htype = $HOOKTYPE{uc $name}; + defined $htype + or Carp::croak "unsupported hook type '$name'"; + + $term->set_should_invoke ($htype, +1); + $term->{_hook}[$htype]{ $disable{$htype} = $cb+0 } + = sub { shift; $cb->($self, @_) }; # very ugly indeed + } + + 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 for C<$action> or +C<$pattern> when called on an extension object, compared to the +C<urxvt::term> methods of the same name - see the description of these +methods in the C<urxvt::term> 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/; + $self->{term}->x_resource ($name) +} + +sub x_resource_boolean { + my ($self, $name) = @_; + $name =~ s/^%(\.|$)/$_[0]{_name}$1/; + $self->{term}->x_resource_boolean ($name) +} + +=back + +=cut + +package urxvt::anyevent; + +=head2 The C<urxvt::anyevent> Class + +The sole purpose of this class is to deliver an interface to the +C<AnyEvent> module - any module using it will work inside urxvt without +further programming. The only exception is that you cannot wait on +condition variables, but non-blocking condvar use is ok. + +In practical terms this means is that you cannot use blocking APIs, but +the non-blocking variant should work. + +=cut + +our $VERSION = '5.23'; + +$INC{"urxvt/anyevent.pm"} = 1; # mark us as there +push @AnyEvent::REGISTRY, [urxvt => urxvt::anyevent::]; + +sub timer { + my ($class, %arg) = @_; + + my $cb = $arg{cb}; + + urxvt::timer + ->new + ->after ($arg{after}, $arg{interval}) + ->cb ($arg{interval} ? $cb : sub { + $_[0]->stop; # need to cancel manually + $cb->(); + }) +} + +sub io { + my ($class, %arg) = @_; + + my $cb = $arg{cb}; + my $fd = fileno $arg{fh}; + defined $fd or $fd = $arg{fh}; + + bless [$arg{fh}, urxvt::iow + ->new + ->fd ($fd) + ->events (($arg{poll} =~ /r/ ? 1 : 0) + | ($arg{poll} =~ /w/ ? 2 : 0)) + ->start + ->cb ($cb) + ], urxvt::anyevent:: +} + +sub idle { + my ($class, %arg) = @_; + + my $cb = $arg{cb}; + + urxvt::iw + ->new + ->start + ->cb ($cb) +} + +sub child { + my ($class, %arg) = @_; + + my $cb = $arg{cb}; + + urxvt::pw + ->new + ->start ($arg{pid}) + ->cb (sub { + $_[0]->stop; # need to cancel manually + $cb->($_[0]->rpid, $_[0]->rstatus); + }) +} + +sub DESTROY { + $_[0][1]->stop; +} + +# only needed for AnyEvent < 6 compatibility +sub one_event { + Carp::croak "AnyEvent->one_event blocking wait unsupported in urxvt, use a non-blocking API"; +} + +package urxvt::term; + +=head2 The C<urxvt::term> Class + +=over 4 + +=cut + +# find on_xxx subs in the package and register them +# as hooks +sub register_package { + my ($self, $pkg, $argv) = @_; + + no strict 'refs'; + + urxvt::verbose 6, "register package $pkg to $self"; + + @{"$pkg\::ISA"} = urxvt::term::extension::; + + my $proxy = bless { + _pkg => $pkg, + _name => ${"$pkg\::_NAME"}, # hackish + argv => $argv, + }, $pkg; + Scalar::Util::weaken ($proxy->{term} = $self); + + $self->{_pkg}{$pkg} = $proxy; + + for my $name (@HOOKNAME) { + if (my $ref = $pkg->can ("on_" . lc $name)) { + $proxy->enable ($name => $ref); + } + } +} + +sub perl_libdirs { + map { split /:/ } + $_[0]->resource ("perl_lib"), + $ENV{URXVT_PERL_LIB}, + "$ENV{HOME}/.urxvt/ext", + "$LIBDIR/perl" +} + +# scan for available extensions and collect their metadata +sub scan_extensions { + my ($self) = @_; + + return if exists $self->{meta}; + + my @urxvtdirs = perl_libdirs $self; +# my @cpandirs = grep -d, map "$_/URxvt/Ext", @INC; + + $self->{meta} = \my %meta; + + # first gather extensions + + my $gather = sub { + my ($dir, $core) = @_; + + opendir my $fh, $dir + or return; |