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

Comparing rxvt-unicode/src/urxvt.pm (file contents):
Revision 1.54 by root, Sun Jan 8 01:59:29 2006 UTC vs.
Revision 1.68 by root, Mon Jan 9 20:00:31 2006 UTC

 =back
 =item option-popup (enabled by default)
-Binds a popup menu to Ctrl-Button3 that lets you toggle (some) options at
+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.
 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
 information is up-to-date when this happens. For interoperability, the
 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 events.
+Various constants for use in X calls and event processing.
 =back
 =head2 RENDITION
 use utf8;
 use strict;
 use Scalar::Util ();
 use List::Util ();
+our $VERSION = 1;
 our $TERM;
 our @HOOKNAME;
 our %OPTION;
 our $LIBDIR;
       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
-# as hooks
-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 $extension_pkg = "extension0000";
 my %extension_pkg;
 # load a single script into its own package, once only
 sub extension_package($) {
       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";
    my $htype = shift;
    if ($htype == 0) { # INIT
       my @dirs = ((split /:/, $TERM->resource ("perl_lib")), "$LIBDIR/perl");
-      my %want_ext;
+      my %ext_arg;
       for (map { split /,/, $TERM->resource ("perl_ext_$_") } 1, 2) {
          if ($_ eq "default") {
-            $want_ext{$_}++ for qw(selection option-popup);
+            $ext_arg{$_} ||= [] for qw(selection option-popup selection-popup);
          } elsif (/^-(.*)$/) {
-            delete $want_ext{$1};
+            delete $ext_arg{$1};
+         } elsif (/^([^<]+)<(.*)>$/) {
+            push @{ $ext_arg{$1} }, $2;
          } else {
-            $want_ext{$_}++;
+            $ext_arg{$_} ||= [];
          }
       }
-      for my $ext (keys %want_ext) {
+      while (my ($ext, $argv) = each %ext_arg) {
          my @files = grep -f $_, map "$_/$ext", @dirs;
          if (@files) {
-            register_package extension_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) {
-         eval {
+         $retval = eval { $cb->($TERM->{_pkg}{$pkg}, @_) }
-            $retval = $cb->(
-               $TERM->{_pkg}{$pkg} ||= do {
-                  my $proxy = bless { }, $pkg;
-                  Scalar::Util::weaken ($proxy->{term} = $TERM);
-                  $proxy
-               },
-               @_,
-            ) and last;
+            and last;
+         if ($@) {
+            $TERM->ungrab; # better to lose the grab than the session
+            warn $@;
-         };
+         }
-         warn $@ if $@;#d#
       }
    }
    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.).
   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);
    &urxvt::term::_resource
 }
 C<$event> I<must> be the event causing the menu to pop up (a button event,
 currently).
 =cut
-sub urxvt::term::popup {
+sub popup {
    my ($self, $event) = @_;
    $self->grab ($event->{time}, 1)
       or return;
 =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
 =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
-package urxvt::popup;
 sub add_item {
    my ($self, $item) = @_;
    $item->{rend}{normal} = "\x1b[0;30;47m" unless exists $item->{rend}{normal};
 }
 sub add_separator {
    my ($self, $sep) = @_;
-   $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 },
+      render => sub { $sep x $self->{term}->ncol },
       activate => sub { },
    });
 }
 sub add_title {
 }
 sub add_button {
    my ($self, $text, $cb) = @_;
-   $self->add_item ({ type => "button", text => "[ $text ]", activate => $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 },
+      render => sub { ($_[0]{value} ? "* " : "  ") . $text },
-      activate => sub { $cb->($item->{value} = !$item->{value}); },
+      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 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.54 by root, Sun Jan 8 01:59:29 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.54 by root, Sun Jan 8 01:59:29 2006 UTC vs.
Revision 1.68 by root, Mon Jan 9 20:00:31 2006 UTC