"Fossies" - the Fresh Open Source Software Archive

Member "namefix.pl/libs/gui/br_preview.pm" (15 Sep 2009, 2767 Bytes) of package /linux/privat/old/namefix.pl_4.0.2.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. For more information about "br_preview.pm" see the Fossies "Dox" file reference documentation.

    1 #--------------------------------------------------------------------------------------------------------------
    2 # br_preview
    3 #--------------------------------------------------------------------------------------------------------------
    4 
    5 sub br_preview
    6 {
    7     &plog(3, "sub br_preview");
    8     &prep_globals;
    9 
   10     my @new_l = split(/\n/, $main::txt_r -> get('1.0', 'end'));
   11     my @old_l = split(/\n/, $main::txt -> get('1.0', 'end'));
   12 
   13     my $c = 0;
   14     my $of = "";    # old file
   15     my $nf = "";    # new file
   16     my $max = $#new_l;
   17     my @a = ();
   18     my @b = ();
   19 
   20     while($c <= $max)
   21     {
   22         $of = $old_l[$c];
   23         $nf = $new_l[$c];
   24         $nf =~ s/\n|\r//g;
   25         $of =~ s/\n|\r//g;
   26 
   27         &plog(4, "sub br_preview: processing \"$of\" \"$nf\" ");
   28         
   29         if(!$nf) # return when we hit a blank line, else we risk zero'ing the rest of the filenames
   30         {
   31             &plog(0, "sub br_preview: error no string for new filename");
   32             return;
   33         }
   34 
   35         $nf = &br_ed2k_cleanup($nf);
   36         if($of ne $nf)
   37         {
   38             &plog(4, "sub br_preview preview rename:\n\t\"$of\"\n\t\"$nf\"");
   39             push @a, $of;
   40             push @b, $nf;
   41         }
   42         else
   43         {
   44             &plog(4, "sub br_preview no changes to \"$of\"");
   45         }
   46         $c++;
   47     }
   48     &br_show_lists("BR Preview", \@a, \@b);
   49     return 1;
   50 }
   51 
   52 
   53 #--------------------------------------------------------------------------------------------------------------
   54 # br_preview_list 
   55 #--------------------------------------------------------------------------------------------------------------
   56 
   57 sub br_show_lists
   58 {
   59     &plog(3, "sub br_preview_list");
   60     my $title = shift;
   61     my $a = shift;
   62     my $b = shift;
   63     
   64     @a = @$a;
   65     @b = @$b;
   66     
   67     my $row = 0;
   68     my $col = 0;
   69     my $c = 0;
   70     
   71     # -----------------------
   72     # start drawing gui
   73     
   74         my $top = $main::mw -> Toplevel();
   75         $top -> title("$title");
   76 
   77     # hlist here
   78     
   79         my $hlist = $top -> Scrolled
   80         (
   81         "HList",
   82         -scrollbars=>"osoe",
   83         -header => 1,
   84         -columns=>3,
   85         -selectbackground => 'Cyan',
   86         -width=>80,
   87         
   88     )
   89         -> pack
   90     (
   91         -side=>"top",
   92         -fill=>"both",
   93         -expand=>1,
   94         );
   95 
   96         $top -> Button
   97     (
   98             -text=>"Close",
   99             -activebackground => "white",
  100             -command => sub 
  101         {
  102                 destroy $top;
  103             }
  104         )
  105         -> pack
  106     (
  107         -side=>"bottom",
  108         );
  109 
  110 #   $top->resizable(0,0);
  111 
  112     # --------------------------------
  113     # Gui drawn, add contents
  114     
  115     $hlist->header('create', 0, -text =>'Old Filename');
  116     $hlist->header('create', 1, -text =>'->');
  117     $hlist->header('create', 2, -text =>'New Filename');
  118 
  119 
  120     $c = 0;
  121     for(@a)
  122     {
  123         $hlist->add
  124         (
  125             $c
  126         );
  127         $hlist->itemCreate($c, 0, -text => $_);
  128         $hlist->itemCreate($c, 1, -text => " -> ");
  129         $hlist->itemCreate($c, 2, -text => "$b[$c]");
  130         $c++;
  131     }
  132 }
  133 
  134 1;