Index by: file name |
procedure name |
procedure call |
annotation
gscope_oo.tcl
(annotations | original source)
#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]
}
Index by: file name |
procedure name |
procedure call |
annotation
File generated 2022-04-05 at 12:55.