# toolbar.tcl
# A toolbar that corresponds to html tags

proc Toolbar_Create {win tool} {
    global toolbar
    set toolbar($win,tools) $tool
    option add *Toolbar*Button.highlightThickness 1 startup
    option add *Toolbar*Button.padX 2 startup
    option add *Toolbar*Button.padY 1 startup

    # Edit mode toolbar

    set e [frame $tool.edit]	;# Container for edit toolbar
    Window_ButtonFrame $e	;# Get button set from resource database
    set toolbar($win,bg) [[lindex [winfo children $e] 0] cget -background]
    catch {$e.pre config -width 4}

    # Browse mode toolbar
    set b [frame $tool.browse]	;# Container for browse toolbar
    Window_ButtonFrame $b	;# Get button set from resource database
}

proc Toolbar_Menus {win args} {
    global toolbar
    set toolbar($win,menus) $args
}
proc Toolbar_EditMode {win edit} {
    global toolbar
    if ![info exists toolbar($win,tools)] {
	return
    }
    if $edit {
	pack forget $toolbar($win,tools).browse
	pack $toolbar($win,tools).edit
    } else {
	pack forget $toolbar($win,tools).edit
	pack $toolbar($win,tools).browse
    }
    foreach mb $toolbar($win,menus) {
	$mb config -state [expr {$edit ? "normal" : "disabled"}]
    }
}
proc Toolbar_HighlightReset {win} {
    global toolbar
    if ![info exists toolbar($win,tools)] {
	return;	# No toolbar for things in a table - could chain up.
    }
    set e $toolbar($win,tools).edit
    foreach b [winfo children $e] {
	if {[winfo class $b] == "Button"} {
	    $b config -background $toolbar($win,bg)
	    set name [file extension $b]	;# ugh
	    if {$name == ".pre"} {
		$e$name config -text pre \
		    -command [list Input_Tag $win pre]
	    }
	}
    }
}
proc Toolbar_Highlight {win htag} {
    global toolbar
    if ![info exists toolbar($win,tools)] {
	return;	# No toolbar for things in a table - could chain up.
    }
    set e $toolbar($win,tools).edit
    if [winfo exists $e.$htag] {
	$e.$htag config -background white
	if {$htag == "pre"} {
	    $e.$htag config -text /pre -command [list Input_ClosePre $win]
	}
	return
    }
}
proc Toolbar_HighlightOff {win htag} {
    global toolbar
    if ![info exists toolbar($win,tools)] {
	return;	# No toolbar for things in a table - could chain up.
    }
    set e $toolbar($win,tools).edit
    if [winfo exists $e.$htag] {
	$e.$htag config -background $toolbar($win,bg)
	if {$htag == "pre"} {
	    $e.$htag config -text pre -command [list Input_Tag $win]
	}
	return
    }
}
proc Toolbar_Update {win} {
    upvar #0 HM$win var
    if ![info exists var(toolbarupdate)] {
	# Batch toolbar updates until after redisplays
	# that will be forced by update idletasks
	set var(toolbarupdate) 1
	after 500 [list ToolbarUpdate $win]
    }
}
# Update UI buttons to reflect state
proc ToolbarUpdate {win} {
    upvar #0 HM$win var
    catch {unset var(toolbarupdate)}
    Toolbar_HighlightReset $win
    set maxlevel 0
    foreach htag [Mark_Stack $win] {
	if [IsList $htag l level] {
	    if {$level >= $maxlevel} {
		set ltag $l
		set maxlevel $level
	    }
	} elseif {![string match /* $htag]} {
	    Toolbar_Highlight $win $htag
	}
    }
    if [info exists ltag] {
	Toolbar_Highlight $win $ltag
    }
}

# Customization interface
proc Toolbar_Edit {} {
    global toolbar
    set t [set toolbar(root) .tooledit]
    if [winfo exists $t] {
	wm deiconify $t
	raise $t
	return
    }
    toplevel $t -class Toolbar -bd 4
    message $t.msg -aspect 2000 -text \
"Toolbar Editor.
The top row is for edit mode.  The second row is for browse mode.
Click NEW to add a button to a row.  Click on a button to change or delete it."
    pack $t.msg
    set toolbar(work) $t.workspace
    frame $toolbar(work)
    pack $toolbar(work) -side bottom

    set toolbar(status) ""
    set toolbar(cmdvalue) ""

    set win \$win		;# For magic command re-writing

    foreach x {edit browse} {
	set e [frame $t.$x]	;# Container for edit toolbar
	button $e._new_ -text NEW -command [list ToolbarNewCommand $e]
	pack $e._new_ -side left -ipadx 2 -ipady 4 -padx 4
	Window_ButtonFrame $e	;# Get button set from resource database
	set toolbar(bg) [[lindex [winfo children $e] 0] cget -background]
	catch {$e.pre config -width 4}
	pack $e
    
	foreach but [winfo children $e] {
	    if [regexp _new_$ $but] {
		continue
	    }
	    catch {
		set oldcommand [$but cget -command]
		$but config -command [list ToolbarEditCommand $but $oldcommand]
	    }
	}
    }
}
proc Toolbar_List {editbrowse} {
    global toolbar
    set t .tooledit
    if {![winfo exists $t]} {
	Toolbar_Edit
	wm withdraw .tooledit
    }
    set result {}
    foreach but [Window_ResourceFamily $t.$editbrowse buttonlist] {
	if {[string compare "|" $but] == 0} {
	    continue
	}
	set cmd [$t.$editbrowse.$but cget -command]
	if {[lindex $cmd 0] == "ToolbarEditCommand"} {
	    set cmd [lindex $cmd 2]
	}
	lappend result $but [$t.$editbrowse.$but cget -text] $cmd
    }
    return $result
}
proc Toolbar_NewCommand {parent text command} {
    global toolbar
    set i 0
    set buttons [Window_ResourceFamily $parent buttonlist]
    while {[lsearch -exact $buttons user$i] >= 0} {
	incr i
    }
    set name user$i
    # Its easiest if we create the button in all toolbar instances
    set editbrowse [lindex [split $parent .] end]
    ToolbarOptionAdd $editbrowse.$name
    ToolbarAddButton $editbrowse $name $text $command
    set toolbar(cmdvalue) $command
    ToolbarChange change $name $text cmd
}
proc ToolbarNewCommand {parent {text {}} {command { }}} {
    global toolbar
    set i 0
    set buttons [Window_ResourceFamily $parent buttonlist]
    while {[lsearch -exact $buttons user$i] >= 0} {
	incr i
    }
    set name user$i
    # Its easiest if we create the button in all toolbar instances
    set editbrowse [lindex [split $parent .] end]
    ToolbarOptionAdd $editbrowse.$name
    ToolbarAddButton $editbrowse $name $text $command
    ToolbarEditCommand $parent.$name $command OK
}
proc ToolbarEditCommand {b command {okText Change}} {
    global toolbar
    set f $toolbar(work)
    catch {eval destroy [winfo children $f]}
    if {$toolbar(status) == "waiting"} {
	set toolbar(status) cancel
	return
    }
    $b config -bg white

    # Name is either "edit.foo" or "browse.foo"
    if ![regexp {[^.]+\.[^.]+$} $b name] {
	error "unexpected name $b"
    }
    label $f.text -text Text:
    entry $f.btext -textvar toolbar(btext)
    set toolbar(btext) [$b cget -text]
    grid $f.text $f.btext -sticky w


    if [regexp ^edit $name] {
	radiobutton $f.action -text "Tcl Command:" \
		-variable toolbar(action) -value cmd
    } else {
	label $f.action -text "Tcl Command:"
    }
    entry $f.cmdvalue -textvar toolbar(cmdvalue) -width 30
    set toolbar(cmdvalue) $command
    trace variable toolbar(action) w ToolbarTraceAction
    set toolbar(action) cmd
    grid $f.action $f.cmdvalue -sticky w

    if [regexp ^edit $name] {
	radiobutton $f.sethtml -text "Html Tag:" \
		-variable toolbar(action) -value html
	entry $f.htmlvalue -textvar toolbar(htmlvalue)
	if {[lindex $command 0] == "Input_Tag"} {
	    set toolbar(htmlvalue) [lindex $command end]
	    set toolbar(action) html
	}
	trace variable toolbar(htmlvalue) w ToolbarTraceHtml
	grid $f.sethtml $f.htmlvalue -sticky w

	radiobutton $f.setmacro -text "Html Macro:" \
		-variable toolbar(action) -value macro
	eval {tk_optionMenu $f.macrovalue toolbar(macrovalue)} [Macro_List]
	if {[lindex $command 0] == "Macro_Invoke"} {
	    set toolbar(macrovalue) [lindex $command 1]
	    set toolbar(action) macro
	}
	trace variable toolbar(macrovalue) w ToolbarTraceMacro
	grid $f.setmacro $f.macrovalue -sticky w
    }
    set g [frame $f.but]
    grid $g -
    grid $g -sticky news
    button $g.ok -text $okText -command {set toolbar(status) change}
    button $g.del -text "Delete" -command {set toolbar(status) delete}
    if {$okText != "OK"} {
	button $g.cancel -text "Cancel" -command {set toolbar(status) cancel}
	pack $g.ok $g.cancel $g.del -side left -expand true
    } else {
	pack $g.ok $g.del -side left -expand true
    }


    set toolbar(status) waiting
    tkwait variable toolbar(status)

    if {$toolbar(status) != "cancel"} {
	ToolbarChange $toolbar(status) $name $toolbar(btext) $toolbar(action)
    }
    catch {eval destroy [winfo children $f]}
    catch {$b config -bg $toolbar(bg)}
    set toolbar(status) ""
    return
}
proc ToolbarTraceAction {args} {
    global toolbar
    if {$toolbar(action) == "cmd"} {
	set toolbar(htmlvalue) {}
	set toolbar(macrovalue) {}
    }
}
proc ToolbarTraceMacro {args} {
    global toolbar
    set toolbar(htmlvalue) ""	;# Note - this fires ToolbarTraceHtml
    if {[string length $toolbar(btext)] == 0} {
	set toolbar(btext) $toolbar(macrovalue)
    }
    set toolbar(cmdvalue) [concat [list Macro_Invoke $toolbar(macrovalue)] \$win]
    set toolbar(action) macro
}
proc ToolbarTraceHtml {args} {
    global toolbar
    if {[string length $toolbar(htmlvalue)] == 0} {
	return
    }
    if {[string length $toolbar(btext)] == 0} {
	regexp {^[^ ]+} $toolbar(htmlvalue) toolbar(btext)
    }
    set toolbar(cmdvalue) [concat Input_Tag \$win [list $toolbar(htmlvalue)]]
    set toolbar(action) html
}
proc ToolbarAddButton {editbrowse name text command {parent .} {classlist {}}} {
    global toolbar
    lappend classlist [winfo class $parent]
    set hit [lsearch $classlist Toolbar]
    foreach child [winfo children $parent] {
	if {($hit >= 0) && ([winfo class $child] == "Frame") &&
		[regexp "\\.$editbrowse\$" $child]} {
	    if [regexp ^$toolbar(root) $child] {
		set command [list ToolbarEditCommand $child.$name $command]
		set option 0
	    }
	    button $child.$name -text $text -command $command
	    pack $child.$name -side right
	} else {
	    ToolbarAddButton $editbrowse $name $text $command $child $classlist
	}
    }
}

proc ToolbarChange {how name text action {parent .} {classlist {}}} {
    global toolbar
    lappend classlist [winfo class $parent]
    set hit [lsearch $classlist Toolbar]
    set option 1
    foreach child [winfo children $parent] {
	if {($hit >= 0) && ([winfo class $child] == "Button") &&
		[regexp "\\.$name\$" $child]} {
	    if [regexp ^$toolbar(root) $child] {
		set command [list ToolbarEditCommand $child $toolbar(cmdvalue)]
		set option 0
	    } else {
		switch -- $action {
		    cmd	{set command $toolbar(cmdvalue)}
		    html {set command \
			[concat Input_Tag \$win [list $toolbar(htmlvalue)]]}
		    macro {set command \
			[concat Macro_Invoke [list $toolbar(macrovalue)] \$win]}
		}
		set toolbar(cmdvalue) $command
	    }
	    switch $how {
		change {
		    $child config -text $text -command $command
		    if {$option} {
			ToolbarOption "*Toolbar.$name.text"  $text
			ToolbarOption "*Toolbar.$name.command" $command
		    }
		}
		delete {
		    destroy $child
		    if {$option} {
			ToolbarOptionDelete $name
		    }
		}
	    }
	} else {
	    ToolbarChange $how $name $text $action $child $classlist
	}
    }
}

proc ToolbarOption {resource value} {
    if ![catch {open [Platform_File def]} in] {
	set X [read $in]
	close $in
    } else {
	set X "!!! WebTk Automatically Generated Resources
!!! Last Modified: [clock format [clock seconds]]
"
    }
    option add $resource $value
    regsub -all {[\.\*]} $resource {\\&} xresource
    if {[regsub "\n$xresource:\[^\n\]*\n" $X "\n$resource: $value\n" X] == 0} {
	append X "$resource: $value\n"
    }
    regsub "!!! Last Modified:\[^\n\]+\n" $X \
	"!!! Last Modified: [clock format [clock seconds]]\n" X
    if ![catch {open [Platform_File def] w} out] {
	puts -nonewline $out $X
	close $out
    } else {
	error "Cannot open file to save toolbar settings"
    }
}
proc ToolbarOptionDelete {name} {
    set parent [lindex [split $name .] 0]
    set name [lindex [split $name .] end]

    set adds [option get .tools.$parent ubuttonlist {}]
    set ix [lsearch $adds $name]
    if {$ix >= 0} {
	set adds [lreplace $adds $ix $ix]
	ToolbarOption "*Toolbar.$parent.ubuttonlist" $adds
    } else {
	set dels [option get .tools.$parent u-buttonlist {}]
	if {[lsearch $dels $name] <= 0} {
	    append dels " $name"
	}
	ToolbarOption "*Toolbar.$parent.u-buttonlist" $dels
    }
}
proc ToolbarOptionAdd {name} {
    set parent [lindex [split $name .] 0]
    set name [lindex [split $name .] end]
    set dels [option get .tools.$parent u-buttonlist {}]
    set ix [lsearch $dels $name]
    if {$ix >= 0} {
	set dels [lreplace $dels $ix $ix]
	ToolbarOption "*Toolbar.$parent.u-buttonlist" $dels
    }
    set adds [option get .tools.$parent ubuttonlist {}]
    if {[lsearch $adds $name] <= 0} {
	append adds " $name"
	ToolbarOption "*Toolbar.$parent.ubuttonlist" $adds
    }

}

