diff options
| author | Junio C Hamano <junkio@cox.net> | 2007-05-10 15:08:18 -0700 | 
|---|---|---|
| committer | Junio C Hamano <junkio@cox.net> | 2007-05-10 15:08:18 -0700 | 
| commit | 2b93bfac0f5bcabbf60f174f4e7bfa9e318e64d5 (patch) | |
| tree | 5e5d3dcf64aa8cd7576e335d3f133deaf22539b5 /git-gui/lib/class.tcl | |
| parent | ffcc952b33575e28b971d63ba2b7e46b7726a257 (diff) | |
| parent | d6da71a9d16b8cf27f9d8f90692d3625c849cbc8 (diff) | |
| download | git-2b93bfac0f5bcabbf60f174f4e7bfa9e318e64d5.tar.gz | |
Merge branch 'master' of git://repo.or.cz/git-gui
* 'master' of git://repo.or.cz/git-gui:
  git gui 0.7.0
  git-gui: Paperbag fix blame in subdirectory
  git-gui: Format author/committer times in ISO format
  git-gui: Cleanup minor nits in blame code
  git-gui: Generate blame on uncommitted working tree file
  git-gui: Smarter command line parsing for browser, blame
  git-gui: Use prefix if blame is run in a subdirectory
  git-gui: Convert blame to the "class" way of doing things
  git-gui: Don't attempt to inline array reads in methods
  git-gui: Convert browser, console to "class" format
  git-gui: Define a simple class/method system
  git-gui: Allow shift-{k,j} to select a range of branches to merge
  git-gui: Call changes "Staged" and "Unstaged" in file list titles.
Diffstat (limited to 'git-gui/lib/class.tcl')
| -rw-r--r-- | git-gui/lib/class.tcl | 154 | 
1 files changed, 154 insertions, 0 deletions
diff --git a/git-gui/lib/class.tcl b/git-gui/lib/class.tcl new file mode 100644 index 0000000000..88b056522a --- /dev/null +++ b/git-gui/lib/class.tcl @@ -0,0 +1,154 @@ +# 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 +			set args [linsert $args 0 $name $this] +			return [uplevel [list namespace code $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]} \; +	append mbodyc {namespace eval $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 {} + +	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 delete_this {{t {}}} { +	if {$t eq {}} { +		upvar this this +		set t $this +	} +	if {[namespace exists $t]} {namespace delete $t} +} + +proc make_toplevel {t w} { +	upvar $t top $w pfx +	if {[winfo ismapped .]} { +		upvar this this +		regsub -all {::} $this {__} w +		set top .$w +		set pfx $top +		toplevel $top +	} else { +		set top . +		set pfx {} +	} +} + + +## 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" +} +  | 
