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

Comparing rxvt-unicode/src/urxvt.pm (file contents):
Revision 1.48 by root, Sat Jan 7 21:43:17 2006 UTC vs.
Revision 1.68 by root, Mon Jan 9 20:00:31 2006 UTC

   @@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.
 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;
 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
-# 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";
    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 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.).
+=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);
    &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};
+   $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,
+   $self->add_item ({ type => "button", text => $text, activate => $cb});
-      render => sub { $_[0]{text} },
-   });
 }
 sub add_toggle {
    my ($self, $text, $cb, $value) = @_;
-   $self->add_item ({ type => "button", text => "  $text", value => $value,
+   my $item; $item = {
+      type => "button",
+      text => "  $text",
+      value => $value,
-      render => sub { ($_[0]{value} ? "✔" : " ") . substr $_[0]{text}, 1 },
+      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 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.48 by root, Sat Jan 7 21:43:17 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.48 by root, Sat Jan 7 21:43:17 2006 UTC vs.
Revision 1.68 by root, Mon Jan 9 20:00:31 2006 UTC