Download code

Jump to: navigation, search

Back to File_Manager_(Perl_Gtk2)

Download for Windows: zip

Download for UNIX: zip, tar.gz, tar.bz2

rc

defx: 320  	# width
defy: 480	# height
hidden: ^\.

open(\.c$,\.cpp$): gvim
open(\.html?$): dillo
open(\.pdf,\.ps): xpdf
open(\.mpg,\.avi,\.wmv,\.mpeg,\.WMV): mplayer

open.default: gvim

# Uncomment this for some versions of GNU ls
#lscmd: ls -la --time-style=posix-locale



build.log

1 Can't locate Gtk2.pm in @INC (@INC contains: /etc/perl /usr/local/lib/perl/5.14.2 /usr/local/share/perl/5.14.2 /usr/lib/perl5 /usr/share/perl5 /usr/lib/perl/5.14 /usr/share/perl/5.14 /usr/local/lib/site_perl .) at /tmp/litprog3266204/fm.perl line 20.
2 BEGIN failed--compilation aborted at /tmp/litprog3266204/fm.perl line 20.


fm.perl

  1 #!/usr/bin/env perl
  2 # The authors of this work have released all rights to it and placed it
  3 # in the public domain under the Creative Commons CC0 1.0 waiver
  4 # (http://creativecommons.org/publicdomain/zero/1.0/).
  5 # 
  6 # THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
  7 # EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
  8 # MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
  9 # IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
 10 # CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
 11 # TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
 12 # SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
 13 # 
 14 # Retrieved from: http://en.literateprograms.org/File_Manager_(Perl_Gtk2)?oldid=19129
 15 
 16 
 17 use strict;
 18 use warnings;
 19 
 20 use Gtk2 -init;
 21 use Cwd;
 22 use File::Basename;
 23 
 24 use vars qw($g_model $g_view $g_pathbox $g_hbutton $g_mainwin);
 25 use vars qw($g_path $g_menu $g_copyfpath $g_cutflag);
 26 use vars qw($g_cmdbarbox $g_cmdlabel $g_cmdbox);
 27 use vars qw($g_sigcmdactivate $g_sigcmdkey);
 28 use vars qw(@g_hidden);
 29 use vars qw($g_lscmd);
 30 
 31 my $rawpath=shift || ".";
 32 
 33 if($rawpath ne ".") {
 34 	chdir($rawpath);
 35 }
 36 $g_path=getcwd;
 37 
 38 my %vars=();
 39 
 40 my $rcfname=$ENV{HOME}."/.fm/rc";
 41 
 42 if(open(INIFILE, $rcfname)) {
 43 	while(my $line=<INIFILE>) {
 44 		chomp($line);
 45 		if(!$line) {next;}
 46 		$line=~s/[ \t]*#.*$//;
 47 		if(!$line) {next;}
 48 		my ($vname, $vvalue)=split(/:[ \t]*/, $line);
 49 		$vars{$vname}=$vvalue;
 50 		
 51 	}
 52 	close(INIFILE);
 53 }
 54 my $defx=$vars{'defx'} || 320;
 55 my $defy=$vars{'defy'} || 480;
 56 my $hidden=$vars{'hidden'} || "^\\.:~\$";
 57 
 58 @g_hidden=split(':', $hidden);
 59 
 60 $g_lscmd=$vars{'lscmd'} || "ls -la";
 61 
 62 sub ishidden
 63 {
 64 	my ($fname)=@_;
 65 
 66 	foreach my $re (@g_hidden) {
 67 		if($fname=~/$re/) {return 1;}
 68 	}
 69 	0;
 70 }
 71 
 72 sub quotepath
 73 {
 74 	my ($rawpath)=@_;
 75 
 76 	$rawpath=~s/\"/\\\"/g;
 77 	my $qpath="\"".$rawpath."\"";
 78 
 79 	$qpath;
 80 }
 81 
 82 sub getfiles
 83 {
 84 	my ($path)=@_;
 85 
 86 	my $qpath=quotepath($path);
 87 	
 88 	my @record;
 89 	my $store=Gtk2::ListStore->new(("Glib::String")x5);
 90 
 91 	open(DIRLIST, "$g_lscmd $qpath | sed '1d' |");
 92 	while(<DIRLIST>) {
 93 		my $line=$_;
 94 		chomp($line);
 95 
 96 		my ($access, $links, $owner, $group, 
 97 			$size, $month, $day, $time, 
 98 			$fname)=split(/[ \t]+/, "$line", 9);
 99 
100 		if($g_hbutton->get_active() || !ishidden($fname)) {
101 			$store->set($store->append, 
102 				0=>$fname, 1=>$owner, 2=>$group, 
103 				3=>$access, 4=>$size);
104 		}
105 	}
106 	close(DIRLIST);
107 
108 	$store;
109 }
110 
111 sub update
112 {
113 	chdir(shift);
114 	$g_path=getcwd;
115 	$g_pathbox->set_text($g_path);
116 	$g_model=getfiles($g_path);
117 	$g_view->set_model($g_model);
118 }
119 sub cmdbox_key_cb
120 {
121 	my ($cmdbox, $event)=@_;
122 		
123 	if($event->keyval==0xFF1B) {
124 		$g_cmdbox->signal_handler_disconnect($g_sigcmdactivate);
125 		$g_cmdbox->signal_handler_disconnect($g_sigcmdkey);
126 		$g_cmdbarbox->hide;
127 		return 1;
128 	}
129 
130 	0;
131 }
132 sub newany_cb
133 {
134 	my ($cmdbox, $filetype)=@_;
135 
136 	my $fname=$cmdbox->get_text;
137 
138 	my $qfname=quotepath($fname);
139 	if($filetype eq "directory") {
140 		system("mkdir $qfname")==0 || print "Error: $?";
141 	} elsif($filetype eq "file") {
142 		system("touch $qfname")==0 || print "Error: $?";
143 	}
144 
145 	$g_cmdbox->signal_handler_disconnect($g_sigcmdactivate);
146 	$g_cmdbox->signal_handler_disconnect($g_sigcmdkey);
147 	$g_cmdbarbox->hide;
148 	update($g_path);
149 }
150 sub newany
151 {
152 	my ($filetype)=@_;
153 
154 	$g_cmdlabel->set_text("Name of new $filetype:");
155 	$g_cmdbox->set_text("");
156 
157 	$g_sigcmdactivate=$g_cmdbox->signal_connect("activate", \&newany_cb, $filetype);
158 
159 	$g_sigcmdkey=$g_cmdbox->signal_connect("key-press-event", \&cmdbox_key_cb);
160 	$g_cmdbox->signal_connect("focus_out_event", sub {$g_cmdbarbox->hide;});
161 	$g_cmdbarbox->show_all;
162 	$g_cmdbox->grab_focus;
163 }
164 
165 sub openfile
166 {
167 	my ($fname)=@_;
168 	while(my ($vname, $vvalue)=each(%vars)) {
169 		my ($type, $res, $rest)=split(/[\(\)]/, $vname);
170 		if(!$res) {next;}
171 		my @ares=split(/,/, $res);
172 		foreach my $re (@ares) {
173 			if($fname =~ /$re/) {
174 				system("$vvalue $fname &"); 
175 				return;
176 			};
177 		}
178 	}
179 	my $qfname=quotepath($fname);
180 	system("$vars{'open.default'} $qfname &");
181 }
182 
183 sub openany
184 {
185 	my ($fname, $mpath)=@_;
186 
187 	if(-d $fname) {update($fname);}
188 	else {openfile($fname);}
189 }
190 
191 sub cutany
192 {
193 	my ($fname)=@_;
194 
195 	if($g_cutflag && $g_cutflag=="+") {	# Undo cut
196 		$g_cutflag="";
197 	} else {			# Do cut
198 		$g_cutflag="+";
199 		$g_copyfpath=$g_path."/".$fname;
200 	}
201 }
202 
203 sub copyany
204 {
205 	my ($fname)=@_;
206 
207 	$g_cutflag="";
208 	$g_copyfpath=$g_path."/".$fname;
209 }
210 
211 sub pasteany
212 {
213 	my ($fname)=@_;
214 
215 	my $copypath=dirname($g_copyfpath);
216 	if($g_copyfpath eq "") {return;}
217 	my $pastefpath=quotepath($g_path);
218 
219 	if($copypath ne $g_path) {
220 		my $copyfname=basename($g_copyfpath);
221 		if(-e $copyfname) {
222 			my $dialog=Gtk2::MessageDialog->new($g_mainwin, 
223 				'modal', 'question', 'yes_no', "Overwrite?");
224 			my $reply=$dialog->run();
225 			$dialog->destroy;
226 			if($reply ne "yes") {return;}
227 		}
228 		my $copyfpath=quotepath($g_copyfpath);
229 		if($g_cutflag eq "+") {
230 			system("mv $copyfpath $pastefpath/")==0 || 
231 					print "Error: $?";
232 		} else {
233 			system("cp -R $copyfpath $pastefpath/")==0 || 
234 					print "Error: $?";
235 		}
236 		update($g_path);
237 		$g_cutflag="";
238 		$g_copyfpath="";
239 	}
240 }
241 
242 
243 sub rename_cb
244 {
245 	my ($cmdbox, $oldfname)=@_;
246 
247 	my $newfname=$cmdbox->get_text;
248 
249 	system("mv $oldfname $newfname")==0 || print "Error: $?";
250 	$g_cmdbox->signal_handler_disconnect($g_sigcmdactivate);
251 	$g_cmdbox->signal_handler_disconnect($g_sigcmdkey);
252 	$g_cmdbarbox->hide;
253 	update($g_path);
254 }
255 
256 
257 sub renameany
258 {
259 	my ($fname)=@_;
260 
261 	$g_cmdlabel->set_text("New name for $fname:");
262 	$g_cmdbox->set_text($fname);
263 	$g_sigcmdactivate=$g_cmdbox->signal_connect("activate", \&rename_cb, $fname);
264 	$g_sigcmdkey=$g_cmdbox->signal_connect("key-press-event", \&cmdbox_key_cb);
265 	
266 	$g_cmdbox->signal_connect("focus_out_event", sub {$g_cmdbarbox->hide;});
267 	$g_cmdbarbox->show_all;
268 	$g_cmdbox->grab_focus;
269 }
270 
271 
272 sub deleteany
273 {
274 	my ($fname)=@_;
275 
276 	if(-d $fname) {
277 		system("rm -rf $fname/")==0 || 
278 			print "Error: $?";
279 	} else {
280 		system("rm -f $fname")==0 || 
281 			print "Error: $?";
282 	}
283 	
284 	update($g_path);
285 }
286 
287 sub click_cb
288 {
289 	my ($view, $event)=@_;
290 	if($event->button==3) {
291 		my $selection=$view->get_selection;
292 		if($selection->count_selected_rows<1) {
293 			my ($x, $y)=$event->get_coords;
294 			my $mpath=$view->get_path_at_pos($x, $y);
295 			if($mpath) {
296 				$selection->select_path($mpath);
297 			}
298 		}
299 		$g_menu->popup(undef, undef, undef, undef,
300 			$event->button, $event->time);
301 		return 1;
302 	}
303 	0;
304 }
305 
306 sub up_cb
307 {
308 	if($g_path ne "/") {
309 		update("..");
310 	}
311 	1;
312 }
313 
314 sub open_cb
315 {
316 	my ($g_view, $mpath, $col)=@_;
317 	my $fname=$g_model->get($g_model->get_iter($mpath), 0);
318 	openany($fname, $mpath);
319 	1;
320 }
321 
322 sub menu_cb
323 {
324 	my ($item, $event)=@_;
325 	my $text=$item->get_child->get_text;
326 	if($text eq "New File") {
327 		newany("file");
328 		return;
329 	} elsif($text eq "New Directory") {
330 		newany("directory");
331 		return;
332 	} elsif($text eq "Paste") {
333 		pasteany(".", undef);
334 		return;
335 	}
336 	my $selection=$g_view->get_selection;
337 	my @mpaths=$selection->get_selected_rows;
338 	foreach my $mpath (@mpaths) {
339 		my $fname=$g_model->get($g_model->get_iter($mpath), 0);
340 		if($text eq "Open") {openany($fname, $mpath);}
341 		elsif($text eq "Cut") {cutany($fname, $mpath);}
342 		elsif($text eq "Copy") {copyany($fname, $mpath);}
343 		elsif($text eq "Rename") {renameany($fname, $mpath);}
344 		elsif($text eq "Delete") {deleteany($fname, $mpath);}
345 	}
346 }
347 
348 $g_mainwin=Gtk2::Window->new;
349 $g_mainwin->set_title($g_path . " - fm");
350 $g_mainwin->set_default_size($defx, $defy);
351 $g_mainwin->signal_connect("destroy", sub {Gtk2->main_quit;});
352 
353 my $mainvbox=Gtk2::VBox->new;
354 $g_mainwin->add($mainvbox);
355 
356 my $tbbox=Gtk2::HBox->new;
357 $mainvbox->pack_start($tbbox, 0, 0, 0);
358 
359 my $upbutton=Gtk2::Button->new("^");
360 $upbutton->signal_connect("clicked", \&up_cb);
361 $tbbox->pack_start($upbutton, 0, 0, 0);
362 
363 $g_pathbox=Gtk2::Entry->new;
364 $g_pathbox->set_text($g_path);
365 $g_pathbox->signal_connect("activate", sub {update($g_pathbox->get_text);});
366 $tbbox->pack_start($g_pathbox, 1, 1, 0);
367 
368 $g_hbutton=Gtk2::CheckButton->new_with_mnemonic("_H");
369 $g_hbutton->signal_connect("toggled", sub {update($g_path);});
370 $tbbox->pack_start($g_hbutton, 0, 0, 0);
371 
372 
373 $g_cmdbarbox=Gtk2::HBox->new;
374 $mainvbox->pack_start($g_cmdbarbox, 0, 0, 0);
375 
376 $g_cmdlabel=Gtk2::Label->new("Cmd:");
377 $g_cmdbarbox->pack_start($g_cmdlabel, 0, 0, 0);
378 
379 $g_cmdbox=Gtk2::Entry->new;
380 $g_cmdbarbox->pack_start($g_cmdbox, 1, 1, 0);
381 
382 
383 my $scroll=Gtk2::ScrolledWindow->new;
384 $scroll->set_policy("never", "always");
385 $mainvbox->pack_start($scroll, 1, 1, 0);
386 
387 $g_model=getfiles($g_path);
388 $g_view=Gtk2::TreeView->new($g_model);
389 my $renderer=Gtk2::CellRendererText->new;
390 my $n=0;
391 foreach my $name qw(Name Owner Group Access Size) {
392 	my $col=Gtk2::TreeViewColumn->new_with_attributes(
393 		$name, $renderer, 'text'=>$n);
394 	$col->set_sort_column_id($n);
395 	++$n;
396 	$g_view->append_column($col);
397 }
398 my $sel=$g_view->get_selection;
399 $sel->set_mode('multiple');
400 $g_view->signal_connect("button-press-event", \&click_cb);
401 $g_view->signal_connect("row-activated", \&open_cb);
402 
403 $g_menu=Gtk2::Menu->new;
404 foreach my $menutext qw(New.File New.Directory Open - Cut Copy Paste - Rename - Delete) {
405 	if($menutext eq "-") {
406 		$g_menu->append(Gtk2::SeparatorMenuItem->new);
407 	} else {
408 		my $text=$menutext;
409 		$text=~s/\./ /g;
410 		my $item=Gtk2::MenuItem->new($text);
411 		$item->signal_connect("activate", \&menu_cb);
412 		$g_menu->append($item);
413 	}
414 }
415 $g_menu->show_all;
416 
417 my $tips=Gtk2::Tooltips->new;
418 $tips->set_tip($g_hbutton, "Show hidden files");
419 $tips->set_tip($upbutton, "Go to parent directory");
420 $scroll->add_with_viewport($g_view);
421 $g_mainwin->show_all;
422 $g_cmdbarbox->hide;
423 Gtk2->main;
424 
425 0;


hijacker
hijacker
hijacker
hijacker