--- rxvt-unicode/src/urxvt.pm 2006/01/03 02:42:17 1.19 +++ rxvt-unicode/src/urxvt.pm 2014/10/10 14:38:02 1.241 @@ -2,7 +2,7 @@ =head1 NAME -@@RXVT_NAME@@perl - rxvt-unicode's embedded perl interpreter +urxvtperl - rxvt-unicode's embedded perl interpreter =head1 SYNOPSIS @@ -13,88 +13,135 @@ () } - # start a @@RXVT_NAME@@ using it: + # start a urxvt using it: - @@RXVT_NAME@@ --perl-lib $HOME -pe grab_test + urxvt --perl-lib $HOME -pe grab_test =head1 DESCRIPTION -Everytime a terminal object gets created, scripts specified via the -C resource are loaded and associated with it. +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' and 'use utf8' environment, and +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 @@RXVT_NAME@@d, where +Each script will only ever be loaded once, even in urxvtd, where scripts will be shared (but not enabled) for all terminals. -=head2 Prepackaged Extensions +You can disable the embedded perl interpreter by setting both "perl-ext" +and "perl-ext-common" resources to the empty string. -This section describes the extensiosn delivered with this version. You can -find them in F<@@RXVT_LIBDIR@@/urxvt/perl/>. +=head1 PREPACKAGED EXTENSIONS + +A number of extensions are delivered with this release. You can find them +in F<< /urxvt/perl/ >>, and the documentation can be viewed using +F<< man urxvt- >>. You can activate them like this: - @@RXVT_NAME@@ -pe + urxvt -pe -=over 4 +Or by adding them to the resource for extensions loaded by default: + + URxvt.perl-ext-common: default,selection-autotransform + +Extensions that add command line parameters or resources on their own are +loaded automatically when used. + +=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 be accessed or +modified). -=item selection +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. -Miscellaneous selection modifications. +Argument names also often indicate the type of a parameter. Here are some +hints on what they mean: =over 4 -=item rot13 +=item $text -Rot-13 the selection when activated. Used via keyboard trigger: +Rxvt-unicode's special way of encoding text, where one "unicode" character +always represents one screen cell. See L for a discussion of this format. - URxvt.keysym.C-M-r: perl:selection:rot13 +=item $string -=back +A perl text string, with an emphasis on I. 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 digital-clock +=item $octets -Displays a very simple digital clock in the upper right corner of the -window. Illustrates overwriting the refresh callbacks to create your own -overlays or changes. +Either binary data or - more common - a text string encoded in a +locale-specific way. -=item simple-overlay-clock +=item $keysym -Displays a digital clock using the built-in overlay (colourful, useless). +an integer that is a valid X11 keysym code. You can convert a string +into a keysym and viceversa by using C and +C. =back -=head2 General API Considerations +=head2 Extension Objects -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 must not be accessed or -modified). +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. -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. +Although it isn't a C object, you can call all methods of the +C class on this object. + +Additional methods only supported for extension objects are described in +the C section below. =head2 Hooks -The following subroutines can be declared in loaded scripts, and will be called -whenever the relevant event happens. +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 section. -All of them must return a boolean value. If it is true, then the event -counts as being I, and the invocation of other hooks is skipped, -and the relevant action might not be carried out by the C++ code. +B of these hooks must return a boolean value. If any of the called +hooks returns true, then the event counts as being I, and the +relevant action might not be carried out by the C++ code. -When in doubt, return a false value (preferably C<()>). +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. +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 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 @@ -102,10 +149,14 @@ control sequences. Here is where you can react on changes to size-related variables. -=item on_start $term +=item on_child_start $term, $pid -Called at the very end of initialisation of a new terminal, just before -returning to the mainloop. +Called just after the child process has been Ced. + +=item on_child_exit $term, $status + +Called just after the child process has exited. C<$status> is the status +from C. =item on_sel_make $term, $eventtime @@ -122,21 +173,22 @@ 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 hilighted. +Returning a true value aborts selection grabbing. It will still be highlighted. -=item on_focus_in $term +=item on_sel_extend $term -Called whenever the window gets the keyboard focus, before urxvt does -focus in processing. +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. -=item on_focus_out $term - -Called wheneever the window loses keyboard focus, before urxvt does focus -out processing. +See the F example extension. =item on_view_change $term, $offset -Called whenever the view offset changes, i..e the user or program +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. @@ -150,14 +202,80 @@ $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_tty_activity $term *NYI* +=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 should be used for new behaviour. + +=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. + +For example, C 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 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. -Called whenever the program(s) running in the urxvt window send output. +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 modify terminal contents in refresh_begin, and +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. @@ -165,11 +283,146 @@ Called just after the screen gets redrawn. See C. -=item on_keyboard_command $term, $string +=item on_user_command $term, $string *DEPRECATED* + +Called whenever a user-configured event is being activated (e.g. via +a C action bound to a key, see description of the B +resource in the urxvt(1) manpage). + +The event is simply the action string. This interface is going away in +preference to the C 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, 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 -Called whenever the user presses a key combination that has a -C action bound to it (see description of the B -resource in the @@RXVT_NAME@@(1) manpage). +=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 and C, which are the +(real, not screen-based) row and column under the mouse cursor. + +C 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 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. + +=item $urxvt::TERM + +The current terminal. This variable stores the current C +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 object (during the C 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 @@ -179,23 +432,59 @@ =item urxvt::fatal $errormessage -Fatally aborts execution with the given error message. Avoid at all -costs! The only time this is acceptable is when the terminal process -starts up. +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 with the given string which should not include a +Calls C with the given string which should include a trailing newline. The module also overwrites the C 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. + +=back + =head2 RENDITION Rendition bitsets contain information about colour, font, font styles and @@ -217,7 +506,8 @@ Return the rendition mask used for overlays by default. -=item $rendbit = urxvt::RS_Bold, RS_Italic, RS_Blink, RS_RVid, RS_Uline +=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 @@ -229,20 +519,22 @@ Return the foreground/background colour index, respectively. -=item $rend = urxvt::SET_FGCOLOR ($rend, $new_colour) +=item $rend = urxvt::SET_FGCOLOR $rend, $new_colour -=item $rend = urxvt::SET_BGCOLOR ($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) +=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) +=item $rend = urxvt::SET_CUSTOM $rend, $new_value Change the custom value. @@ -250,17 +542,7 @@ =cut -package urxvt; - -use strict; - -our $term; -our @HOOKNAME; -our $LIBDIR; - BEGIN { - urxvt->bootstrap; - # overwrite perl's warn *CORE::GLOBAL::warn = sub { my $msg = join "", @_; @@ -270,103 +552,678 @@ }; } -my @hook_count; -my $verbosity = $ENV{URXVT_PERL_VERBOSITY}; +no warnings 'utf8'; -sub verbose { - my ($level, $msg) = @_; - warn "$msg\n" if $level <= $verbosity; +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]; + + 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 } -# find on_xxx subs in the package and register them -# as hooks -sub register_package($) { - my ($pkg) = @_; +sub usage { + my ($term, $usage_type) = @_; - for my $htype (0.. $#HOOKNAME) { - my $name = $HOOKNAME[$htype]; + $term->scan_extensions; - my $ref = $pkg->can ("on_" . lc $name) - or next; + my $r = $term->{meta}{resource}; + + for my $pattern (sort keys %$r) { + my ($ext, $type, $desc) = @{ $r->{$pattern} }; - $term->{_hook}[$htype]{$ref*1} = $ref; - $hook_count[$htype]++ - or set_should_invoke $htype, 1; + $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 $script_pkg = "script0000"; -my %script_pkg; +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 script_package($) { +sub extension_package($) { my ($path) = @_; - $script_pkg{$path} ||= do { - my $pkg = "urxvt::" . ($script_pkg++); + $extension_pkg{$path} ||= do { + $path =~ /([^\/\\]+)$/; + my $pkg = $1; + $pkg =~ s/[^[:word:]]/_/g; + $pkg = "urxvt::ext::$pkg"; - verbose 3, "loading script '$path' into package '$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; use utf8;\n" - . "#line 1 \"$path\"\n{\n" - . (do { local $/; <$fh> }) - . "\n};\n1"; + 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: $@"; + eval $source + or die "$path: $@"; $pkg } } +our $retval; # return value for urxvt + # called by the rxvt core sub invoke { - local $term = shift; + local $TERM = shift; my $htype = shift; - if ($htype == 0) { # INIT - my @dirs = ((split /:/, $term->resource ("perl_lib")), "$LIBDIR/perl"); + 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 + ) { + if ($_ eq "default") { + + $ext_arg{$_} = [] + for + qw(selection option-popup selection-popup readline), + @{ delete $TERM->{perl_ext_3} }, + map $_->[0], values %{ $TERM->{meta}{binding} }; + + 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{$_} ||= []; + } + } + + # 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]"); + } + } - for my $ext (split /:/, $term->resource ("perl_ext")) { + for my $ext (sort keys %ext_arg) { my @files = grep -f $_, map "$_/$ext", @dirs; if (@files) { - register_package script_package $files[0]; + $TERM->register_package (extension_package $files[0], $ext_arg{$ext}); } else { warn "perl extension '$ext' not found in perl library search path\n"; } } - } elsif ($htype == 1) { # DESTROY - if (my $hook = $term->{_hook}) { - for my $htype (0..$#$hook) { - $hook_count[$htype] -= scalar keys %{ $hook->[$htype] || {} } - or set_should_invoke $htype, 0; + 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; } - my $cb = $term->{_hook}[$htype] - or return; + if ($htype == HOOK_DESTROY) { + # clear package objects + %$_ = () for values %{ $TERM->{_pkg} }; + + # clear package + %$TERM = (); + } - verbose 10, "$HOOKNAME[$htype] (" . (join ", ", $term, @_) . ")" - if $verbosity >= 10; + $retval +} - while (my ($k, $v) = each %$cb) { - return 1 if $v->($term, @_); +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) +} - 0 +package urxvt::term::extension; + +=head2 The C class + +Each extension attached to a terminal object is represented by +a C 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 +class. + +=over 4 + +=item $urxvt_term = $self->{term} + +Returns the C object associated with this instance of the +extension. This member I 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 prefix) for +this extension, replacing any hook previously installed via C 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 +method of the C 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, 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->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. + +=cut + +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 Class + +The sole purpose of this class is to deliver an interface to the +C 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 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 @libdirs = perl_libdirs $self; + +# return if $self->{meta_libdirs} eq join "\x00", @libdirs;#d# + +# $self->{meta_libdirs} = join "\x00", @libdirs;#d# + $self->{meta} = \my %meta; + + # first gather extensions + for my $dir (reverse @libdirs) { + opendir my $fh, $dir + or next; + for my $ext (readdir $fh) { + $ext !~ /^\./ + and open my $fh, "<", "$dir/$ext" + or next; + + my %ext = (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]; + } + } elsif (/^#:META:BINDING:(.*)/) { + my ($keysym, $action) = split /:/, $1; + $ext{binding}{$keysym} = [$ext, $action]; + } elsif (/^\s*(?:#|$)/) { + # skip other comments and empty lines + } else { + last; # stop parsing on first non-empty non-comment line + } + } + + $meta{ext}{$ext} = \%ext; + } + } + + # and now merge resources and bindings + while (my ($k, $v) = each %{ $meta{ext} }) { + #TODO: should check for extensions overriding each other + %{ $meta{resource} } = (%{ $meta{resource} }, %{ $v->{resource} }); + %{ $meta{binding} } = (%{ $meta{binding} }, %{ $v->{binding} }); + } +} + +=item $term = new urxvt::term $envhashref, $rxvtname, [arg...] + +Creates a new terminal, very similar as if you had started it with system +C<$rxvtname, arg...>. C<$envhashref> must be a reference to a C<%ENV>-like +hash which defines the environment of the new terminal. + +Croaks (and probably outputs an error message) if the new instance +couldn't be created. Returns C if the new instance didn't +initialise perl, and the terminal object otherwise. The C and +C hooks will be called before this call returns, and are free to +refer to global data (which is race free). + +=cut + +sub new { + my ($class, $env, @args) = @_; + + $env or Carp::croak "environment hash missing in call to urxvt::term->new"; + @args or Carp::croak "name argument missing in call to urxvt::term->new"; + + _new ([ map "$_=$env->{$_}", keys %$env ], \@args); +} + +=item $term->destroy + +Destroy the terminal object (close the window, free resources +etc.). Please note that urxvt will not exit as long as any event +watchers (timers, io watchers) are still active. + +=item $term->exec_async ($cmd[, @args]) + +Works like the combination of the C/C builtins, which executes +("starts") programs in the background. This function takes care of setting +the user environment before exec'ing the command (e.g. C) and should +be preferred over explicit calls to C or C. + +Returns the pid of the subprocess or C on error. + +=cut + +sub exec_async { + my $self = shift; + + my $pid = fork; + + return $pid + if !defined $pid or $pid; + + %ENV = %{ $self->env }; + + exec @_; + urxvt::_exit 255; +} + +=item $isset = $term->option ($optval[, $set]) + +Returns true if the option specified by C<$optval> is enabled, and +optionally change it. All option values are stored by name in the hash +C<%urxvt::OPTION>. Options not enabled in this binary are not in the hash. + +Here is a likely non-exhaustive list of option names, please see the +source file F to see the actual list: + + borderLess buffered console cursorBlink cursorUnderline hold iconic + 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 + =item $value = $term->resource ($name[, $newval]) Returns the current resource value associated with a given name and @@ -384,123 +1241,394 @@ Please note that resource strings will currently only be freed when the terminal is destroyed, so changing options frequently will eat memory. -Here is a a likely non-exhaustive list of resource names, not all of which -are supported in every build, please see the source to see the actual -list: - - answerbackstring backgroundPixmap backspace_key boldFont boldItalicFont - borderLess color cursorBlink cursorUnderline cutchars delete_key - display_name embed ext_bwidth fade font geometry hold iconName - imFont imLocale inputMethod insecure int_bwidth intensityStyles - italicFont jumpScroll lineSpace loginShell mapAlert menu meta8 modifier - mouseWheelScrollPage name pastableTabs path perl_eval perl_ext - perl_lib pointerBlank pointerBlankDelay preeditType print_pipe pty_fd - reverseVideo saveLines scrollBar scrollBar_align scrollBar_floating - scrollBar_right scrollBar_thickness scrollTtyKeypress scrollTtyOutput - scrollWithBuffer scrollstyle secondaryScreen secondaryScroll selectstyle - shade term_name title transparent transparent_all tripleclickwords +Here is a likely non-exhaustive list of resource names, not all of which +are supported in every build, please see the source file F +to see the actual list: + + answerbackstring backgroundPixmap backspace_key blurradius + boldFont boldItalicFont borderLess buffered chdir color cursorBlink + cursorUnderline cutchars delete_key depth display_name embed ext_bwidth + fade font geometry hold iconName iconfile imFont imLocale inputMethod + insecure int_bwidth intensityStyles iso14755 iso14755_52 italicFont + jumpScroll letterSpace lineSpace loginShell mapAlert meta8 modifier + mouseWheelScrollPage name override_redirect pastableTabs path perl_eval + perl_ext_1 perl_ext_2 perl_lib pointerBlank pointerBlankDelay + 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 =cut -sub urxvt::term::resource($$;$) { +sub resource($$;$) { my ($self, $name) = (shift, shift); unshift @_, $self, $name, ($name =~ s/\s*\+\s*(\d+)$// ? $1 : 0); - goto &urxvt::term::_resource; + goto &urxvt::term::_resource } +=item $value = $term->x_resource ($pattern) + +Returns the X-Resource for the given pattern, excluding the program or +class name, i.e. C<< $term->x_resource ("boldFont") >> should return the +same value as used by this instance of rxvt-unicode. Returns C if no +resource with that pattern exists. + +Extensions that define extra resource or command line arguments also need +to call this method to access their values. + +If the method is called on an extension object (basically, from an +extension), then the special prefix C<%.> will be replaced by the name of +the extension and a dot, and the lone string C<%> will be replaced by the +extension name itself. This makes it possible to code extensions so you +can rename them and get a new set of commandline switches and resources +without having to change the actual code. + +This method should only be called during the C hook, as there is +only one resource database per display, and later invocations might return +the wrong resources. + +=item $value = $term->x_resource_boolean ($pattern) + +Like C, above, but interprets the string value as a boolean +and returns C<1> for true values, C<0> for false values and C if +the resource or option isn't specified. + +You should always use this method to parse boolean resources. + +=cut + +sub x_resource_boolean { + my $res = &x_resource; + + $res =~ /^\s*(?:true|yes|on|1)\s*$/i ? 1 : defined $res && 0 +} + +=item $success = $term->bind_action ($key, $octets) + +Adds a key binding exactly as specified via a C resource. See the +C resource in the urxvt(1) manpage. + +=item $rend = $term->rstyle ([$new_rstyle]) + +Return and optionally change the current rendition. Text that is output by +the terminal application will use this style. + +=item ($row, $col) = $term->screen_cur ([$row, $col]) + +Return the current coordinates of the text cursor position and optionally +set it (which is usually bad as applications don't expect that). + =item ($row, $col) = $term->selection_mark ([$row, $col]) =item ($row, $col) = $term->selection_beg ([$row, $col]) =item ($row, $col) = $term->selection_end ([$row, $col]) -Return the current values of the selection mark, begin or end positions, -and optionally set them to new values. +Return the current values of the selection mark, begin or end positions. + +When arguments are given, then the selection coordinates are set to +C<$row> and C<$col>, and the selection screen is set to the current +screen. + +=item $screen = $term->selection_screen ([$screen]) + +Returns the current selection screen, and then optionally sets it. -=item $success = $term->selection_grab ($eventtime) +=item $term->selection_make ($eventtime[, $rectangular]) -Try to request the primary selection from the server (for example, as set -by the next method). +Tries to make a selection as set by C and +C. If C<$rectangular> is true (default: false), a +rectangular selection will be made. This is the preferred function to make +a selection. -=item $oldtext = $term->selection ([$newtext]) +=item $success = $term->selection_grab ($eventtime[, $clipboard]) -Return the current selection text and optionally replace it by C<$newtext>. +Try to acquire ownership of the primary (clipboard if C<$clipboard> is +true) selection from the server. The corresponding text can be set +with the next method. No visual feedback will be given. This function +is mostly useful from within C hooks. -=item $term->scr_overlay ($x, $y, $text) +=item $oldtext = $term->selection ([$newtext, $clipboard]) + +Return the current selection (clipboard if C<$clipboard> is true) text +and optionally replace it by C<$newtext>. + +=item $term->selection_clear ([$clipboard]) + +Revoke ownership of the primary (clipboard if C<$clipboard> is true) selection. + +=item $term->overlay_simple ($x, $y, $text) Create a simple multi-line overlay box. See the next method for details. =cut -sub urxvt::term::scr_overlay { +sub overlay_simple { my ($self, $x, $y, $text) = @_; my @lines = split /\n/, $text; - my $w = 0; - for (map $self->strwidth ($_), @lines) { - $w = $_ if $w < $_; - } + my $w = List::Util::max map $self->strwidth ($_), @lines; - $self->scr_overlay_new ($x, $y, $w, scalar @lines); - $self->scr_overlay_set (0, $_, $lines[$_]) for 0.. $#lines; + my $overlay = $self->overlay ($x, $y, $w, scalar @lines); + $overlay->set (0, $_, $lines[$_]) for 0.. $#lines; + + $overlay } -=item $term->scr_overlay_new ($x, $y, $width, $height) +=item $term->overlay ($x, $y, $width, $height[, $rstyle[, $border]]) Create a new (empty) overlay at the given position with the given -width/height. A border will be put around the box. If either C<$x> or -C<$y> is negative, then this is counted from the right/bottom side, -respectively. +width/height. C<$rstyle> defines the initial rendition style +(default: C). + +If C<$border> is C<2> (default), then a decorative border will be put +around the box. + +If either C<$x> or C<$y> is negative, then this is counted from the +right/bottom side, respectively. -=item $term->scr_overlay_off +This method returns an urxvt::overlay object. The overlay will be visible +as long as the perl object is referenced. -Switch the overlay off again. +The methods currently supported on C objects are: + +=over 4 -=item $term->scr_overlay_set_char ($x, $y, $char, $rend = OVERLAY_RSTYLE) +=item $overlay->set ($x, $y, $text[, $rend]) -Put a single character (specified numerically) at the given overlay -position. +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 +at a specific position inside the overlay. -=item $term->scr_overlay_set ($x, $y, $text) +If C<$rend> is missing, then the rendition will not be changed. -Write a string at the given position into the overlay. +=item $overlay->hide -=item $cellwidth = $term->strwidth $string +If visible, hide the overlay, but do not destroy it. + +=item $overlay->show + +If hidden, display the overlay again. + +=back + +=item $popup = $term->popup ($event) + +Creates a new C object that implements a popup menu. The +C<$event> I be the event causing the menu to pop up (a button event, +currently). + +=cut + +sub popup { + my ($self, $event) = @_; + + $self->grab ($event->{time}, 1) + or return; + + my $popup = bless { + term => $self, + event => $event, + }, urxvt::popup::; + + Scalar::Util::weaken $popup->{term}; + + $self->{_destroy}{$popup} = urxvt::destroy_hook { $popup->{popup}->destroy }; + Scalar::Util::weaken $self->{_destroy}{$popup}; + + $popup +} + +=item $cellwidth = $term->strwidth ($string) Returns the number of screen-cells this string would need. Correctly accounts for wide and combining characters. -=item $octets = $term->locale_encode $string +=item $octets = $term->locale_encode ($string) Convert the given text string into the corresponding locale encoding. -=item $string = $term->locale_decode $octets +=item $string = $term->locale_decode ($octets) Convert the given locale-encoded octets into a perl string. +=item $term->scr_xor_span ($beg_row, $beg_col, $end_row, $end_col[, $rstyle]) + +XORs the rendition values in the given span with the provided value +(default: C), which I contain font styles. Useful in +refresh hooks to provide effects similar to the selection. + +=item $term->scr_xor_rect ($beg_row, $beg_col, $end_row, $end_col[, $rstyle1[, $rstyle2]]) + +Similar to C, but xors a rectangle instead. Trailing +whitespace will additionally be xored with the C<$rstyle2>, which defaults +to C, which removes reverse video again and underlines +it instead. Both styles I contain font styles. + +=item $term->scr_bell + +Ring the bell! + +=item $term->scr_add_lines ($string) + +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. + +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 +C hook, though. + +=item $term->scr_change_screen ($screen) + +Switch to given screen - 0 primary, 1 secondary. + +=item $term->cmd_parse ($octets) + +Similar to C, but the argument must be in the +locale-specific encoding of the terminal and can contain command sequences +(escape codes) that will be interpreted. + =item $term->tt_write ($octets) -Write the octets given in C<$data> to the tty (i.e. as program input). To +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 >>. -=item $nrow = $term->nrow +=item $term->tt_write_user_input ($octets) + +Like C, but should be used when writing strings in response to +the user pressing a key, to invoke the additional actions requested by +the user for that case (C doesn't do that). + +The typical use case would be inside C hooks. + +=item $term->tt_paste ($octets) + +Write the octets given in C<$octets> to the tty as a paste, converting NL to +CR and bracketing the data with control sequences if bracketed paste mode +is set. + +=item $old_events = $term->pty_ev_events ([$new_events]) + +Replaces the event mask of the pty watcher by the given event mask. Can +be used to suppress input and output handling to the pty/tty. See the +description of C<< urxvt::timer->events >>. Make sure to always restore +the previous value. + +=item $fd = $term->pty_fd + +Returns the master file descriptor for the pty in use, or C<-1> if no pty +is used. + +=item $windowid = $term->parent + +Return the window id of the toplevel window. + +=item $windowid = $term->vt + +Return the window id of the terminal window. + +=item $term->vt_emask_add ($x_event_mask) + +Adds the specified events to the vt event mask. Useful e.g. when you want +to receive pointer events all the times: + + $term->vt_emask_add (urxvt::PointerMotionMask); + +=item $term->set_urgency ($set) + +Enable/disable the urgency hint on the toplevel window. + +=item $term->focus_in + +=item $term->focus_out + +=item $term->key_press ($state, $keycode[, $time]) + +=item $term->key_release ($state, $keycode[, $time]) + +Deliver various fake events to to terminal. + +=item $window_width = $term->width + +=item $window_height = $term->height + +=item $font_width = $term->fwidth + +=item $font_height = $term->fheight + +=item $font_ascent = $term->fbase + +=item $terminal_rows = $term->nrow + +=item $terminal_columns = $term->ncol -=item $ncol = $term->ncol +=item $has_focus = $term->focus -Return the number of rows/columns of the terminal window (i.e. as -specified by C<-geometry>, excluding any scrollback). +=item $is_mapped = $term->mapped -=item $nsaved = $term->nsaved +=item $max_scrollback = $term->saveLines -Returns the number of lines in the scrollback buffer. +=item $nrow_plus_saveLines = $term->total_rows + +=item $topmost_scrollback_row = $term->top_row + +Return various integers describing terminal characteristics. + +=item $x_display = $term->display_id + +Return the DISPLAY used by rxvt-unicode. + +=item $lc_ctype = $term->locale + +Returns the LC_CTYPE category string used by this rxvt-unicode. + +=item $env = $term->env + +Returns a copy of the environment in effect for the terminal as a hashref +similar to C<\%ENV>. + +=item @envv = $term->envv + +Returns the environment as array of strings of the form C. + +=item @argv = $term->argv + +Return the argument vector as this terminal, similar to @ARGV, but +includes the program name as first element. + +=cut + +sub env { + +{ map /^([^=]+)(?:=(.*))?$/s && ($1 => $2), $_[0]->envv } +} + +=item $modifiermask = $term->ModLevel3Mask + +=item $modifiermask = $term->ModMetaMask + +=item $modifiermask = $term->ModNumLockMask + +Return the modifier masks corresponding to the "ISO Level 3 Shift" (often +AltGr), the meta key (often Alt) and the num lock key, if applicable. + +=item $screen = $term->current_screen + +Returns the currently displayed screen (0 primary, 1 secondary). + +=item $cursor_is_hidden = $term->hidden_cursor + +Returns whether the cursor is currently hidden or not. =item $view_start = $term->view_start ([$newvalue]) -Returns the negative row number of the topmost line. Minimum value is -C<0>, which displays the normal terminal contents. Larger values scroll +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. =item $term->want_refresh @@ -513,10 +1641,10 @@ =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<0> -is the topmost terminal line, row C<< $term->$ncol-1 >> is the bottommost -terminal line. The scrollback buffer starts at line C<-1> and extends to -line C<< -$term->nsaved >>. +Returns the text of the entire row with number C<$row_number>. Row C<< $term->top_row >> +is the topmost terminal line, row C<< $term->nrow-1 >> is the bottommost +terminal line. Nothing will be returned if a nonexistent line +is requested. If C<$new_text> is specified, it will replace characters in the current line, starting at column C<$start_col> (default C<0>), which is useful @@ -524,10 +1652,10 @@ automatically be updated. C<$text> is in a special encoding: tabs and wide characters that use more -than one cell when displayed are padded with urxvt::NOCHAR characters -(C). Characters with combining characters and other characters -that do not fit into the normal tetx encoding will be replaced with -characters in the private use area. +than one cell when displayed are padded with C<$urxvt::NOCHAR> (chr 65535) +characters. Characters with combining characters and other characters that +do not fit into the normal text encoding will be replaced with characters +in the private use area. You have to obey this encoding when changing text. The advantage is that C and similar functions work on screen cells and not on @@ -548,9 +1676,128 @@ =item $length = $term->ROW_l ($row_number[, $new_length]) -Returns the number of screen cells that are in use ("the line length"). If -it is C<-1>, then the line is part of a multiple-row logical "line", which -means all characters are in use and it is continued on the next row. +Returns the number of screen cells that are in use ("the line +length"). Unlike the urxvt core, this returns C<< $term->ncol >> if the +line is joined with the following one. + +=item $bool = $term->is_longer ($row_number) + +Returns true if the row is part of a multiple-row logical "line" (i.e. +joined with the following row), which means all characters are in use +and it is continued on the next row (and possibly a continuation of the +previous row(s)). + +=item $line = $term->line ($row_number) + +Create and return a new C object that stores information +about the logical line that row C<$row_number> is part of. It supports the +following methods: + +=over 4 + +=item $text = $line->t ([$new_text]) + +Returns or replaces the full text of the line, similar to C + +=item $rend = $line->r ([$new_rend]) + +Returns or replaces the full rendition array of the line, similar to C + +=item $length = $line->l + +Returns the length of the line in cells, similar to C. + +=item $rownum = $line->beg + +=item $rownum = $line->end + +Return the row number of the first/last row of the line, respectively. + +=item $offset = $line->offset_of ($row, $col) + +Returns the character offset of the given row|col pair within the logical +line. Works for rows outside the line, too, and returns corresponding +offsets outside the string. + +=item ($row, $col) = $line->coord_of ($offset) + +Translates a string offset into terminal coordinates again. + +=back + +=cut + +sub line { + my ($self, $row) = @_; + + my $maxrow = $self->nrow - 1; + + my ($beg, $end) = ($row, $row); + + --$beg while $self->ROW_is_longer ($beg - 1); + ++$end while $self->ROW_is_longer ($end) && $end < $maxrow; + + bless { + term => $self, + beg => $beg, + end => $end, + ncol => $self->ncol, + len => ($end - $beg) * $self->ncol + $self->ROW_l ($end), + }, urxvt::line:: +} + +sub urxvt::line::t { + my ($self) = @_; + + if (@_ > 1) { + $self->{term}->ROW_t ($_, $_[1], 0, ($_ - $self->{beg}) * $self->{ncol}, $self->{ncol}) + for $self->{beg} .. $self->{end}; + } + + defined wantarray && + substr +(join "", map $self->{term}->ROW_t ($_), $self->{beg} .. $self->{end}), + 0, $self->{len} +} + +sub urxvt::line::r { + my ($self) = @_; + + if (@_ > 1) { + $self->{term}->ROW_r ($_, $_[1], 0, ($_ - $self->{beg}) * $self->{ncol}, $self->{ncol}) + for $self->{beg} .. $self->{end}; + } + + if (defined wantarray) { + my $rend = [ + map @{ $self->{term}->ROW_r ($_) }, $self->{beg} .. $self->{end} + ]; + $#$rend = $self->{len} - 1; + return $rend; + } + + () +} + +sub urxvt::line::beg { $_[0]{beg} } +sub urxvt::line::end { $_[0]{end} } +sub urxvt::line::l { $_[0]{len} } + +sub urxvt::line::offset_of { + my ($self, $row, $col) = @_; + + ($row - $self->{beg}) * $self->{ncol} + $col +} + +sub urxvt::line::coord_of { + my ($self, $offset) = @_; + + use integer; + + ( + $offset / $self->{ncol} + $self->{beg}, + $offset % $self->{ncol} + ) +} =item $text = $term->special_encode $string @@ -560,53 +1807,262 @@ =item $string = $term->special_decode $text -Converts rxvt-unicodes text reprsentation into a perl string. See +Converts rxvt-unicodes text representation into a perl string. See C<< $term->ROW_t >> for details. +=item $success = $term->grab_button ($button, $modifiermask[, $window = $term->vt]) + +=item $term->ungrab_button ($button, $modifiermask[, $window = $term->vt]) + +Register/unregister a synchronous button grab. See the XGrabButton +manpage. + +=item $success = $term->grab ($eventtime[, $sync]) + +Calls XGrabPointer and XGrabKeyboard in asynchronous (default) or +synchronous (C<$sync> is true). Also remembers the grab timestamp. + +=item $term->allow_events_async + +Calls XAllowEvents with AsyncBoth for the most recent grab. + +=item $term->allow_events_sync + +Calls XAllowEvents with SyncBoth for the most recent grab. + +=item $term->allow_events_replay + +Calls XAllowEvents with both ReplayPointer and ReplayKeyboard for the most +recent grab. + +=item $term->ungrab + +Calls XUngrabPointer and XUngrabKeyboard for the most recent grab. Is called automatically on +evaluation errors, as it is better to lose the grab in the error case as +the session. + +=item $atom = $term->XInternAtom ($atom_name[, $only_if_exists]) + +=item $atom_name = $term->XGetAtomName ($atom) + +=item @atoms = $term->XListProperties ($window) + +=item ($type,$format,$octets) = $term->XGetWindowProperty ($window, $property) + +=item $term->XChangeProperty ($window, $property, $type, $format, $octets) + +=item $term->XDeleteProperty ($window, $property) + +=item $window = $term->DefaultRootWindow + +=item $term->XReparentWindow ($window, $parent, [$x, $y]) + +=item $term->XMapWindow ($window) + +=item $term->XUnmapWindow ($window) + +=item $term->XMoveResizeWindow ($window, $x, $y, $width, $height) + +=item ($x, $y, $child_window) = $term->XTranslateCoordinates ($src, $dst, $x, $y) + +=item $term->XChangeInput ($window, $add_events[, $del_events]) + +=item $keysym = $term->XStringToKeysym ($string) + +=item $string = $term->XKeysymToString ($keysym) + +Various X or X-related functions. The C<$term> object only serves as +the source of the display, otherwise those functions map more-or-less +directly onto the X functions of the same name. + +=back + +=cut + +package urxvt::popup; + +=head2 The C Class + +=over 4 + +=cut + +sub add_item { + my ($self, $item) = @_; + + $item->{rend}{normal} = "\x1b[0;30;47m" unless exists $item->{rend}{normal}; + $item->{rend}{hover} = "\x1b[0;30;46m" unless exists $item->{rend}{hover}; + $item->{rend}{active} = "\x1b[m" unless exists $item->{rend}{active}; + + $item->{render} ||= sub { $_[0]{text} }; + + push @{ $self->{item} }, $item; +} + +=item $popup->add_title ($title) + +Adds a non-clickable title to the popup. + +=cut + +sub add_title { + my ($self, $title) = @_; + + $self->add_item ({ + rend => { normal => "\x1b[38;5;11;44m", hover => "\x1b[38;5;11;44m", active => "\x1b[38;5;11;44m" }, + text => $title, + activate => sub { }, + }); +} + +=item $popup->add_separator ([$sepchr]) + +Creates a separator, optionally using the character given as C<$sepchr>. + +=cut + +sub add_separator { + my ($self, $sep) = @_; + + $sep ||= "="; + + $self->add_item ({ + rend => { normal => "\x1b[0;30;47m", hover => "\x1b[0;30;47m", active => "\x1b[0;30;47m" }, + text => "", + render => sub { $sep x $self->{term}->ncol }, + activate => sub { }, + }); +} + +=item $popup->add_button ($text, $cb) + +Adds a clickable button to the popup. C<$cb> is called whenever it is +selected. + +=cut + +sub add_button { + my ($self, $text, $cb) = @_; + + $self->add_item ({ type => "button", text => $text, activate => $cb}); +} + +=item $popup->add_toggle ($text, $initial_value, $cb) + +Adds a toggle/checkbox item to the popup. The callback gets called +whenever it gets toggled, with a boolean indicating its new value as its +first argument. + +=cut + +sub add_toggle { + my ($self, $text, $value, $cb) = @_; + + my $item; $item = { + type => "button", + text => " $text", + value => $value, + render => sub { ($_[0]{value} ? "* " : " ") . $text }, + activate => sub { $cb->($_[1]{value} = !$_[1]{value}); }, + }; + + $self->add_item ($item); +} + +=item $popup->show + +Displays the popup (which is initially hidden). + +=cut + +sub show { + my ($self) = @_; + + local $urxvt::popup::self = $self; + + my $env = $self->{term}->env; + # we can't hope to reproduce the locale algorithm, so nuke LC_ALL and set LC_CTYPE. + delete $env->{LC_ALL}; + $env->{LC_CTYPE} = $self->{term}->locale; + + my $term = urxvt::term->new ( + $env, "popup", + "--perl-lib" => "", "--perl-ext-common" => "", + "-pty-fd" => -1, "-sl" => 0, + "-b" => 1, "-bd" => "grey80", "-bl", "-override-redirect", + "--transient-for" => $self->{term}->parent, + "-display" => $self->{term}->display_id, + "-pe" => "urxvt-popup", + ) or die "unable to create popup window\n"; + + unless (delete $term->{urxvt_popup_init_done}) { + $term->ungrab; + $term->destroy; + die "unable to initialise popup window\n"; + } +} + +sub DESTROY { + my ($self) = @_; + + delete $self->{term}{_destroy}{$self}; + $self->{term}->ungrab; +} + =back +=cut + +package urxvt::watcher; + =head2 The C Class This class implements timer watchers/events. Time is represented as a fractional number of seconds since the epoch. Example: - # create a digital clock display in upper right corner + $term->{overlay} = $term->overlay (-1, 0, 8, 1, urxvt::OVERLAY_RSTYLE, 0); $term->{timer} = urxvt::timer ->new - ->start (urxvt::NOW) + ->interval (1) ->cb (sub { - my ($timer) = @_; - my $time = $timer->at; - $timer->start ($time + 1); - $self->scr_overlay (-1, 0, - POSIX::strftime "%H:%M:%S", localtime $time); + $term->{overlay}->set (0, 0, + sprintf "%2d:%02d:%02d", (localtime urxvt::NOW)[2,1,0]); }); =over 4 =item $timer = new urxvt::timer -Create a new timer object in stopped state. +Create a new timer object in started state. It is scheduled to fire +immediately. =item $timer = $timer->cb (sub { my ($timer) = @_; ... }) Set the callback to be called when the timer triggers. -=item $tstamp = $timer->at +=item $timer = $timer->set ($tstamp[, $interval]) -Return the time this watcher will fire next. +Set the time the event is generated to $tstamp (and optionally specifies a +new $interval). -=item $timer = $timer->set ($tstamp) +=item $timer = $timer->interval ($interval) -Set the time the event is generated to $tstamp. +By default (and when C<$interval> is C<0>), the timer will automatically +stop after it has fired once. If C<$interval> is non-zero, then the timer +is automatically rescheduled at the given intervals. =item $timer = $timer->start Start the timer. -=item $timer = $timer->start ($tstamp) +=item $timer = $timer->start ($tstamp[, $interval]) -Set the event trigger time to C<$tstamp> and start the timer. +Set the event trigger time to C<$tstamp> and start the timer. Optionally +also replaces the interval. + +=item $timer = $timer->after ($delay[, $interval]) + +Like C, but sets the expiry timer to c. =item $timer = $timer->stop @@ -622,7 +2078,7 @@ $term->{iow} = urxvt::iow ->new ->fd (fileno $term->{socket}) - ->events (1) # wait for read data + ->events (urxvt::EV_READ) ->start ->cb (sub { my ($iow, $revents) = @_; @@ -645,12 +2101,13 @@ =item $iow = $iow->fd ($fd) -Set the filedescriptor (not handle) to watch. +Set the file descriptor (not handle) to watch. =item $iow = $iow->events ($eventmask) -Set the event mask to watch. Bit #0 (value C<1>) enables watching for read -data, Bit #1 (value C<2>) enables watching for write data. +Set the event mask to watch. The only allowed values are +C and C, which might be ORed +together, or C. =item $iow = $iow->start @@ -658,7 +2115,68 @@ =item $iow = $iow->stop -Stop watching for events on the given filehandle. +Stop watching for events on the given file handle. + +=back + +=head2 The C Class + +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 + +=item $iw = new urxvt::iw + +Create a new idle watcher object in stopped state. + +=item $iw = $iw->cb (sub { my ($iw) = @_; ... }) + +Set the callback to be called when the watcher triggers. + +=item $timer = $timer->start + +Start the watcher. + +=item $timer = $timer->stop + +Stop the watcher. + +=back + +=head2 The C Class + +This class implements process watchers. They create an event whenever a +process exits, after which they stop automatically. + + my $pid = fork; + ... + $term->{pw} = urxvt::pw + ->new + ->start ($pid) + ->cb (sub { + my ($pw, $exit_status) = @_; + ... + }); + +=over 4 + +=item $pw = new urxvt::pw + +Create a new process watcher in stopped state. + +=item $pw = $pw->cb (sub { my ($pw, $exit_status) = @_; ... }) + +Set the callback to be called when the timer triggers. + +=item $pw = $timer->start ($pid) + +Tells the watcher to start watching for process C<$pid>. + +=item $pw = $pw->stop + +Stop the watcher. =back @@ -671,19 +2189,23 @@ =over 4 -=item 0 - only fatal messages +=item == 0 - fatal messages -=item 3 - script loading and management +=item >= 3 - script loading and management -=item 10 - all events received +=item >=10 - all called hooks + +=item >=11 - hook return values =back =head1 AUTHOR - Marc Lehmann + Marc Lehmann http://software.schmorp.de/pkg/rxvt-unicode =cut 1 + +# vim: sw=3: