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

Comparing rxvt-unicode/src/urxvt.pm (file contents):
Revision 1.43 by root, Sat Jan 7 04:19:43 2006 UTC vs.
Revision 1.46 by root, Sat Jan 7 20:29:28 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
 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
       $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"
+                   . "use base urxvt::term::proxy::;\n"
                    . "#line 1 \"$path\"\n{\n"
                    . (do { local $/; <$fh> })
                    . "\n};\n1";
       eval $source or die "$path: $@";
       for my $ext (map { split /,/, $TERM->resource ("perl_ext_$_") } 1, 2) {
          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";
          }
       }
    }
          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;
+         };
+         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::destroy_hook::DESTROY {
+   ${$_[0]}->();
+}
+sub urxvt::destroy_hook(&) {
+   bless \shift, urxvt::destroy_hook::
 }
 =head2 The C<urxvt::term> Class
 =over 4
 =cut
 sub urxvt::term::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 urxvt::term::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.
 Converts rxvt-unicodes text reprsentation into a perl string. See
 C<< $term->ROW_t >> for details.
 =back
+=head2 The C<urxvt::popup> Class
+=over 4
+=cut
+package urxvt::popup;
+sub add_item {
+   my ($self, $item) = @_;
+   push @{ $self->{item} }, $item;
+}
+sub add_button {
+   my ($self, $text, $cb) = @_;
+   $self->add_item ({ type => "button", text => "[ $text ]", activate => $cb });
+}
+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) = @_;
+   $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:

Diff Legend

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

Comparing rxvt-unicode/src/urxvt.pm (file contents): Revision 1.43 by root, Sat Jan 7 04:19:43 2006 UTC vs. Revision 1.46 by root, Sat Jan 7 20:29:28 2006 UTC

Diff Legend

Comparing rxvt-unicode/src/urxvt.pm (file contents):
Revision 1.43 by root, Sat Jan 7 04:19:43 2006 UTC vs.
Revision 1.46 by root, Sat Jan 7 20:29:28 2006 UTC