File: MRU.pm

package info (click to toggle)
libdemeter-perl 0.9.27%2Bds6-9
  • links: PTS, VCS
  • area: contrib
  • in suites: forky, sid, trixie
  • size: 74,028 kB
  • sloc: perl: 73,233; python: 2,196; makefile: 1,999; ansic: 1,368; lisp: 454; sh: 74
file content (139 lines) | stat: -rw-r--r-- 3,797 bytes parent folder | download
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
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
package  Demeter::UI::Wx::MRU;

=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 Wx qw( :everything );
use base qw(Wx::SingleChoiceDialog);
use Wx::Event qw(EVT_CLOSE EVT_LISTBOX EVT_BUTTON EVT_RADIOBOX);

use List::MoreUtils qw(any);

use Demeter qw(:none);

## type is either a scalar containing a string or an array reference
## pointing to an array of strings
sub new {
  my ($class, $parent, $type, $text, $title) = @_;

  my @types = (ref($type) =~ m{ARRAY}) ? @$type : ($type);

  my @list = Demeter->get_mru_list(@types);
  unshift(@list, ["Open a blank Atoms window", '-----']) if any {$_ eq 'atoms'} @types;
  return -1 if not @list;

  my @mrulist = (ref($type) =~ m{ARRAY})
    ? map { sprintf "[ %s ]  %s", $_->[1], $_->[0] } @list
      : map { $_->[0] } @list;
  my @toss;
  $#toss = $#mrulist;

  my $dialog = $class->SUPER::new( $parent,
				   $text  || "Select a recent $type file",
				   $title || "Recent $type files",
				   \@mrulist); #, \@mrulist, wxCENTRE, Wx::GetMousePosition);
#				   \@toss,
#				   wxDEFAULT_DIALOG_STYLE | wxRESIZE_BORDER | wxOK | wxCANCEL | wxCENTRE,
#				   Wx::GetMousePosition);
  _doublewide($dialog);

  return $dialog;
};

sub _doublewide {
  my ($dialog) = @_;
  my ($w, $h) = $dialog->GetSizeWH;
  $dialog -> SetSizeWH(2*$w, $h);
};

sub _pad {
  my ($string, $width) = @_;
  $width ||= 10;
  my $len = length $string;
  return $string if ($len >= 10);
  my $left = int($len/2);
  my $right = $len - $left;
  return " " x $left . $string . " " x $right;
};

1;

package Wx::SingleChoiceDialog;
sub GetMruSelection {
  my ($self) = @_;
  my $file = $self->GetStringSelection;
  $file =~ s{\A\[.+\]\s+}{}; # this will simply not match if the filename is not preceded by its type
  return $file;
};

1;

=head1 NAME

Demeter::UI::Wx::MRU - A Wx dialog for selecting from Demeter's most recently used files

=head1 VERSION

This documentation refers to Demeter version 0.9.26.

=head1 SYNOPSIS

This provides a dialog for selecting from one or more of Demeter's
most recently used files.

  use Demeter::UI::Wx::MRU;
  $dialog = Demeter::UI::Wx::MRU->new($self, $type,
                                      "Select a recent $type file",
                                      "Recent $type files");
  $file = $dialog->GetMruSelection if ( $dialog->ShowModal != wxID_CANCEL );

C<$type> is one the strings recognized by L<Demeter::MRU>.  C<$file>
is a fully resolve file path.

=head1 DESCRIPTION

This posts a Wx
L<SingleChoiceDialog|http://docs.wxwidgets.org/2.8.4/wx_wxsinglechoicedialog.html#wxsinglechoicedialog>
instrumented to display and selection from one of Demeter's lists of
recently used files.

=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