| Bsoft 2.0.5 Bernard's software package

btext.tcl
Go to the documentation of this file.
1 ##
2 # @file btext.tcl
3 #
4 # @brief Window to show text information
5 #
6 # @author Bernard Heymann
7 # @date Created: 20010516
8 # @date Modified: 20130123
9
10 set textfile ""
11
12 ## @brief Open a text editing window
13 #
14 # @param w window name to contain ".text" window.
15
16 proc openTextWindow { w } {
17 global textfile
18
19 set wn $w
20 if [string equal $w "."] { set wn ""}
21 set twin $wn.text
22 # puts "Window name: $wn"
23
24 if { ![winfo exists $w] || $w == "." } {
25 if { $w != "." } { toplevel $w}
26
27 set m $wn.menu
28 # puts "Text window menu: $m"
29 menu $m -tearoff 0
30 $m add cascade -menu $m.file -label "File" -underline 0
31 menu $m.file -tearoff 0
32 $w configure -menu $m
33 $m.file add command -label "Open" \
34 -command "openTextFile $twin" -underline 0
35 $m.file add command -label "Save" \
36 -command [ list "saveTextFile" $twin $textfile] -underline 0
37 $m.file add command -label "Save as ..." \
38 -command "saveAsTextFile $twin" -underline 0
39 $m.file add command -label "Close" \
40 -command "$wn.text delete 1.0 end" -underline 0
41
42 frame $wn.frame
43 pack $wn.frame -expand yes -fill both -padx 1 -pady 1
44 text $wn.text -width 80 -height 60 -wrap none -undo 1 -background white\
45 -xscrollcommand "$wn.xscroll set" \
46 -yscrollcommand "$wn.yscroll set" \
47 -setgrid 1 -highlightthickness 0 -pady 2 -padx 3
48 scrollbar $wn.xscroll -command "$wn.text xview" \
49 -highlightthickness 0 -orient horizontal
50 scrollbar $wn.yscroll -command "$wn.text yview" \
51 -highlightthickness 0 -orient vertical
52
53 grid $wn.text -in $wn.frame -padx 1 -pady 1 \
54 -row 0 -column 0 -rowspan 1 -columnspan 1 -sticky news
55 grid $wn.xscroll -in $wn.frame -padx 1 -pady 1 \
56 -row 1 -column 0 -rowspan 1 -columnspan 1 -sticky news
57 grid $wn.yscroll -in $wn.frame -padx 1 -pady 1 \
58 -row 0 -column 1 -rowspan 1 -columnspan 1 -sticky news
59 grid rowconfig $wn.frame 0 -weight 1 -minsize 0
60 grid columnconfig $wn.frame 0 -weight 1 -minsize 0
61
62 } else {
63 wm deiconify $wn
64 raise $wn
65 }
66 wm title $w "Text Editor"
67 wm iconname $w "Ted"
68 bind $w <Control-z> { $wn.text edit undo }
69 bind $w <Control-Z> { $wn.text edit redo }
70 bind $w <Command-Z> { $wn.text edit redo }
71 bind $w <Control-w> { destroy $w }
72 bind $w <Command-w> { destroy $w }
73 return $wn.text
74 }
75
76 ## @brief Opens a text window with the supplied information
77 #
78 # @param theinfo text information.
79
80 proc showInfo { theinfo } {
81 set w .info
82 set wtxt [openTextWindow $w]
83 wm title $w "Bsoft information window"
84 wm iconname $w "Bsoft info"
85 $wtxt delete 1.0 end
86 $wtxt insert 1.0 $theinfo
87 $wtxt mark set insert 1.0
88 return $wtxt
89 }
90
91 ## @brief Reads a text file for editing
92 #
93 # @param filename file name (including path).
94
95 proc editTextFile { filename } {
96 if { [string length $filename] < 1 } { return}
97 set w .wtxt
98 readTextFile [openTextWindow $w] $filename
99 set thename [file tail $filename]
100 wm title $w $thename
101 wm iconname $w $thename
102 }
103
104 ## @brief Opens a text file for editing
105 #
106 # @param wtxt text window.
107
108 proc openTextFile { wtxt } {
109 set filename [tk_getOpenFile -initialdir [pwd]]
110 # set filename [file tail $filename]
111 # puts "Open in $wtxt: $filename"
112 readTextFile $wtxt $filename
113 }
114
115 ## @brief Reads a text file
116 #
117 # @param wtxt a text window
118 # @param filename file name (including path).
119
120 proc readTextFile { wtxt filename } {
121 global textfile
122 if { [string length $filename] < 1 } { return}
123 if { [catch {open $filename r} ftxt] } {
124 tk_messageBox -message "File $filename not opened!" -icon error -type ok
125 return
126 }
127 set thetext [read $ftxt]
128 close $ftxt
129 $wtxt delete 1.0 end
130 $wtxt insert 1.0 $thetext
131 set textfile $filename
132 }
133
134 ## @brief Saves a text file using its current name
135 #
136 # @param wtxt a text window
137 # @param filename file name (including path).
138
139 proc saveTextFile { wtxt filename } {
140 global textfile
141 if { [string length $filename] < 1 } { return}
142 if { [catch {open $filename w} ftxt] } { return}
143 set thetext [$wtxt get 1.0 end]
144 puts $ftxt $thetext
145 close $ftxt
146 set textfile $filename
147 return $filename
148 }
149
150 ## @brief Saves a text file with a new name
151 #
152 # @param wtxt a text window
153
154 proc saveAsTextFile { wtxt } {
155 global textfile
156 set filename [tk_getSaveFile -initialdir [pwd] -initialfile [file tail $textfile]]
157 saveTextFile $wtxt $filename
158 return $filename
159 }
160
161 ## @brief Updates text originating from an open channel
162 #
163 # @param wtxt a text window
164 # @param chan the channel
165
166 proc updateText { wtxt chan } {
167 $wtxt configure -state normal
168 $wtxt insert end [read $chan]
169 $wtxt configure -state disabled
170 $wtxt see end
171 if {[eof $chan]} {
172 puts "Closing text output channel"
173 close $chan
174 $wtxt configure -state normal
175 }
176 }
177
178 ## @brief Executes a command and sends the output to a channel for updating
179 #
180 # @param cmd the command (with arguments)
181 # @param logfile a text file to write to.
182
183 proc executeCommand { cmd logfile } {
184 global textfile
185 set p [lindex $cmd 0]
186 if [ file executable $p] {
187 set textfile $logfile
188 puts "Executing: $cmd"
189 set wtxt [showInfo "$cmd\n\n"]
190 set chan [open |[concat $cmd 2>@1]]
191 fconfigure $chan -blocking 0 -buffering line
192 fileevent $chan readable [list updateText $wtxt $chan]
193 } else {
194 puts "$p not executable!"
195 }
196 }
197
198 ## @brief Gets a file name entry
199 #
200 # @param w an entry window
201
202 proc getFilename { w } {
203 set name [tk_getOpenFile]
204 if { $name > " " } {
205 $w delete 0 end
206 $w insert 0 $name
207 }
208 }
209
210 ## @brief Gets a directory entry
211 #
212 # @param w an entry window
213
214 proc getDirectoryName { w } {
215 set dir [tk_chooseDirectory \
216 -initialdir ~ -title "Choose a directory"]
217 if { $dir > " " } {
218 $w.e delete 0 end
219 $w.e insert 0 $dir
220 }
221 }
222