|
1 #!/usr/bin/wish |
|
2 |
|
3 text .text -relief sunken -bd 2 -yscrollcommand ".scroll set" -setgrid 1 \ |
|
4 -height 30 -undo 1 -autosep 1 |
|
5 scrollbar .scroll -command ".text yview" |
|
6 pack .scroll -side right -fill y |
|
7 pack .text -expand yes -fill both |
|
8 |
|
9 menu .menu -tearoff 0 |
|
10 |
|
11 set File .menu.file |
|
12 menu $File -tearoff 0 |
|
13 .menu add cascade -label "File" -menu $File |
|
14 $File add command -label "New" -command { newfile } |
|
15 $File add command -label "Open" -command { openfile } |
|
16 $File add command -label "Save" -command { savefile $actualfile $actualpass} |
|
17 $File add command -label "Save as..." -command { savefile } |
|
18 $File add separator |
|
19 $File add command -label "Quit" -command { exit} |
|
20 |
|
21 . configure -menu .menu |
|
22 |
|
23 set actualpass "" |
|
24 set actualfile "" |
|
25 wm title . "tkcrypt - New File" |
|
26 |
|
27 proc askpassword { op entries } { |
|
28 set tl [toplevel .pass] |
|
29 global password1 password2 |
|
30 global actualpass |
|
31 |
|
32 set password1 "" |
|
33 set password2 "" |
|
34 label .pass.info -text "Please introduce your password two times for $op:" |
|
35 pack .pass.info -side top |
|
36 |
|
37 entry .pass.entry -textvariable password1 -show "*" |
|
38 pack .pass.entry -side top |
|
39 if { $entries == 2} { |
|
40 entry .pass.entry2 -textvariable password2 -show "*" |
|
41 pack .pass.entry2 -side top |
|
42 } |
|
43 button .pass.ok -text "Ok" -command \ |
|
44 { destroy .pass } |
|
45 pack .pass.ok -side left |
|
46 button .pass.cancel -text "Cancel" \ |
|
47 -command {set password1 ""; set password2 ""; destroy .pass} |
|
48 pack .pass.cancel -side right |
|
49 |
|
50 bind .pass.entry <Return> {destroy .pass} |
|
51 bind .pass.entry <Escape> {set password1 ""; set password2 ""; destroy .pass} |
|
52 |
|
53 focus $tl |
|
54 focus $tl.entry |
|
55 grab $tl |
|
56 tkwait window $tl |
|
57 catch { grab release $tl } |
|
58 focus . |
|
59 |
|
60 if { $entries != 2 } { |
|
61 set tmppass $password1 |
|
62 set password1 "" |
|
63 return $tmppass |
|
64 } |
|
65 |
|
66 if { $password1 == $password2 } { |
|
67 set tmppass $password1 |
|
68 set password1 "" |
|
69 set password2 "" |
|
70 return $tmppass |
|
71 } else { |
|
72 set password1 "" |
|
73 set password2 "" |
|
74 tk_messageBox -type ok -message "The passwords don't match" \ |
|
75 -icon error |
|
76 return "" |
|
77 } |
|
78 } |
|
79 |
|
80 proc newfile { } { |
|
81 global actualpass actualfile |
|
82 set actualpass "" |
|
83 set actualfile "" |
|
84 wm title . "tkcrypt - New File" |
|
85 } |
|
86 |
|
87 proc openfile { } { |
|
88 global env actualpass actualfile |
|
89 set file [tk_getOpenFile] |
|
90 set pass [askpassword "Open" 1] |
|
91 |
|
92 if { $pass == "" } { return } |
|
93 |
|
94 # Decode |
|
95 set env(PASS) $pass |
|
96 |
|
97 set error [ catch { set txt [exec ccrypt -dc -E PASS $file] } result ] |
|
98 if { $error != 0 } { |
|
99 tk_messageBox -type ok -message "Password incorrect:\n$result" \ |
|
100 -icon error |
|
101 return |
|
102 } |
|
103 |
|
104 .text delete 1.0 end |
|
105 .text insert end $txt |
|
106 # while { [eof $fd ] != 1 } { |
|
107 # set line [gets $fd] |
|
108 # .text insert end $line |
|
109 # } |
|
110 |
|
111 set env(PASS) "" |
|
112 |
|
113 set actualpass $pass |
|
114 set actualfile $file |
|
115 wm title . "tkcrypt - $file" |
|
116 } |
|
117 |
|
118 proc savefile { {file ""} {pass ""} } { |
|
119 global env actualpass actualfile |
|
120 |
|
121 if { $file == "" } { |
|
122 set file [tk_getSaveFile] |
|
123 } |
|
124 |
|
125 if { $pass == "" } { |
|
126 set pass [askpassword "Save" 2] |
|
127 |
|
128 if { $pass == "" } { return } |
|
129 } |
|
130 |
|
131 # Decode |
|
132 set env(PASS) $pass |
|
133 |
|
134 set error [ catch { set fd [open "|ccrypt -E PASS >$file" w] } result ] |
|
135 if { $error != 0 } { |
|
136 tk_messageBox -type ok -message "Password incorrect:\n$result" \ |
|
137 -icon error |
|
138 return |
|
139 } |
|
140 |
|
141 puts -nonewline $fd [.text get 1.0 end] |
|
142 close $fd |
|
143 |
|
144 set env(PASS) "" |
|
145 set actualfile $file |
|
146 wm title . "tkcrypt - $file" |
|
147 tk_messageBox -type ok -message "File \"$file\" saved!" \ |
|
148 -icon info |
|
149 } |