diff options
Diffstat (limited to 'third_party/git/git-gui/lib/class.tcl')
| -rw-r--r-- | third_party/git/git-gui/lib/class.tcl | 194 |
1 files changed, 0 insertions, 194 deletions
diff --git a/third_party/git/git-gui/lib/class.tcl b/third_party/git/git-gui/lib/class.tcl deleted file mode 100644 index f08506f3834a..000000000000 --- a/third_party/git/git-gui/lib/class.tcl +++ /dev/null @@ -1,194 +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_dialog {t w args} { - upvar $t top $w pfx this this - global use_ttk - uplevel [linsert $args 0 make_toplevel $t $w] - catch {wm attributes $top -type dialog} - pave_toplevel $pfx -} - -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" -} |