*** empty log message ***

8 files changed, 519 insertions, 0 deletions

diff --git a/src/perl/block-graphics-to-ascii b/src/perl/block-graphics-to-ascii
new file mode 100644
index 0000000..3d6e71a
--- /dev/null
+++ b/src/perl/block-graphics-to-ascii
@@ -0,0 +1,37 @@
+#! perl
+
+=head1 NAME
+
+block-graphics-to-ascii - map block graphics to ascii characters
+
+=head1 DESCRIPTION
+
+A not very useful example of filtering all text output to the terminal
+by replacing all line-drawing characters (U+2500 .. U+259F) by a
+similar-looking ascii character.
+
+=cut
+
+# simple example that uses the add_lines hook to filter unicode and vt100 line/box graphics
+
+#                  ─━│┃┄┅┆┇┈┉┊┋┌┍┎┏┐┑┒┓└┕┖┗┘┙┚┛├┝┞┟┠┡┢┣┤┥┦┧┨┩┪┫┬┭┮┯┰┱┲┳┴┵┶┷┸┹┺┻┼┽┾┿╀╁╂╃╄╅╆╇╈╉╊╋╌╍╎╏
+my $rep_unicode = "--||--||--||++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++--||"
+#                  ═║╒╓╔╕╖╗╘╙╚╛╜╝╞╟╠╡╢╣╤╥╦╧╨╩╪╫╬╭╮╯╰╱╲ ╳╴╵╶╷╸╹╺╻╼╽╾╿▀▁▂▃▄▅▆▇█▉▊▋▌▍▎▏▐░▒▓▔▕▖▗▘▙▚▛▜▝▞▟
+                . "=|+++++++++++++++++++++++++++++++/\\X-|-|-|-|-|-|#____#######|||||###~###########";
+
+#              ↑↓→←█▚ ☃HIJKLMNOPQRSTUVWXYZ[\ ]^ ◆▒␉␌␍␊°±␤␋┘┐┌└┼⎺⎻─⎼⎽├┤┴┬│≤≥π≠£·
+my $rep_acs = "↑↓<>#\\☃HIJKLMNOPQRSTUVWXYZ[\\]^ ◆#␉␌␍␊°±␤␋+++++⎺⎻-⎼⎽++++!<>π≠£·";
+
+sub on_add_lines {
+   my ($self, $str) = @_;
+
+   $str =~ s/([\x{2500}-\x{259f}])/substr $rep_unicode, (ord $1) - 0x2500, 1/ge;
+
+   $str =~ s/([\x41-\x7e])/substr $rep_acs, (ord $1) - 0x41, 1/ge
+      if $self->cur_charset eq "0";
+
+   $self->scr_add_lines ($str);
+
+   1
+}
+
diff --git a/src/perl/confirm-paste b/src/perl/confirm-paste
new file mode 100644
index 0000000..4b45238
--- /dev/null
+++ b/src/perl/confirm-paste
@@ -0,0 +1,57 @@
+#! perl
+
+=head1 NAME
+
+confirm-paste - ask for confirmation before pasting multiline text
+
+=head1 DESCRIPTION
+
+Displays a confirmation dialog when a paste containing at least a full
+line is detected.
+
+=cut
+
+sub msg {
+   my ($self, $msg) = @_;
+
+   $self->{overlay} = $self->overlay (0, -1, $self->ncol, 2, urxvt::OVERLAY_RSTYLE, 0);
+   $self->{overlay}->set (0, 0, $msg);
+}
+
+sub on_tt_paste {
+   my ($self, $str) = @_;
+
+   my $count = ($str =~ tr/\012\015//);
+
+   return unless $count;
+
+   $self->{paste} = \$str;
+   $self->msg ("Paste of $count lines, continue? (y/n)");
+   my $preview = substr $self->locale_decode ($str), 0, $self->ncol;
+   $preview =~ s/\n/\\n/g;
+   $self->{overlay}->set (0, 1, $self->special_encode ($preview));
+   $self->enable (key_press => \&key_press);
+
+   1
+}
+
+sub leave {
+   my ($self) = @_;
+
+   $self->{paste} = undef;
+   delete $self->{overlay};
+   $self->disable ("key_press");
+}
+
+sub key_press {
+   my ($self, $event, $keysym, $string) =  @_;
+
+   if ($keysym == 121) { # y
+      $self->tt_paste (${$self->{paste}});
+      $self->leave;
+   } elsif ($keysym == 110) { # n
+      $self->leave;
+   }
+
+   1
+}
diff --git a/src/perl/digital-clock b/src/perl/digital-clock
new file mode 100644
index 0000000..7adddde
--- /dev/null
+++ b/src/perl/digital-clock
@@ -0,0 +1,29 @@
+#! perl
+
+=head1 NAME
+
+digital-clock - display a digital clock overlay
+
+=head1 DESCRIPTION
+
+Displays a digital clock using the built-in overlay.
+
+=cut
+
+sub on_start {
+   my ($self) = @_;
+
+   $self->{overlay} = $self->overlay (-1, 0, 8, 1, urxvt::OVERLAY_RSTYLE, 0);
+   $self->{timer} = urxvt::timer
+                    ->new
+                    ->start (1 + int urxvt::NOW) # make sure we update "on" the second
+                    ->interval (1)
+                    ->cb (sub {
+                       $self->{overlay}->set (0, 0,
+                          sprintf "%2d:%02d:%02d", (localtime urxvt::NOW)[2,1,0]);
+                    });
+
+   ()
+}
+
+
diff --git a/src/perl/example-refresh-hooks b/src/perl/example-refresh-hooks
new file mode 100644
index 0000000..97d8d71
--- /dev/null
+++ b/src/perl/example-refresh-hooks
@@ -0,0 +1,57 @@
+#! perl
+
+=head1 NAME
+
+example-refresh-hooks - example of how to use refresh hooks
+
+=head1 DESCRIPTION
+
+Displays a very simple digital clock in the upper right corner of the
+window. Illustrates overwriting the refresh callbacks to create your own
+overlays or changes.
+
+=cut
+
+sub on_init {
+   my ($self) = @_;
+
+   # force a refresh every second
+   $self->{digital_clock_refresh} = urxvt::timer
+                    ->new
+                    ->start (1 + int urxvt::NOW)
+                    ->interval (1)
+                    ->cb (sub { $self->want_refresh });
+
+   ()
+}
+
+# before refreshing: replace upper right with the clock display
+sub on_refresh_begin {
+   my ($self) = @_;
+
+   my $time = sprintf "%2d:%02d:%02d", (localtime urxvt::NOW)[2, 1, 0];
+   my $xpos = $self->ncol - length $time;
+
+   $xpos >= 0
+      or return;
+
+   $self->{digital_clock_rend} = $self->ROW_r (0, [(urxvt::DEFAULT_RSTYLE) x length $time], $xpos);
+   $self->{digital_clock_text} = $self->ROW_t (0, $time, $xpos);
+
+   ()
+}
+
+# after refreshing: restore previous screen contents
+sub on_refresh_end {
+   my ($self) = @_;
+
+   exists $self->{digital_clock_text}
+      or return;
+
+   $self->ROW_r (0, delete $self->{digital_clock_rend});
+   $self->ROW_t (0, delete $self->{digital_clock_text});
+
+   ()
+}
+
+
diff --git a/src/perl/option-popup b/src/perl/option-popup
new file mode 100644
index 0000000..d15aa1e
--- /dev/null
+++ b/src/perl/option-popup
@@ -0,0 +1,84 @@
+#! perl
+
+=head1 NAME
+
+option-popup - option menu (enabled by default)
+
+=head1 DESCRIPTION
+
+Binds a popup menu to Ctrl-Button2 that lets you toggle (some) options at
+runtime.
+
+Other extensions can extend this popup menu by pushing a code reference
+onto C<< @{ $term->{option_popup_hook} } >>, which gets called whenever
+the popup is being displayed.
+
+Its sole argument is the popup menu, which can be modified.  It should
+either return nothing or a string, the initial boolean value and a code
+reference. The string will be used as button text and the code reference
+will be called when the toggle changes, with the new boolean value as
+first argument.
+
+The following will add an entry C<myoption> that changes
+C<< $self->{myoption} >>:
+
+   push @{ $self->{term}{option_popup_hook} }, sub {
+      ("my option" => $myoption, sub { $self->{myoption} = $_[0] })
+   };
+
+=cut
+
+sub on_start {
+   my ($self) = @_;
+
+   $self->grab_button (2, urxvt::ControlMask);
+
+   ()
+}
+
+sub on_button_press {
+   my ($self, $event) = @_;
+
+   if ($event->{button} == 2 && $event->{state} & urxvt::ControlMask) {
+      my $popup = $self->popup ($event)
+         or return 1;
+
+      $popup->add_title ("Options");
+      $popup->add_separator;
+
+      my %unsafe = map +($_ => 1),
+         qw(borderLess console iconic loginShell reverseVideo
+            scrollBar scrollBar_floating scrollBar_right
+            secondaryScreen transparent utmpInhibit meta8
+            override_redirect);
+
+      for my $name (sort keys %urxvt::OPTION) {
+         next if $unsafe{$name};
+
+         my $optval = $urxvt::OPTION{$name};
+
+         $popup->add_toggle ($name => $self->option ($optval),
+                             sub { $self->option ($optval, $_[0]) });
+      }
+
+      for my $hook (@{ $self->{term}{option_popup_hook} || [] }) {
+         if (my ($name, $value, $cb) = $hook->($popup)) {
+            $popup->add_toggle ($name => $value, sub { $cb->($_[0]) });
+         }
+      }
+
+      {
+         $popup->add_separator;
+         my $locale = $self->locale;
+         $locale =~ y/\x20-\x7e//cd;
+         $popup->add_title ("Locale: $locale");
+      }
+
+      $popup->show;
+
+      return 1;
+   }
+
+   ()
+}
+
diff --git a/src/perl/overlay-osc b/src/perl/overlay-osc
new file mode 100644
index 0000000..5b06e9a
--- /dev/null
+++ b/src/perl/overlay-osc
@@ -0,0 +1,73 @@
+#! perl
+
+=head1 NAME
+
+overlay-osc - implement OSC to manage overlays
+
+=head1 DESCRIPTION
+
+This extension implements some OSC commands to display timed popups on the
+screen - useful for status displays from within scripts. You have to read
+the sources for more info.
+
+=cut
+
+# allows programs to open popups
+# printf "\033]777;overlay;action;args\007"
+#
+# action "simple;<id>;<timeout>;<x>;<y>;<h|t>;<text>"
+#   printf "\033]777;overlay;simple;ov1;5;0;0;t;test\007"
+#
+
+# action "timeout;<id>;<seconds>"
+#   printf "\033]777;overlay;timeout;ov1;6\007"
+
+# action "destroy;<id>"
+#   printf "\033]777;overlay;destroy;ov1\007"
+
+# TODO:
+## action "complex;<id>;<timeout>;<x>;<y>;<width>;<height>;<rstyle>;<border>"
+## action "set;<id>;<x>;<y>;<h|t>;<hextext>;<rendition...>"
+
+sub on_osc_seq_perl {
+   my ($self, $osc, $resp) = @_;
+
+   return unless $osc =~ s/^overlay;//;
+
+   $osc =~ s/^([^;]+)+;//
+      or return;
+
+   if ($1 eq "timeout") {
+      my ($id, $to) = split /;/, $osc, 2;
+      my $ov = $self->{ov}{$id}
+         or return;
+      if (length $to) {
+         $ov->{to}->start (urxvt::NOW + $to);
+      } else {
+         delete $ov->{to};
+      }
+
+   } elsif ($1 eq "simple") {
+      my ($id, $to, $x, $y, $t, $txt) = split /;/, $osc, 6;
+      if ($t eq "h") {
+         $txt = pack "H*", $txt;
+         utf8::decode $txt;
+      }
+      $self->{ov}{$id} = {
+         ov => $self->overlay_simple ($x, $y, $txt),
+         to => urxvt::timer
+            ->new
+            ->start (urxvt::NOW + $to)
+            ->cb(sub {
+               delete $self->{ov}{$id};
+            }),
+      };
+
+   } elsif ($1 eq "destroy") {
+      delete $self->{ov}{$osc};
+   }
+
+   1
+}
+
+
diff --git a/src/perl/readline b/src/perl/readline
new file mode 100644
index 0000000..b22677f
--- /dev/null
+++ b/src/perl/readline
@@ -0,0 +1,92 @@
+#! perl
+
+=head1 NAME
+
+readline - improve readline editing (enabled by default)
+
+=head1 DESCRIPTION
+
+A support package that tries to make editing with readline easier. At
+the moment, it reacts to clicking shift-left mouse button by trying to
+move the text cursor to this position. It does so by generating as many
+cursor-left or cursor-right keypresses as required (this only works
+for programs that correctly support wide characters).
+
+To avoid too many false positives, this is only done when:
+
+=over 4
+
+=item - the tty is in ICANON state.
+
+=item - the text cursor is visible.
+
+=item - the primary screen is currently being displayed.
+
+=item - the mouse is on the same (multi-row-) line as the text cursor.
+
+=back
+
+The normal selection mechanism isn't disabled, so quick successive clicks
+might interfere with selection creation in harmless ways.
+
+=cut
+
+use POSIX ();
+
+my $termios = new POSIX::Termios;
+
+sub on_init {
+   my ($self) = @_;
+
+   $self->{enabled} = 1;
+
+   push @{ $self->{term}{option_popup_hook} }, sub {
+      ("readline" => $self->{enabled}, sub { $self->{enabled} = shift })
+   };
+
+   ()
+}
+
+sub on_button_press {
+   my ($self, $event) = @_;
+
+   $self->current_screen || $self->hidden_cursor || !$self->{enabled}
+      and return;
+
+   my $mask = $self->ModLevel3Mask | $self->ModMetaMask
+            | urxvt::ShiftMask | urxvt::ControlMask;
+
+   ($event->{state} & $mask) == urxvt::ShiftMask
+      or return;
+
+   $termios->getattr ($self->pty_fd)
+      or return;
+
+   $termios->getlflag & &POSIX::ICANON
+      and return;
+
+   my ($row, $col) = $self->screen_cur;
+   my $line = $self->line ($row);
+   my $cur = $line->offset_of ($row, $col);
+   my $ofs = $line->offset_of ($event->{row}, $event->{col});
+
+   $ofs >= 0 && $ofs < $line->l
+      or return;
+
+   my $diff = $ofs - $cur;
+   my $move;
+
+   if ($diff < 0) {
+      ($ofs, $cur) = ($cur, $ofs);
+      $move = "\x1b[D";
+   } else {
+      $move = "\x1b[C";
+   }
+
+   my $skipped = substr $line->t, $cur, $ofs - $cur;
+   $skipped =~ s/\x{ffff}//g;
+
+   $self->tt_write ($move x length $skipped);
+
+   1
+}
diff --git a/src/perl/xim-onthespot b/src/perl/xim-onthespot
new file mode 100644
index 0000000..b5acee2
--- /dev/null
+++ b/src/perl/xim-onthespot
@@ -0,0 +1,90 @@
+#! perl
+
+=head1 NAME
+
+xim-onthespot - implement XIM "on-the-spot" behaviour
+
+=head1 DESCRIPTION
+
+This perl extension implements OnTheSpot editing. It does not work
+perfectly, and some input methods don't seem to work well with OnTheSpot
+editing in general, but it seems to work at least for SCIM and kinput2.
+
+You enable it by specifying this extension and a preedit style of
+C<OnTheSpot>, i.e.:
+
+   urxvt -pt OnTheSpot -pe xim-onthespot
+
+=cut
+
+#
+# problems with this implementation include
+#
+# - primary, secondary, tertiary are NO different to other highlighting styles
+# - if rend values are missing, they are not being interpolated
+#
+
+my $SIZEOF_LONG = length pack "l!", 0;
+
+sub refresh {
+   my ($self) = @_;
+
+   delete $self->{overlay};
+
+   my $text = $self->{text};
+
+   return unless length $text;
+
+   my ($row, $col) = $self->screen_cur;
+
+   my $idx = 0;
+
+   my @rend = map {
+      my $rstyle = $self->{caret} == $idx ? urxvt::OVERLAY_RSTYLE : $self->rstyle;
+
+      $rstyle |= urxvt::RS_Uline   if $_ & (urxvt::XIMUnderline | urxvt::XIMPrimary);
+      $rstyle |= urxvt::RS_RVid    if $_ & (urxvt::XIMReverse   | urxvt::XIMSecondary);
+      $rstyle |= urxvt::RS_Italic  if $_ & (urxvt::XIMHighlight | urxvt::XIMTertiary);
+
+      ($rstyle) x ($self->strwidth (substr $text, $idx++, 1))
+   } unpack "l!*", $self->{rend};
+
+   if ($self->{caret} >= length $text) {
+      $text .= " ";
+      push @rend, urxvt::OVERLAY_RSTYLE;
+   }
+
+   $self->{overlay} = $self->overlay ($col, $row, $self->strwidth ($text), 1, $self->rstyle, 0);
+   $self->{overlay}->set (0, 0, $self->special_encode ($text), \@rend);
+}
+
+sub on_xim_preedit_start {
+   my ($self) = @_;
+
+   ()
+}
+
+sub on_xim_preedit_done {
+   my ($self) = @_;
+
+   delete $self->{overlay};
+   delete $self->{text};
+   delete $self->{rend};
+
+   ()
+}
+
+sub on_xim_preedit_draw {
+   my ($self, $caret, $pos, $len, $feedback, $chars) = @_;
+
+   $self->{caret} = $caret;
+
+   substr $self->{rend}, $pos * $SIZEOF_LONG, $len * $SIZEOF_LONG, $feedback;
+   substr $self->{text}, $pos               , $len               , $chars if defined $feedback || !defined $chars;
+
+   $self->refresh;
+
+   ()
+}
+
+