├── .gitignore
├── AUTHORS
├── README.md
├── install
├── package
    └── cut-a-release.sh
├── command-runner.sample
├── Makefile
├── pgid-cd.pl
├── LICENSE
└── tabbedex


/.gitignore:
--------------------------------------------------------------------------------
1 | *.1
2 | *.1.gz
3 | *.html
4 | 


--------------------------------------------------------------------------------
/AUTHORS:
--------------------------------------------------------------------------------
 1 | Original urxvt tabbed extension authors.
 2 | 8ware <8wared@googlemail.com>
 3 | Alexey Semenko <asemenko@gmail.com>
 4 | David Beniamine <david@beniamine.net>
 5 | David Koňařík <dvd.kon@gmail.com>
 6 | Enrico Zini <enrico@enricozini.org>
 7 | Illya Klymov <iklymov@qarea.com>
 8 | Jim Diamond <Jim.Diamond@acadiau.ca>
 9 | Mark Pustjens <mark@unkie.org>
10 | Martin Pohlack <pohlack@os.inf.tu-dresden.de>
11 | Michael Traxler <M.Traxler@gsi.de>
12 | Michal Nazarewicz <mina86@mina86.com>
13 | Mihai Basa <bmihai@gmail.com>
14 | Piaodan Zheng <zhengpiaodan@gmail.com>
15 | Steven Merrill <steven.merrill@gmail.com>
16 | Thomas Jost <schnouki@schnouki.net>
17 | jpkotta
18 | smb128 <smb128@york.ac.uk>
19 | stepb <mail4stb@gmail.com>
20 | xanf (Illya Klymov)
21 | 


--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
 1 | # URxvt Tabbed Extended plugin
 2 | 
 3 | An extended version of rxvt-unicode's tabbed perl extension with many
 4 | new features such as:
 5 | 
 6 | * activity and bell markers,
 7 | * terminal status in the tab bar,
 8 | * tabs renaming (also using OSC command),
 9 | * user commands (so keysyms can be used),
10 | * tab bar auto-hiding,
11 | * preserving of -e option,
12 | * and more…
13 | 
14 | ## Installing tabbedex
15 | 
16 | Since tabbedex extension does not come with rxvt-unicode, it has to be
17 | installed separately.  Installation is as simple as invoking:
18 | 
19 |     curl https://raw.githubusercontent.com/mina86/urxvt-tabbedex/master/install | sh
20 | 
21 | or to install system-wide (even though frankly this hasn’t been tested
22 | well):
23 | 
24 |     curl https://raw.githubusercontent.com/mina86/urxvt-tabbedex/master/install | sudo sh
25 | 
26 | Running this command again (or executing `sh
27 | ~/.urxvt/urxvt-tabbedex/install`) will update the code.
28 | 
29 | ## Enabling the extension
30 | 
31 | The plugin can be tested, without enabling it by default, by using
32 | urxvt’s `-pe` switch as follows:
33 | 
34 |     urxvt -pe tabbedex
35 | 
36 | To enable it by default, it needs to be added to `perl-ext` or
37 | `perl-ext-common` URxvt resource.  For example, `~/.Xresources` might
38 | contain:
39 | 
40 |     URxvt.perl-ext:  matcher,tabbedex,searchable-scrollback<M-s>
41 | 
42 | For full documentation of that resource, consult RESOURCES section of
43 | [urxvt man page](http://linux.die.net/man/1/urxvt).
44 | 
45 | ## Configuration and usage
46 | 
47 | For configuration and usage see the sources of tabbedex file or read
48 | the urxvt-tabbedex man page installed by the above command (in case of
49 | local installation it is put in `~/man` directory which `man` will
50 | look if `~/bin` is in `PATH`).
51 | 


--------------------------------------------------------------------------------
/install:
--------------------------------------------------------------------------------
 1 | #!/bin/sh
 2 | # tabbedex install script
 3 | 
 4 | # Wrap everything in a function so we don’t have to worry about connection
 5 | # dropping in the middle of the stream.  This makes ‘curl … | sh’ as well as
 6 | # updating the install script while it is running safe.
 7 | _() {
 8 | 
 9 | url=https://github.com/mina86/urxvt-tabbedex
10 | 
11 | set -eu
12 | 
13 | if [ -e ~/.urxvt/tabbedex ]; then
14 | 	printf >&2 '~/.urxvt/tabbedex already exist, overwrite? [y/N] '
15 | 	if ! read ans || [ "$ans" != y ]; then
16 | 		echo >&2 'Aborting'
17 | 		exit 1
18 | 	fi
19 | fi
20 | 
21 | log () {
22 | 	echo >&2
23 | 	echo "$*" >&2
24 | }
25 | 
26 | git=$(which git 2>/dev/null) || true
27 | 
28 | if [ -z "$git" ]; then
29 | 	log 'Downloading and extracting the package to ~/.urxvt/tabbedex'
30 | 	mkdir -p ~/.urxvt/tabbedex && cd ~/.urxvt/tabbedex
31 | 	curl -L "$url/archive/master.tar.gz" |
32 | 		tar vzx --exclude=.gitignore --strip-components=1
33 | 
34 | elif [ -e ~/.urxvt/tabbedex/.git ]; then
35 | 	log 'Updating the repository'
36 | 	cd ~/.urxvt/tabbedex
37 | 	git remote update
38 | 	git reset --hard origin/master
39 | 
40 | else
41 | 	if [ -e ~/.urxvt/tabbedex ]; then
42 | 		log 'Deleting ~/.urxvt/tabbedex'
43 | 		rm -rf -- ~/.urxvt/tabbedex
44 | 	fi
45 | 	log 'Cloning the repository to ~/.urxvt/tabbedex'
46 | 	mkdir -p ~/.urxvt
47 | 	git clone "$url" ~/.urxvt/tabbedex
48 | 	cd ~/.urxvt/tabbedex
49 | fi
50 | 
51 | case "$(id -u)" in
52 | 0)
53 | 	log 'Running as super user, installing globally.'
54 | 	make install
55 | 	;;
56 | 
57 | *)
58 | 	log 'Running as regular user, installing symbolic links locally'
59 | 	make install-local-symlink
60 | esac
61 | 
62 | log 'You can re-run this script to update the extension.'
63 | 
64 | # Exit so that if this script got longer (if user run it from the repository),
65 | # shell will not try to execute anything past its cursor in the file.
66 | exit
67 | }
68 | 
69 | _
70 | 


--------------------------------------------------------------------------------
/package/cut-a-release.sh:
--------------------------------------------------------------------------------
 1 | #!/bin/sh
 2 | 
 3 | set -eu
 4 | 
 5 | if [ -z "$(which tput 2>/dev/null)" ]; then
 6 | 	setf() { true; }
 7 | 	bold=
 8 | 	sgr0=
 9 | else
10 | 	setf() { tput setf "$1"; }
11 | 	bold=$(tput bold)
12 | 	sgr0=$(tput sgr0)
13 | fi
14 | 
15 | die() {
16 | 	echo "${0##*/}: $(setf 4)$*${sgr0}" >&2
17 | 	exit 1
18 | }
19 | 
20 | noclobber=true
21 | patchlevel=
22 | tag=-a
23 | dry=
24 | experimental=o/experimental
25 | master=o/master
26 | n=0
27 | while [ $# -gt 0 ]; do
28 | 	case "$n:$1" in
29 | 	?:-s|?:--sign)    tag=-s ;;
30 | 	?:-f|?:--force)   noclobber=false ;;
31 | 	?:-n|?:--dry-run) dry="echo >" ;;
32 | 	?:-p?*)           patchlevel=${1#-?} ;;
33 | 	0:[!-]*)
34 | 		master=$1
35 | 		experimental=HEAD
36 | 		n=1
37 | 		;;
38 | 	1:[!-]*)
39 | 		experimental=$1
40 | 		n=2
41 | 		;;
42 | 	*)
43 | 		die "unknown argument: $1"
44 | 	esac
45 | 	shift
46 | done
47 | 
48 | version=$(date +%g.%V)${patchlevel:+.$patchlevel}
49 | pkg=urxvt-tabbedex-$version
50 | 
51 | out=${TMPDIR:-/tmp}/$pkg.tar.bz2
52 | 
53 | git remote update o
54 | 
55 | if ! git merge-base --is-ancestor "$master" "$experimental"; then
56 | 	die "$master is not an ancestor of $experimental" >&2
57 | elif [ -z "$dry" ] && $noclobber && [ -e "$out" ]; then
58 | 	die "Release file (‘${bold}$out$(setf 4)’) already exists, aborting" >&2
59 | fi
60 | 
61 | echo "Creating release ${bold}urxvt-tabbedex $version${sgr0} from $master:"
62 | git log -n1 --pretty="format:    $(setf 6)%h  $(setf 3)%s${sgr0}" "$master"
63 | 
64 | $dry git tag $tag "v$version" "$master"
65 | $dry git push o +"v$version:refs/tags/v$version" \
66 |      "$master:refs/heads/master" +"$experimental:refs/heads/experimental"
67 | 
68 | tmp=$(mktemp -d)
69 | trap 'rm -r -- "$tmp"' 0
70 | 
71 | git archive --format=tar --prefix="$pkg/" "$master" | tar xC "$tmp" \
72 | 	--exclude=.gitignore --exclude=install --exclude=package
73 | 
74 | mkdir -- "$tmp/$pkg/experimental"
75 | git format-patch -o "$tmp/$pkg/experimental" "$master".."$experimental" >/dev/null
76 | if find "$tmp/$pkg/experimental" -maxdepth 0 -empty | grep -q .; then
77 | 	rmdir -- "$tmp/$pkg/experimental"
78 | fi
79 | 
80 | echo "$version" >$tmp/$pkg/.version
81 | 
82 | mkdir -- "$tmp/$pkg/release-notes"
83 | for tag in $(git tag | grep -o '^v[1-9][0-9]\.[0-9][0-9].*'); do
84 | 	git cat-file tag $tag | sed '1,/^$/d' >$tmp/$pkg/release-notes/$tag.txt
85 | done
86 | 
87 | cd -- "$tmp"
88 | echo
89 | setf 7
90 | dry_out=${dry:+/dev/null}
91 | tar jcvf "${dry_out:-$out}" --sort=name --owner=0 --group=0 --mode=a+rX "$pkg"
92 | echo "$sgr0"
93 | 
94 | if [ -z "$dry" ]; then
95 | 	echo ">>  Release file saved to ${bold}$out${sgr0}  <<"
96 | else
97 | 	echo ">>  Would save release file to ${bold}$out${sgr0}  <<"
98 | fi
99 | 


--------------------------------------------------------------------------------
/command-runner.sample:
--------------------------------------------------------------------------------
 1 | #!/bin/sh
 2 | : <<'=cut'
 3 | 
 4 | =head1 NAME
 5 | 
 6 | command-runner.sample - example script for use with tabbedex tab-arguments
 7 | 
 8 | =head1 SYNOPSIS
 9 | 
10 | command-runner.sample I<id> I<command> [ I<arguments> ... ]
11 | 
12 | =head1 DESCRIPTION
13 | 
14 | Runs a predefined commands identified by I<id> or I<command> if I<id> doesn't
15 | match any.  Predefined commands are hard-coded in the source code of this
16 | script.
17 | 
18 | =head1 OPTIONS
19 | 
20 | =over
21 | 
22 | =item I<id>
23 | 
24 | Identifier of a predefined command to run.  Typically a zero-indexed integer.
25 | 
26 | =item I<command> [ I<arguments> ... ]
27 | 
28 | Command to execute if I<id> does not match any know predefined command.
29 | 
30 | =back
31 | 
32 | =head1 TABBEDEX
33 | 
34 | The script is designed to work with tabbedex urxvt plugin (and showcase its
35 | I<tab-arguments> configuration resource).  It can be used to execute different
36 | commands in different tabs.  To use it, copy it and edit list of commands at the
37 | end of the file.  Provided urxvt-tabbedex is installed in B</usr/lib/urxvt>, the
38 | following steps are a good start:
39 | 
40 |     mkdir -p ~/.urxvt
41 |     cp /usr/lib/urxvt/tabbedex-command-runner.sample \
42 |        ~/.urxvt/command-runner.sh
43 |     ${VISUAL:-${EDITOR:-/bin/vi}} ~/.urxvt/command-runner.sh
44 | 
45 | Finally, configure B<tab-arguments> resource, for example:
46 | 
47 |     URxvt.tabbedex.tab-arguments: \
48 |         -e /bin/sh %~/.urxvt/command-runner.sh %n %E
49 | 
50 | With this done, each time new tab is started, this script will be run so that it
51 | can decide what actual command is executed in the tab.
52 | 
53 | To use this script in conjunction with B<pgid-cd.pl> tool also packaged with
54 | urxvt-tabbedex, the resource should be:
55 | 
56 |     URxvt.tabbedex.tab-arguments: \
57 |         -e /usr/lib/urxvt/tabbedex-pgid-cd %p \
58 |         /bin/sh %~/.urxvt/command-runner.sh %n %e
59 | 
60 | (modulo the actual location of the files).
61 | 
62 | =head1 SEE ALSO
63 | 
64 | L<tabbedex(1)> and L<tabbedex-pgid-cd(1)>
65 | 
66 | =cut
67 | 
68 | trap 'echo "Press RETURN to continue." >&2 && read && exit 1' 0
69 | if [ $# -lt 2 ]; then
70 | 	echo "usage: /bin/sh ${0##*/} <id> <command> [ <args> ... ]" >&2
71 | 	exit 1
72 | fi
73 | 
74 | id=$1
75 | shift
76 | 
77 | set_tab_name() {
78 | 	printf '\033]777;tabbedex;set_tab_name;%s\007' "$1"
79 | }
80 | 
81 | #### Predefined commands ####
82 | 
83 | case $id in
84 | 0) # First tab is shell
85 | 	set_tab_name sh
86 | 	exec "${SHELL:-bash}"
87 | 	;;
88 | 1) # Second tab is Emacs
89 | 	set_tab_name ed
90 | 	exec emacs -nw
91 | 	;;
92 | 2) # In third, let’s tail /var/log/syslog
93 | 	set_tab_name log
94 | 	exec tail -f /var/log/syslog
95 | 	;;
96 | *) # If nothing matches, run whatever was given as an argument
97 | 	exec "$@"
98 | esac
99 | 


--------------------------------------------------------------------------------
/Makefile:
--------------------------------------------------------------------------------
 1 | DESTDIR   =
 2 | PREFIX    = /usr
 3 | LIBDIR    = lib
 4 | # Set to empty value to prevent man pages from being installed:
 5 | MANDIR    = share/man
 6 | # Set to empty value to prevent documentation from being installed:
 7 | DOCDIR    = share/doc/urxvt-tabbedex
 8 | 
 9 | L         = $(DESTDIR)/$(PREFIX)/$(LIBDIR)/urxvt
10 | M         = $(DESTDIR)/$(PREFIX)/$(MANDIR)/man1
11 | D         = $(DESTDIR)/$(PREFIX)/$(DOCDIR)
12 | 
13 | DIST      = tabbedex command-runner.sample pgid-cd.pl
14 | 
15 | 
16 | all: man html
17 | man: tabbedex.1.gz command-runner.sample.1.gz pgid-cd.pl.1.gz
18 | html: tabbedex.html command-runner.sample.html pgid-cd.pl.html
19 | 
20 | 
21 | %.1: %
22 | 	if ! pod2man $< >$@; then rm -- $@; exit 1; fi
23 | 
24 | %.1.gz: %.1
25 | 	if ! gzip -9 <$< >$@; then rm -- $@; exit 1; fi
26 | 
27 | %.html: %
28 | 	if ! pod2html $< >$@; then rm -- $@; exit 1; fi
29 | 	@rm -f -- pod2htmd.tmp
30 | 
31 | 
32 | clean:
33 | 	rm -f -- *.1 *.1.gz *.html
34 | 
35 | 
36 | install: AUTHORS LICENSE $(DIST) man html
37 | 	install -D -m 644 tabbedex                   $L/perl/tabbedex
38 | 	install -D -m 644 command-runner.sample      $L/tabbedex-command-runner.sample
39 | 	install -D -m 755 pgid-cd.pl                 $L/tabbedex-pgid-cd
40 | ifneq ($(MANDIR),)
41 | 	install -D -m 644 tabbedex.1.gz              $M/urxvt-tabbedex.1.gz
42 | 	install -D -m 644 command-runner.sample.1.gz $M/tabbedex-command-runner.1.gz
43 | 	install -D -m 644 pgid-cd.pl.1.gz            $M/tabbedex-pgid-cd.1.gz
44 | endif
45 | ifneq ($(DOCDIR),)
46 | 	install -D -m 644 AUTHORS                    $D/AUTHORS
47 | 	install -D -m 644 LICENSE                    $D/LICENSE
48 | 	install -D -m 644 tabbedex.html              $D/tabbedex.html
49 | 	install -D -m 644 command-runner.sample.html $D/command-runner.html
50 | 	install -D -m 644 pgid-cd.pl.html            $D/pgid-cd.html
51 | endif
52 | 
53 | uninstall:
54 | 	rm -f -- $L/perl/tabbedex $L/tabbedex-command-runner.sample \
55 | 	         $L/tabbedex-pgid-cd
56 | ifneq ($(MANDIR),)
57 | 	rm -f -- $M/urxvt-tabbedex.1.gz $M/tabbedex-command-runner.1.gz \
58 | 	         $M/tabbedex-pgid-cd.1.gz
59 | endif
60 | ifneq ($(DOCDIR),)
61 | 	rm -rf -- $D
62 | endif
63 | 
64 | 
65 | install-local: $(DIST) man
66 | 	install -D -m 644 tabbedex                   ~/.urxvt/ext/tabbedex
67 | 	install -D -m 644 command-runner.sample      ~/.urxvt/tabbedex-command-runner.sample
68 | 	install -D -m 755 pgid-cd.pl                 ~/.urxvt/tabbedex-pgid-cd
69 | ifneq ($(MANDIR),)
70 | # TODO: This assumes user has ~/bin in their PATH:
71 | 	install -D -m 644 tabbedex.1.gz              ~/man/man1/urxvt-tabbedex.1.gz
72 | 	install -D -m 644 command-runner.sample.1.gz ~/man/man1/tabbedex-command-runner.1.gz
73 | 	install -D -m 644 pgid-cd.pl.1.gz            ~/man/man1/tabbedex-pgid-cd.1.gz
74 | endif
75 | 
76 | install-local-symlink: $(DIST) man
77 | 	mkdir -m 755 -p ~/.urxvt/ext ~/man/man1/
78 | 	ln -sf -- "$$(realpath tabbedex)"                   ~/.urxvt/ext
79 | 	ln -sf -- "$$(realpath command-runner.sample)"      ~/.urxvt/tabbedex-command-runner.sample
80 | 	ln -sf -- "$$(realpath pgid-cd.pl)"                 ~/.urxvt/pgid-cd
81 | ifneq ($(MANDIR),)
82 | 	ln -sf -- "$$(realpath tabbedex.1.gz)"              ~/man/man1/urxvt-tabbedex.1.gz
83 | 	ln -sf -- "$$(realpath command-runner.sample.1.gz)" ~/man/man1/tabbedex-command-runner.1.gz
84 | 	ln -sf -- "$$(realpath pgid-cd.pl.1.gz)"            ~/man/man1/tabbedex-pgid-cd.1.gz
85 | endif
86 | 
87 | uninstall-local:
88 | 	rm -f -- ~/.urxvt/ext/tabbedex ~/.urxvt/tabbedex-command-runner.sample \
89 | 	         ~/.urxvt/tabbedex-pgid-cd
90 | ifneq ($(MANDIR),)
91 | 	rm -f -- ~/man/man1/urxvt-tabbedex.1.gz \
92 | 	         ~/man/man1/tabbedex-command-runner.1.gz \
93 | 	         ~/man/man1/tabbedex-pgid-cd.1.gz
94 | endif
95 | 
96 | 
97 | .PHONY: all man html clean
98 | .PHONY: install uninstall install-local install-local-symlink uninstall-local
99 | 


--------------------------------------------------------------------------------
/pgid-cd.pl:
--------------------------------------------------------------------------------
  1 | #!/usr/bin/env perl
  2 | 
  3 | =head1 NAME
  4 | 
  5 | pgid-cd.pl - change directory to that of given process and run command
  6 | 
  7 | =head1 SYNOPSIS
  8 | 
  9 | pgid-cd.pl [ -v ] ( I<pgid> | -1 ) I<command> [ I<args> ... ]
 10 | 
 11 | =head1 DESCRIPTION
 12 | 
 13 | Tries to detect current working directory (or CWD) of specified process group
 14 | and runs specified command in that directory.
 15 | 
 16 | CWD detection is brittle and can lead to unexpected results.  It is likely to
 17 | fail if all processes in given process group run as a user other than current
 18 | user (current user will simply lack permission to read CWD information).
 19 | Furthermore, if different processes in process group have different CWDs the
 20 | script will pick arbitrary one (it can access).  And of course there's no hope
 21 | of it working via remote connection (e.g. SSH).
 22 | 
 23 | =head1 OPTIONS
 24 | 
 25 | =over
 26 | 
 27 | =item B<-v>
 28 | 
 29 | If changing directory fails, print all encountered errors.  Otherwise silently
 30 | start the command.  Note: if present, this *must* be the first argument.
 31 | 
 32 | =item I<pgid> or B<-1>
 33 | 
 34 | ID of the process group to detect CWD of.  B<-1> disables CWD detection and the
 35 | script then simply executes the command.
 36 | 
 37 | =item I<command> [ I<args> ... ]
 38 | 
 39 | Command to execute.
 40 | 
 41 | =back
 42 | 
 43 | =head1 TABBEDEX
 44 | 
 45 | The script was designed to work with tabbedex urxvt plugin and in particular its
 46 | B<tab-arguments> configuration resource.  For example, if this script is located
 47 | in B<~/.urxvt/tabbedex-pgid-cd> one can use the following configuration:
 48 | 
 49 |     URxvt.tabbedex.tab-arguments: \
 50 |         -e %~/.urxvt/tabbedex-pgid-cd %p %E
 51 | 
 52 | or if it's in B</usr/lib/urxvt/tabbedex-pgid-cd> then:
 53 | 
 54 |     URxvt.tabbedex.tab-arguments: \
 55 |         -e /usr/lib/urxvt/tabbedex-pgid-cd %p %E
 56 | 
 57 | Tabbedex will replace B<%p> sequence with an ID of a process in foreground of
 58 | current tab such that command in the new tab will inherit current working
 59 | directory from existing tab.
 60 | 
 61 | =head1 SEE ALSO
 62 | 
 63 | L<tabbedex(1)> and L<tabbedex-command-runner(1)>
 64 | 
 65 | =cut
 66 | 
 67 | use warnings;
 68 | use strict;
 69 | 
 70 | sub error {
 71 | 	print STDERR join(': ', $0, @_), "\n";
 72 | }
 73 | 
 74 | sub fatal {
 75 | 	error @_;
 76 | 	error 'use Ctrl+C to terminate this script';
 77 | 	sleep;
 78 | 	exit 1;
 79 | }
 80 | 
 81 | my $verbose = $ARGV[0] eq '-v';
 82 | if ($verbose) {
 83 | 	shift @ARGV;
 84 | }
 85 | 
 86 | my $pgid = shift @ARGV;
 87 | if ($pgid !~ /^(?:-1|\d+)$/ || !@ARGV) {
 88 | 	fatal 'usage: $0 [ -v ] ( <pgid> | -1 ) <command> [ <args> ... ]';
 89 | }
 90 | 
 91 | if ($pgid == -1) {
 92 | 	goto DONE;
 93 | } elsif (!-d '/proc') {
 94 | 	error('/proc missing, unable to determine CWD of other processes');
 95 | 	goto DONE;
 96 | }
 97 | 
 98 | my @errors;
 99 | 
100 | sub try_pid {
101 | 	my ($pid) = @_;
102 | 	my $path = "/proc/$pid/cwd";
103 | 	my $cwd = eval { readlink $path };
104 | 	if ($@) {
105 | 		push @errors, "$path: $@";
106 | 	} elsif (!defined $cwd) {
107 | 		push @errors, "$path: $!";
108 | 	} elsif (!chdir $cwd) {
109 | 		push @errors, "$cwd: $!";
110 | 	} else {
111 | 		goto DONE;
112 | 	}
113 | }
114 | 
115 | # If $pgid is still alive we can use its CWD
116 | if (-d "/proc/$pgid") {
117 | 	try_pid($pgid);
118 | }
119 | 
120 | # If $pgid is no longer with us, we need to go through all running
121 | # processes and filter the ones which are in process group $pgid.
122 | if (opendir(my $dir, '/proc')) {
123 | 	while (my $pid = readdir $dir) {
124 | 		if ($pid =~ /^[0-9]+$/ && $pid != $pgid &&
125 | 		    open(my $fh, '<', "/proc/$pid/stat")) {
126 | 			if ($pgid == (split ' ', scalar <$fh>)[4]) {
127 | 				try_pid $pid;
128 | 			}
129 | 		}
130 | 	}
131 | } else {
132 | 	push @errors, "/proc: $!";
133 | }
134 | 
135 | if ($verbose) {
136 | 	for (@errors) {
137 | 		chomp;
138 | 		error $_;
139 | 	}
140 | 	error("can't find " . (@errors ? 'CWD of' : 'process in') .
141 | 	      " group $pgid; won't change directory");
142 | }
143 | 
144 | DONE:
145 | { exec { $ARGV[0] } @ARGV }
146 | fatal $ARGV[0], "$!";
147 | 


--------------------------------------------------------------------------------
/LICENSE:
--------------------------------------------------------------------------------
  1 |                     GNU GENERAL PUBLIC LICENSE
  2 |                        Version 3, 29 June 2007
  3 | 
  4 |  Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>
  5 |  Everyone is permitted to copy and distribute verbatim copies
  6 |  of this license document, but changing it is not allowed.
  7 | 
  8 |                             Preamble
  9 | 
 10 |   The GNU General Public License is a free, copyleft license for
 11 | software and other kinds of works.
 12 | 
 13 |   The licenses for most software and other practical works are designed
 14 | to take away your freedom to share and change the works.  By contrast,
 15 | the GNU General Public License is intended to guarantee your freedom to
 16 | share and change all versions of a program--to make sure it remains free
 17 | software for all its users.  We, the Free Software Foundation, use the
 18 | GNU General Public License for most of our software; it applies also to
 19 | any other work released this way by its authors.  You can apply it to
 20 | your programs, too.
 21 | 
 22 |   When we speak of free software, we are referring to freedom, not
 23 | price.  Our General Public Licenses are designed to make sure that you
 24 | have the freedom to distribute copies of free software (and charge for
 25 | them if you wish), that you receive source code or can get it if you
 26 | want it, that you can change the software or use pieces of it in new
 27 | free programs, and that you know you can do these things.
 28 | 
 29 |   To protect your rights, we need to prevent others from denying you
 30 | these rights or asking you to surrender the rights.  Therefore, you have
 31 | certain responsibilities if you distribute copies of the software, or if
 32 | you modify it: responsibilities to respect the freedom of others.
 33 | 
 34 |   For example, if you distribute copies of such a program, whether
 35 | gratis or for a fee, you must pass on to the recipients the same
 36 | freedoms that you received.  You must make sure that they, too, receive
 37 | or can get the source code.  And you must show them these terms so they
 38 | know their rights.
 39 | 
 40 |   Developers that use the GNU GPL protect your rights with two steps:
 41 | (1) assert copyright on the software, and (2) offer you this License
 42 | giving you legal permission to copy, distribute and/or modify it.
 43 | 
 44 |   For the developers' and authors' protection, the GPL clearly explains
 45 | that there is no warranty for this free software.  For both users' and
 46 | authors' sake, the GPL requires that modified versions be marked as
 47 | changed, so that their problems will not be attributed erroneously to
 48 | authors of previous versions.
 49 | 
 50 |   Some devices are designed to deny users access to install or run
 51 | modified versions of the software inside them, although the manufacturer
 52 | can do so.  This is fundamentally incompatible with the aim of
 53 | protecting users' freedom to change the software.  The systematic
 54 | pattern of such abuse occurs in the area of products for individuals to
 55 | use, which is precisely where it is most unacceptable.  Therefore, we
 56 | have designed this version of the GPL to prohibit the practice for those
 57 | products.  If such problems arise substantially in other domains, we
 58 | stand ready to extend this provision to those domains in future versions
 59 | of the GPL, as needed to protect the freedom of users.
 60 | 
 61 |   Finally, every program is threatened constantly by software patents.
 62 | States should not allow patents to restrict development and use of
 63 | software on general-purpose computers, but in those that do, we wish to
 64 | avoid the special danger that patents applied to a free program could
 65 | make it effectively proprietary.  To prevent this, the GPL assures that
 66 | patents cannot be used to render the program non-free.
 67 | 
 68 |   The precise terms and conditions for copying, distribution and
 69 | modification follow.
 70 | 
 71 |                        TERMS AND CONDITIONS
 72 | 
 73 |   0. Definitions.
 74 | 
 75 |   "This License" refers to version 3 of the GNU General Public License.
 76 | 
 77 |   "Copyright" also means copyright-like laws that apply to other kinds of
 78 | works, such as semiconductor masks.
 79 | 
 80 |   "The Program" refers to any copyrightable work licensed under this
 81 | License.  Each licensee is addressed as "you".  "Licensees" and
 82 | "recipients" may be individuals or organizations.
 83 | 
 84 |   To "modify" a work means to copy from or adapt all or part of the work
 85 | in a fashion requiring copyright permission, other than the making of an
 86 | exact copy.  The resulting work is called a "modified version" of the
 87 | earlier work or a work "based on" the earlier work.
 88 | 
 89 |   A "covered work" means either the unmodified Program or a work based
 90 | on the Program.
 91 | 
 92 |   To "propagate" a work means to do anything with it that, without
 93 | permission, would make you directly or secondarily liable for
 94 | infringement under applicable copyright law, except executing it on a
 95 | computer or modifying a private copy.  Propagation includes copying,
 96 | distribution (with or without modification), making available to the
 97 | public, and in some countries other activities as well.
 98 | 
 99 |   To "convey" a work means any kind of propagation that enables other
100 | parties to make or receive copies.  Mere interaction with a user through
101 | a computer network, with no transfer of a copy, is not conveying.
102 | 
103 |   An interactive user interface displays "Appropriate Legal Notices"
104 | to the extent that it includes a convenient and prominently visible
105 | feature that (1) displays an appropriate copyright notice, and (2)
106 | tells the user that there is no warranty for the work (except to the
107 | extent that warranties are provided), that licensees may convey the
108 | work under this License, and how to view a copy of this License.  If
109 | the interface presents a list of user commands or options, such as a
110 | menu, a prominent item in the list meets this criterion.
111 | 
112 |   1. Source Code.
113 | 
114 |   The "source code" for a work means the preferred form of the work
115 | for making modifications to it.  "Object code" means any non-source
116 | form of a work.
117 | 
118 |   A "Standard Interface" means an interface that either is an official
119 | standard defined by a recognized standards body, or, in the case of
120 | interfaces specified for a particular programming language, one that
121 | is widely used among developers working in that language.
122 | 
123 |   The "System Libraries" of an executable work include anything, other
124 | than the work as a whole, that (a) is included in the normal form of
125 | packaging a Major Component, but which is not part of that Major
126 | Component, and (b) serves only to enable use of the work with that
127 | Major Component, or to implement a Standard Interface for which an
128 | implementation is available to the public in source code form.  A
129 | "Major Component", in this context, means a major essential component
130 | (kernel, window system, and so on) of the specific operating system
131 | (if any) on which the executable work runs, or a compiler used to
132 | produce the work, or an object code interpreter used to run it.
133 | 
134 |   The "Corresponding Source" for a work in object code form means all
135 | the source code needed to generate, install, and (for an executable
136 | work) run the object code and to modify the work, including scripts to
137 | control those activities.  However, it does not include the work's
138 | System Libraries, or general-purpose tools or generally available free
139 | programs which are used unmodified in performing those activities but
140 | which are not part of the work.  For example, Corresponding Source
141 | includes interface definition files associated with source files for
142 | the work, and the source code for shared libraries and dynamically
143 | linked subprograms that the work is specifically designed to require,
144 | such as by intimate data communication or control flow between those
145 | subprograms and other parts of the work.
146 | 
147 |   The Corresponding Source need not include anything that users
148 | can regenerate automatically from other parts of the Corresponding
149 | Source.
150 | 
151 |   The Corresponding Source for a work in source code form is that
152 | same work.
153 | 
154 |   2. Basic Permissions.
155 | 
156 |   All rights granted under this License are granted for the term of
157 | copyright on the Program, and are irrevocable provided the stated
158 | conditions are met.  This License explicitly affirms your unlimited
159 | permission to run the unmodified Program.  The output from running a
160 | covered work is covered by this License only if the output, given its
161 | content, constitutes a covered work.  This License acknowledges your
162 | rights of fair use or other equivalent, as provided by copyright law.
163 | 
164 |   You may make, run and propagate covered works that you do not
165 | convey, without conditions so long as your license otherwise remains
166 | in force.  You may convey covered works to others for the sole purpose
167 | of having them make modifications exclusively for you, or provide you
168 | with facilities for running those works, provided that you comply with
169 | the terms of this License in conveying all material for which you do
170 | not control copyright.  Those thus making or running the covered works
171 | for you must do so exclusively on your behalf, under your direction
172 | and control, on terms that prohibit them from making any copies of
173 | your copyrighted material outside their relationship with you.
174 | 
175 |   Conveying under any other circumstances is permitted solely under
176 | the conditions stated below.  Sublicensing is not allowed; section 10
177 | makes it unnecessary.
178 | 
179 |   3. Protecting Users' Legal Rights From Anti-Circumvention Law.
180 | 
181 |   No covered work shall be deemed part of an effective technological
182 | measure under any applicable law fulfilling obligations under article
183 | 11 of the WIPO copyright treaty adopted on 20 December 1996, or
184 | similar laws prohibiting or restricting circumvention of such
185 | measures.
186 | 
187 |   When you convey a covered work, you waive any legal power to forbid
188 | circumvention of technological measures to the extent such circumvention
189 | is effected by exercising rights under this License with respect to
190 | the covered work, and you disclaim any intention to limit operation or
191 | modification of the work as a means of enforcing, against the work's
192 | users, your or third parties' legal rights to forbid circumvention of
193 | technological measures.
194 | 
195 |   4. Conveying Verbatim Copies.
196 | 
197 |   You may convey verbatim copies of the Program's source code as you
198 | receive it, in any medium, provided that you conspicuously and
199 | appropriately publish on each copy an appropriate copyright notice;
200 | keep intact all notices stating that this License and any
201 | non-permissive terms added in accord with section 7 apply to the code;
202 | keep intact all notices of the absence of any warranty; and give all
203 | recipients a copy of this License along with the Program.
204 | 
205 |   You may charge any price or no price for each copy that you convey,
206 | and you may offer support or warranty protection for a fee.
207 | 
208 |   5. Conveying Modified Source Versions.
209 | 
210 |   You may convey a work based on the Program, or the modifications to
211 | produce it from the Program, in the form of source code under the
212 | terms of section 4, provided that you also meet all of these conditions:
213 | 
214 |     a) The work must carry prominent notices stating that you modified
215 |     it, and giving a relevant date.
216 | 
217 |     b) The work must carry prominent notices stating that it is
218 |     released under this License and any conditions added under section
219 |     7.  This requirement modifies the requirement in section 4 to
220 |     "keep intact all notices".
221 | 
222 |     c) You must license the entire work, as a whole, under this
223 |     License to anyone who comes into possession of a copy.  This
224 |     License will therefore apply, along with any applicable section 7
225 |     additional terms, to the whole of the work, and all its parts,
226 |     regardless of how they are packaged.  This License gives no
227 |     permission to license the work in any other way, but it does not
228 |     invalidate such permission if you have separately received it.
229 | 
230 |     d) If the work has interactive user interfaces, each must display
231 |     Appropriate Legal Notices; however, if the Program has interactive
232 |     interfaces that do not display Appropriate Legal Notices, your
233 |     work need not make them do so.
234 | 
235 |   A compilation of a covered work with other separate and independent
236 | works, which are not by their nature extensions of the covered work,
237 | and which are not combined with it such as to form a larger program,
238 | in or on a volume of a storage or distribution medium, is called an
239 | "aggregate" if the compilation and its resulting copyright are not
240 | used to limit the access or legal rights of the compilation's users
241 | beyond what the individual works permit.  Inclusion of a covered work
242 | in an aggregate does not cause this License to apply to the other
243 | parts of the aggregate.
244 | 
245 |   6. Conveying Non-Source Forms.
246 | 
247 |   You may convey a covered work in object code form under the terms
248 | of sections 4 and 5, provided that you also convey the
249 | machine-readable Corresponding Source under the terms of this License,
250 | in one of these ways:
251 | 
252 |     a) Convey the object code in, or embodied in, a physical product
253 |     (including a physical distribution medium), accompanied by the
254 |     Corresponding Source fixed on a durable physical medium
255 |     customarily used for software interchange.
256 | 
257 |     b) Convey the object code in, or embodied in, a physical product
258 |     (including a physical distribution medium), accompanied by a
259 |     written offer, valid for at least three years and valid for as
260 |     long as you offer spare parts or customer support for that product
261 |     model, to give anyone who possesses the object code either (1) a
262 |     copy of the Corresponding Source for all the software in the
263 |     product that is covered by this License, on a durable physical
264 |     medium customarily used for software interchange, for a price no
265 |     more than your reasonable cost of physically performing this
266 |     conveying of source, or (2) access to copy the
267 |     Corresponding Source from a network server at no charge.
268 | 
269 |     c) Convey individual copies of the object code with a copy of the
270 |     written offer to provide the Corresponding Source.  This
271 |     alternative is allowed only occasionally and noncommercially, and
272 |     only if you received the object code with such an offer, in accord
273 |     with subsection 6b.
274 | 
275 |     d) Convey the object code by offering access from a designated
276 |     place (gratis or for a charge), and offer equivalent access to the
277 |     Corresponding Source in the same way through the same place at no
278 |     further charge.  You need not require recipients to copy the
279 |     Corresponding Source along with the object code.  If the place to
280 |     copy the object code is a network server, the Corresponding Source
281 |     may be on a different server (operated by you or a third party)
282 |     that supports equivalent copying facilities, provided you maintain
283 |     clear directions next to the object code saying where to find the
284 |     Corresponding Source.  Regardless of what server hosts the
285 |     Corresponding Source, you remain obligated to ensure that it is
286 |     available for as long as needed to satisfy these requirements.
287 | 
288 |     e) Convey the object code using peer-to-peer transmission, provided
289 |     you inform other peers where the object code and Corresponding
290 |     Source of the work are being offered to the general public at no
291 |     charge under subsection 6d.
292 | 
293 |   A separable portion of the object code, whose source code is excluded
294 | from the Corresponding Source as a System Library, need not be
295 | included in conveying the object code work.
296 | 
297 |   A "User Product" is either (1) a "consumer product", which means any
298 | tangible personal property which is normally used for personal, family,
299 | or household purposes, or (2) anything designed or sold for incorporation
300 | into a dwelling.  In determining whether a product is a consumer product,
301 | doubtful cases shall be resolved in favor of coverage.  For a particular
302 | product received by a particular user, "normally used" refers to a
303 | typical or common use of that class of product, regardless of the status
304 | of the particular user or of the way in which the particular user
305 | actually uses, or expects or is expected to use, the product.  A product
306 | is a consumer product regardless of whether the product has substantial
307 | commercial, industrial or non-consumer uses, unless such uses represent
308 | the only significant mode of use of the product.
309 | 
310 |   "Installation Information" for a User Product means any methods,
311 | procedures, authorization keys, or other information required to install
312 | and execute modified versions of a covered work in that User Product from
313 | a modified version of its Corresponding Source.  The information must
314 | suffice to ensure that the continued functioning of the modified object
315 | code is in no case prevented or interfered with solely because
316 | modification has been made.
317 | 
318 |   If you convey an object code work under this section in, or with, or
319 | specifically for use in, a User Product, and the conveying occurs as
320 | part of a transaction in which the right of possession and use of the
321 | User Product is transferred to the recipient in perpetuity or for a
322 | fixed term (regardless of how the transaction is characterized), the
323 | Corresponding Source conveyed under this section must be accompanied
324 | by the Installation Information.  But this requirement does not apply
325 | if neither you nor any third party retains the ability to install
326 | modified object code on the User Product (for example, the work has
327 | been installed in ROM).
328 | 
329 |   The requirement to provide Installation Information does not include a
330 | requirement to continue to provide support service, warranty, or updates
331 | for a work that has been modified or installed by the recipient, or for
332 | the User Product in which it has been modified or installed.  Access to a
333 | network may be denied when the modification itself materially and
334 | adversely affects the operation of the network or violates the rules and
335 | protocols for communication across the network.
336 | 
337 |   Corresponding Source conveyed, and Installation Information provided,
338 | in accord with this section must be in a format that is publicly
339 | documented (and with an implementation available to the public in
340 | source code form), and must require no special password or key for
341 | unpacking, reading or copying.
342 | 
343 |   7. Additional Terms.
344 | 
345 |   "Additional permissions" are terms that supplement the terms of this
346 | License by making exceptions from one or more of its conditions.
347 | Additional permissions that are applicable to the entire Program shall
348 | be treated as though they were included in this License, to the extent
349 | that they are valid under applicable law.  If additional permissions
350 | apply only to part of the Program, that part may be used separately
351 | under those permissions, but the entire Program remains governed by
352 | this License without regard to the additional permissions.
353 | 
354 |   When you convey a copy of a covered work, you may at your option
355 | remove any additional permissions from that copy, or from any part of
356 | it.  (Additional permissions may be written to require their own
357 | removal in certain cases when you modify the work.)  You may place
358 | additional permissions on material, added by you to a covered work,
359 | for which you have or can give appropriate copyright permission.
360 | 
361 |   Notwithstanding any other provision of this License, for material you
362 | add to a covered work, you may (if authorized by the copyright holders of
363 | that material) supplement the terms of this License with terms:
364 | 
365 |     a) Disclaiming warranty or limiting liability differently from the
366 |     terms of sections 15 and 16 of this License; or
367 | 
368 |     b) Requiring preservation of specified reasonable legal notices or
369 |     author attributions in that material or in the Appropriate Legal
370 |     Notices displayed by works containing it; or
371 | 
372 |     c) Prohibiting misrepresentation of the origin of that material, or
373 |     requiring that modified versions of such material be marked in
374 |     reasonable ways as different from the original version; or
375 | 
376 |     d) Limiting the use for publicity purposes of names of licensors or
377 |     authors of the material; or
378 | 
379 |     e) Declining to grant rights under trademark law for use of some
380 |     trade names, trademarks, or service marks; or
381 | 
382 |     f) Requiring indemnification of licensors and authors of that
383 |     material by anyone who conveys the material (or modified versions of
384 |     it) with contractual assumptions of liability to the recipient, for
385 |     any liability that these contractual assumptions directly impose on
386 |     those licensors and authors.
387 | 
388 |   All other non-permissive additional terms are considered "further
389 | restrictions" within the meaning of section 10.  If the Program as you
390 | received it, or any part of it, contains a notice stating that it is
391 | governed by this License along with a term that is a further
392 | restriction, you may remove that term.  If a license document contains
393 | a further restriction but permits relicensing or conveying under this
394 | License, you may add to a covered work material governed by the terms
395 | of that license document, provided that the further restriction does
396 | not survive such relicensing or conveying.
397 | 
398 |   If you add terms to a covered work in accord with this section, you
399 | must place, in the relevant source files, a statement of the
400 | additional terms that apply to those files, or a notice indicating
401 | where to find the applicable terms.
402 | 
403 |   Additional terms, permissive or non-permissive, may be stated in the
404 | form of a separately written license, or stated as exceptions;
405 | the above requirements apply either way.
406 | 
407 |   8. Termination.
408 | 
409 |   You may not propagate or modify a covered work except as expressly
410 | provided under this License.  Any attempt otherwise to propagate or
411 | modify it is void, and will automatically terminate your rights under
412 | this License (including any patent licenses granted under the third
413 | paragraph of section 11).
414 | 
415 |   However, if you cease all violation of this License, then your
416 | license from a particular copyright holder is reinstated (a)
417 | provisionally, unless and until the copyright holder explicitly and
418 | finally terminates your license, and (b) permanently, if the copyright
419 | holder fails to notify you of the violation by some reasonable means
420 | prior to 60 days after the cessation.
421 | 
422 |   Moreover, your license from a particular copyright holder is
423 | reinstated permanently if the copyright holder notifies you of the
424 | violation by some reasonable means, this is the first time you have
425 | received notice of violation of this License (for any work) from that
426 | copyright holder, and you cure the violation prior to 30 days after
427 | your receipt of the notice.
428 | 
429 |   Termination of your rights under this section does not terminate the
430 | licenses of parties who have received copies or rights from you under
431 | this License.  If your rights have been terminated and not permanently
432 | reinstated, you do not qualify to receive new licenses for the same
433 | material under section 10.
434 | 
435 |   9. Acceptance Not Required for Having Copies.
436 | 
437 |   You are not required to accept this License in order to receive or
438 | run a copy of the Program.  Ancillary propagation of a covered work
439 | occurring solely as a consequence of using peer-to-peer transmission
440 | to receive a copy likewise does not require acceptance.  However,
441 | nothing other than this License grants you permission to propagate or
442 | modify any covered work.  These actions infringe copyright if you do
443 | not accept this License.  Therefore, by modifying or propagating a
444 | covered work, you indicate your acceptance of this License to do so.
445 | 
446 |   10. Automatic Licensing of Downstream Recipients.
447 | 
448 |   Each time you convey a covered work, the recipient automatically
449 | receives a license from the original licensors, to run, modify and
450 | propagate that work, subject to this License.  You are not responsible
451 | for enforcing compliance by third parties with this License.
452 | 
453 |   An "entity transaction" is a transaction transferring control of an
454 | organization, or substantially all assets of one, or subdividing an
455 | organization, or merging organizations.  If propagation of a covered
456 | work results from an entity transaction, each party to that
457 | transaction who receives a copy of the work also receives whatever
458 | licenses to the work the party's predecessor in interest had or could
459 | give under the previous paragraph, plus a right to possession of the
460 | Corresponding Source of the work from the predecessor in interest, if
461 | the predecessor has it or can get it with reasonable efforts.
462 | 
463 |   You may not impose any further restrictions on the exercise of the
464 | rights granted or affirmed under this License.  For example, you may
465 | not impose a license fee, royalty, or other charge for exercise of
466 | rights granted under this License, and you may not initiate litigation
467 | (including a cross-claim or counterclaim in a lawsuit) alleging that
468 | any patent claim is infringed by making, using, selling, offering for
469 | sale, or importing the Program or any portion of it.
470 | 
471 |   11. Patents.
472 | 
473 |   A "contributor" is a copyright holder who authorizes use under this
474 | License of the Program or a work on which the Program is based.  The
475 | work thus licensed is called the contributor's "contributor version".
476 | 
477 |   A contributor's "essential patent claims" are all patent claims
478 | owned or controlled by the contributor, whether already acquired or
479 | hereafter acquired, that would be infringed by some manner, permitted
480 | by this License, of making, using, or selling its contributor version,
481 | but do not include claims that would be infringed only as a
482 | consequence of further modification of the contributor version.  For
483 | purposes of this definition, "control" includes the right to grant
484 | patent sublicenses in a manner consistent with the requirements of
485 | this License.
486 | 
487 |   Each contributor grants you a non-exclusive, worldwide, royalty-free
488 | patent license under the contributor's essential patent claims, to
489 | make, use, sell, offer for sale, import and otherwise run, modify and
490 | propagate the contents of its contributor version.
491 | 
492 |   In the following three paragraphs, a "patent license" is any express
493 | agreement or commitment, however denominated, not to enforce a patent
494 | (such as an express permission to practice a patent or covenant not to
495 | sue for patent infringement).  To "grant" such a patent license to a
496 | party means to make such an agreement or commitment not to enforce a
497 | patent against the party.
498 | 
499 |   If you convey a covered work, knowingly relying on a patent license,
500 | and the Corresponding Source of the work is not available for anyone
501 | to copy, free of charge and under the terms of this License, through a
502 | publicly available network server or other readily accessible means,
503 | then you must either (1) cause the Corresponding Source to be so
504 | available, or (2) arrange to deprive yourself of the benefit of the
505 | patent license for this particular work, or (3) arrange, in a manner
506 | consistent with the requirements of this License, to extend the patent
507 | license to downstream recipients.  "Knowingly relying" means you have
508 | actual knowledge that, but for the patent license, your conveying the
509 | covered work in a country, or your recipient's use of the covered work
510 | in a country, would infringe one or more identifiable patents in that
511 | country that you have reason to believe are valid.
512 | 
513 |   If, pursuant to or in connection with a single transaction or
514 | arrangement, you convey, or propagate by procuring conveyance of, a
515 | covered work, and grant a patent license to some of the parties
516 | receiving the covered work authorizing them to use, propagate, modify
517 | or convey a specific copy of the covered work, then the patent license
518 | you grant is automatically extended to all recipients of the covered
519 | work and works based on it.
520 | 
521 |   A patent license is "discriminatory" if it does not include within
522 | the scope of its coverage, prohibits the exercise of, or is
523 | conditioned on the non-exercise of one or more of the rights that are
524 | specifically granted under this License.  You may not convey a covered
525 | work if you are a party to an arrangement with a third party that is
526 | in the business of distributing software, under which you make payment
527 | to the third party based on the extent of your activity of conveying
528 | the work, and under which the third party grants, to any of the
529 | parties who would receive the covered work from you, a discriminatory
530 | patent license (a) in connection with copies of the covered work
531 | conveyed by you (or copies made from those copies), or (b) primarily
532 | for and in connection with specific products or compilations that
533 | contain the covered work, unless you entered into that arrangement,
534 | or that patent license was granted, prior to 28 March 2007.
535 | 
536 |   Nothing in this License shall be construed as excluding or limiting
537 | any implied license or other defenses to infringement that may
538 | otherwise be available to you under applicable patent law.
539 | 
540 |   12. No Surrender of Others' Freedom.
541 | 
542 |   If conditions are imposed on you (whether by court order, agreement or
543 | otherwise) that contradict the conditions of this License, they do not
544 | excuse you from the conditions of this License.  If you cannot convey a
545 | covered work so as to satisfy simultaneously your obligations under this
546 | License and any other pertinent obligations, then as a consequence you may
547 | not convey it at all.  For example, if you agree to terms that obligate you
548 | to collect a royalty for further conveying from those to whom you convey
549 | the Program, the only way you could satisfy both those terms and this
550 | License would be to refrain entirely from conveying the Program.
551 | 
552 |   13. Use with the GNU Affero General Public License.
553 | 
554 |   Notwithstanding any other provision of this License, you have
555 | permission to link or combine any covered work with a work licensed
556 | under version 3 of the GNU Affero General Public License into a single
557 | combined work, and to convey the resulting work.  The terms of this
558 | License will continue to apply to the part which is the covered work,
559 | but the special requirements of the GNU Affero General Public License,
560 | section 13, concerning interaction through a network will apply to the
561 | combination as such.
562 | 
563 |   14. Revised Versions of this License.
564 | 
565 |   The Free Software Foundation may publish revised and/or new versions of
566 | the GNU General Public License from time to time.  Such new versions will
567 | be similar in spirit to the present version, but may differ in detail to
568 | address new problems or concerns.
569 | 
570 |   Each version is given a distinguishing version number.  If the
571 | Program specifies that a certain numbered version of the GNU General
572 | Public License "or any later version" applies to it, you have the
573 | option of following the terms and conditions either of that numbered
574 | version or of any later version published by the Free Software
575 | Foundation.  If the Program does not specify a version number of the
576 | GNU General Public License, you may choose any version ever published
577 | by the Free Software Foundation.
578 | 
579 |   If the Program specifies that a proxy can decide which future
580 | versions of the GNU General Public License can be used, that proxy's
581 | public statement of acceptance of a version permanently authorizes you
582 | to choose that version for the Program.
583 | 
584 |   Later license versions may give you additional or different
585 | permissions.  However, no additional obligations are imposed on any
586 | author or copyright holder as a result of your choosing to follow a
587 | later version.
588 | 
589 |   15. Disclaimer of Warranty.
590 | 
591 |   THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY
592 | APPLICABLE LAW.  EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT
593 | HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY
594 | OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,
595 | THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
596 | PURPOSE.  THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM
597 | IS WITH YOU.  SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF
598 | ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
599 | 
600 |   16. Limitation of Liability.
601 | 
602 |   IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
603 | WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS
604 | THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY
605 | GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE
606 | USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF
607 | DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD
608 | PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),
609 | EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
610 | SUCH DAMAGES.
611 | 
612 |   17. Interpretation of Sections 15 and 16.
613 | 
614 |   If the disclaimer of warranty and limitation of liability provided
615 | above cannot be given local legal effect according to their terms,
616 | reviewing courts shall apply local law that most closely approximates
617 | an absolute waiver of all civil liability in connection with the
618 | Program, unless a warranty or assumption of liability accompanies a
619 | copy of the Program in return for a fee.
620 | 
621 |                      END OF TERMS AND CONDITIONS
622 | 
623 |             How to Apply These Terms to Your New Programs
624 | 
625 |   If you develop a new program, and you want it to be of the greatest
626 | possible use to the public, the best way to achieve this is to make it
627 | free software which everyone can redistribute and change under these terms.
628 | 
629 |   To do so, attach the following notices to the program.  It is safest
630 | to attach them to the start of each source file to most effectively
631 | state the exclusion of warranty; and each file should have at least
632 | the "copyright" line and a pointer to where the full notice is found.
633 | 
634 |     <one line to give the program's name and a brief idea of what it does.>
635 |     Copyright (C) <year>  <name of author>
636 | 
637 |     This program is free software: you can redistribute it and/or modify
638 |     it under the terms of the GNU General Public License as published by
639 |     the Free Software Foundation, either version 3 of the License, or
640 |     (at your option) any later version.
641 | 
642 |     This program is distributed in the hope that it will be useful,
643 |     but WITHOUT ANY WARRANTY; without even the implied warranty of
644 |     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
645 |     GNU General Public License for more details.
646 | 
647 |     You should have received a copy of the GNU General Public License
648 |     along with this program.  If not, see <http://www.gnu.org/licenses/>.
649 | 
650 | Also add information on how to contact you by electronic and paper mail.
651 | 
652 |   If the program does terminal interaction, make it output a short
653 | notice like this when it starts in an interactive mode:
654 | 
655 |     <program>  Copyright (C) <year>  <name of author>
656 |     This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
657 |     This is free software, and you are welcome to redistribute it
658 |     under certain conditions; type `show c' for details.
659 | 
660 | The hypothetical commands `show w' and `show c' should show the appropriate
661 | parts of the General Public License.  Of course, your program's commands
662 | might be different; for a GUI interface, you would use an "about box".
663 | 
664 |   You should also get your employer (if you work as a programmer) or school,
665 | if any, to sign a "copyright disclaimer" for the program, if necessary.
666 | For more information on this, and how to apply and follow the GNU GPL, see
667 | <http://www.gnu.org/licenses/>.
668 | 
669 |   The GNU General Public License does not permit incorporating your program
670 | into proprietary programs.  If your program is a subroutine library, you
671 | may consider it more useful to permit linking proprietary applications with
672 | the library.  If this is what you want to do, use the GNU Lesser General
673 | Public License instead of this License.  But first, please read
674 | <http://www.gnu.org/philosophy/why-not-lgpl.html>.
675 | 


--------------------------------------------------------------------------------
/tabbedex:
--------------------------------------------------------------------------------
   1 | #! perl
   2 | # TabbedEx plugin for rxvt-unicode; based on original tabbed plugin.
   3 | # https://github.com/mina86/urxvt-tabbedex
   4 | # Copyright 2006-2020 tabbed and tabbedex authors
   5 | #
   6 | # This program is free software: you can redistribute it and/or modify
   7 | # it under the terms of the GNU General Public License as published by
   8 | # the Free Software Foundation, either version 3 of the License, or
   9 | # (at your option) any later version.
  10 | #
  11 | # This program is distributed in the hope that it will be useful,
  12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 | # GNU General Public License for more details.
  15 | #
  16 | # You should have received a copy of the GNU General Public License
  17 | # along with this program.  If not, see <http://www.gnu.org/licenses/>.
  18 | 
  19 | =head1 NAME
  20 | 
  21 | tabbedex - tabbed interface to urxvt; extended
  22 | 
  23 | =head1 DESCRIPTION
  24 | 
  25 | This extension implements a tabbed terminal.  Once rxvt-unicode starts, slave
  26 | terminals can be started in their own tabs and switched between.  At each point
  27 | only one terminal is visible.  rxvt-unicode exits once all tabs are closed.
  28 | 
  29 | Once at least two tabs are created a tab bar is displayed at the top of the
  30 | window which lists all the slave terminals.  Clicking on a number/name of a tab
  31 | on that bar switches to it.
  32 | 
  33 | tabbedex is an extended version of the tabbed plugin distributed with urxvt.
  34 | 
  35 | =head2 Key bindings
  36 | 
  37 | Creating new tabs, switching between them and moving them around can be
  38 | performed through the following key bindings:
  39 | 
  40 | =over
  41 | 
  42 | =item B<Shift-Down>
  43 | 
  44 | Creates a new tab.
  45 | 
  46 | =item B<Shift-Left> and B<Shift-Right>
  47 | 
  48 | Switches to the tab on the left or on the right of the current tab.  Movement
  49 | wraps around once at the first or last tab.
  50 | 
  51 | =item B<Meta-F1> through B<Meta-F12>
  52 | 
  53 | Switches to the first through twelfth tab.
  54 | 
  55 | =item B<Control-Left> and B<Control-right>
  56 | 
  57 | Move current tab to the left or right.  Wraps around on the first and last
  58 | position.
  59 | 
  60 | =item B<Shift-Up>
  61 | 
  62 | Allows current tab to be renamed.  Tab bar is shown if it was hidden, current
  63 | tab's name (if any) is cleared and cursor is displayed in its place.  Typing
  64 | text renames the tab, backspace or Ctrl+H delete the last character, Escape or
  65 | Ctrl+C aborts the rename operation and Enter accepts the new name.
  66 | 
  67 | =back
  68 | 
  69 | Default key bindings can be disabled using B<no-tabbedex-keys> resource (see
  70 | below) and replaced with custom ones using urxvt's B<keysym> resource.
  71 | 
  72 | =head1 CONFIGURATION
  73 | 
  74 | The extension can be configured with X resources just like urxvt itself, for
  75 | example:
  76 | 
  77 |     URxvt.tabbedex.tabbar-fg: 4
  78 |     URxvt.tabbedex.tabbar-bg: 0
  79 | 
  80 | Tabbedex recognises the following resources:
  81 | 
  82 | =over
  83 | 
  84 | =item B<autohide>: I<boolean>
  85 | 
  86 | If set (the default), the tab bar will be hidden unless there are at least two
  87 | tabs open.  This is irrespective of whether C<NEW> button or tab's title is
  88 | displayed.
  89 | 
  90 | =item B<new-button>: I<boolean>
  91 | 
  92 | If set, a C<NEW> button will be displayed on the left of the tab bar.  Clicking
  93 | the button creates a new tab.  It is not displayed by default.
  94 | 
  95 | =item B<title>: I<boolean>
  96 | 
  97 | If set (the default), when tab bar is visible and there is enough space left,
  98 | current tab's title will be displayed after the last tab.
  99 | 
 100 | =item B<tabbar-fg>:   [I<style>] I<colour>  and  B<tabbar-bg>:   I<colour>
 101 | 
 102 | =item B<tab-fg>:      [I<style>] I<colour>  and  B<tab-bg>:      I<colour>
 103 | 
 104 | =item B<bell-fg>:     [I<style>] I<colour>  and  B<bell-bg>:     I<colour>
 105 | 
 106 | =item B<bell-tab-fg>: [I<style>] I<colour>  and  B<bell-tab-bg>: I<colour>
 107 | 
 108 | =item B<title-fg>:    [I<style>] I<colour>  and  B<title-bg>:    I<colour>
 109 | 
 110 | Foreground and background styles of elements of the tab bar, respectively: 1)
 111 | the tab bar including background tabs, 2) the current tab and new button, 3)
 112 | a background tab on which bell has rung, 4) the current tab if bell has rung and
 113 | 5) tab title.
 114 | 
 115 | Colours can be specified as: I<-2> meaning default foreground, I<-1> meaning
 116 | default background, an integer between B<0> and B<255> specifying index in
 117 | terminal' colour palette or any other string which X11 recognises as a colour
 118 | (e.g. B<#1155CC>).
 119 | 
 120 | Furthermore, the B<-fg> resource can be prefixed by combination of B<bold>,
 121 | B<italic>, B<blink>, B<reverse-video> and B<underline> which specify the
 122 | font-style of the text.
 123 | 
 124 | The default values for the settings are as follows:
 125 | 
 126 |     Component | *-fg          | *-bg | Description
 127 |     ----------+---------------+------+----------------------
 128 |     tabbar    |             3 |    0 | brown text on black
 129 |     tab       | bold        0 |    1 | black text on red
 130 |     bell      |      italic 0 |    3 | black text on brown
 131 |     bell-tab  | bold italic 5 |    4 | magenta text on blue
 132 |     title     |      italic 2 |    0 | green text on black
 133 | 
 134 | =item B<bell-timeout>: I<number>
 135 | 
 136 | Time in seconds, one second by default, a bell is said to be ringing on current
 137 | tab for after it was rung.  Setting this to zero essentially disables the
 138 | B<bell-tab-(fg|bg)> styling of tabs.
 139 | 
 140 | =item B<tab-arguments>: I<string>
 141 | 
 142 | Arguments passed when starting a slave tabs.  If not specified, I<-e B<command>>
 143 | switch used when starting urxvt command is used (if any).  If specified, the
 144 | value is first expanded (see below), then split into words using shell quoting
 145 | rules and those are passed as arguments to slave terminals when they are
 146 | started.
 147 | 
 148 | This resource can be used to pass any arguments however doing so may have
 149 | unintended consequences.  Options such as I<-bw> or I<-geometry> are especially
 150 | problematic but others may cause issues as well.  Because of this, only I<-e
 151 | B>command arguments>> is officially supported.
 152 | 
 153 | The value is expanded by replacing two-character sequences starting with
 154 | a percent sign as follows:
 155 | 
 156 | =over
 157 | 
 158 | =item I<%%>
 159 | 
 160 | Replaced by a literal percent sign.
 161 | 
 162 | =item I<%e>
 163 | 
 164 | Replaced by properly quoted I<-e B<command>> arguments if they were given when
 165 | urxvt was started or an empty string otherwise.  See also I<%E> which may be
 166 | easier for some uses.
 167 | 
 168 | Remember that if neither I<%e> nor I<%E> is used, I<-e> switch passed when
 169 | starting urxvt will be completely ignored.
 170 | 
 171 | =item I<%E>
 172 | 
 173 | Similar to I<%e> but I<-e> is not included in the expansion and if I<%e> would
 174 | expand to an empty string I<%E> expands to value of SHELL environment variable
 175 | or I</bin/sh> if that's empty.  This means that I<%E> is always a valid command.
 176 | 
 177 | For example, here's how the sequence can be used to set TABBEDEX_NUM environment
 178 | variables when running a command:
 179 | 
 180 |     URxvt.tabbedex.tab-arguments: \
 181 |         -e /usr/bin/env TABBEDEX_NUM=%n %E
 182 | 
 183 | =item I<%n>
 184 | 
 185 | Replaced by the total number of tabs opened during the lifetime of the
 186 | extension.  Not to be confused with number of tabs currently open.  The counter
 187 | starts at zero and always increments for each subsequent tab.
 188 | 
 189 | =item I<%p>
 190 | 
 191 | Replaced by ID of a process group which is running in foreground of the pseudo
 192 | terminal in the current tab (as in, not the new tab being created but the tab
 193 | where the new tab request originated from) or -1 if this piece of information
 194 | could not be determined.
 195 | 
 196 | This can be used to guess the current working directory of current tab.
 197 | 
 198 | =item I<%~>
 199 | 
 200 | Replaced by a properly quoted value of HOME environment variable or I</> if it's
 201 | not set.
 202 | 
 203 | =back
 204 | 
 205 | Unrecognised sequences are replaced with an empty string.
 206 | 
 207 | See B<command-runner.sample> file distributed with this extension for some ideas
 208 | how this resource can be used to start different commands in different tabs or
 209 | how to start new tabs in the same working directory as the current tab is using.
 210 | 
 211 | =item B<no-tabbedex-keys>: I<boolean>
 212 | 
 213 | If set, the default key bindings (described at the beginning of this document)
 214 | are not set up.  The mappings can be recreated using urxvt's B<keysym.*>
 215 | resources:
 216 | 
 217 |     URxvt.tabbedex.no-tabbedex-keys: yes
 218 |     URxvt.keysym.Shift-Left:    tabbedex:prev_tab
 219 |     URxvt.keysym.Shift-Right:   tabbedex:next_tab
 220 |     URxvt.keysym.Shift-Down:    tabbedex:new_tab
 221 |     URxvt.keysym.Shift-Up:      tabbedex:rename_tab
 222 |     URxvt.keysym.Control-Left:  tabbedex:move_tab_left
 223 |     URxvt.keysym.Control-Right: tabbedex:move_tab_right
 224 |     URxvt.keysym.Meta-F1:       tabbedex:goto_tab_1
 225 |     URxvt.keysym.Meta-F2:       tabbedex:goto_tab_2
 226 |     URxvt.keysym.Meta-F3:       tabbedex:goto_tab_3
 227 |     URxvt.keysym.Meta-F4:       tabbedex:goto_tab_4
 228 |     URxvt.keysym.Meta-F5:       tabbedex:goto_tab_5
 229 |     URxvt.keysym.Meta-F6:       tabbedex:goto_tab_6
 230 |     URxvt.keysym.Meta-F7:       tabbedex:goto_tab_7
 231 |     URxvt.keysym.Meta-F8:       tabbedex:goto_tab_8
 232 |     URxvt.keysym.Meta-F9:       tabbedex:goto_tab_9
 233 |     URxvt.keysym.Meta-F10:      tabbedex:goto_tab_10
 234 |     URxvt.keysym.Meta-F11:      tabbedex:goto_tab_11
 235 |     URxvt.keysym.Meta-F12:      tabbedex:goto_tab_12
 236 | 
 237 | See I<ACTIONS AND USER COMMANDS> below for list of available actions.
 238 | 
 239 | =item B<perl-ext-blacklist>: I<string>
 240 | 
 241 | A comma-separated list of extensions that must not be loaded into the slave
 242 | terminals (tabs).  tabbedex plugin is implicitly added onto the list.
 243 | 
 244 | =item B<reopen-on-close>: I<boolean>
 245 | 
 246 | If set, whenever last tab is destroyed a new one will be created.
 247 | 
 248 | =item B<tabbar-timeouts>: I<string>
 249 | 
 250 | When new text is written to a background tab, activity marks are displayed
 251 | around its number (or name if it has one) on the tab bar.  By default Unicode
 252 | characters are used to display a block which grows with time the longer it was
 253 | since last time there was any activity in the tab.
 254 | 
 255 | This resource allows for this to be customised.  It's format is
 256 | 
 257 |     ( <timeout> ":" <char> <char>? ":" )* <timeout> ":" <char> <char>? ":"
 258 | 
 259 | where <timeout> is timeout in seconds and <char> is an activity character.  If
 260 | two characters are given, they specify left and right activity marks.  If one
 261 | character is given, it specifies both.  For example:
 262 | 
 263 |     URxvt.tabbedex.tabbar-timeouts: 0:|:3:():6:[]:9:{}:12:<>
 264 | 
 265 | See B<tabbedex;ignore_line_activity> OSC sequence below to see how the activity
 266 | detection can be further affected.
 267 | 
 268 | =back
 269 | 
 270 | Extension's behaviour is also influenced by some of URxvt's configuration
 271 | options as well.  (See I<RESOURCES> in the L<urxvt(1)> manpage for more
 272 | information about them).  The options include:
 273 | 
 274 | =over
 275 | 
 276 | =item B<mapAlert>
 277 | 
 278 | If set, when bell rings in a background tab, the tab is selected as current.
 279 | 
 280 | =item B<urgentOnBell>
 281 | 
 282 | If set, when bell rings in a background tab, the master terminal's urgency hint
 283 | is set.
 284 | 
 285 | =back
 286 | 
 287 | =head1 ACTIONS AND USER COMMANDS
 288 | 
 289 | tabbedex supports actions which can be bound to keystrokes using
 290 | B<URxvt.keysym>.I<keysym> resource.  For example:
 291 | 
 292 |     URxvt.keysym.Control-t:            tabbedex:new_tab
 293 |     URxvt.keysym.Control-Tab:          tabbedex:next_tab
 294 |     URxvt.keysym.Control-Shift-Tab:    tabbedex:prev_tab
 295 |     ! Shift-Tab is often bound to ISO_Left_Tab in X keyboard
 296 |     ! layouts.  In those layouts Control-Shift-Tab won't
 297 |     ! work and Control-ISO_Left_Tab is needed instead:
 298 |     URxvt.keysym.Control-ISO_Left_Tab: tabbedex:prev_tab
 299 | 
 300 | makes I<Ctrl+T> create a new tab and I<Ctrl+Tab> and I<Ctrl+Shift+Tab> switch
 301 | between existing tabs.  Using the name of the extension as the prefix of the
 302 | keysym binding is preferred but when running an ancient urxvt (i.e. anything
 303 | prior to 9.21) an alternative B<perl:tabbedex> must be used instead.
 304 | 
 305 | Supported actions are:
 306 | 
 307 | =over
 308 | 
 309 | =item B<tabbedex:new_tab> and B<tabbedex:new_tab:>I<arguments>
 310 | 
 311 | Creates a new tab, puts it at the end of the tab list and switches to it.  In
 312 | the second form, I<arguments> temporarily override value of the B<tab-arguments>
 313 | resource.  This makes it possible to create bindings which start particular
 314 | commands, for example:
 315 | 
 316 |     URxvt.keysym.F1:    tabbedex:new_tab:-e info
 317 | 
 318 | makes it such that pressing F1 will open a new tab running B<info> command.
 319 | (Remember that I<arguments> are passed as arguments to urxvt so to run a command
 320 | B<-e> is required as in example above).
 321 | 
 322 | =item B<tabbedex:new_tab_>I<side>B<_this> and B<tabbedex:new_tab_>I<side>B<_this:>I<arguments>
 323 | 
 324 | Like B<tabbedex:new_tab> but puts the new tab before (if I<side> is B<before>)
 325 | or after (if I<side> is B<after>) the current tab on the tab list.  For example,
 326 | 
 327 |     URxvt.keysym.C-t:   tabbedex:new_tab_after_this
 328 | 
 329 | makes I<Ctrl+T> start a new tab next to the current one.
 330 | 
 331 | =item B<tabbedex:next_tab> and B<tabbedex:prev_tab>
 332 | 
 333 | Switches to the tab on the right or left of the current tab.  Wraps around when
 334 | switching right from the last tab or left from the first one.
 335 | 
 336 | =item B<tabbedex:next_tab:nowrap> and B<tabbedex:prev_tab:nowrap>
 337 | 
 338 | Switches tabs like B<tabbedex:next_tab> and B<tabbedex:prev_tab> action but does
 339 | not wrap around.  I.e. does nothing if trying to switch to the last tab's next
 340 | tab or first tab's previous tab.
 341 | 
 342 | =item B<tabbedex:move_tab_left> and B<tabbedex:move_tab_right>
 343 | 
 344 | Moves the current tab left or right.  Wraps around when moving last tab right or
 345 | first tab left.
 346 | 
 347 | =item B<tabbedex:move_tab_left:nowrap> and B<tabbedex:move_tab_right:nowrap>
 348 | 
 349 | Moves the current tab left or right like B<tabbedex:move_tab_left> and
 350 | B<tabbedex:move_tab_right> but does not wrap around.  I.e. moving first tab left
 351 | or last tab right does nothing.
 352 | 
 353 | =item B<tabbedex:goto_tab_>I<N>
 354 | 
 355 | If I<N> is a positive integer, switches to the I<N>th tab.  If I<N> is negative,
 356 | switches to the -I<N>th tab counting from the last one.
 357 | 
 358 | =item B<tabbedex:kill_tab>
 359 | 
 360 | Kills/destroys current tab.
 361 | 
 362 | =item B<tabbedex:rename_tab>
 363 | 
 364 | Start renaming the tab.
 365 | 
 366 | =back
 367 | 
 368 | =head1 OSC SEQUENCES
 369 | 
 370 | tabbedex supports two OSC sequences.  They can be invoked by programs running in
 371 | the terminal by writing an OSC sequence I<ESC ] 777 ; string ST> where I<string>
 372 | is the command to execute.  For example:
 373 | 
 374 |     printf '\033]777;tabbedex;set_tab_name;%s\007' "foo"
 375 | 
 376 | =over
 377 | 
 378 | =item B<tabbedex;set_tab_name;>I<name>
 379 | 
 380 | Sets name of the current tab to I<name>.
 381 | 
 382 | =item B<tabbedex;ignore_line_activity;>I<n>
 383 | 
 384 | Prevents new text on given line affecting activity marks displayed in the tab
 385 | bar (see B<tabbar-timeouts> resource).  Positive values specify I<n>th row from
 386 | the top, negative specify -I<n>th row from the bottom and zero disables the
 387 | filtering (thus making all updates affect activity marks).
 388 | 
 389 | This is useful if an application has a periodically-updating status line whose
 390 | refresh does not indicate activity in the tab.  For example, L<screen(1)> can
 391 | display current time in its hardstatus.  To prevent updates to the clock
 392 | registering as activity in the screen window, tabbedex can be instructed to
 393 | ignore the bottom row of the display:
 394 | 
 395 |     printf '\033]777;tabbedex;ignore_line_activity;%d\007' -1
 396 | 
 397 | To make this automatic a custom script for starting L<screen(1)> could be used:
 398 | 
 399 |     #!/bin/sh
 400 |     ignore_line_activity() {
 401 |         printf '\033]777;tabbedex;ignore_line_activity;%d\007' "$1"
 402 |     }
 403 |     ignore_line_activity -1
 404 |     screen "$@"
 405 |     ignore_line_activity 0
 406 | 
 407 | Note that if text wraps multiple lines, only the topmost row counts as changed.
 408 | 
 409 | =back
 410 | 
 411 | =head1 SEE ALSO
 412 | 
 413 | L<urxvt(1)>, L<urxvt-tabbed(1)>, L<tabbedex-command-runner(1)> and
 414 | L<tabbedex-pgid-cd(1)>
 415 | 
 416 | =head1 COPYRIGHT
 417 | 
 418 | Copyright 2006-2020 tabbed and tabbedex authors
 419 | 
 420 | This program is free software: you can redistribute it and/or modify it under
 421 | the terms of the GNU General Public License as published by the Free Software
 422 | Foundation, either version 3 of the License, or (at your option) any later
 423 | version.
 424 | 
 425 | This program is distributed in the hope that it will be useful, but WITHOUT ANY
 426 | WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
 427 | A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
 428 | 
 429 | You should have received a copy of the GNU General Public License along with
 430 | this program.  If not, see <http://www.gnu.org/licenses/>.
 431 | 
 432 | =head1 AUTHOR
 433 | 
 434 | tabbedex has been created (as a fork of L<urxvt-tabbed(1)>) and is maintained by
 435 | Michal Nazarewicz.  For list of authors see B<AUTHORS> file distributed with the
 436 | extension.  Send bug reports and comments to mina86@mina86.com or file them at
 437 | L<https://github.com/mina86/urxvt-tabbedex>.
 438 | 
 439 | =cut
 440 | 
 441 | use Scalar::Util;
 442 | use Text::ParseWords;
 443 | 
 444 | 
 445 | # An initialisation hook which is called in root/master and slave tabs.  It’s
 446 | # purpose is to determine which one the object is and call that type’s
 447 | # initialisation code.
 448 | #
 449 | # The reason we do it this way rather than directly pointing urxvt at correct
 450 | # package is that we want urxvt to think that master and slave tabs both use
 451 | # ‘tabbedex’ extension.  Previously, the code would point tabs to
 452 | # a ‘urxvt::ext::tabbedex::tab’ extension but that resulted in terminal thinking
 453 | # the extension is ‘tabbedex::tab’ (actually it was even more complicated than
 454 | # that) and actions weren’t dispatched correctly.
 455 | #
 456 | # Now, no matter if it’s root or not, from urxvt’s point of view it’s all
 457 | # ‘tebbedex’ plugin.
 458 | sub on_init {
 459 | 	my ($self) = @_;
 460 | 
 461 | 	# If we are root tab, then terminal’s 'tabbedex-root-tab' property is
 462 | 	# not set.  Otherwise it is set and it points to the root tab.
 463 | 	my $root = delete $self->{term}{'tabbedex-root-tab'};
 464 | 	my $type = 'root';
 465 | 	if (defined $root) {
 466 | 		$type = 'tab';
 467 | 		$self->{root} = $root;
 468 | 	}
 469 | 
 470 | 	# Copy ISA so things behave the same way.
 471 | 	my $pkg = Scalar::Util::blessed($self);
 472 | 	@{"urxvt::ext::tabbedex::$type\::ISA"} = @{"$pkg\::ISA"};
 473 | 
 474 | 	# Change type of the object so methods in proper package are used.
 475 | 	bless $self, "urxvt::ext::tabbedex::$type";
 476 | 
 477 | 	# And continue initialisation.
 478 | 	my $supports_action = enable_action_hooks($self, !defined $root);
 479 | 	$self->enable_hooks;
 480 | 	$self->init;
 481 | 	if ($root->{register_keysyms}) {
 482 | 		register_keysyms($self, $supports_action);
 483 | 	}
 484 | 
 485 | 	()
 486 | }
 487 | 
 488 | sub register_keysyms {
 489 | 	my ($self, $supports_action) = @_;
 490 | 	my $prefix = ($supports_action && $self->{_name}) || 'perl:tabbedex';
 491 | 	$self->parse_keysym('Shift-Left', $prefix . ':prev_tab');
 492 | 	$self->parse_keysym('Shift-Right', $prefix . ':next_tab');
 493 | 	$self->parse_keysym('Shift-Down', $prefix . ':new_tab');
 494 | 	$self->parse_keysym('Shift-Up', $prefix . ':rename_tab');
 495 | 	$self->parse_keysym('Control-Left', $prefix . ':move_tab_left');
 496 | 	$self->parse_keysym('Control-Right', $prefix . ':move_tab_right');
 497 | 	for my $num (1..12) {
 498 | 		$self->parse_keysym('Meta-F' . $num,
 499 | 				    $prefix . ':goto_tab_' . $num);
 500 | 	}
 501 | }
 502 | 
 503 | # Install handlers for ‘action’ and ‘user_command’ hooks.  This subroutine means
 504 | # that root and tab packages should not touch those hooks themselves.  This is
 505 | # here mostly because ancient urxvt errors out when trying to define ‘action’
 506 | # hook.  As I didn’t want to duplicate handling of that, I moved it here where
 507 | # both packages are handled.  And since ‘user_command’ is closely related, why
 508 | # not handle it here as well?  A µoptimisation is that whatever way an action
 509 | # reaches the plugin, there’s just one hop till ‘tab_action’ is called.
 510 | sub enable_action_hooks {
 511 | 	my ($self, $isroot) = @_;
 512 | 	$self->enable(user_command => $isroot ? sub {
 513 | 		if ($_[1] =~ s/^tabbedex://) {
 514 | 			splice @_, 1, 0, $_[0]{cur};
 515 | 			goto \&urxvt::ext::tabbedex::root::tab_action;
 516 | 		}
 517 | 	} : sub {
 518 | 		if ($_[1] =~ s/^tabbedex://) {
 519 | 			unshift @_, $_[0]{root};
 520 | 			goto \&urxvt::ext::tabbedex::root::tab_action;
 521 | 		}
 522 | 	});
 523 | 	# Guard against ancient urxvts which do not support ‘action’ hook.  We
 524 | 	# probably shouldn’t bother, but oh well…
 525 | 	eval {
 526 | 		$self->enable(action => $isroot ? sub {
 527 | 			splice @_, 1, 0, $_[0]{cur};
 528 | 			goto \&urxvt::ext::tabbedex::root::tab_action;
 529 | 		} : sub {
 530 | 			unshift @_, $_[0]{root};
 531 | 			goto \&urxvt::ext::tabbedex::root::tab_action;
 532 | 		});
 533 | 		1
 534 | 	} // 0
 535 | }
 536 | 
 537 | 
 538 | package urxvt::ext::tabbedex::root;
 539 | 
 540 | use Encode qw(decode);
 541 | 
 542 | {
 543 | 	my %hooks;
 544 | 
 545 | 	sub _on($&) {
 546 | 		my ($hook, $sub) = @_;
 547 | 		$hooks{$hook} = $sub
 548 | 	}
 549 | 
 550 | 	sub enable_hooks {
 551 | 		my ($root) = @_;
 552 | 		$root->enable(%hooks);
 553 | 	}
 554 | }
 555 | 
 556 | 
 557 | sub warn {
 558 | 	my $root = shift;
 559 | 	urxvt::warn(join '', $root->{_name} // 'tabbedex', ': ', @_, "\n");
 560 | }
 561 | 
 562 | 
 563 | sub tab_activity_marks {
 564 | 	my ($root, $tab, $now) = @_;
 565 | 	if (!defined($tab->{last_activity})) {
 566 | 		return (' ', ' ');
 567 | 	}
 568 | 	my $diff = $now - $tab->{last_activity};
 569 | 	my $prev;
 570 | 	for my $spec (@{ $root->{timeouts} }) {
 571 | 		my ($time, $left, $right) = @$spec;
 572 | 		if ($diff >= $time) {
 573 | 			my $next = defined $prev ? $prev - $diff : undef;
 574 | 			return ($left, $right, $next);
 575 | 		}
 576 | 		$prev = $time;
 577 | 	}
 578 | 	('!', '!')  # we should never be here
 579 | }
 580 | 
 581 | 
 582 | # Returns a ($first_idx, $last_idx) list indicating index of first and last
 583 | # (inclusive) tab to be shown in the tabbar.
 584 | sub _tabbar_range {
 585 | 	my ($root, $ncol, $new_button, $names, $first_idx) = @_;
 586 | 	my $last_idx = $first_idx;
 587 | 
 588 | 	my $max = int(($ncol - 1) / 3) - 3;
 589 | 	$max = $max < 2 ? 1 : $max;
 590 | 	my $width = length $names->[$first_idx];
 591 | 	$ncol -= (($width < $max ? $width : $max) + 2 +  # name and marks
 592 | 	          ($first_idx > 0 && !$new_button) +  # left arrow
 593 | 	          ($last_idx < $#$names));  # right arrow
 594 | 
 595 | 	my $try_add = sub {
 596 | 		my $idx = shift;
 597 | 		if ($idx >= 0 && $idx <= $#$names) {
 598 | 			my $length = length $names->[$idx];
 599 | 			my $n = $ncol - (($length < $max ? $length : $max) + 2);
 600 | 			$n -= ($idx > 0) && ($idx < $#$names);
 601 | 			if ($n > 0) {
 602 | 				$ncol = $n;
 603 | 				return 1;
 604 | 			}
 605 | 		}
 606 | 		0
 607 | 	};
 608 | 
 609 | 	if ($try_add->($last_idx + 1)) {
 610 | 		++$last_idx;
 611 | 	}
 612 | 	while ($try_add->($first_idx - 1)) {
 613 | 		--$first_idx;
 614 | 	}
 615 | 	while ($try_add->($last_idx + 1)) {
 616 | 		++$last_idx;
 617 | 	}
 618 | 
 619 | 	($first_idx, $last_idx)
 620 | }
 621 | 
 622 | # Truncates names of the tabs so that all tabs visible in the tabbar (specified
 623 | # by the [$first_idx..$last_idx] range) can all fit.  Tries to keep as much of
 624 | # the names of all tabs as possible.
 625 | sub _tabbar_truncate_names {
 626 | 	my ($root, $ncol, $new_button, $names, $first_idx, $last_idx) = @_;
 627 | 
 628 | 	$ncol -= (3 * ($last_idx - $first_idx) + 2 +  # pipes and marks
 629 | 	          ($first_idx > 0 && !$new_button) +  # left arrow
 630 | 	          ($last_idx < $#$names));  # right arrow
 631 | 	my $max = int($ncol / ($last_idx - $first_idx + 1));
 632 | 	my $cur_max = $max;
 633 | 
 634 | 	if ($max > 0 && $first_idx < $last_idx) {
 635 | 		my @lengths = sort { $b <=> $a }
 636 | 		              grep { $_ <= $max ? (($ncol -= $_), 0) : 1 }
 637 | 		              map  length, @{ $names }[$first_idx .. $last_idx];
 638 | 		while (@lengths &&
 639 | 		       $lengths[$#lengths] <= ($max = int($ncol / @lengths))) {
 640 | 			do {
 641 | 				$ncol -= pop @lengths;
 642 | 			} while (@lengths && $lengths[$#lengths] <= $max);
 643 | 		}
 644 | 		$cur_max = $max + $ncol - $max * @lengths;
 645 | 	}
 646 | 
 647 | 	for my $idx ($first_idx .. $last_idx) {
 648 | 		my $width = $root->{cur} == $root->{tabs}[$idx]
 649 | 			? $cur_max : $max;
 650 | 		if (length(my $name = $names->[$idx]) <= $width) {
 651 | 			# nop
 652 | 		} elsif ($width >= 2) {
 653 | 			$names->[$idx] = '…' . substr $name, -($width - 1);
 654 | 		} elsif ($width >= 1) {
 655 | 			$names->[$idx] = substr $name, -1;
 656 | 		} else {  # extremely narrow window
 657 | 			$names->[$idx] = '';
 658 | 		}
 659 | 	}
 660 | }
 661 | 
 662 | # Determines layout of the tabbar.  Returns a ($new_button, $first_idx,
 663 | # $last_idx, \@names) list where:
 664 | # - $new_button specifies text of the NEW button or is an empty string,
 665 | # - $first_idx is an index of the first visible tab,
 666 | # - $last_idx is an index of the last visible tab and
 667 | # - \@names is an array of (possibly truncated) names of the tabs.
 668 | sub _tabbar_layout {
 669 | 	my ($root) = @_;
 670 | 
 671 | 	my $ncol = $root->ncol;
 672 | 	my $new_button = '';
 673 | 	if ($root->{new_button}) {
 674 | 		if ($ncol >= 60) {
 675 | 			$new_button = '[NEW]';
 676 | 		} elsif ($ncol >= 30) {
 677 | 			$new_button = 'NEW';
 678 | 		} elsif ($ncol >= 13) {
 679 | 			$new_button = '+';
 680 | 		}
 681 | 	}
 682 | 	$ncol -= !!$new_button + length $new_button;
 683 | 
 684 | 	my $max = int(($ncol - 1) / 3) - 3;
 685 | 	$max = $max < 2 ? 1 : $max;
 686 | 	my ($total_truncated, $total_full, $cur_idx) = (-1, -1);
 687 | 	my @names = map {
 688 | 		my $tab = $root->{tabs}[$_];
 689 | 		if ($tab == $root->{cur}) {
 690 | 			$cur_idx = $_;
 691 | 		}
 692 | 		my $name      = $tab->{name} || '' . ($_ + 1);
 693 | 		my $length    = length $name;
 694 | 		$total_full      += 3 + $length;
 695 | 		$total_truncated += 3 + ($length < $max ? $length : $max);
 696 | 		$name
 697 | 	} 0..$#{ $root->{tabs} };
 698 | 
 699 | 	my ($first_idx, $last_idx) = (0, $#names);
 700 | 	if ($ncol < $total_full) {
 701 | 		if ($ncol < $total_truncated) {
 702 | 			($first_idx, $last_idx) = $root->_tabbar_range(
 703 | 				$ncol, !!$new_button, \@names, $cur_idx);
 704 | 		}
 705 | 		$root->_tabbar_truncate_names(
 706 | 			$ncol, !!$new_button, \@names, $first_idx, $last_idx);
 707 | 	}
 708 | 
 709 | 	($new_button, $first_idx, $last_idx, \@names)
 710 | }
 711 | 
 712 | sub min {
 713 | 	@_ = grep { defined && $_ > 0 } @_;
 714 | 	my $best = shift;
 715 | 	for my $n (@_) {
 716 | 		if ($n < $best) {
 717 | 			$best = $n;
 718 | 		}
 719 | 	}
 720 | 	$best;
 721 | }
 722 | 
 723 | sub refresh {
 724 | 	my ($root, $now) = @_;
 725 | 
 726 | 	my $visible = (!$root->{autohide} ||
 727 | 	               @{ $root->{tabs} } > 1 ||
 728 | 	               $root->{cur}->is_being_renamed);
 729 | 	if ($visible != !!$root->{tabheight}) {
 730 | 		$root->{tabheight} = $visible * $root->{maxtabheight};
 731 | 		$root->configure;
 732 | 		$root->copy_properties;
 733 | 	}
 734 | 	if (!$visible) {
 735 | 		return;
 736 | 	}
 737 | 
 738 | 	my ($new_button, $first_idx, $last_idx, $names) = $root->_tabbar_layout;
 739 | 	my $bar = new urxvt::ext::tabbedex::tabbar($root);
 740 | 
 741 | 	if ($new_button) {
 742 | 		$bar->add_button($new_button, 1, -1);
 743 | 	}
 744 | 	if ($first_idx) {
 745 | 		$bar->add_arrow(-1);
 746 | 	}
 747 | 
 748 | 	if (!defined $now) {
 749 | 		$now = urxvt::NOW;
 750 | 	}
 751 | 	my $min_delay;
 752 | 	for my $idx ($first_idx .. $last_idx) {
 753 | 		my $tab = $root->{tabs}[$idx];
 754 | 		my ($left, $right, $delay) =
 755 | 			$root->tab_activity_marks($tab, $now);
 756 | 		$bar->add_button(
 757 | 			$left . $names->[$idx] . $right,
 758 | 			($tab == $root->{cur}) + 2 * ($now < $tab->{bell_ends}),
 759 | 			$idx);
 760 | 		if ($tab->is_being_renamed) {
 761 | 			$bar->put_cursor(-2);
 762 | 		}
 763 | 		$min_delay = min $min_delay, $delay, $tab->{bell_ends} - $now;
 764 | 	}
 765 | 
 766 | 	if ($last_idx < $#$names) {
 767 | 		$bar->add_arrow(1);
 768 | 	}
 769 | 
 770 | 	if ($root->{tab_title} && $bar->space_left > 0) {
 771 | 		my @str = $root->XGetWindowProperty(
 772 | 			$root->parent, $root->{tab_title});
 773 | 		if (@str && $str[2]) {
 774 | 			my $str = decode('utf8', $str[2]);
 775 | 			$bar->add_title($root->special_encode($str));
 776 | 		}
 777 | 	}
 778 | 
 779 | 	$bar->apply;
 780 | 	$root->want_refresh;
 781 | 	if (defined $min_delay) {
 782 | 		$root->{timer}->start($now + $min_delay);
 783 | 	}
 784 | }
 785 | 
 786 | sub tab_term_init {
 787 | 	my ($root, $term, $index) = @_;
 788 | 	$term->{'tabbedex-root-tab'} = $root;
 789 | 	$term->{'tabbedex-tab-index'} = $index;
 790 | 
 791 | 	for (0 .. urxvt::NUM_RESOURCES - 1) {
 792 | 		if (defined(my $value = $root->{resource}[$_])) {
 793 | 			$term->resource("+$_" => $value);
 794 | 		}
 795 | 	}
 796 | 
 797 | 	foreach my $key (values %urxvt::OPTION) {
 798 | 		my $val = exists $root->{option}{$key}
 799 | 		  ? $root->{option}{$key} : $root->option($key);
 800 | 		$term->option($key, $val);
 801 | 	}
 802 | 
 803 | 	if (defined(my $blacklist = $root->{perl_ext_blacklist})) {
 804 | 		$term->resource(perl_ext_2 =>
 805 | 			$term->resource('perl_ext_2') . $blacklist);
 806 | 	}
 807 | }
 808 | 
 809 | sub quote_words {
 810 | 	join ' ', map {
 811 | 		my $v = $_;
 812 | 		$v =~ s/'/'\\''/g;
 813 | 		"'$v'";
 814 | 	} @_
 815 | }
 816 | 
 817 | sub args_percent_substitution {
 818 | 	my ($root, $ch, $tab) = @_;
 819 | 	if ($ch eq '%') {
 820 | 		$ch
 821 | 	} elsif ($ch eq 'e') {
 822 | 		quote_words @{ $root->{argv} }
 823 | 	} elsif ($ch eq 'E') {
 824 | 		quote_words @{ $root->{argv} }
 825 | 			? @{ $root->{argv} }[1..$#{ $root->{argv} }]
 826 | 			: ($ENV{SHELL} || '/bin/sh')
 827 | 	} elsif ($ch eq 'p') {
 828 | 		$tab ? $tab->foreground_pgid : -1
 829 | 	} elsif ($ch eq 'n') {
 830 | 		$root->{total_tabs_open} // 0
 831 | 	} elsif ($ch eq '~') {
 832 | 		exists $ENV{'HOME'} ? quote_words $ENV{'HOME'} : '/'
 833 | 	} else {
 834 | 		$root->warn('unrecognised substitution in ‘tab-arguments’: ',
 835 | 			    '‘%', $ch, '’; will substitute with empty string');
 836 | 		''
 837 | 	}
 838 | }
 839 | 
 840 | sub new_tab {
 841 | 	my ($root, $tab, $args, $index) = @_;
 842 | 
 843 | 	if (!defined $args) {
 844 | 		$args = $root->{tab_arguments};
 845 | 	}
 846 | 	$args =~ s/^\s+|\s+$//g;
 847 | 	if ($args eq '' || $args eq '%e') {
 848 | 		$args = $root->{argv};
 849 | 	} else {
 850 | 		$args =~ s/%(.)/
 851 | 			$root->args_percent_substitution($1, $tab)
 852 | 		/ge;
 853 | 		if (defined Text::ParseWords::shellwords($args)) {
 854 | 			$args = [Text::ParseWords::shellwords($args)];
 855 | 		} else {
 856 | 			$root->warn('error parsing ‘tab-arguments’ value: ‘',
 857 | 				    $args, '’; ignoring');
 858 | 			$args = $root->{argv};
 859 | 		}
 860 | 	}
 861 | 
 862 | 	push @urxvt::TERM_INIT, sub { $root->tab_term_init($_[0], $index) };
 863 | 	push @urxvt::TERM_EXT, urxvt::ext::tabbedex::;
 864 | 	new urxvt::term
 865 | 		$root->env, $urxvt::RXVTNAME,
 866 | 		-embed => $root->parent,
 867 | 		@{ $args }
 868 | }
 869 | 
 870 | 
 871 | sub configure {
 872 |    my ($root) = @_;
 873 | 
 874 |    my $tab = $root->{cur};
 875 | 
 876 |    # this is an extremely dirty way to force a configurenotify, but who cares
 877 |    $tab->XMoveResizeWindow (
 878 |       $tab->parent,
 879 |       0, $root->{tabheight} + 1,
 880 |       $root->width, $root->height - $root->{tabheight}
 881 |    );
 882 |    $tab->XMoveResizeWindow (
 883 |       $tab->parent,
 884 |       0, $root->{tabheight},
 885 |       $root->width, $root->height - $root->{tabheight}
 886 |    );
 887 | }
 888 | 
 889 | 
 890 | sub copy_properties {
 891 |    my ($root) = @_;
 892 |    my $tab = $root->{cur};
 893 | 
 894 |    my $wm_normal_hints = $root->XInternAtom ("WM_NORMAL_HINTS");
 895 | 
 896 |    my $current = delete $root->{current_properties};
 897 | 
 898 |    # pass 1: copy over properties different or nonexisting
 899 |    for my $atom ($tab->XListProperties ($tab->parent)) {
 900 |       my ($type, $format, $items) = $root->XGetWindowProperty ($tab->parent,
 901 |                                                                $atom);
 902 | 
 903 |       # fix up size hints
 904 |       if ($atom == $wm_normal_hints && $root->{tabheight}) {
 905 |          # typedef struct {
 906 |          #         long flags;                  /* 0 */
 907 |          #         int x, y;                    /* 1, 2 */ /* Obsolete */
 908 |          #         int width, height;           /* 3, 4 */ /* Obsolete */
 909 |          #         int min_width, min_height;   /* 5, 6 */
 910 |          #         int max_width, max_height;   /* 7, 8 */
 911 |          #         int width_inc, height_inc;   /* 9, 10 */
 912 |          #         struct {
 913 |          #                 int x; /* numerator */
 914 |          #                 int y; /* denominator */
 915 |          #         } min_aspect, max_aspect;    /* 11, 12, 13, 14 */
 916 |          #         int base_width, base_height; /* 15, 16 */
 917 |          #         int win_gravity;             /* 17 */
 918 |          # } XSizeHints;
 919 |          #
 920 |          # (Don’t ask me how this works with long and int types.  Somehow it
 921 |          # does – mina86).
 922 |          my (@hints) = unpack "l!*", $items;
 923 |          $hints[$_] += $root->{tabheight} for (4, 6, 16);
 924 |          $items = pack "l!*", @hints;
 925 |       }
 926 | 
 927 |       my $cur = delete $current->{$atom};
 928 | 
 929 |       # update if changed, we assume empty items and zero type and
 930 |       # format will not happen
 931 |       $root->XChangeProperty ($root->parent, $atom, $type, $format, $items)
 932 |          if $cur->[0] != $type or $cur->[1] != $format or $cur->[2] ne $items;
 933 | 
 934 |       $root->{current_properties}{$atom} = [$type, $format, $items];
 935 |    }
 936 | 
 937 |    # pass 2, delete all extraneous properties
 938 |    $root->XDeleteProperty ($root->parent, $_) for keys %$current;
 939 | }
 940 | 
 941 | 
 942 | sub make_current {
 943 | 	my ($root, $tab, $bell_ends) = @_;
 944 | 
 945 | 	if (!ref $tab) {
 946 | 		$tab = $root->{tabs}[$tab];
 947 | 	}
 948 | 
 949 | 	my $cur = $root->{cur};
 950 | 	if ($cur == $tab) {
 951 | 		return;
 952 | 	}
 953 | 
 954 | 	if ($cur) {
 955 | 		if ($cur->is_being_renamed) {
 956 | 			return;
 957 | 		}
 958 | 		$cur->enable_activity_hook(1);
 959 | 		delete $cur->{last_activity};
 960 | 		$cur->{bell_ends} = 0;
 961 | 		$cur->XUnmapWindow ($cur->parent) if $cur->mapped;
 962 | 		$cur->focus_out;
 963 | 	}
 964 | 
 965 | 	$root->{cur} = $tab;
 966 | 	# Disable the add_lines hook so that we don’t waste time processing that
 967 | 	# hook for the current tab.  We’re not interested in that hook on the
 968 | 	# current tab.
 969 | 	$tab->enable_activity_hook(0);
 970 | 
 971 | 	$root->configure;
 972 | 	$root->copy_properties;
 973 | 
 974 | 	$tab->focus_out; # just in case, should be a nop
 975 | 	$tab->focus_in if $root->focus;
 976 | 
 977 | 	$tab->XMapWindow ($tab->parent);
 978 | 	delete $tab->{last_activity};
 979 | 	$tab->{bell_ends} = $bell_ends // 0;
 980 | 
 981 | 	$root->refresh;
 982 | }
 983 | 
 984 | 
 985 | _on focus_in => sub {
 986 |    my ($root, $event) = @_;
 987 |    $root->{cur}->focus_in;
 988 |    ();
 989 | };
 990 | 
 991 | _on focus_out => sub {
 992 |    my ($root, $event) = @_;
 993 |    $root->{cur}->focus_out;
 994 |    ();
 995 | };
 996 | 
 997 | _on tt_write => sub {
 998 |     my ($root, $octets) = @_;
 999 |     $root->{cur}->tt_write ($octets);
1000 |     1
1001 | };
1002 | 
1003 | _on key_press => sub {
1004 | 	my ($root, $event) = @_;
1005 | 
1006 | 	# This check fixes dead keys when pointer is not above the terminal
1007 | 	# window (see https://github.com/mina86/urxvt-tabbedex/issues/26).  The
1008 | 	# fix only works if ibus is used; if ibus is not used, the condition is
1009 | 	# always true.
1010 | 	#
1011 | 	# When a dead key is combined with a letter a key_press event with zero
1012 | 	# state, keycode and time is generated.  If we forward it to the tab and
1013 | 	# report back to urxvt that the event was handled, nothing happens and
1014 | 	# the character is not inserted.
1015 | 	#
1016 | 	# On the other hand, if we ignore such events everything works as
1017 | 	# expected.  To be honest, I don’t completely understand what is
1018 | 	# happening here, but it fixes stuff. — mina86
1019 | 	if ($event->{state} || $event->{keycode} || $event->{time}) {
1020 | 		$root->key_event('key_press', $event);
1021 | 	}
1022 | };
1023 | 
1024 | _on key_release => sub {
1025 |    my ($root, $event) = @_;
1026 |    $root->key_event('key_release', $event);
1027 | };
1028 | 
1029 | sub key_event {
1030 | 	my ($root, $type, $event) = @_;
1031 | 
1032 | 	my $tab = $root->{cur};
1033 | 	$tab->$type($event->{state}, $event->{keycode}, $event->{time});
1034 | 
1035 | 	# refresh_check is available since rxvt-unicode 9.22.  For some reason
1036 | 	# $tab->can('refresh_check') doesn’t work which is why eval block is
1037 | 	# used to silence warnings.
1038 | 	eval {
1039 | 		$tab->refresh_check;
1040 | 	};
1041 | 	if ($@ && $@ !~ /refresh_check/) {
1042 | 		# If there was a warning unrelated to refresh_check propagate
1043 | 		# it.  Otherwise ignore.
1044 | 		warn "$@";
1045 | 	}
1046 | 	1;
1047 | }
1048 | 
1049 | _on button_release => sub {
1050 | 	my ($root, $event) = @_;
1051 | 
1052 | 	if ($root->{cur}->is_being_renamed || $event->{row} != 0 ||
1053 | 	    $event->{button} != 1) {
1054 | 		return ();
1055 | 	}
1056 | 
1057 | 	my $col = $event->{col};
1058 | 	for my $button (@{ $root->{tabofs} }) {
1059 | 		if ($col < $button->[0]) {
1060 | 			last;
1061 | 		} elsif ($col >= $button->[1]) {
1062 | 			# nop
1063 | 		} elsif ($button->[2] == -1) {
1064 | 			$root->new_tab($root->{cur});
1065 | 		} else {
1066 | 			$root->make_current($button->[2]);
1067 | 		}
1068 | 	}
1069 | 	1;
1070 | };
1071 | 
1072 | 
1073 | {
1074 | 
1075 | sub parse_single_timeout {
1076 | 	my ($root, $t, $l, $r) = @_;
1077 | 	$l = $root->special_encode($l);
1078 | 	$r = defined $r ? $root->special_encode($r) : $l;
1079 | 	[$t + 0, $l, $r]
1080 | }
1081 | 
1082 | sub parse_timeouts {
1083 | 	my ($root, $timeouts) = @_;
1084 | 	my $char = eval { qr/\X/ } // qr/./;
1085 | 	my @timeouts;
1086 | 	while ($timeouts =~ /\G(\d*\.\d+|\d+):($char)($char)?(?::|$)/g) {
1087 | 		push @timeouts, $root->parse_single_timeout($1, $2, $3);
1088 | 	}
1089 | 	@timeouts = sort { $b->[0] <=> $a->[0] } @timeouts;
1090 | 	if (!@timeouts || $timeouts[$#timeouts][0] > 0) {
1091 | 		push @timeouts, [0, '*', '*'];
1092 | 	}
1093 | 	\@timeouts
1094 | }
1095 | 
1096 | }
1097 | 
1098 | sub init {
1099 |    my ($root) = @_;
1100 | 
1101 |    $root->{resource} = [map $root->resource ("+$_"),
1102 |                             0 .. urxvt::NUM_RESOURCES - 1];
1103 | 
1104 |    $root->{hpadding} = $root->{vpadding} = 2 * $root->int_bwidth;
1105 |    $root->resource (int_bwidth => 0);
1106 |    $root->resource (pty_fd => -1);
1107 | 
1108 |    if (defined(my $key = $urxvt::OPTION{scrollBar})) {
1109 |       if ($root->{option}{$key} = $root->option($key, 0)) {
1110 |          $root->{hpadding} += $root->get_scrollbar_thickness;
1111 |       }
1112 |    }
1113 |    # Disable ‘intensityStyles’ so that bold, blink etc. specified in tabbar
1114 |    # styles don’t affect the colours.
1115 |    if (defined(my $key = $urxvt::OPTION{intensityStyles})) {
1116 |       $root->{option}{$key} = $root->option($key, 0);
1117 |    }
1118 | 
1119 |    my $rs = new urxvt::ext::tabbedex::rs_reader($root);
1120 | 
1121 |    $root->{timeouts} = $root->parse_timeouts($rs->text(
1122 |       'tabbar-timeouts', '0:▁:3:▂:6:▃:9:▄:12:▅:15:▆:18:▇:21:█'));
1123 |    $root->{bell_timeout}     = $rs->text('bell-timeout', 1) + 0;
1124 |    $root->{new_button}       = $rs->bool('new-button', 0);
1125 |    $root->{tab_title}        = $rs->bool('title', 1);
1126 |    $root->{autohide}         = $rs->bool('autohide', 1);
1127 |    $root->{register_keysyms} = !$rs->bool('no-tabbedex-keys', 0);
1128 |    $root->{reopen_on_close}  = $rs->bool('reopen-on-close', 0);
1129 |    $root->{tab_arguments}    = $rs->text('tab-arguments', '');
1130 | 
1131 |    if (my $blacklist = $rs->text('perl-ext-blacklist')) {
1132 |        $blacklist =~ s/,/,-/;
1133 |        $root->{perl_ext_blacklist} = ',-' . $blacklist;
1134 |    }
1135 | 
1136 |    my ($colours, $cmd) = $rs->colours(['            3', '0', 'tabbar'],
1137 |                                       ['bold        0', '1', 'tab'],
1138 |                                       ['     italic 0', '3', 'bell'],
1139 |                                       ['bold italic 5', '4', 'bell-tab'],
1140 |                                       ['     italic 2', '0', 'title']);
1141 |    $root->{init_cmd} = $cmd . "\033[?25l";
1142 |    $root->{rs_colours} = $colours;
1143 | 
1144 |    $root->{timer} = urxvt::timer->new->cb ( sub { $root->refresh; } );
1145 | }
1146 | 
1147 | # Figures out the thickness of scroll bar.  This is based on scrollBar_t::setup
1148 | # code and written with the assumption that urxvt was compiled with all styles
1149 | # enabled.
1150 | sub get_scrollbar_thickness {
1151 | 	my ($root) = @_;
1152 | 
1153 | 	my $style = $root->resource('scrollstyle') || '';
1154 | 	my $width;
1155 | 
1156 | 	if ($style =~ /^next/i) {
1157 | 		$style = 'next';
1158 | 		$width = 19;  # SB_WIDTH_NEXT
1159 | 	} elsif ($style =~ /^xterm/i) {
1160 | 		$width = 15;  # SB_STYLE_XTERM
1161 | 	} elsif ($style =~ /^plain/i) {
1162 | 		$width = 7;  # SB_WIDTH_PLAIN
1163 | 	} else {
1164 | 		$style = 'rxvt';
1165 | 		$width = 10;  # SB_WIDTH_RXVT
1166 | 	}
1167 | 
1168 | 	# Relevant excerpt from the C++ code:
1169 | 	#
1170 | 	#  thickness = term->rs[Rs_scrollBar_thickness];
1171 | 	#  if (style != SB_STYLE_NEXT)	/* dishonour request - for now */
1172 | 	#    if (thickness && (i = atoi (thickness)) >= SB_WIDTH_MINIMUM)
1173 | 	#      width = min (i, SB_WIDTH_MAXIMUM);
1174 | 	if ($style ne 'next') {
1175 | 		my $thickness = $root->resource('scrollBar_thickness');
1176 | 		if ($thickness && $thickness >= 5) {
1177 | 			# SB_WIDTH_MAXIMUM == 100
1178 | 			$width = $thickness < 100 ? $thickness : 100;
1179 | 		}
1180 | 	}
1181 | 
1182 | 	my $key = $urxvt::OPTION{scrollBar_floating};
1183 | 	if ($style eq 'rxvt' && defined $key && !$root->option($key)) {
1184 | 		$width += 2;
1185 | 	}
1186 | 
1187 | 	$width
1188 | }
1189 | 
1190 | _on start => sub {
1191 |    my ($root) = @_;
1192 | 
1193 |    $root->{maxtabheight} =
1194 |       $root->int_bwidth + $root->fheight + $root->lineSpace;
1195 |    $root->{tabheight} = $root->{autohide} ? 0 : $root->{maxtabheight};
1196 | 
1197 |    # Root window is always created without scroll bar or border which means that
1198 |    # it’s sized without any space allocated for those elements.  However, tabs
1199 |    # may have those options enabled which makes means that they end up with less
1200 |    # usable space than user requested. To account for that, enlarge the root to
1201 |    # make space for the border and scroll bar.
1202 |    my $hpadding = delete $root->{hpadding};
1203 |    my $vpadding = delete $root->{vpadding};
1204 |    if ($hpadding || $vpadding || $root->{tabheight}) {
1205 |       my $w = $root->width + $hpadding;
1206 |       my $h = $root->height + $vpadding + $root->{tabheight};
1207 |       $root->XMoveResizeWindow($root->parent, 0, 0, $w, $h);
1208 |    }
1209 | 
1210 |    $root->cmd_parse(delete $root->{init_cmd});
1211 | 
1212 |    my @argv = $root->argv;
1213 |    do {
1214 |       shift @argv;
1215 |    } while @argv && $argv[0] ne "-e";
1216 |    $root->{argv} = \@argv;
1217 | 
1218 |    if ($root->{tab_title}) {
1219 |       $root->{tab_title} = $root->XInternAtom("_NET_WM_NAME", 1);
1220 |    }
1221 | 
1222 |    $root->new_tab;
1223 | 
1224 |    ();
1225 | };
1226 | 
1227 | 
1228 | _on configure_notify => sub {
1229 |    my ($root, $event) = @_;
1230 |    $root->configure;
1231 |    $root->refresh;
1232 |    ();
1233 | };
1234 | 
1235 | 
1236 | _on wm_delete_window => sub {
1237 | 	my ($root) = @_;
1238 | 	# Disable reopen-on-close so we respect delete window request.  If
1239 | 	# reopen-on-close was to remain true, as soon as last tab was closed
1240 | 	# a new would be created and we would never exit.
1241 | 	$root->{reopen_on_close} = 0;
1242 | 	$_->destroy for @{ $root->{tabs} };
1243 | 	1;
1244 | };
1245 | 
1246 | 
1247 | sub tab_start {
1248 | 	my ($root, $tab) = @_;
1249 | 	my $index = delete $tab->{term}{'tabbedex-tab-index'};
1250 | 	$tab->XChangeInput ($tab->parent, urxvt::PropertyChangeMask);
1251 | 	if (defined $index && $index < @{ $root->{tabs} }) {
1252 | 		splice @{ $root->{tabs} }, $index, 0, $tab;
1253 | 	} else {
1254 | 		push @{ $root->{tabs} }, $tab;
1255 | 	}
1256 | 	++$root->{total_tabs_open};
1257 | 	$root->make_current($tab);
1258 | 	();
1259 | }
1260 | 
1261 | 
1262 | sub tab_destroy {
1263 | 	my ($root, $tab) = @_;
1264 | 
1265 | 	my $idx = $tab->index;
1266 | 	splice @{ $root->{tabs} }, $idx, 1;
1267 | 
1268 | 	if (!@{ $root->{tabs} }) {
1269 | 		if (!$root->{reopen_on_close}) {
1270 | 			# Delay destruction a tiny bit.
1271 | 			$root->{destroy} = urxvt::iw->new->start->cb(sub {
1272 | 				$root->{timer}->stop;
1273 | 				$root->destroy;
1274 | 			});
1275 | 			return ();
1276 | 		}
1277 | 		$root->new_tab;
1278 | 	}
1279 | 
1280 | 	if ($root->{cur} == $tab) {
1281 | 		delete $root->{cur};
1282 | 		$root->make_current($idx < @{ $root->{tabs} } ? $idx : -1);
1283 | 	} else {
1284 | 		$root->refresh;
1285 | 	}
1286 | 
1287 | 	();
1288 | }
1289 | 
1290 | 
1291 | sub tab_property_notify {
1292 |    my ($root, $tab, $event) = @_;
1293 | 
1294 |    $root->copy_properties
1295 |       if $event->{window} == $tab->parent;
1296 | 
1297 |    ();
1298 | }
1299 | 
1300 | 
1301 | sub tab_bell {
1302 | 	my ($root, $tab, $event) = @_;
1303 | 	my $now = urxvt::NOW;
1304 | 
1305 | 	my $key = $urxvt::OPTION{urgentOnBell};
1306 | 	if (defined($key) && $tab->option($key) && !$root->focus) {
1307 | 		$root->set_urgency(1);
1308 | 	}
1309 | 
1310 | 	if ($tab == $root->{cur}) {
1311 | 		$tab->{bell_ends} = $now + $root->{bell_timeout};
1312 | 	} elsif (defined($key = $urxvt::OPTION{mapAlert}) &&
1313 | 	         $tab->option($key)) {
1314 | 		$root->make_current($tab, $now + $root->{bell_timeout});
1315 | 		return;
1316 | 	} else {
1317 | 		$tab->{bell_ends} = ~0;
1318 | 	}
1319 | 
1320 | 	# refresh called to update rendering (if bell wasn’t active in the tab)
1321 | 	# and update timer’s timeout.
1322 | 	$root->refresh($now);
1323 | 
1324 | 	();
1325 | }
1326 | 
1327 | 
1328 | sub tab_line_update {
1329 | 	my ($root, $tab, $row) = @_;
1330 | 	my $ignore = $tab->{ignore_line_activity} // 0;
1331 | 	# 0 ≤ $row < nrow thus if $ignore is zero the condition is always true.
1332 | 	# Otherwise, the two tests handle checks for when $ignore is positive
1333 | 	# and negative respectively.
1334 | 	if ($row + 1 != $ignore && $tab->nrow + $ignore != $row) {
1335 | 		my $now = urxvt::NOW;
1336 | 		my @pre = $root->tab_activity_marks($tab, $now);
1337 | 		$tab->{last_activity} = $now;
1338 | 		my @post = $root->tab_activity_marks($tab, $now);
1339 | 		if ($pre[0] ne $post[0] || $pre[1] ne $post[1]) {
1340 | 			$root->refresh($now);
1341 | 		}
1342 | 	}
1343 | 	()
1344 | }
1345 | 
1346 | 
1347 | sub tab_action {
1348 | 	my ($root, $tab, $cmd) = @_;
1349 | 	if ($cmd =~ /^new_tab(?:_(before|after)_this)?(?::(.*))?$/) {
1350 | 		if (!$root->{cur}->is_being_renamed) {
1351 | 			my $index;
1352 | 			if (defined $1) {
1353 | 				$index = $tab->index + ($1 eq 'after');
1354 | 			}
1355 | 			$root->new_tab($tab, $2, $index);
1356 | 		}
1357 | 	} elsif ($cmd =~ /^(next|prev)_tab(:nowrap)?$/) {
1358 | 		my $index = $tab->index + ($1 eq 'next' ? 1 : -1);
1359 | 		if (!$2 || ($index >= 0 && $index < @{ $root->{tabs} })) {
1360 | 			$root->make_current($index % @{ $root->{tabs} });
1361 | 		}
1362 | 	} elsif ($cmd =~ /^move_tab_(left|right)(:nowrap)?$/) {
1363 | 		$root->move_tab($tab, $1 eq 'left' ? -1 : 1, !!$2);
1364 | 	} elsif ($cmd =~ /^goto_tab[_:](-?)(0*[1-9]\d*)$/) {
1365 | 		if ($2 <= @{ $root->{tabs} }) {
1366 | 			$root->make_current($1 eq '' ? $2 - 1 : -$2);
1367 | 		}
1368 | 	} elsif ($cmd eq 'rename_tab') {
1369 | 		if ($tab == $root->{cur} && $tab->start_rename_tab) {
1370 | 			$root->refresh;
1371 | 		}
1372 | 	} elsif ($cmd eq 'kill_tab') {
1373 | 		$tab->destroy;
1374 | 	} else {
1375 | 		$root->warn('unrecognised action: ‘', $cmd, '’; ignoring');
1376 | 	}
1377 | 	()
1378 | }
1379 | 
1380 | sub move_tab {
1381 | 	my ($root, $tab, $direction, $nowrap) = @_;
1382 | 	if (@{ $root->{tabs} } < 2) {
1383 | 		return;
1384 | 	}
1385 | 
1386 | 	my $last = $#{$root->{tabs}};
1387 | 	my $idx = $tab->index;
1388 | 
1389 | 	if ($idx == 0 && $direction == -1) {
1390 | 		if ($nowrap) {
1391 | 			return;
1392 | 		}
1393 | 		push @{$root->{tabs}}, shift @{$root->{tabs}};
1394 | 	} elsif ($idx == $last && $direction == 1) {
1395 | 		if ($nowrap) {
1396 | 			return;
1397 | 		}
1398 | 		unshift @{$root->{tabs}}, pop @{$root->{tabs}};
1399 | 	} else {
1400 | 		($root->{tabs}[$idx], $root->{tabs}[$idx + $direction]) =
1401 | 			($root->{tabs}[$idx + $direction], $root->{tabs}[$idx]);
1402 | 	}
1403 | 	$root->refresh;
1404 | }
1405 | 
1406 | 
1407 | sub tab_osc_seq_perl {
1408 | 	my ($root, $tab, $osc) = @_;
1409 | 
1410 | 	# For historical reasons, we also accept misspelled "tabbedx" prefix.
1411 | 	if ($osc =~ /^tabbede?x;set_tab_name;(.*)$/) {
1412 | 		my $name = $root->locale_decode($1);
1413 | 		if ($tab->set_name($root->special_encode($name))) {
1414 | 			$root->refresh;
1415 | 		}
1416 | 		1;
1417 | 	} elsif ($osc =~ /^tabbedex;ignore_line_activity;(-?\d+)$/) {
1418 | 		$tab->{ignore_line_activity} = $1 + 0;
1419 | 		1;
1420 | 	}
1421 | }
1422 | 
1423 | 
1424 | package urxvt::ext::tabbedex::tab;
1425 | 
1426 | use POSIX qw/tcgetpgrp/;
1427 | 
1428 | # helper extension implementing the subwindows of a tabbed terminal.
1429 | # simply proxies all interesting calls back to the tabbedex class.
1430 | 
1431 | 
1432 | {
1433 | 	my %hooks = map {
1434 | 		my $name = "urxvt::ext::tabbedex::root::tab_$_";
1435 | 		$_ => sub {
1436 | 			unshift @_, $_[0]{root};
1437 | 			goto &$name;
1438 | 		}
1439 | 	} qw(start destroy property_notify line_update bell osc_seq_perl);
1440 | 
1441 | 	sub enable_hooks {
1442 | 		my ($root) = @_;
1443 | 		$root->enable(%hooks);
1444 | 	}
1445 | 
1446 | 	sub enable_activity_hook {
1447 | 		my ($tab, $enable) = (@_, 1);
1448 | 		if ($enable) {
1449 | 			$tab->enable(line_update => $hooks{line_update});
1450 | 		} else {
1451 | 			$tab->disable('line_update');
1452 | 		}
1453 | 	}
1454 | }
1455 | 
1456 | sub init {
1457 | 	$_[0]{bell_ends} = 0;
1458 | }
1459 | 
1460 | 
1461 | sub index {
1462 | 	my ($tab) = @_;
1463 | 	my $tabs = $tab->{root}{tabs};
1464 | 	my $idx = 0;
1465 | 	++$idx while $tabs->[$idx] != $tab;
1466 | 	$idx;
1467 | }
1468 | 
1469 | 
1470 | sub foreground_pgid {
1471 | 	my $n = $_[0]->pty_fd;
1472 | 	$n < 0 || ($n = tcgetpgrp($n)) < 0 ? -1 : $n
1473 | }
1474 | 
1475 | 
1476 | sub start_rename_tab {
1477 | 	my ($tab) = @_;
1478 | 	if ($tab->is_being_renamed) {
1479 | 		return 0;
1480 | 	}
1481 | 	$tab->{old_name} = $tab->{name};
1482 | 	$tab->{name} = ' ';
1483 | 	$tab->enable('key_press', \&_rename_tab_key_press);
1484 | 	1
1485 | }
1486 | 
1487 | sub finish_rename_tab {
1488 | 	my ($tab, $accept) = @_;
1489 | 	if (!$tab->is_being_renamed) {
1490 | 		$tab->{root}->warn('finish_rename_tab called on tab which is ',
1491 | 				   'not being renamed; this is an internal ',
1492 | 				   'error, please report it');
1493 | 		return;
1494 | 	}
1495 | 	if ($accept) {
1496 | 		substr $tab->{name}, -1, 1, '';
1497 | 	} else {
1498 | 		$tab->{name} = $tab->{old_name};
1499 | 	}
1500 | 	delete $tab->{old_name};
1501 | 	$tab->disable('key_press');
1502 | }
1503 | 
1504 | sub set_name {
1505 | 	my ($tab, $name) = @_;
1506 | 	if ($tab->is_being_renamed) {
1507 | 		$tab->{old_name} = $name;
1508 | 		0
1509 | 	} else {
1510 | 		$tab->{name} = $name;
1511 | 		1
1512 | 	}
1513 | }
1514 | 
1515 | sub is_being_renamed { exists $_[0]{old_name} }
1516 | 
1517 | sub _is_escape($$) {
1518 | 	my ($event, $keysym) = @_;
1519 | 	return 1 if $keysym == 0xff1b;  # Escape
1520 | 	return 0 unless $event->{state} & urxvt::ControlMask;
1521 | 	$keysym == 99 || $keysym == 67;  # Ctrl+C
1522 | }
1523 | 
1524 | sub _is_backspace($$) {
1525 | 	my ($event, $keysym) = @_;
1526 | 	return 1 if $keysym == 0xff08;  # Backspace
1527 | 	return 0 unless $event->{state} & urxvt::ControlMask;
1528 | 	$keysym == 104 || $keysym == 72;  # Ctrl+H
1529 | }
1530 | 
1531 | sub _rename_tab_key_press {
1532 | 	my ($tab, $event, $keysym, $octets) = @_;
1533 | 
1534 | 	# rxvt-unicode-scroll-bug-fix.patch causes early key_press events to be
1535 | 	# passed without $keysym or $octects arguments passed.  Work around it
1536 | 	# by ignoring such invocations; we’ll be called again soon with all
1537 | 	# those arguments.  The patch shouldn’t be used any more anyway.
1538 | 	if (!defined $keysym) {
1539 | 		return 0;
1540 | 	}
1541 | 
1542 | 	my $is_enter = $keysym == 0xff0d || $keysym == 0xff8d;
1543 | 	if ($is_enter || _is_escape $event, $keysym) {
1544 | 		$tab->finish_rename_tab($is_enter);
1545 | 	} elsif (_is_backspace $event, $keysym) {
1546 | 		substr $tab->{name}, -2, 1, '';
1547 | 	} elsif ($octets !~ /[\x00-\x1f]/) {
1548 | 		my $text = $tab->locale_decode($octets);
1549 | 		substr $tab->{name}, -1, 0, $tab->special_encode($text);
1550 | 	} else {
1551 | 		return 1;
1552 | 	}
1553 | 
1554 | 	$tab->{root}->refresh;
1555 | 	1
1556 | }
1557 | 
1558 | 
1559 | ## Class for getting data from resources.  Most notably, it handles locale
1560 | ## decoding and parsing the values.
1561 | package urxvt::ext::tabbedex::rs_reader;
1562 | 
1563 | sub new {
1564 | 	my ($class, $root) = @_;
1565 | 	# TODO: Stop printing this warning in late 2023 or early 2024.
1566 | 	my $prefix = $root->x_resource('tabbed.tabbedex-rs-prefix') // '%';
1567 | 	my $extname = $root->{_name};
1568 | 	if ($prefix ne '%' && $prefix ne $extname) {
1569 | 		$root->warn("‘tabbed.tabbedex-rs-prefix’ resource is no " .
1570 | 		            "longer respected; use ‘$extname’ as prefix for " .
1571 | 		            "tabbedex resources");
1572 | 	}
1573 | 	bless \$root, $class
1574 | }
1575 | 
1576 | sub text {
1577 | 	my ($rs, $name, $default) = @_;
1578 | 	my $value = ($$rs)->x_resource("%.$name");
1579 | 	defined $value ? ($$rs)->locale_decode($value) : $default
1580 | }
1581 | 
1582 | sub bool {
1583 | 	my ($rs, $name, $default) = @_;
1584 | 	my $value = $rs->text($name);
1585 | 	defined $value ? $value !~ /^(?:false|0|no|off)$/i : $default;
1586 | }
1587 | 
1588 | sub colours {
1589 | 	my $rs = shift;
1590 | 
1591 | 	my %styles = (
1592 | 		bold            => urxvt::RS_Bold,
1593 | 		italic          => urxvt::RS_Italic,
1594 | 		blink           => urxvt::RS_Blink,
1595 | 		'reverse-video' => urxvt::RS_RVid,
1596 | 		underline       => urxvt::RS_Uline
1597 | 	);
1598 | 	my $styles = join '|', keys %styles;
1599 | 
1600 | 	my (@suffix, @styles, %used) = ('-fg', '-bg');
1601 | 	for my $c (@_) {
1602 | 		my $style = urxvt::DEFAULT_RSTYLE;
1603 | 		for my $i (0, 1) {
1604 | 			my $value = $rs->text($c->[2] . $suffix[$i], $c->[$i]);
1605 | 			$value =~ s/\s+/ /g;
1606 | 			$value =~ s/^ | $//g;
1607 | 			while ($i == 0 && $value =~ s/^($styles) //) {
1608 | 				$style |= $styles{$1};
1609 | 			}
1610 | 			if ($value =~ /^[-#a-zA-Z0-9 ]/) {
1611 | 				$c->[$i] = $value;
1612 | 			}
1613 | 			$used{$c->[$i]} = undef;
1614 | 		}
1615 | 		push @styles, $style;
1616 | 	}
1617 | 
1618 | 	my ($i, $cmd) = (0, '');
1619 | 	for my $key (keys %used) {
1620 | 		if ($key =~ /^-?\d+$/ && -2 <= $key && $key <= 255) {
1621 | 			$used{$key} = $key + 2;
1622 | 		} else {
1623 | 			++$i while exists $used{$i};
1624 | 			$cmd .= ';' . $i . ';' . $key;
1625 | 			$used{$key} = $used{$i} = $i + 2;
1626 | 		}
1627 | 	}
1628 | 
1629 | 	for $i (0..$#_) {
1630 | 		my ($fg, $bg) = @{ $_[$i] };
1631 | 		$styles[$i] = urxvt::SET_COLOR $styles[$i], $used{$fg}, $used{$bg};
1632 | 	}
1633 | 
1634 | 	(\@styles, $cmd ? "\e]4$cmd\a" : '')
1635 | }
1636 | 
1637 | 
1638 | ## Class for building up the tabbar.
1639 | package urxvt::ext::tabbedex::tabbar;
1640 | 
1641 | sub new {
1642 | 	my ($class, $root) = @_;
1643 | 	$#{ $root->{tabofs} } = -1;
1644 | 	bless {
1645 | 		root => $root,
1646 | 		text => '',
1647 | 		rend => [],
1648 | 		ncol => $root->ncol,
1649 | 		buttons => $root->{tabofs},
1650 | 		pipe_pending => 0,
1651 | 		pad_colour => 0,
1652 | 	}, $class;
1653 | }
1654 | 
1655 | sub _append {
1656 | 	my ($bar, $text, $c) = @_;
1657 | 	$bar->{text} .= $text;
1658 | 	push @{$bar->{rend}}, ($bar->{root}{rs_colours}[$c]) x length $text;
1659 | }
1660 | 
1661 | sub _append_pending_pipe_maybe {
1662 | 	my ($bar) = @_;
1663 | 	if ($bar->{pipe_pending}) {
1664 | 		$bar->_append('|');
1665 | 		$bar->{pipe_pending} = 0;
1666 | 	}
1667 | }
1668 | 
1669 | sub space_left {
1670 | 	my ($bar) = @_;
1671 | 	$bar->{ncol} - $bar->{pipe_pending} - length $bar->{text};
1672 | }
1673 | 
1674 | sub add_button {
1675 | 	my ($bar, $text, $color_idx, $code) = @_;
1676 | 	$bar->_append_pending_pipe_maybe;
1677 | 	my $start = length $bar->{text};
1678 | 	$bar->_append($text, $color_idx);
1679 | 	push @{ $bar->{buttons} }, [$start, length $bar->{text}, $code];
1680 | 	$bar->{pipe_pending} = 1;
1681 | }
1682 | 
1683 | sub add_title {
1684 | 	my ($bar, $text) = @_;
1685 | 	$bar->_append_pending_pipe_maybe;
1686 | 	my $available = $bar->space_left;
1687 | 	if (length $text < $available) {
1688 | 		$text = ' ' . $text;
1689 | 	} elsif (length $text > $available && $available > 1) {
1690 | 		substr($text, $available - 1) = '…';
1691 | 	}
1692 | 	$bar->_append($text, 4);
1693 | 	$bar->{pad_colour} = 4;
1694 | }
1695 | 
1696 | sub add_arrow {
1697 | 	my ($bar, $direction) = @_;
1698 | 	$bar->_append($direction < 0 ? '←' : '→');
1699 | 	$bar->{pipe_pending} = 0;
1700 | }
1701 | 
1702 | sub put_cursor {
1703 | 	my ($bar, $dx) = @_;
1704 | 	$bar->{cursor} = length($bar->{text}) + $dx + 1;
1705 | }
1706 | 
1707 | sub apply {
1708 | 	my ($bar) = @_;
1709 | 	$bar->{pipe_pending} = 0;
1710 | 	if ($bar->{ncol} > length $bar->{text}) {
1711 | 		$bar->_append(' ' x ($bar->{ncol} - length $bar->{text}),
1712 | 		              $bar->{pad_colour});
1713 | 	} elsif ($bar->{ncol} < length $bar->{text}) {
1714 | 		$bar->{text} = substr $bar->{text}, 0, $bar->{ncol};
1715 | 		splice @{ $bar->{rend} }, $bar->{ncol};
1716 | 	}
1717 | 	my ($term, $cur) = ($bar->{root}{term}, $bar->{cursor});
1718 | 	$term->cmd_parse(defined($cur) ? "\e[1;${cur}f\e[?25h" : "\e[?25l");
1719 | 	$term->ROW_t(0, $bar->{text});
1720 | 	$term->ROW_r(0, $bar->{rend});
1721 | }
1722 | 


--------------------------------------------------------------------------------