| changeset 3 | 533cbe2b7f3c |
| parent 2 | 063a30048b60 |
| 2:063a30048b60 | 3:533cbe2b7f3c |
|---|---|
1 #!/usr/bin/wish |
1 #!/usr/bin/wish |
2 # encoding: utf-8 |
|
3 # |
|
4 # Tkccrypt - a frontend for Peter Selinger's ccrypt |
|
5 # Copyright (C) 2006 Lluís Batlle i Rossell |
|
6 # |
|
7 # This program is free software; you can redistribute it and/or |
|
8 # modify it under the terms of the GNU General Public License |
|
9 # as published by the Free Software Foundation; either version 2 |
|
10 # of the License, or (at your option) any later version. |
|
11 # |
|
12 # This program is distributed in the hope that it will be useful, |
|
13 # but WITHOUT ANY WARRANTY; without even the implied warranty of |
|
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
|
15 # GNU General Public License for more details. |
|
16 # |
|
17 # You should have received a copy of the GNU General Public License |
|
18 # along with this program; if not, write to the Free Software |
|
19 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. |
|
20 # |
|
2 |
21 |
3 text .text -relief sunken -bd 2 -yscrollcommand ".scroll set" -setgrid 1 \ |
22 text .text -relief sunken -bd 2 -yscrollcommand ".scroll set" -setgrid 1 \ |
4 -height 30 -undo 1 -autosep 1 |
23 -height 30 -undo 1 -autosep 1 |
5 scrollbar .scroll -command ".text yview" |
24 scrollbar .scroll -command ".text yview" |
6 pack .scroll -side right -fill y |
25 pack .scroll -side right -fill y |
25 |
44 |
26 . configure -menu .menu |
45 . configure -menu .menu |
27 |
46 |
28 set actualpass "" |
47 set actualpass "" |
29 set actualfile "" |
48 set actualfile "" |
30 wm title . "tkcrypt - New File" |
49 wm title . "tkccrypt - New File" |
31 |
50 |
32 proc askpassword { op entries } { |
51 proc askpassword { op entries } { |
33 set tl [toplevel .pass] |
52 set tl [toplevel .pass] |
34 global password1 password2 |
53 global password1 password2 |
35 global actualpass |
54 global actualpass |
88 proc newfile { } { |
107 proc newfile { } { |
89 global actualpass actualfile |
108 global actualpass actualfile |
90 set actualpass "" |
109 set actualpass "" |
91 set actualfile "" |
110 set actualfile "" |
92 .text delete 1.0 end |
111 .text delete 1.0 end |
93 wm title . "tkcrypt - New File" |
112 wm title . "tkccrypt - New File" |
94 } |
113 } |
95 |
114 |
96 proc openfile { } { |
115 proc openfile { } { |
97 global env actualpass actualfile filetypes |
116 global env actualpass actualfile filetypes |
98 set file [tk_getOpenFile -defaultextension .cpt -filetypes $filetypes] |
117 set file [tk_getOpenFile -defaultextension .cpt -filetypes $filetypes] |
124 |
143 |
125 set env(PASS) "" |
144 set env(PASS) "" |
126 |
145 |
127 set actualpass $pass |
146 set actualpass $pass |
128 set actualfile $file |
147 set actualfile $file |
129 wm title . "tkcrypt - $file" |
148 wm title . "tkccrypt - $file" |
130 } |
149 } |
131 |
150 |
132 proc savefile { {file ""} {pass ""} } { |
151 proc savefile { {file ""} {pass ""} } { |
133 global env actualpass actualfile filetypes |
152 global env actualpass actualfile filetypes |
134 |
153 |
161 close $fd |
180 close $fd |
162 |
181 |
163 set env(PASS) "" |
182 set env(PASS) "" |
164 set actualpass $pass |
183 set actualpass $pass |
165 set actualfile $file |
184 set actualfile $file |
166 wm title . "tkcrypt - $file" |
185 wm title . "tkccrypt - $file" |
167 tk_messageBox -type ok -message "File \"$file\" saved!" \ |
186 tk_messageBox -type ok -message "File \"$file\" saved!" \ |
168 -icon info |
187 -icon info |
169 } |
188 } |