Changeset 383
- Timestamp:
- Dec 4, 2009 5:05:15 PM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/addcmds.tcl
- Property rcs:date changed from 2001/04/16 21:25:33 to 2001/04/17 22:46:55
- Property rcs:lines changed from +67 -7 to +76 -163
- Property rcs:rev changed from 1.18 to 1.19
r379 r383 2 2 3 3 proc MakeAddPhaseBox {} { 4 global expmap expgui tcl_platform4 global expmap expgui 5 5 6 6 set expgui(coordList) {} … … 15 15 # no more room 16 16 if {$nextphase == ""} { 17 tk_dialog .phaseerr"Add Phase Error" \18 "There are already 9 phases. You cannot add more." \19 error 0 "OK"17 MyMessageBox -parent . -title "Add Phase Error" \ 18 -message "There are already 9 phases. You cannot add more." \ 19 -icon error 20 20 return 21 21 } … … 112 112 113 113 if {$err != ""} { 114 tk_dialog .phaseerr"Add Phase Error" \115 "The following error(s) were found in your input:\n$err" \116 error 0 "OK"114 MyMessageBox -parent . -title "Add Phase Error" \ 115 -message "The following error(s) were found in your input:\n$err" \ 116 -icon error 117 117 set expgui(oldphaselist) -1 118 118 return … … 289 289 290 290 # convert a file to Win-95 direct access 291 proc WinCvt {file } {291 proc WinCvt {file win} { 292 292 global expgui 293 293 if ![file exists $file] { 294 tk_dialog .warn"Convert Error" \295 "File $file does not exist" question 0 "OK"294 MyMessageBox -parent $win -title "Convert Error" \ 295 -message "File $file does not exist" -icon error 296 296 return 297 297 } … … 300 300 set oldname "[file rootname $file].org" 301 301 if [file exists $oldname] { 302 set ans [ tk_dialog .warn"OK to overwrite?" \303 "File [file tail $oldname] exists in [file dirname $oldname]. OK to overwrite?" question 0\304 "Yes" "No"]305 if $ansreturn302 set ans [MyMessageBox -parent $win -title "OK to overwrite?" \ 303 -message "File [file tail $oldname] exists in [file dirname $oldname]. OK to overwrite?" \ 304 -icon question -type yesno -default yes] 305 if {$ans == "no"} return 306 306 catch {file delete $oldname} 307 307 } … … 336 336 file rename $tmpname $file 337 337 } errmsg] { 338 tk_dialog .warn Notify "Error in conversion:\n$errmsg" warning 0 OK 338 MyMessageBox -parent $win -title Notify \ 339 -message "Error in conversion:\n$errmsg" -icon warning 339 340 } 340 341 return $file … … 363 364 364 365 proc validaterawfile {np inp} { 365 global tcl_platformexpgui newhist366 global expgui newhist 366 367 if {$inp == ""} return 367 368 if [catch {set in [open $inp r]}] { 368 tk_dialog .err "Open error" "Unable to open file $inp" \369 error 0 OK369 MyMessageBox -parent $np -title "Open error" \ 370 -message "Unable to open file $inp" -icon error 370 371 return 371 372 } … … 373 374 foreach child [winfo children $np.bank] {destroy $child} 374 375 # is this a properly formatted file? 375 if {$tcl_platform(platform) == "windows"} { 376 # are lines the correct length? 377 378 #--> can we check that lines are terminated CR-LF? 379 380 set i 0 381 while {[set len [gets $in line]] > 0} { 382 incr i 383 if {$len != 80} { 384 set ans [tk_dialog .err "Read error" \ 385 "File $inp is not direct access. OK to convert?" \ 386 error 0 OK QUIT] 387 if {$ans == 0} { 388 close $in 389 WinCvt $inp 390 set i 0 391 set in [open $inp r] 392 set line {} 393 } else { 394 return 395 } 396 } 397 # scan for BANK lines 398 if {[string first BANK $line] == 0} { 399 scan $line "BANK%d" num 400 lappend newhist(banklist) $num 401 # compute last point 402 set tmax 0 403 catch { 404 scan $line "BANK%d%d%d%s%f%f" num nchan nrec rest start step 405 set tmax [expr ($start + $step*($nchan-1))/100.] 406 } 407 set newhist(tmax$num) $tmax 408 } 409 # check for "Instrument parameter file" line 410 if {$i == 2 && [string first "Instrument parameter" $line] == 0} { 411 validateinstfile $np \ 412 [file join [file dirname $inp] \ 413 [string trim [string range $line 26 end]]] 414 } 415 } 416 } else { 417 # is the file one big record? 418 set len [gets $in line] 419 # a instrument parameter file should be more than 4 lines 420 if {$len <= 4*80} { 421 set ans [tk_dialog .err "Read error" \ 422 "File $inp is not direct access. OK to convert?" \ 423 error 0 OK QUIT] 424 if {$ans == 0} { 376 # -- are lines the correct length & terminated with a CR-LF? 377 fconfigure $in -translation lf 378 set i 0 379 while {[set len [gets $in line]] > 0} { 380 incr i 381 if {$len != 81 || [string range $line end end] != "\r"} { 382 set ans [MyMessageBox -parent $np -title "Convert?" \ 383 -message "File $inp is not in the correct format for GSAS.\nOK to convert?" \ 384 -icon warning -type {OK Quit} -default OK] 385 if {$ans == "ok"} { 386 # convert and reopen the file 425 387 close $in 426 set oldname ${inp}.original 427 file rename $inp $oldname 428 if [catch { 429 exec [file join $expgui(gsasexe) convstod] < \ 430 $oldname > $inp 431 } errmsg] { 432 tk_dialog .warn Notify \ 433 "Error in conversion:\n$errmsg" warning 0 OK 434 } 388 WinCvt $inp $np 389 set i 0 435 390 set in [open $inp r] 391 fconfigure $in -translation lf 436 392 set line {} 437 393 } else { … … 439 395 } 440 396 } 441 seek $in 0 442 set i 0 443 while {[string length [set line [read $in 80]]] == 80} { 444 incr i 445 # scan for BANK lines 446 if {[string first BANK $line] == 0} { 447 scan $line "BANK%d" num 448 lappend newhist(banklist) $num 449 # compute last point 450 set tmax 0 451 catch { 452 scan $line "BANK%d%d%d%s%f%f" num nchan nrec rest start step 453 set tmax [expr ($start + $step*($nchan-1))/100.] 454 } 455 set newhist(tmax$num) $tmax 456 } 457 # check for "Instrument parameter file" line 458 if {$i == 2 && [string first "Instrument parameter" $line] == 0} { 459 validateinstfile $np \ 460 [file join [file dirname $inp] \ 461 [string trim [string range $line 26 end]]] 462 } 397 # scan for BANK lines 398 if {[string first BANK $line] == 0} { 399 scan $line "BANK%d" num 400 lappend newhist(banklist) $num 401 # compute last point 402 set tmax 0 403 catch { 404 scan $line "BANK%d%d%d%s%f%f" num nchan nrec rest start step 405 set tmax [expr ($start + $step*($nchan-1))/100.] 406 } 407 set newhist(tmax$num) $tmax 408 } 409 # check for "Instrument parameter file" line 410 if {$i == 2 && [string first "Instrument parameter" $line] == 0} { 411 validateinstfile $np \ 412 [file join [file dirname $inp] \ 413 [string trim [string range $line 26 end]]] 463 414 } 464 415 } 465 416 # were banks found? 466 417 if {$newhist(banklist) == ""} { 467 tk_dialog .err"Read error" \468 "File $inp has no BANK lines.This is not a valid GSAS data file." \469 error 0 OK418 MyMessageBox -parent $np -title "Read error" \ 419 -message "File $inp has no BANK lines.\nThis is not a valid GSAS data file." \ 420 -icon warning 470 421 return 471 422 } … … 526 477 527 478 proc validateinstfile {np inp} { 528 global tcl_platformexpgui newhist479 global expgui newhist 529 480 if {$inp == ""} return 530 481 if [catch {set in [open $inp r]}] { 531 tk_dialog .err "Open error" "Unable to open file $inp" \532 error 0 OK482 MyMessageBox -parent $np -title "Open error" \ 483 -message "Unable to open file $inp" -icon error 533 484 return 534 485 } … … 536 487 foreach child [winfo children $np.set] {destroy $child} 537 488 # is this a properly formatted file? 538 if {$tcl_platform(platform) == "windows"} { 539 # are lines the correct length? 540 541 #--> can we check that lines are terminated CR-LF? 542 543 while {[set len [gets $in line]] > 0} { 544 if {$len != 80} { 545 set ans [tk_dialog .err "Read error" \ 546 "File $inp is not direct access. OK to convert?" \ 547 error 0 OK QUIT] 548 if {$ans == 0} { 549 close $in 550 WinCvt $inp 551 set in [open $inp r] 552 set line {} 553 } else { 554 return 555 } 556 } 557 # scan for the INS BANK line 558 if {[string first "INS BANK" $line] == 0} { 559 set newhist(instbanks) \ 560 [string trim [string range $line 12 end]] 561 } 562 } 563 } else { 564 # is the file one big record? 565 set len [gets $in line] 566 if {$len <= 80} { 567 set ans [tk_dialog .err "Read error" \ 568 "File $inp is not direct access. OK to convert?" \ 569 error 0 OK QUIT] 570 if {$ans == 0} { 489 # -- are lines the correct length & terminated with a CR-LF? 490 fconfigure $in -translation lf 491 while {[set len [gets $in line]] > 0} { 492 if {$len != 81 || [string range $line end end] != "\r"} { 493 set ans [MyMessageBox -parent $np -title "Convert?" \ 494 -message "File $inp is not in the correct format for GSAS.\nOK to convert?" \ 495 -icon warning -type {OK Quit} -default OK] 496 if {$ans == "ok"} { 497 # convert and reopen the file 571 498 close $in 572 set oldname ${inp}.original 573 file rename $inp $oldname 574 if [catch { 575 exec [file join $expgui(gsasexe) convstod] < \ 576 $oldname > $inp 577 } errmsg] { 578 tk_dialog .warn Notify \ 579 "Error in conversion:\n$errmsg" warning 0 OK 580 } 499 WinCvt $inp $np 581 500 set in [open $inp r] 501 fconfigure $in -translation lf 582 502 set line {} 583 503 } else { … … 585 505 } 586 506 } 587 seek $in 0 588 while {[string length [set line [read $in 80]]] == 80} { 589 # scan for the INS BANK line 590 if {[string first "INS BANK" $line] == 0} { 591 set newhist(instbanks) \ 592 [string trim [string range $line 12 end]] 593 } 507 # scan for the INS BANK line 508 if {[string first "INS BANK" $line] == 0} { 509 set newhist(instbanks) \ 510 [string trim [string range $line 12 end]] 594 511 } 595 512 } 596 513 # were banks found? 597 514 if {$newhist(instbanks) == ""} { 598 tk_dialog .err "Read error"\599 "File $inp has no INS BANK line.This is not a valid GSAS Instrument Parameter file." \600 error 0 OK515 MyMessageBox -parent $np -title "Read error" -message \ 516 "File $inp has no \"INS BANK\" line.\nThis is not a valid GSAS Instrument Parameter file." \ 517 -icon warning 601 518 return 602 519 } … … 652 569 653 570 if {$err != ""} { 654 # tk_dialog .phaseerr "Add Histogram Error" \655 # "The following error(s) were found in your input:\n$err" \656 # error 0 "OK"657 571 MyMessageBox -parent $np -title "Add Histogram Error" \ 658 572 -message "The following error(s) were found in your input:\n$err" \ … … 1426 1340 1427 1341 if {$err != ""} { 1428 tk_dialog .phaseerr "Replace Phase Error" \ 1429 "The following error(s) were found in your input:\n$err" \ 1430 error 0 "OK" 1342 MyMessageBox -parent $top -title "Replace Phase Error" -icon warning \ 1343 -message "The following error(s) were found in your input:\n$err" 1431 1344 return 1432 1345 }
Note: See TracChangeset
for help on using the changeset viewer.