#rR gscope_oo.tcl #rR Quelques petits outils pour faire de l'objet ... proc rroo {classe {objName ""} {constructeur ""} args} { global rroo #rR Cette proc permet de creer des objets d'une classe donnée. C'est en fait un superconstructeur qui permet d'utiliser tout de suite l'objet créé #rR pour faciliter l'ecriture en ligne de commande on peut mettre . au lieu de "" #rR Dans rroo on stocke les objets qui ont déjà été créés avec un Id donné ... #rR 2017/08/10 on change et Id disparait ... if {$objName =="."} { set objName "" } if {$constructeur=="."} { set constructeur "" } if {$objName=="_"} { #rR ceci pour pouvoir écrire rroo Quidam _ {"Raymond Ripp"} qui créra Raymond_Ripp set NameFromCons [join {*}$constructeur "_"] regsub -all {[^a-zA-Z0-9\:_]} $NameFromCons "_" NameFromCons set objName $NameFromCons } set objName [string trim $objName] if { [info object isa object $objName] && ! [info exists rroo($objName)]} { set rroo($objName) $objName } ; #rR au cas où il aurait été créé ailleurs if { $objName!="" && [info exists rroo($objName)]} { return [$rroo($objName) {*}$args] } #rR Maintenant il faut le créer if { $objName==""} { set objNameCreated [$classe new {*}$constructeur] } else { set objNameCreated [$classe create $objName {*}$constructeur] } set rroo($objName) $objNameCreated if { $args!={}} { return [$objNameCreated {*}$args] } return $objNameCreated } proc OLDrroo {classe {objName ""} {id ""} args} { global rroo #rR Cette proc permet de creer des objets d'une classe donnée. C'est en fait un superconstructeur qui permet d'utiliser tout de suite l'objet créé #rR pour faciliter l'ecriture en ligne de commande on peut mettre . au lieu de "" #rR Dans rroo on stocke les objets qui ont déjà été créés avec un Id donné ... if {$objName=="."} { set objName "" } if {$id =="."} { set id "" } set objName [string trim $objName] set id [string trim $id] regsub -all " " $id "_" id ;#rR 2017/08/06 2017/08/10 Je pense qu'l faut le faire !!! #if {$objName=="" && $id=="" } { set id [string trim [NomDe ObjRrOo] "."] } #on peut forcer le objName et/ou le id if { $objName=="" } { if { [info exists rroo($id)]} { set objName $rroo($id) } else { set objName [$classe new $id] } set rroo($id) $objName } if { ! [info object isa object $objName]} { $classe create $objName $id} if { ! [info exists args] || $args=={}} { return $objName } return [$objName {*}$args] }