initial class tcl tk

class Singleton {
       private common _instance {}  ;# static instance variable

       #
       # Define a "static method" Instance.
       #
       proc Instance {} {
           if { $_instance == {} } {
             set _instance [Singleton ABC]
              }
       return $_instance
       }
       # end of Instance
       constructor {} {
          set caller [info level [expr [info level] - 1]]
         if ![string match "Singleton::Instance" $caller] {
               error "Class Singleton can not be directly instantiated - use Instance"
           }

      }

}

set s [Singleton::Instance]

set bb [Singleton::Instance]

==============================================

class Singleton {
       private common _instance {}  ;# static instance variable
       constructor {} {
    if { $_instance == {} } {
        set _instance onlyone
    } else {
        error "Class Singleton already instantiated"
    }
       }
   }

Singleton ab                 (right)
Singleton cd                 (wrong)