rxvt-unicode/src/urxvt.pm

=head1 NAME

urxvt - rxvt-unicode's embedded perl interpreter

=head1 SYNOPSIS

Put your scripts into $LIBDIR/perl-init/, 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 written in 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-init/*>;


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