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

Comparing rxvt-unicode/src/urxvt.pm (file contents):
Revision 1.57 by root, Sun Jan 8 08:43:11 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
 newline. The module also overwrites the C<warn> builtin with a function
 that calls this function.
 Using this function has the advantage that its output ends up in the
 correct place, e.g. on stderr of the connecting urxvtc client.
+=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).
       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";
-      $source =~ /(.*)/s and $source = $1; # untaint
       eval $source or die "$path: $@";
       $pkg
    }
 }
    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";
          }
       }
          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
       }
       1
    } 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 {
 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 $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
       $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;
 }
 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.57 by root, Sun Jan 8 08:43:11 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.57 by root, Sun Jan 8 08:43:11 2006 UTC vs.
Revision 1.68 by root, Mon Jan 9 20:00:31 2006 UTC