]> mj.ucw.cz Git - eval.git/blob - mop/project/templater.pl
Templater: Fix Pascal projects
[eval.git] / 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}.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/*/*.lpi")) {
64         my ($name, $task) = m#.*/(.*?)/(.*)(\.lpi|\.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 }