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