From 58ec6cac56b8252110cb975be312c4956cecf6e4 Mon Sep 17 00:00:00 2001
From: didier
Date: Mon, 27 Aug 2007 08:01:27 +0000
Subject: Ajout de la possibilte de passer en parametre un chemin pour les
 creation du repertoire AUTOGEN (pour eviter l'ecriture concurrente de
 classes). Restriction, le chemin passe est toujours relatif. Evolution
 ulterieure prevue.

---
 src/MTools.pm | 68 +++++++++++++++++++++++++++++++++--------------------------
 1 file changed, 38 insertions(+), 30 deletions(-)

(limited to 'src/MTools.pm')

diff --git a/src/MTools.pm b/src/MTools.pm
index f4c7a67..e5fe52f 100644
--- a/src/MTools.pm
+++ b/src/MTools.pm
@@ -1,20 +1,4 @@
 package MTools;
-#	This program is free software; you can redistribute it and/or
-#	modify it under the terms of the GNU LGPL Libray General Public License
-#	as published by the Free Software Foundation; either version 2
-#	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 Library General Public License for more details.
-#
-#	You should have received a copy of the GNU Library General Public License
-#	along with this program; if not, write to the Free Software
-#	Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA,
-#	or refer to http://www.gnu.org/copyleft/lgpl.html
-#
-##################################################################
 
 # MTools exporte des fonctions destinees principalement a :
 #	- activer des fonctions propres a la librairie mtools
@@ -23,7 +7,7 @@ package MTools;
 # Ainsi, d'une maniere generale, toutes fonctions exportees s'appliquent aussi bien a des objets 
 # zinc qu'a des objets mtools. L'unique restriction est dans la methode d'appel :
 #	- obligatoirement : fct ($obj, @parametres) pour un objet zinc
-#	- indiferemment $obj -> fct (@parametres).
+#	- indefiremment $obj -> fct (@parametres).
 # L'avantage de la premiere methode est qu'elle s'applique aussi bien a un objet zinc qu'a un objet MTools. 
 # L'inconvenient est que l'on perd la possibilite de profiter de l'heritage et de la redefinition eventuelle de la fonction.
 #
@@ -55,10 +39,10 @@ package MTools;
 #	toutes les propriete prennent la valeur de property_1.
 #	- executer : executer (callback); permet d'executer une callback du type predefini ci-dessus dans la section 
 #	"Les callbacks dans MTools"
-#	- binding : $obj -> binding ('evenement', callback) permet d'ecouter un evenement MTOOLS ou Tk survenant sur un objet.
-#	binding peut aussi etre redefini pour ecouter de nouvelles sources d'evenements (par exemple MIvy ou WacomAdapter)
+#	- binding : $obj -> binding ('evenement', callback) permet d'ecouter un evenement MTOOLS ou Tk survenant sur un objet. binding peut aussi etre redefini pour ecouter
+#	de nouvelle source d'evenement (par exemple MIvy ou WacomAdapter)
 #	- unbinding : $obj -> unbinding ('evenement', callback) arrete l'ecoute d'un evenement
-#	- minstanciate : minstanciate ('definition', $parent) permet de retourner un objet MTools a partir de la spec 'definition'
+#	- minstanciate : minstanciate ('definition', $parent) permet de retourner un objet MTools ? partir de la spec 'definition'
 #	si 'definition' est un path svg, minstanciate instancie le svg et retourne un objet MTools encapsulant le contenu
 #	si 'definition' est un objet zinc, minstanciate retourne un objet MTools encapsulant l'objet zinc
 #	si 'definition' est deja un objet MTools, minstanciate retourne l'objet lui-meme.
@@ -93,7 +77,7 @@ require Exporter;
 BEGIN 
 {
 	@ISA = qw / Exporter/;
-	@EXPORT = qw / %fonts $zinc translate rotate executer mconfigure binding unbinding raise mget 
+	@EXPORT = qw / %fonts $zinc $pathForAutogen translate rotate executer mconfigure binding unbinding raise mget 
 		scale getGradient chggroup plink plisten mplaying minstance mrun minstanciate 
 		propertyExists bbox width height mdelete mfind coords type tset treset tget clone unplisten/;
 }
@@ -107,20 +91,24 @@ use MTools::SVG::SVGLoader;
 
 our $zinc;
 our %fonts;
+our $pathForAutogen;
 
 my %gradients;
 
 sub new {
-	my ($class, $width, $height, $title, $Zinc, $screen, $geometry) = @_;
+	my ($class, $width, $height, $title, $Zinc, $screen, $geometry, $PathForAutogen) = @_;
+
 	my $self = {};
 	bless $self, $class;
+
 	if (!defined $Zinc)
 	{
 	$screen = ":0.0" if (!defined $screen);
 	$self -> {window} = my $mw = MainWindow -> new ('-screen' =>$screen);
 	$mw -> title($title);
+
 	$mw->geometry ($geometry) if (defined $geometry);
-	$self -> {zinc} = $zinc = $mw -> Zinc (
+	  $self -> {zinc} = $zinc = $mw -> Zinc (
 		-width => $width,
 		-height => $height,
 		-borderwidth => 0,
@@ -134,6 +122,15 @@ sub new {
 	  $zinc = $Zinc;
 	  $self -> {window} = $zinc->toplevel ;
 	}
+
+	# Path for AUTOGEN : format the path
+	if(defined $PathForAutogen){
+		$PathForAutogen =~ s/^\///g ;
+		$PathForAutogen = "$PathForAutogen/" if not $PathForAutogen =~ /\/$/;
+		$PathForAutogen =~ s/\//::/g;
+		$pathForAutogen = $PathForAutogen;
+	}
+
 	return $self;
 }
 
@@ -142,7 +139,10 @@ my $link_token = 0;
 sub __configure {
 	my ($obj, $sender, $key, $value) = @_;
 	my $obj_instance = ref ($obj) eq '' ? $obj : $obj -> {instance};
-	if ($obj_instance ne $obj)
+	
+	my $obj_i = "";
+	$obj_i = "$obj_instance" if defined $obj_instance;
+	if ($obj_i ne "$obj")
 	{
 		my $oldvalue = $obj -> {__properties} -> {$key} -> {val};
 		$obj -> {__properties} -> {$key} -> {val} = $value;
@@ -172,7 +172,9 @@ sub __confproplink {
 	my ($sender, $obj, $key, $val) = @_;
 	
 	my $obj_instance = ref ($obj) eq '' ? $obj : $obj -> {instance};
-	if ($obj_instance ne $obj)
+	my $obj_i = "";
+	$obj_i = "$obj_instance" if defined $obj_instance;
+	if ($obj_i ne "$obj")
 	{
 		if ($obj -> {__properties} -> {$key} -> {link_token} != $link_token)
 		{
@@ -204,7 +206,9 @@ sub __confproplink {
 sub propertyExists {
 	my ($obj, $key) = @_;
 	my $obj_instance = ref ($obj) eq '' ? $obj : $obj -> {instance};
-	if ("$obj_instance" ne "$obj")
+	my $obj_i = "";
+	$obj_i = "$obj_instance" if defined $obj_instance;
+	if ($obj_i ne "$obj")
 	{
 		if (exists $obj -> {__properties} -> {$key})
 		{
@@ -218,7 +222,9 @@ sub mconfigure {
 	my ($obj, %options) = @_;
 	my $obj_instance = ref ($obj) eq '' ? $obj : $obj -> {instance};
 	my %zinc_props = ();
- 	if ("$obj_instance" ne "$obj")
+ 	my $obj_i = "";
+	$obj_i = "$obj_instance" if defined $obj_instance;
+	if ($obj_i ne "$obj")
 	{
  		while ( my ($key, $val) = each (%options) )
 		{
@@ -247,6 +253,7 @@ sub mconfigure {
  	{
 	 	%zinc_props = %options;
  	}
+
  	if (%zinc_props)
  	{
  		eval 
@@ -271,6 +278,7 @@ sub mconfigure {
 # d'un objets zinc.
 sub plink {
 	my (@objets) = @_;
+
 	if (! @objets) {return;}
 	
 	for (my $i = 0; $i < @objets; $i ++)
@@ -454,8 +462,8 @@ sub tset {
 }
 
 sub tget {
-	my ($obj, $ref) = @_;
-	return $zinc -> tget (ref ($obj) eq '' ? $obj : $obj -> {instance}, $ref);
+	my ($obj) = @_;
+	return $zinc -> tget (ref ($obj) eq '' ? $obj : $obj -> {instance});
 }
 
 sub treset {
@@ -715,7 +723,7 @@ sub minstanciate {
 				return MTools::SVG::SVGLoader::load ($path, $parent);
 			}
 			else
-			{
+			{	
 				my $obj = new MTools::MObjet ();
 				$obj -> {instance} = $path;
 				$obj -> chggroup ($parent);
-- 
cgit v1.1