summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/perl/block-graphics-to-ascii37
-rw-r--r--src/perl/confirm-paste57
-rw-r--r--src/perl/digital-clock29
-rw-r--r--src/perl/example-refresh-hooks57
-rw-r--r--src/perl/option-popup84
-rw-r--r--src/perl/overlay-osc73
-rw-r--r--src/perl/readline92
-rw-r--r--src/perl/xim-onthespot90
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;
+
+ ()
+}
+
+
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-23 23:11:15 +0000