
# This code is shared by all the ICEM CFD GUI's.
#
# Copyright (c) 1993 - 1995 Pacific Marketing and Consulting, Inc,
#       and ICEM Systems, GmbH.  All rights reserved.
# Author:  Wayne A. Christopher, wayne@icemcfd.com

set mess_numred 0

proc start_process {ident win command prompt {use_socket 0} {args ""}} {
    global process_fd enable_exec echo_flag process_prompt process_ident
    global process_command process_window use_xwindows tcl_version dlremote
    
    if {[info commands application_main] != ""} {
	start_process_internal $ident $win $command $prompt
	return
    }
    
    if {[info exists process_ident] && [winfo exists $win.$process_ident]} {
	# Put the current one away first...
	# pack unpack $win.$process_ident
	finish_process
    }
    if [winfo exists $win.$ident] {
	#pack $win.$ident -side top -fill both -expand 1
	#set process_ident $ident
	#mess "Resumed: $process_command($ident)\n"
	#return 0
    }
    
    busy 1
    
    set process_ident $ident
    mess "Running: $command\n"
    set process_command($ident) $command
    if $use_socket {
	for {set addr 1024} 1 {incr addr} {
	    if ![catch {socket -server "process_socket $ident" $addr}] break
	}
	mess "Set up socket at port $addr\n"
	set pid [eval exec $command -socket $addr &]
	mess "Process id: $pid\n"
	tkwait variable process_fd($ident)
	mess "Connected to backend!\n"
    } else {
	set process_fd($ident) [open "| $command |& cat -u " w+]
	mess "Process id: [pid $process_fd($ident)]\n"
    }
    set process_prompt($ident) [string trim $prompt]
    
    if [string compare $tcl_version 7.4] {
	#fconfigure $process_fd($ident) -blocking 0
	fconfigure $process_fd($ident) -buffering none -blocking 1
    }
    
    set sw $win.$ident
    if { ! [ winfo exists $sw ] }  {
    	frame $sw -background black
    }
    
    while 1 {
	if [eof $process_fd($ident)] {
	    process_dead 1
	} else {
	    set line [process_gets $process_fd($ident)]
	    if [string match $process_prompt($ident)* $line] {
		mess $line black
		break
	    } else {
		mess "$line\n" blue
	    }
	}
    }
    
    set enable_exec 1
    set echo_flag 1
    
    pack $sw -side top -fill both -expand 1
    set process_window($ident) $sw
    update idle
    
    set cmd "create_window [winfo width $sw] [winfo height $sw] \
	[winfo id $sw] $args"
    switch $use_xwindows {
	1 { append cmd " -x" }
	2 { append cmd " -ogl" }
    }
    if {$dlremote != ""} { append cmd " -host $dlremote" }
    command $cmd
    
    busy 0
    return 1
}

if [string compare $tcl_version 7.4] {
    proc process_gets {fp} {
	for {set i 0} 1 {incr i} {
	    if [eof $fp] { return "" } 
	    set ret [gets $fp ]
	    if { $ret != "" } break
	    after $i
	}
	return $ret
    }
} else {
    proc process_gets {fp} { return [gets $fp] }
}

proc process_socket {ident fp other_addr other_port} {
    global process_fd
    set process_fd($ident) $fp
}

proc finish_process {} {
    global process_ident process_command process_fd process_prompt
    global process_window
    
    if {[info commands command_execute] != ""} {
	command_execute quit
	return
    }
    
    if {![info exists process_ident] || ($process_ident == "")} return
    
    set id $process_ident
    catch { puts $process_fd($id) quit }
    catch { flush $process_fd($id) }
    if [catch {close $process_fd($id)} res] { puts $res }
    if [ info exists process_window($id) ] {
	top_destroy $process_window($id)
    }
    
    catch { unset process_fd($id) }
    catch { unset process_command($id) }
    catch { unset process_prompt($id) }
    catch { unset process_window($id) }
    catch { unset process_ident }
}

proc put_output {stuff} {
    mess $stuff green
}
proc process_dead { dummy } {
    global enable_exec process_fd process_ident
   
    mess "The process has exited ...\n" red
    mess "----------\n"
    set enable_exec 0
    if [catch {close $process_fd($id)} res] {
	puts $res
    }
    unset process_ident
    busy 0
    tkwait variable never_set
}

proc command {com {echo 1} {noidle 0} {ndefer 0}} {
    global enable_exec process_fd last_line all_lines echo_flag
    global mess_allflag cmdlog_fp process_ident process_prompt
    global process_window command_hook replay_mess_prefix
    
    set sl [expr [string length $com] - 1]
    if {[string index $com $sl] == "\\"} {
	set com [string range $com 0 [expr $sl - 1]]
    }
    
    if {[info commands command_execute] != ""} {
	command_internal $com $echo
	return 1
    }
    if {![info exists enable_exec] || ![info exists process_ident]} {
	return 0
    }
    
    if !$enable_exec {
	mess "Please complete the current command first before performing\
		another one.\n" red
	set last_line ""
	return 0
	
	what about this?
	incr ndefer
	if {$ndefer > 50} {
	    mess "Command $com deferred too long\n" red
	    return 0
	}
	after 100 command \"$com\" $echo $noidle $ndefer
	return 1
    }
    
    set id $process_ident
    
    set enable_exec 0
    if {$mess_allflag || ($echo == 1)} {
	set lnum ""
	if {[info exists replay_mess_prefix] && ($replay_mess_prefix != "")} {
	    set lnum "$replay_mess_prefix. "
	}
	mess "$lnum$com\n" green
    }
    
    set last_line ""
    set all_lines ""
    if $mess_allflag {
	set echo_flag 1
    } elseif {$echo > 0} {
	set echo_flag $echo
    } else {
	set echo_flag 0
    }
    
    # filter out the prompt ...
    set pl [string length $process_prompt($id)]
    set np "[string range $process_prompt($id) 0 [expr $pl - 2]]_[string index $process_prompt($id) [expr $pl - 1]]"
    regsub -all $process_prompt($id) $com $np com
    if [info exists command_hook] { $command_hook $com }
    if [ catch { puts $process_fd($id) $com } result ] {
	process_dead 2
    }
	
    
    if [string match quit* $com] {
	if [catch {close $process_fd($id)} res] {
	    puts $res
	}
	pack unpack $process_window($id)
	unset process_ident
	return 1
    }

    if [ catch { flush $process_fd($id) } result ] {
	if { ! [ string match quad* $com ]  } {
		process_dead 3
	}
    }
    
    set stop_id [stop_button 1 [lindex $com 0]]
    
    while 1 {
	set eof [eof $process_fd($id)]
	if $eof {
		process_dead 4
	} else {
	    set line [process_gets $process_fd($id)]
	    if [string match $process_prompt($id)* $line] {
		if $echo_flag { mess $line black }
		break
	    } else {
		set last_line $line
		lappend all_lines $line
		if $echo_flag { mess "$line\n" blue }
	    }
	}
    }
    
    stop_button 0 "" $stop_id
    
    set enable_exec 1
    
    return 1
}

proc check_enabled {} {
    global enable_exec
    if $enable_exec {
	return 1
    } else {
	bell
	return 0
    }
}

# -------------------------------------------------------------

proc make_message_window {} {
    global log_messages tool_name no_all_interaction_button messages_at_startup
    global small_screen_hack mess_numred mess_frame is_win mess_win_font
    global verbose_messages
    
    if ![info exists mess_frame] {
	set mess_frame .m
	top_window .m 1 "$tool_name messages" "" .v 0
	top_geometry .m +0-0
	set text_size 1
    } else {
	set text_size 0
    }
    
    if ![info exists log_messages] { set log_messages 0 }
    if ![info exists verbose_messages] { set verbose_messages 0 }
    
    scrollbar $mess_frame.yscroll -relief sunken -command "$mess_frame.text yview" -orient v
    text $mess_frame.text -yscroll "$mess_frame.yscroll set" \
	    -exportselection 1 -wrap word -padx 4 -pady 4 \
	    -relief sunken -borderwidth 2 -background white
    if [info exists mess_win_font] {
	$mess_frame.text configure -font $mess_win_font
    }
    if $text_size {
	$mess_frame.text configure -width 81 -height 5
    } else {
	$mess_frame.text configure -width 1 -height 5
    }
    frame $mess_frame.bot
    
    if ![info exists no_all_interaction_button] {
	checkbutton $mess_frame.bot.all -text "All interaction" -variable mess_allflag
	pack $mess_frame.bot.all -side left -padx 2 -pady 2
    }	
    bind $mess_frame.text <KeyPress> "tk::TextSetCursor %W end-1c"
    bind $mess_frame.text <ButtonRelease-2> {
	if {!$tk::Priv(mouseMoved) || $tk_strictMotif} {
	    %W mark set insert end-1c
	    %W see insert
	    catch {%W insert insert [selection get -displayof %W]}
	    if {[%W cget -state] == "normal"} {focus %W}
	    break
	}
    }
    bind $mess_frame.text <Return> "message_send_line $mess_frame.text"
    
    checkbutton $mess_frame.bot.verb -text "Verbose" -variable verbose_messages
    checkbutton $mess_frame.bot.log -text Log -variable log_messages \
	-command message_log_reopen
    button $mess_frame.bot.save -text " Save " -command message_save
    
    pack $mess_frame.bot.verb $mess_frame.bot.log $mess_frame.bot.save -side left -padx 2 -pady 0
    pack $mess_frame.bot -side bottom -fill both
    pack $mess_frame.yscroll -side right -fill both
    pack $mess_frame.text -side top -expand 1 -fill both
    
    if $small_screen_hack {
	pack propagate $mess_frame.bot 0
	$mess_frame.bot configure -height 20
    }
    
    if [info exists messages_at_startup] {
	foreach m $messages_at_startup { eval mess $m }
    }
}

proc message_send_line {m} {
    global process_prompt process_ident
    
    set end [$m index insert]
    set line [lindex [split $end .] 0]
    #incr line -1
    set cmd [$m get $line.0 $end]
    set cmd [lindex [split $cmd \n] 0]
    $m insert $end \n
    if {[info exists process_ident] && \
	    [info exists process_prompt($process_ident)] && \
	    ($process_prompt($process_ident) != "") && \
	    [string match $process_prompt($process_ident)* $cmd]} {
	set pl [string length $process_prompt($process_ident)]
	set cmd [string trim [string range $cmd $pl end]]
    }
    
    if {[string index $cmd 0] == "!"} {
	set cmd [string range $cmd 1 end]
	if [catch {uplevel \#0 eval \{$cmd\}} res] {
	    mess "Error: $res\n" red
	    busy reset
	} else {
            mess "Result: " blue
            mess "$res\n"
	}
	
    } elseif ![info exists process_prompt] {
	# check for simple variable set with "="
	# return only if it's a valid definition
	if {[string first "=" $cmd] >= 0} {
		if {[va_vvar $cmd] != ""} return 
	} 
	if [catch {uplevel \#0 eval \{$cmd\}} res] {
	    mess "Error: $res\n" red
	    busy reset
	} else {
            mess "Result: " blue
	    mess "$res\n"
	}
	
    } else {
	command $cmd 2
	# We don't know so ...
	catch {file_dirty}
    }
}

proc message_log_reopen {{fname ""} {put_contents 0}} {
    global log_fp log_messages mess_frame
    
    if ![info exists log_messages] return
    
    message_log_close
    
    if !$log_messages return
    
    if {$fname == ""} {
	set fname [message_get_filename messages.log]
    }
    if {$fname == ""} { set log_messages 0; return }
    
    if [catch {open $fname a} log_fp] {
	user_error "Can't open message log: $log_fp\nNot logging messages."
	set log_messages 0
	unset log_fp
	return
    }
    
    set username [cmd_whoami]
    set host [cmd_uname_n]
    set date [cmd_date]
    
    puts $log_fp "\n----- Message log opened by $username@$host at $date\n"
    if $put_contents { puts $log_fp [$mess_frame.text get 1.0 end] }
}

proc message_log_close {} {
    global log_fp
    
    if [info exists log_fp] {
	catch {
	    puts $log_fp "\n----- Message log closed at [cmd_date]"
	    close $log_fp
	}
	unset log_fp
    }
}

proc message_save {} {
    global message_save_directory mess_frame is_win
    
    set dir .
    if [info exists message_save_directory] {
	set dir $message_save_directory
    }
    for {set num 1} 1 {incr num} {
	set fname $dir/messages.[format %02d $num]
	if $is_win { append fname .txt }
	if ![file exists $fname] break
    }
    set fname [file_selection -message "Select the file to save messages to." \
		   -default $fname -new_ok 1 -mkdir_button 1 -title "Save log"\
		   -warn_overwrite 1]
    if {$fname == ""} return
    
    set fp [open $fname w]
    
    set username [cmd_whoami]
    set host [cmd_uname_n]
    set date [cmd_date]
    
    puts $fp "----- Message log saved by $username@$host at $date"
    puts $fp [$mess_frame.text get 1.0 end]
    close $fp
}

proc message_get_filename {default} {
    global message_save_file_done mess_frame
    
    if {[info commands directory] != ""} {
	set default [directory message_file]/$default
    } else {
	set default [pwd]/$default
    }
    
    set fn [file_selection -message "Select a file to append messages to." \
		-new_ok 1 -delete_button 1 -mkdir_button 1 \
		-warn_overwrite 0 -default $default]
    return $fn
}

proc message_add_button {name label command} {
    global tk_version mess_frame
    
    if ![info exists tk_version] return
    
    if ![winfo exists $mess_frame.bot.$name] {
	button $mess_frame.bot.$name -text $label -command $command
    }
    pack $mess_frame.bot.$name -side right
    return $mess_frame.bot.$name
}

proc message_remove_button {name} {
    global tk_version mess_frame
    
    if ![info exists tk_version] return
    
    pack unpack $mess_frame.bot.$name
}

proc message_enable_button {name state} {
    if {$name != ""} {
	$name configure -state $state
    }
}

# The messages_visible variable has three states: small, large, and none.
# They cycle in this order.

proc message_window_visible {} {
    global messages_visible messages_geo sun_y_hack mess_frame
    
    if ![info exists messages_visible] { set messages_visible none }
    
    case $messages_visible {
	none {
	    if [info exists messages_geo(small)] {
		# The window manager is mixed up.
		top_geometry .m $messages_geo(small)
		update
		top_geometry .m $messages_geo(small)
	    } else {
		top_geometry .m +0-$sun_y_hack
	    }
	    top_deiconify .m
	    set messages_visible small
            if [winfo exist .v.top.extras.msgs] {
               .v.top.extras.msgs configure -text "Msg+"
            }
	    message_last_end $mess_frame.text
	}
	small {
	    # Impossible to record the position because wm geometry is screwed.
	    set messages_geo(small) "[winfo width .m]x[winfo height .m]+0-0"

	    top_withdraw .m
	    if [info exists messages_geo(large)] {
		top_geometry .m $messages_geo(large)
	    } else {
		$mess_frame.text configure -width 81 -height 50
		update
		top_geometry .m +0-$sun_y_hack
	    }
	    top_deiconify .m
	    set messages_visible large
            if [winfo exist .v.top.extras.msgs] {
               .v.top.extras.msgs configure -text "Msg "
            }
	    message_last_end $mess_frame.text
	}
	large {
	    # Impossible to record the position because wm geometry is screwed.
	    set messages_geo(large) "[winfo width .m]x[winfo height .m]+0-0"
	    top_withdraw .m
	    set messages_visible none
            if [winfo exist .v.top.extras.msgs] {
               .v.top.extras.msgs configure -text "Msg-"
            }
	}
    }
}

proc message_last_end {m} {
    update
    $m yview 0
    $m yview -pickplace end
}

proc mess_checkred {} {
    global mess_numred
    set n $mess_numred
    set mess_numred 0
    return $n
}

proc vmess {line {color ""} {font ""} {update 1} {show_tail 1}} {
    global verbose_messages
    if {![info exists verbose_messages] || $verbose_messages} {
	mess $line $color $font $update $show_tail
    }
}

proc mess {line {color ""} {font ""} {update 1} {show_tail 1}} {
    global mess_tagnum log_fp mess_to_stdout mess_frame
    global mess_tags mess_colors mess_numred message_hook
    
    if {![info exists mess_frame] || ![winfo exists $mess_frame] == ""} {
	puts -nonewline $line
	return
    }
    
    if {"debug" == $color} {
	global debug
	if {![info exists debug] || !$debug} {
	    return
	}
	set color purple
	set line "debug@[clock format [clock seconds]]: $line"
    }

    if [info exists mess_colors($color)] {
	set color $mess_colors($color)
    }

    set now [$mess_frame.text index "end -1c"]
    $mess_frame.text insert end $line
    if {($color != "") || ($font != "")} {
	if [info exists mess_tags($color,$font)] {
	    set tag $mess_tags($color,$font)
	} else {
	    if ![info exists mess_tagnum] { set mess_tagnum 0 }
	    set tag t[incr mess_tagnum]
	    if {$color != ""} {
		$mess_frame.text tag configure $tag -foreground $color
	    }
	    if {$font != ""} {
		$mess_frame.text tag configure $tag -font $font
	    }
	    set mess_tags($color,$font) $tag
	}
	$mess_frame.text tag add $tag $now "end - 1c"
    }
    if $show_tail {
	$mess_frame.text yview -pickplace end
    }
    if [info exists log_fp] {
	catch { # maybe this file has been removed in another process ?
	    puts -nonewline $log_fp $line
	    flush $log_fp
	}
    }
    
    if [info exists mess_to_stdout] {
	puts -nonewline $line
    }
    
    if [info exists message_hook] {
	eval $message_hook \{$line\} \{$color\}
    }
    if {$color == "red"} { incr mess_numred }
    
    if $update {update idletasks}
}

proc mess_start_saving {} {
    global message_hook message_hook_data
    set message_hook_data ""
    set message_hook mess_do_save
}

proc mess_do_save {m c} {
    global message_hook_data
    lappend message_hook_data $m $c
}

proc mess_end_saving {} {
    global message_hook message_hook_data
    unset message_hook
    return $message_hook_data
}

# for backward compatibility

proc infomsg {m} { mess "$m\n" }
proc warningmsg {m} { mess "$m\n" red }
proc errormsg {m} { mess "$m\n" red }

proc mess_query {question {color ""} {font ""}} {
    global query_done mess_frame mess_tagnum
    
    incr mess_tagnum
    
    set now [$mess_frame.text index end]
    $mess_frame.text insert end "$question\n-> "
    $mess_frame.text tag add t$mess_tagnum $now "end - 1c"
    $mess_frame.text tag configure t$mess_tagnum -foreground blue
    $mess_frame.text insert end " "
    $mess_frame.text yview -pickplace end
    set start [$mess_frame.text index end]
    bind $mess_frame.text <Return> "set query_done 1"
    
    set prev [focus]
    focus $mess_frame.text
    tkwait variable query_done
    set result [$mess_frame.text get $start end]
    $mess_frame.text insert end \n
    focus $prev
    bind $mess_frame.text <Return> ""
    
    return $result
}

proc banner {mess {win default}} {
    global banner_image banner_disables_menus menus_are_disabled
    global use_hexa_banner old_mess bigfont
    global tdv_last_viewer_clicked
    global banner_window_used tdv_default

    if {$win == "default"} { set win .v }

    if {$win == ".v"} {
	if {[info exists tdv_last_viewer_clicked] &&
            [winfo exists $tdv_last_viewer_clicked] &&
	    [winfo ismapped $tdv_last_viewer_clicked]} {
	    set in_win $tdv_last_viewer_clicked
	    set win .v
	} else {
	    set in_win $tdv_default
	}
    } elseif {[winfo class $win] == "Tdv_Viewer"} {
        set in_win $win
        set win [winfo parent $win]
    } else {
	if ![winfo exists $win.view] {
	    set in_win $win
	    set win [winfo parent $win]
	} else {
	    set in_win $win.view
	}
    }


    # This is a work-a-round
    set banner_window_used $win

    global tdv_banner_cmd
    if {[info exist tdv_banner_cmd($in_win)] && \
	    ([info command [lindex $tdv_banner_cmd($in_win) 0]] != "")} {
	set rr $tdv_banner_cmd($in_win)
	lappend rr $mess $in_win
	return [eval $rr]
    }
    
    set use_im [expr {[info commands tdv_text_im] != ""}]
    set use_im 0
    
    if [ info exists use_hexa_banner ] {
        if [ info exists old_mess ] {
	    set omess $old_mess
        } else {
	    set omess ""
        }
        set old_mess $mess
        global last_line all_lines
        set last_line_save $last_line
        set all_lines_save $all_lines
        command "display_text { $mess } red"
        set last_line $last_line_save
        set all_lines $all_lines_save
    } elseif { !$use_im } {
 	if ![winfo exists $win.banner] {
 	    label $win.banner -background black -foreground red -font $bigfont
 	}
	set omess [$win.banner cget -text]
	$win.banner configure -text $mess
	$win.banner configure -wraplength [expr [winfo width $tdv_default] - 50]

	if {$mess == ""} {
	    place forget $win.banner
	    	    
	    # delete selection images (rbox, poly, circ):
	    # May be result of F9 + cancel selection/delete geometry/...
	    foreach im [$in_win list_with_tag selection_image] {
			$im delete
		}
	    
	} else {
	    place $win.banner -in $in_win -relx 0.01 -rely 0.99 -anchor sw
	}
	update
    } else {
	if ![info exists banner_image] {
            set ifont [expr [winfo width $in_win] / 400]
	    set banner_image [tdv_text_im -transform 0 -point "10 10 0" \
				  -color \#ff8888 -fontsize $ifont \
                                  -y_dir_up 1 -overlay 1]
	    $in_win add_image $banner_image
	}
	$banner_image configure -text $mess
	$banner_image configure -wraplength [expr [winfo width $tdv_default] - 50]

	set omess [$banner_image cget -text]
	$in_win redraw_overlay
    }
    if {[info exists banner_disables_menus] && \
	    ([info command phase_enable] != "")} {
	if {$mess == ""} {
	    phase_enable 1
	    catch {unset menus_are_disabled}
	    if {[info commands after_phase_enable] != ""} after_phase_enable
	} else {
	    set menus_are_disabled 1
	    phase_enable 0
	}
    }
    return $omess
}
    
proc banner_get {{win .v}} {
    global banner_image
    if [winfo exists $win.banner] {
	return [$win.banner cget -text]
    }
    if ![info exists banner_image] { return "" }
    return [$banner_image configure -text]
}

proc tcl_eval {} {
    global prev_command
    
    set com [query "Enter Tcl command:"]
    if {$com == ""} return
    if {$com == "!!"} {
	if [info exists prev_command] {set com $prev_command} else return
    }
    if {$com == "^^"} {set com [selection get]}
    set prev_command $com
    
    catch {uplevel #0 eval \{$com\}} result
    mess "Result: $result\n"
}

# This is useful for other subprocesses than the main one.

proc read_until_prompt {fp prompt {cmd ""}} {
    if {$cmd != ""} {
	puts $fp $cmd
	flush $fp
    }
    busy 1
    set lines ""
    while {![eof $fp]} {
	set line [process_gets $fp]
	#puts "line is $line"
	if {[string trim $line] == $prompt} break
	lappend lines $line
	mess "$line\n" green
    }
    busy 0
    return $lines
}

proc stop_button {on {cmd ""} {pid ""} {mess ""} {sig ""}} {
    global env process_fd process_ident
    global command_needs_stopbutton
    
    set stop_pid ""
    if $on {
	if ![info exists command_needs_stopbutton($cmd)] {
	    return ""
	}
	
	# set the pid if not given
	
	if {$pid == ""} {
	    if [info exists process_fd($process_ident)] {
		set pid [pid $process_fd($process_ident)]
	    } else {
		set pid [pid]
	    }
	}
    
	# set the message
	
	if {$mess == ""} {
	    set mess $command_needs_stopbutton($cmd)
	}
	
	# set the signal to send
	
	if {$sig == ""} {
	    set sig 1
	}
	
	# determine the directory of the stop button
	
	if [info exists env(GUIBASE_DIR)] {
	    set guidir $env(GUIBASE_DIR)
	} else {
	    set guidir $env(ICEM_ACN)/lib/guibase
	}
	
	# return the pid of the created window
	
	if {[file exists $guidir/stop_button.tcl]} {
	    set stop_pid [exec [info nameofexecutable] \
			      $guidir/stop_button.tcl $pid $mess $sig &]
	}
	
    } elseif {!$on && $pid != ""} {
	catch {cmd_kill $pid 15}
    }
    return $stop_pid
}

