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

Comparing rxvt-unicode/src/urxvt.pm (file contents):
Revision 1.5 by root, Mon Jan 2 17:20:00 2006 UTC vs.
Revision 1.7 by root, Mon Jan 2 19:05:05 2006 UTC

 rxvtperl - rxvt-unicode's embedded perl interpreter
 =head1 SYNOPSIS
 * Put your scripts into F<@@RXVT_LIBDIR@@/urxvt/perl-ext/>, they will be loaded automatically.
-* Each script will only be loaded once, even in urxvtd, and will be valid
-globally.
 * Scripts are evaluated in a 'use strict' and 'use utf8' environment, and
 thus must be encoded as UTF-8.
    sub on_sel_grab {
    1
 =head1 DESCRIPTION
+On startup, @@RXVT_NAME@@ will scan F<@@RXVT_LIBDIR@@/urxvt/perl-ext/>
+for files and will load them. Everytime a terminal object gets created,
+the directory specified by the C<perl-lib> resource will be additionally
+scanned.
+Each script will only ever be loaded once, even in @@RXVT_NAME@@d, where
+scripts will be shared for all terminals.
+Hooks in scripts specified by C<perl-lib> will only be called for the
+terminals created with that specific option value.
+=head2 General API Considerations
+All objects (such as terminals, time watchers etc.) are typical
+reference-to-hash objects. The hash can be used to store anything you
+like. All members starting with an underscore (such as C<_ptr> or
+C<_hook>) are reserved for internal uses and must not be accessed or
+modified).
+When objects are destroyed on the C++ side, the perl object hashes are
+emptied, so its best to store related objects such as time watchers and
+the like inside the terminal object so they get destroyed as soon as the
+terminal is destroyed.
 =head2 Hooks
 The following subroutines can be declared in loaded scripts, and will be called
 whenever the relevant event happens.
 costs! The only time this is acceptable is when the terminal process
 starts up.
 =item urxvt::warn $string
-Calls C<rxvt_warn> witht eh given string which should not include a
+Calls C<rxvt_warn> with the given string which should not include a
 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 $cellwidth = urxvt::wcswidth $string
-Returns the number of screen-cells this string would need. Correctly
-accounts for wide and combining characters.
 =item $time = urxvt::NOW
 Returns the "current time" (as per the event loop).
          unless $msg =~ /\n$/;
       urxvt::warn ($msg);
    };
 }
-my $verbosity = $ENV{URXVT_PERL_VERBOSITY} || 10;
+my $verbosity = $ENV{URXVT_PERL_VERBOSITY};
 sub verbose {
    my ($level, $msg) = @_;
-   warn "$msg\n"; #d#
+   warn "$msg\n" if $level < $verbosity;
 }
-my @invoke_cb;
+my %hook_global;
+my @hook_count;
 # called by the rxvt core
 sub invoke {
    local $term = shift;
    my $htype = shift;
-   my $cb = $invoke_cb[$htype];
    verbose 10, "$HOOKNAME[$htype] (" . (join ", ", $term, @_) . ")"
       if $verbosity >= 10;
+   for my $cb ($hook_global{_hook}[$htype], $term->{_hook}[$htype]) {
+      $cb or next;
-   while (my ($k, $v) = each %$cb) {
+      while (my ($k, $v) = each %$cb) {
-      return 1 if $v->($term, @_);
+         return 1 if $v->($term, @_);
+      }
    }
    0
 }
 # find on_xxx subs in the package and register them
 # as hooks
 sub register_package($) {
    my ($pkg) = @_;
-   for my $hook (0.. $#HOOKNAME) {
+   for my $htype (0.. $#HOOKNAME) {
-      my $name = $HOOKNAME[$hook];
+      my $name = $HOOKNAME[$htype];
       my $ref = $pkg->can ("on_" . lc $name)
          or next;
-      $invoke_cb[$hook]{$ref*1} = $ref;
+      $term->{_hook}[$htype]{$ref*1} = $ref;
+      $hook_count[$htype]++
-      set_should_invoke $hook, 1;
+         or set_should_invoke $htype, 1;
    }
 }
 my $script_pkg = "script0000";
 my %script_pkg;
 # load a single script into its own package, once only
-sub load_script($) {
+sub script_package($) {
    my ($path) = @_;
    $script_pkg{$path} ||= do {
       my $pkg = $script_pkg++;
       verbose 3, "loading script '$path' into package '$pkg'";
       eval "package $pkg; use strict; use utf8;\n"
          . "#line 1 \"$path\"\n"
          . do { local $/; <$fh> }
          or die "$path: $@";
-      register_package $pkg;
       $pkg
-   };
+   }
 }
-load_script $_ for grep -f $_, <$LIBDIR/perl-ext/*>;
+sub load_scripts($) {
+   my ($dir) = @_;
+   verbose 3, "loading scripts from '$dir'";
+   register_package script_package $_
+      for grep -f $_,
+         <$dir/*>;
+}
+sub on_init {
+   my ($term) = @_;
+   my $libdir = $term->resource ("perl_lib");
+   load_scripts $libdir
+      if defined $libdir;
+}
+sub on_destroy {
+   my ($term) = @_;
+   my $hook = $term->{_hook}
+      or return;
+   for my $htype (0..$#$hook) {
+      $hook_count[$htype] -= scalar keys %{ $hook->[$htype] || {} }
+         or set_should_invoke $htype, 0;
+   }
+}
+{
+   local $term = \%hook_global;
+   register_package __PACKAGE__;
+   load_scripts "$LIBDIR/perl-ext";
+}
 =back
 =head2 The C<urxvt::term> Class
   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
   italicFont jumpScroll lineSpace loginShell mapAlert menu meta8
-  modifier mouseWheelScrollPage name pastableTabs path pointerBlank
+  modifier mouseWheelScrollPage name pastableTabs path perl perl_eval
-  pointerBlankDelay preeditType print_pipe pty_fd reverseVideo saveLines
+  perl_lib pointerBlank pointerBlankDelay preeditType print_pipe pty_fd
-  scrollBar scrollBar_align scrollBar_floating scrollBar_right
+  reverseVideo saveLines scrollBar scrollBar_align scrollBar_floating
-  scrollBar_thickness scrollTtyKeypress scrollTtyOutput scrollWithBuffer
+  scrollBar_right scrollBar_thickness scrollTtyKeypress scrollTtyOutput
-  scrollstyle secondaryScreen secondaryScroll selectstyle shade term_name
+  scrollWithBuffer scrollstyle secondaryScreen secondaryScroll selectstyle
-  title transparent transparent_all tripleclickwords utmpInhibit
+  shade term_name title transparent transparent_all tripleclickwords
-  visualBell
+  utmpInhibit visualBell
 =cut
 sub urxvt::term::resource($$;$) {
    my ($self, $name) = (shift, shift);
    my ($self, $x, $y, $text) = @_;
    my @lines = split /\n/, $text;
    my $w = 0;
-   for (map urxvt::wcswidth $_, @lines) {
+   for (map $self->strwidth ($_), @lines) {
       $w = $_ if $w < $_;
    }
    $self->scr_overlay_new ($x, $y, $w, scalar @lines);
    $self->scr_overlay_set (0, $_, $lines[$_]) for 0.. $#lines;
 position.
 =item $term->scr_overlay_set ($x, $y, $text)
 Write a string at the given position into the overlay.
+=item $cellwidth = $term->strwidth $string
+Returns the number of screen-cells this string would need. Correctly
+accounts for wide and combining characters.
+=item $octets = $term->locale_encode $string
+Convert the given text string into the corresponding locale encoding.
+=item $string = $term->locale_decode $octets
+Convert the given locale-encoded octets into a perl string.
+=item $term->tt_write ($octets)
+Write the octets given in C<$data> to the tty (i.e. as program input). To
+pass characters instead of octets, you should convetr you strings first to
+the locale-specific encoding using C<< $term->locale_encode >>.
 =back
 =head2 The C<urxvt::timer> Class

Diff Legend

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

Comparing rxvt-unicode/src/urxvt.pm (file contents): Revision 1.5 by root, Mon Jan 2 17:20:00 2006 UTC vs. Revision 1.7 by root, Mon Jan 2 19:05:05 2006 UTC

Diff Legend

Comparing rxvt-unicode/src/urxvt.pm (file contents):
Revision 1.5 by root, Mon Jan 2 17:20:00 2006 UTC vs.
Revision 1.7 by root, Mon Jan 2 19:05:05 2006 UTC