[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.60 by root, Mon Jan 9 01:21:43 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.
 click) and is either supposed to return false (normal operation), or
 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
 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
 =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
 Rendition bitsets contain information about colour, font, font styles and
 =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};
       $hook_count[$htype]++
          or set_should_invoke $htype, 1;
    }
 }
-my $script_pkg = "script0000";
+my $extension_pkg = "extension0000";
-my %script_pkg;
+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 {
+   $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 %want_ext;
-      for my $ext (map { split /,/, $TERM->resource ("perl_ext_$_") } 1, 2) {
+      for (map { split /,/, $TERM->resource ("perl_ext_$_") } 1, 2) {
+         if ($_ eq "default") {
+            $want_ext{$_}++ for qw(selection option-popup selection-popup);
+         } elsif (/^-(.*)$/) {
+            delete $want_ext{$1};
+         } else {
+            $want_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";
          }
       }
+      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 = $cb->(
+            $retval = $cb->(
-            $TERM->{_pkg}{$pkg} ||= do {
+               $TERM->{_pkg}{$pkg} ||= do {
-               my $proxy = bless { }, urxvt::term::proxy::;
+                  my $proxy = bless { }, $pkg;
-               Scalar::Util::weaken ($proxy->{term} = $TERM);
+                  Scalar::Util::weaken ($proxy->{term} = $TERM);
-               $proxy
+                  $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
 =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 $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);
 Converts rxvt-unicodes text reprsentation into a perl string. See
 C<< $term->ROW_t >> for details.
 =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 $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 { ($_[0]{value} ? "* " : "  ") . $text },
+      activate => sub { $cb->($_[0]{value} = !$_[0]{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) = @_;
+   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.60 by root, Mon Jan 9 01:21:43 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.60 by root, Mon Jan 9 01:21:43 2006 UTC