| 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 |
} |
Parent Directory
| 
Revision Log