[gimp-perl] Implement G::E::podregister_temp, with Gimp::Fu UI.
- From: Ed J <edj src gnome org>
- To: commits-list gnome org
- Cc:
- Subject: [gimp-perl] Implement G::E::podregister_temp, with Gimp::Fu UI.
- Date: Thu, 22 May 2014 06:57:06 +0000 (UTC)
commit 6c1a2ba5403d9be89cece6e478132c390229dbfa
Author: Ed J <edj src gnome org>
Date: Thu May 22 07:56:44 2014 +0100
Implement G::E::podregister_temp, with Gimp::Fu UI.
Gimp/Extension.pm | 121 ++++++++++-------------
Gimp/Fu.pm | 67 ++++++++-----
Gimp/Pod.pm | 9 +-
Net/Net.pm | 4 +-
examples/autosave | 273 +++++++++++++++++++++++------------------------------
t/extension.t | 26 +++++-
6 files changed, 244 insertions(+), 256 deletions(-)
---
diff --git a/Gimp/Extension.pm b/Gimp/Extension.pm
index 7f76687..2a956ff 100644
--- a/Gimp/Extension.pm
+++ b/Gimp/Extension.pm
@@ -3,8 +3,8 @@ package Gimp::Extension;
use strict;
use Carp qw(croak carp);
use base 'Exporter';
-use Filter::Simple;
use Gimp::Pod;
+require Gimp::Fu;
use autodie;
use Gtk2;
@@ -12,56 +12,47 @@ use Gtk2;
sub __ ($) { goto &Gimp::__ }
sub main { goto &Gimp::main; }
-my $podreg_re = qr/(\bpodregister\s*{)/;
-FILTER {
- return unless /$podreg_re/;
- my $myline = make_arg_line(fixup_args(('') x 9, 1));
- s/$podreg_re/$1\n$myline/;
- warn __PACKAGE__."::FILTER: found: '$1'" if $Gimp::verbose;
-};
+our $VERSION = 2.3003;
+our @EXPORT = qw(podregister main add_listener register_temp podregister_temp);
+
+# this is to avoid warnings from importing main etc from Gimp::Fu AND here
+sub import {
+ my $p = \%::;
+ $p = $p->{"${_}::"} for split /::/, caller;
+ map { delete $p->{$_} if defined &{caller."::$_"}; } @_ == 1 ? @EXPORT : @_;
+ __PACKAGE__->export_to_level(1, @_);
+}
-our @EXPORT = qw(podregister main add_listener register_temp);
-our $run_mode;
+my $TP = 'TEMPORARY PROCEDURES';
my @register_params;
my @temp_procs;
-my @pod_temp_procs;
Gimp::on_query {
- unshift @{$register_params[9]}, [&Gimp::PDB_INT32,"run_mode","Interactive:0=yes,1=no"]
- if defined $register_params[6];
- Gimp->install_procedure(@register_params);
+ Gimp->install_procedure(Gimp::Fu::procinfo2installable(@register_params));
};
sub podregister (&) {
- no strict 'refs';
- my ($function, $blurb, $help, $author, $copyright, $date, $menupath,
- $imagetypes, $params, $results, $code) = fixup_args(('')x9, @_);
- Gimp::register_callback $function => sub {
- warn "$$-Gimp::Extension sub: $function(@_)" if $Gimp::verbose;
- $run_mode = defined($menupath) ? shift : undef;
+ my @procinfo = fixup_args(('')x9, @_);
+ Gimp::register_callback $procinfo[0] => sub {
+ warn "$$-Gimp::Extension sub: $procinfo[0](@_)" if $Gimp::verbose;
for my $tp (@temp_procs) {
- my (
- $tfunction, $tblurb, $thelp, $tmenupath, $timagetypes,
- $tparams, $tretvals, $tcallback,
- ) = @$tp;
- Gimp::register_callback $tfunction => $tcallback;
- Gimp->install_temp_proc(
- $tfunction, $tblurb, $thelp,
- $author, $copyright, $date,
- $tmenupath, $timagetypes,
+ my @tpinfo = (
+ @{$tp}[0..2],
+ @procinfo[3..5],
+ @{$tp}[3,4],
&Gimp::TEMPORARY,
- $tparams, $tretvals,
+ @{$tp}[5..7],
);
+ Gimp->install_temp_proc(Gimp::Fu::procinfo2installable(@tpinfo[0..10]));
+ Gimp::register_callback
+ $tpinfo[0] => Gimp::Fu::make_ui_closure(@tpinfo[0..7,9..11]);
}
Gimp::gtk_init;
Gimp->extension_ack;
Gimp->extension_enable;
- goto &$code;
+ Gimp::Fu::make_ui_closure(@procinfo)->(@_);
};
- @register_params = (
- $function, $blurb, $help, $author, $copyright, $date, $menupath,
- $imagetypes, &Gimp::EXTENSION, $params, $results
- );
+ @register_params = (@procinfo[0..7], &Gimp::EXTENSION, @procinfo[8,9]);
}
sub add_listener {
@@ -81,7 +72,25 @@ sub add_listener {
}
sub register_temp ($$$$$$$&) { push @temp_procs, [ @_ ]; }
-sub podregister_temp { push @pod_temp_procs, [ @_ ]; }
+sub podregister_temp {
+ my ($tfunction, $tcallback) = @_;
+ my $pod = Gimp::Pod->new;
+ my ($t) = grep { /^$tfunction\s*-/ } $pod->sections($TP);
+ croak "No POD found for temporary procedure '$tfunction'" unless $t;
+ my ($tblurb) = $t =~ m#$tfunction\s*-\s*(.*)#;
+ my $thelp = $pod->section($TP, $t);
+ my $tmenupath = $pod->section($TP, $t, 'SYNOPSIS');
+ my $timagetypes = $pod->section($TP, $t, 'IMAGE TYPES');
+ my $tparams = $pod->section($TP, $t, 'PARAMETERS');
+ my $tretvals = $pod->section($TP, $t, 'RETURN VALUES');
+ ($tfunction, $tmenupath, $timagetypes, $tparams, $tretvals) = (fixup_args(
+ $tfunction, ('fake') x 5, $tmenupath, $timagetypes, $tparams, $tretvals, 1
+ ))[0, 6..9];
+ push @temp_procs, [
+ $tfunction, $tblurb, $thelp, $tmenupath, $timagetypes,
+ $tparams, $tretvals, $tcallback,
+ ];
+}
1;
__END__
@@ -93,6 +102,7 @@ Gimp::Extension - Easy framework for Gimp-Perl extensions
=head1 SYNOPSIS
use Gimp;
+ use Gimp::Fu; # necessary for variable insertion and param constants
use Gimp::Extension;
podregister {
# your code
@@ -118,8 +128,7 @@ extensions.
Your main interface for using C<Gimp::Extension> is the C<podregister>
function. This works in exactly the same way as L<Gimp::Fu/PODREGISTER>,
-including declaring/receiving your variables for you, with a few crucial
-differences. See below for those differences.
+including declaring/receiving your variables for you.
Before control is passed to your function, these procedures are called:
@@ -146,21 +155,13 @@ Another benefit is that you can respond to events outside of GIMP,
such as network connections (this is how the Perl-Server is implemented).
Additionally, if no parameters are specified, then the extension will
-be started as soon as GIMP starts up.
+be started as soon as GIMP starts up. Make sure you specify menupath
+<None>, so no parameters will be added for you.
If you need to clean up on exit, just register a callback with
C<Gimp::on_quit>. This is how C<Perl-Server> removes its Unix-domain
socket on exit.
-=head2 PODREGISTER DIFFERENCES
-
-The C<podregister> function here is different from in L<Gimp::Fu>
-in that parameters and return values are not added for you, and your
-function name will not be changed but passed to GIMP verbatim.
-
-The C<run_mode> is passed on to your function, rather than being stripped
-off as with Gimp::Fu.
-
=head1 FUNCTIONS AVAILABLE TO EXTENSIONS
These are all exported by default.
@@ -204,7 +205,7 @@ sending an initial message down that socket.
=head1 TEMPORARY PROCEDURES
- =head2 perl_fu_procname - blurb
+ =head2 procname - blurb
Longer help text.
@@ -219,9 +220,9 @@ sending an initial message down that socket.
Registers a temporary procedure, reading from the POD the SYNOPSIS,
PARAMETERS, RETURN VALUES, IMAGE TYPES, etc, as for L<Gimp::Fu>. As
you can see above, the temporary procedure's relevant information is in
-similarly-named sections, but at level 3, not 1, within the suitably-named
-level 2 section. Like C<podregister>, it will not interpolate variables
-for you.
+similarly-named sections, but at level 2 or 3, not 1, within the
+suitably-named level 2 section. Unlike C<podregister>, it will not
+interpolate variables for you.
=head2 register_temp
@@ -254,22 +255,6 @@ All as per L<Gimp/Gimp-E<gt>install_procedure>.
=back
-=head1 TODO
-
- =head1 TEMPORARY PROCEDURES
- =head2 autosave_configure - blurb text
-
- Longer help text.
-
- =head3 PARAMETERS
-
- # gets interpolated vars per Gimp::Fu
- podregister_ui 'autosave_configure' => sub { ... };
-
- podregister will have interpolated vars too, and
- add vars based on menupath, etc
- menupath <Autostart> - die if get any params/retvals
-
=head1 AUTHOR
Ed J
diff --git a/Gimp/Fu.pm b/Gimp/Fu.pm
index 27d36e8..5859f67 100644
--- a/Gimp/Fu.pm
+++ b/Gimp/Fu.pm
@@ -4,12 +4,12 @@ use Gimp::Data;
use Gimp::Pod;
use strict;
use Carp qw(croak carp);
-use vars qw($run_mode @EXPORT_OK @EXPORT %EXPORT_TAGS);
use base 'Exporter';
use Filter::Simple;
use FindBin qw($RealBin $RealScript);
use File::stat;
+our $run_mode;
our $VERSION = 2.3003;
# manual import
@@ -104,11 +104,11 @@ FILTER {
warn __PACKAGE__."::FILTER: found: '$1'" if $Gimp::verbose >= 2;
};
- EXPORT_OK = qw($run_mode save_image);
-%EXPORT_TAGS = (
+our @EXPORT_OK = qw($run_mode save_image);
+our %EXPORT_TAGS = (
params => [ keys %pfname2info ]
);
- EXPORT = (qw(podregister register main), @{$EXPORT_TAGS{params}});
+our @EXPORT = (qw(podregister register main), @{$EXPORT_TAGS{params}});
my @scripts;
@@ -265,26 +265,36 @@ sub datatype(@) {
return Gimp::PDB_INT32;
}
+sub param_gimpify {
+ my $p = shift;
+ return $p if $p->[0] < Gimp::PDB_END;
+ my @c = @$p; # copy as modifying
+ $c[0] = $pf2info{$p->[0]}->[1] // datatype(values %{+{ {$p->[4]}}});
+ \ c;
+}
+
+sub procinfo2installable {
+ my @c = @_;
+ $c[9] = [ map { param_gimpify($_) } @{$c[9]} ];
+ unshift @{$c[9]}, [&Gimp::PDB_INT32,"run_mode","Interactive:0=yes,1=no"]
+ if defined $c[6];
+ @c;
+}
+
Gimp::on_query {
- for my $s (@scripts) {
- for my $p (@{$s->[9]}) {
- next if $p->[0] < Gimp::PDB_END;
- $p->[0] = $pf2info{$p->[0]}->[1] // datatype(values %{+{ {$p->[4]}}});
- }
- unshift @{$s->[9]}, [&Gimp::PDB_INT32,"run_mode","Interactive:0=yes,1=no"]
- if defined $s->[6];
- Gimp->install_procedure(@$s);
- }
+ for my $s (@scripts) { Gimp->install_procedure(procinfo2installable(@$s)); }
};
-sub podregister (&) { unshift @_, ('') x 9; goto ®ister; }
-sub register($$$$$$$$$;@) {
- no strict 'refs';
+sub make_ui_closure {
my ($function, $blurb, $help, $author, $copyright, $date, $menupath,
- $imagetypes, $params, $results, $code) = fixup_args(@_);
-
- Gimp::register_callback $function => sub {
- $run_mode = defined($menupath) ? shift : undef; # global!
+ $imagetypes, $params, $results, $code) = @_;
+ warn "$$-Gimp::Fu::make_ui_closure(@_)\n" if $Gimp::verbose >= 2;
+ die "Params must be array, instead: $params\n" unless ref $params eq 'ARRAY';
+ die "Retvals must be array, instead: $results\n" unless ref $results eq 'ARRAY';
+ die "Callback must be code, instead: $code\n" unless ref $code eq 'CODE';
+ sub {
+ warn "$$-Gimp::Fu closure: (@_)\n" if $Gimp::verbose >= 2;
+ $run_mode = defined($menupath) ? shift : Gimp::RUN_NONINTERACTIVE;
my(@pre,@defaults,@lastvals);
Gimp::ignore_functions(@Gimp::GUI_FUNCTIONS)
@@ -299,7 +309,9 @@ sub register($$$$$$$$$;@) {
}
for($menupath) {
- if (/^<Image>\//) {
+ if (not defined $_ or m#^<Toolbox>/Xtns/#) {
+ # no-op
+ } elsif (/^<Image>\//) {
if (defined $imagetypes and length $imagetypes) {
@_ >= 2 or die __"<Image> plug-in called without both image and drawable arguments!\n";
@pre = (shift,shift);
@@ -310,8 +322,6 @@ sub register($$$$$$$$$;@) {
} elsif (/^<Save>\//) {
@_ >= 4 or die __"<Save> plug-in called without the 5 standard arguments!\n";
@pre = (shift,shift,shift,shift);
- } elsif (m#^<Toolbox>/Xtns/#) {
- # no-op
} elsif (defined $_) {
die __"menupath _must_ start with <Image>, <Load>, <Save>, <Toolbox>/Xtns/, or <None>!";
}
@@ -326,6 +336,8 @@ sub register($$$$$$$$$;@) {
my $data_savetime = shift @$fudata;
my $script_savetime = stat("$RealBin/$RealScript")->mtime;
undef $fudata if $script_savetime > $data_savetime;
+ } else {
+ undef $fudata;
}
if ($Gimp::verbose >= 2) {
require Data::Dumper;
@@ -363,8 +375,13 @@ sub register($$$$$$$$$;@) {
Gimp->displays_flush;
wantarray ? @retvals : $retvals[0];
};
- push(@scripts,[$function,$blurb,$help,$author,$copyright,$date,
- $menupath,$imagetypes,Gimp::PLUGIN,$params,$results]);
+}
+
+sub podregister (&) { unshift @_, ('') x 9; goto ®ister; }
+sub register($$$$$$$$$;@) {
+ my @procinfo = fixup_args(@_);
+ Gimp::register_callback $procinfo[0] => make_ui_closure(@procinfo);
+ push @scripts, [ @procinfo[0..7], Gimp::PLUGIN, @procinfo[8,9] ];
}
sub save_image($$) {
diff --git a/Gimp/Pod.pm b/Gimp/Pod.pm
index 4e7ab66..0af6e4f 100644
--- a/Gimp/Pod.pm
+++ b/Gimp/Pod.pm
@@ -50,7 +50,7 @@ sub _flatten_para {
sub section {
my $self = shift;
- warn __PACKAGE__."::section(@_)" if $Gimp::verbose >= 2;
+ warn "$$-".__PACKAGE__."::section(@_)" if $Gimp::verbose >= 2;
return unless defined(my $doc = $self->_cache);
my $i = 2; # skip 'Document' and initial attrs
my $depth = 0;
@@ -62,10 +62,10 @@ sub section {
return if $i >= @$doc;
}
my $i2 = ++$i;
- $i2++ until $i2 >= @$doc or $doc->[$i2]->[0] eq "head$depth";
+ $i2++ until $i2 >= @$doc or $doc->[$i2]->[0] =~ /^head/;
$i2--;
my $text = join "\n\n", map { _flatten_para($_) } @{$doc}[$i..$i2];
- warn __PACKAGE__."::section returning '$text'" if $Gimp::verbose >= 2;
+ warn "$$-".__PACKAGE__."::section returning '$text'" if $Gimp::verbose >= 2;
$text;
}
@@ -118,6 +118,7 @@ my %IND2SECT = (
sub _getpod { $_[0] ||= new __PACKAGE__; $_[0]->section($_[1]); }
sub _patchup_eval ($$) {
my ($label, $text) = @_;
+ no strict;
my @result = eval "package main;\n#line 0 \"$0 $label\"\n" . ($text // '');
die $@ if $@;
@result;
@@ -159,7 +160,7 @@ sub make_arg_line {
return '' unless @{$p[8]};
die "$0: parameter had empty string\n" if grep { !length $_->[1] } @{$p[8]};
my $myline = 'my ('.join(',', map { '$'.$_->[1] } @{$p[8]}).') = @_;';
- warn __PACKAGE__."::make_arg_line: $myline" if $Gimp::verbose >= 2;
+ warn "$$-".__PACKAGE__."::make_arg_line: $myline" if $Gimp::verbose >= 2;
$myline;
}
diff --git a/Net/Net.pm b/Net/Net.pm
index 5d62f25..65cc230 100644
--- a/Net/Net.pm
+++ b/Net/Net.pm
@@ -241,7 +241,7 @@ my $unix_path;
my $max_pkt = 1024*1024*8;
sub slog {
- return if $Gimp::Extension::run_mode == &Gimp::RUN_NONINTERACTIVE;
+ return if $Gimp::Fu::run_mode == &Gimp::RUN_NONINTERACTIVE;
print localtime.": $$-slog(",@_,")\n";
}
@@ -364,7 +364,7 @@ sub setup_listen_tcp {
sub perl_server_run {
(my $filehandle, $Gimp::verbose) = @_;
warn "$$-".__PACKAGE__."::perl_server_run(@_)\n" if $Gimp::verbose;
- if ($Gimp::Extension::run_mode == &Gimp::RUN_NONINTERACTIVE) {
+ if ($Gimp::Fu::run_mode == &Gimp::RUN_NONINTERACTIVE) {
die __"unable to open Gimp::Net communications socket: $!\n"
unless open my $fh,"+<&$filehandle";
$fh->autoflush;
diff --git a/examples/autosave b/examples/autosave
index 84676c1..15c5e47 100755
--- a/examples/autosave
+++ b/examples/autosave
@@ -1,185 +1,115 @@
-#!/usr/local/bin/perl
+#!/usr/bin/perl -w
use strict;
use Gimp;
-# use Gimp::UI;
+#BEGIN { $Gimp::verbose = 3; }
use Gimp::Fu;
use Gimp::Extension;
-use Glib;
-use Gtk2;
use Cwd 'abs_path';
use File::Path 'make_path';
use File::Basename;
+use List::Util qw(min max);
my %C = (
active => 1,
interval => 5,
saved_file_pattern => '%F~',
- new_file_pattern => '%~/.gimp-autosave/%N.%D.%B.%Wx%H');
+ new_file_pattern => '%~/.gimp-autosave/%N.%D.%B.%Wx%H'
+);
+
+sub expand_pattern {
+ my ($img, $pattern, $file, $date) = @_;
+ $pattern =~ s{%(?:(~)|(B)|(C)|(D)|(F)|(N)|(W)|(H)|%)}{
+ $1 ? $ENV{HOME}
+ : $2 ? qw(RGB GRAY INDEXED) [$img->base_type]
+ : $3 ? dirname ($file)
+ : $4 ? $date
+ : $5 ? (index ($file, '.xcf') == (length ($file) - 4)
+ ? $file : "$file.xcf")
+ : $6 ? $img->get_name
+ : $7 ? $img->width
+ : $8 ? $img->height
+ : '%' }xeg;
+ $pattern;
+}
sub autosave_real {
# warn "calling autosave_real";
my $sfp = ($C{saved_file_pattern} || '%F~');
my $nfp = ($C{new_file_pattern} || '%~/.gimp-autosave/%N.%D.%B.%Wx%H');
-
- for my $img (Gimp::Image->list) {
- if ($img->is_valid) {
- my $saved=0;
- my $file;
-
- if (($file = $img->get_filename) && index ($file, 'Untitled') == -1) {
- $saved=1;
- } else {
- $file = ($img->get_name || $$img);
- }
-
- if ($img->is_dirty) {
- my @date = (localtime) [5,4,3];
- $date[0]+=1900; $date[1]+=1;
- my $fname;
-
- if ($saved) {
- $fname = $sfp;
- $fname =~ s{%(?:(~)|(B)|(C)|(D)|(F)|(N)|(W)|(H)|%)}{
- $1 ? $ENV{HOME}
- : $2 ? qw(RGB GRAY INDEXED) [$img->base_type]
- : $3 ? dirname ($file)
- : $4 ? join ('', @date)
- : $5 ? (index ($file, '.xcf') == (length ($file) - 4)
- ? $file : "$file.xcf")
- : $6 ? $img->get_name
- : $7 ? $img->width
- : $8 ? $img->height
- : '%' }xeg;
- } elsif ($img->get_filename) {
- $fname = $img->get_filename;
- } else {
- $fname = $nfp;
- $fname =~ s{%(?:(~)|(B)|(D)|(N)|(W)|(H)|(%))}{
- $1 ? $ENV{HOME}
- : $2 ? qw(RGB GRAY INDEXED) [$img->base_type]
- : $3 ? join ('', @date)
- : $4 ? ($img->get_name().'-<<x>>')
- : $5 ? $img->width
- : $6 ? $img->height
- : '%' }xeg;
-
- $fname =~ s/(?:\.xcf)?$/.xcf/;
-
- unless ($img->get_name =~ /Untitled-\d+/) {
- my $c = 0;
- my @fname = split '<<x>>', $fname, 2;
- my @fs = glob "$fname[0]*";
- $c++ while grep /$fname[0]$c\b/, @fs;
- $fname = "$fname[0]$c$fname[1]";
- $img->set_filename ($fname);
- }
- }
-
- my $savedir = dirname $fname;
- if (!-e $savedir) {
- warn "could not make directory '$savedir'" if !make_path $savedir;
- } else {
- warn "'$savedir' exists, but isn't a directory, can't save"
- if !-d $savedir;
- }
- # warn "saving '$fname'";
- undef $@;
- my $res = eval {
- Gimp->xcf_save(0, $img, ($img->get_layers)[0], $fname, $fname);
- };
- if ($@) {
- warn "couldn't save '$fname': $@";
- }
+ for my $img (grep { $_->is_valid and $_->is_dirty } Gimp::Image->list) {
+ my $saved=0;
+ my $file;
+ if (($file = $img->get_filename) && index ($file, 'Untitled') == -1) {
+ $saved=1;
+ } else {
+ $file = ($img->get_name || $$img);
+ }
+ my @date = (localtime) [5,4,3];
+ $date[0]+=1900; $date[1]+=1;
+ my $date = join '', @date;
+ my $fname;
+ if ($saved) {
+ $fname = expand_pattern($img, $sfp, $file, $date);
+ } elsif ($img->get_filename) {
+ $fname = $img->get_filename;
+ } else {
+ $fname = expand_pattern($img, $nfp, $file, $date);
+ $fname =~ s/(?:\.xcf)?$/.xcf/;
+ unless ($img->get_name =~ /Untitled-\d+/) {
+ my $c = 0;
+ my @fname = split '<<x>>', $fname, 2;
+ my @fs = glob "$fname[0]*";
+ $c++ while grep /$fname[0]$c\b/, @fs;
+ $fname = "$fname[0]$c$fname[1]";
+ $img->set_filename ($fname);
}
}
+ my $savedir = dirname $fname;
+ if (-e $savedir and not -d $savedir) {
+ warn "'$savedir' exists, but isn't a directory, can't save\n";
+ } elsif (not -d $savedir) {
+ warn "couldn't make directory '$savedir'\n" unless make_path $savedir;
+ }
+ # warn "saving '$fname'";
+ eval { ($img->get_layers)[0]->xcf_save($fname, $fname); };
+ warn "couldn't save '$fname': $ \n" if $@;
}
- 1
+ 1;
}
-sub autosave_configure {
- my ($ok, $tog, $int, $sfp, $nfp) = Gimp::Fu::interact 'autosave-configure',
- <<EOF,
-Edit autosave settings
-
-You can use the special identifiers:
-%~ => user\'s home directory
-%B => image base type (RGB/GRAY/INDEXED)
-%C => current directory of the file *
-%D => date file was opened
-%F => filename (full path) *
-%N => filename (basename)
-%W => image width
-%H => image height
-
-* not available for unsaved files
-EOF
- "Edit Autosave Settings",
- [[PF_TOGGLE, 'active', 'Set whether or not autosave is active', 1],
- [PF_SPINNER, 'interval', "Autosave interval in minutes", 5, [1, 120, 1]],
- [PF_STRING, 'saved_file_pattern', 'Path and filename pattern for saved files',
- '%F~'],
- [PF_STRING, 'new_file_pattern',
- 'Path and filename pattern for new (unsaved) files',
- '%~/.gimp-autosave/%N.%D.%M.%Wx%H']],
- 'Configure Autosave',
- @C{qw(active interval saved_file_pattern new_file_pattern)};
-
- unless ($ok) {
- # warn "config cancelled";
- return;
- }
+podregister_temp autosave_configure => sub {
+ my ($tog, $int, $sfp, $nfp) = @_;
# warn "got $tog, $int, $sfp, $nfp";
-
- Gimp->gimprc_set ('autosave_active', $tog);
- Gimp->gimprc_set ('autosave_interval', $int);
- Gimp->gimprc_set ('autosave_saved_file_pattern', $sfp);
- Gimp->gimprc_set ('autosave_new_file_pattern', $nfp);
-
+ $int = max(1, min(120, $int//1));
+ Gimp->gimprc_set('autosave_active', $C{active} = $tog);
+ Gimp->gimprc_set('autosave_interval', $C{interval} = $int);
+ Gimp->gimprc_set('autosave_saved_file_pattern',$C{saved_file_pattern} = $sfp);
+ Gimp->gimprc_set('autosave_new_file_pattern', $C{new_file_pattern} = $nfp);
Glib::Source->remove(delete $C{t})
if $C{t} && ($int != $C{interval} || !$tog);
-
- $C{active} = $tog;
- $C{interval} = $int//0 < 1 ? 1 : $int > 120 ? 120 : $int;
- $C{saved_file_pattern} = $sfp;
- $C{new_file_pattern} = $nfp;
-
$C{t} = Glib::Timeout->add_seconds(60*$C{interval}, \&autosave_real)
if $tog && !$C{t};
- ()
-}
-
-register_temp
- 'autosave_configure', # Name
- 'Edit autosave settings', # Blurb
- "Update autosave settings\nAll files are saved as .xcf", # Help
- N_"<Image>/File/Autosave", # Menu
- undef, # Image types
- [[PDB_INT32, 'run_mode', 'interactive, [non-interactive]', 0]], # Params
- [], # Return
- \&autosave_configure;
+ 1; # as has "image return"
+};
podregister {
for (keys %C) {
- my $x = eval { Gimp->gimprc_query ("autosave_$_") };
+ my $x = eval { Gimp->gimprc_query("autosave_$_") };
$C{$_} = $x if length $x;
}
- if (($C{interval}//0) < 1) {
- Gimp->gimprc_set ('autosave_interval', $C{interval} = 1);
- } elsif ($C{interval} > 120) {
- Gimp->gimprc_set ('autosave_interval', $C{interval} = 120);
- }
- if ($C{active}) {
- $C{t} = Glib::Timeout->add_seconds (60*$C{interval}, \&autosave_real);
- }
- Gtk2->main
+ $C{interval} = max(1, min(120, $C{interval}));
+ Gimp->gimprc_set('autosave_interval', $C{interval});
+ $C{t} = Glib::Timeout->add_seconds(60*$C{interval}, \&autosave_real)
+ if $C{active};
+ Gtk2->main;
};
-exit Gimp::main;
+exit main;
__END__
=head1 NAME
-extension_autosave - periodically save all open documents with unsaved changes to a temporary file
+extension_autosave - Periodically save all open images to temporary files
=head1 SYNOPSIS
@@ -187,9 +117,39 @@ extension_autosave - periodically save all open documents with unsaved changes t
=head1 DESCRIPTION
-Open images that haven't been saved to at all yet, will be saved in the home
-directory (or the cwd, or a configurable directory, using the time the image was
-started, and some random/distinguishing property)
+Open images that haven't been saved to at all yet, will be saved in the
+home directory, or the cwd, or a configurable directory, using the time
+the image was started, and some random/distinguishing property.
+
+=head1 TEMPORARY PROCEDURES
+
+=head2 autosave_configure - Edit autosave settings
+
+Update autosave settings. All files are saved as .xcf.
+
+=head3 SYNOPSIS
+
+<Image>/Edit/Autosave settings...
+
+=head3 PARAMETERS
+
+ [PF_TOGGLE, 'active', 'Set whether or not autosave is active', 1],
+ [PF_SPINNER, 'interval', "Autosave interval in minutes", 5, [1, 120, 1]],
+ [PF_STRING, 'saved_file_pattern', 'Path and filename pattern for saved files:
+ You can use the special identifiers:
+ %~ => user\'s home directory
+ %B => image base type (RGB/GRAY/INDEXED)
+ %C => current directory of the file *
+ %D => date file was opened
+ %F => filename (full path) *
+ %N => filename (basename)
+ %W => image width
+ %H => image height
+ * not available for unsaved files',
+ '%F~'],
+ [PF_STRING, 'new_file_pattern',
+ 'Path and filename pattern for new (unsaved) files',
+ '%~/.gimp-autosave/%N.%D.%M.%Wx%H']
=head1 AUTHOR
@@ -201,14 +161,15 @@ Rain <rain AT terminaldeficit DOT com>
=head1 LICENSE
-This program is free software: you can redistribute it and/or modify it under
-the terms of the GNU General Public License as published by the Free Software
-Foundation, either version 3 of the License, or (at your option) any later
-version.
+This program is free software: you can redistribute it and/or modify it
+under the terms of the GNU General Public License as published by the
+Free Software Foundation, either version 3 of the License, or (at your
+option) any later version.
-This program is distributed in the hope that it will be useful, but WITHOUT
-ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
+This program is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+for more details.
-You should have received a copy of the GNU General Public License along with
-this program. If not, see <http://www.gnu.org/licenses/>.
+You should have received a copy of the GNU General Public License along
+with this program. If not, see <http://www.gnu.org/licenses/>.
diff --git a/t/extension.t b/t/extension.t
index 3bddfad..fe9ce0b 100644
--- a/t/extension.t
+++ b/t/extension.t
@@ -9,16 +9,22 @@ BEGIN {
use Config;
$tpf_name = "test_perl_extension";
write_plugin($DEBUG, $tpf_name, $Config{startperl}.
- "\nBEGIN { \$Gimp::verbose = ".int($Gimp::verbose||0).'; }'.<<'EOF');
+ " -w\nBEGIN { \$Gimp::verbose = ".int($Gimp::verbose||0).'; }'.<<'EOF');
use strict;
use Gimp;
+use Gimp::Fu;
use Gimp::Extension;
podregister {
(0, $num + 1);
};
+podregister_temp test_temp => sub {
+ my ($image, $drawable, $v1) = @_;
+ ();
+};
+
exit main;
__END__
@@ -42,6 +48,24 @@ Description.
[&Gimp::PDB_INT32, "retnum", "Number returned"],
+=head1 TEMPORARY PROCEDURES
+
+=head2 test_temp - blurb
+
+Longer help text.
+
+=head3 SYNOPSIS
+
+<Image>/File/Label...
+
+=head3 IMAGE TYPES
+
+*
+
+=head3 PARAMETERS
+
+ [ PF_TOGGLE, 'var', 'Var description' ],
+
=head1 AUTHOR
Author.
[
Date Prev][
Date Next] [
Thread Prev][
Thread Next]
[
Thread Index]
[
Date Index]
[
Author Index]
