/[ascend]/trunk/ascend4/TK/NoteboxProc.tcl
ViewVC logotype

Contents of /trunk/ascend4/TK/NoteboxProc.tcl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1 - (show annotations) (download) (as text)
Fri Oct 29 20:54:12 2004 UTC (17 years, 1 month ago) by aw0a
File MIME type: text/x-tcl
File size: 8228 byte(s)
Setting up web subdirectory in repository
1 # NoteboxProc.tcl: Functions for handling the notes database display box
2 # By Benjamin Andrew Allan
3 # May 3, 1998
4 # Part of ASCEND
5 # Revision: $Revision: 1.3 $
6 # Last modified on: $Date: 1998/06/18 15:54:51 $
7 # Last modified by: $Author: mthomas $
8 # Revision control file: $RCSfile: NoteboxProc.tcl,v $
9 #
10 # This file is part of the ASCEND Tcl/Tk Interface.
11 #
12 # Copyright (C) 1998 Carnegie Mellon University
13 #
14 # The ASCEND Tcl/Tk Interface is free software; you can redistribute
15 # it and/or modify it under the terms of the GNU General Public
16 # License as published by the Free Software Foundation; either
17 # version 2 of the License, or (at your option) any later version.
18 #
19 # The ASCEND Tcl/Tk Interface is distributed in hope that it will be
20 # useful, but WITHOUT ANY WARRANTY; without even the implied warranty
21 # of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
22 # GNU General Public License for more details.
23 #
24 # You should have received a copy of the GNU General Public License
25 # along with the program; if not, write to the Free Software
26 # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139 USA. Check the
27 # file named COPYING. COPYING is found in ../compiler.
28
29
30 global ascNotesVect
31 set ascNotesVect(defaulted) 0
32
33 proc set_Notebox_defaults {} {
34 global ascNotesVect
35 if {$ascNotesVect(defaulted)} {
36 return
37 }
38 set ascNotesVect(stringmatch) {}
39 set ascNotesVect(windowname) .notebox
40 set ascNotesVect(textwidth) 30
41 set ascNotesVect(font) {courier 10}
42 set ascNotesVect(sort1) Type
43 set ascNotesVect(sort2) None
44 set ascNotesVect(current) {Loaded Libraries}
45 set ascNotesVect(global_built) 0
46 set ascNotesVect(defaulted) 1
47 }
48
49 proc NoteBind {} {
50 global ascNotesVect
51 #$ascNotesVect(typelist) delete 0 end
52 #$ascNotesVect(langlist) delete 0 end
53 #$ascNotesVect(namelist) delete 0 end
54 #$ascNotesVect(methlist) delete 0 end
55 #$ascNotesVect(textlist) delete 0 end
56 #$ascNotesVect(fililist) delete 0 end
57 bind $ascNotesVect(dbbutton) <Any-Enter> {+NoteUpdateDBbutton}
58 HPane-Bind .notebox.main_frm list_frm text_frm 10 0.5
59 bind $ascNotesVect(textlist) <ButtonRelease-1> \
60 {+NoteUpdateText [%W nearest %y]}
61 bind $ascNotesVect(fililist) <ButtonRelease-1> \
62 {+NoteUpdateFileEntry [%W nearest %y]}
63 }
64
65 proc NoteUpdateDBbutton {} {
66 global ascNotesVect
67 set ascNotesVect(dbchoices) [libr_query -notesdblist]
68 $ascNotesVect(dbmenu) delete 0 end
69 foreach i $ascNotesVect(dbchoices) {
70 $ascNotesVect(dbmenu) add radiobutton \
71 -variable ascNotesVect(current) \
72 -value $i \
73 -label $i
74 }
75 $ascNotesVect(dbmenu) entryconfigure 0 -state active
76 }
77
78 proc NoteOpen {} {
79 if {![winfo exists .notebox]} {
80 set_Notebox_defaults
81 ShowWindow.notebox
82 NoteBind
83 }
84 wm deiconify .notebox
85 raise .notebox
86 }
87
88 proc NoteUpdateFileEntry {index} {
89 global ascNotesVect
90 set ascNotesVect(entrytext) [NoteGetFile $index]
91 }
92
93 proc NoteUpdateText {index} {
94 global ascNotesVect
95 set text [NoteGetText $index]
96 $ascNotesVect(textbox) delete 1.0 end
97 $ascNotesVect(textbox) insert end $text
98 }
99
100 proc NoteGetFile {index} {
101 global NotesRowToRecord
102 global ascNotesVect
103 if {![info exists NotesRowToRecord($index)]} {
104 error "NoteText called with bad row index $index"
105 }
106 set nptr $NotesRowToRecord($index)
107 set note [libr_query -notes -dbid $ascNotesVect(current) -record $nptr]
108 if {[llength $note]} {
109 return [lindex [lindex $note 0] 5]:[lindex [lindex $note 0] 6]
110 }
111 }
112
113 proc NoteGetText {index} {
114 global NotesRowToRecord
115 global ascNotesVect
116 if {![info exists NotesRowToRecord($index)]} {
117 error "NoteText called with bad row index $index"
118 }
119 set nptr $NotesRowToRecord($index)
120 set note [libr_query -notes -dbid $ascNotesVect(current) -record $nptr]
121 if {[llength $note]} {
122 return [lindex [lindex $note 0] 4]
123 }
124 }
125
126 proc NoteKeyToColumn {key} {
127 switch -exact -- $key {
128 Type {
129 return 0
130 }
131 Language {
132 return 1
133 }
134 Name {
135 return 2
136 }
137 Method {
138 return 3
139 }
140 File {
141 return 4
142 }
143 None -
144 default {
145 return -1
146 }
147 }
148 }
149
150 proc NoteSortLists {pkey skey} {
151 global ascNotesVect
152 # translate keys to columns
153 set e1 [NoteKeyToColumn $pkey]
154 set e2 [NoteKeyToColumn $skey]
155 # enforce column sanity on keys
156 if {$e1 < 0 && $e2 > $e1} {
157 set ascNotesVect(sort1) $skey
158 set ascNotesVect(sort2) None
159 }
160 if {$e1 == $e2} {
161 set ascNotesVect(sort2) None
162 set skey None
163 }
164 set e1 [NoteKeyToColumn $pkey]
165 set e2 [NoteKeyToColumn $skey]
166
167 # puts "sorting with $pkey $e1 $skey $e2"
168 if {$e1 < 0 && $e2 < 0 &&
169 ![string length [string trim $ascNotesVect(stringmatch)]]} {
170 return [libr_query -notesdump -dbid $ascNotesVect(current) \
171 -textwidth $ascNotesVect(textwidth)]
172 }
173 set data [libr_query -notesdump -dbid $ascNotesVect(current) \
174 -textwidth $ascNotesVect(textwidth)]
175 set l(0) [lindex $data 0]
176 set l(1) [lindex $data 1]
177 set l(2) [lindex $data 2]
178 set l(3) [lindex $data 3]
179 set l(4) [lindex $data 4]
180 set l(5) [lindex $data 5]
181 set l(6) [lindex $data 6]
182 unset data
183 set master {}
184 if {$e2 < 0} {
185 # if unsorted last key, the natural order is mostly preserved by this
186 # and it's much faster.
187 set master [lsort -ascii $l($e1)]
188 unset l($e1)
189 } else {
190 set ascNotesVect(l2) $l($e2)
191 set master [lsort -command NoteSort $l($e1)]
192 unset l($e1)
193 }
194 set data {}
195 for {set i 0} {$i < 7} {incr i} {
196 if {$i == $e1} {
197 lappend data $master
198 } else {
199 set list {}
200 foreach j $master {
201 lappend list [lindex $l($i) [lindex $j 1]]
202 }
203 lappend data $list
204 unset list
205 unset l($i)
206 }
207 }
208 return $data
209 }
210
211 proc NoteSort {k1 k2} {
212 global ascNotesVect
213 set r [string compare [lindex $k1 0] [lindex $k2 0]]
214 if {$r} {
215 return $r
216 }
217 return [string compare \
218 [lindex [lindex $ascNotesVect(l2) [lindex $k1 1]] 0] \
219 [lindex [lindex $ascNotesVect(l2) [lindex $k2 1]] 0] \
220 ]
221 }
222
223 proc NoteFillLists {} {
224 global ascNotesVect
225 global NotesRowToRecord NotesRecordToRow
226 set data [NoteSortLists $ascNotesVect(sort1) $ascNotesVect(sort2)]
227 $ascNotesVect(textlist) configure -width $ascNotesVect(textwidth)
228 $ascNotesVect(typelist) delete 0 end
229 $ascNotesVect(langlist) delete 0 end
230 $ascNotesVect(namelist) delete 0 end
231 $ascNotesVect(methlist) delete 0 end
232 $ascNotesVect(textlist) delete 0 end
233 $ascNotesVect(fililist) delete 0 end
234 #uncommenting all the row/check statements verifies the sort
235 #set check(-1) {}
236 set col [lindex $data 0]
237 #set row 0
238 foreach i $col {
239 $ascNotesVect(typelist) insert end [lindex $i 0]
240 # lappend check($row) [lindex $i 1]
241 # incr row
242 }
243 set col [lindex $data 1]
244 #set row 0
245 foreach i $col {
246 $ascNotesVect(langlist) insert end [lindex $i 0]
247 # lappend check($row) [lindex $i 1]
248 # incr row
249 }
250 set col [lindex $data 2]
251 #set row 0
252 foreach i $col {
253 $ascNotesVect(namelist) insert end [lindex $i 0]
254 # lappend check($row) [lindex $i 1]
255 # incr row
256 }
257 set col [lindex $data 3]
258 #set row 0
259 foreach i $col {
260 $ascNotesVect(methlist) insert end [lindex $i 0]
261 # lappend check($row) [lindex $i 1]
262 # incr row
263 }
264 set col [lindex $data 4]
265 #set row 0
266 foreach i $col {
267 $ascNotesVect(textlist) insert end [lindex $i 0]
268 # lappend check($row) [lindex $i 1]
269 # incr row
270 }
271 set col [lindex $data 5]
272 #set row 0
273 foreach i $col {
274 $ascNotesVect(fililist) insert end [file tail [lindex $i 0]]
275 # lappend check($row) [lindex $i 1]
276 # incr row
277 }
278 # parray check
279 set col [lindex $data 6]
280 set row 0
281 catch {unset NotesRowToRecord}
282 catch {unset NotesRecordToRow}
283 set NotesRecordToRow(-1) 0; #NULL note, keep array existent
284 set NotesRowToRecord(-1) 0; #NULL note, keep array existent
285 set row 0
286 foreach i $col {
287 set NotesRowToRecord($row) [lindex $i 0]
288 set NotesRecordToRow([lindex $i 0]) $row
289 incr row
290 }
291 }
292
293 proc NoteBrowse {args} {
294 NoteOpen
295 NoteFillLists
296 }
297
298 proc Notes_Handle_Sourceread {args} {
299 global ascNotesVect
300
301 set_Notebox_defaults
302 if {![winfo exists $ascNotesVect(windowname)] || \
303 ![winfo ismapped $ascNotesVect(windowname)]} {
304 return
305 }
306 NoteBrowse
307 }

john.pye@anu.edu.au
ViewVC Help
Powered by ViewVC 1.1.22