| 1 |
# UtilProc.tcl: ascend path/unix utility box procedures |
| 2 |
# by Benjamin A. Allan and Kirk A. Abbott |
| 3 |
# Created: January 1994 |
| 4 |
# Part of ASCEND |
| 5 |
# Revision: $Revision: 1.38 $ |
| 6 |
# Last modified on: $Date: 1998/06/18 15:55:07 $ |
| 7 |
# Last modified by: $Author: mthomas $ |
| 8 |
# Revision control file: $RCSfile: UtilProc.tcl,v $ |
| 9 |
# |
| 10 |
# This file is part of the ASCEND Tcl/Tk Interface. |
| 11 |
# |
| 12 |
# Copyright (C) 1994-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 |
# each system default not configured by |
| 31 |
# Xresources or ascend.ad should have an entry in the ascUtilVect |
| 32 |
# The list of subscripts is keyed to the list of labels through |
| 33 |
# the util_get_label procedure so we don't actually have to |
| 34 |
# add new widget definitions every time we get a new utility: |
| 35 |
# just update the procedures |
| 36 |
# util_init |
| 37 |
# util_get_label |
| 38 |
# util_get_var |
| 39 |
# |
| 40 |
# display is alpha-by-utilvect-subscript order |
| 41 |
# any sanity checking desired must be done at button press time |
| 42 |
# |
| 43 |
# util init:creates a utilvect entry for each option we want to appear |
| 44 |
# on the unix page. the values in sub must be appropriate as array |
| 45 |
# subscripts, duh, and widget names. |
| 46 |
# |
| 47 |
|
| 48 |
# Work around for tcl's braindead file volume command which |
| 49 |
# demands media in every drive before returning. |
| 50 |
# This simply gets the list of lettered devices c-z: that exist |
| 51 |
proc windoze_file_volume {} { |
| 52 |
set result {} |
| 53 |
foreach i {c d e f g h i j k l m n o p q r s t u v w x y z} { |
| 54 |
if {[file exists $i:]} { |
| 55 |
lappend result $i: |
| 56 |
} |
| 57 |
} |
| 58 |
if {![llength $result]} { |
| 59 |
lappend result a: b: |
| 60 |
} |
| 61 |
return $result |
| 62 |
} |
| 63 |
|
| 64 |
# |
| 65 |
# This function tries to guess windoze tmp directory, since |
| 66 |
# the idiots didn't standardize it. |
| 67 |
proc set_Windoze_tmp {} { |
| 68 |
global ascUtilVect env ascGlobalVect |
| 69 |
if {[info exists ascUtilVect(asctmp)] && \ |
| 70 |
[file writable $ascUtilVect(asctmp)] && \ |
| 71 |
[file isdirectory $ascUtilVect(asctmp)]} { |
| 72 |
if {![info exists env(TMPDIR)]} { |
| 73 |
set env(TMPDIR) $ascUtilVect(asctmp) |
| 74 |
} |
| 75 |
return |
| 76 |
} |
| 77 |
set drive [windoze_file_volume] |
| 78 |
set suffix [list \ |
| 79 |
{/Tmp} \ |
| 80 |
{/Temp} \ |
| 81 |
{/ASCEND IV/Tmp} \ |
| 82 |
{/WinNT/Temp} \ |
| 83 |
{/Win95/Temp} \ |
| 84 |
{/Windows/Temp} \ |
| 85 |
{/Program Files/Temp} \ |
| 86 |
{/Program Files/ASCEND IV/Tmp} \ |
| 87 |
] |
| 88 |
set dl {} |
| 89 |
foreach dr $drive { |
| 90 |
if {[string compare [string tolower $dr] "a:"] && \ |
| 91 |
[string compare [string tolower $dr] "b:"]} { |
| 92 |
foreach su $suffix { |
| 93 |
lappend dl $dr$su |
| 94 |
} |
| 95 |
} |
| 96 |
} |
| 97 |
if {[info exists ascGlobalVect(userhome)]} { |
| 98 |
lappend dl $ascGlobalVect(userhome)/../tmp |
| 99 |
} |
| 100 |
if {[info exists env(TMPDIR)]} { |
| 101 |
linsert dl 0 $env(TMPDIR) |
| 102 |
} |
| 103 |
if {[info exists env(TMP)]} { |
| 104 |
linsert dl 0 $env(TMP) |
| 105 |
} |
| 106 |
if {[info exists env(TEMP)]} { |
| 107 |
linsert dl 0 $env(TEMP) |
| 108 |
} |
| 109 |
foreach d $dl { |
| 110 |
set ascUtilVect(asctmp) [file rootname $d ] |
| 111 |
if {[file isdirectory $ascUtilVect(asctmp)] && \ |
| 112 |
[file writable $ascUtilVect(asctmp)]} { |
| 113 |
if {![info exists env(TMPDIR)]} { |
| 114 |
set env(TMPDIR) $ascUtilVect(asctmp) |
| 115 |
} |
| 116 |
return |
| 117 |
} |
| 118 |
} |
| 119 |
set ascUtilVect(asctmp) c:/temp |
| 120 |
if {![info exists env(TMPDIR)]} { |
| 121 |
set env(TMPDIR) $ascUtilVect(asctmp) |
| 122 |
} |
| 123 |
set str "Could not find a writable scratch directory. Tried:" |
| 124 |
append str " " $dl |
| 125 |
append str " Open the ASCEND System Utilities tool and set one." |
| 126 |
append str " Otherwise, some functions like Display Code do not work." |
| 127 |
Script_Raise_Alert $str |
| 128 |
return |
| 129 |
} |
| 130 |
# |
| 131 |
# proc set_Util_Defaults {} |
| 132 |
#------------------------------------------------------------------------ |
| 133 |
# set utility defaults here. note: any values not stored in |
| 134 |
# utilvect must be initialized elsewhere, eg. set_Toolbox_Defaults |
| 135 |
#------------------------------------------------------------------------ |
| 136 |
proc set_Util_Defaults {} { |
| 137 |
global ascUtilVect tcl_platform env |
| 138 |
if {[string compare $tcl_platform(platform) windows]==0} { |
| 139 |
set ascUtilVect(edit) "runemacs" |
| 140 |
set ascUtilVect(ghostview) "ghostview" |
| 141 |
set_Windoze_tmp |
| 142 |
set ascUtilVect(plot_type) "xgraph" |
| 143 |
set ascUtilVect(plot_command) \{$env(ASCENDDIST) |
| 144 |
append ascUtilVect(plot_command) "/../Tcl/bin/tkxgraph.exe\} -- -f" |
| 145 |
} else { |
| 146 |
set ascUtilVect(edit) "emacs" |
| 147 |
set ascUtilVect(ghostview) "ghostview" |
| 148 |
set ascUtilVect(asctmp) "/tmp" |
| 149 |
set ascUtilVect(plot_type) "xgraph" |
| 150 |
set ascUtilVect(plot_command) "xgraph" |
| 151 |
} |
| 152 |
set_Print_Defaults |
| 153 |
} |
| 154 |
|
| 155 |
# |
| 156 |
# proc Util_Init {} |
| 157 |
#------------------------------------------------------------------------ |
| 158 |
# Utilvect valu check here to guarantee widget creation. |
| 159 |
# All variables must ultimately resolve to vector entries. |
| 160 |
# We will _not_ have single variables running around loose in Util |
| 161 |
#------------------------------------------------------------------------ |
| 162 |
proc Util_Init {} { |
| 163 |
global ascUtilSubs ascUtilVect |
| 164 |
set subs "dir" |
| 165 |
lappend subs asclib ascdist tklib tcllib printer |
| 166 |
lappend subs print edit ghostview asctmp xspread webstart |
| 167 |
lappend subs webkick webroot plot_type plot_command |
| 168 |
# if not set, set dummy so it gets on the util page |
| 169 |
set alist [array names ascUtilVect] |
| 170 |
foreach s $subs { |
| 171 |
if {[lsearch $alist $s]=="-1"} { |
| 172 |
set ascUtilVect($s) "unset" |
| 173 |
} |
| 174 |
} |
| 175 |
set ascUtilSubs $subs |
| 176 |
} |
| 177 |
|
| 178 |
# |
| 179 |
# proc Util_Get_Label {defsub} |
| 180 |
#------------------------------------------------------------------------ |
| 181 |
# take a util default subscript and return its label string |
| 182 |
# for the utility box |
| 183 |
#------------------------------------------------------------------------ |
| 184 |
proc Util_Get_Label {defsub} { |
| 185 |
switch $defsub { |
| 186 |
{asclib} {return "ASCENDLIBRARY path"} |
| 187 |
{webstart} {return "WWW startup"} |
| 188 |
{webroot} {return "WWW root URL"} |
| 189 |
{ascdist} {return "ASCENDDIST dir"} |
| 190 |
{asctmp} {return "Scratch directory"} |
| 191 |
{dir} {return "Working Directory"} |
| 192 |
{edit} {return "Text edit command"} |
| 193 |
{ghostview} {return "Postscript viewer"} |
| 194 |
{plot_command} {return "Plot program name"} |
| 195 |
{plot_type} {return "Plot file type"} |
| 196 |
{print} {return "Text print command"} |
| 197 |
{printer} {return "PRINTER"} |
| 198 |
{webkick} {return "WWW restart"} |
| 199 |
{tcllib} {return "TCL_LIBRARY"} |
| 200 |
{tklib} {return "TK_LIBRARY dir"} |
| 201 |
{xspread} {return "Spreadsheet command"} |
| 202 |
default {error "util_get_label called with bad option $defsub"} |
| 203 |
} |
| 204 |
} |
| 205 |
|
| 206 |
# |
| 207 |
# proc Util_Get_Var {defsub} |
| 208 |
#------------------------------------------------------------------------ |
| 209 |
# take a util default subscript and return its variable |
| 210 |
# for the utility box. you better have set these vars |
| 211 |
# elsewhere or trap those not ever set |
| 212 |
#------------------------------------------------------------------------ |
| 213 |
proc Util_Get_Var {defsub} { |
| 214 |
switch $defsub { |
| 215 |
{dir} {return "ascToolVect(dirinput)"} |
| 216 |
{asclib} {return "env(ASCENDLIBRARY)"} |
| 217 |
{ascdist} {return "env(ASCENDDIST)"} |
| 218 |
{webstart} {return "ascHelpVect(start_command)"} |
| 219 |
{webroot} {return "ascHelpVect(rootURL)"} |
| 220 |
{asctmp} {return "ascUtilVect(asctmp)"} |
| 221 |
{tklib} {return "env(TK_LIBRARY)"} |
| 222 |
{tcllib} {return "env(TCL_LIBRARY)"} |
| 223 |
{plot_type} {return "ascUtilVect(plot_type)"} |
| 224 |
{plot_command} {return "ascUtilVect(plot_command)"} |
| 225 |
{printer} {return "env(PRINTER)"} |
| 226 |
{print} {return "ascToolVect(printargs)"} |
| 227 |
{webkick} {return "ascHelpVect(restart_command)"} |
| 228 |
{ghostview} {return "ascUtilVect(ghostview)"} |
| 229 |
{edit} {return "ascUtilVect(edit)"} |
| 230 |
{xspread} {return "ascUtilVect(xspread)"} |
| 231 |
default {error "util_get_var called with bad option $defsub"} |
| 232 |
} |
| 233 |
} |
| 234 |
|
| 235 |
# |
| 236 |
# proc Util_do_OK {} |
| 237 |
#------------------------------------------------------------------------ |
| 238 |
# any return from here before the Destroy leaves the utilbox up. |
| 239 |
# do sanity checks here where those failing cause a return |
| 240 |
#------------------------------------------------------------------------ |
| 241 |
proc Util_do_OK {} { |
| 242 |
global ascUtilSubs ascUtilVect |
| 243 |
foreach i $ascUtilSubs { |
| 244 |
set s [Util_Get_Var $i] |
| 245 |
set aname [lindex [split $s (] 0] |
| 246 |
global $aname |
| 247 |
set $s [string trim [set $s]] |
| 248 |
} |
| 249 |
if {[catch {Tool_set_dir} ]} {return} |
| 250 |
global ascUtilVect |
| 251 |
if {[catch { set ascUtilVect(asctmp) \ |
| 252 |
[file rootname $ascUtilVect(asctmp) ] } ] } { |
| 253 |
return |
| 254 |
} |
| 255 |
if {![file isdirectory $ascUtilVect(asctmp)] || \ |
| 256 |
![file writable $ascUtilVect(asctmp)]} { |
| 257 |
set str $ascUtilVect(asctmp) |
| 258 |
append str " is not a writable Scratch directory" |
| 259 |
Script_Raise_Alert $str |
| 260 |
return |
| 261 |
} |
| 262 |
Tool_printinstr |
| 263 |
DestroyWindow.util |
| 264 |
} |
| 265 |
|
| 266 |
# |
| 267 |
# proc Util_do_Read {} |
| 268 |
#------------------------------------------------------------------------ |
| 269 |
# Reads in settings from ~/ascdata/ascend-config if that is available. |
| 270 |
#------------------------------------------------------------------------ |
| 271 |
proc Util_do_Read {} { |
| 272 |
global env |
| 273 |
set configread 0 |
| 274 |
|
| 275 |
if {!$configread && [file exists ~/ascdata/ascend-config] && |
| 276 |
[file readable ~/ascdata/ascend-config] && |
| 277 |
("[file type ~/ascdata/ascend-config]" == "file" || |
| 278 |
"[file type ~/ascdata/ascend-config]" == "link")} { |
| 279 |
if {[catch "uplevel {source [glob ~/ascdata/ascend-config]}" ]} { |
| 280 |
puts stderr "error in config file: [glob ~/ascdata/ascend-config]" |
| 281 |
} else { |
| 282 |
set configread 1 |
| 283 |
} |
| 284 |
} |
| 285 |
|
| 286 |
} |
| 287 |
|
| 288 |
# |
| 289 |
# proc Util_do_Save {} |
| 290 |
#------------------------------------------------------------------------ |
| 291 |
# save ~/ascdata/ascend-config. overwrite whatever there. |
| 292 |
#------------------------------------------------------------------------ |
| 293 |
proc Util_do_Save {} { |
| 294 |
global ascUtilVect ascGlobalVect |
| 295 |
|
| 296 |
if {$ascGlobalVect(saveoptions) == 0} { |
| 297 |
puts stdout "cannot write ascend configure file" |
| 298 |
return; |
| 299 |
} |
| 300 |
|
| 301 |
if {[catch {set conffile [open ~/ascdata/ascend-config w]} ]} { |
| 302 |
Script_Raise_Alert "Error writing ~/ascdata/ascend-config." |
| 303 |
return |
| 304 |
} |
| 305 |
|
| 306 |
set ostr \ |
| 307 |
"\# Parameters in this file may be changed, saved, and read at any time." |
| 308 |
puts $conffile $ostr |
| 309 |
puts $conffile "\# Actions in the .ascendrc are only done at startup time." |
| 310 |
set ostr \ |
| 311 |
"\# This file is overwritten when toolbox.utilities.save is pressed." |
| 312 |
puts $conffile $ostr |
| 313 |
puts $conffile "\# Environment variables are not saved and set here." |
| 314 |
set subs [lsort [array names ascUtilVect]] |
| 315 |
foreach s $subs { |
| 316 |
set varname [Util_Get_Var $s] |
| 317 |
set aname [lindex [split $varname (] 0] |
| 318 |
global $varname |
| 319 |
# we don't save environment vars |
| 320 |
if {[string range $varname 0 2] !="env"} { |
| 321 |
puts $conffile " global $aname" |
| 322 |
puts $conffile " set $varname {[.util.box.main_frm.val_frm.$s get]}" |
| 323 |
} |
| 324 |
} |
| 325 |
close $conffile |
| 326 |
puts stdout "wrote config file." |
| 327 |
} |
| 328 |
|
| 329 |
# |
| 330 |
# proc Util_do_Help {} |
| 331 |
#------------------------------------------------------------------------ |
| 332 |
# Util Help button |
| 333 |
#------------------------------------------------------------------------ |
| 334 |
proc Util_do_Help {} { |
| 335 |
Help_button utilities |
| 336 |
} |
| 337 |
|
| 338 |
# |
| 339 |
# proc ascFindFile {filename code args} |
| 340 |
#------------------------------------------------------------------------ |
| 341 |
# File find procedure. baa 3-94 |
| 342 |
# given a filename, a control code, and zero or more searchpaths, |
| 343 |
# will return the first, last or all matches to a filename in the |
| 344 |
# search paths. |
| 345 |
# paths are searched in the order given and may be compound paths |
| 346 |
# separated by colons. |
| 347 |
# Each match is returned as a full path name. |
| 348 |
# filename is first warped to the nativename format |
| 349 |
# If file starts with / or ~ file will be globbed and the first match |
| 350 |
# returned rather than searched for. |
| 351 |
# under windoze, \ or ~ will be globbed instead of / and ~. |
| 352 |
# |
| 353 |
# If no path is given, . will be assumed. |
| 354 |
# If some path is given, . will NOT be assumed |
| 355 |
# If redundant paths are given, redundant entries will be returned |
| 356 |
# on the list. |
| 357 |
# |
| 358 |
# code must be one of: first last all |
| 359 |
# for all, return is a list of name elements |
| 360 |
# for first or last return is a single full path name |
| 361 |
#------------------------------------------------------------------------ |
| 362 |
proc ascFindFile {filename code args} { |
| 363 |
global tcl_platform |
| 364 |
set filename [file nativename $filename] |
| 365 |
switch $code { |
| 366 |
{first} - |
| 367 |
{last} - |
| 368 |
{all} {} |
| 369 |
default {error "bad call to ascFindFile: want first last or all"} |
| 370 |
} |
| 371 |
if {[file exists $filename]} { |
| 372 |
if {[file readable $filename]} { |
| 373 |
return $filename |
| 374 |
} |
| 375 |
} |
| 376 |
set fc [string range $filename 0 0] |
| 377 |
if {($fc == "/" ) || |
| 378 |
($fc == "\\" && $tcl_platform(platform)=="windows") } { |
| 379 |
return $filename |
| 380 |
} |
| 381 |
if {$fc == "~"} { |
| 382 |
if {[catch {set tfile [lindex [glob $filename] 0]} foo ]} { |
| 383 |
puts stderr $foo |
| 384 |
return "" |
| 385 |
} { |
| 386 |
return $tfile |
| 387 |
} |
| 388 |
} |
| 389 |
if {$args == ""} {set searchlist "."} {set searchlist ""} |
| 390 |
foreach p $args { |
| 391 |
set dlist "" |
| 392 |
if {$tcl_platform(platform)=="unix"} { |
| 393 |
set dlist [split $p :] |
| 394 |
} |
| 395 |
if {$tcl_platform(platform)=="windows"} { |
| 396 |
set dlist [split $p \;] |
| 397 |
} |
| 398 |
foreach d $dlist { |
| 399 |
lappend searchlist $d ;# redundant? |
| 400 |
} |
| 401 |
} |
| 402 |
set foundlist "" |
| 403 |
set SLASH "/" |
| 404 |
if {$tcl_platform(platform)=="windows"} { |
| 405 |
set SLASH "\\" |
| 406 |
} |
| 407 |
foreach d $searchlist { |
| 408 |
if {[file exists "${d}${SLASH}$filename"]} { |
| 409 |
if {![file readable "${d}${SLASH}$filename"]} { |
| 410 |
puts stderr "Cannot read $d$SLASH$filename (permission denied)" |
| 411 |
} else { |
| 412 |
lappend foundlist ${d}${SLASH}$filename |
| 413 |
if {$code == "first"} { |
| 414 |
return [file nativename [lindex $foundlist 0]] |
| 415 |
} |
| 416 |
} |
| 417 |
} |
| 418 |
} |
| 419 |
if {$code == "last"} { |
| 420 |
return [file nativename [lindex $foundlist end]] |
| 421 |
} |
| 422 |
return [file nativename $foundlist] |
| 423 |
} |
| 424 |
|
| 425 |
# |
| 426 |
# proc Util_Label_Width {} |
| 427 |
#------------------------------------------------------------------------ |
| 428 |
# pick out the maximum width of a Util window label |
| 429 |
#------------------------------------------------------------------------ |
| 430 |
proc Util_Label_Width {} { |
| 431 |
global ascUtilVect |
| 432 |
set items [array names ascUtilVect] |
| 433 |
set wid 0 |
| 434 |
foreach i $items { |
| 435 |
set sl [string length "[Util_Get_Label $i]"] |
| 436 |
if {[expr $sl > $wid]} {set wid $sl} |
| 437 |
} |
| 438 |
return $wid |
| 439 |
} |
| 440 |
|
| 441 |
proc set_Print_Defaults {} { |
| 442 |
global tcl_platform ascPrintVect env |
| 443 |
set ascPrintVect(grab) 1 |
| 444 |
set ascPrintVect(cancellable) 1 |
| 445 |
set ascPrintVect(entrywidth) 20 |
| 446 |
set ascPrintVect(npages) 1 |
| 447 |
set ascPrintVect(toplevel) .printconfig |
| 448 |
set ascPrintVect(title) "Printer setup" |
| 449 |
set ascPrintVect(helpcommand) {Help_button print} |
| 450 |
set ascPrintVect(usercheckcommand) Print_checkinput |
| 451 |
set ascPrintVect(whenokcommand) "" |
| 452 |
set ascPrintVect(namelist) [list \ |
| 453 |
destination \ |
| 454 |
printername \ |
| 455 |
filename \ |
| 456 |
enscriptflags \ |
| 457 |
customcommand \ |
| 458 |
] |
| 459 |
if {$tcl_platform(platform) == "unix"} { |
| 460 |
set ascPrintVect(destination.choices) [list \ |
| 461 |
{Print} \ |
| 462 |
{Write to file} \ |
| 463 |
{Append to file} \ |
| 464 |
{Enscript} \ |
| 465 |
{Custom} |
| 466 |
] |
| 467 |
} else { |
| 468 |
# until we can cope with PC idiocy |
| 469 |
set ascPrintVect(destination.choices) Print |
| 470 |
} |
| 471 |
set ascPrintVect(destination) {Print} |
| 472 |
set ascPrintVect(destination.type) string |
| 473 |
set ascPrintVect(destination.label) Destination |
| 474 |
set ascPrintVect(filename) Noname |
| 475 |
set ascPrintVect(filename.type) string |
| 476 |
set ascPrintVect(filename.label) "Name of file" |
| 477 |
|
| 478 |
set ascPrintVect(enscriptflags) {-2rG} |
| 479 |
set ascPrintVect(enscriptflags.type) string |
| 480 |
set ascPrintVect(enscriptflags.label) "Enscript flags" |
| 481 |
|
| 482 |
set ascPrintVect(customcommand) {>> /dev/null cat} |
| 483 |
set ascPrintVect(customcommand.type) string |
| 484 |
set ascPrintVect(customcommand.label) "User print command" |
| 485 |
|
| 486 |
# set the default printer name to mirage, then overwrite it with the |
| 487 |
# value in the PRINTER or LPDEST environment variable. Finally, set |
| 488 |
# the PRINTER environment variable so the Utilities window will |
| 489 |
# display the current printer |
| 490 |
set ascPrintVect(printername) mirage |
| 491 |
if {[catch {set ascPrintVect(printername) $env(PRINTER)}]} { |
| 492 |
catch {set ascPrintVect(printername) $env(LPDEST)} |
| 493 |
} |
| 494 |
set env(PRINTER) $ascPrintVect(printername) |
| 495 |
|
| 496 |
set ascPrintVect(printername.type) string |
| 497 |
set ascPrintVect(printername.label) "Printer" |
| 498 |
|
| 499 |
if {$tcl_platform(platform) == "unix"} { |
| 500 |
# Use SysV-style `lp' command if on HP-UX, IRIX, or Solaris |
| 501 |
# Use BSD-style `lpr' command everywhere else |
| 502 |
switch -regexp $tcl_platform(os)$tcl_platform(osVersion) { |
| 503 |
HP-UX* - |
| 504 |
IRIX* - |
| 505 |
SunOS5* { |
| 506 |
set ascPrintVect(Print) {lp -d%Printer%} |
| 507 |
set ascPrintVect(Enscript) {enscript %Enscript% -d%Printer%} |
| 508 |
} |
| 509 |
default { |
| 510 |
set ascPrintVect(Print) {lpr -P%Printer%} |
| 511 |
set ascPrintVect(Enscript) {enscript %Enscript% -P%Printer%} |
| 512 |
} |
| 513 |
} ;# endsw |
| 514 |
set ascPrintVect(Write) {> %File% cat} |
| 515 |
set ascPrintVect(Append) {>> %File% cat} |
| 516 |
} else { |
| 517 |
set ascPrintVect(Print) {notepad /p} |
| 518 |
# 3 NOT accessed since only Print is offered under windows. |
| 519 |
set ascPrintVect(Write) {> %File% type} |
| 520 |
set ascPrintVect(Append) {>> %File% type} |
| 521 |
set ascPrintVect(Enscript) {enscript %Enscript%P%Printer%} |
| 522 |
} |
| 523 |
} |
| 524 |
|
| 525 |
proc Print_checkinput {args} { |
| 526 |
global ascToolVect env ascPrintVect |
| 527 |
set option [lindex $ascPrintVect(destination) 0] |
| 528 |
switch $option { |
| 529 |
Print { |
| 530 |
if {"[stringcompact $ascPrintVect(printername)]" == ""} { |
| 531 |
error "You must specify a printer" |
| 532 |
} |
| 533 |
regsub %Printer% $ascPrintVect(Print) \ |
| 534 |
$ascPrintVect(printername) ascToolVect(printargs) |
| 535 |
return |
| 536 |
} |
| 537 |
Write { |
| 538 |
if {"[stringcompact $ascPrintVect(filename)]" == ""} { |
| 539 |
error "You must specify a name for the file written" |
| 540 |
} |
| 541 |
set fname [file nativename $ascPrintVect(filename)] |
| 542 |
if {[file exists $fname]} { |
| 543 |
if {[file isfile $fname] && [file writable $fname]} { |
| 544 |
set not [Script_Raise_Alert "File exists. Ok to replace?" \ |
| 545 |
"Print to file question"] |
| 546 |
if {$not} {error "Please specify a new file name"} |
| 547 |
} else { |
| 548 |
error "Please specify a writable file name" |
| 549 |
} |
| 550 |
} |
| 551 |
regsub %File% $ascPrintVect(Write) $fname ascToolVect(printargs) |
| 552 |
return |
| 553 |
} |
| 554 |
Append { |
| 555 |
if {"[stringcompact $ascPrintVect(filename)]" == ""} { |
| 556 |
error "You must specify a name for the file to append" |
| 557 |
} |
| 558 |
set fname [file nativename $ascPrintVect(filename)] |
| 559 |
if {![file exists $fname]} { |
| 560 |
set not [Script_Raise_Alert "File does not exist. Ok to create?" \ |
| 561 |
"Print to file question"] |
| 562 |
if {$not} {error "Please specify a new file name"} |
| 563 |
} else { |
| 564 |
if {![file isfile $fname] || ![file writable $fname]} { |
| 565 |
error "File not appendable. Please specify a new file name" |
| 566 |
} |
| 567 |
} |
| 568 |
regsub %File% $ascPrintVect(Append) $fname ascToolVect(printargs) |
| 569 |
return |
| 570 |
} |
| 571 |
Enscript { |
| 572 |
if {"[stringcompact $ascPrintVect(printername)]" == ""} { |
| 573 |
error "You must specify a printer" |
| 574 |
} |
| 575 |
regsub %Printer% $ascPrintVect(Enscript) \ |
| 576 |
$ascPrintVect(printername) tmp1 |
| 577 |
regsub %Enscript% $tmp1 \ |
| 578 |
$ascPrintVect(enscriptflags) ascToolVect(printargs) |
| 579 |
return |
| 580 |
} |
| 581 |
Custom { |
| 582 |
if {"[stringcompact $ascPrintVect(customcommand)]" == ""} { |
| 583 |
error "You must specify a custom printing command" |
| 584 |
} |
| 585 |
set ascToolVect(printargs) $ascPrintVect(customcommand) |
| 586 |
return |
| 587 |
} |
| 588 |
default {error "Unknown destination specified to print dialog"} |
| 589 |
} ;# endswitch |
| 590 |
} |
| 591 |
|
| 592 |
proc Print_cancelcheck {args} { |
| 593 |
global ascPrintVect |
| 594 |
return $ascPrintVect(__,cancelled) |
| 595 |
} |
| 596 |
|
| 597 |
# |
| 598 |
# call this and Print_cancelcheck in sequence always |
| 599 |
proc Print_configure {window {destination ""}} { |
| 600 |
global ascToolVect env ascPrintVect |
| 601 |
set g +10+10 |
| 602 |
catch { |
| 603 |
set w [winfo toplevel $window] |
| 604 |
set g "+[winfo x $w]+[winfo y $w]" |
| 605 |
} |
| 606 |
if {$destination !=""} { |
| 607 |
set ascPrintVect(destination) $destination |
| 608 |
} |
| 609 |
ascParPage ascPrintVect $g 1 |
| 610 |
set env(PRINTER) $ascPrintVect(printername) |
| 611 |
set env(LPDEST) $ascPrintVect(printername) |
| 612 |
} |
Parent Directory
| 
Revision Log