]> git.saurik.com Git - wxWidgets.git/blob - distrib/msw/tmake/lib/wxFileList.pm
Give app a default wxWidgets icon other than random one e.g. CD-ROM
[wxWidgets.git] / distrib / msw / tmake / lib / wxFileList.pm
1 package wxFileList;
2
3 =head1 NAME
4
5 wxFileList
6
7 =head1 SYNOPSIS
8
9 use wxFileList qw(grep_filetype grep_fileflag grep_not_fileflag
10 grep_source grep_header sort_files make_arrays);
11
12 # shorthand for
13 # @wxGeneric = sort_files grep_filetype 'Generic', @wxALL;
14 # @wxGenericInclude = sort_files grep_filetype 'GenericH', @wxALL;
15 make_arrays( 'wxGeneric', 'wxGenericInclude' );
16
17 =head1 METHODS
18
19 =cut
20
21 use strict;
22
23 # alias wxALL from main
24 use vars qw(@wxALL);
25 *wxALL = \@main::wxALL;
26
27 use base 'Exporter';
28 use vars qw(@EXPORT_OK %EXPORT_TAGS);
29
30 @EXPORT_OK = qw(grep_filetype grep_fileflag grep_not_fileflag
31 grep_source grep_header sort_files make_arrays);
32
33 %EXPORT_TAGS = ( 'default' => [ qw(grep_filetype grep_fileflag grep_source
34 grep_not_fileflag grep_header
35 sort_files) ],
36 );
37
38 my %type_2_array = (
39 Common => "wxCommon",
40 Generic => "wxGeneric",
41 GenericH => "wxGenericInclude",
42 HTML => "wxHtml",
43 HtmlH => "wxHtmlInclude",
44 Motif => "wxMotif",
45 MotifH => "wxMotifInclude",
46 ProtoH => "wxProtocolInclude",
47 Unix => "wxUnix",
48 UnixH => "wxUnixInclude",
49 WXH => "wxWxInclude",
50 );
51 # inverse mapping
52 my %array_2_type = map { ( $type_2_array{$_}, $_ ) } keys %type_2_array;
53
54 sub _sort {
55 sort { $a->filename cmp $b->filename } @_;
56 }
57
58 =head2 grep_filetype
59
60 my @files = grep_filetype 'Type', @all_files;
61
62 Returns files in C<@all_files> whose file type matches C<'Type'>.
63
64 =cut
65
66 sub grep_filetype {
67 my $filetype = lc( shift );
68
69 return _sort grep { $filetype eq lc( $_->filetype ) } @_;
70 }
71
72 =head2 grep_fileflag
73
74 =head2 grep_not_fileflag
75
76 my @files = grep_fileflag 'NotX', @all_files;
77 my @files2 = grep_not_fileflag 'NotX', @all_files;
78
79 Return files in C<@all_files> [not] having the given file flag.
80
81 =cut
82
83 sub grep_fileflag {
84 my $fileflag = shift;
85
86 return _sort grep { $_->has_flag( $fileflag ) } @_;
87 }
88
89 sub grep_not_fileflag {
90 my $fileflag = shift;
91
92 return _sort grep { !( $_->has_flag( $fileflag ) ) } @_;
93 }
94
95 =head2 grep_header
96
97 =head2 grep_source
98
99 my @headers = grep_header @all_files;
100 my @sources = grep_source @all_files;
101
102 Return header/source files contained in C<@all_files>.
103
104 =cut
105
106 sub grep_header {
107 return _sort grep { $_->is_header } @_;
108 }
109
110 sub grep_source {
111 return _sort grep { $_->is_source } @_;
112 }
113
114 =head2 sort_files
115
116 my @sorted_files = sort_files @files;
117
118 Sorts files by file name.
119
120 =cut
121
122 sub sort_files {
123 return sort { $a->{filename} cmp $b->{filename} } @_;
124 }
125
126 =head2 make_arrays
127
128 See SYNOPSIS.
129
130 =cut
131
132 sub make_arrays {
133 my( $package ) = caller;
134
135 foreach my $array ( @_ ) {
136 my $type = $array_2_type{$array};
137
138 unless( $type ) {
139 require Carp;
140 croak( "Invalid array name '$array'" );
141 }
142
143 no strict 'refs';
144 @{"${package}::${array}"} = sort_files grep_filetype $type, @wxALL;
145 }
146 }
147
148 1;