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.