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

Comparing rxvt-unicode/src/urxvt.pm (file contents):
Revision 1.42 by root, Fri Jan 6 21:06:09 2006 UTC vs.
Revision 1.68 by root, Mon Jan 9 20:00:31 2006 UTC

    @@RXVT_NAME@@ --perl-lib $HOME -pe grab_test
 =head1 DESCRIPTION
-Everytime a terminal object gets created, scripts specified via the
+Everytime a terminal object gets created, extension scripts specified via
-C<perl> resource are loaded and associated with it.
+the C<perl> 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.
 Each script will only ever be loaded once, even in @@RXVT_NAME@@d, where
   @@RXVT_NAME@@ -pe <extensionname>
 =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
 urls and complete shell-quoted arguments, which is very convenient, too,
 if your F<ls> supports C<--quoting-style=shell>.
 Rot-13 the selection when activated. Used via keyboard trigger:
    URxvt.keysym.C-M-r: perl:selection:rot13
 =back
+=item option-popup (enabled by default)
+Binds a popup menu to Ctrl-Button2 that lets you toggle (some) options at
+runtime.
+=item selection-popup (enabled by default)
+Binds a popup menu to Ctrl-Button3 that lets you convert the selection
+text into various other formats/action.
 =item digital-clock
 Displays a digital clock using the built-in overlay.
 =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<urxvt::term> methods on it, but
+and extension package. You can call all C<urxvt::term> methods on it, but
 its not a real C<urxvt::term> object. Instead, the real C<urxvt::term>
 object that is shared between all packages is stored in the C<term>
-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<consumed>, and the invocation of other hooks is skipped,
 and the relevant action might not be carried out by the C++ code.
 should extend the selection itelf and return true to suppress the built-in
 processing.
 See the F<selection> 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
 scrolls. Offset C<0> means display the normal terminal, positive values
 show this many lines of scrollback.
 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_tty_activity $term *NYI*
-Called whenever the program(s) running in the urxvt window send output.
 =item on_osc_seq $term, $string
 Called whenever the B<ESC ] 777 ; string ST> command sequence (OSC =
 operating system command) is processed. Cursor position and other state
 Called whenever the user presses a key combination that has a
 C<perl:string> action bound to it (see description of the B<keysym>
 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
 =over 4
 =item $urxvt::TERM
-The current terminal. Whenever a callback/Hook is bein executed, this
+The current terminal. This variable stores the current C<urxvt::term>
-variable stores the current C<urxvt::term> object.
+object, whenever a callback/hook is executing.
 =back
 =head2 Functions in the C<urxvt> Package
 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.
+=item $is_safe = urxvt::safe
+Returns true when it is safe to do potentially unsafe things, such as
+evaluating perl code specified by the user. This is true when urxvt was
+started setuid or setgid.
 =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
+Various constants for use in X calls and event processing.
 =back
 =head2 RENDITION
 =cut
 package urxvt;
+use utf8;
 use strict;
 use Scalar::Util ();
+use List::Util ();
+our $VERSION = 1;
 our $TERM;
 our @HOOKNAME;
+our %OPTION;
 our $LIBDIR;
 BEGIN {
    urxvt->bootstrap;
       my $msg = join "", @_;
       $msg .= "\n"
          unless $msg =~ /\n$/;
       urxvt::warn ($msg);
    };
+   delete $ENV{IFS};
+   delete $ENV{CDPATH};
+   delete $ENV{BASH_ENV};
+   $ENV{PATH} = "/bin:/sbin:/usr/bin:/usr/sbin:/usr/local/bin:/usr/local/sbin:/opt/bin:/opt/sbin";
 }
 my @hook_count;
 my $verbosity = $ENV{URXVT_PERL_VERBOSITY};
 sub verbose {
    my ($level, $msg) = @_;
    warn "$msg\n" if $level <= $verbosity;
 }
-# find on_xxx subs in the package and register them
+my $extension_pkg = "extension0000";
-# as hooks
+my %extension_pkg;
-sub register_package($) {
-   my ($pkg) = @_;
-   for my $htype (0.. $#HOOKNAME) {
-      my $name = $HOOKNAME[$htype];
-      my $ref = $pkg->can ("on_" . lc $name)
-         or next;
-      $TERM->{_hook}[$htype]{$pkg} = $ref;
-      $hook_count[$htype]++
-         or set_should_invoke $htype, 1;
-   }
-}
-my $script_pkg = "script0000";
-my %script_pkg;
 # load a single script into its own package, once only
-sub script_package($) {
+sub extension_package($) {
    my ($path) = @_;
-   $script_pkg{$path} ||= do {
+   $extension_pkg{$path} ||= do {
-      my $pkg = "urxvt::" . ($script_pkg++);
+      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"
+      my $source = untaint "package $pkg; use strict; use utf8;\n"
+                   . "use base urxvt::term::proxy::;\n"
                    . "#line 1 \"$path\"\n{\n"
                    . (do { local $/; <$fh> })
                    . "\n};\n1";
       eval $source or die "$path: $@";
    local $TERM = shift;
    my $htype = shift;
    if ($htype == 0) { # INIT
       my @dirs = ((split /:/, $TERM->resource ("perl_lib")), "$LIBDIR/perl");
+      my %ext_arg;
-      for my $ext (map { split /,/, $TERM->resource ("perl_ext_$_") } 1, 2) {
+      for (map { split /,/, $TERM->resource ("perl_ext_$_") } 1, 2) {
+         if ($_ eq "default") {
+            $ext_arg{$_} ||= [] for qw(selection option-popup selection-popup);
+         } elsif (/^-(.*)$/) {
+            delete $ext_arg{$1};
+         } elsif (/^([^<]+)<(.*)>$/) {
+            push @{ $ext_arg{$1} }, $2;
+         } else {
+            $ext_arg{$_} ||= [];
+         }
+      }
+      while (my ($ext, $argv) = each %ext_arg) {
          my @files = grep -f $_, map "$_/$ext", @dirs;
          if (@files) {
-            register_package script_package $files[0];
+            $TERM->register_package (extension_package $files[0], $argv);
          } 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]) {
          if $verbosity >= 10;
       keys %$cb;
       while (my ($pkg, $cb) = each %$cb) {
-         $retval = $cb->(
+         $retval = eval { $cb->($TERM->{_pkg}{$pkg}, @_) }
-            $TERM->{_pkg}{$pkg} ||= do {
-               my $proxy = bless { }, urxvt::term::proxy::;
-               Scalar::Util::weaken ($proxy->{term} = $TERM);
-               $proxy
-            },
-            @_,
-         ) and last;
+            and last;
+         if ($@) {
+            $TERM->ungrab; # better to lose the grab than the session
+            warn $@;
+         }
       }
    }
    if ($htype == 1) { # DESTROY
       # remove hooks if unused
    }
    $retval
 }
+# urxvt::term::proxy
 sub urxvt::term::proxy::AUTOLOAD {
    $urxvt::term::proxy::AUTOLOAD =~ /:([^:]+)$/
       or die "FATAL: \$AUTOLOAD '$urxvt::term::proxy::AUTOLOAD' unparsable";
    eval qq{
    } or die "FATAL: unable to compile method forwarder: $@";
    goto &$urxvt::term::proxy::AUTOLOAD;
 }
+sub urxvt::term::proxy::DESTROY {
+   # nop
+}
+# urxvt::destroy_hook
+sub urxvt::destroy_hook::DESTROY {
+   ${$_[0]}->();
+}
+sub urxvt::destroy_hook(&) {
+   bless \shift, urxvt::destroy_hook::
+}
+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 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<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) = @_;
+   my $proxy = bless { argv => $argv }, $pkg;
+   Scalar::Util::weaken ($proxy->{term} = $TERM);
+   $self->{_pkg}{$pkg} = $proxy;
+   for my $htype (0.. $#HOOKNAME) {
+      my $name = $HOOKNAME[$htype];
+      my $ref = $pkg->can ("on_" . lc $name)
+         or next;
+      $self->{_hook}[$htype]{$pkg} = $ref;
+      $hook_count[$htype]++
+         or urxvt::set_should_invoke $htype, 1;
+   }
+}
 =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</src/optinc.h> 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
 optionally sets a new value. Setting values is most useful in the C<init>
 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
+are supported in every build, please see the source file F</src/rsinc.h>
-list:
+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
   shade term_name title transparent transparent_all tripleclickwords
   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;
+   &urxvt::term::_resource
 }
 =item $rend = $term->rstyle ([$new_rstyle])
 Return and optionally change the current rendition. Text that is output by
 If hidden, display the overlay again.
 =back
+=item $popup = $term->popup ($event)
+Creates a new C<urxvt::popup> object that implements a popup menu. The
+C<$event> I<must> 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 $nrow_plus_saveLines = $term->total_rows
 =item $lines_in_scrollback = $term->nsaved
 Return various integers describing terminal characteristics.
+=item $lc_ctype = $term->locale
+Returns the LC_CTYPE category string used by this rxvt-unicode.
+=item $x_display = $term->display_id
+Return the DISPLAY used by rxvt-unicode.
+=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])
 Returns the negative row number of the topmost line. Minimum value is
 C<0>, which displays the normal terminal contents. Larger values scroll
 =back
 =cut
-sub urxvt::term::line {
+sub line {
    my ($self, $row) = @_;
    my $maxrow = $self->nrow - 1;
    my ($beg, $end) = ($row, $row);
       $offset / $self->{ncol} + $self->{beg},
       $offset % $self->{ncol}
    )
 }
-=item ($row, $col) = $line->coord_of ($offset)
 =item $text = $term->special_encode $string
 Converts a perl string into the special encoding used by rxvt-unicode,
 where one character corresponds to one screen cell. See
 C<< $term->ROW_t >> for details.
 =item $string = $term->special_decode $text
 Converts rxvt-unicodes text reprsentation into a perl string. See
 C<< $term->ROW_t >> for details.
+=item $success = $term->grab_button ($button, $modifiermask)
+Registers 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 timestampe.
+=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 XUngrab 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.
 =back
+=cut
+package urxvt::popup;
+=head2 The C<urxvt::popup> 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 $self->{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 { ($_[0]{value} ? "* " : "  ") . $text },
+      activate => sub { $cb->($_[0]{value} = !$_[0]{value}); },
+   };
+   $self->add_item ($item);
+}
+sub show {
+   my ($self) = @_;
+   local $urxvt::popup::self = $self;
+   local $ENV{LC_ALL} = $self->{term}->locale;
+   urxvt->new ("--perl-lib" => "", "--perl-ext-common" => "", "-pty-fd" => -1, "-sl" => 0, "-b" => 0,
+               "--transient-for" => $self->{term}->parent,
+               "-display" => $self->{term}->display_id,
+               "-pe" => "urxvt-popup")
+      or die "unable to create popup window\n";
+}
+sub DESTROY {
+   my ($self) = @_;
+   delete $self->{term}{_destroy}{$self};
+   $self->{term}->ungrab;
+}
 =head2 The C<urxvt::timer> Class
 This class implements timer watchers/events. Time is represented as a
 fractional number of seconds since the epoch. Example:
 This variable controls the verbosity level of the perl extension. Higher
 numbers indicate more verbose output.
 =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 events received
 =back
 =head1 AUTHOR

Diff Legend

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

Comparing rxvt-unicode/src/urxvt.pm (file contents): Revision 1.42 by root, Fri Jan 6 21:06:09 2006 UTC vs. Revision 1.68 by root, Mon Jan 9 20:00:31 2006 UTC

Diff Legend

Comparing rxvt-unicode/src/urxvt.pm (file contents):
Revision 1.42 by root, Fri Jan 6 21:06:09 2006 UTC vs.
Revision 1.68 by root, Mon Jan 9 20:00:31 2006 UTC