@@ -1,7 +1,58 @@
Changes for Perl Application Development and Refactoring Environment
NOTE: Do not "tidy" or change the indenting here, or we break svn annotate
-0.63 2010.05.02
+0.66 2010.07.01
+ - Improved the quality and integration of the default window size (ADAMK)
+ - The non-blocking IO upgrade in 0.65 meant that Padre could no longer
+ open files on Windows. Fixed (ADAMK)
+ - Minor improvements to the About dialog (ADAMK)
+
+0.65 2010.07.01
+ - Task 2.0 API landed on trunk (and everything breaks) (ADAMK)
+ - Converted the FunctionList GUI component to work via a task (ADAMK)
+ - Padre::Role::Task role added to allow any object in Padre
+ to be the "owner" of task and automatically handle which
+ tasks are still relevant to the UI state at the time the task
+ is completed, and ignore the ones that aren't (ADAMK)
+ - New compulsory Padre::Wx::Role::View for editor GUI componants
+ that want to live in the left/right/bottom tool panels (ADAMK)
+ - Renamed a number of classes to simpler names. Because we are
+ breaking everything anyway, this is an opportune time to lump
+ in these low-importance changes (ADAMK)
+ - Padre::DocBrowser --> Padre::Browser (ADAMK)
+ - Padre::Wx::DocBrowser --> Padre::Wx::Browser (ADAMK)
+ - Padre::Wx::Role::MainChild --> Padre::Wx::Role::Main (ADAMK)
+ - Language-specific task sub-classes now live under the document class
+ instead of under the Padre::Task tree, to encourage concentration
+ of language-specific code within the document tree (ADAMK)
+ - Padre::Task::Perl::Syntax --> Padre::Document::Perl::Syntax (ADAMK)
+ - Padre::Task::Perl::Outline --> Padre::Document::Perl::Outline (ADAMK)
+ - Startup config file now uses a custom hyper-minimalist format
+ which avoids the need to load YAML::Tiny before the first thread
+ spawn, saving about 400k per thread (ADAMK)
+ - Padre::Logger now allows the PADRE_DEBUG environment variable to be
+ set to a specific class name, enabling logging only for that class.
+ This simplies tracing around a specific problem now that the number
+ of classes with debugging hooks is getting large (ADAMK)
+ - Moved the startup tool enabling of the syntax check and error list
+ from the startup timer to the constructor, and prevent them from
+ writing back to the config. We no longer need to write the config
+ at all during startup, making startup faster (ADAMK)
+ - Scroll the output window down on outputs (kthakore)
+ - Directory browser rewritten to operate in the background (ADAMK)
+ - Improved directory tree search to take advantage of new background
+ file scanning. It is now instantaneously quick (ADAMK)
+ - Added the PPI::Cache API to provide a simple common mechanism for
+ stashing GUI model data such that all cache data can be cleaned up in
+ one go when the relevant project or document is released (ADAMK)
+ - Fixing some new bugs or adding temporary workarounds for them (SEWI)
+ - Rebuild History using non-blocking IO on Padre start (SEWI)
+
+0.64 2010.06.12
+ - Last Stable before merge of new Task 2.0 API
+ - zh-cn translation updated (jagd)
+
+0.63 2010.06.02
- Autocomplete "sub new" for Perl modules (SEWI)
- fixed ticket #956: crashes if Outline is active (ZENOG)
@@ -52,6 +52,11 @@ lib/Padre/Action/Tools.pm
lib/Padre/Action/View.pm
lib/Padre/Action/Window.pm
lib/Padre/Autosave.pm
+lib/Padre/Browser.pm
+lib/Padre/Browser/Document.pm
+lib/Padre/Browser/POD.pm
+lib/Padre/Browser/PseudoPerldoc.pm
+lib/Padre/Cache.pm
lib/Padre/Command.pm
lib/Padre/Config.pm
lib/Padre/Config/Host.pm
@@ -78,20 +83,19 @@ lib/Padre/DB/SessionFile.pm
lib/Padre/DB/Snippets.pod
lib/Padre/DB/SyntaxHighlight.pm
lib/Padre/Desktop.pm
-lib/Padre/DocBrowser.pm
-lib/Padre/DocBrowser/document.pm
-lib/Padre/DocBrowser/POD.pm
-lib/Padre/DocBrowser/PseudoPerldoc.pm
lib/Padre/Document.pm
lib/Padre/Document/Config.pm
lib/Padre/Document/Perl.pm
lib/Padre/Document/Perl/Beginner.pm
+lib/Padre/Document/Perl/FunctionList.pm
lib/Padre/Document/Perl/Help.pm
lib/Padre/Document/Perl/Lexer.pm
+lib/Padre/Document/Perl/Outline.pm
lib/Padre/Document/Perl/PPILexer.pm
lib/Padre/Document/Perl/QuickFix.pm
lib/Padre/Document/Perl/QuickFix/IncludeModule.pm
lib/Padre/Document/Perl/QuickFix/StrictWarnings.pm
+lib/Padre/Document/Perl/Syntax.pm
lib/Padre/Document/POD.pm
lib/Padre/File.pm
lib/Padre/File/FTP.pm
@@ -108,6 +112,7 @@ lib/Padre/MimeTypes.pm
lib/Padre/Perl.pm
lib/Padre/Plugin.pm
lib/Padre/Plugin/Devel.pm
+lib/Padre/Plugin/Devel/Crash.pm
lib/Padre/Plugin/My.pm
lib/Padre/Plugin/PopularityContest.pm
lib/Padre/Plugin/PopularityContest/Ping.pm
@@ -125,30 +130,30 @@ lib/Padre/Project/Perl/MB.pm
lib/Padre/Project/Perl/MI.pm
lib/Padre/Project/Temp.pm
lib/Padre/QuickFix.pm
+lib/Padre/Role/Task.pm
lib/Padre/Search.pm
-lib/Padre/Service.pm
-lib/Padre/SlaveDriver.pm
lib/Padre/Startup.pm
lib/Padre/Task.pm
-lib/Padre/Task/Debug/Crashing.pm
-lib/Padre/Task/DocBrowser.pm
-lib/Padre/Task/ErrorParser.pm
-lib/Padre/Task/Examples/WxEvent.pm
-lib/Padre/Task/HTTPClient.pm
-lib/Padre/Task/HTTPClient/LWP.pm
+lib/Padre/Task/Addition.pm
+lib/Padre/Task/Browser.pm
+lib/Padre/Task/ErrorList.pm
+lib/Padre/Task/Eval.pm
+lib/Padre/Task/FindUnmatchedBrace.pm
+lib/Padre/Task/FindVariableDeclaration.pm
+lib/Padre/Task/FunctionList.pm
+lib/Padre/Task/IntroduceTemporaryVariable.pm
lib/Padre/Task/LaunchDefaultBrowser.pm
+lib/Padre/Task/LexicalReplaceVariable.pm
lib/Padre/Task/LWP.pm
-lib/Padre/Task/OpenResource/SearchTask.pm
+lib/Padre/Task/OpenResource.pm
lib/Padre/Task/Outline.pm
-lib/Padre/Task/Outline/Perl.pm
lib/Padre/Task/PPI.pm
-lib/Padre/Task/PPI/FindUnmatchedBrace.pm
-lib/Padre/Task/PPI/FindVariableDeclaration.pm
-lib/Padre/Task/PPI/IntroduceTemporaryVariable.pm
-lib/Padre/Task/PPI/LexicalReplaceVariable.pm
-lib/Padre/Task/SyntaxChecker.pm
-lib/Padre/Task/SyntaxChecker/Perl.pm
+lib/Padre/Task/Syntax.pm
+lib/Padre/TaskHandle.pm
lib/Padre/TaskManager.pm
+lib/Padre/TaskProcess.pm
+lib/Padre/TaskThread.pm
+lib/Padre/TaskWorker.pm
lib/Padre/Test.pm
lib/Padre/Transform.pm
lib/Padre/Transform/Perl.pm
@@ -164,6 +169,7 @@ lib/Padre/Wx/Ack.pm
lib/Padre/Wx/App.pm
lib/Padre/Wx/AuiManager.pm
lib/Padre/Wx/Bottom.pm
+lib/Padre/Wx/Browser.pm
lib/Padre/Wx/CPAN.pm
lib/Padre/Wx/CPAN/Listview.pm
lib/Padre/Wx/Debugger.pm
@@ -203,10 +209,10 @@ lib/Padre/Wx/Dialog/Warning.pm
lib/Padre/Wx/Dialog/WhereFrom.pm
lib/Padre/Wx/Dialog/WindowList.pm
lib/Padre/Wx/Directory.pm
-lib/Padre/Wx/Directory/SearchCtrl.pm
+lib/Padre/Wx/Directory/Path.pm
+lib/Padre/Wx/Directory/Task.pm
lib/Padre/Wx/Directory/TreeCtrl.pm
lib/Padre/Wx/Display.pm
-lib/Padre/Wx/DocBrowser.pm
lib/Padre/Wx/Editor.pm
lib/Padre/Wx/ErrorList.pm
lib/Padre/Wx/FileDropTarget.pm
@@ -240,7 +246,8 @@ lib/Padre/Wx/Popup.pm
lib/Padre/Wx/Printout.pm
lib/Padre/Wx/Progress.pm
lib/Padre/Wx/Right.pm
-lib/Padre/Wx/Role/MainChild.pm
+lib/Padre/Wx/Role/Conduit.pm
+lib/Padre/Wx/Role/Main.pm
lib/Padre/Wx/Role/View.pm
lib/Padre/Wx/StatusBar.pm
lib/Padre/Wx/Syntax.pm
@@ -388,8 +395,19 @@ t/07-version.t
t/08-style.t
t/14-warnings.t
t/15-locale.t
-t/50-docbrowser.t
+t/21_task_thread.t
+t/22_task_worker.t
+t/23_task_chain.t
+t/24_task_master.t
+t/25_task_handle.t
+t/26_task_eval.t
+t/27_task_signal.t
+t/28_task_manager.t
+t/50-browser.t
t/60-db.t
+t/61-directory-path.t
+t/62-directory-task.t
+t/63-directory-project.t
t/70-document.t
t/71-perl.t
t/72-dialog-html.t
@@ -400,9 +418,6 @@ t/80-newline.t
t/81-search.t
t/82-plugin-manager.t
t/83-autosave.t
-t/84-task.t
-t/85-task-manager.t
-t/86-service.t
t/91-vi.t
t/92-padre-file.t
t/93-padre-filename-win.t
@@ -449,10 +464,9 @@ t/files/plugins/Padre/Plugin/B.pm
t/files/plugins/Padre/Plugin/C.pm
t/lib/Padre.pm
t/lib/Padre/Editor.pm
+t/lib/Padre/NullWindow.pm
t/lib/Padre/Plugin/Test/Plugin.pm
t/lib/Padre/Plugin/TestPlugin.pm
-t/lib/Padre/Task/PPITest.pm
-t/lib/Padre/Task/Test.pm
t/lib/Padre/Win32.pm
t/win32/002-menu.t
t/win32/010-file-new.t
@@ -15,7 +15,7 @@ configure_requires:
Alien::wxWidgets: 0.46
ExtUtils::MakeMaker: 6.42
distribution_type: module
-generated_by: 'Module::Install version 0.97'
+generated_by: 'Module::Install version 1.00'
keywords:
- auto-completion
- code
@@ -79,7 +79,7 @@ requires:
File::Copy::Recursive: 0.37
File::Find::Rule: 0.30
File::Glob: 0
- File::HomeDir: 0.84
+ File::HomeDir: 0.91
File::Next: 1.06
File::Path: 2.07
File::Remove: 1.42
@@ -99,10 +99,12 @@ requires:
IO::String: 1.08
IPC::Open2: 0
IPC::Open3: 0
+ LWP: 5.815
List::MoreUtils: 0.22
List::Util: 1.18
Module::Build: 0.3603
Module::CoreList: 0
+ Module::Manifest: 0.07
Module::Refresh: 0.13
Module::Starter: 1.50
ORLite: 1.41
@@ -141,4 +143,4 @@ resources:
homepage: http://padre.perlide.org/
license: http://dev.perl.org/licenses/
repository: http://svn.perlide.org/padre/trunk/Padre/
-version: 0.63
+version: 0.66
@@ -5,7 +5,7 @@
use 5.008005;
use strict;
use lib 'privinc';
-use inc::Module::Install 0.94;
+use inc::Module::Install 1.00;
use POSIX qw(locale_h);
# Workaround for the fact that Module::Install loads the modules
@@ -68,112 +68,116 @@ name 'Padre';
license 'perl';
author 'Gabor Szabo';
all_from 'lib/Padre.pm';
-requires 'perl' => '5.008005';
-requires 'App::Ack' => '1.86';
-requires 'App::cpanminus' => '0.9923';
-requires 'Class::Adapter' => '1.05';
-requires 'Class::Unload' => '0.03';
-requires 'Class::XSAccessor' => '1.05';
-requires 'Cwd' => '3.2701';
-requires 'Data::Dumper' => 0;
-requires 'DBD::SQLite' => '1.27';
-requires 'DBI' => '1.58';
-requires 'Debug::Client' => '0.11';
-requires 'Devel::Dumpvar' => '0.04';
-requires 'Devel::Refactor' => '0.05';
-requires 'Digest::MD5' => 0;
-requires 'Encode' => '2.26';
-requires 'ExtUtils::MakeMaker' => '6.56';
-requires 'File::Basename' => 0;
-requires 'File::Glob' => 0;
-requires 'File::Glob::Windows' => '0.1.3' if win32;
-requires 'File::Copy::Recursive' => '0.37';
-requires 'File::Find::Rule' => '0.30';
-requires 'File::HomeDir' => '0.84';
-requires 'File::Next' => '1.06'; # Force-bump ack dep
-requires 'File::Path' => '2.07';
-requires 'File::Remove' => '1.42';
-requires 'File::ShareDir' => '1.00';
-requires 'File::Spec' => '3.2701';
-requires 'File::Spec::Functions' => '3.2701';
-requires 'File::Temp' => 0;
-requires 'File::Which' => '1.08';
-requires 'File::pushd' => '1.00';
-requires 'FindBin' => 0;
-requires 'Format::Human::Bytes' => '0.04';
-requires 'Getopt::Long' => 0;
-requires 'HTML::Entities' => '3.57';
-requires 'HTML::Parser' => '3.58';
-
-# In the Padre.ppd file we need to list IO-stringy instead
-requires 'IO::Scalar' => '2.110';
-
-requires 'IO::Socket' => '1.30';
-requires 'IO::String' => '1.08';
-requires 'IPC::Open2' => 0;
-requires 'IPC::Open3' => 0;
-requires 'List::Util' => '1.18';
-requires 'List::MoreUtils' => '0.22';
-requires 'Module::Build' => '0.3603';
-requires 'Module::Refresh' => '0.13';
-requires 'Module::Starter' => '1.50';
-requires 'ORLite' => '1.41';
-
-# Temporarily disabled as we have cloned a private copy
-# requires 'ORLite::Migrate' => '1.06';
-
+requires 'perl' => '5.008005';
+
+# General dependencies
+requires 'App::Ack' => '1.86';
+requires 'App::cpanminus' => '0.9923';
+requires 'Class::Adapter' => '1.05';
+requires 'Class::Unload' => '0.03';
+requires 'Class::XSAccessor' => '1.05';
+requires 'Cwd' => '3.2701';
+requires 'Data::Dumper' => 0;
+requires 'DBD::SQLite' => '1.27';
+requires 'DBI' => '1.58';
+requires 'Debug::Client' => '0.11';
+requires 'Devel::Dumpvar' => '0.04';
+requires 'Devel::Refactor' => '0.05';
+requires 'Digest::MD5' => 0;
+requires 'Encode' => '2.26';
+requires 'ExtUtils::MakeMaker' => '6.56';
+requires 'ExtUtils::Manifest' => '1.56';
+requires 'File::Basename' => 0;
+requires 'File::Glob' => 0;
+requires 'File::Glob::Windows' => '0.1.3' if win32;
+requires 'File::Copy::Recursive' => '0.37';
+requires 'File::Find::Rule' => '0.30';
+requires 'File::HomeDir' => '0.91';
+requires 'File::Path' => '2.07';
+requires 'File::Remove' => '1.42';
+requires 'File::ShareDir' => '1.00';
+requires 'File::Spec' => '3.2701';
+requires 'File::Spec::Functions' => '3.2701';
+requires 'File::Temp' => 0;
+requires 'File::Which' => '1.08';
+requires 'File::pushd' => '1.00';
+requires 'FindBin' => 0;
+requires 'Format::Human::Bytes' => '0.04';
+requires 'Getopt::Long' => 0;
+requires 'HTML::Entities' => '3.57';
+requires 'HTML::Parser' => '3.58';
+requires 'IO::Socket' => '1.30';
+requires 'IO::String' => '1.08';
+requires 'IPC::Open2' => 0;
+requires 'IPC::Open3' => 0;
+requires 'List::Util' => '1.18';
+requires 'List::MoreUtils' => '0.22';
+requires 'LWP' => '5.815';
+requires 'Module::Build' => '0.3603';
+requires 'Module::CoreList' => 0;
+requires 'Module::Manifest' => '0.07';
+requires 'Module::Refresh' => '0.13';
+requires 'Module::Starter' => '1.50';
+requires 'ORLite' => '1.41';
requires 'Params::Util' => '0.33';
requires 'Parse::ErrorString::Perl' => '0.11';
requires 'Parse::ExuberantCTags' => '1.00';
+requires 'Pod::Functions' => 0;
requires 'Pod::POM' => '0.17';
requires 'Pod::Simple' => '3.07';
requires 'Pod::Simple::XHTML' => '3.04';
requires 'Pod::Abstract' => '0.16';
requires 'Pod::Perldoc' => '3.15';
requires 'POD2::Base' => '0.043';
+requires 'POSIX' => 0;
+requires 'PPI' => '1.205';
+requires 'PPIx::EditorTools' => '0.09';
+requires 'PPIx::Regexp' => '0.005';
+requires 'Storable' => '2.15';
+requires 'Template::Tiny' => '0.11';
+requires 'Term::ReadLine' => 0;
+requires 'Text::Balanced' => '2.01';
+requires 'Text::Diff' => '0.35';
+requires 'Text::FindIndent' => '0.06';
+requires 'Thread::Queue' => '2.11';
+requires 'threads' => '1.71';
+requires 'threads::shared' => '1.26';
+requires 'URI' => '0';
+requires 'version' => '0.80';
+requires 'Win32' => '0.31' if win32;
+requires 'Win32::API' => '0.58' if win32;
+requires 'Win32::Shortcut' => '0.07' if win32;
+requires 'Win32::TieRegistry' => '0.26' if win32;
+requires 'Wx' => ( win32 and $] >= 5.01 ) ? '0.94' : '0.91';
+requires 'Wx::Perl::ProcessStream' => '0.25';
+requires 'YAML::Tiny' => '1.32';
+test_requires 'Capture::Tiny' => '0.06';
+test_requires 'Test::More' => '0.88';
+test_requires 'Test::MockObject' => '1.09';
+test_requires 'Test::Script' => '1.07';
+test_requires 'Test::Exception' => '0.27';
+test_requires 'Test::NoWarnings' => '0.084';
+
+# Special dependencies
+
+# Force-bump ack dep, removed once we remove Ack
+requires 'File::Next' => '1.06';
-# Add later, once we native support portability
-#requires 'Portable' => '0.12' if win32;
+# In the Padre.ppd file we need to list IO-stringy instead
+requires 'IO::Scalar' => '2.110';
+
+# Temporarily disabled as we have cloned a private copy
+# requires 'ORLite::Migrate' => '1.06';
-requires 'POSIX' => 0;
-requires 'PPI' => '1.205';
-requires 'PPIx::EditorTools' => '0.09';
+# Add later, once we native support portability
+# requires 'Portable' => '0.12' if win32;
# For PPIx::Regexp Readonly dependency
requires 'Readonly::XS' => '1.05';
-requires 'PPIx::Regexp' => '0.005';
-requires 'Storable' => '2.15';
-requires 'Template::Tiny' => '0.11';
-requires 'Term::ReadLine' => 0;
-requires 'Text::Balanced' => '2.01';
-requires 'Text::Diff' => '0.35';
-requires 'Text::FindIndent' => '0.06';
-requires 'Thread::Queue' => '2.11';
-requires 'threads' => '1.71';
-requires 'threads::shared' => '1.26';
-requires 'URI' => '0';
-requires 'version' => '0.80';
-requires 'Win32' => '0.31' if win32;
-requires 'Win32::API' => '0.58' if win32;
-requires 'Win32::Shortcut' => '0.07' if win32;
-requires 'Win32::TieRegistry' => '0.26' if win32;
-requires 'Wx' => ( win32 and $] >= 5.01 ) ? '0.94' : '0.91';
-requires 'Wx::Perl::ProcessStream' => '0.25';
-requires 'YAML::Tiny' => '1.32';
-requires 'ExtUtils::Manifest' => '1.56';
-requires 'Pod::Functions' => 0;
-requires 'Module::CoreList' => 0;
-test_requires 'Capture::Tiny' => '0.06';
-test_requires 'Test::More' => '0.88';
-test_requires 'Test::MockObject' => '1.09';
-test_requires 'Test::Script' => '1.07';
-test_requires 'Test::Exception' => '0.27';
-test_requires 'Test::NoWarnings' => '0.084';
-
# PAR support disabled for now
-#requires 'File::ShareDir::PAR' => '0.04';
-#requires 'PAR' => '0.989';
+# requires 'File::ShareDir::PAR' => '0.04';
+# requires 'PAR' => '0.989';
my $locale = setlocale(LC_CTYPE);
print "Found locale $locale\n";
@@ -4,7 +4,7 @@ package Module::Install::Base;
use strict 'vars';
use vars qw{$VERSION};
BEGIN {
- $VERSION = '0.97';
+ $VERSION = '1.00';
}
# Suspend handler for "redefined" warnings
@@ -9,7 +9,7 @@ use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.97';
+ $VERSION = '1.00';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
@@ -6,7 +6,7 @@ use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.97';
+ $VERSION = '1.00';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
@@ -4,10 +4,11 @@ package Module::Install::Makefile;
use strict 'vars';
use ExtUtils::MakeMaker ();
use Module::Install::Base ();
+use Fcntl qw/:flock :seek/;
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.97';
+ $VERSION = '1.00';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
@@ -364,9 +365,9 @@ sub fix_up_makefile {
. ($self->postamble || '');
local *MAKEFILE;
- open MAKEFILE, "< $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!";
+ open MAKEFILE, "+< $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!";
+ eval { flock MAKEFILE, LOCK_EX };
my $makefile = do { local $/; <MAKEFILE> };
- close MAKEFILE or die $!;
$makefile =~ s/\b(test_harness\(\$\(TEST_VERBOSE\), )/$1'inc', /;
$makefile =~ s/( -I\$\(INST_ARCHLIB\))/ -Iinc$1/g;
@@ -386,7 +387,8 @@ sub fix_up_makefile {
# XXX - This is currently unused; not sure if it breaks other MM-users
# $makefile =~ s/^pm_to_blib\s+:\s+/pm_to_blib :: /mg;
- open MAKEFILE, "> $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!";
+ seek MAKEFILE, 0, SEEK_SET;
+ truncate MAKEFILE, 0;
print MAKEFILE "$preamble$makefile$postamble" or die $!;
close MAKEFILE or die $!;
@@ -410,4 +412,4 @@ sub postamble {
__END__
-#line 539
+#line 541
@@ -6,7 +6,7 @@ use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.97';
+ $VERSION = '1.00';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
@@ -616,8 +616,15 @@ sub _perl_version {
return $v;
}
-
-
+sub add_metadata {
+ my $self = shift;
+ my %hash = @_;
+ for my $key (keys %hash) {
+ warn "add_metadata: $key is not prefixed with 'x_'.\n" .
+ "Use appopriate function to add non-private metadata.\n" unless $key =~ /^x_/;
+ $self->{values}->{$key} = $hash{$key};
+ }
+}
######################################################################
@@ -6,7 +6,7 @@ use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.97';
+ $VERSION = '1.00';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
@@ -8,7 +8,7 @@ use ExtUtils::Manifest ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.97';
+ $VERSION = '1.00';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
@@ -6,7 +6,7 @@ use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.97';
+ $VERSION = '1.00';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
@@ -8,7 +8,7 @@ use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.97';
+ $VERSION = '1.00';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
@@ -6,7 +6,7 @@ use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.97';;
+ $VERSION = '1.00';
@ISA = qw{Module::Install::Base};
$ISCORE = 1;
}
@@ -22,7 +22,6 @@ use strict 'vars';
use Cwd ();
use File::Find ();
use File::Path ();
-use FindBin;
use vars qw{$VERSION $MAIN};
BEGIN {
@@ -32,7 +31,7 @@ BEGIN {
# This is not enforced yet, but will be some time in the next few
# releases once we can make sure it won't clash with custom
# Module::Install extensions.
- $VERSION = '0.97';
+ $VERSION = '1.00';
# Storage for the pseudo-singleton
$MAIN = undef;
@@ -231,7 +230,12 @@ sub preload {
sub new {
my ($class, %args) = @_;
- FindBin->again;
+ delete $INC{'FindBin.pm'};
+ {
+ # to suppress the redefine warning
+ local $SIG{__WARN__} = sub {};
+ require FindBin;
+ }
# ignore the prefix on extension modules built from top level.
my $base_path = Cwd::abs_path($FindBin::Bin);
@@ -17,7 +17,7 @@ use warnings;
use Padre::Action ();
use Padre::Current qw{_CURRENT};
-our $VERSION = '0.63';
+our $VERSION = '0.66';
#####################################################################
@@ -9,7 +9,7 @@ use Padre::Current qw{_CURRENT};
use Padre::Wx ();
use Padre::Wx::Menu ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
#####################################################################
@@ -10,7 +10,7 @@ use Padre::Wx::Menu ();
use Padre::Current ('_CURRENT');
use Padre::Logger;
-our $VERSION = '0.63';
+our $VERSION = '0.66';
#####################################################################
# Padre::Wx::Menu Methods
@@ -11,7 +11,7 @@ use Padre::Constant ();
use Padre::Current '_CURRENT';
use Padre::Locale ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
@@ -24,7 +24,7 @@ use Padre::Action ();
use Padre::Current qw{_CURRENT};
use Padre::Constant();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
#####################################################################
@@ -22,7 +22,7 @@ use Params::Util qw{_INSTANCE};
use Padre::Locale ();
use Padre::Current qw{_CURRENT};
-our $VERSION = '0.63';
+our $VERSION = '0.66';
our @ISA = 'Padre::Wx::Menu';
sub new {
@@ -17,7 +17,7 @@ use warnings;
use Padre::Wx ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
#####################################################################
@@ -24,7 +24,7 @@ use Padre::Wx::Menu ();
use Padre::Locale ();
use Padre::Current qw{_CURRENT};
-our $VERSION = '0.63';
+our $VERSION = '0.66';
#####################################################################
# Methods
@@ -17,7 +17,7 @@ use warnings;
use Padre::Action ();
use Padre::Current qw{_CURRENT};
-our $VERSION = '0.63';
+our $VERSION = '0.66';
@@ -11,7 +11,7 @@ use Padre::Current qw{_CURRENT};
use Padre::Wx ();
use Padre::Wx::Menu ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
@@ -13,7 +13,7 @@ use Padre::Wx ();
use Padre::Action ();
use Padre::Current qw{_CURRENT};
-our $VERSION = '0.63';
+our $VERSION = '0.66';
@@ -5,14 +5,15 @@ package Padre::Action::View;
use 5.008;
use strict;
use warnings;
-use File::Glob ();
use Padre::Constant ();
-use Padre::Current qw{_CURRENT};
-use Padre::Wx ();
-use Padre::Wx::Menu ();
use Padre::Locale ();
+use Padre::Wx ();
+
+our $VERSION = '0.66';
+
+
+
-our $VERSION = '0.63';
#####################################################################
# Padre::Wx::Menu Methods
@@ -34,7 +35,8 @@ sub new {
},
);
- # Show or hide GUI elements
+ # Visible GUI Elements
+
Padre::Action->new(
name => 'view.output',
label => Wx::gettext('Show Output'),
@@ -62,16 +64,10 @@ sub new {
comment => Wx::gettext('Show a window listing all todo items in the current document'),
menu_method => 'AppendCheckItem',
menu_event => sub {
- if ( $_[1]->IsChecked ) {
- $_[0]->refresh_todo( $_[0]->current );
- $_[0]->show_todo(1);
- } else {
- $_[0]->show_todo(0);
- }
+ $_[0]->show_todo( $_[1]->IsChecked );
},
);
- # Show or hide GUI elements
Padre::Action->new(
name => 'view.outline',
label => Wx::gettext('Show Outline'),
@@ -98,7 +94,7 @@ sub new {
comment => Wx::gettext('Turn on syntax checking of the current document and show output in a window'),
menu_method => 'AppendCheckItem',
menu_event => sub {
- $_[0]->on_toggle_syntax_check( $_[1] );
+ $_[0]->show_syntax( $_[1]->IsChecked );
},
);
@@ -108,7 +104,7 @@ sub new {
comment => Wx::gettext('Show the list of errors received during execution of a script'),
menu_method => 'AppendCheckItem',
menu_event => sub {
- $_[0]->on_toggle_errorlist( $_[1] );
+ $_[0]->show_errorlist( $_[1]->IsChecked );
},
);
@@ -133,6 +129,7 @@ sub new {
);
# Editor Functionality
+
Padre::Action->new(
name => 'view.lines',
label => Wx::gettext('Show Line Numbers'),
@@ -208,6 +205,7 @@ sub new {
);
# Editor Whitespace Layout
+
Padre::Action->new(
name => 'view.eol',
label => Wx::gettext('Show Newlines'),
@@ -249,6 +247,7 @@ sub new {
);
# Font Size
+
Padre::Action->new(
name => 'view.font_increase',
label => Wx::gettext('Increase Font Size'),
@@ -281,6 +280,7 @@ sub new {
);
# Bookmark Support
+
Padre::Action->new(
name => 'view.bookmark_set',
label => Wx::gettext('Set Bookmark'),
@@ -303,8 +303,8 @@ sub new {
},
);
-
# Window Effects
+
Padre::Action->new(
name => 'view.full_screen',
label => Wx::gettext('&Full Screen'),
@@ -8,7 +8,7 @@ use warnings;
use Padre::Action;
use Padre::Current qw{_CURRENT};
-our $VERSION = '0.63';
+our $VERSION = '0.66';
our @ISA = 'Padre::Wx::Menu';
#####################################################################
@@ -18,7 +18,7 @@ use Padre::Action::Tools ();
use Padre::Action::Window ();
use Padre::Action::Internal ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
# Generate faster accessors
use Class::XSAccessor {
@@ -4,7 +4,7 @@ use 5.008;
use strict;
use warnings;
-our $VERSION = '0.63';
+our $VERSION = '0.66';
=head1 NAME
@@ -0,0 +1,126 @@
+package Padre::Browser::Document;
+
+=pod
+
+=head1 NAME
+
+Padre::Browser::Document - is an afterthought
+
+L<Padre::Browser> began using <Padre::Document> for internal representation
+of documents. This module aims to be less costly to serialize.
+
+=head1 CAVEATS
+
+Until this is a better copy of Padre::Document or the similar parts converge,
+it will probably change.
+
+=cut
+
+use 5.008;
+use strict;
+use warnings;
+use File::Basename ();
+
+our $VERSION = '0.66';
+
+use Class::XSAccessor {
+ constructor => 'new',
+ accessors => {
+ mimetype => 'mime_type',
+ body => 'body',
+ title => 'title',
+ filename => 'filename',
+ },
+};
+
+sub load {
+ my ( $class, $path ) = @_;
+ open( my $file_in, '<', $path ) or die "Failed to load '$path' $!";
+ my $body;
+ $body .= $_ while <$file_in>;
+ close $file_in;
+ my $doc = $class->new( body => $body, filename => $path );
+ $doc->mimetype( $doc->guess_mimetype );
+ $doc->title( $doc->guess_title );
+ return $doc;
+}
+
+sub guess_title {
+ my ($self) = @_;
+ if ( $self->filename ) {
+ return File::Basename::basename( $self->filename );
+ }
+ 'Untitled';
+}
+
+# Yuk .
+# This is the primary file extension to mime-type mapping
+our %EXT_MIME = (
+ abc => 'text/x-abc',
+ ada => 'text/x-adasrc',
+ asm => 'text/x-asm',
+ bat => 'text/x-bat',
+ cpp => 'text/x-c++src',
+ css => 'text/css',
+ diff => 'text/x-patch',
+ e => 'text/x-eiffel',
+ f => 'text/x-fortran',
+ htm => 'text/html',
+ html => 'text/html',
+ js => 'application/javascript',
+ json => 'application/json',
+ latex => 'application/x-latex',
+ lsp => 'application/x-lisp',
+ lua => 'text/x-lua',
+ mak => 'text/x-makefile',
+ mat => 'text/x-matlab',
+ pas => 'text/x-pascal',
+ pod => 'text/x-pod',
+ php => 'application/x-php',
+ py => 'text/x-python',
+ rb => 'application/x-ruby',
+ sql => 'text/x-sql',
+ tcl => 'application/x-tcl',
+ vbs => 'text/vbscript',
+ patch => 'text/x-patch',
+ pl => 'application/x-perl',
+ plx => 'application/x-perl',
+ pm => 'application/x-perl',
+ pod => 'application/x-perl',
+ t => 'application/x-perl',
+ conf => 'text/plain',
+ sh => 'application/x-shellscript',
+ ksh => 'application/x-shellscript',
+ txt => 'text/plain',
+ xml => 'text/xml',
+ yml => 'text/x-yaml',
+ yaml => 'text/x-yaml',
+ '4th' => 'text/x-forth',
+ pasm => 'application/x-pasm',
+ pir => 'application/x-pir',
+ p6 => 'application/x-perl6',
+);
+
+sub guess_mimetype {
+ my ($self) = @_;
+ unless ( $self->filename ) {
+ return 'application/x-pod';
+ }
+ my ( $path, $file, $suffix ) = File::Basename::fileparse(
+ $self->filename,
+ keys %EXT_MIME
+ );
+
+ my $type =
+ exists $EXT_MIME{$suffix}
+ ? $EXT_MIME{$suffix}
+ : '';
+ return $type;
+}
+
+1;
+
+# Copyright 2008-2010 The Padre development team as listed in Padre.pm.
+# LICENSE
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl 5 itself.
@@ -0,0 +1,147 @@
+package Padre::Browser::POD;
+
+use 5.008;
+use strict;
+use warnings;
+use Config ();
+use File::Temp ();
+use IO::Scalar ();
+use Params::Util ();
+use Pod::Simple::XHTML ();
+use Pod::Abstract ();
+use Padre::Browser::Document ();
+use Padre::Browser::PseudoPerldoc ();
+
+our $VERSION = '0.66';
+
+use Class::XSAccessor {
+ constructor => 'new',
+ getters => {
+ get_provider => 'provider',
+ },
+};
+
+sub provider_for {
+ ( 'application/x-perl', 'application/x-pod' );
+}
+
+# uri schema like http:// pod:// blah://
+sub accept_schemes {
+ 'perldoc';
+}
+
+sub viewer_for {
+ 'application/x-pod';
+}
+
+sub resolve {
+ my $self = shift;
+ my $ref = shift;
+ my $hints = shift;
+ my $query = $ref;
+
+ if ( Params::Util::_INSTANCE( $ref, 'URI' ) ) {
+ $query = $ref->opaque;
+ }
+ my ( $docname, $section ) = split_link($query);
+
+ # Put Pod::Perldoc to work on $query
+ my ( $fh, $tempfile ) = File::Temp::tempfile();
+
+ my @args = (
+ '-u',
+ "-d$tempfile",
+ ( exists $hints->{lang} )
+ ? ( '-L', ( $hints->{lang} ) )
+ : (),
+ ( exists $hints->{perlfunc} ) ? '-f'
+ : (),
+ ( exists $hints->{perlvar} ) ? '-v'
+ : (),
+ $query
+ );
+
+ my $pd = Padre::Browser::PseudoPerldoc->new( args => \@args );
+ SCOPE: {
+ local *STDERR = IO::Scalar->new;
+ local *STDOUT = IO::Scalar->new;
+ eval { $pd->process() };
+ }
+
+ return unless -s $tempfile;
+
+ my $pa = Pod::Abstract->load_file($tempfile);
+ close $fh;
+ unlink($tempfile);
+
+ my $doc = Padre::Browser::Document->new( body => $pa->pod );
+ $doc->mimetype('application/x-pod');
+ my $title_from = $hints->{title_from_section} || 'NAME';
+ my $name;
+ if ( ($name) = $pa->select("/head1[\@heading =~ {$title_from}]")
+ or ($name) = $pa->select("/head1") )
+ {
+ my $text = $name->text;
+ my ($module) = $text =~ /([^\s]+)/g;
+ $doc->title($module);
+ } elsif ( ($name) = $pa->select("//item") ) {
+ my $text = $name->pod;
+ my ($item) = $text =~ /=item\s+([^\s]+)/g;
+ $doc->title($item);
+ }
+
+ unless ( $pa->select('/pod')
+ || $pa->select('//item')
+ || $pa->select('//head1') )
+ {
+ warn "$ref has no pod in" . $pa->ptree;
+
+ # Unresolvable ?
+ return;
+ }
+
+ return $doc;
+
+}
+
+sub generate {
+ my $self = shift;
+ my $doc = shift;
+ $doc->mimetype('application/x-pod');
+ return $doc;
+ #### TO DO , pod extract / pod tidy ?
+
+ # (Ticket #671)
+}
+
+sub render {
+ my $self = shift;
+ my $doc = shift;
+ my $data = '';
+ return if not $doc;
+ my $pod = IO::Scalar->new( \$doc->body );
+ my $out = IO::Scalar->new( \$data );
+ my $v = Pod::Simple::XHTML->new;
+ $v->perldoc_url_prefix('perldoc:');
+ $v->output_fh($out);
+ $v->parse_file($pod);
+ my $response = Padre::Browser::Document->new;
+ $response->body( ${ $out->sref } );
+ $response->mimetype('text/xhtml');
+ $response->title( $doc->title );
+ return $response;
+}
+
+# Utility function , really wants to be inside a class like
+# URI::perldoc ??
+sub split_link {
+ my $query = shift;
+ my ( $doc, $section ) = split /\//, $query, 2; # was m|([^/]+)/?+(.*+)|;
+}
+
+1;
+
+# Copyright 2008-2010 The Padre development team as listed in Padre.pm.
+# LICENSE
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl 5 itself.
@@ -0,0 +1,86 @@
+package Padre::Browser::PseudoPerldoc;
+
+use 5.008;
+use strict;
+use warnings;
+use Pod::Perldoc ();
+use Pod::Perldoc::ToPod ();
+
+our $VERSION = '0.66';
+our @ISA = 'Pod::Perldoc';
+
+sub new {
+ my $class = shift;
+ my $self = $class->SUPER::new(@_);
+ return $self;
+}
+
+## Lie to Pod::PerlDoc - and avoid it's autoloading implementation
+sub find_good_formatter_class {
+ $_[0]->{'formatter_class'} = 'Pod::Perldoc::ToPod';
+ return;
+}
+
+# Even worse than monkey patching , copy paste from Pod::Perldoc w/ edits
+# to avoid untrappable calls to 'exit'
+sub process {
+
+ # if this ever returns, its retval will be used for exit(RETVAL)
+
+ my $self = shift;
+
+ # TO DO: make it deal with being invoked as various different things
+ # such as perlfaq".
+
+ # (Ticket #672)
+
+ return $self->usage_brief unless @{ $self->{'args'} };
+ $self->pagers_guessing;
+ $self->options_reading;
+ $self->aside( sprintf "$0 => %s v%s\n", ref($self), $self->VERSION );
+ $self->drop_privs_maybe;
+ $self->options_processing;
+
+ # Hm, we have @pages and @found, but we only really act on one
+ # file per call, with the exception of the opt_q hack, and with
+ # -l things
+
+ $self->aside("\n");
+
+ my @pages;
+ $self->{'pages'} = \@pages;
+ if ( $self->opt_f ) { @pages = ("perlfunc") }
+ elsif ( $self->opt_q ) { @pages = ( "perlfaq1" .. "perlfaq9" ) }
+ elsif ( $self->opt_v ) { @pages = ("perlvar") }
+ else { @pages = @{ $self->{'args'} }; }
+
+ return $self->usage_brief unless @pages;
+
+ $self->find_good_formatter_class();
+ $self->formatter_sanity_check();
+
+ $self->maybe_diddle_INC();
+
+ # for when we're apparently in a module or extension directory
+
+ my @found = $self->grand_search_init( \@pages );
+ return unless @found;
+
+ if ( $self->opt_l ) {
+ print join( "\n", @found ), "\n";
+ return;
+ }
+
+ $self->tweak_found_pathnames( \@found );
+ $self->assert_closing_stdout;
+ return $self->page_module_file(@found) if $self->opt_m;
+
+ return $self->render_and_page( \@found );
+}
+
+1;
+
+# Copyright 2008-2010 The Padre development team as listed in Padre.pm.
+# LICENSE
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl 5 itself.
@@ -0,0 +1,311 @@
+package Padre::Browser;
+
+use 5.008;
+use strict;
+use warnings;
+use Carp ();
+use Scalar::Util ();
+use Padre::Browser::POD ();
+
+our $VERSION = '0.66';
+
+use Class::XSAccessor {
+ getters => {
+ get_providers => 'providers',
+ get_viewers => 'viewers',
+ get_schemes => 'schemes',
+ },
+ setters => {
+ set_providers => 'providers',
+ set_viewers => 'viewers',
+ set_schemes => 'schemes',
+ },
+};
+
+=pod
+
+=head1 NAME
+
+Padre::Browser -- documentation browser for Padre
+
+=head1 DESCRIPTION
+
+Provide an interface for retrieving / generating documentation, resolving terms
+to documentation (search?) and formatting documentation.
+
+Allow new packages to be loaded and interrogated for the MIME types they can
+generate documentation for. Provide similar mechanism for registering new
+documentation viewers and URI schemes accepted for resolving.
+
+B<NOTE:> I think all the method names are wrong. Blast it.
+
+=head1 SYNOPSIS
+
+ # Does perlish things by default via 'Padre::Browser::POD'
+ my $browser = Padre::Browser->new();
+ my $source = Padre::Document->new( filename=>'source/Package.pm' );
+
+ my $docs = $browser->docs( $source );
+ # $docs provided by Browser::POD->generate
+ # should be Padre::Browser::Document , application/x-pod
+
+ my $output = $browser->browse( $docs );
+ # $output provided by Browser::POD->render
+ # should be Padre::Document , text/x-html
+
+ $browser->load_viewer( 'Padre::Browser::PodAdvanced' );
+ # PodAdvanced->render might add an html TOC in addition to
+ # just pod2html
+
+ my $new_output = $browser->browse( $docs );
+ # $new_output now with a table of contents
+
+=head1 METHODS
+
+=head2 new
+
+Boring constructor, pass nothing. Yet.
+
+=head2 load_provider
+
+Accepts a single class name, will attempt to auto-L<use> the class and
+interrogate its C<provider_for> method. Any MIME types returned will be
+associated with the class for dispatch to C<generate>.
+
+Additionally, interrogate class for C<accept_schemes> and associate the class
+with URI schemes for dispatch to C<resolve>.
+
+=head2 load_viewer
+
+Accepts a single class name, will attempt to auto-L<use> the class and
+interrogate its C<viewer_for> method. Any MIME types returned will be
+associated with the class for dispatch to C<render>.
+
+=head2 resolve
+
+Accepts a URI or scalar
+
+=head2 browse
+
+=head2 accept
+
+=head1 EXTENDING
+
+ package My::Browser::Doxygen;
+
+ # URI of doxygen:$string or doxygen://path?query
+ sub accept_schemes {
+ 'doxygen',
+ }
+
+ sub provider_for {
+ 'text/x-c++src'
+ }
+
+ sub viewer_for {
+ 'text/x-doxygen',
+ }
+
+ sub generate {
+ my ($self,$doc) = @_;
+ # $doc will be Padre::Document of any type specified
+ # by ->provider_for
+
+ # push $doc through doxygen
+ # ...
+ # that was easy :)
+
+ # You know your own output type, be explicit
+ my $response = Padre::Document->new();
+ $response->{original_content} = $doxygen->output;
+ $response->set_mimetype( 'text/x-doxygen' );
+ return $response;
+ }
+
+ sub render {
+ my ($self,$docs) = @_;
+ # $docs will be of any type specified
+ # by ->viewer_for;
+
+ ## turn $docs into doxygen(y) html document
+ # ...
+ #
+
+ my $response = Padre::Document->new();
+ $response->{original_content} = $doxy2html->output;
+ $response->set_mimetype( 'text/x-html' );
+ return $response;
+
+ }
+
+=cut
+
+sub new {
+ my ( $class, %args ) = @_;
+
+ my $self = bless \%args, ref($class) || $class;
+ $self->set_providers( {} ) unless $args{providers};
+ $self->set_viewers( {} ) unless $args{viewers};
+ $self->set_schemes( {} ) unless $args{schemes};
+
+ # Provides pod from perl, pod: perldoc: schemes
+ $self->load_provider('Padre::Browser::POD');
+
+ # Produces html view of POD
+ $self->load_viewer('Padre::Browser::POD');
+
+ return $self;
+}
+
+sub load_provider {
+ my ( $self, $class ) = @_;
+
+ unless ( $class->VERSION ) {
+ eval "require $class;";
+ die("Failed to load $class: $@") if $@;
+ }
+ if ( $class->can('provider_for') ) {
+ $self->register_providers( $_ => $class ) for $class->provider_for;
+ } else {
+ Carp::confess("$class is not a provider for anything.");
+ }
+
+ if ( $class->can('accept_schemes') ) {
+ $self->register_schemes( $_ => $class ) for $class->accept_schemes;
+ } else {
+ Carp::confess("$class accepts no uri schemes");
+ }
+
+ return $self;
+}
+
+sub load_viewer {
+ my ( $self, $class ) = @_;
+ unless ( $class->VERSION ) {
+ eval "require $class;";
+ die("Failed to load $class: $@") if $@;
+ }
+ if ( $class->can('viewer_for') ) {
+ $self->register_viewers( $_ => $class ) for $class->viewer_for;
+ }
+ $self;
+}
+
+sub register_providers {
+ my ( $self, %provides ) = @_;
+ while ( my ( $type, $class ) = each %provides ) {
+
+ # TO DO - handle collisions, ie multi providers
+
+ # (Ticket #673)
+
+ $self->get_providers->{$type} = $class;
+ }
+ $self;
+}
+
+sub register_viewers {
+ my ( $self, %viewers ) = @_;
+ while ( my ( $type, $class ) = each %viewers ) {
+ $self->get_viewers->{$type} = $class;
+ unless ( $class->VERSION ) {
+ eval "require $class;";
+ die("Failed to load $class: $@") if $@;
+ }
+ }
+ $self;
+}
+
+sub register_schemes {
+ my ( $self, %schemes ) = @_;
+ while ( my ( $scheme, $class ) = each %schemes ) {
+ $self->get_schemes->{$scheme} = $class;
+ }
+ $self;
+}
+
+sub provider_for {
+ my ( $self, $type ) = @_;
+ my $p;
+ eval {
+ if ( exists $self->get_providers->{$type} )
+ {
+ $p = $self->get_providers->{$type}->new;
+ }
+ };
+ Carp::confess($@) if $@;
+ return $p;
+}
+
+sub accept {
+ my ( $self, $scheme ) = @_;
+ if ( defined $self->get_schemes->{$scheme} ) {
+ return $self->get_schemes->{$scheme};
+ }
+ return;
+}
+
+sub viewer_for {
+ my ( $self, $type ) = @_;
+ my $v;
+ eval {
+ if ( exists $self->get_viewers->{$type} )
+ {
+ $v = $self->get_viewers->{$type}->new;
+ }
+ };
+ Carp::confess($@) if $@;
+ return $v;
+}
+
+sub docs {
+ my ( $self, $doc ) = @_;
+ if ( my $provider = $self->provider_for( $doc->guess_mimetype ) ) {
+ my $docs = $provider->generate($doc);
+ return $docs;
+ }
+ return;
+}
+
+sub resolve {
+ my ( $self, $ref, $hints ) = @_;
+ my @refs;
+ if ( Scalar::Util::blessed($ref) and $ref->isa('URI') ) {
+ return $self->resolve_uri( $ref, $hints );
+ }
+
+ # TO DO this doubles up if a provider subscribes to multi
+ # mimetypes .
+
+ # (Ticket #674)
+
+ foreach my $class ( values %{ $self->get_providers } ) {
+ my $resp = $class->resolve( $ref, $hints );
+ push @refs, $resp if $resp;
+ last if $resp;
+ }
+ return $refs[0];
+}
+
+sub resolve_uri {
+ my ( $self, $uri, $hints ) = @_;
+ my $resolver = $self->accept( $uri->scheme );
+ return unless $resolver;
+ my $doc = $resolver->resolve( $uri, $hints );
+ return $doc;
+}
+
+sub browse {
+ my ( $self, $docs ) = @_;
+ if ( my $viewer = $self->viewer_for( $docs->mimetype ) ) {
+ return $viewer->render($docs);
+ }
+ return;
+}
+
+1;
+
+# Copyright 2008-2010 The Padre development team as listed in Padre.pm.
+# LICENSE
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl 5 itself.
@@ -5,7 +5,7 @@ use strict;
use warnings;
use Carp ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
use CPAN ();
@@ -0,0 +1,43 @@
+package Padre::Cache;
+
+# Lightweight in-memory caching mechanism primarily intended for
+# storing GUI model data keyed against projects or documents.
+
+use 5.008;
+use strict;
+use warnings;
+use Params::Util ();
+
+our $VERSION = '0.66';
+
+my %DATA = ();
+
+sub stash {
+ my $owner = shift;
+ my $key = shift;
+
+ # We need an instantiated cache target
+ # NOTE: The defined is needed because Padre::Project::Null
+ # boolifies to false. In retrospect, that may have been a bad idea.
+ if ( defined Params::Util::_INSTANCE( $key, 'Padre::Project' ) ) {
+ $key = $key->root;
+ } elsif ( Params::Util::_INSTANCE( $key, 'Padre::Document' ) ) {
+ $key = $key->filename;
+ } else {
+ die "Missing or invalid cache key";
+ }
+
+ $DATA{$key}->{$owner}
+ or $DATA{$key}->{$owner} = {};
+}
+
+sub release {
+ delete $DATA{ $_[0] };
+}
+
+1;
+
+# Copyright 2008-2010 The Padre development team as listed in Padre.pm.
+# LICENSE
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl 5 itself.
@@ -10,7 +10,7 @@ use 5.008005;
use strict;
use warnings;
-our $VERSION = '0.63';
+our $VERSION = '0.66';
use Class::XSAccessor {
getters => {
@@ -7,7 +7,7 @@ use strict;
use warnings;
use Padre::Current ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
# -- constructors
@@ -10,7 +10,7 @@ use YAML::Tiny ();
use Params::Util ();
use Padre::Constant ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
# Config schema revision
my $REVISION = 1;
@@ -9,7 +9,7 @@ use YAML::Tiny ();
use Exporter ();
use Padre::Config ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
1;
@@ -9,7 +9,7 @@ use File::Basename ();
use YAML::Tiny ();
use Params::Util ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
@@ -10,7 +10,7 @@ use File::Spec ();
use Params::Util ();
use Padre::Constant ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
use Class::XSAccessor {
getters => [
@@ -9,7 +9,7 @@ use Carp ();
use Params::Util ();
use YAML::Tiny ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
@@ -7,7 +7,7 @@ use 5.008;
use strict;
use warnings;
-our $VERSION = '0.63';
+our $VERSION = '0.66';
=pod
@@ -21,8 +21,9 @@ use Padre::Config::Human ();
use Padre::Config::Project ();
use Padre::Config::Host ();
use Padre::Config::Upgrade ();
+use Padre::Logger;
-our $VERSION = '0.63';
+our $VERSION = '0.66';
our ( %SETTING, %DEFAULT, %STARTUP, $REVISION, $SINGLETON );
@@ -134,6 +135,7 @@ sub read {
my $class = shift;
unless ($SINGLETON) {
+ TRACE("Loading configuration for $class") if DEBUG;
# Load the host configuration
my $host = Padre::Config::Host->read;
@@ -152,6 +154,7 @@ sub read {
}
sub write {
+ TRACE( $_[0] ) if DEBUG;
my $self = shift;
# Save the user configuration
@@ -162,12 +165,14 @@ sub write {
$self->[Padre::Constant::HOST]->{version} = $REVISION;
$self->[Padre::Constant::HOST]->write;
- # Write the startup subset copy of the configuration
+ # Write the startup subset of the configuration.
+ # NOTE: Use a hyper-minimalist listified key/value file format
+ # so that we don't need to load YAML::Tiny before the thread fork.
+ # This should save around 400k of memory per background thread.
my %startup = map { $_ => $self->$_() } sort keys %STARTUP;
- YAML::Tiny::DumpFile(
- Padre::Constant::CONFIG_STARTUP,
- \%startup,
- );
+ open( my $FILE, '>', Padre::Constant::CONFIG_STARTUP ) or return 1;
+ print $FILE map {"$_\n$startup{$_}\n"} sort keys %startup or return 1;
+ close $FILE or return 1;
return 1;
}
@@ -193,6 +198,7 @@ sub default {
}
sub set {
+ TRACE( $_[1] ) if DEBUG;
my $self = shift;
my $name = shift;
my $value = shift;
@@ -236,6 +242,7 @@ sub set {
# Set a value in the configuration and apply the preference change
# to the application.
sub apply {
+ TRACE( $_[0] ) if DEBUG;
my $self = shift;
my $name = shift;
my $value = shift;
@@ -457,12 +464,6 @@ setting(
default => 0,
);
setting(
- name => 'main_todo',
- type => Padre::Constant::BOOLEAN,
- store => Padre::Constant::HUMAN,
- default => 0,
-);
-setting(
name => 'main_functions_order',
type => Padre::Constant::ASCII,
store => Padre::Constant::HUMAN,
@@ -480,6 +481,12 @@ setting(
default => 0,
);
setting(
+ name => 'main_todo',
+ type => Padre::Constant::BOOLEAN,
+ store => Padre::Constant::HUMAN,
+ default => 0,
+);
+setting(
name => 'main_directory',
type => Padre::Constant::BOOLEAN,
store => Padre::Constant::HUMAN,
@@ -961,25 +968,25 @@ setting(
name => 'main_top',
type => Padre::Constant::INTEGER,
store => Padre::Constant::HOST,
- default => 40,
+ default => -1,
);
setting(
name => 'main_left',
type => Padre::Constant::INTEGER,
store => Padre::Constant::HOST,
- default => 20,
+ default => -1,
);
setting(
name => 'main_width',
type => Padre::Constant::POSINT,
store => Padre::Constant::HOST,
- default => 600,
+ default => -1,
);
setting(
name => 'main_height',
type => Padre::Constant::POSINT,
store => Padre::Constant::HOST,
- default => 400,
+ default => -1,
);
# Run Parameters
@@ -10,7 +10,7 @@ use File::Path ();
use File::Spec ();
use File::HomeDir ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
# Convenience constants for the operating system
use constant WIN32 => !!( ( $^O eq 'MSWin32' ) or ( $^O eq 'cygwin' ) );
@@ -106,7 +106,7 @@ use constant PLUGIN_DIR => File::Spec->catdir( CONFIG_DIR, 'plugins' );
use constant PLUGIN_LIB => File::Spec->catdir( PLUGIN_DIR, 'Padre', 'Plugin' );
use constant CONFIG_HOST => File::Spec->catfile( CONFIG_DIR, 'config.db' );
use constant CONFIG_HUMAN => File::Spec->catfile( CONFIG_DIR, 'config.yml' );
-use constant CONFIG_STARTUP => File::Spec->catfile( CONFIG_DIR, 'startup.yml' );
+use constant CONFIG_STARTUP => File::Spec->catfile( CONFIG_DIR, 'startup.txt' );
# Do the initialisation in a function,
# so we can run it again later if needed.
@@ -141,7 +141,6 @@ BEGIN {
# NOTE: The only reason this is here is that it is needed both during
# main configuration, and also during Padre::Startup.
use constant DEFAULT_SINGLEINSTANCE => ( WIN32 and not( $ENV{HARNESS_ACTIVE} or $^P ) ) ? 1 : 0;
-
use constant DEFAULT_SINGLEINSTANCE_PORT => 4444;
1;
@@ -9,7 +9,7 @@ use Carp ();
use Exporter ();
use Params::Util ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
our @ISA = 'Exporter';
our @EXPORT_OK = '_CURRENT';
@@ -64,8 +64,11 @@ sub project {
sub text {
my $self = ref( $_[0] ) ? $_[0] : $_[0]->new;
my $editor = $self->editor;
- return '' unless defined $editor;
- return $editor->GetSelectedText;
+ if ( defined $editor ) {
+ return $editor->GetSelectedText;
+ } else {
+ return '';
+ }
}
# Get the title of the current editor window (and don't cache)
@@ -143,7 +146,6 @@ sub notebook {
# Get the current configuration from the main window (and don't cache).
sub config {
my $self = ref( $_[0] ) ? $_[0] : $_[0]->new;
-
if ( defined $self->main ) {
return $self->main->config;
} elsif ( $self->ide ) {
@@ -196,6 +198,7 @@ sub main {
# Convenience method
sub ide {
my $self = ref( $_[0] ) ? $_[0] : $_[0]->new;
+
if ( defined $self->{ide} ) {
return $self->{ide};
}
@@ -225,8 +228,8 @@ Padre::Current - convenient access to current objects within Padre
=head1 SYNOPSIS
- my $main = Padre::Current->main;
- ...
+ my $main = Padre::Current->main;
+ # ...
=head1 DESCRIPTION
@@ -242,11 +245,11 @@ retrieve whatever current object you need.
=head2 new
- # Vanilla constructor
- Padre::Current->new;
-
- # Seed the object with some context
- Padre::Current->new( document => $document );
+ # Vanilla constructor
+ Padre::Current->new;
+
+ # Seed the object with some context
+ Padre::Current->new( document => $document );
The C<new> constructor creates a new context object, it optionally takes
one or more named parameters which should be any context the caller is
@@ -4,7 +4,7 @@ use 5.008;
use strict;
use warnings;
-our $VERSION = '0.63';
+our $VERSION = '0.66';
sub select_names {
Padre::DB->selectcol_arrayref('select name from bookmark order by name');
@@ -8,7 +8,7 @@ use strict;
use warnings;
use Params::Util ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
sub recent {
my $class = shift;
@@ -6,7 +6,7 @@ use 5.008;
use strict;
use warnings;
-our $VERSION = '0.63';
+our $VERSION = '0.66';
sub read {
my %config = map { $_->name => $_->value } $_[0]->select;
@@ -9,7 +9,7 @@ use 5.008;
use strict;
use warnings;
-our $VERSION = '0.63';
+our $VERSION = '0.66';
sub get_last_pos {
my ( $class, $name ) = @_;
@@ -11,7 +11,7 @@ use DBD::SQLite ();
use vars qw{@ISA @EXPORT $FILE};
-our $VERSION = '0.63';
+our $VERSION = '0.66';
BEGIN {
@@ -18,7 +18,7 @@ use Padre::DB::Migrate::Patch ();
use vars qw{@ISA};
-our $VERSION = '0.63';
+our $VERSION = '0.66';
BEGIN {
@@ -4,7 +4,7 @@ use 5.008;
use strict;
use warnings;
-our $VERSION = '0.63';
+our $VERSION = '0.66';
# Finds and returns a single element by name
sub fetch_name {
@@ -7,7 +7,7 @@ use 5.008;
use strict;
use warnings;
-our $VERSION = '0.63';
+our $VERSION = '0.66';
1;
@@ -9,7 +9,7 @@ use 5.008;
use strict;
use warnings;
-our $VERSION = '0.63';
+our $VERSION = '0.66';
my $PADRE_SESSION = 'padre-last';
@@ -7,7 +7,7 @@ use 5.008;
use strict;
use warnings;
-our $VERSION = '0.63';
+our $VERSION = '0.66';
1;
@@ -9,7 +9,7 @@ use warnings;
use Padre::DB ();
use Padre::Current ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
sub set_mime_type {
my $class = shift;
@@ -39,7 +39,7 @@ use Padre::DB::LastPositionInFile ();
use Padre::DB::Session ();
use Padre::DB::SessionFile ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
our $COMPATIBLE = '0.26';
@@ -87,8 +87,10 @@ sub vacuum {
TRACE("VACUUM database") if DEBUG;
my $page_size = Padre::DB->pragma("page_size");
Padre::DB->do("VACUUM");
- my $diff = Padre::DB->pragma("page_size") - $page_size;
- TRACE("Page count difference after VACUUM: $diff") if DEBUG;
+ if (DEBUG) {
+ my $diff = Padre::DB->pragma('page_size') - $page_size;
+ TRACE("Page count difference after VACUUM: $diff");
+ }
return;
}
@@ -25,7 +25,7 @@ use warnings;
use File::Spec ();
use Padre::Constant ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
=pod
@@ -1,147 +0,0 @@
-package Padre::DocBrowser::POD;
-
-use 5.008;
-use strict;
-use warnings;
-use Config ();
-use File::Temp ();
-use IO::Scalar ();
-use Params::Util ();
-use Pod::Simple::XHTML ();
-use Pod::Abstract ();
-use Padre::DocBrowser::document ();
-use Padre::DocBrowser::PseudoPerldoc ();
-
-our $VERSION = '0.63';
-
-use Class::XSAccessor {
- constructor => 'new',
- getters => {
- get_provider => 'provider',
- },
-};
-
-sub provider_for {
- ( 'application/x-perl', 'application/x-pod' );
-}
-
-# uri schema like http:// pod:// blah://
-sub accept_schemes {
- 'perldoc';
-}
-
-sub viewer_for {
- 'application/x-pod';
-}
-
-sub resolve {
- my $self = shift;
- my $ref = shift;
- my $hints = shift;
- my $query = $ref;
-
- if ( Params::Util::_INSTANCE( $ref, 'URI' ) ) {
- $query = $ref->opaque;
- }
- my ( $docname, $section ) = split_link($query);
-
- # Put Pod::Perldoc to work on $query
- my ( $fh, $tempfile ) = File::Temp::tempfile();
-
- my @args = (
- '-u',
- "-d$tempfile",
- ( exists $hints->{lang} )
- ? ( '-L', ( $hints->{lang} ) )
- : (),
- ( exists $hints->{perlfunc} ) ? '-f'
- : (),
- ( exists $hints->{perlvar} ) ? '-v'
- : (),
- $query
- );
-
- my $pd = Padre::DocBrowser::PseudoPerldoc->new( args => \@args );
- SCOPE: {
- local *STDERR = IO::Scalar->new;
- local *STDOUT = IO::Scalar->new;
- eval { $pd->process() };
- }
-
- return unless -s $tempfile;
-
- my $pa = Pod::Abstract->load_file($tempfile);
- close $fh;
- unlink($tempfile);
-
- my $doc = Padre::DocBrowser::document->new( body => $pa->pod );
- $doc->mimetype('application/x-pod');
- my $title_from = $hints->{title_from_section} || 'NAME';
- my $name;
- if ( ($name) = $pa->select("/head1[\@heading =~ {$title_from}]")
- or ($name) = $pa->select("/head1") )
- {
- my $text = $name->text;
- my ($module) = $text =~ /([^\s]+)/g;
- $doc->title($module);
- } elsif ( ($name) = $pa->select("//item") ) {
- my $text = $name->pod;
- my ($item) = $text =~ /=item\s+([^\s]+)/g;
- $doc->title($item);
- }
-
- unless ( $pa->select('/pod')
- || $pa->select('//item')
- || $pa->select('//head1') )
- {
- warn "$ref has no pod in" . $pa->ptree;
-
- # Unresolvable ?
- return;
- }
-
- return $doc;
-
-}
-
-sub generate {
- my $self = shift;
- my $doc = shift;
- $doc->mimetype('application/x-pod');
- return $doc;
- #### TO DO , pod extract / pod tidy ?
-
- # (Ticket #671)
-}
-
-sub render {
- my $self = shift;
- my $doc = shift;
- my $data = '';
- return if not $doc;
- my $pod = IO::Scalar->new( \$doc->body );
- my $out = IO::Scalar->new( \$data );
- my $v = Pod::Simple::XHTML->new;
- $v->perldoc_url_prefix('perldoc:');
- $v->output_fh($out);
- $v->parse_file($pod);
- my $response = Padre::DocBrowser::document->new;
- $response->body( ${ $out->sref } );
- $response->mimetype('text/xhtml');
- $response->title( $doc->title );
- return $response;
-}
-
-# Utility function , really wants to be inside a class like
-# URI::perldoc ??
-sub split_link {
- my $query = shift;
- my ( $doc, $section ) = split /\//, $query, 2; # was m|([^/]+)/?+(.*+)|;
-}
-
-1;
-
-# Copyright 2008-2010 The Padre development team as listed in Padre.pm.
-# LICENSE
-# This program is free software; you can redistribute it and/or
-# modify it under the same terms as Perl 5 itself.
@@ -1,86 +0,0 @@
-package Padre::DocBrowser::PseudoPerldoc;
-
-use 5.008;
-use strict;
-use warnings;
-use Pod::Perldoc ();
-use Pod::Perldoc::ToPod ();
-
-our $VERSION = '0.63';
-our @ISA = 'Pod::Perldoc';
-
-sub new {
- my $class = shift;
- my $self = $class->SUPER::new(@_);
- return $self;
-}
-
-## Lie to Pod::PerlDoc - and avoid it's autoloading implementation
-sub find_good_formatter_class {
- $_[0]->{'formatter_class'} = 'Pod::Perldoc::ToPod';
- return;
-}
-
-# Even worse than monkey patching , copy paste from Pod::Perldoc w/ edits
-# to avoid untrappable calls to 'exit'
-sub process {
-
- # if this ever returns, its retval will be used for exit(RETVAL)
-
- my $self = shift;
-
- # TO DO: make it deal with being invoked as various different things
- # such as perlfaq".
-
- # (Ticket #672)
-
- return $self->usage_brief unless @{ $self->{'args'} };
- $self->pagers_guessing;
- $self->options_reading;
- $self->aside( sprintf "$0 => %s v%s\n", ref($self), $self->VERSION );
- $self->drop_privs_maybe;
- $self->options_processing;
-
- # Hm, we have @pages and @found, but we only really act on one
- # file per call, with the exception of the opt_q hack, and with
- # -l things
-
- $self->aside("\n");
-
- my @pages;
- $self->{'pages'} = \@pages;
- if ( $self->opt_f ) { @pages = ("perlfunc") }
- elsif ( $self->opt_q ) { @pages = ( "perlfaq1" .. "perlfaq9" ) }
- elsif ( $self->opt_v ) { @pages = ("perlvar") }
- else { @pages = @{ $self->{'args'} }; }
-
- return $self->usage_brief unless @pages;
-
- $self->find_good_formatter_class();
- $self->formatter_sanity_check();
-
- $self->maybe_diddle_INC();
-
- # for when we're apparently in a module or extension directory
-
- my @found = $self->grand_search_init( \@pages );
- return unless @found;
-
- if ( $self->opt_l ) {
- print join( "\n", @found ), "\n";
- return;
- }
-
- $self->tweak_found_pathnames( \@found );
- $self->assert_closing_stdout;
- return $self->page_module_file(@found) if $self->opt_m;
-
- return $self->render_and_page( \@found );
-}
-
-1;
-
-# Copyright 2008-2010 The Padre development team as listed in Padre.pm.
-# LICENSE
-# This program is free software; you can redistribute it and/or
-# modify it under the same terms as Perl 5 itself.
@@ -1,125 +0,0 @@
-package Padre::DocBrowser::document;
-
-use 5.008;
-use strict;
-use warnings;
-use File::Basename ();
-use Class::XSAccessor {
- constructor => 'new',
- accessors => {
- mimetype => 'mime_type',
- body => 'body',
- title => 'title',
- filename => 'filename',
- },
-};
-
-our $VERSION = '0.63';
-
-=pod
-
-=head1 NAME
-
-Padre::DocBrowser::document - is an afterthought
-
-L<Padre::DocBrowser> began using <Padre::Document> for internal representation
-of documents. This module aims to be less costly to serialize.
-
-=head1 CAVEATS
-
-Until this is a better copy of Padre::Document or the similar parts converge,
-it will probably change.
-
-=cut
-
-sub load {
- my ( $class, $path ) = @_;
- open( my $file_in, '<', $path ) or die "Failed to load '$path' $!";
- my $body;
- $body .= $_ while <$file_in>;
- close $file_in;
- my $doc = $class->new( body => $body, filename => $path );
- $doc->mimetype( $doc->guess_mimetype );
- $doc->title( $doc->guess_title );
- return $doc;
-}
-
-sub guess_title {
- my ($self) = @_;
- if ( $self->filename ) {
- return File::Basename::basename( $self->filename );
- }
- 'Untitled';
-}
-
-# Yuk .
-# This is the primary file extension to mime-type mapping
-our %EXT_MIME = (
- abc => 'text/x-abc',
- ada => 'text/x-adasrc',
- asm => 'text/x-asm',
- bat => 'text/x-bat',
- cpp => 'text/x-c++src',
- css => 'text/css',
- diff => 'text/x-patch',
- e => 'text/x-eiffel',
- f => 'text/x-fortran',
- htm => 'text/html',
- html => 'text/html',
- js => 'application/javascript',
- json => 'application/json',
- latex => 'application/x-latex',
- lsp => 'application/x-lisp',
- lua => 'text/x-lua',
- mak => 'text/x-makefile',
- mat => 'text/x-matlab',
- pas => 'text/x-pascal',
- pod => 'text/x-pod',
- php => 'application/x-php',
- py => 'text/x-python',
- rb => 'application/x-ruby',
- sql => 'text/x-sql',
- tcl => 'application/x-tcl',
- vbs => 'text/vbscript',
- patch => 'text/x-patch',
- pl => 'application/x-perl',
- plx => 'application/x-perl',
- pm => 'application/x-perl',
- pod => 'application/x-perl',
- t => 'application/x-perl',
- conf => 'text/plain',
- sh => 'application/x-shellscript',
- ksh => 'application/x-shellscript',
- txt => 'text/plain',
- xml => 'text/xml',
- yml => 'text/x-yaml',
- yaml => 'text/x-yaml',
- '4th' => 'text/x-forth',
- pasm => 'application/x-pasm',
- pir => 'application/x-pir',
- p6 => 'application/x-perl6',
-);
-
-sub guess_mimetype {
- my ($self) = @_;
- unless ( $self->filename ) {
- return 'application/x-pod';
- }
- my ( $path, $file, $suffix ) = File::Basename::fileparse(
- $self->filename,
- keys %EXT_MIME
- );
-
- my $type =
- exists $EXT_MIME{$suffix}
- ? $EXT_MIME{$suffix}
- : '';
- return $type;
-}
-
-1;
-
-# Copyright 2008-2010 The Padre development team as listed in Padre.pm.
-# LICENSE
-# This program is free software; you can redistribute it and/or
-# modify it under the same terms as Perl 5 itself.
@@ -1,311 +0,0 @@
-package Padre::DocBrowser;
-
-use 5.008;
-use strict;
-use warnings;
-use Carp ();
-use Scalar::Util ();
-use Padre::DocBrowser::POD ();
-
-our $VERSION = '0.63';
-
-use Class::XSAccessor {
- getters => {
- get_providers => 'providers',
- get_viewers => 'viewers',
- get_schemes => 'schemes',
- },
- setters => {
- set_providers => 'providers',
- set_viewers => 'viewers',
- set_schemes => 'schemes',
- },
-};
-
-=pod
-
-=head1 NAME
-
-Padre::DocBrowser -- documentation browser for Padre
-
-=head1 DESCRIPTION
-
-Provide an interface for retrieving / generating documentation, resolving terms
-to documentation (search?) and formatting documentation.
-
-Allow new packages to be loaded and interrogated for the MIME types they can
-generate documentation for. Provide similar mechanism for registering new
-documentation viewers and URI schemes accepted for resolving.
-
-B<NOTE:> I think all the method names are wrong. Blast it.
-
-=head1 SYNOPSIS
-
- # Does perlish things by default via 'Padre::DocBrowser::POD'
- my $browser = Padre::DocBrowser->new();
- my $source = Padre::Document->new( filename=>'source/Package.pm' );
-
- my $docs = $browser->docs( $source );
- # $docs provided by DocBrowser::POD->generate
- # should be Padre::DocBrowser::document , application/x-pod
-
- my $output = $browser->browse( $docs );
- # $output provided by DocBrowser::POD->render
- # should be Padre::Document , text/x-html
-
- $browser->load_viewer( 'Padre::DocBrowser::PodAdvanced' );
- # PodAdvanced->render might add an html TOC in addition to
- # just pod2html
-
- my $new_output = $browser->browse( $docs );
- # $new_output now with a table of contents
-
-=head1 METHODS
-
-=head2 new
-
-Boring constructor, pass nothing. Yet.
-
-=head2 load_provider
-
-Accepts a single class name, will attempt to auto-L<use> the class and
-interrogate its C<provider_for> method. Any MIME types returned will be
-associated with the class for dispatch to C<generate>.
-
-Additionally, interrogate class for C<accept_schemes> and associate the class
-with URI schemes for dispatch to C<resolve>.
-
-=head2 load_viewer
-
-Accepts a single class name, will attempt to auto-L<use> the class and
-interrogate its C<viewer_for> method. Any MIME types returned will be
-associated with the class for dispatch to C<render>.
-
-=head2 resolve
-
-Accepts a URI or scalar
-
-=head2 browse
-
-=head2 accept
-
-=head1 EXTENDING
-
- package My::DocBrowser::Doxygen;
-
- # URI of doxygen:$string or doxygen://path?query
- sub accept_schemes {
- 'doxygen',
- }
-
- sub provider_for {
- 'text/x-c++src'
- }
-
- sub viewer_for {
- 'text/x-doxygen',
- }
-
- sub generate {
- my ($self,$doc) = @_;
- # $doc will be Padre::Document of any type specified
- # by ->provider_for
-
- # push $doc through doxygen
- # ...
- # that was easy :)
-
- # You know your own output type, be explicit
- my $response = Padre::Document->new();
- $response->{original_content} = $doxygen->output;
- $response->set_mimetype( 'text/x-doxygen' );
- return $response;
- }
-
- sub render {
- my ($self,$docs) = @_;
- # $docs will be of any type specified
- # by ->viewer_for;
-
- ## turn $docs into doxygen(y) html document
- # ...
- #
-
- my $response = Padre::Document->new();
- $response->{original_content} = $doxy2html->output;
- $response->set_mimetype( 'text/x-html' );
- return $response;
-
- }
-
-=cut
-
-sub new {
- my ( $class, %args ) = @_;
-
- my $self = bless \%args, ref($class) || $class;
- $self->set_providers( {} ) unless $args{providers};
- $self->set_viewers( {} ) unless $args{viewers};
- $self->set_schemes( {} ) unless $args{schemes};
-
- # Provides pod from perl, pod: perldoc: schemes
- $self->load_provider('Padre::DocBrowser::POD');
-
- # Produces html view of POD
- $self->load_viewer('Padre::DocBrowser::POD');
-
- return $self;
-}
-
-sub load_provider {
- my ( $self, $class ) = @_;
-
- unless ( $class->VERSION ) {
- eval "require $class;";
- die("Failed to load $class: $@") if $@;
- }
- if ( $class->can('provider_for') ) {
- $self->register_providers( $_ => $class ) for $class->provider_for;
- } else {
- Carp::confess("$class is not a provider for anything.");
- }
-
- if ( $class->can('accept_schemes') ) {
- $self->register_schemes( $_ => $class ) for $class->accept_schemes;
- } else {
- Carp::confess("$class accepts no uri schemes");
- }
-
- return $self;
-}
-
-sub load_viewer {
- my ( $self, $class ) = @_;
- unless ( $class->VERSION ) {
- eval "require $class;";
- die("Failed to load $class: $@") if $@;
- }
- if ( $class->can('viewer_for') ) {
- $self->register_viewers( $_ => $class ) for $class->viewer_for;
- }
- $self;
-}
-
-sub register_providers {
- my ( $self, %provides ) = @_;
- while ( my ( $type, $class ) = each %provides ) {
-
- # TO DO - handle collisions, ie multi providers
-
- # (Ticket #673)
-
- $self->get_providers->{$type} = $class;
- }
- $self;
-}
-
-sub register_viewers {
- my ( $self, %viewers ) = @_;
- while ( my ( $type, $class ) = each %viewers ) {
- $self->get_viewers->{$type} = $class;
- unless ( $class->VERSION ) {
- eval "require $class;";
- die("Failed to load $class: $@") if $@;
- }
- }
- $self;
-}
-
-sub register_schemes {
- my ( $self, %schemes ) = @_;
- while ( my ( $scheme, $class ) = each %schemes ) {
- $self->get_schemes->{$scheme} = $class;
- }
- $self;
-}
-
-sub provider_for {
- my ( $self, $type ) = @_;
- my $p;
- eval {
- if ( exists $self->get_providers->{$type} )
- {
- $p = $self->get_providers->{$type}->new;
- }
- };
- Carp::confess($@) if $@;
- return $p;
-}
-
-sub accept {
- my ( $self, $scheme ) = @_;
- if ( defined $self->get_schemes->{$scheme} ) {
- return $self->get_schemes->{$scheme};
- }
- return;
-}
-
-sub viewer_for {
- my ( $self, $type ) = @_;
- my $v;
- eval {
- if ( exists $self->get_viewers->{$type} )
- {
- $v = $self->get_viewers->{$type}->new;
- }
- };
- Carp::confess($@) if $@;
- return $v;
-}
-
-sub docs {
- my ( $self, $doc ) = @_;
- if ( my $provider = $self->provider_for( $doc->guess_mimetype ) ) {
- my $docs = $provider->generate($doc);
- return $docs;
- }
- return;
-}
-
-sub resolve {
- my ( $self, $ref, $hints ) = @_;
- my @refs;
- if ( Scalar::Util::blessed($ref) and $ref->isa('URI') ) {
- return $self->resolve_uri( $ref, $hints );
- }
-
- # TO DO this doubles up if a provider subscribes to multi
- # mimetypes .
-
- # (Ticket #674)
-
- foreach my $class ( values %{ $self->get_providers } ) {
- my $resp = $class->resolve( $ref, $hints );
- push @refs, $resp if $resp;
- last if $resp;
- }
- return $refs[0];
-}
-
-sub resolve_uri {
- my ( $self, $uri, $hints ) = @_;
- my $resolver = $self->accept( $uri->scheme );
- return unless $resolver;
- my $doc = $resolver->resolve( $uri, $hints );
- return $doc;
-}
-
-sub browse {
- my ( $self, $docs ) = @_;
- if ( my $viewer = $self->viewer_for( $docs->mimetype ) ) {
- return $viewer->render($docs);
- }
- return;
-}
-
-1;
-
-# Copyright 2008-2010 The Padre development team as listed in Padre.pm.
-# LICENSE
-# This program is free software; you can redistribute it and/or
-# modify it under the same terms as Perl 5 itself.
@@ -5,7 +5,7 @@ use strict;
use warnings;
use Padre::Document ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
our @ISA = 'Padre::Document';
sub comment_lines_str {
@@ -5,7 +5,7 @@ use strict;
use warnings;
use Padre::Document ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
our @ISA = 'Padre::Document';
1;
@@ -4,7 +4,7 @@ use 5.008;
use strict;
use warnings;
-our $VERSION = '0.63';
+our $VERSION = '0.66';
=head1 NAME
@@ -0,0 +1,36 @@
+package Padre::Document::Perl::FunctionList;
+
+use 5.008;
+use strict;
+use warnings;
+use Padre::Task::FunctionList ();
+
+our $VERSION = '0.66';
+our @ISA = 'Padre::Task::FunctionList';
+
+
+
+
+
+######################################################################
+# Padre::Task::FunctionList Methods
+
+sub find {
+ my $n = "\\cM?\\cJ";
+ return grep { defined $_ } $_[1] =~ m/
+ (?:
+ (?:$n)*__(?:DATA|END)__\b.*
+ |
+ $n$n=\w+.*?$n$n=cut\b(?=.*?$n$n)
+ |
+ (?:^|$n)\s*sub\s+(\w+(?:::\w+)*)
+ )
+ /sgx;
+}
+
+1;
+
+# Copyright 2008-2010 The Padre development team as listed in Padre.pm.
+# LICENSE
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl 5 itself.
@@ -9,7 +9,7 @@ use Padre::Util ();
use Padre::Help ();
use Padre::Logger;
-our $VERSION = '0.63';
+our $VERSION = '0.66';
our @ISA = 'Padre::Help';
# for caching help list (for faster access)
@@ -174,7 +174,7 @@ sub _parse_perlopref {
# Open perlopref.pod for reading
my $perlopref = File::Spec->join( Padre::Util::sharedir('doc'), 'perlopref', 'perlopref.pod' );
- if ( open my $fh, '<', $perlopref ) { ## no critic (RequireBriefOpen)
+ if ( open my $fh, '<', $perlopref ) { #-# no critic (RequireBriefOpen)
# Add PRECEDENCE to index
until ( <$fh> =~ /=head1 PRECEDENCE/ ) { }
@@ -253,8 +253,8 @@ sub help_render {
}
# Render using perldoc pseudo code package
- require Padre::DocBrowser::POD;
- my $pod = Padre::DocBrowser::POD->new;
+ require Padre::Browser::POD;
+ my $pod = Padre::Browser::POD->new;
my $doc = $pod->resolve( $topic, $hints );
my $pod_html = $pod->render($doc);
if ($pod_html) {
@@ -8,7 +8,7 @@ use PPI::Dumper ();
use Text::Balanced ();
use Padre::Logger;
-our $VERSION = '0.63';
+our $VERSION = '0.66';
sub class_to_color {
my $class = shift;
@@ -0,0 +1,100 @@
+package Padre::Document::Perl::Outline;
+
+use 5.008;
+use strict;
+use warnings;
+use Padre::Task::Outline ();
+
+our $VERSION = '0.66';
+our @ISA = 'Padre::Task::Outline';
+
+
+
+
+
+######################################################################
+# Padre::Task::Outline Methods
+
+sub find {
+ my $self = shift;
+ my $text = shift;
+
+ # Parse the document
+ require PPI::Document;
+ my $ppi = PPI::Document->new( \$text );
+ return [] unless defined $ppi;
+ $ppi->index_locations;
+
+ # Search for interesting things
+ require PPI::Find;
+ my @things = PPI::Find->new(
+ sub {
+
+ # This is a fairly ugly search
+ return 1 if ref $_[0] eq 'PPI::Statement::Package';
+ return 1 if ref $_[0] eq 'PPI::Statement::Include';
+ return 1 if ref $_[0] eq 'PPI::Statement::Sub';
+ return 1 if ref $_[0] eq 'PPI::Statement';
+ }
+ )->in($ppi);
+
+ # Build the outline structure from the search results
+ my @outline = ();
+ my $cur_pkg = {};
+ my $not_first_one = 0;
+ foreach my $thing (@things) {
+ if ( ref $thing eq 'PPI::Statement::Package' ) {
+ if ($not_first_one) {
+ if ( not $cur_pkg->{name} ) {
+ $cur_pkg->{name} = 'main';
+ }
+ push @outline, $cur_pkg;
+ $cur_pkg = {};
+ }
+ $not_first_one = 1;
+ $cur_pkg->{name} = $thing->namespace;
+ $cur_pkg->{line} = $thing->location->[0];
+ } elsif ( ref $thing eq 'PPI::Statement::Include' ) {
+ next if $thing->type eq 'no';
+ if ( $thing->pragma ) {
+ push @{ $cur_pkg->{pragmata} }, { name => $thing->pragma, line => $thing->location->[0] };
+ } elsif ( $thing->module ) {
+ push @{ $cur_pkg->{modules} }, { name => $thing->module, line => $thing->location->[0] };
+ }
+ } elsif ( ref $thing eq 'PPI::Statement::Sub' ) {
+ push @{ $cur_pkg->{methods} }, { name => $thing->name, line => $thing->location->[0] };
+ } elsif ( ref $thing eq 'PPI::Statement' ) {
+
+ # last resort, let's analyse further down...
+ my $node1 = $thing->first_element;
+ my $node2 = $thing->child(2);
+ next unless defined $node2;
+
+ # Moose attribute declaration
+ if ( $node1->isa('PPI::Token::Word') && $node1->content eq 'has' ) {
+ push @{ $cur_pkg->{attributes} }, { name => $node2->content, line => $thing->location->[0] };
+ next;
+ }
+
+ # MooseX::POE event declaration
+ if ( $node1->isa('PPI::Token::Word') && $node1->content eq 'event' ) {
+ push @{ $cur_pkg->{events} }, { name => $node2->content, line => $thing->location->[0] };
+ next;
+ }
+ }
+ }
+
+ if ( not $cur_pkg->{name} ) {
+ $cur_pkg->{name} = 'main';
+ }
+ push @outline, $cur_pkg;
+
+ return \@outline;
+}
+
+1;
+
+# Copyright 2008-2010 The Padre development team as listed in Padre.pm.
+# LICENSE
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl 5 itself.
@@ -7,7 +7,7 @@ use Padre::Document ();
use Padre::Util ();
use Padre::Logger;
-our $VERSION = '0.63';
+our $VERSION = '0.66';
sub colorize {
my $self = shift;
@@ -4,7 +4,7 @@ use 5.008;
use strict;
use warnings;
-our $VERSION = '0.63';
+our $VERSION = '0.66';
#
# Constructor.
@@ -4,7 +4,7 @@ use 5.008;
use strict;
use warnings;
-our $VERSION = '0.63';
+our $VERSION = '0.66';
#
# Constructor.
@@ -6,7 +6,7 @@ use warnings;
use PPI ();
use Padre::QuickFix ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
our @ISA = 'Padre::QuickFix';
# Returns the quick fix list
@@ -0,0 +1,164 @@
+package Padre::Document::Perl::Syntax;
+
+use 5.008;
+use strict;
+use warnings;
+use Padre::Constant ();
+use Padre::Task::Syntax ();
+
+our $VERSION = '0.66';
+our @ISA = 'Padre::Task::Syntax';
+
+sub syntax {
+ my $self = shift;
+ my $text = shift;
+
+ # Localise newlines using Adam's magic "Universal Newline"
+ # regex conveniently stolen from File::LocalizeNewlines.
+ # (Conveniently adding a bunch of dependencies for one regex)
+ $text =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg;
+
+ # Execute the syntax check
+ my $stderr = '';
+ my $filename = undef;
+ SCOPE: {
+
+ # Create a temporary file with the Perl text
+ require File::Temp;
+ my $file = File::Temp->new( UNLINK => 1 );
+ binmode( $file, ":utf8" );
+ $file->print($text);
+ $file->close;
+ $filename = $file->filename;
+
+ # Run with console Perl to prevent unexpected results under wperl
+ require Padre::Perl;
+ my @cmd = ( Padre::Perl::cperl() );
+
+ # Append Perl command line options
+ if ( $self->{project} ) {
+ push @cmd, '-Ilib';
+ }
+
+ # Open a temporary file for standard error redirection
+ my $err = File::Temp->new( UNLINK => 1 );
+ $err->close;
+
+ # Redirect perl's output to temporary file
+ push @cmd,
+ (
+ '-Mdiagnostics',
+ '-c',
+ $file->filename,
+ '2>' . $err->filename,
+ );
+
+ # We need shell redirection (list context does not give that)
+ my $cmd = join ' ', @cmd;
+
+ # Make sure we execute from the correct directory
+ if (Padre::Constant::WIN32) {
+ require Padre::Util::Win32;
+ Padre::Util::Win32::ExecuteProcessAndWait(
+ directory => $self->{project},
+ file => 'cmd.exe',
+ parameters => "/C $cmd",
+ );
+ } else {
+ require File::pushd;
+ my $pushd = File::pushd::pushd( $self->{project} );
+ system $cmd;
+ }
+
+ # Slurp Perl's stderr...
+ open my $fh, '<', $err->filename or die $!;
+ local $/ = undef;
+ $stderr = <$fh>;
+ close $fh;
+
+ # ...and delete it
+ require File::Remove;
+ File::Remove::remove( $err->filename );
+ }
+
+ # Don't really know where that comes from...
+ my $i = index( $stderr, 'Uncaught exception from user code' );
+ if ( $i > 0 ) {
+ $stderr = substr( $stderr, 0, $i );
+ }
+
+ # Handle the "no errors or warnings" case
+ if ( $stderr =~ /^\s+syntax OK\s+$/s ) {
+ return [];
+ }
+
+ # Split into message paragraphs
+ $stderr =~ s/\n\n/\n/go;
+ $stderr =~ s/\n\s/\x1F /go;
+ my @messages = split( /\n/, $stderr );
+
+ my @issues = ();
+ my @diag = ();
+ foreach my $message (@messages) {
+ last if index( $message, 'has too many errors' ) > 0;
+ last if index( $message, 'had compilation errors' ) > 0;
+ last if index( $message, 'syntax OK' ) > 0;
+
+ my $error = {};
+ my $tmp = '';
+
+ if ( $message =~ s/\s\(\#(\d+)\)\s*\Z//o ) {
+ $error->{diag} = $1 - 1;
+ }
+
+ if ( $message =~ m/\)\s*\Z/o ) {
+ my $pos = rindex( $message, '(' );
+ $tmp = substr( $message, $pos, length($message) - $pos, '' );
+ }
+
+ if ( $message =~ s/\s\(\#(\d+)\)(.+)//o ) {
+ $error->{diag} = $1 - 1;
+ my $diagtext = $2;
+ $diagtext =~ s/\x1F//go;
+ push @diag, join( ' ', split( ' ', $diagtext ) );
+ }
+
+ if ( $message =~ s/\sat(?:\s|\x1F)+(.+?)(?:\s|\x1F)line(?:\s|\x1F)(\d+)//o ) {
+ next if $1 ne $filename;
+ $error->{line} = $2;
+ $error->{msg} = $message;
+ }
+
+ if ($tmp) {
+ $error->{msg} .= "\n" . $tmp;
+ }
+
+ if ( defined $error->{msg} ) {
+ $error->{msg} =~ s/\x1F/\n/go;
+ }
+
+ if ( defined $error->{diag} ) {
+ $error->{desc} = $diag[ $error->{diag} ];
+ delete $error->{diag};
+ }
+ if ( defined( $error->{desc} )
+ && $error->{desc} =~ /^\s*\([WD]/o )
+ {
+ $error->{severity} = 1;
+ } else {
+ $error->{severity} = 0;
+ }
+ delete $error->{desc};
+
+ push @issues, $error;
+ }
+
+ return \@issues;
+}
+
+1;
+
+# Copyright 2008-2010 The Padre development team as listed in Padre.pm.
+# LICENSE
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl 5 itself.
@@ -3,22 +3,44 @@ package Padre::Document::Perl;
use 5.008;
use strict;
use warnings;
-use Carp ();
-use Encode ();
-use File::Spec ();
-use File::Temp ();
-use File::Find::Rule ();
-use Params::Util ('_INSTANCE');
-use YAML::Tiny ();
-use Padre::Util ();
-use Padre::Perl ();
-use Padre::Document ();
-use Padre::File ();
-use Padre::Document::Perl::Beginner ();
+use Carp ();
+use Encode ();
+use File::Spec ();
+use File::Temp ();
+use File::Find::Rule ();
+use Params::Util ('_INSTANCE');
+use YAML::Tiny ();
+use Padre::Util ();
+use Padre::Perl ();
+use Padre::Document ();
+use Padre::File ();
+use Padre::Role::Task ();
use Padre::Logger;
-our $VERSION = '0.63';
-our @ISA = 'Padre::Document';
+our $VERSION = '0.66';
+our @ISA = qw{
+ Padre::Role::Task
+ Padre::Document
+};
+
+
+
+
+
+#####################################################################
+# Task Integration
+
+sub task_functions {
+ return 'Padre::Document::Perl::FunctionList';
+}
+
+sub task_outline {
+ return 'Padre::Document::Perl::Outline';
+}
+
+sub task_syntax {
+ return 'Padre::Document::Perl::Syntax';
+}
@@ -30,7 +52,7 @@ our @ISA = 'Padre::Document';
# Ticket #637:
# TO DO watch out! These PPI methods may be VERY expensive!
# (Ballpark: Around 1 Gigahertz-second of *BLOCKING* CPU per 1000 lines)
-# Check out Padre::Task::PPI and its subclasses instead!
+# Check out Padre::Task::PPI and children instead!
sub ppi_get {
my $self = shift;
my $text = $self->text_get;
@@ -225,12 +247,20 @@ sub keywords {
return $keywords;
}
+# This emulates qr/(?<=^|[\012\015])sub\s$name\b/ but without
+# triggering a "Variable length lookbehind not implemented" error.
+# return qr/(?:(?<=^)\s*sub\s+$_[1]|(?<=[\012\015])\s*sub\s+$_[1])\b/;
+sub get_function_regex {
+ qr/(?:^|[^# \t])[ \t]*(sub\s+$_[1])\b/;
+}
+
sub get_functions {
- my $self = shift;
+ $_[0]->find_functions( $_[0]->text_get );
+}
- # Filter out POD
+sub find_functions {
my $n = "\\cM?\\cJ";
- return grep { defined $_ } $self->text_get =~ m/
+ return grep { defined $_ } $_[1] =~ m/
(?:
(?:$n)*__(?:DATA|END)__\b.*
|
@@ -241,14 +271,6 @@ sub get_functions {
/sgx;
}
-sub get_function_regex {
-
- # This emulates qr/(?<=^|[\012\015])sub\s$name\b/ but without
- # triggering a "Variable length lookbehind not implemented" error.
- # return qr/(?:(?<=^)\s*sub\s+$_[1]|(?<=[\012\015])\s*sub\s+$_[1])\b/;
- return qr/(?:^|[^# \t])[ \t]*(sub\s+$_[1])\b/;
-}
-
=pod
=head2 get_command
@@ -343,7 +365,7 @@ sub pre_process {
# Checks the syntax of a Perl document.
# Documented in Padre::Document!
-# Implemented as a task. See Padre::Task::SyntaxChecker::Perl
+# Implemented as a task. See Padre::Document::Perl::Syntax
sub check_syntax {
shift->_check_syntax_internals(
@@ -384,33 +406,23 @@ sub _check_syntax_internals {
}
$self->{last_syncheck_md5} = $md5;
- my $nlchar = $self->newline;
-
- require Padre::Task::SyntaxChecker::Perl;
- my %check = (
- editor => $self->editor,
- text => $text,
- newlines => $nlchar,
+ require Padre::Document::Perl::Syntax;
+ my $task = Padre::Document::Perl::Syntax->new(
+ document => $self,
);
- if ( exists $args->{on_finish} ) {
- $check{on_finish} = $args->{on_finish};
- }
- if ( $self->project ) {
- $check{cwd} = $self->project->root;
- $check{perl_cmd} = ['-Ilib'];
- }
- my $task = Padre::Task::SyntaxChecker::Perl->new(%check);
+
if ( $args->{background} ) {
# asynchroneous execution (see on_finish hook)
$task->schedule;
- return ();
+ return;
} else {
# serial execution, returning the result
- return () if $task->prepare() =~ /^break$/;
- $task->run();
- return $task->{syntax_check};
+ $task->prepare or return;
+ $task->run;
+ $task->finish;
+ return $task->{model};
}
}
@@ -435,6 +447,7 @@ sub beginner_check {
# it should at least go to the line it's complaining about.
# Ticket #534
+ require Padre::Document::Perl::Beginner;
my $Beginner = Padre::Document::Perl::Beginner->new(
document => $self,
editor => $self->editor
@@ -453,64 +466,44 @@ sub beginner_check {
return 1;
}
-sub get_outline {
- my $self = shift;
- my %args = @_;
-
- my $text = $self->text_get;
- unless ( defined $text and $text ne '' ) {
- return [];
- }
-
- # Do we really need an update?
- require Digest::MD5;
- my $md5 = Digest::MD5::md5_hex( Encode::encode_utf8($text) );
- unless ( $args{force} ) {
- if ( defined( $self->{last_outline_md5} )
- and $self->{last_outline_md5} eq $md5 )
- {
- return;
- }
- }
- $self->{last_outline_md5} = $md5;
-
- my %arg = (
- editor => $self->editor,
- text => $text,
- filename => defined $self->filename ? $self->filename : $self->get_title,
- );
- if ( $self->project ) {
- $arg{cwd} = $self->project->root;
- $arg{perl_cmd} = ['-Ilib'];
- }
-
- require Padre::Task::Outline::Perl;
- my $task = Padre::Task::Outline::Perl->new(%arg);
-
- # asynchronous execution (see on_finish hook)
- $task->schedule;
- return;
-}
-
sub comment_lines_str {
return '#';
}
sub find_unmatched_brace {
- my ($self) = @_;
+ TRACE("find_unmatched_brace") if DEBUG;
+ my $self = shift;
- # create a new object of the task class and schedule it
- require Padre::Task::PPI::FindUnmatchedBrace;
- Padre::Task::PPI::FindUnmatchedBrace->new(
+ # Fire the task
+ $self->task_request(
+ task => 'Padre::Task::FindUnmatchedBrace',
+ document => $self,
+ callback => 'find_unmatched_brace_response',
+ );
- # for parsing
- text => $self->text_get,
+ return;
+}
- # will be available in "finish" but not in "run"/"process_ppi"
- document => $self,
- )->schedule;
+sub find_unmatched_brace_response {
+ TRACE("find_unmatched_brace_response") if DEBUG;
+ my $self = shift;
+ my $task = shift;
- return ();
+ # Found what we were looking for
+ if ( $task->{location} ) {
+ $self->ppi_select( $task->{location} );
+ return;
+ }
+
+ # Must have been a clean result
+ # TO DO: Convert this to a call to ->main that doesn't require
+ # us to use Wx directly.
+ Wx::MessageBox(
+ Wx::gettext("All braces appear to be matched"),
+ Wx::gettext("Check Complete"),
+ Wx::wxOK,
+ $self->current->main,
+ );
}
# finds the start of the current symbol.
@@ -571,7 +564,7 @@ sub get_current_symbol {
}
sub find_variable_declaration {
- my ($self) = @_;
+ my $self = shift;
my ( $location, $token ) = $self->get_current_symbol;
unless ( defined $location ) {
@@ -579,19 +572,49 @@ sub find_variable_declaration {
Wx::gettext("Current cursor does not seem to point at a variable"),
Wx::gettext("Check cancelled"),
Wx::wxOK,
- Padre->ide->wx->main
+ $self->current->main,
);
- return ();
+ return;
}
- # create a new object of the task class and schedule it
- require Padre::Task::PPI::FindVariableDeclaration;
- Padre::Task::PPI::FindVariableDeclaration->new(
+ # Create a new object of the task class and schedule it
+ $self->task_request(
+ task => 'Padre::Task::FindVariableDeclaration',
document => $self,
location => $location,
- )->schedule;
+ callback => 'find_variable_declaration_response',
+ );
- return ();
+ return;
+}
+
+sub find_variable_declaration_response {
+ my $self = shift;
+ my $task = shift;
+
+ # Found what we were looking for
+ if ( $task->{location} ) {
+ $self->ppi_select( $task->{location} );
+ return;
+ }
+
+ # Couldn't find the variable declaration.
+ # TO DO: Convert this to a call to ->main that doesn't require
+ # us to use Wx directly.
+ my $text;
+ if ( $self->{error} =~ /no token/ ) {
+ $text = Wx::gettext("Current cursor does not seem to point at a variable");
+ } elsif ( $self->{error} =~ /no declaration/ ) {
+ $text = Wx::gettext("No declaration could be found for the specified (lexical?) variable");
+ } else {
+ $text = Wx::gettext("Unknown error");
+ }
+ Wx::MessageBox(
+ $text,
+ Wx::gettext("Search Canceled"),
+ Wx::wxOK,
+ $self->current->main,
+ );
}
sub find_method_declaration {
@@ -791,47 +814,111 @@ sub get_sub_line_number {
# Padre::Document Document Manipulation
sub lexical_variable_replacement {
- my ( $self, $replacement ) = @_;
+ my $self = shift;
+ my $name = shift;
+ # Can we find something to replace
my ( $location, $token ) = $self->get_current_symbol;
if ( not defined $location ) {
Wx::MessageBox(
Wx::gettext("Current cursor does not seem to point at a variable"),
Wx::gettext("Check cancelled"),
Wx::wxOK,
- Padre->ide->wx->main
+ $self->current->main,
);
- return ();
+ return;
}
- # create a new object of the task class and schedule it
- require Padre::Task::PPI::LexicalReplaceVariable;
- Padre::Task::PPI::LexicalReplaceVariable->new(
+ # Launch the background task
+ $self->task_request(
+ task => 'Padre::Task::LexicalReplaceVariable',
document => $self,
location => $location,
- replacement => $replacement,
- )->schedule;
+ replacement => $name,
+ callback => 'lexical_variable_replacement_response',
+ );
- return ();
+ return;
}
-sub introduce_temporary_variable {
- my ( $self, $varname ) = @_;
+sub lexical_variable_replacement_response {
+ my $self = shift;
+ my $task = shift;
- my $editor = $self->editor;
- my $start_position = $editor->GetSelectionStart;
- my $end_position = $editor->GetSelectionEnd - 1;
+ if ( defined $task->{munged} ) {
- # create a new object of the task class and schedule it
- require Padre::Task::PPI::IntroduceTemporaryVariable;
- Padre::Task::PPI::IntroduceTemporaryVariable->new(
+ # GUI update
+ # TO DO: What if the document changed? Bad luck for now.
+ $self->editor->SetText( $task->{munged} );
+ $self->ppi_select( $task->{location} );
+ return;
+ }
+
+ # Explain why it didn't work
+ my $text;
+ my $error = $self->{error} || '';
+ if ( $error =~ /no token/ ) {
+ $text = Wx::gettext("Current cursor does not seem to point at a variable");
+ } elsif ( $error =~ /no declaration/ ) {
+ $text = Wx::gettext("No declaration could be found for the specified (lexical?) variable");
+ } else {
+ $text = Wx::gettext("Unknown error");
+ }
+ Wx::MessageBox(
+ $text,
+ Wx::gettext("Replace Operation Canceled"),
+ Wx::wxOK,
+ $self->current->main,
+ );
+}
+
+sub introduce_temporary_variable {
+ my $self = shift;
+ my $name = shift;
+ my $editor = $self->editor;
+
+ # Run the replacement in the background
+ $self->task_request(
+ task => 'Padre::Task::IntroduceTemporaryVariable',
document => $self,
- start_location => $start_position,
- end_location => $end_position,
- varname => $varname,
- )->schedule;
+ varname => $name,
+ start_location => $editor->GetSelectionStart,
+ end_location => $editor->GetSelectionEnd - 1,
+ callback => 'introduce_temporary_variable_response',
+ );
- return ();
+ return;
+}
+
+sub introduce_temporary_variable_response {
+ my $self = shift;
+ my $task = shift;
+
+ if ( defined $task->{munged} ) {
+
+ # GUI update
+ # TO DO: What if the document changed? Bad luck for now.
+ $self->editor->SetText( $task->{munged} );
+ $self->ppi_select( $task->{location} );
+ return;
+ }
+
+ # Explain why it didn't work
+ my $text;
+ my $error = $self->{error} || '';
+ if ( $error =~ /no token/ ) {
+ $text = Wx::gettext("First character of selection does not seem to point at a token.");
+ } elsif ( $error =~ /no statement/ ) {
+ $text = Wx::gettext("Selection not part of a Perl statement?");
+ } else {
+ $text = Wx::gettext("Unknown error");
+ }
+ Wx::MessageBox(
+ $text,
+ Wx::gettext("Replace Operation Canceled"),
+ Wx::wxOK,
+ $self->current->main,
+ );
}
# this method takes the new subroutine name
@@ -1554,7 +1641,7 @@ sub event_on_right_down {
sub {
my $editor = shift;
my $doc = $self; # FIX ME if Padre::Wx::Editor had a method to access its Document...
- return unless Params::Util::_INSTANCE( $doc, 'Padre::Document::Perl' );
+ return unless _INSTANCE( $doc, 'Padre::Document::Perl' );
$doc->find_variable_declaration;
},
);
@@ -1567,7 +1654,7 @@ sub event_on_right_down {
# FIX ME near duplication of the code in Padre::Wx::Menu::Perl
my $editor = shift;
my $doc = $self; # FIX ME if Padre::Wx::Editor had a method to access its Document...
- return unless Params::Util::_INSTANCE( $doc, 'Padre::Document::Perl' );
+ return unless _INSTANCE( $doc, 'Padre::Document::Perl' );
require Padre::Wx::History::TextEntryDialog;
my $dialog = Padre::Wx::History::TextEntryDialog->new(
$editor->main,
@@ -1593,7 +1680,7 @@ sub event_on_right_down {
sub {
my $editor = shift;
my $doc = $self; # FIX ME if Padre::Wx::Editor had a method to access its Document...
- return unless Params::Util::_INSTANCE( $doc, 'Padre::Document::Perl' );
+ return unless _INSTANCE( $doc, 'Padre::Document::Perl' );
$doc->find_method_declaration;
},
);
@@ -127,6 +127,7 @@ use warnings;
use Carp ();
use File::Spec ();
use File::Temp ();
+use Padre::Cache ();
use Padre::Constant ();
use Padre::Current ();
use Padre::Util ();
@@ -136,7 +137,26 @@ use Padre::MimeTypes ();
use Padre::File ();
use Padre::Logger;
-our $VERSION = '0.63';
+our $VERSION = '0.66';
+
+
+
+
+
+#####################################################################
+# Task Integration
+
+sub task_functions {
+ return '';
+}
+
+sub task_outline {
+ return '';
+}
+
+sub task_syntax {
+ return '';
+}
@@ -312,6 +332,19 @@ sub current {
+######################################################################
+# Padre::Cache Integration
+
+sub DESTROY {
+ if ( defined $_[0]->{filename} ) {
+ Padre::Cache::release( $_[0]->{filename} );
+ }
+}
+
+
+
+
+
#####################################################################
# Padre::Document GUI Integration
@@ -849,6 +882,10 @@ sub text_get {
$_[0]->editor->GetText;
}
+sub text_length {
+ $_[0]->editor->GetLength;
+}
+
sub text_set {
$_[0]->editor->SetText( $_[1] );
}
@@ -8,7 +8,7 @@ use Padre::File;
use Wx::Perl::Dialog::Simple ();
use File::Temp;
-our $VERSION = '0.63';
+our $VERSION = '0.66';
our @ISA = 'Padre::File';
my %connection_cache;
@@ -7,7 +7,7 @@ use warnings;
use Padre::File;
use Padre::Logger;
-our $VERSION = '0.63';
+our $VERSION = '0.66';
our @ISA = 'Padre::File';
sub new {
@@ -8,7 +8,7 @@ use File::Spec ();
use Padre::Constant ();
use Padre::File ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
our @ISA = 'Padre::File';
sub _reformat_filename {
@@ -4,7 +4,7 @@ use 5.008;
use strict;
use warnings;
-our $VERSION = '0.63';
+our $VERSION = '0.66';
# a list of registered protocol handlers. Structure:
# regexp => [handler1, handler2, ...]
@@ -4,7 +4,7 @@ use 5.008;
use strict;
use warnings;
-our $VERSION = '0.63';
+our $VERSION = '0.66';
# Constructor.
# No need to override this, just override help_init
@@ -50,7 +50,7 @@ use Padre::Logger;
use constant DEFAULT => 'en-gb';
use constant SHAREDIR => Padre::Util::sharedir('locale');
-our $VERSION = '0.63';
+our $VERSION = '0.66';
# The RFC4646 table is the primary language data table and contains
# mappings from a Padre-supported language to all the relevant data
@@ -4,7 +4,7 @@ use 5.008;
use strict;
use warnings;
-our $VERSION = '0.63';
+our $VERSION = '0.66';
sub new {
my $class = shift;
@@ -14,7 +14,7 @@ use warnings;
use Padre::Lock ();
use Padre::DB ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
sub new {
my $class = shift;
@@ -27,6 +27,9 @@ sub new {
# Padre::DB Transaction lock
db_depth => 0,
+ # Padre::Config Transaction lock
+ config_depth => 0,
+
# Wx ->Update lock
update_depth => 0,
update_locker => undef,
@@ -54,6 +57,8 @@ sub locked {
return !!$self->{busy_depth};
} elsif ( $asset eq 'REFRESH' ) {
return !!$self->{method_depth};
+ } elsif ( $asset eq 'CONFIG' ) {
+ return !!$self->{config_depth};
} else {
return !!$self->{method_pending}->{$asset};
}
@@ -68,7 +73,7 @@ sub locked {
# might slow the shutdown process.
sub shutdown {
my $self = shift;
- my $lock = $self->lock( 'UPDATE', 'REFRESH' );
+ my $lock = $self->lock( 'UPDATE', 'REFRESH', 'CONFIG' );
$self->{shutdown} = 1;
# If we have an update lock running, stop it manually now.
@@ -112,6 +117,27 @@ sub db_decrement {
return;
}
+sub config_increment {
+ my $self = shift;
+ unless ( $self->{config_depth}++ ) {
+
+ # TO DO: Initiate config locking here
+ # NOTE: Pretty sure we don't need to do anything specific
+ # here for the config file stuff.
+ }
+ return;
+}
+
+sub config_decrement {
+ my $self = shift;
+ unless ( $self->{config_depth}-- ) {
+
+ # Write the config file here
+ $self->owner->config->write;
+ }
+ return;
+}
+
sub update_increment {
my $self = shift;
unless ( $self->{update_depth}++ ) {
@@ -182,8 +208,16 @@ sub method_decrement {
# Run all of the pending methods
foreach ( keys %{ $self->{method_pending} } ) {
- next if $_ eq uc($_);
- $self->{owner}->$_();
+ next if $_ eq uc $_;
+
+ # This call is sent into what is essentially
+ # arbitrary code, and it's easy for exceptions
+ # under here to cause the entire locking sub-system
+ # to crash. Trap and ignore errors so we can attempt
+ # to retain the integrity of the locking subsystem
+ # as a whole.
+ local $@;
+ eval { $self->{owner}->$_(); };
}
$self->{method_pending} = {};
}
@@ -35,23 +35,44 @@ used in Padre that will compile out of the application when not in use.
use 5.008;
use strict;
use warnings;
+use threads;
+use threads::shared;
use Padre::Constant ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
+
+# Handle the PADRE_DEBUG environment variable
+BEGIN {
+ if ( $ENV{PADRE_DEBUG} ) {
+ if ( $ENV{PADRE_DEBUG} eq '1' ) {
+
+ # Debug everything
+ $Padre::Logger::DEBUG = 1;
+ } else {
+
+ # Debug a single class
+ eval "\$$ENV{PADRE_DEBUG}::DEBUG = 1;";
+ }
+ }
+}
sub import {
+ if ( $_[1] and $_[1] eq ':ALL' ) {
+ $Padre::Logger::DEBUG = 1;
+ }
my $pkg = ( caller() )[0];
eval <<"END_PERL";
package $pkg;
+
use constant DEBUG => !! (
- defined(\$${pkg}::DEBUG) ? \$${pkg}::DEBUG :
- defined(\$Padre::Logger::DEBUG) ? \$Padre::Logger::DEBUG :
- \$ENV{PADRE_DEBUG}
+ defined(\$${pkg}::DEBUG) ? \$${pkg}::DEBUG : \$Padre::Logger::DEBUG
);
+
BEGIN {
*TRACE = *Padre::Logger::TRACE;
TRACE('::DEBUG enabled') if DEBUG;
}
+
1;
END_PERL
die("Failed to enable debugging for $pkg") if $@;
@@ -61,21 +82,41 @@ END_PERL
# Global trace function
sub TRACE {
my $time = scalar localtime time;
- my $package = ( caller() )[0];
+ my $caller = ( caller(1) )[3];
my $logfile = Padre::Constant::LOG_FILE;
- open my $fh, '>>', $logfile or return;
- foreach my $message (@_) {
- print $fh sprintf(
- "%s %s%s\n",
+ my $thread =
+ ( $INC{'threads.pm'} and threads->self->tid )
+ ? ( '(Thread ' . threads->self->tid . ') ' )
+ : '';
+
+ # open my $fh, '>>', $logfile or return;
+ foreach (@_) {
+
+ # print $fh sprintf(
+ print sprintf(
+ "# %s %s%s %s\n",
$time,
- $package,
- $message,
+ $thread,
+ $caller,
+ string($_),
);
}
- close $fh;
+
+ # close $fh;
return;
}
+sub string {
+ require Devel::Dumpvar;
+ my $object = shift;
+ my $shared = ( $INC{'threads/shared.pm'} and threads::shared::is_shared($object) ) ? ' : shared' : '';
+ my $string =
+ ref($object)
+ ? Devel::Dumpvar->_refstring($object)
+ : Devel::Dumpvar->_scalar($object);
+ return $string . $shared;
+}
+
1;
# Copyright 2008-2010 The Padre development team as listed in Padre.pm.
@@ -23,7 +23,7 @@ use File::Basename ();
use Padre::Wx ();
use Padre::DB ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
#####################################################################
# Document Registration
@@ -621,6 +621,16 @@ sub guess_mimetype {
if ( defined $text ) {
my $eval_mime_type = eval {
+ # Working on content with malformed/bad UTF-8 chars may drop warnings
+ # which just say that there are bad UTF-8 chars in the file currently
+ # being checked. Maybe they are no UTF-8 chars at all but just a line
+ # of bits and Padre/Perl simply has the wrong point of view (UTF-8),
+ # so we drop these warnings:
+ local $SIG{__WARN__} = sub {
+ print STDERR $_[0] . ' while looking for mime type of $filename'
+ unless $_[0] =~ /Malformed UTF\-8 char/;
+ };
+
# Is this a script of some kind?
if ( $text =~ /\A#!/m ) {
if ( $text =~ /\A#![^\n]*\bperl6?\b/m ) {
@@ -5,7 +5,7 @@ use strict;
use warnings;
use PPI;
-our $VERSION = '0.63';
+our $VERSION = '0.66';
#####################################################################
# Assorted Search Functions
@@ -54,7 +54,7 @@ use warnings;
# Because this is sometimes used outside the Padre codebase,
# don't put any dependencies on other Padre modules in here.
-our $VERSION = '0.63';
+our $VERSION = '0.66';
my $perl = undef;
@@ -0,0 +1,42 @@
+package Padre::Plugin::Devel::Crash;
+
+# (To the tune of Flash by Queen)
+#
+# DUN dun dun dun dun dun dun dun
+# dun dun dun dun dun dun dun dun
+# CRASH! Aaaaaaah!
+# Explosive debugging task!
+# DUN dun dun dun dun dun dun dun
+# dun dun dun dun dun dun dun dun
+# CRASH! Aaaaaaah!
+# Simulates a failing task!
+# DUN dun dun dun dun dun dun dun
+# ...
+# ...
+
+# TO DO: Replace this with some use of Padre::Task::Eval so we don't need
+# an entire dedicated class just for this.
+
+use 5.008;
+use strict;
+use warnings;
+use Padre::Task ();
+
+our $VERSION = '0.66';
+our @ISA = 'Padre::Task';
+
+sub run {
+ sleep 5;
+ die "This is a debugging task that simply crashes after running for 5 seconds!";
+}
+
+sub finish {
+ warn "This should never be reached";
+}
+
+1;
+
+# Copyright 2008-2010 The Padre development team as listed in Padre.pm.
+# LICENSE
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl 5 itself.
@@ -7,7 +7,7 @@ use Padre::Wx ();
use Padre::Plugin ();
use Padre::Current ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
our @ISA = 'Padre::Plugin';
@@ -253,8 +253,8 @@ sub simulate_crash {
}
sub simulate_task_crash {
- require Padre::Task::Debug::Crashing;
- Padre::Task::Debug::Crashing->new->schedule;
+ require Padre::Plugin::Devel::Crash;
+ Padre::Plugin::Devel::Crash->new->schedule;
}
sub show_about {
@@ -8,7 +8,7 @@ use Padre::Constant ();
use Padre::Plugin ();
use Padre::Wx ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
our @ISA = 'Padre::Plugin';
@@ -6,10 +6,9 @@ use 5.008;
use strict;
use warnings;
use URI ();
-use HTTP::Request ();
use Padre::Task::LWP ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
our @ISA = 'Padre::Task::LWP';
sub new {
@@ -29,12 +28,11 @@ sub new {
$data{svn} = $revision if -d "$dir.svn";
}
- # Generate the request URL
- my $url = URI->new('http://perlide.org/popularity/v1/ping.html');
- $url->query_form( \%data, ';' );
-
# Hand off to the parent constructor
- return $class->SUPER::new( request => HTTP::Request->new( GET => $url->as_string ) );
+ return $class->SUPER::new(
+ url => 'http://perlide.org/popularity/v1/ping.html',
+ query => \%data,
+ );
}
1;
@@ -113,13 +113,12 @@ this plug-in entirely.
use 5.008;
use strict;
use warnings;
-use Config ();
-use Scalar::Util ();
-use Padre::Plugin ();
-use Padre::Task::HTTPClient;
-use Padre::Constant();
+use Config ();
+use Scalar::Util ();
+use Padre::Plugin ();
+use Padre::Constant ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
our @ISA = 'Padre::Plugin';
# Track the number of times actions are used
@@ -276,10 +275,12 @@ sub report {
my $report = $self->_generate;
# TO DO: Enable as soon as the server is functional:
- # my $response = Padre::Task::HTTPClient->new(
- # URL => 'http://padre.perlide.org/popularity_contest.cgi',
- # query => \%STATS, method => 'POST'
- # )->run;
+ # $self->task_request(
+ # task => 'Padre::Task::LWP'->new(
+ # method => 'POST',
+ # url => 'http://padre.perlide.org/popularity_contest.cgi',
+ # query => \%STATS,
+ # );
return 1;
}
@@ -53,7 +53,7 @@ use YAML::Tiny ();
use Padre::DB ();
use Padre::Wx ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
our $COMPATIBLE = '0.43';
# Link plug-ins back to their IDE
@@ -106,8 +106,12 @@ sub plugin_directory_share {
$class =~ s/\=HASH\(.+?\)$//;
if ( $ENV{PADRE_DEV} ) {
+ my $bin = do {
+ no warnings;
+ $FindBin::Bin;
+ };
my $root = File::Spec->catdir(
- $FindBin::Bin,
+ $bin,
File::Spec->updir,
File::Spec->updir,
$class,
@@ -687,7 +691,11 @@ sub _menu_plugins_submenu {
# Convert to a function reference
my $method = $value;
- $value = sub { $self->$method(@_) };
+ $value = sub {
+ local $@;
+ eval { $self->$method(@_); };
+ $main->error("Unhandled exception in plugin menu: $@") if $@;
+ };
}
# Function Reference
@@ -696,8 +704,9 @@ sub _menu_plugins_submenu {
$main,
$menu->Append( -1, $label ),
sub {
- eval { $value->(@_) };
- Carp::cluck($@) if $@;
+ local $@;
+ eval { $value->(@_); };
+ $main->error("Unhandled exception in plugin menu: $@") if $@;
},
);
next;
@@ -32,7 +32,7 @@ use warnings;
use Module::Build ();
use Padre::Constant ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
our @ISA = 'Module::Build';
sub ACTION_plugin {
@@ -8,7 +8,7 @@ use Padre::Current ();
use Padre::Locale ();
use Params::Util qw{ _STRING _IDENTIFIER _CLASS _INSTANCE };
-our $VERSION = '0.63';
+our $VERSION = '0.66';
use overload
'bool' => sub () {1},
@@ -41,7 +41,7 @@ use Padre::PluginHandle ();
use Padre::Wx ();
use Padre::Wx::Menu::Tools ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
@@ -33,7 +33,7 @@ use strict;
use warnings;
use Pod::Simple::XHTML ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
our @ISA = 'Pod::Simple::XHTML';
#####################################################################
@@ -5,7 +5,7 @@ use strict;
use warnings;
use Padre::Project ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
our @ISA = 'Padre::Project';
use overload 'bool' => sub () {0};
@@ -7,7 +7,7 @@ use strict;
use warnings;
use Padre::Project::Perl ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
our @ISA = 'Padre::Project::Perl';
use Class::XSAccessor {
@@ -7,7 +7,7 @@ use strict;
use warnings;
use Padre::Project::Perl ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
our @ISA = 'Padre::Project::Perl';
use Class::XSAccessor {
@@ -7,7 +7,7 @@ use strict;
use warnings;
use Padre::Project::Perl ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
our @ISA = 'Padre::Project::Perl';
use Class::XSAccessor {
@@ -7,7 +7,7 @@ use strict;
use warnings;
use Padre::Project::Perl::EUMM ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
our @ISA = 'Padre::Project::Perl::EUMM';
1;
@@ -8,7 +8,7 @@ use warnings;
use File::Spec ();
use Padre::Project ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
our @ISA = 'Padre::Project';
@@ -96,6 +96,13 @@ sub ignore_rule {
};
}
+sub ignore_skip {
+ return [
+ '(?:^|\\/)\\.',
+ '(?:^|\\/)(?:blib|_build|inc|Makefile|pm_to_blib)\z',
+ ];
+}
+
1;
# Copyright 2008-2010 The Padre development team as listed in Padre.pm.
@@ -10,7 +10,7 @@ use strict;
use warnings;
use File::Temp ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
use Class::XSAccessor {
getters => {
@@ -10,8 +10,9 @@ use File::Path ();
use File::Basename ();
use Padre::Config ();
use Padre::Current ();
+use Padre::Cache ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
use Class::XSAccessor {
getters => {
@@ -284,6 +285,13 @@ sub ignore_rule {
};
}
+# Alternate form
+sub ignore_skip {
+ return [
+ '(?:^|\\/)\\.',
+ ];
+}
+
sub name {
my $self = shift;
my $name = ( reverse( File::Spec->splitdir( $self->root ) ) )[0];
@@ -296,6 +304,19 @@ sub name {
return $name;
}
+
+
+
+
+######################################################################
+# Padre::Cache Integration
+
+sub DESTROY {
+ if ( defined $_[0]->{root} ) {
+ Padre::Cache::release( $_[0]->{root} );
+ }
+}
+
1;
# Copyright 2008-2010 The Padre development team as listed in Padre.pm.
@@ -4,7 +4,7 @@ use 5.008;
use strict;
use warnings;
-our $VERSION = '0.63';
+our $VERSION = '0.66';
# Constructor.
# No need to override this
@@ -0,0 +1,114 @@
+package Padre::Role::Task;
+
+=pod
+
+=head1 NAME
+
+Padre::Role::Task - A role for objects that commission tasks
+
+=head1 DESCRIPTION
+
+This is a role that should be inherited from by objects in Padre's
+permanent model that want to commision tasks to be run and have the
+results fed back to them, if the answer is still relevant.
+
+=cut
+
+use 5.008005;
+use strict;
+use warnings;
+use Scalar::Util ();
+
+our $VERSION = '0.66';
+
+# Use a shared sequence for object revisioning greatly
+# simplifies the indexing process.
+my $SEQUENCE = 0;
+my %INDEX = ();
+
+
+
+
+
+######################################################################
+# Statefulness
+
+# Get the object's current revision
+sub task_revision {
+ my $self = shift;
+
+ # Set a revision if this is the first time
+ unless ( defined $self->{task_revision} ) {
+ $self->{task_revision} = ++$SEQUENCE;
+ }
+
+ # Optimisation hack: Only populate the index when
+ # the revision is queried from the view.
+ unless ( exists $INDEX{ $self->{task_revision} } ) {
+ $INDEX{ $self->{task_revision} } = $self;
+ Scalar::Util::weaken( $INDEX{ $self->{task_revision} } );
+ }
+
+ return $self->{task_revision};
+}
+
+# Object state has changed, update revision and flush index.
+sub task_reset {
+ my $self = shift;
+ if ( $self->{task_revision} ) {
+ delete $INDEX{ $self->{task_revision} };
+ }
+ $self->{task_revision} = ++$SEQUENCE;
+}
+
+# Locate an object by revision
+sub task_owner {
+ $INDEX{ $_[1] };
+}
+
+# Create a new task bound to the owner
+sub task_request {
+ my $self = shift;
+ my %param = @_;
+
+ # Check and load the task
+ # Support a convenience shortcut where a false value
+ # for task means don't run a task at all.
+ my $task = delete $param{task} or return;
+ my $class = Params::Util::_DRIVER(
+ $task,
+ 'Padre::Task',
+ ) or die "Missing or invalid task class '$task'";
+
+ # Create and start the task with ourself as the owner
+ $class->new( owner => $self, %param )->schedule;
+}
+
+# By default explode to highlight task requesters that
+# have not implemented an appropriate response handler.
+sub task_response {
+ my $class = ref( $_[0] ) || $_[0];
+ my $task = ref( $_[1] ) || $_[1];
+ die "Unhandled task_response for $class (recieved $task)";
+}
+
+1;
+
+=pod
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2008-2010 The Padre development team as listed in Padre.pm.
+
+This program is free software; you can redistribute
+it and/or modify it under the same terms as Perl itself.
+
+The full text of the license can be found in the
+LICENSE file included with this module.
+
+=cut
+
+# Copyright 2008-2010 The Padre development team as listed in Padre.pm.
+# LICENSE
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl 5 itself.
@@ -32,7 +32,7 @@ use Encode ();
use List::Util ();
use Params::Util '_INSTANCE';
-our $VERSION = '0.63';
+our $VERSION = '0.66';
use Class::XSAccessor {
getters => {
@@ -1,347 +0,0 @@
-package Padre::Service;
-
-use 5.008;
-use strict;
-use warnings;
-use Carp qw( croak );
-
-use threads;
-use threads::shared;
-
-use Padre::Wx ();
-use Padre::Task ();
-use Thread::Queue ();
-use Padre::Logger;
-
-our $VERSION = '0.63';
-our @ISA = 'Padre::Task';
-
-=pod
-
-=head1 NAME
-
-Padre::Service - persistent Padre::Task API
-
-=head2 SYNOPSIS
-
- # Create your service, default implementation warns to output
- # sleeps 1 second and loops over.
- my $service = Padre::Service->new();
- Wx::Event::EVT_COMMAND(
- $main , -1 , $service->event ,
- \&receive_data_from_service
- );
- $service->schedule;
- $service->
-
-
- # Later
- $service->shutdown; # Your show_my_dialog will be called...,eventually
-
-=head1 DESCRIPTION
-
-Padre::Service extends L<Padre::Task> to provide a means to launch and
-control a long running background service, without blocking the editor.
-
-=head2 EXTENDING
-
-To extend this class, inherit it and implement C<service_loop> and preferably
-C<hangup>.
-
-C<service_loop> should not block forever. If there is no work for the service to do
-then return immediately, allowing the C<< Task->run >> loop to continue.
-
- package Padre::Service::HTTPD
- use base qw( Padre::Service );
-
- sub prepare { # Build a dummy httpd.conf from $self , "BREAK" if error }
-
- sub service_start { # Launch httpd binary goodness, IPC::Run3 maybe? }
-
- sub service_shutdown { # Clean shutdown httpd binary }
-
- sub service_loop { # ->select($timeout) on your IPC handles }
-
- sub hangup { ->service_shutdown ?!?}
-
- sub terminate { # Stop everything, brutally }
-
-=head1 METHODS
-
-=head2 run
-
-Overrides C<Padre::Task::run> providing a non-blocking loop around the
-C<TaskManager> to C<Service> shared queue.
-
-C<run> will call C<hangup> or C<terminate> on your service if instructed
-by the main thread, otherwise C<service_loop> is called in void context
-with no arguments B<in a tight loop>.
-
-=cut
-
-{
- my $running = 0;
- sub running {$running}
-
- sub stop { $running = 0 }
- sub start { $running = 1 }; #??
-
- sub run {
- croak "Already running!" if $running;
-
- my ($self) = @_;
- my $queue = $self->queue;
- TRACE("Running queue $queue") if DEBUG;
- my $tid = threads->tid;
- my $event = $self->event;
-
- # Now we're in the worker thread, start our service
- # and begin the select orbit around the manager's queue
- # , the service_loop and throwing ->event back at the main thread
- $self->start;
- $running = 1;
- $self->post_event( $event, "ALIVE" );
- while ($running) {
-
- # Let the service provider have first chance.
- # and if nothing is waiting in the queue - tight loop.
- $self->service_loop;
- next unless $queue->pending;
-
- my $command = $queue->dequeue;
- TRACE("Service dequeued input") if DEBUG;
-
- # Respond to HANGUP TERMINATE and PING -
- if ( ref($command) ) {
- $self->service_loop($command);
- }
-
- # Or possibly a signal from the main thread
- else {
- TRACE("Caught command signal '$command'") if DEBUG;
- if ( $command eq 'HANGUP' ) {
- $self->hangup( \$running );
- } elsif ( $command eq 'TERMINATE' ) {
- $self->terminate( \$running );
- } elsif ( $command eq 'PING' ) {
- $self->post_event( $event, "ALIVE" );
- } else {
- TRACE("Service does not recognise '$command' signal") if DEBUG;
- }
- }
- }
-
- # Loop broken - cleanup
- #$self->shutdown;
- return;
- }
-
-}
-
-=head2 start
-
-consider start the background_thread analog of C<prepare> and will be called
-in the service thread immediately prior to the service loop starting.
-
-
-=cut
-
-=head2 hangup
-
-Called on your service when the editor requests a hangup. Your service is obliged
-to gracefully stop what it is doing and return from this method as soon as possible
-
-=cut
-
-sub hangup {
- my ( $self, $running ) = @_;
- $$running = 0;
-}
-
-=head2 terminate
-
-Called on your service when C<TaskManager> believes your service is hung or not
-responding to a C<<->hangup>. Your service is obliged to B<IMMEDIATELY> stop
-everything and to hell with the consequences.
-
-=cut
-
-sub terminate {
- my ( $self, $running ) = @_;
- $$running = 0;
-}
-
-=head2 service_loop
-
-Called in a loop while the service is believed to be running
-The default implementation emits output to the editor and sleeps for a
-second before returning control to the loop.
-
-=cut
-
-{
-
- sub service_loop {
- my ( $self, $incoming ) = @_;
- $self->{iterator} = 0
- unless exists $self->{iterator};
- my $tid = threads->tid;
- $self->task_print('ok - entered service loop')
- || print "ok - entered service loop\n";
-
- $self->task_print("# Service ($tid) Looped $self->{iterator}\n");
- if ( defined $incoming ) {
- $self->task_print("ok - got incoming service data '$incoming'");
- }
-
- # Tell the main thread some progress.
- $self->post_event( $self->event, "$self->{iterator}" );
-
- $self->{iterator}++;
- $self->tell('HANGUP') if $self->{iterator} > 10;
- sleep 1;
- }
-}
-
-=head2 event
-
-Accessor for this service's instance event, in the running service
-data may be posted to this event and the Wx subscribers will be notified
-
-=cut
-
-{
- our %ServiceEvents : shared = ();
-
- sub event {
- my $self = shift;
- if ( exists $ServiceEvents{ $self->{__service_refid} } ) {
- return $ServiceEvents{ $self->{__service_refid} };
- } else {
- croak "Cannot lookup shared event for $self";
- }
- }
-
- my %Queues : shared;
-
- sub prepare {
- my $self = shift;
- my $queue : shared;
- $queue = Thread::Queue->new;
- $Queues{"$self"} = $queue;
- $self->{_refid} = "$self";
- $self->SUPER::prepare(@_);
- }
-
-=head2 queue
-
-accessor for the shared queue the service thread is polling for input.
-Calling C<enqueue> on reference sends data to the service thread. L<Storable>
-serialization rules apply. See also L<"event"> for receiving data from
-the service thread
-
-=cut
-
- sub queue {
- my $self = shift;
- if ( exists $self->{_refid}
- && exists $Queues{ $self->{_refid} } )
- {
- return $Queues{ $self->{_refid} };
- } elsif ( exists $Queues{"$self"} ) {
- return $Queues{"$self"};
- } else {
- croak "No such service queue ";
- }
-
- }
-
- sub serialize {
- my $self = shift;
-
- # croak "Serialized!!";
- my $service_refid = "$self";
- $self->{__service_refid} = $service_refid;
-
- # Wait until the last moment before we declare
- # the event
- my $service_event : shared = Wx::NewEventType;
- $ServiceEvents{$service_refid} = $service_event;
-
- # my $wx_attach;
- # if ( exists $self->{_main_thread_only}
- # &&
- # _INSTANCE( $self->{_main_thread_only}, 'Wx::Object' )
- # )
- # {
- # $wx_attach = $self->{_main_thread_only};
- # }
- # else { $wx_attach = Padre->ide->wx->main };
-
- # if (!exists $self->{__events_init}
- # and !defined $self->{__events_init} )
- # {
- # $self->{__events_init} =
- # Wx::Event::EVT_COMMAND(
- # $wx_attach, -1,
- # $service_event,
- # sub{ $self->receive(@_) } ,
- # );
- # }
-
- # FILO
- my $payload = $self->SUPER::serialize(@_);
-
- return $payload;
- }
-
- sub deserialize_hook {
- my $self = shift;
-
- # FILO
- # Shutdown the queue and event ?;
- }
-
-}
-
-sub shutdown {
- my $self = shift;
- TRACE("shutdown - $self") if DEBUG;
- my $queue = $self->queue;
- $queue->enqueue('HANGUP');
-}
-
-sub cleanup {
- my $self = shift;
- TRACE("cleanup - $self") if DEBUG;
-}
-
-=head2 tell
-
-Accepts a reference as it's argument, this is serialized and sent to
-the service thread
-
-=cut
-
-## MAIN
-sub tell {
- my ( $self, $ref ) = @_;
- my $queue = $self->queue;
- $queue->enqueue($ref);
-}
-
-=head1 COPYRIGHT
-
-Copyright 2008-2010 The Padre development team as listed in Padre.pm
-
-This program is free software; you can redistribute it and/or
-modify it under the same terms as Perl 5 itself.
-
-=cut
-
-# Copyright 2008-2010 The Padre development team as listed in Padre.pm.
-# LICENSE
-# This program is free software; you can redistribute it and/or
-# modify it under the same terms as Perl 5 itself.
-
-1;
@@ -1,283 +0,0 @@
-package Padre::SlaveDriver;
-
-=pod
-
-=head1 NAME
-
-Padre::SlaveDriver - Padre thread spawning
-
-=head1 SYNOPSIS
-
- use Padre::SlaveDriver;
- my $sd = Padre::SlaveDriver->new();
- my $slave_thread = $sd->spawn($taskManager);
-
-=head1 DESCRIPTION
-
-Padre uses threads for asynchronous background operations
-which may take so long that they would make the GUI unresponsive
-if run in the main (GUI) thread.
-
-This class is a helper that will spawn new worker on demand. It
-keeps a single model thread around that was (or should have been)
-created very early in the start-up process of Padre. Therefore,
-the threads' memory consumption will be significantly lower than
-if one created new worker (slave) threads from the main Padre thread.
-
-Maintainer note: This module must not load any other part of Padre
-and should generally be kept low on memory overhead.
-
-=head1 INTERFACE
-
-=head2 Class Methods
-
-=cut
-
-use 5.008005;
-use strict;
-use warnings;
-use threads;
-use threads::shared;
-
-# This has a version to prevent known cases of people not upgrading
-use Thread::Queue 2.11;
-
-our $VERSION = '0.63';
-
-# This event is triggered by the worker thread main loop after
-# finishing a task.
-our $TASK_DONE_EVENT : shared;
-
-# This event is triggered by the worker thread main loop before
-# running a task.
-our $TASK_START_EVENT : shared;
-
-=pod
-
-=head3 C<new>
-
-The constructor returns a C<Padre::SlaveDriver> object.
-C<Padre::SlaveDriver> is a singleton.
-
-An object is instantiated when the editor object is created.
-
-=cut
-
-SCOPE: {
- my $SlaveDriver;
-
- sub new {
- return $SlaveDriver if defined $SlaveDriver;
-
- my $class = shift;
- @_ = ();
-
- $SlaveDriver = bless {
- cmd_queue => Thread::Queue->new,
- tid_queue => Thread::Queue->new,
- task_queue => Thread::Queue->new,
- } => $class;
-
- # Wx must be loaded before this code fires
- require Wx;
- require Wx::Event;
- $TASK_DONE_EVENT = Wx::NewEventType() unless defined $TASK_DONE_EVENT;
- $TASK_START_EVENT = Wx::NewEventType() unless defined $TASK_START_EVENT;
-
- # Because the following code spawns the slave master,
- # we need to wrap an database anti-lock around it.
- my $locked = Padre::DB->can('connected') && Padre::DB->connected;
- Padre::DB->commit if $locked;
-
- # Create the "slave master" top level thread.
- $SlaveDriver->{master} = threads->create(
- \&_slave_driver_loop,
- $SlaveDriver->{cmd_queue},
- $SlaveDriver->{tid_queue}
- );
-
- # If we were previously in a database lock restore it
- # so that lock management doesn't freak out.
- Padre::DB->begin if $locked;
-
- return $SlaveDriver;
- }
-
- END {
- if ( defined $SlaveDriver ) {
- $SlaveDriver->cleanup;
- undef $SlaveDriver;
- }
- }
-}
-
-=pod
-
-=head2 Object methods
-
-=head3 C<spawn>
-
-Takes the L<Padre::TaskManager> object as argument.
-Returns a new worker thread object.
-
-=cut
-
-sub spawn {
- my $self = shift;
- my $manager = shift;
-
- require Storable;
- $self->{cmd_queue}->enqueue( Storable::freeze( [ $manager->task_queue ] ) );
-
- return threads->object( $self->{tid_queue}->dequeue );
-}
-
-=pod
-
-=head3 C<task_queue>
-
-Returns the task queue (C<Thread::Queue> object) for use by the
-L<Padre::TaskManager> for passing processing tasks to the worker
-threads.
-
-This queue is instantiated by the slave driver because it needs to be available
-early for passing to the master thread.
-
-=cut
-
-sub task_queue {
- $_[0]->{task_queue};
-}
-
-=pod
-
-=head3 C<cleanup>
-
-Reaps the master thread. Will be called by the C<TaskManager> on shutdown and
-on global destruction.
-
-=cut
-
-sub cleanup {
- my $self = shift;
-
- if ( defined $self->{master} and defined $self->{cmd_queue} ) {
- $self->{cmd_queue}->enqueue('STOP');
-
- require Time::HiRes;
- Time::HiRes::usleep(5000); # 5 milli-sec
-
- if ( $self->{master}->is_joinable ) {
- $self->{master}->join;
- }
- }
-
- # TaskManager does handle thread *killing*
-}
-
-sub DESTROY {
- shift->cleanup;
-}
-
-
-
-
-
-######################################################################
-# Worker thread main loop
-
-sub _worker_loop {
- my ($queue) = @_;
- @_ = (); # Hack to avoid "Scalars leaked"
-
- # warn threads->tid . " -- Hi, I'm a thread.";
-
- # Hold a pointer to the global application root
- require Padre::Wx::App;
- my $wx = Padre::Wx::App->new;
-
- while ( my $frozen = $queue->dequeue ) {
-
- # warn threads->tid . " -- got task.";
-
- # warn("THREAD TERMINATING"), return 1 if not ref($task) and $task eq 'STOP';
- return 1 if not ref($frozen) and $frozen eq 'STOP';
-
- require Padre::Task;
- my $task = Padre::Task->deserialize( \$frozen );
- $task->{__thread_id} = threads->tid;
-
- my $before = Wx::PlThreadEvent->new(
- -1,
- $TASK_START_EVENT,
- $task->{__thread_id} . ";" . ref($task),
- );
- Wx::PostEvent( $wx, $before );
-
- # RUN
- $task->run;
-
- # FREEZE THE PROCESS AND PASS IT BACK
- undef $frozen;
- $task->serialize( \$frozen );
-
- my $after = Wx::PlThreadEvent->new(
- -1,
- $TASK_DONE_EVENT,
- $frozen,
- );
- Wx::PostEvent( $wx, $after );
-
- # warn threads->tid . " -- done with task.";
- }
-}
-
-sub _slave_driver_loop {
- my ( $in, $out ) = @_;
- @_ = (); # Hack to avoid "Scalars leaked"
-
- while ( my $args = $in->dequeue ) { # args is frozen [$main, $queue]
- last if $args eq 'STOP';
- my $queue = Padre::SlaveDriver->new->task_queue;
- my $worker = threads->create( \&_worker_loop, $queue );
- $out->enqueue( $worker->tid );
- }
-
- return 1;
-}
-
-1;
-
-=pod
-
-=head1 TO DO
-
-What if the computer can't keep up with the queued jobs? This needs
-some consideration and probably, the C<schedule()> call needs to block once
-the queue is I<"full">. However, it's not clear how this can work if the
-Wx C<MainLoop> isn't reached for processing finish events.
-
-Polling services I<aliveness> in a useful way, something a C<Wx::Taskmanager>
-might like to display. Ability to selectively kill tasks/services
-
-=head1 SEE ALSO
-
-The base class of all I<"work units"> is L<Padre::Task>.
-
-=head1 AUTHOR
-
-Steffen Mueller C<smueller@cpan.org>
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright 2008-2010 The Padre development team as listed in Padre.pm.
-
-This program is free software; you can redistribute it and/or
-modify it under the same terms as Perl 5 itself.
-
-=cut
-
-# Copyright 2008-2010 The Padre development team as listed in Padre.pm.
-# LICENSE
-# This program is free software; you can redistribute it and/or
-# modify it under the same terms as Perl 5 itself.
@@ -32,7 +32,7 @@ use strict;
use warnings;
use Padre::Constant ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
my $SPLASH = undef;
@@ -64,12 +64,7 @@ sub startup {
# Load and overlay the startup.yml file
if ( -f Padre::Constant::CONFIG_STARTUP ) {
- require YAML::Tiny;
- my $yaml = YAML::Tiny::LoadFile(Padre::Constant::CONFIG_STARTUP);
- foreach ( sort keys %setting ) {
- next unless exists $yaml->{$_};
- $setting{$_} = $yaml->{$_};
- }
+ %setting = ( %setting, startup_config() );
}
# Attempt to connect to the single instance server
@@ -111,13 +106,12 @@ sub startup {
# NOTE: Replace the following with if ( 0 ) will disable the
# slave master quick-spawn optimisation.
- # If we are going to use threading, spawn off the slave
- # driver as early as we possibly can so we reduce the amount of
- # wasted memory copying to a minimum.
+ # Second-generation version of the threading optimisation.
+ # This one is much safer because we start with zero existing tasks
+ # and no expectation of existing load behaviour.
if ( $setting{threads} ) {
- require Padre::SlaveDriver;
-
- # Padre::SlaveDriver->new;
+ require Padre::TaskThread;
+ Padre::TaskThread->master;
}
# Show the splash image now we are starting a new instance
@@ -136,6 +130,7 @@ sub startup {
my $share = undef;
if ( $ENV{PADRE_DEV} ) {
require FindBin;
+ no warnings;
$share = File::Spec->catdir(
$FindBin::Bin,
File::Spec->updir,
@@ -177,6 +172,14 @@ sub startup {
return 1;
}
+sub startup_config {
+ open( my $FILE, '<', Padre::Constant::CONFIG_STARTUP ) or return ();
+ my @buffer = <$FILE>;
+ close $FILE or return ();
+ chomp @buffer;
+ return @buffer;
+}
+
# Destroy the splash screen if it exists
sub destroy_splash {
if ($SPLASH) {
@@ -0,0 +1,42 @@
+package Padre::Task::Addition;
+
+use 5.008005;
+use strict;
+use warnings;
+use Padre::Task ();
+
+our $VERSION = '0.66';
+our @ISA = 'Padre::Task';
+
+sub new {
+ shift->SUPER::new(
+ prepare => 0,
+ run => 0,
+ finish => 0,
+ @_,
+ );
+}
+
+sub prepare {
+ $_[0]->{prepare}++;
+ return 1;
+}
+
+sub run {
+ my $self = shift;
+ $self->{run}++;
+ $self->{z} = $self->{x} + $self->{y};
+ return 1;
+}
+
+sub finish {
+ $_[0]->{finish}++;
+ return 1;
+}
+
+1;
+
+# Copyright 2008-2010 The Padre development team as listed in Padre.pm.
+# LICENSE
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl 5 itself.
@@ -0,0 +1,42 @@
+package Padre::Task::Browser;
+
+use 5.008;
+use strict;
+use warnings;
+use threads;
+use Padre::Task ();
+
+our $VERSION = '0.66';
+our @ISA = 'Padre::Task';
+
+sub prepare {
+ my $self = shift;
+ $self->{method} ||= 'error';
+ return 0 if $self->{method} eq 'error';
+ return 1;
+}
+
+sub run {
+ my $self = shift;
+ my $method = $self->{method};
+
+ require Padre::Browser;
+ my $browser = Padre::Browser->new;
+ unless ( $browser->can($method) ) {
+ die "Browser does not support '$method'";
+ }
+
+ $self->{result} = $browser->$method(
+ $self->{document},
+ $self->{args}
+ );
+
+ return 1;
+}
+
+1;
+
+# Copyright 2008-2010 The Padre development team as listed in Padre.pm.
+# LICENSE
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl 5 itself.
@@ -1,31 +0,0 @@
-package Padre::Task::Debug::Crashing;
-
-use 5.008;
-use strict;
-use warnings;
-use Padre::Task ();
-
-our $VERSION = '0.63';
-our @ISA = 'Padre::Task';
-
-sub run {
- my ($self) = @_;
-
- sleep 5;
- die "This is a debugging task that simply crashes after running for 5 seconds!";
-
- # Commented out temporarily to appease xt/critic.t
- # return 1;
-}
-
-sub finish {
- my $self = shift;
- warn "This should never be reached since the task crashed during run()!";
-}
-
-1;
-
-# Copyright 2008-2010 The Padre development team as listed in Padre.pm.
-# LICENSE
-# This program is free software; you can redistribute it and/or
-# modify it under the same terms as Perl 5 itself.
@@ -1,45 +0,0 @@
-package Padre::Task::DocBrowser;
-
-use 5.008;
-use strict;
-use warnings;
-use threads;
-use Padre::Task ();
-
-our $VERSION = '0.63';
-our @ISA = 'Padre::Task';
-
-sub run {
- my ($self) = @_;
-
- require Padre::DocBrowser;
- $self->{browser} ||= Padre::DocBrowser->new;
- my $type = $self->{type} || 'error';
- if ( $type eq 'error' ) {
- return "BREAK";
- }
- unless ( $self->{browser}->can($type) ) {
- return "BREAK";
- }
-
- my $result = $self->{browser}->$type(
- $self->{document},
- $self->{args}
- );
- $self->{result} = $result;
-
- return 1;
-
-}
-
-sub finish {
- my $self = shift;
- $self->{main_thread_only}->( $self->{result}, $self->{document} );
-}
-
-1;
-
-# Copyright 2008-2010 The Padre development team as listed in Padre.pm.
-# LICENSE
-# This program is free software; you can redistribute it and/or
-# modify it under the same terms as Perl 5 itself.
@@ -0,0 +1,125 @@
+package Padre::Task::ErrorList;
+
+use 5.008;
+use strict;
+use warnings;
+use Padre::Task ();
+
+our $VERSION = '0.66';
+our @ISA = 'Padre::Task';
+
+sub new {
+ my $class = shift;
+ my $self = $class->SUPER::new(@_);
+ $self->{data} ||= '';
+ $self->{cur_lang} ||= '';
+ $self->{old_lang} ||= '';
+ return $self;
+}
+
+sub run {
+ my $self = shift;
+
+ # Shortcut if nothing to do.
+ # TODO: Make sure this never happens, then remove the code
+ if ( $self->{old_lang} eq $self->{cur_lang} ) {
+ return 1;
+ }
+
+ # Build the parser
+ require Parse::ErrorString::Perl;
+ my $parser =
+ $self->{cur_lang}
+ ? Parser::ErrorString::Perl->new(
+ lang => $self->{cur_lang},
+ )
+ : Parser::ErrorString::Perl->new;
+
+ # Parse and process the file to produce the model
+ my @model = ();
+ my @errors = $parser->parse_string( delete $self->{text} );
+ foreach my $error (@errors) {
+ my $line = $error->message . " at " . $error->file . " line " . $error->line;
+
+ #$line = encode('utf8', $line);
+ if ( $error->near ) {
+ my $near = $error->near;
+
+ # some day when we have unicode in wx ...
+ #$near =~ s/\n/\x{c2b6}/g;
+ $near =~ s/\n/\\n/g;
+ $near =~ s/\r//g;
+ $line .= ", near \"$near\"";
+ } elsif ( $error->at ) {
+ my $at = $error->at;
+ $line .= ", at $at";
+ }
+
+ push @model, [ 0, $line, $error ];
+
+ foreach my $stack ( $error->stack ) {
+ my $line = $stack->sub . " called at " . $stack->file . " line " . $stack->line;
+ push @model, [ 1, $line, $stack ];
+ }
+ }
+
+ # Save the model and we're done
+ $self->{model} = \@model;
+ return 1;
+}
+
+# TO DO: Finish porting this to the new Task API style once someone
+# demonstrates what, if anything, is actually using the ErrorList GUI
+# at the moment.
+sub finish2 {
+ my $self = shift;
+
+ # my $main = shift;
+ # really not sure if this is right, but parameter passed in isa Padre::Wx::App,
+ # not Padre::Wx::Main, however a reference to main is held in Padre::Wx::App
+ my $main = shift->{main};
+ return if !$main;
+ my $errorlist = $main ? $main->errorlist : undef;
+ my $data = $self->data;
+ my $parser = $self->parser;
+ $errorlist->{parser} = $parser if $errorlist;
+
+ my @errors = defined $data && $data ne '' ? $parser->parse_string($data) : ();
+
+ foreach my $err (@errors) {
+ my $message = $err->message . " at " . $err->file . " line " . $err->line;
+
+ #$message = encode('utf8', $message);
+ if ( $err->near ) {
+ my $near = $err->near;
+
+ # some day when we have unicode in wx ...
+ #$near =~ s/\n/\x{c2b6}/g;
+ $near =~ s/\n/\\n/g;
+ $near =~ s/\r//g;
+ $message .= ", near \"$near\"";
+ } elsif ( $err->at ) {
+ my $at = $err->at;
+ $message .= ", at $at";
+ }
+
+ my $err_tree_item = $errorlist->AppendItem( $errorlist->root, $message, -1, -1, Wx::TreeItemData->new($err) );
+
+ if ( $err->stack ) {
+ foreach my $stack_item ( $err->stack ) {
+ my $stack_message = $stack_item->sub . " called at " . $stack_item->file . " line " . $stack_item->line;
+ $errorlist->AppendItem( $err_tree_item, $stack_message, -1, -1, Wx::TreeItemData->new($stack_item) );
+ }
+ }
+ }
+
+ return 1;
+}
+
+1;
+
+# Copyright 2008-2010 The Padre development team as listed in Padre.pm.
+# LICENSE
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl 5 itself.
+
@@ -1,86 +0,0 @@
-package Padre::Task::ErrorParser;
-
-use 5.008;
-use strict;
-use warnings;
-use Padre::Task ();
-
-our $VERSION = '0.63';
-our @ISA = 'Padre::Task';
-
-use Class::XSAccessor {
- getters => {
- parser => 'parser',
- old_lang => 'old_lang',
- cur_lang => 'cur_lang',
- data => 'data',
- }
-};
-
-require Parse::ErrorString::Perl;
-
-sub run {
- my $self = shift;
- unless ( $self->parser and ( ( !$self->cur_lang and !$self->old_lang ) or ( $self->cur_lang eq $self->old_lang ) ) )
- {
-
- if ( $self->cur_lang ) {
- $self->{parser} = Parse::ErrorString::Perl->new( lang => $self->cur_lang );
- } else {
- $self->{parser} = Parse::ErrorString::Perl->new;
- }
- }
- return 1;
-}
-
-sub finish {
- my $self = shift;
-
- # my $main = shift;
- # really not sure if this is right, but parameter passed in isa Padre::Wx::App,
- # not Padre::Wx::Main, however a reference to main is held in Padre::Wx::App
- my $main = shift->{main};
- return if !$main;
- my $errorlist = $main ? $main->errorlist : undef;
- my $data = $self->data;
- my $parser = $self->parser;
- $errorlist->{parser} = $parser if $errorlist;
-
- my @errors = defined $data && $data ne '' ? $parser->parse_string($data) : ();
-
- foreach my $err (@errors) {
- my $message = $err->message . " at " . $err->file . " line " . $err->line;
-
- #$message = encode('utf8', $message);
- if ( $err->near ) {
- my $near = $err->near;
-
- # some day when we have unicode in wx ...
- #$near =~ s/\n/\x{c2b6}/g;
- $near =~ s/\n/\\n/g;
- $near =~ s/\r//g;
- $message .= ", near \"$near\"";
- } elsif ( $err->at ) {
- my $at = $err->at;
- $message .= ", at $at";
- }
- my $err_tree_item = $errorlist->AppendItem( $errorlist->root, $message, -1, -1, Wx::TreeItemData->new($err) );
-
- if ( $err->stack ) {
- foreach my $stack_item ( $err->stack ) {
- my $stack_message = $stack_item->sub . " called at " . $stack_item->file . " line " . $stack_item->line;
- $errorlist->AppendItem( $err_tree_item, $stack_message, -1, -1, Wx::TreeItemData->new($stack_item) );
- }
- }
- }
-
- return 1;
-}
-
-1;
-
-# Copyright 2008-2010 The Padre development team as listed in Padre.pm.
-# LICENSE
-# This program is free software; you can redistribute it and/or
-# modify it under the same terms as Perl 5 itself.
-
@@ -0,0 +1,125 @@
+package Padre::Task::Eval;
+
+=pod
+
+=head1 NAME
+
+Padre::Task::Eval - Task for executing arbitrary code via a string eval
+
+=head1 SYNOPSIS
+
+ my $task = Padre::Task::Eval->new(
+ prepare => '1 + 1',
+ run => 'my $foo = sub { 2 + 3 }; $foo->();',
+ finish => '$_[0]->{prepare}',
+ );
+
+ $task->prepare;
+ $task->run;
+ $task->finish;
+
+=head1 DESCRIPTION
+
+B<Padre::Task::Eval> is a stub class used to implement testing and other
+miscellaneous functionality.
+
+It takes three named string parameters matching each of the three execution
+phases. When each phase of the task is run, the string will be eval'ed and
+the result will be stored in the same has key as the source string.
+
+If the key does not exist at all, nothing will be executed for that phase.
+
+Regardless of the execution result (or the non-execution of the phase) each
+phase will always return true. However, if the string eval throws an
+exception it will escape the task object (although when run properly inside
+of a task handle it should be caught by the handle).
+
+=head1 METHODS
+
+This class contains now additional methods beyond the defaults provided by
+the L<Padre::Task> API.
+
+=cut
+
+use 5.008005;
+use strict;
+use warnings;
+use Padre::Task ();
+
+our $VERSION = '0.66';
+our @ISA = 'Padre::Task';
+our $AUTOLOAD = undef;
+
+sub prepare {
+
+ # Only optionally override
+ unless ( exists $_[0]->{prepare} ) {
+ return shift->SUPER::prepare(@_);
+ }
+
+ $_[0]->{prepare} = eval $_[0]->{prepare};
+ die $@ if $@;
+
+ return 1;
+}
+
+sub run {
+
+ # Only optionally override
+ unless ( exists $_[0]->{run} ) {
+ return shift->SUPER::run(@_);
+ }
+
+ $_[0]->{run} = eval $_[0]->{run};
+ die $@ if $@;
+
+ return 1;
+}
+
+sub finish {
+
+ # Only optionally override
+ unless ( exists $_[0]->{run} ) {
+ return shift->SUPER::finish(@_);
+ }
+
+ $_[0]->{finish} = eval $_[0]->{finish};
+ die $@ if $@;
+
+ return 1;
+}
+
+sub AUTOLOAD {
+ my $self = shift;
+ my $slot = $AUTOLOAD =~ m/^.*::(.*)\z/s;
+ if ( exists $self->{$slot} ) {
+ $self->{$slot} = eval $_[0]->{$slot};
+ die $@ if $@;
+ } else {
+ die("No such handler '$slot'");
+ }
+ return 1;
+}
+
+sub DESTROY { }
+
+1;
+
+=pod
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2008-2010 The Padre development team as listed in Padre.pm.
+
+This program is free software; you can redistribute
+it and/or modify it under the same terms as Perl itself.
+
+The full text of the license can be found in the
+LICENSE file included with this module.
+
+=cut
+
+# Copyright 2008-2010 The Padre development team as listed in Padre.pm.
+# LICENSE
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl 5 itself.
@@ -1,57 +0,0 @@
-package Padre::Task::Examples::WxEvent;
-
-use 5.008;
-use strict;
-use warnings;
-use Padre::Task ();
-use Padre::Wx ();
-
-our $VERSION = '0.63';
-our @ISA = 'Padre::Task';
-
-# set up a new event type
-our $SAY_HELLO_EVENT : shared = Wx::NewEventType();
-
-sub prepare {
-
- # Set up the event handler
- Wx::Event::EVT_COMMAND(
- Padre->ide->wx->main,
- -1,
- $SAY_HELLO_EVENT,
- \&on_say_hello,
- );
-
- return;
-}
-
-# The event handler
-sub on_say_hello {
- my ( $main, $event ) = @_;
- @_ = (); # hack to avoid "Scalars leaked"
-
- # Write a message to the beginning of the document
- my $editor = $main->current->editor;
- return if not defined $editor;
- $editor->InsertText( 0, $event->GetData );
-}
-
-sub run {
- my $self = shift;
-
- # post two events for fun
- $self->post_event( $SAY_HELLO_EVENT, "Hello from thread!\n" );
- sleep 1;
- $self->post_event( $SAY_HELLO_EVENT, "Hello again!\n" );
-
- return 1;
-}
-
-1;
-
-__END__
-
-# Copyright 2008-2010 The Padre development team as listed in Padre.pm.
-# LICENSE
-# This program is free software; you can redistribute it and/or
-# modify it under the same terms as Perl 5 itself.
@@ -0,0 +1,83 @@
+package Padre::Task::FindUnmatchedBrace;
+
+use 5.008;
+use strict;
+use warnings;
+use Padre::Task::PPI ();
+use Padre::Logger;
+
+our $VERSION = '0.66';
+our @ISA = 'Padre::Task::PPI';
+
+=pod
+
+=head1 NAME
+
+Padre::Task::FindUnmatchedBrace - C<PPI> based unmatched brace finder
+
+=head1 SYNOPSIS
+
+ my $task = Padre::Task::FindUnmatchedBrace->new(
+ document => $padre_document,
+ );
+ $task->schedule;
+
+=head1 DESCRIPTION
+
+Finds the location of unmatched braces in a C<Padre::Document::Perl>.
+If there is no unmatched brace, a message box tells the user about
+that glorious fact. If there is one, the cursor will jump to it.
+
+=cut
+
+sub process {
+ TRACE('process') if DEBUG;
+ my $self = shift;
+ my $ppi = shift or return;
+ my $result = eval {
+ require PPIx::EditorTools::FindUnmatchedBrace;
+ PPIx::EditorTools::FindUnmatchedBrace->new->find( ppi => $ppi );
+ };
+ if ($@) {
+ $self->{error} = $@;
+ return;
+ }
+
+ # An undef brace throws a die here.
+ # undef = no error found.
+ if ( defined $result ) {
+
+ # Remember for gui update
+ $self->{location} = $result->element->location;
+ }
+
+ return;
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 SEE ALSO
+
+This class inherits from C<Padre::Task::PPI>.
+
+=head1 AUTHOR
+
+Steffen Mueller C<smueller@cpan.org>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2008-2010 The Padre development team as listed in Padre.pm.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl 5 itself.
+
+=cut
+
+# Copyright 2008-2010 The Padre development team as listed in Padre.pm.
+# LICENSE
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl 5 itself.
@@ -0,0 +1,84 @@
+package Padre::Task::FindVariableDeclaration;
+
+use 5.008;
+use strict;
+use warnings;
+use Padre::Task::PPI ();
+
+our $VERSION = '0.66';
+our @ISA = 'Padre::Task::PPI';
+
+=pod
+
+=head1 NAME
+
+Padre::Task::FindVariableDeclaration - Finds where a variable was declared using L<PPI>
+
+=head1 SYNOPSIS
+
+ # Find declaration of variable at cursor
+ my $task = Padre::Task::FindVariableDeclaration->new(
+ document => $document_obj,
+ location => [ $line, $column ], # ppi-style location is okay, too
+ );
+
+ $task->schedule;
+
+=head1 DESCRIPTION
+
+Finds out where a variable has been declared.
+If unsuccessful, a message box tells the user about
+that glorious fact. If a declaration is found, the cursor will jump to it.
+
+=cut
+
+sub process {
+ my $self = shift;
+ my $ppi = shift or return;
+ my $location = $self->{location};
+ my $result = eval {
+ require PPIx::EditorTools::FindVariableDeclaration;
+ PPIx::EditorTools::FindVariableDeclaration->new->find(
+ ppi => $ppi,
+ line => $location->[0],
+ column => $location->[1]
+ );
+ };
+ if ($@) {
+ $self->{error} = $@;
+ return;
+ }
+
+ # If we found it, save the location
+ if ( defined $result ) {
+ $self->{location} = $result->element->location;
+ }
+
+ return;
+}
+
+1;
+
+__END__
+
+=head1 SEE ALSO
+
+This class inherits from C<Padre::Task::PPI>.
+
+=head1 AUTHOR
+
+Steffen Mueller C<smueller@cpan.org>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2008-2010 The Padre development team as listed in Padre.pm.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl 5 itself.
+
+=cut
+
+# Copyright 2008-2010 The Padre development team as listed in Padre.pm.
+# LICENSE
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl 5 itself.
@@ -0,0 +1,64 @@
+package Padre::Task::FunctionList;
+
+# Function list refresh task, done mainly as a full-feature proof of concept.
+
+use 5.008005;
+use strict;
+use warnings;
+use Padre::Task ();
+
+our $VERSION = '0.66';
+our @ISA = 'Padre::Task';
+
+
+
+
+
+######################################################################
+# Padre::Task Methods
+
+sub run {
+ my $self = shift;
+
+ # Pull the text off the task so we won't need to serialize
+ # it back up to the parent Wx thread at the end of the task.
+ my $text = delete $self->{text};
+
+ # Get the function list
+ my @functions = $self->find($text);
+
+ # Sort it appropriately
+ if ( $self->{order} eq 'alphabetical' ) {
+
+ # Alphabetical (aka 'abc')
+ @functions = sort { lc($a) cmp lc($b) } @functions;
+ } elsif ( $self->{order} eq 'alphabetical_private_last' ) {
+
+ # ~ comes after \w
+ tr/_/~/ foreach @functions;
+ @functions = sort { lc($a) cmp lc($b) } @functions;
+ tr/~/_/ foreach @functions;
+ }
+
+ $self->{list} = \@functions;
+ return 1;
+}
+
+
+
+
+
+######################################################################
+# Padre::Task::FunctionList Methods
+
+# Show an empty function list by default
+sub find {
+ return ();
+}
+
+1;
+
+# Copyright 2008-2010 The Padre development team as listed in Padre.pm.
+# LICENSE
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl 5 itself.
@@ -1,126 +0,0 @@
-package Padre::Task::HTTPClient::LWP;
-
-use 5.008;
-use strict;
-use warnings;
-use Params::Util qw{_CODE _INSTANCE};
-use Padre::Task::HTTPClient;
-
-our $VERSION = '0.63';
-our @ISA = 'Padre::Task::HTTPClient';
-
-=pod
-
-=head1 NAME
-
-Padre::Task::HTTPClient::LWP - Generic HTTP client processing task using L<LWP>
-
-=head1 SYNOPSIS
-
-=head1 DESCRIPTION
-
-Sending and receiving data via HTTP.
-
-See L<Padre::Task::HTTPClient> for details.
-
-This module uses "require" instead of "use" to load the required modules
-
- LWP::UserAgent
- HTTP::Request
-
-because it need to be loaded without failing on dependencies which are no
-global Padre dependencies.
-
-=cut
-
-sub new {
- my $class = shift;
- my %args = @_;
-
- # These modules are no and should be no global Padre dependency, if they're
- # installed, use this module, otherwise another one needs to do the job:
- eval {
- require LWP::UserAgent;
- require HTTP::Request;
- };
-
- my $self = bless {@_}, $class;
-
- $self->{_UA} = LWP::UserAgent->new();
- $self->{_UA}->timeout(60); # TO DO: Make this configurable
- $self->{_UA}->env_proxy;
-
- return $self;
-
-}
-
-sub run {
- my $self = shift;
-
- # content (POST data) and query (GET data) may be passed as hash ref's
- # and they're converted automatically:
- foreach my $var ( 'query', 'content' ) {
- next unless ref( $self->{$var} ) eq 'HASH';
- $self->{$var} = join(
- '&',
- map {
- my $value = $self->{$var}->{$_} || '';
- $value =~ s/(\W)/"%".uc(unpack("H*",$1))/ge;
- $value =~ s/\%20/\+/g;
- $_ . '=' . $value;
- } ( keys( %{ $self->{$var} } ) )
- );
- }
-
- $self->{query} = '?' . $self->{query} if defined( $self->{query} );
-
- my $Request = HTTP::Request->new( $self->{method}, $self->{URL} . $self->{query} );
-
- if ( $self->{method} eq 'POST' ) {
- $Request->content_type( $self->{content_type} || 'application/x-www-form-urlencoded' );
- $Request->content( $self->{content} );
- }
-
- $Request->header( %{ $self->{header} } )
- if defined( $self->{header} )
- and ( ref( $self->header ) eq 'HASH' );
-
- my $Result = $self->{_UA}->request($Request);
-
- if ( $Result->is_success ) {
- if (wantarray) {
- return $Result->content, $Result;
- } else {
- return $Result->content;
- }
- } else {
- if (wantarray) {
- return ( undef, $Result );
- } else {
- return;
- }
- }
-
-}
-
-1;
-
-__END__
-
-=head1 SEE ALSO
-
-This class inherits from C<Padre::Task::HTTPClient>.
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright 2008-2010 The Padre development team as listed in Padre.pm.
-
-This program is free software; you can redistribute it and/or
-modify it under the same terms as Perl 5 itself.
-
-=cut
-
-# Copyright 2008-2010 The Padre development team as listed in Padre.pm.
-# LICENSE
-# This program is free software; you can redistribute it and/or
-# modify it under the same terms as Perl 5 itself.
@@ -1,90 +0,0 @@
-package Padre::Task::HTTPClient;
-
-use 5.008;
-use strict;
-use warnings;
-
-use Padre::Util::SVN ();
-
-# Use all modules which may provide services for us:
-
-our $VERSION = '0.63';
-our @DRIVERS = qw{
- Padre::Task::HTTPClient::LWP
-};
-
-=pod
-
-=head1 NAME
-
-Padre::Task::HTTPClient - HTTP client for Padre
-
-=head1 DESCRIPTION
-
-C<Padre::Task::HTTPClient> provides a common API for HTTP access to Padre.
-
-As we don't want a specific HTTP client module dependency to a
-network-independent application like Padre, this module searches
-for installed HTTP client modules and uses one of them.
-
-If none of the "child" modules could be loaded (no HTTP support at all
-on this computer), it fails and returns nothing (scalar C<undef>).
-
-=head1 METHODS
-
-=head2 new
-
- my $http = Padre::Task::HTTPClient->new();
-
-The C<new> constructor lets you create a new C<Padre::Task::HTTPClient> object.
-
-Returns a new C<Padre::Task::HTTPClient> or dies on error.
-
-=cut
-
-sub new {
- my $class = shift;
- my %args = @_;
- unless ( defined $args{URL} and length $args{URL} ) {
- return;
- }
-
- # Prepare information
- my $revision = Padre::Util::SVN->padre_revision() || 'na';
- $args{method} ||= 'GET';
- $args{headers}->{'X-Padre'} ||= "Padre version $VERSION $revision";
-
- # Each module will be tested and the first working one should return
- # a object, all others should return nothing (undef)
- foreach my $driver (@DRIVERS) {
- eval "require $driver;";
- next if $@;
- my $self = $driver->new(%args) or next;
- return $self;
- }
-
- return;
-}
-
-#=head2 atime
-#
-# $file->atime;
-#
-#Returns the last-access time of the file.
-#
-#This is usually not possible for non-local files, in these cases, undef
-#is returned.
-#
-#=cut
-#
-## Fallback if the module has no such function:
-#sub atime {
-# return;
-#}
-#
-1;
-
-# Copyright 2008-2010 The Padre development team as listed in Padre.pm.
-# LICENSE
-# This program is free software; you can redistribute it and/or
-# modify it under the same terms as Perl 5 itself.
@@ -0,0 +1,89 @@
+package Padre::Task::IntroduceTemporaryVariable;
+
+use 5.008;
+use strict;
+use warnings;
+use Padre::Task::PPI ();
+
+our $VERSION = '0.66';
+our @ISA = 'Padre::Task::PPI';
+
+=pod
+
+=head1 NAME
+
+Padre::Task::IntroduceTemporaryVariable - Introduces a temporary variable using L<PPI>
+
+=head1 SYNOPSIS
+
+ my $tempvarmaker = Padre::Task::IntroduceTemporaryVariable->new(
+ document => $document_obj,
+ start_location => [$line, $column], # or just character position
+ end_location => [$line, $column], # or ppi-style location
+ varname => '$foo',
+ );
+
+ $tempvarmaker->schedule;
+
+=head1 DESCRIPTION
+
+Given a region of code within a statement, replaces that code with a temporary variable.
+Declares and initializes the temporary variable right above the statement that included the selected
+expression.
+
+Usually, you simply set C<start_position> to what C<< $editor->GetSelectionStart() >> returns
+and C<end_position> to C<< $editor->GetSelectionEnd() - 1 >>.
+
+=cut
+
+sub process {
+ my $self = shift;
+ my $ppi = shift or return;
+
+ # Transform the document
+ my $munged = eval {
+ require PPIx::EditorTools::IntroduceTemporaryVariable;
+ PPIx::EditorTools::IntroduceTemporaryVariable->new->introduce(
+ ppi => $ppi,
+ start_location => $self->{start_location},
+ end_location => $self->{end_location},
+ varname => $self->{varname},
+ );
+ };
+ if ($@) {
+ $self->{error} = $@;
+ return;
+ }
+
+ # TO DO: passing this back and forth is probably hyper-inefficient, but such is life.
+ $self->{munged} = $munged->code;
+ $self->{location} = $munged->element->location;
+
+ return;
+}
+
+1;
+
+__END__
+
+=head1 SEE ALSO
+
+This class inherits from C<Padre::Task::PPI>.
+
+=head1 AUTHOR
+
+Steffen Mueller C<smueller@cpan.org>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2008-2010 The Padre development team as listed in Padre.pm.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl 5 itself.
+
+=cut
+
+# Copyright 2008-2010 The Padre development team as listed in Padre.pm.
+# LICENSE
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl 5 itself.
@@ -23,15 +23,15 @@ Sending and receiving data via HTTP.
=cut
-use 5.008;
+use 5.008005;
use strict;
use warnings;
-use Params::Util qw{_INSTANCE};
+use Params::Util ();
use HTTP::Request ();
use HTTP::Response ();
use Padre::Task ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
our @ISA = 'Padre::Task';
use Class::XSAccessor {
@@ -53,9 +53,8 @@ use Class::XSAccessor {
=head2 new
my $task = Padre::Task::LWP->new(
- request => HTTP::Request->new(
- GET => 'http://perlide.org',
- ),
+ method => 'GET',
+ url => 'http://perlide.org',
);
The C<new> constructor creates a L<Padre::Task> for a background HTTP request.
@@ -70,16 +69,20 @@ Returns a new L<Padre::Task::LWP> object, or throws an exception on error.
sub new {
my $self = shift->SUPER::new(
@_,
+
+ # Temporarily disable the ability to fully specify the request
+ request => undef,
response => undef,
);
-
- unless ( _INSTANCE( $self->request, 'HTTP::Request' ) ) {
+ unless ( $self->{url} ) {
Carp::croak("Missing or invalid 'request' for Padre::Task::LWP");
}
return $self;
}
+=pod
+
=head2 request
The C<request> method returns the L<HTTP::Request> object that was provided
@@ -105,11 +108,44 @@ of the HTTP call.
sub run {
my $self = shift;
- # Execute the web request
+ # Generate the formal request
+ my $method = $self->{method} || 'GET';
+ my $url = $self->{url};
+ my $query = $self->{query};
+ if ( Params::Util::_HASH0($query) ) {
+ $query = join '&', map {
+ my $value = $query->{$_} || '';
+ $value =~ s/(\W)/"%".uc(unpack("H*",$1))/ge;
+ $value =~ s/\%20/\+/g;
+ $_ . '=' . $value;
+ } ( sort keys %$query );
+ }
+ if ( $method eq 'GET' and defined $query ) {
+ $url .= '?' . $query;
+ }
+ my $request = HTTP::Request->new( $self->{method}, $url );
+ if ( $method eq 'POST' ) {
+ $request->content_type( $self->{content_type} || 'application/x-www-form-urlencoded' );
+ $request->content( $query || '' );
+ }
+ my $headers = Params::Util::_HASH0( $self->{headers} ) || {};
+ foreach my $name ( sort keys %$headers ) {
+ $request->header( $name => $headers->{$name} );
+ }
+ $self->{request} = $request;
+
+ # Initialise the user agent
require LWP::UserAgent;
- $self->{response} = LWP::UserAgent->new(
- agent => "Padre/$VERSION",
- )->request( $self->request );
+ my $useragent = LWP::UserAgent->new(
+ agent => "Padre/$VERSION",
+ timeout => 60,
+ );
+ $useragent->env_proxy;
+
+ # Execute the request.
+ # It's not up to us to judge success or failure at this point,
+ # we just do the heavy lifting of the request itself.
+ $self->{response} = $useragent->request($request);
# Remove the CODE references from the response.
# They aren't needed any more, and they won't survive
@@ -9,12 +9,16 @@ use 5.008;
use strict;
use warnings;
use Padre::Task ();
-use Padre::Wx ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
our @ISA = 'Padre::Task';
sub run {
+
+ # We don't need to load all of Padre::Wx for this,
+ # but we do need the minimum bits of wxWidgets.
+ require Wx;
+
Wx::LaunchDefaultBrowser( $_[0]->{url} );
return 1;
}
@@ -0,0 +1,84 @@
+package Padre::Task::LexicalReplaceVariable;
+
+use 5.008;
+use strict;
+use warnings;
+use Padre::Task::PPI ();
+
+our $VERSION = '0.66';
+our @ISA = 'Padre::Task::PPI';
+
+=pod
+
+=head1 NAME
+
+Padre::Task::LexicalReplaceVariable - Lexically variable replace using L<PPI>
+
+=head1 SYNOPSIS
+
+ my $replacer = Padre::Task::LexicalReplaceVariable->new(
+ document => $document_obj,
+ location => [ $line, $column ], # the position of *any* occurrence of the variable
+ replacement => '$foo',
+ );
+ $replacer->schedule();
+
+=head1 DESCRIPTION
+
+Given a location in the document (line/column), determines the name of the
+variable at this position, finds where the variable was defined,
+and B<lexically> replaces all occurrences with another variable.
+
+=cut
+
+sub process {
+ my $self = shift;
+ my $ppi = shift or return;
+ my $location = $self->{location};
+
+ my $munged = eval {
+ require PPIx::EditorTools::RenameVariable;
+ PPIx::EditorTools::RenameVariable->new->rename(
+ ppi => $ppi,
+ line => $location->[0],
+ column => $location->[1],
+ replacement => $self->{replacement},
+ );
+ };
+ if ($@) {
+ $self->{error} = $@;
+ return;
+ }
+
+ # Save the results
+ $self->{munged} = $munged->code;
+ $self->{location} = $munged->element->location;
+
+ return;
+}
+
+1;
+
+__END__
+
+=head1 SEE ALSO
+
+This class inherits from C<Padre::Task::PPI>.
+
+=head1 AUTHOR
+
+Steffen Mueller C<smueller@cpan.org>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2008-2010 The Padre development team as listed in Padre.pm.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl 5 itself.
+
+=cut
+
+# Copyright 2008-2010 The Padre development team as listed in Padre.pm.
+# LICENSE
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl 5 itself.
@@ -1,134 +0,0 @@
-package Padre::Task::OpenResource::SearchTask;
-
-use 5.008;
-use strict;
-use warnings;
-
-our $VERSION = '0.63';
-our @ISA = 'Padre::Task';
-our $thread_running = 0;
-
-# accessors
-use Class::XSAccessor {
- accessors => {
-
- # Searched directory
- _directory => '_directory',
-
- # Matched files list
- _matched_files => '_matched_files',
-
- # Skip VCS files menu item
- _skip_vcs_files => '_skip_vcs_files',
-
- # Skip using MANIFEST.SKIP menu item
- _skip_using_manifest_skip => '_skip_using_manifest_skip',
- }
-};
-
-#
-# This is run in the main thread before being handed
-# off to a worker (background) thread. The Wx GUI can be
-# polled for information here.
-#
-sub prepare {
- my ($self) = @_;
-
- # move the document to the main-thread-only storage
- my $mto = $self->{main_thread_only} ||= {};
- $mto->{dialog} = $self->{dialog}
- if defined $self->{dialog};
- delete $self->{dialog};
-
- $self->_directory( $self->{directory} );
- $self->_skip_vcs_files( $self->{skip_vcs_files} );
- $self->_skip_using_manifest_skip( $self->{skip_using_manifest_skip} );
-
- # assign a place in the work queue
- if ($thread_running) {
-
- # single thread instance at a time please. aborting...
- return "break";
- }
- $thread_running = 1;
- return 1;
-}
-
-#
-# Task thread subroutine
-#
-sub run {
- my $self = shift;
-
- # search and ignore rc folders (CVS,.svn,.git) if the user wants
- require File::Find::Rule;
- my $rule = File::Find::Rule->new;
- if ( $self->_skip_vcs_files ) {
- $rule->or(
- $rule->new->directory->name( 'CVS', '.svn', '.git', 'blib' )->prune->discard,
- $rule->new
- );
- }
- $rule->file;
-
- if ( $self->_skip_using_manifest_skip ) {
- my $manifest_skip_file = File::Spec->catfile( $self->_directory, 'MANIFEST.SKIP' );
- if ( -e $manifest_skip_file ) {
- require ExtUtils::Manifest;
- ExtUtils::Manifest->import(qw(maniskip));
- my $skip_check = maniskip($manifest_skip_file);
- my $skip_files = sub {
- my ( $shortname, $path, $fullname ) = @_;
- return not $skip_check->($fullname);
- };
- $rule->exec( \&$skip_files );
- }
- }
-
- # Generate a sorted file-list based on filename
- my @matched_files =
- sort { File::Basename::fileparse($a) cmp File::Basename::fileparse($b) } $rule->in( $self->_directory );
- $self->_matched_files( \@matched_files );
-
- return 1;
-}
-
-#
-# This is run in the main thread after the task is done.
-# It can update the GUI and do cleanup.
-#
-sub finish {
- my ( $self, $main ) = @_;
-
- my $dialog = $self->{main_thread_only}->{dialog};
- $dialog->_matched_files( $self->_matched_files );
- $dialog->_status_text->SetLabel( Wx::gettext("Finished Searching") );
- $dialog->_update_matches_list_box;
-
- # finished here
- $thread_running = 0;
-
- return 1;
-}
-
-1;
-
-__END__
-
-=head1 AUTHOR
-
-Ahmad M. Zawawi C<< <ahmad.zawawi at gmail.com> >>
-
-=head1 COPYRIGHT & LICENSE
-
-Copyright 2008-2010 The Padre development team as listed in Padre.pm.
-
-This program is free software; you can redistribute
-it and/or modify it under the same terms as Perl itself.
-
-=cut
-
-# Copyright 2008-2010 The Padre development team as listed in Padre.pm.
-# LICENSE
-# This program is free software; you can redistribute it and/or
-# modify it under the same terms as Perl 5 itself.
@@ -0,0 +1,70 @@
+package Padre::Task::OpenResource;
+
+use 5.008;
+use strict;
+use warnings;
+
+use Padre::Task ();
+
+our $VERSION = '0.66';
+our @ISA = 'Padre::Task';
+
+sub run {
+ my $self = shift;
+
+ # Search and ignore rc folders (CVS,.svn,.git) if the user wants
+ require File::Find::Rule;
+ my $rule = File::Find::Rule->new;
+ if ( $self->{skip_vcs_files} ) {
+ $rule->or(
+ $rule->new->directory->name( 'CVS', '.svn', '.git', 'blib' )->prune->discard,
+ $rule->new
+ );
+ }
+ $rule->file;
+
+ if ( $self->{skip_using_manifest_skip} ) {
+ my $manifest_skip = File::Spec->catfile(
+ $self->{directory},
+ 'MANIFEST.SKIP',
+ );
+ if ( -e $manifest_skip ) {
+ require ExtUtils::Manifest;
+ ExtUtils::Manifest->import('maniskip');
+ my $maniskip = maniskip($manifest_skip);
+ $rule->exec(
+ sub {
+ return not $maniskip->( $_[2] );
+ }
+ );
+ }
+ }
+
+ # Generate a sorted file list based on filename
+ $self->{matched} =
+ [ sort { File::Basename::fileparse($a) cmp File::Basename::fileparse($b) } $rule->in( $self->{directory} ) ];
+
+ return 1;
+}
+
+1;
+
+__END__
+
+=head1 AUTHOR
+
+Ahmad M. Zawawi C<< <ahmad.zawawi at gmail.com> >>
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2008-2010 The Padre development team as listed in Padre.pm.
+
+This program is free software; you can redistribute
+it and/or modify it under the same terms as Perl itself.
+
+=cut
+
+# Copyright 2008-2010 The Padre development team as listed in Padre.pm.
+# LICENSE
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl 5 itself.
@@ -1,232 +0,0 @@
-package Padre::Task::Outline::Perl;
-
-=pod
-
-=head1 NAME
-
-Padre::Task::Outline::Perl - Perl document outline structure info
-gathering in the background
-
-=head1 SYNOPSIS
-
- # by default, the text of the current document
- # will be fetched as will the document's notebook page.
- my $task = Padre::Task::Outline::Perl->new;
- $task->schedule;
-
- my $task2 = Padre::Task::Outline::Perl->new(
- text => Padre::Current->document->text_get,
- editor => Padre::Current->editor,
- );
- $task2->schedule;
-
-=head1 DESCRIPTION
-
-This class implements structure info gathering of Perl documents in
-the background.
-Also the updating of the GUI is implemented here, because other
-languages might have different outline structures.
-It inherits from L<Padre::Task::Outline>.
-Please read its documentation!
-
-=cut
-
-use 5.008;
-use strict;
-use warnings;
-use version;
-use Padre::Task::Outline ();
-
-our $VERSION = '0.63';
-our @ISA = 'Padre::Task::Outline';
-
-sub new {
- my $class = shift;
- my $self = $class->SUPER::new(@_);
-
- return $self;
-}
-
-sub run {
- my $self = shift;
- $self->_get_outline;
- return 1;
-}
-
-sub _get_outline {
-
- # TO DO switch to using File::PackageIndexer
- # (which needs to be modified / extended first)
- my $self = shift;
-
- my $outline = [];
-
- require PPI::Find;
- require PPI::Document;
-
- my $ppi_doc = PPI::Document->new( \$self->{text} );
-
- return {} unless defined($ppi_doc);
-
- $ppi_doc->index_locations;
-
- my $find = PPI::Find->new(
- sub {
- return 1
- if ref $_[0] eq 'PPI::Statement::Package'
- or ref $_[0] eq 'PPI::Statement::Include'
- or ref $_[0] eq 'PPI::Statement::Sub'
- or ref $_[0] eq 'PPI::Statement';
- }
- );
-
- my @things = $find->in($ppi_doc);
- my $cur_pkg = {};
- my $not_first_one = 0;
- foreach my $thing (@things) {
- if ( ref $thing eq 'PPI::Statement::Package' ) {
- if ($not_first_one) {
- if ( not $cur_pkg->{name} ) {
- $cur_pkg->{name} = 'main';
- }
- push @$outline, $cur_pkg;
- $cur_pkg = {};
- }
- $not_first_one = 1;
- $cur_pkg->{name} = $thing->namespace;
- $cur_pkg->{line} = $thing->location->[0];
- } elsif ( ref $thing eq 'PPI::Statement::Include' ) {
- next if $thing->type eq 'no';
- if ( $thing->pragma ) {
- push @{ $cur_pkg->{pragmata} }, { name => $thing->pragma, line => $thing->location->[0] };
- } elsif ( $thing->module ) {
- push @{ $cur_pkg->{modules} }, { name => $thing->module, line => $thing->location->[0] };
- }
- } elsif ( ref $thing eq 'PPI::Statement::Sub' ) {
- push @{ $cur_pkg->{methods} }, { name => $thing->name, line => $thing->location->[0] };
- } elsif ( ref $thing eq 'PPI::Statement' ) {
-
- # last resort, let's analyse further down...
- my $node1 = $thing->first_element;
- my $node2 = $thing->child(2);
- next unless defined $node2;
-
- # Moose attribute declaration
- if ( $node1->isa('PPI::Token::Word') && $node1->content eq 'has' ) {
- push @{ $cur_pkg->{attributes} }, { name => $node2->content, line => $thing->location->[0] };
- next;
- }
-
- # MooseX::POE event declaration
- if ( $node1->isa('PPI::Token::Word') && $node1->content eq 'event' ) {
- push @{ $cur_pkg->{events} }, { name => $node2->content, line => $thing->location->[0] };
- next;
- }
- }
- }
-
- if ( not $cur_pkg->{name} ) {
- $cur_pkg->{name} = 'main';
- }
- push @{$outline}, $cur_pkg;
-
- $self->{outline} = $outline;
-
- return;
-}
-
-sub update_gui {
- my $self = shift;
- my $outline = $self->{outline};
- my $filename = $self->{filename};
- my $outlinebar = Padre->ide->wx->main->outline;
-
- # only update the outline pane if we still have the same filename
- my $current_filename = Padre::Current->filename;
- $current_filename = Padre::Current->document->get_title if !defined($current_filename);
-
- if ( $filename eq $current_filename ) {
- $outlinebar->update_data( $outline, $filename, \&_on_tree_item_right_click );
-
- # store data for further use by other components
- Padre::Current->document->set_outline_data($outline);
- } else {
- $outlinebar->store_in_cache( $filename, [ $outline, \&_on_tree_item_right_click ] );
- }
-}
-
-sub _on_tree_item_right_click {
- my ( $outlinebar, $event ) = @_;
- my $showMenu = 0;
-
- my $menu = Wx::Menu->new;
- my $itemData = $outlinebar->GetPlData( $event->GetItem );
-
- if ( defined($itemData) && defined( $itemData->{line} ) && $itemData->{line} > 0 ) {
- my $goTo = $menu->Append( -1, Wx::gettext("&Go to Element") );
- Wx::Event::EVT_MENU(
- $outlinebar, $goTo,
- sub { $outlinebar->on_tree_item_set_focus($event); },
- );
- $showMenu++;
- }
-
- if ( defined($itemData)
- && defined( $itemData->{type} )
- && ( $itemData->{type} eq 'modules' || $itemData->{type} eq 'pragmata' ) )
- {
- my $pod = $menu->Append( -1, Wx::gettext("Open &Documentation") );
- Wx::Event::EVT_MENU(
- $outlinebar,
- $pod,
- sub {
-
- # TO DO Fix this wasting of objects (cf. Padre::Wx::Menu::Help)
- require Padre::Wx::DocBrowser;
- my $help = Padre::Wx::DocBrowser->new;
- $help->help( $itemData->{name} );
- $help->SetFocus;
- $help->Show(1);
- return;
- },
- );
- $showMenu++;
- }
-
- if ( $showMenu > 0 ) {
- my $x = $event->GetPoint->x;
- my $y = $event->GetPoint->y;
- $outlinebar->PopupMenu( $menu, $x, $y );
- }
- return;
-}
-
-1;
-
-__END__
-
-=pod
-
-=head1 SEE ALSO
-
-This class inherits from L<Padre::Task::Outline> which
-in turn is a L<Padre::Task> and its instances can be scheduled
-using L<Padre::TaskManager>.
-
-=head1 AUTHOR
-
-Heiko Jansen C<heiko_jansen@web.de>
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright 2008-2010 The Padre development team as listed in Padre.pm.
-
-This program is free software; you can redistribute it and/or
-modify it under the same terms as Perl 5 itself.
-
-=cut
-
-# Copyright 2008-2010 The Padre development team as listed in Padre.pm.
-# LICENSE
-# This program is free software; you can redistribute it and/or
-# modify it under the same terms as Perl 5 itself.
@@ -1,154 +1,74 @@
package Padre::Task::Outline;
-use 5.008;
+# Function list refresh task, done mainly as a full-feature proof of concept.
+
+use 5.008005;
use strict;
use warnings;
-use Params::Util qw{_CODE _INSTANCE};
-use Padre::Task ();
-use Padre::Current ();
-use Padre::Wx ();
+use Params::Util ('_INSTANCE');
+use Padre::Task ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
our @ISA = 'Padre::Task';
-=pod
-
-=head1 NAME
-
-Padre::Task::Outline - Generic background processing task to
-gather structure info on the current document
-
-=head1 SYNOPSIS
-
- package Padre::Task::Outline::MyLanguage;
-
- use base 'Padre::Task::Outline';
-
- sub run {
- my $self = shift;
- my $doc_text = $self->{text};
- # black magic here
- $self->{outline} = ...;
- return 1;
- };
-
- 1;
-
- # elsewhere:
-
- # by default, the text of the current document
- # will be fetched as will the document's notebook page.
- my $task = Padre::Task::Outline::MyLanguage->new();
- $task->schedule;
-
- my $task2 = Padre::Task::Outline::MyLanguage->new(
- text => Padre::Current->document->text_get,
- editor => Padre::Current->editor,
- );
- $task2->schedule;
-
-=head1 DESCRIPTION
-
-This is a base class for all tasks that need to do
-expensive structure info gathering in a background task.
-
-You can either let C<Padre::Task::Outline> fetch the
-Perl code for parsing from the current document
-or specify it as the "C<text>" parameter to
-the constructor.
-
-To create a outline gatherer for a given document type C<Foo>,
-you create a subclass C<Padre::Task::Outline::Foo> and
-implement the C<run> method which uses the C<$self-E<gt>{text}>
-attribute of the task object for its nefarious structure info gathering
-purposes and then stores the result in the C<$self-E<gt>{outline}>
-attribute of the object. The result should be a data structure of the
-form defined in the documentation of the C<Padre::Document::get_outline>
-method. See L<Padre::Document>.
-
-This base class requires all logic necessary to update the GUI
-with the structure info in a method C<update_gui> of the derived
-class. That method is called in the C<finish()> hook.
-
-=cut
-sub new {
- my $class = shift;
- my $self = $class->SUPER::new(@_);
- unless ( defined $self->{text} ) {
- $self->{text} = Padre::Current->document->text_get;
- }
- my %args = @_;
- $self->{filename} = $args{filename};
- # put notebook page and callback into main-thread-only storage
- $self->{main_thread_only} ||= {};
- my $editor = $self->{editor}
- || $self->{main_thread_only}->{editor};
- delete $self->{editor};
- unless ( defined $editor ) {
- $editor = Padre::Current->editor;
+######################################################################
+# Constructor
+
+sub new {
+ my $self = shift->SUPER::new(@_);
+
+ # Just convert the document to text for now.
+ # Later, we'll suck in more data from the project and
+ # other related documents to do syntax checks more awesomely.
+ unless ( _INSTANCE( $self->{document}, 'Padre::Document' ) ) {
+ die "Failed to provide a document to the syntax check task";
}
- return if not defined $editor;
- $self->{main_thread_only}->{editor} = $editor;
+ # Remove the document entirely as we do this,
+ # as it won't be able to survive serialisation.
+ my $document = delete $self->{document};
+ $self->{text} = $document->text_get;
return $self;
}
-sub run {
- my $self = shift;
- return 1;
-}
-sub prepare {
- my $self = shift;
- unless ( defined $self->{text} ) {
- require Carp;
- Carp::croak("Could not find the document's text.");
- }
- unless ( defined $self->{main_thread_only}->{editor} ) {
- require Carp;
- Carp::croak("Could not find the reference to the notebook page for GUI updating.");
- }
- return 1;
-}
-sub finish {
- $_[0]->update_gui;
- return;
-}
-1;
-__END__
+######################################################################
+# Padre::Task Methods
-=pod
+sub run {
+ my $self = shift;
-=head1 SEE ALSO
+ # Pull the text off the task so we won't need to serialize
+ # it back up to the parent Wx thread at the end of the task.
+ my $text = delete $self->{text};
-This class inherits from C<Padre::Task> and its instances can be scheduled
-using C<Padre::TaskManager>.
+ # Generate the outline
+ $self->{data} = $self->find($text);
-The transfer of the objects to and from the worker threads is implemented
-with L<Storable>.
+ return 1;
+}
-=head1 AUTHOR
-Steffen Mueller E<lt>smueller@cpan.orgE<gt>
-Heiko Jansen E<lt>heiko_jansen@web.deE<gt>
-=head1 COPYRIGHT AND LICENSE
-Copyright 2008-2010 The Padre development team as listed in Padre.pm.
+######################################################################
+# Padre::Task::Outline Methods
-This program is free software; you can redistribute it and/or
-modify it under the same terms as Perl 5 itself.
+# Show an empty function list by default
+sub find {
+ return [];
+}
-=cut
+1;
# Copyright 2008-2010 The Padre development team as listed in Padre.pm.
# LICENSE
@@ -1,111 +0,0 @@
-package Padre::Task::PPI::FindUnmatchedBrace;
-
-use 5.008;
-use strict;
-use warnings;
-use Padre::Wx ();
-use Padre::Task::PPI ();
-use PPIx::EditorTools::FindUnmatchedBrace ();
-
-our $VERSION = '0.63';
-our @ISA = 'Padre::Task::PPI';
-
-=pod
-
-=head1 NAME
-
-Padre::Task::PPI::FindUnmatchedBrace - C<PPI> based unmatched brace finder
-
-=head1 SYNOPSIS
-
- my $bracefinder = Padre::Task::PPI::FindUnmatchedBrace->new(
- document => $document_obj,
- );
- # pass "text => 'foo'" if you want to set the code manually
- # otherwise, the current document will be used
-
- $bracefinder->schedule();
-
-=head1 DESCRIPTION
-
-Finds the location of unmatched braces in a C<Padre::Document::Perl>.
-If there is no unmatched brace, a message box tells the user about
-that glorious fact. If there is one, the cursor will jump to it.
-
-=cut
-
-sub prepare {
- my $self = shift;
- $self->SUPER::prepare(@_);
-
- # move the document to the main-thread-only storage
- my $mto = $self->{main_thread_only} ||= {};
- $mto->{document} = $self->{document}
- if defined $self->{document};
- delete $self->{document};
- if ( not defined $mto->{document} ) {
- require Carp;
- Carp::croak("Missing Padre::Document::Perl object as {document} attribute of the brace-finder task");
- }
- return ();
-}
-
-sub process_ppi {
-
- # find bad braces
- my $self = shift;
- my $ppi = shift or return;
-
- my $brace = eval { PPIx::EditorTools::FindUnmatchedBrace->new->find( ppi => $ppi ); };
- if ($@) {
- $self->{error} = $@;
- return;
- }
- if ( defined($brace) ) { # An undef brace throws a die here. undef = no error found.
- $self->{bad_element} = $brace->element->location; # remember for gui update
- }
-
- return ();
-}
-
-sub finish {
- my $self = shift;
- if ( defined $self->{bad_element} ) {
-
- # GUI update
- $self->{main_thread_only}->{document}->ppi_select( $self->{bad_element} );
- } else {
- Wx::MessageBox(
- Wx::gettext("All braces appear to be matched"),
- Wx::gettext("Check Complete"),
- Wx::wxOK, Padre->ide->wx->main
- );
- }
- return ();
-}
-
-1;
-
-__END__
-
-=head1 SEE ALSO
-
-This class inherits from C<Padre::Task::PPI>.
-
-=head1 AUTHOR
-
-Steffen Mueller C<smueller@cpan.org>
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright 2008-2010 The Padre development team as listed in Padre.pm.
-
-This program is free software; you can redistribute it and/or
-modify it under the same terms as Perl 5 itself.
-
-=cut
-
-# Copyright 2008-2010 The Padre development team as listed in Padre.pm.
-# LICENSE
-# This program is free software; you can redistribute it and/or
-# modify it under the same terms as Perl 5 itself.
@@ -1,127 +0,0 @@
-package Padre::Task::PPI::FindVariableDeclaration;
-
-use 5.008;
-use strict;
-use warnings;
-use Padre::Wx ();
-use Padre::Task::PPI ();
-use PPIx::EditorTools::FindVariableDeclaration ();
-
-our $VERSION = '0.63';
-our @ISA = 'Padre::Task::PPI';
-
-=pod
-
-=head1 NAME
-
-Padre::Task::PPI::FindVariableDeclaration - Finds where a variable was declared using L<PPI>
-
-=head1 SYNOPSIS
-
- # finds declaration of variable at cursor
- my $declfinder = Padre::Task::PPI::FindVariableDeclaration->new(
- document => $document_obj,
- location => [$line, $column], # ppi-style location is okay, too
- );
-
- $declfinder->schedule();
-
-=head1 DESCRIPTION
-
-Finds out where a variable has been declared.
-If unsuccessful, a message box tells the user about
-that glorious fact. If a declaration is found, the cursor will jump to it.
-
-=cut
-
-sub prepare {
- my $self = shift;
- $self->SUPER::prepare(@_);
-
- # move the document to the main-thread-only storage
- my $mto = $self->{main_thread_only} ||= {};
- $mto->{document} = $self->{document}
- if defined $self->{document};
- delete $self->{document};
- if ( not defined $mto->{document} ) {
- require Carp;
- Carp::croak("Missing Padre::Document::Perl object as {document} attribute of the FindVariableDeclaration task");
- }
-
- if ( not defined $self->{location} ) {
- require Carp;
- Carp::croak("Need a {location}!");
- }
-
- return ();
-}
-
-sub process_ppi {
- my $self = shift;
- my $ppi = shift or return;
- my $location = $self->{location};
-
- my $declaration = eval {
- PPIx::EditorTools::FindVariableDeclaration->new->find(
- ppi => $ppi,
- line => $location->[0],
- column => $location->[1]
- );
- };
- if ($@) {
- $self->{error} = $@;
- return;
- }
-
- $self->{declaration_location} = $declaration->element->location;
- return ();
-}
-
-sub finish {
- my $self = shift;
- if ( defined $self->{declaration_location} ) {
-
- # GUI update
- $self->{main_thread_only}->{document}->ppi_select( $self->{declaration_location} );
- } else {
- my $text;
- if ( $self->{error} =~ /no token/ ) {
- $text = Wx::gettext("Current cursor does not seem to point at a variable");
- } elsif ( $self->{error} =~ /no declaration/ ) {
- $text = Wx::gettext("No declaration could be found for the specified (lexical?) variable");
- } else {
- $text = Wx::gettext("Unknown error");
- }
- Wx::MessageBox(
- $text, Wx::gettext("Search Canceled"),
- Wx::wxOK, Padre->ide->wx->main
- );
- }
- return ();
-}
-
-1;
-
-__END__
-
-=head1 SEE ALSO
-
-This class inherits from C<Padre::Task::PPI>.
-
-=head1 AUTHOR
-
-Steffen Mueller C<smueller@cpan.org>
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright 2008-2010 The Padre development team as listed in Padre.pm.
-
-This program is free software; you can redistribute it and/or
-modify it under the same terms as Perl 5 itself.
-
-=cut
-
-# Copyright 2008-2010 The Padre development team as listed in Padre.pm.
-# LICENSE
-# This program is free software; you can redistribute it and/or
-# modify it under the same terms as Perl 5 itself.
@@ -1,141 +0,0 @@
-package Padre::Task::PPI::IntroduceTemporaryVariable;
-
-use 5.008;
-use strict;
-use warnings;
-use Padre::Wx ();
-use Padre::Task::PPI ();
-use PPIx::EditorTools::IntroduceTemporaryVariable ();
-
-our $VERSION = '0.63';
-our @ISA = 'Padre::Task::PPI';
-
-=pod
-
-=head1 NAME
-
-Padre::Task::PPI::IntroduceTemporaryVariable - Introduces a temporary variable using L<PPI>
-
-=head1 SYNOPSIS
-
- my $tempvarmaker = Padre::Task::PPI::IntroduceTemporaryVariable->new(
- document => $document_obj,
- start_location => [$line, $column], # or just character position
- end_location => [$line, $column], # or ppi-style location
- varname => '$foo',
- );
-
- $tempvarmaker->schedule();
-
-=head1 DESCRIPTION
-
-Given a region of code within a statement, replaces that code with a temporary variable.
-Declares and initializes the temporary variable right above the statement that included the selected
-expression.
-
-Usually, you simply set C<start_position> to what C<< $editor->GetSelectionStart() >> returns
-and C<end_position> to C<< $editor->GetSelectionEnd() - 1 >>.
-
-=cut
-
-sub prepare {
- my $self = shift;
- $self->SUPER::prepare(@_);
-
- # move the document to the main-thread-only storage
- my $mto = $self->{main_thread_only} ||= {};
- $mto->{document} = $self->{document}
- if defined $self->{document};
- delete $self->{document};
- if ( not defined $mto->{document} ) {
- require Carp;
- Carp::croak("Missing Padre::Document::Perl object as {document} attribute of the temporary-variable task");
- }
-
- foreach my $key (qw(start_location end_location)) {
- if ( not defined $self->{$key} ) {
- require Carp;
- Carp::croak("Need a {$key}!");
- } elsif ( not ref( $self->{$key} ) ) {
- my $doc = $mto->{document};
- $self->{$key} = $doc->character_position_to_ppi_location( $self->{$key} );
- }
- }
-
- return ();
-}
-
-sub process_ppi {
- my $self = shift;
- my $ppi = shift or return;
- my $location = $self->{start_location};
-
- my $munged = eval {
- PPIx::EditorTools::IntroduceTemporaryVariable->new->introduce(
- ppi => $ppi,
- start_location => $self->{start_location},
- end_location => $self->{end_location},
- varname => $self->{varname},
- );
- };
- if ($@) {
- $self->{error} = $@;
- return;
- }
-
- # TO DO: passing this back and forth is probably hyper-inefficient, but such is life.
- $self->{updated_document_string} = $munged->code;
- $self->{location} = $munged->element->location;
- return ();
-}
-
-sub finish {
- my $self = shift;
- if ( defined $self->{updated_document_string} ) {
-
- # GUI update
- # TO DO: What if the document changed? Bad luck for now.
- $self->{main_thread_only}->{document}->editor->SetText( $self->{updated_document_string} );
- $self->{main_thread_only}->{document}->ppi_select( $self->{location} );
- } else {
- my $text;
- if ( $self->{error} =~ /no token/ ) {
- $text = Wx::gettext("First character of selection does not seem to point at a token.");
- } elsif ( $self->{error} =~ /no statement/ ) {
- $text = Wx::gettext("Selection not part of a Perl statement?");
- } else {
- $text = Wx::gettext("Unknown error");
- }
- Wx::MessageBox(
- $text, Wx::gettext("Replace Operation Canceled"),
- Wx::wxOK, Padre->ide->wx->main
- );
- }
- return ();
-}
-
-1;
-
-__END__
-
-=head1 SEE ALSO
-
-This class inherits from C<Padre::Task::PPI>.
-
-=head1 AUTHOR
-
-Steffen Mueller C<smueller@cpan.org>
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright 2008-2010 The Padre development team as listed in Padre.pm.
-
-This program is free software; you can redistribute it and/or
-modify it under the same terms as Perl 5 itself.
-
-=cut
-
-# Copyright 2008-2010 The Padre development team as listed in Padre.pm.
-# LICENSE
-# This program is free software; you can redistribute it and/or
-# modify it under the same terms as Perl 5 itself.
@@ -1,141 +0,0 @@
-package Padre::Task::PPI::LexicalReplaceVariable;
-
-use 5.008;
-use strict;
-use warnings;
-use Padre::Wx ();
-use Padre::Task::PPI ();
-use PPIx::EditorTools::RenameVariable ();
-
-our $VERSION = '0.63';
-our @ISA = 'Padre::Task::PPI';
-
-=pod
-
-=head1 NAME
-
-Padre::Task::PPI::LexicalReplaceVariable - Lexically variable replace using L<PPI>
-
-=head1 SYNOPSIS
-
- my $replacer = Padre::Task::PPI::LexicalReplaceVariable->new(
- document => $document_obj,
- location => [$line, $column], # the position of *any* occurrence of the variable
- replacement => '$foo',
- );
- $replacer->schedule();
-
-=head1 DESCRIPTION
-
-Given a location in the document (line/column), determines the name of the
-variable at this position, finds where the variable was defined,
-and B<lexically> replaces all occurrences with another variable.
-
-=cut
-
-sub prepare {
- my $self = shift;
- $self->SUPER::prepare(@_);
-
- # move the document to the main-thread-only storage
- my $mto = $self->{main_thread_only} ||= {};
- $mto->{document} = $self->{document}
- if defined $self->{document};
- delete $self->{document};
- if ( not defined $mto->{document} ) {
- require Carp;
- Carp::croak("Missing Padre::Document::Perl object as {document} attribute of the brace-finder task");
- }
-
- if ( not defined $self->{replacement} ) {
- require Carp;
- Carp::croak("Need a {replacement}!");
- }
-
- if ( not defined $self->{location} ) {
- require Carp;
- Carp::croak("Need a {location}!");
- }
-
- return ();
-}
-
-sub process_ppi {
-
- # find bad braces
- my $self = shift;
- my $ppi = shift or return;
- my $location = $self->{location};
-
- my $munged = eval {
- PPIx::EditorTools::RenameVariable->new->rename(
- ppi => $ppi,
- line => $location->[0],
- column => $location->[1],
- replacement => $self->{replacement},
- );
- };
- if ($@) {
- $self->{error} = $@;
- return;
- }
-
- # for moving the cursor after updating the text
- $self->{token_location} = $munged->element->location;
-
- # TO DO: passing this back and forth is probably hyper-inefficient, but such is life.
- $self->{updated_document_string} = $munged->code;
-
- return ();
-}
-
-sub finish {
- my $self = shift;
- if ( defined $self->{updated_document_string} ) {
-
- # GUI update
- # TO DO: What if the document changed? Bad luck for now.
- $self->{main_thread_only}->{document}->editor->SetText( $self->{updated_document_string} );
- $self->{main_thread_only}->{document}->ppi_select( $self->{token_location} );
- } else {
- my $text;
- if ( $self->{error} =~ /no token/ ) {
- $text = Wx::gettext("Current cursor does not seem to point at a variable");
- } elsif ( $self->{error} =~ /no declaration/ ) {
- $text = Wx::gettext("No declaration could be found for the specified (lexical?) variable");
- } else {
- $text = Wx::gettext("Unknown error");
- }
- Wx::MessageBox(
- $text, Wx::gettext("Replace Operation Canceled"),
- Wx::wxOK, Padre->ide->wx->main
- );
- }
- return ();
-}
-
-1;
-
-__END__
-
-=head1 SEE ALSO
-
-This class inherits from C<Padre::Task::PPI>.
-
-=head1 AUTHOR
-
-Steffen Mueller C<smueller@cpan.org>
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright 2008-2010 The Padre development team as listed in Padre.pm.
-
-This program is free software; you can redistribute it and/or
-modify it under the same terms as Perl 5 itself.
-
-=cut
-
-# Copyright 2008-2010 The Padre development team as listed in Padre.pm.
-# LICENSE
-# This program is free software; you can redistribute it and/or
-# modify it under the same terms as Perl 5 itself.
@@ -3,10 +3,9 @@ package Padre::Task::PPI;
use 5.008;
use strict;
use warnings;
-use Padre::Task ();
-use Padre::Current ();
+use Padre::Task ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
our @ISA = 'Padre::Task';
=pod
@@ -17,37 +16,26 @@ Padre::Task::PPI - Generic L<PPI> background processing task
=head1 SYNOPSIS
- package Padre::Task::PPI::MyFancyTest;
+ package Padre::Task::MyFancyTest;
+
use base 'Padre::Task::PPI';
-
- # will be called after ppi-parsing:
- sub process_ppi {
- my $self = shift;
- my $ppi = shift or return;
- my $result = ...expensive_calculation_using_ppi...
- $self->{result} = $result;
- return();
- },
-
- sub finish {
- my $self = shift;
- my $result = $self->{result};
- # update GUI here...
- };
-
+
+ # Will be called after ppi-parsing:
+ sub process {
+ my $self = shift;
+ my $ppi = shift or return;
+ my $result = ...expensive_calculation_using_ppi...
+ $self->{result} = $result;
+ return;
+ }
+
1;
-
+
# elsewhere:
-
- # by default, the text of the current document
- # will be fetched.
- my $task = Padre::Task::PPI::MyFancyTest->new();
- $task->schedule;
-
- my $task2 = Padre::Task::PPI::MyFancyTest->new(
- text => 'parse-this!',
- );
- $task2->schedule;
+
+ Padre::Task::MyFancyTest->new(
+ text => 'parse-this!',
+ )->schedule;
=head1 DESCRIPTION
@@ -71,32 +59,21 @@ of a C<Padre::Task::PPI> object.
=cut
sub new {
- my $class = shift;
- my $self = $class->SUPER::new(@_);
- unless ( defined $self->{text} ) {
- my $doc = Padre::Current->document;
- return () if not defined $doc;
- $self->{text} = $doc->text_get;
+ my $self = shift->SUPER::new(@_);
+ if ( $self->{document} ) {
+ $self->{text} = delete( $self->{document} )->text_get;
}
- return bless $self => $class;
+ return $self;
}
sub run {
my $self = shift;
- require PPI;
+ my $text = delete $self->{text};
+
+ # Parse the document and hand off to the task
require PPI::Document;
- my $ppi = PPI::Document->new( \( $self->{text} ) );
- delete $self->{text};
- $self->process_ppi($ppi) if $self->can('process_ppi');
- return 1;
-}
+ $self->process( PPI::Document->new( \$text ) );
-sub prepare {
- my $self = shift;
- unless ( defined $self->{text} ) {
- require Carp;
- Carp::croak("Could not find the document's text for PPI parsing.");
- }
return 1;
}
@@ -0,0 +1,68 @@
+package Padre::Task::Syntax;
+
+use 5.008;
+use strict;
+use warnings;
+use Carp ();
+use Params::Util ('_INSTANCE');
+use Padre::Task ();
+
+our $VERSION = '0.66';
+our @ISA = 'Padre::Task';
+
+
+
+
+
+######################################################################
+# Constructor
+
+sub new {
+ my $self = shift->SUPER::new(@_);
+
+ # Just convert the document to text for now.
+ # Later, we'll suck in more data from the project and
+ # other related documents to do syntax checks more awesomely.
+ unless ( _INSTANCE( $self->{document}, 'Padre::Document' ) ) {
+ die "Failed to provide a document to the syntax check task";
+ }
+
+ # Remove the document entirely as we do this,
+ # as it won't be able to survive serialisation.
+ my $document = delete $self->{document};
+ $self->{text} = $document->text_get;
+ $self->{project} = $document->project->root;
+
+ return $self;
+}
+
+
+
+
+
+######################################################################
+# Padre::Task Methods
+
+sub run {
+ my $self = shift;
+
+ # Pull the text off the task so we won't need to serialize
+ # it back up to the parent Wx thread at the end of the task.
+ my $text = delete $self->{text};
+
+ # Get the function list
+ $self->{model} = $self->syntax($text);
+
+ return 1;
+}
+
+sub syntax {
+ return [];
+}
+
+1;
+
+# Copyright 2008-2010 The Padre development team as listed in Padre.pm.
+# LICENSE
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl 5 itself.
@@ -1,232 +0,0 @@
-package Padre::Task::SyntaxChecker::Perl;
-
-use 5.008;
-use strict;
-use warnings;
-use Padre::Perl ();
-use Padre::Constant ();
-use Padre::Task::SyntaxChecker ();
-
-our $VERSION = '0.63';
-our @ISA = 'Padre::Task::SyntaxChecker';
-
-use version;
-
-=pod
-
-=head1 NAME
-
-Padre::Task::SyntaxChecker::Perl - Perl document syntax-checking in the background
-
-=head1 SYNOPSIS
-
- # by default, the text of the current document
- # will be fetched as will the document's notebook page.
- my $task = Padre::Task::SyntaxChecker::Perl->new(
- newlines => "\r\n", # specify the newline type!
- );
- $task->schedule;
-
- my $task2 = Padre::Task::SyntaxChecker::Perl->new(
- text => Padre::Current->document->text_get,
- editor => Padre::Current->editor,
- on_finish => sub { my $task = shift; ... },
- newlines => "\r\n", # specify the newline type!
- );
- $task2->schedule;
-
-=head1 DESCRIPTION
-
-This class implements syntax checking of Perl documents in
-the background. It inherits from L<Padre::Task::SyntaxChecker>.
-Please read its documentation!
-
-=cut
-
-sub run {
- my $self = shift;
- $self->_check_syntax;
- return 1;
-}
-
-sub _check_syntax {
- my $self = shift;
-
- my $nlchar = $self->{newlines};
- $self->{text} =~ s/$nlchar/\n/g if defined $nlchar;
-
- # Execute the syntax check
- my $stderr = '';
- my $testfilename;
- SCOPE: {
-
- # Create a temporary file with the Perl text
- require File::Temp;
- my $file = File::Temp->new( UNLINK => 1 );
- binmode( $file, ":utf8" );
- $file->print( $self->{text} );
- $file->close;
- $testfilename = $file->filename;
-
- # Run with console Perl to prevent unexpected results under wperl
- my @cmd = (
- Padre::Perl::cperl(),
- );
-
- # Append Perl command line options
- if ( $self->{perl_cmd} ) {
- push @cmd, @{ $self->{perl_cmd} };
- }
-
- # Open a temporary file for standard error redirection
- my $err = File::Temp->new( UNLINK => 1 );
- $err->close;
-
- # Redirect perl's output to temporary file
- push @cmd,
- (
- '-Mdiagnostics',
- '-c',
- $file->filename,
- '2>' . $err->filename,
- );
-
- # We need shell redirection (list context does not give that)
- my $cmd = join ' ', @cmd;
-
- # Make sure we execute from the correct directory
- if (Padre::Constant::WIN32) {
- require Padre::Util::Win32;
- Padre::Util::Win32::ExecuteProcessAndWait(
- directory => $self->{cwd},
- file => 'cmd.exe',
- parameters => "/C $cmd",
- );
- } else {
- if ( $self->{cwd} ) {
- require File::pushd;
- my $pushd = File::pushd::pushd( $self->{cwd} );
- system $cmd;
- } else {
- system $cmd;
- }
- }
-
- # Slurp Perl's stderr
- open my $fh, '<', $err->filename or die $!;
- local $/ = undef;
- $stderr = <$fh>;
- close $fh;
-
- # and delete it
- unlink $err->filename;
- }
-
- # Don't really know where that comes from...
- my $i = index( $stderr, 'Uncaught exception from user code' );
- if ( $i > 0 ) {
- $stderr = substr( $stderr, 0, $i );
- }
-
- # Handle the "no errors or warnings" case
- if ( $stderr =~ /^\s+syntax OK\s+$/s ) {
- return [];
- }
-
- # Split into message paragraphs
- $stderr =~ s/\n\n/\n/go;
- $stderr =~ s/\n\s/\x1F /go;
- my @messages = split( /\n/, $stderr );
-
- my $issues = [];
- my @diag = ();
- foreach my $message (@messages) {
- if ( index( $message, 'has too many errors' ) > 0
- or index( $message, 'had compilation errors' ) > 0
- or index( $message, 'syntax OK' ) > 0 )
- {
- last;
- }
-
- my $cur = {};
- my $tmp = '';
-
- if ( $message =~ s/\s\(\#(\d+)\)\s*\Z//o ) {
- $cur->{diag} = $1 - 1;
- }
-
- if ( $message =~ m/\)\s*\Z/o ) {
- my $pos = rindex( $message, '(' );
- $tmp = substr( $message, $pos, length($message) - $pos, '' );
- }
-
- if ( $message =~ s/\s\(\#(\d+)\)(.+)//o ) {
- $cur->{diag} = $1 - 1;
- my $diagtext = $2;
- $diagtext =~ s/\x1F//go;
- push @diag, join( ' ', split( ' ', $diagtext ) );
- }
-
- if ( $message =~ s/\sat(?:\s|\x1F)+(.+?)(?:\s|\x1F)line(?:\s|\x1F)(\d+)//o ) {
- next if $1 ne $testfilename;
- $cur->{line} = $2;
- $cur->{msg} = $message;
- }
-
- if ($tmp) {
- $cur->{msg} .= "\n" . $tmp;
- }
-
- if ( defined $cur->{msg} ) {
- $cur->{msg} =~ s/\x1F/\n/go;
- }
-
- if ( defined $cur->{diag} ) {
- $cur->{desc} = $diag[ $cur->{diag} ];
- delete $cur->{diag};
- }
- if ( defined( $cur->{desc} )
- && $cur->{desc} =~ /^\s*\([WD]/o )
- {
- $cur->{severity} = 'W';
- } else {
- $cur->{severity} = 'E';
- }
- delete $cur->{desc};
-
- push @{$issues}, $cur;
- }
-
- $self->{syntax_check} = $issues;
-}
-
-1;
-
-__END__
-
-=head1 SEE ALSO
-
-This class inherits from L<Padre::Task::SyntaxChecker> which
-in turn is a L<Padre::Task> and its instances can be scheduled
-using L<Padre::TaskManager>.
-
-The transfer of the objects to and from the worker threads is implemented
-with L<Storable>.
-
-=head1 AUTHOR
-
-Steffen Mueller C<smueller@cpan.org>
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright 2008-2010 The Padre development team as listed in Padre.pm.
-
-This program is free software; you can redistribute it and/or
-modify it under the same terms as Perl 5 itself.
-
-=cut
-
-# Copyright 2008-2010 The Padre development team as listed in Padre.pm.
-# LICENSE
-# This program is free software; you can redistribute it and/or
-# modify it under the same terms as Perl 5 itself.
@@ -1,230 +0,0 @@
-package Padre::Task::SyntaxChecker;
-
-use 5.008;
-use strict;
-use warnings;
-use Carp ();
-use Params::Util (qw{_CODE _INSTANCE});
-use Padre::Task ();
-use Padre::Current ();
-use Padre::Wx ();
-
-our $VERSION = '0.63';
-our @ISA = 'Padre::Task';
-
-=pod
-
-=head1 NAME
-
-Padre::Task::SyntaxChecker - Generic syntax-checking background processing task
-
-=head1 SYNOPSIS
-
- package Padre::Task::SyntaxChecker::MyLanguage;
- use base 'Padre::Task::SyntaxChecker';
-
- sub run {
- my $self = shift;
- my $doc_text = $self->{text};
- # black magic here
- $self->{syntax_check} = ...;
- return 1;
- };
-
- 1;
-
- # elsewhere:
-
- # by default, the text of the current document
- # will be fetched as will the document's notebook page.
- my $task = Padre::Task::SyntaxChecker::MyLanguage->new();
- $task->schedule;
-
- my $task2 = Padre::Task::SyntaxChecker::MyLanguage->new(
- text => Padre::Current->document->text_get,
- editor => Padre::Current->editor,
- );
- $task2->schedule;
-
-=head1 DESCRIPTION
-
-This is a base class for all tasks that need to do
-expensive syntax checking in a background task.
-
-You can either let C<Padre::Task::SyntaxChecker> fetch the
-Perl code for parsing from the current document
-or specify it as the "C<text>" parameter to
-the constructor.
-
-To create a syntax checker for a given document type C<Foo>,
-you create a subclass C<Padre::Task::SyntaxChecker::Foo> and
-implement the C<run> method which uses the C<$self-E<gt>{text}>
-attribute of the task object for its nefarious syntax checking
-purposes and then stores the result in the C<$self-E<gt>{syntax_check}>
-attribute of the object. The result should be a data structure of the
-form defined in the documentation of the C<Padre::Document::check_syntax>
-method. See L<Padre::Document>.
-
-This base class implements all logic necessary to update the GUI
-with the syntax check results in a C<finish()> hook. If you want
-to implement your own C<finish()>, make sure to call C<$self-E<gt>SUPER::finish>
-for this reason.
-
-=cut
-
-sub new {
- my $class = shift;
- my $self = $class->SUPER::new(@_);
- unless ( defined $self->{text} ) {
- $self->{text} = Padre::Current->document->text_get;
- }
-
- # Put notebook page and callback into main-thread-only storage
- $self->{main_thread_only} ||= {};
- my $editor = $self->{editor} || $self->{main_thread_only}->{editor};
- my $on_finish = $self->{on_finish} || $self->{main_thread_only}->{on_finish};
- delete $self->{editor};
- delete $self->{on_finish};
- unless ( defined $editor ) {
- $editor = Padre::Current->editor;
- }
- return () if not defined $editor;
- $editor = Scalar::Util::refaddr($editor);
- $self->{main_thread_only}->{on_finish} = $on_finish if $on_finish;
- $self->{main_thread_only}->{editor} = $editor;
- return bless $self => $class;
-}
-
-sub run {
- my $self = shift;
- return 1;
-}
-
-sub prepare {
- my $self = shift;
- unless ( defined $self->{text} ) {
- Carp::croak("Could not find the document's text for syntax checking.");
- }
- unless ( defined $self->{main_thread_only}->{editor} ) {
- Carp::croak("Could not find the reference to the notebook page for GUI updating.");
- }
- return 1;
-}
-
-sub finish {
- my $self = shift;
- my $callback = $self->{main_thread_only}->{on_finish};
- if ( _CODE($callback) ) {
- $callback->($self);
- } else {
- $self->update_gui;
- }
-}
-
-sub update_gui {
- my $self = shift;
- my $messages = $self->{syntax_check};
- my $current = Padre::Current->new;
- my $main = $current->main;
- my $editor = $current->editor;
- my $syntax = $main->syntax;
- my $addr = delete $self->{main_thread_only}->{editor};
-
- if ( not $addr or not $editor or $addr ne Scalar::Util::refaddr($editor) ) {
-
- # Editor reference is not valid any more
- return 1;
- }
-
- # Clear out the existing stuff
- $syntax->clear;
-
- # If there are no errors, clear the synax checker pane and return.
- if ( ( !defined($messages) ) or ( $#{$messages} == -1 ) ) {
- my $idx = $syntax->InsertStringImageItem( 0, '', 2 );
- $syntax->SetItemData( $idx, 0 );
- $syntax->SetItem( $idx, 1, Wx::gettext('Info') );
-
- # Relative-to-the-project filename
- my $document = $current->document;
- if ( defined( $document->file ) ) { # check that the document has been saved
- my $filename = $document->file->{filename};
- if ( defined( $document->project_dir ) ) {
- my $project_dir = quotemeta $document->project_dir;
- $filename =~ s/^$project_dir//;
- }
- $syntax->SetItem( $idx, 2, sprintf( Wx::gettext('No errors or warnings found in %s.'), $filename ) );
- } else {
- $syntax->SetItem( $idx, 2, Wx::gettext('No errors or warnings found.') );
- }
- return;
- }
-
- # Update the syntax checker pane
- if ( scalar( @{$messages} ) > 0 ) {
- my $i = 0;
- delete $editor->{synchk_calltips};
- my $last_hint = '';
-
- # eliminate some warnings
- foreach my $m ( @{$messages} ) {
- $m->{line} = 0 unless defined $m->{line};
- $m->{msg} = '' unless defined $m->{msg};
- }
- foreach my $hint ( sort { $a->{line} <=> $b->{line} } @{$messages} ) {
- my $l = $hint->{line} - 1;
- if ( $hint->{severity} eq 'W' ) {
- $editor->MarkerAdd( $l, Padre::Wx::MarkWarn() );
- } else {
- $editor->MarkerAdd( $l, Padre::Wx::MarkError() );
- }
- my $idx = $syntax->InsertStringImageItem( $i++, $l + 1, ( $hint->{severity} eq 'W' ? 1 : 0 ) );
- $syntax->SetItemData( $idx, 0 );
- $syntax->SetItem( $idx, 1, ( $hint->{severity} eq 'W' ? Wx::gettext('Warning') : Wx::gettext('Error') ) );
- $syntax->SetItem( $idx, 2, $hint->{msg} );
-
- if ( exists $editor->{synchk_calltips}->{$l} ) {
- $editor->{synchk_calltips}->{$l} .= "\n--\n" . $hint->{msg};
- } else {
- $editor->{synchk_calltips}->{$l} = $hint->{msg};
- }
- $last_hint = $hint;
- }
-
- $syntax->set_column_widths($last_hint);
- }
-
- return 1;
-}
-
-1;
-
-__END__
-
-=pod
-
-=head1 SEE ALSO
-
-This class inherits from C<Padre::Task> and its instances can be scheduled
-using C<Padre::TaskManager>.
-
-The transfer of the objects to and from the worker threads is implemented
-with L<Storable>.
-
-=head1 AUTHOR
-
-Steffen Mueller C<smueller@cpan.org>
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright 2008-2010 The Padre development team as listed in Padre.pm.
-
-This program is free software; you can redistribute it and/or
-modify it under the same terms as Perl 5 itself.
-
-=cut
-
-# Copyright 2008-2010 The Padre development team as listed in Padre.pm.
-# LICENSE
-# This program is free software; you can redistribute it and/or
-# modify it under the same terms as Perl 5 itself.
@@ -1,584 +1,134 @@
package Padre::Task;
-=pod
-
-=head1 NAME
-
-Padre::Task - Padre Background Task API
-
-=head1 SYNOPSIS
-
-Create a subclass of Padre::Task which implements your background
-task:
-
- package Padre::Task::Foo;
-
- use base 'Padre::Task';
-
- # This is run in the main thread before being handed
- # off to a worker (background) thread. The Wx GUI can be
- # polled for information here.
- # If you don't need it, just inherit the default no-op.
- sub prepare {
- my $self = shift;
- if ( condition_for_not_running_the_task ) {
- return "BREAK";
- }
-
- return 1;
- }
-
- # This is run in a worker thread and may take a long-ish
- # time to finish. It must not touch the GUI, except through
- # Wx events. TO DO: explain how this works
- sub run {
- my $self = shift;
- # Do something that takes a long time!
- # optionally print to the output window
- $self->print("Background thread says hi!\n");
- return 1;
- }
-
- # This is run in the main thread after the task is done.
- # It can update the GUI and do cleanup.
- # You don't have to implement this if you don't need it.
- sub finish {
- my $self = shift;
- my $main = shift;
- # cleanup!
- return 1;
- }
-
- 1;
-
-From your code, you can then use this new background task class as
-follows. (C<new> and C<schedule> are inherited.)
-
- require Padre::Task::Foo;
- my $task = Padre::Task::Foo->new(some => 'data');
- $task->schedule; # hand off to the task manager
-
-As a special case, any (arbitrarily nested and complex) data
-structure you put into your object under
-the magic C<main_thread_only> hash slot will not be passed
-to the worker thread but become available again when C<finish>
-is called in the main thread. You can use this to pass references
-to GUI objects and similar things to the finish event handler
-since these must not be accessed from worker threads.
-
-However, you should be cautious when keeping references to GUI
-elements in your tasks, in case the GUI wants to destroy them
-before your task returns.
-
-Instead, it is better if your C<finish> method knows how to
-relocate the GUI element from scratch (and can safely handle
-the situation when the GUI element is gone, or has changed enough
-to make the task response irrelevent).
-
-=head1 DESCRIPTION
-
-This is the base class of all background operations in Padre.
-The SYNOPSIS explains the basic usage, but in a nutshell, you create a
-subclass, implement your own custom C<run> method, create a new instance,
-and call C<schedule> on it to run it in a worker thread. When the scheduler
-has a free worker thread for your task, the following steps happen:
-
-=over 2
-
-=item The scheduler calls C<prepare> on your object.
-
-=item If your prepare method returns the string 'break', all further processing
-is stopped immediately.
-
-=item The scheduler serializes your object with C<Storable>.
-
-=item Your object is handed to the worker thread.
-
-=item The thread deserializes the task object and calls C<run()> on it.
-
-=item After C<run()> is done, the thread serializes the object again
-and hands it back to the main thread.
-
-=item In the main thread, the scheduler calls C<finish> on your
-object with the Padre main window object as argument for cleanup.
-
-=back
-
-During all this time, the state of your task object is retained!
-So anything you store in the task object while in the worker thread
-is still there when C<finish> runs in the main thread. (Confer the
-CAVEATS section below!)
-
-=head1 METHODS
-
-=cut
-
-use 5.008;
+use 5.008005;
use strict;
use warnings;
-use Storable ();
-use IO::Handle ();
-use IO::String ();
-use Scalar::Util ();
-use Params::Util '_INSTANCE';
-
-our $VERSION = '0.63';
-
-# set up the stdout/stderr printing events => initialized during run time
-our $STDOUT_EVENT : shared;
-our $STDERR_EVENT : shared;
-
-# TO DO: Why are these require?
-require Padre;
-require Padre::Wx;
-require Wx;
-
-BEGIN {
-
- # Hack IO::String to be a real IO::Handle
- unless ( IO::String->isa('IO::Handle') ) {
- @IO::String::ISA = qw{IO::Handle IO::Seekable};
- }
-}
-
-=pod
-
-=head2 new
-
-C<Padre::Task> provides a basic constructor for you to
-inherit. It simply stores all provided data in the internal
-hash reference.
+use Storable ();
+use Scalar::Util ();
+use Params::Util ();
+use Padre::Current ();
+use Padre::Role::Task ();
-=cut
+our $VERSION = '0.66';
sub new {
my $class = shift;
- my $self = bless {@_} => $class;
- if ( not defined $STDOUT_EVENT ) {
- $STDOUT_EVENT = Wx::NewEventType();
- $STDERR_EVENT = Wx::NewEventType();
- }
- return $self;
-}
-
-=head2 schedule
-
-C<Padre::Task> implements the scheduling logic for your
-subclass. Simply call the C<schedule> method to have your task
-processed by the task manager.
-
-Calling this multiple times will submit multiple jobs.
+ my $self = bless {@_}, $class;
-=cut
-
-SCOPE: {
- my $event_hooks_initialized = 0;
-
- sub schedule {
- my $self = shift;
- if ( not $event_hooks_initialized ) {
- $event_hooks_initialized = 1;
- my $main = Padre->ide->wx;
- Wx::Event::EVT_COMMAND(
- $main,
- -1,
- $STDOUT_EVENT,
- \&_on_stdout,
- );
- Wx::Event::EVT_COMMAND(
- $main,
- -1,
- $STDERR_EVENT,
- \&_on_stderr,
- );
+ # Check parameters for the object that owns the task
+ if ( exists $self->{owner} ) {
+ if ( exists $self->{callback} ) {
+ unless ( Params::Util::_IDENTIFIER( $self->{callback} ) ) {
+ die "Task 'callback' must be a method name";
+ }
}
- Padre->ide->task_manager->schedule($self);
+ my $callback = $self->callback;
+ unless ( $self->{owner}->can($callback) ) {
+ die "Task callback '$callback' is not defined";
+ }
+ $self->{owner} = $self->{owner}->task_revision;
}
-}
-=pod
-
-=head2 run
+ return $self;
+}
-This is the method that will be called in the worker thread.
-You must implement this in your subclass.
+sub handle {
+ $_[0]->{handle};
+}
-You must not interact with the Wx GUI directly from the
-worker thread. You may use Wx thread events only.
-TO DO: Experiment with this and document it.
+sub running {
+ defined $_[0]->{handle};
+}
-=cut
+sub owner {
+ Padre::Role::Task->task_owner( $_[0]->{owner} );
+}
-sub run {
- my $self = shift;
- warn "This is Padre::Task->run(); Somebody didn't implement his background task's run() method!";
- return 1;
+sub callback {
+ $_[0]->{callback} || 'task_response';
}
-=pod
-=head2 prepare
-In case you need to set up things in the main thread,
-you can implement a C<prepare> method which will be called
-right before serialization for transfer to the assigned
-worker thread.
-If C<prepare> returns the string C<break> (case insensitive),
-all further processing of the task will be stopped and neither
-C<run> nor C<finish> will be called. Any other return values
-are generally ignored.
-You do not have to implement this method in the subclass.
+######################################################################
+# Task API - Based on Process.pm
-=cut
+# Send the task to the task manager to be executed
+sub schedule {
+ Padre::Current->ide->task_manager->schedule(@_);
+}
+# Called in the parent thread immediately before being passed
+# to the worker thread. This method should compensate for
+# potential time difference between when C<new> is original
+# called, and when the Task is actually run.
+# Returns true if the task should continue and be run.
+# Returns false if the task is irrelevant and should be aborted.
sub prepare {
return 1;
}
-=pod
-
-=head2 finish
-
-Quite likely, you need to actually use the results of your
-background task somehow. Since you cannot directly
-communicate with the Wx GUI from the worker thread,
-this method is called from the main thread after the
-task object has been transferred back to the main thread.
-
-The first and only argument to C<finish> is the Padre
-main window object.
-
-You do not have to implement this method in the subclass.
+# Called in the worker thread, and should continue the main body
+# of code that needs to run in the background.
+# Variables saved to the object in the C<prepare> method will be
+# available in the C<run> method.
+sub run {
+ my $self = shift;
-=cut
+ # If we have an owner, and it has moved on to a different state
+ # while we have been waiting to be executed abort the run.
+ if ( $self->{owner} ) {
+ $self->owner or return 0;
+ }
-sub finish {
return 1;
}
-# Scope for main thread data storage
-SCOPE: {
- my %MainThreadData;
-
- # this will serialize the object and do some magic as it happens
- # This is an INTERNAL method and subject to change
- sub serialize {
- my $self = shift;
-
- # The idea is to store the actual class of the object
- # in the object itself for serialization. It's not as bad as
- # it sounds. It just requires two things from the subclasses:
- # - The subclasses cannot override "deserialize" and thus
- # probably not "serialize" either. But that shouldn't be
- # a huge deal as there are the "prepare" and "finish" hooks
- # for the user.
- # - The subclasses must not use the "_process_class" slot
- # of the object. (Ohh...)
-
- # save the real object class for deserialization
- my $class = ref($self);
- if ( exists $self->{_process_class} ) {
- require Carp;
- Carp::croak(
- "The '_process_class' slot in a Padre::Task" . " object is reserved for usage by Padre::Task" );
- }
-
- $self->{_process_class} = $class;
-
- my $save_main_thread_data = ( threads->tid() == 0 and exists $self->{main_thread_only} );
- if ($save_main_thread_data) {
- my $id = "$self";
- $id .= '_' while exists $MainThreadData{$id};
- $MainThreadData{$id} = $self->{main_thread_only};
- $self->{_main_thread_data_id} = $id;
- delete $self->{main_thread_only};
- }
-
- # remove pesky dependency by explicitly
- # blessing into Padre::Task
- bless $self => 'Padre::Task';
-
- my $ret = $self->_serialize(@_);
-
- # cleanup
- delete $self->{_process_class};
- if ($save_main_thread_data) {
- $self->{main_thread_only} = $MainThreadData{ $self->{_main_thread_data_id} };
- delete $self->{_main_thread_data_id};
- }
- bless $self => $class;
-
- return $ret;
- }
-
- # this will deserialize the object and do some magic as it happens
- # This is an INTERNAL method and subject to change
- sub deserialize {
- my $class = shift;
-
- my $padretask = Padre::Task->_deserialize(@_);
- my $userclass = $padretask->{_process_class};
- delete $padretask->{_process_class};
-
- no strict 'refs';
- my $ref = \%{"${userclass}::"};
- use strict 'refs';
- my $loaded = exists $ref->{"ISA"};
- unless ( $loaded or eval("require $userclass;") ) {
- require Carp;
- if ($@) {
- Carp::croak("Failed to load Padre::Task subclass '$userclass': $@");
- } else {
- Carp::croak("Failed to load Padre::Task subclass '$userclass': It did not return a true value.");
- }
- }
-
- # restore the main-thread-only data in the task
- if ( threads->tid == 0 and exists $padretask->{_main_thread_data_id} ) {
- my $id = $padretask->{_main_thread_data_id};
- $padretask->{main_thread_only} = $MainThreadData{$id};
- delete $padretask->{_main_thread_data_id};
- delete $MainThreadData{$id};
- }
-
- my $obj = bless $padretask => $userclass;
-
- # Xtra evil , let a subclass ducktype a hook here
- $obj->deserialize_hook if $obj->can('deserialize_hook');
-
- return $obj;
+# Called in the parent thread immediately after the task has
+# completed and been passed back to the parent.
+# Variables saved to the object in the C<run> method will be
+# available in the C<finish> method.
+# The object may be destroyed at any time after this method
+# has been completed.
+sub finish {
+ my $self = shift;
+ if ( $self->{owner} ) {
+ my $owner = $self->owner or return;
+ my $callback = $self->callback;
+ $owner->$callback($self);
}
+ return 1;
}
-# old Process::Storable internals
-sub _serialize {
- my $self = shift;
- # Serialize to a named file (locking it)
- if ( defined $_[0] and !ref $_[0] and length $_[0] ) {
- return Storable::lock_nstore( $self, shift );
- }
- # Serialize to a string (via a handle)
- if ( Params::Util::_SCALAR0( $_[0] ) ) {
- my $string = shift;
- $$string = 'pst0' . Storable::nfreeze($self);
- return 1;
- }
- # Serialize to a generic handle
- if ( defined fileno( $_[0] ) ) {
- local $/ = undef;
- return Storable::nstore_fd( $self, shift );
- }
- # Serialize to an IO::Handle object
- if ( Params::Util::_INSTANCE( $_[0], 'IO::Handle' ) ) {
- my $string = Storable::nfreeze($self);
- my $iohandle = shift;
- $iohandle->print('pst0') or return;
- $iohandle->print($string) or return;
- return 1;
- }
+######################################################################
+# Serialization - Based on Process::Serializable and Process::Storable
- # We don't support anything else
- undef;
+# my $string = $task->as_string;
+sub as_string {
+ Storable::nfreeze( $_[0] );
}
-# old Process::Storable internals
-sub _deserialize {
+# my $task = Class::Name->from_string($string);
+sub from_string {
my $class = shift;
+ my $self = Storable::thaw( $_[0] );
+ unless ( Scalar::Util::blessed($self) eq $class ) {
- # Serialize from a named file (locking it)
- if ( defined $_[0] and !ref $_[0] and length $_[0] ) {
- return Storable::lock_retrieve(shift);
+ # Because this is an internal API we can be brutally
+ # unforgiving is we aren't use the right way.
+ die("Task unexpectedly did not deserialize as a $class");
}
-
- # Serialize from a string (via a handle)
- if ( Params::Util::_SCALAR0( $_[0] ) ) {
- my $string = shift;
-
- # Remove the magic header if it exists
- if ( substr( $$string, 0, 4 ) eq 'pst0' ) {
- substr( $$string, 0, 4, '' );
- }
-
- return Storable::thaw($$string);
- }
-
- # Serialize from a generic handle
- if ( defined fileno( $_[0] ) ) {
- return Storable::retrieve_fd(shift);
- }
-
- # Serialize from an IO::Handle object
- if ( Params::Util::_INSTANCE( $_[0], 'IO::Handle' ) ) {
- local $/ = undef;
- my $string = $_[0]->getline;
-
- # Remove the magic header if it exists
- if ( substr( $string, 0, 4 ) eq 'pst0' ) {
- substr( $string, 0, 4, '' );
- }
-
- return Storable::thaw($string);
- }
-
- # We don't support anything else
- undef;
-}
-
-# The main-thread stdout hook
-sub _on_stdout {
- my ( $wx, $event ) = @_;
- @_ = (); # hack to avoid "Scalars leaked"
- my $main = $wx->main;
- my $out = $main->output();
- $main->show_output(1);
- $out->style_neutral();
- $out->AppendText( $event->GetData );
- return ();
-}
-
-# The main-thread stderr hook
-sub _on_stderr {
- my ( $wx, $event ) = @_;
- @_ = (); # hack to avoid "Scalars leaked"
- my $main = $wx->main;
- my $out = $main->output();
- $main->show_output(1);
- $out->style_bad();
- $out->AppendText( $event->GetData );
- $out->style_neutral();
- return ();
-}
-
-=pod
-
-=head2 task_print
-
- $task->task_print("Hi this is immediately sent to the Padre output window\n");
-
-Sends an event to the main Padre thread and displays a
-message in the Padre output window.
-
-=cut
-
-sub task_print {
- my $self = shift;
- $self->post_event( $STDOUT_EVENT, join( "", @_ ) );
- return ();
-}
-
-=pod
-
-=head2 task_warn
-
- $task->task_warn("Hi this is immediately sent to the Padre output window\n");
-
-Sends an event to the main Padre thread and displays a
-message in the Padre output window with style C<bad>.
-
-=cut
-
-sub task_warn {
- my $self = shift;
- $self->post_event( $STDERR_EVENT, join( "", @_ ) );
- return ();
-}
-
-=pod
-
-=head2 post_event
-
-This method allows you to easily post a Wx event to the main
-thread. First argument must be the event ID, second argument
-the data you want to pass to the event handler.
-
-For a complete example, please check the code of
-C<Padre::Task::Example::WxEvent>.
-
-You can set up a new event ID in your Padre::Task subclass
-like this:
-
- our $FUN_EVENT_TYPE : shared;
- BEGIN { $FUN_EVENT_TYPE = Wx::NewEventType(); }
-
-Then you have to setup the event handler (for example in the
-C<prepare()> method. This should happen in the main thread!
-
-But watch out: You should not declare the same
-handler multiple times.
-
- Wx::Event::EVT_COMMAND(
- Padre->ide->wx->main,
- -1,
- $FUN_EVENT,
- \&update_gui_with_fun
- );
-
- sub update_gui_with_fun {
- my ($main, $event) = @_; @_=(); # hack to avoid "Scalars leaked"
- my $data = $event->GetData();
- }
-
-After that, you can dispatch events of type C<$FUN_EVENT_TYPE>
-by simply running:
-
- $self->post_event($FUN_EVENT_TYPE, $data);
-
-=cut
-
-use Carp qw( cluck );
-
-sub post_event {
- my ( $self, $eventid, $data ) = @_;
- @_ = ();
- cluck 'eventid is not defined' unless defined $eventid;
- cluck "eventid[$eventid] , no data to post"
- unless ( defined $data and length($data) );
-
- Wx::PostEvent(
- Padre->ide->wx,
- Wx::PlThreadEvent->new( -1, $eventid, $data ),
- );
- return ();
+ return $self;
}
1;
-=pod
-
-=head1 NOTES AND CAVEATS
-
-Since the task objects are transferred to the worker threads via
-C<Storable::freeze()> / C<Storable::thaw()>, you cannot put any data
-into the objects that cannot be serialized by C<Storable>. I<To the best
-of my knowledge>, that includes file handles and code references.
-
-=head1 SEE ALSO
-
-The management of worker threads is implemented in the L<Padre::TaskManager>
-class.
-
-The transfer of the objects to and from the worker threads is implemented
-with L<Storable>.
-
-=head1 AUTHOR
-
-Steffen Mueller C<smueller@cpan.org>
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright 2008-2010 The Padre development team as listed in Padre.pm.
-
-This program is free software; you can redistribute it and/or
-modify it under the same terms as Perl 5 itself.
-
-=cut
-
# Copyright 2008-2010 The Padre development team as listed in Padre.pm.
# LICENSE
# This program is free software; you can redistribute it and/or
@@ -0,0 +1,221 @@
+package Padre::TaskHandle;
+
+use 5.008005;
+use strict;
+use warnings;
+use threads;
+use threads::shared;
+use Thread::Queue 2.11;
+use Scalar::Util ();
+use Storable ();
+use Padre::Wx::Role::Conduit ();
+use Padre::Logger;
+
+our $VERSION = '0.66';
+our $SEQUENCE = 0;
+
+
+
+
+
+######################################################################
+# Constructor and Accessors
+
+sub new {
+ TRACE( $_[0] ) if DEBUG;
+ bless {
+ hid => ++$SEQUENCE,
+ task => $_[1],
+ },
+ $_[0];
+}
+
+sub hid {
+ TRACE( $_[0] ) if DEBUG;
+ $_[0]->{hid};
+}
+
+sub task {
+ TRACE( $_[0] ) if DEBUG;
+ $_[0]->{task};
+}
+
+
+
+
+
+######################################################################
+# Parent Methods
+
+sub prepare {
+ TRACE( $_[0] ) if DEBUG;
+ my $self = shift;
+ my $task = $self->{task};
+ my $rv = eval { $task->prepare; };
+ if ($@) {
+ TRACE("Exception in task during 'prepare': $@") if DEBUG;
+ return !1;
+ }
+ return !!$rv;
+}
+
+sub finish {
+ TRACE( $_[0] ) if DEBUG;
+ my $self = shift;
+ my $task = $self->{task};
+ my $rv = eval { $task->finish; };
+ if ($@) {
+ TRACE("Exception in task during 'finish': $@") if DEBUG;
+ return !1;
+ }
+ return !!$rv;
+}
+
+
+
+
+
+######################################################################
+# Worker Methods
+
+sub run {
+ TRACE( $_[0] ) if DEBUG;
+ my $self = shift;
+ my $task = $self->task;
+
+ # Create a circular reference back from the task
+ $task->{handle} = $self;
+
+ # Call the task's run method
+ eval { $task->run(); };
+
+ # Clean up the circular
+ delete $task->{handle};
+
+ # Save the exception if thrown
+ if ($@) {
+ TRACE("Exception in task during 'run': $@") if DEBUG;
+ $self->{exception} = $@;
+ return !1;
+ }
+
+ return 1;
+}
+
+
+
+
+
+######################################################################
+# Message Passing
+
+sub as_array {
+ TRACE( $_[0] ) if DEBUG;
+ my $self = shift;
+ my $task = $self->task;
+ return [
+ $self->hid,
+ Scalar::Util::blessed($task),
+ $task->as_string,
+ ];
+}
+
+sub from_array {
+ TRACE( $_[0] ) if DEBUG;
+ my $class = shift;
+ my $array = shift;
+
+ # Load the task class first so we can deserialize
+ TRACE("$class: Loading $array->[1]") if DEBUG;
+ eval "require $array->[1];";
+ die $@ if $@;
+
+ return bless {
+ hid => $array->[0] + 0,
+ task => $array->[1]->from_string( $array->[2] ),
+ }, $class;
+}
+
+# Serialize and pass-through to the Wx signal dispatch
+sub message {
+ TRACE( $_[0] ) if DEBUG;
+ Padre::Wx::Role::Conduit->signal( Storable::freeze( [ shift->hid, @_ ] ) );
+}
+
+sub on_message {
+ TRACE( $_[0] ) if DEBUG;
+ my $self = shift;
+ my $method = shift;
+
+ # Does the method exist
+ unless ( $self->{task}->can($method) ) {
+
+ # A method name provided directly by the Task
+ # doesn't exist in the Task. Naughty Task!!!
+ # Lacking anything more sane to do, squelch it.
+ return;
+ }
+
+ # Pass the call down to the task and protect it from itself
+ local $@;
+ eval { $self->{task}->$method(@_); };
+ if ($@) {
+
+ # A method in the main thread blew up.
+ # Beyond catching it and preventing it killing
+ # Padre entirely, I'm not sure what else we can
+ # really do about it at this point.
+ return;
+ }
+
+ return;
+}
+
+# Task startup handling
+sub started {
+ TRACE( $_[0] ) if DEBUG;
+ $_[0]->message('STARTED');
+}
+
+# There is no on_stopped atm... not sure if it's needed.
+# sub on_started { ... }
+
+# Task shutdown handling
+sub stopped {
+ TRACE( $_[0] ) if DEBUG;
+ $_[0]->message( 'STOPPED', $_[0]->{task} );
+}
+
+sub on_stopped {
+ TRACE( $_[0] ) if DEBUG;
+ my $self = shift;
+
+ # The first parameter is the updated Task object.
+ # Replace all content in the stored version with that from the
+ # event-provided version.
+ my $new = shift;
+ my $task = $self->{task};
+ %$task = %$new;
+ %$new = ();
+
+ # Execute the finish method in the updated Task object
+ local $@;
+ eval { $self->{task}->finish; };
+ if ($@) {
+
+ # A method in the main thread blew up.
+ # Beyond catching it and preventing it killing
+ # Padre entirely, I'm not sure what else we can
+ # really do about it at this point.
+ return;
+ }
+
+ return;
+}
+
+1;
+
+# Copyright 2008-2010 The Padre development team as listed in Padre.pm.
+# LICENSE
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl 5 itself.
@@ -1,693 +1,264 @@
package Padre::TaskManager;
-=pod
-
-=head1 NAME
-
-Padre::TaskManager - Padre Background Task Scheduler
-
-=head1 SYNOPSIS
-
- require Padre::Task::Foo;
- my $task = Padre::Task::Foo->new(some => 'data');
- $task->schedule; # handed off to the task manager
-
-=head1 DESCRIPTION
-
-Padre uses threads for asynchronous background operations
-which may take so long that they would make the GUI unresponsive
-if run in the main (GUI) thread.
-
-This class implements a pool of a configurable number of
-re-usable worker threads. Re-using threads is necessary as
-the overhead of spawning threads is high. Additional threads
-are spawned if many background tasks are scheduled for execution.
-When the load goes down, the number of extra threads is (slowly!)
-reduced down to the default.
-
-=head1 INTERFACE
-
-=head2 Class Methods
-
-=head3 C<new>
-
-The constructor returns a C<Padre::TaskManager> object.
-At the moment, C<Padre::TaskManager> is a singleton.
-An object is instantiated when the editor object is created.
-
-Optional parameters:
-
-=over 2
-
-=item min_no_workers / max_no_workers
-
-Set the minimum and maximum number of worker threads
-to spawn. Default: 1 to 3
-
-The first workers are spawned lazily: I.e. only when
-the first task is being scheduled.
-
-=item use_threads
-
-Disable for profiling runs. In the degraded, thread-less mode,
-all tasks are run in the main thread. Default: 1 (use threads)
-
-=item reap_interval
-
-The number of milliseconds to wait before checking for dead
-worker threads. Default: 15000ms
-
-=back
-
-=cut
-
-use 5.008;
+use 5.008005;
use strict;
use warnings;
-use Params::Util ();
-
-our $VERSION = '0.63';
-
-# According to Wx docs,
-# this MUST be loaded before Wx,
-# so this also happens in the script.
-use threads;
-use threads::shared;
-use Thread::Queue 2.11;
-use Time::HiRes qw(gettimeofday tv_interval);
-
-require Padre;
-use Padre::Task ();
-use Padre::Service ();
-use Padre::Wx ();
+use Params::Util ();
+use Padre::TaskHandle ();
+use Padre::TaskThread ();
+use Padre::TaskWorker ();
+use Padre::Wx ();
+use Padre::Wx::Role::Conduit ();
use Padre::Logger;
-require Padre::SlaveDriver;
-
-use Class::XSAccessor {
- getters => {
- task_queue => 'task_queue',
- reap_interval => 'reap_interval',
- use_threads => 'use_threads',
- max_no_workers => 'max_no_workers',
- }
-};
-# This event is triggered by a worker thread DURING ->run to incrementally
-# communicate to the main thread over the life of a service.
-our $SERVICE_POLL_EVENT : shared;
+our $VERSION = '0.66';
+
+# Set up the primary integration event
+our $THREAD_SIGNAL : shared;
BEGIN {
- $SERVICE_POLL_EVENT = Wx::NewEventType;
+ $THREAD_SIGNAL = Wx::NewEventType();
}
-# remember whether the event handlers were initialized...
-our $EVENTS_INITIALIZED = 0;
-
-# Timer to reap dead workers every N milliseconds
-our $REAP_TIMER;
-
-# You can instantiate this class only once.
-our $SINGLETON;
-
sub new {
- my $class = shift;
-
- return $SINGLETON if defined $SINGLETON;
-
- my $driver = Padre::SlaveDriver->new;
-
- my $self = $SINGLETON = bless {
- min_no_workers => 2, # there were config settings for
- max_no_workers => 6, # these long ago?
- use_threads => 1, # can be explicitly disabled
- reap_interval => 15000,
- @_,
- workers => [],
-
- # Grab a copy of the task_queue that's now handled by the slave driver
- task_queue => $driver->task_queue,
- running_tasks => {},
+ TRACE( $_[0] ) if DEBUG;
+ my $class = shift;
+ my %param = @_;
+ my $conduit = delete $param{conduit};
+ my $self = bless {
+ active => 0, # Are we running at the moment
+ threads => 1, # Are threads enabled
+ minimum => 2, # Workers to launch at startup
+ %param,
+ workers => [], # List of all workers
+ handles => {}, # Handles for all active tasks
+ running => {}, # Mapping from tid back to parent handle
+ queue => [], # Pending tasks to run in FIFO order
}, $class;
- # Special case for profiling mode
- if ( defined( $INC{"Devel/NYTProf.pm"} ) ) {
- $self->{use_threads} = 0;
+ # Do the initialisation needed for the event conduit
+ unless ( Params::Util::_INSTANCE( $conduit, 'Padre::Wx::Role::Conduit' ) ) {
+ die("Failed to provide an event conduit for the TaskManager");
}
-
- my $main = Padre->ide->wx;
- _init_events($main);
-
- # To be removed: Old task queue instantiation => Padre::SlaveDriver
- #$self->{task_queue} = Thread::Queue->new;
-
- # Set up a regular action for reaping dead workers
- # and setting up new workers
- if ( not defined $REAP_TIMER and $self->use_threads ) {
-
- # explicit id necessary to distinguish from start-up timer of the main window
- my $timerid = Wx::NewId();
- $REAP_TIMER = Wx::Timer->new( $main, $timerid );
- Wx::Event::EVT_TIMER(
- $main, $timerid,
- sub {
- $SINGLETON->reap;
- },
- );
- $REAP_TIMER->Start(
- $self->reap_interval,
- Wx::wxTIMER_CONTINUOUS,
- );
- }
-
- # if ( not defined $SERVICE_TIMER and $self->use_threads ) {
- # my $timer ;
- # }
+ $conduit->conduit_init($self);
return $self;
}
-# This is separated out to its own routine in order to
-# squash the "Scalars Leaked" warning (or at least one of them).
-# Previously, the warning pointed to the "my $main = ..." line.
-# This move of the event setup was a wild guess that changing the
-# scope might help. --Steffen
-sub _init_events {
- my $main = shift;
- @_ = ();
- unless ($EVENTS_INITIALIZED) {
- no warnings 'once';
- Wx::Event::EVT_COMMAND(
- $main, -1,
- $Padre::SlaveDriver::TASK_DONE_EVENT,
- \&on_task_done_event,
- );
- Wx::Event::EVT_COMMAND(
- $main, -1,
- $Padre::SlaveDriver::TASK_START_EVENT,
- \&on_task_start_event,
- );
- Wx::Event::EVT_COMMAND(
- $main, -1,
- $SERVICE_POLL_EVENT,
- \&on_service_poll_event,
- );
- $EVENTS_INITIALIZED = 1;
- }
+sub active {
+ TRACE( $_[0] ) if DEBUG;
+ $_[0]->{active};
}
-=pod
-
-=head2 Instance Methods
-
-=head3 C<schedule>
-
-Given a C<Padre::Task> instance (or rather an instance of a subclass),
-schedule that task for execution in a worker thread.
-If you call the C<schedule> method of the task object, it will
-proxy to this method for convenience.
+sub threads {
+ TRACE( $_[0] ) if DEBUG;
+ $_[0]->{threads};
+}
-=cut
+sub minimum {
+ TRACE( $_[0] ) if DEBUG;
+ $_[0]->{minimum};
+}
-sub schedule {
+sub start {
+ TRACE( $_[0] ) if DEBUG;
my $self = shift;
- my $task = Params::Util::_INSTANCE( shift, 'Padre::Task' )
- or die "Invalid task scheduled!"; # TO DO: grace
-
- if ( Params::Util::_INSTANCE( $task, 'Padre::Service' ) ) {
- $self->{running_services}{$task} = $task;
- }
-
- # Cleanup old threads and refill the pool
- $self->reap();
-
- # Prepare and stop if vetoes
- my $return = $task->prepare();
- if ( $return and $return =~ /^break$/i ) {
- return;
- }
-
- my $string;
- $task->serialize( \$string );
-
- if ( $self->use_threads ) {
- require Time::HiRes;
-
- # This is to make sure we don't indefinitely fill the
- # queue if the CPU can't keep up. If it REALLY can't
- # keep up, we *want* to block eventually.
- # For now, the limit has been set to 5*NWORKERTHREADS
- # which should be a lot.
- while ( $self->task_queue->pending > 5 * $self->{max_no_workers} ) {
-
- # Sleep 10msec
- Time::HiRes::usleep(10000);
- }
- $self->task_queue->enqueue($string);
-
- } else {
-
- # TO DO: Instead of this hack, consider
- # "reimplementing" the worker loop
- # as a non-threading, non-queued, fake worker loop
- $self->task_queue->enqueue($string);
- $self->task_queue->enqueue("STOP");
- require Padre::SlaveDriver;
- no warnings 'once';
- if ( not defined $Padre::SlaveDriver::TASK_DONE_EVENT ) {
- Padre::SlaveDriver->_init_events();
+ if ( $self->{threads} ) {
+ foreach ( 0 .. $self->{minimum} - 1 ) {
+ $self->start_thread($_);
}
- Padre::SlaveDriver::_worker_loop( $self->task_queue );
}
-
- return 1;
+ $self->{active} = 1;
+ $self->step;
}
-=pod
-
-=head3 C<setup_workers>
-
-Create more workers if necessary. Called by C<reap> which
-is called regularly by the reap timer, so users don't
-typically need to call this.
-
-=cut
-
-sub setup_workers {
- my $self = shift;
- @_ = (); # Avoid "Scalars leaked"
-
- return unless $self->use_threads;
-
- my $main = Padre->ide->wx->main;
-
- # Ensure minimum no. workers
- my $workers = $self->{workers};
- while ( @$workers < $self->{min_no_workers} ) {
- $self->_make_worker_thread($main);
- }
-
- # Add workers to satisfy demand
- my $jobs_pending = $self->task_queue->pending();
- if ( @$workers < $self->{max_no_workers} and $jobs_pending > 2 * @$workers ) {
- my $target = int( $jobs_pending / 2 );
- $target = $self->{max_no_workers} if $target > $self->{max_no_workers};
- $self->_make_worker_thread($main) for 1 .. ( $target - @$workers );
- }
-
+sub start_thread {
+ TRACE( $_[0] ) if DEBUG;
+ my $self = shift;
+ my $master = Padre::TaskThread->master;
+ my $worker = Padre::TaskWorker->new->spawn;
+ $self->{workers}->[ $_[0] ] = $worker;
return 1;
}
-# short method to create a new thread
-sub _make_worker_thread {
+sub stop {
+ TRACE( $_[0] ) if DEBUG;
my $self = shift;
- my $main = shift;
- return unless $self->use_threads;
-
-
- # To be removed: Old worker thread cration. => Padre::SlaveDriver
- # @_ = (); # avoid "Scalars leaked"
- # my $worker = threads->create(
- # { 'exit' => 'thread_only' }, \&worker_loop,
- # $main, $self->task_queue
- # );
- my $worker = Padre::SlaveDriver->new->spawn($self);
- die if not ref $worker;
- push @{ $self->{workers} }, $worker;
-}
-
-=pod
-
-=head3 C<reap>
-
-Check for worker threads that have exited and can be joined.
-If there are more worker threads than the normal number and
-they are idle, one worker thread (per C<reap> call) is
-stopped.
-
-This method is called regularly by the reap timer (see
-the C<reap_interval> option to the constructor) and it's not
-typically called by users.
-
-=cut
-
-sub reap {
- my $self = shift;
- return if not $self->use_threads;
-
- @_ = (); # avoid "Scalars leaked"
- my $workers = $self->{workers};
-
- my @active_or_waiting;
-
- #warn "No. worker threads before reaping: ".scalar (@$workers);
-
- foreach my $thread (@$workers) {
- if ( $thread->is_joinable() ) {
- my $tid = $thread->tid();
-
- # clean up the running task if necessary (case of crashed thread)
- $self->_stop_task($tid);
- my $tmp = $thread->join();
- } else {
- push @active_or_waiting, $thread;
+ $self->{active} = 0;
+ if ( $self->{threads} ) {
+ foreach ( 0 .. $#{ $self->{workers} } ) {
+ $self->stop_thread($_);
}
+ Padre::TaskThread->master->stop;
}
- $self->{workers} = \@active_or_waiting;
-
- #warn "No. worker threads after reaping: ".scalar (@$workers);
-
- # kill the no. of workers that aren't needed
- my $n_threads_to_kill = @active_or_waiting - $self->{max_no_workers};
- $n_threads_to_kill = 0 if $n_threads_to_kill < 0;
- my $jobs_pending = $self->task_queue->pending();
-
- # slowly reduce the no. workers to the minimum
- $n_threads_to_kill++
- if @active_or_waiting - $n_threads_to_kill > $self->{min_no_workers}
- and $jobs_pending == 0;
-
- if ($n_threads_to_kill) {
-
- # my $target_n_threads = @active_or_waiting - $n_threads_to_kill;
- my $queue = $self->task_queue;
- $queue->insert( 0, ("STOP") x $n_threads_to_kill )
- unless $queue->pending()
- and not ref( $queue->peek(0) );
- }
-
- $self->setup_workers();
-
return 1;
}
-sub _stop_task {
- my $self = shift;
- my $tid = shift;
- my $task_type = shift;
-
- my $running = $self->{running_tasks};
-
- if ( not defined $task_type ) { # attempt cleanup after crash
- foreach my $task_type ( keys %$running ) {
- delete $running->{$task_type}{$tid};
- delete $running->{$task_type} if not keys %{ $running->{$task_type} };
- }
- } else {
- delete $running->{$task_type}{$tid};
- delete $running->{$task_type} if not keys %{ $running->{$task_type} };
- }
-
- Padre->ide->wx->main->GetStatusBar->refresh;
- return (1);
-}
-
-=pod
-
-=head3 C<cleanup>
-
-Shutdown all services with a HANGUP, then stop all worker threads.
-Called on editor shutdown.
-
-=cut
-
-sub cleanup {
+sub stop_thread {
+ TRACE( $_[0] ) if DEBUG;
my $self = shift;
- return if not $self->use_threads;
-
- # Send all services a HANGUP , they will (hopefully)
- # catch this and break the run loop, returning below as
- # regular tasks. :|
- TRACE('Tell services to hangup') if DEBUG;
- $self->shutdown_services;
-
- # the nice way:
- TRACE('Tell all tasks to stop') if DEBUG;
- my @workers = $self->workers;
- $self->task_queue->insert( 0, ("STOP") x scalar(@workers) );
-
- my $waitstart = [ gettimeofday() ];
-
- # Changing the selection seems to solve the endless-loop problem
- # while ( threads->list(threads::running) >= 2 ) {
- while ( threads->list(threads::joinable) > 0 ) {
- for ( threads->list(threads::joinable) ) {
- $_->join;
- }
-
- # Wait no more than two minutes
- last if ( tv_interval($waitstart) >= ( 2 * 60 ) );
-
- # Pass time slices to the threads for finishing
- threads->yield();
- }
-
- foreach my $thread ( threads->list(threads::joinable) ) {
- TRACE( 'Joining thread ' . $thread->tid ) if DEBUG;
- $thread->join;
- }
-
- # cleanup master thread, too
- Padre::SlaveDriver->new->cleanup;
-
- # didn't work the nice way?
- while ( threads->list(threads::running) >= 1 ) {
- TRACE( 'Killing thread ' . $_->tid ) if DEBUG;
- foreach ( threads->list(threads::running) ) {
- $_->detach;
- $_->kill('TERM');
- }
- }
-
+ delete( $self->{workers}->[ $_[0] ] )->stop;
return 1;
}
-=pod
-
-=head2 Accessors
-
-=head3 C<task_queue>
-
-Returns the queue of tasks to be processed as a
-L<Thread::Queue> object. The tasks in the
-queue have been serialized for passing between threads,
-so this is mostly useful internally or
-for checking the number of outstanding jobs.
-
-=head3 C<reap_interval>
-
-Returns the number of milliseconds between the
-regular cleanup runs.
-
-=head3 C<use_threads>
-
-Returns whether running in degraded mode (no threads, false)
-or normal operation (threads, true).
-
-=head3 C<running_tasks>
-
-Returns the number of tasks that are currently being executed.
-
-=cut
-
-sub running_tasks {
+# Get the next available free child
+sub next_thread {
+ TRACE( $_[0] ) if DEBUG;
my $self = shift;
- my $n = 0;
- foreach my $task_type_hash ( values %{ $self->{running_tasks} } ) {
- $n += keys %$task_type_hash;
+ foreach my $worker ( @{ $self->{workers} } ) {
+ next if $worker->handle;
+ return $worker;
}
- return $n;
+ return undef;
}
-=pod
-=head3 C<shutdown_services>
-Gracefully shutdown the services by instructing them to hangup themselves
-and return via the usual Task mechanism.
-=cut
-## ERM FIX ME where are is the {running_services} populated then eh?
-sub shutdown_services {
- my $self = shift;
- TRACE('Shutdown services') if DEBUG;
+######################################################################
+# Task Management
- while ( my ( $sid, $service ) = each %{ $self->{running_services} } ) {
- TRACE("Hangup service $sid!") if DEBUG;
- $service->shutdown;
+sub schedule {
+ TRACE( $_[1] ) if DEBUG;
+ my $self = shift;
+ my $task = Params::Util::_INSTANCE( shift, 'Padre::Task' );
+ unless ($task) {
+ die "Invalid task scheduled!"; # TO DO: grace
}
-}
-
-=pod
-
-=head3 C<workers>
-Returns B<a list> of the worker threads.
+ # Add to the queue of pending events
+ push @{ $self->{queue} }, $task;
-=cut
-
-sub workers {
- $_[0]->{workers};
+ # Iterate the management loop
+ $self->step;
}
-=pod
-
-=head2 Event Handlers
+sub step {
+ TRACE( $_[0] ) if DEBUG;
+ my $self = shift;
+ my $queue = $self->{queue};
+ my $handles = $self->{handles};
-=head3 C<on_task_done_event>
+ # Shortcut if not allowed to run, or nothing to do
+ return 1 unless $self->{active};
+ return 1 unless @$queue;
-This event handler is called when a background task has
-finished execution. It deserializes the background task
-object and calls its C<finish> method with the
-Padre main window object as first argument. (This is done
-because C<finish> most likely updates the GUI.)
-
-=cut
-
-sub on_task_done_event {
- my ( $main, $event ) = @_;
- @_ = (); # hack to avoid "Scalars leaked"
- my $frozen = $event->GetData;
-
- # FIXME - can we know the _real_ class so the an extender
- # may hook de/serialize
- my $task = Padre::Task->deserialize( \$frozen );
-
- $task->finish($main);
- my $tid = $task->{__thread_id};
+ # Shortcut if there is nowhere to run the task
+ if ( $self->{threads} ) {
+ unless ( $self->{minimum} > scalar keys %$handles ) {
+ return 1;
+ }
+ }
- # TO DO/FIXME:
- # This should somehow get at the specific TaskManager object
- # instead of going through the Padre globals!
- my $manager = Padre->ide->task_manager;
- my $running = $manager->{running_tasks};
- my $task_type = ref($task);
- $manager->_stop_task( $tid, $task_type );
+ # Fetch and prepare the next task
+ my $task = shift @$queue;
+ my $handle = Padre::TaskHandle->new($task);
+ my $hid = $handle->hid;
- return ();
-}
+ # Run the pre-run step in the main thread
+ unless ( $handle->prepare ) {
-=pod
+ # Task wishes to abort itself. Oblige it.
+ undef $handle;
-=head3 C<on_task_start_event>
+ # Move on to the next task
+ return $self->step;
+ }
-This event handler is called when a background task is about to start
-execution.
-It simply increments the running task counter.
+ # Register the handle for Wx event callbacks
+ $handles->{$hid} = $handle;
-=cut
+ # Find a worker and register worker/thread relationship
+ my $worker = $self->next_thread or return;
+ $worker->handle($hid);
+ $handle->{worker} = $worker->wid;
-sub on_task_start_event {
- my ( $wx, $event ) = @_; @_ = (); # hack to avoid "Scalars leaked"
- # TO DO/FIXME:
- # This should somehow get at the specific TaskManager object
- # instead of going through the Padre globals!
- my $main = $wx->main;
- my $manager = Padre->ide->task_manager;
- my $tid_and_task_type = $event->GetData();
- my ( $tid, $task_type ) = split /;/, $tid_and_task_type, 2;
- $manager->{running_tasks}{$task_type}{$tid} = 1;
- $main->GetStatusBar->refresh;
+ # Send the message into the worker to start the task
+ $worker->send( 'task', $handle->as_array );
- return ();
+ # Continue to the next iteration
+ return $self->step;
}
-=pod
-=head3 C<on_service_poll_event>
-=cut
-sub on_service_poll_event {
- my ( $main, $event ) = @_; @_ = ();
- my $tid_and_type = $event->GetData();
- my ( $tid, $type ) = split /;/, $tid_and_type, 2;
- warn "Polled by service [$tid] as [$type]";
- return ();
-}
-=pod
+######################################################################
+# Signal Handling
-=head3 C<on_dump_running_tasks>
+sub on_signal {
+ TRACE( $_[0] ) if DEBUG;
+ my $self = shift;
+ my $event = shift;
-Called by the toolbar task-status button.
-Dumps the list of running tasks to the output panel.
-
-=cut
-
-sub on_dump_running_tasks {
- my $ide = Padre->ide;
- my $manager = $ide->task_manager;
- my $nrunning = $manager->running_tasks();
-
- my $main = $ide->wx->main;
- my $output = $main->output;
- $main->show_output(1);
- $output->style_neutral;
+ # Deserialize and squelch bad messages
+ my $frozen = $event->GetData;
+ my $message = eval { Storable::thaw($frozen); };
+ if ($@) {
- $output->AppendText( "\n-----------------------------------------\n["
- . localtime() . "] "
- . sprintf( Wx::gettext("%s worker threads are running.\n"), scalar( $manager->workers ) ) );
- if ( $nrunning == 0 ) {
- $output->AppendText( Wx::gettext("Currently, no background tasks are being executed.\n") );
- return ();
+ # warn("Exception deserialising message from thread ('$frozen')");
+ return;
}
+ unless ( ref $message eq 'ARRAY' ) {
- my $running = $manager->{running_tasks};
- my $text;
- $text .= Wx::gettext("The following tasks are currently executing in the background:\n");
-
- foreach my $type ( keys %$running ) {
- my $threads = $running->{$type};
- my $n = keys %$threads;
- $text .= sprintf(
- Wx::gettext("- %s of type '%s':\n (in thread(s) %s)\n"),
- $n, $type, join( ", ", sort { $a <=> $b } keys %$threads )
- );
+ # warn("Unrecognised non-ARRAY message received by a thread");
+ return;
}
- $output->AppendText($text);
+ # Fine the task handle for the task
+ my $hid = shift @$message;
+ my $handle = $self->{handles}->{$hid} or return;
- my $queue = $manager->task_queue;
- my $pending = $queue->pending;
+ # Handle the special startup message
+ my $method = shift @$message;
+ if ( $method eq 'STARTED' ) {
- if ($pending) {
- $output->AppendText(
- sprintf( Wx::gettext("\nAdditionally, there are %s tasks pending execution.\n"), $pending ) );
+ # Register the task as running
+ $self->{running}->{$hid} = $handle;
+ return;
}
-}
+ # Any remaining task should be running
+ unless ( $self->{running}->{$hid} ) {
-1;
-
-=pod
-
-=head1 TO DO
-
-What if the computer can't keep up with the queued jobs? This needs
-some consideration and probably, the C<schedule()> call needs to block once
-the queue is I<"full">. However, it's not clear how this can work if the
-Wx C<MainLoop> isn't reached for processing finish events.
-
-Polling services I<aliveness> in a useful way, something a C<Wx::Taskmanager>
-might like to display. Ability to selectively kill tasks/services
+ # warn("Received message for a task that is not running");
+ return;
+ }
-=head1 SEE ALSO
+ # Handle the special shutdown message
+ if ( $method eq 'STOPPED' ) {
-The base class of all I<"work units"> is L<Padre::Task>.
+ # Remove from the running list to guarentee no more events
+ # will be sent to the handle (and thus to the task)
+ delete $self->{running}->{$hid};
-=head1 AUTHOR
+ # Free up the worker thread for other tasks
+ foreach my $worker ( @{ $self->{workers} } ) {
+ next unless defined $worker->handle;
+ next unless $worker->handle == $hid;
+ $worker->handle(undef);
+ last;
+ }
-Steffen Mueller C<smueller@cpan.org>
+ # Fire the post-process/cleanup finish method, passing in the
+ # completed (and serialised) task object.
+ $handle->on_stopped(@$message);
-=head1 COPYRIGHT AND LICENSE
+ # Remove from the task list to destroy the task
+ delete $self->{handles}->{$hid};
-Copyright 2008-2010 The Padre development team as listed in Padre.pm.
+ # This should have released a worker to process
+ # a new task, kick off the next scheduling iteration.
+ return $self->step;
+ }
-This program is free software; you can redistribute it and/or
-modify it under the same terms as Perl 5 itself.
+ # Pass the message through to the handle
+ $handle->on_message( $method, @$message );
+}
-=cut
+1;
# Copyright 2008-2010 The Padre development team as listed in Padre.pm.
# LICENSE
@@ -0,0 +1,41 @@
+package Padre::TaskProcess;
+
+use 5.008;
+use strict;
+use warnings;
+use Carp ();
+use Padre::Task ();
+
+our $VERSION = '0.66';
+our @ISA = 'Padre::Task';
+
+
+
+
+
+######################################################################
+# Process API Methods
+
+# Pass upstream to our handle
+sub message {
+ my $self = shift;
+
+ # Check the message
+ my $method = shift;
+ unless ( $self->running ) {
+ croak("Attempted to send message while not in a worker thread");
+ }
+ unless ( $method and $self->can($method) ) {
+ croak("Attempted to send message to non-existant method '$method'");
+ }
+
+ # Hand off to our parent handle
+ $self->handle->message( $method, @_ );
+}
+
+1;
+
+# Copyright 2008-2010 The Padre development team as listed in Padre.pm.
+# LICENSE
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl 5 itself.
@@ -0,0 +1,273 @@
+package Padre::TaskThread;
+
+# Cleanly encapsulated object for a thread that does work based
+# on packaged method calls passed via a shared queue.
+
+use 5.008005;
+use strict;
+use warnings;
+use threads;
+use threads::shared;
+use Thread::Queue 2.11;
+use Scalar::Util ();
+
+# NOTE: Don't use Padre::Wx here, by only loading the Wx core
+# we can have less of Wx loaded when we spawn the master thread.
+# Given that background threads shouldn't be using Wx anyway,
+# loaded less code now cuts the per-thread cost of several meg.
+use Wx ();
+
+our $VERSION = '0.66';
+
+# Worker id sequence, so identifiers will be available in objects
+# across all instances and threads before the thread has been spawned.
+# We map the worker ID to the thread id, once it exists.
+my $SEQUENCE : shared = 0;
+my %WID2TID : shared = ();
+
+
+
+
+######################################################################
+# Slave Master Support (main thread only)
+
+my $SINGLETON = undef;
+
+sub master {
+ $SINGLETON
+ or $SINGLETON = shift->new->spawn;
+}
+
+# Handle master initialisation
+sub import {
+ if ( defined $_[1] and $_[1] eq ':master' ) {
+ $_[0]->master;
+ }
+}
+
+
+
+
+
+######################################################################
+# Constructor and Accessors
+
+sub new {
+
+ # TRACE($_[0]) if DEBUG;
+ bless {
+ wid => ++$SEQUENCE,
+ queue => Thread::Queue->new,
+ },
+ $_[0];
+}
+
+sub wid {
+
+ # TRACE($_[0]) if DEBUG;
+ $_[0]->{wid};
+}
+
+sub queue {
+
+ # TRACE($_[0]) if DEBUG;
+ # TRACE($_[0]->{queue}) if DEBUG;
+ $_[0]->{queue};
+}
+
+
+
+
+
+######################################################################
+# Main Methods
+
+sub spawn {
+
+ # TRACE($_[0]) if DEBUG;
+ my $self = shift;
+
+ # Spawn the object into the thread and enter the main runloop
+ $WID2TID{ $self->{wid} } = threads->create(
+ sub {
+ $_[0]->run;
+ },
+ $self,
+ )->tid;
+
+ return $self;
+}
+
+sub tid {
+
+ # TRACE($_[0]) if DEBUG;
+ $WID2TID{ $_[0]->{wid} };
+}
+
+sub thread {
+
+ # TRACE($_[0]) if DEBUG;
+ threads->object( $_[0]->tid );
+}
+
+sub join {
+
+ # TRACE($_[0]) if DEBUG;
+ $_[0]->thread->join;
+}
+
+sub is_thread {
+
+ # TRACE($_[0]) if DEBUG;
+ $_[0]->tid == threads->self->tid;
+}
+
+sub is_running {
+
+ # TRACE($_[0]) if DEBUG;
+ $_[0]->thread->is_running;
+}
+
+sub is_joinable {
+
+ # TRACE($_[0]) if DEBUG;
+ $_[0]->thread->is_joinable;
+}
+
+sub is_detached {
+
+ # TRACE($_[0]) if DEBUG;
+ $_[0]->thread->is_detached;
+}
+
+
+
+
+
+######################################################################
+# Parent Thread Methods
+
+sub send {
+
+ # TRACE($_[0]) if DEBUG;
+ my $self = shift;
+ my $method = shift;
+ unless ( _CAN( $self, $method ) ) {
+ die("Attempted to send message to non-existant method '$method'");
+ }
+
+ # Add the message to the queue
+ $self->{queue}->enqueue( [ $method, @_ ] );
+
+ return 1;
+}
+
+# Add a worker object to the pool, spawning it from the master
+sub start {
+
+ # TRACE($_[0]) if DEBUG;
+ shift->send( 'start_child', @_ );
+}
+
+# Immediately detach and terminate when queued jobs are completed
+sub stop {
+
+ # TRACE($_[0]) if DEBUG;
+ # TRACE("Detaching thread") if DEBUG;
+ $_[0]->thread->detach;
+ $_[0]->send('stop_child');
+}
+
+
+
+
+
+######################################################################
+# Child Thread Methods
+
+sub run {
+
+ # TRACE($_[0]) if DEBUG;
+ my $self = shift;
+ my $queue = $self->{queue};
+
+ # Loop over inbound requests
+ # TRACE("Entering worker run-time loop") if DEBUG;
+ while ( my $message = $queue->dequeue ) {
+
+ # TRACE("Worker received message '$message->[0]'") if DEBUG;
+ unless ( _ARRAY($message) ) {
+
+ # warn("Message is not an ARRAY reference");
+ next;
+ }
+
+ # Check the message type
+ my $method = shift @$message;
+ unless ( _CAN( $self, $method ) ) {
+
+ # warn("Illegal message type");
+ next;
+ }
+
+ # Hand off to the appropriate method.
+ # Methods must return true, otherwise the thread
+ # will abort processing and end.
+ $self->$method(@$message) or last;
+ }
+
+ # TRACE("Exited worker run-time loop") if DEBUG;
+ return;
+}
+
+
+
+
+
+######################################################################
+# Message Handlers
+
+# Spawn a worker object off the current thread
+sub start_child {
+
+ # TRACE($_[0]) if DEBUG;
+ $_[1]->spawn;
+ return 1;
+}
+
+# Stop the current child
+sub stop_child {
+
+ # TRACE($_[0]) if DEBUG;
+ return 0;
+}
+
+# Execute a task
+sub task {
+
+ # TRACE($_[0]) if DEBUG;
+ require Padre::TaskHandle;
+ Padre::TaskHandle->from_array( $_[1] );
+}
+
+
+
+
+
+######################################################################
+# Support Methods
+
+sub _ARRAY {
+ ( ref $_[0] eq 'ARRAY' and @{ $_[0] } ) ? $_[0] : undef;
+}
+
+sub _CAN {
+ ( Scalar::Util::blessed( $_[0] ) and $_[0]->can( $_[1] ) ) ? $_[0] : undef;
+}
+
+1;
+
+# Copyright 2008-2010 The Padre development team as listed in Padre.pm.
+# LICENSE
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl 5 itself.
@@ -0,0 +1,67 @@
+package Padre::TaskWorker;
+
+# Object that represents the worker thread
+
+use 5.008005;
+use strict;
+use warnings;
+use Scalar::Util ();
+use Padre::TaskThread ();
+use Padre::Logger;
+
+our $VERSION = '0.66';
+our @ISA = 'Padre::TaskThread';
+
+
+
+
+
+#######################################################################
+# Main Thread Methods
+
+sub handle {
+ my $self = shift;
+ $self->{handle} = shift if @_;
+ return $self->{handle};
+}
+
+
+
+
+
+######################################################################
+# Worker Thread Methods
+
+sub task {
+ TRACE( $_[0] ) if DEBUG;
+ my $self = shift;
+
+ # Deserialize the task handle
+ TRACE("Loading Padre::TaskHandle") if DEBUG;
+ require Padre::TaskHandle;
+ TRACE("Inflating handle object") if DEBUG;
+ my $handle = Padre::TaskHandle->from_array(shift);
+
+ # Execute the task (ignore the result) and signal as we go
+ eval {
+ TRACE("Calling ->started") if DEBUG;
+ $handle->started;
+ TRACE("Calling ->run") if DEBUG;
+ $handle->run;
+ TRACE("Calling ->stopped") if DEBUG;
+ $handle->stopped;
+ };
+ if ($@) {
+ TRACE($@) if DEBUG;
+ }
+
+ # Continue to the next task
+ return 1;
+}
+
+1;
+
+# Copyright 2008-2010 The Padre development team as listed in Padre.pm.
+# LICENSE
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl 5 itself.
@@ -17,7 +17,7 @@ use 5.008005;
use strict;
use warnings;
-our $VERSION = '0.63';
+our $VERSION = '0.66';
# Disable the splash screen
$ENV{PADRE_NOSPLASH} = 1; ## no critic (RequireLocalizedPunctuationVars)
@@ -34,7 +34,7 @@ use Params::Util qw{ _STRING };
use Padre::Current ();
use Padre::Transform::Perl ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
our @ISA = 'Padre::Transform::Perl';
#####################################################################
@@ -7,7 +7,7 @@ use strict;
use warnings;
use Padre::Transform ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
our @ISA = 'Padre::Transform';
sub apply {
@@ -23,7 +23,7 @@ use strict;
use warnings;
use Params::Util qw{ _INSTANCE };
-our $VERSION = '0.63';
+our $VERSION = '0.66';
#####################################################################
# Constructor
@@ -18,7 +18,7 @@ use strict;
use warnings;
# package exports and version
-our $VERSION = '0.63';
+our $VERSION = '0.66';
use Padre::Constant ();
@@ -8,7 +8,7 @@ use 5.008005;
use strict;
use warnings;
-our $VERSION = '0.63';
+our $VERSION = '0.66';
my $PADRE = undef;
@@ -23,7 +23,7 @@ use 5.008;
use strict;
use warnings;
-our $VERSION = '0.63';
+our $VERSION = '0.66';
# This is a Padre::Util module where the subs should be called as functions,
# but Template::Tiny requires us to use a blessed package and we could use
@@ -35,7 +35,7 @@ if (Padre::Constant::WIN32) {
TRACE("WARN: Inefficiently loading Padre::Util::Win32 when not on Win32");
}
-our $VERSION = '0.63';
+our $VERSION = '0.66';
my %Types = ();
@@ -34,7 +34,7 @@ use List::Util ();
use POSIX ();
use Padre::Constant ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
our @ISA = 'Exporter';
our @EXPORT_OK = '_T';
@@ -493,7 +493,7 @@ sub parse_version {
my $result;
local $/ = "\n";
local $_;
- open( my $fh, '<', $parsefile ) ## no critic (RequireBriefOpen)
+ open( my $fh, '<', $parsefile ) #-# no critic (RequireBriefOpen)
or die "Could not open '$parsefile': $!";
my $inpod = 0;
while (<$fh>) {
@@ -13,7 +13,7 @@ use Padre::Util ();
use Wx::Perl::ProcessStream ();
use PPI ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
our @ISA = 'Wx::Dialog';
sub new {
@@ -309,12 +309,16 @@ END_HTML
sub _content_info {
my $self = shift;
my $padre_info = Wx::gettext('System Info');
- my $wx_widgets = Wx::wxVERSION_STRING();
my $config_dir_txt = Wx::gettext('Config dir:');
my $config_dir = Padre::Constant::CONFIG_DIR;
- my $uptime = time - $^T;
- my @uptime_parts = ( 0, 0, 0 );
+ # Reformat the native wxWidgets version string slightly
+ my $wx_widgets = Wx::wxVERSION_STRING();
+ $wx_widgets =~ s/^wx\w+\s+//;
+
+ # Calculate the process uptime
+ my $uptime = time - $^T;
+ my @uptime_parts = ( 0, 0, 0 );
if ( $uptime > 3600 ) {
$uptime_parts[0] = int( $uptime / 3600 );
$uptime -= $uptime_parts[0] * 3600;
@@ -327,12 +331,17 @@ sub _content_info {
my $uptime_text = Wx::gettext('Uptime');
$uptime = sprintf( '%d:%02d:%02d', @uptime_parts );
+ # Calculate the current memory in use across all threads
my $ram = Padre::Util::humanbytes( Padre::Util::process_memory() ) || '0';
-
$ram = '(' . Wx::gettext('unsupported') . ')' if $ram eq '0';
# Yes, THIS variable should have this upper case char :-)
my $Perl_version = $^V || $];
+ $Perl_version = "$Perl_version";
+ $Perl_version =~ s/^v//;
+
+ # How many threads are running
+ my $threads = $INC{'threads.pm'} ? scalar( threads->list ) : 'disabled';
$self->{info}->SetPage( $self->_rtl(<<"END_HTML") );
<html>
@@ -394,6 +403,14 @@ sub _content_info {
$ram
</td>
</tr>
+ <tr>
+ <td valign="top">
+ Threads:
+ </td>
+ <td>
+ $threads
+ </td>
+ </tr>
</table>
</body>
</html>
@@ -22,7 +22,7 @@ use Padre::DB ();
use Padre::Wx ();
use Padre::Wx::Dialog ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
my $iter;
my %opts;
@@ -33,32 +33,45 @@ use warnings;
use Carp ();
use Padre::Wx ();
-our $VERSION = '0.63';
+# use Padre::Logger;
+
+our $VERSION = '0.66';
our @ISA = 'Wx::App';
+######################################################################
+# Singleton Support
+
+my $SINGLETON = undef;
+
+sub new {
+
+ # TRACE($_[0]) if DEBUG;
+ $SINGLETON
+ or $SINGLETON = shift->SUPER::new;
+}
+
+
+
+
+
#####################################################################
# Constructor and Accessors
sub create {
- my $self = shift->new;
- # Check IDE param
- my $ide = shift;
- require Params::Util;
- unless ( Params::Util::_INSTANCE( $ide, 'Padre' ) ) {
- Carp::croak("Did not provide the ide object to Padre::App->create");
- }
+ # TRACE($_[0]) if DEBUG;
+ my $self = shift->new;
# Save a link back to the parent ide
- $self->{ide} = $ide;
+ $self->{ide} = shift;
# Immediately populate the main window
require Padre::Wx::Main;
- $self->{main} = Padre::Wx::Main->new($ide);
+ $self->{main} = Padre::Wx::Main->new( $self->{ide} );
return $self;
}
@@ -69,6 +82,14 @@ sub create {
The C<ide> accessor provides a link back to the parent L<Padre> IDE object.
+=cut
+
+sub ide {
+ $_[0]->{ide};
+}
+
+=pod
+
=head2 C<main>
The C<main> accessor returns the L<Padre::Wx::Main> object for the
@@ -76,12 +97,9 @@ application.
=cut
-use Class::XSAccessor {
- getters => {
- ide => 'ide',
- main => 'main',
- }
-};
+sub main {
+ $_[0]->{main};
+}
=pod
@@ -92,6 +110,8 @@ The C<config> accessor returns the L<Padre::Config> for the application.
=cut
sub config {
+
+ # TRACE($_[0]) if DEBUG;
$_[0]->ide->config;
}
@@ -102,7 +122,14 @@ sub config {
#####################################################################
# Wx Methods
-sub OnInit {1}
+sub OnInit {
+
+ # TRACE($_[0]) if DEBUG;
+ if ( $_[0]->can('conduit_init') ) {
+ $_[0]->conduit_init;
+ }
+ return 1;
+}
1;
@@ -9,7 +9,7 @@ use warnings;
use Padre::Wx ();
use Padre::Logger;
-our $VERSION = '0.63';
+our $VERSION = '0.66';
# Due to an overly simplistic implementation at the C level,
# Wx::AuiManager is only a SCALAR reference and cannot be
@@ -1,17 +1,17 @@
package Padre::Wx::Bottom;
-# The bottom notebook
+# The bottom notebook for tool views
use 5.008;
use strict;
use warnings;
-use Padre::Constant ();
-use Padre::Wx ();
-use Padre::Wx::Role::MainChild ();
+use Padre::Constant ();
+use Padre::Wx ();
+use Padre::Wx::Role::Main ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
our @ISA = qw{
- Padre::Wx::Role::MainChild
+ Padre::Wx::Role::Main
Wx::AuiNotebook
};
@@ -63,7 +63,8 @@ sub new {
# Page Management
sub show {
- my ( $self, $page ) = @_;
+ my $self = shift;
+ my $page = shift;
# Are we currently showing the page
my $position = $self->GetPageIndex($page);
@@ -75,8 +76,7 @@ sub show {
}
# Add the page
- $self->InsertPage(
- 0,
+ $self->AddPage(
$page,
$page->gettext_label,
1,
@@ -85,7 +85,12 @@ sub show {
$self->Show;
$self->aui->GetPane($self)->Show;
- Wx::Event::EVT_AUINOTEBOOK_PAGE_CLOSE( $self, $self, \&_on_close );
+ Wx::Event::EVT_AUINOTEBOOK_PAGE_CLOSE(
+ $self, $self,
+ sub {
+ shift->on_close(@_);
+ }
+ );
return;
}
@@ -113,6 +118,15 @@ sub hide {
return;
}
+# Allows for content-adaptive labels
+sub refresh {
+ my $self = shift;
+ foreach my $i ( 0 .. $self->GetPageCount - 1 ) {
+ $self->SetPageText( $i, $self->GetPage($i)->gettext_label );
+ }
+ return;
+}
+
sub relocale {
my $self = shift;
foreach my $i ( 0 .. $self->GetPageCount - 1 ) {
@@ -122,6 +136,29 @@ sub relocale {
return;
}
+# It is unscalable for the view notebooks to have to know what they might contain
+# and then re-implement the show/hide logic (probably wrong).
+# Instead, tunnel the close action to the tool and let the tool decide how to go
+# about closing itself (which will usually be by delegating up to the main window).
+sub on_close {
+ my $self = shift;
+ my $event = shift;
+
+ # Tunnel the request through to the tool if possible.
+ my $position = $event->GetSelection;
+ my $tool = $self->GetPage($position);
+ unless ( $tool->can('view_close') ) {
+
+ # HACK: Crash in a controller manner for the moment.
+ # Later just let this crash uncontrolably :)
+ # DOUBLE HACK: Just warn, and pass through for now.
+ my $class = ref $tool;
+ warn "Panel tool $class does define 'view_close' method";
+ return $self->_on_close($event);
+ }
+ $tool->view_close;
+}
+
sub _on_close {
my ( $self, $event ) = @_;
@@ -132,13 +169,9 @@ sub _on_close {
# De-activate in the menu and in the configuration
my %menu_name = (
'Padre::Wx::ErrorList' => 'show_errorlist',
- 'Padre::Wx::Syntax' => 'show_syntaxcheck',
- 'Padre::Wx::Output' => 'output',
);
my %config_name = (
'Padre::Wx::ErrorList' => 'main_errorlist',
- 'Padre::Wx::Syntax' => 'main_syntaxcheck',
- 'Padre::Wx::Output' => 'main_output',
);
if ( exists $menu_name{$type} ) {
$self->main->menu->view->{ $menu_name{$type} }->Check(0);
@@ -0,0 +1,496 @@
+package Padre::Wx::Browser;
+
+=pod
+
+=head1 NAME
+
+Padre::Wx::Browser - Wx front-end for C<Padre::Browser>
+
+=head1 Welcome to Padre C<Browser>
+
+C<Padre::Wx::Browser> ( C<Wx::Frame> )
+
+=head1 DESCRIPTION
+
+User interface for C<Padre::Browser>.
+
+=head1 METHODS
+
+=cut
+
+use 5.008;
+use strict;
+use warnings;
+use URI ();
+use Encode ();
+use Scalar::Util ();
+use List::MoreUtils ();
+use Params::Util (qw{ _INSTANCE _INVOCANT _HASH _STRING });
+use Padre::Util ('_T');
+use Padre::Browser ();
+use Padre::Task::Browser ();
+use Padre::Wx ();
+use Padre::Wx::HtmlWindow ();
+use Padre::Wx::Icon ();
+use Padre::Wx::AuiManager ();
+use Padre::Wx::Dialog ();
+use Padre::Role::Task ();
+use Wx::Perl::Dialog::Simple ();
+use Padre::Logger;
+
+our $VERSION = '0.66';
+our @ISA = qw{
+ Padre::Role::Task
+ Wx::Dialog
+};
+
+our %VIEW = (
+ 'text/html' => 'Padre::Wx::HtmlWindow',
+ 'text/xhtml' => 'Padre::Wx::HtmlWindow',
+ 'text/x-html' => 'Padre::Wx::HtmlWindow',
+);
+
+=pod
+
+=head2 new
+
+Constructor , see L<Wx::Frame>
+
+=cut
+
+sub new {
+ my $class = shift;
+ my $self = $class->SUPER::new(
+ undef,
+ -1,
+ Wx::gettext('Help'),
+ Wx::wxDefaultPosition,
+ [ 750, 700 ],
+ Wx::wxDEFAULT_FRAME_STYLE,
+ );
+
+ $self->{provider} = Padre::Browser->new;
+
+ # Until we get a real icon use the same one as the others
+ $self->SetIcon(Padre::Wx::Icon::PADRE);
+
+ my $top_s = Wx::BoxSizer->new(Wx::wxVERTICAL);
+ my $but_s = Wx::BoxSizer->new(Wx::wxHORIZONTAL);
+
+ $self->{notebook} = Wx::AuiNotebook->new(
+ $self,
+ -1,
+ Wx::wxDefaultPosition,
+ Wx::wxDefaultSize,
+ Wx::wxAUI_NB_DEFAULT_STYLE
+ );
+
+ $self->{search} = Wx::TextCtrl->new(
+ $self, -1,
+ '',
+ Wx::wxDefaultPosition,
+ Wx::wxDefaultSize,
+ Wx::wxTE_PROCESS_ENTER
+ );
+ $self->{search}->SetToolTip( Wx::ToolTip->new( Wx::gettext('Search for perldoc - e.g. Padre::Task, Net::LDAP') ) );
+
+ Wx::Event::EVT_TEXT_ENTER(
+ $self,
+ $self->{search},
+ sub {
+ $self->on_search_text_enter( $self->{search} );
+ }
+ );
+
+ my $label = Wx::StaticText->new(
+ $self, -1, Wx::gettext('Search:'),
+ Wx::wxDefaultPosition, [ 50, -1 ],
+ Wx::wxALIGN_RIGHT
+ );
+ $label->SetToolTip( Wx::ToolTip->new( Wx::gettext('Search for perldoc - e.g. Padre::Task, Net::LDAP') ) );
+
+ my $close_button = Wx::Button->new( $self, Wx::wxID_CANCEL, Wx::gettext('&Close') );
+
+ $but_s->Add( $label, 0, Wx::wxALIGN_CENTER_VERTICAL );
+ $but_s->Add( $self->{search}, 1, Wx::wxALIGN_LEFT | Wx::wxALIGN_CENTER_VERTICAL );
+ $but_s->AddStretchSpacer(2);
+ $but_s->Add( $close_button, 0, Wx::wxALIGN_RIGHT | Wx::wxALIGN_CENTER_VERTICAL );
+
+ $top_s->Add( $but_s, 0, Wx::wxEXPAND );
+ $top_s->Add( $self->{notebook}, 1, Wx::wxGROW );
+ $self->SetSizer($top_s);
+
+ #$self->_setup_welcome;
+
+ # not sure about this but we want to throw the close X event ot on_close so it gets
+ # rid of a busy cursor if it's busy..
+ # bind the close event to our close method
+
+ # This doesn't work... !!! :( It should do though!
+ # http://www.nntp.perl.org/group/perl.wxperl.users/2007/06/msg3154.html
+ # http://www.gigi.co.uk/wxperl/pdk/perltrayexample.txt
+ # use a similar syntax.... for some reason this doesn't call on_close()
+
+ # TO DO: Figure out what needs to be done to check and shutdown a
+ # long running thread
+ # To trigger this, search for perltoc in the search text entry.
+
+ Wx::Event::EVT_CLOSE(
+ $self,
+ sub {
+ $_[0]->on_close;
+ }
+ );
+
+ $self->SetAutoLayout(1);
+
+ return $self;
+}
+
+
+
+
+
+######################################################################
+# Event Handlers
+
+sub on_close {
+ my $self = shift;
+ TRACE("Closing the docbrowser") if DEBUG;
+
+ # In case we have a busy cursor still:
+ $self->{busy} = undef;
+
+ $self->Close;
+}
+
+sub on_search_text_enter {
+ my $self = shift;
+ my $event = shift;
+ my $text = $event->GetValue;
+
+ # need to see where to put the busy cursor
+ # we want to see a busy cursor
+ # cheating a bit here:
+ $self->{busy} = Wx::BusyCursor->new;
+
+ $self->resolve($text);
+}
+
+sub on_html_link_clicked {
+ my $self = shift;
+ my $uri = URI->new( $_[0]->GetLinkInfo->GetHref );
+ if ( $self->{provider}->accept( $uri->scheme ) ) {
+ $self->resolve($uri);
+ } else {
+ Padre::Wx::launch_browser($uri);
+ }
+}
+
+
+
+
+
+######################################################################
+# General Methods
+
+=pod
+
+=head2 help
+
+Accepts a string, L<URI> or L<Padre::Document> and attempts to render
+documentation for such in a new C<AuiNoteBook> tab. Links matching a scheme
+accepted by L<Padre::Browser> will (when clicked) be resolved and
+displayed in a new tab.
+
+=cut
+
+sub help {
+ my $self = shift;
+ my $document = shift;
+ my $hint = shift;
+
+ if ( _INSTANCE( $document, 'Padre::Document' ) ) {
+ $document = $self->padre2docbrowser($document);
+ }
+
+ my %hints = (
+ $self->_hints,
+ _HASH($hint) ? %$hint : (),
+ );
+
+ if ( _INVOCANT($document) and $document->isa('Padre::Browser::Document') ) {
+ if ( $self->viewer_for( $document->guess_mimetype ) ) {
+ return $self->display($document);
+ }
+
+ my $render = $self->{provider}->viewer_for( $document->mimetype );
+ my $generate = $self->{provider}->provider_for( $document->mimetype );
+
+ if ($generate) {
+ $self->task_request(
+ task => 'Padre::Task::Browser',
+ document => $document,
+ method => 'docs',
+ args => \%hints,
+ then => 'display',
+ );
+ return 1;
+ }
+ if ($render) {
+ $self->task_request(
+ task => 'Padre::Task::Browser',
+ document => $document,
+ method => 'browse',
+ args => \%hints,
+ then => 'display',
+ );
+ return 1;
+ }
+ $self->not_found( $document, \%hints );
+ return;
+ } elsif ( defined $document ) {
+ $self->task_request(
+ task => 'Padre::Task::Browser',
+ document => $document,
+ method => 'resolve',
+ args => \%hints,
+ then => 'help',
+ );
+ return 1;
+ } else {
+ $self->not_found( $hints{referrer} );
+ }
+}
+
+sub resolve {
+ my $self = shift;
+ my $document = shift;
+ $self->task_request(
+ task => 'Padre::Task::Browser',
+ document => $document,
+ method => 'resolve',
+ args => { $self->_hints },
+ then => 'display',
+ );
+}
+
+# FIX ME , add our own output panel
+sub debug {
+ Padre->ide->wx->main->output->AppendText( $_[1] . $/ );
+}
+
+=pod
+
+=head2 display
+
+Accepts a L<Padre::Document> or work-alike
+
+=cut
+
+sub display {
+ my $self = shift;
+ my $docs = shift;
+ my $query = shift;
+
+ if ( _INSTANCE( $docs, 'Padre::Browser::Document' ) ) {
+
+ # if doc is html just display it
+ # TO DO, a means to register other wx display windows such as ?!
+ if ( $self->viewer_for( $docs->mimetype ) ) {
+ return $self->show_page( $docs, $query );
+ }
+
+ $self->task_request(
+ task => 'Padre::Task::Browser',
+ method => 'browse',
+ document => $docs,
+ then => 'display',
+ );
+
+ return 1;
+ } else {
+ $self->not_found( $docs, $query );
+
+ }
+}
+
+sub task_response {
+ my $self = shift;
+ my $task = shift;
+ my $then = $task->{then};
+ my $document = $task->{document};
+ my $result = $task->{result};
+ if ( $then eq 'display' ) {
+ return $self->not_found($document) unless $result;
+ return $self->display( $result, $document );
+ }
+ if ( $then eq 'help' ) {
+ return $self->help( $result, { referrer => $document } );
+ }
+ return 1;
+}
+
+sub show_page {
+ my $self = shift;
+ my $docs = shift;
+ my $query = shift;
+
+ unless ( _INSTANCE( $docs, 'Padre::Browser::Document' ) ) {
+ return $self->not_found($query);
+ }
+
+ my $title = Wx::gettext('Untitled');
+ my $mime = 'text/xhtml';
+
+ # Best effort to title the tab ANYTHING more useful
+ # than 'Untitled'
+ if ( _INSTANCE( $query, 'Padre::Browser::Document' ) ) {
+ $title = $query->title;
+ } elsif ( $docs->title ) {
+ $title = $docs->title;
+ } elsif ( _STRING($query) ) {
+ $title = $query;
+ }
+
+ # Bashing on Indicies in the attempt to replace an open
+ # tab with the same title.
+ my $found = $self->notebook->GetPageCount;
+ my @opened;
+ my $i = 0;
+ while ( $i < $found ) {
+ my $page = $self->{notebook}->GetPage($i);
+ if ( $self->{notebook}->GetPageText($i) eq $title ) {
+ push @opened,
+ {
+ page => $page,
+ index => $i,
+ };
+ }
+ $i++;
+ }
+ if ( my $last = pop @opened ) {
+ $last->{page}->SetPage( $docs->body );
+ $self->{notebook}->SetSelection( $last->{index} );
+ } else {
+ my $page = $self->new_page( $docs->mimetype, $title );
+ $page->SetPage( $docs->body );
+ }
+
+ # and turn off the busy cursor
+ $self->{busy} = undef;
+
+ # not sure if I can do this:
+ # yep seems I can!
+ $self->{search}->SetFocus();
+
+}
+
+sub new_page {
+ my $self = shift;
+ my $mime = shift;
+ my $title = shift;
+ my $page = eval {
+ if ( exists $VIEW{$mime} )
+ {
+ my $class = $VIEW{$mime};
+ unless ( $class->VERSION ) {
+ eval "require $class;";
+ die "Failed to load $class: $@" if $@;
+ }
+ my $panel = $class->new($self);
+ Wx::Event::EVT_HTML_LINK_CLICKED(
+ $self, $panel,
+ sub {
+ shift->on_html_link_clicked(@_);
+ },
+ );
+ $self->{notebook}->AddPage( $panel, $title, 1 );
+ $panel;
+ } else {
+ $self->debug( sprintf( Wx::gettext('Browser: no viewer for %s'), $mime ) );
+ }
+ };
+ return $page;
+}
+
+sub padre2docbrowser {
+ my $class = shift;
+ my $padredoc = shift;
+ my $doc = Padre::Browser::Document->new(
+ mimetype => $padredoc->mimetype,
+ title => $padredoc->get_title,
+ filename => $padredoc->filename,
+ );
+
+ $doc->body( Encode::encode( 'utf8', $padredoc->text_get ) );
+
+ $doc->mimetype( $doc->guess_mimetype ) unless $doc->mimetype;
+
+ return $doc;
+}
+
+# trying a dialog rather than the open tab.
+sub not_found {
+ my $self = shift;
+ my $query = shift;
+ my $hints = shift;
+
+ # We got this far, make the cursor not busy
+ $self->{busy} = undef;
+
+ $query ||= $hints->{referrer};
+ my $dialog = Wx::MessageDialog->new(
+ $self,
+ sprintf( Wx::gettext("Searched for '%s' and failed..."), $query ),
+ Wx::gettext('Help not found.'),
+ Wx::wxOK | Wx::wxCENTRE | Wx::wxICON_INFORMATION
+ );
+
+ $dialog->ShowModal;
+ $dialog->Destroy;
+
+ # Set focus back to the entry.
+ $self->{search}->SetFocus;
+}
+
+# Private methods
+
+# There are some things only the instance knows , like desired locale
+# or how to derive a title from a documentation section
+sub _hints {
+ return (
+ ( Padre::Locale::iso639() eq Padre::Locale::system_iso639() )
+ ? ()
+ : ( lang => Padre::Locale::iso639() ),
+
+ title_from_section => Wx::gettext('NAME'),
+ );
+}
+
+sub viewer_for {
+ my $self = shift;
+ my $mimetype = shift or return;
+ if ( exists $VIEW{$mimetype} ) {
+ return $VIEW{$mimetype};
+ }
+ return;
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 SEE ALSO
+
+L<Padre::Browser> L<Padre::Task::Browser>
+
+=cut
+
+# Copyright 2008-2010 The Padre development team as listed in Padre.pm.
+# LICENSE
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl 5 itself.
+
@@ -7,7 +7,7 @@ use Params::Util qw{_INSTANCE};
use Padre::Wx ();
use Padre::Wx::Icon ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
our @ISA = 'Wx::ListView';
sub new {
@@ -9,7 +9,7 @@ use Params::Util qw( _INSTANCE );
use Padre::Wx ();
use Padre::Wx::CPAN::Listview ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
our @ISA = 'Wx::Frame';
use Class::XSAccessor {
@@ -8,7 +8,7 @@ use Padre::Wx ();
use Padre::Wx::Icon ();
use Padre::Logger;
-our $VERSION = '0.63';
+our $VERSION = '0.66';
our @ISA = 'Wx::ListView';
sub new {
@@ -4,7 +4,7 @@ use 5.008;
use strict;
use warnings;
-our $VERSION = '0.63';
+our $VERSION = '0.66';
use Padre::Wx ();
use Padre::Logger;
@@ -3,14 +3,14 @@ package Padre::Wx::Dialog::Advanced;
use 5.008;
use strict;
use warnings;
-use Padre::Constant ();
-use Padre::Config ();
-use Padre::Wx ();
-use Padre::Wx::Role::MainChild ();
+use Padre::Constant ();
+use Padre::Config ();
+use Padre::Wx ();
+use Padre::Wx::Role::Main ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
our @ISA = qw{
- Padre::Wx::Role::MainChild
+ Padre::Wx::Role::Main
Wx::Dialog
};
@@ -7,7 +7,7 @@ use Padre::DB ();
use Padre::Wx ();
use Padre::Wx::Dialog ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
# workaround: need to be accessible from outside in oder to write unit test ( t/03-wx.t )
# TO DO - Don't store run-time data in package lexicals
@@ -4,12 +4,12 @@ use 5.008;
use strict;
use warnings;
use File::Basename;
-use Padre::Wx ();
-use Padre::Wx::Role::MainChild ();
+use Padre::Wx ();
+use Padre::Wx::Role::Main ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
our @ISA = qw{
- Padre::Wx::Role::MainChild
+ Padre::Wx::Role::Main
Wx::Dialog
};
@@ -6,7 +6,7 @@ use warnings;
use Padre::Wx ();
use Padre::Wx::Dialog ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
# Encode document to System Default
# Encode document to utf-8
@@ -6,7 +6,7 @@ use warnings;
use Padre::Wx ();
use Padre::Wx::Icon ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
our @ISA = 'Wx::Dialog';
use Class::XSAccessor {
@@ -22,13 +22,13 @@ use Padre::Current ();
use Padre::Search ();
use Padre::DB ();
use Padre::Wx ();
-use Padre::Wx::Role::MainChild ();
+use Padre::Wx::Role::Main ();
use Padre::Wx::History::ComboBox ();
use Padre::Wx::FindResult ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
our @ISA = qw{
- Padre::Wx::Role::MainChild
+ Padre::Wx::Role::Main
Wx::Dialog
};
@@ -3,13 +3,13 @@ package Padre::Wx::Dialog::Form;
use 5.008;
use strict;
use warnings;
-use Padre::Wx ();
-use Padre::Wx::Role::MainChild ();
-use Padre::Locale ();
+use Padre::Wx ();
+use Padre::Wx::Role::Main ();
+use Padre::Locale ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
our @ISA = qw{
- Padre::Wx::Role::MainChild
+ Padre::Wx::Role::Main
Wx::Dialog
};
@@ -3,12 +3,12 @@ package Padre::Wx::Dialog::Goto;
use 5.008;
use strict;
use warnings;
-use Padre::Wx ();
-use Padre::Wx::Role::MainChild ();
+use Padre::Wx ();
+use Padre::Wx::Role::Main ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
our @ISA = qw{
- Padre::Wx::Role::MainChild
+ Padre::Wx::Role::Main
Wx::Dialog
};
@@ -8,7 +8,7 @@ use warnings;
use Padre::Wx ();
use Padre::Wx::HtmlWindow ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
our @ISA = 'Wx::Frame';
sub new {
@@ -5,7 +5,7 @@ use strict;
use warnings;
# package exports and version
-our $VERSION = '0.63';
+our $VERSION = '0.66';
our @ISA = 'Wx::Dialog';
# module imports
@@ -3,14 +3,14 @@ package Padre::Wx::Dialog::KeyBindings;
use 5.008;
use strict;
use warnings;
-use Padre::Constant ();
-use Padre::Config ();
-use Padre::Wx ();
-use Padre::Wx::Role::MainChild ();
+use Padre::Constant ();
+use Padre::Config ();
+use Padre::Wx ();
+use Padre::Wx::Role::Main ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
our @ISA = qw{
- Padre::Wx::Role::MainChild
+ Padre::Wx::Role::Main
Wx::Dialog
};
@@ -10,7 +10,7 @@ use File::Spec ();
use Padre::Wx ();
use Padre::Wx::Dialog ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
our %license_id = ( # TODO: check for other module builders as well
Wx::gettext('Apache License') => 'apache', ## TODO: does not work w/ Module::Build
@@ -3,39 +3,27 @@ package Padre::Wx::Dialog::OpenResource;
use 5.008;
use strict;
use warnings;
-use Cwd ();
-use Padre::DB ();
-use Padre::Wx ();
-use Padre::Wx::Icon ();
-use Padre::MimeTypes ();
-
-our $VERSION = '0.63';
+use Cwd ();
+use Padre::DB ();
+use Padre::Wx ();
+use Padre::Wx::Icon ();
+use Padre::Wx::Role::Main ();
+use Padre::MimeTypes ();
+use Padre::Role::Task ();
+
+our $VERSION = '0.66';
our @ISA = qw{
- Padre::Wx::Role::MainChild
+ Padre::Role::Task
+ Padre::Wx::Role::Main
Wx::Dialog
};
-use Class::XSAccessor {
- accessors => {
- _sizer => '_sizer', # window sizer
- _search_text => '_search_text', # search text control
- _matches_list => '_matches_list', # matches list
- _status_text => '_status_text', # status label
- _directory => '_directory', # searched directory
- _matched_files => '_matched_files', # matched files list
- _copy_button => '_copy_button', # copy button
- _popup_button => '_popup_button', # popup button for options
- _popup_menu => '_popup_menu', # options popup menu
- _skip_vcs_files => '_skip_vcs_files', # Skip VCS files menu item
- _skip_using_manifest_skip => '_skip_using_manifest_skip', # Skip using MANIFEST.SKIP menu item
- }
-};
-
# -- constructor
sub new {
- my ( $class, $main ) = @_;
+ my $class = shift;
+ my $main = shift;
- # create object
+ # Create object
my $self = $class->SUPER::new(
$main,
-1,
@@ -50,7 +38,7 @@ sub new {
# Dialog's icon as is the same as Padre
$self->SetIcon(Padre::Wx::Icon::PADRE);
- # create dialog
+ # Create dialog
$self->_create;
return $self;
@@ -61,33 +49,29 @@ sub new {
# Initialize search
#
sub init_search {
- my $self = shift;
-
- #Check if we have an open file so we can use its directory
- my $doc = $self->current->document;
- my $filename = ( defined $doc ) ? $doc->filename : undef;
- my $dir;
- if ($filename) {
-
- # current document's project or base directory
- $dir = Padre::Util::get_project_dir($filename)
- || File::Basename::dirname($filename);
- } else {
+ my $self = shift;
+ my $current = $self->current;
+ my $document = $current->document;
+ my $filename = $current->filename;
- # current working directory
- $dir = Cwd::getcwd();
- }
+ # Check if we have an open file so we can use its directory
+ my $directory = $filename
+ # Current document's project or base directory
+ ? Padre::Util::get_project_dir($filename)
+ || File::Basename::dirname($filename)
- my $old_dir = $self->_directory;
- if ( $old_dir && $old_dir ne $dir ) {
+ # Current working directory
+ : Cwd::getcwd();
- # Restart search if the project/current directory is different
- $self->_matched_files(undef);
+ # Restart search if the project/current directory is different
+ my $previous = $self->{directory};
+ if ( $previous && $previous ne $directory ) {
+ $self->{matched_files} = undef;
}
- $self->_directory($dir);
- $self->SetLabel( Wx::gettext('Open Resource') . ' - ' . $dir );
+ $self->{directory} = $directory;
+ $self->SetLabel( Wx::gettext('Open Resource') . ' - ' . $directory );
}
# -- event handler
@@ -95,26 +79,30 @@ sub init_search {
#
# handler called when the ok button has been clicked.
#
-sub _on_ok_button_clicked {
- my ($self) = @_;
-
+sub ok_button {
+ my $self = shift;
my $main = $self->main;
+
$self->Hide;
#Open the selected resources here if the user pressed OK
- my @selections = $self->_matches_list->GetSelections();
+ my @selections = $self->{matches_list}->GetSelections;
foreach my $selection (@selections) {
- my $filename = $self->_matches_list->GetClientData($selection);
+ my $filename = $self->{matches_list}->GetClientData($selection);
# Fetch the recently used files from the database
require Padre::DB::RecentlyUsed;
- my $recently_used = Padre::DB::RecentlyUsed->select( "where type = ? and value = ?", 'RESOURCE', $filename )
- || [];
+ my $recently_used = Padre::DB::RecentlyUsed->select(
+ "where type = ? and value = ?",
+ 'RESOURCE',
+ $filename,
+ ) || [];
+
my $found = scalar @$recently_used > 0;
eval {
- # try to open the file now
+ # Try to open the file now
if ( my $id = $main->find_editor_of_file($filename) ) {
my $page = $main->notebook->GetPage($id);
$page->SetFocus;
@@ -133,18 +121,18 @@ sub _on_ok_button_clicked {
# And insert a recently used tuple if it is not found
# and the action is successful.
- if ( not $found ) {
+ if ($found) {
+ Padre::DB->do(
+ "update recently_used set last_used = ? where name = ? and type = ?",
+ {}, time(), $filename, 'RESOURCE',
+ );
+ } else {
Padre::DB::RecentlyUsed->create(
name => $filename,
value => $filename,
type => 'RESOURCE',
last_used => time(),
);
- } else {
- Padre::DB->do(
- "update recently_used set last_used = ? where name = ? and type = ?",
- {}, time(), $filename, 'RESOURCE',
- );
}
}
}
@@ -158,11 +146,10 @@ sub _on_ok_button_clicked {
# create the dialog itself.
#
sub _create {
- my ($self) = @_;
+ my $self = shift;
# create sizer that will host all controls
- my $sizer = Wx::BoxSizer->new(Wx::wxVERTICAL);
- $self->_sizer($sizer);
+ $self->{sizer} = Wx::BoxSizer->new(Wx::wxVERTICAL);
# create the controls
$self->_create_controls;
@@ -170,7 +157,7 @@ sub _create {
# wrap everything in a vbox to add some padding
$self->SetMinSize( [ 360, 340 ] );
- $self->SetSizer($sizer);
+ $self->SetSizer( $self->{sizer} );
# center/fit the dialog
$self->Fit;
@@ -181,112 +168,125 @@ sub _create {
# create the buttons pane.
#
sub _create_buttons {
- my ($self) = @_;
- my $sizer = $self->_sizer;
+ my $self = shift;
$self->{ok_button} = Wx::Button->new(
- $self, Wx::wxID_OK, Wx::gettext('&OK'),
+ $self,
+ Wx::wxID_OK,
+ Wx::gettext('&OK'),
);
$self->{ok_button}->SetDefault;
$self->{cancel_button} = Wx::Button->new(
- $self, Wx::wxID_CANCEL, Wx::gettext('&Cancel'),
+ $self,
+ Wx::wxID_CANCEL,
+ Wx::gettext('&Cancel'),
);
my $buttons = Wx::BoxSizer->new(Wx::wxHORIZONTAL);
$buttons->AddStretchSpacer;
$buttons->Add( $self->{ok_button}, 0, Wx::wxALL | Wx::wxEXPAND, 5 );
$buttons->Add( $self->{cancel_button}, 0, Wx::wxALL | Wx::wxEXPAND, 5 );
- $sizer->Add( $buttons, 0, Wx::wxALL | Wx::wxEXPAND | Wx::wxALIGN_CENTER, 5 );
+ $self->{sizer}->Add( $buttons, 0, Wx::wxALL | Wx::wxEXPAND | Wx::wxALIGN_CENTER, 5 );
- Wx::Event::EVT_BUTTON( $self, Wx::wxID_OK, \&_on_ok_button_clicked );
+ Wx::Event::EVT_BUTTON( $self, Wx::wxID_OK, \&ok_button );
}
#
# create controls in the dialog
#
sub _create_controls {
- my ($self) = @_;
+ my $self = shift;
# search textbox
my $search_label = Wx::StaticText->new(
- $self, -1,
+ $self,
+ -1,
Wx::gettext('&Select an item to open (? = any character, * = any string):')
);
- $self->_search_text(
- Wx::TextCtrl->new(
- $self, -1, '',
- Wx::wxDefaultPosition, Wx::wxDefaultSize,
- )
+ $self->{search_text} = Wx::TextCtrl->new(
+ $self,
+ -1,
+ '',
+ Wx::wxDefaultPosition,
+ Wx::wxDefaultSize,
);
# matches result list
my $matches_label = Wx::StaticText->new(
- $self, -1,
+ $self,
+ -1,
Wx::gettext('&Matching Items:')
);
- $self->_matches_list(
- Wx::ListBox->new(
- $self, -1, Wx::wxDefaultPosition, Wx::wxDefaultSize, [],
- Wx::wxLB_EXTENDED
- )
+ $self->{matches_list} = Wx::ListBox->new(
+ $self,
+ -1,
+ Wx::wxDefaultPosition,
+ Wx::wxDefaultSize,
+ [],
+ Wx::wxLB_EXTENDED,
);
# Shows how many items are selected and information about what is selected
- $self->_status_text(
- Wx::TextCtrl->new(
- $self, -1, Wx::gettext('Current Directory: ') . $self->_directory,
- Wx::wxDefaultPosition, Wx::wxDefaultSize, Wx::wxTE_READONLY
- )
+ $self->{status_text} = Wx::TextCtrl->new(
+ $self,
+ -1,
+ Wx::gettext('Current Directory: ') . $self->{directory},
+ Wx::wxDefaultPosition,
+ Wx::wxDefaultSize,
+ Wx::wxTE_READONLY,
);
my $folder_image = Wx::StaticBitmap->new(
- $self, -1,
+ $self,
+ -1,
Padre::Wx::Icon::find("places/stock_folder")
);
- $self->_copy_button(
- Wx::BitmapButton->new(
- $self, -1,
- Padre::Wx::Icon::find("actions/edit-copy")
- )
+ $self->{copy_button} = Wx::BitmapButton->new(
+ $self,
+ -1,
+ Padre::Wx::Icon::find("actions/edit-copy"),
);
+ $self->{popup_button} = Wx::BitmapButton->new(
+ $self,
+ -1,
+ Padre::Wx::Icon::find("actions/down")
+ );
- $self->_popup_button(
- Wx::BitmapButton->new(
- $self, -1,
- Padre::Wx::Icon::find("actions/down")
- )
+ $self->{popup_menu} = Wx::Menu->new;
+ $self->{skip_vcs_files} = $self->{popup_menu}->AppendCheckItem(
+ -1,
+ Wx::gettext("Skip version control system files"),
+ );
+ $self->{skip_using_manifest_skip} = $self->{popup_menu}->AppendCheckItem(
+ -1,
+ Wx::gettext("Skip using MANIFEST.SKIP"),
);
- $self->_popup_menu( Wx::Menu->new );
- $self->_skip_vcs_files(
- $self->_popup_menu->AppendCheckItem( -1, Wx::gettext("Skip version control system files") ) );
- $self->_skip_using_manifest_skip(
- $self->_popup_menu->AppendCheckItem( -1, Wx::gettext("Skip using MANIFEST.SKIP") ) );
- $self->_skip_vcs_files->Check(1);
- $self->_skip_using_manifest_skip->Check(1);
+ $self->{skip_vcs_files}->Check(1);
+ $self->{skip_using_manifest_skip}->Check(1);
my $hb;
- $self->_sizer->AddSpacer(10);
- $self->_sizer->Add( $search_label, 0, Wx::wxALL | Wx::wxEXPAND, 2 );
+ $self->{sizer}->AddSpacer(10);
+ $self->{sizer}->Add( $search_label, 0, Wx::wxALL | Wx::wxEXPAND, 2 );
$hb = Wx::BoxSizer->new(Wx::wxHORIZONTAL);
$hb->AddSpacer(2);
- $hb->Add( $self->_search_text, 1, Wx::wxALIGN_CENTER_VERTICAL, 2 );
- $hb->Add( $self->_popup_button, 0, Wx::wxALL | Wx::wxEXPAND, 2 );
+ $hb->Add( $self->{search_text}, 1, Wx::wxALIGN_CENTER_VERTICAL, 2 );
+ $hb->Add( $self->{popup_button}, 0, Wx::wxALL | Wx::wxEXPAND, 2 );
$hb->AddSpacer(1);
- $self->_sizer->Add( $hb, 0, Wx::wxBOTTOM | Wx::wxEXPAND, 5 );
- $self->_sizer->Add( $matches_label, 0, Wx::wxALL | Wx::wxEXPAND, 2 );
- $self->_sizer->Add( $self->_matches_list, 1, Wx::wxALL | Wx::wxEXPAND, 2 );
+ $self->{sizer}->Add( $hb, 0, Wx::wxBOTTOM | Wx::wxEXPAND, 5 );
+ $self->{sizer}->Add( $matches_label, 0, Wx::wxALL | Wx::wxEXPAND, 2 );
+ $self->{sizer}->Add( $self->{matches_list}, 1, Wx::wxALL | Wx::wxEXPAND, 2 );
$hb = Wx::BoxSizer->new(Wx::wxHORIZONTAL);
$hb->AddSpacer(2);
- $hb->Add( $folder_image, 0, Wx::wxALL | Wx::wxEXPAND, 1 );
- $hb->Add( $self->_status_text, 1, Wx::wxALIGN_CENTER_VERTICAL, 1 );
- $hb->Add( $self->_copy_button, 0, Wx::wxALL | Wx::wxEXPAND, 1 );
+ $hb->Add( $folder_image, 0, Wx::wxALL | Wx::wxEXPAND, 1 );
+ $hb->Add( $self->{status_text}, 1, Wx::wxALIGN_CENTER_VERTICAL, 1 );
+ $hb->Add( $self->{copy_button}, 0, Wx::wxALL | Wx::wxEXPAND, 1 );
$hb->AddSpacer(1);
- $self->_sizer->Add( $hb, 0, Wx::wxBOTTOM | Wx::wxEXPAND, 5 );
- $self->_setup_events();
+ $self->{sizer}->Add( $hb, 0, Wx::wxBOTTOM | Wx::wxEXPAND, 5 );
+ $self->_setup_events;
return;
}
@@ -298,13 +298,13 @@ sub _setup_events {
my $self = shift;
Wx::Event::EVT_CHAR(
- $self->_search_text,
+ $self->{search_text},
sub {
my $this = shift;
my $event = shift;
my $code = $event->GetKeyCode;
- $self->_matches_list->SetFocus
+ $self->{matches_list}->SetFocus
if ( $code == Wx::WXK_DOWN )
or ( $code == Wx::WXK_NUMPAD_PAGEDOWN )
or ( $code == Wx::WXK_PAGEDOWN );
@@ -315,34 +315,33 @@ sub _setup_events {
Wx::Event::EVT_TEXT(
$self,
- $self->_search_text,
+ $self->{search_text},
sub {
-
- if ( not $self->_matched_files ) {
- $self->_search();
+ unless ( $self->{matched_files} ) {
+ $self->search;
}
- $self->_update_matches_list_box;
-
+ $self->render;
return;
}
);
Wx::Event::EVT_LISTBOX(
$self,
- $self->_matches_list,
+ $self->{matches_list},
sub {
my $self = shift;
- my @matches = $self->_matches_list->GetSelections();
+ my @matches = $self->{matches_list}->GetSelections;
my $num_selected = scalar @matches;
if ( $num_selected == 1 ) {
- $self->_status_text->ChangeValue( $self->_path( $self->_matches_list->GetClientData( $matches[0] ) ) );
- $self->_copy_button->Enable(1);
+ $self->{status_text}
+ ->ChangeValue( $self->_path( $self->{matches_list}->GetClientData( $matches[0] ) ) );
+ $self->{copy_button}->Enable(1);
} elsif ( $num_selected > 1 ) {
- $self->_status_text->ChangeValue( $num_selected . " items selected" );
- $self->_copy_button->Enable(0);
+ $self->{status_text}->ChangeValue( $num_selected . " items selected" );
+ $self->{copy_button}->Enable(0);
} else {
- $self->_status_text->ChangeValue('');
- $self->_copy_button->Enable(0);
+ $self->{status_text}->ChangeValue('');
+ $self->{copy_button}->Enable(0);
}
return;
@@ -351,23 +350,23 @@ sub _setup_events {
Wx::Event::EVT_LISTBOX_DCLICK(
$self,
- $self->_matches_list,
+ $self->{matches_list},
sub {
- $self->_on_ok_button_clicked();
+ $self->ok_button;
}
);
Wx::Event::EVT_BUTTON(
$self,
- $self->_copy_button,
+ $self->{copy_button},
sub {
- my @matches = $self->_matches_list->GetSelections();
+ my @matches = $self->{matches_list}->GetSelections();
my $num_selected = scalar @matches;
if ( $num_selected == 1 ) {
- if ( Wx::wxTheClipboard->Open() ) {
+ if ( Wx::wxTheClipboard->Open ) {
Wx::wxTheClipboard->SetData(
- Wx::TextDataObject->new( $self->_matches_list->GetClientData( $matches[0] ) ) );
- Wx::wxTheClipboard->Close();
+ Wx::TextDataObject->new( $self->{matches_list}->GetClientData( $matches[0] ) ) );
+ Wx::wxTheClipboard->Close;
}
}
}
@@ -375,24 +374,28 @@ sub _setup_events {
Wx::Event::EVT_MENU(
$self,
- $self->_skip_vcs_files,
- sub { $self->_restart_search; },
+ $self->{skip_vcs_files},
+ sub {
+ $self->restart;
+ },
);
Wx::Event::EVT_MENU(
$self,
- $self->_skip_using_manifest_skip,
- sub { $self->_restart_search; },
+ $self->{skip_using_manifest_skip},
+ sub {
+ $self->restart;
+ },
);
Wx::Event::EVT_BUTTON(
$self,
- $self->_popup_button,
+ $self->{popup_button},
sub {
my ( $self, $event ) = @_;
$self->PopupMenu(
- $self->_popup_menu,
- $self->_popup_button->GetPosition->x,
- $self->_popup_button->GetPosition->y + $self->_popup_button->GetSize->GetHeight
+ $self->{popup_menu},
+ $self->{popup_button}->GetPosition->x,
+ $self->{popup_button}->GetPosition->y + $self->{popup_button}->GetSize->GetHeight
);
}
);
@@ -403,10 +406,10 @@ sub _setup_events {
#
# Restarts search
#
-sub _restart_search {
+sub restart {
my $self = shift;
- $self->_search();
- $self->_update_matches_list_box;
+ $self->search;
+ $self->render;
}
#
@@ -425,13 +428,13 @@ sub show {
my $selection = $editor->GetSelectedText;
my $selection_length = length $selection;
if ( $selection_length > 0 ) {
- $self->_search_text->ChangeValue($selection);
- $self->_restart_search;
+ $self->{search_text}->ChangeValue($selection);
+ $self->restart;
} else {
- $self->_search_text->ChangeValue('');
+ $self->{search_text}->ChangeValue('');
}
} else {
- $self->_search_text->ChangeValue('');
+ $self->{search_text}->ChangeValue('');
}
$self->_show_recent_while_idle;
@@ -452,7 +455,7 @@ sub _show_recent_while_idle {
$self->_show_recently_opened_resources;
# focus on the search text box
- $self->_search_text->SetFocus;
+ $self->{search_text}->SetFocus;
# unregister from idle event
Wx::Event::EVT_IDLE( $self, undef );
@@ -468,7 +471,7 @@ sub _show_recently_opened_resources {
# Fetch them from Padre's RecentlyUsed database table
require Padre::DB::RecentlyUsed;
- my $recently_used = Padre::DB::RecentlyUsed->select( "where type = ?", 'RESOURCE' ) || [];
+ my $recently_used = Padre::DB::RecentlyUsed->select( 'where type = ?', 'RESOURCE' ) || [];
my @recent_files = ();
foreach my $e (@$recently_used) {
push @recent_files, $self->_path( $e->value );
@@ -476,53 +479,60 @@ sub _show_recently_opened_resources {
@recent_files = sort { File::Basename::fileparse($a) cmp File::Basename::fileparse($b) } @recent_files;
# Show results in matching items list
- $self->_matched_files( \@recent_files );
- $self->_update_matches_list_box;
+ $self->{matched_files} = \@recent_files;
+ $self->render;
# No need to store them anymore
- $self->_matched_files(undef);
+ $self->{matched_files} = undef;
}
#
# Search for files and cache result
#
-sub _search {
+sub search {
my $self = shift;
- $self->_status_text->ChangeValue( Wx::gettext("Reading items. Please wait...") );
+ $self->{status_text}->ChangeValue( Wx::gettext('Reading items. Please wait...') );
- require Padre::Task::OpenResource::SearchTask;
- my $search_task = Padre::Task::OpenResource::SearchTask->new(
- dialog => $self,
- directory => $self->_directory,
- skip_vcs_files => $self->_skip_vcs_files->IsChecked,
- skip_using_manifest_skip => $self->_skip_using_manifest_skip->IsChecked,
+ # Kick off the resource search
+ $self->task_request(
+ task => 'Padre::Task::OpenResource',
+ directory => $self->{directory},
+ skip_vcs_files => $self->{skip_vcs_files}->IsChecked,
+ skip_using_manifest_skip => $self->{skip_using_manifest_skip}->IsChecked,
);
- $search_task->schedule;
return;
}
+sub task_response {
+ my $self = shift;
+ my $task = shift;
+ my $matched = $task->{matched} or return;
+ $self->{matched_files} = $matched;
+ $self->render;
+ return 1;
+}
+
#
# Update matches list box from matched files list
#
-sub _update_matches_list_box {
+sub render {
my $self = shift;
+ return unless $self->{matched_files};
- return if not $self->_matched_files;
-
- my $search_expr = $self->_search_text->GetValue();
+ my $search_expr = $self->{search_text}->GetValue;
- #quote the search string to make it safer
- #and then tranform * and ? into .* and .
+ # Quote the search string to make it safer
+ # and then tranform * and ? into .* and .
$search_expr = quotemeta $search_expr;
$search_expr =~ s/\\\*/.*?/g;
$search_expr =~ s/\\\?/./g;
#Populate the list box now
- $self->_matches_list->Clear();
+ $self->{matches_list}->Clear;
my $pos = 0;
- foreach my $file ( @{ $self->_matched_files } ) {
+ foreach my $file ( @{ $self->{matched_files} } ) {
my $filename = File::Basename::fileparse($file);
if ( $filename =~ /^$search_expr/i ) {
@@ -535,20 +545,20 @@ sub _update_matches_list_box {
$pkg = " ($1)";
}
}
- $self->_matches_list->Insert( $filename . $pkg, $pos, $file );
+ $self->{matches_list}->Insert( $filename . $pkg, $pos, $file );
$pos++;
}
}
if ( $pos > 0 ) {
- $self->_matches_list->Select(0);
- $self->_status_text->ChangeValue( $self->_path( $self->_matches_list->GetClientData(0) ) );
- $self->_status_text->Enable(1);
- $self->_copy_button->Enable(1);
+ $self->{matches_list}->Select(0);
+ $self->{status_text}->ChangeValue( $self->_path( $self->{matches_list}->GetClientData(0) ) );
+ $self->{status_text}->Enable(1);
+ $self->{copy_button}->Enable(1);
$self->{ok_button}->Enable(1);
} else {
- $self->_status_text->ChangeValue('');
- $self->_status_text->Enable(0);
- $self->_copy_button->Enable(0);
+ $self->{status_text}->ChangeValue('');
+ $self->{status_text}->Enable(0);
+ $self->{copy_button}->Enable(0);
$self->{ok_button}->Enable(0);
}
@@ -559,7 +569,8 @@ sub _update_matches_list_box {
# Cleans a path on various platforms
#
sub _path {
- my ( $self, $path ) = @_;
+ my $self = shift;
+ my $path = shift;
if (Padre::Constant::WIN32) {
$path =~ s/\//\\/g;
}
@@ -570,6 +581,8 @@ sub _path {
__END__
+=pod
+
=head1 NAME
Padre::Wx::Dialog::OpenResource - Open Resource dialog
@@ -589,7 +602,7 @@ You can simply ignore F<CVS>, F<.svn> and F<.git> folders using a simple check-b
=head1 AUTHOR
-Ahmad M. Zawawi C<< <ahmad.zawawi at gmail.com> >>
+Ahmad M. Zawawi E<lt>ahmad.zawawi at gmail.comE<gt>
=head1 COPYRIGHT & LICENSE
@@ -3,12 +3,12 @@ package Padre::Wx::Dialog::OpenURL;
use 5.008;
use strict;
use warnings;
-use Padre::Wx ();
-use Padre::Wx::Role::MainChild ();
+use Padre::Wx ();
+use Padre::Wx::Role::Main ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
our @ISA = qw{
- Padre::Wx::Role::MainChild
+ Padre::Wx::Role::Main
Wx::Dialog
};
@@ -5,14 +5,14 @@ package Padre::Wx::Dialog::PluginManager;
use 5.008;
use strict;
use warnings;
-use Carp ();
-use Padre::Wx ();
-use Padre::Wx::Icon ();
-use Padre::Wx::Role::MainChild ();
+use Carp ();
+use Padre::Wx ();
+use Padre::Wx::Icon ();
+use Padre::Wx::Role::Main ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
our @ISA = qw{
- Padre::Wx::Role::MainChild
+ Padre::Wx::Role::Main
Wx::Dialog
};
@@ -190,6 +190,8 @@ sub new {
$self->Fit;
$self->CentreOnParent;
+ $self->{list}->SetFocus;
+
return $self;
}
@@ -233,8 +235,8 @@ sub list_item_selected {
$self->{label}->SetLabel( $plugin->plugin_name );
# Update plug-in documentation
- require Padre::DocBrowser;
- my $browser = Padre::DocBrowser->new;
+ require Padre::Browser;
+ my $browser = Padre::Browser->new;
my $class = $plugin->class;
my $doc = $browser->resolve($class);
my $output = eval { $browser->browse($doc) };
@@ -6,7 +6,7 @@ use warnings;
use Padre::Wx::Editor;
-our $VERSION = '0.63';
+our $VERSION = '0.66';
our @ISA = 'Padre::Wx::Editor';
sub main {
@@ -6,7 +6,7 @@ use warnings;
use Padre::Wx::Dialog::Preferences ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
our @ISA = 'Padre::Wx::Dialog::Preferences';
=pod
@@ -5,7 +5,7 @@ use strict;
use warnings;
use Padre::Wx::Dialog::Preferences ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
our @ISA = 'Padre::Wx::Dialog::Preferences';
sub panel {
@@ -10,7 +10,7 @@ use Padre::Wx::Editor ();
use Padre::Wx::Dialog::Preferences::Editor ();
use Padre::MimeTypes ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
our @ISA = 'Padre::Wx::Dialog';
our %PANELS = (
@@ -3,16 +3,17 @@ package Padre::Wx::Dialog::QuickMenuAccess;
use 5.008;
use strict;
use warnings;
-use Padre::Util ();
-use Padre::DB ();
-use Padre::Wx ();
-use Padre::Wx::Icon ();
+use Padre::Util ();
+use Padre::DB ();
+use Padre::Wx ();
+use Padre::Wx::Icon ();
+use Padre::Wx::Role::Main ();
use Padre::Logger;
# package exports and version
-our $VERSION = '0.63';
+our $VERSION = '0.66';
our @ISA = qw{
- Padre::Wx::Role::MainChild
+ Padre::Wx::Role::Main
Wx::Dialog
};
@@ -10,7 +10,7 @@ use warnings;
use Padre::Wx ();
use Padre::Wx::Icon ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
our @ISA = 'Wx::Dialog';
use Class::XSAccessor {
@@ -5,16 +5,16 @@ package Padre::Wx::Dialog::RegexEditor;
use 5.008;
use strict;
use warnings;
-use Padre::Wx ();
-use Padre::Wx::Icon ();
-use Padre::Wx::Role::MainChild ();
+use Padre::Wx ();
+use Padre::Wx::Icon ();
+use Padre::Wx::Role::Main ();
# RichTextCtrl
use Wx::RichText ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
our @ISA = qw{
- Padre::Wx::Role::MainChild
+ Padre::Wx::Role::Main
Wx::Dialog
};
@@ -21,12 +21,12 @@ use Params::Util qw{_STRING};
use Padre::Current ();
use Padre::DB ();
use Padre::Wx ();
-use Padre::Wx::Role::MainChild ();
+use Padre::Wx::Role::Main ();
use Padre::Wx::History::ComboBox ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
our @ISA = qw{
- Padre::Wx::Role::MainChild
+ Padre::Wx::Role::Main
Wx::Dialog
};
@@ -8,7 +8,7 @@ use warnings;
use Padre::Wx ();
use Padre::Wx::Icon ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
######################################################################
# Constructor
@@ -9,7 +9,7 @@ use POSIX qw{ strftime };
use Padre::Wx ();
use Padre::Wx::Icon ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
our @ISA = 'Wx::Dialog';
use Class::XSAccessor {
@@ -6,7 +6,7 @@ use warnings;
use Padre::Wx ();
use Padre::Wx::Icon ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
our @ISA = 'Wx::Dialog';
use Class::XSAccessor {
@@ -3,13 +3,13 @@ package Padre::Wx::Dialog::Shortcut;
use 5.008;
use strict;
use warnings;
-use Padre::Wx ();
-use Padre::Wx::Role::MainChild ();
-use Padre::Locale ();
+use Padre::Wx ();
+use Padre::Wx::Role::Main ();
+use Padre::Locale ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
our @ISA = qw{
- Padre::Wx::Role::MainChild
+ Padre::Wx::Role::Main
Wx::Dialog
};
@@ -9,7 +9,7 @@ use Padre::Wx ();
use Padre::Wx::Dialog ();
use Padre::Current ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
sub get_layout {
my ($config) = @_;
@@ -9,7 +9,7 @@ use Padre::Wx ();
use Padre::Wx::Dialog ();
use Padre::Current ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
my $categories = {
Wx::gettext('Date/Time') => [
@@ -8,7 +8,7 @@ use Padre::Wx;
use Padre::Wx::Dialog;
use Wx::Locale qw(:default);
-our $VERSION = '0.63';
+our $VERSION = '0.66';
sub get_layout {
my ($text) = @_;
@@ -3,13 +3,13 @@ package Padre::Wx::Dialog::Warning;
use 5.008;
use strict;
use warnings;
-use Padre::Wx ();
-use Padre::Wx::Role::MainChild ();
-use Padre::Locale ();
+use Padre::Wx ();
+use Padre::Wx::Role::Main ();
+use Padre::Locale ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
our @ISA = qw{
- Padre::Wx::Role::MainChild
+ Padre::Wx::Role::Main
Wx::Dialog
};
@@ -3,21 +3,32 @@ package Padre::Wx::Dialog::WhereFrom;
use 5.008;
use strict;
use warnings;
-use Padre::Wx ();
-use Padre::Task::HTTPClient ();
+use Padre::Role::Task ();
+use Padre::Wx::Role::Main ();
+use Padre::Wx ();
+
+our $VERSION = '0.66';
+our @ISA = qw{
+ Padre::Role::Task
+ Padre::Wx::Role::Main
+ Wx::Dialog
+};
+
+use constant SERVER => 'http://perlide.org/popularity/v1/wherefrom.html';
-our $VERSION = '0.63';
-our @ISA = 'Wx::Dialog';
-sub new {
- my ( $class, $main ) = @_;
- my $config = $main->config;
- return if $config->feedback_done;
+
+######################################################################
+# Constructor
+
+sub new {
+ my $class = shift;
+ my $main = shift;
# Create the Wx dialog
- my $dialog = $class->SUPER::new(
+ my $self = $class->SUPER::new(
$main,
-1,
Wx::gettext('New installation survey'),
@@ -25,36 +36,50 @@ sub new {
Wx::wxDefaultSize,
Wx::wxDEFAULT_FRAME_STYLE,
);
-
- # Minimum dialog size
- $dialog->SetMinSize( [ 350, 100 ] );
+ $self->SetMinSize( [ 350, 100 ] );
# Create sizer that will host all controls
my $sizer = Wx::BoxSizer->new(Wx::wxHORIZONTAL);
# Create the controls
- $dialog->_create_controls($sizer);
+ $self->_create_controls($sizer);
- # Bind the control events
- $dialog->_bind_events;
+ # Ok button
+ Wx::Event::EVT_BUTTON(
+ $self,
+ $self->{button_ok},
+ sub {
+ $_[0]->button_ok( $_[1] );
+ },
+ );
+
+ # Cancel or Skip feedback button
+ Wx::Event::EVT_BUTTON(
+ $self,
+ $self->{button_cancel},
+ sub {
+ $_[0]->button_cancel( $_[1] );
+ },
+ );
# Wrap everything in a vbox to add some padding
- $dialog->SetSizer($sizer);
- $dialog->Fit;
- $dialog->CentreOnParent;
+ $self->SetSizer($sizer);
+ $self->Fit;
+ $self->CentreOnParent;
- $dialog->{wherefrom}->SetFocus;
- $dialog->Show(1);
+ $self->{from}->SetFocus;
+ $self->Show(1);
- return $dialog;
+ return $self;
}
sub _create_controls {
- my ( $dialog, $sizer ) = @_;
+ my $self = shift;
+ my $sizer = shift;
# "Where did you hear..." label
- my $wherefrom_label = Wx::StaticText->new(
- $dialog,
+ my $from_label = Wx::StaticText->new(
+ $self,
-1,
Wx::gettext('Where did you hear about Padre?')
);
@@ -70,8 +95,8 @@ sub _create_controls {
Wx::gettext('Other (Please fill in here)'),
];
- $dialog->{wherefrom} = Wx::ComboBox->new(
- $dialog,
+ $self->{from} = Wx::ComboBox->new(
+ $self,
-1,
'',
Wx::wxDefaultPosition,
@@ -80,32 +105,32 @@ sub _create_controls {
);
# OK button
- $dialog->{button_ok} = Wx::Button->new(
- $dialog, Wx::wxID_OK, Wx::gettext("OK"),
+ $self->{button_ok} = Wx::Button->new(
+ $self, Wx::wxID_OK, Wx::gettext("OK"),
);
- $dialog->{button_ok}->SetDefault;
+ $self->{button_ok}->SetDefault;
# Cancel button
- $dialog->{button_cancel} = Wx::Button->new(
- $dialog, Wx::wxID_CANCEL,
+ $self->{button_cancel} = Wx::Button->new(
+ $self, Wx::wxID_CANCEL,
Wx::gettext("Skip question without giving feedback"),
);
# where from...? sizer
- my $wherefrom_sizer = Wx::BoxSizer->new(Wx::wxHORIZONTAL);
- $wherefrom_sizer->Add( $wherefrom_label,, 0, Wx::wxALIGN_CENTER_VERTICAL, 5 );
- $wherefrom_sizer->AddSpacer(5);
- $wherefrom_sizer->Add( $dialog->{wherefrom}, 1, Wx::wxALIGN_CENTER_VERTICAL, 5 );
+ my $from_sizer = Wx::BoxSizer->new(Wx::wxHORIZONTAL);
+ $from_sizer->Add( $from_label,, 0, Wx::wxALIGN_CENTER_VERTICAL, 5 );
+ $from_sizer->AddSpacer(5);
+ $from_sizer->Add( $self->{from}, 1, Wx::wxALIGN_CENTER_VERTICAL, 5 );
# Button sizer
my $button_sizer = Wx::BoxSizer->new(Wx::wxHORIZONTAL);
- $button_sizer->Add( $dialog->{button_ok}, 0, 0, 0 );
- $button_sizer->Add( $dialog->{button_cancel}, 0, Wx::wxLEFT, 5 );
+ $button_sizer->Add( $self->{button_ok}, 0, 0, 0 );
+ $button_sizer->Add( $self->{button_cancel}, 0, Wx::wxLEFT, 5 );
$button_sizer->AddSpacer(5);
# Main vertical sizer
my $vsizer = Wx::BoxSizer->new(Wx::wxVERTICAL);
- $vsizer->Add( $wherefrom_sizer, 0, Wx::wxALL | Wx::wxEXPAND, 3 );
+ $vsizer->Add( $from_sizer, 0, Wx::wxALL | Wx::wxEXPAND, 3 );
$vsizer->AddSpacer(5);
$vsizer->Add( $button_sizer, 0, Wx::wxALIGN_RIGHT, 5 );
$vsizer->AddSpacer(5);
@@ -117,62 +142,44 @@ sub _create_controls {
}
-sub _bind_events {
- my $dialog = shift;
-
- # Ok button
- Wx::Event::EVT_BUTTON(
- $dialog,
- $dialog->{button_ok},
- \&WhereFrom_ok_clicked
- );
-
- # Cancel or Skip feedback button
- Wx::Event::EVT_BUTTON(
- $dialog,
- $dialog->{button_cancel},
- \&WhereFrom_cancel_clicked
- );
- return;
-}
-sub WhereFrom_cancel_clicked {
- my ( $dialog, $event ) = @_;
- my $config = Padre->ide->config;
+######################################################################
+# Event Handlers
- if ( !$config->feedback_done ) {
- $config->set( 'feedback_done', 1 );
- $config->write;
- }
+sub button_cancel {
+ my $self = shift;
+ my $event = shift;
+ my $config = $self->config;
+ $self->Destroy;
+ return if $config->feedback_done;
- $dialog->Destroy;
+ # Don't ask again
+ $config->set( feedback_done => 1 );
+ $config->write;
return;
}
-sub WhereFrom_ok_clicked {
- my ( $dialog, $event ) = @_;
-
- my $config = Padre->ide->config;
-
- my $window = $dialog->GetParent;
- $dialog->Destroy;
-
- if ( !$config->feedback_done ) {
-
- my $url = 'http://perlide.org/popularity/v1/wherefrom.html';
- my $args = { from => $dialog->{wherefrom}->GetValue };
- my $http = Padre::Task::HTTPClient->new(
- URL => $url,
- query => $args,
- )->run;
+sub button_ok {
+ my $self = shift;
+ my $event = shift;
+ my $from = $self->{from}->GetValue;
+ my $config = $self->config;
+ $self->Destroy;
+ return if $config->feedback_done;
- $config->set( 'feedback_done', 1 );
- $config->write;
+ # Fire and forget the HTTP request to the server
+ $self->task_request(
+ task => 'Padre::Task::LWP',
+ url => SERVER,
+ query => { from => $from },
+ );
- }
+ # Don't ask again
+ $config->set( feedback_done => 1 );
+ $config->write;
return;
}
@@ -9,7 +9,7 @@ use POSIX qw{ strftime };
use Padre::Wx ();
use Padre::Wx::Icon ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
our @ISA = 'Wx::Dialog';
use Class::XSAccessor {
@@ -5,7 +5,7 @@ use strict;
use warnings;
use Wx::Perl::Dialog ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
our @ISA = 'Wx::Perl::Dialog';
sub create_widget {
@@ -0,0 +1,123 @@
+package Padre::Wx::Directory::Path;
+
+use 5.008;
+use strict;
+use warnings;
+use File::Spec::Unix ();
+
+our $VERSION = '0.66';
+
+use constant {
+ FILE => 0,
+ DIRECTORY => 1,
+};
+
+
+
+
+
+######################################################################
+# Constructors
+
+sub file {
+ my $class = shift;
+ return bless [
+ FILE,
+ File::Spec::Unix->catfile(@_),
+ @_,
+ ], $class;
+}
+
+sub directory {
+ my $class = shift;
+ return bless [
+ DIRECTORY,
+ File::Spec::Unix->catfile(@_),
+ @_,
+ ], $class;
+}
+
+
+
+
+
+######################################################################
+# Main Methods
+
+sub type {
+ $_[0]->[0];
+}
+
+sub name {
+ $_[0]->[-1];
+}
+
+sub unix {
+ $_[0]->[1];
+}
+
+sub path {
+ @{ $_[0] }[ 2 .. $#{ $_[0] } ];
+}
+
+sub depth {
+ $#{ $_[0] } - 1;
+}
+
+sub is_file {
+ ( $_[0]->[0] == FILE ) ? 1 : 0;
+}
+
+sub is_directory {
+ ( $_[0]->[0] == DIRECTORY ) ? 1 : 0;
+}
+
+# Is this path the immediate parent of another path
+sub is_parent {
+ my $self = shift;
+ my $path = shift;
+
+ # If it is our child, it will be one element longer than us
+ unless ( @$path == @$self + 1 ) {
+ return 0;
+ }
+
+ # All the elements of our path will be identical in it
+ foreach my $i ( 2 .. $#$self ) {
+ return 0 unless $self->[$i] eq $path->[$i];
+ }
+
+ return 1;
+}
+
+# Compare two paths for the purpose of file sorting
+sub compare {
+ my $self = shift;
+ my $path = shift;
+ my $i = 1;
+ while ( ++$i ) {
+ my $left = $self->[$i];
+ my $right = $path->[$i];
+ unless ( defined $left ) {
+ return 0 unless defined $right;
+ return -1;
+ }
+ return 1 unless defined $right;
+
+ # Try to sort case insensitive first
+ my $result = ( lc($left) cmp lc($right) );
+ return $result if $result;
+
+ # To prevent nesting problems, repeat case sensitive
+ # before we descend to the next level.
+ $result = ( $left cmp $right ) or next;
+ return $result;
+ }
+}
+
+1;
+
+# Copyright 2008-2010 The Padre development team as listed in Padre.pm.
+# LICENSE
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl 5 itself.
@@ -1,546 +0,0 @@
-package Padre::Wx::Directory::SearchCtrl;
-
-use 5.008;
-use strict;
-use warnings;
-use Padre::Current ();
-use Padre::Wx ();
-
-our $VERSION = '0.63';
-our @ISA = 'Wx::SearchCtrl';
-
-# Create a new Search object and show a search text field above the tree
-sub new {
- my $class = shift;
- my $panel = shift;
- my $self = $class->SUPER::new(
- $panel, -1, '',
- Wx::wxDefaultPosition,
- Wx::wxDefaultSize,
- Wx::wxTE_PROCESS_ENTER
- );
-
- # Caches each project search WORD and result
- $self->{CACHED} = {};
-
- # Text that is showed when the search field is empty
- $self->SetDescriptiveText( Wx::gettext('Search') );
-
- # Setups the search box menu
- $self->SetMenu( $self->create_menu );
-
- # Setups events related with the search field
- Wx::Event::EVT_TEXT(
- $self, $self,
- \&_on_text
- );
-
- Wx::Event::EVT_SEARCHCTRL_CANCEL_BTN(
- $self, $self,
- sub {
- $self->SetValue('');
- }
- );
-
- Wx::Event::EVT_SET_FOCUS(
- $self,
- sub {
- $_[0]->parent->refresh;
- },
- );
-
- return $self;
-}
-
-# Returns the Directory Panel object reference
-sub parent {
- $_[0]->GetParent;
-}
-
-# Returns the main object reference
-sub main {
- $_[0]->GetParent->main;
-}
-
-# Traverse to the sibling tree widget
-sub tree {
- $_[0]->GetParent->tree;
-}
-
-sub current {
- Padre::Current->new( main => $_[0]->main );
-}
-
-# Called by Directory.pm
-sub refresh {
- my $self = shift;
- my $parent = $self->parent;
-
- # Gets the last and current actived projects
- my $project_dir = $parent->project_dir;
- my $previous_dir = $parent->previous_dir;
-
- # Compares if they are not the same, if not updates search field
- # content
- if ( defined($project_dir)
- and defined($previous_dir)
- and $previous_dir ne $project_dir )
- {
- $self->{use_cache} = 1;
- my $value = $self->{CACHED}->{$project_dir}->{value};
- $self->SetValue( defined $value ? $value : '' );
-
- # Checks the currently mode view
- my $mode = "sub_" . $parent->mode;
- $self->{$mode}->Check(1);
-
- # (Un)Checks current project Searcher Menu Skips options
- my $skips_hidden = $self->{_skip_hidden}->{$project_dir};
- my $skips_vcs = $self->{_skip_vcs}->{$project_dir};
-
- $self->{skip_hidden}->Check( defined $skips_hidden ? $skips_hidden : 1 );
- $self->{skip_vcs}->Check( defined $skips_vcs ? $skips_vcs : 1 );
- }
-}
-
-# Searchs recursively per items that matchs the REGEX typed in search field,
-# showing all items matched below the ROOT project directory will all the
-# folders that paths to them expanded.
-sub _search {
- my ( $self, $node ) = @_;
- my $parent = $self->parent;
- my $project_dir = $parent->project_dir;
-
- # Fetch the ignore criteria
- my $project = $self->current->project;
- my $rule = $project ? $project->ignore_rule : undef;
-
- # Check if it is to use the Cached search (in case of a project
- # switching)
- if ( $self->{use_cache} ) {
- delete $self->{use_cache};
- if ( defined $self->{CACHED}->{$project_dir}->{Data} ) {
- return $self->_display_cached_search(
- $node,
- $self->{CACHED}->{$project_dir}->{Data},
- );
- }
- }
-
- # If there is a Cached Word (in case that the user is still typing)
- if ( my $last_word = $self->{CACHED}->{$project_dir}->{value} ) {
-
- # Quotes meta characters
- $last_word = quotemeta($last_word);
-
- # If the typed word contains the cached word, use Cached result to do
- # the new search and returns the result
- if ( $self->GetValue =~ /$last_word/i ) {
- return $self->_search_in_cache(
- $node,
- $self->{CACHED}->{$project_dir}->{Data},
- );
- }
- }
-
- # Quotes meta characters
- my $word = quotemeta( $self->GetValue );
-
- # Gets the node's data and generates its path
- my $tree = $self->tree;
- my $node_data = $tree->GetPlData($node);
- my $path = File::Spec->catfile( $node_data->{dir}, $node_data->{name} );
-
- # Opens the current directory and sort its items by type and name
- my ( $dirs, $files ) = $tree->readdir($path);
-
- # Accept some regex like characters
- # ^ = begin with
- # $ = end with
- # * = any string
- # ? = any character
- $word =~ s/^\\\^/^/g;
- $word =~ s/\\\$$/\$/g;
- $word =~ s/\\\*/.*?/g;
- $word =~ s/\\\?/./g;
-
- # Filter the file list by the search criteria (but not the dir list)
- @$files = grep { $_ =~ /$word/i } @$files;
-
- # Search recursively inside each folder of the current folder
- my $found = scalar @$files;
- my @result = ();
- foreach (@$dirs) {
- my %temp = (
- name => $_,
- dir => $path,
- type => 'folder',
- );
-
- # Are we ignoring this directory
- if ( $self->{skip_hidden}->IsChecked ) {
- if ($rule) {
- local $_ = \%temp;
- unless ( $rule->() ) {
- next;
- }
- } elsif ( $temp{name} =~ /^\./ ) {
- next;
- }
- }
-
- # Skips VCS folders if selected to
- if ( $self->{skip_vcs}->IsChecked ) {
- if ( $temp{name} =~ /^(cvs|blib|\.(svn|git))$/i ) {
- next;
- }
- }
-
- # Creates each folder node
- my $new_folder = $tree->AppendItem(
- $node, $_, -1, -1,
- Wx::TreeItemData->new(
- { dir => $path,
- name => $_,
- type => 'folder',
- }
- )
- );
- $tree->SetItemImage(
- $new_folder,
- $tree->{file_types}->{folder},
- Wx::wxTreeItemIcon_Normal,
- );
-
- # Deletes the folder node if any file below it was found
- if ( @{ $temp{data} } = $self->_search($new_folder) ) {
- $found = 1;
- push @result, \%temp;
- } else {
- $tree->Delete($new_folder);
- }
- }
-
- # Adds each matched file
- foreach (@$files) {
- my $new_elem = $tree->AppendItem(
- $node, $_, -1, -1,
- Wx::TreeItemData->new(
- { name => $_,
- dir => $path,
- type => 'package',
- }
- )
- );
- $tree->SetItemImage(
- $new_elem,
- $tree->{file_types}->{package},
- Wx::wxTreeItemIcon_Normal,
- );
- push @result,
- {
- name => $_,
- dir => $path,
- type => 'package',
- };
- }
-
- # Returns 1 if any file above this path node was found or 0 and
- # deletes parent node if none
- return @result;
-}
-
-# Searchs recursively per items that matchs the REGEX typed in search field,
-# using the cached result. Only when the new word contains the lastest
-# searched word
-sub _search_in_cache {
- my $self = shift;
- my $node = shift;
- my $data = shift;
- my $tree = $self->tree;
-
- # Quotes meta characters
- my $word = quotemeta( $self->GetValue );
-
- # Accept some regex like characters
- # ^ = begin with
- # $ = end with
- # * = any string
- # ? = any character
- $word =~ s/^\\\^/^/g;
- $word =~ s/\\\$$/\$/g;
- $word =~ s/\\\*/.*?/g;
- $word =~ s/\\\?/./g;
-
- # Goes thought each item from $data, if is a folder , searchs
- # recursively inside it, if is a file tries to match its name
- my @result = ();
- foreach (@$data) {
-
- # If it is a folder, searchs recursively below it
- if ( defined $_->{data} ) {
- my %temp = (
- dir => $_->{dir},
- name => $_->{name},
- type => $_->{type}
- );
-
- # Creates each folder node
- my $new_folder = $tree->AppendItem(
- $node,
- $_->{name},
- $tree->{file_types}->{folder},
- -1,
- Wx::TreeItemData->new(
- { dir => $_->{dir},
- name => $_->{name},
- type => $_->{type},
- }
- )
- );
-
- # Deletes the folder node if any file below it was found
- if ( @{ $temp{data} } = $self->_search_in_cache( $new_folder, $_->{data} ) ) {
- push @result, \%temp;
- } else {
- $tree->Delete($new_folder);
- }
- } else {
-
- # Adds each matched file
- if ( $_->{name} =~ /$word/i ) {
- my $new_elem = $tree->AppendItem(
- $node,
- $_->{name},
- $tree->{file_types}->{package},
- -1,
- Wx::TreeItemData->new(
- { name => $_->{name},
- dir => $_->{dir},
- type => 'package',
- }
- )
- );
- push @result,
- {
- name => $_->{name},
- dir => $_->{dir},
- type => 'package',
- };
- }
- }
- }
-
- # Returns 1 if any file above this path node was found or 0 and
- # deletes parent node if none
- return @result;
-}
-
-# If was switched between projects, and the search is actived, use the cached
-# result set instead of doing the search again
-sub _display_cached_search {
- my ( $self, $node, $data ) = @_;
- my $tree = $self->tree;
- my $node_data = $tree->GetPlData($node);
- my $path = File::Spec->catfile( $node_data->{dir}, $node_data->{name} );
-
- # Files that matchs and Dirs arrays
- my @dirs = grep { $_->{type} eq 'folder' } @{$data};
- my @files = grep { $_->{type} eq 'package' } @{$data};
-
- # Search recursively inside each folder of the current folder
- for (@dirs) {
-
- # Creates each folder node
- my $new_folder = $tree->AppendItem(
- $node,
- $_->{name},
- $tree->{file_types}->{folder},
- -1,
- Wx::TreeItemData->new(
- { dir => $path,
- name => $_->{name},
- type => 'folder',
- }
- )
- );
-
- # Deletes the folder node if any file below it was found
- $self->_search( $new_folder, $_->{Data} );
- }
-
- # Adds each matched file
- foreach (@files) {
- my $new_elem = $tree->AppendItem(
- $node,
- $_->{name},
- $tree->{file_types}->{package},
- -1,
- Wx::TreeItemData->new(
- { dir => $path,
- name => $_->{name},
- type => 'package',
- }
- )
- );
- }
-
- return @{$data};
-}
-
-# Create the dropdown menu attached to the looking glass icon
-sub create_menu {
- my $self = shift;
- my $parent = $self->parent;
- my $project_dir = $parent->project_dir;
- my $menu = Wx::Menu->new;
-
- # Skip hidden files
- $self->{skip_hidden} = $menu->AppendCheckItem(
- -1,
- Wx::gettext('Skip hidden files')
- );
- $self->{skip_hidden}->Check(1);
-
- Wx::Event::EVT_MENU(
- $self,
- $self->{skip_hidden},
- sub {
- $self->{_skip_hidden}->{$project_dir} = $self->{skip_hidden}->IsChecked ? 1 : 0;
- },
- );
-
- # Skip CVS / .svn / blib and .git folders
- $self->{skip_vcs} = $menu->AppendCheckItem(
- -1,
- Wx::gettext('Skip CVS/.svn/.git/blib folders')
- );
- $self->{skip_vcs}->Check(1);
-
- Wx::Event::EVT_MENU(
- $self,
- $self->{skip_vcs},
- sub {
- $self->{_skip_vcs}->{$project_dir} = $self->{skip_vcs}->IsChecked ? 1 : 0;
- },
- );
- $menu->AppendSeparator();
-
- # Changes the project directory
- $self->{project_dir} = $menu->Append(
- -1,
- Wx::gettext('Change project directory')
- );
-
- Wx::Event::EVT_MENU(
- $self,
- $self->{project_dir},
- sub {
- $_[0]->parent->_change_project_dir;
- }
- );
-
- # Changes the Tree mode view
- my $submenu = Wx::Menu->new;
- $self->{sub_tree} = $submenu->AppendRadioItem( 1, Wx::gettext('Tree listing') );
- $self->{sub_navigate} = $submenu->AppendRadioItem( 2, Wx::gettext('Navigate') );
- $self->{mode} = $menu->AppendSubMenu( $submenu, Wx::gettext('Change listing mode view') );
- $self->{sub_navigate}->Check(1);
-
- Wx::Event::EVT_MENU(
- $submenu,
- $self->{sub_tree},
- sub {
- $parent->{projects}->{ $parent->project_dir }->{mode} = 'tree';
- $parent->{mode_change} = 1;
- $parent->refresh;
- }
- );
-
- Wx::Event::EVT_MENU(
- $submenu,
- $self->{sub_navigate},
- sub {
- $parent->{projects}->{ $parent->project_dir }->{mode} = 'navigate';
- $parent->{mode_change} = 1;
- $parent->refresh;
- }
- );
-
- # Changes the panel side
- $self->{move_panel} = $menu->Append(
- -1,
- Wx::gettext('Move to other panel')
- );
-
- Wx::Event::EVT_MENU(
- $self,
- $self->{move_panel},
- sub {
- $_[0]->parent->move;
- }
- );
-
- return $menu;
-}
-
-# If it is a project, caches search field content while it is typed and
-# searchs for files that matchs the type word
-sub _on_text {
- my $self = shift;
- my $parent = $self->parent;
- my $tree = $self->tree;
- my $value = $self->GetValue;
- my $project_dir = $parent->project_dir or return;
-
- # If nothing is typed hides the Cancel button
- # and sets that the search is not in use
- unless ($value) {
-
- # Hides Cancel Button
- $self->ShowCancelButton(0);
-
- # Sets that the search for this project was just used
- # and is not in use anymore
- $self->{just_used}->{$project_dir} = 1;
- delete $self->{in_use}->{$project_dir};
- delete $self->{CACHED}->{$project_dir};
-
- # Updates the Directory Browser window
- $self->tree->refresh;
-
- return;
- }
-
- # Sets that the search is in use
- $self->{in_use}->{$project_dir} = 1;
-
- # Lock the gui here to make the updates look slicker
- # The locker holds the gui freeze until the update is done.
- my $lock = $self->current->main->lock('UPDATE');
-
- # Cleans the Directory Browser window to show the result
- my $root = $tree->GetRootItem;
- $tree->DeleteChildren($root);
-
- # Searchs below the root path and caches it
- @{ $self->{CACHED}->{$project_dir}->{Data} } = $self->_search($root);
-
- # Caches the searched word to the project
- $self->{CACHED}->{$project_dir}->{value} = $value;
-
- # Expands all the folders to the files matched
- $tree->ExpandAll;
-
- # Shows the Cancel button
- $self->ShowCancelButton(1);
-
- return 1;
-}
-
-1;
-
-# Copyright 2008-2010 The Padre development team as listed in Padre.pm.
-# LICENSE
-# This program is free software; you can redistribute it and/or
-# modify it under the same terms as Perl 5 itself.
@@ -0,0 +1,168 @@
+package Padre::Wx::Directory::Task;
+
+# This is a simple flexible task that fetches lists of file names
+# (but does not look inside of those files)
+
+use 5.008;
+use strict;
+use warnings;
+use Padre::Task ();
+use Padre::Wx::Directory::Path ();
+
+our $VERSION = '0.66';
+our @ISA = 'Padre::Task';
+
+use constant NO_WARN => 1;
+
+
+
+######################################################################
+# Constructor
+
+sub new {
+ my $self = shift->SUPER::new(@_);
+
+ # Automatic project integration
+ if ( exists $self->{project} ) {
+ $self->{root} = $self->{project}->root;
+ $self->{skip} = $self->{project}->ignore_skip;
+ delete $self->{project};
+ }
+
+ # Property defaults
+ unless ( defined $self->{skip} ) {
+ $self->{skip} = [];
+ }
+ unless ( defined $self->{recursive} ) {
+ $self->{recursive} = 1;
+ }
+
+ return $self;
+}
+
+
+
+
+
+######################################################################
+# Padre::Task Methods
+
+sub run {
+ require Module::Manifest;
+ my $self = shift;
+ my $root = $self->{root};
+ my @queue = Padre::Wx::Directory::Path->directory;
+ my @files = ();
+
+ # Prepare the skip rules
+ my $rule = Module::Manifest->new;
+ $rule->parse( skip => $self->{skip} );
+
+ # WARNING!!!
+ # what should really happen here?
+ # I'm only initialising the values here as
+ # t/62-directory-task.t and t/63-directory-project.t
+ # fails the no warnings test
+ # but I'm quite sure you don't want an empty string
+ # should it test and return maybe?
+ my $path = defined( $queue[0]->path ) ? $queue[0]->path : "";
+ my $name = defined( $queue[0]->name ) ? $queue[0]->name : "";
+
+ my %path_cache = ( File::Spec->catdir( $path, $name ) => $queue[0] );
+
+ # Get the device of the root path
+ my $dev = ( stat($root) )[0];
+
+ # Recursively scan for files
+ while (@queue) {
+ my $parent = shift @queue;
+ my @path = $parent->path;
+ my $dir = File::Spec->catdir( $root, @path );
+
+ # Read the file list for the directory
+ # NOTE: Silently ignore any that fail. Anything we don't have
+ # permission to see inside of them will just be invisible.
+ opendir DIRECTORY, $dir or next;
+ my @list = readdir DIRECTORY;
+ closedir DIRECTORY;
+
+ foreach my $file (@list) {
+
+ my $skip = 0;
+
+ next if $file =~ /^\.+\z/;
+ my $fullname = File::Spec->catdir( $dir, $file );
+
+ while (1) {
+
+ my $target;
+
+ # readlink may die if symlinks are not implemented
+ eval { $target = readlink($fullname); };
+ last if $@; # readlink failed
+ last unless defined($target); # not a link
+
+ # Target may be "/home/user/foo" or "../foo" or "bin/foo"
+ $fullname =
+ File::Spec->file_name_is_absolute($target)
+ ? $target
+ : File::Spec->canonpath( File::Spec->catdir( $dir, $target ) );
+
+ # Get it from the cache in case of loops:
+ if ( exists $path_cache{$fullname} ) {
+ push @files, $path_cache{$fullname} if defined( $path_cache{$fullname} );
+ $skip = 1;
+ last;
+ }
+
+ # Prepare a cache object to step out of symlink loops
+ $path_cache{$fullname} = undef;
+ }
+ next if $skip;
+
+ my @fstat = stat($fullname);
+
+ # File doesn't exist, either a directory error, symlink to nowhere or something unexpected.
+ # Don't worry, just skip, because we can't show it in the dir browser anyway
+ next if $#fstat == -1;
+
+ if ( $dev != $fstat[0] ) {
+ warn "DirectoryBrowser root-dir $root is on a different device than $fullname, skipping (FIX REQUIRED!)"
+ unless NO_WARN;
+ next;
+ }
+
+ if ( -f _ ) {
+ my $object = Padre::Wx::Directory::Path->file( @path, $file );
+ next if $rule->skipped( $object->unix );
+ push @files, $object;
+
+ } elsif ( -d _ ) {
+ my $object = Padre::Wx::Directory::Path->directory( @path, $file );
+ next if $rule->skipped( $object->unix );
+ push @files, $object;
+
+ # Continue down within it?
+ next unless $self->{recursive};
+ push @queue, $object;
+ $path_cache{$fullname} = $object;
+
+ } else {
+ warn "Unknown or unsupported file type for $fullname" unless NO_WARN;
+ }
+ }
+ }
+
+ # Case insensitive Schwartzian sort so the caller doesn't have to
+ # do the sort while blocking.
+ $self->{model} = [ sort { $a->compare($b) } @files ];
+
+ return 1;
+}
+
+1;
+
+# Copyright 2008-2010 The Padre development team as listed in Padre.pm.
+# LICENSE
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl 5 itself.
@@ -3,18 +3,25 @@ package Padre::Wx::Directory::TreeCtrl;
use 5.008;
use strict;
use warnings;
-use File::Copy;
-use File::Spec ();
-use File::Basename ();
-use Padre::Current ();
-use Padre::Util ();
-use Padre::Wx ();
-use Padre::Constant ();
-
-our $VERSION = '0.63';
-our @ISA = 'Wx::TreeCtrl';
-
-# Creates a new Directory Browser object
+use File::Spec ();
+use Padre::Constant ();
+use Padre::Wx ();
+use Padre::Wx::Role::Main ();
+use Padre::Wx::Directory::Path ();
+
+our $VERSION = '0.66';
+our @ISA = qw{
+ Padre::Wx::Role::Main
+ Wx::TreeCtrl
+};
+
+
+
+
+
+######################################################################
+# Constructor
+
sub new {
my $class = shift;
my $panel = shift;
@@ -27,23 +34,29 @@ sub new {
| Wx::wxTR_LINES_AT_ROOT | Wx::wxBORDER_NONE
);
- # Files that must be skipped
- $self->{CACHED} = {};
-
- # Selected item of each project
- $self->{current_item} = {};
-
# Create the image list
my $images = Wx::ImageList->new( 16, 16 );
- $self->{file_types} = {
+ $self->{images} = {
upper => $images->Add(
- Wx::ArtProvider::GetBitmap( 'wxART_GO_DIR_UP', 'wxART_OTHER_C', [ 16, 16 ] ),
+ Wx::ArtProvider::GetBitmap(
+ 'wxART_GO_DIR_UP',
+ 'wxART_OTHER_C',
+ [ 16, 16 ],
+ ),
),
folder => $images->Add(
- Wx::ArtProvider::GetBitmap( 'wxART_FOLDER', 'wxART_OTHER_C', [ 16, 16 ] ),
+ Wx::ArtProvider::GetBitmap(
+ 'wxART_FOLDER',
+ 'wxART_OTHER_C',
+ [ 16, 16 ],
+ ),
),
package => $images->Add(
- Wx::ArtProvider::GetBitmap( 'wxART_NORMAL_FILE', 'wxART_OTHER_C', [ 16, 16 ] ),
+ Wx::ArtProvider::GetBitmap(
+ 'wxART_NORMAL_FILE',
+ 'wxART_OTHER_C',
+ [ 16, 16 ],
+ ),
),
};
$self->AssignImageList($images);
@@ -51,62 +64,20 @@ sub new {
# Set up the events
Wx::Event::EVT_TREE_ITEM_ACTIVATED(
$self, $self,
- \&_on_tree_item_activated
- );
-
- Wx::Event::EVT_SET_FOCUS(
- $self,
sub {
- $_[0]->parent->refresh;
- },
+ shift->on_tree_item_activated(@_);
+ }
);
Wx::Event::EVT_TREE_ITEM_MENU(
$self, $self,
- \&_on_tree_item_menu,
- );
-
- Wx::Event::EVT_TREE_SEL_CHANGED(
- $self, $self,
- \&_on_tree_sel_changed,
- );
-
- Wx::Event::EVT_TREE_ITEM_EXPANDING(
- $self, $self,
- \&_on_tree_item_expanding,
- );
-
- Wx::Event::EVT_TREE_ITEM_COLLAPSING(
- $self, $self,
- \&_on_tree_item_collapsing,
- );
-
- Wx::Event::EVT_TREE_END_LABEL_EDIT(
- $self, $self,
- \&_on_tree_end_label_edit,
- );
-
- Wx::Event::EVT_TREE_BEGIN_DRAG(
- $self, $self,
- \&_on_tree_begin_drag,
- );
-
- Wx::Event::EVT_TREE_END_DRAG(
- $self, $self,
- \&_on_tree_end_drag,
+ sub {
+ shift->on_tree_item_menu(@_);
+ },
);
# Set up the root
- my $root = $self->AddRoot(
- Wx::gettext('Directory'),
- -1, -1,
- Wx::TreeItemData->new(
- { dir => '',
- name => '',
- type => 'folder',
- }
- ),
- );
+ $self->AddRoot( Wx::gettext('Directory'), -1, -1 );
# Ident to sub nodes
$self->SetIndent(10);
@@ -114,762 +85,120 @@ sub new {
return $self;
}
-# Returns the Directory Panel object reference
-sub parent {
- $_[0]->GetParent;
-}
-
-# Traverse to the search widget
-sub search {
- $_[0]->GetParent->search;
-}
-
-# Returns the main object reference
-sub main {
- $_[0]->GetParent->main;
-}
-sub current {
- Padre::Current->new( main => $_[0]->main );
-}
-# Updates the gui if needed
-sub refresh {
- my $self = shift;
- my $parent = $self->parent;
- my $search = $parent->search;
-
- # Gets the last and current actived projects
- my $project_dir = $parent->project_dir;
- my $previous_dir = $parent->previous_dir;
-
- # Gets Root node
- my $root = $self->GetRootItem;
-
- # Lock the gui here to make the updates look slicker
- # The locker holds the gui freeze until the update is done.
- my $lock = $self->main->lock('UPDATE');
-
- # If the project have changed or the project root folder updates or
- # the search is not in use anymore (was just used)
- if ( ( defined($project_dir) and ( not defined($previous_dir) or $previous_dir ne $project_dir ) )
- or $self->_updated_dir($project_dir)
- or $search->{just_used}->{$project_dir}
- or $parent->{mode_change} )
- {
-
- # Updates Root node data
- $self->_update_root_data;
-
- # Returns if Search is in use
- return if $search->{in_use}->{$project_dir};
-
- $self->_list_dir($root);
- $self->_append_upper if $parent->mode eq 'navigate';
- delete $search->{just_used}->{$project_dir};
- delete $parent->{mode_change};
- }
-
- # Checks expanded sub folders and its content recursively
- _update_subdirs( $self, $root );
-}
-# Appends an Upper item to the node beginning
-# if the current dir is not the system root
-sub _append_upper {
- my $self = shift;
- my $root = $self->GetRootItem;
- my $project_dir = $self->parent->project_dir;
-
- # Gets the current directory path
- my $current_base_dir = File::Basename::dirname($project_dir);
-
- # Returns if project's dir is the same of it's
- # basename (usually system's root dir)
- return if $project_dir eq $current_base_dir;
-
- # Splits the current directory base to get its
- # name and path
- my ( $volume, $path, $name ) = File::Spec->splitpath($current_base_dir);
-
- # Joins the volume and path
- $path = File::Spec->catdir( $volume, $path );
-
- # Inserts the Upper item to the root node
- $self->InsertItem(
- $root, 0, '..',
- $self->{file_types}->{upper},
- -1,
- Wx::TreeItemData->new(
- { name => $name,
- dir => $path,
- type => 'upper',
- }
- )
- );
-}
-
-# Read a directory, removing the current and updir only.
-# Returns the contents pre-split into directories and files so that
-# we only have to do a -d file stat once and return by reference.
-sub readdir {
- my $self = shift;
- my $directory = shift;
-
- # Read the directory, and do the cheap name presort
- opendir( my $dh, $directory ) or return;
- my @buffer = sort { lc($a) cmp lc($b) } CORE::readdir($dh);
- closedir($dh);
-
- # Filter out ignored files and split out the directories
- # We don't use sort for the directory split, because it can
- # end up calling extra extra -d filesystem stats.
- my @files = ();
- my @dirs = ();
- foreach (@buffer) {
- if ( -d File::Spec->catfile( $directory, $_ ) ) {
- next if /^\.\.?\z/;
- push @dirs, $_;
- } else {
- push @files, $_;
- }
- }
-
- return ( \@dirs, \@files );
-}
-
-# Updates root nodes data to the current project
-# Called when turned beteween projects
-sub _update_root_data {
- my $self = shift;
- my $project = $self->parent->project_dir;
-
- # Splits the path to get the Root folder name and its path
- my ( $volume, $path, $name ) = File::Spec->splitpath($project);
- $path = File::Spec->catdir( $volume, $path );
-
- # Updates Root node data
- my $root = $self->GetRootItem;
- my $data = $self->GetPlData($root);
- $data->{dir} = $path;
- $data->{name} = $name;
-}
-
-# Updates a node's content
-# Called only if project directory changes or show/hide hidden files is
-# requested
-sub _list_dir {
- my $self = shift;
- my $node = shift;
- my $node_data = $self->GetPlData($node);
- my $path = File::Spec->catfile( $node_data->{dir}, $node_data->{name} );
- my $cached = \%{ $self->{CACHED}->{$path} };
-
- # Read folder's content and cache if it had changed or isn't cached
- if ( $self->_updated_dir($path) ) {
-
- # Open the folder and sort its content by name and type
- my ( $dirs, $files ) = $self->readdir($path);
-
- # For each item, creates its CACHE data
- my @Data = map { { name => $_, dir => $path, type => 'folder', } } @$dirs;
- push @Data, map { { name => $_, dir => $path, type => 'package', } } @$files;
- $cached->{Data} = \@Data;
- $cached->{Change} = ( stat $path )[10];
- }
-
- # Show or hide hidden files
- my @data = @{ $cached->{Data} };
- unless ( $cached->{ShowHidden} ) {
- my $project = $self->current->project;
- if ($project) {
- my $rule = $project->ignore_rule;
- @data = grep { $rule->() } @data;
- } else {
- @data = grep { $_->{name} !~ /^\./ } @data;
- }
- }
-
- # Delete node children and populates it again
- $self->DeleteChildren($node);
- foreach my $each (@data) {
- my $new_elem = $self->AppendItem(
- $node,
- $each->{name},
- $self->{file_types}->{ $each->{type} },
- -1,
- Wx::TreeItemData->new(
- { name => $each->{name},
- dir => $each->{dir},
- type => $each->{type},
- }
- )
- );
- if ( $each->{type} eq 'folder' ) {
- $self->SetItemHasChildren( $new_elem, 1 );
- }
- }
-}
-
-# Returns 1 if the directory has changed or is not cached and 0 if it's still #
-# the same #
-sub _updated_dir {
- my $self = shift;
- my $dir = shift;
- my $cached = $self->{CACHED}->{$dir};
-
- my $file = $self->parent->{file};
- my $mtime;
-
- if ( defined($file) ) {
- $file->browse_mtime($dir);
- } else {
- $mtime = ( stat($dir) )[10];
- }
-
- if ( not defined $cached
- or !$cached->{Data}
- or !$cached->{Change}
- or !defined($mtime)
- or $mtime != $cached->{Change}
- or $self->search->{just_used}->{$dir} )
- {
- return 1;
- }
-
- return 0;
-}
-
-# Runs thought a directory content recursively looking if each EXPANDED item #
-# has changed and updates it #
-sub _update_subdirs {
- my ( $self, $root ) = @_;
- my $parent = $self->parent;
- my $project = $parent->project_dir;
-
- my $cookie;
-
- # Loops thought the node's total children
- foreach my $item ( 1 .. $self->GetChildrenCount($root) ) {
-
- ( my $node, $cookie ) = $item == 1 ? $self->GetFirstChild($root) : $self->GetNextChild( $root, $cookie );
- next if not $node->IsOk;
-
- my $node_data = $self->GetPlData($node);
- my $path = File::Spec->catfile( $node_data->{dir}, $node_data->{name} );
-
- # If the item (folder) was expanded, then expands its node and updates
- # its content recursively
- if ( defined $self->{CACHED}->{$project}->{Expanded}->{$path} ) {
-
- # Expands the folder node
- $self->Expand($node);
-
- # Updates the folder node if its content has any change
- $self->_list_dir($node) if $self->_updated_dir($path);
-
- # Runs thought its content
- _update_subdirs( $self, $node );
- }
-
- # If the item was the last selected item, selects and scrolls to it
- if ( defined $self->{current_item}->{$project}
- and $self->{current_item}->{$project} eq $path
- and delete $self->{select_item} )
- {
- $self->SelectItem($node);
- }
- }
-}
-
-# Removes '..' and its previous directories
-sub _removes_double_dot {
- my ( $self, $file ) = @_;
- my @dirs = File::Spec->splitdir($file);
- for ( my $i = 0; $i < @dirs; $i++ ) {
- splice @dirs, $i - 1, 2 if $i > 0 and $dirs[$i] eq "..";
- }
- return File::Spec->catfile(@dirs);
-}
-
-# Tries to rename a file and if success returns 1 or if fails shows a
-# MessageBox with the reason and returns 0
-sub _rename_or_move {
- my $self = shift;
- my $old_file = $self->_removes_double_dot(shift);
- my $new_file = $self->_removes_double_dot(shift);
-
- # Renames/moves the old file name to the new file name
- if ( rename $old_file, $new_file ) {
-
- # Sets the new file to be selected
- my $project = $self->parent->project_dir;
- $self->{current_item}->{$project} = $new_file;
-
- # Expands the node's parent (one level expand)
- my $cached = $self->{CACHED};
- my $parent_dir = File::Basename::dirname($new_file);
- if ( $parent_dir =~ /^$project/ ) {
- $cached->{$project}->{Expanded}->{$parent_dir} = 1;
- }
-
- # If the old file was expanded, keeps the new one expanded
- if ( defined $cached->{$project}->{Expanded}->{$old_file} ) {
- $cached->{$project}->{Expanded}->{$new_file} = 1;
- delete $cached->{$project}->{Expanded}->{$old_file};
- }
-
- # Finds which is the OS separator character
- my $separator = File::Spec->catfile( '', '' );
-
- # Moves all cached data of the node and above it to the new path
- foreach ( keys %$cached ) {
- next unless /^$old_file($separator.+?)?$/;
- $cached->{ $new_file . ( defined $1 ? $1 : '' ) } = $cached->{$_};
- delete $cached->{$_};
- }
- $self->{select_item} = 1;
-
- # Returns success
- return 1;
- } else {
-
- # Popups the error message and returns fail
- my $error_msg = $!;
- Wx::MessageBox( $error_msg, Wx::gettext('Error'), Wx::wxOK | Wx::wxCENTRE | Wx::wxICON_ERROR );
- return 0;
- }
-}
-
-# Tries to copy a file and if success returns 1 or if fails shows a
-# MessageBox with the reason and returns 0
-sub _copy {
- my $self = shift;
- my $old_file = $self->_removes_double_dot(shift);
- my $new_file = $self->_removes_double_dot(shift);
-
- # Renames/moves the old file name to the new file name
-
- if ( copy( $old_file, $new_file ) ) {
-
- # Sets the new file to be selected
- my $project = $self->parent->project_dir;
- $self->{current_item}->{$project} = $new_file;
- $self->{select_item} = 1;
-
- # Expands the node's parent (one level expand)
- my $cached = $self->{CACHED};
- my $parent_dir = File::Basename::dirname($new_file);
- if ( $parent_dir =~ /^$project/ ) {
- $cached->{$project}->{Expanded}->{$parent_dir} = 1;
- }
-
- # Returns success
- return 1;
- } else {
-
- # Popups the error message and returns fail
- my $error_msg = $!;
- Wx::MessageBox( $error_msg, Wx::gettext('Error'), Wx::wxOK | Wx::wxCENTRE | Wx::wxICON_ERROR );
- return 0;
- }
-}
+######################################################################
+# Event Handlers
# Action that must be executaded when a item is activated
# Called when the item is actived
-sub _on_tree_item_activated {
- my ( $self, $event ) = @_;
- my $parent = $self->parent;
- my $node = $event->GetItem;
- my $node_data = $self->GetPlData($node);
-
- # If its a folder expands/collapses it and returns
- # or makes it the current project folder, depending
- # of the mode view
- if ( $node_data->{type} eq 'folder' or $node_data->{type} eq 'upper' ) {
- if ( $parent->mode eq 'navigate' ) {
- $parent->{projects}->{ $parent->project_dir_original }->{dir} =
- File::Spec->catdir( $node_data->{dir}, $node_data->{name} );
- $parent->refresh;
- } else {
- $self->Toggle($node);
- }
- return;
- }
-
- # Returns if the selected FILE have no path
- my $path = File::Spec->catfile( $node_data->{dir}, $node_data->{name} );
- return if not defined $path;
-
- # Opens the selected file
- my $main = $self->main;
- if ( my $id = $main->find_editor_of_file($path) ) {
- my $page = $main->notebook->GetPage($id);
- $page->SetFocus;
- } else {
- $main->setup_editors($path);
- }
- return;
-}
-
-# Verifies if the new file name already exists and prompt if it does
-# or rename the file if don't.
-# Called when a item label is edited
-sub _on_tree_end_label_edit {
- my ( $self, $event ) = @_;
-
- # Returns if no label is typed
- return unless $event->GetLabel();
-
- # Node old and new names and paths
- my $node_data = $self->GetPlData( $event->GetItem );
- my $old_file = File::Spec->catfile( $node_data->{dir}, $node_data->{name} );
- my $new_file = File::Spec->catfile( $node_data->{dir}, $event->GetLabel() );
- my $new_label = ( File::Spec->splitpath($new_file) )[2];
-
- # Loops while already exists a file with the new label name
- while ( -e $new_file ) {
-
- # Prompts the user asking for a new name for the file
- my $prompt = Wx::TextEntryDialog->new(
- $self,
- Wx::gettext('Please choose a different name.'),
- Wx::gettext('File already exists'),
- $new_label,
- );
-
- # If Cancel button pressed, ignores changes and returns
- if ( $prompt->ShowModal == Wx::wxID_CANCEL ) {
- $event->Veto();
- return;
- }
-
- # Reads the new file name and generates its complete path
- $new_file = File::Spec->catfile( $node_data->{dir}, $prompt->GetValue );
- $new_label = ( File::Spec->splitpath($new_file) )[2];
- $prompt->Destroy;
- }
-
- # Ignores changes if the renaming have no success
- $event->Veto() unless $self->_rename_or_move( $old_file, $new_file );
- return;
-}
-
-# Caches the item path as current selected item
-# Called when a item is selected
-sub _on_tree_sel_changed {
- my ( $self, $event ) = @_;
- return if not $self->parent->can('project_dir');
- my $node_data = $self->GetPlData( $event->GetItem );
-
- # Caches the item path
- $self->{current_item}->{ $self->parent->project_dir } =
- File::Spec->catfile( $node_data->{dir}, $node_data->{name} );
-}
-
-# Expands the node and loads its content.
-# Called when a folder is expanded.
-sub _on_tree_item_expanding {
- my ( $self, $event ) = @_;
- my $node = $event->GetItem;
- my $node_data = $self->GetPlData($node);
-
- # Returns if a search is being done (expands only the browser listing)
- return if !defined( $self->search );
- return if $self->search->{in_use}->{ $self->parent->project_dir };
-
- # The item complete path
- my $path = File::Spec->catfile( $node_data->{dir}, $node_data->{name} );
-
- # Cache the expanded state of the node
- $self->{CACHED}->{ $self->parent->project_dir }->{Expanded}->{$path} = 1;
-
- # Updates the node content if it changed or has no child
- if ( $self->_updated_dir($path) or !$self->GetChildrenCount($node) ) {
- $self->_list_dir($node);
- }
-}
+sub on_tree_item_activated {
+ my $self = shift;
+ my $item = shift->GetItem;
+ my $data = $self->GetPlData($item);
+ my $parent = $self->GetParent;
-# Deletes nodes Expanded cache param.
-# Called when a folder is collapsed.
-sub _on_tree_item_collapsing {
- my ( $self, $event ) = @_;
- my $node = $event->GetItem;
- my $node_data = $self->GetPlData($node);
- my $project_dir = $self->parent->project_dir;
-
- # If it is the Root node, set Expanded to 0
- if ( $node == $self->GetRootItem ) {
- $self->{CACHED}->{$project_dir}->{Expanded}->{$project_dir} = 0;
+ # If a folder, toggle the expand/collanse state
+ if ( $data->type == 1 ) {
+ $self->Toggle($item);
return;
}
- # Deletes cache expanded state of the node
- delete $self->{CACHED}->{$project_dir}->{Expanded}
- ->{ File::Spec->catfile( $node_data->{dir}, $node_data->{name} ) };
-}
-
-# If the item is not the root node let it to be dragged.
-# Called when a item is dragged.
-sub _on_tree_begin_drag {
- my ( $self, $event ) = @_;
- my $node = $event->GetItem;
- my $node_data = $self->GetPlData($node);
-
- # Only drags if it's not the Root node
- # and if it's not the upper item
- if ( $node != $self->GetRootItem
- and $node_data->{type} ne 'upper' )
- {
- $self->{dragged_item} = $node;
- $event->Allow;
- }
+ # Open the selected file
+ my $current = $self->current;
+ my $main = $current->main;
+ my $project = $current->project;
+ my $file = File::Spec->catfile( $project->root, $data->path );
+ $main->setup_editor($file);
+ return;
}
-# If dragged to a different folder, tries to move (renaming) it to the new
-# folder.
-# Called just after the item is dragged.
-sub _on_tree_end_drag {
- my ( $self, $event ) = @_;
- my $node = $event->GetItem;
- my $node_data = $self->GetPlData($node);
-
- # If drops to a file, the new destination will be it's folder
- if ( $node->IsOk and ( !$self->ItemHasChildren($node) and $node_data->{type} ne 'upper' ) ) {
- $node = $self->GetItemParent($node);
- }
-
- # Returns if the target node doesn't exists
- return unless $node->IsOk;
-
- # Gets dragged and target nodes data
- my $new_data = $self->GetPlData($node);
- my $old_data = $self->GetPlData( $self->{dragged_item} );
-
- # Returns if the target is the file parent
- my $from = $old_data->{dir};
- my $to = File::Spec->catfile( $new_data->{dir}, $new_data->{name} );
- return if $from eq $to;
-
- # The file complete name (path and its name) before and after the move
- my $old_file = File::Spec->catfile( $old_data->{dir}, $old_data->{name} );
- my $new_file = File::Spec->catfile( $to, $old_data->{name} );
-
- # Alerts if there is a file with the same name in the target
- if ( -e $new_file ) {
- Wx::MessageBox(
- Wx::gettext('A file with the same name already exists in this directory'),
- Wx::gettext('Error'),
- Wx::wxOK | Wx::wxCENTRE | Wx::wxICON_ERROR
- );
+# Shows up a context menu above an item with its controls
+# the file if don't.
+# Called when a item context menu is requested.
+sub on_tree_item_menu {
+ my $self = shift;
+ my $event = shift;
+ my $item = $event->GetItem;
+ my $data = $self->GetPlData($item);
+
+ # Only show the context menu for files (for now)
+ if ( $data->type == Padre::Wx::Directory::Path::DIRECTORY ) {
return;
}
- # Pops up a menu to confirm the
- # action do be done
+ # Generate the context menu for this file
my $menu = Wx::Menu->new;
-
- # Move file or directory
- my $menu_mv = $menu->Append(
- -1,
- Wx::gettext('Move here')
- );
- Wx::Event::EVT_MENU(
- $self, $menu_mv,
- sub { $self->_rename_or_move( $old_file, $new_file ) }
+ my $file = File::Spec->catfile(
+ $self->GetParent->root,
+ $data->path,
);
- # Copy file
- unless ( -d $old_file ) {
- my $menu_cp = $menu->Append(
- -1,
- Wx::gettext('Copy here')
- );
- Wx::Event::EVT_MENU(
- $self, $menu_cp,
- sub { $self->_copy( $old_file, $new_file ) }
- );
- }
-
- # Cancel action
- $menu->AppendSeparator();
- my $menu_cl = $menu->Append(
- -1,
- Wx::gettext('Cancel')
- );
-
- # Pops up the context menu
- my $x = $event->GetPoint->x;
- my $y = $event->GetPoint->y;
- $self->PopupMenu( $menu, $x, $y );
-}
-
-# Shows up a context menu above an item with its controls
-# the file if don't.
-# Called when a item context menu is requested.
-sub _on_tree_item_menu {
- my ( $self, $event ) = @_;
- my $node = $event->GetItem;
- my $node_data = $self->GetPlData($node);
-
- # Do not show if it is the upper item
- return if defined( $node_data->{type} ) and ( $node_data->{type} eq 'upper' );
-
- $node_data->{type} ||= ''; # Defined but empty
-
- my $menu = Wx::Menu->new;
- my $selected_dir = $node_data->{dir};
- my $selected_path = File::Spec->catfile( $node_data->{dir}, $node_data->{name} );
-
- # Default action - same when the item is activated
- my $default = $menu->Append(
- -1,
- Wx::gettext( $node_data->{type} eq 'folder' ? 'Open Folder' : 'Open File' )
- );
+ # The default action is the same as when it is double-clicked
Wx::Event::EVT_MENU(
- $self, $default,
- sub { $self->_on_tree_item_activated($event) }
+ $self,
+ $menu->Append( -1, Wx::gettext('Open File') ),
+ sub {
+ shift->on_tree_item_activated($event);
+ }
);
-
Wx::Event::EVT_MENU(
$self,
$menu->Append( -1, Wx::gettext('Open in File Browser') ),
sub {
- $_[0]->main->on_open_in_file_browser($selected_path);
+ shift->main->on_open_in_file_browser($file);
}
);
- $menu->AppendSeparator();
+ $menu->AppendSeparator;
- # Rename and/or move the item
- my $rename = $menu->Append( -1, Wx::gettext('Rename / Move') );
+ # Updates the directory listing
+ my $refresh = $menu->Append( -1, Wx::gettext('Refresh') );
Wx::Event::EVT_MENU(
- $self, $rename,
+ $self, $refresh,
sub {
- $self->EditLabel($node);
- },
+ shift->GetParent->refresh;
+ }
);
- # Move item to trash
- # Note: File::Remove->trash() only works on Mac
- # Please see ticket:553 (http://padre.perlide.org/trac/ticket/553)
- if ( Padre::Constant::MAC or Padre::Constant::WIN32 ) {
- my $trash = $menu->Append( -1, Wx::gettext('Move to trash') );
- Wx::Event::EVT_MENU(
- $self, $trash,
- sub {
- eval {
- if (Padre::Constant::WIN32)
- {
-
- # WIN32
- require Padre::Util::Win32;
- Padre::Util::Win32::Recycle($selected_path);
- } else {
-
- # MAC
- require File::Remove;
- File::Remove->trash($selected_path);
- }
- };
- if ($@) {
- my $error_msg = $@;
- Wx::MessageBox(
- $error_msg, Wx::gettext('Error'),
- Wx::wxOK | Wx::wxCENTRE | Wx::wxICON_ERROR
- );
- }
- return;
- },
- );
- }
+ # Pops up the context menu
+ $self->PopupMenu(
+ $menu,
+ $event->GetPoint->x,
+ $event->GetPoint->y,
+ );
- # Delete item
- my $delete = $menu->Append( -1, Wx::gettext('Delete') );
- Wx::Event::EVT_MENU(
- $self, $delete,
- sub {
+ return;
+}
- my $dialog = Wx::MessageDialog->new(
- $self,
- Wx::gettext('Are you sure you want to delete this item?') . $/ . $selected_path,
- Wx::gettext('Delete'),
- Wx::wxYES_NO | Wx::wxICON_QUESTION | Wx::wxCENTRE
- );
- return if $dialog->ShowModal == Wx::wxID_NO;
-
- eval {
- require File::Remove;
- File::Remove->remove($selected_path);
- };
- if ($@) {
- my $error_msg = $@;
- Wx::MessageBox(
- $error_msg, Wx::gettext('Error'),
- Wx::wxOK | Wx::wxCENTRE | Wx::wxICON_ERROR
- );
- }
- return;
- },
- );
- # ?????
- if ( defined $node_data->{type} and ( $node_data->{type} eq 'modules' or $node_data->{type} eq 'pragmata' ) ) {
- my $pod = $menu->Append( -1, Wx::gettext("Open &Documentation") );
- Wx::Event::EVT_MENU(
- $self, $pod,
- sub {
-
- # TO DO Fix this wasting of objects (cf. Padre::Wx::Menu::Help)
- require Padre::Wx::DocBrowser;
- my $help = Padre::Wx::DocBrowser->new;
- $help->help( $node_data->{name} );
- $help->SetFocus;
- $help->Show(1);
- return;
- },
- );
- }
- $menu->AppendSeparator();
-
- # Shows / Hides hidden files - applied to each directory
- my $hiddenFiles = $menu->AppendCheckItem( -1, Wx::gettext('Show hidden files') );
- my $applies_to_node = $node;
- my $applies_to_path = $selected_path;
- if ( $node_data->{type} ne 'folder' ) {
- $applies_to_path = $selected_dir;
- $applies_to_node = $self->GetParent($node);
- }
- my $cached = defined($applies_to_path) ? \%{ $self->{CACHED}->{$applies_to_path} } : undef;
- my $show = $cached->{ShowHidden};
- $hiddenFiles->Check($show);
- Wx::Event::EVT_MENU(
- $self,
- $hiddenFiles,
- sub {
- $cached->{ShowHidden} = !$show;
- $self->_list_dir($applies_to_node);
- },
- );
- # Updates the directory listing
- my $reload = $menu->Append( -1, Wx::gettext('Reload') );
- Wx::Event::EVT_MENU(
- $self, $reload,
- sub {
- delete $self->{CACHED}->{ $self->GetPlData($node)->{dir} }->{Change};
- }
- );
- # Pops up the context menu
- my $x = $event->GetPoint->x;
- my $y = $event->GetPoint->y;
- $self->PopupMenu( $menu, $x, $y );
+######################################################################
+# General Methods
- return;
+# Scan the tree to find all directory nodes which are expanded.
+# Returns a reference to a HASH of ->unix path strings.
+sub expanded {
+ my $self = shift;
+ my @queue = $self->GetRootItem;
+ my %expand = ();
+ while (@queue) {
+ my $parent = shift @queue;
+ my ( $child, $cookie ) = $self->GetFirstChild($parent);
+ while ($child) {
+ if ( $self->IsExpanded($child) ) {
+ $expand{ $self->GetPlData($child)->unix } = 1;
+ push @queue, $child;
+ }
+ ( $child, $cookie ) = $self->GetNextChild( $parent, $cookie );
+ }
+ }
+ return \%expand;
}
1;
@@ -3,27 +3,36 @@ package Padre::Wx::Directory;
use 5.008;
use strict;
use warnings;
-use Padre::Wx ();
-use Padre::Wx::Directory::TreeCtrl ();
-use Padre::Wx::Directory::SearchCtrl ();
+use Padre::Cache ();
+use Padre::Role::Task ();
+use Padre::Wx::Role::View ();
+use Padre::Wx::Role::Main ();
+use Padre::Wx::Directory::TreeCtrl ();
+use Padre::Wx ();
-our $VERSION = '0.63';
-our @ISA = 'Wx::Panel';
+our $VERSION = '0.66';
+our @ISA = qw{
+ Padre::Role::Task
+ Padre::Wx::Role::View
+ Padre::Wx::Role::Main
+ Wx::Panel
+};
use Class::XSAccessor {
getters => {
+ root => 'root',
tree => 'tree',
search => 'search',
},
- accessors => {
- mode => 'mode',
- project_dir => 'project_dir',
- previous_dir => 'previous_dir',
- project_dir_original => 'project_dir_original',
- previous_dir_original => 'previous_dir_original',
- },
};
+
+
+
+
+######################################################################
+# Constructor
+
# Creates the Directory Left Panel with a Search field
# and the Directory Browser
sub new {
@@ -38,16 +47,63 @@ sub new {
Wx::wxDefaultSize,
);
- # Creates the Search Field and the Directory Browser
- $self->{tree} = Padre::Wx::Directory::TreeCtrl->new($self);
- $self->{search} = Padre::Wx::Directory::SearchCtrl->new($self);
+ # Where is the current root directory of the tree
+ $self->{root} = '';
+
+ # The list of all files to build into the tree
+ $self->{files} = [];
+
+ # The directories in the tree that should be expanded
+ $self->{expand} = {};
+
+ # Create the search control
+ my $search = $self->{search} = Wx::SearchCtrl->new(
+ $self,
+ -1,
+ '',
+ Wx::wxDefaultPosition,
+ Wx::wxDefaultSize,
+ Wx::wxTE_PROCESS_ENTER
+ );
+ $search->SetDescriptiveText( Wx::gettext('Search') );
+
+ Wx::Event::EVT_TEXT(
+ $self, $search,
+ sub {
+ shift->on_text(@_);
+ },
+ );
+
+ Wx::Event::EVT_SEARCHCTRL_CANCEL_BTN(
+ $self, $search,
+ sub {
+ shift->{search}->SetValue('');
+ },
+ );
+
+ # Create the search control menu
+ my $menu = Wx::Menu->new;
+ Wx::Event::EVT_MENU(
+ $self,
+ $menu->Append(
+ -1,
+ Wx::gettext('Move to other panel')
+ ),
+ sub {
+ shift->move;
+ }
+ );
+ $search->SetMenu($menu);
+
+ # Create the tree control
+ $self->{tree} = Padre::Wx::Directory::TreeCtrl->new($self);
# Fill the panel
my $sizerv = Wx::BoxSizer->new(Wx::wxVERTICAL);
my $sizerh = Wx::BoxSizer->new(Wx::wxHORIZONTAL);
- $sizerv->Add( $self->search, 0, Wx::wxALL | Wx::wxEXPAND, 0 );
- $sizerv->Add( $self->tree, 1, Wx::wxALL | Wx::wxEXPAND, 0 );
- $sizerh->Add( $sizerv, 1, Wx::wxALL | Wx::wxEXPAND, 0 );
+ $sizerv->Add( $self->{search}, 0, Wx::wxALL | Wx::wxEXPAND, 0 );
+ $sizerv->Add( $self->{tree}, 1, Wx::wxALL | Wx::wxEXPAND, 0 );
+ $sizerh->Add( $sizerv, 1, Wx::wxALL | Wx::wxEXPAND, 0 );
# Fits panel layout
$self->SetSizerAndFit($sizerh);
@@ -56,34 +112,75 @@ sub new {
return $self;
}
-# The parent panel
-sub panel {
- $_[0]->GetParent;
+
+
+
+
+######################################################################
+# Padre::Wx::Role::View Methods
+
+sub view_panel {
+ shift->side(@_);
}
-# Returns the main object reference
-sub main {
- $_[0]->GetGrandParent;
+sub view_label {
+ shift->gettext_label(@_);
}
-sub current {
- Padre::Current->new( main => $_[0]->main );
+sub view_close {
+ shift->main->show_directory(0);
}
+
+
+
+
+######################################################################
+# Event Handlers
+
+# If it is a project, caches search field content while it is typed and
+# searchs for files that matchs the type word.
+sub on_text {
+ my $self = shift;
+ my $search = $self->{search};
+
+ # Show or hide the cancel button
+ $search->ShowCancelButton( $search->IsEmpty ? 0 : 1 );
+
+ # The changed search state requires a rerender
+ $self->render;
+}
+
+
+
+
+
+######################################################################
+# General Methods
+
# Returns the window label
sub gettext_label {
- my $self = shift;
- if ( defined( $self->mode ) and ( $self->mode eq 'tree' ) ) {
- return Wx::gettext('Project');
- } else {
- return Wx::gettext('Directory');
- }
+ Wx::gettext('Project');
+}
+
+# The search term if we have one
+sub term {
+ $_[0]->{search}->GetValue;
+}
+
+# Are we in search mode?
+sub searching {
+ $_[0]->{search}->IsEmpty ? 0 : 1;
}
# Updates the gui, so each compoment can update itself
-# according to the new state
+# according to the new state.
sub clear {
- $_[0]->refresh;
+ my $self = shift;
+ my $lock = $self->main->lock('UPDATE');
+ $self->{search}->SetValue('');
+ $self->{search}->ShowCancelButton(0);
+ $self->{tree}->DeleteChildren( $self->{tree}->GetRootItem );
return;
}
@@ -91,68 +188,199 @@ sub clear {
# refresh function.
# Called outside Directory.pm, on directory browser focus and item dragging
sub refresh {
- my $self = shift;
- my $current = $self->current;
- my $document = $current->document;
-
- # Finds project base
- my $dir;
- if ( defined($document) ) {
- $dir = $document->project_dir;
- $self->{file} = $document->{file};
+ my $self = shift;
+
+ # NOTE: Without a file open, Padre does not consider itself to
+ # have a "current project". We should probably try to find a way
+ # to correct this in future.
+ my $current = $self->current;
+ my $project = $current->project;
+ my $root = '';
+ my @options = ();
+ if ($project) {
+ $root = $project->root;
+ @options = ( project => $project );
} else {
- $dir = $self->main->config->default_projects_directory;
- delete $self->{file};
+ $root = $current->config->default_projects_directory;
+ @options = ( root => $root );
}
- # Shortcut if there's no directory, or we haven't changed directory
- return unless $dir;
- if ( defined $self->project_dir and $self->project_dir eq $dir ) {
- return;
+ # Before we change anything, store the expansion state
+ unless ( $self->searching ) {
+ $self->{expand} = $self->tree->expanded;
}
- $self->{projects}->{$dir}->{dir} ||= $dir;
- $self->{projects}->{$dir}->{mode} ||=
- $document->{is_project}
- ? 'tree'
- : 'navigate';
+ # Switch project states if needed
+ unless ( $self->{root} eq $root ) {
+ my $ide = $current->ide;
- # The currently view mode
- $self->mode( $self->{projects}->{$dir}->{mode} );
+ # Save the current model data to the cache
+ # if we potentially need it again later.
+ if ( $ide->project_exists( $self->{root} ) ) {
+ my $stash = Padre::Cache::stash(
+ __PACKAGE__,
+ $ide->project( $self->{root} ),
+ );
+ %$stash = (
+ root => $self->{root},
+ files => $self->{files},
+ expand => $self->{expand},
+ );
+ }
- # Save the current project path
- $self->project_dir( $self->{projects}->{$dir}->{dir} );
- $self->project_dir_original($dir);
+ # Flush the now-unusable state
+ $self->{root} = $root;
+ $self->{files} = [];
+ $self->{expand} = {};
- # Calls Searcher and Browser refresh
- $self->tree->refresh;
- $self->search->refresh;
+ # Do we have an (out of date) cached state we can use?
+ # If so, display it immediately and update it later.
+ if ($project) {
+ my $stash = Padre::Cache::stash(
+ __PACKAGE__,
+ $project,
+ );
+ if ( $stash->{root} ) {
- # Sets the last project to the current one
- $self->previous_dir( $self->{projects}->{$dir}->{dir} );
- $self->previous_dir_original($dir);
+ # We have a cached state
+ $self->{files} = $stash->{files};
+ $self->{expand} = $stash->{expand};
+ }
+ }
- # Update the panel label
- $self->panel->refresh;
+ # Flush the search box and rerender the tree
+ $self->{search}->SetValue('');
+ $self->{search}->ShowCancelButton(0);
+ $self->render;
+ }
+
+ # Trigger the refresh task to update the temporary state
+ $self->task_request(
+ task => 'Padre::Wx::Directory::Task',
+ callback => 'refresh_response',
+ recursive => 1,
+ @options,
+ );
return 1;
}
-# When a project folder is changed
-sub _change_project_dir {
+sub refresh_response {
+ my $self = shift;
+ my $task = shift;
+ $self->{files} = $task->{model};
+ $self->render;
+}
+
+# This is a primitive first attempt to get familiar with the tree API
+sub render {
my $self = shift;
- my $dialog = Wx::DirDialog->new(
- undef,
- Wx::gettext('Choose a directory'),
- $self->project_dir,
- );
- if ( $dialog->ShowModal == Wx::wxID_CANCEL ) {
- return;
+ my $tree = $self->tree;
+ my $root = $tree->GetRootItem;
+ my $expand = $self->{expand};
+
+ # Prepare search mode if needed
+ my $search = $self->searching;
+ my @files = $search ? $self->filter( $self->term ) : @{ $self->{files} };
+
+ # Flush the old tree contents
+ # TO DO: This is inefficient, upgrade to something that does the
+ # equivalent of a treewise diff application, modifying the tree
+ # to get the result we want instead of rebuilding it entirely.
+ my $lock = $self->main->lock('UPDATE');
+ $tree->DeleteChildren($root);
+
+ # Fill the new tree
+ my @stack = ();
+ while (@files) {
+ my $path = shift @files;
+ my $image = $path->type ? 'folder' : 'package';
+ while (@stack) {
+
+ # If we are not the child of the deepest element in
+ # the stack, move up a level and try again
+ last if $tree->GetPlData( $stack[-1] )->is_parent($path);
+
+ # We have finished filling the directory.
+ # Now it (maybe) has children, we can expand it.
+ my $complete = pop @stack;
+ if ( $search or $expand->{ $tree->GetPlData($complete)->unix } ) {
+ $tree->Expand($complete);
+ }
+ }
+
+ # If there is anything left on the stack it is our parent
+ my $parent = $stack[-1] || $root;
+
+ # Add the next item to that parent
+ my $item = $tree->AppendItem(
+ $parent, # Parent node
+ $path->name, # Label
+ $tree->{images}->{$image}, # Icon
+ -1, # Wx Identifier
+ Wx::TreeItemData->new($path), # Embedded data
+ );
+
+ # If it is a folder, it goes onto the stack
+ if ( $path->type == 1 ) {
+ push @stack, $item;
+ }
+ }
+
+ # Apply the same Expand logic above to any remaining stack elements
+ while (@stack) {
+ my $complete = pop @stack;
+ if ( $search or $expand->{ $tree->GetPlData($complete)->unix } ) {
+ $tree->Expand($complete);
+ }
+ }
+
+ # When in search mode, force the scroll position to the top after
+ # every refresh. It tends to want to scroll to the bottom.
+ if ($search) {
+ my ( $first, $cookie ) = $tree->GetFirstChild($root);
+ $tree->ScrollTo($first) if $first;
}
- $self->{projects_dirs}->{ $self->project_dir_original } = $dialog->GetPath;
- $self->refresh;
+
+ return 1;
}
+# Filter the file list to remove all files that do not match a search term
+# TO DO: I believe that the two phases shown below can be merged into one.
+sub filter {
+ my $self = shift;
+ my $term = shift;
+
+ # Apply a simple substring match on the file name only
+ my $quote = quotemeta $term;
+ my $regex = qr/$quote/i;
+ my @match =
+ grep { $_->is_directory or $_->name =~ $regex } @{ $self->{files} };
+
+ # Prune empty directories
+ # NOTE: This is tricky and hard to make sense of, but damned fast :)
+ foreach my $i ( reverse 0 .. $#match ) {
+ my $path = $match[$i];
+ my $after = $match[ $i + 1 ];
+ my $prune = (
+ $path->is_directory and not( defined $after
+ and $after->depth - $path->depth == 1 )
+ );
+ if ($prune) {
+ splice @match, $i, 1;
+ }
+ }
+
+ return @match;
+}
+
+
+
+
+
+######################################################################
+# Panel Migration (Experimental)
+
# What side of the application are we on
sub side {
my $self = shift;
@@ -166,11 +394,18 @@ sub side {
die "Bad parent panel";
}
-# Moves the panel to the other side
+# Moves the panel to the other side.
+# To prevent corrupting the layout engine we do this in a specific order.
+# Hide, Reconfigure, Show
+# TO DO: This results in loss of all state, and the need to rescan the tree.
+# Come up with a saner approach to migrating views between arbitrary panels
+# that we can expand out so all views can potentially be moved around.
sub move {
my $self = shift;
- my $config = $self->main->config;
+ my $main = $self->main;
+ my $config = $main->config;
my $side = $config->main_directory_panel;
+ $main->show_directory(0);
if ( $side eq 'left' ) {
$config->apply( main_directory_panel => 'right' );
} elsif ( $side eq 'right' ) {
@@ -178,6 +413,8 @@ sub move {
} else {
die "Bad main_directory_panel setting '$side'";
}
+ $main->show_directory(1);
+ return 1;
}
1;
@@ -26,9 +26,9 @@ use warnings;
use List::Util ();
use Padre::Wx ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
-use constant GOLDEN => 1.618;
+use constant GOLDEN_RATIO => 1.618;
@@ -39,6 +39,49 @@ use constant GOLDEN => 1.618;
=pod
+=head2 perfect
+
+ my $boolean = Padre::Wx::Display->perfect(
+ Padre::Current->main
+ );
+
+The default Wx implementation of IsShownOnScreen is a bit weird, and while
+it may be technically correct as far as Wx is concerned it does not
+necesarily represent what a typical human expects, which is that the
+application is on an active plugged in monitor and that it is entirely on
+the monitor.
+
+The C<perfect> method takes a L<Wx::TopLevelWindow> object (which
+incorporates either a L<Wx::Dialog> or a L<Wx::Frame>) and determines if
+the window meets the warm and fuzzy human criteria for a usable location.
+
+Returns true if so, or false otherwise.
+
+=cut
+
+sub perfect {
+ my $class = shift;
+ my $window = shift;
+
+ # Anything that isn't a regular framed window is acceptable
+ return 1 if $window->IsIconized;
+ return 1 if $window->IsMaximized;
+ return 1 if $window->IsFullScreen;
+
+ # Are we entirely within the usable area of a single display.
+ my $rect = $window->GetScreenRect;
+ foreach ( 0 .. Wx::Display::GetCount() - 1 ) {
+ my $display = Wx::Display->new($_);
+ if ( $display->GetGeometry->ContainsRect($rect) ) {
+ return 1;
+ }
+ }
+
+ return 0;
+}
+
+=pod
+
=head2 primary
Locates and returns the primary display as a L<Wx::Display> object.
@@ -129,14 +172,14 @@ sub _rect_scale_margin {
# Shrink long size to meet the (landscape) golden (aspect) ratio.
sub _rect_golden {
my $rect = shift;
- if ( $rect->width > ( $rect->height * GOLDEN ) ) {
+ if ( $rect->width > ( $rect->height * GOLDEN_RATIO ) ) {
# Shrink left from the right
- $rect->width( int( $rect->height / GOLDEN ) );
+ $rect->width( int( $rect->height * GOLDEN_RATIO ) );
} else {
# Shrink up from the bottom
- $rect->height( int( $rect->width / GOLDEN ) );
+ $rect->height( int( $rect->width / GOLDEN_RATIO ) );
}
return $rect;
}
@@ -1,486 +0,0 @@
-package Padre::Wx::DocBrowser;
-
-use 5.008;
-use strict;
-use warnings;
-use URI ();
-use Encode ();
-use Scalar::Util ();
-use List::MoreUtils ();
-use Padre::Wx ();
-use Padre::Wx::HtmlWindow ();
-use Scalar::Util ();
-use Params::Util qw(
- _INSTANCE _INVOCANT _CLASSISA _HASH _STRING
-);
-use Padre::Wx::Icon ();
-use Padre::Wx::AuiManager ();
-use Padre::Wx::Dialog ();
-use Padre::Task::DocBrowser ();
-use Padre::DocBrowser ();
-use Padre::Util qw( _T );
-use Wx::Perl::Dialog::Simple ();
-
-our $VERSION = '0.63';
-our @ISA = 'Wx::Dialog';
-
-use Class::XSAccessor {
- accessors => {
- notebook => 'notebook',
- provider => 'provider',
- }
-};
-
-our %VIEW = (
- 'text/html' => 'Padre::Wx::HtmlWindow',
- 'text/xhtml' => 'Padre::Wx::HtmlWindow',
- 'text/x-html' => 'Padre::Wx::HtmlWindow',
-);
-
-=pod
-
-=head1 NAME
-
-Padre::Wx::DocBrowser - Wx front-end for C<Padre::DocBrowser>
-
-=head1 Welcome to Padre C<DocBrowser>
-
-C<Padre::Wx::DocBrowser> ( C<Wx::Frame> )
-
-=head1 DESCRIPTION
-
-User interface for C<Padre::DocBrowser>.
-
-=head1 METHODS
-
-=head2 new
-
-Constructor , see L<Wx::Frame>
-
-=head2 help
-
-Accepts a string, L<URI> or L<Padre::Document> and attempts to render
-documentation for such in a new C<AuiNoteBook> tab. Links matching a scheme
-accepted by L<Padre::DocBrowser> will (when clicked) be resolved and
-displayed in a new tab.
-
-=head2 display
-
-Accepts a L<Padre::Document> or work-alike
-
-=head1 SEE ALSO
-
-L<Padre::DocBrowser> L<Padre::Task::DocBrowser>
-
-=cut
-
-sub new {
- my ($class) = @_;
-
- my $self = $class->SUPER::new(
- undef,
- -1,
- Wx::gettext('Help'),
- Wx::wxDefaultPosition,
- [ 750, 700 ],
- Wx::wxDEFAULT_FRAME_STYLE,
- );
-
- $self->{provider} = Padre::DocBrowser->new;
-
- # Until we get a real icon use the same one as the others
- $self->SetIcon(Padre::Wx::Icon::PADRE);
-
- my $top_s = Wx::BoxSizer->new(Wx::wxVERTICAL);
- my $but_s = Wx::BoxSizer->new(Wx::wxHORIZONTAL);
-
- my $notebook = Wx::AuiNotebook->new(
- $self,
- -1,
- Wx::wxDefaultPosition,
- Wx::wxDefaultSize,
- Wx::wxAUI_NB_DEFAULT_STYLE
- );
- $self->notebook($notebook);
-
- my $entry = Wx::TextCtrl->new(
- $self, -1,
- '',
- Wx::wxDefaultPosition,
- Wx::wxDefaultSize,
- Wx::wxTE_PROCESS_ENTER
- );
- $entry->SetToolTip( Wx::ToolTip->new( Wx::gettext('Search for perldoc - e.g. Padre::Task, Net::LDAP') ) );
-
- Wx::Event::EVT_TEXT_ENTER(
- $self, $entry,
- sub {
- $self->OnSearchTextEnter($entry);
- }
- );
-
- # this could be lame:
- $self->{_searchEntry} = $entry;
-
- my $label = Wx::StaticText->new(
- $self, -1, Wx::gettext('Search:'),
- Wx::wxDefaultPosition, [ 50, -1 ],
- Wx::wxALIGN_RIGHT
- );
- $label->SetToolTip( Wx::ToolTip->new( Wx::gettext('Search for perldoc - e.g. Padre::Task, Net::LDAP') ) );
-
- my $close_button = Wx::Button->new( $self, Wx::wxID_CANCEL, Wx::gettext('&Close') );
-
- $but_s->Add( $label, 0, Wx::wxALIGN_CENTER_VERTICAL );
- $but_s->Add( $entry, 1, Wx::wxALIGN_LEFT | Wx::wxALIGN_CENTER_VERTICAL );
- $but_s->AddStretchSpacer(2);
- $but_s->Add( $close_button, 0, Wx::wxALIGN_RIGHT | Wx::wxALIGN_CENTER_VERTICAL );
-
- $top_s->Add( $but_s, 0, Wx::wxEXPAND );
- $top_s->Add( $notebook, 1, Wx::wxGROW );
- $self->SetSizer($top_s);
-
- #$self->_setup_welcome;
-
- # not sure about this but we want to throw the close X event ot _close so it gets
- # rid of a busy cursor if it's busy..
- # bind the close event to our close method
-
- # This doesn't work... !!! :( It should do though!
- # http://www.nntp.perl.org/group/perl.wxperl.users/2007/06/msg3154.html
- # http://www.gigi.co.uk/wxperl/pdk/perltrayexample.txt
- # use a similar syntax.... for some reason this doesn't call _close()
-
- # TO DO: Figure out what needs to be done to check and shutdown a
- # long running thread
- # To trigger this, search for perltoc in the search text entry.
-
- Wx::Event::EVT_CLOSE( $self, sub { $_[0]->_close(); } );
-
- $self->SetAutoLayout(1);
-
- return $self;
-}
-
-sub OnLinkClicked {
- my $self = shift;
- my $uri = URI->new( $_[0]->GetLinkInfo->GetHref );
- my $linkinfo = $_[0]->GetLinkInfo;
- my $scheme = $uri->scheme;
- if ( $self->provider->accept( $uri->scheme ) ) {
- $self->ResolveRef($uri);
- } else {
- Padre::Wx::launch_browser($uri);
- }
-}
-
-sub OnSearchTextEnter {
- my $self = shift;
- my $text = $_[0]->GetValue;
-
- # need to see where to put the busy cursor
- # we want to see a busy cursor
- # cheating a bit here:
- $self->{_busyCursor} = Wx::BusyCursor->new();
-
- $self->ResolveRef($text);
-}
-
-sub help {
- my ( $self, $query, $hint ) = @_;
-
- if ( _INSTANCE( $query, 'Padre::Document' ) ) {
- $query = $self->padre2docbrowser($query);
- }
-
- my %hints = (
- $self->_hints,
- _HASH($hint) ? %$hint : (),
- );
-
- if ( _INVOCANT($query) and $query->isa('Padre::DocBrowser::document') ) {
-
- return $self->display($query)
- if $self->viewer_for( $query->guess_mimetype );
-
- my $render = $self->provider->viewer_for( $query->mimetype );
- my $generate = $self->provider->provider_for( $query->mimetype );
-
- if ($generate) {
- my $task = Padre::Task::DocBrowser->new(
- document => $query,
- type => 'docs',
- args => \%hints,
- main_thread_only => sub {
- $self->display( $_[0], $query );
- },
- );
- $task->schedule;
- return 1;
- }
- if ($render) {
- my $talk = Padre::Task::DocBrowser->new(
- document => $query,
- type => 'browse',
- args => \%hints,
- main_thread_only => sub {
- $self->display( $_[0], $query );
- }
- );
-
- }
- $self->not_found( $query, \%hints );
- return;
- } elsif ( defined $query ) {
- my $task = Padre::Task::DocBrowser->new(
- document => $query,
- type => 'resolve',
- args => \%hints,
- main_thread_only => sub {
- $self->help( $_[0], { referrer => $query } );
- }
- );
- $task->schedule;
- return 1;
- } else {
- $self->not_found( $hints{referrer} );
- }
-}
-
-sub ResolveRef {
- my ( $self, $ref ) = @_;
- my $task = Padre::Task::DocBrowser->new(
- document => $ref,
- type => 'resolve',
- args => { $self->_hints },
- main_thread_only => sub {
- if ( $_[0] ) {
- $self->display( $_[0], $ref );
- } else {
- $self->not_found($ref);
- }
- }
- );
- $task->schedule;
-}
-
-# FIX ME , add our own output panel
-sub debug {
- Padre->ide->wx->main->output->AppendText( $_[1] . $/ );
-}
-
-=head2 display
-
-
-=cut
-
-sub display {
- my ( $self, $docs, $query ) = @_;
- if ( _INSTANCE( $docs, 'Padre::DocBrowser::document' ) ) {
-
- # if doc is html just display it
- # TO DO, a means to register other wx display windows such as ?!
- return $self->ShowPage( $docs, $query )
- if ( $self->viewer_for( $docs->mimetype ) );
-
- my $task = Padre::Task::DocBrowser->new(
- document => $docs,
- type => 'browse',
- main_thread_only => sub {
- $self->display( $_[0], $query );
- }
- );
- $task->schedule;
- return 1;
- } else {
- $self->not_found( $docs, $query );
-
- }
-}
-
-sub ShowPage {
- my ( $self, $docs, $query ) = @_;
- unless ( _INSTANCE( $docs, 'Padre::DocBrowser::document' ) ) {
- return $self->not_found($query);
- }
-
- my $title = Wx::gettext('Untitled');
- my $mime = 'text/xhtml';
-
- # Best effort to title the tab ANYTHING more useful
- # than 'Untitled'
- if ( _INSTANCE( $query, 'Padre::DocBrowser::document' ) ) {
- $title = $query->title;
- } elsif ( $docs->title ) {
- $title = $docs->title;
- } elsif ( _STRING($query) ) {
- $title = $query;
- }
-
- # Bashing on Indicies in the attempt to replace an open
- # tab with the same title.
- my $found = $self->notebook->GetPageCount;
- my @opened;
- my $i = 0;
- while ( $i < $found ) {
- my $page = $self->notebook->GetPage($i);
- if ( $self->notebook->GetPageText($i) eq $title ) {
- push @opened,
- {
- page => $page,
- index => $i,
- };
- }
- $i++;
- }
- if ( my $last = pop @opened ) {
- $last->{page}->SetPage( $docs->body );
- $self->notebook->SetSelection( $last->{index} );
- } else {
- my $page = $self->NewPage( $docs->mimetype, $title );
- $page->SetPage( $docs->body );
- }
-
- # and turn off the busy cursor
- $self->{_busyCursor} = undef;
-
- # not sure if I can do this:
- # yep seems I can!
- $self->{_searchEntry}->SetFocus();
-
-}
-
-sub NewPage {
- my ( $self, $mime, $title ) = @_;
- my $page = eval {
- if ( exists $VIEW{$mime} )
- {
- my $class = $VIEW{$mime};
- unless ( $class->VERSION ) {
- eval "require $class;";
- die "Failed to load $class: $@" if $@;
- }
- my $panel = $class->new($self);
- Wx::Event::EVT_HTML_LINK_CLICKED(
- $self, $panel,
- \&OnLinkClicked,
- );
- $self->notebook->AddPage( $panel, $title, 1 );
- $panel;
- } else {
- $self->debug( sprintf( Wx::gettext('DocBrowser: no viewer for %s'), $mime ) );
- }
- };
- return $page;
-}
-
-sub padre2docbrowser {
- my ( $class, $padredoc ) = @_;
- my $doc = Padre::DocBrowser::document->new(
- mimetype => $padredoc->mimetype,
- title => $padredoc->get_title,
- filename => $padredoc->filename,
- );
-
- $doc->body( Encode::encode( 'utf8', $padredoc->text_get ) );
-
- $doc->mimetype( $doc->guess_mimetype ) unless $doc->mimetype;
-
- return $doc;
-}
-
-sub not_found {
-
- # trying a dialog rather than the open tab.
- my ( $self, $query, $hints ) = @_;
-
- # we got this far, make the cursor not busy
- $self->{_busyCursor} = undef;
-
- $query ||= $hints->{referrer};
- use Wx qw(wxOK wxCENTRE wxICON_INFORMATION);
- my $notFound = Wx::MessageDialog->new(
- $self,
- sprintf( Wx::gettext("Searched for '%s' and failed..."), $query ),
- Wx::gettext('Help not found.'),
- wxOK | wxCENTRE | wxICON_INFORMATION
- );
-
- $notFound->ShowModal;
- $notFound->Destroy;
-
- # set focus back to the entry.
- $self->{_searchEntry}->SetFocus();
-
-}
-
-# Private methods
-
-# There are some things only the instance knows , like desired locale
-# or how to derive a title from a documentation section
-sub _hints {
- return (
- ( Padre::Locale::iso639() eq Padre::Locale::system_iso639() )
- ? ()
- : ( lang => Padre::Locale::iso639() ),
-
- title_from_section => Wx::gettext('NAME'),
- );
-}
-
-sub _close {
- my ($self) = @_;
-
- #print "Going to close the docbrowser\n";
-
- # in case we have a busy cursor still:
- $self->{_busyCursor} = undef;
-
- $self->Close();
-}
-
-sub _close_tab {
- my ( $self, $event ) = @_;
-
- # When we get an Wx::AuiNotebookEvent from it will try to close
- # the notebook no matter what. For the other events we have to
- # close the tab manually which we do in the close() function
- # Hence here we don't allow the automatic closing of the window.
- if ( $event and $event->isa('Wx::AuiNotebookEvent') ) {
- $event->Veto;
- }
-
- my $notebook = $self->notebook;
- my $id = $notebook->GetSelection;
- return if $id == -1;
-
- $self->notebook->DeletePage($id);
-
- return 1;
-
-}
-
-sub _open_doc {
- my $self = shift;
- my $filename = Wx::Perl::Dialog::Simple::file_selector();
- if ( defined $filename ) {
- my $doc = Padre::DocBrowser::document->load($filename);
- $self->help( $doc, $filename );
- }
-}
-
-sub viewer_for {
- my ( $self, $mimetype ) = @_;
- return unless defined $mimetype;
- if ( exists $VIEW{$mimetype} ) {
- return $VIEW{$mimetype};
- }
-}
-
-1;
-
-# Copyright 2008-2010 The Padre development team as listed in Padre.pm.
-# LICENSE
-# This program is free software; you can redistribute it and/or
-# modify it under the same terms as Perl 5 itself.
-
@@ -11,7 +11,7 @@ use Padre::Wx ();
use Padre::Wx::FileDropTarget ();
use Padre::Logger;
-our $VERSION = '0.63';
+our $VERSION = '0.66';
our @ISA = 'Wx::StyledTextCtrl';
# End-Of-Line modes:
@@ -3,13 +3,20 @@ package Padre::Wx::ErrorList;
use 5.008;
use strict;
use warnings;
-use Encode ();
-use Padre::Constant ();
-use Padre::Wx ();
-use Padre::Locale ();
-
-our $VERSION = '0.63';
-our @ISA = 'Wx::TreeCtrl';
+use Encode ();
+use Padre::Constant ();
+use Padre::Locale ();
+use Padre::Wx::Role::View ();
+use Padre::Wx::Role::Main ();
+use Padre::Wx ();
+use Padre::Logger;
+
+our $VERSION = '0.66';
+our @ISA = qw{
+ Padre::Wx::Role::View
+ Padre::Wx::Role::Main
+ Wx::TreeCtrl
+};
use Class::XSAccessor {
getters => {
@@ -18,17 +25,24 @@ use Class::XSAccessor {
enabled => 'enabled',
index => 'index',
lang => 'lang',
- parser => 'parser',
}
};
+
+
+
+
+######################################################################
+# Constructor
+
sub new {
my $class = shift;
my $main = shift;
+ my $panel = shift || $main->bottom;
# Create the Wx object
my $self = $class->SUPER::new(
- $main->bottom,
+ $panel,
-1,
Wx::wxDefaultPosition,
Wx::wxDefaultSize,
@@ -47,79 +61,38 @@ sub new {
Wx::Event::EVT_TREE_ITEM_ACTIVATED(
$self, $self,
sub {
- $self->on_tree_item_activated( $_[1] );
+ $_[0]->on_tree_item_activated( $_[1] );
},
);
return $self;
}
-sub bottom {
- $_[0]->GetParent;
-}
-sub main {
- $_[0]->GetGrandParent;
-}
-sub config {
- $_[0]->GetGrandParent->config;
-}
-sub enable {
- my $self = shift;
- my $main = $self->main;
- my $bottom = $self->bottom;
- my $position = $bottom->GetPageCount;
- $bottom->InsertPage( $position, $self, gettext_label(), 0 );
- $self->Show;
- $bottom->SetSelection($position);
- $main->aui->Update;
- $self->{enabled} = 1;
-}
+######################################################################
+# Padre::Wx::Role::View Methods
-sub disable {
- my $self = shift;
+sub view_panel {
+ return 'bottom';
+}
- my $main = $self->main;
- my $bottom = $self->bottom;
- my $position = $bottom->GetPageIndex($self);
- $self->Hide;
- $bottom->RemovePage($position);
- $main->aui->Update;
- $self->{enabled} = 0;
+sub view_label {
+ shift->gettext_label(@_);
}
-sub gettext_label {
- return Wx::gettext('Errors');
+sub view_close {
+ shift->main->show_errorlist(0);
}
-sub populate {
- my $self = shift;
- return unless $self->enabled;
- my $lang = $self->config->locale_perldiag;
- $lang =~ s/^\s*//;
- $lang =~ s/\s*$//;
- $lang = '' if $lang eq 'EN';
- my $old = $self->lang;
- $self->{lang} = $lang;
- my $data = $self->data;
- $self->{data} = "";
- return unless $data;
- require Padre::Task::ErrorParser;
- my $task = Padre::Task::ErrorParser->new(
- parser => $self->parser,
- cur_lang => $lang,
- old_lang => $old,
- data => $data,
- );
- $task->schedule;
-}
+######################################################################
+# Event Handlers
sub on_menu_help_context_help {
my $self = shift;
@@ -171,6 +144,73 @@ sub on_tree_item_activated {
$editor->goto_line_centerize($line);
}
+
+
+
+
+######################################################################
+# General Methods
+
+sub bottom {
+ TRACE("DEPRECATED") if DEBUG;
+ shift->main->bottom;
+}
+
+sub gettext_label {
+ Wx::gettext('Errors');
+}
+
+sub clear {
+ my $self = shift;
+ $self->DeleteChildren( $self->root );
+}
+
+sub enable {
+ TRACE("DEPRECATED") if DEBUG;
+ my $self = shift;
+ $self->bottom->AddPage( $self, $self->gettext_label, 1 );
+ $self->Show;
+ $self->main->aui->Update;
+ $self->{enabled} = 1;
+}
+
+sub disable {
+ TRACE("DEPRECATED") if DEBUG;
+ my $self = shift;
+ my $bottom = $self->bottom;
+ my $position = $bottom->GetPageIndex($self);
+ $self->Hide;
+ $bottom->RemovePage($position);
+ $self->main->aui->Update;
+ $self->{enabled} = 0;
+}
+
+sub populate {
+ my $self = shift;
+ return unless $self->enabled;
+
+ my $lang = $self->config->locale_perldiag;
+ $lang =~ s/^\s*//;
+ $lang =~ s/\s*$//;
+ $lang = '' if $lang eq 'EN';
+ my $old = $self->lang;
+ $self->{lang} = $lang;
+
+ my $data = $self->data;
+ $self->{data} = "";
+ return unless $data;
+
+ # Kick off the parsing
+ $self->task_request(
+ task => 'Padre::Task::ErrorList',
+ text => $data,
+ cur_lang => $lang,
+ old_lang => $old,
+ );
+
+ return 1;
+}
+
sub collect_data {
my $self = shift;
return unless $self->enabled;
@@ -184,11 +224,6 @@ sub collect_data {
$self->{data} .= "\n";
}
-sub clear {
- my $self = shift;
- $self->DeleteChildren( $self->root );
-}
-
1;
# Copyright 2008-2010 The Padre development team as listed in Padre.pm.
@@ -6,7 +6,7 @@ use warnings;
use Params::Util qw{ _INSTANCE };
use Padre::Wx ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
our @ISA = 'Wx::FileDropTarget';
sub new {
@@ -21,7 +21,7 @@ use Padre::Wx;
use Wx::Event qw( EVT_BUTTON );
-our $VERSION = '0.63';
+our $VERSION = '0.66';
our @ISA = 'Wx::ListView';
my $LineCount; # Global fid count so it can be used in the label
@@ -3,14 +3,18 @@ package Padre::Wx::FunctionList;
use 5.008005;
use strict;
use warnings;
-use Params::Util ('_STRING');
-use Padre::Current ('_CURRENT');
-use Padre::Wx ();
+use Scalar::Util ();
+use Params::Util ();
+use Padre::Role::Task ();
use Padre::Wx::Role::View ();
+use Padre::Wx::Role::Main ();
+use Padre::Wx ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
our @ISA = qw{
+ Padre::Role::Task
Padre::Wx::Role::View
+ Padre::Wx::Role::Main
Wx::Panel
};
@@ -26,7 +30,7 @@ sub new {
my $main = shift;
my $panel = shift || $main->right;
- # Create the parent panel, which will contain the search and tree
+ # Create the parent panel which will contain the search and tree
my $self = $class->SUPER::new(
$panel,
-1,
@@ -34,11 +38,11 @@ sub new {
Wx::wxDefaultSize,
);
- # Store main for other methods
- $self->{main} = $main;
-
# Temporary store for the function list.
- $self->{names} = [];
+ $self->{model} = [];
+
+ # Remember the last document we were looking at
+ $self->{document} = '';
# Create the search control
$self->{search} = Wx::TextCtrl->new(
@@ -49,7 +53,7 @@ sub new {
);
# Create the functions list
- $self->{functions} = Wx::ListBox->new(
+ $self->{list} = Wx::ListBox->new(
$self,
-1,
Wx::wxDefaultPosition,
@@ -61,9 +65,9 @@ sub new {
# Create a sizer
my $sizerv = Wx::BoxSizer->new(Wx::wxVERTICAL);
my $sizerh = Wx::BoxSizer->new(Wx::wxHORIZONTAL);
- $sizerv->Add( $self->{search}, 0, Wx::wxALL | Wx::wxEXPAND );
- $sizerv->Add( $self->{functions}, 1, Wx::wxALL | Wx::wxEXPAND );
- $sizerh->Add( $sizerv, 1, Wx::wxALL | Wx::wxEXPAND );
+ $sizerv->Add( $self->{search}, 0, Wx::wxALL | Wx::wxEXPAND );
+ $sizerv->Add( $self->{list}, 1, Wx::wxALL | Wx::wxEXPAND );
+ $sizerh->Add( $sizerv, 1, Wx::wxALL | Wx::wxEXPAND );
# Fits panel layout
$self->SetSizerAndFit($sizerh);
@@ -71,7 +75,7 @@ sub new {
# Grab the kill focus to prevent deselection
Wx::Event::EVT_KILL_FOCUS(
- $self->{functions},
+ $self->{list},
sub {
return;
},
@@ -80,7 +84,7 @@ sub new {
# Double-click a function name
Wx::Event::EVT_LISTBOX_DCLICK(
$self,
- $self->{functions},
+ $self->{list},
sub {
$self->on_list_item_activated( $_[1] );
}
@@ -88,7 +92,7 @@ sub new {
# Handle key events
Wx::Event::EVT_KEY_UP(
- $self->{functions},
+ $self->{list},
sub {
my ( $this, $event ) = @_;
if ( $event->GetKeyCode == Wx::WXK_RETURN ) {
@@ -108,23 +112,20 @@ sub new {
if ( $code == Wx::WXK_DOWN || $code == Wx::WXK_UP || $code == Wx::WXK_RETURN ) {
# Up/Down and return keys focus on the functions lists
- $self->{functions}->SetFocus;
- my $selection = $self->{functions}->GetSelection;
- if ( $selection == -1 && $self->{functions}->GetCount > 0 ) {
+ $self->{list}->SetFocus;
+ my $selection = $self->{list}->GetSelection;
+ if ( $selection == -1 && $self->{list}->GetCount > 0 ) {
$selection = 0;
}
- $self->{functions}->Select($selection);
+ $self->{list}->Select($selection);
} elsif ( $code == Wx::WXK_ESCAPE ) {
# Escape key clears search and returns focus
# to the editor
$self->{search}->SetValue('');
- my $current = _CURRENT( $self->{main}->current );
- my $document = $current->document;
- if ($document) {
- $document->editor->SetFocus;
- }
+ my $editor = $self->current->editor;
+ $editor->SetFocus if $editor;
}
$event->Skip(1);
@@ -136,7 +137,7 @@ sub new {
$self,
$self->{search},
sub {
- $self->_update_functions_list;
+ $self->render;
}
);
@@ -158,6 +159,10 @@ sub view_label {
shift->gettext_label;
}
+sub view_close {
+ shift->main->show_functions(0);
+}
+
@@ -166,18 +171,18 @@ sub view_label {
# Event Handlers
sub on_list_item_activated {
- my ( $self, $event ) = @_;
+ my $self = shift;
+ my $event = shift;
# Which sub did they click
- my $subname = $self->{functions}->GetStringSelection;
- unless ( defined _STRING($subname) ) {
+ my $subname = $self->{list}->GetStringSelection;
+ unless ( defined Params::Util::_STRING($subname) ) {
return;
}
# Locate the function
- my $current = _CURRENT( $self->{main}->current );
- my $document = $current->document or return;
- my $editor = $document->editor;
+ my $document = $self->current->document or return;
+ my $editor = $document->editor;
my ( $start, $end ) = Padre::Util::get_matches(
$editor->GetText,
$document->get_function_regex($subname),
@@ -211,92 +216,83 @@ sub gettext_label {
Wx::gettext('Functions');
}
-# Refresh the functions list
sub refresh {
- my ( $self, $current ) = @_;
-
- # Flush the list if there is no active document
- return unless $current;
- my $document = $current->document;
- my $functions = $self->{functions};
+ my $self = shift;
+ my $current = shift or return;
+ my $document = $current->document;
+ my $search = $self->{search};
+ my $list = $self->{list};
# Hide the widgets when no files are open
- if ($document) {
- $self->{search}->Show(1);
- $self->{functions}->Show(1);
- } else {
- $functions->Clear;
- $self->{search}->Hide;
- $self->{functions}->Hide;
- $self->{names} = [];
- return;
- }
-
- # Clear search when it is a different document
- if ( $self->{_document} && $document != $self->{_document} ) {
- $self->{search}->ChangeValue('');
- }
- $self->{_document} = $document;
-
- my $config = $self->{main}->config;
- my @methods = $document->get_functions;
-
- if ( scalar @methods == 0 ) {
- $functions->Clear;
- $self->{names} = [];
+ unless ($document) {
+ $search->Hide;
+ $list->Hide;
+ $list->Clear;
+ $self->{model} = [];
+ $self->{document} = '';
return;
}
- if ( $config->main_functions_order eq 'original' ) {
-
- # That should be the one we got from get_functions
- } elsif ( $config->main_functions_order eq 'alphabetical_private_last' ) {
+ # Ensure the widget is visible
+ $search->Show(1);
+ $list->Show(1);
- # ~ comes after \w
- tr/_/~/ foreach @methods;
- @methods = sort { lc($a) cmp lc($b) } @methods;
- tr/~/_/ foreach @methods;
- } else {
-
- # Alphabetical (aka 'abc')
- @methods = sort { lc($a) cmp lc($b) } @methods;
- }
-
- if ( scalar(@methods) == scalar( @{ $self->{names} } ) ) {
- my $new = join ';', @methods;
- my $old = join ';', @{ $self->{names} };
- return if $old eq $new;
+ # Clear search when it is a different document
+ my $id = Scalar::Util::refaddr($document);
+ if ( $id ne $self->{document} ) {
+ $search->ChangeValue('');
+ $self->{document} = $id;
}
- $self->{names} = \@methods;
+ # Launch the background task
+ my $task = $document->task_functions or return;
+ $self->task_request(
+ task => $task,
+ text => $document->text_get,
+ order => $current->config->main_functions_order,
+ );
- # Show them again
- $self->{search}->Show;
- $self->{functions}->Show;
+ return 1;
+}
- $self->_update_functions_list;
+# Set an updated method list from the task
+sub task_response {
+ my $self = shift;
+ my $task = shift;
+ my $list = $task->{list} or return;
+ $self->{model} = $list;
+ $self->render;
}
# Populate the functions list with search results
-sub _update_functions_list {
- my $self = shift;
- my $functions = $self->{functions};
-
- #quote the search string to make it safer
- my $search_expr = $self->{search}->GetValue();
- if ( $search_expr eq '' ) {
- $search_expr = '.*';
+sub render {
+ my $self = shift;
+ my $model = $self->{model};
+ my $search = $self->{search};
+ my $list = $self->{list};
+
+ # Quote the search string to make it safer
+ my $string = $search->GetValue;
+ if ( $string eq '' ) {
+ $string = '.*';
} else {
- $search_expr = quotemeta $search_expr;
+ $string = quotemeta $string;
}
- # Populate the function list with matching functions
- $functions->Clear;
- foreach my $method ( reverse @{ $self->{names} } ) {
- if ( $method =~ /$search_expr/i ) {
- $functions->Insert( $method, 0 );
+ # Show the components and populate the function list
+ SCOPE: {
+ my $lock = $self->main->lock('UPDATE');
+ $search->Show(1);
+ $list->Show(1);
+ $list->Clear;
+ foreach my $method ( reverse @$model ) {
+ if ( $method =~ /$string/i ) {
+ $list->Insert( $method, 0 );
+ }
}
}
+
+ return 1;
}
1;
@@ -9,7 +9,7 @@ use Padre::Wx ();
use Padre::DB ();
use Padre::DB::History ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
our @ISA = 'Wx::ComboBox';
sub new {
@@ -11,7 +11,7 @@ use Class::Adapter::Builder
ISA => 'Wx::TextEntryDialog',
AUTOLOAD => 1;
-our $VERSION = '0.63';
+our $VERSION = '0.66';
sub new {
my $class = shift;
@@ -26,7 +26,7 @@ use warnings;
use Padre::Wx ();
use Wx::Html ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
our @ISA = 'Wx::HtmlWindow';
@@ -22,7 +22,7 @@ use Padre::Util ();
use Padre::Wx ();
use Params::Util qw( _HASH );
-our $VERSION = '0.63';
+our $VERSION = '0.66';
# For now apply a single common configuration
use constant SIZE => '16x16';
@@ -1,16 +1,17 @@
package Padre::Wx::Left;
-# The left-hand notebook
+# The left notebook for tool views
use 5.008;
use strict;
use warnings;
-use Padre::Constant ();
-use Padre::Wx ();
+use Padre::Constant ();
+use Padre::Wx ();
+use Padre::Wx::Role::Main ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
our @ISA = qw{
- Padre::Wx::Role::MainChild
+ Padre::Wx::Role::Main
Wx::AuiNotebook
};
@@ -75,8 +76,7 @@ sub show {
}
# Add the page
- $self->InsertPage(
- 0,
+ $self->AddPage(
$page,
$page->gettext_label,
1,
@@ -85,6 +85,13 @@ sub show {
$self->Show;
$self->aui->GetPane($self)->Show;
+ Wx::Event::EVT_AUINOTEBOOK_PAGE_CLOSE(
+ $self, $self,
+ sub {
+ shift->on_close(@_);
+ }
+ );
+
return;
}
@@ -111,7 +118,7 @@ sub hide {
return;
}
-# This has a refresh so we can do content-adaptive labels
+# Allows for content-adaptive labels
sub refresh {
my $self = shift;
foreach my $i ( 0 .. $self->GetPageCount - 1 ) {
@@ -128,6 +135,27 @@ sub relocale {
return;
}
+# It is unscalable for the view notebooks to have to know what they might contain
+# and then re-implement the show/hide logic (probably wrong).
+# Instead, tunnel the close action to the tool and let the tool decide how to go
+# about closing itself (which will usually be by delegating up to the main window).
+sub on_close {
+ my $self = shift;
+ my $event = shift;
+
+ # Tunnel the request through to the tool if possible.
+ my $position = $event->GetSelection;
+ my $tool = $self->GetPage($position);
+ unless ( $tool->can('view_close') ) {
+
+ # HACK: Crash in a controller manner for the moment.
+ # Later just let this crash uncontrolably :)
+ my $class = ref $tool;
+ die "Panel tool $class does define 'view_close' method";
+ }
+ $tool->view_close;
+}
+
1;
# Copyright 2008-2010 The Padre development team as listed in Padre.pm.
@@ -50,6 +50,7 @@ use Padre::Util::Template ();
use Padre::Wx ();
use Padre::Wx::Icon ();
use Padre::Wx::Debugger ();
+use Padre::Wx::Display ();
use Padre::Wx::Editor ();
use Padre::Wx::Menubar ();
use Padre::Wx::ToolBar ();
@@ -59,10 +60,14 @@ use Padre::Wx::AuiManager ();
use Padre::Wx::FileDropTarget ();
use Padre::Wx::Dialog::Text ();
use Padre::Wx::Dialog::FilterTool ();
+use Padre::Wx::Role::Conduit ();
use Padre::Logger;
-our $VERSION = '0.63';
-our @ISA = 'Wx::Frame';
+our $VERSION = '0.66';
+our @ISA = qw{
+ Padre::Wx::Role::Conduit
+ Wx::Frame
+};
use constant SECONDS => 1000;
@@ -115,8 +120,7 @@ sub new {
}
# Generate a smarter default size than Wx does
- if ( $size->[0] == -1 ) {
- require Padre::Wx::Display;
+ if ( grep { defined $_ and $_ eq '-1' } ( @$size, @$position ) ) {
my $rect = Padre::Wx::Display::primary_default();
$size = $rect->GetSize;
$position = $rect->GetPosition;
@@ -124,7 +128,8 @@ sub new {
# Create the underlying Wx frame
my $self = $class->SUPER::new(
- undef, -1,
+ undef,
+ -1,
'Padre',
$position,
$size,
@@ -207,7 +212,7 @@ sub new {
Wx::Event::EVT_AUI_PANE_CLOSE(
$self,
sub {
- $_[0]->on_aui_pane_close( $_[1] );
+ shift->on_aui_pane_close(@_);
},
);
@@ -237,8 +242,8 @@ sub new {
# Use Padre's icon
if (Padre::Constant::WIN32) {
- # Windows needs its ICOn file for Padre to look cooler in the
- # task bar, task switch bar and task manager
+ # Windows needs its ICO'n file for Padre to look cooler in
+ # the task bar, task switch bar and task manager
$self->SetIcons(Padre::Wx::Icon::PADRE_ICON_FILE);
} else {
$self->SetIcon(Padre::Wx::Icon::PADRE);
@@ -247,14 +252,16 @@ sub new {
# Show the tools that the configuration dictates.
# Use the fast and crude internal versions here only,
# so we don't accidentally trigger any configuration writes.
- $self->_show_todo( $self->config->main_todo );
- $self->_show_functions( $self->config->main_functions );
- $self->_show_outline( $self->config->main_outline );
- $self->_show_directory( $self->config->main_directory );
- $self->_show_output( $self->config->main_output );
+ $self->_show_todo( $config->main_todo );
+ $self->_show_functions( $config->main_functions );
+ $self->_show_outline( $config->main_outline );
+ $self->_show_directory( $config->main_directory );
+ $self->_show_output( $config->main_output );
+ $self->_show_syntax( $config->main_syntaxcheck );
+ $self->_show_errorlist( $config->main_errorlist );
# Lock the panels if needed
- $self->aui->lock_panels( $self->config->main_lockinterface );
+ $self->aui->lock_panels( $config->main_lockinterface );
$self->{_debugger_} = Padre::Wx::Debugger->new;
@@ -306,14 +313,9 @@ sub timer_start {
# size, reposition to the defaults).
# This must happen AFTER the initial ->Show(1) because otherwise
# ->IsShownOnScreen returns a false-negative result.
- unless ( $self->IsShownOnScreen and $self->_xy_on_screen ) {
- $self->SetSize(
- Wx::Size->new(
- $config->default('main_width'),
- $config->default('main_height'),
- )
- );
- $self->CentreOnScreen;
+ unless ( Padre::Wx::Display->perfect($self) ) {
+ my $rect = Padre::Wx::Display::primary_default();
+ $self->SetSizeRect($rect);
}
# Lock everything during the initial opening of files.
@@ -344,11 +346,6 @@ sub timer_start {
$self->GetStatusBar->Hide;
}
$manager->enable_editors_for_all;
-
- $self->show_syntax( $config->main_syntaxcheck );
- if ( $config->main_errorlist ) {
- $self->errorlist->enable;
- }
}
# Start the single instance server
@@ -359,7 +356,7 @@ sub timer_start {
# Check for new plug-ins and alert the user to them
$manager->alert_new;
- unless ($Padre::Test::VERSION) {
+ unless ( $Padre::Test::VERSION or $config->feedback_done ) {
require Padre::Wx::Dialog::WhereFrom;
Padre::Wx::Dialog::WhereFrom->new($self);
}
@@ -375,6 +372,9 @@ sub timer_start {
);
$timer->Start( $config->update_file_from_disk_interval * SECONDS, 0 );
+ # Start the second-generation task manager
+ $self->ide->task_manager->start;
+
return;
}
@@ -1155,6 +1155,8 @@ sub refresh {
$self->refresh_functions($current);
$self->refresh_directory($current);
$self->refresh_status($current);
+ $self->refresh_outline($current);
+ $self->refresh_syntaxcheck($current);
# Now signal the refresh to all remaining listeners
# weed out expired weak references
@@ -1172,7 +1174,6 @@ sub refresh {
my $id = $notebook->GetSelection;
if ( defined $id and $id >= 0 ) {
$notebook->GetPage($id)->SetFocus;
- $self->refresh_syntaxcheck;
}
$self->aui->GetPane('notebook')->PaneBorder(0);
} else {
@@ -1783,15 +1784,14 @@ the panel.
sub show_todo {
my $self = shift;
- my $on = ( @_ ? ( $_[0] ? 1 : 0 ) : 1 );
+ my $on = ( @_ ? ( $_[0] ? 1 : 0 ) : 1 );
+ my $lock = $self->lock( 'UPDATE', 'refresh_todo' );
unless ( $on == $self->menu->view->{todo}->IsChecked ) {
$self->menu->view->{todo}->Check($on);
}
- $self->config->set( main_todo => $on );
- $self->config->write;
+ $self->config->set( main_todo => $on );
$self->_show_todo($on);
-
$self->aui->Update;
$self->ide->save_config;
@@ -1824,16 +1824,14 @@ the panel.
sub show_outline {
my $self = shift;
-
- my $on = ( @_ ? ( $_[0] ? 1 : 0 ) : 1 );
+ my $on = ( @_ ? ( $_[0] ? 1 : 0 ) : 1 );
+ my $lock = $self->lock( 'UPDATE', 'refresh_outline' );
unless ( $on == $self->menu->view->{outline}->IsChecked ) {
$self->menu->view->{outline}->Check($on);
}
- $self->config->set( main_outline => $on );
- $self->config->write;
+ $self->config->set( main_outline => $on );
$self->_show_outline($on);
-
$self->aui->Update;
$self->ide->save_config;
@@ -1846,11 +1844,11 @@ sub _show_outline {
if ( $_[0] ) {
my $outline = $self->outline;
$self->right->show($outline);
- $outline->start unless $outline->running;
+ $outline->start;
} elsif ( $self->has_outline ) {
my $outline = $self->outline;
$self->right->hide($outline);
- $outline->stop if $outline->running;
+ $outline->stop;
delete $self->{outline};
}
}
@@ -1902,16 +1900,14 @@ the panel.
sub show_directory {
my $self = shift;
-
- my $on = ( @_ ? ( $_[0] ? 1 : 0 ) : 1 );
+ my $on = ( @_ ? ( $_[0] ? 1 : 0 ) : 1 );
+ my $lock = $self->lock( 'UPDATE', 'refresh_directory' );
unless ( $on == $self->menu->view->{directory}->IsChecked ) {
$self->menu->view->{directory}->Check($on);
}
- $self->config->set( main_directory => $on );
- $self->config->write;
+ $self->config->set( main_directory => $on );
$self->_show_directory($on);
-
$self->aui->Update;
$self->ide->save_config;
@@ -1943,15 +1939,14 @@ the panel.
sub show_output {
my $self = shift;
- my $on = @_ ? $_[0] ? 1 : 0 : 1;
+ my $on = ( @_ ? ( $_[0] ? 1 : 0 ) : 1 );
+ my $lock = $self->lock('UPDATE');
unless ( $on == $self->menu->view->{output}->IsChecked ) {
$self->menu->view->{output}->Check($on);
}
- $self->config->set( main_output => $on );
- $self->config->write;
+ $self->config->set( main_output => $on );
$self->_show_output($on);
-
$self->aui->Update;
$self->ide->save_config;
@@ -1962,10 +1957,7 @@ sub _show_output {
my $self = shift;
my $lock = $self->lock('UPDATE');
if ( $_[0] ) {
- $self->bottom->show(
- $self->output,
- sub { $self->show_output(0) },
- );
+ $self->bottom->show( $self->output );
} elsif ( $self->has_output ) {
$self->bottom->hide( $self->output );
delete $self->{output};
@@ -1986,14 +1978,14 @@ the panel.
sub show_syntax {
my $self = shift;
-
- my $on = @_ ? $_[0] ? 1 : 0 : 1;
+ my $on = ( @_ ? ( $_[0] ? 1 : 0 ) : 1 );
+ my $lock = $self->lock( 'UPDATE', 'refresh_syntaxcheck' );
unless ( $on == $self->menu->view->{show_syntaxcheck}->IsChecked ) {
$self->menu->view->{show_syntaxcheck}->Check($on);
}
+ $self->config->set( main_syntaxcheck => $on );
$self->_show_syntax($on);
-
$self->aui->Update;
$self->ide->save_config;
@@ -2018,6 +2010,33 @@ sub _show_syntax {
}
}
+sub show_errorlist {
+ my $self = shift;
+ my $on = ( @_ ? ( $_[0] ? 1 : 0 ) : 1 );
+ my $lock = $self->lock('UPDATE');
+ unless ( $on == $self->menu->view->{show_errorlist}->IsChecked ) {
+ $self->menu->view->{show_errorlist}->Check($on);
+ }
+
+ $self->config->set( main_errorlist => $on );
+ $self->_show_errorlist($on);
+ $self->aui->Update;
+ $self->ide->save_config;
+
+ return;
+}
+
+sub _show_errorlist {
+ my $self = shift;
+ my $lock = $self->lock('UPDATE');
+ if ( $_[0] ) {
+ $self->bottom->show( $self->errorlist );
+ } elsif ( $self->has_errorlist ) {
+ $self->bottom->hide( $self->errorlist );
+ delete $self->{errorlist};
+ }
+}
+
=pod
=head2 Introspection
@@ -3187,10 +3206,9 @@ sub on_close_window {
$ide->save_config;
$event->Skip;
- TRACE("Tell TaskManager to cleanup") if DEBUG;
-
- # Stop all Task Manager's worker threads
- $self->ide->task_manager->cleanup;
+ # Stop the task manager.
+ TRACE("Shutting down TaskManager") if DEBUG;
+ $self->ide->task_manager->stop;
# Vacuum database on exit so that it does not grow.
# Since you can't VACUUM inside a transaction, finish it here.
@@ -4937,49 +4955,6 @@ sub on_toggle_right_margin {
=pod
-=head3 C<on_toggle_syntax_check>
-
- $main->on_toggle_syntax_check;
-
-Toggle visibility of syntax panel. No return value.
-
-=cut
-
-sub on_toggle_syntax_check {
- my $self = shift;
- my $event = shift;
- $self->config->set( 'main_syntaxcheck', $event->IsChecked ? 1 : 0, );
- $self->show_syntax( $self->config->main_syntaxcheck );
- $self->ide->save_config;
- return;
-}
-
-=pod
-
-=head3 C<on_toggle_errorlist>
-
- $main->on_toggle_errorlist;
-
-Toggle visibility of error-list panel. No return value.
-
-=cut
-
-sub on_toggle_errorlist {
- my $self = shift;
- my $event = shift;
-
- $self->config->set( 'main_errorlist', $event->IsChecked ? 1 : 0, );
- if ( $self->config->main_errorlist ) {
- $self->errorlist->enable;
- } else {
- $self->errorlist->disable;
- }
- $self->ide->save_config;
- return;
-}
-
-=pod
-
=head3 C<on_toggle_indentation_guide>
$main->on_toggle_indentation_guide;
@@ -5404,7 +5379,7 @@ sub on_stc_update_ui {
return if $self->{_in_stc_update_ui};
local $self->{_in_stc_update_ui} = 1;
- # Check for brace, on current position, higlight the matching brace
+ # Check for brace, on current position, highlight the matching brace
my $current = $self->current;
my $editor = $current->editor;
return if not defined $editor;
@@ -6040,13 +6015,13 @@ sub show_as_numbers {
return;
}
-# showing the DocBrowser window
+# showing the Browser window
sub help {
my $self = shift;
my $param = shift;
unless ( $self->{help} ) {
- require Padre::Wx::DocBrowser;
- $self->{help} = Padre::Wx::DocBrowser->new;
+ require Padre::Wx::Browser;
+ $self->{help} = Padre::Wx::Browser->new;
Wx::Event::EVT_CLOSE(
$self->{help},
sub { $self->on_help_close( $_[1] ) },
@@ -9,7 +9,7 @@ use Padre::Wx ();
use Padre::Wx::Menu ();
use Padre::Current qw{_CURRENT};
-our $VERSION = '0.63';
+our $VERSION = '0.66';
our @ISA = 'Padre::Wx::Menu';
@@ -9,7 +9,7 @@ use Padre::Current qw{_CURRENT};
use Padre::Wx ();
use Padre::Wx::Menu ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
our @ISA = 'Padre::Wx::Menu';
@@ -5,12 +5,14 @@ package Padre::Wx::Menu::File;
use 5.008;
use strict;
use warnings;
+use Fcntl ();
use Padre::Wx ();
use Padre::Wx::Menu ();
+use Padre::Constant ();
use Padre::Current ('_CURRENT');
use Padre::Logger;
-our $VERSION = '0.63';
+our $VERSION = '0.66';
our @ISA = 'Padre::Wx::Menu';
@@ -329,7 +331,22 @@ sub refresh_recent {
}
my $idx = 0;
- foreach my $file ( grep { -f if $_ } Padre::DB::History->recent('files') ) {
+ foreach my $file ( Padre::DB::History->recent('files') ) {
+ if (Padre::Constant::WIN32) {
+ next unless -f $file;
+ } else {
+
+ # Try a non-blocking "-f" (doesn't work in all cases)
+ # File does not exist or is not accessable.
+ # NOTE: O_NONBLOCK does not exist on Windows, kaboom
+ sysopen(
+ my $fh,
+ $file,
+ Fcntl::O_RDONLY | Fcntl::O_NONBLOCK
+ ) or next;
+ close $fh;
+ }
+
Wx::Event::EVT_MENU(
$self->{main},
$self->{recentfiles}->Append(
@@ -12,7 +12,7 @@ use Padre::Locale ();
use Padre::Wx ();
use Padre::Wx::Menu ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
our @ISA = 'Padre::Wx::Menu';
@@ -14,7 +14,7 @@ use Padre::Wx::Menu ();
use Padre::Locale ();
use Padre::Current qw{_CURRENT};
-our $VERSION = '0.63';
+our $VERSION = '0.66';
our @ISA = 'Padre::Wx::Menu';
@@ -5,16 +5,15 @@ package Padre::Wx::Menu::Refactor;
use 5.008;
use strict;
use warnings;
-use List::Util ();
-use File::Spec ();
-use File::HomeDir ();
-use Params::Util qw{_INSTANCE};
+use List::Util ();
+use File::Spec ();
+use File::HomeDir ();
use Padre::Wx ();
use Padre::Wx::Menu ();
use Padre::Locale ();
-use Padre::Current qw{_CURRENT};
+use Padre::Current ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
our @ISA = 'Padre::Wx::Menu';
@@ -63,8 +62,7 @@ sub title {
sub refresh {
my $self = shift;
- my $current = _CURRENT(@_);
- my $config = $current->config;
+ my $current = Padre::Current::_CURRENT(@_);
my $document = $current->document;
$self->{rename_variable}->Enable( $document->can('lexical_variable_replacement') ? 1 : 0 );
@@ -9,7 +9,7 @@ use Padre::Current qw{_CURRENT};
use Padre::Wx ();
use Padre::Wx::Menu ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
our @ISA = 'Padre::Wx::Menu';
sub new {
@@ -9,7 +9,7 @@ use Padre::Wx ();
use Padre::Wx::Menu ();
use Padre::Current ('_CURRENT');
-our $VERSION = '0.63';
+our $VERSION = '0.66';
our @ISA = 'Padre::Wx::Menu';
@@ -11,7 +11,7 @@ use Padre::Wx ();
use Padre::Wx::Menu ();
use Padre::Current();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
our @ISA = 'Padre::Wx::Menu';
@@ -12,7 +12,7 @@ use Padre::Wx ();
use Padre::Wx::Menu ();
use Padre::Current ('_CURRENT');
-our $VERSION = '0.63';
+our $VERSION = '0.66';
our @ISA = 'Padre::Wx::Menu';
@@ -12,7 +12,7 @@ use Padre::Wx ();
use Padre::Wx::Menu ();
use Padre::Locale ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
our @ISA = 'Padre::Wx::Menu';
my @GUI_ELEMENTS = (
@@ -10,7 +10,7 @@ use Padre::Wx ();
use Padre::Wx::Menu ();
use Padre::Current ('_CURRENT');
-our $VERSION = '0.63';
+our $VERSION = '0.66';
our @ISA = 'Padre::Wx::Menu';
@@ -13,7 +13,7 @@ use Class::Adapter::Builder
NEW => 'Wx::Menu',
AUTOLOAD => 'PUBLIC';
-our $VERSION = '0.63';
+our $VERSION = '0.66';
use Class::XSAccessor {
getters => {
@@ -19,7 +19,7 @@ use Padre::Wx::Menu::Tools ();
use Padre::Wx::Menu::Window ();
use Padre::Wx::Menu::Help ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
@@ -3,13 +3,13 @@ package Padre::Wx::Notebook;
use 5.008;
use strict;
use warnings;
-use Params::Util ();
-use Padre::Wx ();
-use Padre::Wx::Role::MainChild ();
+use Params::Util ();
+use Padre::Wx ();
+use Padre::Wx::Role::Main ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
our @ISA = qw{
- Padre::Wx::Role::MainChild
+ Padre::Wx::Role::Main
Wx::AuiNotebook
};
@@ -3,32 +3,43 @@ package Padre::Wx::Outline;
use 5.008;
use strict;
use warnings;
-use Params::Util ();
-use Padre::Wx ();
-use Padre::Current ();
+use Scalar::Util ();
+use Params::Util ();
+use Padre::Role::Task ();
+use Padre::Wx::Role::View ();
+use Padre::Wx::Role::Main ();
+use Padre::Wx ();
use Padre::Logger;
-our $VERSION = '0.63';
-our @ISA = 'Wx::TreeCtrl';
-
-use Class::XSAccessor {
- accessors => {
- force_next => 'force_next',
- }
+our $VERSION = '0.66';
+our @ISA = qw{
+ Padre::Role::Task
+ Padre::Wx::Role::View
+ Padre::Wx::Role::Main
+ Wx::TreeCtrl
};
+
+
+
+
+######################################################################
+# Constructor and Accessors
+
sub new {
my $class = shift;
my $main = shift;
- my $self = $class->SUPER::new(
- $main->right,
+ my $panel = shift || $main->right;
+
+ # This tool is just a single tree control
+ my $self = $class->SUPER::new(
+ $panel,
-1,
Wx::wxDefaultPosition,
Wx::wxDefaultSize,
Wx::wxTR_HIDE_ROOT | Wx::wxTR_SINGLE | Wx::wxTR_HAS_BUTTONS | Wx::wxTR_LINES_AT_ROOT
);
$self->SetIndent(10);
- $self->{force_next} = 0;
Wx::Event::EVT_COMMAND_SET_FOCUS(
$self, $self,
@@ -47,81 +58,51 @@ sub new {
$self->Hide;
- $self->{cache} = {};
+ # Track state so we can do shortcutting
+ $self->{document} = '';
+ $self->{length} = -1;
+
+ # Cache document metadata for use when changing documents.
+ # By substituting old metadata before we scan for new metadata,
+ # we can make the widget APPEAR to be faster than it is and
+ # offset the cost of doing the PPI parse in the background.
+ # $self->{cache} = {};
return $self;
}
-sub right {
- $_[0]->GetParent;
-}
-sub main {
- $_[0]->GetGrandParent;
-}
-sub gettext_label {
- Wx::gettext('Outline');
+
+
+######################################################################
+# Padre::Wx::Role::View Methods
+
+sub view_panel {
+ return 'right';
}
-sub clear {
- my ($self) = @_;
- $self->DeleteAllItems;
- return;
+sub view_label {
+ shift->gettext_label;
}
-################################################################
-# Cache routines
+sub view_close {
+ shift->main->show_outline(0);
+}
-sub store_in_cache {
- my ( $self, $cache_key, $content ) = @_;
- if ( defined $cache_key ) {
- $self->{cache}->{$cache_key} = $content;
- }
- return;
-}
-sub get_from_cache {
- my ( $self, $cache_key ) = @_;
- if ( defined $cache_key and exists $self->{cache}->{$cache_key} ) {
- return $self->{cache}->{$cache_key};
- }
- return;
-}
-#####################################################################
-# GUI routines
-
-sub update_data {
- my ( $self, $outline_data, $filename, $right_click_handler ) = @_;
-
- $self->Freeze;
-
- # Clear out the existing stuff
- # TO DO extract data for keeping (sub)trees collapsed/expanded (see below)
- #if ( $self->GetCount > 0 ) {
- # my $r = $self->GetRootItem;
- # warn ref $r;
- # use Data::Dumper;
- # my ( $fc, $cookie ) = $self->GetFirstChild($r);
- # warn ref $fc;
- # warn $self->GetItemText($fc) . ': ' . Dumper( $self->GetPlData($fc) );
- #}
- $self->clear;
-
- require Padre::Wx;
-
- # If there is no structure, clear the outline pane and return.
- unless ($outline_data) {
- return;
- }
+######################################################################
+# Padre::Role::Task Methods
- # Again, slightly differently
- unless (@$outline_data) {
- return 1;
- }
+sub task_response {
+ TRACE( $_[1] ) if DEBUG;
+ my $self = shift;
+ my $task = shift;
+ my $data = Params::Util::_ARRAY( $task->{data} ) or return;
+ my $lock = $self->main->lock('UPDATE');
# Add the hidden unused root
my $root = $self->AddRoot(
@@ -131,55 +112,238 @@ sub update_data {
Wx::TreeItemData->new('')
);
- # Update the outline pane
- _update_treectrl( $self, $outline_data, $root );
-
- # Set MIME type specific event handler
- if ( defined $right_click_handler ) {
- Wx::Event::EVT_TREE_ITEM_RIGHT_CLICK(
- $self,
- $self,
- $right_click_handler,
+ # Add the packge trees
+ foreach my $pkg (@$data) {
+ my $branch = $self->AppendItem(
+ $root,
+ $pkg->{name},
+ -1, -1,
+ Wx::TreeItemData->new(
+ { line => $pkg->{line},
+ name => $pkg->{name},
+ type => 'package',
+ }
+ )
);
+ foreach my $type (qw(pragmata modules attributes methods events)) {
+ $self->add_subtree( $pkg, $type, $branch );
+ }
+ $self->Expand($branch);
}
+ # Set MIME type specific event handler
+ Wx::Event::EVT_TREE_ITEM_RIGHT_CLICK(
+ $self, $self,
+ sub {
+ $_[0]->on_tree_item_right_click( $_[1] );
+ },
+ );
+
# TO DO Expanding all is not acceptable: We need to keep the state
# (i.e., keep the pragmata subtree collapsed if it was collapsed
# by the user)
#$self->ExpandAll;
$self->GetBestSize;
- $self->Thaw;
- $self->store_in_cache( $filename, [ $outline_data, $right_click_handler ] );
+ # Disable caching for the moment
+ # $self->store_in_cache( $filename, [ $data, $right_click_handler ] );
return 1;
}
-sub _update_treectrl {
- my ( $outlinebar, $outline, $root ) = @_;
- foreach my $pkg ( @{$outline} ) {
- my $branch = $outlinebar->AppendItem(
- $root,
- $pkg->{name},
- -1, -1,
- Wx::TreeItemData->new(
- { line => $pkg->{line},
- name => $pkg->{name},
- type => 'package',
- }
- )
+
+
+
+#####################################################################
+# Timer Control
+
+sub running {
+ !!( $_[0]->{timer} and $_[0]->{timer}->IsRunning );
+}
+
+sub start {
+ my $self = shift;
+ TRACE("Starting Outline timer") if DEBUG;
+
+ # Set up or reinitialise the timer
+ if ( Params::Util::_INSTANCE( $self->{timer}, 'Wx::Timer' ) ) {
+ $self->{timer}->Stop if $self->{timer}->IsRunning;
+ } else {
+ $self->{timer} = Wx::Timer->new(
+ $self,
+ Padre::Wx::ID_TIMER_OUTLINE
);
- foreach my $type (qw(pragmata modules attributes methods events)) {
- _add_subtree( $outlinebar, $pkg, $type, $branch );
- }
- $outlinebar->Expand($branch);
+ Wx::Event::EVT_TIMER(
+ $self,
+ Padre::Wx::ID_TIMER_OUTLINE,
+ sub {
+ $_[1]->Skip(0);
+ $_[0]->refresh;
+ },
+ );
+ }
+ $self->{timer}->Start(5000);
+
+ return;
+}
+
+sub stop {
+ my $self = shift;
+ TRACE("Stopping Outline timer") if DEBUG;
+
+ # Stop the timer
+ if ( Params::Util::_INSTANCE( $self->{timer}, 'Wx::Timer' ) ) {
+ $self->{timer}->Stop if $self->{timer}->IsRunning;
}
return;
}
-sub _add_subtree {
+
+
+
+
+#####################################################################
+# Event Handlers
+
+sub on_tree_item_right_click {
+ my $self = shift;
+ my $event = shift;
+ my $show = 0;
+ my $menu = Wx::Menu->new;
+ my $pldata = $self->GetPlData( $event->GetItem );
+
+ if ( defined($pldata) && defined( $pldata->{line} ) && $pldata->{line} > 0 ) {
+ my $goto = $menu->Append( -1, Wx::gettext('&Go to Element') );
+ Wx::Event::EVT_MENU(
+ $self, $goto,
+ sub {
+ $self->on_tree_item_set_focus($event);
+ },
+ );
+ $show++;
+ }
+
+ if ( defined($pldata)
+ && defined( $pldata->{type} )
+ && ( $pldata->{type} eq 'modules' || $pldata->{type} eq 'pragmata' ) )
+ {
+ my $pod = $menu->Append( -1, Wx::gettext('Open &Documentation') );
+ Wx::Event::EVT_MENU(
+ $self, $pod,
+ sub {
+
+ # TO DO Fix this wasting of objects (cf. Padre::Wx::Menu::Help)
+ require Padre::Wx::Browser;
+ my $help = Padre::Wx::Browser->new;
+ $help->help( $pldata->{name} );
+ $help->SetFocus;
+ $help->Show(1);
+ return;
+ },
+ );
+ $show++;
+ }
+
+ if ( $show > 0 ) {
+ my $x = $event->GetPoint->x;
+ my $y = $event->GetPoint->y;
+ $self->PopupMenu( $menu, $x, $y );
+ }
+
+ return;
+}
+
+# Method alias
+sub on_tree_item_activated {
+ shift->on_tree_item_set_focus(@_);
+}
+
+sub on_tree_item_set_focus {
+ my $self = shift;
+ my $event = shift;
+ my $selection = $self->GetSelection();
+ if ( $selection and $selection->IsOk ) {
+ my $item = $self->GetPlData($selection);
+ if ( defined $item ) {
+ $self->select_line_in_editor( $item->{line} );
+ }
+ }
+ return;
+}
+
+
+
+
+
+################################################################
+# Cache routines
+
+# sub store_in_cache {
+# my ( $self, $cache_key, $content ) = @_;
+#
+# if ( defined $cache_key ) {
+# $self->{cache}->{$cache_key} = $content;
+# }
+# return;
+# }
+#
+# sub get_from_cache {
+# my ( $self, $cache_key ) = @_;
+#
+# if ( defined $cache_key and exists $self->{cache}->{$cache_key} ) {
+# return $self->{cache}->{$cache_key};
+# }
+# return;
+# }
+
+
+
+
+
+######################################################################
+# General Methods
+
+sub gettext_label {
+ Wx::gettext('Outline');
+}
+
+sub clear {
+ $_[0]->DeleteAllItems;
+}
+
+sub refresh {
+ TRACE( $_[0] ) if DEBUG;
+ my $self = shift;
+ my $document = $self->current->document or return;
+ my $length = $document->text_length;
+
+ if ( $document eq $self->{document} ) {
+
+ # Shortcut if nothing has changed.
+ # NOTE: Given the speed at which the timer fires a cheap
+ # length check is better than an expensive MD5 check.
+ if ( $length eq $self->{length} ) {
+ return;
+ }
+ } else {
+
+ # New file, don't keep the current list visible
+ $self->clear;
+ }
+ $self->{document} = $document;
+ $self->{length} = $length;
+
+ # Fire the background task discarding old results
+ $self->task_reset;
+ $self->task_request(
+ task => $document->task_outline,
+ document => $document,
+ );
+}
+
+sub add_subtree {
my ( $self, $pkg, $type, $root ) = @_;
my %type_caption = (
@@ -245,149 +409,32 @@ sub _add_subtree {
if ( $type eq 'methods' ) {
$self->Expand($type_elem);
} else {
- $self->Collapse($type_elem);
- }
- }
-
- return;
-}
-
-#####################################################################
-# Timer Control
-
-sub start {
- my $self = shift; @_ = (); # Feeble attempt to kill Scalars Leaked ($self is leaking)
-
- # TO DO: GUI on-start initialisation here
-
- # Set up or reinitialise the timer
- if ( Params::Util::_INSTANCE( $self->{timer}, 'Wx::Timer' ) ) {
- $self->{timer}->Stop if $self->{timer}->IsRunning;
- } else {
- $self->{timer} = Wx::Timer->new(
- $self,
- Padre::Wx::ID_TIMER_OUTLINE
- );
- Wx::Event::EVT_TIMER(
- $self,
- Padre::Wx::ID_TIMER_OUTLINE,
- sub {
- $self->on_timer( $_[1], $_[2] );
- },
- );
- }
- $self->{timer}->Start(1000);
- $self->on_timer( undef, 1 );
-
- return ();
-}
-
-sub stop {
- my $self = shift;
-
- TRACE("stopping Outline") if DEBUG;
-
- # Stop the timer
- if ( Params::Util::_INSTANCE( $self->{timer}, 'Wx::Timer' ) ) {
- $self->{timer}->Stop if $self->{timer}->IsRunning;
- }
-
- $self->clear;
-
- # TO DO: GUI on-stop cleanup here
-
- return ();
-}
-
-sub refresh {
- my $self = shift;
-
- $self->clear;
-
- my $filename = Padre::Current->filename;
- my $outline_data_ref = $self->get_from_cache($filename);
- if ( defined $outline_data_ref ) {
- my ( $outline_data, $right_click_handler ) = @$outline_data_ref;
- $self->update_data( $outline_data, $filename, $right_click_handler );
- }
-
- $self->force_next(1);
-}
-
-sub running {
- !!( $_[0]->{timer} and $_[0]->{timer}->IsRunning );
-}
-
-#####################################################################
-# Event Handlers
-
-sub on_tree_item_set_focus {
- my ( $self, $event ) = @_;
- my $main = Padre::Current->main($self);
- my $page = $main->current->editor;
- my $selection = $self->GetSelection();
- if ( $selection and $selection->IsOk ) {
- my $item = $self->GetPlData($selection);
- if ( defined $item ) {
- $self->select_line_in_editor( $item->{line} );
+ if ( $self->IsExpanded($type_elem) ) {
+ $self->Collapse($type_elem);
+ }
}
}
- return;
-}
-sub on_tree_item_activated {
- on_tree_item_set_focus(@_);
return;
}
sub select_line_in_editor {
- my ( $self, $line_number ) = @_;
- my $main = Padre::Current->main($self);
- my $page = $main->current->editor;
- if ( defined $line_number
- && ( $line_number =~ /^\d+$/o )
- && ( defined $page )
- && ( $line_number <= $page->GetLineCount ) )
+ my $self = shift;
+ my $line = shift;
+ my $editor = $self->current->editor;
+ if ( defined $line
+ && ( $line =~ /^\d+$/o )
+ && ( defined $editor )
+ && ( $line <= $editor->GetLineCount ) )
{
- $line_number--;
- $page->EnsureVisible($line_number);
- $page->goto_pos_centerize( $page->GetLineIndentPosition($line_number) );
- $page->SetFocus;
+ $line--;
+ $editor->EnsureVisible($line);
+ $editor->goto_pos_centerize( $editor->GetLineIndentPosition($line) );
+ $editor->SetFocus;
}
return;
}
-sub on_timer {
- my ( $self, $event, $force ) = @_;
-
- ### NOTE:
- # floating windows, when undocked (err... "floating"), will
- # return Wx::AuiFloatingFrame as their parent. So floating
- # windows should always get their "main" from Padre::Current->main
- # and -not- from $self->main.
- my $main = Padre::Current->main($self);
-
- my $document = $main->current->document or return;
-
- unless ( $document->can('get_outline') ) {
- $self->clear;
- return;
- }
-
- if ( $self->force_next ) {
- $force = 1;
- $self->force_next(0);
- }
-
- $document->get_outline( force => $force );
-
- if ( defined($event) ) {
- $event->Skip(0);
- }
-
- return;
-}
-
1;
# Copyright 2008-2010 The Padre development team as listed in Padre.pm.
@@ -8,25 +8,37 @@ use 5.008;
use strict;
use warnings;
use utf8;
-use Encode ();
-use Params::Util ();
-use Padre::Wx ();
+use Encode ();
+use File::Spec ();
+use Params::Util ();
+use Padre::Wx::Role::View ();
+use Padre::Wx::Role::Main ();
+use Padre::Wx ();
+use Padre::Logger;
+use Wx::RichText; # Is this necesary?
-our $VERSION = '0.63';
-use Wx::RichText;
-our @ISA = 'Wx::RichTextCtrl';
+our $VERSION = '0.66';
+our @ISA = qw{
+ Padre::Wx::Role::View
+ Padre::Wx::Role::Main
+ Wx::RichTextCtrl
+};
+
+
+
+
+
+######################################################################
+# Constructor
sub new {
my $class = shift;
my $main = shift;
-
- # Bottom defaults to $main's bottom panel, but can be
- # something different (for example see Padre::Plugin::Plack's usage)
- my $bottom = shift || $main->bottom;
+ my $panel = shift || $main->bottom;
# Create the underlying object
my $self = $class->SUPER::new(
- $bottom,
+ $panel,
-1,
"",
Wx::wxDefaultPosition,
@@ -40,60 +52,71 @@ sub new {
# Do custom start-up stuff here
$self->clear;
$self->set_font;
- $self->{main} = $main;
- $self->{bottom} = $bottom;
# see #351: output should be blank by default at start-up.
#$self->AppendText( Wx::gettext('No output') );
- use Padre::Logger;
Wx::Event::EVT_TEXT_URL(
$self, $self,
sub {
- my $self = shift;
- my $event = shift;
- my $uri_string = $event->GetString or return;
- require URI;
- require File::Spec;
- my $uri = URI->new($uri_string) or return;
- TRACE(" onclick for URI: $uri") if DEBUG;
-
- my $file = $uri->file or return;
- my $path = File::Spec->rel2abs($file) or return;
- my $line = $uri->fragment || 1;
-
- #TRACE(" path: $path") if DEBUG;
- #TRACE(" line: $line") if DEBUG;
-
- return unless -e $path;
-
- my $main = $self->main;
- $main->setup_editor($path);
- if ( $main->current->document->filename eq $path ) {
- $main->current->editor->goto_line_centerize( $line - 1 );
- } else {
- TRACE(" Current doc does not match our expectations") if DEBUG;
- }
+ shift->on_text_url(@_);
},
);
return $self;
}
-sub bottom {
- $_[0]->{bottom} || $_[0]->GetParent;
+
+
+
+
+######################################################################
+# Padre::Wx::Role::View Methods
+
+sub view_panel {
+ return 'bottom';
}
-sub main {
- $_[0]->{main} || $_[0]->GetGrandParent;
+sub view_label {
+ shift->gettext_label(@_);
}
-sub current {
- Padre::Current->new( main => $_[0]->main );
+sub view_close {
+ shift->main->show_output(0);
}
-sub gettext_label {
- Wx::gettext('Output');
+
+
+
+
+######################################################################
+# Event Handlers
+
+sub on_text_url {
+ my $self = shift;
+ my $event = shift;
+ my $string = $event->GetString or return;
+
+ require URI;
+ my $uri = URI->new($string) or return;
+ TRACE("Output URI clicked: $uri") if DEBUG;
+
+ my $file = $uri->file or return;
+ my $path = File::Spec->rel2abs($file) or return;
+ my $line = $uri->fragment || 1;
+ return unless -e $path;
+
+ TRACE("Output Path: $path") if DEBUG;
+ TRACE("Output Line: $line") if DEBUG;
+
+ # Open the file and jump to the appropriate line
+ $self->main->setup_editor($path);
+ my $current = $self->current;
+ if ( $current->filename eq $path ) {
+ $current->editor->goto_line_centerize( $line - 1 );
+ } else {
+ TRACE(" Current doc does not match our expectations") if DEBUG;
+ }
}
@@ -108,14 +131,11 @@ sub gettext_label {
sub setup_bindings {
my $self = shift;
- if ($Wx::Perl::ProcessStream::VERSION) {
- return 1;
- }
-
+ return 1 if $Wx::Perl::ProcessStream::VERSION;
require Wx::Perl::ProcessStream;
if ( $Wx::Perl::ProcessStream::VERSION < .20 ) {
- $self->{main}->error(
+ $self->main->error(
sprintf(
Wx::gettext(
'Wx::Perl::ProcessStream is version %s'
@@ -167,6 +187,15 @@ sub setup_bindings {
#####################################################################
# General Methods
+sub bottom {
+ warn "Unexpectedly called Padre::Wx::Output::bottom, it should be deprecated";
+ shift->main->bottom;
+}
+
+sub gettext_label {
+ Wx::gettext('Output');
+}
+
# From Sean Healy on wxPerl mailing list.
# Tweaked to avoid strings copying as much as possible.
sub AppendText {
@@ -186,6 +215,11 @@ sub AppendText {
$self->SUPER::AppendText($text);
}
}
+
+ # Scroll down to the latest position
+ # Maybe we should check for a setting
+ # so user can set if they want scroll
+ $self->ShowPosition( $self->GetLastPosition() );
return ();
}
@@ -223,24 +257,24 @@ SCOPE: {
my $self = shift;
my $newtext = shift;
- # read the next TEXT CONTROL-SEQUENCE pair
+ # Read the next TEXT CONTROL-SEQUENCE pair
my $style = $self->GetDefaultStyle;
my $ansi_found = 0;
while ( $newtext =~ m{ \G (.*?) \033\[ ( (?: \d+ (?:;\d+)* )? ) m }xcg ) {
$ansi_found = 1;
my $ctrl = $2;
- # first print the text preceding the control sequence
+ # First print the text preceding the control sequence
$self->_handle_links($1);
- # split the sequence on ; -- this may be specific to the graphics 'm' sequences, but
+ # Split the sequence on ; -- this may be specific to the graphics 'm' sequences, but
# we don't handle any others at the moment (see regexp above)
my @cmds = split /;/, $ctrl;
foreach my $cmd (@cmds) {
if ( $cmd >= 0 and $cmd < 30 ) {
- # for all these, we need the font object:
+ # For all these, we need the font object:
my $font = $style->GetFont;
if ( $cmd == 0 ) { # reset
$style->SetTextColour( $fg_colors->[9] ); # reset text color
@@ -314,6 +348,7 @@ SCOPE: {
my ( $file, $line ) = ( $2, $3 );
# first print the text preceding the link
+ # TO DO: You can't make SUPER calls to different methods
$self->SUPER::AppendText($1);
$self->SUPER::AppendText(' at ');
@@ -330,7 +365,7 @@ SCOPE: {
}
# the remaining text
- if ( defined( pos($newtext) ) ) {
+ if ( defined pos($newtext) ) {
$self->SUPER::AppendText( substr( $newtext, pos($newtext) ) );
}
unless ($link_found) {
@@ -384,16 +419,15 @@ sub style_busy {
}
sub set_font {
- my $self = shift;
- my $config = $self->main->config;
- my $font = Wx::Font->new( 10, Wx::wxTELETYPE, Wx::wxNORMAL, Wx::wxNORMAL );
- if ( defined $config->editor_font && length $config->editor_font > 0 ) { # empty default...
- $font->SetNativeFontInfoUserDesc( $config->editor_font );
+ my $self = shift;
+ my $font = Wx::Font->new( 10, Wx::wxTELETYPE, Wx::wxNORMAL, Wx::wxNORMAL );
+ my $name = $self->config->editor_font;
+ if ( defined $name and length $name ) {
+ $font->SetNativeFontInfoUserDesc($name);
}
my $style = $self->GetDefaultStyle;
$style->SetFont($font);
$self->SetDefaultStyle($style);
-
return;
}
@@ -30,7 +30,7 @@ use strict;
use warnings;
use Padre::Wx ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
our @ISA = 'Wx::Frame';
=pod
@@ -5,7 +5,7 @@ use strict;
use warnings;
use Padre::Wx ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
our @ISA = 'Wx::PlPopupTransientWindow';
sub on_paint {
@@ -6,7 +6,7 @@ use warnings;
use Padre::Wx ();
use Wx::Print ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
our @ISA = 'Wx::Printout';
sub new {
@@ -28,7 +28,7 @@ use strict;
use warnings;
use Padre::Wx;
-our $VERSION = '0.63';
+our $VERSION = '0.66';
=pod
@@ -1,16 +1,17 @@
package Padre::Wx::Right;
-# The right-hand notebook
+# The right notebook for tool views
use 5.008;
use strict;
use warnings;
-use Padre::Constant ();
-use Padre::Wx ();
+use Padre::Constant ();
+use Padre::Wx ();
+use Padre::Wx::Role::Main ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
our @ISA = qw{
- Padre::Wx::Role::MainChild
+ Padre::Wx::Role::Main
Wx::AuiNotebook
};
@@ -62,7 +63,8 @@ sub new {
# Page Management
sub show {
- my ( $self, $page, $on_close ) = @_;
+ my $self = shift;
+ my $page = shift;
# Are we currently showing the page
my $position = $self->GetPageIndex($page);
@@ -74,6 +76,7 @@ sub show {
}
# Add the page
+ # NOTE: Only the Right panel adds tools at the left, the rest do so on the right
$self->InsertPage(
0,
$page,
@@ -84,7 +87,12 @@ sub show {
$self->Show;
$self->aui->GetPane($self)->Show;
- Wx::Event::EVT_AUINOTEBOOK_PAGE_CLOSE( $self, $self, \&_on_close );
+ Wx::Event::EVT_AUINOTEBOOK_PAGE_CLOSE(
+ $self, $self,
+ sub {
+ shift->on_close(@_);
+ }
+ );
return;
}
@@ -112,49 +120,45 @@ sub hide {
return;
}
-sub relocale {
+# Allows for content-adaptive labels
+sub refresh {
my $self = shift;
foreach my $i ( 0 .. $self->GetPageCount - 1 ) {
$self->SetPageText( $i, $self->GetPage($i)->gettext_label );
}
-
return;
}
-sub _on_close {
- my ( $self, $event ) = @_;
-
- my $pos = $event->GetSelection;
- my $type = ref $self->GetPage($pos);
- $self->RemovePage($pos);
-
- # De-activate in the menu
- my %menu_name = (
- 'Padre::Wx::Outline' => 'outline',
- 'Padre::Wx::TodoList' => 'todo',
- 'Padre::Wx::FunctionList' => 'functions',
- );
- my %config_name = (
- 'Padre::Wx::Outline' => 'main_outline',
- 'Padre::Wx::TodoList' => 'main_todo',
- 'Padre::Wx::FunctionList' => 'main_functions',
- );
- if ( exists $menu_name{$type} ) {
- $self->main->menu->view->{ $menu_name{$type} }->Check(0);
- $self->main->config->set( $config_name{$type}, 0 );
- } else {
- warn "Unknown page type: '$type'\n";
- }
-
- # Is this the last page?
- if ( $self->GetPageCount == 0 ) {
- $self->Hide;
- $self->aui->GetPane($self)->Hide;
+sub relocale {
+ my $self = shift;
+ foreach my $i ( 0 .. $self->GetPageCount - 1 ) {
+ $self->SetPageText( $i, $self->GetPage($i)->gettext_label );
}
return;
}
+# It is unscalable for the view notebooks to have to know what they might contain
+# and then re-implement the show/hide logic (probably wrong).
+# Instead, tunnel the close action to the tool and let the tool decide how to go
+# about closing itself (which will usually be by delegating up to the main window).
+sub on_close {
+ my $self = shift;
+ my $event = shift;
+
+ # Tunnel the request through to the tool if possible.
+ my $position = $event->GetSelection;
+ my $tool = $self->GetPage($position);
+ unless ( $tool->can('view_close') ) {
+
+ # HACK: Crash in a controller manner for the moment.
+ # Later just let this crash uncontrolably :)
+ my $class = ref $tool;
+ die "Panel tool $class does define 'view_close' method";
+ }
+ $tool->view_close;
+}
+
1;
# Copyright 2008-2010 The Padre development team as listed in Padre.pm.
@@ -0,0 +1,74 @@
+package Padre::Wx::Role::Conduit;
+
+=pod
+
+=head1 NAME
+
+Padre::Wx::Role::Conduit - Role to allows an object to receive Wx events
+
+=head1 DESCRIPTION
+
+This is a role that provides the functionality needed to receive Wx thread
+events.
+
+However, you should only use this role once, in the parent process.
+
+It is implemented as a role so that the functionality can be used across the
+main process and various testing classes (and will be easier to turn into a
+CPAN spinoff later).
+
+=cut
+
+use 5.008;
+use strict;
+use warnings;
+use Padre::Wx ();
+use Padre::Logger;
+
+our $VERSION = '0.66';
+
+our $SIGNAL : shared;
+
+BEGIN {
+ $SIGNAL = Wx::NewEventType();
+}
+
+my $CONDUIT = undef;
+my $HANDLER = undef;
+
+sub handler {
+ $HANDLER = $_[1];
+}
+
+sub conduit_init {
+ TRACE( $_[0] ) if DEBUG;
+ $CONDUIT = $_[0];
+ $HANDLER = $_[1];
+ Wx::Event::EVT_COMMAND( $CONDUIT, -1, $SIGNAL, \&on_signal );
+ return 1;
+}
+
+sub signal {
+ TRACE( $_[0] ) if DEBUG;
+ $CONDUIT->AddPendingEvent( Wx::PlThreadEvent->new( -1, $SIGNAL, $_[1] ) ) if $CONDUIT;
+ TRACE('->AddPendingEvent ok') if DEBUG;
+}
+
+sub on_signal {
+ TRACE( $_[0] ) if DEBUG;
+ TRACE( $_[1] ) if DEBUG;
+ my $self = shift;
+ my $event = shift;
+
+ # Pass the event through to the event handler
+ $HANDLER->on_signal($event) if $HANDLER;
+
+ return 1;
+}
+
+1;
+
+# Copyright 2008-2010 The Padre development team as listed in Padre.pm.
+# LICENSE
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl 5 itself.
@@ -0,0 +1,124 @@
+package Padre::Wx::Role::Main;
+
+=pod
+
+=head1 NAME
+
+Padre::Wx::Role::Main - Convenience methods for children of the main window
+
+=head1 DESCRIPTION
+
+This role implements the fairly common method pattern for Wx elements that
+are children of L<Padre::Wx::Main>.
+
+It provides accessors for easy access to the most commonly needed elements,
+and shortcut integration with the L<Padre::Current> context system.
+
+=head1 METHODS
+
+=cut
+
+use 5.008;
+use strict;
+use warnings;
+use Params::Util ();
+use Padre::Current ();
+
+our $VERSION = '0.66';
+
+=pod
+
+=head2 C<ide>
+
+ my $ide = $object->ide;
+
+Get the L<Padre> IDE instance that this object is a child of.
+
+=cut
+
+sub ide {
+ shift->main->ide;
+}
+
+=pod
+
+=head2 C<config>
+
+ my $config = $object->config;
+
+Get the L<Padre::Config> for the current user. Provided mainly as a
+convenience because it is needed so often.
+
+=cut
+
+sub config {
+ shift->main->config;
+}
+
+=pod
+
+=head2 C<main>
+
+ my $main = $object->main;
+
+Get the L<Padre::Wx::Main> main window that this object is a child of.
+
+=cut
+
+sub main {
+ my $main = shift->GetParent;
+ while ( not Params::Util::_INSTANCE( $main, 'Padre::Wx::Main' ) ) {
+ $main = $main->GetParent or return Padre::Current->main;
+ }
+ return $main;
+}
+
+=pod
+
+=head2 C<aui>
+
+ my $aui = $object->aui;
+
+Convenient access to the Wx Advanced User Interface (AUI) Manager object.
+
+=cut
+
+sub aui {
+ shift->main->aui;
+}
+
+=pod
+
+=head2 current
+
+ my $current = $object->current;
+
+Get a new C<Padre::Current> context object, for access to other parts of
+the current context.
+
+=cut
+
+sub current {
+ Padre::Current->new( main => shift->main );
+}
+
+1;
+
+=pod
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2008-2010 The Padre development team as listed in Padre.pm.
+
+This program is free software; you can redistribute
+it and/or modify it under the same terms as Perl itself.
+
+The full text of the license can be found in the
+LICENSE file included with this module.
+
+=cut
+
+# Copyright 2008-2010 The Padre development team as listed in Padre.pm.
+# LICENSE
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl 5 itself.
@@ -1,122 +0,0 @@
-package Padre::Wx::Role::MainChild;
-
-=pod
-
-=head1 NAME
-
-Padre::Wx::Role::MainChild - Convenience methods for children of the main window
-
-=head1 DESCRIPTION
-
-This pseudo-role implements the fairly common method pattern for Wx elements that
-are children of L<Padre::Wx::Main>.
-
-=head1 METHODS
-
-=cut
-
-use 5.008;
-use strict;
-use warnings;
-use Params::Util ('_INSTANCE');
-use Padre::Current ();
-
-our $VERSION = '0.63';
-
-# The four most common things we need are implemented directly
-
-=pod
-
-=head2 C<ide>
-
- my $ide = $object->ide;
-
-Get the L<Padre> IDE instance that this object is a child of.
-
-=cut
-
-sub ide {
- shift->main->ide;
-}
-
-=pod
-
-=head2 C<config>
-
- my $config = $object->config;
-
-Get the L<Padre::Config> for the current user. Provided mainly as a
-convenience because it is needed so often.
-
-=cut
-
-sub config {
- shift->main->config;
-}
-
-=pod
-
-=head2 C<main>
-
- my $main = $object->main;
-
-Get the L<Padre::Wx::Main> main window that this object is a child of.
-
-=cut
-
-sub main {
- my $main = shift->GetParent;
- while ( not _INSTANCE( $main, 'Padre::Wx::Main' ) ) {
- $main = $main->GetParent or return Padre::Current->main;
- }
- return $main;
-}
-
-=pod
-
-=head2 C<aui>
-
- my $aui = $object->aui;
-
-Convenient access to the C<AUI> Manager.
-
-=cut
-
-sub aui {
- $_[0]->main->aui;
-}
-
-=pod
-
-=head2 current
-
- my $current = $object->current;
-
-Get a new C<Padre::Current> context object.
-
-=cut
-
-sub current {
- Padre::Current->new( main => shift->main );
-}
-
-1;
-
-=pod
-
-=head1 COPYRIGHT & LICENSE
-
-Copyright 2008-2010 The Padre development team as listed in Padre.pm.
-
-This program is free software; you can redistribute
-it and/or modify it under the same terms as Perl itself.
-
-The full text of the license can be found in the
-LICENSE file included with this module.
-
-=cut
-
-# Copyright 2008-2010 The Padre development team as listed in Padre.pm.
-# LICENSE
-# This program is free software; you can redistribute it and/or
-# modify it under the same terms as Perl 5 itself.
@@ -1,27 +1,72 @@
package Padre::Wx::Role::View;
+use 5.008005;
+use strict;
+use warnings;
+
+our $VERSION = '0.66';
+
+1;
+
+__END__
+
=pod
=head1 NAME
Padre::Wx::Role::View - A role for GUI tools that live in panels
+=head1 SYNOPSIS
+
+ # From the Padre::Wx::Role::View section of Padre::Wx::FunctionList
+
+ sub view_panel {
+ return 'right';
+ }
+
+ sub view_label {
+ Wx::gettext('Functions');
+ }
+
+ sub view_close {
+ shift->{main}->show_functions(0);
+ }
+
=head1 DESCRIPTION
-This is a role that should be inherited from by GUI elements that
-live in the left, right or bottom panels of Padre.
+This is a role that should be inherited from by GUI components that
+live in the left, right or bottom notebook panels of Padre.
-=cut
+Anything that inherits from this role is expected to implement a number
+of methods that allow it to play nicely with the Padre object model.
-use 5.008005;
-use strict;
-use warnings;
+=head1 METHODS
-our $VERSION = '0.63';
+To help compartmentalise methods that are provided by different roles,
+a "view_" prefix is used across methods expected by the role.
-1;
+=head2 view_panel
-=pod
+This method describes which panel the tool lives in.
+
+Returns the string 'right', 'left', or 'bottom'.
+
+=head2 view_label
+
+The method returns the string that the notebook label should be filled
+with. This should be internationalised properly. This method is called
+once when the object is constructed, and again if the user triggers a
+C<relocale> cascade to change their interface language.
+
+=head2 view_close
+
+This method is called on the object by the event handler for the "X"
+control on the notebook label, if it has one.
+
+The method should generally initiate whatever is needed to close the
+tool via the highest level API. Note that while we aren't calling the
+equivalent menu handler directly, we are calling the high method method
+on the main window that the menu itself calls.
=head1 COPYRIGHT & LICENSE
@@ -37,13 +37,13 @@ the available methods that can be applied to it besides the added ones
use 5.008;
use strict;
use warnings;
-use Padre::Constant ();
-use Padre::Current ();
-use Padre::Util ();
-use Padre::Wx ();
-use Padre::Wx::Icon ();
-use Padre::Wx::Role::MainChild ();
-use Padre::MimeTypes ();
+use Padre::Constant ();
+use Padre::Current ();
+use Padre::Util ();
+use Padre::Wx ();
+use Padre::Wx::Icon ();
+use Padre::Wx::Role::Main ();
+use Padre::MimeTypes ();
use Class::XSAccessor {
accessors => {
@@ -53,9 +53,9 @@ use Class::XSAccessor {
}
};
-our $VERSION = '0.63';
+our $VERSION = '0.66';
our @ISA = qw{
- Padre::Wx::Role::MainChild
+ Padre::Wx::Role::Main
Wx::StatusBar
};
@@ -101,13 +101,13 @@ sub new {
my $sbmp = Wx::StaticBitmap->new( $self, -1, Wx::wxNullBitmap );
$self->_task_sbmp($sbmp);
$self->_task_status('foobar'); # init status to sthg defined
- Wx::Event::EVT_LEFT_DOWN(
- $sbmp,
- sub {
- require Padre::TaskManager;
- Padre::TaskManager::on_dump_running_tasks(@_);
- },
- );
+ # Wx::Event::EVT_LEFT_DOWN(
+ # $sbmp,
+ # sub {
+ # require Padre::TaskManager;
+ # Padre::TaskManager::on_dump_running_tasks(@_);
+ # },
+ # );
# Set up the fields
$self->SetFieldsCount(7);
@@ -357,7 +357,7 @@ sub on_resize {
#
sub _get_task_status {
my $self = shift;
- my $manager = $self->current->ide->task_manager;
+ my $manager = undef; # $self->current->ide->task_manager;
# still in editor start-up phase, default to idle
return 'idle' unless defined $manager;
@@ -3,43 +3,65 @@ package Padre::Wx::Syntax;
use 5.008;
use strict;
use warnings;
-use Params::Util ();
-use Padre::Wx ();
-use Padre::Wx::Icon ();
+use Params::Util ();
+use Padre::Role::Task ();
+use Padre::Wx::Role::View ();
+use Padre::Wx::Role::Main ();
+use Padre::Wx ();
+use Padre::Wx::Icon ();
use Padre::Logger;
-our $VERSION = '0.63';
-our @ISA = 'Wx::ListView';
+our $VERSION = '0.66';
+our @ISA = qw{
+ Padre::Role::Task
+ Padre::Wx::Role::View
+ Padre::Wx::Role::Main
+ Wx::ListView
+};
sub new {
my $class = shift;
my $main = shift;
+ my $panel = shift || $main->bottom;
# Create the underlying object
my $self = $class->SUPER::new(
- $main->bottom,
+ $panel,
-1,
Wx::wxDefaultPosition,
Wx::wxDefaultSize,
Wx::wxLC_REPORT | Wx::wxLC_SINGLE_SEL
);
+ # Additional properties
+ $self->{model} = [];
+ $self->{document} = '';
+ $self->{length} = -1;
+
+ # Prepare the available images
my $list = Wx::ImageList->new( 16, 16 );
$list->Add( Padre::Wx::Icon::icon('status/padre-syntax-error') );
$list->Add( Padre::Wx::Icon::icon('status/padre-syntax-warning') );
$list->Add( Padre::Wx::Icon::icon('status/padre-syntax-ok') );
$self->AssignImageList( $list, Wx::wxIMAGE_LIST_SMALL );
- $self->InsertColumn( $_, _get_title($_) ) for 0 .. 2;
+ # Flesh out the columns
+ my @titles = $self->titles;
+ foreach ( 0 .. 2 ) {
+ $self->InsertColumn( $_, $titles[$_] );
+ }
Wx::Event::EVT_LIST_ITEM_ACTIVATED(
$self, $self,
sub {
- $self->on_list_item_activated( $_[1] );
+ shift->on_list_item_activated(@_);
},
);
Wx::Event::EVT_RIGHT_DOWN(
- $self, \&on_right_down,
+ $self,
+ sub {
+ shift->on_right_down(@_);
+ },
);
$self->Hide;
@@ -47,70 +69,36 @@ sub new {
return $self;
}
-sub bottom {
- $_[0]->GetParent;
-}
-
-sub main {
- $_[0]->GetGrandParent;
-}
-sub current {
- Padre::Current->new( main => $_[0]->main );
-}
-sub gettext_label {
- Wx::gettext('Syntax Check');
-}
-# Remove all markers and empty the list
-sub clear {
- my $self = shift;
- # Remove the margins for the syntax markers
- foreach my $editor ( $self->main->editors ) {
- $editor->MarkerDeleteAll(Padre::Wx::MarkError);
- $editor->MarkerDeleteAll(Padre::Wx::MarkWarn);
- }
+######################################################################
+# Padre::Wx::Role::View Methods
- # Remove all items from the tool
- $self->DeleteAllItems;
+sub view_panel {
+ return 'bottom';
+}
- return;
+sub view_label {
+ shift->gettext_label(@_);
}
-sub set_column_widths {
- my $self = shift;
- my $ref_entry = shift;
- if ( !defined $ref_entry ) {
- $ref_entry = { line => ' ', };
- }
+sub view_close {
+ shift->main->show_syntax(0);
+}
- my $width0_default = $self->GetCharWidth * length( Wx::gettext("Line") ) + 16;
- my $width0 = $self->GetCharWidth * length( $ref_entry->{line} x 2 ) + 14;
- my $refStr = '';
- if ( length( Wx::gettext('Warning') ) > length( Wx::gettext('Error') ) ) {
- $refStr = Wx::gettext('Warning');
- } else {
- $refStr = Wx::gettext('Error');
- }
- my $width1 = $self->GetCharWidth * ( length($refStr) + 2 );
- my $width2 = $self->GetSize->GetWidth - $width0 - $width1 - $self->GetCharWidth * 4;
- $self->SetColumnWidth( 0, ( $width0_default > $width0 ? $width0_default : $width0 ) );
- $self->SetColumnWidth( 1, $width1 );
- $self->SetColumnWidth( 2, $width2 );
-
- return;
-}
#####################################################################
# Timer Control
sub start {
my $self = shift;
+ $self->running and return;
+ TRACE('Starting the syntax checker') if DEBUG;
# Add the margins for the syntax markers
foreach my $editor ( $self->main->editors ) {
@@ -122,8 +110,6 @@ sub start {
$editor->SetMarginWidth( 1, 16 );
}
- TRACE('still starting the syntax checker') if DEBUG;
-
# List appearance: Initialize column widths
$self->set_column_widths;
@@ -150,20 +136,22 @@ sub start {
sub stop {
my $self = shift;
+ $self->running or return;
+ TRACE('Stopping the syntax checker') if DEBUG;
# Stop the timer
if ( Params::Util::_INSTANCE( $self->{timer}, 'Wx::Timer' ) ) {
$self->{timer}->Stop;
}
- # Clear out the existing data
- $self->clear;
-
# Remove the editor margin
foreach my $editor ( $self->main->editors ) {
$editor->SetMarginWidth( 1, 0 );
}
+ # Clear out the existing data
+ $self->clear;
+
return;
}
@@ -171,6 +159,10 @@ sub running {
!!( $_[0]->{timer} and $_[0]->{timer}->IsRunning );
}
+
+
+
+
#####################################################################
# Event Handlers
@@ -192,127 +184,10 @@ sub on_list_item_activated {
return;
}
-# Selects the problemistic line :)
-sub select_problem {
- my $self = shift;
- my $line = shift;
- my $editor = $self->current->editor or return;
- $editor->EnsureVisible($line);
- $editor->goto_pos_centerize( $editor->GetLineIndentPosition($line) );
- $editor->SetFocus;
-}
-
-# Selects the next problem in the editor.
-# Wraps to the first one when at the end.
-sub select_next_problem {
- my $self = shift;
- my $editor = $self->current->editor or return;
- my $line = $editor->LineFromPosition( $editor->GetCurrentPos );
-
- my $first_line = undef;
- foreach my $i ( 0 .. $self->GetItemCount - 1 ) {
-
- # Get the line and check that it is a valid line number
- my $line = $self->GetItem($i)->GetText;
- next
- if ( not defined($line) )
- or ( $line !~ /^\d+$/o )
- or ( $line > $editor->GetLineCount );
- $line--;
-
- if ( not $first_line ) {
-
- # record the position of the first problem
- $first_line = $line;
- }
-
- if ( $line > $line ) {
-
- # select the next problem
- $self->select_problem($line);
-
- # no need to wrap around...
- $first_line = undef;
-
- # and we're done here...
- last;
- }
- }
-
- # The next problem is simply the first (wrap around)
- $self->select_problem($first_line) if $first_line;
-}
-
-sub on_timer {
- my $self = shift;
- my $event = shift;
- my $force = shift;
- my $editor = $self->current->editor or return;
- my $document = $editor->{Document};
-
- # Don't check without document of if the document has no checker
- unless ( $document and $document->can('check_syntax') ) {
- $self->clear;
- return;
- }
-
- # Don't really check while typing but check if typing pauses,
- # because the user usually won't stop typing to correct a
- # syntax error but finish the current line and then fix the typo
- if ( defined( $document->{last_char_time} ) ) {
- if ( $self->main->ide->{has_Time_HiRes} ) {
-
- # Not typing for 500ms usually means that you got
- # time to look at the syntax check results
- return if ( Time::HiRes::time() - $document->{last_char_time} ) < .5;
- } else {
-
- # Without HiRes, we could only set the timeout to
- # one second, but this is very inaccurate
- return if $document->{last_char_time} == time;
- }
- }
-
- my $pre_exec_result = $document->check_syntax_in_background( force => $force );
-
- # In case we have created a new and still completely empty doc we
- # need to clean up the message list
- if ( ref $pre_exec_result eq 'ARRAY' and not @{$pre_exec_result} ) {
- $self->clear;
- }
-
- if ( defined $event ) {
- $event->Skip(0);
- }
-
- return;
-}
-
-sub _get_title {
- my $c = shift;
-
- return Wx::gettext('Line') if $c == 0;
- return Wx::gettext('Type') if $c == 1;
- return Wx::gettext('Description') if $c == 2;
-
- die "invalid value '$c'";
-}
-
-sub relocale {
- my $self = shift;
-
- foreach my $i ( 0 .. 2 ) {
- my $col = $self->GetColumn($i);
- $col->SetText( _get_title($i) );
- $self->SetColumn( $i, $col );
- }
-
- return;
-}
-
# Called when the user presses a right click or a context menu key (on win32)
sub on_right_down {
- my ( $self, $event ) = @_;
+ my $self = shift;
+ my $event = shift;
return if $self->GetItemCount == 0;
@@ -377,6 +252,238 @@ sub on_right_down {
}
}
+sub on_timer {
+ my $self = shift;
+ my $event = shift;
+ $event->Skip(0) if defined $event;
+ $self->refresh;
+}
+
+
+
+
+
+#####################################################################
+# General Methods
+
+sub bottom {
+ TRACE("DEPRECATED") if DEBUG;
+ shift->main->bottom;
+}
+
+sub gettext_label {
+ Wx::gettext('Syntax Check');
+}
+
+sub titles {
+ return (
+ Wx::gettext('Line'),
+ Wx::gettext('Type'),
+ Wx::gettext('Description'),
+ );
+}
+
+# Remove all markers and empty the list
+sub clear {
+ my $self = shift;
+ my $lock = $self->main->lock('UPDATE');
+
+ # Remove the margins for the syntax markers
+ foreach my $editor ( $self->main->editors ) {
+ $editor->MarkerDeleteAll(Padre::Wx::MarkError);
+ $editor->MarkerDeleteAll(Padre::Wx::MarkWarn);
+ }
+
+ # Remove all items from the tool
+ $self->DeleteAllItems;
+
+ return;
+}
+
+sub relocale {
+ my $self = shift;
+ my @titles = $self->titles;
+ foreach my $i ( 0 .. 2 ) {
+ my $col = $self->GetColumn($i);
+ $col->SetText( $titles[$i] );
+ $self->SetColumn( $i, $col );
+ }
+ return;
+}
+
+sub refresh {
+ my $self = shift;
+ my $document = $self->current->document or return;
+
+ # allows us to check when an empty or unsaved document is open
+ my $filename = defined( $document->filename ) ? $document->filename : '';
+
+ my $length = $document->text_length;
+
+ if ( $filename eq $self->{document} ) {
+
+ # Shortcut if nothing has changed.
+ # NOTE: Given the speed at which the timer fires a cheap
+ # length check is better than an expensive MD5 check.
+ if ( $length eq $self->{length} ) {
+ return;
+ }
+ } else {
+
+ # New file, don't keep the current list visible
+ $self->clear;
+ }
+ $self->{document} = $filename;
+ $self->{length} = $length;
+
+ # Fire the background task discarding old results
+ $self->task_reset;
+ $self->task_request(
+ task => $document->task_syntax,
+ document => $document,
+ );
+}
+
+sub task_response {
+ my $self = shift;
+ my $task = shift;
+ $self->{model} = $task->{model};
+ $self->render;
+}
+
+sub render {
+ my $self = shift;
+ my $model = $self->{model} || [];
+ my $current = $self->current;
+ my $editor = $current->editor;
+ my $document = $current->document;
+ my $filename = $current->filename;
+ my $lock = $self->main->lock('UPDATE');
+
+ # Flush old results
+ $self->clear;
+
+ # If there are no errors clear the synax checker pane
+ unless ( Params::Util::_ARRAY($model) ) {
+ my $i = $self->InsertStringImageItem( 0, '', 2 );
+ $self->SetItemData( $i, 0 );
+ $self->SetItem( $i, 1, Wx::gettext('Info') );
+
+ # Relative-to-the-project filename.
+ # Check that the document has been saved.
+ if ( defined $filename ) {
+ my $project_dir = $document->project_dir;
+ if ( defined $project_dir ) {
+ $project_dir = quotemeta $project_dir;
+ $filename =~ s/^$project_dir[\\\/]?//;
+ }
+ $self->SetItem( $i, 2, sprintf( Wx::gettext('No errors or warnings found in %s.'), $filename ) );
+ } else {
+ $self->SetItem( $i, 2, Wx::gettext('No errors or warnings found.') );
+ }
+ return;
+ }
+
+ # Eliminate some warnings
+ foreach my $hint (@$model) {
+ $hint->{line} = 0 unless defined $hint->{line};
+ $hint->{msg} = '' unless defined $hint->{msg};
+ }
+
+ my @MARKER = ( Padre::Wx::MarkError(), Padre::Wx::MarkWarn() );
+ my @LABEL = ( Wx::gettext('Warning'), Wx::gettext('Error') );
+
+ my $i = 0;
+ foreach my $hint ( sort { $a->{line} <=> $b->{line} } @$model ) {
+ my $line = $hint->{line} - 1;
+ my $severity = $hint->{severity};
+ $editor->MarkerAdd( $line, $MARKER[$severity] );
+ my $item = $self->InsertStringImageItem( $i++, $line + 1, $severity );
+ $self->SetItemData( $item, 0 );
+ $self->SetItem( $item, 1, $LABEL[$severity] );
+ $self->SetItem( $item, 2, $hint->{msg} );
+ }
+
+ $self->set_column_widths( $model->[-1] );
+
+ return 1;
+}
+
+sub set_column_widths {
+ my $self = shift;
+ my $item = shift || { line => ' ' };
+
+ my $width0_default = $self->GetCharWidth * length( Wx::gettext("Line") ) + 16;
+ my $width0 = $self->GetCharWidth * length( $item->{line} x 2 ) + 14;
+
+ my $ref_str = '';
+ if ( length( Wx::gettext('Warning') ) > length( Wx::gettext('Error') ) ) {
+ $ref_str = Wx::gettext('Warning');
+ } else {
+ $ref_str = Wx::gettext('Error');
+ }
+
+ my $width1 = $self->GetCharWidth * ( length($ref_str) + 2 );
+ my $width2 = $self->GetSize->GetWidth - $width0 - $width1 - $self->GetCharWidth * 4;
+
+ $self->SetColumnWidth( 0, ( $width0_default > $width0 ? $width0_default : $width0 ) );
+ $self->SetColumnWidth( 1, $width1 );
+ $self->SetColumnWidth( 2, $width2 );
+
+ return;
+}
+
+# Selects the problemistic line :)
+sub select_problem {
+ my $self = shift;
+ my $line = shift;
+ my $editor = $self->current->editor or return;
+ $editor->EnsureVisible($line);
+ $editor->goto_pos_centerize( $editor->GetLineIndentPosition($line) );
+ $editor->SetFocus;
+}
+
+# Selects the next problem in the editor.
+# Wraps to the first one when at the end.
+sub select_next_problem {
+ my $self = shift;
+ my $editor = $self->current->editor or return;
+ my $line = $editor->LineFromPosition( $editor->GetCurrentPos );
+
+ my $first_line = undef;
+ foreach my $i ( 0 .. $self->GetItemCount - 1 ) {
+
+ # Get the line and check that it is a valid line number
+ my $line = $self->GetItem($i)->GetText;
+ next
+ if ( not defined($line) )
+ or ( $line !~ /^\d+$/o )
+ or ( $line > $editor->GetLineCount );
+ $line--;
+
+ if ( not $first_line ) {
+
+ # record the position of the first problem
+ $first_line = $line;
+ }
+
+ if ( $line > $line ) {
+
+ # select the next problem
+ $self->select_problem($line);
+
+ # no need to wrap around...
+ $first_line = undef;
+
+ # and we're done here...
+ last;
+ }
+ }
+
+ # The next problem is simply the first (wrap around)
+ $self->select_problem($first_line) if $first_line;
+}
+
1;
# Copyright 2008-2010 The Padre development team as listed in Padre.pm.
@@ -1,14 +1,26 @@
package Padre::Wx::TodoList;
-use 5.008;
+use 5.008005;
use strict;
use warnings;
-use Params::Util qw{ _STRING };
-use Padre::Wx ();
-use Padre::Current ('_CURRENT');
+use Scalar::Util ();
+use Params::Util ();
+use Padre::Role::Task ();
+use Padre::Wx::Role::View ();
+use Padre::Wx::Role::Main ();
+use Padre::Wx ();
+
+our $VERSION = '0.66';
+our @ISA = qw{
+ Padre::Role::Task
+ Padre::Wx::Role::View
+ Padre::Wx::Role::Main
+ Wx::Panel
+};
+
+
+
-our $VERSION = '0.63';
-our @ISA = 'Wx::Panel';
#####################################################################
# Constructor
@@ -16,31 +28,34 @@ our @ISA = 'Wx::Panel';
sub new {
my $class = shift;
my $main = shift;
+ my $panel = shift || $main->right;
# Create the parent panel, which will contain the search and tree
my $self = $class->SUPER::new(
- $main->right,
+ $panel,
-1,
Wx::wxDefaultPosition,
Wx::wxDefaultSize,
);
- # Store main for other methods
- $self->{main} = $main;
-
# Temporary store for the todo list.
- $self->{_items} = [];
+ $self->{model} = [];
+
+ # Remember the last document we were looking at
+ $self->{document} = '';
# Create the search control
$self->{search} = Wx::TextCtrl->new(
- $self, -1, '',
+ $self,
+ -1,
+ '',
Wx::wxDefaultPosition,
Wx::wxDefaultSize,
Wx::wxTE_PROCESS_ENTER | Wx::wxSIMPLE_BORDER,
);
# Create the Todo list
- $self->{items} = Wx::ListBox->new(
+ $self->{list} = Wx::ListBox->new(
$self,
-1,
Wx::wxDefaultPosition,
@@ -52,7 +67,7 @@ sub new {
# Create a sizer
my $sizer = Wx::BoxSizer->new(Wx::wxVERTICAL);
$sizer->Add( $self->{search}, 0, Wx::wxALL | Wx::wxEXPAND );
- $sizer->Add( $self->{items}, 1, Wx::wxALL | Wx::wxEXPAND );
+ $sizer->Add( $self->{list}, 1, Wx::wxALL | Wx::wxEXPAND );
# Fits panel layout
$self->SetSizerAndFit($sizer);
@@ -60,7 +75,7 @@ sub new {
# Grab the kill focus to prevent deselection
Wx::Event::EVT_KILL_FOCUS(
- $self->{items},
+ $self->{list},
sub {
return;
},
@@ -69,21 +84,22 @@ sub new {
# Double-click a function name
Wx::Event::EVT_LISTBOX_DCLICK(
$self,
- $self->{items},
+ $self->{list},
sub {
- $self->on_list_item_activated( $_[0], $_[1] );
+ $_[0]->on_list_item_activated( $_[1] );
}
);
# Handle key events
Wx::Event::EVT_KEY_UP(
- $self->{items},
+ $self->{list},
sub {
- my ( $this, $event ) = @_;
- if ( $event->GetKeyCode == Wx::WXK_RETURN ) {
- $self->on_list_item_activated($event);
+ if ( $_[1]->GetKeyCode == Wx::WXK_RETURN ) {
+
+ # EVT_KEY_UP always binds to a single thing
+ $_[0]->GetParent->on_list_item_activated( $_[1] );
}
- $event->Skip(1);
+ $_[1]->Skip(1);
}
);
@@ -91,29 +107,27 @@ sub new {
Wx::Event::EVT_CHAR(
$self->{search},
sub {
- my ( $this, $event ) = @_;
+ my $this = shift;
+ my $event = shift;
+ my $code = $event->GetKeyCode;
- my $code = $event->GetKeyCode;
if ( $code == Wx::WXK_DOWN || $code == Wx::WXK_UP || $code == Wx::WXK_RETURN ) {
# Up/Down and return keys focus on the functions lists
- $self->{items}->SetFocus;
- my $selection = $self->{items}->GetSelection;
- if ( $selection == -1 && $self->{items}->GetCount > 0 ) {
+ $self->{list}->SetFocus;
+ my $selection = $self->{list}->GetSelection;
+ if ( $selection == -1 && $self->{list}->GetCount > 0 ) {
$selection = 0;
}
- $self->{items}->Select($selection);
+ $self->{list}->Select($selection);
} elsif ( $code == Wx::WXK_ESCAPE ) {
- # Escape key clears search and returns focus
- # to the editor
+ # Escape key clears search and returns the
+ # focus to the editor.
$self->{search}->SetValue('');
- my $current = _CURRENT( $self->{main}->current );
- my $document = $current->document;
- if ($document) {
- $document->editor->SetFocus;
- }
+ my $editor = $this->current->editor;
+ $editor->SetFocus if $editor;
}
$event->Skip(1);
@@ -125,7 +139,7 @@ sub new {
$self,
$self->{search},
sub {
- $self->_update_list;
+ $self->render;
}
);
@@ -134,8 +148,23 @@ sub new {
return $self;
}
-sub gettext_label {
- Wx::gettext('To-do');
+
+
+
+
+######################################################################
+# Padre::Wx::Role::View Methods
+
+sub view_panel {
+ return 'right';
+}
+
+sub view_label {
+ shift->gettext_label(@_);
+}
+
+sub view_close {
+ shift->main->show_todo(0);
}
@@ -146,72 +175,68 @@ sub gettext_label {
# Event Handlers
sub on_list_item_activated {
- my ( $self, $event ) = @_;
+ my $self = shift;
+ my $event = shift;
+ my $editor = $self->current->editor or return;
+ my $nth = $self->{list}->GetSelection;
+ my $todo = $self->{model}->[$nth] or return;
- # Which sub did they click
- my $item = $self->{items}->GetSelection;
+ # Move the selection to where we last saw it
+ $editor->goto_pos_centerize( $todo->{pos} );
- my $current = _CURRENT( $self->{main}->current );
- my $document = $current->document or return;
- my $editor = $document->editor;
+ return;
+}
- my $start = $self->{_items}->[$item];
- unless ( defined $start ) {
- # Couldn't find it
- return;
- }
- # Move the selection to the location
- $editor->goto_pos_centerize( $start->{pos} );
- return;
+######################################################################
+# General Methods
+
+sub gettext_label {
+ Wx::gettext('To-do');
}
-#
# Sets the focus on the search field
-#
sub focus_on_search {
- my $self = shift;
- $self->{search}->SetFocus;
+ $_[0]->{search}->SetFocus;
}
-#
-# Refresh the functions list
-#
sub refresh {
- my ( $self, $current ) = @_;
-
- # Flush the list if there is no active document
- return unless $current;
+ my $self = shift;
+ my $current = shift or return;
my $document = $current->document;
- my $items = $self->{items};
-
- # Hide the widgets when no files are open
- if ($document) {
- $self->{search}->Show(1);
- $self->{items}->Show(1);
- } else {
- $items->Clear;
- $self->{search}->Hide;
- $self->{items}->Hide;
- $self->{_items} = [];
+ my $search = $self->{search};
+ my $list = $self->{list};
+
+ # Flush and hide the list if there is no active document
+ unless ($document) {
+ my $lock = $self->main->lock('UPDATE');
+ $search->Hide;
+ $list->Hide;
+ $list->Clear;
+ $self->{model} = [];
+ $self->{document} = '';
return;
}
+ # Ensure the widget is visible
+ $search->Show(1);
+ $list->Show(1);
+
# Clear search when it is a different document
- if ( $self->{_document} && $document != $self->{_document} ) {
- $self->{search}->ChangeValue('');
+ my $id = Scalar::Util::refaddr($document);
+ if ( $id ne $self->{document} ) {
+ $search->ChangeValue('');
+ $self->{document} = $id;
}
- $self->{_document} = $document;
-
- my $config = $self->{main}->config;
- my $regexp = $config->todo_regexp;
- #my @items = $document->get_todo; # XXX retrieving the list of items should become a method of ->document
- my $text = $document->text_get();
- my @items;
+ # Unlike the Function List widget we copied to make this,
+ # don't bother with a background task, since this is much quicker.
+ my $regexp = $current->config->todo_regexp;
+ my $text = $document->text_get;
+ my @items = ();
while ( $text =~ /$regexp/gim ) {
push @items, { text => $1 || '<no text>', 'pos' => pos($text) };
}
@@ -219,65 +244,47 @@ sub refresh {
push @items, { text => $1, 'pos' => pos($text) };
}
- if ( scalar @items == 0 ) {
- $items->Clear;
- $self->{_items} = [];
+ if ( @items == 0 ) {
+ $list->Clear;
+ $self->{model} = [];
return;
}
- #if ( $config->main_functions_order eq 'original' ) {
-
- # That should be the one we got from get_functions
- #} elsif ( $config->main_functions_order eq 'alphabetical_private_last' ) {
- #
- # # ~ comes after \w
- # tr/_/~/ foreach @methods;
- # @methods = sort @methods;
- # tr/~/_/ foreach @methods;
- #} else {
-
- # Alphabetical (aka 'abc')
- #@items = sort { $a->{text} cmp $b->{text} } @items;
- #}
-
- if ( scalar(@items) == scalar( @{ $self->{_items} } ) ) {
- my $new = join "\0", @items;
- my $old = join "\0", @{ $self->{_items} };
- return if $old eq $new;
- }
-
- $self->{_items} = \@items;
-
- # Show them again
- $self->{search}->Show;
- $self->{items}->Show;
-
- $self->_update_list;
+ # Update the model and rerender
+ $self->{model} = \@items;
+ $self->render;
}
-#
# Populate the list with search results
-#
-sub _update_list {
- my $self = shift;
-
- my $items = $self->{items};
-
- #quote the search string to make it safer
- my $search_expr = $self->{search}->GetValue();
- if ( $search_expr eq '' ) {
- $search_expr = '.*';
+sub render {
+ my $self = shift;
+ my $model = $self->{model};
+ my $search = $self->{search};
+ my $list = $self->{list};
+
+ # Quote the search string to make it safer
+ my $string = $search->GetValue;
+ if ( $string eq '' ) {
+ $string = '.*';
} else {
- $search_expr = quotemeta $search_expr;
+ $string = quotemeta $string;
}
- #populate the function list with matching items
- $items->Clear;
- foreach my $item ( reverse @{ $self->{_items} } ) {
- if ( $item->{text} =~ /$search_expr/i ) {
- $items->Insert( $item->{text}, 0 );
+ # Show the components and populate the function list
+ SCOPE: {
+ my $lock = $self->main->lock('UPDATE');
+ $search->Show(1);
+ $list->Show(1);
+ $list->Clear;
+ foreach my $todo ( reverse @$model ) {
+ my $text = $todo->{text};
+ if ( $text =~ /$string/i ) {
+ $list->Insert( $text, 0 );
+ }
}
}
+
+ return 1;
}
1;
@@ -9,7 +9,7 @@ use Padre::Wx::Icon ();
use Padre::Wx::Editor ();
use Padre::Constant();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
our @ISA = 'Wx::ToolBar';
# NOTE: Something is wrong with dockable toolbars on Windows
@@ -5,8 +5,6 @@ package Padre::Wx;
use 5.008;
use strict;
use warnings;
-use FindBin;
-use File::Spec ();
# Threading must be loaded before Wx loads
use threads;
@@ -16,16 +14,15 @@ use Thread::Queue 2.11;
# Load every exportable constant into here, so that they come into
# existence in the Wx:: packages, allowing everywhere else in the code to
# use them without braces.
-use Wx ':everything';
-use Wx 'wxTheClipboard';
-use Wx::Event ':everything';
-use Wx::DND ();
-use Wx::STC ();
-use Wx::AUI ();
-use Wx::Locale ();
-use Padre::Util ();
+use Wx (':everything');
+use Wx ('wxTheClipboard');
+use Wx::Event (':everything');
+use Wx::DND ();
+use Wx::STC ();
+use Wx::AUI ();
+use Wx::Locale ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
# Hard version lock on a new-enough Wx.pm
BEGIN {
@@ -42,24 +39,26 @@ BEGIN {
# Defines for sidebar marker; others may be needed for breakpoint
# icons etc.
-sub MarkError {1}
-sub MarkWarn {2}
-sub MarkLocation {3} # current location of the debugger
-sub MarkBreakpoint {4} # location of the debugger breakpoint
-
+use constant {
+ MarkError => 1,
+ MarkWarn => 2,
+ MarkLocation => 3, # current location of the debugger
+ MarkBreakpoint => 4, # location of the debugger breakpoint
+};
#####################################################################
# Defines for object IDs
-sub ID_TIMER_SYNTAX {30001}
-sub ID_TIMER_FILECHECK {30002}
-sub ID_TIMER_POSTINIT {30003}
-sub ID_TIMER_OUTLINE {30004}
-sub ID_TIMER_ACTIONQUEUE {30005}
-
-
+use constant {
+ ID_TIMER_SYNTAX => 30001,
+ ID_TIMER_FILECHECK => 30002,
+ ID_TIMER_POSTINIT => 30003,
+ ID_TIMER_OUTLINE => 30004,
+ ID_TIMER_ACTIONQUEUE => 30005,
+ ID_TIMER_LASTRESORT => 30006,
+};
@@ -24,7 +24,7 @@ use DBD::SQLite ();
# TO DO: Bug report dispatched. Likely to be fixed in 0.77.
use version ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
# Since everything is used OO-style, we will be require'ing
# everything other than the bare essentials
@@ -153,7 +153,8 @@ sub new {
# Create the task manager
require Padre::TaskManager;
$self->{task_manager} = Padre::TaskManager->new(
- use_threads => $self->config->threads,
+ threads => 1,
+ conduit => $self->{wx}->{main},
);
# Create the action queue
@@ -270,6 +271,10 @@ sub project {
return $self->{project}->{$root};
}
+sub project_exists {
+ defined $_[0]->{project}->{ $_[1] };
+}
+
1;
__END__
@@ -7,7 +7,7 @@ use File::Spec ();
use Wx::Perl::Dialog ();
use Wx::STC ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
our @ISA = 'Wx::Frame';
sub new {
@@ -48,11 +48,11 @@ use Cwd ();
use Exporter ();
use File::Spec ();
-our $VERSION = '0.63';
+our $VERSION = '0.66';
our @ISA = 'Exporter';
# I'd change this, but I suspect it's rather breaky
-our @EXPORT = ## no critic (ProhibitAutomaticExportation)
+our @EXPORT = #-# no critic (ProhibitAutomaticExportation)
qw(
entry
password
@@ -5,7 +5,7 @@ use strict;
use warnings;
use Wx::Perl::Dialog;
-our $VERSION = '0.63';
+our $VERSION = '0.66';
=head1 NAME
@@ -7,7 +7,7 @@ use Cwd ();
use Wx ':everything';
use Wx::Event ':everything';
-our $VERSION = '0.63';
+our $VERSION = '0.66';
our @ISA = 'Wx::Dialog';
=pod
@@ -12,7 +12,7 @@ local $SIG{__DIE__} =
: $SIG{__DIE__};
# Must run using wxPerl on OS X.
-if ( $^O eq 'darwin' and $^X !~ m{/wxPerl\.app/} ) {
+if ( $^O eq 'darwin' and $^X !~ m{/wxPerl} ) {
require File::Which;
my $perl = scalar File::Which::which('wxPerl');
chomp($perl);
@@ -1,15 +1,15 @@
-# Chinese translations for PACKAGE package
-# PACKAGE 软件包的简体中文翻译.
-# Copyright (C) 2009 THE PACKAGE'S COPYRIGHT HOLDER
-# This file is distributed under the same license as the PACKAGE package.
+# Chinese translations for Padre package
+# Padre 简体中文翻译.
+# Copyright (C) 2009 THE Padre'S COPYRIGHT HOLDER
+# This file is distributed under the same license as the Padre package.
# <fayland@gmail.com>, 2009
# Chuanren Wu <wuchuanren@gmail.com>, 2010
msgid ""
msgstr ""
"Project-Id-Version: Padre 0.34\n"
"Report-Msgid-Bugs-To: \n"
-"POT-Creation-Date: 2010-05-11 11:25+0200\n"
-"PO-Revision-Date: 2010-05-11 12:47+0100\n"
+"POT-Creation-Date: 2010-06-29 13:35+0200\n"
+"PO-Revision-Date: 2010-06-29 13:34+0100\n"
"Last-Translator: jagd <wuchuanren@gmail.com>\n"
"Language-Team: Chinese\n"
"MIME-Version: 1.0\n"
@@ -17,16 +17,18 @@ msgstr ""
"Content-Transfer-Encoding: 8bit\n"
"X-Poedit-Basepath: /home/wu/projects/padre/padre/Padre\n"
-#: lib/Padre/Document.pm:212
+#: lib/Padre/Document.pm:234
msgid "Error while opening file: no file object"
msgstr "文件打开错误: 不存在文件对象"
-#: lib/Padre/Document.pm:236
+#: lib/Padre/Document.pm:258
#, perl-format
-msgid "Cannot open %s as it is over the arbitrary file size limit of Padre which is currently %s"
+msgid ""
+"Cannot open %s as it is over the arbitrary file size limit of Padre which is "
+"currently %s"
msgstr "无法打开文件 %s 因为文件大小已超过 Padre 当前设置 %s"
-#: lib/Padre/Document.pm:258
+#: lib/Padre/Document.pm:280
msgid ""
"Error while determining MIME type.\n"
"This is possibly an encoding problem.\n"
@@ -36,41 +38,33 @@ msgstr ""
"这可能是一个编码问题。\n"
"您正在试图加载一个二进制文件吗?"
-#: lib/Padre/Document.pm:403
-#: lib/Padre/Task/SyntaxChecker.pm:183
-#: lib/Padre/Wx/Syntax.pm:93
-#: lib/Padre/Wx/Syntax.pm:96
-#: lib/Padre/Wx/Main.pm:2749
-#: lib/Padre/Wx/Main.pm:4263
-#: lib/Padre/Wx/Editor.pm:210
-#: lib/Padre/Wx/Directory/TreeCtrl.pm:440
-#: lib/Padre/Wx/Directory/TreeCtrl.pm:474
-#: lib/Padre/Wx/Directory/TreeCtrl.pm:663
-#: lib/Padre/Wx/Directory/TreeCtrl.pm:780
-#: lib/Padre/Wx/Directory/TreeCtrl.pm:810
-#: lib/Padre/Wx/Dialog/OpenResource.pm:128
-#: lib/Padre/Wx/Dialog/PluginManager.pm:349
+#: lib/Padre/Document.pm:438 lib/Padre/Wx/Syntax.pm:394
+#: lib/Padre/Wx/Syntax.pm:420 lib/Padre/Wx/Syntax.pm:423
+#: lib/Padre/Wx/Main.pm:2767 lib/Padre/Wx/Main.pm:4280
+#: lib/Padre/Wx/Editor.pm:211 lib/Padre/Wx/Dialog/OpenResource.pm:113
+#: lib/Padre/Wx/Dialog/PluginManager.pm:351
#: lib/Padre/Wx/Dialog/ModuleStart.pm:172
-#: lib/Padre/Wx/Dialog/QuickMenuAccess.pm:89
+#: lib/Padre/Wx/Dialog/QuickMenuAccess.pm:90
msgid "Error"
msgstr "错误"
-#: lib/Padre/Document.pm:717
+#: lib/Padre/Document.pm:752
#, perl-format
-msgid "Visual filename %s does not match the internal filename %s, do you want to abort saving?"
+msgid ""
+"Visual filename %s does not match the internal filename %s, do you want to "
+"abort saving?"
msgstr "显示的文件名 %s 与内在文件名 %s 不匹配，终止保存？"
-#: lib/Padre/Document.pm:721
+#: lib/Padre/Document.pm:756
msgid "Save Warning"
msgstr "保存警告"
-#: lib/Padre/Document.pm:936
+#: lib/Padre/Document.pm:975
#, perl-format
msgid "Unsaved %d"
msgstr "未保存 %d"
-#: lib/Padre/Document.pm:1350
-#: lib/Padre/Document.pm:1351
+#: lib/Padre/Document.pm:1389 lib/Padre/Document.pm:1390
msgid "Skipped for large files"
msgstr "跳过大文件"
@@ -99,11 +93,12 @@ msgid "PPI Standard"
msgstr "标准 PPI"
#: lib/Padre/MimeTypes.pm:328
-msgid "Hopefully faster than the PPI Traditional. Big file will fall back to Scintilla highlighter."
+msgid ""
+"Hopefully faster than the PPI Traditional. Big file will fall back to "
+"Scintilla highlighter."
msgstr "比原来的 PPI 要快一点。大文件将返回到原始的 Scintilla 加亮。"
-#: lib/Padre/PluginHandle.pm:89
-#: lib/Padre/Wx/Dialog/PluginManager.pm:480
+#: lib/Padre/PluginHandle.pm:89 lib/Padre/Wx/Dialog/PluginManager.pm:482
msgid "error"
msgstr "错误"
@@ -115,18 +110,15 @@ msgstr "未载入"
msgid "loaded"
msgstr "已载入"
-#: lib/Padre/PluginHandle.pm:92
-#: lib/Padre/Wx/Dialog/PluginManager.pm:492
+#: lib/Padre/PluginHandle.pm:92 lib/Padre/Wx/Dialog/PluginManager.pm:494
msgid "incompatible"
msgstr "不兼容"
-#: lib/Padre/PluginHandle.pm:93
-#: lib/Padre/Wx/Dialog/PluginManager.pm:519
+#: lib/Padre/PluginHandle.pm:93 lib/Padre/Wx/Dialog/PluginManager.pm:521
msgid "disabled"
msgstr "禁用"
-#: lib/Padre/PluginHandle.pm:94
-#: lib/Padre/Wx/Dialog/PluginManager.pm:507
+#: lib/Padre/PluginHandle.pm:94 lib/Padre/Wx/Dialog/PluginManager.pm:509
msgid "enabled"
msgstr "启用"
@@ -189,10 +181,8 @@ msgstr "插件错误, 事件 %s: %s"
msgid "(core)"
msgstr "(核心)"
-#: lib/Padre/PluginManager.pm:781
-#: lib/Padre/Task/PPI/FindVariableDeclaration.pm:93
-#: lib/Padre/Task/PPI/LexicalReplaceVariable.pm:107
-#: lib/Padre/Task/PPI/IntroduceTemporaryVariable.pm:107
+#: lib/Padre/PluginManager.pm:781 lib/Padre/Document/Perl.pm:610
+#: lib/Padre/Document/Perl.pm:865 lib/Padre/Document/Perl.pm:914
#: lib/Padre/File/FTP.pm:138
msgid "Unknown error"
msgstr "未知错误"
@@ -206,17 +196,13 @@ msgstr "插件 %s"
msgid "Error when calling menu for plug-in "
msgstr "为插件调出菜单出错"
-#: lib/Padre/PluginManager.pm:905
-#: lib/Padre/Wx/Main.pm:2160
-#: lib/Padre/Wx/Main.pm:2215
-#: lib/Padre/Wx/Main.pm:2267
+#: lib/Padre/PluginManager.pm:905 lib/Padre/Wx/Main.pm:2178
+#: lib/Padre/Wx/Main.pm:2233 lib/Padre/Wx/Main.pm:2285
msgid "No document open"
msgstr "没有打开文档"
-#: lib/Padre/PluginManager.pm:909
-#: lib/Padre/Util/FileBrowser.pm:47
-#: lib/Padre/Util/FileBrowser.pm:87
-#: lib/Padre/Util/FileBrowser.pm:135
+#: lib/Padre/PluginManager.pm:909 lib/Padre/Util/FileBrowser.pm:47
+#: lib/Padre/Util/FileBrowser.pm:87 lib/Padre/Util/FileBrowser.pm:135
msgid "No filename"
msgstr "没有文件名"
@@ -224,8 +210,7 @@ msgstr "没有文件名"
msgid "Could not locate project dir"
msgstr "无法载入工程目录"
-#: lib/Padre/PluginManager.pm:933
-#: lib/Padre/PluginManager.pm:1029
+#: lib/Padre/PluginManager.pm:933 lib/Padre/PluginManager.pm:1029
#, perl-format
msgid ""
"Failed to load the plug-in '%s'\n"
@@ -234,8 +219,7 @@ msgstr ""
"载入插件 '%s' 失败\n"
"%s"
-#: lib/Padre/PluginManager.pm:983
-#: lib/Padre/Wx/Main.pm:5213
+#: lib/Padre/PluginManager.pm:983 lib/Padre/Wx/Main.pm:5187
msgid "Open file"
msgstr "打开文件"
@@ -244,89 +228,63 @@ msgstr "打开文件"
msgid "Plug-in must have '%s' as base directory"
msgstr "插件必须以 '%s' 为基础目录"
-#: lib/Padre/Config.pm:380
+#: lib/Padre/Config.pm:387
msgid "Previous open files"
msgstr "以前的打开文件"
-#: lib/Padre/Config.pm:381
+#: lib/Padre/Config.pm:388
msgid "A new empty file"
msgstr "新的空文件"
-#: lib/Padre/Config.pm:382
+#: lib/Padre/Config.pm:389
msgid "No open files"
msgstr "没有打开文件"
-#: lib/Padre/Config.pm:383
+#: lib/Padre/Config.pm:390
msgid "Open session"
msgstr "打开会话"
-#: lib/Padre/Config.pm:471
+#: lib/Padre/Config.pm:472
msgid "Code Order"
msgstr "代码排序"
-#: lib/Padre/Config.pm:472
+#: lib/Padre/Config.pm:473
msgid "Alphabetical Order"
msgstr "按字母排序"
-#: lib/Padre/Config.pm:473
+#: lib/Padre/Config.pm:474
msgid "Alphabetical Order (Private Last)"
msgstr "按字母排序（私有最后）"
-#: lib/Padre/Config.pm:494
+#: lib/Padre/Config.pm:501
msgid "Project Tools (Left)"
msgstr "工程工具（左）"
-#: lib/Padre/Config.pm:495
+#: lib/Padre/Config.pm:502
msgid "Document Tools (Right)"
msgstr "文档工具（右）"
-#: lib/Padre/Config.pm:658
+#: lib/Padre/Config.pm:665
msgid "No Autoindent"
msgstr "无自动缩进"
-#: lib/Padre/Config.pm:659
+#: lib/Padre/Config.pm:666
msgid "Indent to Same Depth"
msgstr "缩进到相同深度"
-#: lib/Padre/Config.pm:660
+#: lib/Padre/Config.pm:667
msgid "Indent Deeply"
msgstr "深度缩进"
-#: lib/Padre/Project.pm:41
-#, perl-format
-msgid "Project directory %s does not exist (any longer). This is fatal and will cause problems, please close or save-as this file unless you know what you are doing."
-msgstr "工程目录 %s 不(复)存在. 这是致命的, 並且会导致一些问题. 若您已明确应如何操作, 请关闭该文件或者将其另存."
-
-#: lib/Padre/TaskManager.pm:630
-#, perl-format
-msgid "%s worker threads are running.\n"
-msgstr "%s worker threads 正在运行中。\n"
-
-#: lib/Padre/TaskManager.pm:632
-msgid "Currently, no background tasks are being executed.\n"
-msgstr "当前没有任何后台任务在运行。\n"
-
-#: lib/Padre/TaskManager.pm:638
-msgid "The following tasks are currently executing in the background:\n"
-msgstr "以下任务正在后台运行中：\n"
-
-#: lib/Padre/TaskManager.pm:644
+#: lib/Padre/Project.pm:42
#, perl-format
msgid ""
-"- %s of type '%s':\n"
-" (in thread(s) %s)\n"
+"Project directory %s does not exist (any longer). This is fatal and will "
+"cause problems, please close or save-as this file unless you know what you "
+"are doing."
msgstr ""
-"- %s 拥有类型 '%s':\n"
-" (在线程 %s)\n"
-
-#: lib/Padre/TaskManager.pm:656
-#, perl-format
-msgid ""
-"\n"
-"Additionally, there are %s tasks pending execution.\n"
-msgstr ""
-"\n"
-"另外, 任务 %s 正在等待运行。\n"
+"工程目录 %s 不(复)存在. 这是致命的, 並且会导致一些问题. 若您已明确应如何操"
+"作, 请关闭该文件或者将其另存."
#: lib/Padre/Locale.pm:85
msgid "English (United Kingdom)"
@@ -336,8 +294,7 @@ msgstr "英语 (英国)"
msgid "English (Australia)"
msgstr "英语 (澳大利亚)"
-#: lib/Padre/Locale.pm:142
-#: lib/Padre/Wx/Main.pm:3438
+#: lib/Padre/Locale.pm:142 lib/Padre/Wx/Main.pm:3455
msgid "Unknown"
msgstr "未知"
@@ -457,484 +414,369 @@ msgstr "繁体中文"
msgid "Klingon"
msgstr "克林贡语"
-#: lib/Padre/Task/SyntaxChecker.pm:146
-msgid "Info"
-msgstr "信息"
-
-#: lib/Padre/Task/SyntaxChecker.pm:156
-#, perl-format
-msgid "No errors or warnings found in %s."
-msgstr "在 %s 中未发现错误或警告 "
-
-#: lib/Padre/Task/SyntaxChecker.pm:158
-msgid "No errors or warnings found."
-msgstr "找不到任何错误或警告"
-
-#: lib/Padre/Task/SyntaxChecker.pm:183
-#: lib/Padre/Wx/Syntax.pm:93
-#: lib/Padre/Wx/Syntax.pm:94
-#: lib/Padre/Wx/Main.pm:2500
-#: lib/Padre/Wx/Main.pm:3129
-#: lib/Padre/Wx/Dialog/Warning.pm:64
-msgid "Warning"
-msgstr "警告"
-
-#: lib/Padre/Task/OpenResource/SearchTask.pm:105
-msgid "Finished Searching"
-msgstr "查找完毕"
-
-#: lib/Padre/Task/PPI/FindVariableDeclaration.pm:89
-#: lib/Padre/Task/PPI/LexicalReplaceVariable.pm:103
-#: lib/Padre/Document/Perl.pm:575
-#: lib/Padre/Document/Perl.pm:760
-msgid "Current cursor does not seem to point at a variable"
-msgstr "当前光标不像指在一个变量上"
-
-# !!!!! not sure, thx for daxim to point out
-#: lib/Padre/Task/PPI/FindVariableDeclaration.pm:91
-#: lib/Padre/Task/PPI/LexicalReplaceVariable.pm:105
-msgid "No declaration could be found for the specified (lexical?) variable"
-msgstr "未能发现此变量的声明"
-
-#: lib/Padre/Task/PPI/FindVariableDeclaration.pm:96
-msgid "Search Canceled"
-msgstr "检查已取消"
-
-#: lib/Padre/Task/PPI/LexicalReplaceVariable.pm:110
-#: lib/Padre/Task/PPI/IntroduceTemporaryVariable.pm:110
-msgid "Replace Operation Canceled"
-msgstr "替换操作已取消"
-
-#: lib/Padre/Task/PPI/FindUnmatchedBrace.pm:79
-msgid "All braces appear to be matched"
-msgstr "所有的括号都已匹配"
-
-#: lib/Padre/Task/PPI/FindUnmatchedBrace.pm:80
-msgid "Check Complete"
-msgstr "检查结束"
-
-#: lib/Padre/Task/PPI/IntroduceTemporaryVariable.pm:103
-msgid "First character of selection does not seem to point at a token."
-msgstr "所选区域的首字符不像一个 token"
-
-#: lib/Padre/Task/PPI/IntroduceTemporaryVariable.pm:105
-msgid "Selection not part of a Perl statement?"
-msgstr "选区非 Perl 声明？"
-
-#: lib/Padre/Task/Outline/Perl.pm:162
-msgid "&Go to Element"
-msgstr "跳至元素(&G)"
-
-#: lib/Padre/Task/Outline/Perl.pm:174
-#: lib/Padre/Wx/Directory/TreeCtrl.pm:820
-msgid "Open &Documentation"
-msgstr "打开文档(&D)"
-
-#: lib/Padre/Wx/DocBrowser.pm:83
-#: lib/Padre/Wx/Dialog/QuickMenuAccess.pm:397
-#: lib/Padre/Action/Help.pm:37
-msgid "Help"
-msgstr "帮助"
-
-#: lib/Padre/Wx/DocBrowser.pm:113
-#: lib/Padre/Wx/DocBrowser.pm:130
-msgid "Search for perldoc - e.g. Padre::Task, Net::LDAP"
-msgstr "搜索 perldoc, 例如 Padre::Task, Net::LDAP"
-
-#: lib/Padre/Wx/DocBrowser.pm:126
-msgid "Search:"
-msgstr "搜索:"
-
-#: lib/Padre/Wx/DocBrowser.pm:132
-#: lib/Padre/Wx/About.pm:86
-#: lib/Padre/Wx/Dialog/Replace.pm:192
-#: lib/Padre/Wx/Dialog/Find.pm:160
-#: lib/Padre/Wx/Dialog/DocStats.pm:58
-#: lib/Padre/Wx/Dialog/HelpSearch.pm:179
-#: lib/Padre/Wx/Dialog/RegexEditor.pm:239
-#: lib/Padre/Action/File.pm:166
-msgid "&Close"
-msgstr "关闭(&C)"
-
-#: lib/Padre/Wx/DocBrowser.pm:307
-msgid "Untitled"
-msgstr "未命名"
-
-#: lib/Padre/Wx/DocBrowser.pm:371
-#, perl-format
-msgid "DocBrowser: no viewer for %s"
-msgstr "文档浏览器: 没有 %s 的查看器"
-
-#: lib/Padre/Wx/DocBrowser.pm:404
-#, perl-format
-msgid "Searched for '%s' and failed..."
-msgstr "查找 '%s' 失败 ..."
-
-#: lib/Padre/Wx/DocBrowser.pm:405
-msgid "Help not found."
-msgstr "找不到帮助."
+#: lib/Padre/Wx/Directory.pm:68 lib/Padre/Wx/Dialog/Find.pm:332
+#: lib/Padre/Wx/Dialog/QuickMenuAccess.pm:390
+msgid "Search"
+msgstr "搜索"
-#: lib/Padre/Wx/DocBrowser.pm:427
-msgid "NAME"
-msgstr "名字"
+#: lib/Padre/Wx/Directory.pm:92
+msgid "Move to other panel"
+msgstr "移动到其他面板"
-#: lib/Padre/Wx/Directory.pm:77
-#: lib/Padre/Wx/Dialog/WindowList.pm:225
+#: lib/Padre/Wx/Directory.pm:165 lib/Padre/Wx/Dialog/WindowList.pm:225
msgid "Project"
msgstr "工程"
-#: lib/Padre/Wx/Directory.pm:79
-#: lib/Padre/Wx/Directory/TreeCtrl.pm:101
-msgid "Directory"
-msgstr "目录"
+#: lib/Padre/Wx/Syntax.pm:203 lib/Padre/Wx/FindResult.pm:227
+msgid "Copy &Selected"
+msgstr "复制所选(&S)"
-#: lib/Padre/Wx/Directory.pm:146
-msgid "Choose a directory"
-msgstr "选择目录"
+#: lib/Padre/Wx/Syntax.pm:228 lib/Padre/Wx/FindResult.pm:250
+msgid "Copy &All"
+msgstr "关闭所有(&A)"
-#: lib/Padre/Wx/Syntax.pm:63
+#: lib/Padre/Wx/Syntax.pm:277
msgid "Syntax Check"
msgstr "语法检查"
-#: lib/Padre/Wx/Syntax.pm:89
-#: lib/Padre/Wx/Syntax.pm:294
+#: lib/Padre/Wx/Syntax.pm:282 lib/Padre/Wx/Syntax.pm:416
#: lib/Padre/Wx/FindResult.pm:179
msgid "Line"
msgstr "行"
-#: lib/Padre/Wx/Syntax.pm:295
-#: lib/Padre/Wx/Dialog/Advanced.pm:108
+#: lib/Padre/Wx/Syntax.pm:283 lib/Padre/Wx/Dialog/Advanced.pm:108
msgid "Type"
msgstr "类型"
-#: lib/Padre/Wx/Syntax.pm:296
-#: lib/Padre/Wx/Dialog/SessionManager.pm:226
+#: lib/Padre/Wx/Syntax.pm:284 lib/Padre/Wx/Dialog/SessionManager.pm:226
msgid "Description"
msgstr "描述"
-#: lib/Padre/Wx/Syntax.pm:327
-#: lib/Padre/Wx/FindResult.pm:227
-msgid "Copy &Selected"
-msgstr "复制所选(&S)"
+#: lib/Padre/Wx/Syntax.pm:370
+msgid "Info"
+msgstr "信息"
-#: lib/Padre/Wx/Syntax.pm:352
-#: lib/Padre/Wx/FindResult.pm:250
-msgid "Copy &All"
-msgstr "关闭所有(&A)"
+#: lib/Padre/Wx/Syntax.pm:380
+#, perl-format
+msgid "No errors or warnings found in %s."
+msgstr "在 %s 中未发现错误或警告 "
+
+#: lib/Padre/Wx/Syntax.pm:382
+msgid "No errors or warnings found."
+msgstr "找不到任何错误或警告"
-#: lib/Padre/Wx/Main.pm:710
+#: lib/Padre/Wx/Syntax.pm:394 lib/Padre/Wx/Syntax.pm:420
+#: lib/Padre/Wx/Syntax.pm:421 lib/Padre/Wx/Main.pm:2518
+#: lib/Padre/Wx/Main.pm:3147 lib/Padre/Wx/Dialog/Warning.pm:64
+msgid "Warning"
+msgstr "警告"
+
+#: lib/Padre/Wx/Main.pm:709
#, perl-format
msgid "No such session %s"
msgstr "没有该会话 %s"
-#: lib/Padre/Wx/Main.pm:885
+#: lib/Padre/Wx/Main.pm:884
msgid "Failed to create server"
msgstr "创建服务器失败"
-#: lib/Padre/Wx/Main.pm:2130
+#: lib/Padre/Wx/Main.pm:2148
msgid "Command line"
msgstr "命令行"
-#: lib/Padre/Wx/Main.pm:2131
+#: lib/Padre/Wx/Main.pm:2149
msgid "Run setup"
msgstr "运行设置"
-#: lib/Padre/Wx/Main.pm:2166
-#: lib/Padre/Wx/Main.pm:2227
-#: lib/Padre/Wx/Main.pm:2282
+#: lib/Padre/Wx/Main.pm:2184 lib/Padre/Wx/Main.pm:2245
+#: lib/Padre/Wx/Main.pm:2300
msgid "Could not find project root"
msgstr "无法找到工程主目录"
-#: lib/Padre/Wx/Main.pm:2193
+#: lib/Padre/Wx/Main.pm:2211
msgid "No Build.PL nor Makefile.PL nor dist.ini found"
msgstr "既没有发现 Build.PL 也没有 Makefile.PL 或 dist.ini"
-#: lib/Padre/Wx/Main.pm:2196
+#: lib/Padre/Wx/Main.pm:2214
msgid "Could not find perl executable"
msgstr "无法找到 perl 可执行文件"
-#: lib/Padre/Wx/Main.pm:2221
-#: lib/Padre/Wx/Main.pm:2273
+#: lib/Padre/Wx/Main.pm:2239 lib/Padre/Wx/Main.pm:2291
msgid "Current document has no filename"
msgstr "当前文档没有文件名"
-#: lib/Padre/Wx/Main.pm:2276
+#: lib/Padre/Wx/Main.pm:2294
msgid "Current document is not a .t file"
msgstr "当前文档不是一个 .t 文件"
-#: lib/Padre/Wx/Main.pm:2373
-#: lib/Padre/Wx/Output.pm:121
+#: lib/Padre/Wx/Main.pm:2391 lib/Padre/Wx/Output.pm:142
#, perl-format
msgid ""
-"Wx::Perl::ProcessStream is version %s which is known to cause problems. Get at least 0.20 by typing\n"
+"Wx::Perl::ProcessStream is version %s which is known to cause problems. Get "
+"at least 0.20 by typing\n"
"cpan Wx::Perl::ProcessStream"
msgstr ""
-"Wx::Perl::ProcessStream 的版本是 %s , 据知会引起一些问题. 获取至少 0.20 版本, 可以输入\n"
+"Wx::Perl::ProcessStream 的版本是 %s , 据知会引起一些问题. 获取至少 0.20 版"
+"本, 可以输入\n"
"cpan Wx::Perl::ProcessStream"
-#: lib/Padre/Wx/Main.pm:2432
+#: lib/Padre/Wx/Main.pm:2450
#, perl-format
msgid "Failed to start '%s' command"
msgstr "启动 '%s' 命令失败"
-#: lib/Padre/Wx/Main.pm:2457
+#: lib/Padre/Wx/Main.pm:2475
msgid "No open document"
msgstr "没有打开文档"
-#: lib/Padre/Wx/Main.pm:2474
+#: lib/Padre/Wx/Main.pm:2492
msgid "No execution mode was defined for this document"
msgstr "没有该文档对应的运行方法"
-#: lib/Padre/Wx/Main.pm:2499
+#: lib/Padre/Wx/Main.pm:2517
msgid "Do you want to continue?"
msgstr "您希望继续吗?"
-#: lib/Padre/Wx/Main.pm:2585
+#: lib/Padre/Wx/Main.pm:2603
#, perl-format
msgid "Opening session %s..."
msgstr "打开会员 %s..."
-#: lib/Padre/Wx/Main.pm:2614
+#: lib/Padre/Wx/Main.pm:2632
msgid "Restore focus..."
msgstr "恢复焦点..."
-#: lib/Padre/Wx/Main.pm:2697
+#: lib/Padre/Wx/Main.pm:2715
msgid "Message"
msgstr "提示"
-#: lib/Padre/Wx/Main.pm:2747
+#: lib/Padre/Wx/Main.pm:2765
msgid "Unknown error from "
msgstr "未知错误出自"
-#: lib/Padre/Wx/Main.pm:2966
+#: lib/Padre/Wx/Main.pm:2984
#, perl-format
msgid "Could not determine the comment character for %s document type"
msgstr "不能判断 %s 文件类型的注释符"
-#: lib/Padre/Wx/Main.pm:3015
+#: lib/Padre/Wx/Main.pm:3033
msgid "Autocompletion error"
msgstr "自动完成错误"
-#: lib/Padre/Wx/Main.pm:3128
+#: lib/Padre/Wx/Main.pm:3146
msgid "You still have a running process. Do you want to kill it and exit?"
msgstr "当前有一个运行中进程。是否终止退出？"
-#: lib/Padre/Wx/Main.pm:3344
+#: lib/Padre/Wx/Main.pm:3361
#, perl-format
msgid "Cannot open a Directory: %s"
msgstr "不能打开目录: %s"
-#: lib/Padre/Wx/Main.pm:3472
+#: lib/Padre/Wx/Main.pm:3489
msgid "Nothing selected. Enter what should be opened:"
msgstr "无选区。请输入需要打开的:"
-#: lib/Padre/Wx/Main.pm:3473
+#: lib/Padre/Wx/Main.pm:3490
msgid "Open selection"
msgstr "打开所选"
-#: lib/Padre/Wx/Main.pm:3514
+#: lib/Padre/Wx/Main.pm:3531
#, perl-format
msgid "Could not find file '%s'"
msgstr "无法找到文件 '%s'"
-#: lib/Padre/Wx/Main.pm:3515
-#: lib/Padre/Action/File.pm:334
+#: lib/Padre/Wx/Main.pm:3532 lib/Padre/Action/File.pm:334
msgid "Open Selection"
msgstr "打开所选"
-#: lib/Padre/Wx/Main.pm:3526
+#: lib/Padre/Wx/Main.pm:3543
msgid "Choose File"
msgstr "选择文件"
-#: lib/Padre/Wx/Main.pm:3632
+#: lib/Padre/Wx/Main.pm:3649
msgid "JavaScript Files"
msgstr "JavaScript 文件"
-#: lib/Padre/Wx/Main.pm:3634
+#: lib/Padre/Wx/Main.pm:3651
msgid "Perl Files"
msgstr "Perl 文件"
-#: lib/Padre/Wx/Main.pm:3636
+#: lib/Padre/Wx/Main.pm:3653
msgid "PHP Files"
msgstr "PHP 文件"
-#: lib/Padre/Wx/Main.pm:3638
+#: lib/Padre/Wx/Main.pm:3655
msgid "Python Files"
msgstr "Python 文件"
-#: lib/Padre/Wx/Main.pm:3640
+#: lib/Padre/Wx/Main.pm:3657
msgid "Ruby Files"
msgstr "Ruby 文件"
-#: lib/Padre/Wx/Main.pm:3642
+#: lib/Padre/Wx/Main.pm:3659
msgid "SQL Files"
msgstr "SQL 文件"
-#: lib/Padre/Wx/Main.pm:3644
+#: lib/Padre/Wx/Main.pm:3661
msgid "Text Files"
msgstr "文本文件"
-#: lib/Padre/Wx/Main.pm:3646
+#: lib/Padre/Wx/Main.pm:3663
msgid "Web Files"
msgstr "网页文件"
-#: lib/Padre/Wx/Main.pm:3648
+#: lib/Padre/Wx/Main.pm:3665
msgid "Script Files"
msgstr "脚本文件"
-#: lib/Padre/Wx/Main.pm:3653
-#: lib/Padre/Wx/Main.pm:3654
-#: lib/Padre/Wx/Main.pm:4026
-#: lib/Padre/Wx/Main.pm:5215
+#: lib/Padre/Wx/Main.pm:3670 lib/Padre/Wx/Main.pm:3671
+#: lib/Padre/Wx/Main.pm:4043 lib/Padre/Wx/Main.pm:5189
msgid "All Files"
msgstr "所有文件"
-#: lib/Padre/Wx/Main.pm:3656
+#: lib/Padre/Wx/Main.pm:3673 lib/Padre/Wx/Directory/TreeCtrl.pm:148
msgid "Open File"
msgstr "打开文件"
-#: lib/Padre/Wx/Main.pm:3693
+#: lib/Padre/Wx/Main.pm:3710
#, perl-format
-msgid "File name %s contains * or ? which are special chars on most computers. Skip?"
+msgid ""
+"File name %s contains * or ? which are special chars on most computers. Skip?"
msgstr "文件名 %s 里包含 * 或 ? （对于大多数电脑来说是特殊字符）。跳过？"
-#: lib/Padre/Wx/Main.pm:3696
-#: lib/Padre/Wx/Main.pm:3716
+#: lib/Padre/Wx/Main.pm:3713 lib/Padre/Wx/Main.pm:3733
msgid "Open Warning"
msgstr "打开警告"
-#: lib/Padre/Wx/Main.pm:3713
+#: lib/Padre/Wx/Main.pm:3730
#, perl-format
msgid "File name %s does not exist on disk. Skip?"
msgstr "文件名 %s 在磁盘中不存在. 跳过?"
-#: lib/Padre/Wx/Main.pm:3801
+#: lib/Padre/Wx/Main.pm:3818
msgid "Reload all files"
msgstr "重新载入所有文件"
-#: lib/Padre/Wx/Main.pm:3832
+#: lib/Padre/Wx/Main.pm:3849
msgid "Reload some files"
msgstr "重新载入一些文件"
-#: lib/Padre/Wx/Main.pm:3833
+#: lib/Padre/Wx/Main.pm:3850
msgid "&Select files to reload:"
msgstr "选择欲重新载入的文件(&S):"
-#: lib/Padre/Wx/Main.pm:3834
+#: lib/Padre/Wx/Main.pm:3851
msgid "&Reload selected"
msgstr "重新载入所选(&R)"
-#: lib/Padre/Wx/Main.pm:3848
+#: lib/Padre/Wx/Main.pm:3865
msgid "Reload some"
msgstr "重新载入一些"
-#: lib/Padre/Wx/Main.pm:3910
+#: lib/Padre/Wx/Main.pm:3927
#, perl-format
msgid "Could not reload file: %s"
msgstr "无法重载文件: %s"
-#: lib/Padre/Wx/Main.pm:4023
+#: lib/Padre/Wx/Main.pm:4040
msgid "Save file as..."
msgstr "另存为..."
-#: lib/Padre/Wx/Main.pm:4050
+#: lib/Padre/Wx/Main.pm:4067
msgid "File already exists. Overwrite it?"
msgstr "文件已存在。是否覆盖？"
-#: lib/Padre/Wx/Main.pm:4051
+#: lib/Padre/Wx/Main.pm:4068
msgid "Exist"
msgstr "存在"
-#: lib/Padre/Wx/Main.pm:4147
-#: lib/Padre/Wx/Directory/TreeCtrl.pm:538
+#: lib/Padre/Wx/Main.pm:4164
msgid "File already exists"
msgstr "文件已存在"
-#: lib/Padre/Wx/Main.pm:4161
+#: lib/Padre/Wx/Main.pm:4178
#, perl-format
msgid "Failed to create path '%s'"
msgstr "创建路径 '%s' 失败"
-#: lib/Padre/Wx/Main.pm:4252
+#: lib/Padre/Wx/Main.pm:4269
msgid "File changed on disk since last saved. Do you want to overwrite it?"
msgstr "文件在上次保存后有更新。是否覆盖？"
-#: lib/Padre/Wx/Main.pm:4253
+#: lib/Padre/Wx/Main.pm:4270
msgid "File not in sync"
msgstr "文件未同步"
-#: lib/Padre/Wx/Main.pm:4262
+#: lib/Padre/Wx/Main.pm:4279
msgid "Could not save file: "
msgstr "无法保存文件："
-#: lib/Padre/Wx/Main.pm:4344
+#: lib/Padre/Wx/Main.pm:4361
msgid "File changed. Do you want to save it?"
msgstr "文件已更改。是否保存？"
-#: lib/Padre/Wx/Main.pm:4345
+#: lib/Padre/Wx/Main.pm:4362
msgid "Unsaved File"
msgstr "未保存文件"
-#: lib/Padre/Wx/Main.pm:4428
+#: lib/Padre/Wx/Main.pm:4445
msgid "Close all"
msgstr "关闭所有"
-#: lib/Padre/Wx/Main.pm:4468
+#: lib/Padre/Wx/Main.pm:4485
msgid "Close some files"
msgstr "关闭一些文件"
-#: lib/Padre/Wx/Main.pm:4469
+#: lib/Padre/Wx/Main.pm:4486
msgid "Select files to close:"
msgstr "选择要关闭的文件:"
-#: lib/Padre/Wx/Main.pm:4484
+#: lib/Padre/Wx/Main.pm:4501
msgid "Close some"
msgstr "关闭一些"
-#: lib/Padre/Wx/Main.pm:4646
+#: lib/Padre/Wx/Main.pm:4663
msgid "Cannot diff if file was never saved"
msgstr "无法对未保存文件进行比较"
-#: lib/Padre/Wx/Main.pm:4670
+#: lib/Padre/Wx/Main.pm:4687
msgid "There are no differences\n"
msgstr "无差异\n"
-#: lib/Padre/Wx/Main.pm:5332
-#: lib/Padre/Plugin/Devel.pm:308
+#: lib/Padre/Wx/Main.pm:5306 lib/Padre/Plugin/Devel.pm:308
#, perl-format
msgid "Error: %s"
msgstr "错误: %s"
-#: lib/Padre/Wx/Main.pm:5333
+#: lib/Padre/Wx/Main.pm:5307
msgid "Internal error"
msgstr "内部错误"
-#: lib/Padre/Wx/Main.pm:5525
-#: lib/Padre/Plugin/Devel.pm:139
+#: lib/Padre/Wx/Main.pm:5499 lib/Padre/Plugin/Devel.pm:139
msgid "No file is open"
msgstr "没有打开文件"
-#: lib/Padre/Wx/Main.pm:5525
+#: lib/Padre/Wx/Main.pm:5499
msgid "Stats"
msgstr "状态"
-#: lib/Padre/Wx/Main.pm:5553
+#: lib/Padre/Wx/Main.pm:5527
msgid "Space to Tab"
msgstr "转换空格为制表符"
-#: lib/Padre/Wx/Main.pm:5554
+#: lib/Padre/Wx/Main.pm:5528
msgid "Tab to Space"
msgstr "转换制表符为空格"
-#: lib/Padre/Wx/Main.pm:5559
+#: lib/Padre/Wx/Main.pm:5533
msgid "How many spaces for each tab:"
msgstr "一个制表符转为多个个空格:"
-#: lib/Padre/Wx/Main.pm:6037
+#: lib/Padre/Wx/Main.pm:6011
msgid "Need to select text in order to translate to hex"
msgstr "请选择文本来显示为十六进制"
-#: lib/Padre/Wx/Main.pm:6179
+#: lib/Padre/Wx/Main.pm:6153
#, perl-format
msgid ""
"Error running filter tool:\n"
@@ -943,7 +785,7 @@ msgstr ""
"运行过滤工具错误:\n"
"%s"
-#: lib/Padre/Wx/Main.pm:6194
+#: lib/Padre/Wx/Main.pm:6168
#, perl-format
msgid ""
"Error returned by filter tool:\n"
@@ -952,7 +794,7 @@ msgstr ""
"过滤工具返回错误:\n"
"%s"
-#: lib/Padre/Wx/Right.pm:51
+#: lib/Padre/Wx/Right.pm:52
msgid "Document Tools"
msgstr "文档工具"
@@ -984,9 +826,7 @@ msgstr "忽略隐藏的子目录(&g)"
msgid "Show only files that don't match"
msgstr "只显示不匹配的文件"
-#: lib/Padre/Wx/Ack.pm:145
-#: lib/Padre/Wx/Ack.pm:338
-#: lib/Padre/Wx/Ack.pm:362
+#: lib/Padre/Wx/Ack.pm:145 lib/Padre/Wx/Ack.pm:338 lib/Padre/Wx/Ack.pm:362
msgid "Find in Files"
msgstr "在文件中查找"
@@ -1014,7 +854,7 @@ msgstr "'%s' 缺失, 在文件 '%s'\n"
msgid "Found '%s' in '%s':\n"
msgstr "发现 '%s' 在 '%s' :\n"
-#: lib/Padre/Wx/TodoList.pm:138
+#: lib/Padre/Wx/TodoList.pm:197
msgid "To-do"
msgstr "待办"
@@ -1026,23 +866,23 @@ msgstr "输出视图"
msgid "Files"
msgstr "文件"
-#: lib/Padre/Wx/ErrorList.pm:95
-msgid "Errors"
-msgstr "错误"
-
-#: lib/Padre/Wx/ErrorList.pm:131
+#: lib/Padre/Wx/ErrorList.pm:107
msgid "No diagnostics available for this error!"
msgstr "该错误没有诊断信息"
-#: lib/Padre/Wx/ErrorList.pm:140
+#: lib/Padre/Wx/ErrorList.pm:116
msgid "Diagnostics"
msgstr "诊断"
-#: lib/Padre/Wx/Editor.pm:1588
+#: lib/Padre/Wx/ErrorList.pm:163
+msgid "Errors"
+msgstr "错误"
+
+#: lib/Padre/Wx/Editor.pm:1612
msgid "You must select a range of lines"
msgstr "您必须选择多行"
-#: lib/Padre/Wx/Editor.pm:1604
+#: lib/Padre/Wx/Editor.pm:1628
msgid "First character of selection must be a non-word character to align"
msgstr "所选区域的首字符必须为非词组字符"
@@ -1050,8 +890,7 @@ msgstr "所选区域的首字符必须为非词组字符"
msgid "About Padre"
msgstr "关于 Padre"
-#: lib/Padre/Wx/About.pm:59
-#: lib/Padre/Wx/Dialog/Form.pm:98
+#: lib/Padre/Wx/About.pm:59 lib/Padre/Wx/Dialog/Form.pm:98
#: lib/Padre/Wx/Menu/View.pm:198
msgid "Padre"
msgstr "Padre"
@@ -1064,23 +903,31 @@ msgstr "开发"
msgid "Translation"
msgstr "翻译"
-#: lib/Padre/Wx/About.pm:74
-#: lib/Padre/Wx/About.pm:311
+#: lib/Padre/Wx/About.pm:74 lib/Padre/Wx/About.pm:311
msgid "System Info"
msgstr "系统信息"
+#: lib/Padre/Wx/About.pm:86 lib/Padre/Wx/Browser.pm:116
+#: lib/Padre/Wx/Dialog/Replace.pm:192 lib/Padre/Wx/Dialog/Find.pm:160
+#: lib/Padre/Wx/Dialog/DocStats.pm:58 lib/Padre/Wx/Dialog/HelpSearch.pm:179
+#: lib/Padre/Wx/Dialog/RegexEditor.pm:239 lib/Padre/Action/File.pm:166
+msgid "&Close"
+msgstr "关闭(&C)"
+
#: lib/Padre/Wx/About.pm:102
msgid "Created by"
msgstr "创建者"
-#: lib/Padre/Wx/About.pm:103
-#: lib/Padre/Wx/About.pm:135
+#: lib/Padre/Wx/About.pm:103 lib/Padre/Wx/About.pm:135
msgid "The Padre Development Team"
msgstr "Padre 开发者团队"
#: lib/Padre/Wx/About.pm:105
-msgid "Padre is free software; you can redistribute it and/or modify it under the same terms as Perl 5."
-msgstr "Padre 是一个自由软件; 您可以在与 Perl 5 相同的条款下再发布并且/或者俢改它。"
+msgid ""
+"Padre is free software; you can redistribute it and/or modify it under the "
+"same terms as Perl 5."
+msgstr ""
+"Padre 是一个自由软件; 您可以在与 Perl 5 相同的条款下再发布并且/或者俢改它。"
#: lib/Padre/Wx/About.pm:106
msgid "Blue butterfly on a green leaf"
@@ -1122,28 +969,35 @@ msgstr "只读"
msgid "R/W"
msgstr "读/写"
-#: lib/Padre/Wx/FunctionList.pm:211
+#: lib/Padre/Wx/FunctionList.pm:216
msgid "Functions"
msgstr "函数"
-#: lib/Padre/Wx/Left.pm:51
+#: lib/Padre/Wx/Left.pm:52
msgid "Project Tools"
msgstr "工程工具"
-#: lib/Padre/Wx/Outline.pm:64
-#: lib/Padre/Wx/Outline.pm:128
+#: lib/Padre/Wx/Outline.pm:112 lib/Padre/Wx/Outline.pm:314
msgid "Outline"
msgstr "提纲"
-#: lib/Padre/Wx/Outline.pm:186
+#: lib/Padre/Wx/Outline.pm:222
+msgid "&Go to Element"
+msgstr "跳至元素(&G)"
+
+#: lib/Padre/Wx/Outline.pm:236
+msgid "Open &Documentation"
+msgstr "打开文档(&D)"
+
+#: lib/Padre/Wx/Outline.pm:353
msgid "Pragmata"
msgstr "编译选项"
-#: lib/Padre/Wx/Outline.pm:187
+#: lib/Padre/Wx/Outline.pm:354
msgid "Modules"
msgstr "模块"
-#: lib/Padre/Wx/Outline.pm:188
+#: lib/Padre/Wx/Outline.pm:355
msgid "Methods"
msgstr "方法"
@@ -1158,15 +1012,14 @@ msgstr "不是一个 Perl 文档"
#: lib/Padre/Wx/Debugger.pm:191
msgid ""
"The debugger is not running.\n"
-"You can start the debugger using one of the commands 'Step In', 'Step Over', or 'Run till Breakpoint' in the Debug menu."
+"You can start the debugger using one of the commands 'Step In', 'Step Over', "
+"or 'Run till Breakpoint' in the Debug menu."
msgstr ""
"调试器未运行。\n"
"您可以使用调试菜单中的“跨入”，“跨过”，或者“运行到断点”命令来启动调试器。"
-#: lib/Padre/Wx/Debugger.pm:193
-#: lib/Padre/Wx/Debugger.pm:299
-#: lib/Padre/Wx/Debugger.pm:325
-#: lib/Padre/Wx/Debugger.pm:365
+#: lib/Padre/Wx/Debugger.pm:193 lib/Padre/Wx/Debugger.pm:299
+#: lib/Padre/Wx/Debugger.pm:325 lib/Padre/Wx/Debugger.pm:365
#: lib/Padre/Wx/Debugger.pm:388
msgid "Debugger not running"
msgstr "调试器未运行"
@@ -1183,7 +1036,9 @@ msgstr "不能执行 '%s'"
#: lib/Padre/Wx/Debugger.pm:450
#, perl-format
-msgid "'%s' does not look like a variable. First select a variable in the code and then try again."
+msgid ""
+"'%s' does not look like a variable. First select a variable in the code and "
+"then try again."
msgstr "'%s' 看起来不像一个变量。 首先请在代码中选择一个变量，然后再试一次。"
#: lib/Padre/Wx/Debugger.pm:487
@@ -1199,8 +1054,7 @@ msgstr "表达式"
msgid "Find Results (%s)"
msgstr "查找结果 (%s)"
-#: lib/Padre/Wx/FindResult.pm:99
-#: lib/Padre/Wx/FindResult.pm:178
+#: lib/Padre/Wx/FindResult.pm:99 lib/Padre/Wx/FindResult.pm:178
msgid "Line No"
msgstr "行"
@@ -1208,111 +1062,66 @@ msgstr "行"
msgid "Related editor has been closed"
msgstr "相关的编辑窗已被关闭"
-#: lib/Padre/Wx/Output.pm:96
-msgid "Output"
-msgstr "输出"
-
-#: lib/Padre/Wx/Progress.pm:76
-msgid "Please wait..."
-msgstr "请等待..."
-
-#: lib/Padre/Wx/Directory/TreeCtrl.pm:537
-msgid "Please choose a different name."
-msgstr "请选择另一个名字"
-
-#: lib/Padre/Wx/Directory/TreeCtrl.pm:662
-msgid "A file with the same name already exists in this directory"
-msgstr "当前目录中已有相同名字的文件"
-
-#: lib/Padre/Wx/Directory/TreeCtrl.pm:676
-msgid "Move here"
-msgstr "移动到这里"
-
-#: lib/Padre/Wx/Directory/TreeCtrl.pm:687
-msgid "Copy here"
-msgstr "复制到这里"
-
-#: lib/Padre/Wx/Directory/TreeCtrl.pm:699
-#: lib/Padre/Wx/Dialog/RefactorSelectFunction.pm:126
-msgid "Cancel"
-msgstr "取消"
-
-#: lib/Padre/Wx/Directory/TreeCtrl.pm:728
-msgid "folder"
-msgstr "文件夹"
-
-#: lib/Padre/Wx/Directory/TreeCtrl.pm:738
-#: lib/Padre/Action/File.pm:120
-msgid "Open in File Browser"
-msgstr "在浏览器中打开文件"
-
-#: lib/Padre/Wx/Directory/TreeCtrl.pm:747
-msgid "Rename / Move"
-msgstr "重命名/移动"
-
-#: lib/Padre/Wx/Directory/TreeCtrl.pm:759
-msgid "Move to trash"
-msgstr "移动到回收站"
+#: lib/Padre/Wx/Browser.pm:66 lib/Padre/Wx/Dialog/QuickMenuAccess.pm:398
+#: lib/Padre/Action/Help.pm:37
+msgid "Help"
+msgstr "帮助"
-#: lib/Padre/Wx/Directory/TreeCtrl.pm:790
-#: lib/Padre/Wx/Directory/TreeCtrl.pm:798
-#: lib/Padre/Wx/Dialog/SessionManager.pm:290
-msgid "Delete"
-msgstr "删除"
+#: lib/Padre/Wx/Browser.pm:97 lib/Padre/Wx/Browser.pm:114
+msgid "Search for perldoc - e.g. Padre::Task, Net::LDAP"
+msgstr "搜索 perldoc, 例如 Padre::Task, Net::LDAP"
-#: lib/Padre/Wx/Directory/TreeCtrl.pm:797
-msgid "Are you sure you want to delete this item?"
-msgstr "您确认要删除该条目吗？"
+#: lib/Padre/Wx/Browser.pm:110
+msgid "Search:"
+msgstr "搜索:"
-#: lib/Padre/Wx/Directory/TreeCtrl.pm:838
-msgid "Show hidden files"
-msgstr "显示隐藏文件"
+#: lib/Padre/Wx/Browser.pm:347
+msgid "Untitled"
+msgstr "未命名"
-#: lib/Padre/Wx/Directory/TreeCtrl.pm:859
-#: lib/Padre/Wx/Menu/File.pm:169
-msgid "Reload"
-msgstr "重载"
+#: lib/Padre/Wx/Browser.pm:414
+#, perl-format
+msgid "Browser: no viewer for %s"
+msgstr "浏览器: 没有 %s 的查看工具"
-#: lib/Padre/Wx/Directory/SearchCtrl.pm:27
-#: lib/Padre/Wx/Dialog/Find.pm:332
-#: lib/Padre/Wx/Dialog/QuickMenuAccess.pm:389
-msgid "Search"
-msgstr "搜索"
+#: lib/Padre/Wx/Browser.pm:448
+#, perl-format
+msgid "Searched for '%s' and failed..."
+msgstr "查找 '%s' 失败 ..."
-#: lib/Padre/Wx/Directory/SearchCtrl.pm:401
-msgid "Skip hidden files"
-msgstr "跳过隐藏文件"
+#: lib/Padre/Wx/Browser.pm:449
+msgid "Help not found."
+msgstr "找不到帮助."
-#: lib/Padre/Wx/Directory/SearchCtrl.pm:416
-msgid "Skip CVS/.svn/.git/blib folders"
-msgstr "跳过 CVS/.svn/.git/blib 目录"
+#: lib/Padre/Wx/Browser.pm:470
+msgid "NAME"
+msgstr "名字"
-#: lib/Padre/Wx/Directory/SearchCtrl.pm:432
-msgid "Change project directory"
-msgstr "选择工程目录"
+#: lib/Padre/Wx/Output.pm:197
+msgid "Output"
+msgstr "输出"
-#: lib/Padre/Wx/Directory/SearchCtrl.pm:445
-msgid "Tree listing"
-msgstr "树形列表"
+#: lib/Padre/Wx/Progress.pm:76
+msgid "Please wait..."
+msgstr "请等待..."
-#: lib/Padre/Wx/Directory/SearchCtrl.pm:446
-msgid "Navigate"
-msgstr "Navigate"
+#: lib/Padre/Wx/Directory/TreeCtrl.pm:86
+msgid "Directory"
+msgstr "目录"
-#: lib/Padre/Wx/Directory/SearchCtrl.pm:447
-msgid "Change listing mode view"
-msgstr "改变列表显示视图"
+#: lib/Padre/Wx/Directory/TreeCtrl.pm:156 lib/Padre/Action/File.pm:120
+msgid "Open in File Browser"
+msgstr "在浏览器中打开文件"
-#: lib/Padre/Wx/Directory/SearchCtrl.pm:473
-msgid "Move to other panel"
-msgstr "移动到其他面板"
+#: lib/Padre/Wx/Directory/TreeCtrl.pm:165
+msgid "Refresh"
+msgstr "刷新"
#: lib/Padre/Wx/Dialog/Replace.pm:51
msgid "Find and Replace"
msgstr "查找并且替换"
-#: lib/Padre/Wx/Dialog/Replace.pm:81
-#: lib/Padre/Wx/Dialog/Find.pm:75
+#: lib/Padre/Wx/Dialog/Replace.pm:81 lib/Padre/Wx/Dialog/Find.pm:75
msgid "Case &sensitive"
msgstr "匹配大小写(&s)"
@@ -1320,13 +1129,11 @@ msgstr "匹配大小写(&s)"
msgid "Regular &Expression"
msgstr "正则表达式(&E)"
-#: lib/Padre/Wx/Dialog/Replace.pm:109
-#: lib/Padre/Wx/Dialog/Find.pm:103
+#: lib/Padre/Wx/Dialog/Replace.pm:109 lib/Padre/Wx/Dialog/Find.pm:103
msgid "Close Window on &Hit"
msgstr "点击时退出该窗口(&H)"
-#: lib/Padre/Wx/Dialog/Replace.pm:123
-#: lib/Padre/Wx/Dialog/Find.pm:117
+#: lib/Padre/Wx/Dialog/Replace.pm:123 lib/Padre/Wx/Dialog/Find.pm:117
msgid "Search &Backwards"
msgstr "向前搜索(&B)"
@@ -1342,8 +1149,7 @@ msgstr "查找(&F)"
msgid "&Replace"
msgstr "替换(&R)"
-#: lib/Padre/Wx/Dialog/Replace.pm:209
-#: lib/Padre/Wx/Dialog/Find.pm:53
+#: lib/Padre/Wx/Dialog/Replace.pm:209 lib/Padre/Wx/Dialog/Find.pm:53
#: lib/Padre/Wx/Dialog/Find.pm:177
msgid "Find"
msgstr "查找"
@@ -1360,19 +1166,16 @@ msgstr "替换"
msgid "Replace Text:"
msgstr "替换文本:"
-#: lib/Padre/Wx/Dialog/Replace.pm:295
-#: lib/Padre/Wx/Dialog/Find.pm:210
+#: lib/Padre/Wx/Dialog/Replace.pm:295 lib/Padre/Wx/Dialog/Find.pm:210
msgid "Options"
msgstr "选项"
-#: lib/Padre/Wx/Dialog/Replace.pm:535
-#: lib/Padre/Wx/Dialog/Replace.pm:584
+#: lib/Padre/Wx/Dialog/Replace.pm:535 lib/Padre/Wx/Dialog/Replace.pm:584
#: lib/Padre/Wx/Dialog/Find.pm:331
msgid "No matches found"
msgstr "找不到任何匹配"
-#: lib/Padre/Wx/Dialog/Replace.pm:536
-#: lib/Padre/Wx/Dialog/Replace.pm:580
+#: lib/Padre/Wx/Dialog/Replace.pm:536 lib/Padre/Wx/Dialog/Replace.pm:580
#: lib/Padre/Wx/Dialog/Replace.pm:585
msgid "Search and Replace"
msgstr "查找和替换"
@@ -1387,58 +1190,52 @@ msgstr "替换了 %d 处匹配"
msgid "Replaced %d matches"
msgstr "替换了 %d 处匹配"
-#: lib/Padre/Wx/Dialog/OpenResource.pm:90
+#: lib/Padre/Wx/Dialog/OpenResource.pm:72
msgid "Open Resource"
msgstr "打开资源"
-#: lib/Padre/Wx/Dialog/OpenResource.pm:127
+#: lib/Padre/Wx/Dialog/OpenResource.pm:112
msgid "Error while trying to perform Padre action"
msgstr "试图运行 Padre 动作时出错"
-#: lib/Padre/Wx/Dialog/OpenResource.pm:188
-#: lib/Padre/Wx/Dialog/OpenURL.pm:62
-#: lib/Padre/Wx/Dialog/Goto.pm:93
-#: lib/Padre/Wx/Dialog/QuickMenuAccess.pm:150
+#: lib/Padre/Wx/Dialog/OpenResource.pm:173 lib/Padre/Wx/Dialog/OpenURL.pm:62
+#: lib/Padre/Wx/Dialog/Goto.pm:93 lib/Padre/Wx/Dialog/QuickMenuAccess.pm:151
msgid "&OK"
msgstr "&OK"
-#: lib/Padre/Wx/Dialog/OpenResource.pm:192
-#: lib/Padre/Wx/Dialog/KeyBindings.pm:199
-#: lib/Padre/Wx/Dialog/Advanced.pm:174
-#: lib/Padre/Wx/Dialog/OpenURL.pm:70
-#: lib/Padre/Wx/Dialog/Goto.pm:100
-#: lib/Padre/Wx/Dialog/Preferences.pm:912
-#: lib/Padre/Wx/Dialog/QuickMenuAccess.pm:154
+#: lib/Padre/Wx/Dialog/OpenResource.pm:179
+#: lib/Padre/Wx/Dialog/KeyBindings.pm:199 lib/Padre/Wx/Dialog/Advanced.pm:174
+#: lib/Padre/Wx/Dialog/OpenURL.pm:70 lib/Padre/Wx/Dialog/Goto.pm:100
+#: lib/Padre/Wx/Dialog/Preferences.pm:926
+#: lib/Padre/Wx/Dialog/QuickMenuAccess.pm:155
msgid "&Cancel"
msgstr "取消(&C)"
-#: lib/Padre/Wx/Dialog/OpenResource.pm:213
+#: lib/Padre/Wx/Dialog/OpenResource.pm:201
msgid "&Select an item to open (? = any character, * = any string):"
msgstr "选择打开项目(&S) (? 代表任何字符，* 代表任何字符串）"
-#: lib/Padre/Wx/Dialog/OpenResource.pm:225
+#: lib/Padre/Wx/Dialog/OpenResource.pm:215
msgid "&Matching Items:"
msgstr "匹配项目：(&M)"
-#: lib/Padre/Wx/Dialog/OpenResource.pm:238
+#: lib/Padre/Wx/Dialog/OpenResource.pm:231
msgid "Current Directory: "
msgstr "当前目录："
-#: lib/Padre/Wx/Dialog/OpenResource.pm:264
+#: lib/Padre/Wx/Dialog/OpenResource.pm:258
msgid "Skip version control system files"
msgstr "跳过版本控制文件"
-#: lib/Padre/Wx/Dialog/OpenResource.pm:266
+#: lib/Padre/Wx/Dialog/OpenResource.pm:262
msgid "Skip using MANIFEST.SKIP"
msgstr "用 MANIFEST.SKIP 跳过文件"
-#: lib/Padre/Wx/Dialog/KeyBindings.pm:46
-#: lib/Padre/Action/Tools.pm:38
+#: lib/Padre/Wx/Dialog/KeyBindings.pm:46 lib/Padre/Action/Tools.pm:38
msgid "Key Bindings"
msgstr "按键组合"
-#: lib/Padre/Wx/Dialog/KeyBindings.pm:77
-#: lib/Padre/Wx/Dialog/Advanced.pm:93
+#: lib/Padre/Wx/Dialog/KeyBindings.pm:77 lib/Padre/Wx/Dialog/Advanced.pm:93
msgid "&Filter:"
msgstr "过滤(&F)"
@@ -1446,8 +1243,7 @@ msgstr "过滤(&F)"
msgid "Key binding name"
msgstr "组合键名字"
-#: lib/Padre/Wx/Dialog/KeyBindings.pm:91
-#: lib/Padre/Wx/Dialog/Shortcut.pm:113
+#: lib/Padre/Wx/Dialog/KeyBindings.pm:91 lib/Padre/Wx/Dialog/Shortcut.pm:113
msgid "Shortcut"
msgstr "快捷键"
@@ -1459,18 +1255,15 @@ msgstr "行为"
msgid "Sh&ortcut:"
msgstr "快捷键"
-#: lib/Padre/Wx/Dialog/KeyBindings.pm:181
-#: lib/Padre/Wx/Dialog/Advanced.pm:156
+#: lib/Padre/Wx/Dialog/KeyBindings.pm:181 lib/Padre/Wx/Dialog/Advanced.pm:156
msgid "&Set"
msgstr "设置(&S)"
-#: lib/Padre/Wx/Dialog/KeyBindings.pm:187
-#: lib/Padre/Wx/Dialog/Advanced.pm:162
+#: lib/Padre/Wx/Dialog/KeyBindings.pm:187 lib/Padre/Wx/Dialog/Advanced.pm:162
msgid "&Reset"
msgstr "重置(&R)"
-#: lib/Padre/Wx/Dialog/KeyBindings.pm:193
-#: lib/Padre/Wx/Dialog/Advanced.pm:168
+#: lib/Padre/Wx/Dialog/KeyBindings.pm:193 lib/Padre/Wx/Dialog/Advanced.pm:168
msgid "S&ave"
msgstr "保存(&A)"
@@ -1478,24 +1271,20 @@ msgstr "保存(&A)"
msgid "All"
msgstr "所有"
-#: lib/Padre/Wx/Dialog/Snippets.pm:22
-#: lib/Padre/Wx/Dialog/SpecialValues.pm:46
+#: lib/Padre/Wx/Dialog/Snippets.pm:22 lib/Padre/Wx/Dialog/SpecialValues.pm:46
msgid "Class:"
msgstr "类:"
-#: lib/Padre/Wx/Dialog/Snippets.pm:23
-#: lib/Padre/Wx/Dialog/Snippets.pm:113
+#: lib/Padre/Wx/Dialog/Snippets.pm:23 lib/Padre/Wx/Dialog/Snippets.pm:113
msgid "Snippet:"
msgstr "片断:"
-#: lib/Padre/Wx/Dialog/Snippets.pm:24
-#: lib/Padre/Wx/Dialog/RegexEditor.pm:234
+#: lib/Padre/Wx/Dialog/Snippets.pm:24 lib/Padre/Wx/Dialog/RegexEditor.pm:234
#: lib/Padre/Wx/Dialog/SpecialValues.pm:50
msgid "&Insert"
msgstr "插入(&I)"
-#: lib/Padre/Wx/Dialog/Snippets.pm:26
-#: lib/Padre/Wx/Menu/Edit.pm:344
+#: lib/Padre/Wx/Dialog/Snippets.pm:26 lib/Padre/Wx/Menu/Edit.pm:344
msgid "&Edit"
msgstr "编辑(&E)"
@@ -1515,8 +1304,7 @@ msgstr "种类:"
msgid "Name:"
msgstr "名字:"
-#: lib/Padre/Wx/Dialog/Snippets.pm:114
-#: lib/Padre/Wx/Dialog/Preferences.pm:890
+#: lib/Padre/Wx/Dialog/Snippets.pm:114 lib/Padre/Wx/Dialog/Preferences.pm:904
#: lib/Padre/Action/File.pm:285
msgid "&Save"
msgstr "保存(&S)"
@@ -1573,8 +1361,7 @@ msgstr "已有书签:"
msgid "Delete &All"
msgstr "删除所有(&A)"
-#: lib/Padre/Wx/Dialog/Bookmarks.pm:56
-#: lib/Padre/Action/View.pm:286
+#: lib/Padre/Wx/Dialog/Bookmarks.pm:56 lib/Padre/Action/View.pm:286
msgid "Set Bookmark"
msgstr "设置书签"
@@ -1596,8 +1383,7 @@ msgstr "%s 行 %s: %s"
msgid "The bookmark '%s' no longer exists"
msgstr "书签 '%s' 不存在"
-#: lib/Padre/Wx/Dialog/DocStats.pm:31
-#: lib/Padre/Action/File.pm:410
+#: lib/Padre/Wx/Dialog/DocStats.pm:31 lib/Padre/Action/File.pm:410
msgid "Document Statistics"
msgstr "文档统计"
@@ -1683,12 +1469,14 @@ msgstr "自动保存会话"
msgid "Open"
msgstr "打开"
+#: lib/Padre/Wx/Dialog/SessionManager.pm:290
+msgid "Delete"
+msgstr "删除"
+
#: lib/Padre/Wx/Dialog/SessionManager.pm:291
-#: lib/Padre/Wx/Dialog/FilterTool.pm:152
-#: lib/Padre/Wx/Dialog/WindowList.pm:282
+#: lib/Padre/Wx/Dialog/FilterTool.pm:152 lib/Padre/Wx/Dialog/WindowList.pm:282
#: lib/Padre/Wx/Dialog/PluginManager.pm:145
-#: lib/Padre/Wx/Dialog/SessionSave.pm:230
-#: lib/Padre/Wx/Menu/File.pm:130
+#: lib/Padre/Wx/Dialog/SessionSave.pm:230 lib/Padre/Wx/Menu/File.pm:132
msgid "Close"
msgstr "关闭"
@@ -1720,15 +1508,12 @@ msgstr "高级设置"
msgid "Preference Name"
msgstr "选项名字"
-#: lib/Padre/Wx/Dialog/Advanced.pm:107
-#: lib/Padre/Wx/Dialog/PluginManager.pm:68
-#: lib/Padre/Wx/CPAN/Listview.pm:32
-#: lib/Padre/Wx/CPAN/Listview.pm:64
+#: lib/Padre/Wx/Dialog/Advanced.pm:107 lib/Padre/Wx/Dialog/PluginManager.pm:68
+#: lib/Padre/Wx/CPAN/Listview.pm:32 lib/Padre/Wx/CPAN/Listview.pm:64
msgid "Status"
msgstr "状态"
-#: lib/Padre/Wx/Dialog/Advanced.pm:109
-#: lib/Padre/Wx/Debugger/View.pm:103
+#: lib/Padre/Wx/Dialog/Advanced.pm:109 lib/Padre/Wx/Debugger/View.pm:103
msgid "Value"
msgstr "值"
@@ -1744,13 +1529,11 @@ msgstr "复制名字"
msgid "Copy Value"
msgstr "复制值"
-#: lib/Padre/Wx/Dialog/Advanced.pm:125
-#: lib/Padre/Wx/Dialog/Advanced.pm:562
+#: lib/Padre/Wx/Dialog/Advanced.pm:125 lib/Padre/Wx/Dialog/Advanced.pm:562
msgid "True"
msgstr "真"
-#: lib/Padre/Wx/Dialog/Advanced.pm:126
-#: lib/Padre/Wx/Dialog/Advanced.pm:563
+#: lib/Padre/Wx/Dialog/Advanced.pm:126 lib/Padre/Wx/Dialog/Advanced.pm:563
msgid "False"
msgstr "假"
@@ -1762,8 +1545,7 @@ msgstr "默认值:"
msgid "Options:"
msgstr "选项:"
-#: lib/Padre/Wx/Dialog/Advanced.pm:399
-#: lib/Padre/Wx/Dialog/Preferences.pm:778
+#: lib/Padre/Wx/Dialog/Advanced.pm:399 lib/Padre/Wx/Dialog/Preferences.pm:792
msgid "Default"
msgstr "默认"
@@ -1775,8 +1557,7 @@ msgstr "用户"
msgid "Host"
msgstr "主机"
-#: lib/Padre/Wx/Dialog/Shortcut.pm:32
-#: lib/Padre/Wx/Dialog/Form.pm:32
+#: lib/Padre/Wx/Dialog/Shortcut.pm:32 lib/Padre/Wx/Dialog/Form.pm:32
#: lib/Padre/Wx/Dialog/Warning.pm:32
msgid "A Dialog"
msgstr "一个对话框"
@@ -1790,8 +1571,7 @@ msgstr "行为: %s"
msgid "CTRL"
msgstr "Ctrl"
-#: lib/Padre/Wx/Dialog/Shortcut.pm:61
-#: lib/Padre/Wx/Dialog/Shortcut.pm:75
+#: lib/Padre/Wx/Dialog/Shortcut.pm:61 lib/Padre/Wx/Dialog/Shortcut.pm:75
#: lib/Padre/Wx/Dialog/Shortcut.pm:89
msgid "+"
msgstr "+"
@@ -1813,8 +1593,7 @@ msgid "Filter command:"
msgstr "过滤命令:"
#: lib/Padre/Wx/Dialog/FilterTool.pm:151
-#: lib/Padre/Wx/Dialog/QuickMenuAccess.pm:393
-#: lib/Padre/Document/Perl.pm:289
+#: lib/Padre/Wx/Dialog/QuickMenuAccess.pm:394 lib/Padre/Document/Perl.pm:311
msgid "Run"
msgstr "运行"
@@ -1828,7 +1607,7 @@ msgstr "列出打开的文件"
#: lib/Padre/Wx/Dialog/WindowList.pm:226
#: lib/Padre/Wx/Dialog/SpecialValues.pm:21
-#: lib/Padre/Wx/Dialog/QuickMenuAccess.pm:387
+#: lib/Padre/Wx/Dialog/QuickMenuAccess.pm:388
msgid "File"
msgstr "文件(&F)"
@@ -1840,13 +1619,11 @@ msgstr "编辑器"
msgid "Disk"
msgstr "磁盘"
-#: lib/Padre/Wx/Dialog/WindowList.pm:349
-#: lib/Padre/Wx/Dialog/WindowList.pm:358
+#: lib/Padre/Wx/Dialog/WindowList.pm:349 lib/Padre/Wx/Dialog/WindowList.pm:358
msgid "CHANGED"
msgstr "己改动"
-#: lib/Padre/Wx/Dialog/WindowList.pm:349
-#: lib/Padre/Wx/Dialog/WindowList.pm:354
+#: lib/Padre/Wx/Dialog/WindowList.pm:349 lib/Padre/Wx/Dialog/WindowList.pm:354
msgid "fresh"
msgstr "最新的"
@@ -1885,8 +1662,11 @@ msgstr "函数"
msgid "Select"
msgstr "选择"
-#: lib/Padre/Wx/Dialog/PluginManager.pm:35
-#: lib/Padre/Action/Tools.pm:48
+#: lib/Padre/Wx/Dialog/RefactorSelectFunction.pm:126
+msgid "Cancel"
+msgstr "取消"
+
+#: lib/Padre/Wx/Dialog/PluginManager.pm:35 lib/Padre/Action/Tools.pm:48
msgid "Plug-in Manager"
msgstr "插件管理器"
@@ -1899,37 +1679,34 @@ msgid "Plug-in Name"
msgstr "插件名称"
#: lib/Padre/Wx/Dialog/PluginManager.pm:117
-#: lib/Padre/Wx/Dialog/PluginManager.pm:517
+#: lib/Padre/Wx/Dialog/PluginManager.pm:519
msgid "Enable"
msgstr "启用"
#: lib/Padre/Wx/Dialog/PluginManager.pm:131
-#: lib/Padre/Wx/Dialog/Preferences.pm:801
-#: lib/Padre/Action/Edit.pm:621
+#: lib/Padre/Wx/Dialog/Preferences.pm:815 lib/Padre/Action/Edit.pm:621
msgid "Preferences"
msgstr "选项"
-#: lib/Padre/Wx/Dialog/PluginManager.pm:243
+#: lib/Padre/Wx/Dialog/PluginManager.pm:245
#, perl-format
msgid "Error loading pod for class '%s': %s"
msgstr "为类 '%s' 载入 pod 时错误: %s"
-#: lib/Padre/Wx/Dialog/PluginManager.pm:478
-#: lib/Padre/Wx/Dialog/PluginManager.pm:490
+#: lib/Padre/Wx/Dialog/PluginManager.pm:480
+#: lib/Padre/Wx/Dialog/PluginManager.pm:492
msgid "Show error message"
msgstr "显示错误消息"
-#: lib/Padre/Wx/Dialog/PluginManager.pm:505
+#: lib/Padre/Wx/Dialog/PluginManager.pm:507
msgid "Disable"
msgstr "禁用"
-#: lib/Padre/Wx/Dialog/HelpSearch.pm:39
-#: lib/Padre/Wx/Dialog/HelpSearch.pm:96
+#: lib/Padre/Wx/Dialog/HelpSearch.pm:39 lib/Padre/Wx/Dialog/HelpSearch.pm:96
msgid "Help Search"
msgstr "帮助搜索"
-#: lib/Padre/Wx/Dialog/HelpSearch.pm:81
-#: lib/Padre/Wx/Dialog/HelpSearch.pm:307
+#: lib/Padre/Wx/Dialog/HelpSearch.pm:81 lib/Padre/Wx/Dialog/HelpSearch.pm:307
#: lib/Padre/Wx/Dialog/HelpSearch.pm:325
#, perl-format
msgid "Error while calling %s %s"
@@ -1981,7 +1758,7 @@ msgid "Session name:"
msgstr "会话名称:"
#: lib/Padre/Wx/Dialog/SessionSave.pm:209
-#: lib/Padre/Wx/Dialog/Preferences.pm:150
+#: lib/Padre/Wx/Dialog/Preferences.pm:164
msgid "Description:"
msgstr "描述:"
@@ -1997,15 +1774,12 @@ msgstr "跳至"
msgid "Position type"
msgstr "位置类型"
-#: lib/Padre/Wx/Dialog/Goto.pm:88
-#: lib/Padre/Wx/Dialog/Goto.pm:193
-#: lib/Padre/Wx/Dialog/Goto.pm:223
-#: lib/Padre/Wx/Dialog/Goto.pm:242
+#: lib/Padre/Wx/Dialog/Goto.pm:88 lib/Padre/Wx/Dialog/Goto.pm:193
+#: lib/Padre/Wx/Dialog/Goto.pm:223 lib/Padre/Wx/Dialog/Goto.pm:242
msgid "Line number"
msgstr "行号"
-#: lib/Padre/Wx/Dialog/Goto.pm:88
-#: lib/Padre/Wx/Dialog/Goto.pm:227
+#: lib/Padre/Wx/Dialog/Goto.pm:88 lib/Padre/Wx/Dialog/Goto.pm:227
msgid "Character position"
msgstr "字符位置"
@@ -2144,8 +1918,7 @@ msgstr ""
"生成 '%s' 时发生错误:\n"
"%s"
-#: lib/Padre/Wx/Dialog/RegexEditor.pm:33
-#: lib/Padre/Action/Edit.pm:589
+#: lib/Padre/Wx/Dialog/RegexEditor.pm:33 lib/Padre/Action/Edit.pm:589
msgid "Regex Editor"
msgstr "正则表达式编辑器"
@@ -2386,7 +2159,7 @@ msgstr "全局匹配(%s)"
#: lib/Padre/Wx/Dialog/RegexEditor.pm:479
#, perl-format
msgid "Match failure in %s: %s"
-msgstr "在 %s 中匹配错误: %s"
+msgstr "在 %s 中匹配失败: %s"
#: lib/Padre/Wx/Dialog/RegexEditor.pm:486
#, perl-format
@@ -2397,39 +2170,44 @@ msgstr "在 %s 中匹配警告: %s"
msgid "No match"
msgstr "无任何匹配"
-#: lib/Padre/Wx/Dialog/WhereFrom.pm:23
+#: lib/Padre/Wx/Dialog/RegexEditor.pm:519
+#, perl-format
+msgid "Replace failure in %s: %s"
+msgstr "在 %s 中替换失败: %s"
+
+#: lib/Padre/Wx/Dialog/WhereFrom.pm:34
msgid "New installation survey"
msgstr "新安装以观望"
-#: lib/Padre/Wx/Dialog/WhereFrom.pm:59
+#: lib/Padre/Wx/Dialog/WhereFrom.pm:84
msgid "Where did you hear about Padre?"
msgstr "您是从哪儿听说 Padre 的?"
-#: lib/Padre/Wx/Dialog/WhereFrom.pm:64
+#: lib/Padre/Wx/Dialog/WhereFrom.pm:89
msgid "Other search engine"
msgstr "其它搜索引擎"
-#: lib/Padre/Wx/Dialog/WhereFrom.pm:67
+#: lib/Padre/Wx/Dialog/WhereFrom.pm:92
msgid "Other event"
msgstr "其它事件"
-#: lib/Padre/Wx/Dialog/WhereFrom.pm:68
+#: lib/Padre/Wx/Dialog/WhereFrom.pm:93
msgid "Friend"
msgstr "朋有"
-#: lib/Padre/Wx/Dialog/WhereFrom.pm:69
+#: lib/Padre/Wx/Dialog/WhereFrom.pm:94
msgid "Reinstalling/installing on other computer"
msgstr "在其它计算机上(再次)安装"
-#: lib/Padre/Wx/Dialog/WhereFrom.pm:70
+#: lib/Padre/Wx/Dialog/WhereFrom.pm:95
msgid "Other (Please fill in here)"
msgstr "其它（请在此填写）"
-#: lib/Padre/Wx/Dialog/WhereFrom.pm:84
+#: lib/Padre/Wx/Dialog/WhereFrom.pm:109
msgid "OK"
msgstr "确定"
-#: lib/Padre/Wx/Dialog/WhereFrom.pm:91
+#: lib/Padre/Wx/Dialog/WhereFrom.pm:116
msgid "Skip question without giving feedback"
msgstr "跳过询问, 不给予反馈"
@@ -2461,201 +2239,202 @@ msgstr "改变文字大小"
msgid "Enable session manager"
msgstr "启用会话管理"
-#: lib/Padre/Wx/Dialog/Preferences.pm:71
+#: lib/Padre/Wx/Dialog/Preferences.pm:85
msgid "Diff tool:"
msgstr "Diff 工具:"
-#: lib/Padre/Wx/Dialog/Preferences.pm:73
-#: lib/Padre/Wx/Dialog/Preferences.pm:77
+#: lib/Padre/Wx/Dialog/Preferences.pm:87 lib/Padre/Wx/Dialog/Preferences.pm:91
msgid "Browse..."
msgstr "浏览..."
-#: lib/Padre/Wx/Dialog/Preferences.pm:75
+#: lib/Padre/Wx/Dialog/Preferences.pm:89
msgid "Perl ctags file:"
msgstr "Perl ctags 文件:"
-#: lib/Padre/Wx/Dialog/Preferences.pm:144
+#: lib/Padre/Wx/Dialog/Preferences.pm:158
msgid "File type:"
msgstr "文件类型："
-#: lib/Padre/Wx/Dialog/Preferences.pm:147
+#: lib/Padre/Wx/Dialog/Preferences.pm:161
msgid "Highlighter:"
msgstr "加亮器："
-#: lib/Padre/Wx/Dialog/Preferences.pm:153
+#: lib/Padre/Wx/Dialog/Preferences.pm:167
msgid "Content type:"
msgstr "文档类型："
-#: lib/Padre/Wx/Dialog/Preferences.pm:245
+#: lib/Padre/Wx/Dialog/Preferences.pm:259
msgid "Automatic indentation style detection"
msgstr "自动缩进风格检测"
-#: lib/Padre/Wx/Dialog/Preferences.pm:249
+#: lib/Padre/Wx/Dialog/Preferences.pm:263
msgid "Use Tabs"
msgstr "使用标签"
-#: lib/Padre/Wx/Dialog/Preferences.pm:252
+#: lib/Padre/Wx/Dialog/Preferences.pm:266
msgid "Tab display size (in spaces):"
msgstr "TAB 显示长度（以空格算）:"
-#: lib/Padre/Wx/Dialog/Preferences.pm:255
+#: lib/Padre/Wx/Dialog/Preferences.pm:269
msgid "Indentation width (in columns):"
msgstr "缩进宽度 (以列算)："
-#: lib/Padre/Wx/Dialog/Preferences.pm:258
+#: lib/Padre/Wx/Dialog/Preferences.pm:272
msgid "Guess from current document:"
msgstr "从当前文档猜测:"
-#: lib/Padre/Wx/Dialog/Preferences.pm:259
+#: lib/Padre/Wx/Dialog/Preferences.pm:273
msgid "Guess"
msgstr "猜测"
-#: lib/Padre/Wx/Dialog/Preferences.pm:261
+#: lib/Padre/Wx/Dialog/Preferences.pm:275
msgid "Autoindent:"
msgstr "自动缩进:"
-#: lib/Padre/Wx/Dialog/Preferences.pm:285
+#: lib/Padre/Wx/Dialog/Preferences.pm:299
msgid "Default word wrap on for each file"
msgstr "默认对所有文件开启换行"
-#: lib/Padre/Wx/Dialog/Preferences.pm:290
+#: lib/Padre/Wx/Dialog/Preferences.pm:304
msgid "Use panel order for Ctrl-Tab (not usage history)"
msgstr "为 Ctrl-Tab 使用面板顺序 (而非使用历史)"
# 尚未实现?
-#: lib/Padre/Wx/Dialog/Preferences.pm:297
+#: lib/Padre/Wx/Dialog/Preferences.pm:311
msgid "Clean up file content on saving (for supported document types)"
msgstr "存储时清理文件内容 （对于支持的文档类型）"
-#: lib/Padre/Wx/Dialog/Preferences.pm:302
+#: lib/Padre/Wx/Dialog/Preferences.pm:316
msgid "Auto-fold POD markup when code folding enabled"
msgstr "当代码启动开展时自动开展 POD 标志"
-#: lib/Padre/Wx/Dialog/Preferences.pm:307
+#: lib/Padre/Wx/Dialog/Preferences.pm:321
msgid "Perl beginner mode"
msgstr "Perl 初学者模式"
-#: lib/Padre/Wx/Dialog/Preferences.pm:311
+#: lib/Padre/Wx/Dialog/Preferences.pm:325
msgid "Open files:"
msgstr "打开文件:"
-#: lib/Padre/Wx/Dialog/Preferences.pm:314
+#: lib/Padre/Wx/Dialog/Preferences.pm:328
msgid "Default projects directory:"
msgstr "默认工程目录："
-#: lib/Padre/Wx/Dialog/Preferences.pm:316
+#: lib/Padre/Wx/Dialog/Preferences.pm:330
msgid "Choose the default projects directory"
msgstr "选择工程的默认目录"
-#: lib/Padre/Wx/Dialog/Preferences.pm:320
+#: lib/Padre/Wx/Dialog/Preferences.pm:334
msgid "Open files in existing Padre"
msgstr "在已运行 Padre 中打开文件"
-#: lib/Padre/Wx/Dialog/Preferences.pm:324
+#: lib/Padre/Wx/Dialog/Preferences.pm:338
msgid "Methods order:"
msgstr "函数顺序"
-#: lib/Padre/Wx/Dialog/Preferences.pm:327
+#: lib/Padre/Wx/Dialog/Preferences.pm:341
msgid "Preferred language for error diagnostics:"
msgstr "错误诊断的首选语言:"
-#: lib/Padre/Wx/Dialog/Preferences.pm:330
+#: lib/Padre/Wx/Dialog/Preferences.pm:344
msgid "Default line ending:"
msgstr "默认行尾："
-#: lib/Padre/Wx/Dialog/Preferences.pm:333
+#: lib/Padre/Wx/Dialog/Preferences.pm:347
msgid "Check for file updates on disk every (seconds):"
msgstr "检查磁盘文件更新频率（秒）："
-#: lib/Padre/Wx/Dialog/Preferences.pm:342
-msgid "Add another closing bracket if there is already one (and the auto-bracket-function is enabled)"
+#: lib/Padre/Wx/Dialog/Preferences.pm:356
+msgid ""
+"Add another closing bracket if there is already one (and the auto-bracket-"
+"function is enabled)"
msgstr "当前已经匹配时视图加入另外的关闭括号（自动括号功能已开启）"
-#: lib/Padre/Wx/Dialog/Preferences.pm:349
+#: lib/Padre/Wx/Dialog/Preferences.pm:363
msgid "Enable Smart highlighting while typing"
msgstr "开启输入过程中的智能加亮"
-#: lib/Padre/Wx/Dialog/Preferences.pm:356
+#: lib/Padre/Wx/Dialog/Preferences.pm:370
msgid "Shorten the common path in window list"
msgstr "在窗口列表中缩短路径"
-#: lib/Padre/Wx/Dialog/Preferences.pm:363
+#: lib/Padre/Wx/Dialog/Preferences.pm:377
msgid "Use X11 middle button paste style"
msgstr "使用 X11 中键粘帖的风格"
-#: lib/Padre/Wx/Dialog/Preferences.pm:367
+#: lib/Padre/Wx/Dialog/Preferences.pm:381
msgid "RegExp for TODO-panel:"
msgstr "待办(TODO)面版所用正则表达式:"
-#: lib/Padre/Wx/Dialog/Preferences.pm:373
+#: lib/Padre/Wx/Dialog/Preferences.pm:387
msgid "Use Splash Screen"
msgstr "使用启动画面"
-#: lib/Padre/Wx/Dialog/Preferences.pm:410
+#: lib/Padre/Wx/Dialog/Preferences.pm:424
msgid "Project name"
msgstr "工程名"
-#: lib/Padre/Wx/Dialog/Preferences.pm:411
+#: lib/Padre/Wx/Dialog/Preferences.pm:425
msgid "Padre version"
msgstr "Padre 版本"
-#: lib/Padre/Wx/Dialog/Preferences.pm:412
+#: lib/Padre/Wx/Dialog/Preferences.pm:426
msgid "Current filename"
msgstr "当前文件名"
-#: lib/Padre/Wx/Dialog/Preferences.pm:413
+#: lib/Padre/Wx/Dialog/Preferences.pm:427
msgid "Current file's dirname"
msgstr "当前文件目录名"
-#: lib/Padre/Wx/Dialog/Preferences.pm:414
+#: lib/Padre/Wx/Dialog/Preferences.pm:428
msgid "Current file's basename"
msgstr "当前文件的基础名"
-#: lib/Padre/Wx/Dialog/Preferences.pm:415
+#: lib/Padre/Wx/Dialog/Preferences.pm:429
msgid "Current filename relative to project"
msgstr "当前文档在工程中的相对文件名"
-#: lib/Padre/Wx/Dialog/Preferences.pm:436
+#: lib/Padre/Wx/Dialog/Preferences.pm:450
msgid "Window title:"
msgstr "窗口标题:"
-#: lib/Padre/Wx/Dialog/Preferences.pm:443
+#: lib/Padre/Wx/Dialog/Preferences.pm:457
msgid "Colored text in output window (ANSI)"
msgstr "输出加色的文字 (ANSI)"
-#: lib/Padre/Wx/Dialog/Preferences.pm:448
+#: lib/Padre/Wx/Dialog/Preferences.pm:462
msgid "Show low-priority info messages on statusbar (not in a popup)"
msgstr "在状态栏上显示低优先级的信息 (而非弹出窗口)"
-#: lib/Padre/Wx/Dialog/Preferences.pm:453
+#: lib/Padre/Wx/Dialog/Preferences.pm:467
msgid "Show right margin at column:"
msgstr "显示右间距（行）："
-#: lib/Padre/Wx/Dialog/Preferences.pm:457
+#: lib/Padre/Wx/Dialog/Preferences.pm:471
msgid "Editor Font:"
msgstr "编辑窗字体:"
-#: lib/Padre/Wx/Dialog/Preferences.pm:460
+#: lib/Padre/Wx/Dialog/Preferences.pm:474
msgid "Editor Current Line Background Colour:"
msgstr "当前编辑窗的行背景色:"
-#: lib/Padre/Wx/Dialog/Preferences.pm:523
+#: lib/Padre/Wx/Dialog/Preferences.pm:537
msgid "Settings Demo"
msgstr "演示"
-#: lib/Padre/Wx/Dialog/Preferences.pm:532
+#: lib/Padre/Wx/Dialog/Preferences.pm:546
msgid "Any changes to these options require a restart:"
msgstr "如下选项的更改需要重启："
-#: lib/Padre/Wx/Dialog/Preferences.pm:643
+#: lib/Padre/Wx/Dialog/Preferences.pm:657
msgid "Enable?"
msgstr "启用?"
-#: lib/Padre/Wx/Dialog/Preferences.pm:658
+#: lib/Padre/Wx/Dialog/Preferences.pm:672
msgid "Crashed"
msgstr "已崩溃"
-#: lib/Padre/Wx/Dialog/Preferences.pm:691
+#: lib/Padre/Wx/Dialog/Preferences.pm:705
msgid ""
"i.e.\n"
"\tinclude directory: -I<dir>\n"
@@ -2671,118 +2450,118 @@ msgstr ""
"\t启用所有警告: -W\n"
"\t禁用所有警告: -X\n"
-#: lib/Padre/Wx/Dialog/Preferences.pm:701
+#: lib/Padre/Wx/Dialog/Preferences.pm:715
msgid "Perl interpreter:"
msgstr "Perl 解释器:"
-#: lib/Padre/Wx/Dialog/Preferences.pm:704
-#: lib/Padre/Wx/Dialog/Preferences.pm:754
+#: lib/Padre/Wx/Dialog/Preferences.pm:718
+#: lib/Padre/Wx/Dialog/Preferences.pm:768
msgid "Interpreter arguments:"
msgstr "解释器参数"
-#: lib/Padre/Wx/Dialog/Preferences.pm:710
-#: lib/Padre/Wx/Dialog/Preferences.pm:760
+#: lib/Padre/Wx/Dialog/Preferences.pm:724
+#: lib/Padre/Wx/Dialog/Preferences.pm:774
msgid "Script arguments:"
msgstr "程序参数"
-#: lib/Padre/Wx/Dialog/Preferences.pm:714
+#: lib/Padre/Wx/Dialog/Preferences.pm:728
msgid "Use external window for execution"
msgstr "使用外部窗口来运行"
-#: lib/Padre/Wx/Dialog/Preferences.pm:723
+#: lib/Padre/Wx/Dialog/Preferences.pm:737
msgid "Unsaved"
msgstr "未保存"
-#: lib/Padre/Wx/Dialog/Preferences.pm:724
+#: lib/Padre/Wx/Dialog/Preferences.pm:738
msgid "N/A"
msgstr "N/A"
-#: lib/Padre/Wx/Dialog/Preferences.pm:743
+#: lib/Padre/Wx/Dialog/Preferences.pm:757
msgid "No Document"
msgstr "没有文档"
-#: lib/Padre/Wx/Dialog/Preferences.pm:748
+#: lib/Padre/Wx/Dialog/Preferences.pm:762
msgid "Document name:"
msgstr "文档名字:"
-#: lib/Padre/Wx/Dialog/Preferences.pm:751
+#: lib/Padre/Wx/Dialog/Preferences.pm:765
msgid "Document location:"
msgstr "文档位置:"
-#: lib/Padre/Wx/Dialog/Preferences.pm:784
+#: lib/Padre/Wx/Dialog/Preferences.pm:798
#, perl-format
msgid "Current Document: %s"
msgstr "当前文档: %s"
-#: lib/Padre/Wx/Dialog/Preferences.pm:827
+#: lib/Padre/Wx/Dialog/Preferences.pm:841
msgid "Behaviour"
msgstr "行为"
-#: lib/Padre/Wx/Dialog/Preferences.pm:830
+#: lib/Padre/Wx/Dialog/Preferences.pm:844
msgid "Appearance"
msgstr "外观"
-#: lib/Padre/Wx/Dialog/Preferences.pm:834
+#: lib/Padre/Wx/Dialog/Preferences.pm:848
msgid "Run Parameters"
msgstr "运行参数"
-#: lib/Padre/Wx/Dialog/Preferences.pm:838
+#: lib/Padre/Wx/Dialog/Preferences.pm:852
msgid "Files and Colors"
msgstr "文件和颜色"
-#: lib/Padre/Wx/Dialog/Preferences.pm:841
+#: lib/Padre/Wx/Dialog/Preferences.pm:855
msgid "Indentation"
msgstr "缩进"
-#: lib/Padre/Wx/Dialog/Preferences.pm:844
+#: lib/Padre/Wx/Dialog/Preferences.pm:858
msgid "External Tools"
msgstr "外部工具"
-#: lib/Padre/Wx/Dialog/Preferences.pm:899
+#: lib/Padre/Wx/Dialog/Preferences.pm:913
msgid "&Advanced..."
msgstr "高级(&A)..."
-#: lib/Padre/Wx/Dialog/Preferences.pm:947
+#: lib/Padre/Wx/Dialog/Preferences.pm:961
msgid "new"
msgstr "新建"
-#: lib/Padre/Wx/Dialog/Preferences.pm:948
+#: lib/Padre/Wx/Dialog/Preferences.pm:962
msgid "nothing"
msgstr "无"
-#: lib/Padre/Wx/Dialog/Preferences.pm:949
+#: lib/Padre/Wx/Dialog/Preferences.pm:963
msgid "last"
msgstr "最后"
-#: lib/Padre/Wx/Dialog/Preferences.pm:950
+#: lib/Padre/Wx/Dialog/Preferences.pm:964
msgid "session"
msgstr "会话"
-#: lib/Padre/Wx/Dialog/Preferences.pm:951
+#: lib/Padre/Wx/Dialog/Preferences.pm:965
msgid "no"
msgstr "不"
-#: lib/Padre/Wx/Dialog/Preferences.pm:952
+#: lib/Padre/Wx/Dialog/Preferences.pm:966
msgid "same_level"
msgstr "相同层次"
-#: lib/Padre/Wx/Dialog/Preferences.pm:953
+#: lib/Padre/Wx/Dialog/Preferences.pm:967
msgid "deep"
msgstr "深度"
-#: lib/Padre/Wx/Dialog/Preferences.pm:954
+#: lib/Padre/Wx/Dialog/Preferences.pm:968
msgid "alphabetical"
msgstr "按字母排序"
-#: lib/Padre/Wx/Dialog/Preferences.pm:955
+#: lib/Padre/Wx/Dialog/Preferences.pm:969
msgid "original"
msgstr "按原始位置排序"
-#: lib/Padre/Wx/Dialog/Preferences.pm:956
+#: lib/Padre/Wx/Dialog/Preferences.pm:970
msgid "alphabetical_private_last"
msgstr "按字母排序（私有最后）"
-#: lib/Padre/Wx/Dialog/Preferences.pm:1117
+#: lib/Padre/Wx/Dialog/Preferences.pm:1131
msgid "Save settings"
msgstr "保存设置"
@@ -2822,52 +2601,52 @@ msgstr "特殊值："
msgid "Insert Special Values"
msgstr "插入特殊值"
-#: lib/Padre/Wx/Dialog/QuickMenuAccess.pm:38
+#: lib/Padre/Wx/Dialog/QuickMenuAccess.pm:39
msgid "Quick Menu Access"
msgstr "菜单快捷通道"
-#: lib/Padre/Wx/Dialog/QuickMenuAccess.pm:88
+#: lib/Padre/Wx/Dialog/QuickMenuAccess.pm:89
#, perl-format
msgid "Error while trying to perform Padre action: %s"
msgstr "试图运行 Padre 动作时出错: %s"
-#: lib/Padre/Wx/Dialog/QuickMenuAccess.pm:175
+#: lib/Padre/Wx/Dialog/QuickMenuAccess.pm:176
msgid "&Type a menu item name to access:"
msgstr "输入菜单名字：(&T)"
-#: lib/Padre/Wx/Dialog/QuickMenuAccess.pm:182
+#: lib/Padre/Wx/Dialog/QuickMenuAccess.pm:183
msgid "&Matching Menu Items:"
msgstr "匹配菜单选项：(&M)"
-#: lib/Padre/Wx/Dialog/QuickMenuAccess.pm:351
+#: lib/Padre/Wx/Dialog/QuickMenuAccess.pm:352
msgid "Reading items. Please wait..."
msgstr "读取选项。请等待..."
-#: lib/Padre/Wx/Dialog/QuickMenuAccess.pm:388
+#: lib/Padre/Wx/Dialog/QuickMenuAccess.pm:389
msgid "Edit"
msgstr "编辑(&E)"
-#: lib/Padre/Wx/Dialog/QuickMenuAccess.pm:390
+#: lib/Padre/Wx/Dialog/QuickMenuAccess.pm:391
msgid "View"
msgstr "视图(&V)"
-#: lib/Padre/Wx/Dialog/QuickMenuAccess.pm:391
+#: lib/Padre/Wx/Dialog/QuickMenuAccess.pm:392
msgid "Perl"
msgstr "&Perl"
-#: lib/Padre/Wx/Dialog/QuickMenuAccess.pm:392
+#: lib/Padre/Wx/Dialog/QuickMenuAccess.pm:393
msgid "Refactor"
msgstr "重构"
-#: lib/Padre/Wx/Dialog/QuickMenuAccess.pm:394
+#: lib/Padre/Wx/Dialog/QuickMenuAccess.pm:395
msgid "Debug"
msgstr "调试"
-#: lib/Padre/Wx/Dialog/QuickMenuAccess.pm:395
+#: lib/Padre/Wx/Dialog/QuickMenuAccess.pm:396
msgid "Plugins"
msgstr "插件(&u)"
-#: lib/Padre/Wx/Dialog/QuickMenuAccess.pm:396
+#: lib/Padre/Wx/Dialog/QuickMenuAccess.pm:397
msgid "Window"
msgstr "窗口(&W)"
@@ -2973,8 +2752,7 @@ msgstr "Ultraedit"
msgid "Notepad++"
msgstr "Notepad++"
-#: lib/Padre/Wx/Menu/View.pm:213
-#: lib/Padre/Wx/Menu/View.pm:237
+#: lib/Padre/Wx/Menu/View.pm:213 lib/Padre/Wx/Menu/View.pm:237
#, perl-format
msgid "Switch highlighting colors to %s style"
msgstr "高亮颜色改变为 %s 风格"
@@ -3001,32 +2779,36 @@ msgstr "切换菜单到 %s"
msgid "&View"
msgstr "视图(&V)"
-#: lib/Padre/Wx/Menu/Refactor.pm:61
+#: lib/Padre/Wx/Menu/Refactor.pm:60
msgid "Ref&actor"
msgstr "重构(&A)"
-#: lib/Padre/Wx/Menu/File.pm:42
+#: lib/Padre/Wx/Menu/File.pm:44
msgid "New"
msgstr "新建"
-#: lib/Padre/Wx/Menu/File.pm:86
+#: lib/Padre/Wx/Menu/File.pm:88
msgid "Open..."
msgstr "打开(&O)..."
-#: lib/Padre/Wx/Menu/File.pm:244
+#: lib/Padre/Wx/Menu/File.pm:171
+msgid "Reload"
+msgstr "重载"
+
+#: lib/Padre/Wx/Menu/File.pm:246
msgid "&Recent Files"
msgstr "最近的文件(&R)"
-#: lib/Padre/Wx/Menu/File.pm:283
+#: lib/Padre/Wx/Menu/File.pm:285
msgid "&File"
msgstr "文件(&F)"
-#: lib/Padre/Wx/Menu/File.pm:351
+#: lib/Padre/Wx/Menu/File.pm:357
#, perl-format
msgid "File %s not found."
msgstr "文件 %s 找不到。"
-#: lib/Padre/Wx/Menu/File.pm:352
+#: lib/Padre/Wx/Menu/File.pm:358
msgid "Open cancelled"
msgstr "打开已取消"
@@ -3082,61 +2864,88 @@ msgstr "调试器"
msgid "Variable"
msgstr "变量"
-#: lib/Padre/Document/Perl.pm:448
+#: lib/Padre/Document/Perl.pm:461
msgid "Error: "
msgstr "错误: "
-#: lib/Padre/Document/Perl.pm:450
+#: lib/Padre/Document/Perl.pm:463
msgid "No errors found."
msgstr "找不到任何错误"
-#: lib/Padre/Document/Perl.pm:576
-#: lib/Padre/Document/Perl.pm:600
-#: lib/Padre/Document/Perl.pm:635
-#: lib/Padre/Document/Perl.pm:761
+#: lib/Padre/Document/Perl.pm:502
+msgid "All braces appear to be matched"
+msgstr "所有的括号都已匹配"
+
+#: lib/Padre/Document/Perl.pm:503
+msgid "Check Complete"
+msgstr "检查结束"
+
+#: lib/Padre/Document/Perl.pm:572 lib/Padre/Document/Perl.pm:606
+#: lib/Padre/Document/Perl.pm:824 lib/Padre/Document/Perl.pm:861
+msgid "Current cursor does not seem to point at a variable"
+msgstr "当前光标不像指在一个变量上"
+
+#: lib/Padre/Document/Perl.pm:573 lib/Padre/Document/Perl.pm:627
+#: lib/Padre/Document/Perl.pm:662 lib/Padre/Document/Perl.pm:825
msgid "Check cancelled"
msgstr "检查已取消"
-#: lib/Padre/Document/Perl.pm:599
+# !!!!! not sure, thx for daxim to point out
+#: lib/Padre/Document/Perl.pm:608 lib/Padre/Document/Perl.pm:863
+msgid "No declaration could be found for the specified (lexical?) variable"
+msgstr "未能发现此变量的声明"
+
+#: lib/Padre/Document/Perl.pm:614
+msgid "Search Canceled"
+msgstr "检查已取消"
+
+#: lib/Padre/Document/Perl.pm:626
msgid "Current cursor does not seem to point at a method"
msgstr "当前指针不像指在一个方法上"
-#: lib/Padre/Document/Perl.pm:634
+#: lib/Padre/Document/Perl.pm:661
#, perl-format
msgid "Current '%s' not found"
msgstr "当前 '%s' 未找到"
-#: lib/Padre/Document/Perl.pm:1501
-#: lib/Padre/Action/Perl.pm:69
+#: lib/Padre/Document/Perl.pm:869 lib/Padre/Document/Perl.pm:918
+msgid "Replace Operation Canceled"
+msgstr "替换操作已取消"
+
+#: lib/Padre/Document/Perl.pm:910
+msgid "First character of selection does not seem to point at a token."
+msgstr "所选区域的首字符不像一个 token"
+
+#: lib/Padre/Document/Perl.pm:912
+msgid "Selection not part of a Perl statement?"
+msgstr "选区非 Perl 声明？"
+
+#: lib/Padre/Document/Perl.pm:1637 lib/Padre/Action/Perl.pm:69
msgid "Find Variable Declaration"
msgstr "查找变量申明"
-#: lib/Padre/Document/Perl.pm:1513
+#: lib/Padre/Document/Perl.pm:1649
msgid "Rename Variable"
msgstr "重命名变量"
-#: lib/Padre/Document/Perl.pm:1525
-#: lib/Padre/Document/Perl.pm:1526
+#: lib/Padre/Document/Perl.pm:1661 lib/Padre/Document/Perl.pm:1662
msgid "Replacement"
msgstr "Replacement"
-#: lib/Padre/Document/Perl.pm:1541
-#: lib/Padre/Action/Perl.pm:81
+#: lib/Padre/Document/Perl.pm:1677 lib/Padre/Action/Perl.pm:81
msgid "Find Method Declaration"
msgstr "查找方法申明"
-#: lib/Padre/Document/Perl.pm:1560
-#: lib/Padre/Action/Refactor.pm:111
+#: lib/Padre/Document/Perl.pm:1696 lib/Padre/Action/Refactor.pm:111
msgid "Introduce Temporary Variable"
msgstr "引入临时变量"
-#: lib/Padre/Document/Perl.pm:1573
-#: lib/Padre/Document/Perl.pm:1574
+#: lib/Padre/Document/Perl.pm:1709 lib/Padre/Document/Perl.pm:1710
#: lib/Padre/Action/Refactor.pm:110
msgid "Variable Name"
msgstr "变量名"
-#: lib/Padre/Document/Perl.pm:1585
+#: lib/Padre/Document/Perl.pm:1721
msgid "Edit with Regex Editor"
msgstr "用正则表达式编辑器编辑"
@@ -3182,7 +2991,9 @@ msgid "Padre Support (English)"
msgstr "Padre 支持 (英文)"
#: lib/Padre/Action/Help.pm:89
-msgid "Open the Padre live support chat in your web browser and talk to others who may help you with your problem"
+msgid ""
+"Open the Padre live support chat in your web browser and talk to others who "
+"may help you with your problem"
msgstr "在您的浏览器中打开 Padre 在线支持, 与能帮您处理难题的人交谈"
#: lib/Padre/Action/Help.pm:99
@@ -3190,7 +3001,9 @@ msgid "Perl Help"
msgstr "Perl 帮助"
#: lib/Padre/Action/Help.pm:101
-msgid "Open the Perl live support chat in your web browser and talk to others who may help you with your problem"
+msgid ""
+"Open the Perl live support chat in your web browser and talk to others who "
+"may help you with your problem"
msgstr "在您的浏览器中打开 Perl 在线支持, 与能帮您处理难题的人交谈"
#: lib/Padre/Action/Help.pm:111
@@ -3198,7 +3011,9 @@ msgid "Win32 Questions (English)"
msgstr "Win32 问题 (英文)"
#: lib/Padre/Action/Help.pm:113
-msgid "Open the Perl/Win32 live support chat in your web browser and talk to others who may help you with your problem"
+msgid ""
+"Open the Perl/Win32 live support chat in your web browser and talk to others "
+"who may help you with your problem"
msgstr "在您的浏览器中打开 Perl/Win32 在线支持, 与能帮您处理难题的人交谈"
#: lib/Padre/Action/Help.pm:124
@@ -3206,7 +3021,9 @@ msgid "Visit the PerlMonks"
msgstr "访问 PerlMonks"
#: lib/Padre/Action/Help.pm:126
-msgid "Open perlmonks.org, one of the biggest Perl community sites, in your default web browser"
+msgid ""
+"Open perlmonks.org, one of the biggest Perl community sites, in your default "
+"web browser"
msgstr "在您的默认浏览器中打开 perlmonks.org （最大的 Perl 社区站点之一）"
#: lib/Padre/Action/Help.pm:135
@@ -3249,8 +3066,7 @@ msgstr "查找(&F)..."
msgid "Find text or regular expressions using a traditional dialog"
msgstr "使用传统对话框查找文本或正则表达式"
-#: lib/Padre/Action/Search.pm:47
-#: lib/Padre/Action/Search.pm:119
+#: lib/Padre/Action/Search.pm:47 lib/Padre/Action/Search.pm:119
msgid "Find Next"
msgstr "查找下一个"
@@ -3279,7 +3095,9 @@ msgid "Incremental search seen at the bottom of the window"
msgstr "在窗口㡳部显示增量搜索"
#: lib/Padre/Action/Search.pm:120
-msgid "Find next matching text using a toolbar-like dialog at the bottom of the editor"
+msgid ""
+"Find next matching text using a toolbar-like dialog at the bottom of the "
+"editor"
msgstr "使用编辑器㡳部类似工具栏的对话框， 找到下一个匹配文本"
#: lib/Padre/Action/Search.pm:130
@@ -3287,7 +3105,9 @@ msgid "Find Previous"
msgstr "查找上一个"
#: lib/Padre/Action/Search.pm:131
-msgid "Find previous matching text using a toolbar-like dialog at the bottom of the editor"
+msgid ""
+"Find previous matching text using a toolbar-like dialog at the bottom of the "
+"editor"
msgstr "使用编辑器㡳部类似工具栏的对话框， 找到前一个匹配文本"
#: lib/Padre/Action/Search.pm:142
@@ -3327,7 +3147,9 @@ msgid "Step In"
msgstr "跨入 Step In"
#: lib/Padre/Action/Debug.pm:43
-msgid "Execute the next statement, enter subroutine if needed. (Start debugger if it is not yet running)"
+msgid ""
+"Execute the next statement, enter subroutine if needed. (Start debugger if "
+"it is not yet running)"
msgstr "执行下一条语句， 在必要时进入子程序。 （若调试器未运行则启动它）"
#: lib/Padre/Action/Debug.pm:57
@@ -3335,8 +3157,12 @@ msgid "Step Over"
msgstr "跨过 Step Over"
#: lib/Padre/Action/Debug.pm:59
-msgid "Execute the next statement. If it is a subroutine call, stop only after it returned. (Start debugger if it is not yet running)"
-msgstr "执行下一条语句， 如果它调用一个子程序， 只在它返回后停止。 （若调试器未运行则启动它）"
+msgid ""
+"Execute the next statement. If it is a subroutine call, stop only after it "
+"returned. (Start debugger if it is not yet running)"
+msgstr ""
+"执行下一条语句， 如果它调用一个子程序， 只在它返回后停止。 （若调试器未运行则"
+"启动它）"
#: lib/Padre/Action/Debug.pm:75
msgid "Step Out"
@@ -3359,7 +3185,8 @@ msgid "Jump to Current Execution Line"
msgstr "跳至当前执行的语句"
#: lib/Padre/Action/Debug.pm:105
-msgid "Set focus to the line where the current statement is in the debugging process"
+msgid ""
+"Set focus to the line where the current statement is in the debugging process"
msgstr "在被调试的当前语句所在的行上设置焦点"
#: lib/Padre/Action/Debug.pm:119
@@ -3400,7 +3227,8 @@ msgid "Show Stack Trace"
msgstr "显示堆栈踪迹"
#: lib/Padre/Action/Debug.pm:177
-msgid "When in a subroutine call show all the calls since the main of the program"
+msgid ""
+"When in a subroutine call show all the calls since the main of the program"
msgstr "在一个子程序中调用时, 显示所有从主命名空间开始的调用"
#: lib/Padre/Action/Debug.pm:191
@@ -3408,7 +3236,8 @@ msgid "Display Value"
msgstr "显示值"
#: lib/Padre/Action/Debug.pm:192
-msgid "Display the current value of a variable in the right hand side debugger pane"
+msgid ""
+"Display the current value of a variable in the right hand side debugger pane"
msgstr "在右手边调试面板，显示变量的当前值"
#: lib/Padre/Action/Debug.pm:205
@@ -3456,7 +3285,9 @@ msgid "Edit My Plug-in"
msgstr "编辑我的插件"
#: lib/Padre/Action/Tools.pm:74
-msgid "My Plug-in is a plug-in where developers could extend their Padre installation"
+msgid ""
+"My Plug-in is a plug-in where developers could extend their Padre "
+"installation"
msgstr "\"My Plug-in\" 是一个插件, 开发者能用它括展 Padre 的安装"
#: lib/Padre/Action/Tools.pm:80
@@ -3471,8 +3302,7 @@ msgstr "重新载入我的插件"
msgid "This function reloads the My plug-in without restarting Padre"
msgstr "文个功能在不重启 Padre 的情况下重新载入 \"My plug-in\""
-#: lib/Padre/Action/Tools.pm:99
-#: lib/Padre/Action/Tools.pm:103
+#: lib/Padre/Action/Tools.pm:99 lib/Padre/Action/Tools.pm:103
#: lib/Padre/Action/Tools.pm:104
msgid "Reset My plug-in"
msgstr "重置我的插件"
@@ -3533,8 +3363,7 @@ msgstr "打开 CPAN::MyConfig.pm 手动编辑"
msgid "Select distribution to install"
msgstr "选择安装包"
-#: lib/Padre/Action/Tools.pm:215
-#: lib/Padre/Action/Tools.pm:240
+#: lib/Padre/Action/Tools.pm:215 lib/Padre/Action/Tools.pm:240
msgid "Did not provide a distribution"
msgstr "没有提供包"
@@ -3554,195 +3383,205 @@ msgstr "cpanm 未安装"
msgid "Failed to find your CPAN configuration"
msgstr "查找您的 CPAN 配置文件错误"
-#: lib/Padre/Action/View.pm:29
+#: lib/Padre/Action/View.pm:30
msgid "Lock User Interface"
msgstr "锁定用户界面"
-#: lib/Padre/Action/View.pm:30
+#: lib/Padre/Action/View.pm:31
msgid "If activated, do not allow moving around some of the windows"
msgstr "若激活，将不允许移动一些窗口"
-#: lib/Padre/Action/View.pm:40
+#: lib/Padre/Action/View.pm:42
msgid "Show Output"
msgstr "显示输出"
-#: lib/Padre/Action/View.pm:42
-msgid "Show the window displaying the standard output and standard error of the running scripts"
+#: lib/Padre/Action/View.pm:44
+msgid ""
+"Show the window displaying the standard output and standard error of the "
+"running scripts"
msgstr "显示提供运行中脚本的标准输出和标准错误信息的窗口"
-#: lib/Padre/Action/View.pm:51
+#: lib/Padre/Action/View.pm:53
msgid "Show Functions"
msgstr "显示函数列表"
-#: lib/Padre/Action/View.pm:52
+#: lib/Padre/Action/View.pm:54
msgid "Show a window listing all the functions in the current document"
msgstr "显示一个窗口, 其中列出当前文档的所有函数"
-#: lib/Padre/Action/View.pm:61
+#: lib/Padre/Action/View.pm:63
msgid "Show To-do List"
msgstr "显示待办(To-do)列表"
-#: lib/Padre/Action/View.pm:62
+#: lib/Padre/Action/View.pm:64
msgid "Show a window listing all todo items in the current document"
msgstr "显示一个窗口, 其中列出当前文档的所有待办项目"
-#: lib/Padre/Action/View.pm:77
+#: lib/Padre/Action/View.pm:73
msgid "Show Outline"
msgstr "显示提纲"
-#: lib/Padre/Action/View.pm:78
-msgid "Show a window listing all the parts of the current file (functions, pragmas, modules)"
+#: lib/Padre/Action/View.pm:74
+msgid ""
+"Show a window listing all the parts of the current file (functions, pragmas, "
+"modules)"
msgstr "显示一个窗口, 其中列出当前文件的所有部分(函数, 编译选项, 模块)"
-#: lib/Padre/Action/View.pm:87
+#: lib/Padre/Action/View.pm:83
msgid "Show Directory Tree"
msgstr "显示目录树"
-#: lib/Padre/Action/View.pm:88
+#: lib/Padre/Action/View.pm:84
msgid "Show a window with a directory browser of the current project"
msgstr "显示当前工程目录的目录浏览器窗口"
-#: lib/Padre/Action/View.pm:97
+#: lib/Padre/Action/View.pm:93
msgid "Show Syntax Check"
msgstr "显示语法检查"
-#: lib/Padre/Action/View.pm:98
-msgid "Turn on syntax checking of the current document and show output in a window"
+#: lib/Padre/Action/View.pm:94
+msgid ""
+"Turn on syntax checking of the current document and show output in a window"
msgstr "为当前文档打开语法检查, 并在一个窗口中显示结果"
-#: lib/Padre/Action/View.pm:107
+#: lib/Padre/Action/View.pm:103
msgid "Show Errors"
msgstr "显示错误列表"
-#: lib/Padre/Action/View.pm:108
+#: lib/Padre/Action/View.pm:104
msgid "Show the list of errors received during execution of a script"
msgstr "显示脚本执行时所收到的错误列表"
-#: lib/Padre/Action/View.pm:117
+#: lib/Padre/Action/View.pm:113
msgid "Show Status Bar"
msgstr "显示状态栏"
-#: lib/Padre/Action/View.pm:118
+#: lib/Padre/Action/View.pm:114
msgid "Show/hide the status bar at the bottom of the screen"
msgstr "显示/隐藏屏幕底部的状态栏"
-#: lib/Padre/Action/View.pm:127
+#: lib/Padre/Action/View.pm:123
msgid "Show Toolbar"
msgstr "显示工具栏"
-#: lib/Padre/Action/View.pm:128
+#: lib/Padre/Action/View.pm:124
msgid "Show/hide the toolbar at the top of the editor"
msgstr "显示/隐藏编辑窗顶部的工具栏"
-#: lib/Padre/Action/View.pm:138
+#: lib/Padre/Action/View.pm:135
msgid "Show Line Numbers"
msgstr "显示行号"
-#: lib/Padre/Action/View.pm:139
-msgid "Show/hide the line numbers of all the documents on the left side of the window"
+#: lib/Padre/Action/View.pm:136
+msgid ""
+"Show/hide the line numbers of all the documents on the left side of the "
+"window"
msgstr "显示/隐藏所有文档的窗口左边行号"
-#: lib/Padre/Action/View.pm:148
+#: lib/Padre/Action/View.pm:145
msgid "Show Code Folding"
msgstr "显示代码折叠"
-#: lib/Padre/Action/View.pm:149
-msgid "Show/hide a vertical line on the left hand side of the window to allow folding rows"
+#: lib/Padre/Action/View.pm:146
+msgid ""
+"Show/hide a vertical line on the left hand side of the window to allow "
+"folding rows"
msgstr "显示/隐藏窗口左侧的竖条，以允许折叠"
-#: lib/Padre/Action/View.pm:158
+#: lib/Padre/Action/View.pm:155
msgid "Fold all"
msgstr "展开所有"
-#: lib/Padre/Action/View.pm:159
+#: lib/Padre/Action/View.pm:156
msgid "Fold all the blocks that can be folded (need folding to be enabled)"
msgstr "折叠所有能折的代码块 (需要开启折叠功能)"
-#: lib/Padre/Action/View.pm:168
+#: lib/Padre/Action/View.pm:165
msgid "Unfold all"
msgstr "收拢所有"
-#: lib/Padre/Action/View.pm:169
+#: lib/Padre/Action/View.pm:166
msgid "Unfold all the blocks that can be folded (need folding to be enabled)"
msgstr "展开所有能折叠的代码块 (需要开启折叠功能)"
-#: lib/Padre/Action/View.pm:178
+#: lib/Padre/Action/View.pm:175
msgid "Show Call Tips"
msgstr "显示提示"
-#: lib/Padre/Action/View.pm:179
+#: lib/Padre/Action/View.pm:176
msgid "When typing in functions allow showing short examples of the function"
msgstr "键入函数时允许显示该函数的简短样例"
-#: lib/Padre/Action/View.pm:192
+#: lib/Padre/Action/View.pm:189
msgid "Show Current Line"
msgstr "显示当前行"
-#: lib/Padre/Action/View.pm:193
+#: lib/Padre/Action/View.pm:190
msgid "Highlight the line where the cursor is"
msgstr "高亮显示光标所在行"
-#: lib/Padre/Action/View.pm:202
+#: lib/Padre/Action/View.pm:199
msgid "Show Right Margin"
msgstr "显示右间距"
-#: lib/Padre/Action/View.pm:203
+#: lib/Padre/Action/View.pm:200
msgid "Show a vertical line indicating the right margin"
msgstr "显示一条铅直的直线来指出右边界"
-#: lib/Padre/Action/View.pm:213
+#: lib/Padre/Action/View.pm:211
msgid "Show Newlines"
msgstr "显示 EOL"
-#: lib/Padre/Action/View.pm:214
+#: lib/Padre/Action/View.pm:212
msgid "Show/hide the newlines with special character"
msgstr "显示/隐藏换行时带的特殊字符"
-#: lib/Padre/Action/View.pm:223
+#: lib/Padre/Action/View.pm:221
msgid "Show Whitespaces"
msgstr "显示空格"
-#: lib/Padre/Action/View.pm:224
+#: lib/Padre/Action/View.pm:222
msgid "Show/hide the tabs and the spaces with special characters"
msgstr "显示/隐藏 TAB 和空格为特殊字符"
-#: lib/Padre/Action/View.pm:233
+#: lib/Padre/Action/View.pm:231
msgid "Show Indentation Guide"
msgstr "显示缩进指导"
-#: lib/Padre/Action/View.pm:234
-msgid "Show/hide vertical bars at every indentation position on the left of the rows"
+#: lib/Padre/Action/View.pm:232
+msgid ""
+"Show/hide vertical bars at every indentation position on the left of the rows"
msgstr "显示/隐藏每个行左端缩进位置的竖条"
-#: lib/Padre/Action/View.pm:243
+#: lib/Padre/Action/View.pm:241
msgid "Word-Wrap"
msgstr "单词换行"
-#: lib/Padre/Action/View.pm:244
+#: lib/Padre/Action/View.pm:242
msgid "Wrap long lines"
msgstr "自动换行"
-#: lib/Padre/Action/View.pm:254
+#: lib/Padre/Action/View.pm:253
msgid "Increase Font Size"
msgstr "增大字号"
-#: lib/Padre/Action/View.pm:255
+#: lib/Padre/Action/View.pm:254
msgid "Make the letters bigger in the editor window"
msgstr "使编辑窗中的字符增大"
-#: lib/Padre/Action/View.pm:264
+#: lib/Padre/Action/View.pm:263
msgid "Decrease Font Size"
msgstr "缩小字号"
-#: lib/Padre/Action/View.pm:265
+#: lib/Padre/Action/View.pm:264
msgid "Make the letters smaller in the editor window"
msgstr "使编辑窗中的字符减小"
-#: lib/Padre/Action/View.pm:274
+#: lib/Padre/Action/View.pm:273
msgid "Reset Font Size"
msgstr "重置字体大小"
-#: lib/Padre/Action/View.pm:275
+#: lib/Padre/Action/View.pm:274
msgid "Reset the size of the letters to the default in the editor window"
msgstr "重置编辑窗中的字符大小"
@@ -3771,7 +3610,9 @@ msgid "Rename Variable..."
msgstr "重命名变量..."
#: lib/Padre/Action/Refactor.pm:50
-msgid "Prompt for a replacement variable name and replace all occurrences of this variable"
+msgid ""
+"Prompt for a replacement variable name and replace all occurrences of this "
+"variable"
msgstr "输入一个替换后的变量名, 替换一切出现这个变量的地方"
#: lib/Padre/Action/Refactor.pm:57
@@ -3787,7 +3628,9 @@ msgid "Extract Subroutine..."
msgstr "提取子程序..."
#: lib/Padre/Action/Refactor.pm:74
-msgid "Cut the current selection and create a new sub from it. A call to this sub is added in the place where the selection was."
+msgid ""
+"Cut the current selection and create a new sub from it. A call to this sub "
+"is added in the place where the selection was."
msgstr "剪切当前所选, 并根据它创建一个新的子程序. 在所选处将会调用该子程序."
#: lib/Padre/Action/Refactor.pm:86
@@ -3910,8 +3753,7 @@ msgstr "关闭该工程"
msgid "Close all the files belonging to the current project"
msgstr "关闭所有属于当前工程的文件"
-#: lib/Padre/Action/File.pm:187
-#: lib/Padre/Action/File.pm:208
+#: lib/Padre/Action/File.pm:187 lib/Padre/Action/File.pm:208
msgid "File is not in a project"
msgstr "文件不在工程中"
@@ -3988,7 +3830,9 @@ msgid "Save Intuition"
msgstr "凭直觉保存"
#: lib/Padre/Action/File.pm:313
-msgid "For new document try to guess the filename based on the file content and offer to save it."
+msgid ""
+"For new document try to guess the filename based on the file content and "
+"offer to save it."
msgstr "对于新的文档， 根据文件内容尝试猜测文件名， 并试图保存。"
#: lib/Padre/Action/File.pm:323
@@ -4000,7 +3844,9 @@ msgid "Save all the files"
msgstr "关闭所有文件"
#: lib/Padre/Action/File.pm:335
-msgid "List the files that match the current selection and let the user pick one to open"
+msgid ""
+"List the files that match the current selection and let the user pick one to "
+"open"
msgstr "列出符合当前选择的文件， 然后让用户选择某个以打开"
#: lib/Padre/Action/File.pm:344
@@ -4008,7 +3854,9 @@ msgid "Open Session..."
msgstr "打开会话..."
#: lib/Padre/Action/File.pm:346
-msgid "Select a session. Close all the files currently open and open all the listed in the session"
+msgid ""
+"Select a session. Close all the files currently open and open all the listed "
+"in the session"
msgstr "选择一个会话。 关闭当前打开的文件， 然后打开所有会话中的文件"
#: lib/Padre/Action/File.pm:356
@@ -4068,11 +3916,15 @@ msgid "Find Unmatched Brace"
msgstr "查找未匹配括号"
#: lib/Padre/Action/Perl.pm:58
-msgid "Searches the source code for brackets with lack a matching (opening/closing) part."
+msgid ""
+"Searches the source code for brackets with lack a matching (opening/closing) "
+"part."
msgstr "搜索源码中缺少匹配的括号"
#: lib/Padre/Action/Perl.pm:70
-msgid "Find where the selected variable was declared using \"my\" and put the focus there."
+msgid ""
+"Find where the selected variable was declared using \"my\" and put the focus "
+"there."
msgstr "找出所选变量是在哪儿用 \"my\" 定义的, 并把焦点放在那儿"
#: lib/Padre/Action/Perl.pm:82
@@ -4092,7 +3944,9 @@ msgid "Newline Same Column"
msgstr "相同列上插入一行"
#: lib/Padre/Action/Perl.pm:106
-msgid "Like pressing ENTER somewhere on a line, but use the current position as ident for the new line."
+msgid ""
+"Like pressing ENTER somewhere on a line, but use the current position as "
+"ident for the new line."
msgstr "就像在一行中某个位置按下回车, 但使用当前位置作为下一行的缩进"
#: lib/Padre/Action/Perl.pm:118
@@ -4100,7 +3954,9 @@ msgid "Create Project Tagsfile"
msgstr "创建工程标记文件 (tagsfile)"
#: lib/Padre/Action/Perl.pm:120
-msgid "Creates a perltags - file for the current project supporting find_method and autocomplete."
+msgid ""
+"Creates a perltags - file for the current project supporting find_method and "
+"autocomplete."
msgstr "为当前工程创建一个 perltags 文件, 以支持方法(函数)查找与自动补全."
#: lib/Padre/Action/Perl.pm:146
@@ -4148,7 +4004,9 @@ msgid "Run Tests"
msgstr "运行测试"
#: lib/Padre/Action/Run.pm:94
-msgid "Run all tests for the current project or document and show the results in the output panel."
+msgid ""
+"Run all tests for the current project or document and show the results in "
+"the output panel."
msgstr "执行当前工程或文件的所有测试, 在输出面板显示结果."
#: lib/Padre/Action/Run.pm:113
@@ -4336,7 +4194,8 @@ msgid "Special Value..."
msgstr "特殊值..."
#: lib/Padre/Action/Edit.pm:347
-msgid "Select a date, filename or other value and insert at the current location"
+msgid ""
+"Select a date, filename or other value and insert at the current location"
msgstr "选择一个日期、文件名或其它值，将其插入到当前位置"
#: lib/Padre/Action/Edit.pm:359
@@ -4384,7 +4243,9 @@ msgid "Encode Document to System Default"
msgstr "转码文档为系统默认编码"
#: lib/Padre/Action/Edit.pm:421
-msgid "Change the encoding of the current document to the default of the operating system"
+msgid ""
+"Change the encoding of the current document to the default of the operating "
+"system"
msgstr "将当前文件的编码改为操作系统默认值"
#: lib/Padre/Action/Edit.pm:431
@@ -4408,7 +4269,9 @@ msgid "EOL to Windows"
msgstr "EOL 转为 Windows 风格"
#: lib/Padre/Action/Edit.pm:455
-msgid "Change the end of line character of the current document to those used in files on MS Windows"
+msgid ""
+"Change the end of line character of the current document to those used in "
+"files on MS Windows"
msgstr "改变当前文件的行尾符到 MS Windows 风格"
#: lib/Padre/Action/Edit.pm:464
@@ -4416,7 +4279,9 @@ msgid "EOL to Unix"
msgstr "EOL 转为 Windows 风格"
#: lib/Padre/Action/Edit.pm:466
-msgid "Change the end of line character of the current document to that used on Unix, Linux, Mac OSX"
+msgid ""
+"Change the end of line character of the current document to that used on "
+"Unix, Linux, Mac OSX"
msgstr "改变当前文件的行尾符到 Unix, Linux, Mac OSX 风格"
#: lib/Padre/Action/Edit.pm:475
@@ -4424,7 +4289,9 @@ msgid "EOL to Mac Classic"
msgstr "EOL 转为 Mac 经典风格"
#: lib/Padre/Action/Edit.pm:476
-msgid "Change the end of line character of the current document to that used on Mac Classic"
+msgid ""
+"Change the end of line character of the current document to that used on Mac "
+"Classic"
msgstr "改变当前文件的行尾符到 Mac 经典风格"
#: lib/Padre/Action/Edit.pm:486
@@ -4480,7 +4347,9 @@ msgid "Diff to Saved Version"
msgstr "Diff 到已保存版本"
#: lib/Padre/Action/Edit.pm:551
-msgid "Compare the file in the editor to that on the disk and show the diff in the output window"
+msgid ""
+"Compare the file in the editor to that on the disk and show the diff in the "
+"output window"
msgstr "比较编辑窗中的文件和磁盘上的文件, 并把不同点显示在输出窗口"
#: lib/Padre/Action/Edit.pm:559
@@ -4504,7 +4373,8 @@ msgid "Filter through External Tool..."
msgstr "使用外部工具过滤..."
#: lib/Padre/Action/Edit.pm:581
-msgid "Filters the selection (or the whole document) through any external command."
+msgid ""
+"Filters the selection (or the whole document) through any external command."
msgstr "通过外部过滤命令来过滤所选文本（或整个文档）"
#: lib/Padre/Action/Edit.pm:590
@@ -4516,7 +4386,9 @@ msgid "Show as Hexadecimal"
msgstr "以十六进制显示"
#: lib/Padre/Action/Edit.pm:602
-msgid "Show the ASCII values of the selected text in hexadecimal notation in the output window"
+msgid ""
+"Show the ASCII values of the selected text in hexadecimal notation in the "
+"output window"
msgstr "在输出窗口显示所选文本的 ASCII 十六进制值"
#: lib/Padre/Action/Edit.pm:611
@@ -4524,7 +4396,9 @@ msgid "Show as Decimal"
msgstr "显示为十进制"
#: lib/Padre/Action/Edit.pm:612
-msgid "Show the ASCII values of the selected text in decimal numbers in the output window"
+msgid ""
+"Show the ASCII values of the selected text in decimal numbers in the output "
+"window"
msgstr "在输出窗口显示所选文本的 ASCII 十进制值"
#: lib/Padre/Action/Edit.pm:622
@@ -4555,13 +4429,14 @@ msgstr "延迟动作队列 30 秒"
msgid "Stops processing of other action queue items for 30 seconds"
msgstr "停止处理动作队列中的其它项目 30 秒钟"
-#: lib/Padre/Action/Window.pm:31
-#: lib/Padre/Action/Window.pm:77
+#: lib/Padre/Action/Window.pm:31 lib/Padre/Action/Window.pm:77
msgid "Last Visited File"
msgstr "最近访问的文件"
#: lib/Padre/Action/Window.pm:32
-msgid "Switch to edit the file that was previously edited (can switch back and forth)"
+msgid ""
+"Switch to edit the file that was previously edited (can switch back and "
+"forth)"
msgstr "切换到先前编辑过的文件 (可以来回切换)"
#: lib/Padre/Action/Window.pm:42
@@ -4656,8 +4531,7 @@ msgstr "新模块"
msgid "Module name:"
msgstr "模块名:"
-#: lib/Padre/Util/FileBrowser.pm:63
-#: lib/Padre/Util/FileBrowser.pm:110
+#: lib/Padre/Util/FileBrowser.pm:63 lib/Padre/Util/FileBrowser.pm:110
#: lib/Padre/Util/FileBrowser.pm:153
#, perl-format
msgid "Unsupported OS: %s"
@@ -4736,13 +4610,11 @@ msgstr "STC 参考"
msgid "wxPerl Live Support"
msgstr "wxPerl 在线支持"
-#: lib/Padre/Plugin/Devel.pm:92
-#: lib/Padre/Plugin/PopularityContest.pm:197
+#: lib/Padre/Plugin/Devel.pm:92 lib/Padre/Plugin/PopularityContest.pm:196
msgid "About"
msgstr "关于"
-#: lib/Padre/Plugin/Devel.pm:110
-#: lib/Padre/Plugin/Devel.pm:111
+#: lib/Padre/Plugin/Devel.pm:110 lib/Padre/Plugin/Devel.pm:111
msgid "Expression"
msgstr "表达式"
@@ -4776,11 +4648,11 @@ msgstr "发现 %s 个未载入的莫块"
msgid "Loaded %s modules"
msgstr "载入了 %s 个模块"
-#: lib/Padre/Plugin/PopularityContest.pm:198
+#: lib/Padre/Plugin/PopularityContest.pm:197
msgid "Show current report"
msgstr "显示当前报告"
-#: lib/Padre/Plugin/PopularityContest.pm:298
+#: lib/Padre/Plugin/PopularityContest.pm:299
msgid "Popularity Contest Report"
msgstr "流行度报告"
@@ -4839,105 +4711,224 @@ msgstr "从 FTP 服务器读取文件..."
msgid "Writing file to FTP server..."
msgstr "文件正在写入FTP服务器..."
+#~ msgid "%s worker threads are running.\n"
+#~ msgstr "%s worker threads 正在运行中。\n"
+
+#~ msgid "Currently, no background tasks are being executed.\n"
+#~ msgstr "当前没有任何后台任务在运行。\n"
+
+#~ msgid "The following tasks are currently executing in the background:\n"
+#~ msgstr "以下任务正在后台运行中：\n"
+
+#~ msgid ""
+#~ "- %s of type '%s':\n"
+#~ " (in thread(s) %s)\n"
+#~ msgstr ""
+#~ "- %s 拥有类型 '%s':\n"
+#~ " (在线程 %s)\n"
+
+#~ msgid ""
+#~ "\n"
+#~ "Additionally, there are %s tasks pending execution.\n"
+#~ msgstr ""
+#~ "\n"
+#~ "另外, 任务 %s 正在等待运行。\n"
+
+#~ msgid "Finished Searching"
+#~ msgstr "查找完毕"
+
+#~ msgid "Choose a directory"
+#~ msgstr "选择目录"
+
+#~ msgid "Please choose a different name."
+#~ msgstr "请选择另一个名字"
+
+#~ msgid "A file with the same name already exists in this directory"
+#~ msgstr "当前目录中已有相同名字的文件"
+
+#~ msgid "Move here"
+#~ msgstr "移动到这里"
+
+#~ msgid "Copy here"
+#~ msgstr "复制到这里"
+
+#~ msgid "folder"
+#~ msgstr "文件夹"
+
+#~ msgid "Rename / Move"
+#~ msgstr "重命名/移动"
+
+#~ msgid "Move to trash"
+#~ msgstr "移动到回收站"
+
+#~ msgid "Are you sure you want to delete this item?"
+#~ msgstr "您确认要删除该条目吗？"
+
+#~ msgid "Show hidden files"
+#~ msgstr "显示隐藏文件"
+
+#~ msgid "Skip hidden files"
+#~ msgstr "跳过隐藏文件"
+
+#~ msgid "Skip CVS/.svn/.git/blib folders"
+#~ msgstr "跳过 CVS/.svn/.git/blib 目录"
+
+#~ msgid "Change project directory"
+#~ msgstr "选择工程目录"
+
+#~ msgid "Tree listing"
+#~ msgstr "树形列表"
+
+#~ msgid "Navigate"
+#~ msgstr "Navigate"
+
+#~ msgid "Change listing mode view"
+#~ msgstr "改变列表显示视图"
+
#~ msgid "Check the current file"
#~ msgstr "检查当前文件"
+
#~ msgid "Open In File Browser"
#~ msgstr "在浏览器中打开文件"
+
#~ msgid "Lexically Rename Variable"
#~ msgstr "词法重命名变量"
+
#~ msgid "Error List"
#~ msgstr "错误列表"
+
#~ msgid "'%s' does not look like a variable"
#~ msgstr "'%s' 看起来不像变量"
+
#~ msgid "Show the about-Padre information"
#~ msgstr "显示 Padre 的“关于”信息"
+
#~ msgid ""
#~ "Ask the user for a line number or a character position and jump there"
#~ msgstr "向用户询问一个行号或者一个字符位置然后跳到那儿"
+
#~ msgid "Show as hexa"
#~ msgstr "显示为十六进制"
+
#~ msgid ""
#~ "Show the ASCII values of the selected text in hexa in the output window"
#~ msgstr "在输出窗口显示所选文本的 ASCII 十六进制值"
+
#~ msgid "Ack"
#~ msgstr "Ack"
+
#~ msgid "Insert Special Value"
#~ msgstr "插入特殊值"
+
#~ msgid "Insert From File..."
#~ msgstr "插入文件..."
+
#~ msgid "New..."
#~ msgstr "新建..."
+
#~ msgid "Close..."
#~ msgstr "关闭..."
+
#~ msgid "Reload..."
#~ msgstr "重新载入..."
+
#~ msgid "%s apparently created. Do you want to open it now?"
#~ msgstr "%s 已创建。现在就打开文件吗？"
+
#~ msgid "Done"
#~ msgstr "完成"
+
#~ msgid "Timeout:"
#~ msgstr "超时:"
+
#~ msgid "New Subroutine Name"
#~ msgstr "新子程序名称"
+
#~ msgid "(Document not on disk)"
#~ msgstr "(文档不在磁盘上)"
+
#~ msgid "Lines: %d"
#~ msgstr "行号: %d"
+
#~ msgid "Chars without spaces: %s"
#~ msgstr "字符（无空格）: %s"
+
#~ msgid "Chars with spaces: %d"
#~ msgstr "字符（带空格）: %d"
+
#~ msgid "Newline type: %s"
#~ msgstr "换行类型: %s"
+
#~ msgid "Size on disk: %s"
#~ msgstr "磁盘空间: %s"
+
#~ msgid "File is read-only.\n"
#~ msgstr "文件只读.\n"
+
#~ msgid "Skip VCS files"
#~ msgstr "跳过 VCS 文件"
+
#~ msgid "Skip feedback"
#~ msgstr "跳过反馈"
+
#~ msgid "Norwegian (Norway)"
#~ msgstr "挪威语 (挪威)"
+
#~ msgid "Ping"
#~ msgstr "Ping"
+
#~ msgid "Dump PPI Document"
#~ msgstr "导出 PPI 文档"
+
#~ msgid "Enable logging"
#~ msgstr "启用日志记录"
+
#~ msgid "Disable logging"
#~ msgstr "禁用日志记录"
+
#~ msgid "Enable trace when logging"
#~ msgstr "记录日志时启用 trace"
+
#~ msgid "Select all\tCtrl-A"
#~ msgstr "全选\tCtrl-A"
+
#~ msgid "&Copy\tCtrl-C"
#~ msgstr "复制(&C)\tCtrl-C"
+
#~ msgid "Cu&t\tCtrl-X"
#~ msgstr "剪切(&t)\tCtrl-X"
+
#~ msgid "&Paste\tCtrl-V"
#~ msgstr "粘贴(&P)\tCtrl-V"
+
#~ msgid "&Toggle Comment\tCtrl-Shift-C"
#~ msgstr "切换注释(&T)\tCtrl-Shift-C"
+
#~ msgid "&Comment Selected Lines\tCtrl-M"
#~ msgstr "添加注释(&C)\tCtrl-M"
+
#~ msgid "&Uncomment Selected Lines\tCtrl-Shift-M"
#~ msgstr "删除注释(&U)\tCtrl-Shift-M"
+
#~ msgid "&Split window"
#~ msgstr "分割窗口(&S)"
+
#~ msgid ""
#~ "File has been deleted on disk, do you want to CLEAR the editor window?"
#~ msgstr "文件在磁盘中被删除，是否清空编辑窗口？"
+
#~ msgid "File changed on disk since last saved. Do you want to reload it?"
#~ msgstr "文件在上次保存后有更新。是否重新载入？"
+
#~ msgid "Error loading template file '%s'"
#~ msgstr "载入模板文件 '%s' 错误"
+
#~ msgid "Found %d matching occurrences"
#~ msgstr "已找到 %d 处匹配"
+
#~ msgid ""
#~ "Error:\n"
#~ "%s"
#~ msgstr ""
#~ "错误:\n"
#~ "%s"
-
@@ -11,7 +11,7 @@ BEGIN {
exit 0;
}
}
-plan( tests => 37 );
+plan( tests => 44 );
use Test::Script;
use Test::NoWarnings;
@@ -38,6 +38,15 @@ use_ok('Padre::Pod2HTML');
use_ok('Padre::Plugin::Devel');
use_ok('Padre::Plugin::My');
+# Load all the second-generation modules
+use_ok('Padre::Task');
+use_ok('Padre::TaskThread');
+use_ok('Padre::TaskHandle');
+use_ok('Padre::TaskManager');
+use_ok('Padre::TaskProcess');
+use_ok('Padre::TaskWorker');
+use_ok('Padre::Role::Task');
+
# Now load everything else
my $loaded = Padre->import(':everything');
ok( $loaded, "Loaded the remaining $loaded classes ok" );
@@ -67,10 +67,10 @@ SCOPE: {
is( $config->locale_perldiag => '' );
is( $config->editor_style => 'default' );
is( $config->main_maximized => 0 );
- is( $config->main_top => 40 );
- is( $config->main_left => 20 );
- is( $config->main_width => 600 );
- is( $config->main_height => 400 );
+ is( $config->main_top => -1 );
+ is( $config->main_left => -1 );
+ is( $config->main_width => -1 );
+ is( $config->main_height => -1 );
}
@@ -196,7 +196,7 @@ my @events = (
my $main = $ide->wx->main;
$T->diag( "syntaxcheck_panel: " . $main->syntax );
$main->menu->view->{show_syntaxcheck}->Check(1);
- $main->on_toggle_syntax_check( event( checked => 1 ) );
+ $main->show_syntax(1);
$T->ok( $main->syntax->isa('Wx::ListView'), 'is a Wx::ListView' );
},
},
@@ -0,0 +1,60 @@
+#!/usr/bin/perl
+
+# Spawn and then shut down the task worker object.
+# Done in similar style to the task master to help encourage
+# implementation similarity in the future.
+
+use strict;
+use warnings;
+use Test::More tests => 19;
+use Test::NoWarnings;
+use Padre::TaskThread ();
+use Padre::Logger;
+
+# Do we start with no threads as expected
+is( scalar( threads->list ), 0, 'One thread exists' );
+
+
+
+
+
+######################################################################
+# Simplistic Start and Stop
+
+SCOPE: {
+
+ # Create the master thread
+ my $thread = Padre::TaskThread->new->spawn;
+ isa_ok( $thread, 'Padre::TaskThread' );
+ is( $thread->wid, 1, '->wid ok' );
+ isa_ok( $thread->queue, 'Thread::Queue' );
+ isa_ok( $thread->thread, 'threads' );
+ ok( !$thread->is_thread, '->is_thread is false' );
+ my $tid = $thread->thread->tid;
+ ok( $tid, "Got thread id $tid" );
+
+ # Does the threads module agree it was created
+ my @threads = threads->list;
+ is( scalar(@threads), 1, 'Found one thread' );
+ is( $threads[0]->tid, $tid, 'Found the expected thread id' );
+
+ # Initially, the thread should be running
+ ok( $thread->is_running, 'Thread is_running' );
+ ok( !$thread->is_joinable, 'Thread is not is_joinable' );
+ ok( !$thread->is_detached, 'Thread is not is_detached' );
+
+ # It should stay running
+ TRACE("Pausing to allow clean thread startup...") if DEBUG;
+ sleep 0.1;
+ ok( $thread->is_running, 'Thread is_running' );
+ ok( !$thread->is_joinable, 'Thread is not is_joinable' );
+ ok( !$thread->is_detached, 'Thread is not is_detached' );
+
+ # Instruct the master to shutdown, and give it a brief time to do so.
+ ok( $thread->stop, '->stop ok' );
+ TRACE("Pausing to allow clean thread shutdown...") if DEBUG;
+ sleep 0.1;
+ ok( !$thread->thread, '->thread no longer exists' );
+}
+
+is( scalar( threads->list ), 0, 'One thread exists' );
@@ -0,0 +1,64 @@
+#!/usr/bin/perl
+
+# Spawn and then shut down the task worker object.
+# Done in similar style to the task master to help encourage
+# implementation similarity in the future.
+
+#BEGIN {
+#$Padre::TaskWorker::DEBUG = 1;
+#}
+
+use strict;
+use warnings;
+use Test::More tests => 19;
+use Test::NoWarnings;
+use Padre::TaskThread ();
+use Padre::Logger;
+
+# Do we start with no threads as expected
+is( scalar( threads->list ), 0, 'One thread exists' );
+
+
+
+
+
+######################################################################
+# Simplistic Start and Stop
+
+SCOPE: {
+
+ # Create the master thread
+ my $thread = Padre::TaskThread->new->spawn;
+ isa_ok( $thread, 'Padre::TaskThread' );
+ is( $thread->wid, 1, '->wid ok' );
+ isa_ok( $thread->queue, 'Thread::Queue' );
+ isa_ok( $thread->thread, 'threads' );
+ ok( !$thread->is_thread, '->is_thread is false' );
+ my $tid = $thread->thread->tid;
+ ok( $tid, "Got thread id $tid" );
+
+ # Does the threads module agree it was created
+ my @threads = threads->list;
+ is( scalar(@threads), 1, 'Found one thread' );
+ is( $threads[0]->tid, $tid, 'Found the expected thread id' );
+
+ # Initially, the thread should be running
+ ok( $thread->is_running, 'Thread is_running' );
+ ok( !$thread->is_joinable, 'Thread is not is_joinable' );
+ ok( !$thread->is_detached, 'Thread is not is_detached' );
+
+ # It should stay running
+ TRACE("Pausing to allow clean thread startup...") if DEBUG;
+ sleep 0.1;
+ ok( $thread->is_running, 'Thread is_running' );
+ ok( !$thread->is_joinable, 'Thread is not is_joinable' );
+ ok( !$thread->is_detached, 'Thread is not is_detached' );
+
+ # Instruct the master to stop, and give it a brief time to do so.
+ ok( $thread->stop, '->stop ok' );
+ TRACE("Pausing to allow clean thread stop...") if DEBUG;
+ sleep 0.1;
+ ok( !$thread->thread, '->thread no longer exists' );
+}
+
+is( scalar( threads->list ), 0, 'One thread exists' );
@@ -0,0 +1,63 @@
+#!/usr/bin/perl
+
+# Start a worker thread from inside another thread
+
+#BEGIN {
+#$Padre::TaskThread::DEBUG = 1;
+#$Padre::TaskWorker::DEBUG = 1;
+#}
+
+use strict;
+use warnings;
+use Test::More tests => 20;
+use Test::NoWarnings;
+use Time::HiRes 'sleep';
+use Padre::Logger;
+use Padre::TaskThread ();
+use Padre::TaskWorker ();
+
+# Do we start with no threads as expected
+is( scalar( threads->list ), 0, 'One thread exists' );
+
+
+
+
+
+######################################################################
+# Single Worker Start and Stop
+
+SCOPE: {
+
+ # Create the master thread
+ my $master = Padre::TaskThread->new->spawn;
+ isa_ok( $master, 'Padre::TaskThread' );
+ is( scalar( threads->list ), 1, 'Found 1 thread' );
+ ok( $master->is_running, 'Master is_running' );
+
+ # Create a single worker
+ my $worker = Padre::TaskWorker->new;
+ isa_ok( $worker, 'Padre::TaskWorker' );
+
+ # Start the worker inside the master
+ ok( $master->start($worker), '->add ok' );
+ TRACE("Pausing to allow worker thread startup...") if DEBUG;
+ sleep 0.1;
+ is( scalar( threads->list ), 2, 'Found 2 threads' );
+ ok( $master->is_running, 'Master is_running' );
+ ok( !$master->is_joinable, 'Master is not is_joinable' );
+ ok( !$master->is_detached, 'Master is not is_detached' );
+ ok( $worker->is_running, 'Worker is_running' );
+ ok( !$worker->is_joinable, 'Worker is not is_joinable' );
+ ok( !$worker->is_detached, 'Worker is not is_detached' );
+
+ # Shut down the worker but leave the master running
+ ok( $worker->stop, '->stop ok' );
+ TRACE("Pausing to allow worker thread shutdown...") if DEBUG;
+ sleep 0.1;
+ ok( $master->is_running, 'Master is_running' );
+ ok( !$master->is_joinable, 'Master is not is_joinable' );
+ ok( !$master->is_detached, 'Master is not is_detached' );
+ ok( !$worker->thread, 'Worker thread has ended' );
+}
+
+is( scalar( threads->list ), 1, 'Thread is gone' );
@@ -0,0 +1,27 @@
+#!/usr/bin/perl
+
+# Start a worker thread from inside another thread
+
+#BEGIN {
+#$Padre::TaskThread::DEBUG = 1;
+#$Padre::TaskWorker::DEBUG = 1;
+#}
+
+use strict;
+use warnings;
+use Test::More tests => 5;
+use Test::NoWarnings;
+use Time::HiRes 'sleep';
+use Padre::Logger;
+use Padre::TaskThread ':master';
+
+# Do we start with one thread as expected
+sleep 0.1;
+is( scalar( threads->list ), 1, 'One thread exists' );
+
+# Fetch the master, is it the existing one?
+my $master1 = Padre::TaskThread->master;
+my $master2 = Padre::TaskThread->master;
+isa_ok( $master1, 'Padre::TaskThread' );
+isa_ok( $master2, 'Padre::TaskThread' );
+is( $master1->wid, $master2->wid, 'Masters match' );
@@ -0,0 +1,99 @@
+#!/usr/bin/perl
+
+# Spawn and then shut down the task worker object.
+# Done in similar style to the task master to help encourage
+# implementation similarity in the future.
+
+use strict;
+use warnings;
+use Test::More tests => 41;
+use Test::NoWarnings;
+use Padre::TaskHandle ();
+use Padre::Task::Addition ();
+use Padre::Logger;
+
+
+
+
+
+######################################################################
+# Check the raw task
+
+SCOPE: {
+ my $addition = Padre::Task::Addition->new(
+ x => 2,
+ y => 3,
+ );
+ isa_ok( $addition, 'Padre::Task::Addition' );
+ is( $addition->{x}, 2, '->{x} matches expected' );
+ is( $addition->{y}, 3, '->{y} matches expected' );
+ is( $addition->{z}, undef, '->{z} matches expected' );
+
+ # Run the task
+ is( $addition->{prepare}, 0, '->{prepare} is false' );
+ is( $addition->prepare, 1, '->prepare ok' );
+ is( $addition->{prepare}, 1, '->{prepare} is true' );
+
+ is( $addition->{run}, 0, '->{run} is false' );
+ is( $addition->run, 1, '->run ok' );
+ is( $addition->{run}, 1, '->{run} is true' );
+
+ is( $addition->{finish}, 0, '->{finish} is false' );
+ is( $addition->finish, 1, '->finish ok' );
+ is( $addition->{finish}, 1, '->{finish} is true' );
+
+ is( $addition->{x}, 2, '->{x} matches expected' );
+ is( $addition->{y}, 3, '->{y} matches expected' );
+ is( $addition->{z}, 5, '->{z} matches expected' );
+
+ # Check task round-trip serialization
+ my $string = $addition->as_string;
+ ok( ( defined $string and !ref $string and length $string ),
+ '->as_string ok',
+ );
+ my $round = Padre::Task::Addition->from_string($string);
+ isa_ok( $round, 'Padre::Task::Addition' );
+ is_deeply( $round, $addition, 'Task round-trips ok' );
+}
+
+
+
+
+
+######################################################################
+# Run the task via a handle object
+
+SCOPE: {
+ my $task = Padre::Task::Addition->new( x => 2, y => 3 );
+ my $handle = Padre::TaskHandle->new($task);
+ isa_ok( $handle, 'Padre::TaskHandle' );
+ isa_ok( $handle->task, 'Padre::Task::Addition' );
+ is( $handle->hid, 1, '->hid ok' );
+ is( $handle->task->{x}, 2, '->{x} matches expected' );
+ is( $handle->task->{y}, 3, '->{y} matches expected' );
+ is( $handle->task->{z}, undef, '->{z} matches expected' );
+
+ # Run the task
+ is( $task->{prepare}, 0, '->{prepare} is false' );
+ is( $handle->prepare, 1, '->prepare ok' );
+ is( $task->{prepare}, 1, '->{prepare} is true' );
+
+ is( $task->{run}, 0, '->{run} is false' );
+ is( $handle->run, 1, '->run ok' );
+ is( $task->{run}, 1, '->{run} is true' );
+
+ is( $task->{finish}, 0, '->{finish} is false' );
+ is( $handle->finish, 1, '->finish ok' );
+ is( $task->{finish}, 1, '->{finish} is true' );
+
+ is( $handle->task->{x}, 2, '->{x} matches expected' );
+ is( $handle->task->{y}, 3, '->{y} matches expected' );
+ is( $handle->task->{z}, 5, '->{z} matches expected' );
+
+ # Check handle round-trip serialisation
+ my $array = $handle->as_array;
+ is( ref($array), 'ARRAY', '->as_array ok' );
+ my $round = Padre::TaskHandle->from_array($array);
+ isa_ok( $round, 'Padre::TaskHandle' );
+ is_deeply( $round, $handle, 'Round trip serialisation ok' );
+}
@@ -0,0 +1,91 @@
+#!/usr/bin/perl
+
+# Spawn and then shut down the task worker object.
+# Done in similar style to the task master to help encourage
+# implementation similarity in the future.
+
+use strict;
+use warnings;
+use Test::More tests => 23;
+use Test::NoWarnings;
+use Test::Exception;
+use Padre::TaskHandle ();
+use Padre::Task::Eval ();
+use Padre::Logger;
+
+
+
+
+
+######################################################################
+# Run a straight forwards eval task via a handle
+
+SCOPE: {
+ my $task = Padre::Task::Eval->new(
+ prepare => '1 + 2',
+ run => '3 + 4',
+ finish => '5 + 6',
+ );
+ isa_ok( $task, 'Padre::Task::Eval' );
+ is( $task->{prepare}, '1 + 2', '->{prepare} is false' );
+ is( $task->{run}, '3 + 4', '->{run} is false' );
+ is( $task->{finish}, '5 + 6', '->{finish} is false' );
+
+ # Wrap a handle around it
+ my $handle = Padre::TaskHandle->new($task);
+ isa_ok( $handle, 'Padre::TaskHandle' );
+ isa_ok( $handle->task, 'Padre::Task::Eval' );
+ is( $handle->hid, 1, '->hid ok' );
+
+ # Run the task
+ is( $handle->prepare, 1, '->prepare ok' );
+ is( $task->{prepare}, 3, '->{prepare} is true' );
+ is( $handle->run, 1, '->run ok' );
+ is( $task->{run}, 7, '->{run} is true' );
+ is( $handle->finish, 1, '->finish ok' );
+ is( $task->{finish}, 11, '->{finish} is true' );
+}
+
+
+
+
+
+######################################################################
+# Exceptions without a handle
+
+SCOPE: {
+ my $task = Padre::Task::Eval->new(
+ prepare => 'die "foo";',
+ run => 'die "bar";',
+ finish => 'die "baz";',
+ );
+ isa_ok( $task, 'Padre::Task::Eval' );
+
+ # Do they throw normal exceptions
+ throws_ok( sub { $task->prepare }, qr/foo/ );
+ throws_ok( sub { $task->run }, qr/bar/ );
+ throws_ok( sub { $task->finish }, qr/baz/ );
+}
+
+
+
+
+
+######################################################################
+# Repeat with the handle
+
+SCOPE: {
+ my $task = Padre::Task::Eval->new(
+ prepare => 'die "foo";',
+ run => 'die "bar";',
+ finish => 'die "baz";',
+ );
+ my $handle = Padre::TaskHandle->new($task);
+ isa_ok( $task, 'Padre::Task::Eval' );
+ isa_ok( $handle, 'Padre::TaskHandle' );
+
+ # Do they throw normal exceptions
+ is( $handle->prepare, '', '->prepare ok' );
+ is( $handle->run, '', '->run ok' );
+ is( $handle->finish, '', '->finish ok' );
+}
@@ -0,0 +1,65 @@
+#!/usr/bin/perl
+
+# Create the task manager
+
+use strict;
+use warnings;
+use Test::More tests => 16;
+use Test::NoWarnings;
+use Time::HiRes ();
+use Padre::Logger;
+use Padre::TaskManager ();
+use Padre::Task::Addition ();
+use Padre::Wx::App ();
+use t::lib::Padre::NullWindow ();
+
+# Do we start with no threads as expected
+is( scalar( threads->list ), 0, 'No threads' );
+
+
+
+
+
+######################################################################
+# Basic Creation
+
+SCOPE: {
+ my $wxapp = Padre::Wx::App->new;
+ isa_ok( $wxapp, 'Padre::Wx::App' );
+
+ my $window = t::lib::Padre::NullWindow->new;
+ isa_ok( $window, 't::lib::Padre::NullWindow' );
+
+ my $manager = Padre::TaskManager->new( conduit => $window );
+ isa_ok( $manager, 'Padre::TaskManager' );
+ is( scalar( threads->list ), 0, 'No threads' );
+
+ # Run the startup process
+ ok( $manager->start, '->start ok' );
+ Time::HiRes::sleep(0.1);
+ is( scalar( threads->list ), 3, 'Three threads exists' );
+
+ # Create the sample task
+ my $addition = Padre::Task::Addition->new(
+ x => 2,
+ y => 3,
+ );
+ isa_ok( $addition, 'Padre::Task::Addition' );
+
+ # Schedule the task (which should trigger it's execution)
+ ok( $manager->schedule($addition), '->schedule ok' );
+
+ # Only the prepare phase should run (for now)
+ is( $addition->{prepare}, 1, '->{prepare} is false' );
+ is( $addition->{run}, 0, '->{run} is false' );
+ is( $addition->{finish}, 0, '->{finish} is false' );
+
+ # Run the shutdown process
+ ok( $manager->stop, '->stop ok' );
+ Time::HiRes::sleep(0.1);
+ is( scalar( threads->list ), 0, 'No threads' );
+}
+
+# Do we start with no threads as expected
+is( scalar( threads->list ), 0, 'No threads' );
+
@@ -0,0 +1,104 @@
+#!/usr/bin/perl
+
+# Create and test the task manager
+
+use strict;
+use warnings;
+use Test::More tests => 14;
+use Test::NoWarnings;
+use Padre::Logger ':ALL';
+use Storable ();
+use Time::HiRes ();
+use Padre::Wx ();
+use Padre::Wx::App ();
+use Padre::TaskManager ();
+use Padre::Task::Addition ();
+use t::lib::Padre::NullWindow ();
+
+
+
+
+
+######################################################################
+# Main Test Sequence
+
+# We will need a running application so the main thread can
+# receive events thrown from the child thread.
+my $wxapp = Padre::Wx::App->new;
+isa_ok( $wxapp, 'Padre::Wx::App' );
+
+# We also need a main window of some kind to handle events
+my $window = t::lib::Padre::NullWindow->new;
+isa_ok( $window, 't::lib::Padre::NullWindow' );
+
+my $manager = Padre::TaskManager->new( conduit => $window );
+isa_ok( $manager, 'Padre::TaskManager' );
+
+# Schedule the startup timer
+Wx::Event::EVT_TIMER( $wxapp, Padre::Wx::ID_TIMER_POSTINIT, \&startup );
+my $timer1 = Wx::Timer->new( $wxapp, Padre::Wx::ID_TIMER_POSTINIT );
+
+# Schedule the failure timeout
+Wx::Event::EVT_TIMER( $wxapp, Padre::Wx::ID_TIMER_LASTRESORT, \&timeout );
+my $timer2 = Wx::Timer->new( $wxapp, Padre::Wx::ID_TIMER_LASTRESORT );
+
+# Start the timers
+$timer1->Start( 1, 1 );
+$timer2->Start( 10000, 1 );
+
+
+
+
+
+######################################################################
+# Main Process
+
+# We start with no threads
+is( scalar( threads->list ), 0, 'No threads' );
+
+# Enter the wx loop
+# $window->Show(1) if $window;
+$wxapp->MainLoop;
+
+# We end with no threads
+is( scalar( threads->list ), 0, 'No threads' );
+
+
+
+
+
+######################################################################
+# Basic Creation
+
+sub startup {
+
+ # Run the startup process
+ ok( $manager->start, '->start ok' );
+ Time::HiRes::sleep(1);
+ is( scalar( threads->list ), 3, 'Three threads exists' );
+
+ # Create the sample task
+ my $addition = Padre::Task::Addition->new(
+ x => 2,
+ y => 3,
+ );
+ isa_ok( $addition, 'Padre::Task::Addition' );
+
+ # Schedule the task (which should trigger it's execution)
+ ok( $manager->schedule($addition), '->schedule ok' );
+ is( $addition->{prepare}, 1, '->{prepare} is false' );
+ is( $addition->{run}, 0, '->{run} is false' );
+ is( $addition->{finish}, 0, '->{finish} is false' );
+}
+
+sub timeout {
+
+ # Run the shutdown process
+ $timer1 = undef;
+ $timer2 = undef;
+ ok( $manager->stop, '->stop ok' );
+ sleep(1);
+
+ # $window->Show(0) if $window;
+ $wxapp->ExitMainLoop;
+}
@@ -0,0 +1,56 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use Test::More;
+use Padre::Constant;
+
+BEGIN {
+
+ require Win32 if Padre::Constant::WIN32;
+ unless ( $ENV{DISPLAY} or Padre::Constant::WIN32 ) {
+ plan skip_all => 'Needs DISPLAY';
+ exit 0;
+ }
+ if ( Padre::Constant::WIN32 ? Win32::IsAdminUser() : !$< ) {
+ plan skip_all => 'Cannot run as root';
+ exit 0;
+ }
+}
+
+plan tests => 14;
+
+use Test::NoWarnings;
+use File::Spec::Functions qw( catfile );
+use File::Temp ();
+use URI;
+
+BEGIN {
+ $ENV{PADRE_HOME} = File::Temp::tempdir( CLEANUP => 1 );
+}
+
+use_ok('Padre::Browser');
+use_ok('Padre::Task::Browser');
+use_ok('Padre::Browser::Document');
+
+my $db = Padre::Browser->new();
+
+ok( $db, 'instance Padre::Browser' );
+
+my $doc = Padre::Browser::Document->load( catfile( 'lib', 'Padre', 'Browser.pm' ) );
+isa_ok( $doc, 'Padre::Browser::Document' );
+ok( $doc->mimetype eq 'application/x-perl', 'Mimetype is sane' );
+my $docs = $db->docs($doc);
+isa_ok( $docs, 'Padre::Browser::Document' );
+
+my $tm = $db->resolve( URI->new('perldoc:Test::More') );
+isa_ok( $tm, 'Padre::Browser::Document' );
+ok( $tm->mimetype eq 'application/x-pod', 'Resolve from uri' );
+cmp_ok( $tm->title, 'eq', 'Test::More', 'Doc title discovered' );
+
+my $view = $db->browse($tm);
+isa_ok( $view, 'Padre::Browser::Document' );
+ok( $view->mimetype eq 'text/xhtml', 'Got html view' );
+cmp_ok( $view->title, 'eq', 'Test::More', 'Title' );
+
+
@@ -1,56 +0,0 @@
-#!/usr/bin/perl
-
-use strict;
-use warnings;
-use Test::More;
-use Padre::Constant;
-
-BEGIN {
-
- require Win32 if Padre::Constant::WIN32;
- unless ( $ENV{DISPLAY} or Padre::Constant::WIN32 ) {
- plan skip_all => 'Needs DISPLAY';
- exit 0;
- }
- if ( Padre::Constant::WIN32 ? Win32::IsAdminUser() : !$< ) {
- plan skip_all => 'Cannot run as root';
- exit 0;
- }
-}
-
-plan tests => 14;
-
-use Test::NoWarnings;
-use File::Spec::Functions qw( catfile );
-use File::Temp ();
-use URI;
-
-BEGIN {
- $ENV{PADRE_HOME} = File::Temp::tempdir( CLEANUP => 1 );
-}
-
-use_ok('Padre::DocBrowser');
-use_ok('Padre::Task::DocBrowser');
-use_ok('Padre::DocBrowser::document');
-
-my $db = Padre::DocBrowser->new();
-
-ok( $db, 'instance Padre::DocBrowser' );
-
-my $doc = Padre::DocBrowser::document->load( catfile( 'lib', 'Padre', 'DocBrowser.pm' ) );
-isa_ok( $doc, 'Padre::DocBrowser::document' );
-ok( $doc->mimetype eq 'application/x-perl', 'Mimetype is sane' );
-my $docs = $db->docs($doc);
-isa_ok( $docs, 'Padre::DocBrowser::document' );
-
-my $tm = $db->resolve( URI->new('perldoc:Test::More') );
-isa_ok( $tm, 'Padre::DocBrowser::document' );
-ok( $tm->mimetype eq 'application/x-pod', 'Resolve from uri' );
-cmp_ok( $tm->title, 'eq', 'Test::More', 'Doc title discovered' );
-
-my $view = $db->browse($tm);
-isa_ok( $view, 'Padre::DocBrowser::document' );
-ok( $view->mimetype eq 'text/xhtml', 'Got html view' );
-cmp_ok( $view->title, 'eq', 'Test::More', 'Title' );
-
-
@@ -0,0 +1,63 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use Test::More tests => 18;
+use Test::NoWarnings;
+use Storable ();
+use File::Spec ();
+use Padre::Wx::Directory::Path ();
+
+my @bits = qw{ Foo Bar Baz };
+
+
+
+
+
+######################################################################
+# Testing a file
+
+SCOPE: {
+ my $file = Padre::Wx::Directory::Path->file(@bits);
+ isa_ok( $file, 'Padre::Wx::Directory::Path' );
+ is( $file->type, Padre::Wx::Directory::Path::FILE, '->type ok' );
+ is( $file->name, 'Baz', '->name ok' );
+ is( $file->unix, 'Foo/Bar/Baz', '->unix ok' );
+ is_deeply( [ $file->path ], \@bits, '->path ok' );
+ is( $file->is_file, 1, '->is_file ok' );
+ is( $file->is_directory, 0, '->is_directory ok' );
+}
+
+
+
+
+
+######################################################################
+# Testing a directory
+
+SCOPE: {
+ my $directory = Padre::Wx::Directory::Path->directory(@bits);
+ isa_ok( $directory, 'Padre::Wx::Directory::Path' );
+ is( $directory->type, Padre::Wx::Directory::Path::DIRECTORY, '->type ok' );
+ is( $directory->name, 'Baz', '->name ok' );
+ is( $directory->unix, 'Foo/Bar/Baz', '->unix ok' );
+ is_deeply( [ $directory->path ], \@bits, '->path ok' );
+ is( $directory->is_file, 0, '->is_file ok' );
+ is( $directory->is_directory, 1, '->is_directory ok' );
+}
+
+
+
+
+
+######################################################################
+# Storable Compatibility
+
+SCOPE: {
+ my $file = Padre::Wx::Directory::Path->file(@bits);
+ isa_ok( $file, 'Padre::Wx::Directory::Path' );
+ my $string = Storable::freeze($file);
+ ok( length $string, 'Got a string' );
+ my $round = Storable::thaw($string);
+ is_deeply( $file, $round, 'File round-trips ok' );
+}
@@ -0,0 +1,50 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use Test::More tests => 13;
+use Test::NoWarnings;
+use File::Spec ();
+use Padre::Wx::Directory::Path ();
+use Padre::Wx::Directory::Task ();
+
+my $plugins = 'plugins/Padre/Plugin';
+my $root = File::Spec->catdir( 't', 'files' );
+ok( -d $root, 'Root path exists' );
+
+
+
+
+
+######################################################################
+# Scan a known tree
+
+my $task = new_ok(
+ 'Padre::Wx::Directory::Task',
+ [ root => $root,
+ skip => [
+ "\\B\\.svn\\b",
+ ],
+ ]
+);
+ok( $task->run, '->run ok' );
+is( $task->{root}, $root, '->{root} ok' );
+is( ref( $task->{model} ), 'ARRAY', '->{model} ok' );
+my @files = @{ $task->{model} };
+is( scalar( grep { !$_->isa('Padre::Wx::Directory::Path') } @files ), 0,
+ 'All files are Padre::Wx::Directory::Path objects',
+);
+my @directories = grep { $_->is_directory } @files;
+is( scalar(@directories), 4, 'Found four directories' );
+
+# Test the deepest of them (also confirms the sorting worked)
+my $deepest = $directories[3];
+is( $deepest->type, Padre::Wx::Directory::Path::DIRECTORY, 'DIRECTORY ->type ok' );
+is( $deepest->unix, $plugins, '->path ok' );
+is_deeply(
+ [ $deepest->path ],
+ [ 'plugins', 'Padre', 'Plugin' ],
+ '->spec ok',
+);
+is( $deepest->is_file, 0, '->is_file' );
+is( $deepest->is_directory, 1, '->is_directory' );
@@ -0,0 +1,53 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use Test::More tests => 7;
+use Test::NoWarnings;
+use File::Spec ();
+use Padre::Project::Perl ();
+use Padre::Wx::Directory::Path ();
+use Padre::Wx::Directory::Task ();
+
+# Locate the test project
+my $root = File::Spec->catdir( 't', 'collection', 'Config-Tiny' );
+my $project = new_ok(
+ 'Padre::Project::Perl' => [
+ root => $root,
+ ]
+);
+
+
+
+
+
+######################################################################
+# Scan a known tree via a project
+
+my $task = new_ok(
+ 'Padre::Wx::Directory::Task',
+ [ project => $project,
+ ]
+);
+ok( $task->run, '->run ok' );
+is( ref( $task->{model} ), 'ARRAY', '->{model} ok' );
+my @files = @{ $task->{model} };
+is( scalar( grep { !$_->isa('Padre::Wx::Directory::Path') } @files ), 0,
+ 'All files are Padre::Wx::Directory::Path objects',
+);
+is_deeply(
+ [ map { $_->unix } @files ],
+ [ qw{
+ Changes
+ lib
+ lib/Config
+ lib/Config/Tiny.pm
+ Makefile.PL
+ t
+ t/01_compile.t
+ t/02_main.t
+ test.conf
+ }
+ ],
+ 'Config-Tiny project contains expected files',
+);
@@ -42,11 +42,11 @@ SCOPE: {
is_deeply(
$msgs,
[ { 'msg' => 'Missing right curly or square bracket, at end of line',
- 'severity' => 'E',
+ 'severity' => 0,
'line' => '17'
},
{ 'msg' => 'syntax error, at EOF',
- 'severity' => 'E',
+ 'severity' => 0,
'line' => '17'
}
]
@@ -192,7 +192,7 @@ SCOPE: {
is_deeply(
$end,
{ 'msg' => $msg,
- 'severity' => 'W',
+ 'severity' => 1,
'line' => '1',
}
);
@@ -1,126 +0,0 @@
-#!/usr/bin/perl
-
-use strict;
-use warnings;
-use Test::More;
-
-BEGIN {
- $| = 1; # Flush for the threads
- unless ( $ENV{DISPLAY} or $^O eq 'MSWin32' ) {
- plan skip_all => 'Needs DISPLAY';
- exit 0;
- }
- plan tests => 108;
-}
-use t::lib::Padre;
-use threads; # need to be loaded before Padre
-use threads::shared; # need to be loaded before Padre
-use Padre::Task;
-use t::lib::Padre::Task::Test;
-use t::lib::Padre::Task::PPITest;
-
-our $TestClass; # secret Task class name accessible in the test threads. See also way below
-
-# reminiscent of the in-thread worker loop in Padre::TaskManager:
-sub fake_run_task {
- my $string = shift;
-
- # try to recover the serialized task from its Storable-dumped form to an object
- my $recovered = Padre::Task->deserialize( \$string );
- ok( defined $recovered, "recovered form defined" );
- isa_ok( $recovered, 'Padre::Task' );
- isa_ok( $recovered, $TestClass ); # a subcalss of Padre::Task
-
- if ( threads->tid() == 0 ) { # main thread
- # Test the execution in the main thread in case worker threads are disabled
- ok( exists( $recovered->{main_thread_only} )
- && ( not exists( $recovered->{_main_thread_data_id} ) )
- && $recovered->{main_thread_only} eq 'not in sub thread',
- "main-thread data stays available in main thread"
- );
- } else {
-
- # Test the execution in a worker thread
- ok( ( not exists( $recovered->{main_thread_only} ) ) && exists( $recovered->{_main_thread_data_id} ),
- "main-thread data not available in worker thread"
- );
- }
-
- # call the test task's run method
- $recovered->run();
- $string = undef;
-
- # ship the thing back at the end
- $recovered->serialize( \$string );
- ok( defined $string );
- return $string;
-}
-
-# helper sub that runs a test task. Reminiscent of what the user would do
-# plus what the scheduler does
-sub fake_execute_task {
- my $class = shift;
- my $test_spec = shift;
- my $use_threads = $test_spec->{threading};
- my $extra_data = $test_spec->{extra_data} || {};
- my $tests_in_thread = $test_spec->{thread_tests} || 0;
-
- # normally user code:
- $class->new( text => 'foo' ); # FIXME necessary for the following to pass for Padre::Task::PPITest???
- ok( $class->can('new'), "task can be constructed" );
- my $task = $class->new( main_thread_only => "not in sub thread", %$extra_data );
- isa_ok( $task, 'Padre::Task' );
- isa_ok( $task, $class );
- ok( $task->can('prepare'), "can prepare" );
-
- # done by the scheduler:
- $task->prepare();
- my $string;
- $task->serialize( \$string );
- ok( defined $string, "serialized form defined" );
-
- if ($use_threads) {
- my $thread = threads->create( \&fake_run_task, $string );
- $string = $thread->join();
-
- # modify main thread copy of test counter since
- # it was copied for the worker thread.
- my $tb = Test::Builder->new();
- $tb->current_test( $tb->current_test() + $tests_in_thread ); # XXX - watch out! Magic number of tests in thread
- isa_ok( $thread, 'threads' );
- } else {
- $string = fake_run_task($string);
- ok(1);
- }
-
- # done by the scheduler:
- my $final = Padre::Task->deserialize( \$string );
- ok( defined $final );
- ok( not exists $task->{answer} );
- $task->{answer} = 'succeed';
- if ( $task->isa("Padre::Task::Test") ) {
- is_deeply( $final, $task );
- } else {
- pass("Skipping deep comparison for non-basic tasks");
- }
- $final->finish();
-}
-
-package main;
-
-# simple task test
-$TestClass = "Padre::Task::Test";
-my $testspec = { threading => 0, thread_tests => 9, };
-fake_execute_task( $TestClass, $testspec );
-$testspec->{threading} = 1;
-fake_execute_task( $TestClass, $testspec );
-
-# PPI subtask test
-$TestClass = "Padre::Task::PPITest";
-$testspec->{thread_tests} = 11;
-$testspec->{extra_data} = { text => q(my $self = shift;) };
-$testspec->{threading} = 0;
-fake_execute_task( $TestClass, $testspec );
-
-$testspec->{threading} = 1;
-fake_execute_task( $TestClass, $testspec );
@@ -1,64 +0,0 @@
-#!/usr/bin/perl
-
-use strict;
-use warnings;
-use Test::More;
-
-BEGIN {
- unless ( $ENV{DISPLAY} or $^O eq 'MSWin32' ) {
- plan( skip_all => 'Needs DISPLAY' );
- exit 0;
- }
- plan( tests => 18 );
-}
-
-# This must exist and must be global.
-# It is examined by the code inside the test task.
-our $TestClass = 'Padre::Task::Test';
-
-# Need to load these before padre!
-use threads;
-use threads::shared;
-use t::lib::Padre;
-use Padre;
-
-# TODO: test in non-degraded mode
-
-use_ok('Padre::TaskManager');
-use_ok('Padre::Task');
-use_ok('Padre::Service');
-require t::lib::Padre::Task::Test;
-
-# Before we create the Padre object,
-# make sure that thread preference is off.
-my $config = Padre::Config->read;
-isa_ok( $config, 'Padre::Config' );
-ok( $config->set( threads => 0 ), '->set ok' );
-ok( $config->write, '->write ok' );
-
-# Create the object so that Padre->ide works
-my $app = Padre->new;
-isa_ok( $app, 'Padre' );
-
-my $task_manager = Padre::TaskManager->new(
- use_threads => 0,
-);
-isa_ok( $task_manager, 'Padre::TaskManager' );
-
-my $padre = Padre->ide;
-is_deeply(
- $task_manager,
- $padre->task_manager,
- 'TaskManager is a singleton',
-);
-
-my $task = Padre::Task::Test->new(
- main_thread_only => 'not in sub thread',
-);
-isa_ok( $task, 'Padre::Task::Test' );
-
-$task->prepare;
-$task->schedule;
-
-# TODO: check the issues with finish, etc.
-$task_manager->cleanup;
@@ -1,138 +0,0 @@
-#!/usr/bin/perl
-
-use strict;
-use warnings;
-use Test::More;
-
-BEGIN {
- unless ( $ENV{DISPLAY} or $^O eq 'MSWin32' ) {
- plan skip_all => 'Needs DISPLAY';
- exit 0;
- }
-}
-use threads; # need to be loaded before Padre
-use threads::shared; # need to be loaded before Padre
-use t::lib::Padre;
-use Padre::Service;
-
-# Create the object so that Padre->ide works
-my $app = Padre->new;
-isa_ok( $app, 'Padre' );
-
-
-# secret Task class name accessible in the test threads. See also way below
-our $TestClass;
-
-# reminiscent of the in-thread worker loop in Padre::TaskManager:
-sub fake_run_task {
- my $string = shift;
- my $spec = shift;
-
- # try to recover the serialized task from its Storable-dumped form to an object
- my $recovered = Padre::Task->deserialize( \$string );
-
- ok( defined $recovered, "recovered form defined" );
- isa_ok( $recovered, 'Padre::Task' );
- isa_ok( $recovered, $TestClass ); # a subcalss of Padre::Task
- #is_deeply($recovered, $task);
-
- # Test the execution in the main thread in case worker threads are disabled
- if ( threads->tid() == 0 ) { # main thread
- ok( exists( $recovered->{main_thread_only} )
- && ( not exists( $recovered->{_main_thread_data_id} ) )
- && $recovered->{main_thread_only} eq 'not in sub thread',
- "main-thread data stays available in main thread"
- );
- }
-
- # Test the execution in a worker thread
- else {
- ok( ( not exists( $recovered->{main_thread_only} ) ) && exists( $recovered->{_main_thread_data_id} ),
- "main-thread data not available in worker thread"
- );
- }
-
- # call the test task's run method
- $recovered->run();
- $string = undef;
-
- # ship the thing back at the end
- $recovered->serialize( \$string );
- return $string;
-}
-
-# helper sub that runs a test task. Reminiscent of what the user would do
-# plus what the scheduler does
-sub fake_execute_task {
- my $class = shift;
- my $test_spec = shift;
- my $use_threads = $test_spec->{threading};
- my $extra_data = $test_spec->{extra_data} || {};
- my $tests_in_thread = $test_spec->{thread_tests} || 0;
- my $tb = Test::Builder->new;
-
- # normally user code:
- $class->new( text => 'foo' ); # FIXME necessary for the following to pass for Padre::Task::PPITest???
- ok( $class->can('new'), "task can be constructed" );
- my $task = $class->new( main_thread_only => "not in sub thread", %$extra_data );
- isa_ok( $task, 'Padre::Task' );
- isa_ok( $task, $class );
- ok( $task->can('prepare'), "can prepare" );
-
- # done by the scheduler:
- $task->prepare();
- my $string;
- $task->serialize( \$string );
- ok( defined $string, "serialized form defined" );
-
- if ($use_threads) {
- my $thread = threads->create( \&fake_run_task, $string, $test_spec );
- $string = $thread->join();
- $tb->current_test( $tb->current_test() + $tests_in_thread );
- isa_ok( $thread, 'threads' );
- } else {
- $string = fake_run_task($string);
- $tb->current_test( $tb->current_test() + $tests_in_thread );
- ok( $string, 'Returned from unthreaded service !' );
- }
-
- # done by the scheduler:
- my $final = Padre::Task->deserialize( \$string );
- ok( defined $final );
- ok( not exists $task->{answer} );
-
- TODO: {
- local $TODO = 'Cleanup the shambolic references in ::Service de/serialize';
- is_deeply( $final, $task );
- }
-
- $task->{answer} = 'succeed';
- $final->finish();
-}
-
-package main;
-
-# simple service test
-$TestClass = "Padre::Service";
-my $testspec = { threading => 0, thread_tests => 11, };
-fake_execute_task( $TestClass, $testspec );
-
-# threaded service test
-$testspec->{threading} = 1;
-$testspec->{thread_tests} += 4; # serializer/tests
-fake_execute_task( $TestClass, $testspec );
-done_testing();
-
-=pod
-
-# PPI subtask test
-$TestClass = "Padre::Task::PPITest";
-$testspec->{thread_tests} = 11;
-$testspec->{extra_data} = {text => q(my $self = shift;)};
-$testspec->{threading} = 0;
-fake_execute_task($TestClass, $testspec);
-
-$testspec->{threading} = 1;
-fake_execute_task($TestClass, $testspec);
-
-=cut
@@ -0,0 +1,47 @@
+package t::lib::Padre::NullWindow;
+
+# This is an empty null main window, so that we can test multi-thread
+# code without having to actually build all of the Padre main window.
+
+use 5.008;
+use strict;
+use warnings;
+use Padre::Wx ();
+use Padre::Logger;
+
+our $VERSION = '0.64';
+our @ISA = qw{
+ Padre::Wx::Role::Conduit
+ Wx::Frame
+};
+
+# NOTE: This is just a test window so don't add Wx::gettext
+use constant NAME => 'Padre Null Test Window';
+
+sub new {
+ TRACE($_[0]) if DEBUG;
+ my $class = shift;
+
+ # Basic constructor
+ my $self = $class->SUPER::new(
+ undef, -1,
+ NAME,
+ [ -1, -1 ],
+ [ -1, -1 ],
+ Wx::wxDEFAULT_FRAME_STYLE,
+ );
+
+ # Set various properties
+ $self->SetTitle(NAME);
+ $self->SetMinSize(
+ Wx::Size->new( 100, 100 ),
+ );
+
+ # Register outself as the event conduit from child workers
+ # to the parent thread.
+ $self->conduit_init;
+
+ return $self;
+}
+
+1;
@@ -1,40 +0,0 @@
-package Padre::Task::PPITest;
-use strict;
-use warnings;
-require Test::More;
-use base 'Padre::Task::PPI';
-
-sub prepare {
- my $self = shift;
- $self->SUPER::prepare(@_);
- Test::More::isa_ok( $self, "Padre::Task" );
- Test::More::isa_ok( $self, "Padre::Task::PPI" );
- Test::More::isa_ok( $self, $main::TestClass );
- $self->{msg} = "query";
-}
-
-sub process_ppi {
- my $self = shift;
- my $ppi = shift;
- Test::More::isa_ok( $self, "Padre::Task" );
- Test::More::isa_ok( $self, "Padre::Task::PPI" );
- Test::More::isa_ok( $self, $main::TestClass );
- Test::More::is( $self->{msg}, "query", "message received in worker" );
- Test::More::ok( !exists $self->{_process_class}, "_process_class was cleaned" );
- Test::More::isa_ok($ppi, 'PPI::Document');
- $self->{answer} = 'succeed';
-}
-
-sub finish {
- my $self = shift;
- $self->SUPER::finish(@_);
- Test::More::isa_ok( $self, "Padre::Task" );
- Test::More::isa_ok( $self, "Padre::Task::PPI" );
- Test::More::isa_ok( $self, $main::TestClass );
- Test::More::is( $self->{msg}, "query", "message survived worker" );
- Test::More::is( $self->{answer}, "succeed", "message from worker" );
- Test::More::ok( !exists $self->{_process_class}, "_process_class was cleaned" );
-}
-
-1;
-
@@ -1,34 +0,0 @@
-package Padre::Task::Test;
-
-use strict;
-use warnings;
-use Test::More ();
-use base 'Padre::Task';
-
-sub prepare {
- my $self = shift;
- Test::More::isa_ok( $self, "Padre::Task" );
- Test::More::isa_ok( $self, $main::TestClass );
- $self->{msg} = "query";
-}
-
-sub run {
- my $self = shift;
- Test::More::isa_ok( $self, "Padre::Task" );
- Test::More::isa_ok( $self, $main::TestClass );
- Test::More::is( $self->{msg}, "query", "message received in worker" );
- Test::More::ok( !exists $self->{_process_class}, "_process_class was cleaned" );
- $self->{answer} = 'succeed';
-}
-
-sub finish {
- my $self = shift;
- Test::More::isa_ok( $self, "Padre::Task" );
- Test::More::isa_ok( $self, $main::TestClass );
- Test::More::is( $self->{msg}, "query", "message survived worker" );
- Test::More::is( $self->{answer}, "succeed", "message from worker" );
- Test::More::ok( !exists $self->{_process_class}, "_process_class was cleaned" );
-}
-
-1;
-
@@ -43,7 +43,10 @@ foreach my $module ( sort keys %modules ) {
ok( $module->VERSION, "$module: Found \$VERSION" );
}
-# list of non-Wx modules still having Wx code
+# List of non-Wx modules still having Wx code.
+# This list is way-the-hell too long, stop putting stuff in here just
+# to prevent failing the test. It should be an absolute last resort.
+# Go away and try to find a way to not have Wx stuff in your code first.
my %TODO = map { $_ => 1 } qw(
Padre::Action::Edit
Padre::Action::View
@@ -60,18 +63,11 @@ my %TODO = map { $_ => 1 } qw(
Padre::Plugin::Devel
Padre::Plugin::My
Padre::PluginManager
- Padre::Service
Padre::Splash
Padre::Task::LaunchDefaultBrowser
- Padre::Task::Outline
- Padre::Task::PPI::FindUnmatchedBrace
- Padre::Task::PPI::FindVariableDeclaration
- Padre::Task::PPI::IntroduceTemporaryVariable
- Padre::Task::PPI::LexicalReplaceVariable
- Padre::Task::SyntaxChecker
+ Padre::TaskThread
+ Padre::TaskHandle
Padre::TaskManager
-
- Padre::Task::Examples::WxEvent
);
foreach my $module ( sort keys %modules ) {
@@ -111,7 +107,7 @@ foreach my $module ( sort keys %modules ) {
SKIP: {
unless (eval { $module->can('current') }
and $module ne 'Padre::Current'
- and $module ne 'Padre::Wx::Role::MainChild' )
+ and $module ne 'Padre::Wx::Role::Main' )
{
skip( "No ->current method", 1 );
}
@@ -42,6 +42,13 @@ foreach my $file (@files) {
}
next;
}
+ if ( $^O ne 'MSWin32' and $file eq 'Padre/Util/Win32.pm' ) {
+ foreach ( 1 .. 2 ) {
+ Test::More->builder->skip("'$file' is for Windows only");
+ }
+ next;
+ }
+
system qq($^X -e "require $module; print 'ok';" > $out 2>$err);
my $err_data = slurp($err);
is( $err_data, '', "STDERR of $file" );
@@ -8,19 +8,23 @@ use strict;
use warnings;
use Test::More;
-#use Test::NoWarnings;
+# use Test::NoWarnings;
use File::Temp ();
-use File::Spec();
-
-plan skip_all => 'DISPLAY not set'
- unless $ENV{DISPLAY}
- or ( $^O eq 'MSWin32' );
+use File::Spec ();
# Don't run tests for installs
unless ( $ENV{AUTOMATED_TESTING} or $ENV{RELEASE_TESTING} ) {
plan( skip_all => "Author tests not required for installation" );
}
+unless ( $ENV{DISPLAY} or $^O eq 'MSWin32' ) {
+ plan skip_all => 'DISPLAY not set';
+}
+
+if ( $^O eq 'MSWin32' ) {
+ plan skip_all => 'Crashing currently blocks the entire test suite on Win32';
+}
+
my $devpl;
# Search for dev.pl
@@ -54,8 +58,9 @@ $ENV{PADRE_HOME} = $dir->dirname;
# Complete the dev.pl - command
$cmd .= $devpl . ' --invisible -- --home=' . $dir->dirname;
$cmd .= ' ' . File::Spec->catfile( $dir->dirname, 'newfile.txt' );
-$cmd
- .= ' --actionqueue=file.new,edit.goto,edit.join_lines,edit.comment_toggle,edit.comment,edit.uncomment,edit.tabs_to_spaces,edit.spaces_to_tabs,edit.show_as_hex,help.current,help.about,file.quit';
+$cmd .= ' --actionqueue=file.new,edit.goto,edit.join_lines,edit.comment_toggle';
+$cmd .= ',edit.comment,edit.uncomment,edit.tabs_to_spaces,edit.spaces_to_tabs';
+$cmd .= ',edit.show_as_hex,help.current,help.about,file.quit';
my $output = `$cmd 2>&1`;
@@ -5,6 +5,11 @@ use warnings;
use Test::More;
use File::Find::Rule;
+# Don't run tests for installs
+unless ( $ENV{AUTOMATED_TESTING} or $ENV{RELEASE_TESTING} ) {
+ plan( skip_all => "Author tests not required for installation" );
+}
+
my %test_texts = (
".class { border: 1px solid; } a { text-decoration: none; }" => 'text/css',
'[% PROCESS Padre %]' => 'text/x-perltt',
@@ -73,7 +78,6 @@ foreach my $file ( sort( keys(%test_files) ) ) {
# Some files that actually exist on-disk
foreach my $file ( sort keys %existing_test_files ) {
my $text = slurp("xt/files/$file");
-
require Padre::Locale;
my $encoding = Padre::Locale::encoding_from_string($text);
$text = Encode::decode( $encoding, $text );
@@ -11,8 +11,8 @@ BEGIN {
}
my @MODULES = (
- 'Perl::MinimumVersion 1.20',
- 'Test::MinimumVersion 0.008',
+ 'Perl::MinimumVersion 1.25',
+ 'Test::MinimumVersion 0.101080',
);
# Don't run tests for installs