parallel: --ctag(string) implemented.

doc/release_new_version

@@ -255,7 +255,7 @@ from:tange@gnu.org
 to:parallel@gnu.org, bug-parallel@gnu.org
 stable-bcc: Jesse Alama <jessealama@fastmail.fm>
 
-Subject: GNU Parallel 20210822 ('turkish fire/greek fire/tysk syndflod/Tunesia') released <<[stable]>>
+Subject: GNU Parallel 20210822 ('South Africa/Kristina Timanovskaya/turkish fire/greek fire/tysk syndflod/Tunesia') released <<[stable]>>
 
 GNU Parallel 20210822 ('') <<[stable]>> has been released. It is available for download at: lbry://@GnuParallel:4
 

src/parallel

@@ -1555,6 +1555,8 @@ sub options_hash() {
 	 "nice=i" => \$opt::nice,
 	 "tag" => \$opt::tag,
 	 "tagstring|tag-string=s" => \$opt::tagstring,
+	 "ctag" => \$opt::ctag,
+	 "ctagstring|ctag-string=s" => \$opt::ctagstring,
 	 "onall" => \$opt::onall,
 	 "nonall" => \$opt::nonall,
 	 "filter-hosts|filterhosts|filter-host" => \$opt::filter_hosts,
@@ -1785,6 +1787,15 @@ sub parse_options(@) {
     if(defined $opt::null) { $/ = "\0"; }
     if(defined $opt::d) { $/ = unquote_printf($opt::d) }
     parse_replacement_string_options();
+    $opt::tag ||= $opt::ctag;
+    $opt::tagstring ||= $opt::ctagstring;
+    if(defined $opt::ctag or defined $opt::ctagstring) {
+	$Global::color = 1;
+    }
+    if(defined $opt::tag and not defined $opt::tagstring) {
+	# Default = {}
+	$opt::tagstring = $Global::parensleft.$Global::parensright;
+    }
     if(defined $opt::tagstring) {
 	$opt::tagstring = unquote_printf($opt::tagstring);
 	if($opt::tagstring =~ /\Q$Global::parensleft\E.*\Q$Global::parensright\E/
@@ -2027,10 +2038,6 @@ sub parse_options(@) {
        not ($opt::xargs or $opt::m)) {
 	$Global::ContextReplace = 1;
     }
-    if(defined $opt::tag and not defined $opt::tagstring) {
-	# Default = {}
-	$opt::tagstring = $Global::parensleft.$Global::parensright;
-    }
     if(grep /^$Global::arg_sep\+?$|^$Global::arg_file_sep\+?$/o, @ARGV) {
         # Deal with ::: :::+ :::: and ::::+
         @ARGV = read_args_from_command_line();
@@ -5840,13 +5847,15 @@ sub which(@) {
 			    if($shellpath = readlink "/proc/$testpid/exe") {
 				::debug("init","procpath $shellpath\n");
 				if($shellpath =~ m:/$shell$:o) {
-				    ::debug("init", "proc which ".$shellpath." => ");
+				    ::debug("init",
+					    "proc which ".$shellpath." => ");
 				    return $shellpath;
 				}
 			    }
 			}
 			::debug("init", "which ".$shellname." => ");
-			$shellpath = (which($shellname,@{$fakename{$shellname}}))[0];
+			$shellpath = (which($shellname,
+					    @{$fakename{$shellname}}))[0];
 			::debug("init", "shell path $shellpath\n");
 			return $shellpath;
 		    }
@@ -5907,11 +5916,13 @@ sub which(@) {
 
        	if(not %pid_parentpid_cmd) {
 	    # Filter for SysV-style `ps`
-	    my $sysv = q( ps -ef | perl -ane '1..1 and /^(.*)CO?MM?A?N?D/ and $s=length $1;).
+	    my $sysv = q( ps -ef |).
+		q(perl -ane '1..1 and /^(.*)CO?MM?A?N?D/ and $s=length $1;).
 		q(s/^.{$s}//; print "@F[1,2] $_"' );
 	    # Minix uses cols 2,3 and can have newlines in the command
 	    # so lines not having numbers in cols 2,3 must be ignored
-	    my $minix = q( ps -ef | perl -ane '1..1 and /^(.*)CO?MM?A?N?D/ and $s=length $1;).
+	    my $minix = q( ps -ef |).
+		q(perl -ane '1..1 and /^(.*)CO?MM?A?N?D/ and $s=length $1;).
 		q(s/^.{$s}// and $F[2]>0 and $F[3]>0 and print "@F[2,3] $_"' );
 	    # BSD-style `ps`
 	    my $bsd = q(ps -o pid,ppid,command -ax);
@@ -5939,7 +5950,8 @@ sub which(@) {
 	     'syllable' => "echo ps not supported",
 	    );
 	}
-	$pid_parentpid_cmd{$^O} or ::die_bug("pid_parentpid_cmd for $^O missing");
+	$pid_parentpid_cmd{$^O} or
+	    ::die_bug("pid_parentpid_cmd for $^O missing");
 
 	my (@pidtable,%parent_of,%children_of,%name_of);
 	# Table with pid -> children of pid
@@ -6111,7 +6123,8 @@ sub kill_youngest_if_over_limit() {
 	push @{$jobs_of{$job->sshlogin()}}, $job;
     }
     for my $sshlogin (@sshlogins) {
-	for my $job (sort { $b->seq() <=> $a->seq() } @{$jobs_of{$sshlogin}}) {
+	for my $job (sort { $b->seq() <=> $a->seq() }
+		     @{$jobs_of{$sshlogin}}) {
 	    if($sshlogin->limit() == 2) {
 		$job->kill();
 		last;
@@ -6141,7 +6154,8 @@ sub suspend_young_if_not_enough_mem() {
 	if($free < 2*$limit) {
 	    # Suspend all jobs (resume some of them later)
 	    map { $_->suspended() or $_->suspend(); } @{$jobs_of{$sshlogin}};
-	    my @jobs = sort { $b->seq() <=> $a->seq() } @{$jobs_of{$sshlogin}};
+	    my @jobs = (sort { $b->seq() <=> $a->seq() }
+			@{$jobs_of{$sshlogin}});
 	    # how many should be running?
 	    # limit*1 => 1;
 	    # limit*1.5 => 2;
@@ -6162,8 +6176,8 @@ sub suspend_young_if_not_enough_mem() {
 	    for my $job (@{$jobs_of{$sshlogin}}) {
 		if($job->suspended()) {
 		    $job->resume();
-		    ::debug("mem","\nResume ",$#{$jobs_of{$sshlogin}}+1, " jobs. Seq ",
+		    ::debug("mem","\nResume ",$#{$jobs_of{$sshlogin}}+1,
-			    $job->seq(), " resumed ",
+			    " jobs. Seq ", $job->seq(), " resumed ",
 			    $sshlogin->memfree()," > ",2*$limit);
 		    last;
 		}
@@ -6189,7 +6203,8 @@ sub kill_youngster_if_not_enough_mem() {
 	push @{$jobs_of{$job->sshlogin()}}, $job;
     }
     for my $sshlogin (@sshlogins) {
-	for my $job (sort { $b->seq() <=> $a->seq() } @{$jobs_of{$sshlogin}}) {
+	for my $job (sort { $b->seq() <=> $a->seq() }
+		     @{$jobs_of{$sshlogin}}) {
 	    if($sshlogin->memfree() < $limit) {
 		::debug("mem","\n",map { $_->seq()." " }
 			(sort { $b->seq() <=> $a->seq() }
@@ -10162,8 +10177,10 @@ sub interactive_start($) {
 	    ::status("See output with: $ENV{'PARALLEL_TMUX'} -S $tmuxsocket attach");
 	}
 	$tmux = "sh -c '".
-	    $ENV{'PARALLEL_TMUX'}." -S $tmuxsocket new-session -s p$$ -d \"sleep .2\" >/dev/null 2>&1';" .
+	    $ENV{'PARALLEL_TMUX'}.
-	    $ENV{'PARALLEL_TMUX'}." -S $tmuxsocket new-window -t p$$ -n $title";
+	    " -S $tmuxsocket new-session -s p$$ -d \"sleep .2\" >/dev/null 2>&1';" .
+	    $ENV{'PARALLEL_TMUX'}.
+	    " -S $tmuxsocket new-window -t p$$ -n $title";
 
 	::debug("tmux", "title len:", $l_tit, " act ", $l_act, " max ",
 		$Limits::Command::line_max_len, " tot ",
@@ -10175,7 +10192,8 @@ sub interactive_start($) {
 	    (
 	     "(".$actual_command.');'.
 	     # The triple print is needed - otherwise the testsuite fails
-	     q[ perl -e 'while($t++<3){ print $ARGV[0],"\n" }' $?h/$status >> ].$tmpfifo."&".
+	     q[ perl -e 'while($t++<3){ print $ARGV[0],"\n" }' $?h/$status >> ].
+	     $tmpfifo."&".
 	     "echo $title; echo \007Job finished at: `date`;sleep 10"
 	    ).
 	    # Run outside tmux
@@ -10361,7 +10379,8 @@ sub print($) {
 	sub jsonquote($) {
 	    my $a = shift;
 	    if(not $jsonmap{"\001"}) {
-		map { $jsonmap{sprintf("%c",$_)} = sprintf '\u%04x', $_ } 0..31;
+		map { $jsonmap{sprintf("%c",$_)} =
+			  sprintf '\u%04x', $_ } 0..31;
 	    }
 	    $a =~ s/\\/\\\\/g;
 	    $a =~ s/\"/\\"/g;
@@ -10609,15 +10628,19 @@ sub print_linebuffer($) {
 			    my $tag = $self->tag();
 			    unshift @$halfline_ref, $tag;
 			    # TODO --recend that can be partially in @$halfline_ref
-			    substr($buf,0,$i-1) =~ s/(?<=[\n\r])(?=.|$)/$tag/gs;
+			    substr($buf,0,$i-1) =~
+				s/(?<=[\n\r])(?=.|$)/$tag/gs;
 			    # The length changed, so find the new ending pos
-			    $i = ::max((rindex($buf,"\n")+1), (rindex($buf,"\r")+1));
+			    $i = ::max((rindex($buf,"\n")+1),
+				       (rindex($buf,"\r")+1));
 			} else {
 			    # Replace with freshly computed value of tag
 			    unshift @$halfline_ref, $self->tag();
-			    substr($buf,0,$i-1) =~ s/(?<=[\n\r])(?=.|$)/$self->tag()/gse;
+			    substr($buf,0,$i-1) =~
+				s/(?<=[\n\r])(?=.|$)/$self->tag()/gse;
 			    # The length changed, so find the new ending pos
-			    $i = ::max((rindex($buf,"\n")+1), (rindex($buf,"\r")+1));
+			    $i = ::max((rindex($buf,"\n")+1),
+				       (rindex($buf,"\r")+1));
 			}
 		    }
 		    # Print the partial line (halfline) and the last half
@@ -10862,17 +10885,51 @@ sub print_joblog($) {
     $self->set_job_in_joblog();
 }
 
-sub tag($) {
+{
+    my @color;
+
+    sub tag($) {
+	sub init_color() {
+	    # color combinations that are readable: black/white text
+	    # on colored background, but not white on yellow
+	    @color =
+		# Force each color code to have the same length in chars
+		# This will make \t work as expected
+		((map { [sprintf("%03d",$_),"000"] }
+		  6..7,9..11,13..15,40..51,75..87,113..123,147..159,
+		  171..231,249..254),
+		 (map { [sprintf("%03d",$_),231] }
+		  1..9,12..13,16..45,52..81,88..116,124..151,153,
+		  160..180,182..185,187..189,196..214,232..252,
+		  255..254));
+	    # reorder list so adjacent colors are dissimilar
+	    # %7 and %17 were found experimentally
+	    @color = @color[
+		sort { ($b%7 <=> $a%7) or ($a%17 <=> $b%17) } 0..$#color
+		];
+	}
 	my $self = shift;
 	if(not defined $self->{'tag'} or not $Global::cache_replacement_eval) {
 	    if($opt::tag or defined $opt::tagstring) {
+		if($Global::color) {
+		    if(not @color) { init_color() }
+		    # Choose a value based on the seq
+		    my $col = @color[$self->seq() % ($#color+1)];
+		    $self->{'tag'} = "\033[48;5;".$col->[0].
+			";38;5;".$col->[1]."m".
+			($self->{'commandline'}->
+			 replace_placeholders([$opt::tagstring],0,0)).
+			"\033[00m\t";
+		} else {
 		    $self->{'tag'} = $self->{'commandline'}->
 			replace_placeholders([$opt::tagstring],0,0)."\t";
+		}
 	    } else {
 		$self->{'tag'} = "";
 	    }
 	}
 	return $self->{'tag'};
+    }
 }
 
 sub hostgroups($) {

src/parallel.pod

@@ -740,6 +740,16 @@ Even quoted newlines are parsed correctly:
 When used with B<--pipe> only pass full CSV-records.
 
 
+=item B<--ctag> I<str> (alpha testing)
+
+Color tag. See B<--tag>.
+
+
+=item B<--ctagstring> I<str> (alpha testing)
+
+Color tagstring. See B<--tagstring>.
+
+
 =item B<--delay> I<mytime>
 
 Delay starting next job by I<mytime>. GNU B<parallel> will pause
@@ -2695,7 +2705,7 @@ to GNU B<parallel> giving each child its own process group, which is
 then killed. Process groups are dependant on the tty.
 
 
-=item B<--tag>
+=item B<--tag> (alpha testing)
 
 Tag lines with arguments. Each output line will be prepended with the
 arguments and TAB (\t). When combined with B<--onall> or B<--nonall>
@@ -2703,8 +2713,10 @@ the lines will be prepended with the sshlogin instead.
 
 B<--tag> is ignored when using B<-u>.
 
+B<--ctag> gives the tag a color.
 
-=item B<--tagstring> I<str>
+
+=item B<--tagstring> I<str> (alpha testing)
 
 Tag lines with a string. Each output line will be prepended with
 I<str> and TAB (\t). I<str> can contain replacement strings such as
@@ -2712,6 +2724,8 @@ B<{}>.
 
 B<--tagstring> is ignored when using B<-u>, B<--onall>, and B<--nonall>.
 
+B<--ctagstring> gives the tag a color.
+
 
 =item B<--tee>
 

testsuite/tests-to-run/parallel-local-0.3s.sh

@@ -16,6 +16,14 @@ export -f stdsort
 # Test amount of parallelization
 # parallel --shuf --jl /tmp/myjl -j1 'export JOBS={1};'bash tests-to-run/parallel-local-0.3s.sh ::: {1..16} ::: {1..5}
 
+par_ctagstring() {
+    echo '### --ctag --ctagstring should be different from --tag --tagstring'
+    parallel --tag echo ::: 1 ::: a| wc -c
+    parallel --ctag echo ::: 1 ::: a | wc -c
+    parallel --tagstring 'I{1}\tB{2}' echo ::: 1 ::: a | wc -c
+    parallel --ctagstring 'I{1}\tB{2}' echo ::: 1 ::: a | wc -c
+}
+
 par_pct() {
     echo '### Test {%...} {%%...} {#...} {##...}'
     a=z.z.z.foo

testsuite/wanted-results/parallel-local-0.3s

@@ -108,6 +108,11 @@ par_csv_pipe	11000"
 par_csv_pipe	More records in single block
 par_csv_pipe	9000"
 par_csv_pipe	11000"
+par_ctagstring	### --ctag --ctagstring should be different from --tag --tagstring
+par_ctagstring	8
+par_ctagstring	33
+par_ctagstring	10
+par_ctagstring	35
 par_delimiter	### Test --delimiter and -d: Delimiter instead of newline
 par_delimiter	# Yes there is supposed to be an extra newline for -d N
 par_delimiter	This is line 1