fiji_setup.pl 23.1 KB
Newer Older
1
2
#!/usr/bin/env perl

Christian Fibich's avatar
Christian Fibich committed
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
#-------------------------------------------------------------------------------
#  University of Applied Sciences Technikum Wien
#
#  Department of Embedded Systems
#  http://embsys.technikum-wien.at
#
#  Josef Ressel Center for Verification of Embedded Computing Systems
#  http://vecs.technikum-wien.at
#
#-------------------------------------------------------------------------------
#  Description:
#
#  FIJI setup script (GUI)
#
#-------------------------------------------------------------------------------

Christian Fibich's avatar
Christian Fibich committed
19
20
## @file fiji_setup.pl
# @brief FIJI setup script (GUI)
21
## @file
Christian Fibich's avatar
Christian Fibich committed
22
# Displays a Tk GUI for entering, viewing and editing \ref FIJI::Settings
23
24
25
26

use strict;
use warnings;

27
28
29
use FindBin;
use lib "$FindBin::Bin";

30
31
32
use Log::Log4perl qw(get_logger);
use Tk;
use Tk::widgets qw(LabFrame Label Entry Button Dialog FBox Checkbutton);
33
use Clone qw(clone);
Christian Fibich's avatar
Christian Fibich committed
34
use File::Spec;
Stefan Tauner's avatar
Stefan Tauner committed
35
use File::Basename qw(basename);
36
use FIJI::Settings;
Stefan Tauner's avatar
Stefan Tauner committed
37
use FIJI::Utils;
38
use Tk::FIJISettingsViewer;
39
use Tk::FIJIUtils;
Christian Fibich's avatar
Christian Fibich committed
40
41
use Time::HiRes qw(ualarm);

42
use Getopt::Long qw(:config bundling);
43

44
use FIJI qw(:fiji_dir :fiji_documentation_path);
45

46
## @var USE_MENU defines control style of fiji_settings:
47
48
# 0 => classic, no menu GUI
# 1 => toplevel menu
49
50
# undef => classic+menu GUI
use constant USE_MENU => undef;
51

Christian Fibich's avatar
Christian Fibich committed
52
use constant FILE_TYPES_CFG => [['FIJI Configurations', ['.cfg', '*.ini']], ['All files', '*'],];
53

54
use constant FILE_TYPES_NETLIST => [['Verilog Netlists', ['.v', '.vm', '*.vqm']], ['All files', '*'],];
55

56
57
58
use constant CHANGED_VALUE   => "<M>";
use constant UNCHANGED_VALUE => "";

59
60
use constant APPNAME => 'FIJI Settings Editor';

61
my $unsaved_changes = 0;
62
my $delete_main = 1;
63
my $current_dir = ".";
Christian Fibich's avatar
Christian Fibich committed
64
65
66
67
my $splash;
my $do_splash;

use constant START_PERIOD => 500000; # 500 ms
68

Stefan Tauner's avatar
Stefan Tauner committed
69
70
71
72
73
74
75
76
77
sub usage {
    my ($err) = @_;
    $err = 0 if !defined($err);
    my $scr = basename($0);
    my $msg = <<USAGE;

$scr is the graphical FIJI Settings editor

Usage: $scr [PARAMETERS]
78

79
Optional command-line arguments:
Stefan Tauner's avatar
Stefan Tauner committed
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97

    -s, --settings=<filename> FIJI Settings file

    -n, --netlist=<filename>  Netlist file to instrument

    -v, --verbose             Increase verbosity of output
                              (can be given multiple times to increase
                               the verbosity level once per occurrence).

    -h, --help                Display this help and exit
USAGE
    if ($err == 0) {
        print STDOUT $msg;
    } else {
        print STDERR $msg;
    }
    return $err;
}
98

99
100
my $rv;

101
sub main {
102
    my $logger = get_logger("");
103
104
    my $name   = $0;
    my @ARGV   = @_;
Stefan Tauner's avatar
Stefan Tauner committed
105
    my $verbosity_delta = 0;
106
107
    $name =~ s/\.p[lm]//;
    $logger->debug("=== Starting new execution of $name ===");
Christian Fibich's avatar
Christian Fibich committed
108
    $logger->debug(sprintf("%d argument(s)%s", scalar(@_), scalar(@_) > 0 ? ": @_" : ""));
109

110
    my ($settings_filename, $netlist_filename, $help);
111

Stefan Tauner's avatar
Stefan Tauner committed
112
113
    my $parse = GetOptions("s|settings=s" => \$settings_filename,
                           "n|netlist=s"  => \$netlist_filename,
Stefan Tauner's avatar
Stefan Tauner committed
114
                           "v|verbose+"   => \$verbosity_delta,
Stefan Tauner's avatar
Stefan Tauner committed
115
                           "h|help"       => \$help);
116

Stefan Tauner's avatar
Stefan Tauner committed
117
    FIJI::Utils::increase_verbosity($verbosity_delta);
118

119
120
121
122
    my $only_load = (defined $ENV{FIJI_BENCHMARK} && $ENV{FIJI_BENCHMARK} eq "ONLY_LOAD");

    $logger->warn("Benchmarking mode: Terminating after loading settings and netlist") if $only_load;

Stefan Tauner's avatar
Stefan Tauner committed
123
124
    return usage(1) if (!$parse);
    return usage() if (defined $help);
125

126
    my %hash;
Christian Fibich's avatar
Christian Fibich committed
127
    my $self = bless(\%hash);
128

Stefan Tauner's avatar
Stefan Tauner committed
129
    my $ini_name;
130
131
132
133
134
135
136
    $self->{'ini_name'} = \$ini_name;
    my $nl_name;
    $self->{'nl_name'} = \$nl_name;

    #
    # Start out with default settings
    #
137
138
    my ($settings_ref, $msg) = FIJI::Settings->new();
    if (!defined($settings_ref)) {
139
        $logger->error($msg);
140
141
142
143
144
145
146
        return 1;
    }
    $self->{'settings'} = $settings_ref;

    #
    # Build GUI
    #
147
148
149
150
151
152
    # Assigning $0 sets a "prettier" program title in Gnome's taskbar
    # Must not contain spaces (duh)
    $0 = (APPNAME =~ s/\s+/\-/rg);
    my $mw = MainWindow->new(-title => APPNAME);
    $mw->appname(APPNAME);

153
    $self->{'mw'} = $mw;
Christian Fibich's avatar
Christian Fibich committed
154
    $self->{'ctrl'} = _ctrl_frame($self, $mw);
155

Christian Fibich's avatar
Christian Fibich committed
156
    if (!defined USE_MENU || USE_MENU == 1) {
157
158
159
        $self->{'menu'} = $self->_menu($mw);
    }

Christian Fibich's avatar
Christian Fibich committed
160
161
162
163
    $mw->toplevel()->bind('<Control-o>'       => sub { $self->_open_settings_file; });
    $mw->toplevel()->bind('<Control-Shift-O>' => sub { $self->_open_netlist_file; });
    $mw->toplevel()->bind("<Control-s>"       => sub { $self->_save; });
    $mw->toplevel()->bind("<Control-Shift-S>" => sub { $self->_save_as; });
164
    $mw->toplevel()->bind("<Control-q>"       => sub { $self->_onexit; });
165
    $mw->toplevel()->bind("<F1>"              => sub { Tk::FIJIUtils::show_documentation($mw); });
166
167

    $self->{'FIJISettingsViewer'} = $mw->FIJISettingsViewer(
168
        -mw               => $self->{'mw'},
Christian Fibich's avatar
Christian Fibich committed
169
170
        -settings         => $self->{'settings'},
        -changes_callback => sub { my $set = shift; _indicate_changes($self, $set) },
171
172
173
174
175
      )->pack(
        '-fill'   => 'both',
        '-expand' => 1
      );

176
    $mw->protocol('WM_DELETE_WINDOW' => [\&_onexit, $self]);
177

178
    Tk::FIJIUtils::set_icon($mw);
179

Christian Fibich's avatar
Christian Fibich committed
180
181
    $self->{'FIJISettingsViewer'}->append_fiu();               # add dummy FIU for layouting purposes
    $self->{'FIJISettingsViewer'}->set_state_as_original();    # no unsaved indicator
182
183
    $mw->update();

Christian Fibich's avatar
Christian Fibich committed
184
    $mw->minsize($self->{'FIJISettingsViewer'}->width(), $self->{'FIJISettingsViewer'}->height() + $self->{'ctrl'}->height());
Stefan Tauner's avatar
Stefan Tauner committed
185
    $mw->resizable(1, 1);
Christian Fibich's avatar
Christian Fibich committed
186
187
    $splash=$mw->toplevel->Frame();
    $splash->Label(-font => [-size => 16], -text => "Loading Netlist - Please wait...",-height=>2,)->pack(-side=>'bottom',-fill=>'both');
Stefan Tauner's avatar
Stefan Tauner committed
188
    $splash->Label(-image => Tk::FIJIUtils::logo_image($self->{'mw'}))->pack(-side=>'bottom',-expand=>1,-fill=>'both');
189
190
191
192
193
    $mw->update();

    #
    # Load settings if specified
    #
194
195
    if (defined $settings_filename) {
        my $filename = $settings_filename;
196
        my $fr       = $mw;
Christian Fibich's avatar
Christian Fibich committed
197
198
        if (-e $filename) {
            my $tmp_settings = \%{Clone::clone($self->{'settings'})};
199
200
201
202
            my $warn;
            ($tmp_settings, $warn) = FIJI::Settings->new('setup', $filename);
            if (defined($warn)) {
                my $msg = "Settings file $filename could not be loaded correctly: $warn";
203
                $logger->error($msg) if !$tmp_settings;
Stefan Tauner's avatar
Stefan Tauner committed
204
205
206
207
                my $d = $self->{'mw'}->FIJIModalDialog(-image     => (!defined($tmp_settings) ?
                                                                        Tk::FIJIUtils::error_image($self->{'mw'}) :
                                                                        Tk::FIJIUtils::alert_image($self->{'mw'})
                                                                     ),
208
209
                                                       -wraplength => "200",
                                                       -text      => $msg,
210
                                                       -title     => 'Open FIJI Settings failed!',);
211
212
213
214
215
                $d->Show() if !$only_load;
                if (!defined($tmp_settings)) {
                    $rv = 1;
                    goto bailout;
                }
216
            }
Christian Fibich's avatar
Christian Fibich committed
217
            if (!defined($self->{'FIJISettingsViewer'}->settings($tmp_settings))) {
218
219
                my $msg = "Could not update GUI correctly with new settings.";
                $logger->error($msg);
Stefan Tauner's avatar
Stefan Tauner committed
220
                my $d = $self->{'mw'}->FIJIModalDialog(-image     => Tk::FIJIUtils::error_image($self->{'mw'}),
221
222
                                                       -wraplength => "200",
                                                       -text      => $msg,
223
                                                       -title     => 'Open FIJI Settings failed!',);
224
225
                $d->Show() if !$only_load;
                $rv = 1;
226
                goto bailout;
227
228
229
230
231
            }
            $self->{'settings'} = $tmp_settings;
        } else {
            $self->{'settings'}->save($filename);
        }
Christian Fibich's avatar
Christian Fibich committed
232
        ${$self->{'ini_name'}} = $filename;
Christian Fibich's avatar
Christian Fibich committed
233
234
    }

235
236
    $self->_load_netlist_file($netlist_filename) if (defined $netlist_filename);

237
    MainLoop if !$only_load;
238

239
240
241
bailout:

    $self->_cleanup();
242
    $logger->trace("=== Stopping execution ===");
243
    return $rv if defined $rv;
244
    return 0;
245
246
}

247
sub _menu {
Christian Fibich's avatar
Christian Fibich committed
248
    my ($self, $mw) = @_;
249

Christian Fibich's avatar
Christian Fibich committed
250
    my $menubar = $self->{'menu'} = $mw->Menu(-relief => "groove");
251

252
253
254
    my $file    = $menubar->cascade(-label => '~Configuration', -tearoff => 0);
    my $netlist = $menubar->cascade(-label => '~Netlist',       -tearoff => 0);
    my $help    = $menubar->cascade(-label => '~Help',          -tearoff => 0);
255
256
257
258

    $file->separator;
    $file->command(
        -label       => 'Open',
259
        -accelerator => 'Ctrl+o',
260
        -underline   => 0,
Christian Fibich's avatar
Christian Fibich committed
261
        -command     => [\&_open_settings_file, $self],
262
    );
263
264
    $file->separator;
    $file->command(
Christian Fibich's avatar
Christian Fibich committed
265
        -label       => 'Save',
266
        -accelerator => 'Ctrl+s',
Christian Fibich's avatar
Christian Fibich committed
267
268
        -underline   => 0,
        -command     => [\&_save, $self],
269
    );
270
    $file->command(
Christian Fibich's avatar
Christian Fibich committed
271
        -label       => 'Save As ...',
272
        -accelerator => 'Ctrl+Shift+s',
Christian Fibich's avatar
Christian Fibich committed
273
274
        -underline   => 1,
        -command     => [\&_save_as, $self],
275
276
277
278
279
    );

    $netlist->separator;
    $netlist->command(
        -label       => 'Load',
280
        -accelerator => 'Ctrl+Shift+O',
281
        -underline   => 0,
Christian Fibich's avatar
Christian Fibich committed
282
        -command     => [\&_open_netlist_file, $self],
283
    );
284
285
286
287
288
    $help->separator;
    $help->command(
        -label       => 'Open Documentation',
        -accelerator => 'F1',
        -underline   => 0,
289
        -command     => [\&Tk::FIJIUtils::show_documentation, $mw],
290
291
292
293
294
    );
    $help->separator;
    $help->command(
        -label     => 'About',
        -underline => 0,
Stefan Tauner's avatar
Stefan Tauner committed
295
        -command   => [\&Tk::FIJIUtils::show_about, $mw],
296
    );
Christian Fibich's avatar
Christian Fibich committed
297
    $mw->configure(-menu => $menubar);
298
299
}

300
sub _ctrl_frame {
Christian Fibich's avatar
Christian Fibich committed
301
    my ($self, $fr) = @_;
302
303
304
305
306
307
308
309
310
311
312
    my $fr_ctrl = $fr->LabFrame(
        -label     => "Control",
        -labelside => "acrosstop"
      )->pack(
        -side   => 'top',
        -anchor => 'w',
        -fill   => 'x',

        # -expand => 1
      );

313
    my $cfg_lbl;
314
    my $cfg_changed_lbl;
315
316
317
318
319
320
321
322
323
324
325
    my $cfg_btn_open;
    my $cfg_btn_save;
    my $cfg_btn_save_as;
    my $cfg_entry;
    my $nl_lbl;
    my $nl_btn_open;
    my $nl_entry;

    #
    # Configuration file entries
    #
Christian Fibich's avatar
Christian Fibich committed
326
    $cfg_lbl = $fr_ctrl->Label(-text => 'FIJI Configuration file',)->grid(
327
328
329
330
        '-row'    => 0,
        '-column' => 0,
        '-sticky' => 'w'
    );
Stefan Tauner's avatar
Stefan Tauner committed
331
    $self->{'change_label'} = $cfg_changed_lbl = $fr_ctrl->Label(-image => Tk::FIJIUtils::dummy_image($self->{'mw'}))->grid(
332
333
334
335
        '-row'    => 0,
        '-column' => 1,
        '-sticky' => 'w'
    );
336

337
    my $b = $fr_ctrl->Balloon();
Christian Fibich's avatar
Christian Fibich committed
338
    $b->attach($cfg_changed_lbl, -postcommand => sub { return $unsaved_changes == 1 }, -msg => "Unsaved changes");
339

Christian Fibich's avatar
Christian Fibich committed
340
    if (!defined USE_MENU || USE_MENU == 0) {
341
342
        $cfg_btn_open = $fr_ctrl->Button(
            -text    => 'Open',
Christian Fibich's avatar
Christian Fibich committed
343
            -command => [\&_open_settings_file, $self],
344
345
          )->grid(
            '-row'    => 0,
346
            '-column' => 2,
347
348
349
350
351
352
            '-sticky' => 'ew'
          );
        $cfg_btn_open->focus();

        $cfg_btn_save = $fr_ctrl->Button(
            -text    => 'Save',
Christian Fibich's avatar
Christian Fibich committed
353
            -command => [\&_save, $self],
354
355
          )->grid(
            '-row'    => 0,
356
            '-column' => 3,
357
358
359
360
361
            '-sticky' => 'ew'
          );

        $cfg_btn_save_as = $fr_ctrl->Button(
            -text    => 'Save as',
Christian Fibich's avatar
Christian Fibich committed
362
            -command => [\&_save_as, $self],
363
364
          )->grid(
            '-row'    => 0,
365
            '-column' => 4,
366
367
368
369
370
371
372
373
374
375
376
            '-sticky' => 'ew'
          );
    }

    $cfg_entry = $fr_ctrl->Entry(
        -textvariable       => $self->{'ini_name'},
        -state              => 'disabled',
        -disabledforeground => 'black',
        -takefocus          => 0,                     # default for disabled
      )->grid(
        '-row'    => 0,
377
        '-column' => 5,
378
379
380
381
382
383
        '-sticky' => 'ew'
      );

    #
    # Netlist file entries
    #
Christian Fibich's avatar
Christian Fibich committed
384
    $nl_lbl = $fr_ctrl->Label(-text => 'Input netlist file',)->grid(
385
386
        '-row'    => 1,
        '-column' => 0,
387
        '-sticky' => 'w',
388
389
    );

Christian Fibich's avatar
Christian Fibich committed
390
    if (!defined USE_MENU || USE_MENU == 0) {
391
392
        $nl_btn_open = $fr_ctrl->Button(
            -text    => 'Open',
Christian Fibich's avatar
Christian Fibich committed
393
            -command => [\&_open_netlist_file, $self],
394
395
          )->grid(
            '-row'    => 1,
396
            '-column' => 2,
397
398
399
400
401
402
403
404
405
406
          );
    }

    $nl_entry = $fr_ctrl->Entry(
        -textvariable       => $self->{'nl_name'},
        -state              => 'disabled',
        -disabledforeground => 'black',
        -takefocus          => 0,                    # default for disabled
      )->grid(
        '-row'        => 1,
407
        '-column'     => 3,
408
409
410
411
        '-columnspan' => 4,
        '-sticky'     => 'ew',
      );

412
    $fr_ctrl->gridColumnconfigure(5, -weight => 1);
413
414
415

    return $fr_ctrl;
}
416

417
418
419
sub _setdir {
    my $filename = shift;
    my ($volume,$directories,$file) = File::Spec->splitpath($filename);
420
    return File::Spec->catpath($volume, $directories, "");
421
422
}

423
sub _open_settings_file {
424
425
426
427
    my ($self) = @_;

    my $mw = $self->{'mw'};

428
    my $logger   = get_logger("");
Stefan Tauner's avatar
Stefan Tauner committed
429
    my $fb = $mw->FBox(
430
431
432
        -type        => 'open',
        -title       => 'Open FIJI Configuration file',
        -filetypes   => FILE_TYPES_CFG,
433
        -initialdir  => $current_dir,
434
        -initialfile => 'fiji.cfg'
Stefan Tauner's avatar
Stefan Tauner committed
435
436
437
    );
    Tk::FIJIUtils::set_icon($fb);
    my $filename = $fb->Show();
Christian Fibich's avatar
Christian Fibich committed
438
    if (!defined($filename)) {
439
440
441
        $logger->debug("User aborted open configuration action");
        return;
    }
442
    $current_dir = _setdir($filename);
Christian Fibich's avatar
Christian Fibich committed
443
    my $tmp_settings = \%{Clone::clone($self->{'settings'})};
444
445
    my $warn;
    ($tmp_settings, $warn) = FIJI::Settings->new('setup', $filename, $tmp_settings);
Christian Fibich's avatar
Christian Fibich committed
446
    if (!ref($tmp_settings)) {
447
        my $msg = "Settings file $filename could not be loaded correctly:\n$warn";
448
        $logger->error($msg);
Stefan Tauner's avatar
Stefan Tauner committed
449
        my $d = $self->{'mw'}->FIJIModalDialog(-image     => Tk::FIJIUtils::error_image($self->{'mw'}),
450
451
                                               -wraplength => "200",
                                               -text      => $msg,
452
                                               -title     => 'Open FIJI Settings failed!',);
453
        $d->Show();
454
455
456
457
        return;
    }
    my $rv = $self->{'FIJISettingsViewer'}->settings($tmp_settings);

Christian Fibich's avatar
Christian Fibich committed
458
    if (!defined($rv)) {
459
460
        my $msg = "Could not update GUI correctly with new settings.";
        $logger->error($msg);
461

Stefan Tauner's avatar
Stefan Tauner committed
462
        my $d = $self->{'mw'}->FIJIModalDialog(-image     => Tk::FIJIUtils::error_image($self->{'mw'}),
463
464
                                               -wraplength => "200",
                                               -text      => $msg,
465
                                               -title     => 'Open FIJI Settings failed!',);
466
        $d->Show();
467
        return;
Christian Fibich's avatar
Christian Fibich committed
468
    } elsif (ref($rv) eq "FIJI::Settings") {
469
        $self->{'settings'} = $tmp_settings;
Christian Fibich's avatar
Christian Fibich committed
470
        ${$self->{'ini_name'}} = $filename;
471
    }
472
473
474
}

sub _open_netlist_file {
475
    my $logger = get_logger("");
476
477
478
479
    my $self   = shift;

    my $mw = $self->{'mw'};

Stefan Tauner's avatar
Stefan Tauner committed
480
    my $fb = $mw->FBox(
481
482
483
        -type        => 'open',
        -title       => 'Open netlist file',
        -filetypes   => FILE_TYPES_NETLIST,
484
        -initialdir  => $current_dir,
485
        -initialfile => ''
Stefan Tauner's avatar
Stefan Tauner committed
486
487
488
    );
    Tk::FIJIUtils::set_icon($fb);
    my $filename = $fb->Show();
Christian Fibich's avatar
Christian Fibich committed
489
    if (!defined($filename)) {
490
491
492
        $logger->debug("User aborted open netlist action.");
        return;
    }
493
    $current_dir = _setdir($filename);
494
495
496
    $self->_load_netlist_file($filename);
}

Christian Fibich's avatar
Christian Fibich committed
497
498
499
$SIG{ALRM} = sub { if(defined $do_splash) {
                        if ($do_splash eq 'start') {
                            $splash->place(-bordermode=>'inside',-anchor=>'center',-relx => 0.5, -rely => 0.5,-relwidth=>1,-relheight=>1);
500
                            $splash->focus;
Christian Fibich's avatar
Christian Fibich committed
501
502
503
504
505
                            $splash->parent->update;
                        }
                    }
                };

506
507
508
509
510
511
sub _load_netlist_file {

    my $logger = get_logger("");
    my $self     = shift;
    my $filename = shift;
    my $mw = $self->{'mw'};
512

Christian Fibich's avatar
Christian Fibich committed
513
514
515
    $do_splash = 'start';
    ualarm START_PERIOD;

516
    # Display "Busy" cursor
Christian Fibich's avatar
Christian Fibich committed
517
518
    $mw->Busy();
    $mw->update();
519
520
521

    $logger->debug("Loading netlist...");
    my $nl = new FIJI::Netlist();
Christian Fibich's avatar
Christian Fibich committed
522
    if ($nl->read_file($filename) != 0) {
523
524
        my $msg = "Netlist could not be loaded correctly from \"$filename\".";
        $logger->error($msg);
Stefan Tauner's avatar
Stefan Tauner committed
525
        my $d = $self->{'mw'}->FIJIModalDialog(-image     => Tk::FIJIUtils::error_image($self->{'mw'}),
526
527
                                               -wraplength => "200",
                                               -text      => $msg,
528
                                               -title     => 'Open netlist failed!',);
529
        $d->Show();
Christian Fibich's avatar
Christian Fibich committed
530
531
532
        undef $do_splash;
        $splash->placeForget();
        $mw->Unbusy();
533
534
535
536
        return;
    }
    $logger->debug("...done");
    $logger->debug("Updating viewer...");
Christian Fibich's avatar
Christian Fibich committed
537
    $mw->update();
538

Christian Fibich's avatar
Christian Fibich committed
539
    if (!defined($self->{'FIJISettingsViewer'}->netlist($nl))) {
540
541
        my $msg = "Could not update GUI correctly with new netlist.";
        $logger->error($msg);
542

Stefan Tauner's avatar
Stefan Tauner committed
543
        my $d = $self->{'mw'}->FIJIModalDialog(-image     => Tk::FIJIUtils::error_image($self->{'mw'}),
544
545
                                               -wraplength => "200",
                                               -text      => $msg,
546
                                               -title     => 'Open netlist failed!',);
547
        $d->Show();
Christian Fibich's avatar
Christian Fibich committed
548
549
550
        undef $do_splash;
        $splash->placeForget();
        $mw->Unbusy();
551
552
        return;
    }
Christian Fibich's avatar
Christian Fibich committed
553
    ${$self->{'nl_name'}} = $filename;
554
555
556
    $logger->debug("...done");

    # Done...
Christian Fibich's avatar
Christian Fibich committed
557
558
559
560
    undef $do_splash;
    $splash->placeForget();
    $mw->Unbusy();
    $mw->update();
561
562
}

563
564
565
sub _indicate_changes {
    my $logger = get_logger("");
    my $self   = shift;
566
    $unsaved_changes = shift;
567
568

    if ($unsaved_changes == 1) {
Stefan Tauner's avatar
Stefan Tauner committed
569
        $self->{'change_label'}->configure(-image => Tk::FIJIUtils::save_image($self->{'mw'}));
570
571
        $self->{'mw'}->configure(-title => "*" . APPNAME);
    } else {
Stefan Tauner's avatar
Stefan Tauner committed
572
        $self->{'change_label'}->configure(-image => Tk::FIJIUtils::dummy_image($self->{'mw'}));
573
574
575
576
        $self->{'mw'}->configure(-title => APPNAME);
    }
}

577
sub _overwrite_existing_file ($) {
Christian Fibich's avatar
Christian Fibich committed
578
    my ($self, $filename) = @_;
579
    my $logger = get_logger("");
Christian Fibich's avatar
Christian Fibich committed
580
    if (!-e $filename) {
581
582
        return 1;
    }
Stefan Tauner's avatar
Stefan Tauner committed
583
    my $d = $self->{'mw'}->FIJIModalDialog(-image     => Tk::FIJIUtils::alert_image($self->{'mw'}),
584
585
                                           -text      => "File \"$filename\" already exists.\nDo you want to overwrite it?",
                                           -title     => 'Really overwrite?',
586
                                           -buttons   => ["~Yes", "~No"]);
587

588
    my $reply = $d->Show();
589
    return (defined $reply && lc($reply) eq 'yes');
590
591
}

592
sub _save_file {
Christian Fibich's avatar
Christian Fibich committed
593
    my ($self, $filename) = @_;
594
    my $logger = get_logger("");
Christian Fibich's avatar
Christian Fibich committed
595
    if (!$self->_overwrite_existing_file($filename)) {
596
597
598
599
        return;
    }

    # Check if all drivers are set, prompt for missing ones
600
    $self->{'mw'}->Busy;
601
    my $drv  = $self->{'FIJISettingsViewer'}->validate_all_drivers();
602
    my $dup  = $self->{'FIJISettingsViewer'}->validate_duplicate_nets();
603
    my $dsgn = $self->{'FIJISettingsViewer'}->validate_all_design_settings();
604
    $self->{'mw'}->Unbusy;
605

606
    # Warn the user if not all drivers could be validated successfully
607
608
609
610
611
612
613
614
615
    my $rv;
    if (defined($drv)) {
        $rv = "$drv\n";
        $logger->error($drv);
    }
    if (defined($dsgn)) {
        $rv .= "$dsgn\n";
        $logger->error($dsgn);
    }
616
617
618
619
    if (defined($dup)) {
        $rv .= "$dup\n";
        $logger->error($dup);
    }
620
    
621
    if (defined($drv) || defined($dsgn) || defined($dup)) {
Stefan Tauner's avatar
Stefan Tauner committed
622
        my $d = $self->{'mw'}->FIJIModalDialog(-image       => Tk::FIJIUtils::alert_image($self->{'mw'}),
623
                                               -text        => $rv . "Save Settings nevertheless?",
624
625
                                               -wraplength  => 350,
                                               -title       => 'Validation failed',
626
                                               -buttons     => [qw/~Yes ~No/]);
627

628
        my $save = $d->Show();
629
        if (!defined $save || $save eq "No") {
630
631
632
633
634
635
636
637
            $logger->info("Saving aborted.");
            return;
        }
        $logger->info("Saving settings nevertheless.");
    }

    # Try to save the settings file
    my $err = $self->{'settings'}->save($filename);
Christian Fibich's avatar
Christian Fibich committed
638
    if (defined($err)) {
639
640
        my $msg = "Saving to file $filename failed!\n$err";
        $logger->error($msg);
641

Stefan Tauner's avatar
Stefan Tauner committed
642
        my $d = $self->{'mw'}->FIJIModalDialog(-image       => Tk::FIJIUtils::error_image($self->{'mw'}),
643
                                               -text        => $msg,
644
                                               -title       => 'Save failed!',);
645

646
        $d->Show();
647
648
        return;
    }
Christian Fibich's avatar
Christian Fibich committed
649
    ${$self->{'ini_name'}} = $filename;
650

651
652
    $self->{'FIJISettingsViewer'}->set_state_as_original();

653
    $logger->info("Successfully saved to file $filename.");
654
655
656
}

sub _save {
657
    my ($self) = @_;
Christian Fibich's avatar
Christian Fibich committed
658
    if (!defined(${$self->{'ini_name'}})) {
659
660
        return $self->_save_as();
    } else {
Christian Fibich's avatar
Christian Fibich committed
661
        return $self->_save_file(${$self->{'ini_name'}});
662
    }
663
664
665
}

sub _save_as {
666
    my ($self) = @_;
Stefan Tauner's avatar
Stefan Tauner committed
667
    my $fb = $self->{'mw'}->FBox(
668
669
670
671
672
        -type             => 'save',
        -title            => 'Save FIJI Configuration file as...',
        -defaultextension => 'cfg',
        -filetypes        => FILE_TYPES_CFG,
        -initialdir       => '.',
673
674
675
676
        -initialfile      => 'fiji.cfg',
        -force            => 1, # prevent FBox's "overwrite?" dialog
                                #    because we have our own check and a nicer dialog
                                #    AND we want to prevent showing the dialog twice
Stefan Tauner's avatar
Stefan Tauner committed
677
678
679
    );
    Tk::FIJIUtils::set_icon($fb);
    my $filename = $fb->Show();
Christian Fibich's avatar
Christian Fibich committed
680
    if (!defined($filename)) {
681
682
683
        return;
    }
    return $self->_save_file($filename);
684
685
}

686
687
sub _onexit {
    my $logger = get_logger("");
688
    my ($self) = @_;
689

690
691
692
    return if (defined $self->{'already_clicked'} && $self->{'already_clicked'} == 1);
    $self->{'already_clicked'} = 1;

693
    my $response;
694
    if ($unsaved_changes == 1) {
695
        $logger->debug("Settings changed. Asking to save.");
Stefan Tauner's avatar
Stefan Tauner committed
696
        my $d = $self->{'mw'}->FIJIModalDialog(-image       => Tk::FIJIUtils::alert_image($self->{'mw'}),
697
698
699
                                               -text        => "Unsaved changes.\nDo you really want to quit?",
                                               -wraplength  => 350,
                                               -title       => 'Really quit?',
700
                                               -buttons     => ["~Save", "~Cancel", "~Quit"]);
701

702
703
        $response = $d->Show();
        $self->{'already_clicked'} = 0;
Christian Fibich's avatar
Christian Fibich committed
704

705
        # use _save_as to give the user the chance to save under a different name
706
707
708
        $self->_save_as if (defined $response && $response eq "Save");

        if (!defined $response || $response ne "Cancel") {
709
            goto finish;
710
711
        }
    } else {
712
        goto finish;
713
    }
714
715
716
717
718
719
720
721
722
723
724
    return;

finish:
    $delete_main = 0;
    $self->{'mw'}->destroy();
    return;
}

sub _cleanup {
    my $self = shift;
    $self->{'mw'}->destroy() if $delete_main; # according to Mastering O'Reilly
725
726
}

727
728
my $log_conf = File::Spec->catfile($FindBin::Bin, 'logger.conf');
Log::Log4perl::init_and_watch($log_conf, 'HUP');
729
Log::Log4perl->eradicate_appender("string"); # No need for buffered log output
730
exit main(@ARGV);