Gecko [ edgpens.lpkmn.gov.my ]

Name	Size	Permission
about.tcl	1.88 KB	-rw-rw-rw-
blame.tcl	34.91 KB	-rw-rw-rw-
branch.tcl	943 B	-rw-rw-rw-
branch_checkout.tcl	2.2 KB	-rw-rw-rw-
branch_create.tcl	5.3 KB	-rw-rw-rw-
branch_delete.tcl	3.28 KB	-rw-rw-rw-
branch_rename.tcl	3.14 KB	-rw-rw-rw-
browser.tcl	12.1 KB	-rw-rw-rw-
checkout_op.tcl	14.55 KB	-rw-rw-rw-
choose_font.tcl	4.1 KB	-rw-rw-rw-
choose_repository.tcl	26.22 KB	-rw-rw-rw-
choose_rev.tcl	14.94 KB	-rw-rw-rw-
chord.tcl	5.26 KB	-rw-rw-rw-
class.tcl	4.45 KB	-rw-rw-rw-
commit.tcl	12.81 KB	-rw-rw-rw-
console.tcl	4.73 KB	-rw-rw-rw-
database.tcl	3 KB	-rw-rw-rw-
date.tcl	1.03 KB	-rw-rw-rw-
diff.tcl	23.6 KB	-rw-rw-rw-
encoding.tcl	16.37 KB	-rw-rw-rw-
error.tcl	2.47 KB	-rw-rw-rw-
git-gui.ico	3.55 KB	-rw-rw-rw-
index.tcl	17.77 KB	-rw-rw-rw-
line.tcl	1.32 KB	-rw-rw-rw-
logo.tcl	2.24 KB	-rw-rw-rw-
merge.tcl	6.37 KB	-rw-rw-rw-
mergetool.tcl	10.35 KB	-rw-rw-rw-
option.tcl	10.45 KB	-rw-rw-rw-
remote.tcl	7.14 KB	-rw-rw-rw-
remote_add.tcl	4.48 KB	-rw-rw-rw-
remote_branch_delete.tcl	8.31 KB	-rw-rw-rw-
search.tcl	6.56 KB	-rw-rw-rw-
shortcut.tcl	3.5 KB	-rw-rw-rw-
spellcheck.tcl	9.4 KB	-rw-rw-rw-
sshkey.tcl	3.38 KB	-rw-rw-rw-
status_bar.tcl	6.85 KB	-rw-rw-rw-
tclIndex	15.45 KB	-rw-rw-rw-
themed.tcl	11.87 KB	-rw-rw-rw-
tools.tcl	3.89 KB	-rw-rw-rw-
tools_dlg.tcl	9.81 KB	-rw-rw-rw-
transport.tcl	5.71 KB	-rw-rw-rw-
win32.tcl	596 B	-rw-rw-rw-
win32_shortcut.js	888 B	-rw-rw-rw-

Code Editor : index.tcl

# git-gui index (add/remove) support
# Copyright (C) 2006, 2007 Shawn Pearce

proc _delete_indexlock {} {
	if {[catch {file delete -- [gitdir index.lock]} err]} {
		error_popup [strcat [mc "Unable to unlock the index."] "\n\n$err"]
	}
}

proc close_and_unlock_index {fd after} {
	if {![catch {_close_updateindex $fd} err]} {
		unlock_index
		uplevel #0 $after
	} else {
		rescan_on_error $err $after
	}
}

proc _close_updateindex {fd} {
	fconfigure $fd -blocking 1
	close $fd
}

proc rescan_on_error {err {after {}}} {
	global use_ttk NS

set w .indexfried
	Dialog $w
	wm withdraw $w
	wm title $w [strcat "[appname] ([reponame]): " [mc "Index Error"]]
	wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
	set s [mc "Updating the Git index failed.  A rescan will be automatically started to resynchronize git-gui."]
	text $w.msg -yscrollcommand [list $w.vs set] \
		-width [string length $s] -relief flat \
		-borderwidth 0 -highlightthickness 0 \
		-background [get_bg_color $w]
	$w.msg tag configure bold -font font_uibold -justify center
	${NS}::scrollbar $w.vs -command [list $w.msg yview]
	$w.msg insert end $s bold \n\n$err {}
	$w.msg configure -state disabled

${NS}::button $w.continue \
		-text [mc "Continue"] \
		-command [list destroy $w]
	${NS}::button $w.unlock \
		-text [mc "Unlock Index"] \
		-command "destroy $w; _delete_indexlock"
	grid $w.msg - $w.vs -sticky news
	grid $w.unlock $w.continue - -sticky se -padx 2 -pady 2
	grid columnconfigure $w 0 -weight 1
	grid rowconfigure $w 0 -weight 1

wm protocol $w WM_DELETE_WINDOW update
	bind $w.continue <Visibility> "
		grab $w
		focus %W
	"
	wm deiconify $w
	tkwait window $w

$::main_status stop_all
	unlock_index
	rescan [concat $after {ui_ready;}] 0
}

proc update_indexinfo {msg path_list after} {
	global update_index_cp

if {![lock_index update]} return

set update_index_cp 0
	set path_list [lsort $path_list]
	set total_cnt [llength $path_list]
	set batch [expr {int($total_cnt * .01) + 1}]
	if {$batch > 25} {set batch 25}

set status_bar_operation [$::main_status start $msg [mc "files"]]
	set fd [git_write update-index -z --index-info]
	fconfigure $fd \
		-blocking 0 \
		-buffering full \
		-buffersize 512 \
		-encoding binary \
		-translation binary
	fileevent $fd writable [list \
		write_update_indexinfo \
		$fd \
		$path_list \
		$total_cnt \
		$batch \
		$status_bar_operation \
		$after \
		]
}

proc write_update_indexinfo {fd path_list total_cnt batch status_bar_operation \
	after} {
	global update_index_cp
	global file_states current_diff_path

if {$update_index_cp >= $total_cnt} {
		$status_bar_operation stop
		close_and_unlock_index $fd $after
		return
	}

for {set i $batch} \
		{$update_index_cp < $total_cnt && $i > 0} \
		{incr i -1} {
		set path [lindex $path_list $update_index_cp]
		incr update_index_cp

set s $file_states($path)
		switch -glob -- [lindex $s 0] {
		A? {set new _O}
		MT -
		TM -
		T_ {set new _T}
		M? {set new _M}
		TD -
		D_ {set new _D}
		D? {set new _?}
		?? {continue}
		}
		set info [lindex $s 2]
		if {$info eq {}} continue

puts -nonewline $fd "$info\t[encoding convertto utf-8 $path]\0"
		display_file $path $new
	}

$status_bar_operation update $update_index_cp $total_cnt
}

proc update_index {msg path_list after} {
	global update_index_cp

if {![lock_index update]} return

set update_index_cp 0
	set path_list [lsort $path_list]
	set total_cnt [llength $path_list]
	set batch [expr {int($total_cnt * .01) + 1}]
	if {$batch > 25} {set batch 25}

set status_bar_operation [$::main_status start $msg [mc "files"]]
	set fd [git_write update-index --add --remove -z --stdin]
	fconfigure $fd \
		-blocking 0 \
		-buffering full \
		-buffersize 512 \
		-encoding binary \
		-translation binary
	fileevent $fd writable [list \
		write_update_index \
		$fd \
		$path_list \
		$total_cnt \
		$batch \
		$status_bar_operation \
		$after \
		]
}

proc write_update_index {fd path_list total_cnt batch status_bar_operation \
	after} {
	global update_index_cp
	global file_states current_diff_path

if {$update_index_cp >= $total_cnt} {
		$status_bar_operation stop
		close_and_unlock_index $fd $after
		return
	}

for {set i $batch} \
		{$update_index_cp < $total_cnt && $i > 0} \
		{incr i -1} {
		set path [lindex $path_list $update_index_cp]
		incr update_index_cp

switch -glob -- [lindex $file_states($path) 0] {
		AD {set new __}
		?D {set new D_}
		_O -
		AT -
		AM {set new A_}
		TM -
		MT -
		_T {set new T_}
		_U -
		U? {
			if {[file exists $path]} {
				set new M_
			} else {
				set new D_
			}
		}
		?M {set new M_}
		?? {continue}
		}
		puts -nonewline $fd "[encoding convertto utf-8 $path]\0"
		display_file $path $new
	}

$status_bar_operation update $update_index_cp $total_cnt
}

proc checkout_index {msg path_list after capture_error} {
	global update_index_cp

if {![lock_index update]} return

set update_index_cp 0
	set path_list [lsort $path_list]
	set total_cnt [llength $path_list]
	set batch [expr {int($total_cnt * .01) + 1}]
	if {$batch > 25} {set batch 25}

set status_bar_operation [$::main_status start $msg [mc "files"]]
	set fd [git_write checkout-index \
		--index \
		--quiet \
		--force \
		-z \
		--stdin \
		]
	fconfigure $fd \
		-blocking 0 \
		-buffering full \
		-buffersize 512 \
		-encoding binary \
		-translation binary
	fileevent $fd writable [list \
		write_checkout_index \
		$fd \
		$path_list \
		$total_cnt \
		$batch \
		$status_bar_operation \
		$after \
		$capture_error \
		]
}

proc write_checkout_index {fd path_list total_cnt batch status_bar_operation \
	after capture_error} {
	global update_index_cp
	global file_states current_diff_path

if {$update_index_cp >= $total_cnt} {
		$status_bar_operation stop

# We do not unlock the index directly here because this
		# operation expects to potentially run in parallel with file
		# deletions scheduled by revert_helper. We're done with the
		# update index, so we close it, but actually unlocking the index
		# and dealing with potential errors is deferred to the chord
		# body that runs when all async operations are completed.
		#
		# (See after_chord in revert_helper.)

if {[catch {_close_updateindex $fd} err]} {
			uplevel #0 $capture_error [list $err]
		}

uplevel #0 $after

return
	}

for {set i $batch} \
		{$update_index_cp < $total_cnt && $i > 0} \
		{incr i -1} {
		set path [lindex $path_list $update_index_cp]
		incr update_index_cp
		switch -glob -- [lindex $file_states($path) 0] {
		U? {continue}
		?M -
		?T -
		?D {
			puts -nonewline $fd "[encoding convertto utf-8 $path]\0"
			display_file $path ?_
		}
		}
	}

$status_bar_operation update $update_index_cp $total_cnt
}

proc unstage_helper {txt paths} {
	global file_states current_diff_path

if {![lock_index begin-update]} return

set path_list [list]
	set after {}
	foreach path $paths {
		switch -glob -- [lindex $file_states($path) 0] {
		A? -
		M? -
		T? -
		D? {
			lappend path_list $path
			if {$path eq $current_diff_path} {
				set after {reshow_diff;}
			}
		}
		}
	}
	if {$path_list eq {}} {
		unlock_index
	} else {
		update_indexinfo \
			$txt \
			$path_list \
			[concat $after {ui_ready;}]
	}
}

proc do_unstage_selection {} {
	global current_diff_path selected_paths

if {[array size selected_paths] > 0} {
		unstage_helper \
			[mc "Unstaging selected files from commit"] \
			[array names selected_paths]
	} elseif {$current_diff_path ne {}} {
		unstage_helper \
			[mc "Unstaging %s from commit" [short_path $current_diff_path]] \
			[list $current_diff_path]
	}
}

proc add_helper {txt paths} {
	global file_states current_diff_path

if {![lock_index begin-update]} return

set path_list [list]
	set after {}
	foreach path $paths {
		switch -glob -- [lindex $file_states($path) 0] {
		_U -
		U? {
			if {$path eq $current_diff_path} {
				unlock_index
				merge_stage_workdir $path
				return
			}
		}
		_O -
		?M -
		?D -
		?T {
			lappend path_list $path
			if {$path eq $current_diff_path} {
				set after {reshow_diff;}
			}
		}
		}
	}
	if {$path_list eq {}} {
		unlock_index
	} else {
		update_index \
			$txt \
			$path_list \
			[concat $after {ui_status [mc "Ready to commit."];}]
	}
}

proc do_add_selection {} {
	global current_diff_path selected_paths

if {[array size selected_paths] > 0} {
		add_helper \
			[mc "Adding selected files"] \
			[array names selected_paths]
	} elseif {$current_diff_path ne {}} {
		add_helper \
			[mc "Adding %s" [short_path $current_diff_path]] \
			[list $current_diff_path]
	}
}

proc do_add_all {} {
	global file_states

set paths [list]
	set untracked_paths [list]
	foreach path [array names file_states] {
		switch -glob -- [lindex $file_states($path) 0] {
		U? {continue}
		?M -
		?T -
		?D {lappend paths $path}
		?O {lappend untracked_paths $path}
		}
	}
	if {[llength $untracked_paths]} {
		set reply 0
		switch -- [get_config gui.stageuntracked] {
		no {
			set reply 0
		}
		yes {
			set reply 1
		}
		ask -
		default {
			set reply [ask_popup [mc "Stage %d untracked files?" \
									  [llength $untracked_paths]]]
		}
		}
		if {$reply} {
			set paths [concat $paths $untracked_paths]
		}
	}
	add_helper [mc "Adding all changed files"] $paths
}

# Copied from TclLib package "lambda".
proc lambda {arguments body args} {
	return [list ::apply [list $arguments $body] {*}$args]
}

proc revert_helper {txt paths} {
	global file_states current_diff_path

if {![lock_index begin-update]} return

# Common "after" functionality that waits until multiple asynchronous
	# operations are complete (by waiting for them to activate their notes
	# on the chord).
	#
	# The asynchronous operations are each indicated below by a comment
	# before the code block that starts the async operation.
	set after_chord [SimpleChord::new {
		if {[string trim $err] != ""} {
			rescan_on_error $err
		} else {
			unlock_index
			if {$should_reshow_diff} { reshow_diff }
			ui_ready
		}
	}]

$after_chord eval { set should_reshow_diff 0 }

# This function captures an error for processing when after_chord is
	# completed. (The chord is curried into the lambda function.)
	set capture_error [lambda \
		{chord error} \
		{ $chord eval [list set err $error] } \
		$after_chord]

# We don't know how many notes we're going to create (it's dynamic based
	# on conditional paths below), so create a common note that will delay
	# the chord's completion until we activate it, and then activate it
	# after all the other notes have been created.
	set after_common_note [$after_chord add_note]

set path_list [list]
	set untracked_list [list]

foreach path $paths {
		switch -glob -- [lindex $file_states($path) 0] {
		U? {continue}
		?O {
			lappend untracked_list $path
		}
		?M -
		?T -
		?D {
			lappend path_list $path
			if {$path eq $current_diff_path} {
				$after_chord eval { set should_reshow_diff 1 }
			}
		}
		}
	}

set path_cnt [llength $path_list]
	set untracked_cnt [llength $untracked_list]

# Asynchronous operation: revert changes by checking them out afresh
	# from the index.
	if {$path_cnt > 0} {
		# Split question between singular and plural cases, because
		# such distinction is needed in some languages. Previously, the
		# code used "Revert changes in" for both, but that can't work
		# in languages where 'in' must be combined with word from
		# rest of string (in different way for both cases of course).
		#
		# FIXME: Unfortunately, even that isn't enough in some languages
		# as they have quite complex plural-form rules. Unfortunately,
		# msgcat doesn't seem to support that kind of string
		# translation.
		#
		if {$path_cnt == 1} {
			set query [mc \
				"Revert changes in file %s?" \
				[short_path [lindex $path_list]] \
				]
		} else {
			set query [mc \
				"Revert changes in these %i files?" \
				$path_cnt]
		}

set reply [tk_dialog \
			.confirm_revert \
			"[appname] ([reponame])" \
			"$query

[mc "Any unstaged changes will be permanently lost by the revert."]" \
			question \
			1 \
			[mc "Do Nothing"] \
			[mc "Revert Changes"] \
			]

if {$reply == 1} {
			set note [$after_chord add_note]
			checkout_index \
				$txt \
				$path_list \
				[list $note activate] \
				$capture_error
		}
	}

# Asynchronous operation: Deletion of untracked files.
	if {$untracked_cnt > 0} {
		# Split question between singular and plural cases, because
		# such distinction is needed in some languages.
		#
		# FIXME: Unfortunately, even that isn't enough in some languages
		# as they have quite complex plural-form rules. Unfortunately,
		# msgcat doesn't seem to support that kind of string
		# translation.
		#
		if {$untracked_cnt == 1} {
			set query [mc \
				"Delete untracked file %s?" \
				[short_path [lindex $untracked_list]] \
				]
		} else {
			set query [mc \
				"Delete these %i untracked files?" \
				$untracked_cnt \
				]
		}

set reply [tk_dialog \
			.confirm_revert \
			"[appname] ([reponame])" \
			"$query

[mc "Files will be permanently deleted."]" \
			question \
			1 \
			[mc "Do Nothing"] \
			[mc "Delete Files"] \
			]

if {$reply == 1} {
			$after_chord eval { set should_reshow_diff 1 }

set note [$after_chord add_note]
			delete_files $untracked_list [list $note activate]
		}
	}

# Activate the common note. If no other notes were created, this
	# completes the chord. If other notes were created, then this common
	# note prevents a race condition where the chord might complete early.
	$after_common_note activate
}

# Delete all of the specified files, performing deletion in batches to allow the
# UI to remain responsive and updated.
proc delete_files {path_list after} {
	# Enable progress bar status updates
	set status_bar_operation [$::main_status \
		start \
		[mc "Deleting"] \
		[mc "files"]]

set path_index 0
	set deletion_errors [list]
	set batch_size 50

delete_helper \
		$path_list \
		$path_index \
		$deletion_errors \
		$batch_size \
		$status_bar_operation \
		$after
}

# Helper function to delete a list of files in batches. Each call deletes one
# batch of files, and then schedules a call for the next batch after any UI
# messages have been processed.
proc delete_helper {path_list path_index deletion_errors batch_size \
	status_bar_operation after} {
	global file_states

set path_cnt [llength $path_list]

set batch_remaining $batch_size

while {$batch_remaining > 0} {
		if {$path_index >= $path_cnt} { break }

set path [lindex $path_list $path_index]

set deletion_failed [catch {file delete -- $path} deletion_error]

if {$deletion_failed} {
			lappend deletion_errors [list "$deletion_error"]
		} else {
			remove_empty_directories [file dirname $path]

# Don't assume the deletion worked. Remove the file from
			# the UI, but only if it no longer exists.
			if {![path_exists $path]} {
				unset file_states($path)
				display_file $path __
			}
		}

incr path_index 1
		incr batch_remaining -1
	}

# Update the progress bar to indicate that this batch has been
	# completed. The update will be visible when this procedure returns
	# and allows the UI thread to process messages.
	$status_bar_operation update $path_index $path_cnt

if {$path_index < $path_cnt} {
		# The Tcler's Wiki lists this as the best practice for keeping
		# a UI active and processing messages during a long-running
		# operation.

after idle [list after 0 [list \
			delete_helper \
			$path_list \
			$path_index \
			$deletion_errors \
			$batch_size \
			$status_bar_operation \
			$after
			]]
	} else {
		# Finish the status bar operation.
		$status_bar_operation stop

# Report error, if any, based on how many deletions failed.
		set deletion_error_cnt [llength $deletion_errors]

if {($deletion_error_cnt > 0)
		 && ($deletion_error_cnt <= [MAX_VERBOSE_FILES_IN_DELETION_ERROR])} {
			set error_text [mc "Encountered errors deleting files:\n"]

foreach deletion_error $deletion_errors {
				append error_text "* [lindex $deletion_error 0]\n"
			}

error_popup $error_text
		} elseif {$deletion_error_cnt == $path_cnt} {
			error_popup [mc \
				"None of the %d selected files could be deleted." \
				$path_cnt \
				]
		} elseif {$deletion_error_cnt > 1} {
			error_popup [mc \
				"%d of the %d selected files could not be deleted." \
				$deletion_error_cnt \
				$path_cnt \
				]
		}

uplevel #0 $after
	}
}

proc MAX_VERBOSE_FILES_IN_DELETION_ERROR {} { return 10; }

# This function is from the TCL documentation:
#
#   https://wiki.tcl-lang.org/page/file+exists
#
# [file exists] returns false if the path does exist but is a symlink to a path
# that doesn't exist. This proc returns true if the path exists, regardless of
# whether it is a symlink and whether it is broken.
proc path_exists {name} {
	expr {![catch {file lstat $name finfo}]}
}

# Remove as many empty directories as we can starting at the specified path,
# walking up the directory tree. If we encounter a directory that is not
# empty, or if a directory deletion fails, then we stop the operation and
# return to the caller. Even if this procedure fails to delete any
# directories at all, it does not report failure.
proc remove_empty_directories {directory_path} {
	set parent_path [file dirname $directory_path]

while {$parent_path != $directory_path} {
		set contents [glob -nocomplain -dir $directory_path *]

if {[llength $contents] > 0} { break }
		if {[catch {file delete -- $directory_path}]} { break }

set directory_path $parent_path
		set parent_path [file dirname $directory_path]
	}
}

proc do_revert_selection {} {
	global current_diff_path selected_paths

if {[array size selected_paths] > 0} {
		revert_helper \
			[mc "Reverting selected files"] \
			[array names selected_paths]
	} elseif {$current_diff_path ne {}} {
		revert_helper \
			[mc "Reverting %s" [short_path $current_diff_path]] \
			[list $current_diff_path]
	}
}

proc do_select_commit_type {} {
	global commit_type commit_type_is_amend

if {$commit_type_is_amend == 0
		&& [string match amend* $commit_type]} {
		create_new_commit
	} elseif {$commit_type_is_amend == 1
		&& ![string match amend* $commit_type]} {
		load_last_commit

# The amend request was rejected...
		#
		if {![string match amend* $commit_type]} {
			set commit_type_is_amend 0
		}
	}
}

${this.title}

Code Editor : index.tcl