From d50a22a63f36f3d4fb5bd2f4d7d0f89f36d84e8f Mon Sep 17 00:00:00 2001 From: root Date: Tue, 4 Sep 2012 22:41:11 +0000 Subject: *** empty log message *** --- src/perl/block-graphics-to-ascii | 37 ++++++++++++++++ src/perl/confirm-paste | 57 +++++++++++++++++++++++++ src/perl/digital-clock | 29 +++++++++++++ src/perl/example-refresh-hooks | 57 +++++++++++++++++++++++++ src/perl/option-popup | 84 ++++++++++++++++++++++++++++++++++++ src/perl/overlay-osc | 73 +++++++++++++++++++++++++++++++ src/perl/readline | 92 ++++++++++++++++++++++++++++++++++++++++ src/perl/xim-onthespot | 90 +++++++++++++++++++++++++++++++++++++++ 8 files changed, 519 insertions(+) create mode 100644 src/perl/block-graphics-to-ascii create mode 100644 src/perl/confirm-paste create mode 100644 src/perl/digital-clock create mode 100644 src/perl/example-refresh-hooks create mode 100644 src/perl/option-popup create mode 100644 src/perl/overlay-osc create mode 100644 src/perl/readline create mode 100644 src/perl/xim-onthespot (limited to 'src') 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 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;;;;;;" +# printf "\033]777;overlay;simple;ov1;5;0;0;t;test\007" +# + +# action "timeout;;" +# printf "\033]777;overlay;timeout;ov1;6\007" + +# action "destroy;" +# printf "\033]777;overlay;destroy;ov1\007" + +# TODO: +## action "complex;;;;;;;;" +## action "set;;;;;;" + +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, 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; + + () +} + + -- cgit v1.2.3