cc/DiffBLUI.pm

   1 =head1 NAME
   2
   3 Diffbl.pm: Perl/Tk UI for diffbl.pl
   4
   5 =head1 USAGE
   6
   7  use DiffBLUI.pm;
   8
   9  CreateUI;
  10
  11 =head1 DESCRIPTION
  12
  13 This Perl module encapsulates the Perl/Tk UI for diffbl.pl.
  14
  15 =head1 AUTHOR
  16
  17 Andrew DeFaria <Andrew@ClearSCM.com>
  18
  19 =head1 COPYRIGHT
  20
  21 Copyright (c) 2010 Andrew DeFaria <Andrew@ClearSCM.com>, ClearSCM, Inc.
  22 All rights reserved.
  23
  24 =cut
  25
  26 package DiffBLUI;
  27
  28 use strict;
  29 use warnings;
  30
  31 use Cwd;
  32 use POSIX;
  33 use Tk;
  34 use Tk::BrowseEntry;
  35 use Tk::DialogBox;
  36 use Tk::ROText;
  37
  38 use lib '../lib';
  39
  40 use Clearcase;
  41 use Display;
  42 use OSDep;
  43
  44 use CCDBService;
  45
  46 use base 'Exporter';
  47
  48 my $VERSION = '1.0';
  49
  50 our (
  51   %SELECTED,
  52   %LINES,
  53   $MODE,
  54   $INTEGRATIONACTIVITIES,
  55   $integrationActivitiesCheck
  56 );
  57
  58 my ($msgWidget, $searchPattern);
  59
  60 our @EXPORT = qw (
  61   createUI
  62   displayLines
  63   Tkerror
  64   Tkmsg
  65 );
  66
  67 # Globals
  68 my $TITLE  = 'Compare Baselines: Use fields to select baselines then ';
  69    $TITLE .= 'select Compare';
  70
  71 my $CCDBService = CCDBService->new;
  72
  73 # Widgets
  74 my (
  75   $main,
  76   $versionsMenu,
  77   $activitiesMenu,
  78   $pvobDropdown,
  79   $streamDropdown,
  80   $fromBaselineDropdown,
  81   $toBaselineDropdown,
  82   $compareButton,
  83   $output,
  84 );
  85
  86 # Data
  87 my (@pvobs, @streams, @fromBaselines, @toBaselines);
  88
  89 sub createButton ($$$) {
  90   my ($parent, $label, $action) = @_;
  91
  92   $parent->Button (
  93     -text    => $label,
  94     -width   => length $label,
  95     -command => \$action
  96   )->pack (
  97     -side    => "left",
  98     -padx    => 5,
  99     -pady    => 5,
 100   );
 101
 102   return;
 103 } # createButton
 104
 105 sub createDropdown ($$$;$$) {
 106   my ($parent, $label, $variable, $action, $list) = @_;
 107
 108   my $widget = $parent->BrowseEntry (
 109     -label     => "$label:",
 110     -font      => 'Arial 8 bold',
 111     -variable  => $variable,
 112     -width     => 175,
 113     -takefocus => 1,
 114   )->pack (
 115     -padx      => 5,
 116     -pady      => 2,
 117   );
 118
 119   if ($action) {
 120     # Any of these cause the action to be invoked
 121     $widget->configure (-browsecmd    => \$action);
 122     $widget->bind      ('<FocusOut>'  => \$action);
 123     $widget->bind      ('<Return>'    => \$action);
 124   } # if
 125
 126   $widget->configure (-listcmd => \$list)
 127     if $list;
 128
 129   my $listBox = $widget->Subwidget ('slistbox');
 130   my $entry   = $widget->Subwidget ('entry');
 131   my $arrow   = $widget->Subwidget ('arrow');
 132   my $choices = $widget->Subwidget ('choices');
 133
 134   # Turn off bolding on the entry
 135   $entry->configure (-font => 'Arial 8');
 136
 137   # Allow both widgets to have highlighted parts
 138   $listBox->configure (-exportselection => 0);
 139   $entry->configure   (-exportselection => 0);
 140
 141   # Take the arrow out of the focus business - Works on Unix!
 142   # Bug on Windows! :-(
 143   $arrow->configure (-takefocus => 0);
 144
 145   # This gets the mouse wheel working - Works on Unix!
 146   # Bug on Windows! :-(
 147   $choices->bind ('<Button-4>', sub {$choices->yviewScroll (1,'units')});
 148   $choices->bind ('<Button-5>', sub {$choices->yviewScroll (-1,'units')});
 149   $choices->bind ('<Button-4>', sub {$choices->yview (1,'units')});
 150   $choices->bind ('<Button-5>', sub {$choices->yview (-1,'units')});
 151
 152   foreach (
 153     '<KeyPress>',
 154     '<Up>',
 155     '<Down>',
 156     '<Control-Key-p>',
 157     '<Control-Key-n>'
 158   ) {
 159     $entry->bind ($_, [\&handleKeypress, $listBox]);
 160   } # foreach
 161
 162   return $widget;
 163 } # createDropdown
 164
 165 sub createList ($) {
 166   my ($parent) = @_;
 167
 168   my $widget = $parent->Scrolled ('Listbox',
 169     -height     => 10,
 170     -width      => 100,
 171     -scrollbars => 'e',
 172   )->pack (
 173     -padx       => 5,
 174     -pady       => 5,
 175     -fill       => 'both',
 176     -expand     => 'yes',
 177     -anchor     => 'w',
 178   );
 179
 180   # Make this list resizeable
 181   $parent->pack (
 182     -fill       => 'both',
 183     -expand     => 'yes',
 184   );
 185
 186   # Bind actions
 187   $widget->bind ('<ButtonPress-3>', [ \&popupCCActions, Ev('@') ]);
 188   $widget->bind ('<Double-ButtonPress-1>', \&properties);
 189
 190   # This gets the mouse wheel working
 191   $widget->bind ('<Button-4>', sub {$widget->yviewScroll (1,'units')});
 192   $widget->bind ('<Button-5>', sub {$widget->yviewScroll (-1,'units')});
 193
 194   return $widget;
 195 } # createList
 196
 197 sub setList ($@) {
 198   my ($list, @value) = @_;
 199
 200   $list->insert ('end', $_)
 201     foreach @value;
 202
 203   return;
 204 } # setList
 205
 206 sub clearList($) {
 207   my ($list) = @_;
 208
 209   return
 210     unless $list;
 211
 212   $list->delete ('0.0', 'end');
 213
 214   return;
 215 } # clearList
 216
 217 sub search (@) {
 218   my (@values) = @_;
 219
 220   return (undef, ())
 221     unless length $searchPattern;
 222
 223   my ($index, @matches);
 224
 225   # First filter @values including only matching entries
 226   foreach (@values) {
 227     push @matches, $_
 228       if /$searchPattern/i;
 229   } # foreach
 230
 231   @values = ();
 232
 233   # Now determine the first qualifying entry. Note if index is already set then
 234   # we do not need to recompute it. It was computed above via a Up or Down key.
 235   foreach (0 .. $#matches) {
 236     if ($matches[$_] =~ m/$searchPattern/i) {
 237       push @values, $matches[$_];
 238       $index = $_ unless defined $index;
 239     } # if
 240   } # foreach
 241
 242   return ($index, @values);
 243 } # search
 244
 245 sub setDropdown ($$$) {
 246   my ($listBox, $entry, $index) = @_;
 247
 248   # Set listBox widget. This is actually the dropdown list.
 249   $listBox->see ($index);
 250   $listBox->activate ($index);
 251
 252   # This should be the active entry to set into the entry widget
 253   my $currentEntry = $listBox->get ($index);
 254
 255   # Set the entry widget. This is the line that the user is typing in
 256   $entry->delete (0, 'end');
 257   $entry->insert (0, $currentEntry);
 258
 259   # Set the selection highlight (if the searchPattern is found)
 260   unless (length $searchPattern == 0) {
 261     if ($currentEntry =~ /$searchPattern/i) {
 262       $entry->selectionClear;
 263       $entry->selectionRange ($-[0], $+[0]);
 264       $entry->icursor ($+[0]);
 265     } # if
 266   } # unless
 267
 268   return;
 269 } # setDropdown
 270
 271 sub handleKeypress {
 272   my ($entry, $listBox) = @_;
 273
 274   my (@matches, $match, $index);
 275
 276   # This is ugly but works
 277   my $browseEntry = $listBox->parent->parent;
 278
 279   my $key    = $entry->XEvent->A;
 280   my $keysym = $entry->XEvent->K;
 281
 282   debug "Entry: " . $entry->get;
 283   debug "Key: '$key' ($keysym)";
 284
 285   # Map Cntl-n and Cntl-p to Down and Up
 286   $keysym = 'Down' if ord ($key) == 14;
 287   $keysym = 'Up'   if ord ($key) == 16;
 288
 289   my $first  = 0;
 290   my $Last   = $listBox->index ('end') - 1; # Make 0 relative
 291   my $active = $listBox->index ('active');
 292
 293   $index = $active;
 294
 295   if ($keysym eq 'BackSpace') {
 296     $searchPattern = substr $searchPattern, 0, -1
 297       if length $searchPattern > 0;
 298
 299     if (length $searchPattern == 0) {
 300       $index = 0;
 301       $entry->delete (0, 'end');
 302     } # if
 303   } elsif ($keysym eq 'Down') {
 304     if ($active < $Last) {
 305       setDropdown ($listBox, $entry, ++$active);
 306     } else {
 307       debug "Beep - no more down";
 308       $main->bell;
 309     } # if
 310
 311     return;
 312   } elsif ($keysym eq 'Up') {
 313     if ($active > 0) {
 314       setDropdown ($listBox, $entry, --$active);
 315     } else {
 316       debug "Beep - no more up";
 317       $main->bell;
 318     } # unless
 319
 320     return;
 321   } elsif ($keysym eq 'Tab') {
 322     $entry->selectionClear;
 323
 324     return;
 325   } else {
 326     return if (!isprint ($key) || !ord ($key));
 327
 328     $searchPattern .= $key;
 329   } # if
 330
 331   debug "searchPattern: $searchPattern";
 332
 333   # Get values based on the $browseEntry widget
 334   my @values;
 335
 336   unless ($index) {
 337     do {
 338       if ($browseEntry == $pvobDropdown) {
 339         ($index, @values) = search sort @pvobs;
 340       } elsif ($browseEntry == $streamDropdown) {
 341         ($index, @values) = search sort @streams;
 342       } elsif ($browseEntry == $fromBaselineDropdown) {
 343        ($index, @values) = search sort @fromBaselines;
 344       } elsif ($browseEntry == $toBaselineDropdown) {
 345         ($index, @values) = search sort @toBaselines;
 346       } # if
 347
 348       if (defined $index) {
 349         debug "Index: $index";
 350         $match = $values[$index];
 351       } else {
 352         debug "Index: <undefined>";
 353         debug "Length of searchPatern " . length $searchPattern;
 354         if (length $searchPattern == 0) {
 355           debug "Setting match to blank";
 356           $match = '';
 357           $index = 0;
 358         } else {
 359           debug "making searchPattern shorter";
 360           $searchPattern = substr $searchPattern, 0, -1;
 361           debug "Length of searchPatern now " . length $searchPattern;
 362         } # if
 363       } # if
 364     } until $match or length $searchPattern == 0;
 365   } # unless
 366
 367   # Setting the listBox clears the active indicator so save it and reset it.
 368   $active = $listBox->index ('active');
 369
 370   clearList $listBox;
 371   setList $listBox, sort @values;
 372
 373   $listBox->activate ($active);
 374
 375   if ($searchPattern) {
 376     if ($match and $match =~ /$searchPattern/i) {
 377       $entry->delete (0, 'end');
 378       $entry->selectionClear;
 379       $entry->insert (0, $match);
 380       $entry->icursor ($+[0]);
 381       $entry->selectionRange ($-[0], $+[0]);
 382     } else {
 383       debug "Beep - no matches";
 384       $main->bell;
 385       return;
 386     } # if
 387   } # if
 388
 389   # Now update the assocated listBox.
 390   $listBox->selectionClear (0, 'end');
 391   $listBox->selectionSet   ($index, $index);
 392
 393   # Makes it so that the entry selected above is centered in the drop down list.
 394   # So if you had say entries like 1, 2, 3, 4,... 10 and you hit '5', you'll see
 395   # '5' in the listBox entry but you really want to also shift it so that if you
 396   # hit the drop down arrow, 5, is the entry at the top of the drop down list.
 397   $listBox->see ($index);
 398
 399   debug 'Entry: ' . $entry->get;
 400
 401   return;
 402 } # handleKeypress
 403
 404 sub Tkerror ($) {
 405   my ($msg) = @_;
 406
 407   my $error = $main->DialogBox (
 408     -title    => 'Error',
 409     -buttons  => [ 'OK' ],
 410   );
 411
 412   my $text = $error->add (
 413     'ROText',
 414     -width      => 65,
 415     -height     => 8,
 416     -font       => "Arial 8",
 417     -wrap       => 'word',
 418   )->pack (
 419     -fill       => 'both',
 420     -expand     => 1,
 421   );
 422
 423   $text->insert ('end', $msg);
 424
 425   $error->Show;
 426
 427   return;
 428 } # Tkerror
 429
 430 sub Tkmsg ($;$) {
 431   my ($msg, $sleep) = @_;
 432
 433   if ($msgWidget) {
 434     $msgWidget->configure (-text => $msg);
 435     $msgWidget->update;
 436
 437     if ($sleep) {
 438       return
 439         if $sleep < 0;
 440
 441       sleep $sleep;
 442     } # if
 443
 444     $msgWidget->configure (-text => '');
 445     $msgWidget->update;
 446   } # if
 447
 448   return;
 449 } # Tkmsg
 450
 451 sub about () {
 452   my $msg = "Utility to select baselines and provide a simple list of "
 453           . "activities or file/directory versions that differ between "
 454           . "two baselines.\n\n"
 455           . "Note you can save this list using the Save button or you can "
 456           . "right click on a line and select Clearcase operations.\n\n"
 457           . "Written by Andrew DeFaria <Andrew\@ClearSCM.com>";
 458
 459   my $about = $main->DialogBox (
 460     -title      => "About $FindBin::Script V$VERSION",
 461     -buttons    => [ 'OK' ],
 462   );
 463
 464   my $text = $about->add (
 465     'ROText',
 466     -width      => 65,
 467     -height     => 8,
 468     -font       => "Arial 8",
 469     -wrap       => 'word',
 470   )->pack;
 471
 472   # Stop about dialog from resizing
 473   $about->bind (
 474     '<Configure>' => sub {
 475       my $e = $about->XEvent;
 476
 477       $about->maxsize ($e->w, $e->h);
 478       $about->minsize ($e->w, $e->h);
 479     },
 480   );
 481
 482   $text->insert ('end', $msg);
 483
 484   $about->Show;
 485
 486   return;
 487 } # about
 488
 489 sub popupCCActions ($) {
 490   my ($widget, $xy) = @_;
 491
 492   $widget->selectionClear (0, 'end');
 493
 494   my $index = $widget->index ($xy);
 495   my $event = $widget->XEvent;
 496
 497   if (defined $index) {
 498     $widget->selectionSet ($index);
 499
 500     if ($MODE eq 'versions') {
 501       $versionsMenu->post ($widget->rootx + $event->x, $widget->rooty + $event->y);
 502     } else {
 503       $activitiesMenu->post ($widget->rootx + $event->x, $widget->rooty + $event->y);
 504     }
 505   } # if
 506
 507   return;
 508 } # popupCCActions
 509
 510 sub busy () {
 511   $main->Busy (-recurse => 1);
 512   $main->update;
 513
 514   return;
 515 } # busy
 516
 517 sub unbusy () {
 518   $main->Unbusy;
 519   $main->update;
 520
 521   return;
 522 } # unbusy
 523
 524 sub getPvobs {
 525   $main->Busy (-recurse => 1);
 526
 527   my ($status, @output) = $Clearcase::CC->execute ('lsvob');
 528
 529   @pvobs = ();
 530
 531   foreach (grep { /\(ucmvob/ } @output) {
 532     my @tokens = split;
 533
 534     my $pvob = $tokens[0] eq '*'
 535              ? Clearcase::vobname ($tokens[1])
 536              : Clearcase::vobname ($tokens[0]);
 537
 538     push @pvobs, $pvob;
 539   } # foreach
 540
 541   clearList $streamDropdown;       $SELECTED{stream}       = '';
 542             $streamDropdown->update;
 543   clearList $fromBaselineDropdown; $SELECTED{fromBaseline} = '';
 544             $fromBaselineDropdown->update;
 545   clearList $toBaselineDropdown;   $SELECTED{toBaseline}   = '';
 546             $toBaselineDropdown->update;
 547   clearList $output;
 548
 549   clearList $pvobDropdown;
 550   setList $pvobDropdown, sort @pvobs;
 551
 552   $main->Unbusy;
 553
 554   return;
 555 } # getPvobs
 556
 557 sub getStreams () {
 558   $main->Busy (-recurse => 1);
 559
 560   $searchPattern = '';
 561
 562   clearList $streamDropdown;
 563
 564   $SELECTED{stream} = 'Getting streams...';
 565
 566   $streamDropdown->update;
 567
 568   my $pvob = Clearcase::vobname ($SELECTED{pvob});
 569
 570   $CCDBService->connectToServer
 571     or error "Unable to connect to CCDBService", 1;
 572
 573   my ($status, $streams) = $CCDBService->execute ("FindStream * $pvob");
 574
 575   $CCDBService->disconnectFromServer;
 576
 577   if ($status) {
 578     Tkerror "Unable to get streams (Status: $status)\n" . join ("\n", @$output);
 579     return;
 580   } # if
 581
 582   # First empty @streams of the old contents
 583   @streams = ();
 584
 585   push @streams, $$_{name}
 586     foreach (@$streams);
 587
 588   clearList $fromBaselineDropdown;
 589   clearList $toBaselineDropdown;
 590
 591   $SELECTED{fromBaseline} = '';
 592   $SELECTED{toBaseline}   = '';
 593
 594   $fromBaselineDropdown->update;
 595   $toBaselineDropdown->update;
 596
 597   clearList $output;
 598
 599   $SELECTED{stream} = '';
 600
 601   setList $streamDropdown, sort @streams;
 602
 603   $streamDropdown->focus;
 604
 605   $main->Unbusy;
 606
 607   return;
 608 } # getStreams
 609
 610 sub getBaselines () {
 611   $main->Busy (-recurse => 1);
 612
 613   $searchPattern = '';
 614
 615   my $status;
 616
 617   clearList $fromBaselineDropdown;
 618   clearList $toBaselineDropdown;
 619
 620   $SELECTED{fromBaseline} = 'Getting baselines...';
 621   $SELECTED{toBaseline}   = 'Getting baselines...';
 622
 623   $fromBaselineDropdown->update;
 624   $toBaselineDropdown->update;
 625
 626   ($status, @fromBaselines) = $Clearcase::CC->execute
 627     ("lsbl -short -stream $SELECTED{stream}\@$Clearcase::VOBTAG_PREFIX$SELECTED{pvob}");
 628
 629   @toBaselines = @fromBaselines;
 630
 631   clearList $fromBaselineDropdown;
 632   clearList $toBaselineDropdown;
 633
 634   $SELECTED{fromBaseline} = '';
 635   $SELECTED{toBaseline}   = '';
 636
 637   $fromBaselineDropdown->update;
 638   $toBaselineDropdown->update;
 639
 640   clearList $output;
 641
 642   setList $fromBaselineDropdown, sort @fromBaselines;
 643   setList $toBaselineDropdown,   sort @toBaselines;
 644
 645   $main->Unbusy;
 646
 647   return;
 648 } # getBaselines
 649
 650 sub saveList () {
 651   my @types = (
 652     ['Text Files', '.txt', 'TEXT'],
 653     ['All Files',   '*']
 654   );
 655
 656   my $filename = $main->getSaveFile (
 657     -filetype         => \@types,
 658     -initialfile      => "$SELECTED{fromBaseline}.$SELECTED{toBaseline}.diffs",
 659     -defaultextension => '.txt',
 660   );
 661
 662   return unless $filename;
 663
 664   open my $file, '>', $filename
 665     or Tkmsg "Unable to open $filename for writing - $!", -1
 666     and return;
 667
 668   foreach ($output->get (0, 'end')) {
 669     print $file "$_\n";
 670   } # foreach
 671
 672   close $file;
 673
 674   return;
 675 } # saveList
 676
 677 sub childDeath () {
 678   my $pid = wait;
 679
 680   display "$pid died";
 681
 682   CORE::exit;
 683
 684   return;
 685 } # childDeath
 686
 687 local $SIG{CLD} = \&childDeath;
 688 local $SIG{CHLD} = \&childDeath;
 689
 690 sub ccexec ($;$$) {
 691   my ($cmd, $parm1, $parm2) = @_;
 692
 693   unless ($parm1) {
 694     my $selected = $output->curselection;
 695
 696     return
 697       unless $selected;
 698
 699     my $line = $output->get ($selected);
 700
 701     if ($MODE eq 'versions') {
 702       # Need to add on the view tag prefix
 703       $cmd .= " $Clearcase::VIEWTAG_PREFIX/" . $::view->tag . $line;
 704     } else {
 705       $cmd .= " activity:$line\@";
 706       $cmd .= Clearcase::vobtag $SELECTED{pvob};
 707     } # if
 708   } else {
 709     $cmd .= " $parm1 $parm2";
 710   } # unless
 711
 712   $main->Busy (-recurse => 1);
 713
 714   if ($ARCH eq 'windows' or $ARCH eq 'cygwin') {
 715     $Clearcase::CC->execute ($cmd);
 716   } else {
 717     # Use fork/exec to allow CC processes to not cause us to block
 718     unless (fork) {
 719       $Clearcase::CC->execute ($cmd);
 720       CORE::exit;
 721     } # unless
 722   } # if
 723
 724   $main->Unbusy;
 725
 726   return
 727 } # ccexec
 728
 729 sub findVersion ($$) {
 730   my ($element, $baseline) = @_;
 731
 732   my $cmd = 'find ' . substr ($element, 1) . ' -directory ';
 733      $cmd .= "-version 'lbtype($baseline)' -print";
 734
 735   my ($status, @output) = $Clearcase::CC->execute ($cmd);
 736
 737   if ($status) {
 738     my $msg = "Unable to determine the version for $element ($baseline)";
 739
 740     Tkerror join ("\n", "$msg (Status: $status)", "\n", @output);
 741
 742     exit $status;
 743   } # if
 744
 745   # Change these silly '\'s -> '/'s
 746   $output[0] =~ s/\\/\//g;
 747
 748   my $version;
 749
 750   if ($output[0] =~ /.*$Clearcase::SFX(.*)/) {
 751     $version = $1;
 752   } # if
 753
 754   return $version
 755 } # findVersion
 756
 757 sub compareToPrev () {
 758   my $selected = $output->curselection;
 759
 760   return
 761     unless $selected;
 762
 763   my $element = $output->get ($selected);
 764
 765   # Need to add on the view tag prefix
 766   my $element1  = "$Clearcase::VIEWTAG_PREFIX/" . $::view->tag . $element;
 767   my $element2  = "$Clearcase::VIEWTAG_PREFIX/" . $::view->tag . $element;
 768
 769   # Get into the view context
 770   my $view_context = $Clearcase::VIEWTAG_PREFIX . '/' . $::view->tag;
 771   my $cwd          = getcwd;
 772
 773   # For my Cygwin environment - translate that path back into a Windows path
 774   if ($ARCH eq 'cygwin') {
 775     my @cwd = `cygpath -w $cwd`;
 776     chomp @cwd;
 777
 778     $cwd = $cwd[0];
 779   } # if
 780
 781   my ($status, @output) = $Clearcase::CC->execute ("cd \"$view_context\"");
 782
 783   Tkerror "Unable to set view context to $view_context (Status: $status)" .
 784     join ("\n", @output)
 785     if $status;
 786
 787   my $version;
 788
 789   # Determine from baseline version
 790   $version   = findVersion $element, $SELECTED{fromBaseline};
 791   $element1 .= "$Clearcase::SFX$version";
 792
 793   # Determine to baseline version
 794   $version   = findVersion $element, $SELECTED{toBaseline};
 795   $element2 .= "$Clearcase::SFX$version";
 796
 797   ccexec 'diff -g', $element1, $element2;
 798
 799   return;
 800 } # compareToPrev
 801
 802 sub history () {
 803   ccexec 'lshist -g';
 804
 805   return;
 806 } # history
 807
 808 sub versionTree () {
 809   ccexec 'lsvtree -g';
 810
 811   return;
 812 } # versionTree
 813
 814 sub properties () {
 815   ccexec 'describe -g';
 816
 817   return;
 818 } # properties
 819
 820 sub displayLines () {
 821   clearList $output;
 822
 823   my @lines = keys %LINES;
 824
 825   if ($MODE eq 'activities') {
 826     @lines = grep {!/(deliver|rebase|tlmerge|integrate)/} @lines
 827       unless $INTEGRATIONACTIVITIES;
 828   } # if
 829
 830   setList $output, sort @lines;
 831
 832   my $msg = @lines > 0 ? @lines : 'No';
 833      $msg .= $MODE eq 'versions' ? ' Element' : ' Activit';
 834
 835   if ($MODE eq 'versions') {
 836     $msg .= 's'
 837       if @lines != 1;
 838   } else {
 839     if (@lines != 1) {
 840       $msg .= 'ies';
 841     } else {
 842       $msg .= 'y';
 843     } # if
 844   } # if
 845
 846   Tkmsg $msg, 3;
 847
 848   return;
 849 } # displayLines
 850
 851 sub setFocus () {
 852   my ($entry) = @_;
 853
 854   $searchPattern = '';
 855   $entry->icursor (0);
 856
 857   return;
 858 } # setFocus
 859
 860 sub createUI () {
 861   $main = MainWindow->new;
 862
 863   # Set an icon image
 864   $main->iconimage ($main->Photo (-file => "$FindBin::Bin/diffbl.gif"))
 865     if -f "$FindBin::Bin/diffbl.gif";
 866
 867   my $WIDTH = (length ($TITLE) + 1) * 10;
 868
 869   $main->geometry ("${WIDTH}x600");
 870   $main->title ("$FindBin::Script V$VERSION");
 871
 872   my @frame;
 873
 874   for (my $i = 0; $i < 9; $i++) {
 875     $frame[$i] = $main->Frame->pack;
 876   } # for
 877
 878   # Create versions popup menu
 879   $versionsMenu = $main->Menu (
 880     -tearoff    => 0,
 881   );
 882
 883   $versionsMenu->add (
 884     'command',
 885     -label      => 'Compare to Prev',
 886     -command    => \&compareToPrev,
 887   );
 888   $versionsMenu->add (
 889     'command',
 890     -label      => 'History',
 891     -command    => \&history,
 892   );
 893   $versionsMenu->add (
 894     'command',
 895     -label      => 'Version Tree',
 896     -command    => \&versionTree,
 897   );
 898   $versionsMenu->add (
 899     'command',
 900     -label      => 'Properties',
 901     -font       => 'Arial 8 bold',
 902     -command    => \&properties,
 903   );
 904
 905   # Create activities popup menu
 906   $activitiesMenu = $main->Menu (
 907     -tearoff    => 0,
 908   );
 909
 910   $activitiesMenu->add (
 911     'command',
 912     -label      => 'Show Contributing Activities',
 913     -state      => 'disable',
 914     -command    => [ \&Tkerror, "Unimplemented" ],
 915   );
 916   $activitiesMenu->add (
 917     'command',
 918     -label      => 'Checkin All',
 919     -state      => 'disable',
 920     -command    => [ \&Tkerror, "Unimplemented" ],
 921   );
 922   $activitiesMenu->add (
 923     'command',
 924     -label      => 'Finish Activity',
 925     -state      => 'disable',
 926     -command    => [ \&Tkerror, "Unimplemented" ],
 927   );
 928   $activitiesMenu->add (
 929     'command',
 930     -label      => 'Properties',
 931     -font       => 'Arial 8 bold',
 932     -command    => \&properties,
 933   );
 934
 935   $frame[0]->Label (
 936     -font   => 'Arial 10 bold',
 937     -text   => $TITLE,
 938     -anchor => 'center',
 939   )->pack;
 940
 941   $pvobDropdown = createDropdown (
 942     $frame[1],
 943     'Project Vob',
 944     \$SELECTED{pvob},
 945     \&getStreams,
 946     \&getPvobs,
 947   );
 948
 949   # Remove the Leave binding from $pvobDropDown
 950   $pvobDropdown->bind ('<FocusOut>', undef);
 951
 952   $streamDropdown = createDropdown (
 953     $frame[2],
 954     'Stream',
 955     \$SELECTED{stream},
 956     \&getBaselines,
 957   );
 958
 959   $streamDropdown->bind ('<FocusIn>', \&setFocus);
 960
 961   $fromBaselineDropdown = createDropdown (
 962     $frame[3],
 963     'From baseline',
 964     \$SELECTED{fromBaseline},
 965   );
 966
 967   $fromBaselineDropdown->bind ('<FocusIn>', \&setFocus);
 968
 969   $toBaselineDropdown = createDropdown (
 970     $frame[4],
 971     'To baseline',
 972     \$SELECTED{toBaseline},
 973   );
 974
 975   $toBaselineDropdown->bind ('<FocusIn>', \&setFocus);
 976
 977   $frame[5]->Label (
 978     -text => 'Show:',
 979     -font => 'Arial 8 bold',
 980   )->pack (
 981     -side    => "left",
 982     -padx    => 5,
 983     -pady    => 5,
 984   );
 985   my $versionsToggle = $frame[5]->Radiobutton (
 986     -text     => 'Versions',
 987     -value    => 'versions',
 988     -variable => \$MODE,
 989     -command  => \&::compareBaselines,
 990   )->pack (
 991     -side    => "left",
 992     -padx    => 5,
 993     -pady    => 5,
 994   );
 995   my $activitiesToggle = $frame[5]->Radiobutton (
 996     -text     => 'Activities',
 997     -value    => 'activities',
 998     -variable => \$MODE,
 999     -command  => \&::compareBaselines,
1000   )->pack (
1001     -side    => "left",
1002     -padx    => 5,
1003     -pady    => 5,
1004   );
1005
1006   # Toggle on activities
1007   $activitiesToggle->select;
1008
1009   $integrationActivitiesCheck = $frame[5]->Checkbutton (
1010     -text     => 'Integration activities',
1011     -variable => \$INTEGRATIONACTIVITIES,
1012     -command  => \&displayLines,
1013   )->pack (
1014     -side    => "left",
1015     -padx    => 5,
1016     -pady    => 5,
1017   );
1018
1019   $output = createList $frame[6];
1020
1021   $msgWidget = $frame[7]->Label (
1022     -font => 'Arial 8 bold',
1023   )->pack;
1024
1025   createButton $frame[8], 'About',   \&about;
1026   $compareButton = createButton $frame[8], 'Compare', \&::compareBaselines;
1027   createButton $frame[8], 'Save',    \&saveList;
1028   createButton $frame[8], 'Exit',    \&exit;
1029
1030   # Now populate the streams
1031   getStreams;
1032
1033   MainLoop;
1034
1035   return;
1036 } # createUI
1037
1038 1;