OpenCores
URL https://opencores.org/ocsvn/an-fpga-implementation-of-low-latency-noc-based-mpsoc/an-fpga-implementation-of-low-latency-noc-based-mpsoc/trunk

Subversion Repositories an-fpga-implementation-of-low-latency-noc-based-mpsoc

[/] [an-fpga-implementation-of-low-latency-noc-based-mpsoc/] [trunk/] [mpsoc/] [perl_gui/] [lib/] [perl/] [software_editor.pl] - Blame information for rev 43

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 34 alirezamon
#!/usr/bin/perl
2
 
3
use strict;
4
use warnings;
5
 
6
use Glib qw(TRUE FALSE);
7
use Gtk2 '-init';
8
use Gtk2::SourceView2;
9
use Data::Dumper;
10
 
11
 
12
use base 'Class::Accessor::Fast';
13
require "widget.pl";
14
 
15
 
16
__PACKAGE__->mk_accessors(qw{
17
        window
18
        sourceview
19
        buffer
20
        filename
21
        search_regexp
22
        search_case
23
        search_entry
24
        regexp
25
        highlighted
26
});
27
 
28
my $NAME = 'Otec';
29
 
30
 
31
exit main() unless caller;
32
 
33
 
34
sub software_main {
35
        my ($sw,$file) = @_;
36
 
37
 
38
 
39
        my $app = __PACKAGE__->new();
40
        my ($table,$tview,$window)=$app->build_gui($sw);
41
        my $main_c=(defined $file)? "$sw/$file" : "$sw/main.c";
42
        $app->load_source($main_c) if (-f $main_c );
43
 
44
        #Gtk2->main();
45
 
46
        return ($app,$table,$tview,$window);
47
}
48
 
49
 
50
sub build_gui {
51
        my ($self,$sw) = @_;
52
 
53 35 alirezamon
        my $window = def_popwin_size (75,75,'Source Editor','percent');
54 34 alirezamon
        my $table= def_table(2,10,FALSE);
55
 
56
 
57
 
58
 
59
        my $hpaned = Gtk2::HPaned -> new;
60
        my $vpaned = Gtk2::VPaned -> new;
61
        $table->attach_defaults ($vpaned,0, 10, 0,1);
62
        #my $make = def_image_button('icons/run.png','Compile');
63
        #$table->attach ($make,9, 10, 1,2,'shrink','shrink',0,0);
64
        #$make -> signal_connect("clicked" => sub{
65
                #$self->do_save();
66
                #run_make_file($sw,$tview);     
67
 
68
        #});
69
 
70
        $window -> add ( $table);
71
 
72
        my($width,$hight)=max_win_size();
73
 
74
        my $scwin_dirs = Gtk2::ScrolledWindow -> new;
75
        $scwin_dirs -> set_policy ('automatic', 'automatic');
76
        $hpaned -> pack1 ($scwin_dirs, TRUE, TRUE);
77
        $hpaned ->set_position ($width*.15);
78
 
79
        my $scwin_text = Gtk2::ScrolledWindow -> new;
80
        $scwin_text -> set_policy ('automatic', 'automatic');
81
        $hpaned -> pack2 ($scwin_text, TRUE, TRUE);
82
 
83
 
84
        my ($scwin_info,$tview)= create_text();
85 43 alirezamon
 
86 34 alirezamon
        $vpaned-> pack1 ($hpaned, TRUE, TRUE);
87
        $vpaned ->set_position ($hight*.5);
88
        $vpaned-> pack2 ($scwin_info, TRUE, TRUE);
89
 
90
 
91 42 alirezamon
my ($tree_view,$tree_store) =$self->build_tree_view($sw);
92 34 alirezamon
 
93
 
94
 
95
 
96 42 alirezamon
$scwin_dirs -> add($tree_view);
97 34 alirezamon
 
98
 
99
 
100
 
101
#print "$sw/\n";
102
 
103
        #my $window = Gtk2::Window->new();
104
        #$window->set_size_request(480, 360);
105
        #$window->set_title($NAME);
106
        $self->window($window);
107
 
108
        my $vbox = Gtk2::VBox->new(FALSE, 0);
109
        $scwin_text->add_with_viewport($vbox);
110
 
111 42 alirezamon
        $vbox->pack_start($self->build_menu("$sw/",$window,$tree_view,$tree_store,$scwin_dirs), FALSE, FALSE, 0);
112 34 alirezamon
        $vbox->pack_start($self->build_search_box, FALSE, FALSE, 0);
113
 
114
        my $scroll = Gtk2::ScrolledWindow->new();
115
        $scroll->set_policy('automatic', 'automatic');
116
        $scroll->set_shadow_type('in');
117
        $vbox->pack_start($scroll, TRUE, TRUE, 0);
118
 
119
        my $buffer = $self->create_buffer();
120
        my $sourceview = Gtk2::SourceView2::View->new_with_buffer($buffer);
121
        $sourceview->set_show_line_numbers(TRUE);
122
        $sourceview->set_tab_width(2);
123
        $sourceview->set_indent_on_tab(TRUE);
124
        $sourceview->set_highlight_current_line(TRUE);
125
#       $sourceview->set_draw_spaces(['tab', 'newline']);
126
 
127
        #
128
        # Fix Gtk2::TextView's annoying paste behaviour when pasting with the mouse
129
        # (middle button click). By default gtk will scroll the text view to the
130
        # original place where the cursor is.
131
        #
132
        $sourceview->signal_connect(button_press_event => sub {
133
                my ($view, $event) = @_;
134
 
135
                # We're only interested on middle mouse clicks (mouse-paste)
136
                return FALSE unless $event->button == 2;
137
 
138
                # Remember the position of the paste
139
                my (@coords) = $sourceview->window_to_buffer_coords('text', $event->x, $event->y);
140
                my ($iter) = $sourceview->get_iter_at_position(@coords);
141
                $self->{paste_mark} = $buffer->create_mark('paste', $iter, FALSE);
142
 
143
                return FALSE;
144
        });
145
 
146
 
147
        #
148
        # If a paste is done through the middle click then place the cursor at the end
149
        # of the pasted text.
150
        #
151
        $buffer->signal_connect('paste-done' => sub {
152
                my $mark = delete $self->{paste_mark} or return;
153
 
154
                my $iter = $buffer->get_iter_at_mark($mark);
155
                $buffer->place_cursor($iter);
156
 
157
                $self->sourceview->scroll_to_mark(
158
                        $mark,
159
                        0.0,
160
                        FALSE,
161
                        0.0, 0.5
162
                );
163
                $buffer->delete_mark($mark);
164
        });
165
 
166
 
167
        $scroll->add($sourceview);
168
        $self->sourceview($sourceview);
169
        $self->buffer($sourceview->get_buffer);
170
 
171
        $window->signal_connect(delete_event => sub {
172
                Gtk2->main_quit();
173
                return TRUE;
174
        });
175
 
176
        $window->show_all();
177
        return ($table,$tview,$window);
178
}
179
 
180
 
181 42 alirezamon
 
182
 
183
sub build_tree_view{
184
        my ($self,$sw)=@_;
185
 
186
        # Directory name, full path
187
my $tree_store = Gtk2::TreeStore->new('Glib::String', 'Glib::String');
188
my $tree_view = Gtk2::TreeView->new($tree_store);
189
my $column = Gtk2::TreeViewColumn->new_with_attributes('', Gtk2::CellRendererText->new(), text => "0");
190
$tree_view->append_column($column);
191
$tree_view->set_headers_visible(FALSE);
192
$tree_view->signal_connect (button_release_event => sub{
193
        my $tree_model = $tree_view->get_model();
194
        my $selection = $tree_view->get_selection();
195
        my $iter = $selection->get_selected();
196
        if(defined $iter){
197
                my $path = $tree_model->get($iter, 1) ;
198
                $path= substr $path, 0, -1;
199
                $self->do_save();
200
                #print "open $path\n";
201
                 $self->load_source($path) if(-f $path);
202
        }
203
         return;
204
});
205
 
206
 
207
$tree_view->signal_connect ('row-expanded' => sub {
208
        my ($tree_view, $iter, $tree_path) = @_;
209
        my $tree_model = $tree_view->get_model();
210
        my ($dir, $path) = $tree_model->get($iter);
211
 
212
        # for each of $iter's children add any subdirectories
213
        my $child = $tree_model->iter_children ($iter);
214
        while ($child) {
215
                my ($dir, $path) = $tree_model->get($child, 0, 1);
216
                add_to_tree($tree_view,$tree_store, $child, $dir, $path);
217
                $child = $tree_model->iter_next ($child);
218
        }
219
         return;
220
});
221
 
222
my $child = $tree_store->append(undef);
223
$tree_store->set($child, 0, $sw, 1, '/');
224
add_to_tree($tree_view,$tree_store, $child, '/', "$sw/");
225
return ($tree_view,$tree_store);
226
 
227
}
228
 
229
 
230
 
231 34 alirezamon
sub build_search_box {
232
        my $self = shift;
233
 
234
        # Elements of the search box
235
        my $hbox = Gtk2::HBox->new(FALSE, 0);
236
 
237
        my $search_entry = Gtk2::Entry->new();
238
        $search_entry->signal_connect(activate => sub {$self->do_search()});
239
        $search_entry->signal_connect(icon_release => sub {$self->do_search()});
240
        $self->search_entry($search_entry);
241
 
242
        my $search_regexp = Gtk2::CheckButton->new('RegExp');
243
        $search_regexp->signal_connect(toggled => sub {
244
                $self->search_regexp($search_regexp->get_active);
245
        });
246
 
247
        my $search_case = Gtk2::CheckButton->new('Case');
248
        $search_case->signal_connect(toggled => sub {
249
                $self->search_case($search_case->get_active);
250
        });
251
 
252
        my $search_icon = Gtk2::Button->new_from_stock('gtk-find');
253
        $search_entry->set_icon_from_stock(primary => 'gtk-find');
254
 
255
        $hbox->pack_start($search_entry, TRUE, TRUE , 0);
256
        $hbox->pack_start($search_regexp, FALSE, FALSE, 0);
257
        $hbox->pack_start($search_case, FALSE, FALSE, 0);
258
 
259
        return $hbox;
260
}
261
 
262
 
263
sub create_buffer {
264
        my $self = shift;
265
        my $tags = Gtk2::TextTagTable->new();
266
 
267
        add_tag($tags, search => {
268
                        background => 'yellow',
269
        });
270
        add_tag($tags, goto_line => {
271
                        'paragraph-background' => 'orange',
272
        });
273
 
274
        my $buffer = Gtk2::SourceView2::Buffer->new($tags);
275
        $buffer->signal_connect('notify::cursor-position' => sub {
276
                $self->clear_highlighted();
277
        });
278
 
279
        return $buffer;
280
}
281
 
282
 
283
sub add_tag {
284
        my ($tags, $name, $properties) = @_;
285
 
286
        my $tag = Gtk2::TextTag->new($name);
287
        $tag->set(%{ $properties });
288
        $tags->add($tag);
289
}
290
 
291
 
292
sub detect_language {
293
        my $self = shift;
294
        my ($filename) = @_;
295
 
296
        # Guess the programming language of the file
297
        my $manager = Gtk2::SourceView2::LanguageManager->get_default;
298
        my $language = $manager->guess_language($filename);
299
        $self->buffer->set_language($language);
300
}
301
 
302
 
303
sub load_source {
304
        my $self = shift;
305
        my ($filename) = @_;
306
        my $buffer = $self->buffer;
307
 
308
        # Guess the programming language of the file
309
        $self->detect_language($filename);
310
 
311
        # Loading a file should not be undoable.
312
        my $content;
313
        do {
314
                open my $handle, $filename or die "Can't read file $filename because $!";
315
                local $/;
316
                $content = <$handle>;
317
                close $handle;
318
        };
319
        $buffer->begin_not_undoable_action();
320
        $buffer->set_text($content);
321
        $buffer->end_not_undoable_action();
322
 
323
        $buffer->set_modified(FALSE);
324
        $buffer->place_cursor($buffer->get_start_iter);
325
 
326
        $self->filename($filename);
327
        $self->window->set_title("$filename - $NAME");
328
}
329
 
330
 
331
sub clear_highlighted {
332
        my $self = shift;
333
 
334
        my $highlighted = delete $self->{highlighted} or return;
335
 
336
        my $buffer = $self->buffer;
337
 
338
        my @iters;
339
        foreach my $mark (@{ $highlighted->{marks} }) {
340
                my $iter = $buffer->get_iter_at_mark($mark);
341
                push @iters, $iter;
342
                $buffer->delete_mark($mark);
343
        }
344
 
345
        $buffer->remove_tag_by_name($highlighted->{name}, @iters);
346
}
347
 
348
 
349
sub get_text {
350
        my $self = shift;
351
        my $buffer = $self->buffer;
352
        return $buffer->get_text($buffer->get_start_iter, $buffer->get_end_iter, FALSE);
353
}
354
 
355
 
356
sub do_search {
357
        my $self = shift;
358
        my $criteria = $self->search_entry->get_text;
359
        if ($criteria eq '') {return;}
360
 
361
        my $case = $self->search_case;
362
        my $buffer = $self->buffer;
363
 
364
 
365
        # Start the search at the last search result or from the current cursor's
366
        # position. As a fall back we also add the beginning of the document. Once we
367
        # have the start position we can erase the previous search results.
368
        my @start;
369
        if (my $highlighted = $self->highlighted) {
370
                # Search from the last match
371
                push @start, $buffer->get_iter_at_mark($highlighted->{marks}[1]);
372
                $self->clear_highlighted();
373
        }
374
        else {
375
                # Search from the cursor
376
                push @start, $buffer->get_iter_at_offset(
377
                        $buffer->get_property('cursor-position')
378
                );
379
        }
380
        push @start, $buffer->get_start_iter;
381
 
382
        my @iters;
383
        if ($self->search_regexp) {
384
                # Gtk2::SourceView2 nor Gtk2::SourceView support regular expressions so we
385
                # have to do the search by hand!
386
 
387
                my $text = $self->get_text;
388
                my $regexp = $case ? qr/$criteria/m : qr/$criteria/im;
389
 
390
                foreach my $iter (@start) {
391
                        # Tell Perl where to start the regexp lookup
392
                        pos($text) = $iter->get_offset;
393
 
394
                        if ($text =~ /($regexp)/g) {
395
                                my $word = $1;
396
                                my $pos = pos($text);
397
                                @iters = (
398
                                        $buffer->get_iter_at_offset($pos - length($word)),
399
                                        $buffer->get_iter_at_offset($pos),
400
                                );
401
                                last;
402
                        }
403
                }
404
        }
405
        else {
406
                # Use the builtin search mechanism
407
                my $flags = $case ? [ ] : [ 'case-insensitive' ];
408
                foreach my $iter (@start) {
409
                        @iters = Gtk2::SourceView2::Iter->forward_search($iter, $criteria, $flags);
410
                        last if @iters;
411
                }
412
        }
413
 
414
        $self->show_highlighted(search => @iters) if @iters;
415
}
416
 
417
 
418
sub show_highlighted {
419
        my $self = shift;
420
        my ($tag_name, $start, $end) = @_;
421
        my $buffer = $self->buffer;
422
 
423
        # Highlight the region, remember it and scroll to it
424
        my $match_start = $buffer->create_mark('match-start', $start, TRUE);
425
        my $match_end = $buffer->create_mark('match-end', $end, FALSE);
426
 
427
        $buffer->apply_tag_by_name($tag_name, $start, $end);
428
 
429
        # We have a callback that listens to when the cursor is placed and we don't
430
        # want it to undo our work! So let's unhighlight the previous entry.
431
        delete $self->{highlighted};
432
        $buffer->place_cursor($end);
433
 
434
        $self->sourceview->scroll_to_mark(
435
                $match_start,
436
                0.2,
437
                FALSE,
438
                0.0, 0.5
439
        );
440
 
441
        # Keep a reference to the markers once they have been added to the buffer.
442
        # Using them before can be catastrophic (segmenation fault).
443
        #
444
        $self->highlighted({
445
                name  => $tag_name,
446
                marks => [$match_start, $match_end],
447
        });
448
}
449
 
450
 
451
sub do_file_new {
452 42 alirezamon
        my ($self,$sw,$window,$tree_view,$tree_store,$scwin_dirs) = @_;
453 34 alirezamon
        my $buffer = $self->buffer;
454 42 alirezamon
 
455 34 alirezamon
 
456
        # Set no language
457
        $buffer->set_language(undef);
458
 
459
        # Showing a blank editor should not be undoable.
460
        $buffer->begin_not_undoable_action();
461
        $buffer->set_text('');
462
        $buffer->end_not_undoable_action();
463
 
464
        $buffer->set_modified(FALSE);
465
        $buffer->place_cursor($buffer->get_start_iter);
466
 
467
        $self->filename('');
468
        $self->window->set_title("Untitled - $NAME");
469 42 alirezamon
        $self->do_save_as($sw,$window,$tree_view,$tree_store,$scwin_dirs);
470 34 alirezamon
}
471
 
472
 
473
sub do_file_open {
474
        my $self = shift;
475
        my ($window, $action, $menu_item) = @_;
476
 
477
        my $dialog = Gtk2::FileSelection->new("Open file...");
478
        $dialog->signal_connect(response => sub {
479
                my ($dialog, $response) = @_;
480
 
481
                if ($response eq 'ok') {
482
                        my $file = $dialog->get_filename;
483
                        return if -d $file;
484
                        $self->load_source($file);
485
                }
486
 
487
                $dialog->destroy();
488
        });
489
        $dialog->show();
490
}
491
 
492
 
493
sub do_show_about_dialog {
494
        my $self = shift;
495
 
496
        my $dialog = Gtk2::AboutDialog->new();
497
        $dialog->set_authors("Emmanuel Rodriguez");
498
        $dialog->set_comments("Gtk2::SourceView2 Demo");
499
        $dialog->signal_connect(response => sub {
500
                my ($dialog, $response) = @_;
501
                $dialog->destroy();
502
        });
503
        $dialog->show();
504
}
505
 
506
 
507
sub do_ask_goto_line {
508
        my $self = shift;
509
 
510
        my $dialog = Gtk2::Dialog->new_with_buttons(
511
                "Goto to line",
512
                $self->window,
513
                [ 'modal' ],
514
                'gtk-cancel' => 'cancel',
515
                'gtk-ok'     => 'ok',
516
        );
517
 
518
        my $hbox = Gtk2::HBox->new(FALSE, 0);
519
        $hbox->pack_start(
520
                Gtk2::Label->new("Line number: "),
521
                FALSE, FALSE, 0
522
        );
523
        my $entry = Gtk2::Entry->new();
524
        $hbox->pack_start($entry, TRUE, TRUE, 0);
525
 
526
        $dialog->get_content_area->add($hbox);
527
        $dialog->show_all();
528
 
529
 
530
        # Signal handlers
531
        $entry->signal_connect(activate => sub {
532
                if ($entry->get_text =~ /(\d+)/) {
533
                        $dialog->response('ok');
534
                }
535
        });
536
 
537
        # Run the dialog
538
        my $response = $dialog->run();
539
        $dialog->destroy();
540
        return unless $response eq 'ok';
541
 
542
        return unless my ($line) = ($entry->get_text =~ /(\d+)/);
543
        my $buffer = $self->buffer;
544
        my $start = $buffer->get_iter_at_line($line - 1);
545
        my $end = $start->copy;
546
        $end->forward_to_line_end;
547
 
548
        $self->clear_highlighted();
549
        $self->show_highlighted(goto_line => $start, $end);
550
}
551
 
552
 
553
sub do_quit {
554 42 alirezamon
        my ($self,$window) = @_;
555
        $window->destroy;
556 34 alirezamon
}
557
 
558
 
559
sub do_save_as {
560 42 alirezamon
        my ($self,$sw,$window,$tree_view,$tree_store,$scwin_dirs) = @_;
561 34 alirezamon
 
562
        # If no file is associated with the editor then ask the user for a file where
563
        # to save the contents of the buffer.
564
        my $dialog = Gtk2::FileChooserDialog->new(
565
                "Save file", $self->window, 'save',
566
                'gtk-cancel' => 'cancel',
567
                'gtk-save'   => 'ok',
568
        );
569 42 alirezamon
        if(defined  $sw){
570
                $dialog->set_current_folder ($sw);
571
                #print "open_in:$sw\n";
572
 
573
        }
574 34 alirezamon
 
575
        my $response = $dialog->run();
576
        if ($response eq 'ok') {
577 42 alirezamon
                my $file=$dialog->get_filename;
578
                $self->filename($file);
579 34 alirezamon
                $self->do_save();
580 42 alirezamon
                $tree_view->destroy;
581
                ($tree_view,$tree_store) =$self->build_tree_view($sw);
582
                $scwin_dirs->add($tree_view);
583
                $scwin_dirs->show_all;
584
                $self->load_source($file);
585
 
586
 
587 34 alirezamon
        }
588
        $dialog->destroy();
589 42 alirezamon
 
590
 
591 34 alirezamon
}
592
 
593
 
594
sub do_save {
595
        my $self = shift;
596
 
597
        my $filename = $self->filename;
598
 
599
        # If there's no file then do a save as...
600
        if (! $filename) {
601 42 alirezamon
                #$self->do_save_as();
602 34 alirezamon
                return;
603
        }
604
 
605
        my $buffer = $self->buffer;
606
        open my $handle, '>:encoding(UTF-8)', $filename or die "Can't write to $filename: $!";
607
        print $handle $self->get_text;
608
        close $handle;
609
 
610
        if (! $buffer->get_language) {
611
                $self->detect_language($filename);
612
        }
613
}
614
 
615
 
616 42 alirezamon
 
617
 
618
 
619 34 alirezamon
sub build_menu {
620 42 alirezamon
        my ($self,$sw,$window,$tree_view,$tree_store,$scwin_dirs) = @_;
621 34 alirezamon
 
622
        my $entries = [
623
                # name, stock id, label
624
                [ "FileMenu",  undef, "_File" ],
625
                [ "SearchMenu",  undef, "_Search" ],
626
                [ "HelpMenu",  undef, "_Help" ],
627
 
628
                # name, stock id, label, accelerator, tooltip, method
629
                [
630
                        "New",
631
                        'gtk-new',
632
                        "_New",
633
                        "<control>N",
634
                        "Create a new file",
635 42 alirezamon
                        sub { $self->do_file_new($sw,$window,$tree_view,$tree_store,$scwin_dirs) }
636 34 alirezamon
                ],
637
                [
638
                        "Open",
639
                        'gtk-open',
640
                        "_Open",
641
                        "<control>O",
642
                        "Open a file",
643
                        sub { $self->do_file_open(@_) }
644
                ],
645
                [
646
                        "Save",
647
                        'gtk-save',
648
                        "_Save",
649
                        "<control>S",
650
                        "Save current file",
651
                        sub { $self->do_save(@_) }
652
                ],
653
                [
654
                        "SaveAs",
655
                        'gtk-save',
656
                        "Save _As...",
657
                        "<control><shift>S",
658
                        "Save to a file",
659 42 alirezamon
                        sub { $self->do_save_as($sw,$window,$tree_view,$tree_store,$scwin_dirs) }
660 34 alirezamon
                ],
661
                [
662
                        "Quit",
663
                        'gtk-quit',
664
                        "_Quit",
665
                        "<control>Q",
666
                        "Quit",
667 42 alirezamon
                        sub { $self->do_quit($window) }
668 34 alirezamon
                ],
669
                [
670
                        "About",
671
                        'gtk-about',
672
                        "_About",
673
                        undef,
674
                        "About",
675
                        sub { $self->do_show_about_dialog(@_) }
676
                ],
677
                [
678
                        "GotoLine",
679
                        undef,
680
                        "Goto to _Line",
681
                        "<control>L",
682
                        "Go to line",
683
                        sub { $self->do_ask_goto_line(@_) }
684
                ],
685
        ];
686
 
687
        my $actions = Gtk2::ActionGroup->new("Actions");
688
        $actions->add_actions($entries, undef);
689
 
690
        my $ui = Gtk2::UIManager->new();
691
        $ui->insert_action_group($actions, 0);
692
        $ui->add_ui_from_string(<<'__UI__');
693
<ui>
694
        <menubar name='MenuBar'>
695
                <menu action='FileMenu'>
696
                        <menuitem action='New'/>
697
                        <menuitem action='Open'/>
698
                        <separator/>
699
                        <menuitem action='Save'/>
700
                        <menuitem action='SaveAs'/>
701
                        <separator/>
702
                        <menuitem action='Quit'/>
703
                </menu>
704
                <menu action='SearchMenu'>
705
                        <menuitem action='GotoLine'/>
706
                </menu>
707
                <menu action='HelpMenu'>
708
                        <menuitem action='About'/>
709
                </menu>
710
        </menubar>
711
</ui>
712
__UI__
713
 
714
        $self->window->add_accel_group($ui->get_accel_group);
715
 
716
        return $ui->get_widget('/MenuBar');
717
}
718
 
719
 
720
 
721
sub add_to_tree {
722
 my ($tree_view,$tree_store, $parent, $dir, $path) = @_;
723
my $tree_model = $tree_view->get_model();
724
 
725
# If $parent already has children, then remove them first
726
 my $child = $tree_model->iter_children ($parent);
727
 while ($child) {
728
  $tree_store->remove ($child);
729
  $child = $tree_model->iter_children ($parent);
730
 }
731
 
732
# Add children from directory listing
733
 opendir(DIRHANDLE, $path) || return ; #die "Cannot open directory:$path $!\n";
734
 foreach my $subdir (sort readdir(DIRHANDLE)) {
735
  if ($subdir ne '.' and $subdir ne '..'
736
                                   # and -d $path.$subdir and -r $path.$subdir
737
) {
738
   my $child = $tree_store->append($parent);
739
   $tree_store->set($child, 0, $subdir, 1, "$path$subdir/");
740
  }
741
 }
742
 closedir(DIRHANDLE);
743
}
744
 
745
 
746
# Directory expanded. Populate subdirectories in readiness.
747
 
748
sub populate_tree {
749
 
750
# $iter has been expanded
751
 my ($tree_view,$tree_store, $iter, $tree_path) = @_;
752
 my $tree_model = $tree_view->get_model();
753
 my ($dir, $path) = $tree_model->get($iter);
754
 
755
# for each of $iter's children add any subdirectories
756
 my $child = $tree_model->iter_children ($iter);
757
 while ($child) {
758
  my ($dir, $path) = $tree_model->get($child, 0, 1);
759
  add_to_tree($tree_view,$tree_store, $child, $dir, $path);
760
  $child = $tree_model->iter_next ($child);
761
 }
762
 return;
763
}
764
 
765
 
766
sub run_make_file {
767 38 alirezamon
        my ($dir,$outtext, $args)=@_;
768
        my $cmd =       (defined $args) ? "cd \"$dir/\" \n  make $args" :  "cd \"$dir/\" \n  make ";
769 34 alirezamon
        my $error=0;
770 38 alirezamon
        add_info(\$outtext,"$cmd\n");
771 34 alirezamon
 
772
        my ($stdout,$exit,$stderr)=run_cmd_in_back_ground_get_stdout( $cmd);
773 38 alirezamon
        #($stdout,$exit,$stderr)=run_cmd_in_back_ground_get_stdout( $cmd);
774 34 alirezamon
 
775
 
776 38 alirezamon
        if($exit){
777
                if($stderr){
778
                        $stderr=~ s/[‘,’]//g;
779
                        add_info(\$outtext,"$stdout\n");
780
                        add_colored_info(\$outtext,"$stderr\n","red");
781
                }
782 34 alirezamon
                add_colored_info(\$outtext,"Compilation failed.\n",'red');
783 38 alirezamon
                return 0;
784 34 alirezamon
 
785
        }else{
786
                add_info(\$outtext,"$stdout\n");
787 38 alirezamon
                if($stderr){ #probebly had warning
788
                        $stderr=~ s/[‘,’]//g;
789
                        #add_info(\$outtext,"$stdout\n"); 
790
                        add_colored_info(\$outtext,"$stderr\n","green");
791
                }
792
 
793 34 alirezamon
                add_colored_info(\$outtext,"Compilation finished successfully.\n",'blue');
794 38 alirezamon
                return 1;
795 34 alirezamon
        }
796
 
797
        #add_info(\$outtext,"**********Quartus compilation is done successfully in $target_dir!*************\n") if($error==0);
798
 
799
 
800
 
801
}
802
 
803
 
804
 
805
 
806
1;
807
 

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.