--- rxvt-unicode/src/urxvt.pm 2006/01/04 00:12:12 1.29 +++ rxvt-unicode/src/urxvt.pm 2006/01/08 05:52:42 1.56 @@ -19,8 +19,8 @@ =head1 DESCRIPTION -Everytime a terminal object gets created, scripts specified via the -C resource are loaded and associated with it. +Everytime 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 thus must be encoded as UTF-8. @@ -39,7 +39,7 @@ =over 4 -=item selection +=item selection (enabled by default) Intelligent selection. This extension tries to be more intelligent when the user extends selections (double-click). Right now, it tries to select @@ -58,10 +58,25 @@ =back +=item option-popup (enabled by default) + +Binds a popup menu to Ctrl-Button3 that lets you toggle (some) options at +runtime. + =item digital-clock Displays a digital clock using the built-in overlay. +=item mark-urls + +Uses per-line display filtering (C) to underline urls. + +=item block-graphics-to-ascii + +A not very useful example of filtering all text output to the terminal, +by replacing all line-drawing characters (U+2500 .. U+259F) by a +similar-looking ascii character. + =item example-refresh-hooks Displays a very simple digital clock in the upper right corner of the @@ -83,16 +98,40 @@ 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-unicodes special way of encoding text, where one "unicode" character +always represents one screen cell. See L for a discussion of this format. + +=item $string + +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 $octets + +Either binary data or - more common - a text string encoded in a +locale-specific way. + +=back + =head2 Hooks -The following subroutines can be declared in loaded scripts, and will be +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 object private to each terminal -and extension package. You can call all C methods on it, but +and extension package. You can call all C methods on it, but its not a real C object. Instead, the real C object that is shared between all packages is stored in the C -member. +member. It is, however, blessed intot he package of the extension script, +so for all practical purposes you can treat an extension script as a class. 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, @@ -105,7 +144,10 @@ =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, +though. =item on_reset $term @@ -144,16 +186,6 @@ See the F example extension. -=item on_focus_in $term - -Called whenever the window gets the keyboard focus, before urxvt does -focus in processing. - -=item on_focus_out $term - -Called wheneever the window loses keyboard focus, before urxvt does focus -out processing. - =item on_view_change $term, $offset Called whenever the view offset changes, i..e the user or program @@ -187,6 +219,28 @@ as its source can not easily be controleld (e-mail content, messages from other users on the same system etc.). +=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_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 @@ -204,6 +258,42 @@ C action bound to it (see description of the B resource in the @@RXVT_NAME@@(1) manpage). +=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 wheneever the window loses keyboard focus, before rxvt-unicode does +focus out processing. + +=item on_key_press $term, $event, $octets + +=item on_key_release $term, $event + +=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 even 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 row +and column under the mouse cursor. + +C additionally receives the string rxvt-unicode would +output, if any, in locale-specific encoding. + +subwindow. + =back =head2 Variables in the C Package @@ -212,8 +302,8 @@ =item $urxvt::TERM -The current terminal. Whenever a callback/Hook is bein executed, this -variable stores the current C object. +The current terminal. This variable stores the current C +object, whenever a callback/hook is executing. =back @@ -221,6 +311,14 @@ =over 4 +=item $term = new urxvt [arg...] + +Creates a new terminal, very similar as if you had started it with +C. 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 during the call. + =item urxvt::fatal $errormessage Fatally aborts execution with the given error message. Avoid at all @@ -240,6 +338,14 @@ 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 + +Various constants for use in X calls and event processing. + =back =head2 RENDITION @@ -298,11 +404,15 @@ package urxvt; +use utf8; use strict; use Scalar::Util (); +use List::Util (); +our $VERSION = 1; our $TERM; our @HOOKNAME; +our %OPTION; our $LIBDIR; BEGIN { @@ -342,22 +452,23 @@ } } -my $script_pkg = "script0000"; -my %script_pkg; +my $extension_pkg = "extension0000"; +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 { + my $pkg = "urxvt::" . ($extension_pkg++); - verbose 3, "loading script '$path' into package '$pkg'"; + verbose 3, "loading extension '$path' into package '$pkg'"; open my $fh, "<:raw", $path or die "$path: $!"; my $source = "package $pkg; use strict; use utf8;\n" + . "use base urxvt::term::proxy::;\n" . "#line 1 \"$path\"\n{\n" . (do { local $/; <$fh> }) . "\n};\n1"; @@ -368,6 +479,8 @@ } } +our $retval; # return value for urxvt + # called by the rxvt core sub invoke { local $TERM = shift; @@ -375,49 +488,77 @@ if ($htype == 0) { # INIT my @dirs = ((split /:/, $TERM->resource ("perl_lib")), "$LIBDIR/perl"); + + my %want_ext; + + for (map { split /,/, $TERM->resource ("perl_ext_$_") } 1, 2) { + if ($_ eq "default") { + $want_ext{$_}++ for qw(selection option-popup); + } elsif (/^-(.*)$/) { + delete $want_ext{$1}; + } else { + $want_ext{$_}++; + } + } - for my $ext (split /:/, $TERM->resource ("perl_ext")) { + for my $ext (keys %want_ext) { my @files = grep -f $_, map "$_/$ext", @dirs; if (@files) { - register_package script_package $files[0]; + register_package extension_package $files[0]; } else { warn "perl extension '$ext' not found in perl library search path\n"; } } - } elsif ($htype == 1) { # DESTROY + 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; + + keys %$cb; + + while (my ($pkg, $cb) = each %$cb) { + eval { + $retval = $cb->( + $TERM->{_pkg}{$pkg} ||= do { + my $proxy = bless { }, $pkg; + Scalar::Util::weaken ($proxy->{term} = $TERM); + $proxy + }, + @_, + ) and last; + }; + warn $@ if $@;#d# + } + } + + if ($htype == 1) { # DESTROY + # remove hooks if unused if (my $hook = $TERM->{_hook}) { for my $htype (0..$#$hook) { $hook_count[$htype] -= scalar keys %{ $hook->[$htype] || {} } or set_should_invoke $htype, 0; } } - } - - my $cb = $TERM->{_hook}[$htype] - or return; - verbose 10, "$HOOKNAME[$htype] (" . (join ", ", $TERM, @_) . ")" - if $verbosity >= 10; + # clear package objects + %$_ = () for values %{ $TERM->{_pkg} }; - keys %$cb; - - while (my ($pkg, $cb) = each %$cb) { - return 1 - if $cb->( - $TERM->{$pkg} ||= do { - my $proxy = bless { }, urxvt::term::proxy::; - Scalar::Util::weaken ($proxy->{term} = $TERM); - $proxy - }, - @_, - ); + # clear package + %$TERM = (); } - 0 + $retval } +# urxvt::term::proxy + sub urxvt::term::proxy::AUTOLOAD { $urxvt::term::proxy::AUTOLOAD =~ /:([^:]+)$/ or die "FATAL: \$AUTOLOAD '$urxvt::term::proxy::AUTOLOAD' unparsable"; @@ -433,10 +574,110 @@ goto &$urxvt::term::proxy::AUTOLOAD; } +# urxvt::destroy_hook + +sub urxvt::destroy_hook::DESTROY { + ${$_[0]}->(); +} + +sub urxvt::destroy_hook(&) { + bless \shift, urxvt::destroy_hook:: +} + +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 work. The only exception is that you cannot wait on condition +variables, but non-blocking condvar use is ok. What this means is that you +cannot use blocking APIs, but the non-blocking variant should work. + +=cut + +our $VERSION = 1; + +$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 + ->start (urxvt::NOW + $arg{after}) + ->cb (sub { + $_[0]->stop; # need to cancel manually + $cb->(); + }) +} + +sub io { + my ($class, %arg) = @_; + + my $cb = $arg{cb}; + + bless [$arg{fh}, urxvt::iow + ->new + ->fd (fileno $arg{fh}) + ->events (($arg{poll} =~ /r/ ? 1 : 0) + | ($arg{poll} =~ /w/ ? 2 : 0)) + ->start + ->cb (sub { + $cb->(($_[1] & 1 ? 'r' : '') + . ($_[1] & 2 ? 'w' : '')); + })], + urxvt::anyevent:: +} + +sub DESTROY { + $_[0][1]->stop; +} + +sub condvar { + bless \my $flag, urxvt::anyevent::condvar:: +} + +sub urxvt::anyevent::condvar::broadcast { + ${$_[0]}++; +} + +sub urxvt::anyevent::condvar::wait { + unless (${$_[0]}) { + require Carp; + Carp::croak ("AnyEvent->condvar blocking wait unsupported in urxvt, use a non-blocking API"); + } +} + +package urxvt::term; + =head2 The C Class =over 4 +=item $term->destroy + +Destroy the terminal object (close the window, free resources etc.). + +=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 a likely non-exhaustive list of option names, please see the +source file F to see the actual list: + + borderLess console cursorBlink cursorUnderline hold iconic insecure + intensityStyles jumpScroll loginShell mapAlert meta8 mouseWheelScrollPage + pastableTabs pointerBlank reverseVideo scrollBar scrollBar_floating + scrollBar_right scrollTtyKeypress scrollTtyOutput scrollWithBuffer + secondaryScreen secondaryScroll skipBuiltinGlyphs transparent + tripleclickwords utmpInhibit visualBell + =item $value = $term->resource ($name[, $newval]) Returns the current resource value associated with a given name and @@ -455,15 +696,15 @@ 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: +are supported in every build, please see the source file F +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 + mouseWheelScrollPage name 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 @@ -473,12 +714,22 @@ =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; + &urxvt::term::_resource } +=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]) @@ -502,21 +753,20 @@ #Create a simple multi-line overlay box. See the next method for details. # #=cut - -sub urxvt::term::scr_overlay { -die; - my ($self, $x, $y, $text) = @_; - - my @lines = split /\n/, $text; - - my $w = 0; - for (map $self->strwidth ($_), @lines) { - $w = $_ if $w < $_; - } - - $self->scr_overlay_new ($x, $y, $w, scalar @lines); - $self->scr_overlay_set (0, $_, $lines[$_]) for 0.. $#lines; -} +# +#sub urxvt::term::scr_overlay { +# my ($self, $x, $y, $text) = @_; +# +# my @lines = split /\n/, $text; +# +# my $w = 0; +# for (map $self->strwidth ($_), @lines) { +# $w = $_ if $w < $_; +# } +# +# $self->scr_overlay_new ($x, $y, $w, scalar @lines); +# $self->scr_overlay_set (0, $_, $lines[$_]) for 0.. $#lines; +#} =item $term->overlay ($x, $y, $width, $height[, $rstyle[, $border]]) @@ -553,35 +803,111 @@ =back -=item $cellwidth = $term->strwidth $string +=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_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->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 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 $windowid = $term->parent + +Return the window id of the toplevel window. + +=item $windowid = $term->vt + +Return the window id of the terminal window. + +=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 $ncol = $term->ncol +=item $terminal_columns = $term->ncol -Return the number of rows/columns of the terminal window (i.e. as -specified by C<-geometry>, excluding any scrollback). +=item $has_focus = $term->focus -=item $nsaved = $term->nsaved +=item $is_mapped = $term->mapped -Returns the number of lines in the scrollback buffer. +=item $max_scrollback = $term->saveLines + +=item $nrow_plus_saveLines = $term->total_rows + +=item $lines_in_scrollback = $term->nsaved + +Return various integers describing terminal characteristics. + +=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 $view_start = $term->view_start ([$newvalue]) @@ -654,13 +980,13 @@ =over 4 -=item $text = $line->t +=item $text = $line->t ([$new_text]) -Returns the full text of the line, similar to C +Returns or replaces the full text of the line, similar to C -=item $rend = $line->r +=item $rend = $line->r ([$new_rend]) -Returns the full rendition array of the line, similar to C +Returns or replaces the full rendition array of the line, similar to C =item $length = $line->l @@ -685,7 +1011,7 @@ =cut -sub urxvt::term::line { +sub line { my ($self, $row) = @_; my $maxrow = $self->nrow - 1; @@ -699,6 +1025,7 @@ term => $self, beg => $beg, end => $end, + ncol => $self->ncol, len => ($end - $beg) * $self->ncol + $self->ROW_l ($end), }, urxvt::line:: } @@ -706,18 +1033,35 @@ sub urxvt::line::t { my ($self) = @_; - substr +(join "", map $self->{term}->ROW_t ($_), $self->{beg} .. $self->{end}), - 0, $self->{len} + 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) = @_; - my $rend = [ - map @{ $self->{term}->ROW_r ($_) }, $self->{beg} .. $self->{end} - ]; - $#$rend = $self->{len} - 1; - $rend + 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} } @@ -727,7 +1071,7 @@ sub urxvt::line::offset_of { my ($self, $row, $col) = @_; - ($row - $self->{beg}) * $self->{term}->ncol + $col + ($row - $self->{beg}) * $self->{ncol} + $col } sub urxvt::line::coord_of { @@ -736,8 +1080,8 @@ use integer; ( - $offset / $self->{term}->ncol + $self->{beg}, - $offset % $self->{term}->ncol + $offset / $self->{ncol} + $self->{beg}, + $offset % $self->{ncol} ) } @@ -755,6 +1099,88 @@ =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; +} + +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 $urxvt::TERM->ncol }, + activate => sub { }, + }); +} + +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 { }, + }); +} + +sub add_button { + my ($self, $text, $cb) = @_; + + $self->add_item ({ type => "button", text => "[ $text ]", activate => $cb}); +} + +sub add_toggle { + my ($self, $text, $cb, $value) = @_; + + my $item; $item = { + type => "button", + text => " $text", + value => $value, + render => sub { ($item->{value} ? "* " : " ") . $text }, + activate => sub { $cb->($item->{value} = !$item->{value}); }, + }; + + $self->add_item ($item); +} + +sub show { + my ($self) = @_; + + local $urxvt::popup::self = $self; + + urxvt->new ("--perl-lib" => "", "--perl-ext-common" => "", "-pty-fd" => -1, "-sl" => 0, "-b" => 0, + "--transient-for" => $self->{term}->parent, + "-pe" => "urxvt-popup") + or die "unable to create popup window\n"; +} + +sub DESTROY { + my ($self) = @_; + + $self->{term}->ungrab; +} + =head2 The C Class This class implements timer watchers/events. Time is represented as a