1use Prima;
2use strict;
3use warnings;
4
5package Prima::sys::win32::FileDialog;
6use vars qw(@ISA);
7@ISA = qw(Prima::Component);
8use Prima::Utils;
9use Encode;
10
11return 1 if Prima::Application-> get_system_info->{apc} != apc::Win32;
12
13sub profile_default
14{
15	return {
16		%{$_[ 0]-> SUPER::profile_default},
17
18		defaultExt  => '',
19		fileName    => '',
20		filter      => [[ 'All files' => '*.*']],
21		filterIndex => 0,
22		directory   => '.',
23
24		createPrompt       => 0,
25		multiSelect        => 0,
26		noReadOnly         => 0,
27		noTestFileCreate   => 0,
28		overwritePrompt    => 1,
29		pathMustExist      => 1,
30		fileMustExist      => 1,
31		showHelp           => 0,
32
33		openMode           => 1,
34		text               => undef,
35	}
36}
37
38sub init
39{
40	my $self = shift;
41	my %profile = $self-> SUPER::init(@_);
42	$self-> {flags} = {
43		HIDEREADONLY => 1,
44		EXPLORER => 1,
45	};
46	for ( qw( filterIndex openMode)) { $self->{$_}=$profile{$_} }
47	for ( qw( defaultExt filter directory multiSelect
48		createPrompt fileMustExist noReadOnly noTestFileCreate
49		overwritePrompt pathMustExist showHelp
50	)) { $self->$_($profile{$_}) }
51	return %profile;
52}
53
54sub quoted_split
55{
56	my @ret;
57	$_ = $_[0];
58	s/(\\[^\\\s])/\\$1/g;
59	study;
60	{
61		/\G\s+/gc && redo;
62		/\G((?:[^\\\s]|\\.)+)\s*/gc && do {
63			my $z = $1;
64			$z =~ s/\\(.)/$1/g;
65			push(@ret, $z);
66			redo;
67		};
68		/\G(\\)$/gc && do { push(@ret, $1); redo; };
69	}
70	return @ret;
71}
72
73sub filter
74{
75	if ( $#_) {
76		my $self   = $_[0];
77		my @filter = @{$_[1]};
78		@filter = [[ '' => '*']] unless scalar @filter;
79		my @exts;
80		my @mdts;
81		for ( @filter) {
82			push @exts, $$_[0];
83			push @mdts, $$_[1];
84		}
85		$self-> {filterIndex} = scalar @exts - 1
86			if $self-> { filterIndex} >= scalar @exts;
87		$self-> {filter} = \@filter;
88	} else {
89		return @{$_[0]-> {filter}};
90	}
91}
92
93sub filterIndex
94{
95	if ( $#_) {
96		$_[0]-> {filterIndex} = $_[1];
97	} else {
98		return $_[0]-> {filterIndex};
99	}
100}
101
102sub directory
103{
104	return $_[0]->{directory} unless $#_;
105	$_[0]->{directory} = $_[1];
106}
107
108sub createPrompt
109{
110	return $_[0]->{flags}->{CREATEPROMPT} unless $#_;
111	$_[0]->{flags}->{CREATEPROMPT} = $_[1];
112}
113
114sub multiSelect
115{
116	return $_[0]->{flags}->{ALLOWMULTISELECT} unless $#_;
117	$_[0]->{flags}->{ALLOWMULTISELECT} = $_[1];
118}
119
120sub noReadOnly
121{
122	return $_[0]->{flags}->{NOREADONLYRETURN} unless $#_;
123	$_[0]->{flags}->{NOREADONLYRETURN} = $_[1];
124}
125
126sub noTestFileCreate
127{
128	return $_[0]->{flags}->{NOTESTFILECREATE} unless $#_;
129	$_[0]->{flags}->{NOTESTFILECREATE} = $_[1];
130}
131
132sub overwritePrompt
133{
134	return $_[0]->{flags}->{OVERWRITEPROMPT} unless $#_;
135	$_[0]->{flags}->{OVERWRITEPROMPT} = $_[1];
136}
137
138sub pathMustExist
139{
140	return $_[0]->{flags}->{PATHMUSTEXIST} unless $#_;
141	$_[0]->{flags}->{PATHMUSTEXIST} = $_[1];
142}
143
144sub fileMustExist
145{
146	return $_[0]->{flags}->{FILEMUSTEXIST} unless $#_;
147	$_[0]->{flags}->{FILEMUSTEXIST} = $_[1];
148}
149
150sub showHelp
151{
152	return $_[0]->{flags}->{SHOWHELP} unless $#_;
153	$_[0]->{flags}->{SHOWHELP} = $_[1];
154}
155
156sub fileName
157{
158	unless ( $#_) {
159		return $_[0]->{fileName} unless $_[0]->multiSelect;
160		my @s = quoted_split( $_[0]-> {fileName});
161		return $s[0] unless wantarray;
162		return @s;
163	}
164	$_[0]->{fileName} = $_[1];
165}
166
167sub defaultExt
168{
169	return $_[0]->{defaultExt} unless $#_;
170	$_[0]->{defaultExt} = $_[1];
171}
172
173sub openMode
174{
175	return $_[0]->{openMode} unless $#_;
176	$_[0]->{openMode} = $_[1];
177}
178
179sub text
180{
181	return $_[0]->{text} unless $#_;
182	$_[0]->{text} = $_[1];
183}
184
185# dummies
186sub sorted { 1 }
187sub showDotFiles { 1 }
188
189# mere callbacks if someone wants these to inherit
190sub ok {}
191sub cancel {}
192
193sub _set
194{
195	my @cmd = @_;
196	for my $c ( @cmd ) {
197		unless ( Encode::is_utf8($c)) {
198			my $v = Prima::Utils::local2sv($c);
199			$c = $v if defined $v;
200		}
201		$c = Encode::encode('utf-8', $c);
202	}
203	my $cmd = shift @cmd;
204	Prima::Application-> sys_action( "win32.OpenFile.$cmd=".join('', @cmd));
205}
206
207sub _get
208{
209	my $cmd = shift;
210	$cmd = Prima::Application-> sys_action( "win32.OpenFile.$cmd");
211	return Encode::decode('utf-8', $cmd);
212}
213
214sub execute
215{
216	my $self = $_[0];
217
218	_set( flags       => join(',', grep { $self->{flags}->{$_}} keys %{$self->{flags}}));
219	_set( filters     => join("\0", map { "$$_[0] ($$_[1])\0$$_[1]" } @{$self->{filter}}) . "\0");
220	_set( filterindex => ($self->{filterIndex}+1));
221	my $dir = $self->{directory};
222	$dir =~ s/\//\\/g;
223
224	_set( directory   => $dir);
225	_set( defext      => $self->{defaultExt});
226	_set( title       => $self->{text} // 'NULL');
227	my $ret = _get($self->{openMode} ? 'open' : 'save');
228	if ( !defined $ret) {
229		$self-> cancel;
230		return wantarray ? () : undef;
231	}
232	$self-> {directory} = $ret;
233	$self-> {directory} =~ s/(\\|\/)[^\\\/]+$//;
234	$self-> {directory} =~ s/\\/\//g;
235	$self-> {directory} =~ s/\s+$//;
236	$self-> {directory} .= '/' unless $self-> {directory} =~ /\/$/;
237	$self-> {fileName} = $ret;
238	if ( $self-> multiSelect) {
239		$self-> {fileName} = join( ' ', map {
240			s/\\/\//g;
241			$_ = $self->{directory} . $_ unless m/^\w\:/; # win32 absolute path, if any
242			s/([\\\s])/\\$1/g;
243			$_;
244		} quoted_split($self-> {fileName}));
245	} else {
246		$self-> {fileName} =~ s/\\/\//g;
247	}
248	$self-> {filterIndex} = _get('filterindex')-1;
249	$self-> ok;
250	return $self-> fileName;
251}
252
253package Prima::sys::win32::OpenDialog;
254use vars qw(@ISA);
255@ISA = qw(Prima::sys::win32::FileDialog);
256
257package Prima::sys::win32::SaveDialog;
258use vars qw(@ISA);
259@ISA = qw(Prima::sys::win32::FileDialog);
260
261sub profile_default
262{
263	return { %{$_[ 0]-> SUPER::profile_default},
264		openMode        => 0,
265		fileMustExist   => 0,
266	}
267}
268
2691;
270
271=head1 NAME
272
273Prima::sys::win32::FileDialog - Windows file system dialogs.
274
275=head1 DESCRIPTION
276
277The module mimics Prima file dialog classes C<Prima::Dialog::OpenDialog>
278and C<Prima::Dialog::SaveDialog>, defined in L<Prima::Dialog::FileDialog>. The
279class names registered in the module are the same, but in C<Prima::sys::win32>
280namespace.
281
282=head1 AUTHOR
283
284Dmitry Karasik, E<lt>dmitry@karasik.eu.orgE<gt>.
285
286=head1 SEE ALSO
287
288L<Prima::Dialog::FileDialog>
289
290=cut
291
292
293