# lists.tcl
#	Support for editting HTML lists

# The tk-text tags for list look like ol=1, ul=2, where the
# number indicates the nesting level.  The following regular
# expression picks apart these tags

proc IsList {htag ltagVar levelVar} {
    upvar $ltagVar ltag $levelVar level
    regexp ^(H:|T,)?(ul|ol|dl|menu|dir)=(\[0-9\]+) $htag x h ltag level
}

# List_Setup - convert a node to a list
# A new list should have <ol> <li> </ol>
#	1) select the node
#	2) change to list type
#	3) insert <li> properly
#	4) refresh the list

proc List_Setup {win htag} {
    global ListMap
    Mark_HideHtml $win
    lassign {m1 m2 oldtype} [Edit_SelectNode $win insert]
    if [$win compare $m1 == $m2] {
	# Nothing here
	Input_Html $win <$htag><li><x-insert></$htag>
	Input_RestoreInsert $win
	Input_Update $win
	return
    }
    if [$win compare $m2 == "$m2 lineend"] {
	# This helps lists merge together
	set m2 [$win index "$m2 +1c"]
    }
    set level 1
    if {"$oldtype" != ""} {
	Text_TagRemove $win $oldtype $m1 $m2
	if [IsList $oldtype ltag level] {
	    set oldtype $ltag
	}
    }
    dputs "List_Setup $win H:$htag=$level $m1 $m2"
    Text_TagAdd $win H:$htag=$level $m1 $m2
    Input_SaveInsert $win
    if ![info exists ListMap($oldtype)] {
	$win mark set insert $m1
	Mark_ReadTags $win insert
	# This is needed to properly merge into adjacent lists
	upvar #0 HM$win var
	foreach x [array names var T,*=*] {
	    Text_TagAdd $win $var($x) $m1 $m2
	}
	HMparse_html <li> [list HMrender $win] {}
    }
    List_Refresh $win
}

# This is used to count up list elements in ordered lists.
# This is needed to reset state correctly for new input.
# (THIS IS STILL BROKEN) because it counts <li> tags in
# nested lists.

proc List_CountItems {win mark htag} {
    upvar #0 HM$win var
    set start [lindex [Edit_CurrentRange $win $htag $mark] 0]
    set n 0
    while {[$win compare $start <= $mark]} {
	set mark [$win mark prev $mark]
	if {[string length $mark] == 0} {
	    break
	}
	if {[string compare [Mark_Htag $win $mark] "li"] == 0} {
	    incr n
	}
    }
    set var(count$var(level)) $n
}

# List selection and redisplay

# ListSelect plants some marks that are used by ListRefresh
proc ListSelect {win {mark insert}} {
    lassign {m1 m2 ltag} [Edit_SelectNode $win $mark]
    $win mark set start:$ltag $m1
    $win mark gravity start:$ltag left
    $win mark set end:$ltag $m2
    $win mark gravity end:$ltag right
    return $ltag
}
# Select a list item.  This requires that
# ListSelect be called first to find the overall bounds of the list

proc ListSelectItem { win mark htag {what li}} {
    set start [ListBeginMark $win $mark $htag $what]
    set end [ListEndIndex $win $mark $htag $what]
    return [list $start $end]
}
proc ListSelectDlItem { win mark htag} {
    set start [ListBeginMark $win $mark $htag (dt|dd)]
    set end [ListEndIndex $win $mark $htag (dt|dd)]
    return [list $start $end]
}
# Find the <li> mark at the beginning-of-item

proc ListBeginMark {win mark htag {item "li"}} {
    upvar #0 HM$win var
    set start start:$htag
    set m1 $mark
    while {[$win compare $start <= $mark]} {
	set mark [$win mark prev $mark]
	if {[string length $mark] == 0} {
	    return [$win index "$m1 linestart"]
	}
	if [regexp ^$item$ [Mark_Htag $win $mark]] {
	    return $mark
	}
    }
    return [$win index "$m1 linestart"]
}

proc ListEndIndex {win mark htag {item "li"}} {
    upvar #0 HM$win var
    set end end:$htag
    while {[$win compare $end > $mark]} {
	set mark [$win mark next $mark]
	if {[string length $mark] == 0} {
	    break
	}
	if [regexp ^$item$ [Mark_Htag $win $mark]] {
	    return $mark
	}
    }
    return [$win index "$end"]
}

proc ListRefresh {win ltag} {
    set m1 start:$ltag
    set m2 end:$ltag
    ListRefreshRange $win start:$ltag end:$ltag $ltag
    $win mark unset start:$ltag end:$ltag
}

# This will fix numbering and the bullets at different levels.
proc List_Refresh {win {mark insert}} {
    ListRefresh $win [ListSelect $win $mark]
}

proc ListRefreshRange {win m1 m2 ltag} {
    upvar #0 HM$win var
    Mark_ReadTags $win $m1
    if ![IsList $ltag x level] { 
        Status $win "ListRefreshRange no list? $ltag"
	return
    }
    dputs $m1 $m2 $ltag $level

    # read tags probably saw the list we are about to refresh, and we want
    # to forget that state because we are about to redisplay it.
    foreach x [array names var T*=*] {
	dputs $x
	if {[IsList $x y lev2] && ($lev2 >= $level)} {
	    HMlist_close $win				;# cleanup var(listtags)
	    unset var($x)
	    set var(indent) [lrange $var(indent) 1 end]	;# Affects var(level)
	    set var(inserttags) [HMcurrent_tags $win]
	}
    }
    dputs level $var(level)
    dputs m1 $m1 m2 $m2
    Edit_RefreshRange $win $m1 $m2 noreadtags
}

# List indent

foreach ltag {ol ul menu dir} {
    proc InputTab_$ltag {win mark} {ListTab $win $mark}
    proc InputShiftTab_$ltag {win mark} {ListShiftTab $win $mark}
}

# ListTab - indent the current list element.
# The first part of the procedure fixes up the indent tags.
#	Lists use the indentN tag in a weird way so that regular paragraphs
#	that are interleaved with list elements are indented properly.
#	The hanging list decoration takes two characters and has a different
#	indent tag than the rest of the list element.
# The last part of the procedure is a streamlined version of HMrender to
# ensure that we have the correct input state set up.

proc ListTab { win mark } {
    set ltag [ListSelect $win $mark]
    if ![IsList $ltag htag level] {
	Status $win "ListTab: no list?"
	return
    }
    lassign {start end} [ListSelectItem $win $mark $ltag]
    Text_TagRemove $win indent[expr $level-1] $start "$start +2c"
    Text_TagRemove $win indent$level "$start +2c" $end
    incr level 1
    Text_TagAdd $win H:$htag=$level $start $end
    Text_TagAdd $win indent[expr $level-1] $start "$start +2c"
    Text_TagAdd $win indent$level "$start +2c" $end

    global HMtag_map
    HMstack $win $HMtag_map($htag)
    HMmark $win $htag {} {} {}
    HMtag_$htag $win {} {}
    HMcurrent_tags $win
#    ListRefresh $win $ltag	;# Too slow for now
}

# List outdent
# 
proc ListShiftTab { win mark } {
    set ltag [ListSelect $win $mark]
    if {[string length $ltag] == 0} {
	Status $win "Not in a list"
	return
    }
    set bullet 1	;# List bullet present or not
    if ![IsList $ltag htag level] {
	# <p> tag within a list
	set bullet 0
	set ptag $ltag ; unset ltag
	lassign {start end} [Edit_CurrentRange $win $ptag $mark]
	if {[string length $start] == 0} {
	    set start [$win index "$mark linestart"]
	    set end [$win index "$mark lineend +1c"]
	}
	set middle $start
	if [$win compare $end == "$end lineend"] {
	    set end [$win index "$end +1c"]
	}
	foreach tag [Mark_Stack $win $mark] { 
	    if {[string compare H:$tag $ptag] != 0
		    && [IsList $tag htag level]} {
		set ltag H:$tag
		break;	# Find enclosing list
	    }
	}
	if ![info exists ltag] {
	    Status $win "Not in a list"
	    return
	}
    } elseif {$htag != "dl"} {
	lassign {start end} [ListSelectItem $win $mark $ltag]
	if {[string length $start] == 0} {
	    set start [$win index "$mark linestart"]
	    set end [$win index "$mark lineend +1c"]
	    Text_MarkSet $win m:ListShiftTab "$start"
	    set bullet 0
	} else {
	    # Do this after the list marker.
	    Text_MarkSet $win m:ListShiftTab "$start +3c"
	}
	set middle m:ListShiftTab
    } else {
	lassign {start end} [ListSelectDlItem $win $mark $ltag]
	if {[string length $start] == 0} {
	    set start [$win index "$mark linestart"]
	    set end [$win index "$mark lineend +1c"]
	}
	if {[Mark_Htag $win $start] == "dt"} {
	    set middle $end
	} else {
	    set middle $start
	}
    }
    # Remove the indent tags and pop the state stacks associated with the list

    Text_TagRemove $win $ltag $start $end
    Text_TagRemove $win indent[expr $level-1] $start $middle
    Text_TagRemove $win indent$level $middle $end
    incr level -1
    global HMtag_map
    HMstack/ $win $HMtag_map($htag)
    HMmark $win $htag / {} {}
    HMtag_/$htag $win {} {}

    if {$level <= 0} {
	Text_TagAdd $win indent0 $start $end
	if [$win compare $end == "$end linestart"] {
	    set end [$win index "$end -1c"]
	}
	Text_TagAdd $win H:p $start $end
	if [$win compare $start != $middle] {
	    Text_Delete $win $start $middle
	}
	catch {Mark_Remove $win $start}	;# The <li> tag, if any
	catch {HMstack $win $HMtag_map(p)}
	HMmark $win p {} {} {}
    } else {
	Text_TagAdd $win indent[expr $level-1] $start $middle
	Text_TagAdd $win indent$level $middle $end
	# Text is already labeled with tag for enclosing list
    }
    HMcurrent_tags $win
    Input_Update $win noreadtags
#    ListRefresh $win [ListSelect $win $mark]
}

# These two change between <p> and <li> tags within lists.
proc List_AddBullet { win {mark insert} } {
    set ptag [Edit_NodeType $win $mark ltag]
    if ![info exists ltag] {
	Status $win "Not in a list"
	return
    }
    if [IsList $ptag htag level] {
	set htag [ListSelect $win $mark]
	lassign {start end} [ListSelectItem $win $mark $htag]
	if {[string length [Mark_Htag $win $start]] != 0} {
	    # Already a <li> tag
	    return
	}
    }
    Undo_Mark $win List_AddBullet
    if ![info exists start] {
	lassign {start end ptag} [Edit_SelectNode $win $mark $ptag]
	Text_TagRemove $win $ptag $start $end
    }
    $win mark set insert $start
    Mark_ReadTags $win insert
    upvar #0 HM$win var
    Input_Html $win <li>
    Input_Dirty $win
#    ListRefresh $win $ltag	;# Too slow for now
    Undo_Mark $win List_AddBulletEnd
}

proc List_RemoveBullet { win {mark insert} } {
    set htag [ListSelect $win $mark]
    if ![IsList $htag ltag level] {
	return
    }
    if {$ltag == "dl"} {
	return
    }
    lassign {start end} [ListSelectItem $win $mark $htag]
    if {[string length [Mark_Htag $win $start]] == 0} {
	# Neither <p> nor <li> tag
	return
    }
    Undo_Mark $win List_RemoveBullet
    Text_Delete $win $start "$start +3c"	;# After list marker
    Text_TagAdd $win H:p $start "$start lineend"
    Mark_Remove $win $start
    Input_Dirty $win
#    ListRefresh $win $ltag	;# Too slow for now
    Undo_Mark $win List_RemoveBulletEnd
}


# Handlers for hitting Return

# Add new list items.  Any non-list tags are closed,
# similar to InputBreakTag

proc List_Item { win ignore {item "li"}} {
    global StyleMap
    Undo_Mark $win List_Item
    set open {}
    set close {}
    foreach htag [Mark_FullStack $win insert force] {
	Mark_SplitTag $htag key x
	if [info exists StyleMap($key)] {
	    set close </$key>$close
	}
    }
    Input_Html $win $close<$item> 1
    Undo_Mark $win List_ItemEnd
}

# Definition List support

proc List_Setup_dl {win htag} {
    LogBegin $win List_Setup_dl
    lassign {m1 m2 oldtype} [Edit_SelectNode $win insert]
    if [$win compare $m1 == $m2] {
	# Nothing here
	Input_Html $win <dl><dt>Term<x-insert><dd>Definition</dl>
	Input_RestoreInsert $win
	Input_Update $win
	return
    }
    if [IsList $oldtype ltag level] {
	if {$ltag != "dl"} {
	    Status $win "Convert $ltag to paragraphs first (List->List End)"
	}
	return
    }
    if {"$oldtype" != ""} {
	Text_TagRemove $win $oldtype $m1 $m2
    }
    # This is a lot like Edit_RefreshRange
    upvar #0 HM$win var
    Input_SaveInsert $win
    $win mark set insert $m1
    set html [Output_string $win insert $m2]
    Mark_RemoveAll $win insert $m2
    Text_Delete $win insert $m2
    if [$win compare insert == 1.0] {
	Mark_ResetTags $win
    } else {
	Mark_ReadTags $win "insert"
    }
    if [$win compare insert == "insert linestart"] {
	set var(newline) 1
	set var(trimspace) 1
    } else {
	catch {unset var(newline)}
	catch {unset var(trimspace)}
    }
    Input_Html $win <dl><dt>$html</dl>
    Input_RestoreInsert $win
    Input_Update $win    
}
proc List_DlItem {win htag} {
    set htag [ListSelect $win]	;# This defines boundary marks
    if ![IsList $htag x level] {
	Status $win "List_DlItem: no list?"
	return
    }
    lassign {start end} [ListSelectDlItem $win insert $htag]
    if {[string length $start] == 0} {
	set start [$win index "insert linestart"]
    }
    if {[string length $end] == 0} {
	set end [$win index "insert lineend"]
    }
    if {[string compare [Mark_Htag $win $start] "dt"] == 0} {
	set oldlevel [expr $level-1]
	set item "dd"
    } elseif {[string compare [Mark_Htag $win $start] "dd"] == 0} {
	set oldlevel $level
	incr level -1
	set item "dt"
    } else {
	error "Unknown DL item tag [Mark_Htag $win $start]"
    }
    List_Item $win $htag $item
    # Fix up the indent level
    lassign {start end} [ListSelectDlItem $win insert $htag]
    Text_TagRemove $win indent$oldlevel $start $end
    Text_TagAdd $win indent$level $start $end
}
proc List_FixDlIndent {win mark} {
    upvar #0 HM$win var
    set htag [ListSelect $win]	;# This defines boundary marks
    IsList $htag x level
    set var(level) [expr [llength $var(indent)]-1]
    lassign {start end} [ListSelectDlItem $win insert $htag]
    catch {HMtag_[Mark_Htag $win $start] $win {} {}}
}

proc ListAddItem { win ltag text } {
    catch {Text_TagRemove $win sel 1.0 end}
    LogBegin $win ListAddItem $ltag $text
    set save [$win index insert]
    Log $win HMrender $ltag $text
    HMrender $win $ltag {} {} $text
    set save2 [$win index insert]
    $win mark set insert $save
    InputAdjustForw $win
    Text_TagAdd $win sel insert $save2
    $win mark set insert $save2
    LogEnd $win [Mark_Current $win]
    return [Mark_Current $win]
}

# The next two alternate between <dd> and <dt> tags

# Insert <dd> (definition) after <dt> (term)
proc ListDefTerm { win htag } {
    LogBegin $win ListDefTerm
    ListAddItem $win "dd" "New Definition"
    LogEnd $win
}

# Pop the <dd> tag and insert a <dt>
proc ListDefText { win htag } {
    LogBegin $win ListDefText
    ListAddItem $win "dt" "New Term"
    LogEnd $win
}

proc List_End {win} {
    ListShiftTab $win insert
}

