Padre

 view release on metacpan or  search on metacpan

lib/Padre/Lock.pm  view on Meta::CPAN

sub new {
	my $class  = shift;
	my $locker = shift;
	my $self   = bless [$locker], $class;

	# Enable the locks
	my $db     = 0;
	my $aui    = 0;
	my $config = 0;
	my $busy   = 0;
	my $update = 0;
	foreach (@_) {
		if ( $_ ne uc $_ ) {
			$locker->method_increment($_);
			push @$self, 'method_decrement';

		} elsif ( $_ eq 'CONFIG' ) {

			# Have CONFIG take an implicit DB lock as well so
			# that any writes for DB locks opened while the CONFIG

lib/Padre/Lock.pm  view on Meta::CPAN

		} elsif ( $_ eq 'DB' ) {
			$locker->db_increment unless $db;
			$db = 1;

		} elsif ( $_ eq 'AUI' ) {
			$locker->aui_increment unless $aui;
			$aui = 1;

		} elsif ( $_ eq 'BUSY' ) {
			$locker->busy_increment unless $busy;
			$busy = 1;

		} else {
			Carp::croak("Unknown or unsupported special lock '$_'");
		}
	}

	# Regardless of which order we were given the locks, the unlocking
	# definitely has to be done in a specific order.
	#
	# Putting DB last means that actions involving a database commit
	# will APPEAR to happen faster. However, this could be somewhat
	# disconcerting for long commits, because there will be user input
	# lag immediately after it appears to be "complete". If this
	# becomes a problem, move the DB to first so actions appear to be
	# slower, but the UI is immediately available once updated.
	#
	# Because configuration involves a database write, we always do it
	# before we release the database lock.
	push @$self, 'busy_decrement'   if $busy;
	push @$self, 'aui_decrement'    if $aui;
	push @$self, 'update_decrement' if $update;
	push @$self, 'db_decrement'     if $db;
	push @$self, 'config_decrement' if $config;

	return $self;
}

# Disable locking on destruction
sub DESTROY {

lib/Padre/Locker.pm  view on Meta::CPAN

		config_depth => 0,

		# Padre::Wx::AuiManager Transaction lock
		aui_depth => 0,

		# Wx ->Update lock
		update_depth  => 0,
		update_locker => undef,

		# Wx "Busy" lock
		busy_depth  => 0,
		busy_locker => undef,

		# Padre ->refresh lock
		method_depth   => 0,
		method_pending => {},
	}, $class;
}

sub lock {
	Padre::Lock->new( shift, @_ );
}

lib/Padre/Locker.pm  view on Meta::CPAN

sub locked {
	my $self  = shift;
	my $asset = shift;
	if ( $asset eq 'UPDATE' ) {
		return !!$self->{update_depth};
	} elsif ( $asset eq 'REFRESH' ) {
		return !!$self->{method_depth};
	} elsif ( $asset eq 'AUI' ) {
		return !!$self->{aui_depth};
	} elsif ( $asset eq 'BUSY' ) {
		return !!$self->{busy_depth};
	} elsif ( $asset eq 'CONFIG' ) {
		return !!$self->{config_depth};
	} else {
		return !!$self->{method_pending}->{$asset};
	}
}

# During Padre shutdown we should disable all forms of screen updating,
# once we have completed all user-interactive steps in the shutdown.
# Calling the shutdown method will permanently ignore any and all attempts

lib/Padre/Locker.pm  view on Meta::CPAN

	unless ( --$self->{aui_depth} ) {
		return if $self->{shutdown};

		# Unlocked for the final time
		$self->{owner}->aui->Update;
		$self->{owner}->Layout;
	}
	return;
}

sub busy_increment {
	my $self = shift;
	unless ( $self->{busy_depth}++ ) {

		# If we are in shutdown, the application isn't painting anyway
		# (or possibly even visible) so don't put us into busy state.
		return if $self->{shutdown};

		# Locking for the first time
		$self->{busy_locker} = Wx::BusyCursor->new;
	}
	return;
}

sub busy_decrement {
	my $self = shift;
	unless ( --$self->{busy_depth} ) {
		return if $self->{shutdown};

		# Unlocked for the final time
		$self->{busy_locker} = undef;
	}
	return;
}

sub method_increment {
	$_[0]->{method_depth}++;
	$_[0]->{method_pending}->{ $_[1] }++ if $_[1];
	return;
}

lib/Padre/TaskManager.pm  view on Meta::CPAN

=pod

=head2 schedule

The C<schedule> method is used to give a task to the task manager and indicate
it should be run as soon as possible.

This may be immediately (with the task sent to a worker before the method
returns) or it may be delayed until some time in the future if all workers
are busy.

As a convenience, this method returns true if the task could be dispatched
immediately, or false if it was queued for future execution.

=cut

sub schedule {
	TRACE( $_[1] ) if DEBUG;
	my $self = shift;
	my $task = Params::Util::_INSTANCE( shift, 'Padre::Task' );

lib/Padre/Wx/Browser.pm  view on Meta::CPAN

	$but_s->AddStretchSpacer(2);
	$but_s->Add( $close_button, 0, Wx::ALIGN_RIGHT | Wx::ALIGN_CENTER_VERTICAL );

	$top_s->Add( $but_s,            0, Wx::EXPAND );
	$top_s->Add( $self->{notebook}, 1, Wx::GROW );
	$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.

lib/Padre/Wx/Browser.pm  view on Meta::CPAN

######################################################################
# 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->Destroy;
}

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 {

lib/Padre/Wx/Browser.pm  view on Meta::CPAN

		$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;

lib/Padre/Wx/Browser.pm  view on Meta::CPAN

	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::OK | Wx::CENTRE | Wx::ICON_INFORMATION
	);

	$dialog->ShowModal;

lib/Padre/Wx/Main.pm  view on Meta::CPAN

The C<UPDATE> lock creates a Wx repaint lock using the built in
L<Wx::WindowUpdateLocker> class.

You should use an update lock during GUI construction/modification to
prevent screen flicker. As a side effect of not updating, the GUI changes
happen B<significantly> faster as well. Update locks should only be held for
short periods of time, as the operating system will begin to treat your
application as "hung" if an update lock persists for more than a few
seconds. In this situation, you may begin to see GUI corruption.

The C<BUSY> lock creates a Wx "busy" lock using the built in
L<Wx::WindowDisabler> class.

You should use a busy lock during times when Padre has to do a long and/or
complex operation in the foreground, or when you wish to disable use of any
user interface elements until a background thread is finished.

Busy locks can be held for long periods of time, however your users may
start to suspect trouble if you do not provide any periodic feedback to them.

Lowercase lock names are used to delay the firing of methods that will
themselves generate GUI events you may want to delay until you are sure
you want to rebuild the GUI.

lib/Padre/Wx/Output.pm  view on Meta::CPAN

sub style_bad {
	$_[0]->SetBackgroundColour('#FFCCCC');
	$_[0]->Refresh;
}

sub style_neutral {
	$_[0]->SetBackgroundColour('#FFFFFF');
	$_[0]->Refresh;
}

sub style_busy {
	$_[0]->SetBackgroundColour('#CCCCCC');
	$_[0]->Refresh;
}

sub set_font {
	my $self = shift;
	my $font = Wx::Font->new( 9, Wx::TELETYPE, Wx::NORMAL, Wx::NORMAL );
	my $name = $self->config->editor_font;
	if ( defined $name and length $name ) {
		$font->SetNativeFontInfoUserDesc($name);