From 10ee12b66a226f890b423ab711e17efd04bd2f70 Mon Sep 17 00:00:00 2001 From: Michele Calgaro Date: Thu, 18 Oct 2018 22:45:41 +0900 Subject: Moved to /usr folder instead of /opt/trinity. This relates to bug 266. Signed-off-by: Michele Calgaro --- PerlTQt/bin/pqtapi | 82 ------- PerlTQt/bin/pqtsh | 675 ---------------------------------------------------- PerlTQt/bin/ptqtapi | 82 +++++++ PerlTQt/bin/ptqtsh | 675 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 757 insertions(+), 757 deletions(-) delete mode 100755 PerlTQt/bin/pqtapi delete mode 100755 PerlTQt/bin/pqtsh create mode 100755 PerlTQt/bin/ptqtapi create mode 100755 PerlTQt/bin/ptqtsh (limited to 'PerlTQt/bin') diff --git a/PerlTQt/bin/pqtapi b/PerlTQt/bin/pqtapi deleted file mode 100755 index 338d600..0000000 --- a/PerlTQt/bin/pqtapi +++ /dev/null @@ -1,82 +0,0 @@ -#!/usr/bin/perl - -# Note: this program is part of PerlTQt and makes use of its internal functions. -# You should not rely on those in your own programs. - -use Getopt::Std; -use strict 'vars'; - -our (%o, @x, $h); -getopts('r:hvimp', \%o); - -package TQt::_internal; -use TQt; - -exists $o{'v'} and do{ print "PerlTQt-$TQt::VERSION using TQt-".&TQt::version."\n" and exit 0 }; -exists $o{'h'} and do{ print $h and exit 0 }; -exists $o{'m'} and do{ # interactive mode for driving the TQt Designer Plugin - select(STDOUT); $| = 1; # unbuffered - while() - { - chomp; - s/^Q(?=[A-Z])/TQt::/; - my $i = find_pclassid( $_ ); - print "__START__\n"; - if ($i) - { - my $a = findAllMethods( $i ); - my $t = dumpCandidates( [map {@{ $$a{$_} }} sort keys %$a] ); - getAllParents($i, \my @sup); - for my $s(@sup) - { - $a = findAllMethods( $s ); - $t.= dumpCandidates( [map {@{ $$a{$_} }} sort keys %$a] ); - } - $t =~ s/\t//gs; - print $t; - } - print "__END__\n"; - } -}; -(my $c = $ARGV[0]) =~ s/^Q(?=[A-Z])/TQt::/; -my $i = $c ? find_pclassid( $c ) : 1; -my $r = exists $o{'r'} ? (exists $o{'i'} ? qr|$o{'r'}|i : qr|$o{'r'}|) : 0; -my $d = ""; - -while ($i) -{ - my $a=findAllMethods($i); - last unless keys %$a; - @x=map {@{ $$a{$_} }} sort keys %$a; - $d = dumpCandidates(\@x); - if($c and $i and exists $o{'p'}) - { - getAllParents($i, \my @sup); - for my $s(@sup) - { - $a = findAllMethods( $s ); - $d.= dumpCandidates( [map {@{ $$a{$_} }} sort keys %$a] ); - } - } - if($r) - { - map { print "$_\n" if $_=~$r } split("\n", $d); - } - else - { - print $d - } - $c and last; - $i++ -} - -BEGIN { - $h = "pqtapi - a PerlTQt introspection tool\t(c) Germain Garand 2003 \n\n". - "usage: pqtapi [-r ] []\n\n". - "options:\n". - "\t-r : find all functions matching regular expression/keyword \n". - "\t-i : together with -r, performs a case insensitive search\n". - "\t-p : display also inherited methods for .\n". - "\t-v : print PerlTQt and TQt versions\n". - "\t-h : print this help message\n"; -} diff --git a/PerlTQt/bin/pqtsh b/PerlTQt/bin/pqtsh deleted file mode 100755 index ec44e43..0000000 --- a/PerlTQt/bin/pqtsh +++ /dev/null @@ -1,675 +0,0 @@ -#!/usr/bin/perl - -# pqtsh : a graphical shell for PerlTQt. -# -# author: Germain Garand -# license: GNU Public License v2 -# - -use utf8; -use strict 'vars'; - -package TQtShellControl; - -use TQt; -use TQt::isa qw(TQt::MainWindow); -use TQt::slots - fileOpen => [], - fileSave => [], - fileSaveAs => [], - filePrint => [], - fileExit => [], - helpExample => []; -use TQt::signals - fileNeedsEval => [TQString]; -use TQt::attributes qw( - menubar - fileMenu - helpMenu - toolBar - fileName - fileOpenAction - fileSaveAction - fileSaveAsAction - filePrintAction - fileExitAction - helpExampleAction - comboBox - sessionLog - executedLines - printer -); - -our $image0_data = -["22 22 7 1", -". c None", -"# c #000000", -"b c #292c29", -"c c #5a5d5a", -"d c #838583", -"e c #c5c2c5", -"a c #ffffff", -"......................", -"....##########........", -"....#aaaaaaa#b#.......", -"....#aaaaaaa#cb#......", -"....#aaaaaaa#dcb#.....", -"....#aaaaaaa#edcb#....", -"....#aaaaaaa#aedcb#...", -"....#aaaaaaa#######...", -"....#aaaaaaaaaaaaa#...", -"....#aaaaaaaaaaaaa#...", -"....#aaaaaaaaaaaaa#...", -"....#aaaaaaaaaaaaa#...", -"....#aaaaaaaaaaaaa#...", -"....#aaaaaaaaaaaaa#...", -"....#aaaaaaaaaaaaa#...", -"....#aaaaaaaaaaaaa#...", -"....#aaaaaaaaaaaaa#...", -"....#aaaaaaaaaaaaa#...", -"....#aaaaaaaaaaaaa#...", -"....###############...", -"......................", -"......................"]; - -our $image1_data = -["22 22 5 1", -". c None", -"# c #000000", -"c c #838100", -"a c #ffff00", -"b c #ffffff", -"......................", -"......................", -"......................", -"............####....#.", -"...........#....##.##.", -"..................###.", -".................####.", -".####...........#####.", -"#abab##########.......", -"#babababababab#.......", -"#ababababababa#.......", -"#babababababab#.......", -"#ababab###############", -"#babab##cccccccccccc##", -"#abab##cccccccccccc##.", -"#bab##cccccccccccc##..", -"#ab##cccccccccccc##...", -"#b##cccccccccccc##....", -"###cccccccccccc##.....", -"##cccccccccccc##......", -"###############.......", -"......................"]; - -our $image2_data = -["22 22 5 1", -". c None", -"# c #000000", -"a c #838100", -"b c #c5c2c5", -"c c #cdb6d5", -"......................", -".####################.", -".#aa#bbbbbbbbbbbb#bb#.", -".#aa#bbbbbbbbbbbb#bb#.", -".#aa#bbbbbbbbbcbb####.", -".#aa#bbbccbbbbbbb#aa#.", -".#aa#bbbccbbbbbbb#aa#.", -".#aa#bbbbbbbbbbbb#aa#.", -".#aa#bbbbbbbbbbbb#aa#.", -".#aa#bbbbbbbbbbbb#aa#.", -".#aa#bbbbbbbbbbbb#aa#.", -".#aaa############aaa#.", -".#aaaaaaaaaaaaaaaaaa#.", -".#aaaaaaaaaaaaaaaaaa#.", -".#aaa#############aa#.", -".#aaa#########bbb#aa#.", -".#aaa#########bbb#aa#.", -".#aaa#########bbb#aa#.", -".#aaa#########bbb#aa#.", -".#aaa#########bbb#aa#.", -"..##################..", -"......................"]; - -our $image3_data = -["22 22 88 2", -"TQt c None", -".2 c #000000", -".S c #08ff08", -"#v c #100810", -".U c #101010", -"#c c #101018", -".M c #181018", -"#e c #181818", -".A c #181820", -".L c #201820", -"#l c #202020", -".z c #202029", -"#m c #292029", -"#u c #292829", -"#n c #292831", -".R c #29ff29", -"#o c #312831", -".T c #313031", -"#p c #313039", -".Z c #31ff31", -"#q c #393039", -"#t c #393839", -".y c #393841", -"#s c #413841", -".o c #414041", -"#h c #4a4852", -".n c #5a505a", -"#r c #5a5962", -".I c #5ace5a", -"#b c #6a616a", -".p c #6a696a", -".x c #6a6973", -".Y c #6aff62", -".l c #736973", -".t c #7b717b", -".s c #7b7183", -".0 c #7bff7b", -".r c #837983", -".u c #83798b", -"#g c #83858b", -".v c #8b7994", -"#i c #8b858b", -".w c #8b8594", -"#j c #8b8d8b", -".8 c #8b8d94", -".m c #948d94", -"#k c #948d9c", -"#f c #949594", -".q c #94959c", -".J c #94c694", -"#d c #9c959c", -"#a c #9c95a4", -".k c #9c9d9c", -".N c #9c9da4", -".H c #9ccea4", -".K c #a49da4", -"#. c #a49dac", -".i c #a4a5a4", -".3 c #a4a5ac", -"## c #ac9dac", -".V c #aca5ac", -".d c #acaeac", -".j c #acaeb4", -".9 c #b4aeb4", -".# c #b4b6b4", -".a c #bdbebd", -".7 c #bdd6bd", -".c c #c5c6c5", -".5 c #cdc6cd", -".b c #cdcecd", -".4 c #cdced5", -".F c #d5ced5", -".G c #d5cede", -".h c #d5d6d5", -".E c #d5d6de", -".Q c #d5ffd5", -".B c #ded6de", -".1 c #ded6e6", -".g c #dedede", -".D c #dedee6", -".6 c #e6dee6", -".f c #e6e6e6", -".C c #e6e6ee", -".X c #e6ffe6", -".O c #eee6ee", -".e c #eeeeee", -".W c #f6f6f6", -".P c #ffffff", -"TQtTQtTQtTQtTQtTQt.#.a.b.b.b.b.c.c.a.a.d.aTQtTQtTQtTQt", -"TQtTQtTQtTQtTQtTQt.a.e.f.f.f.f.f.e.e.e.g.aTQtTQtTQtTQt", -"TQtTQtTQtTQtTQtTQt.a.c.c.c.b.b.c.c.c.c.a.cTQtTQtTQtTQt", -"TQtTQtTQtTQtTQtTQt.#.a.a.a.a.#.a.a.#.#.d.aTQtTQtTQtTQt", -"TQtTQtTQtTQtTQt.c.d.c.a.c.c.c.a.a.a.c.#TQtTQtTQtTQtTQt", -"TQtTQtTQtTQtTQt.a.a.#.a.a.a.a.a.a.c.c.#TQtTQtTQtTQtTQt", -"TQtTQtTQtTQtTQt.a.#.c.a.a.a.a.a.c.a.c.dTQtTQtTQtTQtTQt", -"TQtTQtTQtTQtTQt.c.a.a.a.a.a.a.a.a.a.a.#TQtTQtTQtTQtTQt", -"TQtTQtTQtTQtTQt.d.b.f.g.g.g.g.g.g.h.g.i.i.jTQtTQtTQt", -"TQtTQtTQt.a.k.l.#.h.b.h.b.h.b.h.g.g.m.n.o.p.#TQt", -"TQtTQt.a.q.r.s.t.t.t.t.t.t.t.u.v.w.x.y.z.A.o.i", -"TQt.a.k.B.C.D.B.E.E.E.E.F.G.H.I.J.K.o.L.L.M.y", -".a.N.O.P.P.P.P.P.P.P.P.P.Q.R.S.R.b.v.T.A.U.L", -".V.W.P.P.P.P.P.P.P.P.P.P.X.Y.Z.0.P.1.t.A.2.L", -".3.E.4.5.4.h.E.E.g.6.D.B.D.E.7.F.4.5.8.M.2.A", -".m.9.j.V.3#..3.K#.#..i#..K#.###a.q.8#b#c.2.L", -".m.j.j#..3.K.K.K.N.K.N.N.N.N#a#d#d.w#b#c.2#e", -"#f#.#..K.N.K.N.N.N#a.k#a#d#d#d#a.m#g#b.M.2#h", -".m.3.K.K#a.k#a#d#a.k#a#d#a#d.q.m.8#i.x#c#e.d", -"#f#g#i.w#j.w#i.8.w#i.8.8.m.8.m#k.8.w#b#e#fTQt", -".#.l.z.A#l.z#m#m#m#n#o#o#p#p#q#q#p#o#p#fTQtTQt", -"TQtTQt.d#r#s#s#t#p.T.T.T#u#u.z#e#e#v.o.kTQtTQtTQt"]; - - -sub NEW -{ - shift->SUPER::NEW(@_); - - my $image0 = TQt::Pixmap($image0_data); - my $image1 = TQt::Pixmap($image1_data); - my $image2 = TQt::Pixmap($image2_data); - my $image3 = TQt::Pixmap($image3_data); - my $box = VBox(this); - sessionLog = TextEdit($box, "sessionLog"); - sessionLog->setTextFormat(TQt::RichText()); - sessionLog->setReadOnly(1); - comboBox = ComboBox($box, "comboBox"); - comboBox->setEditable(1); - comboBox->setAutoCompletion(1); - this->setCentralWidget($box); - comboBox->setFocus; - this->resize(500,300); - setCaption("PerlTQt Shell"); -# fileNewAction= TQt::Action(this, "fileNewAction"); -# fileNewAction->setIconSet(TQt::IconSet($image0)); -# fileNewAction->setText(trUtf8("New")); -# fileNewAction->setMenuText(trUtf8("&New")); -# fileNewAction->setAccel(KeySequence(trUtf8("Ctrl+N"))); - fileOpenAction= TQt::Action(this, "fileOpenAction"); - fileOpenAction->setIconSet(TQt::IconSet($image1)); - fileOpenAction->setText(trUtf8("Open")); - fileOpenAction->setMenuText(trUtf8("&Open...")); - fileOpenAction->setAccel(KeySequence(trUtf8("Ctrl+O"))); - fileSaveAction= TQt::Action(this, "fileSaveAction"); - fileSaveAction->setIconSet(TQt::IconSet($image2)); - fileSaveAction->setText(trUtf8("Save")); - fileSaveAction->setMenuText(trUtf8("&Save")); - fileSaveAction->setAccel(KeySequence(trUtf8("Ctrl+S"))); - fileSaveAsAction= TQt::Action(this, "fileSaveAsAction"); - fileSaveAsAction->setText(trUtf8("Save As")); - fileSaveAsAction->setMenuText(trUtf8("Save &As...")); - fileSaveAsAction->setAccel(KeySequence(trUtf8("Ctrl+A"))); - filePrintAction= TQt::Action(this, "filePrintAction"); - filePrintAction->setIconSet(TQt::IconSet($image3)); - filePrintAction->setText(trUtf8("Print")); - filePrintAction->setMenuText(trUtf8("&Print...")); - filePrintAction->setAccel(KeySequence(trUtf8("Ctrl+P"))); - fileExitAction= TQt::Action(this, "fileExitAction"); - fileExitAction->setText(trUtf8("Exit")); - fileExitAction->setMenuText(trUtf8("E&xit")); - fileExitAction->setAccel(KeySequence(trUtf8("Ctrl+E"))); - - helpExampleAction= TQt::Action(this, "helpExampleAction"); - helpExampleAction->setText(trUtf8("Example")); - helpExampleAction->setMenuText(trUtf8("Examp&le")); - helpExampleAction->setAccel(KeySequence(trUtf8("Ctrl+L"))); - - toolBar = TQt::ToolBar("", this, DockTop()); - - toolBar->setLabel(trUtf8("Tools")); - fileOpenAction->addTo(toolBar); - fileSaveAction->addTo(toolBar); - filePrintAction->addTo(toolBar); - - - menubar= TQt::MenuBar( this, "menubar"); - - fileMenu= TQt::PopupMenu(this); -# fileNewAction->addTo(fileMenu); - fileOpenAction->addTo(fileMenu); - fileSaveAction->addTo(fileMenu); - fileSaveAsAction->addTo(fileMenu); - fileMenu->insertSeparator; - filePrintAction->addTo(fileMenu); - fileMenu->insertSeparator; - fileExitAction->addTo(fileMenu); - menubar->insertItem(trUtf8("&File"), fileMenu); - - menubar->insertSeparator; - - helpMenu= TQt::PopupMenu(this); - helpExampleAction->addTo(helpMenu); - menubar->insertItem(trUtf8("&Help"), helpMenu); - -# TQt::Object::connect(fileNewAction, TQT_SIGNAL "activated()", this, TQT_SLOT "fileNew()"); - TQt::Object::connect(fileOpenAction, TQT_SIGNAL "activated()", this, TQT_SLOT "fileOpen()"); - TQt::Object::connect(fileSaveAction, TQT_SIGNAL "activated()", this, TQT_SLOT "fileSave()"); - TQt::Object::connect(fileSaveAsAction, TQT_SIGNAL "activated()", this, TQT_SLOT "fileSaveAs()"); - TQt::Object::connect(filePrintAction, TQT_SIGNAL "activated()", this, TQT_SLOT "filePrint()"); - TQt::Object::connect(fileExitAction, TQT_SIGNAL "activated()", this, TQT_SLOT "fileExit()"); - TQt::Object::connect(helpExampleAction, TQT_SIGNAL "activated()", this, TQT_SLOT "helpExample()"); - - - executedLines = []; -} - -#sub fileNew -#{ -# print "Form1->fileNew(): Not implemented yet.\n"; -#} - -sub fileOpen -{ - my $fn = TQt::FileDialog::getOpenFileName( - ".", - "Pqtsh Session (*.pqts)", - this, - "open session", - "Choose a file to open" ); - $fn or return; - emit fileNeedsEval($fn); - -} - -sub getFileName -{ - fileName = TQt::FileDialog::getSaveFileName( - ".", - "Pqtsh Session (*.pqts)", - this, - "save session", - "Choose a filename" ); - fileName !~ /\.pqts$/ and fileName = fileName . ".pqts"; - return fileName; -} - - -sub save -{ - my $fn = shift; - open( OUT, ">$fn") or do { - TQt::MessageBox::critical( - this, - "Error" , - "Couldn't open $fn for writing: $!", - &TQt::MessageBox::Ok, - &TQt::MessageBox::NoButton ); - return - }; - for (@{ &executedLines }) - { - next if /^\s*$/; - chomp; - $_ .= ";" unless /;\s*$/; - print OUT $_, "\n" - } - close OUT -} - -sub fileSave -{ - emptySession() and return; - my $fn = fileName || getFileName(); - $fn or return; - save($fn) -} - -sub fileSaveAs -{ - emptySession() and return; - my $fn; - my ($cond, $doit); - AGAIN: - { - $fn = getFileName(); - $fn or return; - if( -e $fn ) - { - $cond++; - $doit = TQt::MessageBox::warning( - this, - "Warning" , - "File exists, overwrite ?", - &TQt::MessageBox::Yes, - &TQt::MessageBox::No ); - } - else - { $cond = 0 } - } - goto AGAIN if $cond and $doit == &TQt::MessageBox::No; - save($fn) -} - -sub filePrint -{ - my $Margin = 10; - my $pageNo = 1; - emptySession() and return; - printer = TQt::Printer unless printer; - if ( printer->setup(this) ) { - statusBar()->message( "Printing..." ); - my $p = TQt::Painter; - if( !$p->begin( printer ) ) - { - statusBar()->message( "An error occured..." ); - return - } - - $p->setFont( sessionLog->font() ); - my $yPos = 0; - my $fm = $p->fontMetrics; - my $metrics = TQt::PaintDeviceMetrics( printer ); - - for( my $i = 0 ; $i < @{ &executedLines } ; $i++ ) { - if ( $Margin + $yPos > $metrics->height() - $Margin ) { - my $msg ="Printing (page ". ++$pageNo . ")..."; - statusBar()->message( $msg ); - printer->newPage(); - $yPos = 0; - } - $p->drawText( $Margin, $Margin + $yPos, - $metrics->width(), $fm->lineSpacing(), - &ExpandTabs | &DontClip, - ${ &executedLines }[ $i ] ); - $yPos = $yPos + $fm->lineSpacing(); - } - $p->end(); - statusBar()->message( "Printing completed", 3000 ); - } else { - statusBar()->message( "Printing aborted", 3000 ); - } -} - -sub fileExit -{ - emit TQt::app()->quit() if confirmExit(); -} - -sub closeEvent -{ - my $e = shift; - if(confirmExit()) - { - $e->accept - } - else - { - $e->ignore - } -} - -sub confirmExit -{ - my $doit; - if(@{ &executedLines }) - { - $doit = TQt::MessageBox::warning( - this, - "Warning" , - "A session is opened, quit anyway ?", - &TQt::MessageBox::Yes, - &TQt::MessageBox::No ); - } - else - { return 1 } - - return (($doit == &TQt::MessageBox::No) ? 0 : 1); -} - -sub emptySession -{ - unless (@{ &executedLines }) - { - statusBar()->message("Session is empty...", 3000); - return 1; - } - 0 -} - -sub helpExample -{ - emit fileNeedsEval("__DATA__") -} - -1; - -package TQtShell; - -use TQt; -use TQt::isa qw(TQt::MainWindow); -use TQt::slots - evalInput=>[], - evalFile=>[TQString]; -use TQt::attributes qw( - shellWindow -); -use TQtShellControl; - -sub NEW -{ - shift->SUPER::NEW(@_); - - shellWindow = TQtShellControl(undef, "shellWindow"); - this->resize(350,350); - this->move(Point(10,10)); - shellWindow->move(Point(300,200)); - this->show; - shellWindow->show; - - - this->connect(shellWindow->comboBox->lineEdit, TQT_SIGNAL 'returnPressed()', TQT_SLOT 'evalInput()'); - this->{'prompt'} = '$>'; - setCaption("MainWindow - this"); - shellWindow->sessionLog->setText("Ready.
"); - TQt::Object::connect(shellWindow, TQT_SIGNAL 'fileNeedsEval(TQString)', this, TQT_SLOT 'evalFile(TQString)'); -} - -sub logAppend -{ - shellWindow->sessionLog->setText( shellWindow->sessionLog->text . shift ) -} - -sub evalInput -{ - evalOneLine( shellWindow->comboBox->currentText ); -} - -sub evalOneLine -{ - my $prot = my $ln = shift; - $prot =~ s//>/gs; - logAppend( this->{'prompt'}. "$prot
" ); - { - no strict; - eval $ln; - } - if($@) - { - my $prot = $@ ; - $prot =~ s//>/gs; - my $c = shellWindow->sessionLog->color; - $prot =~ s/\n/
/gs; - logAppend(''.$prot.'
'); - shellWindow->sessionLog->setColor( $c ); - } - else - { - push @{ shellWindow()->{'executedLines'} }, $ln; - shellWindow->comboBox->clearEdit; - shellWindow->comboBox->setFocus; - } - shellWindow->sessionLog->scrollToBottom -} - -sub evalFile -{ - my $fn = shift; - my $fh; - if($fn eq "__DATA__") - { - $fh = \*::DATA - } - else - { - open($fh, $fn) or do { - TQt::MessageBox::warning ( - this, - "Error" , - "Couldn't open $fn: $!", - &TQt::MessageBox::Ok, - &TQt::MessageBox::NoButton ); - return - }; - } - while(<$fh>) - { - evalOneLine($_) - } - close $fh -} - -1; - -package TQt::TextHandle; - -sub TIEHANDLE { my ( $classnm, $widg, $color) = @_; - my $h = { widg => $widg, color => $color}; - bless $h, $classnm; - -} - -sub PRINT { - my $me = shift; - my $color = $me->{color}; - my $printed = join $/, @_; - $printed =~ s//>/gs; - $printed =~ s/\n/
/gs; - $me->{widg}->setText( $me->{widg}->text . "$printed" ); - -} - -sub PRINTF { shift->PRINT(sprintf shift, @_); } -sub CLOSE { shift->UNTIE; } -sub UNTIE { } - - -1; - -package main; -use strict; -use TQt; -use TQtShell; -use TQt::debug; - -my $app = TQt::Application(\@ARGV); -my $w = TQtShell(undef, "mainWindow"); -my $shw = $w->shellWindow; -$app->setMainWidget($shw); -tie *STDOUT, 'TQt::TextHandle', $shw->sessionLog, 'black'; -tie *STDERR, 'TQt::TextHandle', $shw->sessionLog, 'red'; - -exit $app->exec; - -__DATA__ -statusBar()->message("Hello World !"); -use TQt::attributes qw|datetime button textedit sample vbox| ; -vbox = VBox(this); -datetime = DateTimeEdit(vbox); -textedit = TQt::TextEdit(vbox); -button = PushButton("Hello World!", vbox) ; -this->setCentralWidget(vbox); -resize(220,240); -vbox->show; -sample = TQt::PopupMenu( this ); -use TQt::slots 'there' => []; -sample->insertItem("&There", this, TQT_SLOT 'there()'); -menuBar()->insertItem("&Here", sample); -sub there { statusBar()->message("There...", 2000) }; diff --git a/PerlTQt/bin/ptqtapi b/PerlTQt/bin/ptqtapi new file mode 100755 index 0000000..3d8705b --- /dev/null +++ b/PerlTQt/bin/ptqtapi @@ -0,0 +1,82 @@ +#!/usr/bin/perl + +# Note: this program is part of PerlTQt and makes use of its internal functions. +# You should not rely on those in your own programs. + +use Getopt::Std; +use strict 'vars'; + +our (%o, @x, $h); +getopts('r:hvimp', \%o); + +package TQt::_internal; +use TQt; + +exists $o{'v'} and do{ print "PerlTQt-$TQt::VERSION using TQt-".&TQt::version."\n" and exit 0 }; +exists $o{'h'} and do{ print $h and exit 0 }; +exists $o{'m'} and do{ # interactive mode for driving the TQt Designer Plugin + select(STDOUT); $| = 1; # unbuffered + while() + { + chomp; + s/^Q(?=[A-Z])/TQt::/; + my $i = find_pclassid( $_ ); + print "__START__\n"; + if ($i) + { + my $a = findAllMethods( $i ); + my $t = dumpCandidates( [map {@{ $$a{$_} }} sort keys %$a] ); + getAllParents($i, \my @sup); + for my $s(@sup) + { + $a = findAllMethods( $s ); + $t.= dumpCandidates( [map {@{ $$a{$_} }} sort keys %$a] ); + } + $t =~ s/\t//gs; + print $t; + } + print "__END__\n"; + } +}; +(my $c = $ARGV[0]) =~ s/^Q(?=[A-Z])/TQt::/; +my $i = $c ? find_pclassid( $c ) : 1; +my $r = exists $o{'r'} ? (exists $o{'i'} ? qr|$o{'r'}|i : qr|$o{'r'}|) : 0; +my $d = ""; + +while ($i) +{ + my $a=findAllMethods($i); + last unless keys %$a; + @x=map {@{ $$a{$_} }} sort keys %$a; + $d = dumpCandidates(\@x); + if($c and $i and exists $o{'p'}) + { + getAllParents($i, \my @sup); + for my $s(@sup) + { + $a = findAllMethods( $s ); + $d.= dumpCandidates( [map {@{ $$a{$_} }} sort keys %$a] ); + } + } + if($r) + { + map { print "$_\n" if $_=~$r } split("\n", $d); + } + else + { + print $d + } + $c and last; + $i++ +} + +BEGIN { + $h = "ptqtapi - a PerlTQt introspection tool\t(c) Germain Garand 2003 \n\n". + "usage: ptqtapi [-r ] []\n\n". + "options:\n". + "\t-r : find all functions matching regular expression/keyword \n". + "\t-i : together with -r, performs a case insensitive search\n". + "\t-p : display also inherited methods for .\n". + "\t-v : print PerlTQt and TQt versions\n". + "\t-h : print this help message\n"; +} diff --git a/PerlTQt/bin/ptqtsh b/PerlTQt/bin/ptqtsh new file mode 100755 index 0000000..012e920 --- /dev/null +++ b/PerlTQt/bin/ptqtsh @@ -0,0 +1,675 @@ +#!/usr/bin/perl + +# ptqtsh : a graphical shell for PerlTQt. +# +# author: Germain Garand +# license: GNU Public License v2 +# + +use utf8; +use strict 'vars'; + +package TQtShellControl; + +use TQt; +use TQt::isa qw(TQt::MainWindow); +use TQt::slots + fileOpen => [], + fileSave => [], + fileSaveAs => [], + filePrint => [], + fileExit => [], + helpExample => []; +use TQt::signals + fileNeedsEval => [TQString]; +use TQt::attributes qw( + menubar + fileMenu + helpMenu + toolBar + fileName + fileOpenAction + fileSaveAction + fileSaveAsAction + filePrintAction + fileExitAction + helpExampleAction + comboBox + sessionLog + executedLines + printer +); + +our $image0_data = +["22 22 7 1", +". c None", +"# c #000000", +"b c #292c29", +"c c #5a5d5a", +"d c #838583", +"e c #c5c2c5", +"a c #ffffff", +"......................", +"....##########........", +"....#aaaaaaa#b#.......", +"....#aaaaaaa#cb#......", +"....#aaaaaaa#dcb#.....", +"....#aaaaaaa#edcb#....", +"....#aaaaaaa#aedcb#...", +"....#aaaaaaa#######...", +"....#aaaaaaaaaaaaa#...", +"....#aaaaaaaaaaaaa#...", +"....#aaaaaaaaaaaaa#...", +"....#aaaaaaaaaaaaa#...", +"....#aaaaaaaaaaaaa#...", +"....#aaaaaaaaaaaaa#...", +"....#aaaaaaaaaaaaa#...", +"....#aaaaaaaaaaaaa#...", +"....#aaaaaaaaaaaaa#...", +"....#aaaaaaaaaaaaa#...", +"....#aaaaaaaaaaaaa#...", +"....###############...", +"......................", +"......................"]; + +our $image1_data = +["22 22 5 1", +". c None", +"# c #000000", +"c c #838100", +"a c #ffff00", +"b c #ffffff", +"......................", +"......................", +"......................", +"............####....#.", +"...........#....##.##.", +"..................###.", +".................####.", +".####...........#####.", +"#abab##########.......", +"#babababababab#.......", +"#ababababababa#.......", +"#babababababab#.......", +"#ababab###############", +"#babab##cccccccccccc##", +"#abab##cccccccccccc##.", +"#bab##cccccccccccc##..", +"#ab##cccccccccccc##...", +"#b##cccccccccccc##....", +"###cccccccccccc##.....", +"##cccccccccccc##......", +"###############.......", +"......................"]; + +our $image2_data = +["22 22 5 1", +". c None", +"# c #000000", +"a c #838100", +"b c #c5c2c5", +"c c #cdb6d5", +"......................", +".####################.", +".#aa#bbbbbbbbbbbb#bb#.", +".#aa#bbbbbbbbbbbb#bb#.", +".#aa#bbbbbbbbbcbb####.", +".#aa#bbbccbbbbbbb#aa#.", +".#aa#bbbccbbbbbbb#aa#.", +".#aa#bbbbbbbbbbbb#aa#.", +".#aa#bbbbbbbbbbbb#aa#.", +".#aa#bbbbbbbbbbbb#aa#.", +".#aa#bbbbbbbbbbbb#aa#.", +".#aaa############aaa#.", +".#aaaaaaaaaaaaaaaaaa#.", +".#aaaaaaaaaaaaaaaaaa#.", +".#aaa#############aa#.", +".#aaa#########bbb#aa#.", +".#aaa#########bbb#aa#.", +".#aaa#########bbb#aa#.", +".#aaa#########bbb#aa#.", +".#aaa#########bbb#aa#.", +"..##################..", +"......................"]; + +our $image3_data = +["22 22 88 2", +"TQt c None", +".2 c #000000", +".S c #08ff08", +"#v c #100810", +".U c #101010", +"#c c #101018", +".M c #181018", +"#e c #181818", +".A c #181820", +".L c #201820", +"#l c #202020", +".z c #202029", +"#m c #292029", +"#u c #292829", +"#n c #292831", +".R c #29ff29", +"#o c #312831", +".T c #313031", +"#p c #313039", +".Z c #31ff31", +"#q c #393039", +"#t c #393839", +".y c #393841", +"#s c #413841", +".o c #414041", +"#h c #4a4852", +".n c #5a505a", +"#r c #5a5962", +".I c #5ace5a", +"#b c #6a616a", +".p c #6a696a", +".x c #6a6973", +".Y c #6aff62", +".l c #736973", +".t c #7b717b", +".s c #7b7183", +".0 c #7bff7b", +".r c #837983", +".u c #83798b", +"#g c #83858b", +".v c #8b7994", +"#i c #8b858b", +".w c #8b8594", +"#j c #8b8d8b", +".8 c #8b8d94", +".m c #948d94", +"#k c #948d9c", +"#f c #949594", +".q c #94959c", +".J c #94c694", +"#d c #9c959c", +"#a c #9c95a4", +".k c #9c9d9c", +".N c #9c9da4", +".H c #9ccea4", +".K c #a49da4", +"#. c #a49dac", +".i c #a4a5a4", +".3 c #a4a5ac", +"## c #ac9dac", +".V c #aca5ac", +".d c #acaeac", +".j c #acaeb4", +".9 c #b4aeb4", +".# c #b4b6b4", +".a c #bdbebd", +".7 c #bdd6bd", +".c c #c5c6c5", +".5 c #cdc6cd", +".b c #cdcecd", +".4 c #cdced5", +".F c #d5ced5", +".G c #d5cede", +".h c #d5d6d5", +".E c #d5d6de", +".Q c #d5ffd5", +".B c #ded6de", +".1 c #ded6e6", +".g c #dedede", +".D c #dedee6", +".6 c #e6dee6", +".f c #e6e6e6", +".C c #e6e6ee", +".X c #e6ffe6", +".O c #eee6ee", +".e c #eeeeee", +".W c #f6f6f6", +".P c #ffffff", +"TQtTQtTQtTQtTQtTQt.#.a.b.b.b.b.c.c.a.a.d.aTQtTQtTQtTQt", +"TQtTQtTQtTQtTQtTQt.a.e.f.f.f.f.f.e.e.e.g.aTQtTQtTQtTQt", +"TQtTQtTQtTQtTQtTQt.a.c.c.c.b.b.c.c.c.c.a.cTQtTQtTQtTQt", +"TQtTQtTQtTQtTQtTQt.#.a.a.a.a.#.a.a.#.#.d.aTQtTQtTQtTQt", +"TQtTQtTQtTQtTQt.c.d.c.a.c.c.c.a.a.a.c.#TQtTQtTQtTQtTQt", +"TQtTQtTQtTQtTQt.a.a.#.a.a.a.a.a.a.c.c.#TQtTQtTQtTQtTQt", +"TQtTQtTQtTQtTQt.a.#.c.a.a.a.a.a.c.a.c.dTQtTQtTQtTQtTQt", +"TQtTQtTQtTQtTQt.c.a.a.a.a.a.a.a.a.a.a.#TQtTQtTQtTQtTQt", +"TQtTQtTQtTQtTQt.d.b.f.g.g.g.g.g.g.h.g.i.i.jTQtTQtTQt", +"TQtTQtTQt.a.k.l.#.h.b.h.b.h.b.h.g.g.m.n.o.p.#TQt", +"TQtTQt.a.q.r.s.t.t.t.t.t.t.t.u.v.w.x.y.z.A.o.i", +"TQt.a.k.B.C.D.B.E.E.E.E.F.G.H.I.J.K.o.L.L.M.y", +".a.N.O.P.P.P.P.P.P.P.P.P.Q.R.S.R.b.v.T.A.U.L", +".V.W.P.P.P.P.P.P.P.P.P.P.X.Y.Z.0.P.1.t.A.2.L", +".3.E.4.5.4.h.E.E.g.6.D.B.D.E.7.F.4.5.8.M.2.A", +".m.9.j.V.3#..3.K#.#..i#..K#.###a.q.8#b#c.2.L", +".m.j.j#..3.K.K.K.N.K.N.N.N.N#a#d#d.w#b#c.2#e", +"#f#.#..K.N.K.N.N.N#a.k#a#d#d#d#a.m#g#b.M.2#h", +".m.3.K.K#a.k#a#d#a.k#a#d#a#d.q.m.8#i.x#c#e.d", +"#f#g#i.w#j.w#i.8.w#i.8.8.m.8.m#k.8.w#b#e#fTQt", +".#.l.z.A#l.z#m#m#m#n#o#o#p#p#q#q#p#o#p#fTQtTQt", +"TQtTQt.d#r#s#s#t#p.T.T.T#u#u.z#e#e#v.o.kTQtTQtTQt"]; + + +sub NEW +{ + shift->SUPER::NEW(@_); + + my $image0 = TQt::Pixmap($image0_data); + my $image1 = TQt::Pixmap($image1_data); + my $image2 = TQt::Pixmap($image2_data); + my $image3 = TQt::Pixmap($image3_data); + my $box = VBox(this); + sessionLog = TextEdit($box, "sessionLog"); + sessionLog->setTextFormat(TQt::RichText()); + sessionLog->setReadOnly(1); + comboBox = ComboBox($box, "comboBox"); + comboBox->setEditable(1); + comboBox->setAutoCompletion(1); + this->setCentralWidget($box); + comboBox->setFocus; + this->resize(500,300); + setCaption("PerlTQt Shell"); +# fileNewAction= TQt::Action(this, "fileNewAction"); +# fileNewAction->setIconSet(TQt::IconSet($image0)); +# fileNewAction->setText(trUtf8("New")); +# fileNewAction->setMenuText(trUtf8("&New")); +# fileNewAction->setAccel(KeySequence(trUtf8("Ctrl+N"))); + fileOpenAction= TQt::Action(this, "fileOpenAction"); + fileOpenAction->setIconSet(TQt::IconSet($image1)); + fileOpenAction->setText(trUtf8("Open")); + fileOpenAction->setMenuText(trUtf8("&Open...")); + fileOpenAction->setAccel(KeySequence(trUtf8("Ctrl+O"))); + fileSaveAction= TQt::Action(this, "fileSaveAction"); + fileSaveAction->setIconSet(TQt::IconSet($image2)); + fileSaveAction->setText(trUtf8("Save")); + fileSaveAction->setMenuText(trUtf8("&Save")); + fileSaveAction->setAccel(KeySequence(trUtf8("Ctrl+S"))); + fileSaveAsAction= TQt::Action(this, "fileSaveAsAction"); + fileSaveAsAction->setText(trUtf8("Save As")); + fileSaveAsAction->setMenuText(trUtf8("Save &As...")); + fileSaveAsAction->setAccel(KeySequence(trUtf8("Ctrl+A"))); + filePrintAction= TQt::Action(this, "filePrintAction"); + filePrintAction->setIconSet(TQt::IconSet($image3)); + filePrintAction->setText(trUtf8("Print")); + filePrintAction->setMenuText(trUtf8("&Print...")); + filePrintAction->setAccel(KeySequence(trUtf8("Ctrl+P"))); + fileExitAction= TQt::Action(this, "fileExitAction"); + fileExitAction->setText(trUtf8("Exit")); + fileExitAction->setMenuText(trUtf8("E&xit")); + fileExitAction->setAccel(KeySequence(trUtf8("Ctrl+E"))); + + helpExampleAction= TQt::Action(this, "helpExampleAction"); + helpExampleAction->setText(trUtf8("Example")); + helpExampleAction->setMenuText(trUtf8("Examp&le")); + helpExampleAction->setAccel(KeySequence(trUtf8("Ctrl+L"))); + + toolBar = TQt::ToolBar("", this, DockTop()); + + toolBar->setLabel(trUtf8("Tools")); + fileOpenAction->addTo(toolBar); + fileSaveAction->addTo(toolBar); + filePrintAction->addTo(toolBar); + + + menubar= TQt::MenuBar( this, "menubar"); + + fileMenu= TQt::PopupMenu(this); +# fileNewAction->addTo(fileMenu); + fileOpenAction->addTo(fileMenu); + fileSaveAction->addTo(fileMenu); + fileSaveAsAction->addTo(fileMenu); + fileMenu->insertSeparator; + filePrintAction->addTo(fileMenu); + fileMenu->insertSeparator; + fileExitAction->addTo(fileMenu); + menubar->insertItem(trUtf8("&File"), fileMenu); + + menubar->insertSeparator; + + helpMenu= TQt::PopupMenu(this); + helpExampleAction->addTo(helpMenu); + menubar->insertItem(trUtf8("&Help"), helpMenu); + +# TQt::Object::connect(fileNewAction, TQT_SIGNAL "activated()", this, TQT_SLOT "fileNew()"); + TQt::Object::connect(fileOpenAction, TQT_SIGNAL "activated()", this, TQT_SLOT "fileOpen()"); + TQt::Object::connect(fileSaveAction, TQT_SIGNAL "activated()", this, TQT_SLOT "fileSave()"); + TQt::Object::connect(fileSaveAsAction, TQT_SIGNAL "activated()", this, TQT_SLOT "fileSaveAs()"); + TQt::Object::connect(filePrintAction, TQT_SIGNAL "activated()", this, TQT_SLOT "filePrint()"); + TQt::Object::connect(fileExitAction, TQT_SIGNAL "activated()", this, TQT_SLOT "fileExit()"); + TQt::Object::connect(helpExampleAction, TQT_SIGNAL "activated()", this, TQT_SLOT "helpExample()"); + + + executedLines = []; +} + +#sub fileNew +#{ +# print "Form1->fileNew(): Not implemented yet.\n"; +#} + +sub fileOpen +{ + my $fn = TQt::FileDialog::getOpenFileName( + ".", + "Pqtsh Session (*.ptqts)", + this, + "open session", + "Choose a file to open" ); + $fn or return; + emit fileNeedsEval($fn); + +} + +sub getFileName +{ + fileName = TQt::FileDialog::getSaveFileName( + ".", + "Pqtsh Session (*.ptqts)", + this, + "save session", + "Choose a filename" ); + fileName !~ /\.ptqts$/ and fileName = fileName . ".ptqts"; + return fileName; +} + + +sub save +{ + my $fn = shift; + open( OUT, ">$fn") or do { + TQt::MessageBox::critical( + this, + "Error" , + "Couldn't open $fn for writing: $!", + &TQt::MessageBox::Ok, + &TQt::MessageBox::NoButton ); + return + }; + for (@{ &executedLines }) + { + next if /^\s*$/; + chomp; + $_ .= ";" unless /;\s*$/; + print OUT $_, "\n" + } + close OUT +} + +sub fileSave +{ + emptySession() and return; + my $fn = fileName || getFileName(); + $fn or return; + save($fn) +} + +sub fileSaveAs +{ + emptySession() and return; + my $fn; + my ($cond, $doit); + AGAIN: + { + $fn = getFileName(); + $fn or return; + if( -e $fn ) + { + $cond++; + $doit = TQt::MessageBox::warning( + this, + "Warning" , + "File exists, overwrite ?", + &TQt::MessageBox::Yes, + &TQt::MessageBox::No ); + } + else + { $cond = 0 } + } + goto AGAIN if $cond and $doit == &TQt::MessageBox::No; + save($fn) +} + +sub filePrint +{ + my $Margin = 10; + my $pageNo = 1; + emptySession() and return; + printer = TQt::Printer unless printer; + if ( printer->setup(this) ) { + statusBar()->message( "Printing..." ); + my $p = TQt::Painter; + if( !$p->begin( printer ) ) + { + statusBar()->message( "An error occured..." ); + return + } + + $p->setFont( sessionLog->font() ); + my $yPos = 0; + my $fm = $p->fontMetrics; + my $metrics = TQt::PaintDeviceMetrics( printer ); + + for( my $i = 0 ; $i < @{ &executedLines } ; $i++ ) { + if ( $Margin + $yPos > $metrics->height() - $Margin ) { + my $msg ="Printing (page ". ++$pageNo . ")..."; + statusBar()->message( $msg ); + printer->newPage(); + $yPos = 0; + } + $p->drawText( $Margin, $Margin + $yPos, + $metrics->width(), $fm->lineSpacing(), + &ExpandTabs | &DontClip, + ${ &executedLines }[ $i ] ); + $yPos = $yPos + $fm->lineSpacing(); + } + $p->end(); + statusBar()->message( "Printing completed", 3000 ); + } else { + statusBar()->message( "Printing aborted", 3000 ); + } +} + +sub fileExit +{ + emit TQt::app()->quit() if confirmExit(); +} + +sub closeEvent +{ + my $e = shift; + if(confirmExit()) + { + $e->accept + } + else + { + $e->ignore + } +} + +sub confirmExit +{ + my $doit; + if(@{ &executedLines }) + { + $doit = TQt::MessageBox::warning( + this, + "Warning" , + "A session is opened, quit anyway ?", + &TQt::MessageBox::Yes, + &TQt::MessageBox::No ); + } + else + { return 1 } + + return (($doit == &TQt::MessageBox::No) ? 0 : 1); +} + +sub emptySession +{ + unless (@{ &executedLines }) + { + statusBar()->message("Session is empty...", 3000); + return 1; + } + 0 +} + +sub helpExample +{ + emit fileNeedsEval("__DATA__") +} + +1; + +package TQtShell; + +use TQt; +use TQt::isa qw(TQt::MainWindow); +use TQt::slots + evalInput=>[], + evalFile=>[TQString]; +use TQt::attributes qw( + shellWindow +); +use TQtShellControl; + +sub NEW +{ + shift->SUPER::NEW(@_); + + shellWindow = TQtShellControl(undef, "shellWindow"); + this->resize(350,350); + this->move(Point(10,10)); + shellWindow->move(Point(300,200)); + this->show; + shellWindow->show; + + + this->connect(shellWindow->comboBox->lineEdit, TQT_SIGNAL 'returnPressed()', TQT_SLOT 'evalInput()'); + this->{'prompt'} = '$>'; + setCaption("MainWindow - this"); + shellWindow->sessionLog->setText("Ready.
"); + TQt::Object::connect(shellWindow, TQT_SIGNAL 'fileNeedsEval(TQString)', this, TQT_SLOT 'evalFile(TQString)'); +} + +sub logAppend +{ + shellWindow->sessionLog->setText( shellWindow->sessionLog->text . shift ) +} + +sub evalInput +{ + evalOneLine( shellWindow->comboBox->currentText ); +} + +sub evalOneLine +{ + my $prot = my $ln = shift; + $prot =~ s//>/gs; + logAppend( this->{'prompt'}. "$prot
" ); + { + no strict; + eval $ln; + } + if($@) + { + my $prot = $@ ; + $prot =~ s//>/gs; + my $c = shellWindow->sessionLog->color; + $prot =~ s/\n/
/gs; + logAppend(''.$prot.'
'); + shellWindow->sessionLog->setColor( $c ); + } + else + { + push @{ shellWindow()->{'executedLines'} }, $ln; + shellWindow->comboBox->clearEdit; + shellWindow->comboBox->setFocus; + } + shellWindow->sessionLog->scrollToBottom +} + +sub evalFile +{ + my $fn = shift; + my $fh; + if($fn eq "__DATA__") + { + $fh = \*::DATA + } + else + { + open($fh, $fn) or do { + TQt::MessageBox::warning ( + this, + "Error" , + "Couldn't open $fn: $!", + &TQt::MessageBox::Ok, + &TQt::MessageBox::NoButton ); + return + }; + } + while(<$fh>) + { + evalOneLine($_) + } + close $fh +} + +1; + +package TQt::TextHandle; + +sub TIEHANDLE { my ( $classnm, $widg, $color) = @_; + my $h = { widg => $widg, color => $color}; + bless $h, $classnm; + +} + +sub PRINT { + my $me = shift; + my $color = $me->{color}; + my $printed = join $/, @_; + $printed =~ s//>/gs; + $printed =~ s/\n/
/gs; + $me->{widg}->setText( $me->{widg}->text . "$printed" ); + +} + +sub PRINTF { shift->PRINT(sprintf shift, @_); } +sub CLOSE { shift->UNTIE; } +sub UNTIE { } + + +1; + +package main; +use strict; +use TQt; +use TQtShell; +use TQt::debug; + +my $app = TQt::Application(\@ARGV); +my $w = TQtShell(undef, "mainWindow"); +my $shw = $w->shellWindow; +$app->setMainWidget($shw); +tie *STDOUT, 'TQt::TextHandle', $shw->sessionLog, 'black'; +tie *STDERR, 'TQt::TextHandle', $shw->sessionLog, 'red'; + +exit $app->exec; + +__DATA__ +statusBar()->message("Hello World !"); +use TQt::attributes qw|datetime button textedit sample vbox| ; +vbox = VBox(this); +datetime = DateTimeEdit(vbox); +textedit = TQt::TextEdit(vbox); +button = PushButton("Hello World!", vbox) ; +this->setCentralWidget(vbox); +resize(220,240); +vbox->show; +sample = TQt::PopupMenu( this ); +use TQt::slots 'there' => []; +sample->insertItem("&There", this, TQT_SLOT 'there()'); +menuBar()->insertItem("&Here", sample); +sub there { statusBar()->message("There...", 2000) }; -- cgit v1.2.3