Index: Padre/Padre.fbp
===================================================================
--- Padre/Padre.fbp (revision 19083)
+++ Padre/Padre.fbp (working copy)
@@ -25546,7 +25546,7 @@
protected
- wxLC_REPORT|wxLC_SINGLE_SEL
+ wxLC_REPORT
Index: Padre/lib/Padre/Wx/VCS.pm
===================================================================
--- Padre/lib/Padre/Wx/VCS.pm (revision 19083)
+++ Padre/lib/Padre/Wx/VCS.pm (working copy)
@@ -178,6 +178,8 @@
my $self = shift;
my $current = shift or return;
my $command = shift || Padre::Task::VCS::VCS_STATUS;
+ my $files = shift || [];
+ my %extra = %{ shift || +{} };
my $document = $current->document;
@@ -206,17 +208,18 @@
}
# Not supported VCS check
- if ( $vcs ne Padre::Constant::SUBVERSION and $vcs ne Padre::Constant::GIT ) {
+ if ( $vcs ne Padre::Constant::SUBVERSION and $vcs ne Padre::Constant::GIT and $vcs ne Padre::Constant::MERCURIAL ) {
$self->{status}->SetValue( sprintf( Wx::gettext('%s version control is not currently available'), $vcs ) );
return;
}
-
# Start a background VCS status task
$self->task_request(
task => 'Padre::Task::VCS',
command => $command,
document => $document,
+ files => $files,
+ %extra,
);
return 1;
@@ -265,7 +268,7 @@
'?' => { name => Wx::gettext('Unversioned') },
);
- my %vcs_status = $self->{vcs} eq Padre::Constant::SUBVERSION ? %SVN_STATUS : %GIT_STATUS;
+ my %vcs_status = $self->{vcs} eq Padre::Constant::GIT ? %GIT_STATUS : %SVN_STATUS;
# Add a zero count key for VCS status hash
$vcs_status{$_}->{count} = 0 for keys %vcs_status;
@@ -484,57 +487,67 @@
$self->render;
}
+my @default_message = map { Wx::gettext($_) }
+(
+ q[DAAAAHUUUUUT!!!!],
+ q[Reverse the polarity of the neutron flow.],
+ q[Increase shareholder value.],
+ q[This patch fixes all known and future bugs in everything ever.],
+ q[I updated some code. Yay for me!],
+);
+
# Called when "Commit" button is clicked
sub on_commit_click {
my $self = shift;
my $main = $self->main;
+
+ my @files = $self->_get_selected or return;
return
unless $main->yes_no(
+ sprintf( Wx::gettext('Commit %s to repository?'), $self->_display_selected(@files) ),
Wx::gettext("Do you want to commit?"),
- Wx::gettext('Commit file/directory to repository?')
);
+
+ my $message = $main->simple_prompt(
+ Wx::gettext("Commit message"),
+ Wx::gettext("Please provide a description of the changes for the commit log."),
+ $default_message[ rand(@default_message) ],
+ ) or return;
- $main->vcs->refresh( $self->current, Padre::Task::VCS::VCS_COMMIT );
+ $main->vcs->refresh( $self->current, Padre::Task::VCS::VCS_COMMIT, \@files, { commit_message => $message } );
}
# Called when "Add" button is clicked
sub on_add_click {
my $self = shift;
+ my $main = $self->main;
- my $main = $self->main;
- my $list = $self->{list};
- my $selected_index = $list->GetNextItem( -1, Wx::LIST_NEXT_ALL, Wx::LIST_STATE_SELECTED );
- return if $selected_index == -1;
- my $rec = $self->{model}->[ $list->GetItemData($selected_index) ] or return;
- my $filename = $rec->{fullpath};
+ my @files = $self->_get_selected or return;
return
unless $main->yes_no(
- sprintf( Wx::gettext("Do you want to add '%s' to your repository"), $filename ),
- Wx::gettext('Add file to repository?')
+ sprintf( Wx::gettext("Do you want to add %s to your repository?"), $self->_display_selected(@files) ),
+ Wx::gettext('Add to repository?')
);
- $main->vcs->refresh( $self->current, Padre::Task::VCS::VCS_ADD );
+ $main->vcs->refresh( $self->current, Padre::Task::VCS::VCS_ADD, \@files );
}
# Called when "Delete" checkbox is clicked
sub on_delete_click {
my $self = shift;
my $main = $self->main;
- my $list = $self->{list};
- my $selected_index = $list->GetNextItem( -1, Wx::LIST_NEXT_ALL, Wx::LIST_STATE_SELECTED );
- return if $selected_index == -1;
- my $rec = $self->{model}->[ $list->GetItemData($selected_index) ] or return;
- my $filename = $rec->{fullpath};
+ my @files = $self->_get_selected or return;
+
return
unless $main->yes_no(
- sprintf( Wx::gettext("Do you want to delete '%s' from your repository"), $filename ),
- Wx::gettext('Delete file from repository??')
+ sprintf( Wx::gettext("Do you want to delete %s from your repository?"), $self->_display_selected(@files) ),
+ Wx::gettext('Delete from repository??')
);
- $main->vcs->refresh( $self->current, Padre::Task::VCS::VCS_DELETE );
+ $main->vcs->refresh( $self->current, Padre::Task::VCS::VCS_DELETE, \@files );
}
# Called when "Update" button is clicked
@@ -549,21 +562,49 @@
sub on_revert_click {
my $self = shift;
my $main = $self->main;
- my $list = $self->{list};
- my $selected_index = $list->GetNextItem( -1, Wx::LIST_NEXT_ALL, Wx::LIST_STATE_SELECTED );
- return if $selected_index == -1;
- my $rec = $self->{model}->[ $list->GetItemData($selected_index) ] or return;
- my $filename = $rec->{fullpath};
+ my @files = $self->_get_selected or return;
+
return
unless $main->yes_no(
- sprintf( Wx::gettext("Do you want to revert changes to '%s'"), $filename ),
+ sprintf( Wx::gettext("Do you want to revert changes to %s?"), $self->_display_selected(@files) ),
Wx::gettext('Revert changes?')
);
- $main->vcs->refresh( $self->current, Padre::Task::VCS::VCS_REVERT );
+ $main->vcs->refresh( $self->current, Padre::Task::VCS::VCS_REVERT, \@files );
}
+sub _display_selected
+{
+ my ($self, @files) = @_;
+ if (@files == 1) {
+ return qq{'$files[0]'};
+ }
+ else {
+ sprintf( Wx::gettext("%d files"), scalar(@files) ),
+ }
+}
+
+sub _get_selected
+{
+ my $self = shift;
+ my $list = $self->{list};
+
+ my @files;
+ my $last = -1;
+
+ while (
+ (my $selected_index = $list->GetNextItem($last, Wx::LIST_NEXT_ALL, Wx::LIST_STATE_SELECTED))
+ >= 0
+ ) {
+ my $rec = $self->{model}->[ $list->GetItemData($selected_index) ] or return @files;
+ push @files, $rec->{fullpath};
+ $last = $selected_index;
+ }
+
+ return @files;
+}
+
1;
# Copyright 2008-2012 The Padre development team as listed in Padre.pm.
Index: Padre/lib/Padre/Wx/FBP/VCS.pm
===================================================================
--- Padre/lib/Padre/Wx/FBP/VCS.pm (revision 19083)
+++ Padre/lib/Padre/Wx/FBP/VCS.pm (working copy)
@@ -156,7 +156,7 @@
-1,
Wx::DefaultPosition,
Wx::DefaultSize,
- Wx::LC_REPORT | Wx::LC_SINGLE_SEL,
+ Wx::LC_REPORT,
);
Wx::Event::EVT_LIST_COL_CLICK(
Index: Padre/lib/Padre/Task/VCS.pm
===================================================================
--- Padre/lib/Padre/Task/VCS.pm (revision 19083)
+++ Padre/lib/Padre/Task/VCS.pm (working copy)
@@ -72,29 +72,87 @@
return unless $self->{project_dir};
my $project_dir = delete $self->{project_dir};
- # bail out if a version control system is not currently supported
- return unless ( $vcs eq Padre::Constant::SUBVERSION or $vcs eq Padre::Constant::GIT );
+# # bail out if a version control system is not currently supported
+# return unless ( $vcs eq Padre::Constant::SUBVERSION or $vcs eq Padre::Constant::GIT or $vcs eq Padre::Constant::MERCURIAL );
+ # This is all pretty repetitive. Could be refactored to something better.
if ( $command eq VCS_STATUS ) {
if ( $vcs eq Padre::Constant::SUBVERSION ) {
$self->{model} = $self->_find_svn_status($project_dir);
} elsif ( $vcs eq Padre::Constant::GIT ) {
$self->{model} = $self->_find_git_status($project_dir);
+ } elsif ( $vcs eq Padre::Constant::MERCURIAL ) {
+ $self->{model} = $self->_find_hg_status($project_dir);
} else {
- die VCS_STATUS . " is not supported for $vcs\n";
+ warn VCS_STATUS . " is not supported for $vcs\n";
+ return;
}
- } else {
+ }
+ elsif ( $command eq VCS_ADD ) {
+ if ( $vcs eq Padre::Constant::SUBVERSION ) {
+ $self->{model} = $self->_svn_add_files($project_dir, $self->{files});
+ } elsif ( $vcs eq Padre::Constant::GIT ) {
+ $self->{model} = $self->_git_add_files($project_dir, $self->{files});
+ } elsif ( $vcs eq Padre::Constant::MERCURIAL ) {
+ $self->{model} = $self->_hg_add_files($project_dir, $self->{files});
+ } else {
+ warn VCS_ADD . " is not supported for $vcs\n";
+ return;
+ }
+ }
+ elsif ( $command eq VCS_DELETE ) {
+ if ( $vcs eq Padre::Constant::SUBVERSION ) {
+ $self->{model} = $self->_svn_delete_files($project_dir, $self->{files});
+ } elsif ( $vcs eq Padre::Constant::GIT ) {
+ $self->{model} = $self->_git_delete_files($project_dir, $self->{files});
+ } elsif ( $vcs eq Padre::Constant::MERCURIAL ) {
+ $self->{model} = $self->_hg_delete_files($project_dir, $self->{files});
+ } else {
+ warn VCS_DELETE . " is not supported for $vcs\n";
+ return;
+ }
+ }
+ elsif ( $command eq VCS_COMMIT ) {
+ if ( $vcs eq Padre::Constant::SUBVERSION ) {
+ $self->{model} = $self->_svn_commit_files($project_dir, $self->{files}, $self->{commit_message});
+ } elsif ( $vcs eq Padre::Constant::GIT ) {
+ $self->{model} = $self->_git_commit_files($project_dir, $self->{files}, $self->{commit_message});
+ } elsif ( $vcs eq Padre::Constant::MERCURIAL ) {
+ $self->{model} = $self->_hg_commit_files($project_dir, $self->{files}, $self->{commit_message});
+ } else {
+ warn VCS_COMMIT . " is not supported for $vcs\n";
+ return;
+ }
+ }
+ elsif ( $command eq VCS_REVERT ) {
+ if ( $vcs eq Padre::Constant::SUBVERSION ) {
+ $self->{model} = $self->_svn_revert_files($project_dir, $self->{files});
+ } elsif ( $vcs eq Padre::Constant::GIT ) {
+ $self->{model} = $self->_git_revert_files($project_dir, $self->{files});
+ } elsif ( $vcs eq Padre::Constant::MERCURIAL ) {
+ $self->{model} = $self->_hg_revert_files($project_dir, $self->{files});
+ } else {
+ warn VCS_REVERT . " is not supported for $vcs\n";
+ return;
+ }
+ }
+ else {
die "$command is not currently supported\n";
}
return 1;
}
-sub _find_svn_status {
- my ( $self, $project_dir ) = @_;
+# function, not method!
+sub __quote_arg {
+ my $r = shift;
+ $r =~ s/[\\\"]/\\$1/;
+ qq{'$r'};
+}
- my @model = ();
-
+sub _vcs_exec {
+ my ($self, $vcs, $project_dir, @args) = @_;
+
# Create a temporary file for standard output redirection
my $out = File::Temp->new( UNLINK => 1 );
$out->close;
@@ -103,138 +161,261 @@
my $err = File::Temp->new( UNLINK => 1 );
$err->close;
- # Find the svn command line
- my $svn = File::Which::which('svn') or return \@model;
+ # Find the hg command line
+ my $executable = File::Which::which($vcs) or return;
# Handle spaces in executable path under win32
- $svn = qq{"$svn"} if Padre::Constant::WIN32;
+ $executable = qq{"$executable"} if Padre::Constant::WIN32;
- # run 'svn --no-ignore --verbose status' command
my @cmd = (
- $svn,
- '--no-ignore',
- '--verbose',
- 'status',
+ $executable => @args,
'1>' . $out->filename,
'2>' . $err->filename,
);
-
+# warn "COMMAND: @cmd";
+
# We need shell redirection (list context does not give that)
# Run command in directory
- Padre::Util::run_in_directory( join( ' ', @cmd ), $project_dir );
+ Padre::Util::run_in_directory( join(' ', @cmd), $project_dir );
+ # Note - above is suboptimal! The system() command accepts arguments
+ # as a list, so you don't need to worry about quoting. Joining them
+ # as a string is a disaster waiting to happen.
- # Slurp command standard input and output
- my $stdout = Padre::Util::slurp $out->filename;
+ if (wantarray) {
+ my $stdout = Padre::Util::slurp $out->filename;
+ my $stderr = Padre::Util::slurp $err->filename;
+ return ($stdout, $stderr);
+ }
+ elsif (defined wantarray) {
+ # Slurp command standard input and output
+ my $stdout = Padre::Util::slurp $out->filename;
+ return $stdout;
+ }
+}
- #TODO parse Standard error?
- #my $stderr = Padre::Util::slurp $err->filename;
+sub _hg_exec {
+ my ($self, @args) = @_;
+ $self->_vcs_exec(hg => @args);
+}
- if ($stdout) {
- for my $line ( split /^/, $$stdout ) {
+sub _svn_exec {
+ my ($self, @args) = @_;
+ $self->_vcs_exec(svn => @args);
+}
- # Remove newlines and an extra CR (carriage return)
- chomp($line);
- $line =~ s/\r//g;
- if ( $line =~ /^(\?|I)\s+(.+?)$/ ) {
+sub _git_exec {
+ my ($self, @args) = @_;
+ $self->_vcs_exec(git => @args);
+}
- # Handle unversioned and ignored objects
- push @model,
- {
- status => $1,
- revision => '',
- author => '',
- path => $2,
- fullpath => File::Spec->catfile( $project_dir, $2 ),
- };
- } elsif ( $line =~ /^(.)\s+\d+\s+(\d+)\s+(\w+)\s+(.+?)$/ ) {
+sub _find_hg_status {
+ my ($self, $project_dir) = @_;
+ my @model;
+
+ my $stdout = $self->_hg_exec($project_dir, qw( status --all ))
+ or return \@model;
+
+ # Map hg codes to subversion.
+ # This saves adding hg-specific stuff to Padre::Wx::VCS.
+ my $lookup = {
+ 'M' => 'M',
+ 'A' => 'A',
+ 'R' => 'D',
+ 'C' => ' ',
+ '!' => '!',
+ '?' => '?',
+ 'I' => 'I',
+ };
- # Handle other cases
- push @model,
- {
- status => $1,
- revision => $2,
- author => $3,
- path => $4,
- fullpath => File::Spec->catfile( $project_dir, $4 ),
- };
- } else {
-
- # Log the event but do not do anything drastic
- # about it
- TRACE("Cannot understand '$line'") if DEBUG;
- }
+ for my $line ( split /^/, $$stdout ) {
+ # Remove newlines and an extra CR (carriage return)
+ chomp($line);
+ $line =~ s/\r//g;
+
+ if ( $line =~ /^([MARC!?I])\s+(.+?)$/ ) {
+ push @model,
+ {
+ status => $lookup->{$1},
+ revision => '',
+ author => '',
+ path => $2,
+ fullpath => File::Spec->catfile($project_dir, $2),
+ };
+ } else {
+ # Log the event but do not do anything drastic
+ # about it
+ TRACE("Cannot understand '$line'") if DEBUG;
}
}
return \@model;
}
-sub _find_git_status {
- my ( $self, $project_dir ) = @_;
+sub _hg_add_files
+{
+ my ($self, $project_dir, $files) = @_;
+ $self->_hg_exec($project_dir, add => (map { __quote_arg($_) } @$files));
+ return $self->_find_hg_status($project_dir);
+}
- my @model = ();
+sub _hg_delete_files
+{
+ my ($self, $project_dir, $files) = @_;
+ $self->_hg_exec($project_dir, remove => (map { __quote_arg($_) } @$files));
+ return $self->_find_hg_status($project_dir);
+}
- # Create a temporary file for standard output redirection
- my $out = File::Temp->new( UNLINK => 1 );
- $out->close;
+sub _hg_commit_files
+{
+ my ($self, $project_dir, $files, $message) = @_;
+ $self->_hg_exec($project_dir, commit => (map { __quote_arg($_) } @$files), -m => __quote_arg($message));
+ return $self->_find_hg_status($project_dir);
+}
- # Create a temporary file for standard error redirection
- my $err = File::Temp->new( UNLINK => 1 );
- $err->close;
+sub _hg_revert_files
+{
+ my ($self, $project_dir, $files) = @_;
+ $self->_hg_exec($project_dir, revert => (map { __quote_arg($_) } @$files));
+ return $self->_find_hg_status($project_dir);
+}
- # Find the git command line
- my $git = File::Which::which('git') or return \@model;
+sub _find_svn_status {
+ my ($self, $project_dir) = @_;
+ my @model;
- # Handle spaces in executable path under win32
- $git = qq{"$git"} if Padre::Constant::WIN32;
+ my $stdout = $self->_svn_exec($project_dir, qw( --no-ignore --verbose status ))
+ or return \@model;
- # run 'git status --short' command
- my @cmd = (
- $git,
- 'status',
- '--short',
- '1>' . $out->filename,
- '2>' . $err->filename,
- );
+ for my $line ( split /^/, $$stdout ) {
- # We need shell redirection (list context does not give that)
- # Run command in directory
- Padre::Util::run_in_directory( join( ' ', @cmd ), $project_dir );
+ # Remove newlines and an extra CR (carriage return)
+ chomp($line);
+ $line =~ s/\r//g;
+ if ( $line =~ /^(\?|I)\s+(.+?)$/ ) {
- # Slurp command standard input and output
- my $stdout = Padre::Util::slurp $out->filename;
+ # Handle unversioned and ignored objects
+ push @model,
+ {
+ status => $1,
+ revision => '',
+ author => '',
+ path => $2,
+ fullpath => File::Spec->catfile( $project_dir, $2 ),
+ };
+ } elsif ( $line =~ /^(.)\s+\d+\s+(\d+|\?)\s+(\w+|\?)\s+(.+?)$/ ) {
- if ($stdout) {
- for my $line ( split /^/, $$stdout ) {
- chomp($line);
- if ( $line =~ /^(..)\s+(.+?)(?:\s\->\s(.+?))?$/ ) {
+ # Handle other cases
+ push @model,
+ {
+ status => $1,
+ revision => $2,
+ author => $3,
+ path => $4,
+ fullpath => File::Spec->catfile( $project_dir, $4 ),
+ };
+ } else {
- # Handle stuff
- my $status = $1;
- my $path = defined $3 ? $3 : $2;
+ # Log the event but do not do anything drastic
+ # about it
+ TRACE("Cannot understand '$line'") if DEBUG;
+ }
+ }
- $status =~ s/(^\s+)|(\s+$)//;
- $status =~ s/\?\?/?/;
- push @model,
- {
- status => $status,
- revision => '',
- author => '',
- path => $path,
- fullpath => File::Spec->catfile( $project_dir, $path ),
- };
- } else {
+ return \@model;
+}
- # Log the event but do not do anything drastic
- # about it
- TRACE("Cannot understand '$line'") if DEBUG;
- }
+sub _svn_add_files
+{
+ my ($self, $project_dir, $files) = @_;
+ $self->_svn_exec($project_dir, add => (map { __quote_arg($_) } @$files));
+ return $self->_find_svn_status($project_dir);
+}
+
+sub _svn_delete_files
+{
+ my ($self, $project_dir, $files) = @_;
+ $self->_svn_exec($project_dir, remove => (map { __quote_arg($_) } @$files));
+ return $self->_find_svn_status($project_dir);
+}
+
+sub _svn_commit_files
+{
+ my ($self, $project_dir, $files, $message) = @_;
+ $self->_svn_exec($project_dir, commit => (map { __quote_arg($_) } @$files), -m => __quote_arg($message));
+ return $self->_find_svn_status($project_dir);
+}
+
+sub _svn_revert_files
+{
+ my ($self, $project_dir, $files) = @_;
+ $self->_svn_exec($project_dir, revert => (map { __quote_arg($_) } @$files));
+ return $self->_find_svn_status($project_dir);
+}
+
+sub _find_git_status {
+ my ($self, $project_dir) = @_;
+ my @model;
+
+ my $stdout = $self->_git_exec($project_dir, qw( status --short ))
+ or return \@model;
+
+ for my $line ( split /^/, $$stdout ) {
+ chomp($line);
+ if ( $line =~ /^(..)\s+(.+?)(?:\s\->\s(.+?))?$/ ) {
+
+ # Handle stuff
+ my $status = $1;
+ my $path = defined $3 ? $3 : $2;
+
+ $status =~ s/(^\s+)|(\s+$)//;
+ $status =~ s/\?\?/?/;
+ push @model,
+ {
+ status => $status,
+ revision => '',
+ author => '',
+ path => $path,
+ fullpath => File::Spec->catfile( $project_dir, $path ),
+ };
+ } else {
+
+ # Log the event but do not do anything drastic
+ # about it
+ TRACE("Cannot understand '$line'") if DEBUG;
}
}
return \@model;
}
+sub _git_add_files
+{
+ my ($self, $project_dir, $files) = @_;
+ $self->_git_exec($project_dir, add => (map { __quote_arg($_) } @$files));
+ return $self->_find_git_status($project_dir);
+}
+
+sub _git_delete_files
+{
+ my ($self, $project_dir, $files) = @_;
+ $self->_git_exec($project_dir, rm => (map { __quote_arg($_) } @$files));
+ return $self->_find_git_status($project_dir);
+}
+
+sub _git_commit_files
+{
+ my ($self, $project_dir, $files, $message) = @_;
+ $self->_git_exec($project_dir, commit => (map { __quote_arg($_) } @$files), -m => __quote_arg($message));
+ return $self->_find_git_status($project_dir);
+}
+
+sub _git_revert_files
+{
+ my ($self, $project_dir, $files) = @_;
+ $self->_git_exec($project_dir, revert => (map { __quote_arg($_) } @$files));
+ return $self->_find_git_status($project_dir);
+}
+
1;
# Copyright 2008-2012 The Padre development team as listed in Padre.pm.