File Manager (Perl Gtk2)

From LiteratePrograms
Jump to: navigation, search

This program is under development.
Please help to debug it. When debugging
is complete, remove the {{develop}} tag.

Screenshot

NOTE: This program is not well-tested, and could, in the worst case, destroy important files. So take care!

In this article we describe a simple, configurable file manager written in Perl/Gtk2. This is not a complete file manager ready for daily use. It is intended as an example of how to use Gtk2 with Perl.

The file manager provides a graphic interface for performing the standard operations on directories and files, such as viewing directory listings and opening or moving files. When it starts up, the file manager reads a configuration file called rc. This file specifies (among other things) the size of the filemanager window, and which applications to use when opening different types of files. Here's a small example of a configuration file:

<<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

The program itself is built upon the functionality of three Perl modules:

  • Gtk2 for user interface
  • Cwd to get current working directory
  • File to get the file name part of a path name
<<modules>>=
use Gtk2 -init;
use Cwd;
use File::Basename;


Contents

[edit] Structure of the file manager program

Like most Perl programs, the file manager begins with an invocation of Perl itself. We need all the help we can get from Perl, so we use strict and warnings.

<<fm.perl>>=
#!/usr/bin/env perl

use strict;
use warnings;

modules
globals
dir
rc_parsing
support
callbacks
create_ui
run

[edit] Globals

We use global variables to avoid sending lots of variables to callbacks and support functions. This simplifies initial development, but can create problems when expanding the program. To separate them from other variables, we use the g_-prefix.

<<globals>>=

use vars qw($g_model $g_view $g_pathbox $g_hbutton $g_mainwin);
use vars qw($g_path $g_menu $g_copyfpath $g_cutflag);
use vars qw($g_cmdbarbox $g_cmdlabel $g_cmdbox);
use vars qw($g_sigcmdactivate $g_sigcmdkey);
use vars qw(@g_hidden);
use vars qw($g_lscmd);

[edit] Startup actions

[edit] Starting directory

The first action the file manager performs is to read the first command-line argument. This argument is assumed to be a directory name, so the file manager changes the current directory to that specified by the argument.

<<dir>>=

my $rawpath=shift || ".";

if($rawpath ne ".") {
	chdir($rawpath);
}
$g_path=getcwd;

[edit] Parse rc-file

The user can create a configuration file called rc in the $HOME/.fm directory. That file contains lines in the form name: value.

If we can read this file, we store these name/value pairs in %vars.

<<rc_parsing>>=

my %vars=();

my $rcfname=$ENV{HOME}."/.fm/rc";

if(open(INIFILE, $rcfname)) {
	while(my $line=<INIFILE>) {
		chomp($line);
		if(!$line) {next;}
		$line=~s/[ \t]*#.*$//;
		if(!$line) {next;}
		my ($vname, $vvalue)=split(/:[ \t]*/, $line);
		$vars{$vname}=$vvalue;
		
	}
	close(INIFILE);
}

If the rc file contained sizex and/or sizey they are used as the initial window size. If not, we use default values.

<<rc_parsing>>=
my $defx=$vars{'defx'} || 320;
my $defy=$vars{'defy'} || 480;

hidden is a regular expression used to hide some files. The default value is to hide all files with names starting with ., or ending with ~.

<<rc_parsing>>=
my $hidden=$vars{'hidden'} || "^\\.:~\$";

@g_hidden=split(':', $hidden);

Some implementations of ls needs special options to print date/time in the format we use, so we make the ls command configurable.

<<rc_parsing>>=

$g_lscmd=$vars{'lscmd'} || "ls -la";

[edit] Support functions

[edit] ishidden()

This function takes a file name as argument, and checks if it matches any of the regular expressions in g_hidden.

<<support>>=

sub ishidden
{
	my ($fname)=@_;

	foreach my $re (@g_hidden) {
		if($fname=~/$re/) {return 1;}
	}
	0;
}


[edit] quotepath()

quotepath() changes a path so that special characters are quoted.

<<support>>=

sub quotepath
{
	my ($rawpath)=@_;

	$rawpath=~s/\"/\\\"/g;
	my $qpath="\"".$rawpath."\"";

	$qpath;
}

[edit] Update file list

This function return a Gtk2::ListStore object containing a list of files. This object is used as the model for a Gtk2::TreeView object.

<<support>>=

sub getfiles
{
	my ($path)=@_;

	my $qpath=quotepath($path);
	
	my @record;
	my $store=Gtk2::ListStore->new(("Glib::String")x5);

	open(DIRLIST, "$g_lscmd $qpath | sed '1d' |");
	while(<DIRLIST>) {
		my $line=$_;
		chomp($line);

		my ($access, $links, $owner, $group, 
			$size, $month, $day, $time, 
			$fname)=split(/[ \t]+/, "$line", 9);

		if($g_hbutton->get_active() || !ishidden($fname)) {
			$store->set($store->append, 
				0=>$fname, 1=>$owner, 2=>$group, 
				3=>$access, 4=>$size);
		}
	}
	close(DIRLIST);

	$store;
}

update() takes a directory path as the only argument, and will update the list of files to the content of that directory.

<<support>>=

sub update
{
	chdir(shift);
	$g_path=getcwd;
	$g_pathbox->set_text($g_path);
	$g_model=getfiles($g_path);
	$g_view->set_model($g_model);
}

[edit] Operations on files

[edit] New

<<support>>=
sub cmdbox_key_cb
{
	my ($cmdbox, $event)=@_;
		
	if($event->keyval==0xFF1B) {
		$g_cmdbox->signal_handler_disconnect($g_sigcmdactivate);
		$g_cmdbox->signal_handler_disconnect($g_sigcmdkey);
		$g_cmdbarbox->hide;
		return 1;
	}

	0;
}
<<support>>=
sub newany_cb
{
	my ($cmdbox, $filetype)=@_;

	my $fname=$cmdbox->get_text;

	my $qfname=quotepath($fname);
	if($filetype eq "directory") {
		system("mkdir $qfname")==0 || print "Error: $?";
	} elsif($filetype eq "file") {
		system("touch $qfname")==0 || print "Error: $?";
	}

	$g_cmdbox->signal_handler_disconnect($g_sigcmdactivate);
	$g_cmdbox->signal_handler_disconnect($g_sigcmdkey);
	$g_cmdbarbox->hide;
	update($g_path);
}
<<support>>=
sub newany
{
	my ($filetype)=@_;

	$g_cmdlabel->set_text("Name of new $filetype:");
	$g_cmdbox->set_text("");

	$g_sigcmdactivate=$g_cmdbox->signal_connect("activate", \&newany_cb, $filetype);

	$g_sigcmdkey=$g_cmdbox->signal_connect("key-press-event", \&cmdbox_key_cb);
	$g_cmdbox->signal_connect("focus_out_event", sub {$g_cmdbarbox->hide;});
	$g_cmdbarbox->show_all;
	$g_cmdbox->grab_focus;
}

[edit] Open

This function takes a file name as argument, and tries to open that file, using a specification from the rc file.

The specification is in the form open(<regexps>): <cmd>, where <regexps> is a comma-separated list of regular expressions for matching the file name, and <cmd> is the command to run (with system()). If no matches are found, it will use open.default.

<<support>>=

sub openfile
{
	my ($fname)=@_;
	while(my ($vname, $vvalue)=each(%vars)) {
		my ($type, $res, $rest)=split(/[\(\)]/, $vname);
		if(!$res) {next;}
		my @ares=split(/,/, $res);
		foreach my $re (@ares) {
			if($fname =~ /$re/) {
				system("$vvalue $fname &"); 
				return;
			};
		}
	}
	my $qfname=quotepath($fname);
	system("$vars{'open.default'} $qfname &");
}

This function is called when any object (file or directory) is opened. When opening a directory, it uses update() to change current directory. When open a file, openfile() is used to call an external program.

<<support>>=

sub openany
{
	my ($fname, $mpath)=@_;

	if(-d $fname) {update($fname);}
	else {openfile($fname);}
}

[edit] Move/copy

For moving files, we use the "Cut/Paste" method. When the user select "Cut" from the popup menu, the complete path of the selected file is stored in $g_path. $g_cutflag is set to "+", to indicate that this file shall be moved, not copied.

<<support>>=

sub cutany
{
	my ($fname)=@_;

	if($g_cutflag && $g_cutflag=="+") {	# Undo cut
		$g_cutflag="";
	} else {			# Do cut
		$g_cutflag="+";
		$g_copyfpath=$g_path."/".$fname;
	}
}

copyany() works like cutany(), except $g_cutflag is cleared.

<<support>>=

sub copyany
{
	my ($fname)=@_;

	$g_cutflag="";
	$g_copyfpath=$g_path."/".$fname;
}

This function is called when the user selects "Paste" from the popup menu.

<<support>>=

sub pasteany
{
	my ($fname)=@_;

	my $copypath=dirname($g_copyfpath);
	if($g_copyfpath eq "") {return;}
	my $pastefpath=quotepath($g_path);

	if($copypath ne $g_path) {
		my $copyfname=basename($g_copyfpath);

If the file name allready exists in the current directory, we ask the user if he wants to replace the file. Gtk2::MessageDialog makes this easy.

<<support>>=
		if(-e $copyfname) {
			my $dialog=Gtk2::MessageDialog->new($g_mainwin, 
				'modal', 'question', 'yes_no', "Overwrite?");
			my $reply=$dialog->run();
			$dialog->destroy;
			if($reply ne "yes") {return;}
		}

We must check $g_cutflag to see if the file should be move or copied.

<<support>>=
		my $copyfpath=quotepath($g_copyfpath);
		if($g_cutflag eq "+") {
			system("mv $copyfpath $pastefpath/")==0 || 
					print "Error: $?";
		} else {
			system("cp -R $copyfpath $pastefpath/")==0 || 
					print "Error: $?";
		}
		update($g_path);
		$g_cutflag="";
		$g_copyfpath="";
	}
}

[edit] Rename

When renaming a file, we must provide a way for the user to type the new file name. This is done with a separate toolbar that is normally hidden.

When the user select Rename from the popup menu, we must first make the $g_cmdbarbox toolbar ready. That includes changing the text of $g_cmdlabel to reflect the expected user action and provide the old file name as a default value in $g_cmdbox.

<<support>>=

rename_cb

sub renameany
{
	my ($fname)=@_;

	$g_cmdlabel->set_text("New name for $fname:");
	$g_cmdbox->set_text($fname);

We provide a signal handler for the activate signal, so that rename_cb() is called when the user presses Enter.

<<support>>=
	$g_sigcmdactivate=$g_cmdbox->signal_connect("activate", \&rename_cb, $fname);

To allow the user to change his mind, we provide a way to escape from the rename-"mode" by pressing ESC. To accomplish this, we need to watch every key-press in $g_cmdbox.

In GTK, the value 0xFF18 is the key value for ESC. If we receive this value, we clean up the signal handlers, hide $g_cmdbarbox, and return 1 to indicate that we have handled the key-press event. For every other keys, we return 0, to indicate that the toolkit should handle the event.

<<support>>=
	$g_sigcmdkey=$g_cmdbox->signal_connect("key-press-event", \&cmdbox_key_cb);
	
	$g_cmdbox->signal_connect("focus_out_event", sub {$g_cmdbarbox->hide;});
	$g_cmdbarbox->show_all;
	$g_cmdbox->grab_focus;
}

The rename_cb() function is called when the user has entered the new file name. We use the mv shell command to rename the file.

<<rename_cb>>=

sub rename_cb
{
	my ($cmdbox, $oldfname)=@_;

	my $newfname=$cmdbox->get_text;

	system("mv $oldfname $newfname")==0 || print "Error: $?";

We release the signal handlers and hide $g_cmdbarbox when the job is done.

<<rename_cb>>=
	$g_cmdbox->signal_handler_disconnect($g_sigcmdactivate);
	$g_cmdbox->signal_handler_disconnect($g_sigcmdkey);
	$g_cmdbarbox->hide;
	update($g_path);
}

[edit] Delete

<<support>>=

sub deleteany
{
	my ($fname)=@_;

	if(-d $fname) {
		system("rm -rf $fname/")==0 || 
			print "Error: $?";
	} else {
		system("rm -f $fname")==0 || 
			print "Error: $?";
	}
	
	update($g_path);
}

[edit] Callbacks

Gtk2 uses callbacks to report user actions.

[edit] click_cb

click_cb is called every time a user clicks on a file.

<<callbacks>>=

sub click_cb
{
	my ($view, $event)=@_;

If it is a right-click, we will show a popu menu for the selected file.

<<callbacks>>=
	if($event->button==3) {
		my $selection=$view->get_selection;

If no files are selected, we let the right-click implicitly select the file the user clicked on.

<<callbacks>>=
		if($selection->count_selected_rows<1) {
			my ($x, $y)=$event->get_coords;
			my $mpath=$view->get_path_at_pos($x, $y);
			if($mpath) {
				$selection->select_path($mpath);
			}
		}

$g_menu is an object of type Gtk2::Menu, that is created on startup. We use the popup() method to show the menu.

<<callbacks>>=
		$g_menu->popup(undef, undef, undef, undef,
			$event->button, $event->time);

If it was a right-click, we return 1 to indicate that we have handled the event. If not, we return 0, so that Gtk2 can handle it.

<<callbacks>>=
		return 1;
	}
	0;
}

[edit] up_cb

This function is called when the user clicks on the up-button. The call to update() will change to parent directory and update the file list.

<<callbacks>>=

sub up_cb
{
	if($g_path ne "/") {
		update("..");
	}
	1;
}

[edit] open_cb

open_cb() is called when the user either double-click on a file, or press enter when a file is selected.

<<callbacks>>=

sub open_cb
{
	my ($g_view, $mpath, $col)=@_;

This will fetch the file name (first column) from the selected line in file list.

<<callbacks>>=
	my $fname=$g_model->get($g_model->get_iter($mpath), 0);

We call openany(), which knows how to open a file or directory, and return 1 to indicate that we have completely handled the event.

<<callbacks>>=
	openany($fname, $mpath);
	1;
}

[edit] menu_cb

This function is called when the user selects a menu item from the popup menu.

<<callbacks>>=

sub menu_cb
{
	my ($item, $event)=@_;

We simply use the text of the menu item to decide what to do.

<<callbacks>>=
	my $text=$item->get_child->get_text;

If the menu item is New File, New Directory or Paste, we don't care which files are selected, and just call the appropriate function.

<<callbacks>>=
	if($text eq "New File") {
		newany("file");
		return;
	} elsif($text eq "New Directory") {
		newany("directory");
		return;
	} elsif($text eq "Paste") {
		pasteany(".", undef);
		return;
	}

In all other cases, we must iterate through all files and call the appropriate function for each file.

<<callbacks>>=
	my $selection=$g_view->get_selection;
	my @mpaths=$selection->get_selected_rows;
	foreach my $mpath (@mpaths) {
		my $fname=$g_model->get($g_model->get_iter($mpath), 0);
		if($text eq "Open") {openany($fname, $mpath);}
		elsif($text eq "Cut") {cutany($fname, $mpath);}
		elsif($text eq "Copy") {copyany($fname, $mpath);}
		elsif($text eq "Rename") {renameany($fname, $mpath);}
		elsif($text eq "Delete") {deleteany($fname, $mpath);}
	}
}

[edit] Creating widgets

[edit] Main window

To create a window in Gtk2, we use the class Gtk2::Window.

<<create_ui>>=

$g_mainwin=Gtk2::Window->new;
$g_mainwin->set_title($g_path . " - fm");
$g_mainwin->set_default_size($defx, $defy);

The destroy signal is sent when the user closes the window. We connect this signal to Gtk2->main_quit, which will terminate the Gtk2 main loop (and stop the program).

<<create_ui>>=
$g_mainwin->signal_connect("destroy", sub {Gtk2->main_quit;});

Gtk2::Window can only contain one widget, so we use a Gtk2::VBox, which can contain multiple widgets. Gtk2::VBoxs child widgets will be arranged vertically.

<<create_ui>>=

my $mainvbox=Gtk2::VBox->new;

We use the add method to add $mainvbox to $g_mainwin. This method can be used on all classes derived from Gtk2::Container to add any object derived from Gtk2::Widget.

<<create_ui>>=
$g_mainwin->add($mainvbox);

[edit] Toolbar and command bar

To create a toolbar on the upper edge of the window, we use a Gtk2::HBox, which works like Gtk2::VBox, except it's child widgets will be arranged horizontally. Gtk2 also has a Toolbar class, but the extra functionality provided is not neccessary in this program.

<<create_ui>>=

my $tbbox=Gtk2::HBox->new;

When adding $tbbox to $mainvbox, we could have used add, but to get more control of the size of the child widgets, we use pack_start. By providing 0 as the second argument to pack_start, we state that $tbbox should not be given extra space.

<<create_ui>>=
$mainvbox->pack_start($tbbox, 0, 0, 0);

$upbutton is used to go to the parent directory. The signal clicked is connected to the up_cb callback function, which will be called every time the user clicks on the button.

<<create_ui>>=

my $upbutton=Gtk2::Button->new("^");
$upbutton->signal_connect("clicked", \&up_cb);
$tbbox->pack_start($upbutton, 0, 0, 0);

$g_pathbox is an entry-box, showing the current directory path. When the user has edited the path and presses enter, the activate signal is sent.

<<create_ui>>=

$g_pathbox=Gtk2::Entry->new;
$g_pathbox->set_text($g_path);
$g_pathbox->signal_connect("activate", sub {update($g_pathbox->get_text);});

We use 1 as the second argument to pack_start, to indicate that $g_pathbox whould be given extra space. The third argument indicates that the widget should use all of the extra space.

<<create_ui>>=
$tbbox->pack_start($g_pathbox, 1, 1, 0);

We use a Gtk2::CheckButton so that the user can choose if "hidden" files are shown. new_with_mnemonic("_H") creates a checkbox with an underlined H as the label. It also makes sure alt-H will toggle the ckeckbox.

<<create_ui>>=

$g_hbutton=Gtk2::CheckButton->new_with_mnemonic("_H");
$g_hbutton->signal_connect("toggled", sub {update($g_path);});
$tbbox->pack_start($g_hbutton, 0, 0, 0);

Here, we create a command bar for user-actions like renaming, that require text input.

<<create_ui>>=

$g_cmdbarbox=Gtk2::HBox->new;
$mainvbox->pack_start($g_cmdbarbox, 0, 0, 0);

$g_cmdlabel=Gtk2::Label->new("Cmd:");
$g_cmdbarbox->pack_start($g_cmdlabel, 0, 0, 0);

$g_cmdbox=Gtk2::Entry->new;
$g_cmdbarbox->pack_start($g_cmdbox, 1, 1, 0);

[edit] The file list

The file list can be quite large, so we need a vertical scrollbar. The easy way to do this is to create a Gtk2::ScrolledWindow. We use set_policy to indicate that we only want a vertical scroll bar.

<<create_ui>>=

my $scroll=Gtk2::ScrolledWindow->new;
$scroll->set_policy("never", "always");
$mainvbox->pack_start($scroll, 1, 1, 0);

To present the list of file, we use Gtk2::Treeview. We get the actual data from getfiles() which returns a Gtk2::ListStore. We must tell the Gtk2::TreeView to use the data. We do that by passing it as an argument to the Gtk2::Treeview constructor.

<<create_ui>>=

$g_model=getfiles($g_path);
$g_view=Gtk2::TreeView->new($g_model);

Gtk2::TreeView is able to render any kind of data, so we have to tell it that we have plain text. We create a Gtk2::CellRendererText to do that.

We also have to make a Gtk2::TreeViewColumn for each column we want.

<<create_ui>>=
my $renderer=Gtk2::CellRendererText->new;
my $n=0;
foreach my $name qw(Name Owner Group Access Size) {
	my $col=Gtk2::TreeViewColumn->new_with_attributes(
		$name, $renderer, 'text'=>$n);
	$col->set_sort_column_id($n);
	++$n;
	$g_view->append_column($col);
}

When opening, moving, copying or deleting files, we need to know which files the user have selected. Gtk2::TreeView provides get_selection to do that.

<<create_ui>>=
my $sel=$g_view->get_selection;
$sel->set_mode('multiple');

Here, we connect the callbacks used to catch right-click and double-click.

<<create_ui>>=
$g_view->signal_connect("button-press-event", \&click_cb);
$g_view->signal_connect("row-activated", \&open_cb);

To create a popu menu, we use Gtk2::Menu.

<<create_ui>>=

$g_menu=Gtk2::Menu->new;
foreach my $menutext qw(New.File New.Directory Open - Cut Copy Paste - Rename - Delete) {

Gtk2::SeparatorMenuItem is used to create a separator line in the menu.

<<create_ui>>=
	if($menutext eq "-") {
		$g_menu->append(Gtk2::SeparatorMenuItem->new);
	} else {

We use Gtk2::MenuItem to create regular menu items. The activate signal of all items are connected to menu_cb().

<<create_ui>>=
		my $text=$menutext;
		$text=~s/\./ /g;
		my $item=Gtk2::MenuItem->new($text);
		$item->signal_connect("activate", \&menu_cb);
		$g_menu->append($item);
	}
}

This code makes sure all menu items (text and separator) will be showed when the menu is opened.

<<create_ui>>=
$g_menu->show_all;

To give the user a hint of what the up-button and the "hidden files"-checkbox does, we add descriptive tooltips. Such tooltips could be added to almost any Gtk2 widget.

<<create_ui>>=

my $tips=Gtk2::Tooltips->new;
$tips->set_tip($g_hbutton, "Show hidden files");
$tips->set_tip($upbutton, "Go to parent directory");

The Gtk2::TreeView is added to the previously created Gtk2::ScrolledWindow.

<<create_ui>>=
$scroll->add_with_viewport($g_view);

The show_all() method will make sure all widgets inside the main window are visual. We do not want the command bar to be shown initially, so we use the hide() method.

An alternative method is to call show() on each individual widget, allowing for fine-grained control of which widgets to show.

<<create_ui>>=
$g_mainwin->show_all;
$g_cmdbarbox->hide;

[edit] Running gtk

<<run>>=
Gtk2->main;

0;
Download code
hijacker
hijacker
hijacker
hijacker