fiji_setup.pl 22.4 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
use Time::HiRes qw(ualarm);
41
use Pod::Usage;
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
use constant CHANGED_VALUE   => "*";
57
58
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

69
70
use constant ONLY_LOAD => (defined $ENV{FIJI_BENCHMARK} && $ENV{FIJI_BENCHMARK} eq "ONLY_LOAD");

71
72
my $rv;

73
sub main {
74
    my $logger = get_logger("");
75
76
    my $name   = $0;
    my @ARGV   = @_;
Stefan Tauner's avatar
Stefan Tauner committed
77
    my $verbosity_delta = 0;
78
79
    $name =~ s/\.p[lm]//;
    $logger->debug("=== Starting new execution of $name ===");
Christian Fibich's avatar
Christian Fibich committed
80
    $logger->debug(sprintf("%d argument(s)%s", scalar(@_), scalar(@_) > 0 ? ": @_" : ""));
81

82
    my ($settings_filename, $netlist_filename, $help);
83

Stefan Tauner's avatar
Stefan Tauner committed
84
85
    my $parse = GetOptions("s|settings=s" => \$settings_filename,
                           "n|netlist=s"  => \$netlist_filename,
Stefan Tauner's avatar
Stefan Tauner committed
86
                           "v|verbose+"   => \$verbosity_delta,
Stefan Tauner's avatar
Stefan Tauner committed
87
                           "h|help"       => \$help);
88

Stefan Tauner's avatar
Stefan Tauner committed
89
    FIJI::Utils::increase_verbosity($verbosity_delta);
90

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

93
94
    pod2usage(-exitval => 1, -verbose => 1) if (!$parse);
    pod2usage(0) if (defined $help);
95

96
    my %hash;
Christian Fibich's avatar
Christian Fibich committed
97
    my $self = bless(\%hash);
98

Stefan Tauner's avatar
Stefan Tauner committed
99
    my $ini_name;
100
101
102
103
104
105
106
    $self->{'ini_name'} = \$ini_name;
    my $nl_name;
    $self->{'nl_name'} = \$nl_name;

    #
    # Start out with default settings
    #
107
    my ($settings_ref, $errors) = FIJI::Settings->new();
108
    if (!defined($settings_ref)) {
109
        $logger->error($errors);
110
111
112
113
114
115
116
        return 1;
    }
    $self->{'settings'} = $settings_ref;

    #
    # Build GUI
    #
117
118
119
120
121
122
    # 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);

123
    $self->{'mw'} = $mw;
Christian Fibich's avatar
Christian Fibich committed
124
    $self->{'ctrl'} = _ctrl_frame($self, $mw);
125

Christian Fibich's avatar
Christian Fibich committed
126
    if (!defined USE_MENU || USE_MENU == 1) {
127
128
129
        $self->{'menu'} = $self->_menu($mw);
    }

Christian Fibich's avatar
Christian Fibich committed
130
131
132
133
    $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; });
134
    $mw->toplevel()->bind("<Control-q>"       => sub { $self->_onexit; });
135
    $mw->toplevel()->bind("<F1>"              => sub { Tk::FIJIUtils::show_documentation($mw); });
136
137

    $self->{'FIJISettingsViewer'} = $mw->FIJISettingsViewer(
138
        -mw               => $self->{'mw'},
Christian Fibich's avatar
Christian Fibich committed
139
140
        -settings         => $self->{'settings'},
        -changes_callback => sub { my $set = shift; _indicate_changes($self, $set) },
141
142
143
144
145
      )->pack(
        '-fill'   => 'both',
        '-expand' => 1
      );

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

148
    Tk::FIJIUtils::set_icon($mw);
149

Christian Fibich's avatar
Christian Fibich committed
150
151
    $self->{'FIJISettingsViewer'}->append_fiu();               # add dummy FIU for layouting purposes
    $self->{'FIJISettingsViewer'}->set_state_as_original();    # no unsaved indicator
152
153
    $mw->update();

Christian Fibich's avatar
Christian Fibich committed
154
    $mw->minsize($self->{'FIJISettingsViewer'}->width(), $self->{'FIJISettingsViewer'}->height() + $self->{'ctrl'}->height());
Stefan Tauner's avatar
Stefan Tauner committed
155
    $mw->resizable(1, 1);
Christian Fibich's avatar
Christian Fibich committed
156
157
    $splash=$mw->toplevel->Frame();
    $splash->Label(-font => [-size => 16], -text => "Loading Netlist - Please wait...",-height=>2,)->pack(-side=>'bottom',-fill=>'both');
158
    $splash->Frame()->pack(-side=>'bottom',-expand=>1,-fill=>"both")->Label(-relief=>"ridge", -borderwidth=>3,-image => Tk::FIJIUtils::logo_image($self->{'mw'}))->pack(-side=>'bottom',-expand=>1,-ipadx=>10,-ipady=>10);
159
160
161
    $mw->update();

    #
162
    # Load netlist and settings if specified
163
    #
164
    $self->_load_netlist_file(FIJI::Utils::glob_path($netlist_filename)) if (defined $netlist_filename);
165
    if (defined $settings_filename) {
166
        my $filename = FIJI::Utils::glob_path($settings_filename);
167
        my $fr       = $mw;
Christian Fibich's avatar
Christian Fibich committed
168
        if (-e $filename) {
169
170
            my $tmp_settings = $self->_load_settings($filename);
            if (!defined($tmp_settings)) {
171
                $rv = 1;
172
                goto bailout;
173
174
175
176
            }
        } else {
            $self->{'settings'}->save($filename);
        }
Christian Fibich's avatar
Christian Fibich committed
177
        ${$self->{'ini_name'}} = $filename;
Christian Fibich's avatar
Christian Fibich committed
178
179
    }

180
    MainLoop if !ONLY_LOAD;
181

182
183
184
bailout:

    $self->_cleanup();
185
    $logger->trace("=== Stopping execution ===");
186
    return $rv if defined $rv;
187
    return 0;
188
189
}

190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
sub _load_settings {
    my $logger = get_logger("");
    my ($self, $filename) = @_;
    my $nl = $self->{'netlist'};
    my $tmp_settings = \%{Clone::clone($self->{'settings'})};
    my ($errors, $warnings);
    ($tmp_settings, $errors, $warnings) = FIJI::Settings->new('setup', $filename, $tmp_settings, $nl);
    if (defined($errors) || defined($warnings)) {
        my $msg = "";
        $msg .= "Following errors prevented the settings to be loaded correctly:\n$errors\n" if $errors;
        $msg .= "Potential (future) problems:\n$warnings\n" if defined($warnings);
        chomp($msg);
        chomp($msg);
        $logger->error($msg) if !$tmp_settings;
        my $d = $self->{'mw'}->FIJIModalDialog(-image      => (!defined($tmp_settings) ?
                                                                Tk::FIJIUtils::error_image($self->{'mw'}) :
                                                                Tk::FIJIUtils::alert_image($self->{'mw'})
                                                              ),
                                               -wraplength => $self->{'mw'}->screenwidth,
                                               -text       => $msg,
                                               -title      => "Problems while loading settings file $filename!",);
        $d->Show() if !ONLY_LOAD;
        return undef if !$tmp_settings;
    }

    if (!defined($self->{'FIJISettingsViewer'}->settings($tmp_settings))) {
        my $msg = "Could not update GUI correctly with new settings.";
        $logger->error($msg);
        my $d = $self->{'mw'}->FIJIModalDialog(-image      => Tk::FIJIUtils::error_image($self->{'mw'}),
                                               -wraplength => $self->{'mw'}->screenwidth,
                                               -text       => $msg,
                                               -title      => 'Open FIJI Settings failed!',);
        $d->Show() if !ONLY_LOAD;
        return undef;
    }

    $self->{'settings'} = $tmp_settings;
    return $tmp_settings;
}

230
sub _menu {
Christian Fibich's avatar
Christian Fibich committed
231
    my ($self, $mw) = @_;
232

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

235
236
237
    my $file    = $menubar->cascade(-label => '~Configuration', -tearoff => 0);
    my $netlist = $menubar->cascade(-label => '~Netlist',       -tearoff => 0);
    my $help    = $menubar->cascade(-label => '~Help',          -tearoff => 0);
238
239
240
241

    $file->separator;
    $file->command(
        -label       => 'Open',
242
        -accelerator => 'Ctrl+o',
243
        -underline   => 0,
Christian Fibich's avatar
Christian Fibich committed
244
        -command     => [\&_open_settings_file, $self],
245
    );
246
247
    $file->separator;
    $file->command(
Christian Fibich's avatar
Christian Fibich committed
248
        -label       => 'Save',
249
        -accelerator => 'Ctrl+s',
Christian Fibich's avatar
Christian Fibich committed
250
251
        -underline   => 0,
        -command     => [\&_save, $self],
252
    );
253
    $file->command(
Christian Fibich's avatar
Christian Fibich committed
254
        -label       => 'Save As ...',
255
        -accelerator => 'Ctrl+Shift+s',
Christian Fibich's avatar
Christian Fibich committed
256
257
        -underline   => 1,
        -command     => [\&_save_as, $self],
258
259
260
261
262
    );

    $netlist->separator;
    $netlist->command(
        -label       => 'Load',
263
        -accelerator => 'Ctrl+Shift+O',
264
        -underline   => 0,
Christian Fibich's avatar
Christian Fibich committed
265
        -command     => [\&_open_netlist_file, $self],
266
    );
267
268
269
270
271
    $help->separator;
    $help->command(
        -label       => 'Open Documentation',
        -accelerator => 'F1',
        -underline   => 0,
272
        -command     => [\&Tk::FIJIUtils::show_documentation, $mw],
273
274
275
276
277
    );
    $help->separator;
    $help->command(
        -label     => 'About',
        -underline => 0,
Stefan Tauner's avatar
Stefan Tauner committed
278
        -command   => [\&Tk::FIJIUtils::show_about, $mw],
279
    );
Christian Fibich's avatar
Christian Fibich committed
280
    $mw->configure(-menu => $menubar);
281
282
}

283
sub _ctrl_frame {
Christian Fibich's avatar
Christian Fibich committed
284
    my ($self, $fr) = @_;
285
286
287
288
289
290
291
292
293
294
295
    my $fr_ctrl = $fr->LabFrame(
        -label     => "Control",
        -labelside => "acrosstop"
      )->pack(
        -side   => 'top',
        -anchor => 'w',
        -fill   => 'x',

        # -expand => 1
      );

296
    my $cfg_lbl;
297
    my $cfg_changed_lbl;
298
299
300
301
302
303
304
305
306
307
308
    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
309
    $cfg_lbl = $fr_ctrl->Label(-text => 'FIJI Configuration file',)->grid(
310
311
312
313
        '-row'    => 0,
        '-column' => 0,
        '-sticky' => 'w'
    );
Stefan Tauner's avatar
Stefan Tauner committed
314
    $self->{'change_label'} = $cfg_changed_lbl = $fr_ctrl->Label(-image => Tk::FIJIUtils::dummy_image($self->{'mw'}))->grid(
315
316
317
318
        '-row'    => 0,
        '-column' => 1,
        '-sticky' => 'w'
    );
319

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

Christian Fibich's avatar
Christian Fibich committed
323
    if (!defined USE_MENU || USE_MENU == 0) {
324
325
        $cfg_btn_open = $fr_ctrl->Button(
            -text    => 'Open',
Christian Fibich's avatar
Christian Fibich committed
326
            -command => [\&_open_settings_file, $self],
327
328
          )->grid(
            '-row'    => 0,
329
            '-column' => 2,
330
331
332
333
334
335
            '-sticky' => 'ew'
          );
        $cfg_btn_open->focus();

        $cfg_btn_save = $fr_ctrl->Button(
            -text    => 'Save',
Christian Fibich's avatar
Christian Fibich committed
336
            -command => [\&_save, $self],
337
338
          )->grid(
            '-row'    => 0,
339
            '-column' => 3,
340
341
342
343
344
            '-sticky' => 'ew'
          );

        $cfg_btn_save_as = $fr_ctrl->Button(
            -text    => 'Save as',
Christian Fibich's avatar
Christian Fibich committed
345
            -command => [\&_save_as, $self],
346
347
          )->grid(
            '-row'    => 0,
348
            '-column' => 4,
349
350
351
352
353
354
355
356
357
358
359
            '-sticky' => 'ew'
          );
    }

    $cfg_entry = $fr_ctrl->Entry(
        -textvariable       => $self->{'ini_name'},
        -state              => 'disabled',
        -disabledforeground => 'black',
        -takefocus          => 0,                     # default for disabled
      )->grid(
        '-row'    => 0,
360
        '-column' => 5,
361
362
363
364
365
366
        '-sticky' => 'ew'
      );

    #
    # Netlist file entries
    #
Christian Fibich's avatar
Christian Fibich committed
367
    $nl_lbl = $fr_ctrl->Label(-text => 'Input netlist file',)->grid(
368
369
        '-row'    => 1,
        '-column' => 0,
370
        '-sticky' => 'w',
371
372
    );

Christian Fibich's avatar
Christian Fibich committed
373
    if (!defined USE_MENU || USE_MENU == 0) {
374
375
        $nl_btn_open = $fr_ctrl->Button(
            -text    => 'Open',
Christian Fibich's avatar
Christian Fibich committed
376
            -command => [\&_open_netlist_file, $self],
377
378
          )->grid(
            '-row'    => 1,
379
            '-column' => 2,
380
381
382
383
384
385
386
387
388
389
          );
    }

    $nl_entry = $fr_ctrl->Entry(
        -textvariable       => $self->{'nl_name'},
        -state              => 'disabled',
        -disabledforeground => 'black',
        -takefocus          => 0,                    # default for disabled
      )->grid(
        '-row'        => 1,
390
        '-column'     => 3,
391
392
393
394
        '-columnspan' => 4,
        '-sticky'     => 'ew',
      );

395
    $fr_ctrl->gridColumnconfigure(5, -weight => 1);
396
397
398

    return $fr_ctrl;
}
399

400
401
402
sub _setdir {
    my $filename = shift;
    my ($volume,$directories,$file) = File::Spec->splitpath($filename);
403
    return File::Spec->catpath($volume, $directories, "");
404
405
}

406
sub _open_settings_file {
407
408
409
410
    my ($self) = @_;

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

411
    my $logger   = get_logger("");
Stefan Tauner's avatar
Stefan Tauner committed
412
    my $fb = $mw->FBox(
413
414
415
        -type        => 'open',
        -title       => 'Open FIJI Configuration file',
        -filetypes   => FILE_TYPES_CFG,
416
        -initialdir  => $current_dir,
417
        -initialfile => 'fiji.cfg'
Stefan Tauner's avatar
Stefan Tauner committed
418
419
420
    );
    Tk::FIJIUtils::set_icon($fb);
    my $filename = $fb->Show();
Christian Fibich's avatar
Christian Fibich committed
421
    if (!defined($filename)) {
422
423
424
        $logger->debug("User aborted open configuration action");
        return;
    }
425
    $current_dir = _setdir($filename);
426
427
    my $tmp_settings = $self->_load_settings($filename);
    if (!defined($tmp_settings)) {
428
429
        return;
    }
430
    ${$self->{'ini_name'}} = $filename;
431
432
433
}

sub _open_netlist_file {
434
    my $logger = get_logger("");
435
436
437
438
    my $self   = shift;

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

Stefan Tauner's avatar
Stefan Tauner committed
439
    my $fb = $mw->FBox(
440
441
442
        -type        => 'open',
        -title       => 'Open netlist file',
        -filetypes   => FILE_TYPES_NETLIST,
443
        -initialdir  => $current_dir,
444
        -initialfile => ''
Stefan Tauner's avatar
Stefan Tauner committed
445
446
447
    );
    Tk::FIJIUtils::set_icon($fb);
    my $filename = $fb->Show();
Christian Fibich's avatar
Christian Fibich committed
448
    if (!defined($filename)) {
449
450
451
        $logger->debug("User aborted open netlist action.");
        return;
    }
452
    $current_dir = _setdir($filename);
453
454
455
    $self->_load_netlist_file($filename);
}

Christian Fibich's avatar
Christian Fibich committed
456
457
458
$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);
459
                            $splash->focus;
Christian Fibich's avatar
Christian Fibich committed
460
461
462
463
464
                            $splash->parent->update;
                        }
                    }
                };

465
466
467
468
469
470
sub _load_netlist_file {

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

Christian Fibich's avatar
Christian Fibich committed
472
473
474
    $do_splash = 'start';
    ualarm START_PERIOD;

475
    # Display "Busy" cursor
Christian Fibich's avatar
Christian Fibich committed
476
477
    $mw->Busy();
    $mw->update();
478
479
480

    $logger->debug("Loading netlist...");
    my $nl = new FIJI::Netlist();
Christian Fibich's avatar
Christian Fibich committed
481
    if ($nl->read_file($filename) != 0) {
482
483
        my $msg = "Netlist could not be loaded correctly from \"$filename\".";
        $logger->error($msg);
Stefan Tauner's avatar
Stefan Tauner committed
484
        my $d = $self->{'mw'}->FIJIModalDialog(-image     => Tk::FIJIUtils::error_image($self->{'mw'}),
485
                                               -wraplength => $self->{'mw'}->screenwidth,,
486
                                               -text      => $msg,
487
                                               -title     => 'Open netlist failed!',);
488
        $d->Show();
Christian Fibich's avatar
Christian Fibich committed
489
490
491
        undef $do_splash;
        $splash->placeForget();
        $mw->Unbusy();
492
        return undef;
493
494
495
    }
    $logger->debug("...done");
    $logger->debug("Updating viewer...");
Christian Fibich's avatar
Christian Fibich committed
496
    $mw->update();
497

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

Stefan Tauner's avatar
Stefan Tauner committed
502
        my $d = $self->{'mw'}->FIJIModalDialog(-image     => Tk::FIJIUtils::error_image($self->{'mw'}),
503
                                               -wraplength => $self->{'mw'}->screenwidth,,
504
                                               -text      => $msg,
505
                                               -title     => 'Open netlist failed!',);
506
        $d->Show();
Christian Fibich's avatar
Christian Fibich committed
507
508
509
        undef $do_splash;
        $splash->placeForget();
        $mw->Unbusy();
510
        return undef;
511
    }
Christian Fibich's avatar
Christian Fibich committed
512
    ${$self->{'nl_name'}} = $filename;
513
    $self->{'netlist'} = $nl;
514
515
516
    $logger->debug("...done");

    # Done...
Christian Fibich's avatar
Christian Fibich committed
517
518
519
520
    undef $do_splash;
    $splash->placeForget();
    $mw->Unbusy();
    $mw->update();
521
    return $nl;
522
523
}

524
525
526
sub _indicate_changes {
    my $logger = get_logger("");
    my $self   = shift;
527
    $unsaved_changes = shift;
528
529

    if ($unsaved_changes == 1) {
Stefan Tauner's avatar
Stefan Tauner committed
530
        $self->{'change_label'}->configure(-image => Tk::FIJIUtils::save_image($self->{'mw'}));
531
        $self->{'mw'}->configure(-title => CHANGED_VALUE . APPNAME);
532
    } else {
Stefan Tauner's avatar
Stefan Tauner committed
533
        $self->{'change_label'}->configure(-image => Tk::FIJIUtils::dummy_image($self->{'mw'}));
534
        $self->{'mw'}->configure(-title => UNCHANGED_VALUE . APPNAME);
535
536
537
    }
}

538
sub _overwrite_existing_file ($) {
539
    my $logger = get_logger("");
540
    my ($self, $filename) = @_;
Christian Fibich's avatar
Christian Fibich committed
541
    if (!-e $filename) {
542
543
        return 1;
    }
Stefan Tauner's avatar
Stefan Tauner committed
544
    my $d = $self->{'mw'}->FIJIModalDialog(-image     => Tk::FIJIUtils::alert_image($self->{'mw'}),
545
546
                                           -text      => "File \"$filename\" already exists.\nDo you want to overwrite it?",
                                           -title     => 'Really overwrite?',
547
                                           -buttons   => ["~Yes", "~No"]);
548

549
    my $reply = $d->Show();
550
    return (defined $reply && lc($reply) eq 'yes');
551
552
}

553
sub _save_file {
554
    my $logger = get_logger("");
555
    my ($self, $filename) = @_;
Christian Fibich's avatar
Christian Fibich committed
556
    if (!$self->_overwrite_existing_file($filename)) {
557
558
559
        return;
    }

560
561
562
563
564
565
    # Warn the user if there are invalid values or other problems
    my $text;
    my $rv = $self->{'FIJISettingsViewer'}->get_validation_status();
    if (defined($rv)) {
        $text = ${rv};
        $text .= "\nPossible cause: there is no netlist loaded." if !defined(${$self->{'nl_name'}});
566
    }
567
568
569
570
571
572
573
574
575

    my $dups = $self->{'settings'}->determine_duplicate_fiu_nets();
    my @dup_nets = keys(%{$dups});
    if (scalar(@dup_nets) > 0) {
        $text = defined($text) ? "$text\n\n" : "";
        $text .= "More than one FIU is attached to the following net(s):\n";
        for my $dup (@dup_nets) {
            $text .= "$dup is attached to FIUs " . join(", ", @{$dups->{$dup}}) . "\n";
        }
576
    }
577
578
579
580

    if (defined($text)) {
        $logger->error($text);
        $text .= "\nSave Settings nevertheless?";
Stefan Tauner's avatar
Stefan Tauner committed
581
        my $d = $self->{'mw'}->FIJIModalDialog(-image       => Tk::FIJIUtils::alert_image($self->{'mw'}),
582
583
584
                                               -text        => $text,
                                               -wraplength  => $self->{'mw'}->screenwidth,,
                                               -title       => 'Problematic FIJI Settings',
585
                                               -buttons     => [qw/~Yes ~No/]);
586

587
        my $save = $d->Show();
588
        if (!defined $save || $save eq "No") {
589
590
591
592
593
594
595
596
            $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
597
    if (defined($err)) {
598
599
        my $msg = "Saving to file $filename failed!\n$err";
        $logger->error($msg);
600

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

605
        $d->Show();
606
607
        return;
    }
Christian Fibich's avatar
Christian Fibich committed
608
    ${$self->{'ini_name'}} = $filename;
609

610
611
    $self->{'FIJISettingsViewer'}->set_state_as_original();

612
    $logger->info("Successfully saved to file $filename.");
613
614
615
}

sub _save {
616
    my ($self) = @_;
Christian Fibich's avatar
Christian Fibich committed
617
    if (!defined(${$self->{'ini_name'}})) {
618
619
        return $self->_save_as();
    } else {
Christian Fibich's avatar
Christian Fibich committed
620
        return $self->_save_file(${$self->{'ini_name'}});
621
    }
622
623
624
}

sub _save_as {
625
    my ($self) = @_;
Stefan Tauner's avatar
Stefan Tauner committed
626
    my $fb = $self->{'mw'}->FBox(
627
628
629
630
631
        -type             => 'save',
        -title            => 'Save FIJI Configuration file as...',
        -defaultextension => 'cfg',
        -filetypes        => FILE_TYPES_CFG,
        -initialdir       => '.',
632
633
634
635
        -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
636
637
638
    );
    Tk::FIJIUtils::set_icon($fb);
    my $filename = $fb->Show();
Christian Fibich's avatar
Christian Fibich committed
639
    if (!defined($filename)) {
640
641
642
        return;
    }
    return $self->_save_file($filename);
643
644
}

645
646
sub _onexit {
    my $logger = get_logger("");
647
    my ($self) = @_;
648

649
650
651
    return if (defined $self->{'already_clicked'} && $self->{'already_clicked'} == 1);
    $self->{'already_clicked'} = 1;

652
    my $response;
653
    if ($unsaved_changes == 1) {
654
        $logger->debug("Settings changed. Asking to save.");
Stefan Tauner's avatar
Stefan Tauner committed
655
        my $d = $self->{'mw'}->FIJIModalDialog(-image       => Tk::FIJIUtils::alert_image($self->{'mw'}),
656
                                               -text        => "Unsaved changes.\nDo you really want to quit?",
657
                                               -wraplength  => $self->{'mw'}->screenwidth,,
658
                                               -title       => 'Really quit?',
659
                                               -buttons     => ["~Save", "~Cancel", "~Quit"]);
660

661
662
        $response = $d->Show();
        $self->{'already_clicked'} = 0;
Christian Fibich's avatar
Christian Fibich committed
663

664
        # use _save_as to give the user the chance to save under a different name
665
666
667
        $self->_save_as if (defined $response && $response eq "Save");

        if (!defined $response || $response ne "Cancel") {
668
            goto finish;
669
670
        }
    } else {
671
        goto finish;
672
    }
673
674
675
676
677
678
679
680
681
682
683
    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
684
685
}

686
687
my $log_conf = File::Spec->catfile($FindBin::Bin, 'logger.conf');
Log::Log4perl::init_and_watch($log_conf, 'HUP');
688
Log::Log4perl->eradicate_appender("string"); # No need for buffered log output
689
exit main(@ARGV);
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726

__END__

=head1 NAME

    fiji_setup.pl

=head1 SYNOPSIS

    fiji_setup.pl [options]
    
    fiji_setup.pl is the graphical FIJI Settings editor

=head1 OPTIONS

=head2 OPTIONAL PARAMETERS

=over

=item B<-s, --settings FILENAME>

FIJI Settings file

=item B<-n, --netlist FILENAME>

Netlist file to instrument

=item B<-v, --verbose>

Increase verbosity of output. Can be given multiple times to increase
the verbosity level once per occurrence.

=item B<-h, --help>

Display this help and exit

=back