mirror of https://github.com/GNOME/gimp.git
See plug-ins/perl/Changes
This commit is contained in:
Marc Lehmann
parent
0896ebc32d
commit
d8e4db64de
|
|
@ -1,11 +1,19 @@
|
|||
Revision history for Gimp-Perl extension.
|
||||
|
||||
- passing arguments on the commandline works again
|
||||
(formerly all arguments were treated as integers)
|
||||
- added the PDB extension to the distribution (alpha!)
|
||||
|
||||
1.046 Thu Nov 5 01:53:34 CET 1998
|
||||
- the syntax really gets tricky - references to INT32 and similar
|
||||
types are no longer accepted (was buggy anyway).
|
||||
- added plug_in_ prefix to layer, darwable, image and channel. We
|
||||
- added plug_in_ prefix to layer, drawable, image and channel. We
|
||||
can now write $layer->sharpen(50), and gimp infers function name,
|
||||
run_mode and image
|
||||
- enhanced the testuite, it now checks much more features
|
||||
- gimp_end() now correctly closes the connection
|
||||
- implemented Gimp::lock and unlock functions, giving exclusive
|
||||
access to the Perl-Server
|
||||
|
||||
1.045 Sun Nov 1 23:40:20 CET 1998
|
||||
- more configuration cleanups
|
||||
|
|
|
|||
|
|
@ -12,7 +12,7 @@ use base qw(DynaLoader);
|
|||
|
||||
require DynaLoader;
|
||||
|
||||
$VERSION = 1.045;
|
||||
$VERSION = 1.046;
|
||||
|
||||
@_param = qw(
|
||||
PARAM_BOUNDARY PARAM_CHANNEL PARAM_COLOR PARAM_DISPLAY PARAM_DRAWABLE
|
||||
|
|
@ -218,9 +218,12 @@ for(qw(_gimp_procedure_available gimp_call_procedure set_trace)) {
|
|||
*$_ = \&{"${interface_pkg}::$_"};
|
||||
}
|
||||
|
||||
*main = *gimp_main = \&{"${interface_pkg}::gimp_main"};
|
||||
*init = *gimp_init = \&{"${interface_pkg}::gimp_init"};
|
||||
*end = *gimp_end = \&{"${interface_pkg}::gimp_end" };
|
||||
*main = *gimp_main = \&{"${interface_pkg}::gimp_main"};
|
||||
*init = *gimp_init = \&{"${interface_pkg}::gimp_init"};
|
||||
*end = *gimp_end = \&{"${interface_pkg}::gimp_end" };
|
||||
|
||||
*lock = \&{"${interface_pkg}::lock" };
|
||||
*unlock= \&{"${interface_pkg}::unlock" };
|
||||
|
||||
@PREFIXES=("gimp_", "");
|
||||
|
||||
|
|
@ -592,6 +595,16 @@ interface (L<Gimp::Net>), and not as a native plug-in. Here's an example:
|
|||
<do something with the gimp>
|
||||
Gimp::end;
|
||||
|
||||
=item Gimp::lock(), Gimp::unlock()
|
||||
|
||||
These functions can be used to gain exclusive access to the Gimp. After
|
||||
calling lock, all accesses by other clients will be blocked and executed
|
||||
after the call to unlock. Calls to lock and unlock can be nested.
|
||||
|
||||
Currently, these functions only lock the current Perl-Server instance
|
||||
against exclusive access, they are nops when used via the Gimp::Lib
|
||||
interface.
|
||||
|
||||
=item gimp_install_procedure(name, blurb, help, author, copyright, date, menu_path, image_types, type, [params], [return_vals])
|
||||
|
||||
Mostly same as gimp_install_procedure. The parameters and return values for
|
||||
|
|
|
|||
|
|
@ -472,7 +472,7 @@ sub net {
|
|||
my $arg=shift @ARGV;
|
||||
my $idx=$map{$1};
|
||||
die "$_: illegal switch, try $0 --help\n" unless defined($idx);
|
||||
$args[$idx]=string2pf($arg,$params->[@args]);
|
||||
$args[$idx]=string2pf($arg,$params->[$idx]);
|
||||
$interact--;
|
||||
}
|
||||
} else {
|
||||
|
|
|
|||
|
|
@ -22,6 +22,14 @@ sub gimp_end {
|
|||
die "gimp_end not implemented for in the Lib interface";
|
||||
}
|
||||
|
||||
sub lock {
|
||||
# unimplemented, ignored
|
||||
}
|
||||
|
||||
sub unlock {
|
||||
# unimplemented, ignored
|
||||
}
|
||||
|
||||
sub import {}
|
||||
|
||||
bootstrap Gimp::Lib $VERSION;
|
||||
|
|
|
|||
|
|
@ -274,20 +274,20 @@ dump_params (int nparams, GParam *args, GParamDef *params)
|
|||
|
||||
switch (args[i].type)
|
||||
{
|
||||
case PARAM_INT32: trace_printf ("%d", args[i].data.d_int32); break;
|
||||
case PARAM_INT16: trace_printf ("%d", args[i].data.d_int16); break;
|
||||
case PARAM_INT8: trace_printf ("%d", (guint8) args[i].data.d_int8); break;
|
||||
case PARAM_FLOAT: trace_printf ("%f", args[i].data.d_float); break;
|
||||
case PARAM_STRING: trace_printf ("\"%s\"", args[i].data.d_string); break;
|
||||
case PARAM_DISPLAY: trace_printf ("%d", args[i].data.d_display); break;
|
||||
case PARAM_IMAGE: trace_printf ("%d", args[i].data.d_image); break;
|
||||
case PARAM_LAYER: trace_printf ("%d", args[i].data.d_layer); break;
|
||||
case PARAM_CHANNEL: trace_printf ("%d", args[i].data.d_channel); break;
|
||||
case PARAM_DRAWABLE: trace_printf ("%d", args[i].data.d_drawable); break;
|
||||
case PARAM_SELECTION: trace_printf ("%d", args[i].data.d_selection); break;
|
||||
case PARAM_BOUNDARY: trace_printf ("%d", args[i].data.d_boundary); break;
|
||||
case PARAM_PATH: trace_printf ("%d", args[i].data.d_path); break;
|
||||
case PARAM_STATUS: trace_printf ("%d", args[i].data.d_status); break;
|
||||
case PARAM_INT32: trace_printf ("%d", args[i].data.d_int32); break;
|
||||
case PARAM_INT16: trace_printf ("%d", args[i].data.d_int16); break;
|
||||
case PARAM_INT8: trace_printf ("%d", (guint8) args[i].data.d_int8); break;
|
||||
case PARAM_FLOAT: trace_printf ("%f", args[i].data.d_float); break;
|
||||
case PARAM_STRING: trace_printf ("\"%s\"", args[i].data.d_string); break;
|
||||
case PARAM_DISPLAY: trace_printf ("%d", args[i].data.d_display); break;
|
||||
case PARAM_IMAGE: trace_printf ("%d", args[i].data.d_image); break;
|
||||
case PARAM_LAYER: trace_printf ("%d", args[i].data.d_layer); break;
|
||||
case PARAM_CHANNEL: trace_printf ("%d", args[i].data.d_channel); break;
|
||||
case PARAM_DRAWABLE: trace_printf ("%d", args[i].data.d_drawable); break;
|
||||
case PARAM_SELECTION: trace_printf ("%d", args[i].data.d_selection); break;
|
||||
case PARAM_BOUNDARY: trace_printf ("%d", args[i].data.d_boundary); break;
|
||||
case PARAM_PATH: trace_printf ("%d", args[i].data.d_path); break;
|
||||
case PARAM_STATUS: trace_printf ("%d", args[i].data.d_status); break;
|
||||
case PARAM_INT32ARRAY: dump_printarray (args, i, gint32, d_int32array, "%d"); break;
|
||||
case PARAM_INT16ARRAY: dump_printarray (args, i, gint16, d_int16array, "%d"); break;
|
||||
case PARAM_INT8ARRAY: dump_printarray (args, i, guint8, d_int8array , "%d"); break;
|
||||
|
|
|
|||
|
|
@ -106,9 +106,16 @@ sub gimp_call_procedure {
|
|||
}
|
||||
|
||||
sub server_quit {
|
||||
print "sending quit\n";
|
||||
print $server_fh pack("N",4)."QUIT";
|
||||
exit(0);
|
||||
undef $server_fh;
|
||||
}
|
||||
|
||||
sub lock {
|
||||
print $server_fh pack("N",12)."LOCK".pack("N*",1,0);
|
||||
}
|
||||
|
||||
sub unlock {
|
||||
print $server_fh pack("N",12)."LOCK".pack("N*",0,0);
|
||||
}
|
||||
|
||||
sub set_trace {
|
||||
|
|
@ -202,6 +209,7 @@ sub gimp_init {
|
|||
}
|
||||
|
||||
sub gimp_end {
|
||||
undef $server_fh;
|
||||
kill 'KILL',$gimp_pid if $gimp_pid;
|
||||
undef $gimp_pid;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -128,6 +128,7 @@ install-plugins:
|
|||
-cd examples && $GIMPTOOL2 --install-admin-bin windy.pl
|
||||
-cd examples && $GIMPTOOL2 --install-admin-bin prep4gif.pl
|
||||
-cd examples && $GIMPTOOL2 --install-admin-bin webify.pl
|
||||
-cd examples && $GIMPTOOL2 --install-admin-bin PDB
|
||||
# -cd examples && $GIMPTOOL2 --install-admin-bin border.pl
|
||||
EOF
|
||||
}
|
||||
|
|
|
|||
|
|
@ -14,7 +14,8 @@ use IO::Socket;
|
|||
|
||||
use strict;
|
||||
use vars qw($use_unix $use_tcp $trace_res $server_quit $max_pkt $unix $tcp $ps_flags
|
||||
%object_dynamic $object_uid %objects $auth @authorized);
|
||||
%object_dynamic $object_uid %objects $auth @authorized $exclusive
|
||||
$rm $saved_rm);
|
||||
use Gimp '';
|
||||
use Gimp::Net qw(:server);
|
||||
|
||||
|
|
@ -35,6 +36,8 @@ Gimp::ignore_functions(qw(gimp_progress_init gimp_progress_update));
|
|||
# TRCE trace in-args trace status out-args run simple command (with tracing)
|
||||
# TEST procname bool check for procedure existance
|
||||
# DTRY in-args destroy all argument objects
|
||||
# LOCK lock? shared? lock or unlock
|
||||
# RSET reset server (NYI)
|
||||
#
|
||||
# args is "number of arguments" arguments preceded by length
|
||||
# type is first character
|
||||
|
|
@ -45,7 +48,8 @@ Gimp::ignore_functions(qw(gimp_progress_init gimp_progress_update));
|
|||
|
||||
$server_quit = 0;
|
||||
|
||||
$max_pkt = 1024*1024;
|
||||
my $max_pkt = 1024*1024*8;
|
||||
my $exclusive = 0;
|
||||
|
||||
sub slog {
|
||||
return if $ps_flags & &Gimp::_PS_FLAG_QUIET;
|
||||
|
|
@ -133,6 +137,23 @@ sub handle_request($) {
|
|||
} elsif($req eq "AUTH") {
|
||||
$data=Gimp::Net::args2net(1,"authorization unnecessary");
|
||||
print $fh pack("N",length($data)).$data;
|
||||
} elsif($req eq "LOCK") {
|
||||
my($lock,$shared)=unpack("N*",$data);
|
||||
slog "WARNING: shared locking requested but not implemented" if $shared;
|
||||
if($lock) {
|
||||
unless($exclusive) {
|
||||
$saved_rm=$rm;
|
||||
undef $rm; vec($rm,fileno($fh),1)=1;
|
||||
}
|
||||
$exclusive++;
|
||||
} else {
|
||||
if ($exclusive) {
|
||||
$exclusive--;
|
||||
$rm = $saved_rm unless $exclusive;
|
||||
} else {
|
||||
slog "WARNING: client tried to unlock without holding a lock";
|
||||
}
|
||||
}
|
||||
} else {
|
||||
print $fh pack("N",0);
|
||||
slog "illegal command received, aborting connection";
|
||||
|
|
@ -194,7 +215,7 @@ sub extension_perl_server {
|
|||
|
||||
$SIG{PIPE}='IGNORE'; # may not work, since libgimp (eech) overwrites it.
|
||||
my($unix_path)=$Gimp::Net::default_unix_dir.$Gimp::Net::default_unix_sock;
|
||||
my($rm,%handles,$r,$fh,$f);
|
||||
my(%handles,$r,$fh,$f);
|
||||
|
||||
if ($use_unix) {
|
||||
unlink $unix_path;
|
||||
|
|
@ -237,10 +258,16 @@ sub extension_perl_server {
|
|||
$fh=$handles{$f};
|
||||
unless(handle_request($fh)) {
|
||||
slog "closing connection ",$f;
|
||||
if ($exclusive) {
|
||||
$rm = $saved_rm;
|
||||
$exclusive = 0;
|
||||
slog "WARNING: client disconnected while holding an active lock\n";
|
||||
}
|
||||
vec($rm,$f,1)=0;
|
||||
delete $handles{$f};
|
||||
undef $fh;
|
||||
}
|
||||
last; # this is because the client might have called lock()
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -70,6 +70,13 @@ INSTALLATION
|
|||
(http://www.linux.org)
|
||||
|
||||
SUPPORT/MAILING LISTS/MORE INFO
|
||||
There is a mailinglist for general discussion about Gimp-Perl.
|
||||
To subscribe, send a mail with the single line
|
||||
|
||||
subscribe
|
||||
|
||||
to gimp-perl-request@lists.netcentral.net.
|
||||
|
||||
If you want to get notified of new versions automatically, send
|
||||
a mail with the single line:
|
||||
|
||||
|
|
|
|||
|
|
@ -20,14 +20,16 @@ bugs
|
|||
important issues
|
||||
|
||||
* gradient button
|
||||
* do not special-case INT32 in convert_sv2gimp
|
||||
* implement Perl-Server RSET and shared lock(!)
|
||||
* Gimp::lock && unlock
|
||||
[DONE] * do not special-case INT32 in convert_sv2gimp
|
||||
* substr 4th argument form for Net:: -> require 5.005!!!! DO IT!
|
||||
* use Gimp qw(GIMP_HOST=jfjf)???
|
||||
* brushes look inverted
|
||||
* zero-copy PDL support
|
||||
[DONE] * gimp_init, gimp_deinit
|
||||
[DONE] * duplicate HAVE_VPRINTF in gimp
|
||||
* get rid of superfluous image arguments
|
||||
[DONE] * get rid of superfluous image arguments
|
||||
* weighted movement in drawing tools
|
||||
* -DMIN_PERL_DEFINE
|
||||
* --function localfunc to select one of the registered scripts
|
||||
|
|
|
|||
|
|
@ -0,0 +1,333 @@
|
|||
#!/usr/bin/perl
|
||||
|
||||
#BEGIN {$^W=1};
|
||||
|
||||
require 5.005;
|
||||
|
||||
use Gimp;
|
||||
use Gimp::Fu;
|
||||
use Gtk;
|
||||
use Gtk::Gdk;
|
||||
|
||||
#Gimp::set_trace(TRACE_ALL);
|
||||
|
||||
my $window; # the main window
|
||||
my $clist; # the list of completions
|
||||
my $rlist; # the results list
|
||||
my $inputline; # the input entry
|
||||
my $result; # the result entry
|
||||
my $synopsis; # the synopsis label
|
||||
|
||||
my $idle; # the idle function id
|
||||
|
||||
my @args; # the arguments of the current function
|
||||
|
||||
my @function; # the names of all functions
|
||||
my %function; # the same as hash
|
||||
my %completion; # a hash that maps completion names to values
|
||||
|
||||
sub refresh {
|
||||
undef %function;
|
||||
@function = gimp_procedural_db_query("","","","","","","");
|
||||
@function{@function}=(1) x @function;
|
||||
}
|
||||
|
||||
sub get_words {
|
||||
my $text = $inputline->get_text;
|
||||
my $i = 0;
|
||||
my($p,$idx,$pos);
|
||||
my $word;
|
||||
my @words;
|
||||
substr($text,$inputline->get('text_position'),0,"\0");
|
||||
while ($text =~ /("(?:[^"\\]*(?:\\.[^"\\]*)*)")[ ,]*|([^ ,]+)[ ,]*|[ ,]+/g) {
|
||||
$word = defined $1 ? $1 : $2;
|
||||
if (($p = index($word, "\0")) >= 0) {
|
||||
$idx=$i; $pos=$p;
|
||||
substr ($word, $p, 1, "");
|
||||
}
|
||||
$i++;
|
||||
push(@words,$word);
|
||||
}
|
||||
($idx,$pos,@words);
|
||||
}
|
||||
|
||||
sub set_words {
|
||||
my $text=shift;
|
||||
$text.=" ".join(",",@_) if scalar@_;
|
||||
my $pos=index($text,"\0");
|
||||
if ($pos) {
|
||||
substr($text,$pos,1,"");
|
||||
$inputline->set_text($text);
|
||||
$inputline->set_position($pos);
|
||||
} else {
|
||||
$inputline->set_text($text);
|
||||
}
|
||||
}
|
||||
|
||||
my $last_func;
|
||||
|
||||
sub set_current_function {
|
||||
my $fun = shift;
|
||||
return if $last_func eq $fun;
|
||||
$last_func = $fun;
|
||||
@args=();
|
||||
eval {
|
||||
$function{$fun} or die;
|
||||
my($blurb,$help,$author,$copyright,$date,$type,$args,$results)=
|
||||
gimp_procedural_db_proc_info($fun);
|
||||
for(0..$args-1) {
|
||||
push(@args,[gimp_procedural_db_proc_arg($fun,$_)]);
|
||||
}
|
||||
};
|
||||
}
|
||||
|
||||
my $block_sel_changed; # gtk is braindamaged
|
||||
my $block_changed; # gtk is broken
|
||||
|
||||
sub set_clist {
|
||||
$block_sel_changed++;
|
||||
# $clist->signal_handler_block($sel_changed); # yes virginia, this is broken
|
||||
$clist->clear_items(0,99999);
|
||||
%completion=@_;
|
||||
while(@_) {
|
||||
$clist->add(new Gtk::ListItem(shift));
|
||||
shift;
|
||||
}
|
||||
$clist->unselect_item(0);
|
||||
$clist->show_all;
|
||||
# $clist->signal_handler_unblock($sel_changed);
|
||||
$block_sel_changed--;
|
||||
}
|
||||
|
||||
sub complete_function {
|
||||
my $name = shift;
|
||||
$name=~s/[-_]/[-_]/g;
|
||||
my @matches = sort grep /$name/i,@function;
|
||||
if(@matches>70) {
|
||||
set_clist map(($_,$_),@matches[0..69]);
|
||||
$synopsis->set("showing only the first 70 matches (of ".scalar@matches.")");
|
||||
} elsif(@matches>1) {
|
||||
set_clist map(($_,$_),@matches);
|
||||
$synopsis->set(scalar@matches." matching functions");
|
||||
} else {
|
||||
set_clist @matches,@matches;
|
||||
$synopsis->set($matches[0]);
|
||||
}
|
||||
}
|
||||
|
||||
sub complete_type {
|
||||
my($type,$name,$desc)=@_;
|
||||
|
||||
if($type==PARAM_IMAGE) {
|
||||
set_clist(map(("$$_: ".$_->get_filename,$$_),Gimp->list_images));
|
||||
} elsif($type==PARAM_LAYER) {
|
||||
set_clist(map { my $i = $_; map(("$$i: ".$i->get_filename."/".$_->get_name,$$_),$i->get_layers)} Gimp->list_images);
|
||||
} elsif($type==PARAM_CHANNEL) {
|
||||
set_clist(map { my $i = $_; map(("$$i: ".$i->get_filename."/".$_->get_name,$$_),$i->get_channels)} Gimp->list_images);
|
||||
} elsif($type==PARAM_DRAWABLE) {
|
||||
set_clist(map { my $i = $_; map(("$$i: ".$i->get_filename."/".$_->get_name,$$_),($i->get_layers,$i->get_channels))} Gimp->list_images);
|
||||
} elsif ($type==PARAM_INT32) {
|
||||
if ($name eq "run_mode") {
|
||||
set_clist("RUN_NONINTERACTIVE","RUN_NONINTERACTIVE",
|
||||
"RUN_INTERACTIVE","RUN_INTERACTIVE",
|
||||
"RUN_WITH_LAST_VALS","RUN_WITH_LAST_VALS");
|
||||
} elsif ($desc=~s/(?::\s*)?{(.*)}.*?$//) {
|
||||
$_=$1;
|
||||
my @args;
|
||||
while(s/^.*?([A-Za-z_-]+)\s*\(\s*(\d+)\s*\)//) {
|
||||
push(@args,"$2: $1",$2);
|
||||
}
|
||||
set_clist(@args);
|
||||
} else {
|
||||
set_clist;
|
||||
}
|
||||
} else {
|
||||
set_clist;
|
||||
}
|
||||
$synopsis->set($desc);
|
||||
}
|
||||
|
||||
my $last_arg;
|
||||
|
||||
sub update_completion {
|
||||
my($idx,$pos,@words)=get_words;
|
||||
|
||||
return unless $idx ne $last_arg;
|
||||
$last_arg=$idx;
|
||||
|
||||
set_current_function $words[0];
|
||||
|
||||
if ($idx == 0) {
|
||||
complete_function($words[0]);
|
||||
} elsif ($idx>@args) {
|
||||
$synopsis->set('too many arguments');
|
||||
set_clist;
|
||||
} else {
|
||||
complete_type(@{$args[$idx-1]});
|
||||
}
|
||||
}
|
||||
|
||||
sub do_completion {
|
||||
update_completion;
|
||||
|
||||
my($idx,$pos,@words)=get_words;
|
||||
my($word)=$words[$idx];
|
||||
|
||||
$word=~s/[-_]/[-_]/g;
|
||||
my(@matches)=grep /$word/i,keys %completion;
|
||||
if(@matches==1) {
|
||||
$words[$idx]=$completion{$matches[0]};
|
||||
set_current_function $words[0] if $idx==0;
|
||||
if($idx<@args) {
|
||||
$words[$idx+1]="\0".$words[$idx+1];
|
||||
} else {
|
||||
$words[$idx].="\0";
|
||||
}
|
||||
set_words @words;
|
||||
} else {
|
||||
Gtk::Gdk->beep;
|
||||
}
|
||||
undef $last_arg;
|
||||
}
|
||||
|
||||
sub idle {
|
||||
Gtk->idle_remove($idle) if $idle;
|
||||
undef $idle;
|
||||
update_completion;
|
||||
}
|
||||
|
||||
sub do_idle {
|
||||
$idle=Gtk->idle_add(\&idle) unless $idle;
|
||||
}
|
||||
|
||||
sub inputline {
|
||||
my $e = new Gtk::Entry;
|
||||
$e->signal_connect("changed",sub {
|
||||
return if $block_changed;
|
||||
undef $last_arg;
|
||||
do_idle;
|
||||
});
|
||||
$e->signal_connect("focus_in_event",\&do_idle);
|
||||
$e->signal_connect("button_press_event",\&do_idle);
|
||||
$e->signal_connect("key_press_event",sub {
|
||||
undef $last_arg;
|
||||
do_idle;
|
||||
if ($_[1]->{keyval} == 0xFF09) {
|
||||
# do_completion;
|
||||
();
|
||||
} elsif ($_[1]->{keyval} == 0xFFBE) {
|
||||
do_completion;
|
||||
();
|
||||
} else {
|
||||
();
|
||||
}
|
||||
});
|
||||
$e->set_usize(300,0);
|
||||
$inputline=$e;
|
||||
|
||||
my $c = new Gtk::List;
|
||||
$clist = $c;
|
||||
$c->set_selection_mode(-single);
|
||||
$c->set_selection_mode(-browse);
|
||||
$c->signal_connect("selection_changed", sub {
|
||||
return if $block_sel_changed;
|
||||
eval {
|
||||
my($idx,$pos,@words)=get_words;
|
||||
$words[$idx]=$completion{$c->selection->children->get}."\0";
|
||||
$block_changed++;
|
||||
set_words (@words);
|
||||
$block_changed--;
|
||||
};
|
||||
do_idle;
|
||||
});
|
||||
|
||||
my $r = new Gtk::List;
|
||||
$rlist = $r;
|
||||
$r->set_selection_mode(-single);
|
||||
$r->set_selection_mode(-browse);
|
||||
}
|
||||
|
||||
sub create_main {
|
||||
my $b;
|
||||
my $t;
|
||||
|
||||
parse Gtk::Rc Gimp->gtkrc;
|
||||
|
||||
$t = new Gtk::Tooltips;
|
||||
my $w = new Gtk::Dialog;
|
||||
$window = $w;
|
||||
|
||||
$w->set_title('PDB Browser - the early alpha version');
|
||||
|
||||
$b = new Gtk::Button "Close";
|
||||
$w->action_area->add($b);
|
||||
$b->signal_connect("clicked",sub {main_quit Gtk});
|
||||
|
||||
my $h = new Gtk::HBox (0,5);
|
||||
$w->vbox->add ($h);
|
||||
|
||||
inputline;
|
||||
|
||||
$synopsis = new Gtk::Label "";
|
||||
$synopsis->set_justify(-left);
|
||||
|
||||
my $table = new Gtk::Table 3,3,0;
|
||||
$w->vbox->add($table);
|
||||
|
||||
my $cs = new Gtk::ScrolledWindow undef,undef;
|
||||
$cs->set_policy(-automatic,-automatic);
|
||||
$cs->add($clist);
|
||||
|
||||
my $rs = new Gtk::ScrolledWindow undef,undef;
|
||||
$rs->set_policy(-automatic,-automatic);
|
||||
$rs->add($rlist);
|
||||
$rs->set_usize(0,200);
|
||||
|
||||
$result = new Gtk::Entry;
|
||||
$result->set_editable(0);
|
||||
$result->set_usize(200,0);
|
||||
|
||||
$table->attach(new Gtk::Label("Synopsis") ,0,1,0,1,{},{},0,0);
|
||||
$table->attach($synopsis ,1,3,0,1,{},{},0,0);
|
||||
$table->attach(new Gtk::Label("Command") ,0,1,1,2,{},{},0,0);
|
||||
$table->attach($inputline,1,2,1,2,['expand','fill'],{},0,0);
|
||||
$table->attach($result,2,3,1,2,['expand','fill'],{},0,0);
|
||||
$table->attach(new Gtk::Label("Shortcuts"),0,1,2,3,{},{},0,0);
|
||||
$table->attach($cs ,1,2,2,3,['expand','fill'],['expand','fill'],0,0);
|
||||
$table->attach($rs,2,3,2,3,['expand','fill'],['expand','fill'],0,0);
|
||||
|
||||
idle;
|
||||
|
||||
show_all $w;
|
||||
}
|
||||
|
||||
register "extension_pdb_browser",
|
||||
"Procedural Database Browser",
|
||||
"This is a more interactive version of the DB Browser",
|
||||
"Marc Lehmann",
|
||||
"Marc Lehmann",
|
||||
"0.0",
|
||||
"<Toolbox>/Xtns/PDB Browser",
|
||||
"",
|
||||
[],
|
||||
sub {
|
||||
|
||||
refresh;
|
||||
create_main;
|
||||
main Gtk;
|
||||
|
||||
();
|
||||
};
|
||||
|
||||
init Gtk;
|
||||
exit main;
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
Loading…
Reference in New Issue