Commit cef394a9 authored by Marc Lehmann's avatar Marc Lehmann
Browse files

see plug-ins/perl/Changes

parent 9f6de5f3
......@@ -5,7 +5,15 @@ Revision history for Gimp-Perl extension.
if it can't be found.
- Uh, ah, debugging code in the repository, again!
- PF_FONT should now display a string widget in gtk+ 1.0.
- PixelRgn/Tile data sould now be accessible again-
- PixelRgn/Tile data sould now be accessible again.
- updated PDB.
- extensive tests is now always on.
- added examples/gimpmagick.
- closed big, BIG security hole on password authenticitation
(basically one could do anything includung killing your
system without authorization. argh). This required a
protocol change, so old clients are unable to connect using
password-authenticitation.
1.06 Sat Mar 6 19:36:12 CET 1999
- Gimp::Fu does no longer display the returned image when it
......
......@@ -12,7 +12,7 @@ use base qw(DynaLoader);
require DynaLoader;
$VERSION = 1.06;
$VERSION = 1.061;
@_param = qw(
PARAM_BOUNDARY PARAM_CHANNEL PARAM_COLOR PARAM_DISPLAY PARAM_DRAWABLE
......@@ -145,7 +145,7 @@ sub VERTICAL (){ 1 };
sub _PS_FLAG_QUIET { 0000000001 }; # do not output messages
sub _PS_FLAG_BATCH { 0000000002 }; # started via Gimp::Net, extra = filehandle
$_PROT_VERSION = "1"; # protocol version
$_PROT_VERSION = "2"; # protocol version
# we really abuse the import facility..
sub import($;@) {
......@@ -412,12 +412,6 @@ sub new($$$$$$$$) {
init Gimp::PixelRgn(@_);
}
sub DESTROY {
my $self = shift;
$self->{_drawable}->{_id}->update($self->{_x},$self->{_y},$self->{_w},$self->{_h})
if $self->{_dirty};
};
package Gimp::Parasite;
sub is_type($$) { $_[0]->[0] eq $_[1] }
......
......@@ -62,7 +62,6 @@ sub gimp_pixel_rgn_w { $_[0]->{_w} }
sub gimp_pixel_rgn_h { $_[0]->{_h} }
sub gimp_pixel_rgn_rowstride { $_[0]->{_rowstride} }
sub gimp_pixel_rgn_bpp { $_[0]->{_bpp} }
sub gimp_pixel_rgn_dirty { $_[0]->{_dirty} }
sub gimp_pixel_rgn_shadow { $_[0]->{_shadow} }
sub gimp_pixel_rgn_drawable { $_[0]->{_drawable} }
......@@ -72,6 +71,13 @@ sub gimp_tile_bpp { $_[0]->{_bpp} }
sub gimp_tile_shadow { $_[0]->{_shadow} }
sub gimp_tile_gdrawable { $_[0]->{_gdrawable} }
sub Gimp::PixelRgn::DESTROY {
my $self = shift;
return unless $self =~ /=HASH/;
$self->{_drawable}->{_id}->update($self->{_x},$self->{_y},$self->{_w},$self->{_h})
if $self->dirty;
};
1;
__END__
......
......@@ -145,7 +145,7 @@ GPixelRgn *old_pixelrgn (SV *sv)
STRLEN dc;
dTHR;
if (!sv_derived_from (sv, PKG_PIXELRGN))
if (!sv_derived_from (sv, PKG_PIXELRGN) && !SvTYPE (sv) != SVt_PVHV)
croak ("argument is not of type " PKG_PIXELRGN);
/* the next line lacks any type of checking. */
......@@ -1503,7 +1503,6 @@ gimp_pixel_rgn_init(gdrawable, x, y, width, height, dirty, shadow)
hv_store (hv, "_h" , 2, newSViv (pr->h) , 0);
hv_store (hv, "_rowstride",10, newSViv (pr->rowstride) , 0);
hv_store (hv, "_bpp" , 4, newSViv (pr->bpp) , 0);
hv_store (hv, "_dirty" , 6, newSViv (pr->dirty) , 0);
hv_store (hv, "_shadow" , 7, newSViv (pr->shadow) , 0);
hv_store (hv, "_drawable",9, newSVsv (gdrawable) , 0);
......@@ -1515,6 +1514,14 @@ gimp_pixel_rgn_init(gdrawable, x, y, width, height, dirty, shadow)
OUTPUT:
RETVAL
guint
gimp_pixel_rgn_dirty(pr)
GPixelRgn * pr
CODE:
RETVAL = pr->dirty;
OUTPUT:
RETVAL
void
gimp_pixel_rgn_resize(sv, x, y, width, height)
SV * sv
......
......@@ -23,7 +23,7 @@ $trace_res = *STDERR;
$trace_level = 0;
sub import {
return if @_;
return if @_>1;
*Gimp::Tile::DESTROY=
*Gimp::PixelRgn::DESTROY=
*Gimp::GDrawable::DESTROY=sub {
......@@ -52,7 +52,7 @@ sub args2net {
$res.="undef,";
}
}
$res;
substr($res,0,-1); # may not be worth the effort
}
sub _gimp_procedure_available {
......@@ -147,8 +147,10 @@ sub start_server {
my $args = &Gimp::RUN_NONINTERACTIVE." ".
(&Gimp::_PS_FLAG_BATCH | &Gimp::_PS_FLAG_QUIET)." ".
fileno(GIMP_FH);
exec "gimp","-n","-b","(extension-perl-server $args)",
"(extension_perl_server $args)";
{ # block to suppress warning with broken perls (e.g. 5.004)
exec "gimp","-n","-b","(extension-perl-server $args)",
"(extension_perl_server $args)"
}
exit(255);
} else {
croak "unable to fork: $!";
......@@ -204,7 +206,8 @@ sub gimp_init {
if($_ eq "AUTH") {
die "server requests authorization, but no authorization available\n"
unless $auth;
command "AUTH",$auth;
my $req = "AUTH".$auth;
print $server_fh pack("N",length($req)).$req;
my @r = response;
die "authorization failed: $r[1]\n" unless $r[0];
print "authorization ok, but: $r[1]\n" if $Gimp::verbose and $r[1];
......
......@@ -60,3 +60,4 @@ examples/scratches.pl
examples/blowinout.pl
examples/terral_text
examples/xachvision.pl
examples/gimpmagick
......@@ -27,7 +27,9 @@ success stories (and of course any bug-reports ;)
Do you want me to make these tests [y]? ";
$EXTENSIVE_TESTS = (<STDIN> !~ /^[nN]/) ? 1 : 0;
print "y\n";
$EXTENSIVE_TESTS = 1;
#$EXTENSIVE_TESTS = (<STDIN> !~ /^[nN]/) ? 1 : 0;
}
print "\n";
......@@ -117,7 +119,7 @@ EOF
@examples =
qw(windy.pl prep4gif.pl webify.pl PDB alpha2color.pl tex-to-float ditherize.pl
border.pl view3d.pl feedback.pl xachlego.pl xachshadow.pl parasite-editor
scratches.pl blowinout.pl terral_text xachvision.pl);
scratches.pl blowinout.pl terral_text xachvision.pl gimpmagick);
@shebang = (map("examples/$_",@examples),
qw(Perl-Server scm2perl scm2scm examples/example-net.pl examples/homepage-logo.pl
examples/example-fu.pl));
......
......@@ -163,15 +163,14 @@ sub handle_request($) {
} else {
if($req eq "AUTH") {
my($ok,$msg);
($req)=Gimp::Net::net2args($data);
if($req eq $auth) {
if($data eq $auth) {
$ok=1;
$authorized[fileno($fh)]=1;
} else {
$ok=0;
$msg="wrong authorization, aborting connection";
slog $msg;
sleep 10; # safety measure
sleep 5; # safety measure
}
$data=Gimp::Net::args2net($ok,$msg);
print $fh pack("N",length($data)).$data;
......
......@@ -2,7 +2,7 @@
#BEGIN {$^W=1};
use Gimp;
use Gimp (':consts');
use Gimp::Fu;
BEGIN { $] >= 5.005 or exit main }
use Gtk;
......@@ -14,6 +14,8 @@ $gtk_10 = Gtk->major_version==1 && Gtk->minor_version==0;
#Gimp::set_trace(TRACE_ALL);
my $ex; # average font width for default font
my $window; # the main window
my $clist; # the list of completions
my $rlist; # the results list
......@@ -21,9 +23,11 @@ my $inputline; # the input entry
my $result; # the result entry
my $synopsis; # the synopsis label
my $statusbar; # the statusbar
my $cinfo; # command info
my $idle; # the idle function id
my($blurb,$help,$author,$copyright,$date,$type,$args,$results);
my @args; # the arguments of the current function
my @function; # the names of all functions
......@@ -32,7 +36,7 @@ my %completion; # a hash that maps completion names to values
sub refresh {
undef %function;
@function = gimp_procedural_db_query("","","","","","","");
@function = Gimp->procedural_db_query("","","","","","","");
@function{@function}=(1) x @function;
}
......@@ -69,19 +73,97 @@ sub set_words {
}
my $last_func;
my $last_arg;
my %type2str = (
&PARAM_BOUNDARY => 'BOUNDARY',
&PARAM_CHANNEL => 'CHANNEL',
&PARAM_COLOR => 'COLOR',
&PARAM_DISPLAY => 'DISPLAY',
&PARAM_DRAWABLE => 'DRAWABLE',
&PARAM_FLOAT => 'FLOAT',
&PARAM_IMAGE => 'IMAGE',
&PARAM_INT32 => 'INT32',
&PARAM_FLOATARRAY => 'FLOATARRAY',
&PARAM_INT16 => 'INT16',
&PARAM_PARASITE => 'PARASITE',
&PARAM_STRING => 'STRING',
&PARAM_PATH => 'PATH',
&PARAM_INT16ARRAY => 'INT16ARRAY',
&PARAM_INT8 => 'INT8',
&PARAM_INT8ARRAY => 'INT8ARRAY',
&PARAM_LAYER => 'LAYER',
&PARAM_REGION => 'REGION',
&PARAM_STRINGARRAY => 'STRINGARRAY',
&PARAM_SELECTION => 'SELECTION',
&PARAM_STATUS => 'STATUS',
&PARAM_INT32ARRAY => 'INT32ARRAY',
);
sub leftlabel {
my $label = new Gtk::Label shift;
$label->set_alignment (0, 0.5);
$label;
}
sub new_cinfo {
my $table = new Gtk::Table 5,$args+$results+3,0;
$table->set_col_spacings($ex);
$table->set_row_spacings($ex*0.1);
$table->attach_defaults(leftlabel("TYPE"),2,3,0,1);
$table->attach_defaults(leftlabel("NAME"),3,4,0,1);
$table->attach_defaults(leftlabel("DESCRIPTION"),4,5,0,1);
my $y=2;
if($args) {
$table->attach_defaults(new Gtk::HSeparator,0,6,$y,$y+1);
$y++;
my $in = new Gtk::Label("In:");
$in->set_alignment (1, 0.5);
$table->attach_defaults($in,0,1,$y,$y+$args);
undef @argsvalid;
for(@args) {
my $valid = new Gtk::Label "-";
push(@argsvalid,$valid);
$table->attach_defaults($valid,1,2,$y,$y+1);
$table->attach_defaults(leftlabel($type2str{$_->[0]}),2,3,$y,$y+1);
$table->attach_defaults(leftlabel($_->[1]),3,4,$y,$y+1);
$table->attach_defaults(leftlabel($_->[2]),4,5,$y,$y+1);
$y++;
}
}
if($results) {
$table->attach_defaults(new Gtk::HSeparator,0,6,$y,$y+1);
$y++;
my $out = new Gtk::Label("Out:");
$out->set_alignment (1, 0.5);
$table->attach_defaults($out,0,1,$y,$y+$results);
for(0..$results-1) {
my($type,$name,$desc)=Gimp->procedural_db_proc_val ($last_func, $_);
$table->attach_defaults(leftlabel($type2str{$type}),2,3,$y,$y+1);
$table->attach_defaults(leftlabel($name),3,4,$y,$y+1);
$table->attach_defaults(leftlabel($desc),4,5,$y,$y+1);
$y++;
}
}
$table->show_all;
$table;
}
sub set_current_function {
my $fun = shift;
return if $last_func eq $fun;
return if $last_func eq $fun || !$function{$fun};
$last_func = $fun;
$last_arg = 0;
@args=();
eval {
$function{$fun} or die;
my($blurb,$help,$author,$copyright,$date,$type,$args,$results)=
gimp_procedural_db_proc_info($fun);
($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,$_)]);
push(@args,[Gimp->procedural_db_proc_arg($fun,$_)]);
}
my $ci = new_cinfo;
$cinfo->remove($cinfo->children); $cinfo->add ($ci);
};
}
......@@ -90,7 +172,6 @@ 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(@_) {
......@@ -99,7 +180,6 @@ sub set_clist {
}
$clist->unselect_item(0);
$clist->show_all;
# $clist->signal_handler_unblock($sel_changed);
$block_sel_changed--;
}
......@@ -115,7 +195,7 @@ sub complete_function {
$synopsis->set(scalar@matches." matching functions");
} else {
set_clist @matches,@matches;
$synopsis->set($matches[0]." (press F2 to complete)");
$synopsis->set($matches[0]." (press Tab to complete)");
}
}
......@@ -151,14 +231,13 @@ sub complete_type {
$synopsis->set($desc);
}
my $last_arg;
sub update_completion {
my($idx,$pos,@words)=get_words;
return unless $idx ne $last_arg;
eval { $argsvalid[$last_arg-1]->set('+') };
$last_arg=$idx;
$statusbar->set_percentage($idx/@args) if @args;
eval { $argsvalid[$last_arg-1]->set('>') };
set_current_function $words[0];
......@@ -180,8 +259,18 @@ sub do_completion {
$word=~s/[-_]/[-_]/g;
my(@matches)=grep /$word/i,keys %completion;
if(@matches==1) {
$words[$idx]=$completion{$matches[0]};
my $new;
if (@matches>1) {
if (join("\n",@matches) =~ ("^(".$words[$idx].".*).*?".("\n\\1.*" x scalar@matches-1))) {
$new=$1;
}
} elsif(@matches==1) {
$new=$completion{$matches[0]};
} else {
Gtk::Gdk->beep;
}
if (defined $new) {
$words[$idx]=$new;
set_current_function $words[0] if $idx==0;
if($idx<@args) {
$words[$idx+1]="\0".$words[$idx+1];
......@@ -189,9 +278,8 @@ sub do_completion {
$words[$idx].="\0";
}
set_words @words;
} else {
Gtk::Gdk->beep;
}
eval { $argsvalid[$last_arg-1]->set('-') };
undef $last_arg;
}
......@@ -199,9 +287,11 @@ sub execute_command {
my($idx,$pos,$fun,@args)=get_words;
$res=eval { Gimp->$fun(@args) };
if ($@) {
$result->set_text($@);
$statusbar->set($@);
$result->set_text("");
Gtk::Gdk->beep;
} else {
$statusbar->set('');
$result->set_text($res);
$rlist->prepend_items(new Gtk::ListItem $res);
}
......@@ -219,30 +309,30 @@ sub do_idle {
sub inputline {
my $e = new Gtk::Entry;
$e->set_text("gimp_blend 0,2,3,6,6,100,10,1,1,1,0,10,20,30,40");
$e->set_text("");
$e->signal_connect("changed",sub {
return if $block_changed;
eval { $argsvalid[$last_arg-1]->set('-') };
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 {
eval { $argsvalid[$last_arg-1]->set('-') };
undef $last_arg;
do_idle;
# GDK_Tab = 0xFF09
if ($_[1]->{keyval} == 0xFF09) {
# do_completion;
print "ztab\n";
return 1;
} elsif ($_[1]->{keyval} == 0xFFBF) {
$_[0]->signal_emit_stop_by_name('key_press_event');
do_completion;
();
1;
} else {
();
}
});
$e->signal_connect("activate",\&execute_command);
$e->set_usize(300,0);
$e->set_usize($ex*40,0);
$inputline=$e;
my $c = new Gtk::List;
......@@ -256,6 +346,7 @@ print "ztab\n";
$words[$idx]=$completion{$c->selection->children->get}."\0";
$block_changed++;
set_words (@words);
set_current_function (substr($words[0],0,-1)) unless $idx;
$block_changed--;
};
do_idle;
......@@ -276,8 +367,10 @@ sub create_main {
$t = new Gtk::Tooltips;
my $w = new Gtk::Dialog;
$window = $w;
$w->realize;
$ex = $w->style->font->string_width ('Mn')*0.5;
$w->set_title('PDB Browser - the early alpha version');
$w->set_title('PDB Explorer - the alpha version');
$w->signal_connect("destroy",sub {main_quit Gtk});
$b = new Gtk::Button "Close";
......@@ -306,16 +399,17 @@ sub create_main {
$result = new Gtk::Entry;
$result->set_editable(0);
$result->set_usize(200,0);
$result->set_usize($ex*30,0);
# $statusbar = new Gtk::Statusbar;
$statusbar = new Gtk::ProgressBar;
$statusbar = new Gtk::Label;
realize $window;
$table->border_width(10);
$table->attach(new Gtk::Label("Synopsis") ,0,1,0,1,{},{},0,0);
$table->attach($synopsis ,1,2,0,1,{},{},0,0);
$table->attach(logo(),2,3,0,1,{},{},0,0);
#$table->attach(logo(),2,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);
......@@ -324,19 +418,24 @@ sub create_main {
$table->attach($rs,2,3,2,3,['expand','fill'],['expand','fill'],0,0);
$table->attach(new Gtk::Label("Status"),0,1,3,4,{},{},0,0);
$table->attach($statusbar,1,3,3,4,['expand','fill'],['expand','fill'],0,0);
$cinfo = new Gtk::Frame "Command Info";
$cinfo->border_width(10);
$cinfo->add (new_cinfo);
$w->vbox->add ($cinfo);
idle;
show_all $w;
}
register "extension_pdb_browser",
"Procedural Database Browser",
register "extension_pdb_explorer",
"Procedural Database Explorer",
"This is a more interactive version of the DB Browser",
"Marc Lehmann",
"Marc Lehmann",
"0.0",
"<Toolbox>/Xtns/PDB Browser",
"0.1",
"<Toolbox>/Xtns/PDB Explorer",
"",
[],
sub {
......
This diff is collapsed.
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