mop/project/templater.pl

   1 #!/usr/bin/perl
   2 use strict;
   3 use warnings;
   4 use Glib qw(TRUE FALSE);
   5 use Gtk2 -init;
   6
   7 my ($where,$taskdir,$home)=('/mo/public/templater/','/mo/templates/',$ENV{'HOME'});
   8 my @tasks = map { s#.*/##; $_ } (glob "$taskdir/*");
   9 my $contestName = "MO-P";
  10
  11 sub create_template($$$$) {
  12     my ($path,$task,$name,$ext)=@_;
  13     return "Project cannot be created!" unless -d $path;
  14     return "Specified project already exist!" if -d "$path/$name";
  15     mkdir "$path/$name" or return "Can not create project directory!";
  16     my %files = (
  17         c => {
  18                 "$where/template-c.cbp" => "$task.cbp",
  19                 "$where/template.layout" => "$task.layout",
  20                 "$taskdir/$task/$task.c" => "$task.c",
  21         },
  22         cpp => {
  23                 "$where/template-cpp.cbp" => "$task.cbp",
  24                 "$where/template.layout" => "$task.layout",
  25                 "$taskdir/$task/$task.cpp" => "$task.cpp",
  26         },
  27         pas => {
  28                 "$where/template-pas.lpi" => "${task}_main.lpi",
  29                 "$taskdir/$task/$task.pas" => "$task.pas",
  30         }
  31     );
  32     my $files = $files{$ext} // die "Unknown ext $ext\n";
  33     while (my ($file, $target) = each %$files) {
  34         $target="$path/$name/$target";
  35         # FUJ! S tímhle by se něco mělo dělat.
  36         system("sed 's#fILENAMe#$name#;
  37                      s#fILENAMEEXt#$name.$ext#;
  38                      s#tASk#$task#;
  39                      s#tASKEXt#$task.$ext#;
  40                      s#pATHFILENAMe#$path/$name/$name#;
  41                      s#pATHFILENAMEEXt#$path/$name/$name.$ext#;
  42                     ' < '$file' > '$target'");
  43     }
  44     return "";
  45 }
  46
  47 sub open_project($) {
  48     my ($p)=@_;
  49     my $cmd;
  50     my @files = glob "$home/$p/*.cbp";
  51     if (@files) {
  52         $cmd = 'codeblocks';
  53     } else {
  54         $cmd = 'lazarus-ide';
  55         @files = ((glob "$home/$p/*.lpi"), (glob "$home/$p/*.pas"));
  56     }
  57     print("@files\n");
  58     system("$cmd @files &");
  59 }
  60
  61 sub existing_projects($) {
  62     my ($lopen_data,$lang)=@_;
  63     foreach ((glob "$home/*/*.cbp"), (glob "$home/*/*.lpr")) {
  64         my ($name, $task) = m#.*/(.*?)/(.*)(_main\.lpr|\.cbp)#;
  65         print "$name $task\n";
  66         $lang=-f "$home/$name/$task.c" ? 'C' : -f "$home/$name/$task.cpp" ? 'C++' : -f "$home/$name/$task.pas" ? 'Pascal' : '';
  67         $lopen_data->set($lopen_data->append, 0, "$1", 1, $lang);
  68     }
  69 }
  70
  71 sub main_window() {
  72     my $retcode='';
  73
  74     my $w=Gtk2::Window->new('toplevel');
  75     $w->signal_connect('destroy' => sub { $retcode='quit' unless length $retcode; Gtk2->main_quit; });
  76     $w->set_default_icon_from_file("$where/templater.xpm");
  77     $w->set_position('center');
  78     $w->set_default_size(600,-1);
  79     $w->set_title("$contestName project management");
  80     my $b=Gtk2::VBox->new(FALSE,0);
  81     $b->set_border_width(10);
  82     $w->add($b);
  83
  84     my $fnew=Gtk2::Frame->new("Create new $contestName contest project");
  85     my $xnew=Gtk2::HBox->new(FALSE,0);
  86     $xnew->set_border_width(10);
  87     my $inew=Gtk2::Image->new_from_file("$where/templater.xpm");
  88     my $bnew=Gtk2::Button->new_with_label("Create new $contestName contest project");
  89     $bnew->signal_connect('clicked' => sub { $retcode='new'; $w->destroy; });
  90     $xnew->pack_start($inew,FALSE,TRUE,10);
  91     $xnew->pack_start($bnew,TRUE,TRUE,10);
  92     $fnew->add($xnew);
  93     $b->pack_start($fnew,FALSE,TRUE,10);
  94
  95     my $fopen=Gtk2::Frame->new("Open existing $contestName contest project");
  96     my $yopen=Gtk2::VBox->new(FALSE,0);    $yopen->set_border_width(5);
  97     my $xopen=Gtk2::HBox->new(FALSE,0);    $xopen->set_border_width(5);
  98     my $lopen_data=Gtk2::ListStore->new(('Glib::String','Glib::String'));
  99     existing_projects($lopen_data);
 100     my $lopen=Gtk2::TreeView->new_with_model($lopen_data);
 101     my $lopen_c1=Gtk2::TreeViewColumn->new_with_attributes('Project name',Gtk2::CellRendererText->new, text=>0);
 102     my $lopen_c2=Gtk2::TreeViewColumn->new_with_attributes('Language',Gtk2::CellRendererText->new, text=>1);
 103     $lopen_c1->set_expand(TRUE); $lopen->append_column($lopen_c1); $lopen->append_column($lopen_c2);
 104     my $iopen=Gtk2::Image->new_from_file("$where/templater.xpm");
 105     my $bopen=Gtk2::Button->new_with_label("Open existing $contestName contest project");
 106     $bopen->signal_connect('clicked' => sub { open_project $lopen_data->get(scalar($lopen->get_selection->get_selected),0),
 107                                               $w->destroy; });
 108     $bopen->set_sensitive(FALSE);
 109     $lopen->signal_connect('row-activated' => sub { $bopen->clicked });
 110     $lopen->get_selection->set_mode('single');
 111     $lopen->get_selection->signal_connect('changed' => sub { $bopen->set_sensitive(TRUE) } );
 112     $xopen->pack_start($iopen,FALSE,TRUE,10);
 113     $xopen->pack_start($bopen,TRUE,TRUE,10);
 114     $yopen->pack_start($lopen,TRUE,TRUE,5);
 115     $yopen->pack_start($xopen,FALSE,TRUE,5);
 116     $fopen->add($yopen);
 117     $b->pack_start($fopen,TRUE,TRUE,10);
 118
 119     my $bquit=Gtk2::Button->new_from_stock('gtk-quit');
 120     $bquit->signal_connect('clicked' => sub { $w->destroy; });
 121     $b->pack_start($bquit,FALSE,TRUE,5);
 122
 123     $w->show_all;
 124     Gtk2->main;
 125     $retcode;
 126 }
 127
 128 sub message($$$) {
 129     my $m=Gtk2::MessageDialog->new($_[0], 'modal', $_[2], 'ok', $_[1]);
 130     $m->run;
 131     $m->destroy;
 132     1
 133 }
 134
 135 sub new_window() {
 136     my $retcode='';
 137
 138     my $w=Gtk2::Window->new('toplevel');
 139     $w->signal_connect('destroy' => sub { $retcode='quit' unless length $retcode; Gtk2->main_quit; });
 140     $w->set_default_icon_from_file("$where/templater.xpm");
 141     $w->set_position('center');
 142     $w->set_default_size(500,-1);
 143     $w->set_title("Create new $contestName project");
 144
 145     my $b=Gtk2::VBox->new(FALSE,0);
 146     $b->set_border_width(10);
 147     $w->add($b);
 148
 149     my $flang=Gtk2::Frame->new('Choose project language');
 150     my $xlang=Gtk2::HBox->new(FALSE,0);
 151     $xlang->set_border_width(10);
 152     my $r_c=Gtk2::RadioButton->new_with_label(undef, 'C');
 153     my $r_cpp=Gtk2::RadioButton->new_with_label($r_c->get_group(), 'C++');
 154     my $r_pas=Gtk2::RadioButton->new_with_label($r_c->get_group(), 'Pascal');
 155     $r_c->set_active(TRUE);
 156     $xlang->pack_start($r_c,TRUE,TRUE,5);
 157     $xlang->pack_start($r_cpp,TRUE,TRUE,5);
 158     $xlang->pack_start($r_pas,TRUE,TRUE,5);
 159     $flang->add($xlang);
 160     $b->pack_start($flang,FALSE,TRUE,10);
 161
 162     my $ftask=Gtk2::Frame->new('Choose task');
 163     my $xtask=Gtk2::HBox->new(FALSE,0);
 164     $xtask->set_border_width(10);
 165     my $group;
 166     my $task = $tasks[0];
 167     for my $t (@tasks) {
 168             my $rb=Gtk2::RadioButton->new_with_label($group, $t);
 169             $rb->signal_connect(clicked => sub {
 170                 $task = $t;
 171             });
 172             unless ($group) {
 173                 $rb->set_active(TRUE);
 174                 $group=$rb->get_group();
 175             }
 176             $xtask->pack_start($rb,TRUE,TRUE,5);
 177     }
 178     $ftask->add($xtask);
 179     $b->pack_start($ftask,FALSE,TRUE,10);
 180
 181     my $fprj=Gtk2::Frame->new('Enter project name');
 182     my $eprj=Gtk2::Entry->new;
 183     $fprj->add($eprj);
 184     $b->pack_start(Gtk2::HBox->new(),TRUE,TRUE,0);
 185     $b->pack_start($fprj,FALSE,TRUE,10);
 186
 187     my $xcreate=Gtk2::HBox->new(FALSE,0);
 188     $xcreate->set_border_width(10);
 189     my $icreate=Gtk2::Image->new_from_file("$where/templater.xpm");
 190     my $bcreate=Gtk2::Button->new_from_stock('gtk-new');
 191     my $qcreate=Gtk2::Button->new_from_stock('gtk-cancel');
 192     $bcreate->signal_connect('clicked' => sub {
 193         my $p=$eprj->get_text; $p =~ s/^\s*//; $p =~ s/\s*$//;
 194         if ($p =~ /\W/) {
 195             message($w, 'Sorry, but be nice with the project name!', 'error');
 196             return;
 197         }
 198         if (not length $p) {
 199             message($w, 'No project name specified!', 'error');
 200             return;
 201         }
 202         my $ret=create_template $home, $task, $p, ($r_c->get_active ? 'c' : $r_cpp->get_active ? 'cpp' : 'pas');
 203         length $ret and message($w,$ret,'error') and return;
 204         open_project $p;
 205         $retcode='new';
 206         $w->destroy;
 207     });
 208     $qcreate->signal_connect('clicked' => sub { $w->destroy; });
 209     $xcreate->pack_start($icreate,FALSE,TRUE,10);
 210     $xcreate->pack_start($bcreate,TRUE,TRUE,10);
 211     $xcreate->pack_start($qcreate,TRUE,TRUE,10);
 212     $b->pack_start(Gtk2::HBox->new(),TRUE,TRUE,0);
 213     $b->pack_start($xcreate,FALSE,TRUE,10);
 214
 215     $w->show_all;
 216     Gtk2->main;
 217     $retcode;
 218 }
 219
 220 while (main_window eq 'new') {
 221     new_window eq 'quit' or exit 0;
 222 }