diff --git a/etc/X/Xdefaults b/etc/X/Xdefaults index 8b37eee..b186cc2 100644 --- a/etc/X/Xdefaults +++ b/etc/X/Xdefaults @@ -1,14 +1,16 @@ !Общие настройки (U)Rxvt -URxvt*font: xft:DejaVU Sans Mono:pixelsize=16 -URxvt*pixelsize:14 +!URxvt*font: xft:DejaVu Sans Mono:pixelsize=16 +!URxvt*boldFont: xft:DejaVu Sans Mono:pixelsize=16:weight=bold + +URxvt.font:xft:droid sans mono slashed:medium:pixelsize=16 +URxvt.boldFont:xft:droid sans mono slashed:medium:pixelsize=16:weight=bold + +!URxvt.letterSpace: 0 + URxvt*scrollBar:false URxvt.cursorColor: #AAAAAA URxvt*termName: xterm -!Отключение расширений Perl -URxvt.perl-ext: -URxvt.perl-ext-common: - !Настрока клавиатуры для URxvt URxvt*keysym.Control-Up: \033[1;5A URxvt*keysym.Control-Down: \033[1;5B @@ -21,11 +23,12 @@ URxvt.keysym.C-End: \033[8;8^ URxvt.keysym.Home: \033[7~ !Настрока шрифтов -Xft.antialias: 1 +Xft.antialias: true Xft.dpi: 96 ! Xft.dpi: 120 -Xft.hinting: 1 -Xft.hintstyle: hintfull +Xft.hinting: true +!Xft.hintstyle: hintfull +Xft.hintstyle: hintslight Xft.rgba: rgb xterm*faceName:DejaVu Sans Mono @@ -36,10 +39,6 @@ rofi.width: 100 rofi.lines: 10 rofi.columns: 8 rofi.font: mono 12 -rofi.color-normal: argb:00000000, #1aa, argb:11FFFFFF, #1aa,#333 -rofi.color-urgent: argb:00000000, #f99, argb:11FFFFFF, #f99,#333 -rofi.color-active: argb:00000000, #aa1, argb:11FFFFFF, #aa1,#333 -rofi.color-window: argb:ee333333, #1aa,#1aa rofi.bw: 1 rofi.location: 1 rofi.padding: 5 @@ -49,3 +48,10 @@ rofi.fixed-num-lines: false #include "/home/maks/.shellrc/etc/X/urxvt.light" #include "/home/maks/.shellrc/etc/X/rofi.lb" +!Расширения Perl +#include "/home/maks/.shellrc/etc/soft/urxvt/extensions.conf" + +!Отключение расширений Perl +!URxvt.perl-ext: +!URxvt.perl-ext-common: + diff --git a/etc/soft/urxvt/extensions.conf b/etc/soft/urxvt/extensions.conf new file mode 100644 index 0000000..d58d356 --- /dev/null +++ b/etc/soft/urxvt/extensions.conf @@ -0,0 +1,33 @@ +!Расширения Perl +URxvt.perl-lib: /home/maks/.shellrc/etc/soft/urxvt/perl/ +URxvt.perl-ext-common: tabbedex,readline,searchable-scrollback,matcher,font-size + +!Tabbedex +URxvt.tabbed.autohide: true +URxvt.keysym.Control-t: perl:tabbedex:new_tab +URxvt.keysym.Control-Tab: perl:tabbedex:next_tab +URxvt.keysym.Control-Shift-Tab: perl:tabbedex:prev_tab + +URxvt.tabbed.tabbar-fg: 2 +URxvt.tabbed.tabbar-bg: 252 +URxvt.tabbed.tab-fg: 0 +URxvt.tabbed.tab-bg: 250 +URxvt.tabbed.title-bg: 252 +URxvt.tabbed.title-fg: 0 +URxvt.tabbed.tabbar-timeouts: " " + +!Font-size +URxvt.keysym.C-Up: font-size:increase +URxvt.keysym.C-Down: font-size:decrease +URxvt.keysym.C-S-Up: font-size:incglobal +URxvt.keysym.C-S-Down: font-size:decglobal +URxvt.keysym.C-equal: font-size:reset +URxvt.keysym.C-slash: font-size:show + +!Matcher +URxvt.url-launcher: chromium +URxvt.matcher.button: 2 +URxvt.colorUL: #09419b +URxvt.underlineURLs: false +URxvt.underlineColor: #09419b + diff --git a/etc/soft/urxvt/perl/background b/etc/soft/urxvt/perl/background new file mode 100644 index 0000000..bf81c63 --- /dev/null +++ b/etc/soft/urxvt/perl/background @@ -0,0 +1,1211 @@ +#! perl + +#:META:RESOURCE:%.expr:string:background expression +#:META:RESOURCE:%.border:boolean:respect the terminal border +#:META:RESOURCE:%.interval:seconds:minimum time between updates + +=head1 NAME + +background - manage terminal background + +=head1 SYNOPSIS + + urxvt --background-expr 'background expression' + --background-border + --background-interval seconds + +=head1 QUICK AND DIRTY CHEAT SHEET + +Just load a random jpeg image and tile the background with it without +scaling or anything else: + + load "/path/to/img.jpg" + +The same, but use mirroring/reflection instead of tiling: + + mirror load "/path/to/img.jpg" + +Load an image and scale it to exactly fill the terminal window: + + scale keep { load "/path/to/img.jpg" } + +Implement pseudo-transparency by using a suitably-aligned root pixmap +as window background: + + rootalign root + +Likewise, but keep a blurred copy: + + rootalign keep { blur 10, root } + +=head1 DESCRIPTION + +This extension manages the terminal background by creating a picture that +is behind the text, replacing the normal background colour. + +It does so by evaluating a Perl expression that I the image on +the fly, for example, by grabbing the root background or loading a file. + +While the full power of Perl is available, the operators have been design +to be as simple as possible. + +For example, to load an image and scale it to the window size, you would +use: + + urxvt --background-expr 'scale keep { load "/path/to/mybg.png" }' + +Or specified as a X resource: + + URxvt.background-expr: scale keep { load "/path/to/mybg.png" } + +=head1 THEORY OF OPERATION + +At startup, just before the window is mapped for the first time, the +expression is evaluated and must yield an image. The image is then +extended as necessary to cover the whole terminal window, and is set as a +background pixmap. + +If the image contains an alpha channel, then it will be used as-is in +visuals that support alpha channels (for example, for a compositing +manager). In other visuals, the terminal background colour will be used to +replace any transparency. + +When the expression relies, directly or indirectly, on the window size, +position, the root pixmap, or a timer, then it will be remembered. If not, +then it will be removed. + +If any of the parameters that the expression relies on changes (when the +window is moved or resized, its position or size changes; when the root +pixmap is replaced by another one the root background changes; or when the +timer elapses), then the expression will be evaluated again. + +For example, an expression such as C scales the image to the window size, so it relies on the window size +and will be reevaluated each time it is changed, but not when it moves for +example. That ensures that the picture always fills the terminal, even +after its size changes. + +=head2 EXPRESSIONS + +Expressions are normal Perl expressions, in fact, they are Perl blocks - +which means you could use multiple lines and statements: + + scale keep { + again 3600; + if (localtime now)[6]) { + return load "$HOME/weekday.png"; + } else { + return load "$HOME/sunday.png"; + } + } + +This inner expression is evaluated once per hour (and whenever the +terminal window is resized). It sets F as background on +Sundays, and F on all other days. + +Fortunately, we expect that most expressions will be much simpler, with +little Perl knowledge needed. + +Basically, you always start with a function that "generates" an image +object, such as C, which loads an image from disk, or C, which +returns the root window background image: + + load "$HOME/mypic.png" + +The path is usually specified as a quoted string (the exact rules can be +found in the L manpage). The F<$HOME> at the beginning of the +string is expanded to the home directory. + +Then you prepend one or more modifiers or filtering expressions, such as +C: + + scale load "$HOME/mypic.png" + +Just like a mathematical expression with functions, you should read these +expressions from right to left, as the C is evaluated first, and +its result becomes the argument to the C function. + +Many operators also allow some parameters preceding the input image +that modify its behaviour. For example, C without any additional +arguments scales the image to size of the terminal window. If you specify +an additional argument, it uses it as a scale factor (multiply by 100 to +get a percentage): + + scale 2, load "$HOME/mypic.png" + +This enlarges the image by a factor of 2 (200%). As you can see, C +has now two arguments, the C<200> and the C expression, while +C only has one argument. Arguments are separated from each other by +commas. + +Scale also accepts two arguments, which are then separate factors for both +horizontal and vertical dimensions. For example, this halves the image +width and doubles the image height: + + scale 0.5, 2, load "$HOME/mypic.png" + +IF you try out these expressions, you might suffer from some sluggishness, +because each time the terminal is resized, it loads the PNG image again +and scales it. Scaling is usually fast (and unavoidable), but loading the +image can be quite time consuming. This is where C comes in handy: + + scale 0.5, 2, keep { load "$HOME/mypic.png" } + +The C operator executes all the statements inside the braces only +once, or when it thinks the outcome might change. In other cases it +returns the last value computed by the brace block. + +This means that the C is only executed once, which makes it much +faster, but also means that more memory is being used, because the loaded +image must be kept in memory at all times. In this expression, the +trade-off is likely worth it. + +But back to effects: Other effects than scaling are also readily +available, for example, you can tile the image to fill the whole window, +instead of resizing it: + + tile keep { load "$HOME/mypic.png" } + +In fact, images returned by C are in C mode by default, so the +C operator is kind of superfluous. + +Another common effect is to mirror the image, so that the same edges +touch: + + mirror keep { load "$HOME/mypic.png" } + +Another common background expression is: + + rootalign root + +This one first takes a snapshot of the screen background image, and then +moves it to the upper left corner of the screen (as opposed to the upper +left corner of the terminal window)- the result is pseudo-transparency: +the image seems to be static while the window is moved around. + +=head2 COLOUR SPECIFICATIONS + +Whenever an operator expects a "colour", then this can be specified in one +of two ways: Either as string with an X11 colour specification, such as: + + "red" # named colour + "#f00" # simple rgb + "[50]red" # red with 50% alpha + "TekHVC:300/50/50" # anything goes + +OR as an array reference with one, three or four components: + + [0.5] # 50% gray, 100% alpha + [0.5, 0, 0] # dark red, no green or blur, 100% alpha + [0.5, 0, 0, 0.7] # same with explicit 70% alpha + +=head2 CACHING AND SENSITIVITY + +Since some operations (such as C and C) can take a long time, +caching results can be very important for a smooth operation. Caching can +also be useful to reduce memory usage, though, for example, when an image +is cached by C, it could be shared by multiple terminal windows +running inside urxvtd. + +=head3 C caching + +The most important way to cache expensive operations is to use C. The C operator takes a block of multiple statements enclosed +by C<{}> and keeps the return value in memory. + +An expression can be "sensitive" to various external events, such as +scaling or moving the window, root background changes and timers. Simply +using an expression (such as C without parameters) that depends on +certain changing values (called "variables"), or using those variables +directly, will make an expression sensitive to these events - for example, +using C or C will make the expression sensitive to the terminal +size, and thus to resizing events. + +When such an event happens, C will automatically trigger a +reevaluation of the whole expression with the new value of the expression. + +C is most useful for expensive operations, such as C: + + rootalign keep { blur 20, root } + +This makes a blurred copy of the root background once, and on subsequent +calls, just root-aligns it. Since C is usually quite slow and +C is quite fast, this trades extra memory (for the cached +blurred pixmap) with speed (blur only needs to be redone when root +changes). + +=head3 C caching + +The C operator itself does not keep images in memory, but as long as +the image is still in memory, C will use the in-memory image instead +of loading it freshly from disk. + +That means that this expression: + + keep { load "$HOME/path..." } + +Not only caches the image in memory, other terminal instances that try to +C it can reuse that in-memory copy. + +=head1 REFERENCE + +=head2 COMMAND LINE SWITCHES + +=over 4 + +=item --background-expr perl-expression + +Specifies the Perl expression to evaluate. + +=item --background-border + +By default, the expression creates an image that fills the full window, +overwriting borders and any other areas, such as the scrollbar. + +Specifying this flag changes the behaviour, so that the image only +replaces the background of the character area. + +=item --background-interval seconds + +Since some operations in the underlying XRender extension can effectively +freeze your X-server for prolonged time, this extension enforces a minimum +time between updates, which is normally about 0.1 seconds. + +If you want to do updates more often, you can decrease this safety +interval with this switch. + +=back + +=cut + +our %_IMG_CACHE; +our $HOME; +our ($self, $frame); +our ($x, $y, $w, $h, $focus); + +# enforce at least this interval between updates +our $MIN_INTERVAL = 6/59.951; + +{ + package urxvt::bgdsl; # background language + + sub FR_PARENT() { 0 } # parent frame, if any - must be #0 + sub FR_CACHE () { 1 } # cached values + sub FR_AGAIN () { 2 } # what this expr is sensitive to + sub FR_STATE () { 3 } # watchers etc. + + use List::Util qw(min max sum shuffle); + +=head2 PROVIDERS/GENERATORS + +These functions provide an image, by loading it from disk, grabbing it +from the root screen or by simply generating it. They are used as starting +points to get an image you can play with. + +=over 4 + +=item load $path + +Loads the image at the given C<$path>. The image is set to plane tiling +mode. + +If the image is already in memory (e.g. because another terminal instance +uses it), then the in-memory copy is returned instead. + +=item load_uc $path + +Load uncached - same as load, but does not cache the image, which means it +is I loaded from the filesystem again, even if another copy of it +is in memory at the time. + +=cut + + sub load_uc($) { + $self->new_img_from_file ($_[0]) + } + + sub load($) { + my ($path) = @_; + + $_IMG_CACHE{$path} || do { + my $img = load_uc $path; + Scalar::Util::weaken ($_IMG_CACHE{$path} = $img); + $img + } + } + +=item root + +Returns the root window pixmap, that is, hopefully, the background image +of your screen. + +This function makes your expression root sensitive, that means it will be +reevaluated when the bg image changes. + +=cut + + sub root() { + $frame->[FR_AGAIN]{rootpmap} = 1; + $self->new_img_from_root + } + +=item solid $colour + +=item solid $width, $height, $colour + +Creates a new image and completely fills it with the given colour. The +image is set to tiling mode. + +If C<$width> and C<$height> are omitted, it creates a 1x1 image, which is +useful for solid backgrounds or for use in filtering effects. + +=cut + + sub solid($;$$) { + my $colour = pop; + + my $img = $self->new_img (urxvt::PictStandardARGB32, 0, 0, $_[0] || 1, $_[1] || 1); + $img->fill ($colour); + $img + } + +=item clone $img + +Returns an exact copy of the image. This is useful if you want to have +multiple copies of the same image to apply different effects to. + +=cut + + sub clone($) { + $_[0]->clone + } + +=item merge $img ... + +Takes any number of images and merges them together, creating a single +image containing them all. The tiling mode of the first image is used as +the tiling mode of the resulting image. + +This function is called automatically when an expression returns multiple +images. + +=cut + + sub merge(@) { + return $_[0] unless $#_; + + # rather annoyingly clumsy, but optimisation is for another time + + my $x0 = +1e9; + my $y0 = +1e9; + my $x1 = -1e9; + my $y1 = -1e9; + + for (@_) { + my ($x, $y, $w, $h) = $_->geometry; + + $x0 = $x if $x0 > $x; + $y0 = $y if $y0 > $y; + + $x += $w; + $y += $h; + + $x1 = $x if $x1 < $x; + $y1 = $y if $y1 < $y; + } + + my $base = $self->new_img (urxvt::PictStandardARGB32, $x0, $y0, $x1 - $x0, $y1 - $y0); + $base->repeat_mode ($_[0]->repeat_mode); + $base->fill ([0, 0, 0, 0]); + + $base->draw ($_) + for @_; + + $base + } + +=back + +=head2 TILING MODES + +The following operators modify the tiling mode of an image, that is, the +way that pixels outside the image area are painted when the image is used. + +=over 4 + +=item tile $img + +Tiles the whole plane with the image and returns this new image - or in +other words, it returns a copy of the image in plane tiling mode. + +Example: load an image and tile it over the background, without +resizing. The C call is superfluous because C already defaults +to tiling mode. + + tile load "mybg.png" + +=item mirror $img + +Similar to tile, but reflects the image each time it uses a new copy, so +that top edges always touch top edges, right edges always touch right +edges and so on (with normal tiling, left edges always touch right edges +and top always touch bottom edges). + +Example: load an image and mirror it over the background, avoiding sharp +edges at the image borders at the expense of mirroring the image itself + + mirror load "mybg.png" + +=item pad $img + +Takes an image and modifies it so that all pixels outside the image area +become transparent. This mode is most useful when you want to place an +image over another image or the background colour while leaving all +background pixels outside the image unchanged. + +Example: load an image and display it in the upper left corner. The rest +of the space is left "empty" (transparent or whatever your compositor does +in alpha mode, else background colour). + + pad load "mybg.png" + +=item extend $img + +Extends the image over the whole plane, using the closest pixel in the +area outside the image. This mode is mostly useful when you use more complex +filtering operations and want the pixels outside the image to have the +same values as the pixels near the edge. + +Example: just for curiosity, how does this pixel extension stuff work? + + extend move 50, 50, load "mybg.png" + +=cut + + sub pad($) { + my $img = $_[0]->clone; + $img->repeat_mode (urxvt::RepeatNone); + $img + } + + sub tile($) { + my $img = $_[0]->clone; + $img->repeat_mode (urxvt::RepeatNormal); + $img + } + + sub mirror($) { + my $img = $_[0]->clone; + $img->repeat_mode (urxvt::RepeatReflect); + $img + } + + sub extend($) { + my $img = $_[0]->clone; + $img->repeat_mode (urxvt::RepeatPad); + $img + } + +=back + +=head2 VARIABLE VALUES + +The following functions provide variable data such as the terminal window +dimensions. They are not (Perl-) variables, they just return stuff that +varies. Most of them make your expression sensitive to some events, for +example using C (terminal width) means your expression is evaluated +again when the terminal is resized. + +=over 4 + +=item TX + +=item TY + +Return the X and Y coordinates of the terminal window (the terminal +window is the full window by default, and the character area only when in +border-respect mode). + +Using these functions makes your expression sensitive to window moves. + +These functions are mainly useful to align images to the root window. + +Example: load an image and align it so it looks as if anchored to the +background (that's exactly what C does btw.): + + move -TX, -TY, keep { load "mybg.png" } + +=item TW + +=item TH + +Return the width (C) and height (C) of the terminal window (the +terminal window is the full window by default, and the character area only +when in border-respect mode). + +Using these functions makes your expression sensitive to window resizes. + +These functions are mainly useful to scale images, or to clip images to +the window size to conserve memory. + +Example: take the screen background, clip it to the window size, blur it a +bit, align it to the window position and use it as background. + + clip move -TX, -TY, keep { blur 5, root } + +=item FOCUS + +Returns a boolean indicating whether the terminal window has keyboard +focus, in which case it returns true. + +Using this function makes your expression sensitive to focus changes. + +A common use case is to fade the background image when the terminal loses +focus, often together with the C<-fade> command line option. In fact, +there is a special function for just that use case: C. + +Example: use two entirely different background images, depending on +whether the window has focus. + + FOCUS ? keep { load "has_focus.jpg" } : keep { load "no_focus.jpg" } + +=cut + + sub TX () { $frame->[FR_AGAIN]{position} = 1; $x } + sub TY () { $frame->[FR_AGAIN]{position} = 1; $y } + sub TW () { $frame->[FR_AGAIN]{size} = 1; $w } + sub TH () { $frame->[FR_AGAIN]{size} = 1; $h } + sub FOCUS() { $frame->[FR_AGAIN]{focus} = 1; $focus } + +=item now + +Returns the current time as (fractional) seconds since the epoch. + +Using this expression does I make your expression sensitive to time, +but the next two functions do. + +=item again $seconds + +When this function is used the expression will be reevaluated again in +C<$seconds> seconds. + +Example: load some image and rotate it according to the time of day (as if it were +the hour pointer of a clock). Update this image every minute. + + again 60; + rotate 50, 50, (now % 86400) * -72 / 8640, scale keep { load "myclock.png" } + +=item counter $seconds + +Like C, but also returns an increasing counter value, starting at +0, which might be useful for some simple animation effects. + +=cut + + sub now() { urxvt::NOW } + + sub again($) { + $frame->[FR_AGAIN]{time} = $_[0]; + } + + sub counter($) { + $frame->[FR_AGAIN]{time} = $_[0]; + $frame->[FR_STATE]{counter} + 0 + } + +=back + +=head2 SHAPE CHANGING OPERATORS + +The following operators modify the shape, size or position of the image. + +=over 4 + +=item clip $img + +=item clip $width, $height, $img + +=item clip $x, $y, $width, $height, $img + +Clips an image to the given rectangle. If the rectangle is outside the +image area (e.g. when C<$x> or C<$y> are negative) or the rectangle is +larger than the image, then the tiling mode defines how the extra pixels +will be filled. + +If C<$x> and C<$y> are missing, then C<0> is assumed for both. + +If C<$width> and C<$height> are missing, then the window size will be +assumed. + +Example: load an image, blur it, and clip it to the window size to save +memory. + + clip keep { blur 10, load "mybg.png" } + +=cut + + sub clip($;$$;$$) { + my $img = pop; + my $h = pop || TH; + my $w = pop || TW; + $img->sub_rect ($_[0], $_[1], $w, $h) + } + +=item scale $img + +=item scale $size_factor, $img + +=item scale $width_factor, $height_factor, $img + +Scales the image by the given factors in horizontal +(C<$width>) and vertical (C<$height>) direction. + +If only one factor is given, it is used for both directions. + +If no factors are given, scales the image to the window size without +keeping aspect. + +=item resize $width, $height, $img + +Resizes the image to exactly C<$width> times C<$height> pixels. + +=item fit $img + +=item fit $width, $height, $img + +Fits the image into the given C<$width> and C<$height> without changing +aspect, or the terminal size. That means it will be shrunk or grown until +the whole image fits into the given area, possibly leaving borders. + +=item cover $img + +=item cover $width, $height, $img + +Similar to C, but shrinks or grows until all of the area is covered +by the image, so instead of potentially leaving borders, it will cut off +image data that doesn't fit. + +=cut + + sub scale($;$;$) { + my $img = pop; + + @_ == 2 ? $img->scale ($_[0] * $img->w, $_[1] * $img->h) + : @_ ? $img->scale ($_[0] * $img->w, $_[0] * $img->h) + : $img->scale (TW, TH) + } + + sub resize($$$) { + my $img = pop; + $img->scale ($_[0], $_[1]) + } + + sub fit($;$$) { + my $img = pop; + my $w = ($_[0] || TW) / $img->w; + my $h = ($_[1] || TH) / $img->h; + scale +(min $w, $h), $img + } + + sub cover($;$$) { + my $img = pop; + my $w = ($_[0] || TW) / $img->w; + my $h = ($_[1] || TH) / $img->h; + scale +(max $w, $h), $img + } + +=item move $dx, $dy, $img + +Moves the image by C<$dx> pixels in the horizontal, and C<$dy> pixels in +the vertical. + +Example: move the image right by 20 pixels and down by 30. + + move 20, 30, ... + +=item align $xalign, $yalign, $img + +Aligns the image according to a factor - C<0> means the image is moved to +the left or top edge (for C<$xalign> or C<$yalign>), C<0.5> means it is +exactly centered and C<1> means it touches the right or bottom edge. + +Example: remove any visible border around an image, center it vertically but move +it to the right hand side. + + align 1, 0.5, pad $img + +=item center $img + +=item center $width, $height, $img + +Centers the image, i.e. the center of the image is moved to the center of +the terminal window (or the box specified by C<$width> and C<$height> if +given). + +Example: load an image and center it. + + center keep { pad load "mybg.png" } + +=item rootalign $img + +Moves the image so that it appears glued to the screen as opposed to the +window. This gives the illusion of a larger area behind the window. It is +exactly equivalent to C, that is, it moves the image to the +top left of the screen. + +Example: load a background image, put it in mirror mode and root align it. + + rootalign keep { mirror load "mybg.png" } + +Example: take the screen background and align it, giving the illusion of +transparency as long as the window isn't in front of other windows. + + rootalign root + +=cut + + sub move($$;$) { + my $img = pop->clone; + $img->move ($_[0], $_[1]); + $img + } + + sub align($;$$) { + my $img = pop; + + move $_[0] * (TW - $img->w), + $_[1] * (TH - $img->h), + $img + } + + sub center($;$$) { + my $img = pop; + my $w = $_[0] || TW; + my $h = $_[1] || TH; + + move 0.5 * ($w - $img->w), 0.5 * ($h - $img->h), $img + } + + sub rootalign($) { + move -TX, -TY, $_[0] + } + +=item rotate $center_x, $center_y, $degrees, $img + +Rotates the image clockwise by C<$degrees> degrees, around the point at +C<$center_x> and C<$center_y> (specified as factor of image width/height). + +Example: rotate the image by 90 degrees around its center. + + rotate 0.5, 0.5, 90, keep { load "$HOME/mybg.png" } + +=cut + + sub rotate($$$$) { + my $img = pop; + $img->rotate ( + $_[0] * ($img->w + $img->x), + $_[1] * ($img->h + $img->y), + $_[2] * (3.14159265 / 180), + ) + } + +=back + +=head2 COLOUR MODIFICATIONS + +The following operators change the pixels of the image. + +=over 4 + +=item tint $color, $img + +Tints the image in the given colour. + +Example: tint the image red. + + tint "red", load "rgb.png" + +Example: the same, but specify the colour by component. + + tint [1, 0, 0], load "rgb.png" + +=cut + + sub tint($$) { + $_[1]->tint ($_[0]) + } + +=item shade $factor, $img + +Shade the image by the given factor. + +=cut + + sub shade($$) { + $_[1]->shade ($_[0]) + } + +=item contrast $factor, $img + +=item contrast $r, $g, $b, $img + +=item contrast $r, $g, $b, $a, $img + +Adjusts the I of an image. + +The first form applies a single C<$factor> to red, green and blue, the +second form applies separate factors to each colour channel, and the last +form includes the alpha channel. + +Values from 0 to 1 lower the contrast, values higher than 1 increase the +contrast. + +Due to limitations in the underlying XRender extension, lowering contrast +also reduces brightness, while increasing contrast currently also +increases brightness. + +=item brightness $bias, $img + +=item brightness $r, $g, $b, $img + +=item brightness $r, $g, $b, $a, $img + +Adjusts the brightness of an image. + +The first form applies a single C<$bias> to red, green and blue, the +second form applies separate biases to each colour channel, and the last +form includes the alpha channel. + +Values less than 0 reduce brightness, while values larger than 0 increase +it. Useful range is from -1 to 1 - the former results in a black, the +latter in a white picture. + +Due to idiosyncrasies in the underlying XRender extension, biases less +than zero can be I slow. + +You can also try the experimental(!) C operator. + +=cut + + sub contrast($$;$$;$) { + my $img = pop; + my ($r, $g, $b, $a) = @_; + + ($g, $b) = ($r, $r) if @_ < 3; + $a = 1 if @_ < 4; + + $img = $img->clone; + $img->contrast ($r, $g, $b, $a); + $img + } + + sub brightness($$;$$;$) { + my $img = pop; + my ($r, $g, $b, $a) = @_; + + ($g, $b) = ($r, $r) if @_ < 3; + $a = 1 if @_ < 4; + + $img = $img->clone; + $img->brightness ($r, $g, $b, $a); + $img + } + +=item muladd $mul, $add, $img # EXPERIMENTAL + +First multiplies the pixels by C<$mul>, then adds C<$add>. This can be used +to implement brightness and contrast at the same time, with a wider value +range than contrast and brightness operators. + +Due to numerous bugs in XRender implementations, it can also introduce a +number of visual artifacts. + +Example: increase contrast by a factor of C<$c> without changing image +brightness too much. + + muladd $c, (1 - $c) * 0.5, $img + +=cut + + sub muladd($$$) { + $_[2]->muladd ($_[0], $_[1]) + } + +=item blur $radius, $img + +=item blur $radius_horz, $radius_vert, $img + +Gaussian-blurs the image with (roughly) C<$radius> pixel radius. The radii +can also be specified separately. + +Blurring is often I slow, at least compared or other +operators. Larger blur radii are slower than smaller ones, too, so if you +don't want to freeze your screen for long times, start experimenting with +low values for radius (<5). + +=cut + + sub blur($$;$) { + my $img = pop; + $img->blur ($_[0], @_ >= 2 ? $_[1] : $_[0]) + } + +=item focus_fade $img + +=item focus_fade $factor, $img + +=item focus_fade $factor, $color, $img + +Fades the image by the given factor (and colour) when focus is lost (the +same as the C<-fade>/C<-fadecolor> command line options, which also supply +the default values for C and C<$color>. Unlike with C<-fade>, the +C<$factor> is a real value, not a percentage value (that is, 0..1, not +0..100). + +Example: do the right thing when focus fading is requested. + + focus_fade load "mybg.jpg"; + +=cut + + sub focus_fade($;$$) { + my $img = pop; + + return $img + if FOCUS; + + my $fade = @_ >= 1 ? $_[0] : defined $self->resource ("fade") ? $self->resource ("fade") * 0.01 : 0; + my $color = @_ >= 2 ? $_[1] : $self->resource ("color+" . urxvt::Color_fade); + + $img = $img->tint ($color) if $color ne "rgb:00/00/00"; + $img = $img->muladd (1 - $fade, 0) if $fade; + + $img + } + +=back + +=head2 OTHER STUFF + +Anything that didn't fit any of the other categories, even after applying +force and closing our eyes. + +=over 4 + +=item keep { ... } + +This operator takes a code block as argument, that is, one or more +statements enclosed by braces. + +The trick is that this code block is only evaluated when the outcome +changes - on other calls the C simply returns the image it computed +previously (yes, it should only be used with images). Or in other words, +C I the result of the code block so it doesn't need to be +computed again. + +This can be extremely useful to avoid redoing slow operations - for +example, if your background expression takes the root background, blurs it +and then root-aligns it it would have to blur the root background on every +window move or resize. + +Another example is C, which can be quite slow. + +In fact, urxvt itself encloses the whole expression in some kind of +C block so it only is reevaluated as required. + +Putting the blur into a C block will make sure the blur is only done +once, while the C is still done each time the window moves. + + rootalign keep { blur 10, root } + +This leaves the question of how to force reevaluation of the block, +in case the root background changes: If expression inside the block +is sensitive to some event (root background changes, window geometry +changes), then it will be reevaluated automatically as needed. + +=cut + + sub keep(&) { + my $id = $_[0]+0; + + local $frame = $self->{frame_cache}{$id} ||= [$frame]; + + unless ($frame->[FR_CACHE]) { + $frame->[FR_CACHE] = [ $_[0]() ]; + + my $self = $self; + my $frame = $frame; + Scalar::Util::weaken $frame; + $self->compile_frame ($frame, sub { + # clear this frame cache, also for all parents + for (my $frame = $frame; $frame; $frame = $frame->[0]) { + undef $frame->[FR_CACHE]; + } + + $self->recalculate; + }); + }; + + # in scalar context we always return the first original result, which + # is not quite how perl works. + wantarray + ? @{ $frame->[FR_CACHE] } + : $frame->[FR_CACHE][0] + } + +# sub keep_clear() { +# delete $self->{frame_cache}; +# } + +=back + +=cut + +} + +sub parse_expr { + my $expr = eval + "sub {\n" + . "package urxvt::bgdsl;\n" + . "#line 0 'background expression'\n" + . "$_[0]\n" + . "}"; + die if $@; + $expr +} + +# compiles a parsed expression +sub set_expr { + my ($self, $expr) = @_; + + $self->{root} = []; # the outermost frame + $self->{expr} = $expr; + $self->recalculate; +} + +# takes a hash of sensitivity indicators and installs watchers +sub compile_frame { + my ($self, $frame, $cb) = @_; + + my $state = $frame->[urxvt::bgdsl::FR_STATE] ||= {}; + my $again = $frame->[urxvt::bgdsl::FR_AGAIN]; + + # don't keep stuff alive + Scalar::Util::weaken $state; + + if ($again->{nested}) { + $state->{nested} = 1; + } else { + delete $state->{nested}; + } + + if (my $interval = $again->{time}) { + $state->{time} = [$interval, urxvt::timer->new->after ($interval)->interval ($interval)] + if $state->{time}[0] != $interval; + + # callback *might* have changed, although we could just rule that out + $state->{time}[1]->cb (sub { + ++$state->{counter}; + $cb->(); + }); + } else { + delete $state->{time}; + } + + if ($again->{position}) { + $state->{position} = $self->on (position_change => $cb); + } else { + delete $state->{position}; + } + + if ($again->{size}) { + $state->{size} = $self->on (size_change => $cb); + } else { + delete $state->{size}; + } + + if ($again->{rootpmap}) { + $state->{rootpmap} = $self->on (rootpmap_change => $cb); + } else { + delete $state->{rootpmap}; + } + + if ($again->{focus}) { + $state->{focus} = $self->on (focus_in => $cb, focus_out => $cb); + } else { + delete $state->{focus}; + } +} + +# evaluate the current bg expression +sub recalculate { + my ($arg_self) = @_; + + # rate limit evaluation + + if ($arg_self->{next_refresh} > urxvt::NOW) { + $arg_self->{next_refresh_timer} = urxvt::timer->new->after ($arg_self->{next_refresh} - urxvt::NOW)->cb (sub { + $arg_self->recalculate; + }); + return; + } + + $arg_self->{next_refresh} = urxvt::NOW + $MIN_INTERVAL; + + # set environment to evaluate user expression + + local $self = $arg_self; + local $HOME = $ENV{HOME}; + local $frame = $self->{root}; + + ($x, $y, $w, $h) = $self->background_geometry ($self->{border}); + $focus = $self->focus; + + # evaluate user expression + + my @img = eval { $self->{expr}->() }; + die $@ if $@; + die "background-expr did not return anything.\n" unless @img; + die "background-expr: expected image(s), got something else.\n" + if grep { !UNIVERSAL::isa $_, "urxvt::img" } @img; + + my $img = urxvt::bgdsl::merge @img; + + $frame->[FR_AGAIN]{size} = 1 + if $img->repeat_mode != urxvt::RepeatNormal; + + # if the expression is sensitive to external events, prepare reevaluation then + $self->compile_frame ($frame, sub { $arg_self->recalculate }); + + # clear stuff we no longer need + +# unless (%{ $frame->[FR_STATE] }) { +# delete $self->{state}; +# delete $self->{expr}; +# } + + # set background pixmap + + $self->set_background ($img, $self->{border}); + $self->scr_recolor (0); + $self->want_refresh; +} + +sub on_start { + my ($self) = @_; + + my $expr = $self->x_resource ("%.expr") + or return; + + $self->has_render + or die "background extension needs RENDER extension 0.10 or higher, ignoring background-expr.\n"; + + $self->set_expr (parse_expr $expr); + $self->{border} = $self->x_resource_boolean ("%.border"); + + $MIN_INTERVAL = $self->x_resource ("%.interval"); + + () +} + diff --git a/etc/soft/urxvt/perl/bell-command b/etc/soft/urxvt/perl/bell-command new file mode 100644 index 0000000..d499ca5 --- /dev/null +++ b/etc/soft/urxvt/perl/bell-command @@ -0,0 +1,51 @@ +#! perl + +# Copyright (C) 2011 Ryan Kavanagh +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License along +# with this program; if not, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +#:META:RESOURCE:%:string:the shell snippet to execute + +=head1 NAME + +bell-command - execute a command when the bell rings + +=head1 DESCRIPTION + +Runs the command specified by the C resource when +a bell event occurs. For example, the following pops up a notification +bubble with the text "Beep, Beep" using notify-send: + + URxvt.bell-command: notify-send "Beep, Beep" + +=cut + +sub on_start { + my ($self) = @_; + + $self->{bell_cmd} = $self->x_resource ("bell-command"); + + () +} + +sub on_bell { + my ($self) = @_; + + if (defined $self->{bell_cmd}) { + $self->exec_async ($self->{bell_cmd}); + } + + () +} diff --git a/etc/soft/urxvt/perl/block-graphics-to-ascii b/etc/soft/urxvt/perl/block-graphics-to-ascii new file mode 100644 index 0000000..3d6e71a --- /dev/null +++ b/etc/soft/urxvt/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/etc/soft/urxvt/perl/clipboard-osc b/etc/soft/urxvt/perl/clipboard-osc new file mode 100644 index 0000000..58d3c2b --- /dev/null +++ b/etc/soft/urxvt/perl/clipboard-osc @@ -0,0 +1,30 @@ +#! perl + +=head1 NAME + +clipboard-osc - implement the clipboard operating system command sequence + +=head1 SYNOPSIS + + urxvt -pe clipboard-osc + +=head1 DESCRIPTION + +This extension implements the clipboard;copy Perl OSC. + +=cut + + +sub on_osc_seq_perl { + my ($self, $osc, $resp) = @_; + + return unless $osc =~ s/^clipboard;([^;]+)//; + + if ($1 eq "copy") { + my $text = $self->selection (); + $self->selection ($text, 1); + $self->selection_grab (urxvt::CurrentTime, 1); + } + + 1 +} diff --git a/etc/soft/urxvt/perl/confirm-paste b/etc/soft/urxvt/perl/confirm-paste new file mode 100644 index 0000000..4b45238 --- /dev/null +++ b/etc/soft/urxvt/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/etc/soft/urxvt/perl/digital-clock b/etc/soft/urxvt/perl/digital-clock new file mode 100644 index 0000000..7adddde --- /dev/null +++ b/etc/soft/urxvt/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/etc/soft/urxvt/perl/eval b/etc/soft/urxvt/perl/eval new file mode 100644 index 0000000..1f38c3b --- /dev/null +++ b/etc/soft/urxvt/perl/eval @@ -0,0 +1,119 @@ +#! perl + +=head1 NAME + +eval - evaluate arbitrary perl code using actions + +=head1 EXAMPLES + + URxvt.keysym.M-c: eval:selection_to_clipboard + URxvt.keysym.M-v: eval:paste_clipboard + URxvt.keysym.M-V: eval:paste_primary + + URxvt.keysym.M-Up: eval:scroll_up 1 + URxvt.keysym.M-Down: eval:scroll_down 1 + URxvt.keysym.M-Home: eval:scroll_to_top + URxvt.keysym.M-End: eval:scroll_to_bottom + +=head1 DESCRIPTION + +Add support for evaluating arbitrary perl code using actions in keysym +resources. If a keysym I takes the form C, the +specified B is evaluated as a Perl expression. While the full +urxvt API is available, the following methods are also provided for +users' convenience, as they implement basic actions: + +=cut + +our ($self); + +=over 4 + +=item scroll_up $count + +=item scroll_up_pages $count + +=item scroll_down $count + +=item scroll_down_pages $count + +Scroll up or down by C<$count> lines or pages. + +=cut + +sub scroll_up ($) { + my $lines = $_[0]; + $self->view_start ($self->view_start - $lines); +} + +sub scroll_up_pages ($) { + my $lines = $_[0] * ($self->nrow - 1); + $self->view_start ($self->view_start - $lines); +} + +sub scroll_down ($) { + my $lines = $_[0]; + $self->view_start ($self->view_start + $lines); +} + +sub scroll_down_pages ($) { + my $lines = $_[0] * ($self->nrow - 1); + $self->view_start ($self->view_start + $lines); +} + +=item scroll_to_top + +=item scroll_to_bottom + +Scroll to the top or bottom of the scrollback. + +=cut + +sub scroll_to_top () { + $self->view_start ($self->top_row); +} + +sub scroll_to_bottom () { + $self->view_start (0); +} + +=item selection_to_clipboard + +Copy the selection to the CLIPBOARD. + +=cut + +sub selection_to_clipboard () { + $self->selection ($self->selection, 1); + $self->selection_grab (urxvt::CurrentTime, 1); +} + +=item paste_primary + +=item paste_clipboard + +Paste the value of the PRIMARY or CLIPBOARD selection. + +=cut + +sub paste_primary () { + $self->selection_request (urxvt::CurrentTime, 1); +} + +sub paste_clipboard () { + $self->selection_request (urxvt::CurrentTime, 3); +} + +=back + +=cut + +sub on_action { + my ($arg_self, $action) = @_; + + local $self = $arg_self; + eval "#line 1 \"$action\"\n$action"; + die $@ if $@; + + () +} diff --git a/etc/soft/urxvt/perl/example-refresh-hooks b/etc/soft/urxvt/perl/example-refresh-hooks new file mode 100644 index 0000000..97d8d71 --- /dev/null +++ b/etc/soft/urxvt/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/etc/soft/urxvt/perl/font-size b/etc/soft/urxvt/perl/font-size new file mode 100644 index 0000000..f6a33bb --- /dev/null +++ b/etc/soft/urxvt/perl/font-size @@ -0,0 +1,471 @@ +#!/usr/bin/perl +# +# On-the-fly adjusting of the font size in urxvt +# +# Copyright (c) 2008 David O'Neill +# 2012 Noah K. Tilton +# 2009-2012 Simon Lundström +# 2012-2016 Jan Larres +# +# Permission is hereby granted, free of charge, to any person obtaining a copy +# of this software and associated documentation files (the "Software"), to +# deal in the Software without restriction, including without limitation the +# rights to use, copy, modify, merge, publish, distribute, sublicense, and/or +# sell copies of the Software, and to permit persons to whom the Software is +# furnished to do so, subject to the following conditions: +# +# The above copyright notice and this permission notice shall be included in +# all copies or substantial portions of the Software. +# +# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING +# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS +# IN THE SOFTWARE. +# +# URL: https://github.com/majutsushi/urxvt-font-size +# +# Based on: +# https://github.com/dave0/urxvt-font-size +# https://github.com/noah/urxvt-font +# https://github.com/simmel/urxvt-resize-font +# + +#:META:X_RESOURCE:%.step:interger:font size increase/decrease step + +=head1 NAME + +font-size - interactive font size setter + +=head1 USAGE + +Put the font-size script into $HOME/.urxvt/ext/ and add it to the list +of enabled perl-extensions in ~/.Xresources: + + URxvt.perl-ext-common: ...,font-size + +Add some keybindings: + + URxvt.keysym.C-Up: font-size:increase + URxvt.keysym.C-Down: font-size:decrease + URxvt.keysym.C-S-Up: font-size:incglobal + URxvt.keysym.C-S-Down: font-size:decglobal + URxvt.keysym.C-equal: font-size:reset + URxvt.keysym.C-slash: font-size:show + +Note that for urxvt versions older than 9.21 the resources have to look like this: + + URxvt.keysym.C-Up: perl:font-size:increase + URxvt.keysym.C-Down: perl:font-size:decrease + URxvt.keysym.C-S-Up: perl:font-size:incglobal + URxvt.keysym.C-S-Down: perl:font-size:decglobal + URxvt.keysym.C-equal: perl:font-size:reset + URxvt.keysym.C-slash: perl:font-size:show + +Supported functions: + +=over 2 + +=item * increase/decrease: + + increase or decrease the font size of the current terminal. + +=item * incglobal/decglobal: + + same as above and also adjust the X server values so all newly + started terminals will use the same fontsize. + +=item * incsave/decsave: + + same as incglobal/decglobal and also modify the ~/.Xresources + file so the changed font sizes will persist over a restart of + the X server or a reboot. + +=item * reset: + + reset the font size to the value of the resource when starting + the terminal. + +=item * show + + show the current value of the 'font' resource in a popup. + +=back + +You can also change the step size that the script will use to increase +the font size: + + URxvt.font-size.step: 4 + +The default step size is 1. This means that with this setting a +size change sequence would be for example 8->12->16->20 instead of +8->9->10->11->12 etc. Please note that many X11 fonts are only +available in specific sizes, though, and odd sizes are often not +available, resulting in an effective step size of 2 instead of 1 +in that case. +=cut + +use strict; +use warnings; + +my %escapecodes = ( + "font" => 710, + "boldFont" => 711, + "italicFont" => 712, + "boldItalicFont" => 713 +); + +sub on_start +{ + my ($self) = @_; + + $self->{step} = $self->x_resource("%.step") || 1; + + foreach my $type (qw(font boldFont italicFont boldItalicFont)) { + $self->{$type} = $self->x_resource($type) || "undef"; + } +} + +# Needed for backwards compatibility with < 9.21 +sub on_user_command +{ + my ($self, $cmd) = @_; + + my $step = $self->{step}; + + if ($cmd eq "font-size:increase") { + fonts_change_size($self, $step, 0); + } elsif ($cmd eq "font-size:decrease") { + fonts_change_size($self, -$step, 0); + } elsif ($cmd eq "font-size:incglobal") { + fonts_change_size($self, $step, 1); + } elsif ($cmd eq "font-size:decglobal") { + fonts_change_size($self, -$step, 1); + } elsif ($cmd eq "font-size:incsave") { + fonts_change_size($self, $step, 2); + } elsif ($cmd eq "font-size:decsave") { + fonts_change_size($self, -$step, 2); + } elsif ($cmd eq "font-size:reset") { + fonts_reset($self); + } elsif ($cmd eq "font-size:show") { + fonts_show($self); + } +} + +sub on_action +{ + my ($self, $action) = @_; + + my $step = $self->{step}; + + if ($action eq "increase") { + fonts_change_size($self, $step, 0); + } elsif ($action eq "decrease") { + fonts_change_size($self, -$step, 0); + } elsif ($action eq "incglobal") { + fonts_change_size($self, $step, 1); + } elsif ($action eq "decglobal") { + fonts_change_size($self, -$step, 1); + } elsif ($action eq "incsave") { + fonts_change_size($self, $step, 2); + } elsif ($action eq "decsave") { + fonts_change_size($self, -$step, 2); + } elsif ($action eq "reset") { + fonts_reset($self); + } elsif ($action eq "show") { + fonts_show($self); + } +} + +sub fonts_change_size +{ + my ($term, $delta, $save) = @_; + + my @newfonts = (); + + my $curres = $term->resource('font'); + if (!$curres) { + $term->scr_add_lines("\r\nWarning: No font configured, trying a default.\r\nPlease set a font with the 'URxvt.font' resource."); + $curres = "fixed"; + } + my @curfonts = split(/\s*,\s*/, $curres); + + my $basefont = shift(@curfonts); + my ($newbasefont, $newbasedelta, $newbasesize) = handle_font($term, $basefont, $delta, 0, 0); + push @newfonts, $newbasefont; + + # Only adjust other fonts if base font changed + if ($newbasefont ne $basefont) { + foreach my $font (@curfonts) { + my ($newfont, $newdelta, $newsize) = handle_font($term, $font, $delta, $newbasedelta, $newbasesize); + push @newfonts, $newfont; + } + my $newres = join(",", @newfonts); + font_apply_new($term, $newres, "font", $save); + + handle_type($term, "boldFont", $delta, $newbasedelta, $newbasesize, $save); + handle_type($term, "italicFont", $delta, $newbasedelta, $newbasesize, $save); + handle_type($term, "boldItalicFont", $delta, $newbasedelta, $newbasesize, $save); + } + + if ($save > 1) { + # write the new values back to the file + my $xresources = readlink $ENV{"HOME"} . "/.Xresources"; + system("xrdb -edit " . $xresources); + } +} + +sub fonts_reset +{ + my ($term) = @_; + + foreach my $type (qw(font boldFont italicFont boldItalicFont)) { + my $initial = $term->{$type}; + if ($initial ne "undef") { + font_apply_new($term, $initial, $type, 0); + } + } +} + +sub fonts_show +{ + my ($term) = @_; + + my $out = $term->resource('font'); + $out =~ s/\s*,\s*/\n/g; + + $term->{'font-size'}{'overlay'} = { + overlay => $term->overlay_simple(0, -1, $out), + timer => urxvt::timer->new->start(urxvt::NOW + 5)->cb( + sub { + delete $term->{'font-size'}{'overlay'}; + } + ), + }; +} + +sub handle_type +{ + my ($term, $type, $delta, $basedelta, $basesize, $save) = @_; + + my $curres = $term->resource($type); + if (!$curres) { + return; + } + my @curfonts = split(/\s*,\s*/, $curres); + my @newfonts = (); + + foreach my $font (@curfonts) { + my ($newfont, $newdelta, $newsize) = handle_font($term, $font, $delta, $basedelta, $basesize); + push @newfonts, $newfont; + } + + my $newres = join(",", @newfonts); + font_apply_new($term, $newres, $type, $save); +} + +sub handle_font +{ + my ($term, $font, $delta, $basedelta, $basesize) = @_; + + my $newfont; + my $newdelta; + my $newsize; + my $prefix = 0; + + if ($font =~ /^\s*x:/) { + $font =~ s/^\s*x://; + $prefix = 1; + } + if ($font =~ /^\s*(\[.*\])?xft:/) { + ($newfont, $newdelta, $newsize) = font_change_size_xft($term, $font, $delta, $basedelta, $basesize); + } elsif ($font =~ /^\s*-/) { + ($newfont, $newdelta, $newsize) = font_change_size_xlfd($term, $font, $delta, $basedelta, $basesize); + } else { + # check whether the font is a valid alias and if yes resolve it to the + # actual font + my $lsfinfo = `xlsfonts -l $font 2>/dev/null`; + + if ($lsfinfo eq "") { + # not a valid alias, ring the bell if it is the base font and just + # return the current font + if ($basesize == 0) { + $term->scr_bell; + } + return ($font, $basedelta, $basesize); + } + + my $fontinfo = (split(/\n/, $lsfinfo))[-1]; + my ($fontfull) = ($fontinfo =~ /\s+([-a-z0-9]+$)/); + ($newfont, $newdelta, $newsize) = font_change_size_xlfd($term, $fontfull, $delta, $basedelta, $basesize); + } + + # $term->scr_add_lines("\r\nNew font is $newfont\n"); + if ($prefix) { + $newfont = "x:$newfont"; + } + return ($newfont, $newdelta, $newsize); +} + +sub font_change_size_xft +{ + my ($term, $fontstring, $delta, $basedelta, $basesize) = @_; + + my @pieces = split(/:/, $fontstring); + my @resized = (); + my $size = 0; + my $new_size = 0; + + foreach my $piece (@pieces) { + if ($piece =~ /^(?:(?:pixel)?size=|[^=-]+-)(\d+(\.\d*)?)$/) { + $size = $1; + + if ($basedelta != 0) { + $new_size = $size + $basedelta; + } else { + $new_size = $size + $delta; + } + + $piece =~ s/(=|-)$size/$1$new_size/; + } + push @resized, $piece; + } + + my $resized_str = join(":", @resized); + + # don't make fonts too small + if ($new_size >= 6) { + return ($resized_str, $new_size - $size, $new_size); + } else { + if ($basesize == 0) { + $term->scr_bell; + } + return ($fontstring, 0, $size); + } +} + +sub font_change_size_xlfd +{ + my ($term, $fontstring, $delta, $basedelta, $basesize) = @_; + + #-xos4-terminus-medium-r-normal-*-12-*-*-*-*-*-*-1 + + my @fields = qw(foundry family weight slant setwidth style pixelSize pointSize Xresolution Yresolution spacing averageWidth registry encoding); + + my %font; + $fontstring =~ s/^-//; # Strip leading - before split + @font{@fields} = split(/-/, $fontstring); + + if ($font{pixelSize} eq '*') { + $term->scr_add_lines("\r\nWarning: Font size undefined, assuming 12.\r\nPlease set the 'URxvt.font' resource to a font with a concrete size."); + $font{pixelSize} = '12' + } + if ($font{registry} eq '*') { + $font{registry} ='iso8859'; + } + + # Blank out the size for the pattern + my %pattern = %font; + $pattern{foundry} = '*'; + $pattern{setwidth} = '*'; + $pattern{pixelSize} = '*'; + $pattern{pointSize} = '*'; + # if ($basesize != 0) { + # $pattern{Xresolution} = '*'; + # $pattern{Yresolution} = '*'; + # } + $pattern{averageWidth} = '*'; + # make sure there are no empty fields + foreach my $field (@fields) { + $pattern{$field} = '*' unless defined($pattern{$field}); + } + my $new_fontstring = '-' . join('-', @pattern{@fields}); + + my @candidates; + # $term->scr_add_lines("\r\nPattern is $new_fontstring\n"); + open(FOO, "xlsfonts -fn '$new_fontstring' | sort -u |") or die $!; + while () { + chomp; + s/^-//; # Strip leading '-' before split + my @fontdata = split(/-/, $_); + + push @candidates, [$fontdata[6], "-$_"]; + # $term->scr_add_lines("\r\npossibly $fontdata[6] $_\n"); + } + close(FOO); + + if (!@candidates) { + die "No possible fonts!"; + } + + if ($basesize != 0) { + # sort by font size, descending + @candidates = sort {$b->[0] <=> $a->[0]} @candidates; + + # font is not the base font, so find the largest font that is at most + # as large as the base font. If the largest possible font is smaller + # than the base font bail and hope that a 0-size font can be found at + # the end of the function + if ($candidates[0]->[0] > $basesize) { + foreach my $candidate (@candidates) { + if ($candidate->[0] <= $basesize) { + return ($candidate->[1], $candidate->[0] - $font{pixelSize}, $candidate->[0]); + } + } + } + } elsif ($delta > 0) { + # sort by font size, ascending + @candidates = sort {$a->[0] <=> $b->[0]} @candidates; + + foreach my $candidate (@candidates) { + if ($candidate->[0] >= $font{pixelSize} + $delta) { + return ($candidate->[1], $candidate->[0] - $font{pixelSize}, $candidate->[0]); + } + } + } elsif ($delta < 0) { + # sort by font size, descending + @candidates = sort {$b->[0] <=> $a->[0]} @candidates; + + foreach my $candidate (@candidates) { + if ($candidate->[0] <= $font{pixelSize} + $delta && $candidate->[0] != 0) { + return ($candidate->[1], $candidate->[0] - $font{pixelSize}, $candidate->[0]); + } + } + } + + # no fitting font available, check whether a 0-size font can be used to + # fit the size of the base font + @candidates = sort {$a->[0] <=> $b->[0]} @candidates; + if ($basesize != 0 && $candidates[0]->[0] == 0) { + return ($candidates[0]->[1], $basedelta, $basesize); + } else { + # if there is absolutely no smaller/larger font that can be used + # return the current one, and beep if this is the base font + if ($basesize == 0) { + $term->scr_bell; + } + return ("-$fontstring", 0, $font{pixelSize}); + } +} + +sub font_apply_new +{ + my ($term, $newfont, $type, $save) = @_; + + # $term->scr_add_lines("\r\nnew font is $newfont\n"); + + $term->cmd_parse("\033]" . $escapecodes{$type} . ";" . $newfont . "\033\\"); + + # load the xrdb db + # system("xrdb -load " . X_RESOURCES); + + if ($save > 0) { + # merge the new values + open(XRDB_MERGE, "| xrdb -merge") || die "can't fork: $!"; + local $SIG{PIPE} = sub { die "xrdb pipe broken" }; + print XRDB_MERGE "URxvt." . $type . ": " . $newfont; + close(XRDB_MERGE) || die "bad xrdb: $! $?"; + } +} diff --git a/etc/soft/urxvt/perl/keysym-list b/etc/soft/urxvt/perl/keysym-list new file mode 100644 index 0000000..433fbc5 --- /dev/null +++ b/etc/soft/urxvt/perl/keysym-list @@ -0,0 +1,37 @@ +#! perl + +=head1 NAME + +keysym-list - implement the "list" keysym expansion. + +=head1 SYNOPSIS + + urxvt -pe keysym-list + +=head1 DESCRIPTION + +The "list" keysym expansion was formerly part of the rxvt-unicode core, +and has been moved into this extension for backwards compatibility. You +shouldn't use this extension except for compatibility with old +configurations. + +=cut + + +sub on_register_command { + my ($self, $keysym, $state, $str) = @_; + + if ($str =~ /^list(.)/) { + my @list = split /\Q$1/, $str; + if (@list == 3 or @list == 4) { + $self->register_command ($keysym++, $state, "string:$list[1]$_$list[3]") + for split //, $list[2]; + + return 1; + } + + warn "unable to parse keysym '$str' as list, processing as normal keysym\n"; + } + + () +} diff --git a/etc/soft/urxvt/perl/kuake b/etc/soft/urxvt/perl/kuake new file mode 100644 index 0000000..f6557e0 --- /dev/null +++ b/etc/soft/urxvt/perl/kuake @@ -0,0 +1,85 @@ +#! perl + +#:META:RESOURCE:%.hotkey:string:activation hotkey keysym + +=head1 NAME + +kuake - kuake-like hotkey terminal + +=head1 EXAMPLES + + @@RXVT_NAME@@ -kuake-hotkey F10 + + URxvt.kuake.hotkey: F10 + +=head1 DESCRIPTION + +A very primitive quake-console-like extension. It was inspired by a +description of how the programs C and C work: Whenever the +user presses a global accelerator key (by default C), the terminal +will show or hide itself. Another press of the accelerator key will hide +or show it again. + +Initially, the window will not be shown when using this extension. + +This is useful if you need a single terminal that is not using any desktop +space most of the time but is quickly available at the press of a key. + +The accelerator key is grabbed regardless of any modifiers, so this +extension will actually grab a physical key just for this function. + +If you want a quake-like animation, tell your window manager to do so +(fvwm can do it). + +=cut + +sub on_start { + my ($self) = @_; + + $self->{key} = $self->{argv}[0] || $self->x_resource ("%.hotkey") || "F10"; + + $self->{keysym} = $self->XStringToKeysym ($self->{key}) + or urxvt::fatal "cannot convert requested kuake wake-up key '$self->{key}' to keysym, unable to continue.\n"; + + $self->{keycode} = $self->XKeysymToKeycode ($self->{keysym}) + or urxvt::fatal "cannot convert requested kuake wake-up key '$self->{key}' to keycode, unable to continue.\n"; + + $self->XGrabKey ($self->{keycode}, urxvt::AnyModifier, $self->DefaultRootWindow); + + $self->XUnmapWindow ($self->parent); + + $self->{unmap_me} = 1; + + () +} + +sub on_map_notify { + my ($self) = @_; + + # suppress initial map event + $self->XUnmapWindow ($self->parent) + if delete $self->{unmap_me}; + + () +} + +sub on_root_event { + my ($self, $event) = @_; + + return unless $event->{type} == urxvt::KeyPress && $event->{keycode} == $self->{keycode}; + + $self->mapped + ? $self->XUnmapWindow ($self->parent) + : $self->XMapWindow ($self->parent); + + 1 +} + +sub on_destroy { + my ($self) = @_; + + $self->XUngrabKey ($self->XKeysymToKeycode ($self->{keysym}), 0, $self->DefaultRootWindow) + if $self->{keysym}; + + () +} diff --git a/etc/soft/urxvt/perl/matcher b/etc/soft/urxvt/perl/matcher new file mode 100644 index 0000000..96f0b77 --- /dev/null +++ b/etc/soft/urxvt/perl/matcher @@ -0,0 +1,492 @@ +#! perl + +# Author: Tim Pope +# Bob Farrell +# Emanuele Giaquinta + +#:META:RESOURCE:%.launcher:string:default launcher command +#:META:RESOURCE:%.button:string:the mouse button used to activate a match +#:META:RESOURCE:%.pattern.:string:extra pattern to match +#:META:RESOURCE:%.launcher.:string:custom launcher for pattern +#:META:RESOURCE:%.rend.:string:custom rendition for pattern + +=head1 NAME + +matcher - match strings in terminal output and change their rendition + +=head1 DESCRIPTION + +Uses per-line display filtering (C) to underline text +matching a certain pattern and make it clickable. When clicked with the +mouse button specified in the C resource (default 2, or +middle), the program specified in the C resource +(default, the C resource, C) will be started +with the matched text as first argument. The default configuration is +suitable for matching URLs and launching a web browser, like the +former "mark-urls" extension. + +The default pattern to match URLs can be overridden with the +C resource, and additional patterns can be specified +with numbered patterns, in a manner similar to the "selection" extension. +The launcher can also be overridden on a per-pattern basis. + +It is possible to activate the most recently seen match or a list of matches +from the keyboard. Simply bind a keysym to "matcher:last" or +"matcher:list" as seen in the example below. + +The 'matcher:select' action enables a mode in which it is possible to +iterate over the matches using the keyboard and either activate them +or copy them to the clipboard. While the mode is active, normal terminal +input/output is suspended and the following bindings are recognized: + +=over 4 + +=item C + +Search for a match upwards. + +=item C + +Search for a match downwards. + +=item C + +Jump to the topmost match. + +=item C + +Jump to the bottommost match. + +=item C + +Leave the mode and return to the point where search was started. + +=item C + +Activate the current match. + +=item C + +Copy the current match to the clipboard. + +=back + +Example: load and use the matcher extension with defaults. + + URxvt.perl-ext: default,matcher + +Example: use a custom configuration. + + URxvt.url-launcher: sensible-browser + URxvt.keysym.C-Delete: matcher:last + URxvt.keysym.M-Delete: matcher:list + URxvt.matcher.button: 1 + URxvt.matcher.pattern.1: \\bwww\\.[\\w-]+\\.[\\w./?&@#-]*[\\w/-] + URxvt.matcher.pattern.2: \\B(/\\S+?):(\\d+)(?=:|$) + URxvt.matcher.launcher.2: gvim +$2 $1 + +=cut + +my $url = + qr{ + (?:https?://|ftp://|news://|mailto:|file://|\bwww\.) + [\w\-\@;\/?:&=%\$.+!*\x27,~#]* + ( + \([\w\-\@;\/?:&=%\$.+!*\x27,~#]*\)| # Allow a pair of matched parentheses + [\w\-\@;\/?:&=%\$+*~] # exclude some trailing characters (heuristic) + )+ + }x; + +sub matchlist_key_press { + my ($self, $event, $keysym, $octets) = @_; + + delete $self->{overlay}; + $self->disable ("key_press"); + + my $i = ($keysym == 96 ? 0 : $keysym - 48); + if ($i >= 0 && $i < @{ $self->{matches} }) { + my @exec = @{ $self->{matches}[$i] }; + $self->exec_async (@exec[5 .. $#exec]); + } + + 1 +} + +# backwards compat +sub on_user_command { + my ($self, $cmd) = @_; + + if ($cmd eq "matcher:list") { + $self->matchlist; + } elsif ($cmd eq "matcher:last") { + $self->most_recent; + } elsif ($cmd eq "matcher:select") { + $self->select_enter; + } elsif ($cmd eq "matcher") { + # for backward compatibility + $self->most_recent; + } + + () +} + +sub on_action { + my ($self, $action) = @_; + + if ($action eq "list") { + $self->matchlist; + } elsif ($action eq "last") { + $self->most_recent; + } elsif ($action eq "select") { + $self->select_enter; + } + + () +} + +sub matchlist { + my ($self) = @_; + + $self->{matches} = []; + my $row = $self->nrow - 1; + while ($row >= 0 && @{ $self->{matches} } < 10) { + my $line = $self->line ($row); + my @matches = $self->find_matches ($row); + + for (sort { $b->[0] <=> $a->[0] or $b->[1] <=> $a->[1] } @matches) { + push @{ $self->{matches} }, $_; + last if @{ $self->{matches} } == 10; + } + + $row = $line->beg - 1; + } + + return unless @{ $self->{matches} }; + + my $width = 0; + + my $i = 0; + for my $match (@{ $self->{matches} }) { + my $text = $match->[4]; + my $w = $self->strwidth ("$i-$text"); + + $width = $w if $w > $width; + $i++; + } + + $width = $self->ncol - 2 if $width > $self->ncol - 2; + + $self->{overlay} = $self->overlay (0, 0, $width, scalar (@{ $self->{matches} }), urxvt::OVERLAY_RSTYLE, 2); + my $i = 0; + for my $match (@{ $self->{matches} }) { + my $text = $match->[4]; + + $self->{overlay}->set (0, $i, "$i-$text"); + $i++; + } + + $self->enable (key_press => \&matchlist_key_press); +} + +sub most_recent { + my ($self) = shift; + my $row = $self->nrow - 1; + my @exec; + while ($row >= $self->top_row) { + my $line = $self->line ($row); + @exec = $self->command_for($row); + last if(@exec); + + $row = $line->beg - 1; + } + if(@exec) { + return $self->exec_async (@exec); + } + () +} + +sub my_resource { + $_[0]->x_resource ("%.$_[1]") +} + +# turn a rendition spec in the resource into a sub that implements it on $_ +sub parse_rend { + my ($self, $str) = @_; + my ($mask, $fg, $bg, $failed) = $str ? urxvt::rend2mask($str) + : (urxvt::RS_Uline, undef, undef, []); + warn "Failed to parse rendition string: " . join(',', @$failed) if @$failed; + my @rend; + push @rend, sub { $_ |= $mask } if $mask; + push @rend, sub { $_ = urxvt::SET_FGCOLOR($_, $fg) } if defined $fg; + push @rend, sub { $_ = urxvt::SET_BGCOLOR($_, $bg) } if defined $bg; + sub { + for my $s ( @rend ) { &$s }; + } +} + +sub on_start { + my ($self) = @_; + + $self->{launcher} = $self->my_resource ("launcher") || $self->x_resource("url-launcher") || "sensible-browser"; + + $self->{button} = 2; + $self->{state} = 0; + if($self->{argv}[0] || $self->my_resource ("button")) { + my @mods = split '', $self->{argv}[0] || $self->my_resource ("button"); + for my $mod (@mods) { + if($mod =~ /^\d+$/) { + $self->{button} = $mod; + } elsif($mod eq "C") { + $self->{state} |= urxvt::ControlMask; + } elsif($mod eq "S") { + $self->{state} |= urxvt::ShiftMask; + } elsif($mod eq "M") { + $self->{state} |= $self->ModMetaMask; + } elsif($mod ne "-" && $mod ne " ") { + warn("$mod is invalid in $self->{_name}<$self->{argv}[0]>\n"); + } + } + } + + my @defaults = ($url); + my @matchers; + for (my $idx = 0; defined (my $res = $self->my_resource ("pattern.$idx") || $defaults[$idx]); $idx++) { + $res = $self->locale_decode ($res); + utf8::encode $res; + my $launcher = $self->my_resource ("launcher.$idx"); + $launcher =~ s/\$&|\$\{&\}/\${0}/g if $launcher; + my $rend = $self->parse_rend($self->my_resource ("rend.$idx")); + unshift @matchers, [qr($res)x,$launcher,$rend]; + } + $self->{matchers} = \@matchers; + + () +} + +sub on_line_update { + my ($self, $row) = @_; + + # fetch the line that has changed + my $line = $self->line ($row); + my $text = $line->t; + my $rend; + + # find all urls (if any) + for my $matcher (@{$self->{matchers}}) { + while ($text =~ /$matcher->[0]/g) { + #print "$&\n"; + $rend ||= $line->r; + + # mark all characters as underlined. we _must_ not toggle underline, + # as we might get called on an already-marked url. + &{$matcher->[2]} + for @{$rend}[$-[0] .. $+[0] - 1]; + } + } + + $line->r ($rend) if $rend; + + () +} + +sub valid_button { + my ($self, $event) = @_; + my $mask = $self->ModLevel3Mask | $self->ModMetaMask + | urxvt::ShiftMask | urxvt::ControlMask; + return ($event->{button} == $self->{button} && + ($event->{state} & $mask) == $self->{state}); +} + +sub find_matches { + my ($self, $row, $col) = @_; + my $line = $self->line ($row); + my $text = $line->t; + my $off = $line->offset_of ($row, $col) if defined $col; + + my @matches; + for my $matcher (@{$self->{matchers}}) { + my $launcher = $matcher->[1] || $self->{launcher}; + while ($text =~ /$matcher->[0]/g) { + my $match = substr $text, $-[0], $+[0] - $-[0]; + my @begin = @-; + my @end = @+; + my @exec; + + if (!defined($off) || ($-[0] <= $off && $+[0] >= $off)) { + if ($launcher !~ /\$/) { + @exec = ($launcher, $match); + } else { + # It'd be nice to just access a list like ($&,$1,$2...), + # but alas, m//g behaves differently in list context. + @exec = map { s/\$(\d+)|\$\{(\d+)\}/ + substr $text, $begin[$1 || $2], $end[$1 || $2] - $begin[$1 || $2] + /egx; $_ } split /\s+/, $launcher; + } + + push @matches, [ $line->coord_of ($begin[0]), $line->coord_of ($end[0]), $match, @exec ]; + } + } + } + + @matches; +} + +sub command_for { + my ($self, $row, $col) = @_; + + my @matches = $self->find_matches ($row, $col); + if (@matches) { + my @match = @{ $matches[0] }; + return @match[5 .. $#match]; + } + + () +} + +sub on_button_press { + my ($self, $event) = @_; + if($self->valid_button($event) + && (my @exec = $self->command_for($event->{row},$event->{col}))) { + $self->{row} = $event->{row}; + $self->{col} = $event->{col}; + $self->{cmd} = \@exec; + return 1; + } else { + delete $self->{row}; + delete $self->{col}; + delete $self->{cmd}; + } + + () +} + +sub on_button_release { + my ($self, $event) = @_; + + my $row = delete $self->{row}; + my $col = delete $self->{col}; + my $cmd = delete $self->{cmd}; + + return if !defined $row; + + if($row == $event->{row} && abs($col-$event->{col}) < 2 + && join("\x00", @$cmd) eq join("\x00", $self->command_for($row,$col))) { + if($self->valid_button($event)) { + + $self->exec_async (@$cmd); + + } + } + + 1; +} + +sub select_enter { + my ($self) = @_; + + $self->{view_start} = $self->view_start; + $self->{pty_ev_events} = $self->pty_ev_events (urxvt::EV_NONE); + $self->{cur_row} = $self->nrow - 1; + + $self->enable ( + key_press => \&select_key_press, + refresh_begin => \&select_refresh, + refresh_end => \&select_refresh, + ); + + $self->{overlay} = $self->overlay (0, -1, $self->ncol, 1, urxvt::OVERLAY_RSTYLE, 0); + $self->{overlay}->set (0, 0, "match-select"); +} + +sub select_leave { + my ($self) = @_; + + $self->disable ("key_press", "refresh_begin", "refresh_end"); + $self->pty_ev_events ($self->{pty_ev_events}); + + delete $self->{overlay}; + delete $self->{matches}; + delete $self->{id}; +} + +sub select_search { + my ($self, $dir, $row) = @_; + + while ($self->nrow > $row && $row >= $self->top_row) { + my $line = $self->line ($row) + or last; + + my @matches = $self->find_matches ($row); + if (@matches) { + @matches = sort { $a->[0] <=> $b->[0] or $a->[1] <=> $b->[1] } @matches; + $self->{matches} = \@matches; + $self->{cur_row} = $row; + $self->{id} = $dir < 0 ? @{ $self->{matches} } - 1 : 0; + $self->view_start (List::Util::min 0, $row - ($self->nrow >> 1)); + $self->want_refresh; + return; + } + + $row = $dir < 0 ? $line->beg - 1 : $line->end + 1; + } + + $self->scr_bell; +} + +sub select_refresh { + my ($self) = @_; + + return unless $self->{matches}; + + my $cur = $self->{matches}[$self->{id}]; + $self->scr_xor_span (@$cur[0 .. 3], urxvt::RS_RVid); + + () +} + +sub select_key_press { + my ($self, $event, $keysym, $string) = @_; + + if ($keysym == 0xff0d || $keysym == 0xff8d) { # enter + if ($self->{matches}) { + my @match = @{ $self->{matches}[$self->{id}] }; + $self->exec_async (@match[5 .. $#match]); + } + $self->select_leave; + } elsif ($keysym == 0x79) { # y + if ($self->{matches}) { + $self->selection ($self->{matches}[$self->{id}][4], 1); + $self->selection_grab (urxvt::CurrentTime, 1); + } + $self->select_leave; + } elsif ($keysym == 0xff1b) { # escape + $self->view_start ($self->{view_start}); + $self->select_leave; + } elsif ($keysym == 0xff50) { # home + $self->select_search (+1, $self->top_row) + } elsif ($keysym == 0xff57) { # end + $self->select_search (-1, $self->nrow - 1) + } elsif ($keysym == 0xff52) { # up + if ($self->{id} > 0) { + $self->{id}--; + $self->want_refresh; + } else { + my $line = $self->line ($self->{cur_row}); + $self->select_search (-1, $line->beg - 1) + if $line->beg > $self->top_row; + } + } elsif ($keysym == 0xff54) { # down + if ($self->{id} < @{ $self->{matches} } - 1) { + $self->{id}++; + $self->want_refresh; + } else { + my $line = $self->line ($self->{cur_row}); + $self->select_search (+1, $line->end + 1) + if $line->end < $self->nrow; + } + } + + 1 +} + +# vim:set sw=3 sts=3 et: diff --git a/etc/soft/urxvt/perl/option-popup b/etc/soft/urxvt/perl/option-popup new file mode 100644 index 0000000..d15aa1e --- /dev/null +++ b/etc/soft/urxvt/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/etc/soft/urxvt/perl/overlay-osc b/etc/soft/urxvt/perl/overlay-osc new file mode 100644 index 0000000..5b06e9a --- /dev/null +++ b/etc/soft/urxvt/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/etc/soft/urxvt/perl/readline b/etc/soft/urxvt/perl/readline new file mode 100644 index 0000000..b22677f --- /dev/null +++ b/etc/soft/urxvt/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/etc/soft/urxvt/perl/remote-clipboard b/etc/soft/urxvt/perl/remote-clipboard new file mode 100644 index 0000000..3f27c2c --- /dev/null +++ b/etc/soft/urxvt/perl/remote-clipboard @@ -0,0 +1,132 @@ +#! perl + +#:META:RESOURCE:%.store:string:the command used to store the selection +#:META:RESOURCE:%.fetch:string:the command used to fetch the selection + +=head1 NAME + +remote-clipboard - manage a shared and possibly remote clipboard + +=head1 DESCRIPTION + +Somewhat of a misnomer, this extension adds two menu entries to the +selection popup that allows one to run external commands to store the +selection somewhere and fetch it again. + +We use it to implement a "distributed selection mechanism", which just +means that one command uploads the file to a remote server, and another +reads it. + +The commands can be set using the C and +C resources. The first should read the +selection to store from STDIN (always in UTF-8), the second should provide +the selection data on STDOUT (also in UTF-8). + +The defaults (which are likely useless to you) use rsh and cat: + + URxvt.remote-selection.store: rsh ruth 'cat >/tmp/distributed-selection' + URxvt.remote-selection.fetch: rsh ruth 'cat /tmp/distributed-selection' + +=cut + +use Fcntl (); + +sub msg { + my ($self, $msg) = @_; + + my $ov = $self->overlay (-1, 0, $self->strwidth ($msg), 1, urxvt::OVERLAY_RSTYLE, 0); + $ov->set (0, 0, $msg); + + $self->{msg} = + urxvt::timer + ->new + ->after (5) + ->cb (sub { delete $self->{msg}; undef $ov; }); +} + +sub wait_pipe { + my ($self, $fh, $pid, $msg) = @_; + + $self->msg ("waiting for selection process to finish..."); + + my $wait_pipe; $wait_pipe = urxvt::pw->new->start ($pid)->cb (sub { + my ($undef, $status) = @_; + undef $wait_pipe; + close $fh; + $status >>= 8; + $self->msg ("$msg (status $status)"); + }); +} + +sub store { + my ($self) = @_; + + my $txt = $self->selection; + + local %ENV = %{ $self->env }; + if (my $pid = open my $fh, "|-:utf8", $self->{store_cmd}) { + fcntl $fh, &Fcntl::F_SETFL, &Fcntl::O_NONBLOCK; + $self->{iow} = urxvt::iow + ->new + ->fd (fileno $fh) + ->events (urxvt::EV_WRITE) + ->start + ->cb (sub { + if (my $len = syswrite $fh, $txt) { + substr $txt, 0, $len, ""; + $self->msg ((length $txt) . " chars to go..."); + } else { + delete $self->{iow}; + $self->wait_pipe ($fh, $pid, "selection stored"); + } + }); + } +} + +sub fetch { + my ($self) = @_; + + my $txt; + + local %ENV = %{ $self->env }; + if (my $pid = open my $fh, "-|:utf8", $self->{fetch_cmd}) { + fcntl $fh, &Fcntl::F_SETFL, &Fcntl::O_NONBLOCK; + $self->{iow} = urxvt::iow + ->new + ->fd (fileno $fh) + ->events (urxvt::EV_READ) + ->start + ->cb (sub { + if (my $len = sysread $fh, $txt, 8192, length $txt) { + $self->msg ((length $txt) . " chars read..."); + } else { + delete $self->{iow}; + $self->selection_clear; + $self->selection ($txt); + $self->selection_grab (urxvt::CurrentTime); + $self->msg ("selection fetched"); + } + }); + } +} + +sub on_start { + my ($self) = @_; + + $self->{store_cmd} = $self->x_resource ("%.store") + || "rsh ruth 'cat >/tmp/distributed-selection'"; + + $self->{fetch_cmd} = $self->x_resource ("%.fetch") + || "rsh ruth 'cat /tmp/distributed-selection'"; + + push @{ $self->{term}{selection_popup_hook} }, sub { + ("selection => remote" => sub { $self->store }) + }; + push @{ $self->{term}{selection_popup_hook} }, sub { + ("remote => selection" => sub { $self->fetch }) + }; + + () +} + + diff --git a/etc/soft/urxvt/perl/searchable-scrollback b/etc/soft/urxvt/perl/searchable-scrollback new file mode 100644 index 0000000..60f1852 --- /dev/null +++ b/etc/soft/urxvt/perl/searchable-scrollback @@ -0,0 +1,213 @@ +#! perl + +# this extension implements scrollback buffer search + +#:META:RESOURCE:%:string:activation hotkey keysym + +=head1 NAME + +searchable-scrollback - incremental scrollback search (enabled by default) + +=head1 DESCRIPTION + +Adds regex search functionality to the scrollback buffer, triggered by +the C action (bound to C by +default). While in search mode, normal terminal input/output is +suspended and a regex is displayed at the bottom of the screen. + +Inputting characters appends them to the regex and continues incremental +search. C removes a character from the regex, C and C +search upwards/downwards in the scrollback buffer, C jumps to the +bottom. C leaves search mode and returns to the point where search +was started, while C or C stay at the current position and +additionally stores the first match in the current line into the primary +selection if the C modifier is active. + +The regex defaults to "(?i)", resulting in a case-insensitive search. To +get a case-sensitive search you can delete this prefix using C +or simply use an uppercase character which removes the "(?i)" prefix. + +See L for more info about perl regular expression syntax. + +=cut + +sub on_init { + my ($self) = @_; + + # only for backwards compatibility + my $hotkey = $self->{argv}[0] + || $self->x_resource ("%") + || "M-s"; + + $self->bind_action ($hotkey, "%:start") + or warn "unable to register '$hotkey' as scrollback search start hotkey\n"; + + () +} + +sub on_user_command { + my ($self, $cmd) = @_; + + $cmd eq "searchable-scrollback:start" + and $self->enter; + + () +} + +sub on_action { + my ($self, $action) = @_; + + $action eq "start" + and $self->enter; + + () +} + +sub msg { + my ($self, $msg) = @_; + + $self->{overlay} = $self->overlay (0, -1, $self->ncol, 1, urxvt::OVERLAY_RSTYLE, 0); + $self->{overlay}->set (0, 0, $self->special_encode ($msg)); +} + +sub enter { + my ($self) = @_; + + return if $self->{overlay}; + + $self->{view_start} = $self->view_start; + $self->{pty_ev_events} = $self->pty_ev_events (urxvt::EV_NONE); + $self->{row} = $self->nrow - 1; + $self->{search} = "(?i)"; + + $self->enable ( + key_press => \&key_press, + tt_write => \&tt_write, + refresh_begin => \&refresh, + refresh_end => \&refresh, + ); + + $self->{manpage_overlay} = $self->overlay (0, -2, $self->ncol, 1, urxvt::OVERLAY_RSTYLE, 0); + $self->{manpage_overlay}->set (0, 0, "scrollback search, see the ${urxvt::RXVTNAME}perl manpage for details"); + + $self->idle; +} + +sub leave { + my ($self) = @_; + + $self->disable ("key_press", "tt_write", "refresh_begin", "refresh_end"); + $self->pty_ev_events ($self->{pty_ev_events}); + + delete $self->{manpage_overlay}; + delete $self->{overlay}; + delete $self->{search}; + delete $self->{found}; +} + +sub idle { + my ($self) = @_; + + $self->msg ("(escape cancels) /$self->{search}█"); +} + +sub search { + my ($self, $dir, $row) = @_; + + my $search = $self->special_encode ($self->{search}); + + no re 'eval'; # just to be sure + if (my $re = eval { qr/$search/ }) { + while ($self->nrow > $row && $row >= $self->top_row) { + my $line = $self->line ($row) + or last; + + my $text = $line->t; + if ($text =~ /$re/g) { + delete $self->{found}; + + do { + push @{ $self->{found} }, [$line->coord_of ($-[0]), $line->coord_of ($+[0])]; + } while $text =~ /$re/g; + + $self->{row} = $row; + $self->view_start (List::Util::min 0, $row - ($self->nrow >> 1)); + $self->want_refresh; + return; + } + + $row = $dir < 0 ? $line->beg - 1 : $line->end + 1; + } + } + + $self->scr_bell; +} + +sub refresh { + my ($self) = @_; + + return unless $self->{found}; + + my $xor = urxvt::RS_RVid | urxvt::RS_Blink; + for (@{ $self->{found} }) { + $self->scr_xor_span (@$_, $xor); + $xor = urxvt::RS_RVid; + } + + () +} + +sub key_press { + my ($self, $event, $keysym, $string) = @_; + + delete $self->{manpage_overlay}; + + if ($keysym == 0xff0d || $keysym == 0xff8d) { # enter + if ($self->{found} && $event->{state} & urxvt::ShiftMask) { + my ($br, $bc, $er, $ec) = @{ $self->{found}[0] }; + $self->selection_beg ($br, $bc); + $self->selection_end ($er, $ec); + $self->selection_make ($event->{time}); + } + $self->leave; + } elsif ($keysym == 0xff1b) { # escape + $self->view_start ($self->{view_start}); + $self->leave; + } elsif ($keysym == 0xff57) { # end + $self->{row} = $self->nrow - 1; + $self->view_start (0); + } elsif ($keysym == 0xff52) { # up + my $line = $self->line ($self->{row}); + $self->search (-1, $line->beg - 1) + if $line->beg > $self->top_row; + } elsif ($keysym == 0xff54) { # down + my $line = $self->line ($self->{row}); + $self->search (+1, $line->end + 1) + if $line->end < $self->nrow; + } elsif ($keysym == 0xff08) { # backspace + substr $self->{search}, -1, 1, ""; + $self->search (+1, $self->{row}); + $self->idle; + } elsif ($string !~ /[\x00-\x1f\x80-\xaf]/) { + return; # pass to tt_write + } + + 1 +} + +sub tt_write { + my ($self, $data) = @_; + + $self->{search} .= $self->locale_decode ($data); + + $self->{search} =~ s/^\(\?i\)// + if $self->{search} =~ /^\(.*[[:upper:]]/; + + delete $self->{found}; + $self->search (-1, $self->{row}); + $self->idle; + + 1 +} + + diff --git a/etc/soft/urxvt/perl/selection b/etc/soft/urxvt/perl/selection new file mode 100644 index 0000000..509423a --- /dev/null +++ b/etc/soft/urxvt/perl/selection @@ -0,0 +1,196 @@ +#! perl + +#:META:RESOURCE:%.pattern-0:string:first selection pattern + +=head1 NAME + +selection - more intelligent selection (enabled by default) + +=head1 DESCRIPTION + +This extension tries to be more intelligent when the user extends +selections (double-click and further clicks). Right now, it tries to +select words, urls and complete shell-quoted arguments, which is very +convenient, too, if your F supports C<--quoting-style=shell>. + +A double-click usually selects the word under the cursor, further clicks +will enlarge the selection. + +The selection works by trying to match a number of regexes and displaying +them in increasing order of length. You can add your own regexes by +specifying resources of the form: + + URxvt.selection.pattern-0: perl-regex + URxvt.selection.pattern-1: perl-regex + ... + +The index number (0, 1...) must not have any holes, and each regex must +contain at least one pair of capturing parentheses, which will be used for +the match. For example, the following adds a regex that matches everything +between two vertical bars: + + URxvt.selection.pattern-0: \\|([^|]+)\\| + +Another example: Programs I use often output "absolute path: " at the +beginning of a line when they process multiple files. The following +pattern matches the filename (note, there is a single space at the very +end): + + URxvt.selection.pattern-0: ^(/[^:]+):\ + +You can look at the source of the selection extension to see more +interesting uses, such as parsing a line from beginning to end. + +This extension also offers the following actions: + +=over 4 + +=item rot13 + +Rot-13 the selection when activated. + +Example: + + URxvt.keysym.C-M-r: selection:rot13 + +=back + +=cut + +sub on_user_command { + my ($self, $cmd) = @_; + + $cmd eq "selection:rot13" + and $self->selection (map { y/A-Za-z/N-ZA-Mn-za-m/; $_ } $self->selection); + + () +} + +sub on_action { + my ($self, $action) = @_; + + $action eq "rot13" + and $self->selection (map { y/A-Za-z/N-ZA-Mn-za-m/; $_ } $self->selection); + + () +} + +sub on_init { + my ($self) = @_; + + if (defined (my $res = $self->resource ("cutchars"))) { + $res = $self->locale_decode ($res); + push @{ $self->{patterns} }, qr{\G [\Q$res\E[:space:]]* ([^\Q$res\E[:space:]]+) }x; + } + + for (my $idx = 0; defined (my $res = $self->x_resource ("selection.pattern-$idx")); $idx++) { + $res = $self->locale_decode ($res); + push @{ $self->{patterns} }, qr/$res/; + } + + $self->{enabled} = 1; + + push @{ $self->{term}{option_popup_hook} }, sub { + ("new selection" => $self->{enabled}, sub { $self->{enabled} = shift }) + }; + + () +} + +# "find interesting things"-patterns +my @mark_patterns = ( +# qr{ ([[:word:]]+) }x, + qr{ ([^[:space:]]+) }x, + + # common types of "parentheses" + qr{ (?]+) \> }x, + + # urls, just a heuristic + qr{( + (?:https?://|ftp://|news://|mailto:|file://|\bwww\.)[ab-zA-Z0-9\-\@;\/?:&=%\$_.+!*\x27(),~#]+ + [ab-zA-Z0-9\-\@;\/?:&=%\$_+*()~] # exclude some trailing characters (heuristic) + )}x, + + # shell-like argument quoting, basically always matches + qr{\G [\ \t|&;<>()]* ( + (?: + [^\\"'\ \t|&;<>()]+ + | \\. + | " (?: [^\\"]+ | \\. )* " + | ' [^']* ' + )+ + )}x, +); + +# "correct obvious? crap"-patterns +my @simplify_patterns = ( + qr{^"([^\\"'\ \t|&;<>()*?]+)"$}, # "simple" => simple + qr{^(.*)[,\-]$}, # strip off trailing , and - +); + +sub on_sel_extend { + my ($self, $time) = @_; + + $self->{enabled} + or return; + + my ($row, $col) = $self->selection_mark; + my $line = $self->line ($row); + my $text = $line->t; + my $markofs = $line->offset_of ($row, $col); + my $curlen = $line->offset_of ($self->selection_end) + - $line->offset_of ($self->selection_beg); + + my @matches; + + if ($markofs < $line->l) { + study $text; # _really_ helps, too :) + + for my $regex (@mark_patterns, @{ $self->{patterns} }) { + while ($text =~ /$regex/g) { + if ($-[1] <= $markofs and $markofs <= $+[1]) { + my $ofs = $-[1]; + my $match = $1; + + for my $regex (@simplify_patterns) { + if ($match =~ $regex) { + $match = $1; + $ofs += $-[1]; + } + } + + push @matches, [$ofs, length $match]; + } + } + } + } + + # whole line + push @matches, [0, ($line->end - $line->beg + 1) * $self->ncol]; + + for (sort { $a->[1] <=> $b->[1] or $b->[0] <=> $a->[0] } @matches) { + my ($ofs, $len) = @$_; + + next if $len <= $curlen; + + $self->selection_beg ($line->coord_of ($ofs)); + $self->selection_end ($line->coord_of ($ofs + $len)); + return 1; + } + + () +} diff --git a/etc/soft/urxvt/perl/selection-autotransform b/etc/soft/urxvt/perl/selection-autotransform new file mode 100644 index 0000000..044dec4 --- /dev/null +++ b/etc/soft/urxvt/perl/selection-autotransform @@ -0,0 +1,101 @@ +#! perl + +#:META:RESOURCE:%.:string:autotransform expression + +=head1 NAME + +selection-autotransform - automatically transform select text + +=head1 DESCRIPTION + +This selection allows you to do automatic transforms on a selection +whenever a selection is made. + +It works by specifying perl snippets (most useful is a single C +operator) that modify C<$_> as resources: + + URxvt.selection-autotransform.0: transform + URxvt.selection-autotransform.1: transform + ... + +For example, the following will transform selections of the form +C, often seen in compiler messages, into C: + + URxvt.selection-autotransform.0: s/^([^:[:space:]]+):(\\d+):?$/vi +$2 \\Q$1\\E\\x0d/ + +And this example matches the same,but replaces it with vi-commands you can +paste directly into your (vi :) editor: + + URxvt.selection-autotransform.0: s/^([^:[:space:]]+(\\d+):?$/:e \\Q$1\\E\\x0d:$2\\x0d/ + +Of course, this can be modified to suit your needs and your editor :) + +To expand the example above to typical perl error messages ("XXX at +FILENAME line YYY."), you need a slightly more elaborate solution: + + URxvt.selection.pattern-0: ( at .*? line \\d+[,.]) + URxvt.selection-autotransform.0: s/^ at (.*?) line (\\d+)[,.]$/:e \\Q$1\E\\x0d:$2\\x0d/ + +The first line tells the selection code to treat the unchanging part of +every error message as a selection pattern, and the second line transforms +the message into vi commands to load the file. + +=cut + +sub msg { + my ($self, $msg) = @_; + + my $overlay = $self->overlay (0, 0, $self->strwidth ($msg), 1); + $overlay->set (0, 0, $msg); + $self->{timer} = urxvt::timer->new->after (2)->cb (sub { + delete $self->{timer}; + undef $overlay; + }); +} + +sub on_init { + my ($self) = @_; + + for (my $idx = 0; defined (my $res = $self->x_resource ("%.$idx")); $idx++) { + $res = $self->locale_decode ($res); + my $transform = eval "sub { $res }"; + + if ($transform) { + push @{ $self->{transforms} }, $transform; + } else { + warn "$res: $@"; + } + } + + $self->{enabled} = 1; + + push @{ $self->{term}{option_popup_hook} }, sub { + ("autotransform" => $self->{enabled}, sub { $self->{enabled} = shift }) + }; + + () +} + +sub on_sel_grab { + my ($self) = @_; + + $self->{enabled} + or return; + + my $text = $self->selection; + local $_ = $text; + + for my $transform (@{ $self->{transforms} }) { + $transform->(); + if ($text ne $_) { + $self->selection ($_); + s/[\x00-\x1f\x80-\x9f]/·/g; + $self->msg ($self->special_encode ("auto-transformed to $_")); + last; + } + } + + () +} + diff --git a/etc/soft/urxvt/perl/selection-pastebin b/etc/soft/urxvt/perl/selection-pastebin new file mode 100644 index 0000000..0d433c3 --- /dev/null +++ b/etc/soft/urxvt/perl/selection-pastebin @@ -0,0 +1,136 @@ +#! perl + +#:META:RESOURCE:%.cmd:string:the command to run create a new pastebin +#:META:RESOURCE:%.url:string:the url template for new pastebins + +=head1 NAME + +selection-pastebin - automatic pastebin upload + +=head1 EXAMPLES + + URxvt.keysym.C-M-e: selection-pastebin:remote-pastebin + +=head1 DESCRIPTION + +This is a little rarely useful extension that uploads the selection as +textfile to a remote site (or does other things). (The implementation is +not currently secure for use in a multiuser environment as it writes to +F directly.). + +It listens to the C action, which, +when activated, runs a command with C<%> replaced by the name of the +textfile. This command can be set via a resource: + + URxvt.selection-pastebin.cmd: rsync -apP % ruth:/var/www/www.ta-sa.org/files/txt/. + +And the default is likely not useful to anybody but the few people around +here :) + +The name of the textfile is the hex encoded md5 sum of the selection, so +the same content should lead to the same filename. + +After a successful upload the selection will be replaced by the text given +in the C resource (again, the % is the placeholder +for the filename): + + URxvt.selection-pastebin.url: http://www.ta-sa.org/files/txt/% + +I xrdb uses the C preprocessor, which might interpret +the double C characters as comment start. Use C<\057\057> instead, +which works regardless of whether xrdb is used to parse the resource file +or not. + +=cut + +sub upload_paste { + my ($self) = @_; + + require Digest::MD5; + + my $txt = $self->selection; + + my $filename = $txt; + utf8::encode $filename; + $filename = Digest::MD5::md5_hex ($filename) . ".txt"; + + my $tmpfile = "/tmp/$filename"; + + my $msg = "uploaded as $filename"; + + if (open my $o, ">:utf8", $tmpfile) { + chmod 0644, $tmpfile; + print $o $txt; + close $o; + } else { + $msg = "couldn't write $tmpfile: $!"; + } + + my $cmd = $self->{pastebin_cmd}; + $cmd =~ s/%/$tmpfile/; + + my $pid = $self->exec_async ($cmd); + + $self->{pw} = urxvt::pw->new->start ($pid)->cb (sub { + my (undef, $status) = @_; + + delete $self->{pw}; + + if ($status) { + $status >>= 8; + $msg = "ERROR: command returned status $status"; + } else { + my $url = $self->{pastebin_url}; + $url =~ s/%/$filename/; + + $self->selection ($url); + } + + unlink $tmpfile; + + my $ov = $self->overlay (-1, 0, $self->strwidth ($msg), 1, urxvt::OVERLAY_RSTYLE, 0); + $ov->set (0, 0, $msg); + + $self->{timer} = + urxvt::timer + ->new + ->after (5) + ->cb (sub { delete $self->{timer}; undef $ov; }); + }); +} + +sub on_start { + my ($self) = @_; + + $self->{pastebin_cmd} = $self->x_resource ("%.cmd") + || "rcp -p % ruth:/var/www/www.ta-sa.org/files/txt/"; + + $self->{pastebin_url} = $self->x_resource ("%.url") + || "http://www.ta-sa.org/files/txt/%"; + + push @{ $self->{term}{selection_popup_hook} }, sub { + ("pastebin upload" => sub { $self->upload_paste }) + }; + + () +} + +sub on_user_command { + my ($self, $cmd) = @_; + + if ($cmd eq "selection-pastebin:remote-pastebin") { + $self->upload_paste; + } + + () +} + +sub on_action { + my ($self, $action) = @_; + + $action eq "remote-pastebin" + and $self->upload_paste; + + () +} + diff --git a/etc/soft/urxvt/perl/selection-popup b/etc/soft/urxvt/perl/selection-popup new file mode 100644 index 0000000..07811d8 --- /dev/null +++ b/etc/soft/urxvt/perl/selection-popup @@ -0,0 +1,147 @@ +#! perl + +#:META:RESOURCE:url-launcher:string:shell command to use + +=head1 NAME + +selection-popup (enabled by default) + +=head1 DESCRIPTION + +Binds a popup menu to Ctrl-Button3 that lets you paste the X +selections and either modify or use the internal selection text in +various ways (such as uri unescaping, perl evaluation, web-browser +starting etc.), depending on content. + +Other extensions can extend this popup menu by pushing a code reference +onto C<< @{ $term->{selection_popup_hook} } >>, which gets called whenever +the popup is being displayed. + +Its sole argument is the popup menu, which can be modified. The selection +is in C<$_>, which can be used to decide whether to add something or not. +It should either return nothing or a string and a code reference. The +string will be used as button text and the code reference will be called +when the button gets activated and should transform C<$_>. + +The following will add an entry C that transforms all Cs in +the selection to Cs, but only if the selection currently contains any +Cs: + + push @{ $self->{term}{selection_popup_hook} }, sub { + /a/ ? ("a to b" => sub { s/a/b/g } + : () + }; + +=cut + +sub msg { + my ($self, $msg) = @_; + + my $overlay = $self->overlay (0, 0, $self->strwidth ($msg), 1); + $overlay->set (0, 0, $msg); + $self->{timer} = urxvt::timer->new->after (1)->cb (sub { + delete $self->{timer}; + undef $overlay; + }); +} + +sub on_start { + my ($self) = @_; + + $self->{browser} = $self->x_resource ("url-launcher") || "sensible-browser"; + + $self->grab_button (3, urxvt::ControlMask); + + () +} + +sub on_button_press { + my ($self, $event) = @_; + + if ($event->{button} == 3 && $event->{state} & urxvt::ControlMask) { + my $popup = $self->popup ($event) + or return 1; + + $popup->add_title ("Selection"); + + my $text = $self->selection; + + my $title = $text; + $title =~ s/[\x00-\x1f\x80-\x9f]/·/g; + substr $title, 40, -1, "..." if 40 < length $title; + $popup->add_title ($title); + $popup->add_separator; + + my $add_button = sub { + my ($title, $cb) = @_; + + $popup->add_button ($title => sub { + for ($text) { + my $orig = $_; + $cb->(); + + if ($orig ne $_) { + $self->selection ($_); + s/[\x00-\x1f\x80-\x9f]/·/g; + $self->msg ($self->special_encode ($_)); + } + } + }); + }; + + for ($text) { + /\n/ + and $add_button->("paste primary selection" => sub { $self->selection_request (urxvt::CurrentTime, 1) }); + + /./ + and $add_button->("paste clipboard selection" => sub { $self->selection_request (urxvt::CurrentTime, 3) }); + + /./ + and $add_button->("copy selection to clipboard" => sub { $self->selection ($self->selection, 1); + $self->selection_grab (urxvt::CurrentTime, 1) }); + + /./ + and $add_button->("newlines to spaces" => sub { y/\n/ / }); + + /./ + and $add_button->("rot13" => sub { y/A-Za-z/N-ZA-Mn-za-m/ }); + + /./ + and $add_button->("eval perl expression" => sub { my $self = $self; no warnings; $_ = eval $_; $_ = "$@" if $@ }); + + /./ + and $add_button->((sprintf "to unicode hex index (%x)", ord) => sub { $_ = sprintf "%x", ord }); + + /(\S+):(\d+):?/ + and $add_button->("vi-commands to load '$1'" => sub { s/^(\S+):(\d+):?$/\x1b:e $1\x0d:$2\x0d/ }); + + /%[0-9a-fA-F]{2}/ && !/%[^0-9a-fA-F]/ && !/%.[^0-9a-fA-F]/ + and $add_button->("uri unescape" => sub { s/%([0-9a-fA-F]{2})/chr hex $1/ge }); + + /[\\"'\ \t|&;<>()]/ + and $add_button->("shell quote" => sub { $_ = "\Q$_" }); + + /^(https?|ftp|telnet|irc|news):\// + and $add_button->("run $self->{browser}" => sub { $self->exec_async ($self->{browser}, $_) }); + + for my $hook (@{ $self->{term}{selection_popup_hook} || [] }) { + if (my ($title, $cb) = $hook->($popup)) { + $add_button->($title, $cb); + } + } + + if (/^\s*((?:0x)?\d+)\s*$/) { + $popup->add_title (sprintf "%20s", eval $1); + $popup->add_title (sprintf "%20s", sprintf "0x%x", eval $1); + $popup->add_title (sprintf "%20s", sprintf "0%o", eval $1); + } + } + + $popup->show; + + return 1; + } + + () +} + diff --git a/etc/soft/urxvt/perl/selection-to-clipboard b/etc/soft/urxvt/perl/selection-to-clipboard new file mode 100644 index 0000000..0431694 --- /dev/null +++ b/etc/soft/urxvt/perl/selection-to-clipboard @@ -0,0 +1,27 @@ +#! perl -w + +=head1 NAME + +selection-to-clipboard - copy the selection to the clipboard each time a selection is made + +=head1 SYNOPSIS + + urxvt -pe selection-to-clipboard + +=head1 DESCRIPTION + +This very simple extension copies the selection to the clipboard every +time a selection is made. This, in effect, synchronises the clipboard with +the selection for selections done by rxvt-unicode. + +=cut + +sub on_sel_grab { + my ($self, $time) = @_; + + $self->selection ($self->selection, 1); + $self->selection_grab ($time, 1); + + () +} + diff --git a/etc/soft/urxvt/perl/tabbed b/etc/soft/urxvt/perl/tabbed new file mode 100644 index 0000000..e9ad415 --- /dev/null +++ b/etc/soft/urxvt/perl/tabbed @@ -0,0 +1,423 @@ +#! perl + +#:META:RESOURCE:tabbar-fg:colour:tab bar foreground colour +#:META:RESOURCE:tabbar-bg:colour:tab bar background colour +#:META:RESOURCE:tab-fg:colour:tab foreground colour +#:META:RESOURCE:tab-bg:colour:tab background colour + +=head1 NAME + +tabbed - tabbed interface to urxvt + +=head1 DESCRIPTION + +This transforms the terminal into a tabbar with additional terminals, that +is, it implements what is commonly referred to as "tabbed terminal". The topmost line +displays a "[NEW]" button, which, when clicked, will add a new tab, followed by one +button per tab. + +Clicking a button will activate that tab. Pressing B and +B will switch to the tab left or right of the current one, +while B creates a new tab. Pressing B and +B will renumber the current tab by moving it to the left or +to the right. + +The tabbar itself can be configured similarly to a normal terminal, but +with a resource class of C. In addition, it supports the +following four resources (shown with defaults): + + URxvt.tabbed.tabbar-fg: + URxvt.tabbed.tabbar-bg: + URxvt.tabbed.tab-fg: + URxvt.tabbed.tab-bg: + +See I in the @@RXVT_NAME@@(1) manpage for valid +indices. + +=cut + +sub refresh { + my ($self) = @_; + + my $ncol = $self->ncol; + + my $text = " " x $ncol; + my $rend = [($self->{rs_tabbar}) x $ncol]; + + my @ofs; + + substr $text, 0, 7, "[NEW] |"; + @$rend[0 .. 5] = ($self->{rs_tab}) x 6; + push @ofs, [0, 6, sub { $_[0]->new_tab }]; + + my $ofs = 7; + my $idx = 0; + + for my $tab (@{ $self->{tabs} }) { + $idx++; + + my $act = $tab->{activity} && $tab != $self->{cur} + ? "*" : " "; + + my $txt = "$act$idx$act"; + my $len = length $txt; + + substr $text, $ofs, $len + 1, "$txt|"; + @$rend[$ofs .. $ofs + $len - 1] = ($self->{rs_tab}) x $len + if $tab == $self->{cur}; + + push @ofs, [ $ofs, $ofs + $len, sub { $_[0]->make_current ($tab) } ]; + + $ofs += $len + 1; + } + + $self->{tabofs} = \@ofs; + + $self->ROW_t (0, $text, 0, 0, $ncol); + $self->ROW_r (0, $rend, 0, 0, $ncol); + + $self->want_refresh; +} + +sub new_tab { + my ($self, @argv) = @_; + + # save a backlink to us, make sure tabbed is inactive + push @urxvt::TERM_INIT, sub { + my ($term) = @_; + $term->{parent} = $self; + + for (0 .. urxvt::NUM_RESOURCES - 1) { + my $value = $self->{resource}[$_]; + + $term->resource ("+$_" => $value) + if defined $value; + } + + $term->resource (perl_ext_2 => $term->resource ("perl_ext_2") . ",-tabbed"); + }; + + push @urxvt::TERM_EXT, urxvt::ext::tabbed::tab::; + + my $term = new urxvt::term + $self->env, $urxvt::RXVTNAME, + -embed => $self->parent, + @argv, + ; +} + +sub configure { + my ($self) = @_; + + my $tab = $self->{cur}; + + # this is an extremely dirty way to force a configurenotify, but who cares + $tab->XMoveResizeWindow ( + $tab->parent, + 0, $self->{tabheight} + 1, + $self->width, $self->height - $self->{tabheight} + ); + $tab->XMoveResizeWindow ( + $tab->parent, + 0, $self->{tabheight}, + $self->width, $self->height - $self->{tabheight} + ); +} + +sub on_resize_all_windows { + my ($self, $width, $height) = @_; + + 1 +} + +sub copy_properties { + my ($self) = @_; + my $tab = $self->{cur}; + + my $wm_normal_hints = $self->XInternAtom ("WM_NORMAL_HINTS"); + + my $current = delete $self->{current_properties}; + + # pass 1: copy over properties different or nonexisting + for my $atom ($tab->XListProperties ($tab->parent)) { + my ($type, $format, $items) = $self->XGetWindowProperty ($tab->parent, $atom); + + # fix up size hints + if ($atom == $wm_normal_hints) { + my (@hints) = unpack "l!*", $items; + + $hints[$_] += $self->{tabheight} for (4, 6, 16); + + $items = pack "l!*", @hints; + } + + my $cur = delete $current->{$atom}; + + # update if changed, we assume empty items and zero type and format will not happen + $self->XChangeProperty ($self->parent, $atom, $type, $format, $items) + if $cur->[0] != $type or $cur->[1] != $format or $cur->[2] ne $items; + + $self->{current_properties}{$atom} = [$type, $format, $items]; + } + + # pass 2, delete all extraneous properties + $self->XDeleteProperty ($self->parent, $_) for keys %$current; +} + +sub make_current { + my ($self, $tab) = @_; + + if (my $cur = $self->{cur}) { + delete $cur->{activity}; + $cur->XUnmapWindow ($cur->parent) if $cur->mapped; + $cur->focus_out; + } + + $self->{cur} = $tab; + + $self->configure; + $self->copy_properties; + + $tab->focus_out; # just in case, should be a nop + $tab->focus_in if $self->focus; + + $tab->XMapWindow ($tab->parent); + delete $tab->{activity}; + $self->refresh; + + () +} + +sub on_focus_in { + my ($self, $event) = @_; + + $self->{cur}->focus_in; + + () +} + +sub on_focus_out { + my ($self, $event) = @_; + + $self->{cur}->focus_out; + + () +} + +sub on_tt_write { + my ($self, $octets) = @_; + + $self->{cur}->tt_write ($octets); + + 1 +} + +sub on_key_press { + my ($self, $event) = @_; + + $self->{cur}->key_press ($event->{state}, $event->{keycode}, $event->{time}); + + 1 +} + +sub on_key_release { + my ($self, $event) = @_; + + $self->{cur}->key_release ($event->{state}, $event->{keycode}, $event->{time}); + + 1 +} + +sub on_button_press { + 1 +} + +sub on_button_release { + my ($self, $event) = @_; + + if ($event->{row} == 0) { + for my $button (@{ $self->{tabofs} }) { + $button->[2]->($self, $event) + if $event->{col} >= $button->[0] + && $event->{col} < $button->[1]; + } + } + + 1 +} + +sub on_motion_notify { + 1 +} + +sub on_init { + my ($self) = @_; + + $self->{resource} = [map $self->resource ("+$_"), 0 .. urxvt::NUM_RESOURCES - 1]; + + $self->resource (int_bwidth => 0); + $self->resource (name => "URxvt.tabbed"); + $self->resource (pty_fd => -1); + + $self->option ($urxvt::OPTION{scrollBar}, 0); + + my $fg = $self->x_resource ("tabbar-fg"); + my $bg = $self->x_resource ("tabbar-bg"); + my $tabfg = $self->x_resource ("tab-fg"); + my $tabbg = $self->x_resource ("tab-bg"); + + defined $fg or $fg = 3; + defined $bg or $bg = 0; + defined $tabfg or $tabfg = 0; + defined $tabbg or $tabbg = 1; + + $self->{rs_tabbar} = urxvt::SET_COLOR (urxvt::DEFAULT_RSTYLE, $fg + 2, $bg + 2); + $self->{rs_tab} = urxvt::SET_COLOR (urxvt::DEFAULT_RSTYLE, $tabfg + 2, $tabbg + 2); + + () +} + +sub on_start { + my ($self) = @_; + + $self->{tabheight} = $self->int_bwidth + $self->fheight + $self->lineSpace; + + $self->cmd_parse ("\033[?25l"); + + my @argv = $self->argv; + + do { + shift @argv; + } while @argv && $argv[0] ne "-e"; + + $self->new_tab (@argv); + + () +} + +sub on_configure_notify { + my ($self, $event) = @_; + + $self->configure; + $self->refresh; + + () +} + +sub on_wm_delete_window { + my ($self) = @_; + + $_->destroy for @{ $self->{tabs} }; + + 1 +} + +sub tab_start { + my ($self, $tab) = @_; + + $tab->XChangeInput ($tab->parent, urxvt::PropertyChangeMask); + + push @{ $self->{tabs} }, $tab; + +# $tab->{name} ||= scalar @{ $self->{tabs} }; + $self->make_current ($tab); + + () +} + +sub tab_destroy { + my ($self, $tab) = @_; + + $self->{tabs} = [ grep $_ != $tab, @{ $self->{tabs} } ]; + + if (@{ $self->{tabs} }) { + if ($self->{cur} == $tab) { + delete $self->{cur}; + $self->make_current ($self->{tabs}[-1]); + } else { + $self->refresh; + } + } else { + # delay destruction a tiny bit + $self->{destroy} = urxvt::iw->new->start->cb (sub { $self->destroy }); + } + + () +} + +sub tab_key_press { + my ($self, $tab, $event, $keysym, $str) = @_; + + if ($event->{state} & urxvt::ShiftMask) { + if ($keysym == 0xff51 || $keysym == 0xff53) { + my ($idx) = grep $self->{tabs}[$_] == $tab, 0 .. $#{ $self->{tabs} }; + + --$idx if $keysym == 0xff51; + ++$idx if $keysym == 0xff53; + + $self->make_current ($self->{tabs}[$idx % @{ $self->{tabs}}]); + + return 1; + } elsif ($keysym == 0xff54) { + $self->new_tab; + + return 1; + } + } + elsif ($event->{state} & urxvt::ControlMask) { + if ($keysym == 0xff51 || $keysym == 0xff53) { + my ($idx1) = grep $self->{tabs}[$_] == $tab, 0 .. $#{ $self->{tabs} }; + my $idx2 = ($idx1 + ($keysym == 0xff51 ? -1 : +1)) % @{ $self->{tabs} }; + + ($self->{tabs}[$idx1], $self->{tabs}[$idx2]) = + ($self->{tabs}[$idx2], $self->{tabs}[$idx1]); + + $self->make_current ($self->{tabs}[$idx2]); + + return 1; + } + } + + () +} + +sub tab_property_notify { + my ($self, $tab, $event) = @_; + + $self->copy_properties + if $event->{window} == $tab->parent; + + () +} + +sub tab_activity { + my ($self, $tab) = @_; + + $self->refresh; +} + +package urxvt::ext::tabbed::tab; + +# helper extension implementing the subwindows of a tabbed terminal. +# simply proxies all interesting calls back to the tabbed class. + +{ + for my $hook (qw(start destroy key_press property_notify)) { + eval qq{ + sub on_$hook { + my \$parent = \$_[0]{term}{parent} + or return; + \$parent->tab_$hook (\@_) + } + }; + die if $@; + } +} + +sub on_add_lines { + $_[0]->{activity}++ + or $_[0]{term}{parent}->tab_activity ($_[0]); + () +} + + diff --git a/etc/soft/urxvt/perl/tabbed_new b/etc/soft/urxvt/perl/tabbed_new new file mode 100644 index 0000000..fddadad --- /dev/null +++ b/etc/soft/urxvt/perl/tabbed_new @@ -0,0 +1,459 @@ +#! perl + +sub refresh { + my ($self) = @_; + + my $ncol = $self->ncol; + + my $text = ' ' x $ncol; + my $rend = [($self->{rs_tabbar}) x $ncol]; + + my @ofs; + my $ofs = 0; + my $idx = 0; + + for my $tab (@{ $self->{tabs} }) { + my $is_rename = defined $self->{tab_rename_started} && $self->{tab_rename_started} && $tab == $self->{cur}; + + my $txt = ' '.($tab->{manual_name} || $tab->{name}).' '; + if ($is_rename) { + $txt = ' '.$tab->{tab_new_name}.' '; + $txt .= ' ' if $tab->{tab_new_pos} == length($tab->{tab_new_name}); + } + my $len = length($txt); + + unless ($idx++) { + # first tab + substr $text, $ofs, $len, $txt; + if ($is_rename) { + @$rend[$ofs .. $ofs + $len - 1] = ($self->{rs_tab}) x $len; + @$rend[$ofs + $tab->{tab_new_pos} + 2] = $self->{rs_rename}; + } elsif ($tab == $self->{cur}) { + @$rend[$ofs .. $ofs + $len - 1] = ($self->{rs_tab}) x $len; + } elsif ($tab->{activity} && $tab != $self->{cur}) { + @$rend[$ofs .. $ofs + $len - 1] = ($self->{rs_tabsel}) x $len; + } + push @ofs, [ $ofs, $ofs + $len, sub { $_[0]->make_current($tab) } ]; + $ofs += $len; + } else { + # other tabs + substr $text, $ofs, $len + 1, '|'.$txt; + @$rend[$ofs] = $self->{rs_tabdiv}; + if ($tab == $self->{cur}) { + @$rend[$ofs + 1 .. $ofs + $len] = ($self->{rs_tab}) x $len; + } elsif ($tab->{activity} && $tab != $self->{cur}) { + @$rend[$ofs + 1 .. $ofs + $len] = ($self->{rs_tabsel}) x $len; + } + push @ofs, [ $ofs + 1, $ofs + $len + 1, sub { $_[0]->make_current($tab) } ]; + $ofs += $len + 1; + } + } + + $self->{tabofs} = \@ofs; + $self->ROW_t(0, $text, 0, 0, $ncol); + $self->ROW_r(0, $rend, 0, 0, $ncol); + $self->want_refresh; +} + +sub new_tab { + my ($self, @argv) = @_; + + my $offset = $self->fheight; + + # save a backlink to us, make sure tabbed is inactive + push @urxvt::TERM_INIT, sub { + my ($term) = @_; + $term->{parent} = $self; + for (0 .. urxvt::NUM_RESOURCES - 1) { + my $value = $self->{resource}[$_]; + $term->resource("+$_" => $value) if defined $value; + } + $term->resource(perl_ext_2 => $term->resource("perl_ext_2") . ",-tabbed_new"); + }; + + push @urxvt::TERM_EXT, urxvt::ext::tabbed_new::tab::; + + my $term = new urxvt::term $self->env, $urxvt::RXVTNAME, -embed => $self->parent, @argv,; +} + +sub configure { + my ($self) = @_; + + my $tab = $self->{cur}; + + # this is an extremely dirty way to force a configurenotify, but who cares + $tab->XMoveResizeWindow($tab->parent, 0, $self->{tabheight} + 1, $self->width, $self->height - $self->{tabheight}); + $tab->XMoveResizeWindow($tab->parent, 0, $self->{tabheight}, $self->width, $self->height - $self->{tabheight}); +} + +sub on_resize_all_windows { + my ($self, $width, $height) = @_; + 1; +} + +sub copy_properties { + my ($self) = @_; + my $tab = $self->{cur}; + + my $wm_normal_hints = $self->XInternAtom("WM_NORMAL_HINTS"); + + my $current = delete $self->{current_properties}; + + # pass 1: copy over properties different or nonexisting + for my $atom ($tab->XListProperties($tab->parent)) { + my ($type, $format, $items) = $self->XGetWindowProperty($tab->parent, $atom); + + # fix up size hints + if ($atom == $wm_normal_hints) { + my (@hints) = unpack "l!*", $items; + + $hints[$_] += $self->{tabheight} for (4, 6, 16); + + $items = pack "l!*", @hints; + } + + my $cur = delete $current->{$atom}; + + # update if changed, we assume empty items and zero type and format will not happen + $self->XChangeProperty($self->parent, $atom, $type, $format, $items) + if $cur->[0] != $type or $cur->[1] != $format or $cur->[2] ne $items; + + $self->{current_properties}{$atom} = [$type, $format, $items]; + } + + # pass 2, delete all extraneous properties + $self->XDeleteProperty($self->parent, $_) for keys %$current; +} + +sub make_current { + my ($self, $tab) = @_; + + if (my $cur = $self->{cur}) { + delete $cur->{activity}; + $cur->XUnmapWindow($cur->parent) if $cur->mapped; + $cur->focus_out; + } + + $self->{cur} = $tab; + $self->configure; + $self->copy_properties; + $tab->focus_out; # just in case, should be a nop + $tab->focus_in if $self->focus; + $tab->XMapWindow($tab->parent); + delete $tab->{activity}; + $self->refresh; + (); +} + +sub on_focus_in { + my ($self, $event) = @_; + $self->{cur}->focus_in; + (); +} + +sub on_focus_out { + my ($self, $event) = @_; + $self->{cur}->focus_out; + (); +} + +sub on_key_press { + my ($self, $event) = @_; + $self->{cur}->key_press($event->{state}, $event->{keycode}, $event->{time}); + 1; +} + +sub on_key_release { + my ($self, $event) = @_; + $self->{cur}->key_release($event->{state}, $event->{keycode}, $event->{time}); + 1; +} + +sub on_button_press { + 1; +} + +sub on_button_release { + my ($self, $event) = @_; + if ($event->{row} == 0) { + for my $button (@{ $self->{tabofs} }) { + $button->[2]->($self, $event) if $event->{col} >= $button->[0] && $event->{col} < $button->[1]; + } + } + 1; +} + +sub on_motion_notify { + 1; +} + +sub on_init { + my ($self) = @_; + + $self->{resource} = [map $self->resource("+$_"), 0 .. urxvt::NUM_RESOURCES - 1]; + + $self->resource(int_bwidth => 0); + $self->resource(name => "URxvt.tabbed_new"); + $self->resource(pty_fd => -1); + + $self->option($urxvt::OPTION{scrollBar}, 0); + + my $renamebg = $self->x_resource("tabren-bg"); + my $divfg = $self->x_resource("tabdiv-fg"); + my $fg = $self->x_resource("tabbar-fg"); + my $bg = $self->x_resource("tabbar-bg"); + my $selfg = $self->x_resource("tabsel-fg"); + my $selbg = $self->x_resource("tabsel-bg"); + my $tabfg = $self->x_resource("tab-fg"); + my $tabbg = $self->x_resource("tab-bg"); + + defined $renamebg or $renamebg = 11; + defined $divfg or $divfg = 8; + defined $fg or $fg = 0; + defined $bg or $bg = 15; + defined $tabfg or $tabfg = 1; + defined $tabbg or $tabbg = 15; + defined $selfg or $selfg = 0; + defined $selbg or $selbg = 7; + + $self->{rs_tabbar} = urxvt::SET_COLOR(urxvt::DEFAULT_RSTYLE, $fg + 2, $bg + 2); + $self->{rs_tabdiv} = urxvt::SET_COLOR(urxvt::DEFAULT_RSTYLE, $divfg + 2, $bg + 2); + $self->{rs_tabsel} = urxvt::SET_COLOR(urxvt::DEFAULT_RSTYLE, $selfg + 2, $selbg + 2); + $self->{rs_tab} = urxvt::SET_COLOR(urxvt::DEFAULT_RSTYLE, $tabfg + 2, $tabbg + 2); + + $self->{rs_rename} = urxvt::SET_COLOR(urxvt::DEFAULT_RSTYLE, $selfg + 2, $renamebg + 2); + + (); +} + +sub on_start { + my ($self) = @_; + + $self->{tabheight} = $self->int_bwidth + $self->fheight + $self->lineSpace; + $self->cmd_parse("\033[?25l"); + my @argv = $self->argv; + + do { shift @argv; } while @argv && $argv[0] ne "-e"; + $self->new_tab(@argv); + (); +} + +sub on_configure_notify { + my ($self, $event) = @_; + $self->configure; + $self->refresh; + (); +} + +sub on_wm_delete_window { + my ($self) = @_; + $_->destroy for @{ $self->{tabs} }; + 1; +} + +sub tab_name { + my ($self, $name) = @_; + + return unless $name =~ /\@/; + my $tab = $self->{cur}; + $tab->{name} = $name; + $self->refresh; + 1; +} + +sub tab_start { + my ($self, $tab) = @_; + $tab->XChangeInput($tab->parent, urxvt::PropertyChangeMask); + push @{ $self->{tabs} }, $tab; + $tab->{name} ||= 'tab '.scalar @{ $self->{tabs} }; + $tab->{manual_name} = undef; + $self->make_current($tab); + (); +} + +sub tab_destroy { + my ($self, $tab) = @_; + $self->{tabs} = [ grep $_ != $tab, @{ $self->{tabs} } ]; + if (@{ $self->{tabs} }) { + if ($self->{cur} == $tab) { + delete $self->{cur}; + $self->make_current($self->{tabs}[-1]); + } else { + $self->refresh; + } + } else { + # delay destruction a tiny bit + $self->{destroy} = urxvt::iw->new->start->cb(sub { $self->destroy }); + } + (); +} + +sub tab_key_press { + my ($self, $tab, $event, $keysum, $str) = @_; + my $action; + + if ($event->{state} & urxvt::Mod4Mask) { + if ($event->{state} & urxvt::ControlMask) { + $action = 'move-left' if $keysum == 0xff51; # Mod4+Ctrl+Left + $action = 'move-right' if $keysum == 0xff53; # Mod4+Ctrl+Right + } else { + $action = 'prev-tab' if $keysum == 0xff51; # Mod4+Left + $action = 'next-tab' if $keysum == 0xff53; # Mod4+Right + $action = 'new-tab' if $keysum == 0x74; # Mod4+T + $action = 'rename-start' if $keysum == 0x6e; # Mod4+N + } + } elsif ($event->{state} & urxvt::ControlMask) { + $action = 'next-tab' if $keysum == 0xff09; # Ctrl+Tab + } elsif (defined $self->{tab_rename_started} && $self->{tab_rename_started}) { + if ($keysum == 0xff1b) { # Esc + $action = 'cancel-rename'; + } elsif ($keysum == 0xff0d || $keysum == 0xff8d) { # Enter + $action = 'confirm-rename'; + } elsif ($keysum == 0xff51) { # Left + if ($tab->{tab_new_pos} > 0) { + $tab->{tab_new_pos}--; + $self->refresh; + } + return 1; + } elsif ($keysum == 0xff53) { # Right + if ($tab->{tab_new_pos} < length($tab->{tab_new_name})) { + $tab->{tab_new_pos}++; + $self->refresh; + } + return 1; + } elsif ($keysum == 0xff50) { # Home + if ($tab->{tab_new_pos} > 0) { + $tab->{tab_new_pos} = 0; + $self->refresh; + } + return 1; + } elsif ($keysum == 0xff57) { # End + if ($tab->{tab_new_pos} < length($tab->{tab_new_name})) { + $tab->{tab_new_pos} = length($tab->{tab_new_name}); + $self->refresh; + } + return 1; + } elsif ($keysum == 0xff08) { # Backspace + if ($tab->{tab_new_pos} > 0) { + my $name = ''; + $name .= substr($tab->{tab_new_name}, 0, $tab->{tab_new_pos} - 1) if $tab->{tab_new_pos} > 1; + $name .= substr($tab->{tab_new_name}, $tab->{tab_new_pos}, length($tab->{tab_new_name})) if $tab->{tab_new_pos} < length($tab->{tab_new_name}); + $tab->{tab_new_name} = $name; + $tab->{tab_new_pos}--; + } + $self->refresh; + return 1; + } elsif ($keysum == 0xffff) { # Delete + if ($tab->{tab_new_pos} < length($tab->{tab_new_name})) { + my $name = ''; + $name .= substr($tab->{tab_new_name}, 0, $tab->{tab_new_pos}) if $tab->{tab_new_pos} > 0; + $name .= substr($tab->{tab_new_name}, $tab->{tab_new_pos} + 1, length($tab->{tab_new_name})) if $tab->{tab_new_pos} < length($tab->{tab_new_name}) - 1; + $tab->{tab_new_name} = $name; + } + $self->refresh; + return 1; + } else { + if ($str =~ /^[\x20-\x7f]$/) { # printable symbols + my $name = ''; + $name .= substr($tab->{tab_new_name}, 0, $tab->{tab_new_pos}) if $tab->{tab_new_pos} > 0; + $name .= $str; + $name .= substr($tab->{tab_new_name}, $tab->{tab_new_pos}, length($tab->{tab_new_name})) if $tab->{tab_new_pos} < length($tab->{tab_new_name}); + $tab->{tab_new_name} = $name; + $tab->{tab_new_pos}++; + } + $self->refresh; + return 1; + } + } + + if (defined $action) { + if ($action eq 'next-tab' || $action eq 'prev-tab') { + my ($idx) = grep $self->{tabs}[$_] == $tab, 0 .. $#{ $self->{tabs} }; + --$idx if $action eq 'prev-tab'; + ++$idx if $action eq 'next-tab'; + $self->make_current($self->{tabs}[$idx % @{ $self->{tabs}}]); + return 1; + } elsif ($action eq 'move-left' || $action eq 'move-right') { + my ($idx1) = grep $self->{tabs}[$_] == $tab, 0 .. $#{ $self->{tabs} }; + if (($action eq 'move-left' && $idx1 > 0) || ($action eq 'move-right' && $idx1 < $#{ $self->{tabs} })) { + my $idx2 = ($idx1 + ($action eq 'move-left' ? -1 : +1)) % @{ $self->{tabs} }; + ($self->{tabs}[$idx1], $self->{tabs}[$idx2]) = ($self->{tabs}[$idx2], $self->{tabs}[$idx1]); + $self->make_current($self->{tabs}[$idx2]); + } + return 1; + } elsif ($action eq 'new-tab') { + $self->new_tab; + return 1; + } elsif ($action eq 'rename-start') { + $self->{tab_rename_started} = 1; + $tab->{tab_new_name} = $tab->{manual_name} || ''; + $tab->{tab_new_pos} = length($tab->{tab_new_name}); + $self->refresh; + return 1; + } elsif ($action eq 'cancel-rename') { + undef $self->{tab_rename_started}; + undef $tab->{tab_new_name}; + undef $tab->{tab_new_pos}; + $self->refresh; + return 1; + } elsif ($action eq 'confirm-rename') { + $tab->{manual_name} = $tab->{tab_new_name} || undef; + undef $self->{tab_rename_started}; + undef $tab->{tab_new_name}; + undef $tab->{tab_new_pos}; + $self->refresh; + return 1; + } + } + + (); +} + +sub tab_property_notify { + my ($self, $tab, $event) = @_; + $self->copy_properties if $event->{window} == $tab->parent; + (); +} + +sub tab_activity { + my ($self, $tab) = @_; + $self->refresh; +} + +package urxvt::ext::tabbed_new::tab; + +# helper extension implementing the subwindows of a tabbed terminal. +# simply proxies all interesting calls back to the tabbed class. + +{ + for my $hook (qw(start destroy key_press property_notify)) { + eval qq{ + sub on_$hook \{ + my \$parent = \$_[0]\{term\}\{parent\} or return; + \$parent->tab_$hook(\@_); + \} + }; + die if $@; + } +} + +sub on_add_lines { + $_[0]->{activity}++ or $_[0]{term}{parent}->tab_activity($_[0]); + (); +} + +sub on_osc_seq { + my ($self, $seq, $cmd, $resp) = @_; + return unless $seq == 0; + + my $parent = $self->{term}->{parent}; + return unless $parent; + + my ($name, undef) = split /:\s/, $cmd, 2; + return unless $name; + + $parent->tab_name($name); + + (); +} + diff --git a/etc/soft/urxvt/perl/tabbedex b/etc/soft/urxvt/perl/tabbedex new file mode 100644 index 0000000..0a372d9 --- /dev/null +++ b/etc/soft/urxvt/perl/tabbedex @@ -0,0 +1,1159 @@ +#! perl +# TabbedEx plugin for rxvt-unicode; based on original tabbed plugin. +# https://github.com/mina86/urxvt-tabbedex +# Copyright (c) 2006-2016 tabbed and tabbedex authors +# +# This program is free software: you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation, either version 3 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see . + +=head1 NAME + +tabbedex - tabbed interface to urxvt; extended + +=head1 DESCRIPTION + +This transforms the terminal into a tabbar with additional terminals, that is, +it implements what is commonly referred to as "tabbed terminal". tabbedex is an +extended version of the tabbed plugin which comes with urxvt. + +When rxvt-unicode is started with this plugin slave terminals or tabs can be +started and switched between. One of the terminals is the current or active one +and it is the only one that is visible. rxvt-unicode will exit once all tabs +are closed. + +Once at least two slave terminals are created a tab bar is displayed at the top +of the window which lists all the slave terminals. Clicking on a number/name of +a tab on that bar switches to given tab. + +=head2 Key bindings + +Creating new tabs, switching between them and moving them around is accomblished +by the following key bindings: + +=over + +=item B + +Creates a new tab. + +=item B and B + +Switches to the tab on the left or on the right of the current tab. Movement +wraps around once at the first or last tab. + +=item B through B + +Switches to the first through twelfth tab. + +=item B and B + +Move current tab to the left or right. Wraps around once on the first/last +position. + +=item B + +Allows current tab to be renamed. Start typing desired new name and press +Return to confirm or Escape to cancel. + +=back + +=head1 CONFIGURATION + +The extension can be configured similarly to a normal terminal. By default, it +uses a resource class of C which is the same as the tabbed +extension. + +=over + +=item B: I + +If set (the default), the tab bar will be hidden unless there are at least two +tabs open. This is irrespective of whether C button or tab's title is +displayed. + +=item B: I + +=item B: I + +Foreground and background colours of an inactive tab on which bell has rung. +(0, 3) by default which translates to black on brown/dark yellow (i.e. inverse +of the default tab bar colours). See I in the L +manpage for valid indices. + +=item B: I + +=item B: I + +Foreground and background colours of a active tab in which bell is ringing. (5, +4) by default which translates to magenta an blue. See I +in the L manpage for valid indices. The bell is said to be ringing on +an active tab for B seconds after it started, see B. + +=item B: I + +Time in seconds, one second by default, a bell is said to be ringing on current +tab for after it was rung. Setting this to zero essentially disables the +B styling of tabs. + +=item B: I + +If set, a C button will be displayed on the left of the tab bar. Clicking +the button creates a new tab. It is not displayed by default. + +=item B: I + +Specifies how urxvt's B<-e> switch affects tabs created by tabbedex. The +resource can have one of three values: + +=over + +=item I + +Not the default! The B<-e> command will be used by all tabs created by tabbedex. + +=item I + +Only the initial tab will use the B<-e> switch provided on urxvt's command line. +All other tabs will act as if the option was not provided. + +=item I<-e B> + +The initial tab will use the B<-e> switch provided on urxvt's command line (if +any) while all other tabs will use switch specified by this setting. Note that +parsing of the resource simply splits words on white space so things like I<-e +my-prog "argument with spaces"> will not work. + +=back + +=item B: I + +If set, the default key bindings (described at the beginning of this document) +are not initialised. The mappings can be recreated using urxvt's support of +a keysym.* resource. For example, the following will recreate all the default +key bindings: + + URxvt.tabbed.no-tabbedex-keys: yes + URxvt.keysym.Shift-Left: perl:tabbedex:prev_tab + URxvt.keysym.Shift-Right: perl:tabbedex:next_tab + URxvt.keysym.Shift-Down: perl:tabbedex:new_tab + URxvt.keysym.Shift-Up: perl:tabbedex:rename_tab + URxvt.keysym.Control-Left: perl:tabbedex:move_tab_left + URxvt.keysym.Control-Right: perl:tabbedex:move_tab_right + URxvt.keysym.Meta-F1: perl:tabbedex:goto_tab_1 + URxvt.keysym.Meta-F2: perl:tabbedex:goto_tab_2 + URxvt.keysym.Meta-F3: perl:tabbedex:goto_tab_3 + URxvt.keysym.Meta-F4: perl:tabbedex:goto_tab_4 + URxvt.keysym.Meta-F5: perl:tabbedex:goto_tab_5 + URxvt.keysym.Meta-F6: perl:tabbedex:goto_tab_6 + URxvt.keysym.Meta-F7: perl:tabbedex:goto_tab_7 + URxvt.keysym.Meta-F8: perl:tabbedex:goto_tab_8 + URxvt.keysym.Meta-F9: perl:tabbedex:goto_tab_9 + URxvt.keysym.Meta-F10: perl:tabbedex:goto_tab_10 + URxvt.keysym.Meta-F11: perl:tabbedex:goto_tab_11 + URxvt.keysym.Meta-F12: perl:tabbedex:goto_tab_12 + +=item B: I + +A comma-separated list of extensions that must not be loaded into the slave +terminals (tabs). tabbedex plugin is implicitly added onto the list. + +=item B: I + +If set, whenever last tab is destroyed a new one will be created. + +=item B: I + +=item B: I + +Foreground and background colours of the tab bar. (3, 0) by default which +translates to brown/dark yellow on black background. See I +in the L manpage for valid indices. + +=item B: I + +=item B: I + +Foreground and background colours of the current tab on the tab bar. (0, 1) by +default which translates to black on red. See I in the +L manpage for valid indices. + +=item B: I + +When new text is written to an inactive tab, activity marks are displayed around +its number (or name if it has one) on the tab bar. By default Unicode +characters are used to display a block which grows with time the longer it was +since last time there was any activity in the tab. + +This resource allows for this to be customised. It's format is + + ( ":" ":" )* ":" ":" + +where is timeout in seconds and is a single activity +character. If activity character is (, [, { or < it will be used as left +activity mark and matching character will be used on the right side. + +=item B: I + +By default tabbedex uses the same prefix for resource names as tabbed plugin. +If this is not desired, the resource can be used to set a new prefix, for +example: + + URxvt.tabbed.tabbedex-rs-prefix: tabbedex + + ! Affects tabbed only: + URxvt.tabbed.tabbar-fg: 4 + URxvt.tabbed.tabbar-bg: 0 + + ! Affects tabbedex only: + URxvt.tabbedex.tabbar-fg: 5 + URxvt.tabbedex.tabbar-bg: 0 + +This settings does not affect the B resource itself which is +always read from C. + +=item B: I<boolean> + +If set (the default), when tab bar is visible and there is enough space left, +current tab's title will be displayed after the last tab. + +=item B<title-fg>: I<color inde> + +=item B<title-bg>: I<color inde> + +Foreground and background colours of the tab title. (2, 0) by default which +translates to green on black. Only used when B<title> is true. See I<COLOUR +AND GRAPHICS> in the L<urxvt(1)> manpage for valid indices. + +=back + +Extension's behaviour is also influenced by some of URxvt's configuration +options as well. (See I<RESOURCES> in the L<urxvt(1)> manpage for more information about them). The options include: + +=over + +=item B<mapAlert> + +If set, when bell rings in an inactive tab, the tab is made active. + +=item B<urgentOnBell> + +If set, when bell rings in an inactive tab, the master terminal's urgency hint +is set. + +=back + +=head1 USER COMMANDS + +tabbedex supports several user commands which can be used with +B<URxvt.keysym>.I<keysym> resource as well as other places. The commands are: + +=over + +=item B<tabbedex:new_tab> + +Creates a new tab. + +=item B<tabbedex:next_tab> and B<tabbedex:prev_tab> + +Switches to the tab on the right or left of the current tab. + +=item B<tabbedex:move_tab_left> and B<tabbedex:move_tab_right> + +Moves the current tab left or right. + +=item B<goto_tab_>I<N> where I<N> is positive integer + +Switches to the tab given by the number I<N> + +=item B<tabbedex:kill_tab> + +Kills/destroys current tab. + +=back + +=head1 OSC SEQUENCES + +tabbedex supports a single OSC sequence which can be invoked by programs running +in the terminal by writing a special sequence, namely I<ESC ] 777 ; string ST> +where I<string> is the command to execute. For example: + + printf '\033]777;tabbedex;set_tab_name;%s\007' "foo" + +=over + +=item B<tabbedex;set_tab_name;>I<name> + +Sets name of the current tab to I<name>. + +=back + +=cut + +use Encode qw(decode); + +sub update_autohide { + my ($self, $reconfigure) = @_; + my $oldh = $self->{tabheight}; + if (!$self->{autohide} || + @{ $self->{tabs} } > 1 || + $self->{is_inputting_name}) { + $self->{tabheight} = $self->{maxtabheight}; + } else { + $self->{tabheight} = 0; + } + if ($reconfigure && $self->{tabheight} != $oldh) { + $self->configure; + $self->copy_properties; + } +} + + +sub tab_bell_active ($$$) { + my ($self, $tab, $now) = @_; + if ($tab->{bell_rung}) { + if ($tab == $self->{cur}) { + return $now - $tab->{bell_rung} < $self->{bell_timeout}; + } else { + return 1; + } + } + return 0; +} + +sub tab_activity_mark ($$;$) { + my ($self, $tab, $now) = @_; + return ' ' unless defined $tab->{last_activity}; + return ' ' if $tab == $self->{cur}; + $now = $now // int urxvt::NOW; + if (defined $self->{timeouts}) { + my $diff = $now - $tab->{last_activity}; + for my $spec (@{ $self->{timeouts} }) { + return $spec->[1] if $diff >= $spec->[0]; + } + } + '*'; +} + +{ + +my %matching_activity_marks = ( + '[' => ']', + '{' => '}', + '(' => ')', + '<' => '>', +); + +sub matching_activity_mark { + return $matching_activity_marks{$_[0]} // $_[0]; +} + +} + + +sub refresh { + my ($self) = @_; + + # autohide makes it zero + return unless $self->{tabheight}; + + my $ncol = $self->ncol; + + my $text = " " x $ncol; + my $rend = [($self->{rs_tabbar}) x $ncol]; + + my ($ofs, $idx, @ofs) = (0, 0); + + if ($self->{new_button}) { + substr $text, 0, 7, "[NEW] |"; + @$rend[0 .. 5] = ($self->{rs_tab}[1]) x 6; + push @ofs, [0, 6, -1 ]; + $ofs = 7; + } + + my $space_available = $ofs; + my $max_len = int(($ncol - $ofs - 5) / ($#{ $self->{tabs} } > 1 ? 3 : 2)); + + # See if the name of the current tab would be displayed; + # if not, compute the number of tabs to skip so that the + # name of the current tab will be displayed. + my $len = $ofs; + my @ends; + for my $tab (@{ $self->{tabs} }) { + my $name = $tab->tab_name($idx, $max_len); + ++$idx; + $len += length($name) + 3; # '| ' and ' ' + if ($tab == $self->{cur}) { + $idx = 0; + if ($len > $ncol + 1) { + for my $end (@ends) { + ++$idx; + if ($len - $end <= $ncol) { + last; + } + } + } + last; + } + push @ends, $len; + } + + my $now = int urxvt::NOW; + + for (; $idx < @{ $self->{tabs} }; ++$idx) { + my $tab = $self->{tabs}[$idx]; + my $name = $tab->tab_name($idx, $max_len); + my $act = $self->tab_activity_mark($tab, $now); + my $txt = sprintf "%s%s%s", $act, $name, matching_activity_mark $act; + my $len = length $txt; + + substr $text, $ofs, $len + 1, "$txt|"; + + my $color = $self->{rs_tab}[ + 2 * $self->tab_bell_active($tab, $now) + ($tab == $self->{cur}) + ]; + if (defined $color) { + @$rend[$ofs .. $ofs + $len - 1] = ($color) x $len; + } + + push @ofs, [ $ofs, $ofs + $len, $idx ]; + $ofs += $len + 1; + } + + substr $text, --$ofs, 1, ' '; # remove last '|' + + if ($self->{tab_title} && $ofs + 3 < $ncol) { + my $term = $self->{term}; + my @str = $term->XGetWindowProperty($term->parent, $self->{tab_title}); + if (@str && $str[2]) { + my $str = '| ' . decode("utf8", $str[2]); + my $len = length $str; + $len = $ncol - $ofs if $ofs + $len > $ncol; + substr $text, $ofs, $len, substr $str, 0, $len; + @$rend[$ofs + 2 .. $ofs + $len - 1] = ($self->{rs_title}) x ($len - 2); + } + } + + $self->{tabofs} = \@ofs; + + $self->ROW_t (0, $text, 0, 0, $ncol); + $self->ROW_r (0, $rend, 0, 0, $ncol); + + $self->want_refresh; +} + + +sub new_tab { + my ($self, @argv) = @_; + + unless ($self->{autohide} && + !(defined $self->{tabs} && @{ $self->{tabs} })) { + $self->{tabheight} = $self->{maxtabheight} + } + + # save a backlink to us, make sure tabbedex is inactive + push @urxvt::TERM_INIT, sub { + my ($term) = @_; + $term->{parent} = $self; + + for (0 .. urxvt::NUM_RESOURCES - 1) { + my $value = $self->{resource}[$_]; + + $term->resource ("+$_" => $value) + if defined $value; + } + + foreach my $opt (keys %urxvt::OPTION) { + my $value = $self->{option}{$opt}; + $term->option($urxvt::OPTION{$opt}, $value); + } + + $term->resource (perl_ext_2 => + $term->resource ('perl_ext_2') . + $self->{perl_ext_blacklist}); + + $self->register_keysyms($term); + }; + + push @urxvt::TERM_EXT, urxvt::ext::tabbedex::tab::; + + my @argv_list = (); + if ( $self->{tabs}[-1] == 0 ) { + @argv_list = ( @{ $self->{argv}} , @argv ); + } + else { + @argv_list = @argv; + } + + my $term = new urxvt::term + $self->env, $urxvt::RXVTNAME, + -embed => $self->parent, + @argv_list; +} + + +sub configure { + my ($self) = @_; + + my $tab = $self->{cur}; + # this is an extremely dirty way to force a configurenotify, but who cares + $tab->XMoveResizeWindow ( + $tab->parent, + 0, $self->{tabheight} - 1, + $self->width, $self->height - $self->{tabheight} + ); + $tab->XMoveResizeWindow ( + $tab->parent, + 0, $self->{tabheight}, + $self->width, $self->height - $self->{tabheight} + ); +} + + +sub copy_properties { + my ($self) = @_; + my $tab = $self->{cur}; + + my $wm_normal_hints = $self->XInternAtom ("WM_NORMAL_HINTS"); + + my $current = delete $self->{current_properties}; + + # pass 1: copy over properties different or nonexisting + for my $atom ($tab->XListProperties ($tab->parent)) { + my ($type, $format, $items) = $self->XGetWindowProperty ($tab->parent, + $atom); + + # fix up size hints + if ($atom == $wm_normal_hints) { + my (@hints) = unpack "l!*", $items; + + $hints[$_] += $self->{tabheight} for (4, 6, 16); + + $items = pack "l!*", @hints; + } + + my $cur = delete $current->{$atom}; + + # update if changed, we assume empty items and zero type and + # format will not happen + $self->XChangeProperty ($self->parent, $atom, $type, $format, $items) + if $cur->[0] != $type or $cur->[1] != $format or $cur->[2] ne $items; + + $self->{current_properties}{$atom} = [$type, $format, $items]; + } + + # pass 2, delete all extraneous properties + $self->XDeleteProperty ($self->parent, $_) for keys %$current; +} + + +sub rs_text { + my ($self, $name, $default) = @_; + my $value = $self->x_resource ($self->{rs_prefix} . '.' . $name); + defined $value ? $self->locale_decode($value) : $default; +} + +sub rs_bool { + my ($self, $name, $default) = @_; + my $val = $self->x_resource ($self->{rs_prefix} . '.' . $name); + defined $val ? $val !~ /^(?:false|0|no)$/i : $default; +} + +sub rs_color($$$$) { + my ($self, $prefix, $def_fg, $def_bg) = @_; + my $fg = $self->rs_text ($prefix . '-fg') // $def_fg; + my $bg = $self->rs_text ($prefix . '-bg') // $def_bg; + urxvt::SET_COLOR (urxvt::DEFAULT_RSTYLE, $fg + 2, $bg + 2); +} + + +sub make_current { + my ($self, $tab) = @_; + + #$self->{currently_switching} = 1; + my $cur = $self->{cur}; + if ($cur != $tab) { + if ($cur) { + delete $cur->{last_activity}; + delete $cur->{bell_rung}; + #$cur->focus_out; + #$cur->XUnmapWindow ($cur->parent) if $cur->mapped; + $cur->XUnmapWindow ($cur->parent); + } + + $self->{cur} = $tab; + + $self->configure; + $self->copy_properties; + #$tab->focus_out; # just in case, should be a nop + #$tab->focus_in if $self->focus; + $tab->focus_in; + $tab->XMapWindow ($tab->parent); + #$tab->focus_out; # just in case, should be a nop + #$tab->focus_in if $self->focus; + #sleep 1; + delete $tab->{last_activity}; + delete $tab->{bell_rung}; + } + + $self->refresh; + #$self->{currently_switching} = 0; + (); +} + + +sub on_focus_in { + my ($self, $event) = @_; + $self->{cur}->focus_in; + (); +} + +sub on_focus_out { + my ($self, $event) = @_; + $self->{cur}->focus_out; + (); +} + +sub on_tt_write { + my ($self, $octets) = @_; + + $self->{cur}->tt_write ($octets); + + 1 +} + +sub on_key_press { + my ($self, $event) = @_; + #return if ($self->{currently_switching} == 1); + $self->key_event('key_press', $event); +} + +sub on_key_release { + my ($self, $event) = @_; + $self->key_event('key_release', $event); +} + +sub key_event { + my ($self, $type, $event) = @_; + my $term = $self->{cur}; + $term->$type($event->{state}, $event->{keycode}, $event->{time}); + + # refresh_check is available since rxvt-unicode 9.22. For some reason + # $term->can('refresh_check') doesn’t work which is why eval block is + # used to silence warnings. + eval { + $term->refresh_check; + }; + if ($@ && $@ !~ /refresh_check/) { + # If there was a warning unrelated to refresh_check propagate + # it. Otherwise ignore. + warn "$@"; + } + 1; +} + +sub on_button_release { + my ($self, $event) = @_; + if (!$self->{is_inputting_name} && $event->{row} == 0) { + my $col = $event->{col}; + for my $button (@{ $self->{tabofs} }) { + last if $col < $button->[0]; + next unless $col <= $button->[1]; + if ($button->[2] == -1) { + $self->new_tab; + } else { + $self->make_current($self->{tabs}[$button->[2]]); + } + } + return 1; + } + (); +} + +sub register_keysyms { + my ($self, $tab) = @_; + if (!$self->{no_default_keys}) { + $tab //= $self; + $tab->parse_keysym('Shift-Left', 'perl:tabbedex:prev_tab'); + $tab->parse_keysym('Shift-Right', 'perl:tabbedex:next_tab'); + $tab->parse_keysym('Shift-Down', 'perl:tabbedex:new_tab'); + $tab->parse_keysym('Shift-Up', 'perl:tabbedex:rename_tab'); + $tab->parse_keysym('Control-Left', 'perl:tabbedex:move_tab_left'); + $tab->parse_keysym('Control-Right', 'perl:tabbedex:move_tab_right'); + for my $num (1..12) { + $tab->parse_keysym('Meta-F' . $num, + 'perl:tabbedex:goto_tab_' . $num); + } + } +} + +sub on_init { + my ($self) = @_; + + $self->{resource} = [map $self->resource ("+$_"), + 0 .. urxvt::NUM_RESOURCES - 1]; + + $self->resource (int_bwidth => 0); + $self->resource (pty_fd => -1); + + $self->{rs_prefix} = 'tabbed'; + $self->{rs_prefix} = $self->rs_text ('tabbedex-rs-prefix', 'tabbed'); + + $self->{option} = {}; + for my $key (keys %urxvt::OPTION) { + $self->{option}{$key} = $self->option($urxvt::OPTION{$key}); + } + + # this is for the tabs terminal; order is important + $self->option ($urxvt::OPTION{scrollBar}, 0); + + $self->{rs_tabbar} = $self->rs_color ('tabbar', 3, 0); + $self->{rs_title} = $self->rs_color ('title', 2, 0); + $self->{rs_tab} = [ + undef, # inactive + $self->rs_color ('tab', 0, 1), # active + $self->rs_color ('bell', 0, 3), # bell ringing + $self->rs_color ('bell-tab', 5, 4) # active, bell ringing + ]; + + my $timeouts = $self->rs_text('tabbar-timeouts', + '0:▁:3:▂:6:▃:9:▄:12:▅:15:▆:18:▇:21:█'); + if ($timeouts) { + my @timeouts; + while ($timeouts =~ /^(\d+):(.)(?::(.*))?$/) { + push @timeouts, [ int $1, $2 ]; + $timeouts = defined $3 ? $3 : ''; + } + if (@timeouts) { + $self->{timeouts} = [ sort { $b->[0] <=> $a-> [0] } @timeouts ]; + } + } + + $self->{bell_timeout} = int($self->rs_text ('bell-timeout') // 1); + + $self->{new_button} = $self->rs_bool ('new-button', 0); + $self->{tab_title} = $self->rs_bool ('title', 1); + $self->{autohide} = $self->rs_bool ('autohide', 1); + $self->{no_default_keys} = $self->rs_bool ('no-tabbedex-keys', 0); + $self->{reopen_on_close} = $self->rs_bool ('reopen-on-close', 0); + $self->{tab_urgent_on_bell} = + $self->x_resource_boolean ('urgentOnBell') // 0; + $self->{map_on_bell} = + $self->x_resource_boolean ('mapAlert') // 0; + $self->{new_tab_command} = $self->rs_text ('new-tab-command', 'clear'); + + $self->register_keysyms; + + my @blacklist = split(',', $self->rs_text ('perl-ext-blacklist')); + $self->{perl_ext_blacklist} = join (',-', ',-tabbedex', @blacklist); + + (); +} + + +sub on_start { + my ($self) = @_; + + $self->{maxtabheight} = + $self->int_bwidth + $self->fheight + $self->lineSpace; + $self->{tabheight} = $self->{autohide} ? 0 : $self->{maxtabheight}; + + $self->{running_user_command} = 0; + + $self->cmd_parse ("\033[?25l"); + + my @argv = $self->argv; + do { + shift @argv; + } while @argv && $argv[0] ne "-e"; + $self->{argv} = \@argv; + + if ($self->{tab_title}) { + $self->{tab_title} = $self->{term}->XInternAtom("_NET_WM_NAME", 1); + } + + $self->new_tab; + + if ($self->{new_tab_command} eq 'inherit') { + # nop + } elsif ($self->{new_tab_command} eq 'clear') { + $self->{argv} = []; + } elsif ($self->{new_tab_command} =~ /^-e\s/) { + $self->{argv} = [split /\s+/, $self->{new_tab_command}]; + } else { + printf "tabbedex: unrecognised value of new-tab-command: '%s'\n", + $self->{new_tab_command}; + } + delete $self->{new_tab_command}; + + if (defined $self->{timeouts}) { + my $interval = ($self->{timeouts}[@{ $self->{timeouts} } - 1]->[0]); + $interval = int($interval / 4); + $self->{timer} = urxvt::timer->new + ->interval($interval < 1 ? 1 : $interval) + ->cb ( sub { $self->refresh; } ); + } + + (); +} + + +sub on_configure_notify { + my ($self, $event) = @_; + + $self->configure; + $self->refresh; + + (); +} + + +sub on_user_command { + my $self = shift; + $self->tab_user_command($self->{cur}, @_); +} + + +sub on_wm_delete_window { + my ($self) = @_; + $_->destroy for @{ $self->{tabs} }; + 1; +} + + +sub tab_start { + my ($self, $tab) = @_; + $tab->XChangeInput ($tab->parent, urxvt::PropertyChangeMask); + + push @{ $self->{tabs} }, $tab; + +# $tab->{name} ||= scalar @{ $self->{tabs} }; + $self->make_current ($tab); + + (); +} + + +sub tab_destroy { + my ($self, $tab) = @_; + + if ($self->{reopen_on_close} && $#{ $self->{tabs} } == 0) { + $self->new_tab; + $self->make_current ($self->{tabs}[-1]); + } + + $self->{tabs} = [ grep $_ != $tab, @{ $self->{tabs} } ]; + $self->update_autohide (); + + if (@{ $self->{tabs} }) { + if ($self->{cur} == $tab) { + delete $self->{cur}; + $self->make_current ($self->{tabs}[-1]); + } else { + $self->refresh; + } + } else { + # delay destruction a tiny bit + $self->{destroy} = urxvt::iw->new->start->cb (sub { $self->destroy }); + } + + (); +} + + +sub tab_property_notify { + my ($self, $tab, $event) = @_; + + $self->copy_properties + if $event->{window} == $tab->parent; + + (); +} + + +sub tab_bell { + my ($self, $tab, $event) = @_; + my $now = int urxvt::NOW; + my $bell = $self->tab_bell_active($tab, $now); + $tab->{bell_rung} = $now; + if ($tab != $self->{cur}) { + if ($self->{map_on_bell}) { + $self->make_current($tab); + undef $bell; + } + if ($self->{tab_urgent_on_bell}) { + $self->{term}->set_urgency(1); + } + } + if (defined $bell && $bell ne $self->tab_bell_active($tab, $now)) { + $self->refresh; + } + (); +} + + +sub tab_add_lines { + my ($self, $tab) = @_; + my $now = int urxvt::NOW; + my $mark = $self->tab_activity_mark($tab, $now); + $tab->{last_activity} = $now; + $self->refresh if $mark ne $self->tab_activity_mark($tab, $now); + (); +} + + +sub tab_user_command { + my ($self, $tab, $cmd, $proxy_events) = @_; + if ($cmd eq 'tabbedex:new_tab') { + if (!$self->{is_inputting_name}) { + $self->new_tab; + } + } + elsif ($cmd eq 'tabbedex:next_tab') { + $self->change_tab($tab, 1); + } + elsif ($cmd eq 'tabbedex:prev_tab') { + $self->change_tab($tab, -1); + } + elsif ($cmd eq 'tabbedex:move_tab_left') { + $self->move_tab($tab, -1); + } + elsif ($cmd eq 'tabbedex:move_tab_right') { + $self->move_tab($tab, 1); + } + elsif ($cmd =~ /^tabbedex:goto_tab_(\d+)$/) { + $self->change_to_tab($tab, $1 - 1); + } + elsif ($cmd eq 'tabbedex:rename_tab') { + $self->rename_tab($tab); + } + elsif ($cmd eq 'tabbedex:kill_tab') { + $tab->destroy; + } + else { + # Proxy the user command through to the tab's term, while taking care not + # to get caught in an infinite loop. + if ($proxy_events && $self->{running_user_command} == 0) { + $self->{running_user_command} = 1; + urxvt::invoke($tab->{term}, 20, $cmd); + $self->{running_user_command} = 0; + } + } + + (); +} + +sub change_tab { + my ($self, $tab, $direction) = @_; + + if (!$self->{is_inputting_name} && @{ $self->{tabs} } > 1) { + my $idx = 0; + ++$idx while $self->{tabs}[$idx] != $tab; + $idx += $direction; + $idx = $idx % @{ $self->{tabs}}; + $self->make_current ($self->{tabs}[$idx]); + } + + (); +} + +sub change_to_tab { + my ($self, $tab, $idx) = @_; + + if (!$self->{is_inputting_name} && @{ $self->{tabs} } > 1 && $idx >= 0 && $idx < @{ $self->{tabs} }) { + $self->make_current ($self->{tabs}[$idx]); + } + + (); +} + +sub move_tab { + my ($self, $tab, $direction) = @_; + + if (@{ $self->{tabs} } > 1) { + my $last = $#{$self->{tabs}}; + my $idx = 0; + ++$idx while $self->{tabs}[$idx] != $tab; + + if ($idx == 0 && $direction == -1) { + push @{$self->{tabs}}, shift @{$self->{tabs}}; + $idx = $last; + } elsif ($idx == $last && $direction == 1) { + unshift @{$self->{tabs}}, pop @{$self->{tabs}}; + $idx = 0; + } else { + ($self->{tabs}[$idx], $self->{tabs}[$idx + $direction]) = + ($self->{tabs}[$idx + $direction], $self->{tabs}[$idx]); + $idx += $direction; + } + $self->make_current ($self->{tabs}[$idx]); + } + + (); +} + +sub rename_tab { + my ($self, $tab) = @_; + + if (!$self->{is_inputting_name}) { + $self->{is_inputting_name} = 1; + $tab->{old_name} = $tab->{name} ? $tab->{name} : ""; + $tab->{new_name} = ""; + $tab->{name} = "█"; + $self->update_autohide (1); + $self->refresh; + + $tab->enable('key_press', sub { + # rxvt-unicode-scroll-bug-fix.patch causes early key_press events to + # be passed without $keysym or $octects arguments passed. Work + # around it by ignoring such invocations; we’ll be called again soon + # with all those arguments. The patch shouldn’t be used any more + # anyway. + if (@_ == 2) { + return 0; + } + + my ($tab, $event, $keysym, $octets) = @_; + + if ($keysym == 0xff0d || $keysym == 0xff8d) { # enter + $tab->{name} = $tab->{new_name}; + $self->{is_inputting_name} = 0; + $tab->disable('key_press'); + $self->update_autohide (1); + } elsif ($keysym == 0xff1b) { # escape + $tab->{name} = $tab->{old_name}; + $self->{is_inputting_name} = 0; + $tab->disable('key_press'); + $self->update_autohide (1); + } elsif ($keysym == 0xff08) { # backspace + #my $substr = $tab->{new_name}, -1, 1, ""; + #print "backspace pressed: name: '$tab->{new_name}' , subst: '$substr'\n"; + substr $tab->{new_name}, -1, 1, ""; + $tab->{name} = $tab->{new_name} . '█'; + } elsif ($octets !~ /[\x00-\x1f\x80-\xaf]/) { + $tab->{new_name} .= $octets; + $tab->{name} = $tab->{new_name} . '█'; + } + $self->refresh; + return 1; + }); + } +} + + +sub tab_osc_seq_perl { + my ($self, $tab, $osc) = @_; + + #print "reached tab_osc_seq_perl: osc: $osc\n"; + + $osc =~ s/^tabbedex;//; + $osc =~ s/^([^;]+)+;?// + or return; + my $tab_command = $1; + #print "reached tab_osc_seq_perl: new osc: \"$osc\" ,command: \"$tab_command\"\n"; + + if ($tab_command eq "set_tab_name") { + my ($name) = split /;/, $osc , 1; + #print "new name: $name\n"; + if ($self->{is_inputting_name}) { + $tab->{old_name} = $name; + } else { + $tab->{name} = $name; + } + $self->update_autohide(1); + $self->refresh; + 1; + } + + if ($tab_command eq "new_tab") { + my ($shell_command) = split /;/, $osc, 2; + #print "command: $shell_command\n"; + #my $shell = $ENV{SHELL}; + #my $exec_command = "-e $shell -e $shell_command"; + + if ($shell_command) { + my $exec_command = "-e $shell_command"; + #print "shell command: $exec_command"; + $self->new_tab (split(" ", $exec_command)); + } else { + $self->new_tab; + } + 1; + } + + if ($tab_command eq "interactive_command" or $tab_command eq + "interactive_key" ) { + my (@commands) = split /;/, $osc; + #print Dumper @commands; + + foreach (@commands) { + $_ = $self->locale_encode($_); + } + + # my $write_string = $commands[0]; + # my $write_string = join ';' , @commands if($#commands > 1); + my $write_string = join ';' , @commands; + $write_string .= "\n" if ($tab_command eq "interactive_command"); + $self->tt_write( $write_string); + + 1; + } + + + if ($tab_command eq "make_current") { + my ($tab_number) = split /;/, $osc, 1; + #print "tab number: $tab_number\n"; + $self->make_current($self->{tabs}[$tab_number]); + 1; + } + + +} + + +package urxvt::ext::tabbedex::tab; + +# helper extension implementing the subwindows of a tabbed terminal. +# simply proxies all interesting calls back to the tabbedex class. + +{ + for my $hook ( qw(start destroy user_command property_notify + add_lines bell ) ) { +# add_lines bell osc_seq_perl) ) { + eval qq{ + sub on_$hook { + my \$parent = \$_[0]{term}{parent} + or return; + \$parent->tab_$hook (\@_) + } + }; + die if $@; + } +} + +sub tab_name { + my ($tab, $idx, $max_len) = @_; + return substr($tab->{name} || ($idx + 1), -$max_len); +} + + + + +sub on_osc_seq_perl { + my ($self, $osc, $resp) = @_; + return unless $osc =~ s/^tabbedex;//; + my $term = $self->{term}->{parent}; + my $tab = $self->{term}->{parent}->{cur}; + $term->tab_osc_seq_perl($tab, $osc); + + 1; +} diff --git a/etc/soft/urxvt/perl/urxvt-popup b/etc/soft/urxvt/perl/urxvt-popup new file mode 100644 index 0000000..c1e5ac0 --- /dev/null +++ b/etc/soft/urxvt/perl/urxvt-popup @@ -0,0 +1,139 @@ +#! perl + +# this extension implements popup-menu functionality for urxvt. it works +# together with the urxvt::popup class - "no user serviceable parts inside". + +sub refresh { + my ($self) = @_; + + my $cmd = "\x1b[H"; + + my $row = 1; + for my $item (@{ $self->{data}{item} }) { + my $rend = "normal"; + + if ($row == $self->{hover}) { + $rend = $self->{press} ? "active" : "hover"; + } + + $cmd .= "$item->{rend}{$rend}\x1b[K"; + $cmd .= $self->locale_encode ($item->{render}->($item)); + $cmd .= "\015\012"; + + $row++; + } + + $self->cmd_parse (substr $cmd, 0, -2); +} + +sub on_motion_notify { + my ($self, $event) = @_; + + delete $self->{hover}; + + my ($row, $col) = ($event->{row}, $event->{col}); + if ($col >= 0 && $col < $self->ncol + && $row >= 0 && $row < @{ $self->{data}{item} }) { + $self->{hover} = $event->{row} + 1; + } + $self->refresh; + + 1 +} + +sub on_button_press { + my ($self, $event) = @_; + + $self->{press}[$event->{button}] = 1; + $self->refresh; + + 1 +} + +sub on_button_release { + my ($self, $event) = @_; + + $self->{press}[$event->{button}] = 0; + + my ($row, $col) = ($event->{row}, $event->{col}); + if ($col >= 0 && $col < $self->ncol + && $row >= 0 && $row < @{ $self->{data}{item} }) { + my $item = $self->{data}{item}[$row]; + $item->{activate}->($event, $item); + } + + $self->refresh; + + if ($event->{button} == $self->{data}{event}{button}) { + $self->ungrab; + $self->destroy; + } + + 1 +} + +sub on_focus_out { + my ($self) = @_; + + delete $self->{hover}; + $self->refresh; + + () +} + +sub on_init { + my ($self) = @_; + + my $data = $self->{data} = $urxvt::popup::self; + + $_->{width} = $self->strwidth ($_->{text}) + for @{ $data->{item} }; + + $self->resource (title => "URxvt Popup Menu"); + $self->resource (name => "URxvt.popup"); + + $self->resource ($_ => $data->{term}->resource ($_)) + for qw(font boldFont italicFont boldItalicFont color+0 color+1); + + my $width = List::Util::max map $_->{width}, @{ $data->{item} }; + my $height = @{ $data->{item} }; + + my $pos = ""; + + if ($data->{event}) { + my $x = int List::Util::max 0, $data->{event}{x_root} - $width * $data->{term}->fwidth * 0.5; + my $y = int List::Util::max 0, $data->{event}{y_root} - $data->{term}->fheight * 0.5; + $pos = "+$x+$y"; + } + + $self->resource (geometry => "${width}x${height}$pos"); + + $self->{term}{urxvt_popup_init_done} = 1; + + () +} + +sub on_start { + my ($self) = @_; + + $self->cmd_parse ("\x1b[?25l\x1b[?7l"); + $self->refresh; + + # might fail, but try anyways + $self->grab ($self->{data}{event}{time}, 1) + and $self->allow_events_async; + + on_button_press $self, $self->{data}{event} if $self->{data}{event}{button}; + + () +} + +sub on_map_notify { + my ($self, $event) = @_; + + # should definitely not fail + $self->grab ($self->{data}{event}{time}, 1) + and $self->allow_events_async; +} + + diff --git a/etc/soft/urxvt/perl/xim-onthespot b/etc/soft/urxvt/perl/xim-onthespot new file mode 100644 index 0000000..b5acee2 --- /dev/null +++ b/etc/soft/urxvt/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; + + () +} + + diff --git a/etc/soft/urxvt/tabbedex b/etc/soft/urxvt/tabbedex new file mode 100644 index 0000000..3863715 --- /dev/null +++ b/etc/soft/urxvt/tabbedex @@ -0,0 +1,678 @@ +#! perl +# This program is free software: you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation, either version 3 of the License, or +# (at your option) any later version. + +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. + +# You should have received a copy of the GNU General Public License +# along with this program. If not, see <http://www.gnu.org/licenses/>. +# +## +## Tabbed plugin for rxvt-unicode +## Modified by Michal Nazarewicz (mina86/AT/mina86.com), StephenB +## (mail4stb/AT/gmail.com), Steven Merrill +## <steven dot merrill at gmail.com>, Mark Pustjens +## <pustjens@dds.nl> and more... +## +## The following has been added: +## +## 1. Depending on time of last activity, activity character differs. +## By default, after 4 seconds an asterisk becomes a plus sing, +## after next 4 it becomes a colon, and finally, after another 8 +## seconds it becomes a dot. This can be configured via +## tabbar-timeouts resource. It's format is: +## +## ( <timeout> ":" <character> ":" )* <timeout> ":" <character> ":" +## +## where <timeout> is timeout in seconds and <character> is +## a single activity character. +## +## 2. The "[NEW]" button can be disabled (who on Earth uses mouse to +## create new tab anyways?) by setting new-button resource to yes. +## +## 3. If title resource is true, tab's title is displayed after last +## button. This is handy if you have terminal with no window +## decorations. Colours can be configured via title-fg and +## title-bg. +## +## 4. Incorporated Alexey Semenko <asemenko at gmail.com> patch adding +## autohide resource. If it's true tab bar is hidden if there is +## no more then one tab opened. +## +## 5. Tabs are indexed in starting with zero hex. :] If you're such +## a geek to use urxvt it shouldn't be a problem for you and it +## saves few character when many tabs are opened. +## +## 6. As a minor modification: Final pipe character is removed (unless +## title is displayed). This make tab bar look nicer. +## +## Added by StephenB: +## +## 7. Tabs can be named with Shift+Up (Enter to confirm, Escape to +## cancel). +## +## 8. "[NEW]" button disabled by default. +## +## Added by Steven Merrill <steven dot merrill at gmail.com> +## +## 9. Ability to start a new tab or cycle through tabs via user +## commands: tabbedex:(new|next|prev)_tab . +## e.g. (in .Xdefaults) URxvt.keysym.M-t: perl:tabbedex:new_tab +## (see the urxvt man file for more info about keysym) +## +## 10. Fix an issue whereby on_user_command would not properly get sent +## to other extension packages if the mouse was not over the urxvt +## window. +## +## Added by Thomas Jost: +## +## 11. Add several user commands: tabbedex:rename_tab, +## tabbedex:move_tab_(left|right). +## e.g. (see 9.) URxvt.keysym.C-S-Left: perl:tabbex:move_tab_left +## +## 12. Ability to disable the default keybindings using the +## no-tabbedex-keys resource. +## +## Added by xanf (Illya Klymov): +## +## 13. Ability to display non-latin characters in tab title. +## +## Added by jpkotta: +## +## 14. Tabs inherit command line options. +## +## Added by Mark Pustjens <pustjens@dds.nl> +## +## 15. Resources are now read respecting the -name option. +## +## 16. Ability to prevent the last tab from closing. +## Use the following in your ~/.Xdefaults to enable: +## URXvt.tabbed.reopen-on-close: yes +## + +use Encode qw(decode); + +sub update_autohide { + my ($self, $reconfigure) = @_; + my $oldh = $self->{tabheight}; + if ($self->{autohide} && @{ $self->{tabs} } <= 1 && + ! (@{ $self->{tabs} } == 1 && $self->{tabs}[-1]->{name})) { + $self->{tabheight} = 0; + } else { + $self->{tabheight} = $self->{maxtabheight}; + } + if ($reconfigure && $self->{tabheight} != $oldh) { + $self->configure; + $self->copy_properties; + } +} + + +sub tab_activity_mark ($$) { + my ($self, $tab) = @_; + return ' ' unless defined $tab->{lastActivity}; + return ' ' if $tab == $self->{cur}; + if (defined $self->{timeouts}) { + my $diff = int urxvt::NOW - $tab->{lastActivity}; + for my $spec (@{ $self->{timeouts} }) { + return $spec->[1] if $diff > $spec->[0]; + } + } + '*'; +} + + +sub refresh { + my ($self) = @_; + + # autohide makes it zero + return unless $self->{tabheight}; + + my $ncol = $self->ncol; + + my $text = " " x $ncol; + my $rend = [($self->{rs_tabbar}) x $ncol]; + + my ($ofs, $idx, @ofs) = (0, 0); + + if ($self->{new_button}) { + substr $text, 0, 7, "[NEW] |"; + @$rend[0 .. 5] = ($self->{rs_tab}) x 6; + push @ofs, [0, 6, -1 ]; + $ofs = 7; + } + + for my $tab (@{ $self->{tabs} }) { + my $name = $tab->{name} ? $tab->{name} : $idx; + my $act = $self->tab_activity_mark($tab); + my $txt = sprintf "%s%s%s", $act, $name, $act; + my $len = length $txt; + + substr $text, $ofs, $len + 1, "$txt|"; + @$rend[$ofs .. $ofs + $len - 1] = ($self->{rs_tab}) x $len + if $tab == $self->{cur}; + + push @ofs, [ $ofs, $ofs + $len, $idx ]; + ++$idx; + $ofs += $len + 1; + } + + substr $text, --$ofs, 1, ' '; # remove last '|' + + if ($self->{tab_title} && $ofs + 3 < $ncol) { + my $term = $self->{term}; + my @str = $term->XGetWindowProperty($term->parent, $self->{tab_title}); + if (@str && $str[2]) { + my $str = '| ' . decode("utf8", $str[2]); + my $len = length $str; + $len = $ncol - $ofs if $ofs + $len > $ncol; + substr $text, $ofs, $len, substr $str, 0, $len; + @$rend[$ofs + 2 .. $ofs + $len - 1] = ($self->{rs_title}) x ($len - 2); + } + } + + $self->{tabofs} = \@ofs; + + $self->ROW_t (0, $text, 0, 0, $ncol); + $self->ROW_r (0, $rend, 0, 0, $ncol); + + $self->want_refresh; +} + + +sub new_tab { + my ($self, @argv) = @_; + + my $offset = $self->fheight; + + $self->{tabheight} = $self->{maxtabheight} + unless $self->{autohide} && !(defined $self->{tabs} && @{ $self->{tabs} }); + + # save a backlink to us, make sure tabbedex is inactive + push @urxvt::TERM_INIT, sub { + my ($term) = @_; + $term->{parent} = $self; + + for (0 .. urxvt::NUM_RESOURCES - 1) { + my $value = $self->{resource}[$_]; + + $term->resource ("+$_" => $value) + if defined $value; + } + + foreach my $opt (keys %urxvt::OPTION) { + my $value = $self->{option}{$opt}; + $term->option($urxvt::OPTION{$opt}, $value); + } + + $term->resource (perl_ext_2 => $term->resource ("perl_ext_2") . ",-tabbedex"); + }; + + push @urxvt::TERM_EXT, urxvt::ext::tabbedex::tab::; + + my $term = new urxvt::term + $self->env, $urxvt::RXVTNAME, + -embed => $self->parent, + @argv; +} + + +sub configure { + my ($self) = @_; + + my $tab = $self->{cur}; + + # this is an extremely dirty way to force a configurenotify, but who cares + $tab->XMoveResizeWindow ( + $tab->parent, + 0, $self->{tabheight} + 1, + $self->width, $self->height - $self->{tabheight} + ); + $tab->XMoveResizeWindow ( + $tab->parent, + 0, $self->{tabheight}, + $self->width, $self->height - $self->{tabheight} + ); +} + + +sub copy_properties { + my ($self) = @_; + my $tab = $self->{cur}; + + my $wm_normal_hints = $self->XInternAtom ("WM_NORMAL_HINTS"); + + my $current = delete $self->{current_properties}; + + # pass 1: copy over properties different or nonexisting + for my $atom ($tab->XListProperties ($tab->parent)) { + my ($type, $format, $items) = $self->XGetWindowProperty ($tab->parent, $atom); + + # fix up size hints + if ($atom == $wm_normal_hints) { + my (@hints) = unpack "l!*", $items; + + $hints[$_] += $self->{tabheight} for (4, 6, 16); + + $items = pack "l!*", @hints; + } + + my $cur = delete $current->{$atom}; + + # update if changed, we assume empty items and zero type and format will not happen + $self->XChangeProperty ($self->parent, $atom, $type, $format, $items) + if $cur->[0] != $type or $cur->[1] != $format or $cur->[2] ne $items; + + $self->{current_properties}{$atom} = [$type, $format, $items]; + } + + # pass 2, delete all extraneous properties + $self->XDeleteProperty ($self->parent, $_) for keys %$current; +} + + +sub my_resource { + my $self = shift; + $self->x_resource ("tabbed.$_[0]"); +} + + +sub make_current { + my ($self, $tab) = @_; + + if (my $cur = $self->{cur}) { + delete $cur->{lastActivity}; + $cur->XUnmapWindow ($cur->parent) if $cur->mapped; + $cur->focus_out; + } + + $self->{cur} = $tab; + + $self->configure; + $self->copy_properties; + + $tab->focus_out; # just in case, should be a nop + $tab->focus_in if $self->focus; + + $tab->XMapWindow ($tab->parent); + delete $tab->{lastActivity}; + $self->refresh; + + (); +} + + +sub on_focus_in { + my ($self, $event) = @_; + $self->{cur}->focus_in; + (); +} + +sub on_focus_out { + my ($self, $event) = @_; + $self->{cur}->focus_out; + (); +} + +sub on_key_press { + my ($self, $event) = @_; + $self->{cur}->key_press ($event->{state}, $event->{keycode}, $event->{time}); + 1; +} + +sub on_key_release { + my ($self, $event) = @_; + $self->{cur}->key_release ($event->{state}, $event->{keycode}, $event->{time}); + 1; +} + +sub on_button_release { + my ($self, $event) = @_; + + if ($event->{row} == 0) { + my $col = $event->{col}; + for my $button (@{ $self->{tabofs} }) { + last if $col < $button->[0]; + next unless $col <= $button->[1]; + if ($button->[2] == -1) { + $self->new_tab; + } else { + $self->make_current($self->{tabs}[$button->[2]]); + } + } + return 1; + } + + (); +} + +sub on_init { + my ($self) = @_; + + $self->{resource} = [map $self->resource ("+$_"), 0 .. urxvt::NUM_RESOURCES - 1]; + + $self->resource (int_bwidth => 0); + $self->resource (pty_fd => -1); + + $self->{option} = {}; + for my $key (keys %urxvt::OPTION) { + $self->{option}{$key} = $self->option($urxvt::OPTION{$key}); + } + + # this is for the tabs terminal; order is important + $self->option ($urxvt::OPTION{scrollBar}, 0); + + my $fg = $self->my_resource ("tabbar-fg"); + my $bg = $self->my_resource ("tabbar-bg"); + my $tabfg = $self->my_resource ("tab-fg"); + my $tabbg = $self->my_resource ("tab-bg"); + my $titfg = $self->my_resource ("title-fg"); + my $titbg = $self->my_resource ("title-bg"); + + defined $fg or $fg = 3; + defined $bg or $bg = 0; + defined $tabfg or $tabfg = 0; + defined $tabbg or $tabbg = 1; + defined $titfg or $titfg = 2; + defined $titbg or $titbg = 0; + + $self->{rs_tabbar} = urxvt::SET_COLOR (urxvt::DEFAULT_RSTYLE, $fg + 2, $bg + 2); + $self->{rs_tab} = urxvt::SET_COLOR (urxvt::DEFAULT_RSTYLE, $tabfg + 2, $tabbg + 2); + $self->{rs_title} = urxvt::SET_COLOR (urxvt::DEFAULT_RSTYLE, $titfg + 2, $titbg + 2); + + + my $timeouts = $self->my_resource ("tabbar-timeouts"); + $timeouts = '16:.:8:::4:+' unless defined $timeouts; + if ($timeouts ne '') { + my @timeouts; + while ($timeouts =~ /^(\d+):(.)(?::(.*))?$/) { + push @timeouts, [ int $1, $2 ]; + $timeouts = defined $3 ? $3 : ''; + } + if (@timeouts) { + $self->{timeouts} = [ sort { $b->[0] <=> $a-> [0] } @timeouts ]; + } + } + + $self->{new_button} = + ($self->my_resource ('new-button') or 'false') !~ /^(?:false|0|no)/i; + $self->{tab_title} = + ($self->my_resource ('title') or 'true') !~ /^(?:false|0|no)/i; + $self->{autohide} = + ($self->my_resource ('autohide') or 'false') !~ /^(?:false|0|no)/i; + $self->{no_default_keys} = + ($self->my_resource ('no-tabbedex-keys') or 'false') !~ /^(?:false|0|no)/i; + $self->{reopen_on_close} = + ($self->my_resource ('reopen-on-close') or 'false') !~ /^(?:false|0|no)/i; + + (); +} + + +sub on_start { + my ($self) = @_; + + $self->{maxtabheight} = $self->int_bwidth + $self->fheight + $self->lineSpace; + $self->{tabheight} = $self->{autohide} ? 0 : $self->{maxtabheight}; + + $self->{running_user_command} = 0; + + $self->cmd_parse ("\033[?25l"); + + my @argv = $self->argv; + + do { + shift @argv; + } while @argv && $argv[0] ne "-e"; + + if ($self->{tab_title}) { + $self->{tab_title} = $self->{term}->XInternAtom("_NET_WM_NAME", 1); + } + + $self->new_tab (@argv); + + if (defined $self->{timeouts}) { + my $interval = ($self->{timeouts}[@{ $self->{timeouts} } - 1]->[0]); + $interval = int($interval / 4); + $self->{timer} = urxvt::timer->new + ->interval($interval < 1 ? 1 : $interval) + ->cb ( sub { $self->refresh; } ); + } + + (); +} + + +sub on_configure_notify { + my ($self, $event) = @_; + + $self->configure; + $self->refresh; + + (); +} + + +sub on_user_command { + my ($self, $event) = @_; + + $self->{cur}->{term}->{parent}->tab_user_command($self->{cur}, $event, 1); + + (); +} + + +sub on_wm_delete_window { + my ($self) = @_; + $_->destroy for @{ $self->{tabs} }; + 1; +} + + +sub tab_start { + my ($self, $tab) = @_; + + $tab->XChangeInput ($tab->parent, urxvt::PropertyChangeMask); + + push @{ $self->{tabs} }, $tab; + +# $tab->{name} ||= scalar @{ $self->{tabs} }; + $self->make_current ($tab); + + (); +} + + +sub tab_destroy { + my ($self, $tab) = @_; + + if ($self->{reopen_on_close} && $#{ $self->{tabs} } == 0) { + $self->new_tab; + $self->make_current ($self->{tabs}[-1]); + } + + $self->{tabs} = [ grep $_ != $tab, @{ $self->{tabs} } ]; + $self->update_autohide (); + + if (@{ $self->{tabs} }) { + if ($self->{cur} == $tab) { + delete $self->{cur}; + $self->make_current ($self->{tabs}[-1]); + } else { + $self->refresh; + } + } else { + # delay destruction a tiny bit + $self->{destroy} = urxvt::iw->new->start->cb (sub { $self->destroy }); + } + + (); +} + + +sub tab_key_press { + my ($self, $tab, $event, $keysym, $str) = @_; + + if ($tab->{is_inputting_name}) { + if ($keysym == 0xff0d || $keysym == 0xff8d) { # enter + $tab->{name} = $tab->{new_name}; + $tab->{is_inputting_name} = 0; + $self->update_autohide (1); + } elsif ($keysym == 0xff1b) { # escape + $tab->{name} = $tab->{old_name}; + $tab->{is_inputting_name} = 0; + $self->update_autohide (1); + } elsif ($keysym == 0xff08) { # backspace + substr $tab->{new_name}, -1, 1, ""; + $tab->{name} = "$tab->{new_name}█"; + } elsif ($str !~ /[\x00-\x1f\x80-\xaf]/) { + $tab->{new_name} .= $str; + $tab->{name} = "$tab->{new_name}█"; + } + $self->refresh; + return 1; + } + + return () if ($self->{no_default_keys}); + + if ($event->{state} & urxvt::ShiftMask) { + if ($keysym == 0xff51 || $keysym == 0xff53) { + if (@{ $self->{tabs} } > 1) { + $self->change_tab($tab, $keysym - 0xff52); + } + return 1; + + } elsif ($keysym == 0xff54) { + $self->new_tab; + return 1; + + } elsif ($keysym == 0xff52) { + $self->rename_tab($tab); + return 1; + } + } elsif ($event->{state} & urxvt::ControlMask) { + if ($keysym == 0xff51 || $keysym == 0xff53) { + $self->move_tab($tab, $keysym - 0xff52); + return 1; + } + } + + (); +} + + +sub tab_property_notify { + my ($self, $tab, $event) = @_; + + $self->copy_properties + if $event->{window} == $tab->parent; + + (); +} + + +sub tab_add_lines { + my ($self, $tab) = @_; + my $mark = $self->tab_activity_mark($tab); + $tab->{lastActivity} = int urxvt::NOW; + $self->refresh if $mark ne $self->tab_activity_mark($tab); + (); +} + + +sub tab_user_command { + my ($self, $tab, $cmd, $proxy_events) = @_; + + if ($cmd eq 'tabbedex:new_tab') { + $self->new_tab; + } + elsif ($cmd eq 'tabbedex:next_tab') { + $self->change_tab($tab, 1); + } + elsif ($cmd eq 'tabbedex:prev_tab') { + $self->change_tab($tab, -1); + } + elsif ($cmd eq 'tabbedex:move_tab_left') { + $self->move_tab($tab, -1); + } + elsif ($cmd eq 'tabbedex:move_tab_right') { + $self->move_tab($tab, 1); + } + elsif ($cmd eq 'tabbedex:rename_tab') { + $self->rename_tab($tab); + } + else { + # Proxy the user command through to the tab's term, while taking care not + # to get caught in an infinite loop. + if ($proxy_events && $self->{running_user_command} == 0) { + $self->{running_user_command} = 1; + urxvt::invoke($tab->{term}, 20, $cmd); + $self->{running_user_command} = 0; + } + } + + (); +} + +sub change_tab { + my ($self, $tab, $direction) = @_; + + my $idx = 0; + ++$idx while $self->{tabs}[$idx] != $tab; + $idx += $direction; + $self->make_current ($self->{tabs}[$idx % @{ $self->{tabs}}]); + + (); +} + +sub move_tab { + my ($self, $tab, $direction) = @_; + + if (@{ $self->{tabs} } > 1) { + my $idx1 = 0; + ++$idx1 while $self->{tabs}[$idx1] != $tab; + my $idx2 = ($idx1 + $direction) % @{ $self->{tabs} }; + + ($self->{tabs}[$idx1], $self->{tabs}[$idx2]) = + ($self->{tabs}[$idx2], $self->{tabs}[$idx1]); + $self->make_current ($self->{tabs}[$idx2]); + } + + (); +} + +sub rename_tab { + my ($self, $tab) = @_; + + $tab->{is_inputting_name} = 1; + $tab->{old_name} = $tab->{name} ? $tab->{name} : ""; + $tab->{new_name} = ""; + $tab->{name} = "█"; + $self->update_autohide (1); + $self->refresh; + + (); +} + +package urxvt::ext::tabbedex::tab; + +# helper extension implementing the subwindows of a tabbed terminal. +# simply proxies all interesting calls back to the tabbedex class. + +{ + for my $hook (qw(start destroy user_command key_press property_notify add_lines)) { + eval qq{ + sub on_$hook { + my \$parent = \$_[0]{term}{parent} + or return; + \$parent->tab_$hook (\@_) + } + }; + die if $@; + } +}