# fileops.tcl --
#	File save, reload, etc.
#
# Copyright (c) 1995 by Sun Microsystems
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
proc File_Open { win } {
    upvar #0 HM$win var
    set file [fileselect "Open HTML file" {} file]
    if {[string length $file] != 0} {
	Url_DisplayNew file:$file
    }
}
proc File_Save { win } {
    upvar #0 HM$win var
    regsub ^file: [string trim $var(S_url)] {} file
    regsub ^/+ $file / file
    if {([string length $file] == 0) ||
	![file isdirectory [file dirname $file]]} {
	File_SaveAs $win
    } else {
	FileSave $win $file
    }
}
proc File_SaveAs {win} {
    upvar #0 HM$win var
    regsub ^file: [string trim $var(S_url)] {} file
    regsub ^/+ $file / file
    set file [fileselect "Save HTML file" $file]
    if {[string length $file] != 0} {
	FileSave $win $file
    }
}
proc FileSave { win file} {
    upvar #0 HM$win var
    $win config -cursor watch
    if ![File_Backup $win $file] {
	return
    }
    Feedback $win save
    set outproc Output
    catch {set outproc $var(S_outproc)}
    if [$outproc $win $file] {
	set var(S_url) file:$file
	set var(S_urlDisplay) $var(S_url)
	Input_Clean $win
	wm iconname [winfo toplevel $win] [file tail $file]
	Status $win "Saved $file"
    }
    $win config -cursor xterm
    Feedback $win ready
}
proc File_Backup { win file } {
    global fileops
    if {[file exists $file]  &&
	    ![info exists fileops(mtime,$file)]} {
	set path [file root $file].bak
	if [catch {open $file} in] {
	    return [DialogConfirm $win .backup \
			"Unable to create backup copy\n$path" \
		    { } { } "Save Anyway" "Do not Save"]
	}
	if [catch {open $path w} out] {
	    close $in
	    return [DialogConfirm $win .backup \
		    "Unable to open backup copy\n$path" \
		    { } { } "Save Anyway" "Do not Save"]
	}
	puts $out [read $in]
	close $out
	close $in
	set fileops(mtime,$file) [file mtime $file]
    }
    return 1
}
proc File_LoadNew {win {newwindow 0}} {
    upvar #0 HM$win var
    if $newwindow {
	Url_DisplayNew $var(S_urlDisplay) $win
	set var(S_urlDisplay) $var(S_url)
    } else {
	Url_Display $win $var(S_urlDisplay)
    }
}
proc File_Reload { win } {
    upvar #0 HM$win var
    Http_kill $var(S_url)	;# Nuke cached state
    set mark [$win index insert]
    Url_Display $win $var(S_url)
    Text_MarkSet $win insert [Input_Adjust $win $mark]
    $win see insert
}
proc File_Refresh { win } {
    upvar #0 HM$win var
    set dirty [Input_IsDirty $win]
    Input_SaveInsert $win
    set html [Head_Output $win]
    append html [Output_string $win 1.0 end]
    append html [Head_OutputTail $win]
    Url_DisplayHtml $win $var(S_url) $html saveundo
    Input_RestoreInsert $win
    $win see insert
    if {$dirty} {
	Input_Dirty $win
    }
}
proc File_SaveReload { win } {
    upvar #0 HM$win var
    File_Save $win
    regsub ^file: $var(S_url) {} file
    if [file exists $file] {
	Url_Display $win file:$file
    }
}
proc File_Stop { win } {
    upvar #0 HM$win var
    set var(stop) 1
    Feedback $win ready
    catch {
	Http_kill $var(S_urlPending)
	Status $win "Killed $var(S_urlPending)"
    }
}
proc File_Quit { win } {
    global AllWindows
    foreach win $AllWindows {
	File_Close $win
    }
    exit	;# Should not reach here
}
proc File_Close { win } {
    upvar #0 HM$win var
    global AllWindows
    set ix [lsearch $AllWindows $win]
    if {$ix >= 0} {
	set AllWindows [lreplace $AllWindows $ix $ix]
    }
    if {[llength $AllWindows] == 0} {
	set what Exit
    } else {
	set what Close
    }
    if [Input_IsDirty $win] {
	set top [winfo toplevel $win]
	wm deiconify $top
	raise $top
	set x [DialogChoice $top .dialog "Save Changes First?" \
		[list Cancel "Save" "Save As..." "Do Not Save"] \
		[list <Control-c> <Return> <Control-s> <Escape>]]
	switch -- $x {
	    0 { return }
	    1 { File_Save $win }
	    2 { File_SaveAs $win }
	    3 { #do nothing }
	}
    }
    File_CloseForce $win $what
}
proc File_CloseForce {win what} {
    if [winfo exists $win] {
	Micro_Reset $win	;# Save state
	set top [winfo toplevel $win]
	if {$top != "."} {
	    destroy $top
	} else {
	    wm withdraw $top
	}
    }
    if {$what == "Exit"} {
	exit
    }
}
# new lets the user choose among templates.
#TODO - merge with Form template chooser (Form_Setup)
proc File_New { win {filename {}}} {
    upvar #0 HM$win var
    global WebTk

    Log $win new 

    set newwindow [expr {[string length $filename] == 0}]

    set top $win.new
    catch {destroy $top}
    toplevel $top -bd 4 -relief raised
    message $top.msg -text \
"Please choose a template."
    pack $top.msg

    set f [frame $top.f -bd 10]
    set l [listbox $f.list -height 10 -yscrollcommand "$f.scroll set"]
    scrollbar $f.scroll -command "$f.list yview" -orient vertical
    pack $f.scroll -side left -fill y
    pack $f.list -side top -fill both -expand true
    pack $f -side top -fill both -expand true

    # After one necessary to avoid crash in <Button-1> event handler
    bind $l <Double-Button-1> "$top.ok flash ; after 1 [list FileNewSetupOK $win $top %W]"

    button $top.ok -text OK -command [list FileNewSetupOK $win $top $l]
    button $top.cancel -text Cancel -command [list destroy $top]
    button $top.custom -text Blank -command [list FileNewSetupOK $win $top blank]
    pack $top.ok $top.custom $top.cancel -side left
    pack $top.cancel -side right

    Platform_WaitVisibility $top

    foreach template [lsort \
	    [glob -nocomplain [file join $WebTk(html) template *]]] {
	set x [file tail $template]
	$l insert end $x
    }

    set var(S_makenew) 0
    tkwait window $top

    if {!$var(S_makenew)} {
	if {$newwindow} {
	    unset var(S_makenew)
	    return
	} else {
	    # startup with new file
	    set var(S_newhtml) {}
	}
    }
    global env
    if {$newwindow} {
	set win [Window_New]
    }
    Url_DisplayHtml $win {} $var(S_newhtml)
    unset var(S_makenew) var(S_newhtml)
    upvar #0 HM$win var
    Input_Mode $win Edit
    Input_Dirty $win
    Head_Display $win
    File_Save $win
}
proc FileNewSetupOK {win top {list blank}} {
    upvar #0 HM$win var
    global WebTk
    set var(S_makenew) 1
    set var(S_newhtml) \
"<HTML>
<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML 2.0//EN\">
<Head>
<META HTTP-Equiv=Editor Content=\"SunLabs WebTk $WebTk(version)\">
<title>(untitled)</title>
</Head>
</HTML>"

    if {"$list" != "blank"} {
	set i [$list curselection]
	if {$i != ""} {
	    set template [$list get $i]
	    set path [file join $WebTk(html) template $template]
	    if [catch {open $path r} in] {
		Status $win $in
		set var(S_makenew) 0
		unset var(S_newhtml)
	    } else {
		Log $win NewTemplate $path
		set var(S_newhtml) [read  $in]
		close $in
	    }
	}
    }
    destroy $top
}

proc File_InsertPlain {win} {
    set file [fileselect "Select plain/text file to insert" {} file]
    if {[string length $file] == 0} {
	return
    }
    if [catch {open $file} in] {
	Status $win $in
	return
    }
    Undo_Mark $win InsertPlainTextEnd
    Edit_PasteHtml $win [Edit_ConvertPlainText [read $in]]
    Undo_Mark $win InsertPlainTextEnd
    close $in
}

# Rename a file
proc File_Rename {src dest} {
    if [catch {file rename -force $src $dest}] {
	File_Copy $src $dest
	File_Remove $src
    }
}
proc File_Remove {file} {
    if {[catch {file delete -force $file}] &&
	[catch {rm $file}] &&
	[catch {exec rm $file}]} {
	    # can't remove it
    }
}
# Copy a file
proc File_Copy {src dest} {
    if [file isdirectory $src] {
	if ![file exists $dest] {
	    if {[catch {file mkdir $dest}] && [catch {mkdir $dest}] &&
		[catch {exec mkdir $dest}]} {
		error "Cannot create directory $dest"
	    }
	}
	foreach f [glob -nocomplain [file join $src *]] {
	    File_Copy $f [file join $dest [file tail $f]]
	}
	return
    }
    set in [open $src]
    if [file isdirectory $dest] {
	set dest [file join $dest [file tail $src]]
    }
    set out [open $dest w]
    puts $out [read $in]
    close $out
    close $in
}
# Copy a file

proc File_CopyBin {src dest} {
    set in [open $src]
    fconfigure $in -trans binary
    if [file isdirectory $dest] {
	set dest [file join $dest [file tail $src]]
    }
    set out [open $dest w]
    fconfigure $out -trans binary
    copychannel $in $out
    close $out
    close $in
}

proc File_MkDir {dir} {
    global tk_version
    if {$tk_version == 4.1} {
	catch {mkdir $dir}
	catch {exec mkdir $dir}
    } else {
	file mkdir $dir
    }
}

