lib/BarnOwl/Module/ColorUtils.pm

   1 # -*- mode: cperl; cperl-indent-level: 4; indent-tabs-mode: nil -*-
   2 # Colors module.
   3 use strict;
   4 use warnings;
   5
   6 package BarnOwl::Module::ColorUtils;
   7
   8 =head1 NAME
   9
  10 BarnOwl::Module::ColorUtils
  11
  12 =head1 DESCRIPTION
  13
  14 This module implements easy to use color suppot for barnowl.
  15
  16 =cut
  17
  18 use Getopt::Long;
  19
  20 ################################################################################
  21 #Run this on start and reload. Adds styles, sets style to start.
  22 ################################################################################
  23 our @colorList = ();
  24 my $config_dir = BarnOwl::get_config_dir();
  25
  26 sub onStart {
  27     @colorList = ('black','red','green','yellow',
  28                   'blue','magenta','cyan','white');
  29     if ( *BarnOwl::getnumcolors{CODE} ) {
  30         for (my $i = 8; $i < BarnOwl::getnumcolors(); $i++) {
  31             push(@colorList,$i);
  32         }
  33     }
  34
  35     bindings_Color();
  36     cmd_load();
  37 }
  38 $BarnOwl::Hooks::startup->add(\&onStart);
  39
  40 ################################################################################
  41 #Register BarnOwl commands and default keybindings.
  42 ################################################################################
  43 sub bindings_Color
  44 {
  45     # Commands
  46     BarnOwl::new_command(
  47         setcolor => \&cmd_setcolor,
  48         {
  49             summary => "Change the color for this sender (personals) or class/muc (or instance if zephyr -c message)",
  50             usage   => "setcolor [-i] [-b] <color>",
  51             description => "Sets the foreground (or background) color for this kind of message.\n\n"
  52               . "The following options are available:\n\n"
  53               . " -i    Set the color for this instance of this zephyr class.\n\n"
  54               . " -b    Sets the background color instead of the foreground color.\n\n"
  55               . "color may be any of the colors listed in `:show color'; if using a 256-color\n"
  56               . "terminal, you may also use an HTML-style color code, #rrggbb, which will\n"
  57               . "be matched to the closest color approximation in a 6x6x6 colorcube.\n"
  58               . "The following special values are also allowed:\n"
  59               . "  default    uncolors the message\n"
  60               . "  restore    restores the last saved color for this message\n"
  61         }
  62     );
  63     BarnOwl::new_command(
  64         loadcolors => \&cmd_load,
  65         {
  66             summary => "Load color filter definitions from disk.",
  67             usage   => "loadcolors"
  68         }
  69     );
  70     BarnOwl::new_command(
  71         savecolors => \&cmd_save,
  72         {
  73             summary => "Save active color filter definitions to disk.",
  74             usage   => "savecolors"
  75         }
  76     );
  77
  78     # Key Bindings
  79     owl::command('bindkey recv "c" command start-command setcolor ');
  80 }
  81
  82
  83 ################################################################################
  84 ## Color state.
  85 ################################################################################
  86 our %currentColorMap = ();
  87 our %savedColorMap = ();
  88 our %mode2Protocol = ('zephyr' => 'zephyr',
  89                       'zephyr-personal' => 'zephyr',
  90                       'aim' => 'aim',
  91                       'jabber' => 'jabber',
  92                       'IRC' => 'IRC',
  93                       'loopback' => 'loopback');
  94
  95 ################################################################################
  96 ## Loading function
  97 ################################################################################
  98 sub createFilters($) {
  99     # Prepare the color filters.
 100     my $fgbg = shift;
 101     return unless (grep(/^[fb]g$/, $fgbg));
 102
 103     my %workingColorMap = %{ $currentColorMap{$fgbg} };
 104
 105     foreach my $color (@colorList) {
 106         my @strs;
 107
 108         #######################################################################
 109         my $mode = 'zephyr';
 110         {
 111             my @class = ();
 112             my @classInst = ();
 113
 114             foreach my $c (sort keys %{ $workingColorMap{$mode} }) {
 115                 my $c_esc = $c;
 116                 $c_esc =~ s/([+*])/\\$1/g;
 117                 my @instances = (sort keys %{ $workingColorMap{$mode}{$c} });
 118                 my $cHasStar = grep(/\*/, @instances);
 119
 120                 if ($cHasStar && @instances == 1) {
 121                     # Collect classes that are only globally colored.
 122                     push(@class, $c_esc) if ($workingColorMap{$mode}{$c}{'*'} eq $color);
 123                 } else {
 124                     # Collect classes that have varying color for instances.
 125                     if ($cHasStar && $workingColorMap{$mode}{$c}{'*'} eq $color) {
 126                         my @cInstances;
 127                         foreach my $i (@instances) {
 128                             next if (($i eq '*') || ($workingColorMap{$mode}{$c}{$i} eq $color));
 129                             $i =~ s/([+*])/\\$1/g;
 130                             push(@cInstances, $i);
 131                         }
 132                         push(@classInst, 'class ^'.$c_esc.'(.d)*$ and not instance ^('.join('|',@cInstances).')(.d)*$') if (@cInstances);
 133                     } else {
 134                         my @cInstances;
 135                         foreach my $i (@instances) {
 136                             next if (($i eq '*') || ($workingColorMap{$mode}{$c}{$i} ne $color));
 137                             $i =~ s/([+*])/\\$1/g;
 138                             push(@cInstances, $i);
 139                         }
 140                         push(@classInst, 'class ^'.$c_esc.'(.d)*$ and instance ^('.join('|',@cInstances).')(.d)*$') if (@cInstances);
 141                     }
 142                 }
 143             }
 144
 145             # Join the collected classes into one big filter.
 146             if (scalar(@class) || scalar(@classInst)) {
 147                 push(@strs,
 148                      '( type ^'.$mode2Protocol{$mode}.'$ and ( '
 149                      . ((scalar(@class)) ? 'class ^('.join('|',@class).')(.d)*$ ' : '')
 150                      . ((scalar(@class) && scalar(@classInst)) ? 'or ' : '')
 151                      . ((scalar(@classInst)) ? '( '.join(' ) or ( ', @classInst).' ) ' : '')
 152                      . ' ) )');
 153             }
 154         }
 155         #######################################################################
 156         $mode = 'zephyr-personal';
 157         {
 158             my $senders = '';
 159             my $count = 0;
 160             foreach my $sender (sort keys %{ $workingColorMap{$mode} }) {
 161                 next if ($workingColorMap{$mode}{$sender} ne $color);
 162                 $sender =~ s/([+*])/\\$1/g;
 163                 $count++;
 164                 $senders .= ($senders eq "") ? $sender : "|$sender";
 165             }
 166             if ($count) {
 167                 push(@strs,
 168                      '( type ^'.$mode2Protocol{$mode}.'$ and ( ( class ^message$ and instance ^personal$ ) or class ^login$ )'
 169                      . ' and ( sender ^('.$senders.')$ or recipient ^('.$senders.')$ ) )');
 170             }
 171         }
 172         #######################################################################
 173         $mode = 'aim';
 174         {
 175             my $senders = "";
 176             my $count = 0;
 177             foreach my $sender (sort keys %{ $workingColorMap{$mode} }) {
 178                 next if ($workingColorMap{$mode}{$sender} ne $color);
 179                 $sender =~ s/([+*])/\\$1/g;
 180                 $count++;
 181                 $senders .= ($senders eq "") ? $sender : "|$sender";
 182             }
 183             if ($count) {
 184                 push(@strs,
 185                      '( type ^'.$mode2Protocol{$mode}.'$'
 186                      . ' and ( sender ^('.$senders.')$ or recipient ^('.$senders.')$ ) )');
 187             }
 188         }
 189         #######################################################################
 190         $mode = 'jabber';
 191         {
 192             my $senders = "";
 193             my $count = 0;
 194             foreach my $sender (sort keys %{ $workingColorMap{$mode} }) {
 195                 next if ($workingColorMap{$mode}{$sender} ne $color);
 196                 $sender =~ s/([+*])/\\$1/g;
 197                 $count++;
 198                 $senders .= ($senders eq "") ? $sender : "|$sender";
 199             }
 200             if ($count) {
 201                 push(@strs,
 202                      '( type ^'.$mode2Protocol{$mode}.'$'
 203                      . ' and ( sender ^('.$senders.')$ or recipient ^('.$senders.')$ ) )');
 204             }
 205         }
 206         #######################################################################
 207         $mode = 'loopback';
 208         {
 209             push(@strs, '( type ^'.$mode2Protocol{$mode}.'$ )') if (($workingColorMap{$mode} || '') eq $color);
 210         }
 211         #######################################################################
 212
 213         my $filter = 'ColorUtils::'.$color.(($fgbg eq 'bg') ? '-bg' : '');
 214         my $filterspec = "$filter ".(($fgbg eq 'bg') ? '-b' : '-c')." $color ";
 215         if (scalar(@strs)) {
 216             BarnOwl::filter("$filterspec ( "
 217                            . join(' or ', @strs)
 218                            . ' )');
 219         } else {
 220             next if (owl::getview() eq $filter);
 221             BarnOwl::_remove_filter($filter);
 222         }
 223     }
 224 }
 225
 226 sub normalize_rgb {
 227     my $c = shift;
 228     return 0 if ($c < 26);
 229     return 1 if ($c < 77);
 230     return 2 if ($c < 128);
 231     return 3 if ($c < 179);
 232     return 4 if ($c < 230);
 233     return 5;
 234 }
 235
 236 sub find_color($$$) {
 237     my $r = normalize_rgb(shift);
 238     my $g = normalize_rgb(shift);
 239     my $b = normalize_rgb(shift);
 240     return 16 + (36 * $r) + (6 * $g) + $b;
 241 }
 242
 243 sub cmd_setcolor {
 244     my $fgbg;
 245     my $inst;
 246
 247     shift; #strip setcolor from argument list.
 248     local @ARGV = @_;
 249     GetOptions(
 250         'backgroud'  => \$fgbg,
 251         'instance' => \$inst,
 252     );
 253
 254     return unless ((scalar @ARGV) > 0);
 255     my $color = shift @ARGV;
 256
 257     if ($color =~ /^#([0-9a-f]{2})([0-9a-f]{2})([0-9a-f]{2})$/i) {
 258         $color = find_color(hex($1),hex($2),hex($3));
 259     }
 260     if ($color eq 'default') {
 261         unset($inst, $fgbg);
 262     } elsif ($color eq 'restore') {
 263         restore($inst, $fgbg);
 264     } else {
 265         die("setcolor: invalid color ($color)\n") unless grep(/$color/,@colorList);
 266         setColor($color, $inst, $fgbg);
 267     }
 268 }
 269
 270 sub cmd_save {
 271     save('fg');
 272     save('bg');
 273     cmd_load();
 274 }
 275
 276 sub cmd_load {
 277     load('fg');
 278     load('bg');
 279     refreshView('fg');
 280     refreshView('bg');
 281 }
 282
 283 ################################################################################
 284 ## Color toggling functions
 285 ################################################################################
 286 sub isZPersonal {
 287     # Return 1 for things that would qualify a zephyr as personal.
 288     my $m = shift;
 289     return 1 if ($m->recipient ne "" and $m->recipient !~ /^@/);
 290     return 1 if lc($m->class) eq "login";
 291     return 0;
 292 }
 293
 294 sub unset($$) {
 295     my $bInst = shift;
 296     my $fgbg = (shift || 0) ? 'bg' : 'fg';
 297     my $m = owl::getcurmsg();
 298     return unless $m;
 299     my $type = lc($m->type);
 300     if ($type eq 'zephyr') {
 301         if (isZPersonal($m)) {
 302             my $sender = lc((lc($m->direction) eq 'in') ? $m->sender : $m->recipient);
 303             delete $currentColorMap{$fgbg}{'zephyr-personal'}{$sender};
 304         } else {
 305             my $class = lc($m->class);
 306             my $instance = ($bInst || ($class eq 'message')) ? lc($m->instance) : '*';
 307
 308             if ($instance eq '*') {
 309                 $currentColorMap{$fgbg}{$type}{$class}{$instance} = 'default';
 310             } else {
 311                 delete $currentColorMap{$fgbg}{$type}{$class}{$instance};
 312             }
 313         }
 314     } elsif ($type eq 'aim' || $type eq 'jabber') {
 315         my $sender = (lc($m->direction) eq 'in') ? $m->sender : $m->recipient;
 316         $sender = $m->recipient if ($type eq 'jabber' && lc($m->jtype) eq 'groupchat');
 317
 318         delete $currentColorMap{$fgbg}{$type}{$sender};
 319     } elsif ($type eq 'loopback') {
 320         delete $currentColorMap{$fgbg}{$type};
 321     }
 322     refreshView($fgbg);
 323 }
 324
 325 sub setColor($$$)
 326 {
 327     my $color = shift;
 328     my $bInst = shift;
 329     my $fgbg = (shift || 0) ? 'bg' : 'fg';
 330     my $m = owl::getcurmsg();
 331     return unless $m;
 332
 333     my $type = lc($m->type);
 334     if ($type eq 'zephyr') {
 335         if (isZPersonal($m)) {
 336             my $sender = lc((lc($m->direction) eq 'in') ? $m->sender : $m->recipient);
 337             $currentColorMap{$fgbg}{'zephyr-personal'}{$sender} = $color;
 338         } else {
 339             my $class = lc($m->class);
 340             my $instance = ($bInst || ($class eq 'message')) ? lc($m->instance) : '*';
 341             $currentColorMap{$fgbg}{$type}{$class}{$instance} = $color;
 342         }
 343     } elsif ($type eq 'aim' || $type eq 'jabber') {
 344         my $sender = lc((lc($m->direction) eq 'in') ? $m->sender : $m->recipient);
 345         $sender = $m->recipient if ($type eq 'jabber' && lc($m->jtype) eq 'groupchat');
 346         $currentColorMap{$fgbg}{$type}{$sender} = $color;
 347     } elsif ($type eq 'loopback') {
 348         $currentColorMap{$fgbg}{$type} = $color;
 349     }
 350
 351     refreshView($fgbg);
 352 }
 353
 354 sub restore($$) {
 355     my $bInst = shift;
 356     my $fgbg = (shift || 0) ? 'bg' : 'fg';
 357     my $m = owl::getcurmsg();
 358     return unless $m;
 359     my $type = lc($m->type);
 360     my $oldColor;
 361     my $sender;
 362     if ($type eq 'zephyr') {
 363         if (isZPersonal($m)) {
 364             $sender = lc((lc($m->direction) eq 'in') ? $m->sender : $m->recipient);
 365             if ($oldColor = ($savedColorMap{$fgbg}{'zephyr-personal'}{$sender}) || '') {
 366                 $currentColorMap{$fgbg}{'zephyr-personal'}{$sender} = $oldColor;
 367             } else {
 368                 delete $currentColorMap{$fgbg}{'zephyr-personal'}{$sender};
 369             }
 370         } else {
 371             my $class = lc($m->class);
 372             my $instance = lc($m->instance);
 373             $instance =
 374               ($bInst
 375                  || ($class eq 'message')
 376                  || ((($savedColorMap{$fgbg}{$type}{$class}{'*'} || '') eq ($currentColorMap{$fgbg}{$type}{$class}{'*'} || ''))
 377                      && (($savedColorMap{$fgbg}{$type}{$class}{$instance} || '') ne ($currentColorMap{$fgbg}{$type}{$class}{$instance} || ''))))
 378                 ? $instance
 379                   : '*';
 380
 381             if ($oldColor = ($savedColorMap{$fgbg}{$type}{$class}{$instance} || '')) {
 382                 $currentColorMap{$fgbg}{$type}{$class}{$instance} = $oldColor;
 383             } else {
 384                 delete $currentColorMap{$fgbg}{$type}{$class}{$instance};
 385             }
 386         }
 387     } elsif ($type eq 'aim' || $type eq 'jabber') {
 388         $sender = lc((lc($m->direction) eq 'in') ? $m->sender : $m->recipient);
 389         $sender = $m->recipient if ($type eq 'jabber' && lc($m->jtype) eq 'groupchat');
 390         if ($oldColor = ($savedColorMap{$fgbg}{$type}{$sender} || '')) {
 391             $currentColorMap{$fgbg}{$type}{$sender} = $oldColor;
 392         } else {
 393             delete $currentColorMap{$fgbg}{$type}{$sender};
 394         }
 395     } elsif ($type eq 'loopback') {
 396
 397         if ($oldColor = ($savedColorMap{$fgbg}{$type} || '')) {
 398             $currentColorMap{$fgbg}{$type} = $oldColor;
 399         } else {
 400             delete $currentColorMap{$fgbg}{$type};
 401         }
 402     }
 403
 404     refreshView($fgbg);
 405 }
 406
 407 sub refreshView($) {
 408     my $fgbg = shift;
 409     return unless (grep(/^[fb]g$/, $fgbg));
 410
 411     createFilters($fgbg);
 412     if ( *BarnOwl::refresh_view{CODE} ) {
 413         BarnOwl::refresh_view();
 414     } else {
 415         my $filter = owl::command("getview");
 416         my $style = owl::command("getstyle");
 417         owl::command("view -f $filter ".($style?"-s $style":""));
 418     }
 419 }
 420
 421 ################################################################################
 422 ## Saving/Loading functions
 423 ################################################################################
 424 sub save($) {
 425     my $fgbg = shift;
 426     return unless (grep(/^[fb]g$/, $fgbg));
 427
 428     if ($fgbg eq 'bg') {
 429         open(COLORS, ">$config_dir/colormap_bg");
 430     } else {
 431         open(COLORS, ">$config_dir/colormap");
 432     }
 433
 434     my $type = 'zephyr';
 435     print COLORS "MODE: $type\n";
 436     foreach my $c (sort keys %{ $currentColorMap{$fgbg}{$type} }) {
 437         foreach my $i (sort keys %{ $currentColorMap{$fgbg}{$type}{$c} }) {
 438             if ($i eq '*'
 439                 || !($currentColorMap{$fgbg}{$type}{$c}{$i} eq ($currentColorMap{$fgbg}{$type}{$c}{'*'} || '')
 440                      || !$currentColorMap{$fgbg}{$type}{$c}{$i})) {
 441                 print COLORS "$c,$i,".($currentColorMap{$fgbg}{$type}{$c}{$i} ? $currentColorMap{$fgbg}{$type}{$c}{$i} : 'default')."\n";
 442             }
 443         }
 444     }
 445
 446     $type = 'zephyr-personal';
 447     print COLORS "MODE: $type\n";
 448     foreach my $s (sort keys %{ $currentColorMap{$fgbg}{$type} }) {
 449         print COLORS "$s,".($currentColorMap{$fgbg}{$type}{$s} ? $currentColorMap{$fgbg}{$type}{$s} : 'default')."\n";
 450     }
 451
 452     $type = 'aim';
 453     print COLORS "MODE: $type\n";
 454     foreach my $s (sort keys %{ $currentColorMap{$fgbg}{$type} }) {
 455         print COLORS "$s,".($currentColorMap{$fgbg}{$type}{$s} ? $currentColorMap{$fgbg}{$type}{$s} : 'default')."\n";
 456     }
 457
 458     $type = 'jabber';
 459     print COLORS "MODE: $type\n";
 460     foreach my $s (sort keys %{ $currentColorMap{$fgbg}{$type} }) {
 461         print COLORS "$s,".($currentColorMap{$fgbg}{$type}{$s} ? $currentColorMap{$fgbg}{$type}{$s} : 'default')."\n";
 462     }
 463
 464     $type = 'loopback';
 465     print COLORS "MODE: $type\n";
 466     print COLORS ($currentColorMap{$fgbg}{$type} ? $currentColorMap{$fgbg}{$type} : 'default')."\n";
 467
 468     close(COLORS);
 469 }
 470
 471 sub load($)
 472 {
 473     my $fgbg = shift;
 474     return unless (grep(/^[fb]g$/, $fgbg));
 475
 476     $currentColorMap{$fgbg} = {};
 477     $savedColorMap{$fgbg} = {};
 478
 479     # Parse the color file.
 480     if ($fgbg eq 'bg') {
 481         open(COLORS, "<$config_dir/colormap_bg") || return;
 482     }
 483     else {
 484         open(COLORS, "<$config_dir/colormap") || return;
 485     }
 486
 487
 488     my $mode = "zephyr";
 489
 490     foreach my $line (<COLORS>) {
 491         chomp($line);
 492         if ($line =~ /^MODE: (.*)$/) {
 493             if (lc($1) eq "zephyr") {
 494                 $mode = 'zephyr';
 495             } elsif (lc($1) eq "zephyr-personal") {
 496                 $mode = 'zephyr-personal';
 497             } elsif (lc($1) eq "aim") {
 498                 $mode = 'aim';
 499             } elsif (lc($1) eq "jabber") {
 500                 $mode = 'jabber';
 501             } elsif (lc($1) eq "loopback") {
 502                 $mode = 'loopback';
 503             } else {
 504                 $mode = 'zephyr';
 505             }
 506         } elsif ($mode eq 'zephyr' && $line =~ /^(.+),(.+),(b?)(black|red|green|yellow|blue|magenta|cyan|white|default|[0-9]{1,3})$/i) {
 507             $currentColorMap{$fgbg}{$mode}{lc($1)}{lc($2)} = lc($4);
 508             $savedColorMap{$fgbg}{$mode}{lc($1)}{lc($2)}   = lc($4);
 509         } elsif ($mode eq 'zephyr-personal' && $line =~ /^(.+),(b?)(black|red|green|yellow|blue|magenta|cyan|white|default|[0-9]{1,3})$/i) {
 510             $currentColorMap{$fgbg}{$mode}{lc($1)} = lc($3);
 511             $savedColorMap{$fgbg}{$mode}{lc($1)}   = lc($3);
 512         } elsif (($mode eq 'aim' || $mode eq 'jabber') && $line =~ /^(.+),(b?)(black|red|green|yellow|blue|magenta|cyan|white|default|[0-9]{1,3})$/i) {
 513             $currentColorMap{$fgbg}{$mode}{lc($1)} = lc($3);
 514             $savedColorMap{$fgbg}{$mode}{lc($1)}   = lc($3);
 515         } elsif ($mode eq 'loopback' && $line =~ /^(b?)(black|red|green|yellow|blue|magenta|cyan|white|default|[0-9]{1,3})$/i) {
 516             $currentColorMap{$fgbg}{$mode} = lc($2);
 517             $savedColorMap{$fgbg}{$mode}   = lc($2);
 518         }
 519     }
 520     close(COLORS);
 521 }