Commit d8e4db64 authored by Marc Lehmann's avatar Marc Lehmann

See plug-ins/perl/Changes

parent 0896ebc3
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
......
#!/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;
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment