1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122
|
package Demeter::UI::Wx::OverwritePrompt;
=for Copyright
.
Copyright (c) 2006-2019 Bruce Ravel (http://bruceravel.github.io/home).
All rights reserved.
.
This file is free software; you can redistribute it and/or
modify it under the same terms as Perl itself. See The Perl
Artistic License.
.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
=cut
use strict;
use warnings;
use Carp;
use Wx qw( :everything );
use base qw( Exporter );
our @EXPORT = qw(overwrite_prompt);
## return true if this file should not be overwritten
## return false if writing the file is ok (does not exists or can be overwritten)
sub overwrite_prompt {
my ($self, $file, $frame) = @_;
$frame ||= $self;
return 0 if (not -e $file);
my $yesno = Demeter::UI::Wx::VerbDialog->new($self, -1,
"Overwrite existing file \"$file\"?",
"Overwrite file?",
"Overwrite"
); ##Wx::GetMousePosition -- how is this done?
my $ok = $yesno->ShowModal;
if ($ok == wxID_NO) {
$frame->status("Not overwriting \"$file\"");
return 1;
};
return 0;
};
1;
=head1 NAME
Demeter::UI::Wx::OverwritePrompt - A prompt dialog for overwriting a file
=head1 VERSION
This documentation refers to Demeter version 0.9.26.
=head1 SYNOPSIS
After querying the user for a file using Wx::FileDialog:
my $file = $fd->GetPath;
return if $frame->overwrite_prompt($file);
The calling object should be a Wx::Frame in Athena or Artemis. Those
two programs add some functionality, including this, to Wx::Frame.
If that frame does not have its own statusbar, then you must specify a
second frame which does have a statusbar in which to display any
status messages:
my $file = $fd->GetPath;
return if $frame->overwrite_prompt($file, $other_frame);
This is not a general purpose tool. It has hardwired aspects that
rely upon coding conventions used in Athena and Artemis.
=head1 DESCRIPTION
The exports a method that posts a prompt about whether to overwrite a
file that exists. It returns true if the user does not want to
overwrite and returns false either if the file is to be overwritten or
if the file does not already exist.
This should not be necessary. It is an inelegant alternative to
specifying the C<wxFD_OVERWRITE_PROMPT> style for Wx::FileDialog.
However there exists a bug in gtk 2.20 (is that right? others?) that
leads to serious misbehaviour in certain situations. Using that
style, it is possible to have Wx::FileDialog return the wrong file,
resulting in the incorrect file being overwritten.
Here is more information:
L<https://bugzilla.gnome.org/show_bug.cgi?id=631908> and
L<https://bugs.launchpad.net/ubuntu/+source/gtk+2.0/+bug/558674>.
Until this bug is fixed at the level of gtk, the
C<wxFD_OVERWRITE_PROMPT> style cannot be safely used.
This is unused in 0.9.20. I am assuming that no one is still using
gtk 2.20. Fingers crossed....
=head1 BUGS AND LIMITATIONS
Please report problems to the Ifeffit Mailing List
(L<http://cars9.uchicago.edu/mailman/listinfo/ifeffit/>)
Patches are welcome.
=head1 AUTHOR
Bruce Ravel (L<http://bruceravel.github.io/home>)
L<http://bruceravel.github.io/demeter/>
=head1 LICENCE AND COPYRIGHT
Copyright (c) 2006-2019 Bruce Ravel (L<http://bruceravel.github.io/home>). All rights reserved.
This module is free software; you can redistribute it and/or
modify it under the same terms as Perl itself. See L<perlgpl>.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
=cut
|