Ticket #1444: padre-vcs-tobyink-20120604.diff

File padre-vcs-tobyink-20120604.diff, 16.0 KB (added by bowtie, 10 months ago)

  • Padre/Padre.fbp

     
    2554625546                        <property name="permission">protected</property> 
    2554725547                        <property name="pos"></property> 
    2554825548                        <property name="size"></property> 
    25549                         <property name="style">wxLC_REPORT|wxLC_SINGLE_SEL</property> 
     25549                        <property name="style">wxLC_REPORT</property> 
    2555025550                        <property name="subclass"></property> 
    2555125551                        <property name="tooltip"></property> 
    2555225552                        <property name="validator_data_type"></property> 

  • Padre/lib/Padre/Wx/VCS.pm

     
    178178    my $self    = shift; 
    179179    my $current = shift or return; 
    180180    my $command = shift || Padre::Task::VCS::VCS_STATUS; 
     181    my $files   = shift || []; 
     182    my %extra   = %{ shift || +{} }; 
    181183 
    182184    my $document = $current->document; 
    183185 
    … …  
    206208    } 
    207209 
    208210    # Not supported VCS check 
    209     if ( $vcs ne Padre::Constant::SUBVERSION and $vcs ne Padre::Constant::GIT ) { 
     211    if ( $vcs ne Padre::Constant::SUBVERSION and $vcs ne Padre::Constant::GIT and $vcs ne Padre::Constant::MERCURIAL ) { 
    210212        $self->{status}->SetValue( sprintf( Wx::gettext('%s version control is not currently available'), $vcs ) ); 
    211213        return; 
    212214    } 
    213215 
    214  
    215216    # Start a background VCS status task 
    216217    $self->task_request( 
    217218        task     => 'Padre::Task::VCS', 
    218219        command  => $command, 
    219220        document => $document, 
     221        files    => $files, 
     222        %extra, 
    220223    ); 
    221224 
    222225    return 1; 
    … …  
    265268        '?' => { name => Wx::gettext('Unversioned') }, 
    266269    ); 
    267270 
    268     my %vcs_status = $self->{vcs} eq Padre::Constant::SUBVERSION ? %SVN_STATUS : %GIT_STATUS; 
     271    my %vcs_status = $self->{vcs} eq Padre::Constant::GIT ? %GIT_STATUS : %SVN_STATUS; 
    269272 
    270273    # Add a zero count key for VCS status hash 
    271274    $vcs_status{$_}->{count} = 0 for keys %vcs_status; 
    … …  
    484487    $self->render; 
    485488} 
    486489 
     490my @default_message = map { Wx::gettext($_) } 
     491( 
     492    q[DAAAAHUUUUUT!!!!], 
     493    q[Reverse the polarity of the neutron flow.], 
     494    q[Increase shareholder value.], 
     495    q[This patch fixes all known and future bugs in everything ever.], 
     496    q[I updated some code. Yay for me!], 
     497); 
     498 
    487499# Called when "Commit" button is clicked 
    488500sub on_commit_click { 
    489501    my $self = shift; 
    490502    my $main = $self->main; 
     503     
     504    my @files = $self->_get_selected or return; 
    491505 
    492506    return 
    493507        unless $main->yes_no( 
     508        sprintf( Wx::gettext('Commit %s to repository?'), $self->_display_selected(@files) ), 
    494509        Wx::gettext("Do you want to commit?"), 
    495         Wx::gettext('Commit file/directory to repository?') 
    496510        ); 
     511     
     512    my $message = $main->simple_prompt( 
     513        Wx::gettext("Commit message"), 
     514        Wx::gettext("Please provide a description of the changes for the commit log."), 
     515        $default_message[ rand(@default_message) ], 
     516    ) or return; 
    497517 
    498     $main->vcs->refresh( $self->current, Padre::Task::VCS::VCS_COMMIT ); 
     518    $main->vcs->refresh( $self->current, Padre::Task::VCS::VCS_COMMIT, \@files, { commit_message => $message } ); 
    499519} 
    500520 
    501521# Called when "Add" button is clicked 
    502522sub on_add_click { 
    503523    my $self = shift; 
     524    my $main = $self->main; 
    504525 
    505     my $main           = $self->main; 
    506     my $list           = $self->{list}; 
    507     my $selected_index = $list->GetNextItem( -1, Wx::LIST_NEXT_ALL, Wx::LIST_STATE_SELECTED ); 
    508     return if $selected_index == -1; 
    509     my $rec = $self->{model}->[ $list->GetItemData($selected_index) ] or return; 
    510     my $filename = $rec->{fullpath}; 
     526    my @files = $self->_get_selected or return; 
    511527 
    512528    return 
    513529        unless $main->yes_no( 
    514         sprintf( Wx::gettext("Do you want to add '%s' to your repository"), $filename ), 
    515         Wx::gettext('Add file to repository?') 
     530        sprintf( Wx::gettext("Do you want to add %s to your repository?"), $self->_display_selected(@files) ), 
     531        Wx::gettext('Add to repository?') 
    516532        ); 
    517533 
    518     $main->vcs->refresh( $self->current, Padre::Task::VCS::VCS_ADD ); 
     534    $main->vcs->refresh( $self->current, Padre::Task::VCS::VCS_ADD, \@files ); 
    519535} 
    520536 
    521537# Called when "Delete" checkbox is clicked 
    522538sub on_delete_click { 
    523539    my $self           = shift; 
    524540    my $main           = $self->main; 
    525     my $list           = $self->{list}; 
    526     my $selected_index = $list->GetNextItem( -1, Wx::LIST_NEXT_ALL, Wx::LIST_STATE_SELECTED ); 
    527     return if $selected_index == -1; 
    528     my $rec = $self->{model}->[ $list->GetItemData($selected_index) ] or return; 
    529     my $filename = $rec->{fullpath}; 
    530541 
     542    my @files = $self->_get_selected or return; 
     543 
    531544    return 
    532545        unless $main->yes_no( 
    533         sprintf( Wx::gettext("Do you want to delete '%s' from your repository"), $filename ), 
    534         Wx::gettext('Delete file from repository??') 
     546        sprintf( Wx::gettext("Do you want to delete %s from your repository?"), $self->_display_selected(@files) ), 
     547        Wx::gettext('Delete from repository??') 
    535548        ); 
    536549 
    537     $main->vcs->refresh( $self->current, Padre::Task::VCS::VCS_DELETE ); 
     550    $main->vcs->refresh( $self->current, Padre::Task::VCS::VCS_DELETE, \@files ); 
    538551} 
    539552 
    540553# Called when "Update" button is clicked 
    … …  
    549562sub on_revert_click { 
    550563    my $self           = shift; 
    551564    my $main           = $self->main; 
    552     my $list           = $self->{list}; 
    553     my $selected_index = $list->GetNextItem( -1, Wx::LIST_NEXT_ALL, Wx::LIST_STATE_SELECTED ); 
    554     return if $selected_index == -1; 
    555     my $rec = $self->{model}->[ $list->GetItemData($selected_index) ] or return; 
    556     my $filename = $rec->{fullpath}; 
    557565 
     566    my @files = $self->_get_selected or return; 
     567 
    558568    return 
    559569        unless $main->yes_no( 
    560         sprintf( Wx::gettext("Do you want to revert changes to '%s'"), $filename ), 
     570        sprintf( Wx::gettext("Do you want to revert changes to %s?"), $self->_display_selected(@files) ), 
    561571        Wx::gettext('Revert changes?') 
    562572        ); 
    563573 
    564     $main->vcs->refresh( $self->current, Padre::Task::VCS::VCS_REVERT ); 
     574    $main->vcs->refresh( $self->current, Padre::Task::VCS::VCS_REVERT, \@files ); 
    565575} 
    566576 
     577sub _display_selected 
     578{ 
     579    my ($self, @files) = @_; 
     580    if (@files == 1) { 
     581        return qq{'$files[0]'}; 
     582    } 
     583    else { 
     584        sprintf( Wx::gettext("%d files"), scalar(@files) ), 
     585    } 
     586} 
     587 
     588sub _get_selected 
     589{ 
     590    my $self           = shift; 
     591    my $list           = $self->{list}; 
     592     
     593    my @files; 
     594    my $last = -1; 
     595     
     596    while ( 
     597        (my $selected_index = $list->GetNextItem($last, Wx::LIST_NEXT_ALL, Wx::LIST_STATE_SELECTED)) 
     598        >= 0 
     599    ) { 
     600        my $rec = $self->{model}->[ $list->GetItemData($selected_index) ] or return @files; 
     601        push @files, $rec->{fullpath}; 
     602        $last = $selected_index; 
     603    } 
     604     
     605    return @files; 
     606} 
     607 
    5676081; 
    568609 
    569610# Copyright 2008-2012 The Padre development team as listed in Padre.pm. 

  • Padre/lib/Padre/Wx/FBP/VCS.pm

     
    156156        -1, 
    157157        Wx::DefaultPosition, 
    158158        Wx::DefaultSize, 
    159         Wx::LC_REPORT | Wx::LC_SINGLE_SEL, 
     159        Wx::LC_REPORT, 
    160160    ); 
    161161 
    162162    Wx::Event::EVT_LIST_COL_CLICK( 

  • Padre/lib/Padre/Task/VCS.pm

     
    7272    return unless $self->{project_dir}; 
    7373    my $project_dir = delete $self->{project_dir}; 
    7474 
    75     # bail out if a version control system is not currently supported 
    76     return unless ( $vcs eq Padre::Constant::SUBVERSION or $vcs eq Padre::Constant::GIT ); 
     75#   # bail out if a version control system is not currently supported 
     76#   return unless ( $vcs eq Padre::Constant::SUBVERSION or $vcs eq Padre::Constant::GIT or $vcs eq Padre::Constant::MERCURIAL ); 
    7777 
    7878    if ( $command eq VCS_STATUS ) { 
    7979        if ( $vcs eq Padre::Constant::SUBVERSION ) { 
    8080            $self->{model} = $self->_find_svn_status($project_dir); 
    8181        } elsif ( $vcs eq Padre::Constant::GIT ) { 
    8282            $self->{model} = $self->_find_git_status($project_dir); 
     83        } elsif ( $vcs eq Padre::Constant::MERCURIAL ) { 
     84            $self->{model} = $self->_find_hg_status($project_dir); 
    8385        } else { 
    84             die VCS_STATUS . " is not supported for $vcs\n"; 
     86            warn VCS_STATUS . " is not supported for $vcs\n"; 
     87            return; 
    8588        } 
    86     } else { 
     89    } 
     90    elsif ( $command eq VCS_ADD ) { 
     91        if ( $vcs eq Padre::Constant::SUBVERSION ) { 
     92            $self->{model} = $self->_svn_add_files($project_dir, $self->{files}); 
     93        } elsif ( $vcs eq Padre::Constant::MERCURIAL ) { 
     94            $self->{model} = $self->_hg_add_files($project_dir, $self->{files}); 
     95        } else { 
     96            warn VCS_ADD . " is not supported for $vcs\n"; 
     97            return; 
     98        } 
     99    } 
     100    elsif ( $command eq VCS_DELETE ) { 
     101        if ( $vcs eq Padre::Constant::SUBVERSION ) { 
     102            $self->{model} = $self->_svn_delete_files($project_dir, $self->{files}); 
     103        } elsif ( $vcs eq Padre::Constant::MERCURIAL ) { 
     104            $self->{model} = $self->_hg_delete_files($project_dir, $self->{files}); 
     105        } else { 
     106            warn VCS_DELETE . " is not supported for $vcs\n"; 
     107            return; 
     108        } 
     109    } 
     110    elsif ( $command eq VCS_COMMIT ) { 
     111        if ( $vcs eq Padre::Constant::SUBVERSION ) { 
     112            $self->{model} = $self->_svn_commit_files($project_dir, $self->{files}, $self->{commit_message}); 
     113        } elsif ( $vcs eq Padre::Constant::MERCURIAL ) { 
     114            $self->{model} = $self->_hg_commit_files($project_dir, $self->{files}, $self->{commit_message}); 
     115        } else { 
     116            warn VCS_COMMIT . " is not supported for $vcs\n"; 
     117            return; 
     118        } 
     119    } 
     120    elsif ( $command eq VCS_REVERT ) { 
     121        if ( $vcs eq Padre::Constant::SUBVERSION ) { 
     122            $self->{model} = $self->_svn_revert_files($project_dir, $self->{files}); 
     123        } elsif ( $vcs eq Padre::Constant::MERCURIAL ) { 
     124            $self->{model} = $self->_hg_revert_files($project_dir, $self->{files}); 
     125        } else { 
     126            warn VCS_REVERT . " is not supported for $vcs\n"; 
     127            return; 
     128        } 
     129    } 
     130    else { 
    87131        die "$command is not currently supported\n"; 
    88132    } 
    89133 
    90134    return 1; 
    91135} 
    92136 
    93 sub _find_svn_status { 
    94     my ( $self, $project_dir ) = @_; 
     137# function, not method! 
     138sub __quote_arg { 
     139    my $r = shift; 
     140    $r =~ s/[\\\"]/\\$1/; 
     141    qq{'$r'}; 
     142} 
    95143 
    96     my @model = (); 
    97  
     144sub _vcs_exec { 
     145    my ($self, $vcs, $project_dir, @args) = @_; 
     146     
    98147    # Create a temporary file for standard output redirection 
    99148    my $out = File::Temp->new( UNLINK => 1 ); 
    100149    $out->close; 
    … …  
    103152    my $err = File::Temp->new( UNLINK => 1 ); 
    104153    $err->close; 
    105154 
    106     # Find the svn command line 
    107     my $svn = File::Which::which('svn') or return \@model; 
     155    # Find the hg command line 
     156    my $executable = File::Which::which($vcs) or return; 
    108157 
    109158    # Handle spaces in executable path under win32 
    110     $svn = qq{"$svn"} if Padre::Constant::WIN32; 
     159    $executable = qq{"$executable"} if Padre::Constant::WIN32; 
    111160 
    112     # run 'svn --no-ignore --verbose status' command 
    113161    my @cmd = ( 
    114         $svn, 
    115         '--no-ignore', 
    116         '--verbose', 
    117         'status', 
     162        $executable => @args, 
    118163        '1>' . $out->filename, 
    119164        '2>' . $err->filename, 
    120165    ); 
    121  
     166     
    122167    # We need shell redirection (list context does not give that) 
    123168    # Run command in directory 
    124     Padre::Util::run_in_directory( join( ' ', @cmd ), $project_dir ); 
     169    Padre::Util::run_in_directory( join(' ', @cmd), $project_dir ); 
     170    # Note - above is insane! The system() command accepts arguments 
     171    # as a list, so you don't need to worry about quoting. Joining them 
     172    # as a string is a disaster waiting to happen. 
    125173 
    126     # Slurp command standard input and output 
    127     my $stdout = Padre::Util::slurp $out->filename; 
     174    if (wantarray) { 
     175        my $stdout = Padre::Util::slurp $out->filename; 
     176        my $stderr = Padre::Util::slurp $err->filename; 
     177        return ($stdout, $stderr); 
     178    } 
     179    elsif (defined wantarray) { 
     180        # Slurp command standard input and output 
     181        my $stdout = Padre::Util::slurp $out->filename; 
     182        return $stdout; 
     183    } 
     184} 
    128185 
    129     #TODO parse Standard error? 
    130     #my $stderr = Padre::Util::slurp $err->filename; 
     186sub _hg_exec { 
     187    my ($self, @args) = @_; 
     188    $self->_vcs_exec(hg => @args); 
     189} 
    131190 
    132     if ($stdout) { 
    133         for my $line ( split /^/, $$stdout ) { 
     191sub _svn_exec { 
     192    my ($self, @args) = @_; 
     193    $self->_vcs_exec(hg => @args); 
     194} 
    134195 
    135             # Remove newlines and an extra CR (carriage return) 
    136             chomp($line); 
    137             $line =~ s/\r//g; 
    138             if ( $line =~ /^(\?|I)\s+(.+?)$/ ) { 
     196sub _find_hg_status { 
     197    my ($self, $project_dir) = @_; 
     198    my @model; 
     199     
     200    my $stdout = $self->_hg_exec($project_dir, qw( status --all )) 
     201        or return \@model; 
     202     
     203    # Map hg codes to subversion. 
     204    # This saves adding hg-specific stuff to Padre::Wx::VCS. 
     205    my $lookup = { 
     206        'M'    => 'M', 
     207        'A'    => 'A', 
     208        'R'    => 'D', 
     209        'C'    => ' ', 
     210        '!'    => '!', 
     211        '?'    => '?', 
     212        'I'    => 'I', 
     213    }; 
    139214 
    140                 # Handle unversioned and ignored objects 
    141                 push @model, 
    142                     { 
    143                     status   => $1, 
    144                     revision => '', 
    145                     author   => '', 
    146                     path     => $2, 
    147                     fullpath => File::Spec->catfile( $project_dir, $2 ), 
    148                     }; 
    149             } elsif ( $line =~ /^(.)\s+\d+\s+(\d+)\s+(\w+)\s+(.+?)$/ ) { 
     215    for my $line ( split /^/, $$stdout ) { 
     216        # Remove newlines and an extra CR (carriage return) 
     217        chomp($line); 
     218        $line =~ s/\r//g; 
     219         
     220        if ( $line =~ /^([MARC!?I])\s+(.+?)$/ ) { 
     221            push @model, 
     222                { 
     223                status   => $lookup->{$1}, 
     224                revision => '', 
     225                author   => '', 
     226                path     => $2, 
     227                fullpath => File::Spec->catfile($project_dir, $2), 
     228                }; 
     229        } else { 
     230            # Log the event but do not do anything drastic 
     231            # about it 
     232            TRACE("Cannot understand '$line'") if DEBUG; 
     233        } 
     234    } 
    150235 
    151                 # Handle other cases 
    152                 push @model, 
    153                     { 
    154                     status   => $1, 
    155                     revision => $2, 
    156                     author   => $3, 
    157                     path     => $4, 
    158                     fullpath => File::Spec->catfile( $project_dir, $4 ), 
    159                     }; 
    160             } else { 
     236    return \@model; 
     237} 
    161238 
    162                 # Log the event but do not do anything drastic 
    163                 # about it 
    164                 TRACE("Cannot understand '$line'") if DEBUG; 
    165             } 
     239sub _hg_add_files 
     240{ 
     241    my ($self, $project_dir, $files) = @_; 
     242    $self->_hg_exec($project_dir, add => (map { __quote_arg($_) } @$files)); 
     243    return $self->_find_hg_status($project_dir); 
     244} 
     245 
     246sub _hg_delete_files 
     247{ 
     248    my ($self, $project_dir, $files) = @_; 
     249    $self->_hg_exec($project_dir, remove => (map { __quote_arg($_) } @$files)); 
     250    return $self->_find_hg_status($project_dir); 
     251} 
     252 
     253sub _hg_commit_files 
     254{ 
     255    my ($self, $project_dir, $files, $message) = @_; 
     256    $self->_hg_exec($project_dir, commit => (map { __quote_arg($_) } @$files), -m => __quote_arg($message)); 
     257    return $self->_find_hg_status($project_dir); 
     258} 
     259 
     260sub _hg_revert_files 
     261{ 
     262    my ($self, $project_dir, $files) = @_; 
     263    $self->_hg_exec($project_dir, revert => (map { __quote_arg($_) } @$files)); 
     264    return $self->_find_hg_status($project_dir); 
     265} 
     266 
     267sub _find_svn_status { 
     268    my ($self, $project_dir) = @_; 
     269    my @model; 
     270 
     271    my $stdout = $self->_hg_exec($project_dir, qw( --no-ignore --verbose status )) 
     272        or return \@model; 
     273 
     274    for my $line ( split /^/, $$stdout ) { 
     275 
     276        # Remove newlines and an extra CR (carriage return) 
     277        chomp($line); 
     278        $line =~ s/\r//g; 
     279        if ( $line =~ /^(\?|I)\s+(.+?)$/ ) { 
     280 
     281            # Handle unversioned and ignored objects 
     282            push @model, 
     283                { 
     284                status   => $1, 
     285                revision => '', 
     286                author   => '', 
     287                path     => $2, 
     288                fullpath => File::Spec->catfile( $project_dir, $2 ), 
     289                }; 
     290        } elsif ( $line =~ /^(.)\s+\d+\s+(\d+)\s+(\w+)\s+(.+?)$/ ) { 
     291 
     292            # Handle other cases 
     293            push @model, 
     294                { 
     295                status   => $1, 
     296                revision => $2, 
     297                author   => $3, 
     298                path     => $4, 
     299                fullpath => File::Spec->catfile( $project_dir, $4 ), 
     300                }; 
     301        } else { 
     302 
     303            # Log the event but do not do anything drastic 
     304            # about it 
     305            TRACE("Cannot understand '$line'") if DEBUG; 
    166306        } 
    167307    } 
    168308 
    169309    return \@model; 
    170310} 
    171311 
     312sub _svn_add_files 
     313{ 
     314    my ($self, $project_dir, $files) = @_; 
     315    $self->_svn_exec($project_dir, add => (map { __quote_arg($_) } @$files)); 
     316    return $self->_find_svn_status($project_dir); 
     317} 
     318 
     319sub _svn_delete_files 
     320{ 
     321    my ($self, $project_dir, $files) = @_; 
     322    $self->_svn_exec($project_dir, remove => (map { __quote_arg($_) } @$files)); 
     323    return $self->_find_svn_status($project_dir); 
     324} 
     325 
     326sub _svn_commit_files 
     327{ 
     328    my ($self, $project_dir, $files, $message) = @_; 
     329    $self->_svn_exec($project_dir, commit => (map { __quote_arg($_) } @$files), -m => __quote_arg($message)); 
     330    return $self->_find_svn_status($project_dir); 
     331} 
     332 
     333sub _svn_revert_files 
     334{ 
     335    my ($self, $project_dir, $files) = @_; 
     336    $self->_svn_exec($project_dir, revert => (map { __quote_arg($_) } @$files)); 
     337    return $self->_find_svn_status($project_dir); 
     338} 
     339 
    172340sub _find_git_status { 
    173341    my ( $self, $project_dir ) = @_; 
    174342