asedeno.scripts.mit.edu Git - git.git/blob

1 #!/bin/sh

2 # Tcl ignores the next line -*- tcl -*- \

3 exec wish "$0" -- "$@"

6 # This program is free software; it may be used, copied, modified

7 # and distributed under the terms of the GNU General Public Licence,

8 # either version 2, or (at your option) any later version.

10 set appname [lindex [file split $argv0] end]

11 set gitdir {}

13 ######################################################################

14 ##

15 ## config

17 proc is_many_config {name} {

18 switch -glob -- $name {

19 remote.*.fetch -

20 remote.*.push

21 {return 1}

22 *

23 {return 0}

24 }

25 }

27 proc load_config {} {

28 global repo_config global_config default_config

30 array unset global_config

31 array unset repo_config

32 catch {

33 set fd_rc [open "| git repo-config --global --list" r]

34 while {[gets $fd_rc line] >= 0} {

35 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {

36 if {[is_many_config $name]} {

37 lappend global_config($name) $value

38 } else {

39 set global_config($name) $value

40 }

41 }

42 }

43 close $fd_rc

44 }

45 catch {

46 set fd_rc [open "| git repo-config --list" r]

47 while {[gets $fd_rc line] >= 0} {

48 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {

49 if {[is_many_config $name]} {

50 lappend repo_config($name) $value

51 } else {

52 set repo_config($name) $value

53 }

54 }

55 }

56 close $fd_rc

57 }

59 foreach name [array names default_config] {

60 if {[catch {set v $global_config($name)}]} {

61 set global_config($name) $default_config($name)

62 }

63 if {[catch {set v $repo_config($name)}]} {

64 set repo_config($name) $default_config($name)

65 }

66 }

67 }

69 proc save_config {} {

70 global default_config font_descs

71 global repo_config global_config

72 global repo_config_new global_config_new

74 foreach option $font_descs {

75 set name [lindex $option 0]

76 set font [lindex $option 1]

77 font configure $font \

78 -family $global_config_new(gui.$font^^family) \

79 -size $global_config_new(gui.$font^^size)

80 font configure ${font}bold \

81 -family $global_config_new(gui.$font^^family) \

82 -size $global_config_new(gui.$font^^size)

83 set global_config_new(gui.$name) [font configure $font]

84 unset global_config_new(gui.$font^^family)

85 unset global_config_new(gui.$font^^size)

86 }

88 foreach name [array names default_config] {

89 set value $global_config_new($name)

90 if {$value != $global_config($name)} {

91 if {$value == $default_config($name)} {

92 catch {exec git repo-config --global --unset $name}

93 } else {

94 catch {exec git repo-config --global $name $value}

95 }

96 set global_config($name) $value

97 if {$value == $repo_config($name)} {

98 catch {exec git repo-config --unset $name}

99 set repo_config($name) $value

100 }

101 }

102 }

103

104 foreach name [array names default_config] {

105 set value $repo_config_new($name)

106 if {$value != $repo_config($name)} {

107 if {$value == $global_config($name)} {

108 catch {exec git repo-config --unset $name}

109 } else {

110 catch {exec git repo-config $name $value}

111 }

112 set repo_config($name) $value

113 }

114 }

115 }

116

117 proc error_popup {msg} {

118 global gitdir appname

119

120 set title $appname

121 if {$gitdir != {}} {

122 append title { (}

123 append title [lindex \

124 [file split [file normalize [file dirname $gitdir]]] \

125 end]

126 append title {)}

127 }

128 tk_messageBox \

129 -parent . \

130 -icon error \

131 -type ok \

132 -title "$title: error" \

133 -message $msg

134 }

135

136 proc info_popup {msg} {

137 global gitdir appname

138

139 set title $appname

140 if {$gitdir != {}} {

141 append title { (}

142 append title [lindex \

143 [file split [file normalize [file dirname $gitdir]]] \

144 end]

145 append title {)}

146 }

147 tk_messageBox \

148 -parent . \

149 -icon error \

150 -type ok \

151 -title $title \

152 -message $msg

153 }

154

155 ######################################################################

156 ##

157 ## repository setup

158

159 if { [catch {set cdup [exec git rev-parse --show-cdup]} err]

160 || [catch {set gitdir [exec git rev-parse --git-dir]} err]} {

161 catch {wm withdraw .}

162 error_popup "Cannot find the git directory:\n\n$err"

163 exit 1

164 }

165 if {$cdup != ""} {

166 cd $cdup

167 }

168 unset cdup

169

170 if {$appname == {git-citool}} {

171 set single_commit 1

172 }

173

174 ######################################################################

175 ##

176 ## task management

177

178 set single_commit 0

179 set status_active 0

180 set diff_active 0

181 set commit_active 0

182

183 set disable_on_lock [list]

184 set index_lock_type none

185

186 set HEAD {}

187 set PARENT {}

188 set commit_type {}

189

190 proc lock_index {type} {

191 global index_lock_type disable_on_lock

192

193 if {$index_lock_type == {none}} {

194 set index_lock_type $type

195 foreach w $disable_on_lock {

196 uplevel #0 $w disabled

197 }

198 return 1

199 } elseif {$index_lock_type == {begin-update} && $type == {update}} {

200 set index_lock_type $type

201 return 1

202 }

203 return 0

204 }

205

206 proc unlock_index {} {

207 global index_lock_type disable_on_lock

208

209 set index_lock_type none

210 foreach w $disable_on_lock {

211 uplevel #0 $w normal

212 }

213 }

214

215 ######################################################################

216 ##

217 ## status

218

219 proc repository_state {hdvar ctvar} {

220 global gitdir

221 upvar $hdvar hd $ctvar ct

222

223 if {[catch {set hd [exec git rev-parse --verify HEAD]}]} {

224 set ct initial

225 } elseif {[file exists [file join $gitdir MERGE_HEAD]]} {

226 set ct merge

227 } else {

228 set ct normal

229 }

230 }

231

232 proc update_status {{final Ready.}} {

233 global HEAD PARENT commit_type

234 global ui_index ui_other ui_status_value ui_comm

235 global status_active file_states

236 global repo_config

237

238 if {$status_active || ![lock_index read]} return

239

240 repository_state new_HEAD new_type

241 if {$commit_type == {amend}

242 && $new_type == {normal}

243 && $new_HEAD == $HEAD} {

244 } else {

245 set HEAD $new_HEAD

246 set PARENT $new_HEAD

247 set commit_type $new_type

248 }

249

250 array unset file_states

251

252 if {![$ui_comm edit modified]

253 || [string trim [$ui_comm get 0.0 end]] == {}} {

254 if {[load_message GITGUI_MSG]} {

255 } elseif {[load_message MERGE_MSG]} {

256 } elseif {[load_message SQUASH_MSG]} {

257 }

258 $ui_comm edit modified false

259 $ui_comm edit reset

260 }

261

262 if {$repo_config(gui.trustmtime) == {true}} {

263 update_status_stage2 {} $final

264 } else {

265 set status_active 1

266 set ui_status_value {Refreshing file status...}

267 set cmd [list git update-index]

268 lappend cmd -q

269 lappend cmd --unmerged

270 lappend cmd --ignore-missing

271 lappend cmd --refresh

272 set fd_rf [open "| $cmd" r]

273 fconfigure $fd_rf -blocking 0 -translation binary

274 fileevent $fd_rf readable \

275 [list update_status_stage2 $fd_rf $final]

276 }

277 }

278

279 proc update_status_stage2 {fd final} {

280 global gitdir PARENT commit_type

281 global ui_index ui_other ui_status_value ui_comm

282 global status_active

283 global buf_rdi buf_rdf buf_rlo

284

285 if {$fd != {}} {

286 read $fd

287 if {![eof $fd]} return

288 close $fd

289 }

290

291 set ls_others [list | git ls-files --others -z \

292 --exclude-per-directory=.gitignore]

293 set info_exclude [file join $gitdir info exclude]

294 if {[file readable $info_exclude]} {

295 lappend ls_others "--exclude-from=$info_exclude"

296 }

297

298 set buf_rdi {}

299 set buf_rdf {}

300 set buf_rlo {}

301

302 set status_active 3

303 set ui_status_value {Scanning for modified files ...}

304 set fd_di [open "| git diff-index --cached -z $PARENT" r]

305 set fd_df [open "| git diff-files -z" r]

306 set fd_lo [open $ls_others r]

307

308 fconfigure $fd_di -blocking 0 -translation binary

309 fconfigure $fd_df -blocking 0 -translation binary

310 fconfigure $fd_lo -blocking 0 -translation binary

311 fileevent $fd_di readable [list read_diff_index $fd_di $final]

312 fileevent $fd_df readable [list read_diff_files $fd_df $final]

313 fileevent $fd_lo readable [list read_ls_others $fd_lo $final]

314 }

315

316 proc load_message {file} {

317 global gitdir ui_comm

318

319 set f [file join $gitdir $file]

320 if {[file isfile $f]} {

321 if {[catch {set fd [open $f r]}]} {

322 return 0

323 }

324 set content [string trim [read $fd]]

325 close $fd

326 $ui_comm delete 0.0 end

327 $ui_comm insert end $content

328 return 1

329 }

330 return 0

331 }

332

333 proc read_diff_index {fd final} {

334 global buf_rdi

335

336 append buf_rdi [read $fd]

337 set c 0

338 set n [string length $buf_rdi]

339 while {$c < $n} {

340 set z1 [string first "\0" $buf_rdi $c]

341 if {$z1 == -1} break

342 incr z1

343 set z2 [string first "\0" $buf_rdi $z1]

344 if {$z2 == -1} break

345

346 set c $z2

347 incr z2 -1

348 display_file \

349 [string range $buf_rdi $z1 $z2] \

350 [string index $buf_rdi [expr $z1 - 2]]_

351 incr c

352 }

353 if {$c < $n} {

354 set buf_rdi [string range $buf_rdi $c end]

355 } else {

356 set buf_rdi {}

357 }

358

359 status_eof $fd buf_rdi $final

360 }

361

362 proc read_diff_files {fd final} {

363 global buf_rdf

364

365 append buf_rdf [read $fd]

366 set c 0

367 set n [string length $buf_rdf]

368 while {$c < $n} {

369 set z1 [string first "\0" $buf_rdf $c]

370 if {$z1 == -1} break

371 incr z1

372 set z2 [string first "\0" $buf_rdf $z1]

373 if {$z2 == -1} break

374

375 set c $z2

376 incr z2 -1

377 display_file \

378 [string range $buf_rdf $z1 $z2] \

379 _[string index $buf_rdf [expr $z1 - 2]]

380 incr c

381 }

382 if {$c < $n} {

383 set buf_rdf [string range $buf_rdf $c end]

384 } else {

385 set buf_rdf {}

386 }

387

388 status_eof $fd buf_rdf $final

389 }

390

391 proc read_ls_others {fd final} {

392 global buf_rlo

393

394 append buf_rlo [read $fd]

395 set pck [split $buf_rlo "\0"]

396 set buf_rlo [lindex $pck end]

397 foreach p [lrange $pck 0 end-1] {

398 display_file $p _O

399 }

400 status_eof $fd buf_rlo $final

401 }

402

403 proc status_eof {fd buf final} {

404 global status_active ui_status_value

405 upvar $buf to_clear

406

407 if {[eof $fd]} {

408 set to_clear {}

409 close $fd

410

411 if {[incr status_active -1] == 0} {

412 display_all_files

413 unlock_index

414 reshow_diff

415 set ui_status_value $final

416 }

417 }

418 }

419

420 ######################################################################

421 ##

422 ## diff

423

424 proc clear_diff {} {

425 global ui_diff ui_fname_value ui_fstatus_value ui_index ui_other

426

427 $ui_diff conf -state normal

428 $ui_diff delete 0.0 end

429 $ui_diff conf -state disabled

430

431 set ui_fname_value {}

432 set ui_fstatus_value {}

433

434 $ui_index tag remove in_diff 0.0 end

435 $ui_other tag remove in_diff 0.0 end

436 }

437

438 proc reshow_diff {} {

439 global ui_fname_value ui_status_value file_states

440

441 if {$ui_fname_value == {}

442 || [catch {set s $file_states($ui_fname_value)}]} {

443 clear_diff

444 } else {

445 show_diff $ui_fname_value

446 }

447 }

448

449 proc handle_empty_diff {} {

450 global ui_fname_value file_states file_lists

451

452 set path $ui_fname_value

453 set s $file_states($path)

454 if {[lindex $s 0] != {_M}} return

455

456 info_popup "No differences detected.

457

458 [short_path $path] has no changes.

459

460 The modification date of this file was updated by another

461 application and you currently have the Trust File Modification

462 Timestamps option enabled, so Git did not automatically detect

463 that there are no content differences in this file.

464

465 This file will now be removed from the modified files list, to

466 prevent possible confusion.

467 "

468 if {[catch {exec git update-index -- $path} err]} {

469 error_popup "Failed to refresh index:\n\n$err"

470 }

471

472 clear_diff

473 set old_w [mapcol [lindex $file_states($path) 0] $path]

474 set lno [lsearch -sorted $file_lists($old_w) $path]

475 if {$lno >= 0} {

476 set file_lists($old_w) \

477 [lreplace $file_lists($old_w) $lno $lno]

478 incr lno

479 $old_w conf -state normal

480 $old_w delete $lno.0 [expr $lno + 1].0

481 $old_w conf -state disabled

482 }

483 }

484

485 proc show_diff {path {w {}} {lno {}}} {

486 global file_states file_lists

487 global PARENT diff_3way diff_active

488 global ui_diff ui_fname_value ui_fstatus_value ui_status_value

489

490 if {$diff_active || ![lock_index read]} return

491

492 clear_diff

493 if {$w == {} || $lno == {}} {

494 foreach w [array names file_lists] {

495 set lno [lsearch -sorted $file_lists($w) $path]

496 if {$lno >= 0} {

497 incr lno

498 break

499 }

500 }

501 }

502 if {$w != {} && $lno >= 1} {

503 $w tag add in_diff $lno.0 [expr $lno + 1].0

504 }

505

506 set s $file_states($path)

507 set m [lindex $s 0]

508 set diff_3way 0

509 set diff_active 1

510 set ui_fname_value [escape_path $path]

511 set ui_fstatus_value [mapdesc $m $path]

512 set ui_status_value "Loading diff of [escape_path $path]..."

513

514 set cmd [list | git diff-index -p $PARENT -- $path]

515 switch $m {

516 MM {

517 set cmd [list | git diff-index -p -c $PARENT $path]

518 }

519 _O {

520 if {[catch {

521 set fd [open $path r]

522 set content [read $fd]

523 close $fd

524 } err ]} {

525 set diff_active 0

526 unlock_index

527 set ui_status_value "Unable to display [escape_path $path]"

528 error_popup "Error loading file:\n\n$err"

529 return

530 }

531 $ui_diff conf -state normal

532 $ui_diff insert end $content

533 $ui_diff conf -state disabled

534 set diff_active 0

535 unlock_index

536 set ui_status_value {Ready.}

537 return

538 }

539 }

540

541 if {[catch {set fd [open $cmd r]} err]} {

542 set diff_active 0

543 unlock_index

544 set ui_status_value "Unable to display [escape_path $path]"

545 error_popup "Error loading diff:\n\n$err"

546 return

547 }

548

549 fconfigure $fd -blocking 0 -translation auto

550 fileevent $fd readable [list read_diff $fd]

551 }

552

553 proc read_diff {fd} {

554 global ui_diff ui_status_value diff_3way diff_active

555 global repo_config

556

557 while {[gets $fd line] >= 0} {

558 if {[string match {diff --git *} $line]} continue

559 if {[string match {diff --combined *} $line]} continue

560 if {[string match {--- *} $line]} continue

561 if {[string match {+++ *} $line]} continue

562 if {[string match index* $line]} {

563 if {[string first , $line] >= 0} {

564 set diff_3way 1

565 }

566 }

567

568 $ui_diff conf -state normal

569 if {!$diff_3way} {

570 set x [string index $line 0]

571 switch -- $x {

572 "@" {set tags da}

573 "+" {set tags dp}

574 "-" {set tags dm}

575 default {set tags {}}

576 }

577 } else {

578 set x [string range $line 0 1]

579 switch -- $x {

580 default {set tags {}}

581 "@@" {set tags da}

582 "++" {set tags dp; set x " +"}

583 " +" {set tags {di bold}; set x "++"}

584 "+ " {set tags dni; set x "-+"}

585 "--" {set tags dm; set x " -"}

586 " -" {set tags {dm bold}; set x "--"}

587 "- " {set tags di; set x "+-"}

588 default {set tags {}}

589 }

590 set line [string replace $line 0 1 $x]

591 }

592 $ui_diff insert end $line $tags

593 $ui_diff insert end "\n"

594 $ui_diff conf -state disabled

595 }

596

597 if {[eof $fd]} {

598 close $fd

599 set diff_active 0

600 unlock_index

601 set ui_status_value {Ready.}

602

603 if {$repo_config(gui.trustmtime) == {true}

604 && [$ui_diff index end] == {2.0}} {

605 handle_empty_diff

606 }

607 }

608 }

609

610 ######################################################################

611 ##

612 ## commit

613

614 proc load_last_commit {} {

615 global HEAD PARENT commit_type ui_comm

616

617 if {$commit_type == {amend}} return

618 if {$commit_type != {normal}} {

619 error_popup "Can't amend a $commit_type commit."

620 return

621 }

622

623 set msg {}

624 set parent {}

625 set parent_count 0

626 if {[catch {

627 set fd [open "| git cat-file commit $HEAD" r]

628 while {[gets $fd line] > 0} {

629 if {[string match {parent *} $line]} {

630 set parent [string range $line 7 end]

631 incr parent_count

632 }

633 }

634 set msg [string trim [read $fd]]

635 close $fd

636 } err]} {

637 error_popup "Error loading commit data for amend:\n\n$err"

638 return

639 }

640

641 if {$parent_count == 0} {

642 set commit_type amend

643 set HEAD {}

644 set PARENT {}

645 update_status

646 } elseif {$parent_count == 1} {

647 set commit_type amend

648 set PARENT $parent

649 $ui_comm delete 0.0 end

650 $ui_comm insert end $msg

651 $ui_comm edit modified false

652 $ui_comm edit reset

653 update_status

654 } else {

655 error_popup {You can't amend a merge commit.}

656 return

657 }

658 }

659

660 proc commit_tree {} {

661 global tcl_platform HEAD gitdir commit_type file_states

662 global commit_active ui_status_value

663 global ui_comm

664

665 if {$commit_active || ![lock_index update]} return

666

667 # -- Our in memory state should match the repository.

668 #

669 repository_state curHEAD cur_type

670 if {$commit_type == {amend}

671 && $cur_type == {normal}

672 && $curHEAD == $HEAD} {

673 } elseif {$commit_type != $cur_type || $HEAD != $curHEAD} {

674 error_popup {Last scanned state does not match repository state.

675

676 Its highly likely that another Git program modified the

677 repository since our last scan. A rescan is required

678 before committing.

679 }

680 unlock_index

681 update_status

682 return

683 }

684

685 # -- At least one file should differ in the index.

686 #

687 set files_ready 0

688 foreach path [array names file_states] {

689 set s $file_states($path)

690 switch -glob -- [lindex $s 0] {

691 _? {continue}

692 A? -

693 D? -

694 M? {set files_ready 1; break}

695 U? {

696 error_popup "Unmerged files cannot be committed.

697

698 File [short_path $path] has merge conflicts.

699 You must resolve them and include the file before committing.

700 "

701 unlock_index

702 return

703 }

704 default {

705 error_popup "Unknown file state [lindex $s 0] detected.

706

707 File [short_path $path] cannot be committed by this program.

708 "

709 }

710 }

711 }

712 if {!$files_ready} {

713 error_popup {No included files to commit.

714

715 You must include at least 1 file before you can commit.

716 }

717 unlock_index

718 return

719 }

720

721 # -- A message is required.

722 #

723 set msg [string trim [$ui_comm get 1.0 end]]

724 if {$msg == {}} {

725 error_popup {Please supply a commit message.

726

727 A good commit message has the following format:

728

729 - First line: Describe in one sentance what you did.

730 - Second line: Blank

731 - Remaining lines: Describe why this change is good.

732 }

733 unlock_index

734 return

735 }

736

737 # -- Ask the pre-commit hook for the go-ahead.

738 #

739 set pchook [file join $gitdir hooks pre-commit]

740 if {$tcl_platform(platform) == {windows} && [file isfile $pchook]} {

741 set pchook [list sh -c \

742 "if test -x \"$pchook\"; then exec \"$pchook\"; fi"]

743 } elseif {[file executable $pchook]} {

744 set pchook [list $pchook]

745 } else {

746 set pchook {}

747 }

748 if {$pchook != {} && [catch {eval exec $pchook} err]} {

749 hook_failed_popup pre-commit $err

750 unlock_index

751 return

752 }

753

754 # -- Write the tree in the background.

755 #

756 set commit_active 1

757 set ui_status_value {Committing changes...}

758

759 set fd_wt [open "| git write-tree" r]

760 fileevent $fd_wt readable [list commit_stage2 $fd_wt $curHEAD $msg]

761 }

762

763 proc commit_stage2 {fd_wt curHEAD msg} {

764 global single_commit gitdir HEAD PARENT commit_type

765 global commit_active ui_status_value ui_comm

766 global file_states

767

768 gets $fd_wt tree_id

769 if {$tree_id == {} || [catch {close $fd_wt} err]} {

770 error_popup "write-tree failed:\n\n$err"

771 set commit_active 0

772 set ui_status_value {Commit failed.}

773 unlock_index

774 return

775 }

776

777 # -- Create the commit.

778 #

779 set cmd [list git commit-tree $tree_id]

780 if {$PARENT != {}} {

781 lappend cmd -p $PARENT

782 }

783 if {$commit_type == {merge}} {

784 if {[catch {

785 set fd_mh [open [file join $gitdir MERGE_HEAD] r]

786 while {[gets $fd_mh merge_head] >= 0} {

787 lappend cmd -p $merge_head

788 }

789 close $fd_mh

790 } err]} {

791 error_popup "Loading MERGE_HEAD failed:\n\n$err"

792 set commit_active 0

793 set ui_status_value {Commit failed.}

794 unlock_index

795 return

796 }

797 }

798 if {$PARENT == {}} {

799 # git commit-tree writes to stderr during initial commit.

800 lappend cmd 2>/dev/null

801 }

802 lappend cmd << $msg

803 if {[catch {set cmt_id [eval exec $cmd]} err]} {

804 error_popup "commit-tree failed:\n\n$err"

805 set commit_active 0

806 set ui_status_value {Commit failed.}

807 unlock_index

808 return

809 }

810

811 # -- Update the HEAD ref.

812 #

813 set reflogm commit

814 if {$commit_type != {normal}} {

815 append reflogm " ($commit_type)"

816 }

817 set i [string first "\n" $msg]

818 if {$i >= 0} {

819 append reflogm {: } [string range $msg 0 [expr $i - 1]]

820 } else {

821 append reflogm {: } $msg

822 }

823 set cmd [list git update-ref -m $reflogm HEAD $cmt_id $curHEAD]

824 if {[catch {eval exec $cmd} err]} {

825 error_popup "update-ref failed:\n\n$err"

826 set commit_active 0

827 set ui_status_value {Commit failed.}

828 unlock_index

829 return

830 }

831

832 # -- Cleanup after ourselves.

833 #

834 catch {file delete [file join $gitdir MERGE_HEAD]}

835 catch {file delete [file join $gitdir MERGE_MSG]}

836 catch {file delete [file join $gitdir SQUASH_MSG]}

837 catch {file delete [file join $gitdir GITGUI_MSG]}

838

839 # -- Let rerere do its thing.

840 #

841 if {[file isdirectory [file join $gitdir rr-cache]]} {

842 catch {exec git rerere}

843 }

844

845 $ui_comm delete 0.0 end

846 $ui_comm edit modified false

847 $ui_comm edit reset

848

849 if {$single_commit} do_quit

850

851 # -- Update status without invoking any git commands.

852 #

853 set commit_active 0

854 set commit_type normal

855 set HEAD $cmt_id

856 set PARENT $cmt_id

857

858 foreach path [array names file_states] {

859 set s $file_states($path)

860 set m [lindex $s 0]

861 switch -glob -- $m {

862 A? -

863 M? -

864 D? {set m _[string index $m 1]}

865 }

866

867 if {$m == {__}} {

868 unset file_states($path)

869 } else {

870 lset file_states($path) 0 $m

871 }

872 }

873

874 display_all_files

875 unlock_index

876 reshow_diff

877 set ui_status_value \

878 "Changes committed as [string range $cmt_id 0 7]."

879 }

880

881 ######################################################################

882 ##

883 ## fetch pull push

884

885 proc fetch_from {remote} {

886 set w [new_console "fetch $remote" \

887 "Fetching new changes from $remote"]

888 set cmd [list git fetch]

889 lappend cmd $remote

890 console_exec $w $cmd

891 }

892

893 proc pull_remote {remote branch} {

894 global HEAD commit_type

895 global file_states

896

897 if {![lock_index update]} return

898

899 # -- Our in memory state should match the repository.

900 #

901 repository_state curHEAD cur_type

902 if {$commit_type != $cur_type || $HEAD != $curHEAD} {

903 error_popup {Last scanned state does not match repository state.

904

905 Its highly likely that another Git program modified the

906 repository since our last scan. A rescan is required

907 before a pull can be started.

908 }

909 unlock_index

910 update_status

911 return

912 }

913

914 # -- No differences should exist before a pull.

915 #

916 if {[array size file_states] != 0} {

917 error_popup {Uncommitted but modified files are present.

918

919 You should not perform a pull with unmodified files in your working

920 directory as Git would be unable to recover from an incorrect merge.

921

922 Commit or throw away all changes before starting a pull operation.

923 }

924 unlock_index

925 return

926 }

927

928 set w [new_console "pull $remote $branch" \

929 "Pulling new changes from branch $branch in $remote"]

930 set cmd [list git pull]

931 lappend cmd $remote

932 lappend cmd $branch

933 console_exec $w $cmd [list post_pull_remote $remote $branch]

934 }

935

936 proc post_pull_remote {remote branch success} {

937 global HEAD PARENT commit_type

938 global ui_status_value

939

940 unlock_index

941 if {$success} {

942 repository_state HEAD commit_type

943 set PARENT $HEAD

944 set $ui_status_value {Ready.}

945 } else {

946 update_status \

947 "Conflicts detected while pulling $branch from $remote."

948 }

949 }

950

951 proc push_to {remote} {

952 set w [new_console "push $remote" \

953 "Pushing changes to $remote"]

954 set cmd [list git push]

955 lappend cmd $remote

956 console_exec $w $cmd

957 }

958

959 ######################################################################

960 ##

961 ## ui helpers

962

963 proc mapcol {state path} {

964 global all_cols ui_other

965

966 if {[catch {set r $all_cols($state)}]} {

967 puts "error: no column for state={$state} $path"

968 return $ui_other

969 }

970 return $r

971 }

972

973 proc mapicon {state path} {

974 global all_icons

975

976 if {[catch {set r $all_icons($state)}]} {

977 puts "error: no icon for state={$state} $path"

978 return file_plain

979 }

980 return $r

981 }

982

983 proc mapdesc {state path} {

984 global all_descs

985

986 if {[catch {set r $all_descs($state)}]} {

987 puts "error: no desc for state={$state} $path"

988 return $state

989 }

990 return $r

991 }

992

993 proc escape_path {path} {

994 regsub -all "\n" $path "\\n" path

995 return $path

996 }

997

998 proc short_path {path} {

999 return [escape_path [lindex [file split $path] end]]

1000 }

1001

1002 set next_icon_id 0

1003

1004 proc merge_state {path new_state} {

1005 global file_states next_icon_id

1006

1007 set s0 [string index $new_state 0]

1008 set s1 [string index $new_state 1]

1009

1010 if {[catch {set info $file_states($path)}]} {

1011 set state __

1012 set icon n[incr next_icon_id]

1013 } else {

1014 set state [lindex $info 0]

1015 set icon [lindex $info 1]

1016 }

1017

1018 if {$s0 == {_}} {

1019 set s0 [string index $state 0]

1020 } elseif {$s0 == {*}} {

1021 set s0 _

1022 }

1023

1024 if {$s1 == {_}} {

1025 set s1 [string index $state 1]

1026 } elseif {$s1 == {*}} {

1027 set s1 _

1028 }

1029

1030 set file_states($path) [list $s0$s1 $icon]

1031 return $state

1032 }

1033

1034 proc display_file {path state} {

1035 global file_states file_lists status_active

1036

1037 set old_m [merge_state $path $state]

1038 if {$status_active} return

1039

1040 set s $file_states($path)

1041 set new_m [lindex $s 0]

1042 set new_w [mapcol $new_m $path]

1043 set old_w [mapcol $old_m $path]

1044 set new_icon [mapicon $new_m $path]

1045

1046 if {$new_w != $old_w} {

1047 set lno [lsearch -sorted $file_lists($old_w) $path]

1048 if {$lno >= 0} {

1049 incr lno

1050 $old_w conf -state normal

1051 $old_w delete $lno.0 [expr $lno + 1].0

1052 $old_w conf -state disabled

1053 }

1054

1055 lappend file_lists($new_w) $path

1056 set file_lists($new_w) [lsort $file_lists($new_w)]

1057 set lno [lsearch -sorted $file_lists($new_w) $path]

1058 incr lno

1059 $new_w conf -state normal

1060 $new_w image create $lno.0 \

1061 -align center -padx 5 -pady 1 \

1062 -name [lindex $s 1] \

1063 -image $new_icon

1064 $new_w insert $lno.1 "[escape_path $path]\n"

1065 $new_w conf -state disabled

1066 } elseif {$new_icon != [mapicon $old_m $path]} {

1067 $new_w conf -state normal

1068 $new_w image conf [lindex $s 1] -image $new_icon

1069 $new_w conf -state disabled

1070 }

1071 }

1072

1073 proc display_all_files {} {

1074 global ui_index ui_other file_states file_lists

1075

1076 $ui_index conf -state normal

1077 $ui_other conf -state normal

1078

1079 $ui_index delete 0.0 end

1080 $ui_other delete 0.0 end

1081

1082 set file_lists($ui_index) [list]

1083 set file_lists($ui_other) [list]

1084

1085 foreach path [lsort [array names file_states]] {

1086 set s $file_states($path)

1087 set m [lindex $s 0]

1088 set w [mapcol $m $path]

1089 lappend file_lists($w) $path

1090 $w image create end \

1091 -align center -padx 5 -pady 1 \

1092 -name [lindex $s 1] \

1093 -image [mapicon $m $path]

1094 $w insert end "[escape_path $path]\n"

1095 }

1096

1097 $ui_index conf -state disabled

1098 $ui_other conf -state disabled

1099 }

1100

1101 proc update_index {pathList} {

1102 global update_index_cp ui_status_value

1103

1104 if {![lock_index update]} return

1105

1106 set update_index_cp 0

1107 set totalCnt [llength $pathList]

1108 set batch [expr {int($totalCnt * .01) + 1}]

1109 if {$batch > 25} {set batch 25}

1110

1111 set ui_status_value "Including files ... 0/$totalCnt 0%"

1112 set ui_status_value [format \

1113 "Including files ... %i/%i files (%.2f%%)" \

1114 $update_index_cp \

1115 $totalCnt \

1116 0.0]

1117 set fd [open "| git update-index --add --remove -z --stdin" w]

1118 fconfigure $fd -blocking 0 -translation binary

1119 fileevent $fd writable [list \

1120 write_update_index \

1121 $fd \

1122 $pathList \

1123 $totalCnt \

1124 $batch \

1125 ]

1126 }

1127

1128 proc write_update_index {fd pathList totalCnt batch} {

1129 global update_index_cp ui_status_value

1130 global file_states ui_fname_value

1131

1132 if {$update_index_cp >= $totalCnt} {

1133 close $fd

1134 unlock_index

1135 set ui_status_value {Ready.}

1136 return

1137 }

1138

1139 for {set i $batch} \

1140 {$update_index_cp < $totalCnt && $i > 0} \

1141 {incr i -1} {

1142 set path [lindex $pathList $update_index_cp]

1143 incr update_index_cp

1144

1145 switch -- [lindex $file_states($path) 0] {

1146 AM -

1147 _O {set new A*}

1148 _M -

1149 MM {set new M*}

1150 AD -

1151 _D {set new D*}

1152 default {continue}

1153 }

1154

1155 puts -nonewline $fd $path

1156 puts -nonewline $fd "\0"

1157 display_file $path $new

1158 if {$ui_fname_value == $path} {

1159 show_diff $path

1160 }

1161 }

1162

1163 set ui_status_value [format \

1164 "Including files ... %i/%i files (%.2f%%)" \

1165 $update_index_cp \

1166 $totalCnt \

1167 [expr {100.0 * $update_index_cp / $totalCnt}]]

1168 }

1169

1170 ######################################################################

1171 ##

1172 ## remote management

1173

1174 proc load_all_remotes {} {

1175 global gitdir all_remotes repo_config

1176

1177 set all_remotes [list]

1178 set rm_dir [file join $gitdir remotes]

1179 if {[file isdirectory $rm_dir]} {

1180 set all_remotes [concat $all_remotes [glob \

1181 -types f \

1182 -tails \

1183 -nocomplain \

1184 -directory $rm_dir *]]

1185 }

1186

1187 foreach line [array names repo_config remote.*.url] {

1188 if {[regexp ^remote\.(.*)\.url\$ $line line name]} {

1189 lappend all_remotes $name

1190 }

1191 }

1192

1193 set all_remotes [lsort -unique $all_remotes]

1194 }

1195

1196 proc populate_remote_menu {m pfx op} {

1197 global all_remotes

1198

1199 foreach remote $all_remotes {

1200 $m add command -label "$pfx $remote..." \

1201 -command [list $op $remote] \

1202 -font font_ui

1203 }

1204 }

1205

1206 proc populate_pull_menu {m} {

1207 global gitdir repo_config all_remotes disable_on_lock

1208

1209 foreach remote $all_remotes {

1210 set rb {}

1211 if {[array get repo_config remote.$remote.url] != {}} {

1212 if {[array get repo_config remote.$remote.fetch] != {}} {

1213 regexp {^([^:]+):} \

1214 [lindex $repo_config(remote.$remote.fetch) 0] \

1215 line rb

1216 }

1217 } else {

1218 catch {

1219 set fd [open [file join $gitdir remotes $remote] r]

1220 while {[gets $fd line] >= 0} {

1221 if {[regexp {^Pull:[ \t]*([^:]+):} $line line rb]} {

1222 break

1223 }

1224 }

1225 close $fd

1226 }

1227 }

1228

1229 set rb_short $rb

1230 regsub ^refs/heads/ $rb {} rb_short

1231 if {$rb_short != {}} {

1232 $m add command \

1233 -label "Branch $rb_short from $remote..." \

1234 -command [list pull_remote $remote $rb] \

1235 -font font_ui

1236 lappend disable_on_lock \

1237 [list $m entryconf [$m index last] -state]

1238 }

1239 }

1240 }

1241

1242 ######################################################################

1243 ##

1244 ## icons

1245

1246 set filemask {

1247 #define mask_width 14

1248 #define mask_height 15

1249 static unsigned char mask_bits[] = {

1250 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,

1251 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,

1252 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};

1253 }

1254

1255 image create bitmap file_plain -background white -foreground black -data {

1256 #define plain_width 14

1257 #define plain_height 15

1258 static unsigned char plain_bits[] = {

1259 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,

1260 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,

1261 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};

1262 } -maskdata $filemask

1263

1264 image create bitmap file_mod -background white -foreground blue -data {

1265 #define mod_width 14

1266 #define mod_height 15

1267 static unsigned char mod_bits[] = {

1268 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,

1269 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,

1270 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};

1271 } -maskdata $filemask

1272

1273 image create bitmap file_fulltick -background white -foreground "#007000" -data {

1274 #define file_fulltick_width 14

1275 #define file_fulltick_height 15

1276 static unsigned char file_fulltick_bits[] = {

1277 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,

1278 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,

1279 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};

1280 } -maskdata $filemask

1281

1282 image create bitmap file_parttick -background white -foreground "#005050" -data {

1283 #define parttick_width 14

1284 #define parttick_height 15

1285 static unsigned char parttick_bits[] = {

1286 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,

1287 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,

1288 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};

1289 } -maskdata $filemask

1290

1291 image create bitmap file_question -background white -foreground black -data {

1292 #define file_question_width 14

1293 #define file_question_height 15

1294 static unsigned char file_question_bits[] = {

1295 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,

1296 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,

1297 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};

1298 } -maskdata $filemask

1299

1300 image create bitmap file_removed -background white -foreground red -data {

1301 #define file_removed_width 14

1302 #define file_removed_height 15

1303 static unsigned char file_removed_bits[] = {

1304 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,

1305 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,

1306 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};

1307 } -maskdata $filemask

1308

1309 image create bitmap file_merge -background white -foreground blue -data {

1310 #define file_merge_width 14

1311 #define file_merge_height 15

1312 static unsigned char file_merge_bits[] = {

1313 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,

1314 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,

1315 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};

1316 } -maskdata $filemask

1317

1318 set ui_index .vpane.files.index.list

1319 set ui_other .vpane.files.other.list

1320 set max_status_desc 0

1321 foreach i {

1322 {__ i plain "Unmodified"}

1323 {_M i mod "Modified"}

1324 {M_ i fulltick "Checked in"}

1325 {MM i parttick "Partially included"}

1326

1327 {_O o plain "Untracked"}

1328 {A_ o fulltick "Added"}

1329 {AM o parttick "Partially added"}

1330 {AD o question "Added (but now gone)"}

1331

1332 {_D i question "Missing"}

1333 {D_ i removed "Removed"}

1334 {DD i removed "Removed"}

1335 {DO i removed "Removed (still exists)"}

1336

1337 {UM i merge "Merge conflicts"}

1338 {U_ i merge "Merge conflicts"}

1339 } {

1340 if {$max_status_desc < [string length [lindex $i 3]]} {

1341 set max_status_desc [string length [lindex $i 3]]

1342 }

1343 if {[lindex $i 1] == {i}} {

1344 set all_cols([lindex $i 0]) $ui_index

1345 } else {

1346 set all_cols([lindex $i 0]) $ui_other

1347 }

1348 set all_icons([lindex $i 0]) file_[lindex $i 2]

1349 set all_descs([lindex $i 0]) [lindex $i 3]

1350 }

1351 unset filemask i

1352

1353 ######################################################################

1354 ##

1355 ## util

1356

1357 proc is_MacOSX {} {

1358 global tcl_platform tk_library

1359 if {$tcl_platform(platform) == {unix}

1360 && $tcl_platform(os) == {Darwin}

1361 && [string match /Library/Frameworks/* $tk_library]} {

1362 return 1

1363 }

1364 return 0

1365 }

1366

1367 proc bind_button3 {w cmd} {

1368 bind $w <Any-Button-3> $cmd

1369 if {[is_MacOSX]} {

1370 bind $w <Control-Button-1> $cmd

1371 }

1372 }

1373

1374 proc incr_font_size {font {amt 1}} {

1375 set sz [font configure $font -size]

1376 incr sz $amt

1377 font configure $font -size $sz

1378 font configure ${font}bold -size $sz

1379 }

1380

1381 proc hook_failed_popup {hook msg} {

1382 global gitdir appname

1383

1384 set w .hookfail

1385 toplevel $w

1386

1387 frame $w.m

1388 label $w.m.l1 -text "$hook hook failed:" \

1389 -anchor w \

1390 -justify left \

1391 -font font_uibold

1392 text $w.m.t \

1393 -background white -borderwidth 1 \

1394 -relief sunken \

1395 -width 80 -height 10 \

1396 -font font_diff \

1397 -yscrollcommand [list $w.m.sby set]

1398 label $w.m.l2 \

1399 -text {You must correct the above errors before committing.} \

1400 -anchor w \

1401 -justify left \

1402 -font font_uibold

1403 scrollbar $w.m.sby -command [list $w.m.t yview]

1404 pack $w.m.l1 -side top -fill x

1405 pack $w.m.l2 -side bottom -fill x

1406 pack $w.m.sby -side right -fill y

1407 pack $w.m.t -side left -fill both -expand 1

1408 pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10

1409

1410 $w.m.t insert 1.0 $msg

1411 $w.m.t conf -state disabled

1412

1413 button $w.ok -text OK \

1414 -width 15 \

1415 -font font_ui \

1416 -command "destroy $w"

1417 pack $w.ok -side bottom

1418

1419 bind $w <Visibility> "grab $w; focus $w"

1420 bind $w <Key-Return> "destroy $w"

1421 wm title $w "$appname ([lindex [file split \

1422 [file normalize [file dirname $gitdir]]] \

1423 end]): error"

1424 tkwait window $w

1425 }

1426

1427 set next_console_id 0

1428

1429 proc new_console {short_title long_title} {

1430 global next_console_id console_data

1431 set w .console[incr next_console_id]

1432 set console_data($w) [list $short_title $long_title]

1433 return [console_init $w]

1434 }

1435

1436 proc console_init {w} {

1437 global console_cr console_data

1438 global gitdir appname M1B

1439

1440 set console_cr($w) 1.0

1441 toplevel $w

1442 frame $w.m

1443 label $w.m.l1 -text "[lindex $console_data($w) 1]:" \

1444 -anchor w \

1445 -justify left \

1446 -font font_uibold

1447 text $w.m.t \

1448 -background white -borderwidth 1 \

1449 -relief sunken \

1450 -width 80 -height 10 \

1451 -font font_diff \

1452 -state disabled \

1453 -yscrollcommand [list $w.m.sby set]

1454 label $w.m.s -anchor w \

1455 -justify left \

1456 -font font_uibold

1457 scrollbar $w.m.sby -command [list $w.m.t yview]

1458 pack $w.m.l1 -side top -fill x

1459 pack $w.m.s -side bottom -fill x

1460 pack $w.m.sby -side right -fill y

1461 pack $w.m.t -side left -fill both -expand 1

1462 pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10

1463

1464 menu $w.ctxm -tearoff 0

1465 $w.ctxm add command -label "Copy" \

1466 -font font_ui \

1467 -command "tk_textCopy $w.m.t"

1468 $w.ctxm add command -label "Select All" \

1469 -font font_ui \

1470 -command "$w.m.t tag add sel 0.0 end"

1471 $w.ctxm add command -label "Copy All" \

1472 -font font_ui \

1473 -command "

1474 $w.m.t tag add sel 0.0 end

1475 tk_textCopy $w.m.t

1476 $w.m.t tag remove sel 0.0 end

1477 "

1478

1479 button $w.ok -text {Running...} \

1480 -width 15 \

1481 -font font_ui \

1482 -state disabled \

1483 -command "destroy $w"

1484 pack $w.ok -side bottom

1485

1486 bind_button3 $w.m.t "tk_popup $w.ctxm %X %Y"

1487 bind $w.m.t <$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"

1488 bind $w.m.t <$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"

1489 bind $w <Visibility> "focus $w"

1490 wm title $w "$appname ([lindex [file split \

1491 [file normalize [file dirname $gitdir]]] \

1492 end]): [lindex $console_data($w) 0]"

1493 return $w

1494 }

1495

1496 proc console_exec {w cmd {after {}}} {

1497 global tcl_platform

1498

1499 # -- Windows tosses the enviroment when we exec our child.

1500 # But most users need that so we have to relogin. :-(

1501 #

1502 if {$tcl_platform(platform) == {windows}} {

1503 set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"]

1504 }

1505

1506 # -- Tcl won't let us redirect both stdout and stderr to

1507 # the same pipe. So pass it through cat...

1508 #

1509 set cmd [concat | $cmd |& cat]

1510

1511 set fd_f [open $cmd r]

1512 fconfigure $fd_f -blocking 0 -translation binary

1513 fileevent $fd_f readable [list console_read $w $fd_f $after]

1514 }

1515

1516 proc console_read {w fd after} {

1517 global console_cr console_data

1518

1519 set buf [read $fd]

1520 if {$buf != {}} {

1521 if {![winfo exists $w]} {console_init $w}

1522 $w.m.t conf -state normal

1523 set c 0

1524 set n [string length $buf]

1525 while {$c < $n} {

1526 set cr [string first "\r" $buf $c]

1527 set lf [string first "\n" $buf $c]

1528 if {$cr < 0} {set cr [expr $n + 1]}

1529 if {$lf < 0} {set lf [expr $n + 1]}

1530

1531 if {$lf < $cr} {

1532 $w.m.t insert end [string range $buf $c $lf]

1533 set console_cr($w) [$w.m.t index {end -1c}]

1534 set c $lf

1535 incr c

1536 } else {

1537 $w.m.t delete $console_cr($w) end

1538 $w.m.t insert end "\n"

1539 $w.m.t insert end [string range $buf $c $cr]

1540 set c $cr

1541 incr c

1542 }

1543 }

1544 $w.m.t conf -state disabled

1545 $w.m.t see end

1546 }

1547

1548 fconfigure $fd -blocking 1

1549 if {[eof $fd]} {

1550 if {[catch {close $fd}]} {

1551 if {![winfo exists $w]} {console_init $w}

1552 $w.m.s conf -background red -text {Error: Command Failed}

1553 $w.ok conf -text Close

1554 $w.ok conf -state normal

1555 set ok 0

1556 } elseif {[winfo exists $w]} {

1557 $w.m.s conf -background green -text {Success}

1558 $w.ok conf -text Close

1559 $w.ok conf -state normal

1560 set ok 1

1561 }

1562 array unset console_cr $w

1563 array unset console_data $w

1564 if {$after != {}} {

1565 uplevel #0 $after $ok

1566 }

1567 return

1568 }

1569 fconfigure $fd -blocking 0

1570 }

1571

1572 ######################################################################

1573 ##

1574 ## ui commands

1575

1576 set starting_gitk_msg {Please wait... Starting gitk...}

1577

1578 proc do_gitk {} {

1579 global tcl_platform ui_status_value starting_gitk_msg

1580

1581 set ui_status_value $starting_gitk_msg

1582 after 10000 {

1583 if {$ui_status_value == $starting_gitk_msg} {

1584 set ui_status_value {Ready.}

1585 }

1586 }

1587

1588 if {$tcl_platform(platform) == {windows}} {

1589 exec sh -c gitk &

1590 } else {

1591 exec gitk &

1592 }

1593 }

1594

1595 proc do_repack {} {

1596 set w [new_console "repack" "Repacking the object database"]

1597 set cmd [list git repack]

1598 lappend cmd -a

1599 lappend cmd -d

1600 console_exec $w $cmd

1601 }

1602

1603 set is_quitting 0

1604

1605 proc do_quit {} {

1606 global gitdir ui_comm is_quitting repo_config

1607

1608 if {$is_quitting} return

1609 set is_quitting 1

1610

1611 # -- Stash our current commit buffer.

1612 #

1613 set save [file join $gitdir GITGUI_MSG]

1614 set msg [string trim [$ui_comm get 0.0 end]]

1615 if {[$ui_comm edit modified] && $msg != {}} {

1616 catch {

1617 set fd [open $save w]

1618 puts $fd [string trim [$ui_comm get 0.0 end]]

1619 close $fd

1620 }

1621 } elseif {$msg == {} && [file exists $save]} {

1622 file delete $save

1623 }

1624

1625 # -- Stash our current window geometry into this repository.

1626 #

1627 set cfg_geometry [list]

1628 lappend cfg_geometry [wm geometry .]

1629 lappend cfg_geometry [lindex [.vpane sash coord 0] 1]

1630 lappend cfg_geometry [lindex [.vpane.files sash coord 0] 0]

1631 if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {

1632 set rc_geometry {}

1633 }

1634 if {$cfg_geometry != $rc_geometry} {

1635 catch {exec git repo-config gui.geometry $cfg_geometry}

1636 }

1637

1638 destroy .

1639 }

1640

1641 proc do_rescan {} {

1642 update_status

1643 }

1644

1645 proc do_include_all {} {

1646 global file_states

1647

1648 if {![lock_index begin-update]} return

1649

1650 set pathList [list]

1651 foreach path [array names file_states] {

1652 set s $file_states($path)

1653 set m [lindex $s 0]

1654 switch -- $m {

1655 AM -

1656 MM -

1657 _M -

1658 _D {lappend pathList $path}

1659 }

1660 }

1661 if {$pathList == {}} {

1662 unlock_index

1663 } else {

1664 update_index $pathList

1665 }

1666 }

1667

1668 set GIT_COMMITTER_IDENT {}

1669

1670 proc do_signoff {} {

1671 global ui_comm GIT_COMMITTER_IDENT

1672

1673 if {$GIT_COMMITTER_IDENT == {}} {

1674 if {[catch {set me [exec git var GIT_COMMITTER_IDENT]} err]} {

1675 error_popup "Unable to obtain your identity:\n\n$err"

1676 return

1677 }

1678 if {![regexp {^(.*) [0-9]+ [-+0-9]+$} \

1679 $me me GIT_COMMITTER_IDENT]} {

1680 error_popup "Invalid GIT_COMMITTER_IDENT:\n\n$me"

1681 return

1682 }

1683 }

1684

1685 set sob "Signed-off-by: $GIT_COMMITTER_IDENT"

1686 set last [$ui_comm get {end -1c linestart} {end -1c}]

1687 if {$last != $sob} {

1688 $ui_comm edit separator

1689 if {$last != {}

1690 && ![regexp {^[A-Z][A-Za-z]*-[A-Za-z-]+: *} $last]} {

1691 $ui_comm insert end "\n"

1692 }

1693 $ui_comm insert end "\n$sob"

1694 $ui_comm edit separator

1695 $ui_comm see end

1696 }

1697 }

1698

1699 proc do_amend_last {} {

1700 load_last_commit

1701 }

1702

1703 proc do_commit {} {

1704 commit_tree

1705 }

1706

1707 proc do_options {} {

1708 global appname gitdir font_descs

1709 global repo_config global_config

1710 global repo_config_new global_config_new

1711

1712 load_config

1713 array unset repo_config_new

1714 array unset global_config_new

1715 foreach name [array names repo_config] {

1716 set repo_config_new($name) $repo_config($name)

1717 }

1718 foreach name [array names global_config] {

1719 set global_config_new($name) $global_config($name)

1720 }

1721 set reponame [lindex [file split \

1722 [file normalize [file dirname $gitdir]]] \

1723 end]

1724

1725 set w .options_editor

1726 toplevel $w

1727 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"

1728

1729 label $w.header -text "$appname Options" \

1730 -font font_uibold

1731 pack $w.header -side top -fill x

1732

1733 frame $w.buttons

1734 button $w.buttons.restore -text {Restore Defaults} \

1735 -font font_ui \

1736 -command do_restore_defaults

1737 pack $w.buttons.restore -side left

1738 button $w.buttons.save -text Save \

1739 -font font_ui \

1740 -command [list do_save_config $w]

1741 pack $w.buttons.save -side right

1742 button $w.buttons.cancel -text {Cancel} \

1743 -font font_ui \

1744 -command [list destroy $w]

1745 pack $w.buttons.cancel -side right

1746 pack $w.buttons -side bottom -fill x -pady 10 -padx 10

1747

1748 labelframe $w.repo -text "$reponame Repository" \

1749 -font font_ui \

1750 -relief raised -borderwidth 2

1751 labelframe $w.global -text {Global (All Repositories)} \

1752 -font font_ui \

1753 -relief raised -borderwidth 2

1754 pack $w.repo -side left -fill both -expand 1 -pady 5 -padx 5

1755 pack $w.global -side right -fill both -expand 1 -pady 5 -padx 5

1756

1757 foreach option {

1758 {trustmtime {Trust File Modification Timestamps}}

1759 } {

1760 set name [lindex $option 0]

1761 set text [lindex $option 1]

1762 foreach f {repo global} {

1763 checkbutton $w.$f.$name -text $text \

1764 -variable ${f}_config_new(gui.$name) \

1765 -onvalue true \

1766 -offvalue false \

1767 -font font_ui

1768 pack $w.$f.$name -side top -anchor w

1769 }

1770 }

1771

1772 set all_fonts [lsort [font families]]

1773 foreach option $font_descs {

1774 set name [lindex $option 0]

1775 set font [lindex $option 1]

1776 set text [lindex $option 2]

1777

1778 set global_config_new(gui.$font^^family) \

1779 [font configure $font -family]

1780 set global_config_new(gui.$font^^size) \

1781 [font configure $font -size]

1782

1783 frame $w.global.$name

1784 label $w.global.$name.l -text "$text:" -font font_ui

1785 pack $w.global.$name.l -side left -anchor w -fill x

1786 eval tk_optionMenu $w.global.$name.family \

1787 global_config_new(gui.$font^^family) \

1788 $all_fonts

1789 spinbox $w.global.$name.size \

1790 -textvariable global_config_new(gui.$font^^size) \

1791 -from 2 -to 80 -increment 1 \

1792 -width 3 \

1793 -font font_ui

1794 pack $w.global.$name.size -side right -anchor e

1795 pack $w.global.$name.family -side right -anchor e

1796 pack $w.global.$name -side top -anchor w -fill x

1797 }

1798

1799 bind $w <Visibility> "grab $w; focus $w"

1800 bind $w <Key-Escape> "destroy $w"

1801 wm title $w "$appname ($reponame): Options"

1802 tkwait window $w

1803 }

1804

1805 proc do_restore_defaults {} {

1806 global font_descs default_config

1807 global repo_config_new global_config_new

1808

1809 foreach name [array names default_config] {

1810 set repo_config_new($name) $default_config($name)

1811 set global_config_new($name) $default_config($name)

1812 }

1813

1814 foreach option $font_descs {

1815 set name [lindex $option 0]

1816 set repo_config($name) $default_config(gui.$name)

1817 }

1818 apply_config

1819

1820 foreach option $font_descs {

1821 set name [lindex $option 0]

1822 set font [lindex $option 1]

1823 set global_config_new(gui.$font^^family) \

1824 [font configure $font -family]

1825 set global_config_new(gui.$font^^size) \

1826 [font configure $font -size]

1827 }

1828 }

1829

1830 proc do_save_config {w} {

1831 if {[catch {save_config} err]} {

1832 error_popup "Failed to completely save options:\n\n$err"

1833 }

1834 destroy $w

1835 }

1836

1837 # shift == 1: left click

1838 # 3: right click

1839 proc click {w x y shift wx wy} {

1840 global ui_index ui_other file_lists

1841

1842 set pos [split [$w index @$x,$y] .]

1843 set lno [lindex $pos 0]

1844 set col [lindex $pos 1]

1845 set path [lindex $file_lists($w) [expr $lno - 1]]

1846 if {$path == {}} return

1847

1848 if {$col > 0 && $shift == 1} {

1849 show_diff $path $w $lno

1850 }

1851 }

1852

1853 proc unclick {w x y} {

1854 global file_lists

1855

1856 set pos [split [$w index @$x,$y] .]

1857 set lno [lindex $pos 0]

1858 set col [lindex $pos 1]

1859 set path [lindex $file_lists($w) [expr $lno - 1]]

1860 if {$path == {}} return

1861

1862 if {$col == 0} {

1863 update_index [list $path]

1864 }

1865 }

1866

1867 ######################################################################

1868 ##

1869 ## config defaults

1870

1871 set cursor_ptr arrow

1872 font create font_diff -family Courier -size 10

1873 font create font_ui

1874 catch {

1875 label .dummy

1876 eval font configure font_ui [font actual [.dummy cget -font]]

1877 destroy .dummy

1878 }

1879

1880 font create font_uibold

1881 font create font_diffbold

1882

1883 set M1B M1

1884 set M1T M1

1885 if {$tcl_platform(platform) == {windows}} {

1886 set M1B Control

1887 set M1T Ctrl

1888 } elseif {[is_MacOSX]} {

1889 set M1B M1

1890 set M1T Cmd

1891 }

1892

1893 proc apply_config {} {

1894 global repo_config font_descs

1895

1896 foreach option $font_descs {

1897 set name [lindex $option 0]

1898 set font [lindex $option 1]

1899 if {[catch {

1900 foreach {cn cv} $repo_config(gui.$name) {

1901 font configure $font $cn $cv

1902 }

1903 } err]} {

1904 error_popup "Invalid font specified in gui.$name:\n\n$err"

1905 }

1906 foreach {cn cv} [font configure $font] {

1907 font configure ${font}bold $cn $cv

1908 }

1909 font configure ${font}bold -weight bold

1910 }

1911 }

1912

1913 set default_config(gui.trustmtime) false

1914 set default_config(gui.fontui) [font configure font_ui]

1915 set default_config(gui.fontdiff) [font configure font_diff]

1916 set font_descs {

1917 {fontui font_ui {Main Font}}

1918 {fontdiff font_diff {Diff/Console Font}}

1919 }

1920 load_config

1921 apply_config

1922

1923 ######################################################################

1924 ##

1925 ## ui construction

1926

1927 # -- Menu Bar

1928 menu .mbar -tearoff 0

1929 .mbar add cascade -label Project -menu .mbar.project

1930 .mbar add cascade -label Edit -menu .mbar.edit

1931 .mbar add cascade -label Commit -menu .mbar.commit

1932 .mbar add cascade -label Fetch -menu .mbar.fetch

1933 .mbar add cascade -label Pull -menu .mbar.pull

1934 .mbar add cascade -label Push -menu .mbar.push

1935 . configure -menu .mbar

1936

1937 # -- Project Menu

1938 menu .mbar.project

1939 .mbar.project add command -label Visualize \

1940 -command do_gitk \

1941 -font font_ui

1942 .mbar.project add command -label {Repack Database} \

1943 -command do_repack \

1944 -font font_ui

1945 .mbar.project add command -label Quit \

1946 -command do_quit \

1947 -accelerator $M1T-Q \

1948 -font font_ui

1949

1950 # -- Edit Menu

1951 #

1952 menu .mbar.edit

1953 .mbar.edit add command -label Undo \

1954 -command {catch {[focus] edit undo}} \

1955 -accelerator $M1T-Z \

1956 -font font_ui

1957 .mbar.edit add command -label Redo \

1958 -command {catch {[focus] edit redo}} \

1959 -accelerator $M1T-Y \

1960 -font font_ui

1961 .mbar.edit add separator

1962 .mbar.edit add command -label Cut \

1963 -command {catch {tk_textCut [focus]}} \

1964 -accelerator $M1T-X \

1965 -font font_ui

1966 .mbar.edit add command -label Copy \

1967 -command {catch {tk_textCopy [focus]}} \

1968 -accelerator $M1T-C \

1969 -font font_ui

1970 .mbar.edit add command -label Paste \

1971 -command {catch {tk_textPaste [focus]; [focus] see insert}} \

1972 -accelerator $M1T-V \

1973 -font font_ui

1974 .mbar.edit add command -label Delete \

1975 -command {catch {[focus] delete sel.first sel.last}} \

1976 -accelerator Del \

1977 -font font_ui

1978 .mbar.edit add separator

1979 .mbar.edit add command -label {Select All} \

1980 -command {catch {[focus] tag add sel 0.0 end}} \

1981 -accelerator $M1T-A \

1982 -font font_ui

1983 .mbar.edit add separator

1984 .mbar.edit add command -label {Options...} \

1985 -command do_options \

1986 -font font_ui

1987

1988 # -- Commit Menu

1989 menu .mbar.commit

1990 .mbar.commit add command -label Rescan \

1991 -command do_rescan \

1992 -accelerator F5 \

1993 -font font_ui

1994 lappend disable_on_lock \

1995 [list .mbar.commit entryconf [.mbar.commit index last] -state]

1996 .mbar.commit add command -label {Amend Last Commit} \

1997 -command do_amend_last \

1998 -font font_ui

1999 lappend disable_on_lock \

2000 [list .mbar.commit entryconf [.mbar.commit index last] -state]

2001 .mbar.commit add command -label {Include All Files} \

2002 -command do_include_all \

2003 -accelerator $M1T-I \

2004 -font font_ui

2005 lappend disable_on_lock \

2006 [list .mbar.commit entryconf [.mbar.commit index last] -state]

2007 .mbar.commit add command -label {Sign Off} \

2008 -command do_signoff \

2009 -accelerator $M1T-S \

2010 -font font_ui

2011 .mbar.commit add command -label Commit \

2012 -command do_commit \

2013 -accelerator $M1T-Return \

2014 -font font_ui

2015 lappend disable_on_lock \

2016 [list .mbar.commit entryconf [.mbar.commit index last] -state]

2017

2018 # -- Fetch Menu

2019 menu .mbar.fetch

2020

2021 # -- Pull Menu

2022 menu .mbar.pull

2023

2024 # -- Push Menu

2025 menu .mbar.push

2026

2027 # -- Main Window Layout

2028 panedwindow .vpane -orient vertical

2029 panedwindow .vpane.files -orient horizontal

2030 .vpane add .vpane.files -sticky nsew -height 100 -width 400

2031 pack .vpane -anchor n -side top -fill both -expand 1

2032

2033 # -- Index File List

2034 frame .vpane.files.index -height 100 -width 400

2035 label .vpane.files.index.title -text {Modified Files} \

2036 -background green \

2037 -font font_ui

2038 text $ui_index -background white -borderwidth 0 \

2039 -width 40 -height 10 \

2040 -font font_ui \

2041 -cursor $cursor_ptr \

2042 -yscrollcommand {.vpane.files.index.sb set} \

2043 -state disabled

2044 scrollbar .vpane.files.index.sb -command [list $ui_index yview]

2045 pack .vpane.files.index.title -side top -fill x

2046 pack .vpane.files.index.sb -side right -fill y

2047 pack $ui_index -side left -fill both -expand 1

2048 .vpane.files add .vpane.files.index -sticky nsew

2049

2050 # -- Other (Add) File List

2051 frame .vpane.files.other -height 100 -width 100

2052 label .vpane.files.other.title -text {Untracked Files} \

2053 -background red \

2054 -font font_ui

2055 text $ui_other -background white -borderwidth 0 \

2056 -width 40 -height 10 \

2057 -font font_ui \

2058 -cursor $cursor_ptr \

2059 -yscrollcommand {.vpane.files.other.sb set} \

2060 -state disabled

2061 scrollbar .vpane.files.other.sb -command [list $ui_other yview]

2062 pack .vpane.files.other.title -side top -fill x

2063 pack .vpane.files.other.sb -side right -fill y

2064 pack $ui_other -side left -fill both -expand 1

2065 .vpane.files add .vpane.files.other -sticky nsew

2066

2067 $ui_index tag conf in_diff -font font_uibold

2068 $ui_other tag conf in_diff -font font_uibold

2069

2070 # -- Diff and Commit Area

2071 frame .vpane.lower -height 300 -width 400

2072 frame .vpane.lower.commarea

2073 frame .vpane.lower.diff -relief sunken -borderwidth 1

2074 pack .vpane.lower.commarea -side top -fill x

2075 pack .vpane.lower.diff -side bottom -fill both -expand 1

2076 .vpane add .vpane.lower -stick nsew

2077

2078 # -- Commit Area Buttons

2079 frame .vpane.lower.commarea.buttons

2080 label .vpane.lower.commarea.buttons.l -text {} \

2081 -anchor w \

2082 -justify left \

2083 -font font_ui

2084 pack .vpane.lower.commarea.buttons.l -side top -fill x

2085 pack .vpane.lower.commarea.buttons -side left -fill y

2086

2087 button .vpane.lower.commarea.buttons.rescan -text {Rescan} \

2088 -command do_rescan \

2089 -font font_ui

2090 pack .vpane.lower.commarea.buttons.rescan -side top -fill x

2091 lappend disable_on_lock \

2092 {.vpane.lower.commarea.buttons.rescan conf -state}

2093

2094 button .vpane.lower.commarea.buttons.amend -text {Amend Last} \

2095 -command do_amend_last \

2096 -font font_ui

2097 pack .vpane.lower.commarea.buttons.amend -side top -fill x

2098 lappend disable_on_lock \

2099 {.vpane.lower.commarea.buttons.amend conf -state}

2100

2101 button .vpane.lower.commarea.buttons.incall -text {Include All} \

2102 -command do_include_all \

2103 -font font_ui

2104 pack .vpane.lower.commarea.buttons.incall -side top -fill x

2105 lappend disable_on_lock \

2106 {.vpane.lower.commarea.buttons.incall conf -state}

2107

2108 button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \

2109 -command do_signoff \

2110 -font font_ui

2111 pack .vpane.lower.commarea.buttons.signoff -side top -fill x

2112

2113 button .vpane.lower.commarea.buttons.commit -text {Commit} \

2114 -command do_commit \

2115 -font font_ui

2116 pack .vpane.lower.commarea.buttons.commit -side top -fill x

2117 lappend disable_on_lock \

2118 {.vpane.lower.commarea.buttons.commit conf -state}

2119

2120 # -- Commit Message Buffer

2121 frame .vpane.lower.commarea.buffer

2122 set ui_comm .vpane.lower.commarea.buffer.t

2123 set ui_coml .vpane.lower.commarea.buffer.l

2124 label $ui_coml -text {Commit Message:} \

2125 -anchor w \

2126 -justify left \

2127 -font font_ui

2128 trace add variable commit_type write {uplevel #0 {

2129 switch -glob $commit_type \

2130 initial {$ui_coml conf -text {Initial Commit Message:}} \

2131 amend {$ui_coml conf -text {Amended Commit Message:}} \

2132 merge {$ui_coml conf -text {Merge Commit Message:}} \

2133 * {$ui_coml conf -text {Commit Message:}}

2134 }}

2135 text $ui_comm -background white -borderwidth 1 \

2136 -undo true \

2137 -maxundo 20 \

2138 -autoseparators true \

2139 -relief sunken \

2140 -width 75 -height 9 -wrap none \

2141 -font font_diff \

2142 -yscrollcommand {.vpane.lower.commarea.buffer.sby set}

2143 scrollbar .vpane.lower.commarea.buffer.sby \

2144 -command [list $ui_comm yview]

2145 pack $ui_coml -side top -fill x

2146 pack .vpane.lower.commarea.buffer.sby -side right -fill y

2147 pack $ui_comm -side left -fill y

2148 pack .vpane.lower.commarea.buffer -side left -fill y

2149

2150 # -- Commit Message Buffer Context Menu

2151 #

2152 menu $ui_comm.ctxm -tearoff 0

2153 $ui_comm.ctxm add command -label "Cut" \

2154 -font font_ui \

2155 -command "tk_textCut $ui_comm"

2156 $ui_comm.ctxm add command -label "Copy" \

2157 -font font_ui \

2158 -command "tk_textCopy $ui_comm"

2159 $ui_comm.ctxm add command -label "Paste" \

2160 -font font_ui \

2161 -command "tk_textPaste $ui_comm"

2162 $ui_comm.ctxm add command -label "Delete" \

2163 -font font_ui \

2164 -command "$ui_comm delete sel.first sel.last"

2165 $ui_comm.ctxm add separator

2166 $ui_comm.ctxm add command -label "Select All" \

2167 -font font_ui \

2168 -command "$ui_comm tag add sel 0.0 end"

2169 $ui_comm.ctxm add command -label "Copy All" \

2170 -font font_ui \

2171 -command "

2172 $ui_comm tag add sel 0.0 end

2173 tk_textCopy $ui_comm

2174 $ui_comm tag remove sel 0.0 end

2175 "

2176 $ui_comm.ctxm add separator

2177 $ui_comm.ctxm add command -label "Sign Off" \

2178 -font font_ui \

2179 -command do_signoff

2180 bind_button3 $ui_comm "tk_popup $ui_comm.ctxm %X %Y"

2181

2182 # -- Diff Header

2183 set ui_fname_value {}

2184 set ui_fstatus_value {}

2185 frame .vpane.lower.diff.header -background orange

2186 label .vpane.lower.diff.header.l1 -text {File:} \

2187 -background orange \

2188 -font font_ui

2189 label .vpane.lower.diff.header.l2 -textvariable ui_fname_value \

2190 -background orange \

2191 -anchor w \

2192 -justify left \

2193 -font font_ui

2194 label .vpane.lower.diff.header.l3 -text {Status:} \

2195 -background orange \

2196 -font font_ui

2197 label .vpane.lower.diff.header.l4 -textvariable ui_fstatus_value \

2198 -background orange \

2199 -width $max_status_desc \

2200 -anchor w \

2201 -justify left \

2202 -font font_ui

2203 pack .vpane.lower.diff.header.l1 -side left

2204 pack .vpane.lower.diff.header.l2 -side left -fill x

2205 pack .vpane.lower.diff.header.l4 -side right

2206 pack .vpane.lower.diff.header.l3 -side right

2207

2208 # -- Diff Body

2209 frame .vpane.lower.diff.body

2210 set ui_diff .vpane.lower.diff.body.t

2211 text $ui_diff -background white -borderwidth 0 \

2212 -width 80 -height 15 -wrap none \

2213 -font font_diff \

2214 -xscrollcommand {.vpane.lower.diff.body.sbx set} \

2215 -yscrollcommand {.vpane.lower.diff.body.sby set} \

2216 -state disabled

2217 scrollbar .vpane.lower.diff.body.sbx -orient horizontal \

2218 -command [list $ui_diff xview]

2219 scrollbar .vpane.lower.diff.body.sby -orient vertical \

2220 -command [list $ui_diff yview]

2221 pack .vpane.lower.diff.body.sbx -side bottom -fill x

2222 pack .vpane.lower.diff.body.sby -side right -fill y

2223 pack $ui_diff -side left -fill both -expand 1

2224 pack .vpane.lower.diff.header -side top -fill x

2225 pack .vpane.lower.diff.body -side bottom -fill both -expand 1

2226

2227 $ui_diff tag conf dm -foreground red

2228 $ui_diff tag conf dp -foreground blue

2229 $ui_diff tag conf di -foreground {#00a000}

2230 $ui_diff tag conf dni -foreground {#a000a0}

2231 $ui_diff tag conf da -font font_diffbold

2232 $ui_diff tag conf bold -font font_diffbold

2233

2234 # -- Diff Body Context Menu

2235 #

2236 menu $ui_diff.ctxm -tearoff 0

2237 $ui_diff.ctxm add command -label "Copy" \

2238 -font font_ui \

2239 -command "tk_textCopy $ui_diff"

2240 $ui_diff.ctxm add command -label "Select All" \

2241 -font font_ui \

2242 -command "$ui_diff tag add sel 0.0 end"

2243 $ui_diff.ctxm add command -label "Copy All" \

2244 -font font_ui \

2245 -command "

2246 $ui_diff tag add sel 0.0 end

2247 tk_textCopy $ui_diff

2248 $ui_diff tag remove sel 0.0 end

2249 "

2250 $ui_diff.ctxm add separator

2251 $ui_diff.ctxm add command -label "Decrease Font Size" \

2252 -font font_ui \

2253 -command {incr_font_size font_diff -1}

2254 $ui_diff.ctxm add command -label "Increase Font Size" \

2255 -font font_ui \

2256 -command {incr_font_size font_diff 1}

2257 $ui_diff.ctxm add command -label {Options...} \

2258 -font font_ui \

2259 -command do_options

2260 bind_button3 $ui_diff "tk_popup $ui_diff.ctxm %X %Y"

2261

2262 # -- Status Bar

2263 set ui_status_value {Initializing...}

2264 label .status -textvariable ui_status_value \

2265 -anchor w \

2266 -justify left \

2267 -borderwidth 1 \

2268 -relief sunken \

2269 -font font_ui

2270 pack .status -anchor w -side bottom -fill x

2271

2272 # -- Load geometry

2273 catch {

2274 set gm $repo_config(gui.geometry)

2275 wm geometry . [lindex $gm 0]

2276 .vpane sash place 0 \

2277 [lindex [.vpane sash coord 0] 0] \

2278 [lindex $gm 1]

2279 .vpane.files sash place 0 \

2280 [lindex $gm 2] \

2281 [lindex [.vpane.files sash coord 0] 1]

2282 unset gm

2283 }

2284

2285 # -- Key Bindings

2286 bind $ui_comm <$M1B-Key-Return> {do_commit;break}

2287 bind $ui_comm <$M1B-Key-i> {do_include_all;break}

2288 bind $ui_comm <$M1B-Key-I> {do_include_all;break}

2289 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}

2290 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}

2291 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}

2292 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}

2293 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}

2294 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}

2295 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}

2296 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}

2297

2298 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}

2299 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}

2300 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}

2301 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}

2302 bind $ui_diff <$M1B-Key-v> {break}

2303 bind $ui_diff <$M1B-Key-V> {break}

2304 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}

2305 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}

2306 bind $ui_diff <Key-Up> {catch {%W yview scroll -1 units};break}

2307 bind $ui_diff <Key-Down> {catch {%W yview scroll 1 units};break}

2308 bind $ui_diff <Key-Left> {catch {%W xview scroll -1 units};break}

2309 bind $ui_diff <Key-Right> {catch {%W xview scroll 1 units};break}

2310

2311 bind . <Destroy> do_quit

2312 bind all <Key-F5> do_rescan

2313 bind all <$M1B-Key-r> do_rescan

2314 bind all <$M1B-Key-R> do_rescan

2315 bind . <$M1B-Key-s> do_signoff

2316 bind . <$M1B-Key-S> do_signoff

2317 bind . <$M1B-Key-i> do_include_all

2318 bind . <$M1B-Key-I> do_include_all

2319 bind . <$M1B-Key-Return> do_commit

2320 bind all <$M1B-Key-q> do_quit

2321 bind all <$M1B-Key-Q> do_quit

2322 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}

2323 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}

2324 foreach i [list $ui_index $ui_other] {

2325 bind $i <Button-1> {click %W %x %y 1 %X %Y; break}

2326 bind $i <ButtonRelease-1> {unclick %W %x %y; break}

2327 bind_button3 $i {click %W %x %y 3 %X %Y; break}

2328 }

2329 unset i

2330

2331 set file_lists($ui_index) [list]

2332 set file_lists($ui_other) [list]

2333

2334 wm title . "$appname ([file normalize [file dirname $gitdir]])"

2335 focus -force $ui_comm

2336 load_all_remotes

2337 populate_remote_menu .mbar.fetch From fetch_from

2338 populate_remote_menu .mbar.push To push_to

2339 populate_pull_menu .mbar.pull

2340 after 1 update_status