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