# mark.tcl
#
# This module has the code that applies the marks and tags that provide
# the fundamental data structure used for editing.  HTML tags are represented
# by either text marks or text tag ranges.  Marks are used for singleton
# tags like <img> and for "null" like isolated <p> tags.  Tag ranges are
# used for HTML tag pairs like <b>bold</b>.
#
proc Mark_Reset {win} {
    upvar #0 HM$win var		;# Rendering state
    upvar #0 HMhead$win head 	;# <head> information
    upvar #0 HMtag$win tag	;# Map from marks to HTML tags
    global CurrentParams	;# The parameters for each active HTML tag

    set var(S_markid) 0		;# UID for mark names
    set var(S_tagcache) -	;# {} matches tags in non-nodes
    set var(newline) 1		;# To supress any leading newlines
    set var(trimspace) 1	;# To supress any leading spaces
    Input_Clean $win
    catch {unset var(S_insertSaved)}
    catch {unset tag}
    catch {unset CurrentParams}

    # At the very beginning of the buffer their may be no mark,
    # so these maps from null to hmstart ensure proper initialization
    set tag()	hmstart

    # For the Html show toggle button
    upvar #0 HtmlShow$win show ; set show 0
}

# HMmark is the callback from HMrender that sets up tags and marks for editting.
# HMrender calls HMmark before inserting text after the html tag.
# We use tag names of the form H:tag where tag
# is the HTML tag (and parameters) applied to the text. 
# If there is no text associated with the HTML tag, then
# a text mark is inserted and a record of the corresponding HTML is kept.

proc HMmark {win htag not param textVar} {
    upvar #0 HM$win var
    upvar $textVar text
    global SingletonMap NodeMap ListMap IgnoreMap UnPMap
    # Handle comments here because defining a proc named "HMtag_!--"
    # does not catch all comments.

    if [info exists IgnoreMap($not$htag)] {
	dputs ingore $not$htag
	return
    }
    if [regexp ^! $htag] {
	upvar #0 Head$win head
	if {[info exists head(inBody)] && !$head(inBody)} {
	    lappend head(comments) "$htag $param"
	} else {
	    Mark_Add $win $htag $param left
	    set text [string trimleft $text]
	}
	return
    }
    if [info exists UnPMap($not$htag)] {
	# Check for unclosed node-type tags.  This test is here because
	# /hmstart is cleverly in the UnPMap to handle any unclosed nodes
	# at the end of the document
	Mark_CloseTags $win 1
    }
    global KnownMap
    if ![info exists KnownMap($htag)] {
	if {"[info commands HMtag_$not$htag][info commands HMtag_$htag][info commands Table_$not$htag][info commands Table_$htag]" == {}} {
	    MarkUndefined $win $not$htag $param text
	    return
	}
	set KnownMap($htag) tagproc
    }

    if {[string length $not]  == 0} {
	# Open tag
	if [info exists SingletonMap($htag)] {
	    Mark_Add $win $htag $param left
	} else {
	    # Clean up some trash introduced by old versions of webedit
	    regsub { nuke!=".+"} $param {} param
	    set t [string trim "H:$htag $param"]
	    if [info exists ListMap($htag)] {
		# var(indent) has just been updated by HMrender, but
		# var(level) is not yet defined, so we simulate HMcurrent_tags
		set level [expr [llength $var(indent)]-1]
		append htag =$level
		set t [string trim "H:$htag $param"]
	    }  elseif {![info exists NodeMap($htag)]} {
		# preserve other tags across node boundaries, but don't stack
		# if this tag is already opened.  Often folks leave out
		# </a> in lists of URLs.
		if ![info exists var(T,$htag)] {
		    HMstack $win [list listtags $t]
		}
	    }
	    # The T* pattern is picked up by HMcurrent_tags
	    set var(T,$htag) [list $t]
	}
    } else {
	# Close tag
	if [info exists ListMap($htag)] {
	    # Indent level has already been popped by HMrender
	    set level [llength $var(indent)]
	    if ![info exists var(T,$htag=$level)] {
		# Handle out-of-order close tags
		# T,ol=4 will be defined, for example
		if [regsub ^T, [array names var T,*=$level] {} x] {
		    set htag $x
		}
	    } else {
		append htag =$level
	    }
	}
	if [info exists var(T,$htag)] {
	    if {![info exists NodeMap($htag)] && ![IsList $htag x y]} {
		HMstack/ $win [list listtags {}]
	    }
	    unset var(T,$htag)	;# See HMcurrent_tags
	} elseif {$htag != "hmstart" && ![info exists SingltonMap($htag)]} {
	    MarkError $win "Unmatched close tag /$htag"
	}
    }
}

# Mark_CloseTags cleans up the previous node, if needed.

proc Mark_CloseTags {win {markErrors 0}} {
    upvar #0 HM$win var
    global HMtag_map
    if [info exists var(T,p)] {
	HMtag_/p $win {} {}
	catch {HMstack/ $win $HMtag_map(p)}
	unset var(T,p)
    }
    return
}
# Mark_ReadTags recomputes the display engine's state variables for
# a given point in the text.
#
# HMinit_state wipes out state elements that do not begin with S_*
# but we need to save (or rebuild) some of these:
# 	tag is a uid for tags
# 	form_id is the key to the current form, if any
# 	level is the indent level
# 	for numbered lists, count${level-1} is the numering counter.
# The tag_<list type> handlers compute some list state, so we call
# them because they don't render anything.

proc Mark_ReadTags { win mark {how all}} {
    upvar #0 HM$win var

    set tags [$win tag names $mark]
    if {[string compare $how "force"] != 0 &&
	    [string compare $tags $var(S_tagcache)] == 0} {

	# In most cases no change in tags means no state change.
        # This makes cursor motion and backspace tons faster, but
	# doesn't work after complex edit operations
	# (e.g., ChangeNode when the cursor is at line end)

	if [$win compare $mark == "$mark linestart"] {
	    set var(newline) 1
	    set var(trimspace) 1
	} else {
	    catch {unset var(newline)}
	    catch {unset var(trimspace)}
	}
	return
    }
    set var(S_tagcache) $tags
    Mark_SetState $win $mark $how $tags
}

proc Mark_SetState {win mark how tags} {
    upvar #0 HM$win var
    global HMtag_map NodeMap
    set taglist [lsort -command OutputSortHtags \
			[Mark_FullStack $win $mark $how $tags]]

    set uid $var(tags)	;# preserve this, a UID counter
    HMinit_state $win
    set var(tags) $uid
    if [$win compare $mark == "$mark linestart"] {
	    set var(newline) 1
	    set var(trimspace) 1
    }

    # Update List state.  The ol, ul, and menu tag handlers initialize state.
    dputs $mark $taglist

    set var(level) -1
    HMstack $win $HMtag_map(hmstart)
    foreach htag $taglist {
	Mark_SplitTag $htag tag x
	if [IsList $tag ltag level] {
	    catch {HMstack $win $HMtag_map($ltag)}
	    set var(level) [expr $level -1]
	    HMtag_$ltag $win $x {}
	    if {[string compare $ltag "ol"] == 0} {
		List_CountItems $win $mark H:$htag
	    } elseif {[string compare $ltag "dl"] == 0} {
		List_FixDlIndent $win $mark
	    }
	} else {
	    catch {HMstack $win $HMtag_map($tag)}
	    if ![info exists NodeMap($tag)] {
		HMstack $win [list listtags H:$htag]
	    }
	    switch -exact -- $tag {
		form {
		    Form_SetID $win $mark
		}
		a {
		    set var(Tlink) link
		}
	    }

	}
	# var(T*) values get transferred to tags by HMcurrent_tags
	set var(T,$tag) [list H:$htag]
    }
    incr var(level)
    HMcurrent_tags $win
    return $var(inserttags)	;# Set by HMcurrent_tags
}

proc Mark_SplitTag {htag tagVar paramVar} {
    upvar $tagVar tag $paramVar param
    set tag [set param ""]
    regexp {^([^ 	]+)(([ 	]+)(.+)?)?$} $htag x tag y z param
}
# This is a specialized version of Mark_ReadTags that is used when
# refreshing from 1.0.  We need to ignore everything and just use
# the state associated with hmstart.  See InputRefreshRange
# This is also useful when pasting in whole HTML nodes at node boundaries.

proc Mark_ResetTags {win} {
    upvar #0 HM$win var
    global HMtag_map

    set uid $var(tags)	;# preserve this, a UID counter
    HMinit_state $win
    set var(tags) $uid

    set var(level) 0
    HMstack $win $HMtag_map(hmstart)
    set t [HMcurrent_tags $win]
    regsub -all {^sel|{}} $t {} var(inserttags)
    dputs $var(inserttags)
    return $var(inserttags)
}
# Insert a text mark and maintain a map from that to the HTML tag
proc Mark_Add {win htag param gravity {location insert}} {
    upvar #0 HM$win var HMtag$win tag
    set mark M:[incr var(S_markid)]
    set tag($mark) [string trim "$htag $param"]
    Undo_Record $win [list unset HMtag$win\($mark)] \
	    [list set HMtag$win\($mark) $tag($mark)]
    Text_MarkSet $win $mark $location $gravity
    return $mark
}
# Remove a mark and its associated information
proc Mark_Remove { win args } {
    upvar #0  HMtag$win tag
    foreach mark $args {
	if ![catch {$win index $mark} ix] {
	    Text_MarkUnset $win $mark
	    dputs $mark $ix
	    if [info exists tag($mark)] {
		Undo_Record $win [list set HMtag$win\($mark) $tag($mark)] \
			[list unset HMtag$win\($mark)]
		unset tag($mark)
	    }
	}
    }
}
# The following is used to remove the last mark added by HMmark.
# This is needed for special case tag handling, such as comments
# in the head section (See head.tcl) or base tags used with cut & paste
# (See tags.tcl)

proc Mark_RemoveLast { win } {
    upvar #0 HM$win var
    set mark M:$var(S_markid)
    Mark_Remove $win $mark
}
proc MarkError {win message} {
    upvar #0 HM$win var
    set mark E:[incr var(S_markid)]:$message
    Text_MarkSet $win $mark insert left
}

# What was the last mark that we inserted?
proc Mark_Current { win } {
    upvar #0 HM$win var
    return M:$var(S_markid)
}

# Locate the HTML mark at the current insert point, if any
proc Mark_Find { win {mark insert} } {
    set x {}
    foreach {z m zz} [$win dump -mark $mark] {
	if {[regexp ^M: $m]} {
	    lappend x $m
	}
    }
    return $x
}
proc Mark_FindHtag { win {mark insert} } {
    upvar #0 HMtag$win tag
    set x {}
    foreach {z m x} [$win dump -mark $mark] {
	if {[regexp ^M: $m]} {
	    lappend x $tag($m)
	}
    }
    return $x
}
proc Mark_Htag {win mark {htag {}}} {
    upvar #0 HMtag$win tag
    if ![info exists tag($mark)] {
	return {}
    }
    if {[string length $htag] == 0} {
	return $tag($mark)
    } else {
	Log $win Mark_Htag $mark $htag
	set tag($mark) $htag
    }
}
proc Mark_HtagOnly {win mark} {
    upvar #0 HMtag$win tag
    return [lindex $tag($mark) 0]	;# strip parameters
}

# Locate the next HTML mark in the range, if any.
# If nothing is found, then the end index is returned.
proc Mark_Next { win start end } {
    foreach {z m x} [$win dump -mark $start $end] {
	if {[regexp ^M: $m]} {
	    return $m
	}
    }
    return $end
}

# Locate the prev HTML mark in the range, if any.
# If nothing is found, the start index is returned
proc Mark_Prev { win start end } {
    set last $start
    foreach {z m x} [$win dump -mark $start $end] {
	if {[regexp ^M: $m]} {
	    set last $m
	}
    }
    return $last
}

# Set mark gravity for things at the insert point so that
# the inserted text pushes (or doesn't) the marks correctly.
# Node-type tags (for null nodes) should stay behind.  Others should get pushed.

proc Mark_AdjustGravity { win {mark insert}} {
    global NodeMap
    foreach m [Mark_Find $win $mark] {
	set h [Mark_HtagOnly $win $m]
	set grav right	;# push along images, form elements
	if {[info exists NodeMap($h)] || [info exists ListSingletonMap($h)]} {
	    set grav right
	}
	Log $win mark gravity $m $grav
	$win mark gravity $m $grav
    }
}

# When inserting whole nodes at the beginning of a node, the underlying
# marks all need to have right gravity to get pushed along.

proc Mark_RightGravity { win {mark insert}} {
    foreach m [Mark_Find $win $mark] {
	dputs $m
	$win mark gravity $m right
	Log $win mark gravity $m right
    }
}

# When inserting whole nodes the end of a node, the underlying
# marks all need to have left gravity to remain in place.

proc Mark_LeftGravity { win {mark insert}} {
    foreach m [Mark_Find $win $mark] {
	dputs $m
	$win mark gravity $m left
	Log $win mark gravity $m left
    }
}

# Return the html tag stack.  This comes from tags with names H:*
# The how parameter is used to refine boundary cases.  In particular,
# when the mark is at the end of an HTML tag, you may or may
# not want to pick up that tag.  When setting up for user input you do,
# but when refreshing ranges after edit operations, you do not.

proc Mark_FullStack { win mark how {tags {}}} {
    upvar #0 HM$win var HMtag$win tag
    global NodeMap StyleMap

    set s {}
    # Check active tags
    if {[string compare $tags {}] == 0} { 
        set tags [$win tag names $mark]
    }
    foreach t $tags {
	if [regexp {^H:(.+)$} $t zz htag] {
	    lappend s $htag
	}
    }

    # Check tag transitions at this point

    foreach {key value ix} [$win dump -tag $mark] {
        switch -- $key {
	    tagoff {
	        # In most cases we want to "see" the close tag of a style
		# or a node so input automatically extends that range.
		# The List tags, however, typically end at the same index
		# as the next node begins.  We don't want this to confuse
		# the NodeType procedure.
		# A special case occurs at end of file, when the close
		# list tag is and the end of line instead of at the beginning
		# of the line after the list.  Only in this case do we want
		# to see the close list tag.
		if [regexp ^H:(.+)$ $value zz htag] {
		    if {![IsList $htag z1 z2] || 
			[$win compare $ix == "$ix lineend"]} {
			if {[lsearch $s $htag] < 0} {
			    lappend s $htag
			}
		    }
		}
	    }
	    tagon {
		if [regexp ^H:(.+)$ $value zz htag] {
		    if {[lsearch $s $htag] < 0} {
			lappend s $htag
		    }
		}
	    }
	}
    }
    if {[string compare $how nostyle] == 0} { 
	# Trim style tags from the stack because the refresh will automatically
	# pick them up and add them to the HTML.  More precisely, the output
	# module will pick up these style tags, so they should not appear
	# in the state stacks.

	foreach htag $s { 
	    if [info exists StyleMap($htag)] {
		set ix [lsearch $s $htag]
		set s [lreplace $s $ix $ix]
	    }
	}
    }
    return $s
}

# This returns a stack that does not include any parameter information
# with the tags (e.g., "a", not "a href=foo"

proc Mark_Stack { win {mark insert} {how all} } {
    set s {}
    foreach t [Mark_FullStack $win $mark $how] {
	Mark_SplitTag $t tag param
	lappend s $tag
    }
    return $s
}
# Mark_RemoveAll is used before redisplaying a section of html.
# It removes all marks up to, but not including, last.

proc Mark_RemoveAll { win first last } {
    upvar #0  HMtag$win tag 
    LogBegin $win Mark_RemoveAll $first "$last"
    foreach {z mark ix} [$win dump -mark $first "$last"] {
	if [regexp M: $mark] {
	    dputs $mark [$win index $mark]
	    Mark_Remove $win $mark
	}
    }
    LogEnd $win
}


proc Mark_ShowHtml { win } {
    upvar #0 HtmlShow$win show
    set show 1
    set state(space) 0
    set state(uid) 0
    set state(marklist) {}

    # The dump command returns raw indexes, which become invalid as
    # soon as we start to insert the tag display, so two passes are made.
    # In pass one, temporary marks are put at each tag, and in
    # pass two text is inserted at those marks.

    set state(displayproc) [list MarkBuildMap <> $win state]
    set state(displaytext) [list MarkBuildMap {} $win state]
    $win dump -mark -tag -text -window -command [list OutputIt state $win] 1.0 end

    set s [$win cget -state]
    $win config -state normal
    foreach m $state(marklist) {
	$win insert  $m $state($m,html) "HTML space"
	$win mark unset $m
    }
    $win config -state $s
}
proc MarkBuildMap {sep win stateVar ix htag} {
    upvar $stateVar state
    set m _[incr state(uid)]
    $win mark set $m $ix
    lappend state(marklist) $m
    lassign {s1 s2} [split $sep {}]
    set state($m,html) "$s1$htag$s2"
}
proc Mark_HideHtml { win } {
    upvar #0 HtmlShow$win show
    set show 0
    set s [$win cget -state]
    $win config -state normal
    set next [$win tag nextrange HTML 1.0 end]
    while {"$next" != ""} {
	eval {$win delete} $next
	set next [$win tag nextrange HTML 1.0 end]
    }
    Mark_AdjustGravity $win
    $win config -state $s
}

proc Mark_RefreshHtml { win } {
    Mark_HideHtml $win
    Mark_ShowHtml $win
}

proc Mark_Show?Html { win } {
    upvar #0 HtmlShow$win show
    Feedback $win busy
    if {$show} {
	Mark_ShowHtml $win
    } else {
	Mark_HideHtml $win
    }
    Feedback $win ready
}

proc Mark_ToggleHtml { win } {
    upvar #0 HtmlShow$win show
    set show [expr !$show]
    Mark_Show?Html $win
}

proc Mark_Print { {win .text} } {
    set state(space) 0
    set state(displayproc) [list MarkPrintOne $win]
    set state(displaytext) [list MarkPrintText $win]
    $win dump -mark -tag -window -text -command [list OutputIt state $win] 1.0 end
}
proc MarkPrintOne {win ix htag} {
    puts "$ix <$htag>"
}
proc MarkPrintText {win ix text} {
    puts "$ix \"$text\""
}

proc Mark_Dump { {win .text} {start 1.0} {end end} } {
    $win dump -command MarkDump $start $end
}
proc MarkDump {key value ix} {
    if {$key == "text"} {
	puts "$ix \"$value\""
    } else {
	puts "$ix $key $value"
    }
}

# Put a marker in for unknown tags.
proc MarkUndefined {win htag param text} {
    upvar #0 HM$win var
    set tags [HMcurrent_tags $win]
    Mark_Add $win $htag $param left
    set mid [Mark_Current $win]
    lappend tags SHTML space $mid
    Text_Insert $win $var(S_insert) <$htag> $tags
    $win tag bind $mid <Motion> [list Status $win <[string trim "$htag $param"]>]
    $win tag bind $mid <Button-1> [list MarkEditTag $win $mid $htag $param]
}
proc MarkEditTag {win mid htag param} {
    if {![Input_Edit $win]} {
	return
    }
    set tag <[string trim "$htag $param"]>
    set message "Unknown Tag: $tag
You can edit or add parameters to the tag with this dialog.
To remove this tag, backspace over it in edit mode.
To insert unknown tags, use the Macro facility."
#    set info [Dialog_Htag $win "$htag parameters=" parameters=$param $message \
	[list MarkEditHook $win] ]
    set entryList [list [list "tag value" "$htag $param"]]
    upvar #0 $win.unknown.totext convert
    set convert 0
    set info [DialogEntry $win .unknown $message MarkEditOk $entryList \
	[list MarkEditHook $win $win.unknown.totext] ]

    if {[string length $info] > 0} {

	Mark_SplitTag $info htag param
	if [regsub ^/ $htag {} htag] {
	    set not /
	} else {
	    set not {}
	}
	lassign {m1 m2} [$win tag ranges $mid]
	Text_Delete $win $m1 $m2
	Mark_Remove $win $mid
	Text_MarkSet $win insert $m1
	if {$convert} {
	    # denature tag and insert as plain text
	    Edit_PasteHtml $win \
		[Edit_ConvertPlainText <[string trim "$htag$not $param"]>]
	} else {
	    HMrender $win $htag $not $param {}
	    Input_Dirty $win
	}
    }
}
proc MarkEditOk {x} {
    return $x	;# pass out as return from DialogEntry
}
proc MarkEditHook { win varname f} {
    upvar #0 $varname convert
    set b $f.b
    set convert 0
    checkbutton $b.text -text "Convert to text" -variable $varname
    pack $b.text -side right -padx 20
}


