Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
Comment: | Bug fix in close handling. Multiple windows implemented. Separate and align diffs use extra window. Some polish in font and colour dialogs. Moved out help text to a file. Polished help dialogs. |
---|---|
Downloads: | Tarball | ZIP archive |
Timelines: | family | ancestors | descendants | both | trunk |
Files: | files | file ages | folders |
SHA1: |
2e45dd270f866de1f8a894a3afd3154d |
User & Date: | peter 2003-08-20 20:20:35.000 |
Context
2003-08-20
| ||
20:39 | Code cleanup. No lower case procs. check-in: 24888431ce user: peter tags: trunk | |
20:20 | Bug fix in close handling. Multiple windows implemented. Separate and align diffs use extra window. Some polish in font and colour dialogs. Moved out help text to a file. Polished help dialogs. check-in: 2e45dd270f user: peter tags: trunk | |
18:41 | Initial revision check-in: f681dbe2db user: peter tags: trunk | |
Changes
Changes to src/eskil.tcl.
︙ | ︙ | |||
12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 | #---------------------------------------------------------------------- # $Revision$ #---------------------------------------------------------------------- # the next line restarts using wish \ exec wish "$0" "$@" package provide app-diff 1.0 package require Tk catch {package require textSearch} if {[catch {package require psballoon}]} { # Add a dummy if it does not exists. proc addBalloon {args} {} } else { namespace import -force psballoon::addBalloon } set debug 1 | > | < < > | 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 | #---------------------------------------------------------------------- # $Revision$ #---------------------------------------------------------------------- # the next line restarts using wish \ exec wish "$0" "$@" package provide app-diff 1.0 package require Tcl 8.3 package require Tk catch {package require textSearch} if {[catch {package require psballoon}]} { # Add a dummy if it does not exists. proc addBalloon {args} {} } else { namespace import -force psballoon::addBalloon } set debug 1 set diffver "Version 1.9.8+ 2003-08-20" set thisscript [file join [pwd] [info script]] set thisdir [file dirname $thisscript] set ::diff(cvsExists) [expr {![string equal [auto_execok cvs] ""]}] set ::diff(diffexe) diff set ::diff(thisexe) [list [info nameofexecutable] $thisscript] # Experimenting with DiffUtil package set ::diff(diffutil) [expr {![catch {package require DiffUtil}]}] set ::diff(diffutil) 0 |
︙ | ︙ | |||
72 73 74 75 76 77 78 79 80 | set env(PATH) "$env(PATH);c:\\bin" auto_reset set ::diff(cvsExists) [expr {![string equal [auto_execok cvs] ""]}] } } proc cleanupAndExit {top} { if {[catch { if {$top != "all"} { | > > | | < > > | > > > > | | > | 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 | set env(PATH) "$env(PATH);c:\\bin" auto_reset set ::diff(cvsExists) [expr {![string equal [auto_execok cvs] ""]}] } } proc cleanupAndExit {top} { # A security thing to make sure we can exit. set cont 0 if {[catch { if {$top != "all"} { set i [lsearch $::diff(diffWindows) $top] if {$i >= 0} { set ::diff(diffWindows) [lreplace $::diff(diffWindows) $i $i] } destroy $top array unset ::diff $top,* # Any windows remaining? if {[llength $::diff(diffWindows)] > 0} { set cont 1 } } } errMsg]} { tk_messageBox -icon error -title "Diff Error" -message \ "An error occured in the close process.\n$errMsg\n\ (This is a bug)\nTerminating application." -type ok } if {$cont} return if {$::diff(diffexe) != "diff"} { catch {file delete $::diff(diffexe)} } cleartmp exit } # Format a line number proc myforml {lineNo} { if {![string is integer -strict $lineNo]} {return "$lineNo\n"} return [format "%3d: \n" $lineNo] } proc maxabs {a b} { return [expr {abs($a) > abs($b) ? $a : $b}] } proc tmpfile {} { if {[info exists ::tmpcnt]} { incr ::tmpcnt } else { set ::tmpcnt 0 } set name [file join $::diff(tmpdir) "tmpd[pid]a$::tmpcnt"] lappend ::tmpfiles $name return $name } proc cleartmp {} { if {[info exists ::tmpfiles]} { foreach f $::tmpfiles { catch {file delete $f} } } set ::tmpfiles {} } # 2nd stage line parsing # Recursively look for common substrings in strings s1 and s2 # The strings are known to not have anything in common at start or end. |
︙ | ︙ | |||
1034 1035 1036 1037 1038 1039 1040 | update idletasks } # Clean up after a conflict diff. proc cleanupConflict {top} { global diff Pref | | | 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 | update idletasks } # Clean up after a conflict diff. proc cleanupConflict {top} { global diff Pref #cleartmp ;# FIXA set diff($top,rightFile) $diff($top,conflictFile) set diff($top,leftFile) $diff($top,conflictFile) } # Display one chunk from a patch file proc displayOnePatch {top leftLines rightLines leftLine rightLine} { emptyline $top 1 |
︙ | ︙ | |||
1375 1376 1377 1378 1379 1380 1381 | update idletasks } # Clean up after a RCS/CVS diff. proc cleanupRCS {top} { global diff Pref | | | 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 | update idletasks } # Clean up after a RCS/CVS diff. proc cleanupRCS {top} { global diff Pref #cleartmp ;# FIXA set diff($top,rightFile) $diff($top,RCSFile) set diff($top,leftFile) $diff($top,RCSFile) } # Prepare for a diff by creating needed temporary files proc prepareFiles {top} { if {$::diff($top,mode) == "RCS" || $::diff($top,mode) == "CVS"} { |
︙ | ︙ | |||
1582 1583 1584 1585 1586 1587 1588 | if {$diff($top,printFile) != ""} { after idle "doPrint $top 1 ; cleanupAndExit all" } } # This is the entrypoint to do a diff via DDE or Send proc remoteDiff {file1 file2} { | < < < < < < < < < < < < < < < < < < | | 1590 1591 1592 1593 1594 1595 1596 1597 1598 1599 1600 1601 1602 1603 1604 | if {$diff($top,printFile) != ""} { after idle "doPrint $top 1 ; cleanupAndExit all" } } # This is the entrypoint to do a diff via DDE or Send proc remoteDiff {file1 file2} { newDiff $file1 $file2 } ##################################### # Highlight and navigation stuff ##################################### # Scroll windows to next/previous diff |
︙ | ︙ | |||
2416 2417 2418 2419 2420 2421 2422 2423 2424 2425 2426 2427 2428 2429 | pack .pr.r1 .pr.r2 .pr.r3 .pr.r4 -in .pr.f -side left -fill x -expand 1 } ##################################### # GUI stuff ##################################### proc formatAlignPattern {p} { set raw [binary format I $p] binary scan $raw B* bin set bin [string trimleft [string range $bin 0 end-8] 0][string range $bin end-7 end] set pat [string map {0 . 1 ,} $bin] return $pat | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 2406 2407 2408 2409 2410 2411 2412 2413 2414 2415 2416 2417 2418 2419 2420 2421 2422 2423 2424 2425 2426 2427 2428 2429 2430 2431 2432 2433 2434 2435 2436 2437 2438 2439 2440 2441 2442 2443 2444 2445 2446 2447 2448 2449 2450 2451 2452 2453 2454 2455 2456 2457 2458 2459 2460 2461 2462 2463 2464 2465 2466 2467 | pack .pr.r1 .pr.r2 .pr.r3 .pr.r4 -in .pr.f -side left -fill x -expand 1 } ##################################### # GUI stuff ##################################### # A little helper to make a scrolled window # It returns the name of the scrolled window proc Scroll {dir class w args} { switch -- $dir { both { set scrollx 1 set scrolly 1 } x { set scrollx 1 set scrolly 0 } y { set scrollx 0 set scrolly 1 } default { return -code error "Bad scrolldirection \"$dir\"" } } frame $w eval [list $class $w.s] $args # Move border properties to frame set bw [$w.s cget -borderwidth] set relief [$w.s cget -relief] $w configure -relief $relief -borderwidth $bw $w.s configure -borderwidth 0 grid $w.s -sticky news if {$scrollx} { $w.s configure -xscrollcommand [list $w.sbx set] scrollbar $w.sbx -orient horizontal -command [list $w.s xview] grid $w.sbx -row 1 -sticky we } if {$scrolly} { $w.s configure -yscrollcommand [list $w.sby set] scrollbar $w.sby -orient vertical -command [list $w.s yview] grid $w.sby -row 0 -column 1 -sticky ns } grid columnconfigure $w 0 -weight 1 grid rowconfigure $w 0 -weight 1 return $w.s } proc formatAlignPattern {p} { set raw [binary format I $p] binary scan $raw B* bin set bin [string trimleft [string range $bin 0 end-8] 0][string range $bin end-7 end] set pat [string map {0 . 1 ,} $bin] return $pat |
︙ | ︙ | |||
2472 2473 2474 2475 2476 2477 2478 | } close $cho close $chi } # FIXA : detta tar bort tmpfiles cleanupFiles $top | | | 2510 2511 2512 2513 2514 2515 2516 2517 2518 2519 2520 2521 2522 2523 2524 | } close $cho close $chi } # FIXA : detta tar bort tmpfiles cleanupFiles $top newDiff $f(1) $f(2) set ::diff($top,aligns) "" } # Mark a line as aligned. proc markAlign {top n line text} { set ::diff($top,align$n) $line |
︙ | ︙ | |||
2554 2555 2556 2557 2558 2559 2560 | set ch [open $f1 w] puts $ch $::diff($top,separatetext1) close $ch set ch [open $f2 w] puts $ch $::diff($top,separatetext2) close $ch | | | 2592 2593 2594 2595 2596 2597 2598 2599 2600 2601 2602 2603 2604 2605 2606 | set ch [open $f1 w] puts $ch $::diff($top,separatetext1) close $ch set ch [open $f2 w] puts $ch $::diff($top,separatetext2) close $ch newDiff $f1 $f2 unset ::diff($top,separate1) unset ::diff($top,separate2) } } proc hlPopup {top n hl X Y x y} { |
︙ | ︙ | |||
2787 2788 2789 2790 2791 2792 2793 2794 2795 | set i [lsearch $args -textvariable] if {$i >= 0} { set var [lindex $args [expr {$i + 1}]] uplevel \#0 "trace variable $var w \ {after idle {$w xview end} ;#}" } } # Build the main window | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | > > > > | | | | | | | | | | > | | | | 2825 2826 2827 2828 2829 2830 2831 2832 2833 2834 2835 2836 2837 2838 2839 2840 2841 2842 2843 2844 2845 2846 2847 2848 2849 2850 2851 2852 2853 2854 2855 2856 2857 2858 2859 2860 2861 2862 2863 2864 2865 2866 2867 2868 2869 2870 2871 2872 2873 2874 2875 2876 2877 2878 2879 2880 2881 2882 2883 2884 2885 2886 2887 2888 2889 2890 2891 2892 2893 2894 2895 2896 | set i [lsearch $args -textvariable] if {$i >= 0} { set var [lindex $args [expr {$i + 1}]] uplevel \#0 "trace variable $var w \ {after idle {$w xview end} ;#}" } } # Fill in default data for a diff window proc initDiffData {top} { global diff set diff($top,leftOK) 0 set diff($top,rightOK) 0 set diff($top,mode) "" set diff($top,printFile) "" set diff($top,mergeFile) "" set diff($top,conflictFile) "" set diff($top,limitlines) 0 } # Create a new diff window and diff two files proc newDiff {file1 file2} { global diff makeDiffWin set top [lindex $::diff(diffWindows) end] set diff($top,leftDir) [file dirname $file1] set diff($top,leftFile) $file1 set diff($top,leftLabel) $file1 set diff($top,leftOK) 1 set diff($top,rightDir) [file dirname $file2] set diff($top,rightFile) $file2 set diff($top,rightLabel) $file2 set diff($top,rightOK) 1 set diff($top,mode) "" wm deiconify $top raise $top update doDiff $top } # Build the main window proc makeDiffWin {{top {}}} { global Pref tcl_platform debug if {$top != "" && [winfo exists $top] && [winfo toplevel $top] == $top} { # Reuse the old window eval destroy [winfo children $top] } else { # Locate a free toplevel name if {[info exists ::diff(topDiffCnt)]} { set t $::diff(topDiffCnt) } else { set t 0 } while {[winfo exists .diff$t]} { incr t } set top .diff$t toplevel $top lappend ::diff(diffWindows) $top } wm title $top "Diff" wm protocol $top WM_DELETE_WINDOW [list cleanupAndExit $top] frame $top.f grid $top.f -row 0 -columnspan 4 -sticky news menubutton $top.mf -text File -underline 0 -menu $top.mf.m |
︙ | ︙ | |||
2846 2847 2848 2849 2850 2851 2852 2853 2854 2855 2856 2857 2858 2859 | $top.mf.m add command -label "CVSDiff..." -underline 1 \ -command [list openCVS $top] } $top.mf.m add separator $top.mf.m add command -label "Print..." -underline 0 \ -command [list doPrint $top] $top.mf.m add separator $top.mf.m add command -label "Close" -underline 0 \ -command [list cleanupAndExit $top] $top.mf.m add separator $top.mf.m add command -label "Quit" -underline 0 \ -command {cleanupAndExit all} menubutton $top.mo -text "Options" -underline 0 -menu $top.mo.m | > > | 2924 2925 2926 2927 2928 2929 2930 2931 2932 2933 2934 2935 2936 2937 2938 2939 | $top.mf.m add command -label "CVSDiff..." -underline 1 \ -command [list openCVS $top] } $top.mf.m add separator $top.mf.m add command -label "Print..." -underline 0 \ -command [list doPrint $top] $top.mf.m add separator $top.mf.m add command -label "New Diff Window" -underline 0 \ -command makeDiffWin $top.mf.m add command -label "Close" -underline 0 \ -command [list cleanupAndExit $top] $top.mf.m add separator $top.mf.m add command -label "Quit" -underline 0 \ -command {cleanupAndExit all} menubutton $top.mo -text "Options" -underline 0 -menu $top.mo.m |
︙ | ︙ | |||
2911 2912 2913 2914 2915 2916 2917 | if {[info procs textSearch::searchMenu] != ""} { textSearch::searchMenu $top.ms.m } else { $top.ms.m add command -label "Text search not available" \ -state disabled } | | | | | 2991 2992 2993 2994 2995 2996 2997 2998 2999 3000 3001 3002 3003 3004 3005 3006 3007 3008 | if {[info procs textSearch::searchMenu] != ""} { textSearch::searchMenu $top.ms.m } else { $top.ms.m add command -label "Text search not available" \ -state disabled } menubutton $top.mh -text "Help" -underline 0 -menu $top.mh.m menu $top.mh.m $top.mh.m add command -label "Help" -command makeHelpWin -underline 0 $top.mh.m add command -label "About" -command makeAboutWin -underline 0 label $top.lo -text "Diff Options" addBalloon $top.lo "Options passed to the external diff.\nNote\ that options for ignoring whitespace are available in\ the Options menu." entry $top.eo -width 6 -textvariable diff($top,dopt) label $top.lr1 -text "Rev 1" |
︙ | ︙ | |||
3051 3052 3053 3054 3055 3056 3057 | -variable ::Pref(context) -value 20 $top.md.m add separator $top.md.m add checkbutton -label Wrap -variable wrapstate \ -onvalue char -offvalue none -command \ "$top.ft1.tt configure -wrap \$wrapstate ;\ $top.ft2.tt configure -wrap \$wrapstate" $top.md.m add command -label "Merge" -command [list makeMergeWin $top] | | > | > | > > > | 3131 3132 3133 3134 3135 3136 3137 3138 3139 3140 3141 3142 3143 3144 3145 3146 3147 3148 3149 3150 3151 3152 3153 3154 3155 3156 3157 3158 3159 3160 3161 3162 3163 3164 3165 | -variable ::Pref(context) -value 20 $top.md.m add separator $top.md.m add checkbutton -label Wrap -variable wrapstate \ -onvalue char -offvalue none -command \ "$top.ft1.tt configure -wrap \$wrapstate ;\ $top.ft2.tt configure -wrap \$wrapstate" $top.md.m add command -label "Merge" -command [list makeMergeWin $top] $top.md.m add command -label "Date Filter" \ -command {set ::diff(filter) {^Date}} $top.md.m add command -label "Align" -command [list runAlign $top] $top.md.m add separator $top.md.m add command -label "Reread Source" \ -command {source $thisscript} $top.md.m add separator $top.md.m add command -label "Redraw Window" \ -command [list makeDiffWin $top] $top.md.m add separator $top.md.m add command -label "Normal Cursor" \ -command [list normalCursor $top] $top.md.m add separator $top.md.m add command -label "Evalstats" -command {evalstats} $top.md.m add command -label "_stats" -command {parray _stats} $top.md.m add command -label "Nuisance" -command {makeNuisance \ "It looks like you are trying out the debug menu."} pack $top.md -in $top.f -side left -padx 20 } initDiffData $top } # Set new preferences. proc applyPref {} { global Pref TmpPref array set Pref [array get TmpPref] |
︙ | ︙ | |||
3099 3100 3101 3102 3103 3104 3105 | set t [tk_chooseColor -parent .pr -initialcolor $TmpPref($name)] if {$t != ""} { set TmpPref($name) $t } } | | < < < > > > > > | | | > > > > | | > | | | | | | | < | | | | | | | | | | | | | | | < < | | 3184 3185 3186 3187 3188 3189 3190 3191 3192 3193 3194 3195 3196 3197 3198 3199 3200 3201 3202 3203 3204 3205 3206 3207 3208 3209 3210 3211 3212 3213 3214 3215 3216 3217 3218 3219 3220 3221 3222 3223 3224 3225 3226 3227 3228 3229 3230 3231 3232 3233 3234 3235 3236 3237 3238 3239 3240 3241 3242 3243 3244 3245 3246 3247 3248 3249 3250 3251 3252 3253 3254 3255 3256 3257 3258 3259 3260 3261 3262 3263 3264 3265 3266 3267 3268 3269 3270 3271 3272 3273 3274 3275 3276 3277 3278 3279 3280 3281 3282 3283 3284 3285 3286 3287 3288 3289 3290 3291 3292 3293 3294 3295 3296 3297 3298 3299 3300 3301 3302 3303 3304 3305 3306 3307 3308 3309 3310 3311 3312 3313 3314 3315 3316 3317 3318 3319 3320 3321 3322 3323 3324 3325 3326 3327 3328 3329 3330 3331 3332 3333 3334 3335 3336 3337 3338 3339 3340 3341 3342 3343 3344 3345 3346 3347 3348 3349 3350 3351 3352 3353 3354 3355 3356 3357 | set t [tk_chooseColor -parent .pr -initialcolor $TmpPref($name)] if {$t != ""} { set TmpPref($name) $t } } # Create a window for changing preferences. # Currently only colors are changed in this dialog. proc makePrefWin {} { global Pref TmpPref array set TmpPref [array get Pref] destroy .pr toplevel .pr wm title .pr "Diff Preferences" frame .pr.fc -borderwidth 1 -relief solid label .pr.fc.l1 -text Colours -anchor w label .pr.fc.l2 -text Text -anchor w label .pr.fc.l3 -text Background -anchor w entry .pr.fc.e1 -textvariable "TmpPref(colorchange)" -width 10 entry .pr.fc.e2 -textvariable "TmpPref(colornew1)" -width 10 entry .pr.fc.e3 -textvariable "TmpPref(colornew2)" -width 10 button .pr.fc.b1 -text Sel -command "selColor colorchange" button .pr.fc.b2 -text Sel -command "selColor colornew1" button .pr.fc.b3 -text Sel -command "selColor colornew2" entry .pr.fc.e4 -textvariable "TmpPref(bgchange)" -width 10 entry .pr.fc.e5 -textvariable "TmpPref(bgnew1)" -width 10 entry .pr.fc.e6 -textvariable "TmpPref(bgnew2)" -width 10 button .pr.fc.b4 -text Sel -command "selColor bgchange" button .pr.fc.b5 -text Sel -command "selColor bgnew1" button .pr.fc.b6 -text Sel -command "selColor bgnew2" text .pr.fc.t1 -width 12 -height 1 -font myfont -takefocus 0 text .pr.fc.t2 -width 12 -height 1 -font myfont -takefocus 0 text .pr.fc.t3 -width 12 -height 1 -font myfont -takefocus 0 .pr.fc.t1 tag configure change -foreground $TmpPref(colorchange) \ -background $TmpPref(bgchange) .pr.fc.t2 tag configure new1 -foreground $TmpPref(colornew1) \ -background $TmpPref(bgnew1) .pr.fc.t3 tag configure new2 -foreground $TmpPref(colornew2) \ -background $TmpPref(bgnew2) .pr.fc.t1 insert end "Changed text" change .pr.fc.t2 insert end "Deleted text" new1 .pr.fc.t3 insert end "Added text" new2 .pr.fc.t1 configure -state disabled .pr.fc.t2 configure -state disabled .pr.fc.t3 configure -state disabled button .pr.b1 -text "Apply" -command applyPref button .pr.b2 -text "Test" -command testColor button .pr.b3 -text "Close" -command {destroy .pr} grid .pr.fc.l1 .pr.fc.l2 x .pr.fc.l3 x -row 0 -sticky ew -padx 1 -pady 1 grid .pr.fc.t1 .pr.fc.e1 .pr.fc.b1 .pr.fc.e4 .pr.fc.b4 -row 1 \ -sticky nsew -padx 1 -pady 1 grid .pr.fc.t2 .pr.fc.e2 .pr.fc.b2 .pr.fc.e5 .pr.fc.b5 -row 2 \ -sticky nsew -padx 1 -pady 1 grid .pr.fc.t3 .pr.fc.e3 .pr.fc.b3 .pr.fc.e6 .pr.fc.b6 -row 3 \ -sticky nsew -padx 1 -pady 1 grid columnconfigure .pr.fc {1 3} -weight 1 pack .pr.fc -side top -fill x pack .pr.b1 .pr.b2 .pr.b3 -side left -expand 1 -fill x -anchor s \ -padx 2 -pady 2 } # Change font preference proc applyFont {} { global Pref TmpPref set Pref(fontsize) $TmpPref(fontsize) set i [lindex [.fo.lb curselection] 0] set Pref(fontfamily) [.fo.lb get $i] chFont } # Update example font proc exampleFont {lb} { global TmpPref set i [lindex [$lb curselection] 0] if {$i == ""} return set TmpPref(fontfamily) [$lb get $i] font configure tmpfont -family $TmpPref(fontfamily) if {[string is integer -strict $TmpPref(fontsize)]} { font configure tmpfont -size $TmpPref(fontsize) } } # Font dialog proc makeFontWin {} { global Pref TmpPref FontCache destroy .fo toplevel .fo wm title .fo "Select Font" label .fo.ltmp -text "Searching for fonts..." pack .fo.ltmp update catch {font delete tmpfont} font create tmpfont array set TmpPref [array get Pref] label .fo.lf -text Family -anchor w set lb [Scroll y listbox .fo.lb -width 15 -height 10 \ -exportselection no -selectmode single] bind $lb <<ListboxSelect>> [list exampleFont $lb] label .fo.ls -text Size -anchor w button .fo.bm -text - -padx 0 -pady 0 -highlightthickness 0 \ -command "incr TmpPref(fontsize) -1 ; exampleFont $lb" button .fo.bp -text + -padx 0 -pady 0 -highlightthickness 0 \ -command "incr TmpPref(fontsize) ; exampleFont $lb" entry .fo.es -textvariable TmpPref(fontsize) -width 3 bind .fo.es <KeyPress> [list after idle [list exampleFont $lb]] label .fo.le -text Example -anchor w -font tmpfont -width 1 button .fo.bo -text Ok -command "applyFont; destroy .fo" button .fo.ba -text Apply -command "applyFont" button .fo.bc -text Close -command "destroy .fo" if {![info exists FontCache]} { set fam [lsort -dictionary [font families]] font create testfont foreach f $fam { if {![string equal $f ""]} { font configure testfont -family $f if {[font metrics testfont -fixed]} { lappend FontCache $f } } } font delete testfont } foreach f $FontCache { $lb insert end $f if {[string equal -nocase $f $Pref(fontfamily)]} { $lb selection set end $lb see end } } destroy .fo.ltmp grid .fo.lf .fo.ls - - -sticky w grid .fo.lb .fo.es .fo.bm .fo.bp -sticky new grid x .fo.le - - -sticky we -padx 2 -pady 2 grid x .fo.bo - - -sticky we -padx 2 -pady 2 grid x .fo.ba - - -sticky we -padx 2 -pady 2 grid x .fo.bc - - -sticky we -padx 2 -pady 2 grid .fo.lb -sticky news -rowspan 5 grid columnconfigure .fo 0 -weight 1 grid rowconfigure .fo 1 -weight 1 exampleFont $lb } ##################################### # Help and startup functions ##################################### proc makeNuisance {{str {Hi there!}}} { |
︙ | ︙ | |||
3290 3291 3292 3293 3294 3295 3296 3297 3298 3299 | wm overrideredirect .nui2 1 wm title .nui2 "" label .nui2.l -text "$str\nDo you want help?" -justify left -bg yellow button .nui2.b -text "No, get out of my face!" -command {destroy .nui2 .nui} -bg yellow pack .nui2.l .nui2.b -side top -fill x wm geometry .nui2 +[expr {405 + [winfo width .nui]}]+400 } proc makeAboutWin {} { global diffver | > > > > > > > > > > > > > > > > < < | > | < < < | | | | | | | | | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | > > | | | | < < < < | | > > > > > > > > | | | | < | < | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 3379 3380 3381 3382 3383 3384 3385 3386 3387 3388 3389 3390 3391 3392 3393 3394 3395 3396 3397 3398 3399 3400 3401 3402 3403 3404 3405 3406 3407 3408 3409 3410 3411 3412 3413 3414 3415 3416 3417 3418 3419 3420 3421 3422 3423 3424 3425 3426 3427 3428 3429 3430 3431 3432 3433 3434 3435 3436 3437 3438 3439 3440 3441 3442 3443 3444 3445 3446 3447 3448 3449 3450 3451 3452 3453 3454 3455 3456 3457 3458 3459 3460 3461 3462 3463 3464 3465 3466 3467 3468 3469 3470 3471 3472 3473 3474 3475 3476 3477 3478 3479 3480 3481 3482 3483 3484 3485 3486 3487 3488 3489 3490 3491 | wm overrideredirect .nui2 1 wm title .nui2 "" label .nui2.l -text "$str\nDo you want help?" -justify left -bg yellow button .nui2.b -text "No, get out of my face!" -command {destroy .nui2 .nui} -bg yellow pack .nui2.l .nui2.b -side top -fill x wm geometry .nui2 +[expr {405 + [winfo width .nui]}]+400 } proc helpWin {w title} { destroy $w toplevel $w wm title $w $title bind $w <Key-Return> "destroy $w" bind $w <Key-Escape> "destroy $w" frame $w.f button $w.b -text "Close" -command "destroy $w" -width 10 \ -default active pack $w.b -side bottom -pady 3 pack $w.f -side top -expand y -fill both focus $w return $w.f } proc makeAboutWin {} { global diffver set w [helpWin .ab "About Diff"] text $w.t -width 45 -height 11 -wrap none -relief flat \ -bg [$w cget -bg] pack $w.t -side top -expand y -fill both $w.t insert end "A Tcl/Tk frontend to diff\n\n" $w.t insert end "$diffver\n" $w.t insert end "Made by Peter Spjuth\n" $w.t insert end "E-Mail: peter.spjuth@space.se\n\n" $w.t insert end "Credits:\n" $w.t insert end "Ideas for scrollbar map and merge function\n" $w.t insert end "taken from TkDiff\n" set last [lindex [split [$w.t index end] "."] 0] $w.t configure -height $last $w.t configure -state disabled } # Insert a text file into a text widget. # Any XML-style tags in the file are used as tags in the text window. proc insertTaggedText {w file} { set ch [open $file r] set data [read $ch] close $ch set tags {} while {$data != ""} { if {[regexp {^([^<]*)<(/?)([^>]+)>(.*)$} $data -> pre sl tag post]} { $w insert end $pre $tags set i [lsearch $tags $tag] if {$sl != ""} { # Remove tag if {$i >= 0} { set tags [lreplace $tags $i $i] } } else { # Add tag lappend tags $tag } set data $post } else { $w insert end $data $tags set data "" } } } proc makeHelpWin {} { global Pref set doc [file join $::thisdir doc/diff.txt] if {![file exists $doc]} return set w [helpWin .he "Diff Help"] text $w.t -width 82 -height 35 -wrap word -yscrollcommand "$w.sb set"\ -font "Courier 10" scrollbar $w.sb -orient vert -command "$w.t yview" pack $w.sb -side right -fill y pack $w.t -side left -expand 1 -fill both # Move border properties to frame set bw [$w.t cget -borderwidth] set relief [$w.t cget -relief] $w configure -relief $relief -borderwidth $bw $w.t configure -borderwidth 0 # Set up tags $w.t tag configure new1 -foreground $Pref(colornew1) \ -background $Pref(bgnew1) $w.t tag configure new2 -foreground $Pref(colornew2) \ -background $Pref(bgnew2) $w.t tag configure change -foreground $Pref(colorchange) \ -background $Pref(bgchange) $w.t tag configure ul -underline 1 insertTaggedText $w.t $doc $w.t configure -state disabled } proc printUsage {} { puts {Usage: diff.tcl [options] [file1] [file2] [options] All options but the ones listed below are passed to diff. [file1],[file2] Files to be compared |
︙ | ︙ | |||
3549 3550 3551 3552 3553 3554 3555 | -o <file> : Specify merge result output file. -browse : Automatically bring up file dialog after starting. -server : Set up diff to be controllable from the outside. -print <file> : Generate postscript and exit. | | < > < < < < < < < < < < | 3522 3523 3524 3525 3526 3527 3528 3529 3530 3531 3532 3533 3534 3535 3536 3537 3538 3539 3540 3541 3542 3543 3544 3545 3546 3547 3548 | -o <file> : Specify merge result output file. -browse : Automatically bring up file dialog after starting. -server : Set up diff to be controllable from the outside. -print <file> : Generate postscript and exit. -limit <lines> : Do not process more than <lines> lines.} } proc parseCommandLine {} { global diff Pref global argv argc tcl_platform if {$argc == 0} return set top [lindex $::diff(diffWindows) end] set noautodiff 0 set autobrowse 0 set files "" set nextArg "" set revNo 1 foreach arg $argv { if {$nextArg != ""} { if {$nextArg == "mergeFile"} { set diff($top,mergeFile) [file join [pwd] $arg] |
︙ | ︙ |