# Procs for help messages and simple dialog boxes
# originally borrowed from BYO, and converted to
# use the new (tk 2.2) text widget with formatting
# tags.
#   By Ray R. Larson
#

proc readFileIntoListBox {Filename lbox_pname} {

	# check whether file exists
	if [file exists $Filename]==0 {
		popMessage .errorF FILE ERROR "File does not exist"
		return
	}
	#endif

	set FID [open $Filename r]

	while {1==1} {

		set cnt [gets $FID line]
		# check for eof
		if {$cnt==-1} {break}
		$lbox_pname insert end $line
	}
	#end while

	close $FID

#end readFileIntoListBox
}

proc readFileIntoText {Filename t_name} {

	# check whether file exists
	if [file exists $Filename]==0 {
		popMessage .errorF FILE ERROR "File does not exist"
		return
	}
	#endif

	set FID [open $Filename r]

	# Set up display styles

	$t_name tag configure <normal> -font -Adobe-Helvetica-Bold-R-Normal-*-120-*
	$t_name tag configure <bold> -font -Adobe-Helvetica-Bold-O-Normal-*-120-*
	$t_name tag configure <big> -font -Adobe-Helvetica-Bold-R-Normal-*-140-*
	$t_name tag configure <verybig> -font -Adobe-Helvetica-Bold-R-Normal-*-240-*
    if {[winfo screendepth $t_name] > 4} {
	$t_name tag configure <bgcolor> -background #eed5b7
	$t_name tag configure <red> -foreground #d00
	$t_name tag configure <yellow> -foreground #ff0
	$t_name tag configure <green> -foreground #0a0
	$t_name tag configure <white> -foreground #fff
	$t_name tag configure <black> -foreground #000
	$t_name tag configure <blue> -foreground #33f
	$t_name tag configure <lightblue> -foreground #aaf
	$t_name tag configure <lightgreen> -foreground #5f5
	$t_name tag configure <raised> -background #eed5b7 -relief raised \
		-borderwidth 1
	$t_name tag configure <sunken> -background #eed5b7 -relief sunken \
		-borderwidth 1
	$t_name tag configure <TITLE> -font -Adobe-Helvetica-Bold-R-Normal-*-140-* -foreground #33f
	$t_name tag configure <SUBTITLE> -font -Adobe-Helvetica-Bold-O-Normal-*-140-* -foreground #33f
    } else {
	$t_name tag configure <bgcolor> -background black -foreground white
	$t_name tag configure <red> -background black -foreground white
	$t_name tag configure <yellow>  -background black -foreground white
	$t_name tag configure <green> -background black -foreground white
	$t_name tag configure <white> -background black -foreground white
	$t_name tag configure <black> -background black -foreground white
	$t_name tag configure <blue> -background black -foreground white
	$t_name tag configure <lightblue> -background black -foreground white
	$t_name tag configure <green2> -background black -foreground white
	$t_name tag configure <raised> -background white -relief raised \
		-borderwidth 1
	$t_name tag configure <sunken> -background white -relief sunken \
		-borderwidth 1
	$t_name tag configure <TITLE> -font -Adobe-Helvetica-Bold-R-Normal-*-140-* -foreground black
	$t_name tag configure <SUBTITLE> -font -Adobe-Helvetica-Bold-O-Normal-*-140-* -foreground black
    }
	$t_name tag configure <bgstipple> -background black -borderwidth 0 \
	    -bgstipple gray25
	$t_name tag configure <fgstipple> -fgstipple gray50
	$t_name tag configure <underline> -underline on
        set currenttags {}
 	while {1==1} { 

		set cnt [gets $FID inline]
		# check for eof
		if {$cnt==-1} {break}
                if {[string length $inline]==0} {
			 insertWithTags $t_name "\n\n" $currenttags 
		}
		set all ""
                set prv ""
                set tagcmd ""
		set rem ""
		set match [regexp (^\[^<>\]*)(<\[0-0a-zA-Z\]*>)(.*\$) $inline all prv tagcmd rem]
		if {$match} {
		# puts stdout [format "all= %s : prv = %s : tagcmd = %s : rem = %s" $all $prv $tagcmd $rem ]

                if {[string length "$tagcmd"] > 0} {
			if {[string compare "<normal>" $tagcmd]==0} {
			    insertWithTags $t_name $prv
                            set currenttags {}
			    append rem " "
                            insertWithTags $t_name $rem
                        } else {
				insertWithTags $t_name $prv $currenttags
 				set currenttags $tagcmd
			  	append rem " "
                       		insertWithTags $t_name $rem $currenttags
			}
                   }
		} else { 
			append inline " "
			insertWithTags $t_name $inline $currenttags 
		}
	}
	#end while

	close $FID

#end readFileIntoListBox
}


proc popMessage {w title messag } {
	# pops up a message box with an ok button for the
	# users information - typically used to warn users of
	# the occurrence of errors, exceptional conditions

	catch "destroy $w"
	toplevel $w
	wm title $w $title

	message $w.mess -text $messag -relief raised

	button $w.ok -text "OK" -relief raised -pady 5 -command "destroy $w"

	pack append $w $w.mess {top expand fill}\
                       $w.ok {top expand fillx filly}

#end popMessage
}



proc createHelpListBox {title Filename} {

	set pname .help$title

	catch {destroy .help$title}
	toplevel .help$title
	wm title .help$title "$title"
	wm geometry  .help$title +100+100

	frame .help$title.f1
	scrollbar .help$title.f1.scroll -command ".help$title.f1.txt yview" -relief raised
	text .help$title.f1.txt -yscrollcommand ".help$title.f1.scroll set" \
		 -borderwidth 1 -relief raised -width 50 -height 20 \
		 -padx 20 -pady 5 -wrap word -setgrid 1 \
 		 -font -Adobe-Helvetica-Bold-R-Normal-*-120-*
	pack append .help$title.f1 .help$title.f1.txt {left expand fill}\
                                   .help$title.f1.scroll {left filly}

	button .help$title.ok -text "QUIT" -relief raised -pady 6 \
             -command "destroy .help$title" 

	pack append .help$title .help$title.f1 {top}\
                                .help$title.ok {top expand fillx}

        WaitWindow {loading help data}
        waitcursor
	update


	# read in the contents of the $Filename document file
	#------------------------------------------------------------------
	global BITMAPPATH

        PQlocopy /PGTcl/src/$Filename $BITMAPPATH/$Filename
	readFileIntoText $BITMAPPATH/$Filename .help$title.f1.txt

        .help$title.f1.txt config -state disabled

        normalcursor
	update


#end createHelpListBox
}

# this is borrowed from the widget demo
# The procedure below inserts text into a given text widget and
# applies one or more tags to that text.  The arguments are:
#
# w		Window in which to insert
# text		Text to insert (it's inserted at the "insert" mark)
# args		One or more tags to apply to text.  If this is empty
#		then all tags are removed from the text.

proc insertWithTags {w text args} {
    set start [$w index insert]
    $w insert insert $text
    foreach tag [$w tag names $start] {
	$w tag remove $tag $start insert
    }
    foreach i $args {
	$w tag add $i $start insert
    }
}

