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 ($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 AUTHOR

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

=cut

1
Revision:	1.3
Committed:	Mon Jan 2 15:59:25 2006 UTC (18 years, 4 months ago) by root
Branch:	MAIN
Changes since 1.2:	+6 -5 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
233			=back
234
235			=head2 The C<urxvt::term> Class
236
237			=over 4
238
239			=item ($row, $col) = $term->selection_mark ([$row, $col])
240
241			=item ($row, $col) = $term->selection_beg ([$row, $col])
242
243			=item ($row, $col) = $term->selection_end ([$row, $col])
244
245			Return the current values of the selection mark, begin or end positions,
246			and optionally set them to new values.
247
248			=item $success = $term->selection_grab ($eventtime)
249
250			Try to request the primary selection from the server (for example, as set
251			by the next method).
252
253			=item $oldtext = $term->selection ([$newtext])
254
255			Return the current selection text and optionally replace it by C<$newtext>.
256
257			=item $term->scr_overlay ($x, $y, $text)
258
259			Create a simple multi-line overlay box. See the next method for details.
260
261			=cut
262
263			sub urxvt::term::scr_overlay {
264			my ($self, $x, $y, $text) = @_;
265
266			my @lines = split /\n/, $text;
267
268			my $w = 0;
269			for (map urxvt::wcswidth $_, @lines) {
270			$w = $_ if $w < $_;
271			}
272
273			$self->scr_overlay_new ($x, $y, $w, scalar @lines);
274			$self->scr_overlay_set (0, $_, $lines[$_]) for 0.. $#lines;
275			}
276
277			=item $term->scr_overlay_new ($x, $y, $width, $height)
278
279			Create a new (empty) overlay at the given position with the given
280			width/height. A border will be put around the box. If either C<$x> or
281			C<$y> is negative, then this is counted from the right/bottom side,
282			respectively.
283
284			=item $term->scr_overlay_off
285
286			Switch the overlay off again.
287
288			=item $term->scr_overlay_set_char ($x, $y, $char, $rend = OVERLAY_RSTYLE)
289
290			Put a single character (specified numerically) at the given overlay
291			position.
292
293			=item $term->scr_overlay_set ($x, $y, $text)
294
295			Write a string at the given position into the overlay.
296
297			=back
298
299			=head2 The C<urxvt::timer> Class
300
301			This class implements timer watchers/events. Time is represented as a
302			fractional number of seconds since the epoch. Example:
303
304			# create a digital clock display in upper right corner
305			$term->{timer} = urxvt::timer
306			->new
307			->start (urxvt::NOW)
308			->cb (sub {
309			my ($timer) = @_;
310			my $time = $timer->at;
311			$timer->start ($time + 1);
312			$self->scr_overlay (-1, 0,
313			POSIX::strftime "%H:%M:%S", localtime $time);
314			});
315
316			=over 4
317
318			=item $timer = new urxvt::timer
319
320			Create a new timer object in stopped state.
321
322			=item $timer = $timer->cb (sub { my ($timer) = @_; ... })
323
324			Set the callback to be called when the timer triggers.
325
326			=item $tstamp = $timer->at
327
328			Return the time this watcher will fire next.
329
330			=item $timer = $timer->set ($tstamp)
331
332			Set the time the event is generated to $tstamp.
333
334			=item $timer = $timer->start
335
336			Start the timer.
337
338			=item $timer = $timer->start ($tstamp)
339
340			Set the event trigger time to C<$tstamp> and start the timer.
341
342			=item $timer = $timer->stop
343
344			Stop the timer.
345
346			=back
347
348			=head2 The C<urxvt::iow> Class
349
350			This class implements io watchers/events. Example:
351
352			$term->{socket} = ...
353			$term->{iow} = urxvt::iow
354			->new
355			->fd (fileno $term->{socket})
356			->events (1) # wait for read data
357			->start
358			->cb (sub {
359			my ($iow, $revents) = @_;
360			# $revents must be 1 here, no need to check
361			sysread $term->{socket}, my $buf, 8192
362			or end-of-file;
363			});
364
365
366			=over 4
367
368			=item $iow = new urxvt::iow
369
370			Create a new io watcher object in stopped state.
371
372			=item $iow = $iow->cb (sub { my ($iow, $reventmask) = @_; ... })
373
374			Set the callback to be called when io events are triggered. C<$reventmask>
375			is a bitset as described in the C<events> method.
376
377			=item $iow = $iow->fd ($fd)
378
379			Set the filedescriptor (not handle) to watch.
380
381			=item $iow = $iow->events ($eventmask)
382
383			Set the event mask to watch. Bit #0 (value C<1>) enables watching for read
384			data, Bit #1 (value C<2>) enables watching for write data.
385
386			=item $iow = $iow->start
387
388			Start watching for requested events on the given handle.
389
390			=item $iow = $iow->stop
391
392			Stop watching for events on the given filehandle.
393
394			=back
395
396			=head1 AUTHOR
397
398			Marc Lehmann <pcg@goof.com>
399			http://software.schmorp.de/pkg/rxvt-unicode
400
401			=cut
402
403			1