# window.tcl --
# Much of the top-level code for the brower/editor
# 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 Window_New {} {
    global WebTk
    set i 0
    while {[winfo exists .webtk$i]} {
	incr i
    }
    toplevel .webtk$i
    wm iconname .webtk$i WebTk
    wm iconbitmap .webtk$i @[file join $WebTk(images) LOGO64.xbm]
    set win [Window_Init .webtk$i]
    # For command line debugging
    uplevel #0 "upvar #0 HM$win var$i HMtag$win tag$i"
    return $win
}
# Create a new window
proc Window_Init {parent} {
    global AllWindows window
    # make the interface
    set win [WindowLayout $parent]
    lappend AllWindows $win
    upvar #0 HM$win var
    Feedback $win init				;# page status
    Input_Clean $win				;# Reset file dirty bit
    set var(S_stat2) ""				;# message line
    set var(S_url) {}				;# URL of the page

    HMinit_win $win				;# Reset display engine
    HMset_state $win -insert insert		;# We use the "insert" mark

    if {![info exists window(fontsize)] ||
	[string length $window(fontsize)] == 0} {
	set window(fontsize) 0			;# Magnifiy factor
    }
    if {![info exists window(indentsize)] ||
	[string length $window(indentsize)] == 0} {
	set window(indentsize) 0.6		;# Indent width
    }
    if {![info exists window(colorAnchor)] ||
	[string length $window(colorAnchor)] == 0} {
	set window(colorAnchor) 1
    }

    HMset_indent $win $window(indentsize)
    HMset_state $win -size $window(fontsize)

    return $win
}
proc Window_Frame {win0 parent scrolling padx pady} {
    global AllWindows window
    # make the interface

    set win [text $parent.text -padx $padx -pady $pady -takefocus 1 \
	-width 0 -height 0]	;# Let grid allocate all the space
    if {[string compare $scrolling none] != 0} {
	scrollbar $parent.scrollbar  -command "$parent.text yview"  -orient v
	$win config -yscrollcommand "$parent.scrollbar set"
	pack $parent.scrollbar -in $parent -side right -expand 0 -fill y
    }
    pack $win -in $parent -side left -fill both -expand 1 -padx 0 -pady 0

    Sel_Init $win
    upvar #0 HM$win var HM$win0 var0

    HMinit_win $win				;# Reset display engine
    HMreset_win $win
    Head_SetColors $win0 $win
    HMset_state $win -insert insert		;# We use the "insert" mark
    HMset_state $win -size $window(fontsize)
    HMset_indent $win $window(indentsize)
    Edit_Reset $win
    Input_Reset $win

    set var(S_url) $var0(S_url)		;# So relative src works.
    # Keep a pointer to the main text widget for the page.
    Window_SetMaster $win $win0

    return $win
}
proc WindowLayout {parent} {
    if {$parent == "."} {
	set self {}
    } else {
	set self $parent
    }

    ### Create main frames in the window.  By Class they are
    # Menubar (.top)	Holds top row of menubuttons
    # Toolbar (.tools)	Holds toolbar buttons
    # Status  (.status)	Holds status line
    # Url     (.url)	Holds URL entry and edit/browse buttons

    upvar #0 HM$self.text var
    set top [frame $self.top -class Menubar]
    set tool [frame $self.tools -class Toolbar]
    set url [frame $self.url -class Url]		;# For URL display
    set status [frame $self.status -class Status]	;# For status display

    set win $self.text

    pack $top $tool $status $url -side top -fill x
    pack $tool -fill none

    set main [frame $self.main]
    upvar #0 Controls$main show
    set show 1

    ### Create menubuttons

    # Create these based on tables of HTML tags
    menubutton $top.style   -text Style -menu $top.style.m -underline 0
    menubutton $top.para    -text Paragraph -menu $top.para.m -underline 0
    menubutton $top.list    -text List -menu $top.list.m -underline 0
    menubutton $top.form    -text Form -menu $top.form.m -underline 1
    pack $top.form $top.list $top.style $top.para \
	-side right -fill y

    ### Create File, Edit, and other menus from resource database

    Window_ButtonFrame $top

    ### Flesh out the user-defined macro menu

    Macro_Init $top.macro.m $win

    ### Create the toolbar

    Toolbar_Create $win $tool
    Toolbar_Menus $win $top.html $top.form $top.list $top.style $top.para $top.macro

    ### Create Edit/Brose buttons

    option add *Url.Radiobutton.padX 2
    option add *Url.Radiobutton.padY 2
    frame $url.edit
    radiobutton $url.edit.normal -text Edit -variable Edit$win -value Edit \
	-command "Input_Mode $win"
    menubutton $url.edit.frame -text Edit... -menu $url.edit.frame.m
    menu $url.edit.frame.m
    pack $url.edit.normal	;# see FrameTweakUI
    radiobutton $url.browse -text Browse -variable Edit$win -value Browse \
	-command "Input_Mode $win"
    pack $url.browse $url.edit -side right

    ### Create URL entry

    entry $url.entry  -textvariable HM$self.text(S_urlDisplay) -width 35
    UrlEntry_Setup $url.entry
    label $url.url  -text URL:
    pack $url.url $url.entry -side left
    pack $url.entry -expand true -fill x
    bind $url.entry <Return> "File_LoadNew $win 0 ; break"
    bind $url.entry <Shift-Return> "File_LoadNew $win 1 ; break"

    ### Create the status line

    entry $status.msg -textvariable HM$self.text(S_stat2) \
	-state disabled -justify center -relief flat \
	-font [$url.url cget -font]
    label $status.status -textvariable HM$self.text(S_stat1) -width 6 \
	-relief ridge -bd 2 -padx 9 -pady 3 -foreground blue
    set var(S_feedback) $status.status

    ### Create the Show HTML Button

    upvar #0 HtmlShow$win show ; set show 0
    checkbutton $status.html -text "Show Html" -variable HtmlShow$win \
	-command "Mark_Show?Html $win"

    set var(S_dmsg) ""
    label $status.dirty -textvariable HM$self.text(S_dmsg)

    pack $status.status $status.msg $status.dirty $status.html -side left
    pack $status.msg -fill x -expand true

    ### Create the blue bar used to give download feedback
    # .bar gets placed later for a progress report
    frame $status.msg.bar -background blue

    ### Create the main text widget
    # takefocus is necessary so browse mode key bindings will work

    scrollbar $self.scrollbar  -command "$self.text yview"  -orient v
    set win [text $self.text  -yscrollcommand "$self.scrollbar set" \
	-padx 5m -takefocus 1]

    Sel_Init $win

    pack $main -in $parent -side top -expand 1 -fill both
    pack $self.scrollbar -in $main -side right -expand 0 -fill y
    pack $win -in $main -side left -fill both -expand 1 -padx 2 -pady 2

    WinHistorySetup $win $top.go.m

    wm protocol [winfo toplevel $parent] WM_DELETE_WINDOW "File_Close $win"

    menu $top.style.m
    menu $top.para.m
    menu $top.list.m

    ### Form Menu
    menu $top.form.m
    Form_Menu $win $top.form.m

    ###  Build the Paragraph, Style, and List menus

    global ParaMap ParaList
    $top.para.m add command -label "No paragraph" \
	-command [list Input_NoParagraph $win]
    $top.para.m add cascade -label [format "%-6s %s" "" "Justify Header"] \
	-menu $top.para.m.align
    set m2 [menu $top.para.m.align]
    $top.para.m add cascade -label [format "%-6s %s" div "Aligned block"] \
	-menu $top.para.m.div
    set m3 [menu $top.para.m.div]
    foreach align {left center right justify} {
	$m2 add command -label $align -command \
	    [list Input_AlignNode $win insert $align]
	$m3 add command -label $align -command \
	    [list Input_Tag $win "div align=$align"]
    }
    foreach x $ParaList {
	set label $ParaMap($x)
	$top.para.m add command -label \
	    [format "%-6s %s" $x $label] \
	    -command [list Input_Tag $win $x]
    }
    $top.para.m add command -label [format "%-6s %s" /pre "End pre"] \
	-command [list Input_ClosePre $win]

    global StyleMap StyleList
    $top.style.m add command -label "Plain text" \
	-command [list Input_PlainText $win]
    foreach x $StyleList {
	set label $StyleMap($x)
	$top.style.m add command -label \
	    [format "%-6s %s" $x $label] \
	    -command [list Input_Tag $win $x]
    }

    global ListMap ListList
    foreach x $ListList {
	set label $ListMap($x)
	$top.list.m add command -label \
	    [format "%-6s %s" $x $label] \
	    -command [list Input_Tag $win $x]
    }
    $top.list.m add separator
    $top.list.m add command -label \
	[format "%-6s %-20s %s" li "List Element" <Return>] \
	-command [list List_Item $win li]
    $top.list.m add command -label \
	[format "%-6s %-20s %s" p "Unbulleted Element" <Control-Return>] \
	-command [list Input_P $win]
    $top.list.m add command -label \
	[format "%-6s %s" li->p "Remove Bullet"] \
	-command [list List_RemoveBullet $win]
    $top.list.m add command -label \
	[format "%-6s %s" p->li "Restore Bullet"] \
	-command [list List_AddBullet $win]
    $top.list.m add separator
    $top.list.m add command -label \
	[format "%6s %-20s %s" {} "Indent List" <Tab>] \
	-command [list Input_Tab $win]
    $top.list.m add command -label \
	[format "%6s %-20s %s" {} "Outdent List" <Shift-Tab>] \
	-command [list Input_ShiftTab $win]
    $top.list.m add command -label \
	[format "%6s %-20s %s" {} "End List" <Shift-Tab>] \
	-command [list List_End $win]
    $top.list.m add command -label  \
	[format "%6s %-20s" {} "Refresh List"] \
	-command [list List_Refresh $win]
    return $win
}
proc Window_FontSize {win} {
    global window
    HMset_state $win -size $window(fontsize)
    File_Reload $win
}
proc Window_Indent {win} {
    global window
    HMset_indent $win $window(indentsize)
    File_Reload $win
}
proc Window_ColorAnchor {win} {
    global window
    if {$window(colorAnchor)} {
	$win tag configure anchor -foreground purple
    } else {
	$win tag configure anchor -foreground {}
    }
}
proc Window_CheckPoint {out} {
    global window
    puts $out [list array set window [list \
	indentsize $window(indentsize) \
	fontsize $window(fontsize) \
	colorAnchor $window(colorAnchor) \
]]
}
# Feedback is for the one-word status button
proc Feedback { win word } {
    upvar #0 HM$win var
    set var(S_stat1) $word
    catch {after cancel $var(S_after)}
    catch {
	set bg [lindex [$var(S_feedback) config -background] 3]
	$var(S_feedback) config -bg $bg  -fg blue
    }
    update idletasks
}

proc FeedbackLoop { win word } {
    upvar #0 HM$win var
    set var(S_stat1) $word
    catch {after cancel $var(S_after)}
    catch {
	set bg [$var(S_feedback) cget -bg]
	set def [lindex [$var(S_feedback) config -background] 3]
	if {[string compare $bg $def] == 0} {
	    $var(S_feedback) config -bg white
	} else {
	    $var(S_feedback) config -bg $def
	}
	set var(S_after) [after 200 [list FeedbackLoop $win $word]]
    }
    update idletasks
}

# win is an embedded window inside masterwin.  win displays a table.
proc Window_SetMaster {win masterwin} {
    upvar #0 HM$masterwin var
    upvar #0 HM$win var2
    if [info exists var(S_mainwin)] { 
	set var2(S_mainwin) $var(S_mainwin)
    } else {
	set var2(S_mainwin) $masterwin
    }
}
proc Window_GetMaster {win} {
    upvar #0 HM$win var
    if [info exists var(S_mainwin)] {
	# Level of indirection to support nested text widgets for tables
	return $var(S_mainwin)
    } else {
	return $win
    }
}
# Status is for the whole-line status information line
proc Status { win msg } {
    set win [Window_GetMaster $win]
    upvar #0 HM$win var
    set var(S_stat2) $msg

    global WebTkLog WebTkLogFile
    update idletasks
    if {[info exists WebTkLog] && $WebTkLog} {
	if ![info exists WebTkLogFile] {
	    if [catch {open [Platform_File log] w} WebTkLogFile] {
		set WebTkLog 0
		puts stderr "Cannot log status to [Platform_File log]"
		return
	    }
	}
	puts $WebTkLogFile [format "%-10s %s" $win $msg]
	flush $WebTkLogFile
    }
}
proc StatusLazy { win msg } {
    set win [Window_GetMaster $win]
    upvar #0 HM$win var
    set var(S_stat2) $msg
}

proc Status_push { win msg } {
    set win [Window_GetMaster $win]
    upvar #0 HM$win var
    set var(old_stat2) $var(S_stat2)
    Status $win $msg
}
proc Status_pop { win } {
    set win [Window_GetMaster $win]
    upvar #0 HM$win var
    if [info exists var(old_stat2)] {
	set var(S_stat2) $var(old_stat2)
	unset var(old_stat2)
    } else {
	set var(S_stat2) ""
    }
    update idletasks
}
# Return the name of the label used for status messages.
proc StatusLabel { win } {
    set win [Window_GetMaster $win]
    set label [winfo parent $win].status.msg
    regsub {\.\.} $label {.} label
    return $label
}
proc WindowControls {win frames} {
    upvar #0 Controls$win show
    if {!$show} {
	eval {pack forget} $frames
    } else {
	eval pack $frames {-side top -fill x -before $win}
    }
}

# Fill up a frame with menubuttons and buttons that are
# registered in the resource database with the
# menulist and buttonlist family of resources.

proc Window_ButtonFrame {frame} {
    foreach mb [Window_ResourceFamily $frame menulist] {
        Window_MenuButton $frame $mb
        WindowMenuInner [menu $frame.$mb.[Window_Resource $frame.$mb menu m]] 2
    }
    set i 0
    foreach b [Window_ResourceFamily $frame buttonlist] {
	if {[string compare $b "|"] == 0} {
	    frame $frame.pad$i -width 5 -bd 0 -height 1
	    pack $frame.pad$i -side left -fill y
	    incr i
	} else {
	    Window_PackedWidget $frame $b button
	    # Subst the command in the conext of our caller.
	    $frame.$b config -command [uplevel [list subst [$frame.$b cget -command]]]
	}
    }
}
# Create a button using the resource database for attributes.
# This packs the button into the parent frame, too.
proc Window_Button {par but args} {
    eval {Window_PackedWidget $par $but button} $args
}
proc Window_MenuButton {par but args} {
    eval {Window_PackedWidget $par $but menubutton} $args
    set menu [$par.$but cget -menu]
    if {[string length $menu] == 0} {
	set menu $par.$but.m
    } elseif {![string match $par.$but.* $menu]} {
	set menu $par.$but.$menu
    }
    $par.$but config -menu $menu
}
proc Window_CheckButton {par but args} {
    eval {Window_PackedWidget $par $but checkbutton} $args
}
proc Window_RadioButton {par but args} {
    eval {Window_PackedWidget $par $but radiobutton} $args
}
proc Window_PackedWidget {par but what args} {
    set cmd [list $what $par.$but]
    if [catch [concat $cmd $args] b] {
	catch {puts stderr "Window $what $par.$but (warning) $b"}
	set ix [lsearch $args -font]
	if {$ix >= 0} {
	    set args [lreplace $args $ix [incr ix]]
	}
	eval $cmd {-font fixed} $args
    }
    eval {pack $par.$but} -side [Window_Resource $par.$but side left]
    return $par.$but
}

proc WindowMenuCommand {m l cmd} {
    set cmd [list $m add command -label $l  -command $cmd]
    if [catch $cmd t] {
	Stderr "WindowMenuCommand $l $cmd: $t"
	eval $cmd {-font fixed}
    }
}
proc WindowMenuRadio {m l {cmd { }} {var {}} {val {}}} {
    # Create a radio menu entry.  By default all radio entries
    # for a menu share a variable.
    if {$var == {}} {
	set var v$m
    }
    set cmd2 [list $m add radio -label $l -variable $var -command $cmd \
	    -value $val]
    if [catch $cmd2 t] {
	Stderr "WindowMenuRadio $l $var $cmd: $t"
	eval $cmd2 {-font fixed}
    }
}
proc WindowMenuCheck {m l {cmd { }} {var {}} {val {}}} {
    # Create a Check button menu entry.  By default all check entries
    # have their own variable.
    if {$var == {}} {
	set var v$m
    }
    set cmd2 [list $m add check -label $l -variable $var -command $cmd]
    if {[string length $val]} {
	lappend cmd2 -onvalue $val -offvalue {}
    }
    if [catch $cmd2 t] {
	Stderr "WindowMenuCheck $l $var $cmd: $t"
	eval $cmd2 {-font fixed}
    }
    return $var
}
proc WindowMenuCascade {menu l {c { }} {sub {}}} {
    # Create a cascade menu entry.
    if [catch {menu $menu.$sub} submenu] {
	set submenu [menu $menu.$sub -font fixed]
    }
    set cmd [list $menu add cascade -label $l -menu $submenu -command $c]
    if [catch $cmd t] {
	Stderr "WindowMenuCascade $l $submenu $c: $t"
	eval $cmd {-font fixed}
    }
    return $submenu
}

proc Window_Resource {b res {default {}}} {
    set val [option get $b $res {}]
    if {[string length $val]} {
	return $val
    } else {
	return $default
    }
}

proc Window_ResourceFamily { w resname } {
    set res	[option get $w $resname {}]
    set lres    [option get $w l$resname {}]
    set ures 	[option get $w u$resname {}]

    set l-res	[option get $w l-$resname {}]
    set u-res	[option get $w u-$resname {}]

    set list [lsubtract $res ${l-res}]
    set list [concat $list $lres]
    set list [lsubtract $list ${u-res}]

    return [concat $list $ures]
}

proc lsubtract { orig nuke } {
    # Remove elements in $nuke from $orig
    foreach x $nuke {
	set ix [lsearch $orig $x]
	if {$ix >= 0} {
	    set orig [lreplace $orig $ix $ix]
	}
    }
    return $orig
}
# Create a menu from resources.
# Ugh! - macro expand any variable references in
# the context of the (original) caller of WindowMenuInner
# Allows variable references in the app-defaults file

proc WindowMenuInner { menu {level 1} } {

    foreach e [Window_ResourceFamily $menu entrylist] {
	set l [option get $menu l_$e {}]	;# label
	set c_orig [option get $menu c_$e {}]	;# command
	set v [option get $menu v_$e {}]	;# variable
	set x [option get $menu x_$e {}]	;# value
	set a [option get $menu a_$e {}]	;# accelerator binding
	set b [option get $menu b_$e {}]	;# bindtag for binding
	set u [option get $menu u_$e {}]	;# underline index
	set v [uplevel $level "subst \"$v\""]
	set c [uplevel $level "subst \"$c_orig\""]
	case [option get $menu t_$e {}] {
	    default {WindowMenuCommand $menu $l $c}
	    check   {WindowMenuCheck $menu $l $c $v $x}
	    radio   {WindowMenuRadio $menu $l $c $v $x}
	    cascade {
		set sub [option get $menu m_$e {}]
		if {[string length $sub] != 0} {
		    set submenu [WindowMenuCascade $menu $l $c $sub]
		    WindowMenuInner $submenu [expr $level+1]
		}
	    }
	    separator {
		$menu add separator
	    }
	}
	if {[string length $u]} {
	    if [catch {$menu entryconfigure $l -underline $u} err] {
		Stderr "$menu $l: $err"
	    }
	}
	if {[string length $a]} {
	    $menu entryconfigure $l -accelerator $a
	    if {[string length $b]} {
		# Hack - map any $win into %W for bindings
		# because the bindtag is something like HCmd, HText, or Tselect
		regsub -all {\$win} $c_orig %W c_orig
		set c [uplevel $level "subst \"$c_orig\""]
		if [catch {bind $b $a $c} err] {
		    Stderr "bind $b $a $c: $err"
		}
	    }
	}
    }
    return $menu
}

