Merge branch 'maint'

[git.git] / lib / class.tcl

diff --git a/lib/class.tcl b/lib/class.tcl
deleted file mode 100644 (file)
index dc21411..0000000
--- a/lib/class.tcl
+++ /dev/null
@@ -1,186 +0,0 @@
-# git-gui simple class/object fake-alike
-# Copyright (C) 2007 Shawn Pearce
-
-proc class {class body} {
-       if {[namespace exists $class]} {
-               error "class $class already declared"
-       }
-       namespace eval $class "
-               variable __nextid     0
-               variable __sealed     0
-               variable __field_list {}
-               variable __field_array
-
-               proc cb {name args} {
-                       upvar this this
-                       concat \[list ${class}::\$name \$this\] \$args
-               }
-       "
-       namespace eval $class $body
-}
-
-proc field {name args} {
-       set class [uplevel {namespace current}]
-       variable ${class}::__sealed
-       variable ${class}::__field_array
-
-       switch [llength $args] {
-       0 { set new [list $name] }
-       1 { set new [list $name [lindex $args 0]] }
-       default { error "wrong # args: field name value?" }
-       }
-
-       if {$__sealed} {
-               error "class $class is sealed (cannot add new fields)"
-       }
-
-       if {[catch {set old $__field_array($name)}]} {
-               variable ${class}::__field_list
-               lappend __field_list $new
-               set __field_array($name) 1
-       } else {
-               error "field $name already declared"
-       }
-}
-
-proc constructor {name params body} {
-       set class [uplevel {namespace current}]
-       set ${class}::__sealed 1
-       variable ${class}::__field_list
-       set mbodyc {}
-
-       append mbodyc {set this } $class
-       append mbodyc {::__o[incr } $class {::__nextid]::__d} \;
-       append mbodyc {create_this } $class \;
-       append mbodyc {set __this [namespace qualifiers $this]} \;
-
-       if {$__field_list ne {}} {
-               append mbodyc {upvar #0}
-               foreach n $__field_list {
-                       set n [lindex $n 0]
-                       append mbodyc { ${__this}::} $n { } $n
-                       regsub -all @$n\\M $body "\${__this}::$n" body
-               }
-               append mbodyc \;
-               foreach n $__field_list {
-                       if {[llength $n] == 2} {
-                               append mbodyc \
-                               {set } [lindex $n 0] { } [list [lindex $n 1]] \;
-                       }
-               }
-       }
-       append mbodyc $body
-       namespace eval $class [list proc $name $params $mbodyc]
-}
-
-proc method {name params body {deleted {}} {del_body {}}} {
-       set class [uplevel {namespace current}]
-       set ${class}::__sealed 1
-       variable ${class}::__field_list
-       set params [linsert $params 0 this]
-       set mbodyc {}
-
-       append mbodyc {set __this [namespace qualifiers $this]} \;
-
-       switch $deleted {
-       {} {}
-       ifdeleted {
-               append mbodyc {if {![namespace exists $__this]} }
-               append mbodyc \{ $del_body \; return \} \;
-       }
-       default {
-               error "wrong # args: method name args body (ifdeleted body)?"
-       }
-       }
-
-       set decl {}
-       foreach n $__field_list {
-               set n [lindex $n 0]
-               if {[regexp -- $n\\M $body]} {
-                       if {   [regexp -all -- $n\\M $body] == 1
-                               && [regexp -all -- \\\$$n\\M $body] == 1
-                               && [regexp -all -- \\\$$n\\( $body] == 0} {
-                               regsub -all \
-                                       \\\$$n\\M $body \
-                                       "\[set \${__this}::$n\]" body
-                       } else {
-                               append decl { ${__this}::} $n { } $n
-                               regsub -all @$n\\M $body "\${__this}::$n" body
-                       }
-               }
-       }
-       if {$decl ne {}} {
-               append mbodyc {upvar #0} $decl \;
-       }
-       append mbodyc $body
-       namespace eval $class [list proc $name $params $mbodyc]
-}
-
-proc create_this {class} {
-       upvar this this
-       namespace eval [namespace qualifiers $this] [list proc \
-               [namespace tail $this] \
-               [list name args] \
-               "eval \[list ${class}::\$name $this\] \$args" \
-       ]
-}
-
-proc delete_this {{t {}}} {
-       if {$t eq {}} {
-               upvar this this
-               set t $this
-       }
-       set t [namespace qualifiers $t]
-       if {[namespace exists $t]} {namespace delete $t}
-}
-
-proc make_toplevel {t w args} {
-       upvar $t top $w pfx this this
-
-       if {[llength $args] % 2} {
-               error "make_toplevel topvar winvar {options}"
-       }
-       set autodelete 1
-       foreach {name value} $args {
-               switch -exact -- $name {
-               -autodelete {set autodelete $value}
-               default     {error "unsupported option $name"}
-               }
-       }
-
-       if {$::root_exists || [winfo ismapped .]} {
-               regsub -all {::} $this {__} w
-               set top .$w
-               set pfx $top
-               toplevel $top
-               set ::root_exists 1
-       } else {
-               set top .
-               set pfx {}
-       }
-
-       if {$autodelete} {
-               wm protocol $top WM_DELETE_WINDOW "
-                       [list delete_this $this]
-                       [list destroy $top]
-               "
-       }
-}
-
-
-## auto_mkindex support for class/constructor/method
-##
-auto_mkindex_parser::command class {name body} {
-       variable parser
-       variable contextStack
-       set contextStack [linsert $contextStack 0 $name]
-       $parser eval [list _%@namespace eval $name] $body
-       set contextStack [lrange $contextStack 1 end]
-}
-auto_mkindex_parser::command constructor {name args} {
-       variable index
-       variable scriptFile
-       append index [list set auto_index([fullname $name])] \
-               [format { [list source [file join $dir %s]]} \
-               [file split $scriptFile]] "\n"
-}