rxvt-unicode/src/urxvt.pm

=head1 NAME

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 {
      warn "you selected ", $_[0]->selection;
      ()
   }

   1

=head1 DESCRIPTION

=head2 Hooks

The following subroutines can be declared in loaded scripts, and will be called
whenever the relevant event happens.

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.

When in doubt, return a false value (preferably C<()>).

=over 4

=item on_init $term

Called after a new terminal object has been initialized, but before
windows are created or the command gets run.

=item on_reset $term

Called after the screen is "reset" for any reason, such as resizing or
control sequences. Here is where you can react on changes to size-related
variables.

=item on_start $term

Called at the very end of initialisation of a new terminal, just before
returning to the mainloop.

=item on_sel_make $term, $eventtime

Called whenever a selection has been made by the user, but before the
selection text is copied, so changes to the beginning, end or type of the
selection will be honored.

Returning a true value aborts selection making by urxvt, in which case you
have to make a selection yourself by calling C<< $term->selection_grab >>.

=item on_sel_grab $term, $eventtime

Called whenever a selection has been copied, but before the selection is
requested from the server.  The selection text can be queried and changed
by calling C<< $term->selection >>.

Returning a true value aborts selection grabbing. It will still be hilighted.

=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
show this many lines of scrollback.

=item on_scroll_back $term, $lines, $saved

Called whenever lines scroll out of the terminal area into the scrollback
buffer. C<$lines> is the number of lines scrolled out and may be larger
than the scroll back buffer or the terminal.

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_refresh_begin $term

Called just before the screen gets redrawn. Can be used for overlay
or similar effects by modify terminal contents in refresh_begin, and
restoring them in refresh_end. The built-in overlay and selection display
code is run after this hook, and takes precedence.

=item on_refresh_end $term

Called just after the screen gets redrawn. See C<on_refresh_begin>.

=back

=head2 Functions in the C<urxvt> Package

=over 4

=item urxvt::fatal $errormessage

Fatally aborts execution with the given error message. Avoid at all
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
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).

=cut

package urxvt;

use strict;

our $term;
our @HOOKNAME;
our $LIBDIR;

BEGIN {
   urxvt->bootstrap;

   # overwrite perl's warn
   *CORE::GLOBAL::warn = sub {
      my $msg = join "", @_;
      $msg .= "\n"
         unless $msg =~ /\n$/;
      urxvt::warn ($msg);
   };
}

my $verbosity = $ENV{URXVT_PERL_VERBOSITY} || 10;

sub verbose {
   my ($level, $msg) = @_;
   warn "$msg\n"; #d#
}

my @invoke_cb;

# 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;

   while (my ($k, $v) = each %$cb) {
      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) {
      my $name = $HOOKNAME[$hook];

      my $ref = $pkg->can ("on_" . lc $name)
         or next;

      $invoke_cb[$hook]{$ref*1} = $ref;
      set_should_invoke $hook, 1;
   }
}

my $script_pkg = "script0000";
my %script_pkg;

# load a single script into its own package, once only
sub load_script($) {
   my ($path) = @_;

   $script_pkg{$path} ||= do {
      my $pkg = $script_pkg++;
      verbose 3, "loading script '$path' into package '$pkg'";

      open my $fh, "<:raw", $path
         or die "$path: $!";

      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/*>;

=back

=head2 The C<urxvt::term> Class

=over 4

=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>
hook. Unset resources are returned and accepted as C<undef>.

The new value must be properly encoded to a suitable character encoding
before passing it to this method. Similarly, the returned value may need
to be converted from the used encoding to text.

Resource names are as defined in F<src/rsinc.h>. Colours can be specified
as resource names of the form C<< color+<index> >>, e.g. C<color+5>. (will
likely change).

Please note that resource strings will currently only be freed when the
terminal is destroyed, so changing options frequently will eat memory.

=cut

sub urxvt::term::resource($$;$) {
   my ($self, $name) = (shift, shift);
   unshift @_, $self, $name, ($name =~ s/\s*\+\s*(\d+)$// ? $1 : 0);
   goto &urxvt::term::_resource;
}

=item ($row, $col) = $term->selection_mark ([$row, $col])

=item ($row, $col) = $term->selection_beg ([$row, $col])

=item ($row, $col) = $term->selection_end ([$row, $col])

Return the current values of the selection mark, begin or end positions,
and optionally set them to new values.

=item $success = $term->selection_grab ($eventtime)

Try to request the primary selection from the server (for example, as set
by the next method).

=item $oldtext = $term->selection ([$newtext])

Return the current selection text and optionally replace it by C<$newtext>.

=item $term->scr_overlay ($x, $y, $text)

Create a simple multi-line overlay box. See the next method for details.

=cut

sub urxvt::term::scr_overlay {
   my ($self, $x, $y, $text) = @_;

   my @lines = split /\n/, $text;

   my $w = 0;
   for (map urxvt::wcswidth $_, @lines) {
      $w = $_ if $w < $_;
   }

   $self->scr_overlay_new ($x, $y, $w, scalar @lines);
   $self->scr_overlay_set (0, $_, $lines[$_]) for 0.. $#lines;
}

=item $term->scr_overlay_new ($x, $y, $width, $height)

Create a new (empty) overlay at the given position with the given
width/height. A border will be put around the box. If either C<$x> or
C<$y> is negative, then this is counted from the right/bottom side,
respectively.

=item $term->scr_overlay_off

Switch the overlay off again.

=item $term->scr_overlay_set_char ($x, $y, $char, $rend = OVERLAY_RSTYLE)

Put a single character (specified numerically) at the given overlay
position.

=item $term->scr_overlay_set ($x, $y, $text)

Write a string at the given position into the overlay.

=back

=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:

   # create a digital clock display in upper right corner
   $term->{timer} = urxvt::timer
                    ->new
                    ->start (urxvt::NOW)
                    ->cb (sub {
                       my ($timer) = @_;
                       my $time = $timer->at;
                       $timer->start ($time + 1);
                       $self->scr_overlay (-1, 0, 
                          POSIX::strftime "%H:%M:%S", localtime $time);
                    });

=over 4

=item $timer = new urxvt::timer

Create a new timer object in stopped state.

=item $timer = $timer->cb (sub { my ($timer) = @_; ... })

Set the callback to be called when the timer triggers.

=item $tstamp = $timer->at

Return the time this watcher will fire next.

=item $timer = $timer->set ($tstamp)

Set the time the event is generated to $tstamp.

=item $timer = $timer->start

Start the timer.

=item $timer = $timer->start ($tstamp)

Set the event trigger time to C<$tstamp> and start the timer.

=item $timer = $timer->stop

Stop the timer.

=back

=head2 The C<urxvt::iow> Class

This class implements io watchers/events. Example:

  $term->{socket} = ...
  $term->{iow} = urxvt::iow
                 ->new
                 ->fd (fileno $term->{socket})
                 ->events (1) # wait for read data
                 ->start
                 ->cb (sub {
                   my ($iow, $revents) = @_;
                   # $revents must be 1 here, no need to check
                   sysread $term->{socket}, my $buf, 8192
                      or end-of-file;
                 });


=over 4

=item $iow = new urxvt::iow

Create a new io watcher object in stopped state.

=item $iow = $iow->cb (sub { my ($iow, $reventmask) = @_; ... })

Set the callback to be called when io events are triggered. C<$reventmask>
is a bitset as described in the C<events> method.

=item $iow = $iow->fd ($fd)

Set the filedescriptor (not handle) to watch.

=item $iow = $iow->events ($eventmask)

Set the event mask to watch. Bit #0 (value C<1>) enables watching for read
data, Bit #1 (value C<2>) enables watching for write data.

=item $iow = $iow->start

Start watching for requested events on the given handle.

=item $iow = $iow->stop

Stop watching for events on the given filehandle.

=back

=head1 ENVIRONMENT

=head2 URXVT_PERL_VERBOSITY

This variable controls the verbosity level of the perl extension. Higher
numbers indicate more verbose output.

=over 4

=item 0 - only fatal messages

=item 3 - script loading and management

=item 10 - all events received

=back

=head1 AUTHOR

 Marc Lehmann <pcg@goof.com>
 http://software.schmorp.de/pkg/rxvt-unicode

=cut

1
Revision:	1.4
Committed:	Mon Jan 2 17:17:02 2006 UTC (20 years, 9 months ago) by root
Branch:	MAIN
Changes since 1.3:	+42 -1 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.1	=head1 NAME
2
3	root	1.3	rxvtperl - rxvt-unicode's embedded perl interpreter
4	root	1.1
5			=head1 SYNOPSIS
6
7	root	1.3	* Put your scripts into F<@@RXVT_LIBDIR@@/urxvt/perl-ext/>, they will be loaded automatically.
8	root	1.1
9	root	1.3	* Each script will only be loaded once, even in urxvtd, and will be valid
10	root	1.1	globally.
11
12	root	1.3	* Scripts are evaluated in a 'use strict' and 'use utf8' environment, and
13			thus must be encoded as UTF-8.
14	root	1.1
15			sub on_sel_grab {
16			warn "you selected ", $_[0]->selection;
17	root	1.3	()
18	root	1.1	}
19
20			1
21
22			=head1 DESCRIPTION
23
24			=head2 Hooks
25
26			The following subroutines can be declared in loaded scripts, and will be called
27			whenever the relevant event happens.
28
29			All of them must return a boolean value. If it is true, then the event
30			counts as being I<consumed>, and the invocation of other hooks is skipped,
31			and the relevant action might not be carried out by the C++ code.
32
33			When in doubt, return a false value (preferably C<()>).
34
35			=over 4
36
37			=item on_init $term
38
39			Called after a new terminal object has been initialized, but before
40			windows are created or the command gets run.
41
42			=item on_reset $term
43
44			Called after the screen is "reset" for any reason, such as resizing or
45			control sequences. Here is where you can react on changes to size-related
46			variables.
47
48			=item on_start $term
49
50			Called at the very end of initialisation of a new terminal, just before
51			returning to the mainloop.
52
53			=item on_sel_make $term, $eventtime
54
55			Called whenever a selection has been made by the user, but before the
56			selection text is copied, so changes to the beginning, end or type of the
57			selection will be honored.
58
59			Returning a true value aborts selection making by urxvt, in which case you
60			have to make a selection yourself by calling C<< $term->selection_grab >>.
61
62			=item on_sel_grab $term, $eventtime
63
64			Called whenever a selection has been copied, but before the selection is
65			requested from the server. The selection text can be queried and changed
66			by calling C<< $term->selection >>.
67
68			Returning a true value aborts selection grabbing. It will still be hilighted.
69
70			=item on_focus_in $term
71
72			Called whenever the window gets the keyboard focus, before urxvt does
73			focus in processing.
74
75			=item on_focus_out $term
76
77			Called wheneever the window loses keyboard focus, before urxvt does focus
78			out processing.
79
80			=item on_view_change $term, $offset
81
82			Called whenever the view offset changes, i..e the user or program
83			scrolls. Offset C<0> means display the normal terminal, positive values
84			show this many lines of scrollback.
85
86			=item on_scroll_back $term, $lines, $saved
87
88			Called whenever lines scroll out of the terminal area into the scrollback
89			buffer. C<$lines> is the number of lines scrolled out and may be larger
90			than the scroll back buffer or the terminal.
91
92			It is called before lines are scrolled out (so rows 0 .. min ($lines - 1,
93			$nrow - 1) represent the lines to be scrolled out). C<$saved> is the total
94			number of lines that will be in the scrollback buffer.
95
96			=item on_tty_activity $term NYI
97
98			Called whenever the program(s) running in the urxvt window send output.
99
100			=item on_refresh_begin $term
101
102			Called just before the screen gets redrawn. Can be used for overlay
103			or similar effects by modify terminal contents in refresh_begin, and
104			restoring them in refresh_end. The built-in overlay and selection display
105			code is run after this hook, and takes precedence.
106
107			=item on_refresh_end $term
108
109			Called just after the screen gets redrawn. See C<on_refresh_begin>.
110
111			=back
112
113			=head2 Functions in the C<urxvt> Package
114
115			=over 4
116
117			=item urxvt::fatal $errormessage
118
119			Fatally aborts execution with the given error message. Avoid at all
120			costs! The only time this is acceptable is when the terminal process
121			starts up.
122
123			=item urxvt::warn $string
124
125			Calls C<rxvt_warn> witht eh given string which should not include a
126			newline. The module also overwrites the C<warn> builtin with a function
127			that calls this function.
128
129			Using this function has the advantage that its output ends up in the
130			correct place, e.g. on stderr of the connecting urxvtc client.
131
132			=item $cellwidth = urxvt::wcswidth $string
133
134			Returns the number of screen-cells this string would need. Correctly
135			accounts for wide and combining characters.
136
137			=item $time = urxvt::NOW
138
139			Returns the "current time" (as per the event loop).
140
141			=cut
142
143			package urxvt;
144
145			use strict;
146
147			our $term;
148			our @HOOKNAME;
149			our $LIBDIR;
150
151			BEGIN {
152			urxvt->bootstrap;
153
154			# overwrite perl's warn
155			*CORE::GLOBAL::warn = sub {
156			my $msg = join "", @_;
157			$msg .= "\n"
158			unless $msg =~ /\n$/;
159			urxvt::warn ($msg);
160			};
161			}
162
163			my $verbosity = $ENV{URXVT_PERL_VERBOSITY} \|\| 10;
164
165			sub verbose {
166			my ($level, $msg) = @_;
167			warn "$msg\n"; #d#
168			}
169
170			my @invoke_cb;
171
172			# called by the rxvt core
173			sub invoke {
174			local $term = shift;
175			my $htype = shift;
176
177			my $cb = $invoke_cb[$htype];
178
179			verbose 10, "$HOOKNAME[$htype] (" . (join ", ", $term, @_) . ")"
180			if $verbosity >= 10;
181
182			while (my ($k, $v) = each %$cb) {
183			return 1 if $v->($term, @_);
184			}
185
186			0
187			}
188
189			# find on_xxx subs in the package and register them
190			# as hooks
191			sub register_package($) {
192			my ($pkg) = @_;
193
194			for my $hook (0.. $#HOOKNAME) {
195			my $name = $HOOKNAME[$hook];
196
197			my $ref = $pkg->can ("on_" . lc $name)
198			or next;
199
200			$invoke_cb[$hook]{$ref*1} = $ref;
201			set_should_invoke $hook, 1;
202			}
203			}
204
205			my $script_pkg = "script0000";
206			my %script_pkg;
207
208			# load a single script into its own package, once only
209			sub load_script($) {
210			my ($path) = @_;
211
212			$script_pkg{$path} \|\|= do {
213			my $pkg = $script_pkg++;
214			verbose 3, "loading script '$path' into package '$pkg'";
215
216			open my $fh, "<:raw", $path
217			or die "$path: $!";
218
219			eval "package $pkg; use strict; use utf8;\n"
220			. "#line 1 \"$path\"\n"
221			. do { local $/; <$fh> }
222			or die "$path: $@";
223
224			register_package $pkg;
225
226			$pkg
227			};
228			}
229
230	root	1.2	load_script $_ for grep -f $_, <$LIBDIR/perl-ext/*>;
231	root	1.1
232			=back
233
234			=head2 The C<urxvt::term> Class
235
236			=over 4
237
238	root	1.4	=item $value = $term->resource ($name[, $newval])
239
240			Returns the current resource value associated with a given name and
241			optionally sets a new value. Setting values is most useful in the C<init>
242			hook. Unset resources are returned and accepted as C<undef>.
243
244			The new value must be properly encoded to a suitable character encoding
245			before passing it to this method. Similarly, the returned value may need
246			to be converted from the used encoding to text.
247
248			Resource names are as defined in F<src/rsinc.h>. Colours can be specified
249			as resource names of the form C<< color+<index> >>, e.g. C<color+5>. (will
250			likely change).
251
252			Please note that resource strings will currently only be freed when the
253			terminal is destroyed, so changing options frequently will eat memory.
254
255			=cut
256
257			sub urxvt::term::resource($$;$) {
258			my ($self, $name) = (shift, shift);
259			unshift @_, $self, $name, ($name =~ s/\s\+\s(\d+)$// ? $1 : 0);
260			goto &urxvt::term::_resource;
261			}
262
263	root	1.1	=item ($row, $col) = $term->selection_mark ([$row, $col])
264
265			=item ($row, $col) = $term->selection_beg ([$row, $col])
266
267			=item ($row, $col) = $term->selection_end ([$row, $col])
268
269			Return the current values of the selection mark, begin or end positions,
270			and optionally set them to new values.
271
272			=item $success = $term->selection_grab ($eventtime)
273
274			Try to request the primary selection from the server (for example, as set
275			by the next method).
276
277			=item $oldtext = $term->selection ([$newtext])
278
279			Return the current selection text and optionally replace it by C<$newtext>.
280
281			=item $term->scr_overlay ($x, $y, $text)
282
283			Create a simple multi-line overlay box. See the next method for details.
284
285			=cut
286
287			sub urxvt::term::scr_overlay {
288			my ($self, $x, $y, $text) = @_;
289
290			my @lines = split /\n/, $text;
291
292			my $w = 0;
293			for (map urxvt::wcswidth $_, @lines) {
294			$w = $_ if $w < $_;
295			}
296
297			$self->scr_overlay_new ($x, $y, $w, scalar @lines);
298			$self->scr_overlay_set (0, $_, $lines[$_]) for 0.. $#lines;
299			}
300
301			=item $term->scr_overlay_new ($x, $y, $width, $height)
302
303			Create a new (empty) overlay at the given position with the given
304			width/height. A border will be put around the box. If either C<$x> or
305			C<$y> is negative, then this is counted from the right/bottom side,
306			respectively.
307
308			=item $term->scr_overlay_off
309
310			Switch the overlay off again.
311
312			=item $term->scr_overlay_set_char ($x, $y, $char, $rend = OVERLAY_RSTYLE)
313
314			Put a single character (specified numerically) at the given overlay
315			position.
316
317			=item $term->scr_overlay_set ($x, $y, $text)
318
319			Write a string at the given position into the overlay.
320
321			=back
322
323			=head2 The C<urxvt::timer> Class
324
325			This class implements timer watchers/events. Time is represented as a
326			fractional number of seconds since the epoch. Example:
327
328			# create a digital clock display in upper right corner
329			$term->{timer} = urxvt::timer
330			->new
331			->start (urxvt::NOW)
332			->cb (sub {
333			my ($timer) = @_;
334			my $time = $timer->at;
335			$timer->start ($time + 1);
336			$self->scr_overlay (-1, 0,
337			POSIX::strftime "%H:%M:%S", localtime $time);
338			});
339
340			=over 4
341
342			=item $timer = new urxvt::timer
343
344			Create a new timer object in stopped state.
345
346			=item $timer = $timer->cb (sub { my ($timer) = @_; ... })
347
348			Set the callback to be called when the timer triggers.
349
350			=item $tstamp = $timer->at
351
352			Return the time this watcher will fire next.
353
354			=item $timer = $timer->set ($tstamp)
355
356			Set the time the event is generated to $tstamp.
357
358			=item $timer = $timer->start
359
360			Start the timer.
361
362			=item $timer = $timer->start ($tstamp)
363
364			Set the event trigger time to C<$tstamp> and start the timer.
365
366			=item $timer = $timer->stop
367
368			Stop the timer.
369
370			=back
371
372			=head2 The C<urxvt::iow> Class
373
374			This class implements io watchers/events. Example:
375
376			$term->{socket} = ...
377			$term->{iow} = urxvt::iow
378			->new
379			->fd (fileno $term->{socket})
380			->events (1) # wait for read data
381			->start
382			->cb (sub {
383			my ($iow, $revents) = @_;
384			# $revents must be 1 here, no need to check
385			sysread $term->{socket}, my $buf, 8192
386			or end-of-file;
387			});
388
389
390			=over 4
391
392			=item $iow = new urxvt::iow
393
394			Create a new io watcher object in stopped state.
395
396			=item $iow = $iow->cb (sub { my ($iow, $reventmask) = @_; ... })
397
398			Set the callback to be called when io events are triggered. C<$reventmask>
399			is a bitset as described in the C<events> method.
400
401			=item $iow = $iow->fd ($fd)
402
403			Set the filedescriptor (not handle) to watch.
404
405			=item $iow = $iow->events ($eventmask)
406
407			Set the event mask to watch. Bit #0 (value C<1>) enables watching for read
408			data, Bit #1 (value C<2>) enables watching for write data.
409
410			=item $iow = $iow->start
411
412			Start watching for requested events on the given handle.
413
414			=item $iow = $iow->stop
415
416			Stop watching for events on the given filehandle.
417
418			=back
419
420	root	1.4	=head1 ENVIRONMENT
421
422			=head2 URXVT_PERL_VERBOSITY
423
424			This variable controls the verbosity level of the perl extension. Higher
425			numbers indicate more verbose output.
426
427			=over 4
428
429			=item 0 - only fatal messages
430
431			=item 3 - script loading and management
432
433			=item 10 - all events received
434
435			=back
436
437	root	1.1	=head1 AUTHOR
438
439			Marc Lehmann <pcg@goof.com>
440			http://software.schmorp.de/pkg/rxvt-unicode
441
442			=cut
443
444			1