#macro.tcl
#	Support for user-defined sequences of HTML
#

proc Macro_Init {menu t} {
    global macro
    Macro_Menu $menu $t 2
    if ![info exists macro(list)] {
	set macro(list) [list $menu $t]
    }
    if {[lsearch $macro(list) $menu] < 0} {
	lappend macro(list) $menu $t
    }
}
# Reset all the macro menus we know about, and garbage collect
# those associated with deleted windows
proc Macro_Reset {} {
    global macro
    catch {uplevel #0 source [Platform_File macros]}
    set list $macro(list)
    set macro(list) {}
    foreach {menu t} $list {
	if [winfo exist $menu] {
	    Macro_Init $menu $t
	}
    }
}

proc Macro_Define {} {
    global macro WebTk
    set f .macro
    set t $f.text
    set list $f.list
    if [winfo exists $f] {
	wm deiconify $f
	raise $f
    } else {
	toplevel $f -class Macro
	wm title $f "WebTk Macro Editor"
	wm protocol $f WM_DELETE_WINDOW [list Macro_Dismiss $t destroy]
	set but [frame $f.but -class Menubar]
	pack $but -side top -fill x
	menubutton $but.file -menu  $but.file.m -text File
	set m [menu $but.file.m]
	$m add command -label Dismiss -command [list Macro_Dismiss $t]

	menubutton $but.help -menu  $but.help.m -text Help
	set file file:[file join $WebTk(html) macro.html]
	set m [menu $but.help.m]
	$m add command -label "Load Help URL into Netscape" -command [list Netscape $file]
	$m add command -label "Load Help URL into Mosaic" -command [list Mosaic $file]
	$m add command -label "Load Help URL into WebTk" -command [list Browse_WebTk $file]

	menubutton $but.edit -menu  $but.edit.m -text Edit
	set m [menu $but.edit.m]
	$m add command -label Cut -command [list MacroCut $t]
	$m add command -label Copy -command [list MacroCopy $t]
	$m add command -label Paste -command [list MacroPaste $t]

	pack  $but.file $but.edit -side left
	pack  $but.help -side right

	frame $f.right -bd 4
	frame $f.left -bd 4
	pack $f.right -side right -expand true -fill both
	pack $f.left -side left -expand true -fill both

	frame $f.right.bottom
	pack $f.right.bottom -side bottom -fill x

	label $f.label -text " Name:"
	label $f.dirty -textvariable macro(dirty) -width 0
	button $f.save -text "Save" -command [list Macro_Save $t]
	button $f.reset -text "Reset" -command [list Macro_ResetUI $t]
	set macro(name) {}
	set macro(toolbar) [MacroOnToolbar]
	checkbutton $f.toolbar -text "Toolbar" -variable macro(toolbar) \
	    -command [list MacroAddToolbar]
	entry $f.entry -textvariable macro(name)
	bind $f.entry <FocusOut> {set macro(toolbar) [MacroOnToolbar]}
	bind $f.entry <Return> {set macro(toolbar) [MacroOnToolbar]}
	pack  $f.entry $f.label $f.save $f.reset $f.toolbar $f.dirty \
	    -side right -in $f.right.bottom

	text $t -width 60 -height 10 \
	    -yscrollcommand "$f.right.yscroll set" \
	    -xscrollcommand "$f.right.xscroll set"
	scrollbar $f.right.yscroll -command "$t yview" -orient vertical
	scrollbar $f.right.xscroll -command "$t xview" -orient horizontal
	pack $f.right.xscroll -side bottom -fill x
	pack $f.right.yscroll -side right -fill y
	pack $f.text -side left -fill both -expand true -in $f.right


	bind $t <Any-Key> MacroDirty

	frame $f.left.bottom
	pack $f.left.bottom -side bottom -fill x

	listbox $list -yscrollcommand "$f.lscroll set" -width 10
	scrollbar $f.lscroll -command "$list yview" -orient vertical
	pack $f.lscroll -side right -in $f.left -fill y
	pack $list -side left -in $f.left -fill both -expand true

	button $f.edit -text "Edit" -command [list MacroEdit $t $list]
	button $f.load -text "Load" -command [list MacroLoad $t $list]
	pack $f.edit $f.load -side left -in $f.left.bottom

    }
    MacroClear $t

    $list delete 0 end
    foreach x [lsort [info procs macro_*]] {
	regsub "macro_" $x {} name
	$list insert end $name
    }
}
proc Macro_List {} {
    set result ""
    foreach x [lsort [info procs macro_*]] {
	regsub "macro_" $x {} name
	lappend result $name
    }
    return $result
}
proc Macro_Edit {} {
    Macro_Define
}
proc MacroEdit {t list} {
    global macro
    set cur [$list cur]
    if {[string length $cur] == 0} {
	return
    }
    if {[MacroIsDirty]} {
	if [DialogConfirm .macro .savedialog \
	    "Save or discard changes to $macro(name)" { } { } Save Discard] {
	    Macro_Save $t
	}
    }
    set macro(name) [$list get $cur]
    MacroClear $t
    MacroDefUse $macro(name) $t
    set macro(toolbar) [MacroOnToolbar]
}
proc MacroLoad {t list} {
    global macro
    set cur [$list cur]
    if {[string length $cur] == 0} {
	return
    }
    MacroDefUse [$list get $cur] $t
    set macro(dirty) (Modified)
}
proc MacroDirty {} {
    global macro
    set macro(dirty) Modified
}
proc MacroIsDirty {} {
    global macro
    return [string length $macro(dirty)]
}
proc MacroClean {} {
    global macro
    set macro(dirty) ""
}
proc MacroOnToolbar {args} {
    global macro
    foreach {but text command} [Toolbar_List edit] {
	if {[lindex $command 0] == "Macro_Invoke"} {
	    set name [lindex $command 1]
	    if {[string compare $name $macro(name)] == 0} {
		return 1
	    }
	}
    }
    return 0
}
proc MacroAddToolbar {args} {
    global macro
    foreach {but text command} [Toolbar_List edit] {
	if {[lindex $command 0] == "Macro_Invoke"} {
	    set macro_name [lindex $command 1]
	    set but_name [lindex [split $but .] end]
	    if {[string compare $macro_name $macro(name)] == 0} {
		if !$macro(toolbar) {
		    ToolbarChange delete edit.$but_name $text cmd
		}
		return
	    }
	}
    }
    if !$macro(toolbar) {
	return
    }
    set parent .tooledit.edit
    Toolbar_NewCommand $parent $macro(name) \
	[concat [list Macro_Invoke $macro(name)] \$win]
    return
}


proc Macro_ResetUI {t} {
    global macro
    Macro_Reset
    catch {MacroDefUse $macro(name) $t}
}

proc MacroClear {t} {
    global macro
    MacroClean
    $t delete 1.0 end
}
# Initialize the macro menu in the main window
proc Macro_Menu {menu t {offset 0}} {
    $menu delete $offset last
    foreach macro [lsort [info procs macro_*]] {
	regsub "macro_" $macro {} name
	$menu add command -label $name -command [list Macro_Invoke $name $t]
    }
}
proc MacroDefUse {name t} {
    $t insert insert [macro_$name $t]
}
proc Macro_Invoke {name t} {
    set result [macro_$name $t]
    if [regexp (SELECTION|TEXTSEL) $result] {
	if [catch {$t index sel.first}] {
	    Status $t "$name applies to a selection"
	    return
	}
	Text_MarkSet $t insert sel.first
	set html [Edit_CutRange $t sel.first sel.last]
	regsub -all SELECTION $result $html result
	regsub -all {<[^>]+>} $html {} plain
	regsub -all TEXTSEL $result $plain result
	Input_Html $t $result
    } else {
	Input_Html $t $result
    }
}
proc Macro_Save {t} {
    global macro
    set macro(name) [string trim $macro(name)]
    if {[string length $macro(name)] == 0} {
	DialogInfo .macro "Please name the macro"
	focus .macro.but.entry
	return
    }
    set text [$t get 1.0 end]
    set body [list return $text]
    ## Rewrite the users macro file

    interp create macro
    set file [Platform_File macros]
    catch {macro eval source $file}
    set out [open $file w]
    interp share {} $out macro
    macro eval [list proc macro_$macro(name) {{win {}}} $body]
    macro eval [list proc MacroSaveClosure {out} [info body MacroSaveClosure]]
    macro eval [list MacroSaveClosure $out]
    interp delete macro
    close $out

    Macro_Reset
    Macro_Edit
    MacroClean
}

proc MacroSaveClosure {out} {
    foreach varName [info globals] {
	upvar #0 $varName var
	if {![regexp ^(tcl|tk|env|auto|error|pkg) $varName]} {
	    if [catch {puts $out [list set $varName $var]}] {
		puts $out [list array set $varName [array get var]]
	    }
	}
    }
    foreach proc [info procs] {
	if ![regexp ^(tcl|tk|unknown|auto|pkg|Macro) $proc] {
	    set cmd [list proc $proc]
	    set args {}
	    foreach arg [info args $proc] {
		if [info default $proc $arg value] {
		    lappend args [list $arg $value]
		} else {
		    lappend args $arg
		}
	    }
	    lappend cmd $args [info body $proc]
	    puts $out $cmd
	}
    }
}

proc MacroCut {t} {
    catch {
	set text [$t get sel.first sel.last]
	$t delete sel.first sel.last
	clipboard clear
	clipboard append $text
	MacroDirty
    }
}
proc MacroCopy {t} {
    catch {
	set text [$t get sel.first sel.last]
	clipboard clear
	clipboard append $text
    }
}
proc MacroPaste {t} {
    if [catch {selection get} text] {
	if [catch {selection get -selection CLIPBOARD} text] {
	    return
	}
    }
    $t insert insert $text
    MacroDirty
}
proc Macro_Dismiss {t {destroy ""}} {
    global macro
    if {[MacroIsDirty]} {
	if [DialogConfirm .macro .savedialog \
	    "Save or discard changes to $macro(name)" { } { } Save Discard] {
	    Macro_Save $t
	}
    }
    if {$destroy == "destroy"} {
	destroy [winfo toplevel $t]
    } else {
	wm withdraw [winfo toplevel $t]
    }
}

proc macro_bolditalic {{win {}}} {
    return \
"<!-- macro example 1: bold-italic -->
<b><em>SELECTION</em></b>"
}
proc macro_hr75 {{win {}}} {
    return \
"<!-- macro example 2: 75% horizontal rule -->
<hr width=75%>"
}
proc macro_trademark {{win {}}} {
    return \
"<sup><font size=-2>TM</font></sup>"
}
proc macro_h1title {win} {
    upvar #0 Head$win head
    return \
"<h1>$head(title)</h1>"
}
proc macro_mailto {{win {}}} {
    return {<a href="mailto:TEXTSEL">TEXTSEL</a>}
}
proc macro_URL {{win {}}} {
    return {<a href="TEXTSEL">TEXTSEL</a>}
}
proc macro_trademark args {
    return {<sup><font size=-2>TM</font></sup>}
}
proc macro_registered args {
    return {&reg;}
}
proc macro_copyright args {
    return {&copy;}
}

