Commit 7a88a15d authored by Dominique Dumont's avatar Dominique Dumont

Import original source of Tk-ObjEditor 2.008

parents
2.008 2014-07-31
* refreshed the code and tests. No other functional changes
2.005 2007-10-05
* ObjEditor.pm (edit_object): new function so that obj_editor can
be invoked from non Tk program with one line.
2.004 2004-07-30
* ChangeLog, MANIFEST: Changed Changes to ChangeLog
* Makefile.PL: Require Tk::ObjScanner v2.010
* ObjEditor.pm: Disable display of internal tied data
Fix incorrect label update after 'add element' (fix rt ticket 6832)
2.003 2003-12-01
* Adapted tests for Tk804.
2.002 2003-02-14
* doc update
* better test with tied stuff
This diff is collapsed.
# This file was automatically generated by Dist::Zilla::Plugin::Manifest v5.019.
Changes
LICENSE
MANIFEST
META.json
META.yml
Makefile.PL
README
demo/obj_ed.pl
dist.ini
lib/Tk/ObjEditor.pm
lib/Tk/ObjEditorDialog.pm
t/obj_ed_dialog.t
t/obj_editor.t
t/pod.t
{
"abstract" : "Tk composite widget Obj editor",
"author" : [
"Dominique Dumont"
],
"dynamic_config" : 0,
"generated_by" : "Dist::Zilla version 5.019, CPAN::Meta::Converter version 2.142060",
"license" : [
"perl_5"
],
"meta-spec" : {
"url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
"version" : "2"
},
"name" : "Tk-ObjEditor",
"prereqs" : {
"configure" : {
"requires" : {
"ExtUtils::MakeMaker" : "6.30"
}
},
"runtime" : {
"requires" : {
"Carp" : "0",
"Scalar::Util" : "1.01",
"Storable" : "0",
"Tk" : "0",
"Tk::Derived" : "0",
"Tk::Dialog" : "0",
"Tk::DialogBox" : "0",
"Tk::Frame" : "0",
"Tk::ObjScanner" : "2.010"
}
},
"test" : {
"requires" : {
"Data::Dumper" : "0",
"Test::More" : "0",
"Tie::Hash" : "0",
"Tie::Scalar" : "0",
"Tk::ROText" : "0"
}
}
},
"release_status" : "stable",
"resources" : {
"bugtracker" : {
"mailto" : "bug-project@rt.cpan.org",
"web" : "http://rt.cpan.org/NoAuth/Bugs.html?Dist=Tk-ObjEditor"
},
"homepage" : "https://github.com/dod38fr/perl-tk-objeditor",
"repository" : {
"type" : "git",
"url" : "https://github.com/dod38fr/perl-tk-objeditor.git",
"web" : "https://github.com/dod38fr/perl-tk-objeditor"
}
},
"version" : "2.008"
}
---
abstract: 'Tk composite widget Obj editor'
author:
- 'Dominique Dumont'
build_requires:
Data::Dumper: '0'
Test::More: '0'
Tie::Hash: '0'
Tie::Scalar: '0'
Tk::ROText: '0'
configure_requires:
ExtUtils::MakeMaker: '6.30'
dynamic_config: 0
generated_by: 'Dist::Zilla version 5.019, CPAN::Meta::Converter version 2.142060'
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: '1.4'
name: Tk-ObjEditor
requires:
Carp: '0'
Scalar::Util: '1.01'
Storable: '0'
Tk: '0'
Tk::Derived: '0'
Tk::Dialog: '0'
Tk::DialogBox: '0'
Tk::Frame: '0'
Tk::ObjScanner: '2.010'
resources:
bugtracker: http://rt.cpan.org/NoAuth/Bugs.html?Dist=Tk-ObjEditor
homepage: https://github.com/dod38fr/perl-tk-objeditor
repository: https://github.com/dod38fr/perl-tk-objeditor.git
version: '2.008'
# This file was automatically generated by Dist::Zilla::Plugin::MakeMaker v5.019.
use strict;
use warnings;
use ExtUtils::MakeMaker 6.30;
my %WriteMakefileArgs = (
"ABSTRACT" => "Tk composite widget Obj editor",
"AUTHOR" => "Dominique Dumont",
"CONFIGURE_REQUIRES" => {
"ExtUtils::MakeMaker" => "6.30"
},
"DISTNAME" => "Tk-ObjEditor",
"EXE_FILES" => [],
"LICENSE" => "perl",
"NAME" => "Tk::ObjEditor",
"PREREQ_PM" => {
"Carp" => 0,
"Scalar::Util" => "1.01",
"Storable" => 0,
"Tk" => 0,
"Tk::Derived" => 0,
"Tk::Dialog" => 0,
"Tk::DialogBox" => 0,
"Tk::Frame" => 0,
"Tk::ObjScanner" => "2.010"
},
"TEST_REQUIRES" => {
"Data::Dumper" => 0,
"Test::More" => 0,
"Tie::Hash" => 0,
"Tie::Scalar" => 0,
"Tk::ROText" => 0
},
"VERSION" => "2.008",
"test" => {
"TESTS" => "t/*.t"
}
);
my %FallbackPrereqs = (
"Carp" => 0,
"Data::Dumper" => 0,
"Scalar::Util" => "1.01",
"Storable" => 0,
"Test::More" => 0,
"Tie::Hash" => 0,
"Tie::Scalar" => 0,
"Tk" => 0,
"Tk::Derived" => 0,
"Tk::Dialog" => 0,
"Tk::DialogBox" => 0,
"Tk::Frame" => 0,
"Tk::ObjScanner" => "2.010",
"Tk::ROText" => 0
);
unless ( eval { ExtUtils::MakeMaker->VERSION(6.63_03) } ) {
delete $WriteMakefileArgs{TEST_REQUIRES};
delete $WriteMakefileArgs{BUILD_REQUIRES};
$WriteMakefileArgs{PREREQ_PM} = \%FallbackPrereqs;
}
delete $WriteMakefileArgs{CONFIGURE_REQUIRES}
unless eval { ExtUtils::MakeMaker->VERSION(6.52) };
WriteMakefile(%WriteMakefileArgs);
Tk::ObjEditor provides a GUI to edit the attributes of an object or
the elements of a simple hash or array.
The editor is a Tk::ObjScanner with additional function to edit data.
When the user double clicks (with left button) on an item, the value
of the item will be displayed in the HList.
Use the right button of the mouse of an element to modify its
value. Depending on the context, you will also be able to delete the
element or to add a sub-element.
This module was tested with perl5.8.4 and Tk 804.025
See the embedded documentation in the module for more details.
Comments and suggestions are always welcome.
Legal mumbo jumbo:
Copyright (c) 1997-2004,2007,2014 Dominique Dumont. All rights reserved.
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
- Dominique Dumont
ddumont at cpan.org
---------------------------------------------------------------------
INSTALLATION
gunzip -c <dist_file>.tar.gz | tar xvf -
cd <dist_directory>
perl Makefile.PL
make test
make install
From github, this module is built with Dist::Zilla.
You must make sure that the following modules are installed:
Dist::Zilla::Plugin::MetaResources
Dist::Zilla::Plugin::Prepender
Dist::Zilla::Plugin::Prereqs
Dist::Zilla::PluginBundle::Filter
On debian or ubuntu, do:
sudo aptitude install \
libdist-zilla-plugin-prepender-perl \
libdist-zilla-plugins-cjm-perl \
libdist-zilla-perl
Then run:
dzil build
or
dzil test
dzil build
#
# This file is part of Tk-ObjEditor
#
# This software is copyright (c) 2014 by Dominique Dumont.
#
# This is free software; you can redistribute it and/or modify it under
# the same terms as the Perl 5 programming language system itself.
#
# ObjEditor - A widget to edit data and object
use Tk ;
use Tk::ObjEditor ;
# sample object to edit
package Toto ;
sub new
{
my $type = shift ;
my $tkstuff = shift ;
my $scalar = 'dummy scalar ref value';
my $self =
{
'key1' => 'value1',
'array' => [qw/a b sdf/, {'v1' => '1', 'v2' => 2},'dfg'],
'key2' => {
'sub key1' => 'sv1',
'sub key2' => 'sv2'
},
'piped|key' => {a => 1 , b => 2},
'scalar_ref_ref' => \\$scalar,
'empty string' => '',
'pseudo hash' => [ { a => 1, b => 2}, 'a value', 'bvalue'],
'non_empty string' => ' ',
'long' => 'very long line'.'.' x 80 ,
'is undef' => undef,
'some text' => "some \n dummy\n Text\n",
} ;
bless $self,$type;
}
package main;
sub obj_ed
{
my($demo) = @_;
$TOP = $MW->WidgetDemo
(
-name => $demo,
-text => 'ObjEditor - data and object editor.',
-geometry_manager => 'grid',
-title => 'A widget to edit data or object',
-iconname => 'ObjEditorDemo'
) ;
$TOP->Label(text => "Please click on right button on any item to modify the data")->pack ;
my $dummy = new Toto ();
$TOP -> ObjEditor
(
caller => $dummy,
direct => 1,
destroyable => 0
) -> pack;
}
name = Tk-ObjEditor
author = Dominique Dumont
license = Perl_5
copyright_holder = Dominique Dumont
copyright_year = 2014
[MetaResources]
homepage = https://github.com/dod38fr/perl-tk-objeditor
bugtracker.web = http://rt.cpan.org/NoAuth/Bugs.html?Dist=Tk-ObjEditor
bugtracker.mailto = bug-project@rt.cpan.org
repository.url = https://github.com/dod38fr/perl-tk-objeditor.git
repository.web = https://github.com/dod38fr/perl-tk-objeditor
repository.type = git
[@Filter]
-bundle = @Basic
-remove = Readme
[AutoPrereqs]
skip = ^[a-z\d]+$
skip = ExtUtils::testlib
skip = Exporter
[Prepender]
copyright=1
[NextRelease]
format = %v%T %{yyyy-MM-dd}d
[PkgVersion]
; use 'V=2.234 dzil release' to override version number
[Git::NextVersion]
[Git::Check]
allow_dirty = dist.ini
allow_dirty = Changes
[Git::Commit]
[Git::Tag]
[Git::Push]
[MetaJSON]
This diff is collapsed.
#
# This file is part of Tk-ObjEditor
#
# This software is copyright (c) 2014 by Dominique Dumont.
#
# This is free software; you can redistribute it and/or modify it under
# the same terms as the Perl 5 programming language system itself.
#
package Tk::ObjEditorDialog;
$Tk::ObjEditorDialog::VERSION = '2.008';
use strict;
use warnings;
use Carp;
use Tk::ObjEditor;
use vars qw/$VERSION @ISA/;
#use Storable qw(dclone);
use base qw(Tk::Derived Tk::DialogBox);
Tk::Widget->Construct('ObjEditorDialog');
sub Populate {
my ( $cw, $args ) = @_;
my $data = delete $args->{'caller'} || delete $args->{'-caller'};
$cw->{direct} = delete $args->{'direct'} || delete $args->{'-direct'} || 0;
# need to add different button for clone ????
my $buttons = $cw->{direct} ? ['done'] : [qw/OK cancel/];
$args->{-buttons} = $buttons;
$cw->SUPER::Populate($args);
$cw->add( 'ObjEditor', caller => $data, -direct => $cw->{direct} )->pack;
return $cw;
}
sub Show {
my $cw = shift;
my $hit = $cw->SUPER::Show(@_);
if ( $hit eq 'OK' ) {
# no direct edit
return $cw->Subwidget("objeditor")->get_data();
}
else {
return $cw->Subwidget("objeditor")->get_orig_data();
}
}
=head1 NAME
Tk::ObjEditorDialog - Tk composite widget obj editor popup dialog
=head1 SYNOPSIS
use Tk::ObjEditorDialog;
my $editor = $mw->ObjEditorDialog( caller => $object,
direct => [1|0],
[title=>"windows"]) ;
$editor -> Show;
=head1 DESCRIPTION
This widget is a L<ObjEditor> within a L<DialogBox> widget. I.e. it
will appear in its own toplevel window when you invoke the Show()
method like the FileDialog widget.
=head1 Constructor parameters
=over 4
=item *
caller: The ref of the object or hash or array to edit (mandatory).
=item *
title: the title of the menu created by the editor (optionnal)
=item *
direct: Set to 1 if you want to perform direct edition.
=back
=head1 Method
=head2 Show(grab)
As in L<Tk::DialogBox>, this method displays the dialog box, until
user invokes one of the buttons in the bottom frame. If the grab type
is specified in grab, then Show uses that grab; otherwise it uses a
local grab. Returns the name of the button invoked.
=head1 CAVEATS
Like L<Tk::ObjScanner> ObjEditor does not detect recursive data
structures. It will just keep on displaying the tree until the user
gets tired of clicking on the HList items.
=head1 AUTHOR
Dominique Dumont.
Copyright (c) 2001 Dominique Dumont. All
rights reserved. This program is free software; you can redistribute
it and/or modify it under the same terms as Perl itself.
=head1 SEE ALSO
perl(1), L<Tk>, L<Tk::HList>, L<Tk::ObjScanner>, L<Tk::ObjEditor>,
L<Tk::DialogBox>
=cut
# -*- cperl -*-
use strict;
use warnings FATAL => qw(all);
use Tk;
use ExtUtils::testlib;
use Tk::ObjEditorDialog;
use Tk::ROText;
use Data::Dumper;
use Test::More tests => 4;
my $trace = shift || 0;
package Toto;
sub new {
my $type = shift;
my $tkstuff = shift;
my $scalar = 'dummy scalar ref value';
my $self = {
'key1' => 'value1',
'array' => [ qw/a b sdf/, { 'v1' => '1', 'v2' => 2 }, 'dfg' ],
'key2' => {
'sub key1' => 'sv1',
'sub key2' => 'sv2'
},
'piped|key' => { a => 1, b => 2 },
'scalar_ref_ref' => \\$scalar,
'empty string' => '',
'pseudo hash' => [ { a => 1, b => 2 }, 'a value', 'bvalue' ],
'non_empty string' => ' ',
'long' => 'very long line' . '.' x 80,
'is undef' => undef,
'some text' => "some \n dummy\n Text\n",
};
bless $self, $type;
}
package main;
ok( 1, "compiled" );
my $toto;
my $mw = eval { MainWindow->new };
SKIP: {
skip "Cannot open Tk", 3 unless defined $mw;
my $dummy = new Toto();
ok( $dummy, "created dummy object" );
$mw->Label( -text => "Here's the data that will be edited" )->pack;
my $text = $mw->Scrolled('ROText');
$text->pack;
$text->insert( 'end', Dumper($dummy) );
$mw->Label( -text => "use right button to get editor menu" )->pack;
my $fm = $mw->Frame;
$fm->pack;
$fm->Label( -text => 'Monitoring hash->{key1} value:' )->pack(qw/-side left/);
my $mon =
$fm->Label( -textvariable => \$dummy->{key1} )->pack(qw/-side left/);
ok( 1, "Created some data monitors" );
my $direct = sub {
print "Creating obj editor (direct edition)\n" if $trace;
my $box = $mw->ObjEditorDialog( '-caller' => $dummy, -direct => 1 );
$box->Show;
$text->delete( '1.0', 'end' );
$text->insert( 'end', Dumper($dummy) );
};
my $cloned = sub {
print "Creating obj editor (not direct edition)\n" if $trace;
my $box = $mw->ObjEditorDialog( '-caller' => $dummy );
my $new = $box->Show;
$text->delete( '1.0', 'end' );
$text->insert( 'end', Dumper($new) );
};
my $bf = $mw->Frame->pack;
### TBD edit direct and indirect ????
$bf->Button( -text => 'direct edit', -command => $direct )->pack( -side => 'right' );
$bf->Button( -text => 'edit', -command => $cloned )->pack( -side => 'right' );
$bf->Button( -text => 'quit', -command => sub { $mw->destroy; } )->pack( -side => 'left' );
if ($trace) {
MainLoop; # Tk's
}
else {
$mw->idletasks;
$mw->after(1000); # sleep 300ms
}
ok( 1, "mainloop done" );
}
# -*- cperl -*-
use strict;
use warnings FATAL => qw(all);
use Tk;
use ExtUtils::testlib;
use Tk::ObjEditor;
use Tk::ROText;
use Data::Dumper;
use Test::More tests => 5;
my $trace = shift || 0;
package myHash;
use Tie::Hash;
use vars qw/@ISA/;
@ISA = qw/Tie::StdHash/;
sub TIEHASH {
my $class = shift;
my %args = @_;
return bless { %args, dummy => 'foo' }, $class;
}
sub STORE {
my ( $self, $idx, $value ) = @_;
$self->{$idx} = $value;
return $value;
}
package MyScalar;
use Tie::Scalar;
use vars qw/@ISA/;
@ISA = qw/Tie::StdHash/;
sub TIESCALAR {
my $class = shift;
my %args = @_;
return bless { %args, dummy => 'foo default value' }, $class;
}
sub STORE {
my ( $self, $value ) = @_;
$self->{data} = $value;
return $value;
}
sub FETCH {
my ($self) = @_;
# print "\t\t",'@.....@.....@..... MeScalar read',"\n";
return $self->{data} || $self->{dummy};
}
package Toto;
sub new {
my %h;
tie %h, 'myHash', 'dummy key' => 'dummy value' or die;
$h{data1} = 'value1';
my $type = shift;
my $tkstuff = shift;
my $scalar = 'dummy scalar ref value';
my $self = {
'key1' => 'example of value for key1',
'array' => [ qw/a b sdf/, { 'v1' => '1', 'v2' => 2 }, 'dfg' ],
'key2' => {
'sub key1' => 'sv1',
'sub key2' => 'sv2'
},
'piped|key' => { a => 1, b => 2 },
'scalar_ref_ref' => \\$scalar,
'empty string' => '',
'pseudo hash' => [ { a => 1, b => 2 }, 'a value', 'bvalue' ],
'non_empty string' => ' ',
'long' => 'very long line' . '.' x 80,
'is undef' => undef,
'some text' => "some \n dummy\n Text\n",
'tied hash' => \%h
};
tie( $self->{tied_scalar}, 'MyScalar', 'dummy key' => 'dummy value' )
or die;
$self->{tied_scalar} = 'some scalar huh?';
bless $self, $type;
}
package main;
ok( 1, "compiled" );
my $toto;
my $mw = eval { MainWindow->new };
SKIP: {
skip "Cannot open Tk", 3 unless defined $mw;
my $w_menu = $mw->Frame( -relief => 'raised', -borderwidth => 2 );
$w_menu->pack( -fill => 'x' );
my $f = $w_menu->Menubutton( -text => 'File', -underline => 0 )->pack( -side => 'left' );
$f->command( -label => 'Quit', -command => sub { $mw->destroy; } );
my $dummy = new Toto($mw);
ok( $dummy, "created dummy object" );
$mw->Label( -text => "use right button to get editor menu" )->pack;
my $fm = $mw->Frame;
$fm->pack;
$fm->Label( -text => 'Monitoring hash->{key1} value:' )->pack(qw/-side left/);
my $mon =
$fm->Label( -textvariable => \$dummy->{key1} )->pack(qw/-side left/);
ok( 1, "Created some data monitors" );
my $objEd = $mw->ObjEditor(
'-caller' => $dummy,