This file is indexed.

/usr/share/xcrysden/Tcl/propC95.tcl is in xcrysden-data 1.5.60-1build3.

This file is owned by root:root, with mode 0o644.

The actual contents of the file can be viewed below.

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
#############################################################################
# Author:                                                                   #
# ------                                                                    #
#  Anton Kokalj                                  Email: Tone.Kokalj@ijs.si  #
#  Department of Physical and Organic Chemistry  Phone: x 386 1 477 3523    #
#  Jozef Stefan Institute                          Fax: x 386 1 477 3811    #
#  Jamova 39, SI-1000 Ljubljana                                             #
#  SLOVENIA                                                                 #
#                                                                           #
# Source: $XCRYSDEN_TOPDIR/Tcl/propC95.tcl                                       
# ------                                                                    #
# Copyright (c) 1996-2014 by Anton Kokalj                                   #
#############################################################################

proc PropC95Cmd {cmd} {
    global prop system grafdata periodic err
    
    xcDebug "\nIn PropC95Cmd; prop(newk) == $prop(newk);   cmd == $cmd\n"
    
    # there are some properties, that are caracteristic for periodic systems
    set perlist [list BWID DOSS BAND]
    foreach com $perlist {
	if { $cmd == $com && $periodic(dim) == 0} {
	    #return silently
	    return
	}
    }

    # delete old unit-25
    if { [file exists $prop(dir)/$prop(file)25] } {
	file delete $prop(dir)/$prop(file)25
    }

    # INFO
    set info 0
    if { $cmd == "INFO" } {
	set input "BASE\n0\n"
	if { $periodic(dim) > 0 } {
	    set button [tk_dialog [WidgetName] Question \
		    "Do You want \"band widths\" to be included in INFO record" question 0 Yes No]
	    if { $button == 0 } {
		set info 1
		if ![RunC95 $system(c95_properties) err "END\n"] {
		    return
		}
		append input [NEWK_Init]
		GetC95Info BWID $system(SCRDIR)/xc_output.$system(PID)
		append input "BWID\n1 $prop(n_band)\n"
	    }
	}
	append input "END\n"
	if ![RunC95 $system(c95_properties) err $input] {
	    return
	}
	DispC95Output $system(SCRDIR) {} "INFO: $prop(unit9)" 1
	return
    }

    # 
    # do user want to run PropC95Cmd that require NEWK ????
    # NOTE: band do not require NEWK, but if we want correct Fermi Energy
    #       to be displayed on the spaghetti-graphs, this is needed !!!
    #
    set newk_cmd_list [list BWID DOSS BAND] 
    foreach newkcmd $newk_cmd_list {
    	if { $cmd == $newkcmd } {
	    set prop(newk) 1
	    set prop(newk_script) [NEWK_Init]	
	    if { $prop(newk_script) == "" } {
		set prop(newk) 0
		return
	    }
	    break
	}
    }

    if { $cmd == "BWID" } {		
	GetC95Info BWID $system(SCRDIR)/xc_output.$system(PID)

	# SINTAX selband will be {{alfa band} {betaband}}
	# SelBandIntv $prop(n_band)
	set input "$prop(newk_script)BWID\n1 $prop(n_band)\nEND\n"

	# run properties program
	if { ![RunC95 $system(c95_properties) {message "CRYSTAL program is calculating band widths.\nIt can take some time, so PLEASE WAIT !!!"} $input \
		   {} "BAND LIMITS" $system(SCRDIR)] } {
	    # error occure
	    #tk_dialog .err "ERROR" "ERROR: $err" error 0 OK
	    return
	}

	# update crystal95's output
	DispC95Output $system(SCRDIR) {} {} 1
	
	# now load a Graph
	set id [NextGrapherID]
	set grafdata($id,Xtitle) "Band Widths: $prop(unit9)"
	set grafdata($id,Xicon) "Band Widths"
	BWIDGraph $system(SCRDIR)/xc_output.$system(PID)
	Grapher BARGraph
	set cmd ""
	return
    }

    if { $cmd == "DOSS" } {
	global doneDOSS
	if ![info exists prop(NPRO)] { set prop(NPRO) 0 }
	GetC95Info DOSS $system(SCRDIR)/xc_output.$system(PID)

	DOSS_Init
	if { $doneDOSS == 0 } {
	    return
	}
	
	xcDebug "after DOSS_Init"
	# T.K.: now I must set prop(N,$i) for each $i
	for {set i 1} {$i <= $prop(NPRO)} {incr i} {
	    set prop(N,$i) [llength $prop(NDM,$i)]
	}
	set    input "$prop(newk_script)"
	append input "DOSS\n"
	append input "$prop(NPRO) $prop(NPT) $prop(firstband) \
		$prop(lastband) 1 $prop(NPOL) $prop(NPR)\n"
	if { $prop(firstband) < 0 && $prop(lastband) < 0 } {
	    append input "$prop(BMI) $prop(BMA)\n"
	}
	for {set i 1} {$i <= $prop(NPRO)} {incr i} {
	    if { $prop(proj_NPRO,$i) != "set of N AOs" && $prop(N,$i) > 0} {
		set prop(N,$i) -$prop(N,$i)
	    }
	    append input "$prop(N,$i) $prop(NDM,$i)\n"
	}
	append input "END\n"
	# run properties program
	if ![RunC95 $system(c95_properties) err $input {} {} $system(SCRDIR)] {
	    # error occure
	    #tk_dialog .err "ERROR" "ERROR: $err" error 0 OK
	    return
	}
	xcDebug "BEFORE DOSSGraph"

	# update crystal95's output
	DispC95Output $system(SCRDIR)

	# now load a Graph
	set id [NextGrapherID]
	set grafdata($id,Xtitle) "Density of States: $prop(unit9)"
	set grafdata($id,Xicon) "Density of States"
	DOSSGraph $prop(NPRO)
	Grapher XYGraph
	return
    }

    if { $cmd == "BAND" } {
	global BzOK
	if { ! [info exists prop(NPRO)] } { 
	    set prop(NPRO) 0 
	}
	GetC95Info DOSS $system(SCRDIR)/xc_output.$system(PID)
	
	if { [Bz_MakeToplevel] == 0 } {
	    return
	}
	#if { $BzOK(done) == 0 } {
	#    # cancel button was pressed; RETURN
	#    return
	#}
	append prop(c95_BAND_script) "END\n"
	xcDebug "BAND_Init: 1"
	if { ![RunC95 $system(c95_properties) err $prop(c95_BAND_script) \
		   {} {} $system(SCRDIR)] } {
	    # error occure
	    #tk_dialog .err "ERROR" "ERROR: $err" error 0 OK
	    return
	}
	xcDebug "BEFORE BANDGraph"

	# update crystal95's output
	DispC95Output $system(SCRDIR)

	# now load a Graph
	set id [NextGrapherID]
	set grafdata($id,Xtitle) "Band Structure: $prop(unit9)"
	set grafdata($id,Xicon)  "Band Structure"
	BANDGraph $prop(NLINE)
	Grapher XYGraph    
	return
    }
}


##############################################################################
# NEWK
# proc return NEWK-block for runing "properties" program
proc NEWK_Init {} {    
    global periodic done newk prop system

    if { ! [info exists prop(IS)]  }  { set prop(IS) 0 }
    if { ! [info exists prop(ISHF)] } { set prop(ISHF) 0 }
    if { ! [info exists prop(ISP)]  } { set prop(ISP) 0 }

    if { $periodic(dim) > 0 } {
	set t [xcToplevel .bwid "NEWK Options" "NEWK" . 100 50 1]
	catch { grab $t }
	set f1 [frame $t.f1 -relief raised -bd 2]
	pack $f1 -side top -fill both -ipady 10
	frame $f1.f1 -relief flat
	frame $f1.f2 -relief flat

	if ![info exists newk(option)] {
	    set newk(option) "Same as in SCF"
	}
	if ![info exists newk(IFE)] {
	    set newk(IFE) "Yes"
	}
	pack $f1.f1 $f1.f2 -side top -padx 10 -fill both -expand 1
	
	if { $system(c95_version) != "06" && $system(c95_version) != "09" && $system(c95_version) != "14" } {
	    #
	    # CRYSTAL prior to version-06
	    #
	    RadioButVarCmd $f1.f1 "Which (IS,ISHF,ISP) values to take:" \
		newk(option) NEWK_RadioButCmd top left 1 1 \
		"Same as in SCF" "New (IS,ISHF,ISP) values" 
	} else {
	    #
	    # CRYSTAL06 or later
	    #
	    RadioButVarCmd $f1.f1 "Which (IS,ISP) values to take:" \
		newk(option) NEWK_RadioButCmd top left 1 1 \
		"Same as in SCF" "New (IS,ISP) values" 
	}

	RadioBut $f1.f2 "Calculate Fermi Energy:" \
	    newk(IFE) left left 1 1 \
	    "Yes" "No"
	
	message $f1.msg -justify center -aspect 400 -text \
		"\nWARNING: In order to obtain correct Fermi energy and \
		eigenvalues spectra when a shift of eigenvalues was \
		requested in SCF (LEVSHIFT, SPINLOCK)\n it is required to\
		re-calculate Fermi energy" 
	pack $f1.msg -side bottom -padx 10 -pady 10

	set f2 [frame $t.f2 -relief raised -bd 2]	
	set ok [button $f2.ok -text "OK" -command [list NEWK_OK $t]]
	set can [button $f2.can -text "Cancel" -command [list NEWK_Can $t]]
	pack $f2 -side bottom -fill x 
	pack $ok $can -side left -expand 1 -padx 10 -pady 10
    }

    tkwait variable done    
    # if cancel button was pressed, return 0
    if $newk(cancel) { return }

    if { $newk(IFE) == "Yes" } {
	set prop(IFE) 1
    } else {
	set prop(IFE) 0
    }
    set prop(NPR) 0

    #
    # NEWK
    # is (ishf) isp
    # if (is==0 && dim>0) is1 is2 is3
    # ife npr
    #

    set    input "NEWK\n"
    if { $system(c95_version) != "06" && $system(c95_version) != "09" && $system(c95_version) != "14" } {
	#
	# CRYSTAL prior to version-06
	#
	append input "$prop(IS) $prop(ISHF) $prop(ISP)\n"
    } else {
	#
	# CRYSTAL06 or later
	#
	append input "$prop(IS) $prop(ISP)\n"
    }	
    if { $periodic(dim) > 0 } {
	# add IS1 IS2 IS3 support
	#append input "$prop(IS1) $prop(IS2) $prop(IS3)\n"
    }
    append input "$prop(IFE) $prop(NPR)\n"
    
    return $input
}


proc NEWK_RadioButCmd {what} {
    global prop

    if { $what == "Same as in SCF" } {
	set prop(IS)   0
	set prop(ISHF) 0
	set prop(ISP)  0
    } else {
	NEWK_IS_ISHF_ISP
    }
}


proc NEWK_IS_ISHF_ISP {} {
    global prop ok system periodic

    set oldgrab [grab current]
    set t [xcToplevel .newkis "Enter values" "NEWK" . 120 70 1]    
    set f1  [frame $t.f1 -relief raised -bd 2]
    set f11 [frame $t.f11 -relief raised -bd 2]
    set f2  [frame $t.f2 -relief raised -bd 2]

    if { $system(c95_version) != "06" && $system(c95_version) != "09" && $system(c95_version) != "14" } {
	#
	# CRYSTAL prior to version-06
	#
	Entries $f1 {IS: ISHF: ISP:} {prop(IS) prop(ISHF) prop(ISP)} 3
	set varlist [list {prop(IS) posint} {prop(ISHF) posint} {prop(ISP) posint}]
	set foclist [list $f1.frame.entry1 $f1.frame.entry2 $f1.frame.entry3]
    } else {
	#
	# CRYSTAL06 or later
	#
	Entries $f1 {IS: ISP:} {prop(IS) prop(ISP)} 2
	set varlist [list {prop(IS) posint} {prop(ISP) posint}]
	set foclist [list $f1.frame.entry1 $f1.frame.entry2]
    }
    
    # if { $periodic(dim) > 0 } {
    # 	# add IS1 IS2 IS3 support
    # 	Entries $f11 {IS1 IS2 IS3} {prop(IS1) prop(IS2) prop(IS3)} 3
    # 	append varlist " {prop(IS1) posint} {prop(IS2) posint} {prop(IS3) posint}"
    # 	append foclist " $f11.frame.entry1 $f11.frame.entry2 $f11.frame.entry3"
    # }
    focus $f1.frame.entry1

    set ok  [button $f2.ok -text OK \
	    -command [list check_var $varlist $foclist]]
    set can [button $f2.can -text Cancel -command NEWK_IS_Can]

    pack $f1 $f11 $f2 -side top -fill both
    pack $ok $can -side left -expand 1 -padx 10 -pady 10

    update
    catch { grab $t }

    tkwait variable ok
    if { [winfo exists $t] } { 
	catch { grab release $t }
	destroy $t 
    }
    if { $oldgrab != "" } {
	catch { grab $oldgrab }
    }
}


proc NEWK_IS_Can {} {
    global prop ok newk
    
    set prop(IS)     0
    set prop(ISHF)   0
    set prop(ISP)    0
    set newk(option) "Same as in SCF"
    set ok           1
}


proc NEWK_Can {t} {
    global done newk

    set done 1
    set newk(cancel) 1
    if { [winfo exists $t] } { 
	catch { grab release $t }
	destroy $t 
    }
}


proc NEWK_OK {t} {
    global done newk

    puts stdout "NEWK_OK"
    set done 1
    set newk(cancel) 0
    if { [winfo exists $t] } { 
	catch { grab release $t }
	destroy $t 
    }
}


proc SelBandIntv w {
    global prop done
    
    set l [label $w.l \
	    -text "Number of Bands:   $prop(n_band)" \
	    -relief flat -anchor w]
    set font [$l cget -font]
    set font [ModifyFont $font $l -underline 1 -weight bold]
    $l config -font $font
    set l1 [label $w.l1 -text \
	    "Please choose the range of bands to consider:" \
	    -relief flat -anchor w]
    pack $l $l1 -side top -padx 5 -fill x -expand 1
    set foclist [OneEntries $w {"First band to consider:" \
	    "Last band to consider:"} \
	    {prop(firstband) prop(lastband)} 37 8 5 -fill x -expand 1]
    return $foclist
}


proc SelEnerIntv {w} {
    global prop ok

    # in future I will have to make some mechanism to check in energy 
    # interval is correctly entered
    xcDebug "inSelEnerIntv"

    set l1 [label $w.l1 -text \
	    "Please enter energy interval for DOSS calculation:\n(Boundaries of energy interval must be in a band gap !!!)" \
	    -relief flat -justify left -anchor w]

    pack $l1 -side top -pady 5 -fill x -expand 1
    OneEntries $w {"Minimum Energy:" "Maximum Energy:"} \
	    {prop(BMI) prop(BMA)} 37 8
}


#proc checkIntv {varlist foclist lastvar last focus} {
#    global ok done
#    upvar #0 $lastvar var
#
#    puts stdout "lastvar = $lastvar"
#    check_var $varlist $foclist
# 
#    if [info exist ok] {
#	if $ok {
#	    if { $last >= $var } {
#		set done 1
#	    } else {
#		tk_dialog .num ERROR "ERROR !\nYou have specified to large \
#			number for \"$lastvar\" variable. It should be \
#			lower or equal to $last" error 0 OK
#		set focus $focus
#	    }
#	}
#    }
#}


##############################################################################
# DENSITY OF STATES
proc DOSS_Init {} {
    global prop doneDOSS

    set doneDOSS 0

    set t [xcToplevel [WidgetName] "Density od States" "DOSS" . 100 50 1]
    catch { grab $t }
    set f [frame $t.f -relief raised -bd 2]
    set f2 [frame $t.f2 -relief raised -bd 2]    
    set f3 [frame $t.f3 -relief raised -bd 2]
    set f4 [frame $t.f4 -relief raised -bd 2]
    set f5 [frame $t.f5 -relief raised -bd 2]
    pack $f $f2 $f3 $f4 $f5 -expand 1 -fill both -side top   

    set ff1 [frame $f.1 -relief groove -borderwidth 2]
    pack $ff1 -side top -padx 2 -pady 2 -fill x -expand 1
    set sc [scale $ff1.scale -from 0 -to 10 -length 100 -variable prop(NPRO) \
	    -orient horizontal -label "Number of DOS projections:" \
	    -tickinterval 2 \
	    -digits 2 -resolution 1 -showvalue true -width 10]
    pack $sc -side top -fill x -padx 5

    if ![info exists prop(doss_criteria)] {
	set prop(doss_criteria) "band-interval criteria"
    } 

    set ff2 [frame $f.2 -relief flat]
    RadioBut $ff2 "Select criteria for spanning DOS:" \
	    prop(doss_criteria) top left 1 1 \
	    "band-interval criteria" "energy-interval criteria"     
    trace variable prop(doss_criteria) w xcTrace
    ##########################################################################
    OneEntries $f2 {"Number of uniformly spaced energy points:" \
	    "Number of Legendre polynomials:"} \
	    {prop(NPT) prop(NPOL)} 37 8
    focus $f2.frame1.entry1
    set varlist [list {prop(NPT) posint} {prop(NPOL) posint}]
    set foclist [list $f2.frame1.entry1 $f2.frame2.frame1]
    pack $ff2 -side top -expand 1 -fill x 
    ###########################################################################
    # BAND INTERVAL
    SelBandIntv $f3
    set prop(bandIntv_labels)  \
	    [list $f3.l $f3.l1 $f3.frame1.lab1 $f3.frame2.lab2]
    set prop(bandIntv_entries) [list $f3.frame1.entry1 $f3.frame2.entry2]

    append varlist " {prop(firstband) posint} {prop(lastband) posint}"
    append foclist " $f3.frame1.entry1 $f3.frame2.entry2"
	
    ###########################################################################
    # ENERGY INTERVAL
    SelEnerIntv $f4
    set prop(enerIntv_labels)  [list $f4.l1 $f4.frame1.lab1 $f4.frame2.lab2]
    set prop(enerIntv_entries) [list $f4.frame1.entry1 $f4.frame2.entry2]

    append varlist " {prop(BMI) real} {prop(BMA) real}"
    append foclist " $f4.frame1.entry1 $f4.frame2.entry2"

    proc DOSS_Init_BandIntv {} {
	global prop
	set dis_c [GetWidgetConfig button -disabledforeground]
	set ena_c [GetWidgetConfig button -foreground]
	# disable "ENERGY-INTERVAL"
	foreach lab $prop(enerIntv_labels) {
	    $lab config -fg $dis_c
	}
	foreach entry $prop(enerIntv_entries) {
	    $entry config -relief flat -state disabled
	}
	# enable "BAND-INTERVAL"
	foreach lab $prop(bandIntv_labels) {
	    $lab config -fg $ena_c
	}
	foreach entry $prop(bandIntv_entries) {
	    $entry config -relief sunken -state normal
	}
    }
    
    proc DOSS_Init_EnerIntv {} {
	global prop
	set dis_c [GetWidgetConfig button -disabledforeground]
	set ena_c [GetWidgetConfig button -foreground]
	# enable "ENERGY-INTERVAL"
	foreach lab $prop(enerIntv_labels) {
	    $lab config -fg $ena_c
	}
	foreach entry $prop(enerIntv_entries) {
	    $entry config -relief sunken -state normal
	}
	foreach lab $prop(bandIntv_labels) {
	    $lab config -fg $dis_c
	}
	foreach entry $prop(bandIntv_entries) {
	    $entry config -relief flat -state disabled
	}
    }
    #
    # query the prop(doss_criteria) state
    #
    trace variable prop(doss_criteria) w xcTrace
    xcTrace prop doss_criteria w
        
    set ok [button $f5.ok -text "OK" \
	    -command [list DOSS_Init2 $t $varlist $foclist]]
    set can [button $f5.can -text "Cancel" -command [list DOSS_InitCan $t]]
    pack $can $ok -side left -expand 1 -padx 10 -pady 10
    
    tkwait variable doneDOSS
    # delete prop(doss_criteria)'s trace
    xcTraceDelete prop(doss_criteria)
    
    xcDebug "end of DOSS_Init"
    return 1
}
    

proc DOSS_InitCan tplw {
    global doneDOSS
    xcTraceDelete prop(doss_criteria)
    CancelProc $tplw doneDOSS 
}

proc DOSS_Init2 {t varlist foclist} {
    global prop doneDOSS

    if { $prop(doss_criteria) == "band-interval criteria" } {
	set varl [lrange $varlist 0 3]
    } else {
	set varl [lrange $varlist 0 1]
	append varl " [lrange $varlist 4 5]"
	set prop(firstband) -1
	set prop(lastband)  -1
    }
    if ![check_var $varl $foclist] {
	return
    }
    # check if band interval is specified correctly:
    if { $prop(doss_criteria) == "band-interval criteria" } {
	if { $prop(firstband) < 1 } {
	    tk_dialog [WidgetName] ERROR \
		    "ERROR: Lowest boundary of band-interval \"$prop(firstband)\" is out of range, should be greater than 0. Try Again !!!" \
		    error 0 OK
	    focus [lindex $foclist 2]
	    return
	}
	if { $prop(lastband) > $prop(n_band) } {
	    tk_dialog [WidgetName] ERROR \
		    "ERROR: Upper boundary of band-interval \"$prop(firstband)\" is out of range, should be lower or equal than $prop(n_band). Try Again !!!" error 0 OK
	    focus [lindex $foclist 3]
	    return
	}
	if { $prop(firstband) > $prop(lastband) } {
	    tk_dialog [WidgetName] ERROR \
		    "ERROR: Lowest boundary of band-interval \"$prop(firstband)\" greater than upper boundary \"$prop(lastband)\". Try Again !!!" \
		    error 0 OK
	    focus [lindex $foclist 2]
	    return
	}
    }

    xcDebug "DOSS_Init2:: $prop(NPRO)    $prop(doss_criteria)"
    if { [winfo exists $t] } {
	catch { grab release $t }
	destroy $t
    }

    if { $prop(NPRO) > 0 } {
	global donePDOSS
	PDOSS_Init
	set doneDOSS $donePDOSS
    } else {
	set doneDOSS 1
    }
}
    
proc PDOSS_Init {} {
    global prop donePDOSS

    set t [xcToplevel .npro "Projected DOSS" "PDOSS" . 100 50 1]
    catch { grab $t }
    set fb [frame $t.fb]
    pack $fb -side bottom -expand true -fill both 
    # and one frame where canvas&scrollbar will be!!
    set ft [frame $t.ft -relief sunken -bd 2]
    pack $ft -side top -expand true -fill both 
	
    set c [canvas $ft.canv -yscrollcommand [list $ft.yscroll set]]
    set scb [scrollbar $ft.yscroll -orient vertical -command [list $c yview]]
    pack $scb -side right -fill y
    pack $c -side left -fill both -expand true
	
    # create FRAME to hold every LABEL&ENTRY
    set f [frame $c.f -bd 0]
    $c create window 0 0 -anchor nw -window $f
    set varlist ""
    set foclist ""
    for {set i 1} {$i <= $prop(NPRO)} {incr i 1} {	    
	set gro [frame $f.fr$i -relief groove -bd 2]
	pack $f.fr$i -padx 5 -pady 5
	if ![info exists prop(proj_NPRO,$i)] {
	    set prop(proj_NPRO,$i) "set of N AOs"
	}
	RadioBut $gro "Density of states projected onto:" \
		prop(proj_NPRO,$i) top left \
		0 1 "set of N AOs" "set of all AOs of the N atoms" 
	set e [Entries $gro \
		{"Specify sequence numbers of AOs/Atoms for projection:"} \
		prop(NDM,$i) 40 1 top -fill x]
	button $gro.b -text "Select sequence" \
		-command [list SelectSequence $i prop(NDM,$i)]
	pack $gro.b -side left -padx 10 -pady 10
	lappend varlist [list prop(NDM,$i) posint]
	append foclist " $e"
    }

    focus $f.fr1.frame.entry1

    puts stdout "FOCLIST: $foclist\n\n"
    puts stdout "VARLIST: $varlist"
    set child [lindex [pack slaves $f] 0]
    
    # set the focus to first entry that upper FOR-LOOP create
    
    tkwait visibility $child
    set width [winfo width $f]
    set height [winfo height $f]
    if { $prop(NPRO) < 3 } {
	$c config -width $width -height $height 
    } else {
	$c config -width $width -height \
		[expr $height / $prop(NPRO) * 3] \
		-scrollregion "0 0 $width $height"
    }
    
    button $fb.butok -text OK -command \
	    [list PDOSS_InitOK $t $varlist $foclist]
    
    button $fb.butcan -text Cancel -command \
	    [list CancelProc $t donePDOSS]
    
    pack $fb.butok $fb.butcan -side left \
	    -expand 1 -padx 10 -pady 10
    
    tkwait variable donePDOSS
    
    catch { grab release $t }
    destroy $t
}


proc PDOSS_InitOK {t varlist foclist} {
    global donePDOSS

    # varlist has the following shape {varname posint} {varname posint}
    set n 0
    foreach var $varlist {
	xcDebug "PDOSS_InitOK:: var=$var"
	set varn [lindex $var 0]
	upvar #0 $varn val 
	set type [lindex $var 1]
	xcDebug "PDOSS_InitOK:: varn=$varn ; val=$val ; type=$type"
	if { $val == "" } {
	    tk_dialog .number2 ERROR "ERROR !\nYou forget to specify \
		    the \"$varn\" variable. Please do so !" error 0 OK
	    focus [lindex $foclist $n]
	    return
	}
	foreach value $val {
	    if { [catch {expr abs($value)}] } {
		# this CATCH specify if $var is a number;
		# if we get 1 --> not number, else number
		# string is not a number
		dialog .number1 ERROR "ERROR !\nYou have specified a character instead of number for \"$varn\" variable.\
			TRY AGAIN \!" error 0 OK
		focus [lindex $foclist $n]
		return
	    }		
	    if { $value != int($value) || [string match *.* $value] } {
		tk_dialog .number2 ERROR "ERROR !\nYou have specified \
			a non-integer number instead of \
			positive integer number \
			for \"$varn\" variable. TRY AGAIN \!" error 0 OK
		focus [lindex $foclist $n]
		return
	    }
	    if { $value < 0 } {
		tk_dialog .number2 ERROR "ERROR !\nYou have specified \
			a negative integer number instead of positive \
			integer number \
			for \"$varn\" variable. TRY AGAIN \!" error 0 OK
		focus [lindex $foclist $n]
		return
	    }
	}
	incr n
    }
    set donePDOSS 1
}
		

proc SelectSequence {i var} {
    global prop

    set what $prop(proj_NPRO,$i)
    xcDebug "SelectSequence $what $var"
    if { $what == "set of N AOs" } {
	set $var [SelectItems "Select the AOs" $prop(n_band)]
    } elseif { $what == "set of all AOs of the N atoms" } {
	set $var [SelectItems "Select Atoms" $prop(n_atom)]
    }
}


proc SelectItems {title num} {
    global prop done value

    set oldgrab [grab current]
    # if .sband already exists, return silenlty
    if [winfo exists .sband] { return }
    set t [xcToplevel .sband $title $title . 100 50 1]
    catch { grab $t }
    # in the future I will have to know whether I'm dealing with 
    # close or open shell
    set bandlist ""
    for {set i 1} {$i <= $num} {incr i} {
	append bandlist "   $i"
    }

    if { $num > 15 } {
	set h 15
    } else {
	set h $num
    }

    set title "$title\n(to select multiple items:\nCTRL-key + mouse-click)"
    label $t.l -text $title -relief flat
    pack $t.l -side top
    set scr [ScrolledListbox2 $t.f -width 10 -height $h -setgrid true \
	    -selectmode extended]
    eval {$scr insert 0} $bandlist
    button $t.ok -text OK -command [list SelectItemsOK $scr]
    pack $t.ok -side left -padx 10 -pady 10
    
    tkwait variable done
    destroy $t
    if { $oldgrab != "" } { 
	catch { grab $oldgrab }
    }
    return $value
}


proc SelectItemsOK {scr} {
    global done value
    
    set done 1
    set value ""
    set vals [$scr curselection]
    foreach va $vals {
	set v [expr $va + 1]
	append value "$v "
    }
}


proc DispC95Output {output_dir {file {}} {title {}} {newWin 0}} {
    global system prop dispC95out unmapWin

    if ![info exists dispC95out(offset)] {
	set dispC95out(offset) 0
    } else {
	incr dispC95out(offset) 15
	if { $dispC95out(offset) > 200 } {
	   set dispC95out(offset) 0
	} 
    }
    set x [expr -50 + $dispC95out(offset)]
    set y [expr  70 + $dispC95out(offset)] 
    # newWin  ...... if newWin == 1 --> always make a new Toplevel
    if { $file == {} } { 
	set file xc_output.$system(PID)
    }
    set fileID [open $output_dir/$file r]
    set output [read $fileID]
    xcDebug "CRYSTAL OUTPUT output::\n\n$output"
    # if .dispC95 already exists, we will just update the display
    if { $title == {} } {
	set title "Crystal95: Output"
    }

    set update 1
    if $newWin {	
	set dispC95out(tplw) [xcToplevel [WidgetName] $title $title . $x $y 1]
	set update 0
	tkwait visibility $dispC95out(tplw)
	set t $dispC95out(tplw)
	xcRegisterUnmapWindow $t $unmapWin(frame,main) \
		C95output_$t -image unmap-C95output
	bind $t <Unmap> [list xcUnmapWindow unmap %W $t \
		$unmapWin(frame,main) C95output_$t]
	bind $t <Map>   [list xcUnmapWindow map %W $t \
		$unmapWin(frame,main) C95output_$t]
    } elseif ![winfo exists .dispC95] {	
	set dispC95out(tplw) [xcToplevel .dispC95 $title $title . $x $y 1]
	set update 0
	tkwait visibility $dispC95out(tplw)
	set t $dispC95out(tplw)
	xcRegisterUnmapWindow $t $unmapWin(frame,main) \
		C95output_$t -image unmap-C95output
	bind $t <Unmap> [list xcUnmapWindow unmap %W $t \
		$unmapWin(frame,main) C95output_$t]
	bind $t <Map>   [list xcUnmapWindow map %W $t \
		$unmapWin(frame,main) C95output_$t]
    } else {
	# wm title $t $title
	;
    }

    if !$update {
	set f2 [frame $dispC95out(tplw).f2 -height 10]
	pack $f2 -side bottom -fill x
	set close [button $f2.cl -text "Close" \
		 -command [list destroy $dispC95out(tplw)]]
	set hid [button $f2.hid -text "Hide" \
		 -command [list DispC95Output_Hide $t]]
	
	pack $hid $close -side left -expand 1 -ipadx 2 -ipady 2 -pady 10
	tkwait visibility $hid
    }
    set text [DispText $dispC95out(tplw).f1 $output 80 35 1]
    $text configure -state disabled

    close $fileID
    return $dispC95out(tplw) 
}


proc DispC95Output_Hide t {
    global unmapWin
    wm withdraw $t
    xcUnmapWindow unmap $t $t $unmapWin(frame,main) C95output_$t
}
    
#set system(PWD) [pwd]
#set system(PID) [pid]
#set periodic(dim) 3
#set prop(n_band)  20
#set prop(n_atom)  4
#lappend auto_path /home/tone/prog/XCrys/Mesa
#DOSS_Init