#
# input.tcl
#	This provides input-side support for the HTML editor.
#	Most of these procedures are invoked directly from bindings.
#
# 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.
#

################# Edit/Browse Mode support ################

proc Input_Reset { win } {
    upvar #0 Edit$win edit
    if ![info exists edit] {
	set edit Browse		;# Start out read-only
    }
}
proc Input_Edit { win } {
    upvar #0 Edit$win edit
    return [expr [string compare $edit "Edit"] == 0]
}

proc Input_ModeBindings { win {value {}}} {
    upvar #0 Edit$win edit
    if {$value != {}} {
	if {$value == 1 || [string compare $value "Edit"] == 0} {
	    set edit Edit
	} else {
	    set edit Browse
	}
    }
    set editbool [expr [string compare $edit "Edit"] == 0]
    if {$editbool} {
	$win config -state normal
	bindtags $win [list $win TSelect TScroll HText [winfo toplevel $win] all] 
	InputSetTags $win force
    } else {
	# Read-only bindings
	Mark_HideHtml $win
	$win config -state disabled
	bindtags $win [list $win TSelect TScroll HCmd [winfo toplevel $win] all]
    }
    return $editbool
}
proc Input_Mode { win {value {}}} {
    set editbool [Input_ModeBindings $win $value]
    foreach proc [info procs *_EditMode] {
	# Toolbar_EditMode, Form_EditMode, Search_EditMode
	$proc $win $editbool
    }
}

########## Text Insertion and the Dirty State #####################

# This is like Text insert, but uses the current set of active tags
proc Input { win a } {
    upvar #0 HM$win var
    InputRemoveSel? $win
    Text_Insert $win insert $a $var(inserttags)
    catch {unset var(newline)}
    if {[string length [string trim $a]]} {
	catch {unset var(trimspace)}
    }
    $win see insert
    Input_Dirty $win
}
proc Input_Dirty {win} {
    upvar #0 HM$win var
    if {!$var(S_dirty)} {
	set var(S_dirty) 1
	set var(S_dmsg) "(Save Needed)"
	Undo_Record $win [list Input_Clean $win] [list Input_Dirty $win]
    }
}
proc Input_IsDirty {win} {
    upvar #0 HM$win var
    return $var(S_dirty)
}
proc Input_Clean {win} {
    upvar #0 HM$win var
    if {![info exists var(S_dirty)] || $var(S_dirty)} {
	set var(S_dirty) 0
	set var(S_dmsg) ""
	Undo_Record $win [list Input_Dirty $win] [list Input_Clean $win]
    }
}

################# Text Selection ###############################
proc Input_StartSelection {w} {
    Undo_Mark $w ButtonPress-1
    Text_MarkSet $w insert [Input_Adjust $w]
    Mark_AdjustGravity $w insert
    Text_SelClear $w
}
proc Input_FinishSelection {w} {
    # Adjust location to avoid white space and set tags
    LogBegin $w mark set insert [Input_Adjust $w]
    InputSetTags $w force
    catch {
	$w mark set m:selfirst [$w index sel.first]
	Input_Adjust $w m:selfirst
	$w mark set m:sellast [$w index sel.last]
	Input_Adjust $w m:sellast
	Text_SelClear $w
	Text_TagAdd $w sel m:selfirst m:sellast
	$w mark unset m:selfirst
	$w mark unset m:sellast
    }
}

proc Input_SelectNode {win mark} {
    Undo_Mark $win SelectNode
    set info [Edit_SelectNode $win $mark]
    eval {Text_TagAdd $win sel} [lrange $info 0 1]
    Undo_Mark $win SelectNodeEnd
}

proc Input_AlignNode {win mark justify} {
    global NodeMap
    Undo_Mark $win AlignNode
    set ptag [Edit_NodeType $win $mark ltag]
    if [IsList $ptag x y] {
	return
    }
    if {[string length $ptag] == 0} {
	set ptag p
    }
    Mark_SplitTag $ptag htag params
    Edit_ChangeNode $win $mark "$htag align=$justify"
    Undo_Mark $win SelectNodeEnd
}

proc Input_PasteSelection {w x y} {
    if ![catch { SelGet $w} html] {
	Undo_Mark $w PasteSelection
	Text_MarkSet $w insert @$x,$y
	InputRemoveSel? $w
	Text_MarkSet $w insert [Input_Adjust $w]
	Edit_PasteHtml $w $html
	Undo_Mark $w PasteSelectionEnd
    }
}

############ Cursor Motion #####################################
# Skip back over decorative text when setting the insert point.
# The decorative text has either the "space" or the "mark" tag, with
# the latter being used by lists.  Basically you just want to skip
# back over text with these marks.  There are some complications:
# A null node (e.g., <p></p>) means you have to stop on open tags (<p>)
# even if they are in "space" text
# A null list node is not really at the <li> tag.  Instead it is on
# a transition between "mark" text and "space" text.
# Finally, stopping at open list tags is a bad idea because you end up
# in front of the leading <li> tag.

proc Input_MoveInsert {win how} {
    $win mark set insert "$how"
    if [string match "*+*" $how] {
	Text_MarkSet $win insert [Input_AdjustForw $win]
    } else {
	Text_MarkSet $win insert [Input_Adjust $win]
    }
    Mark_AdjustGravity $win
    Input_Update $win cache
    $win see insert
}


proc Input_Adjust { win {mark insert}} {
    set tags [$win tag names $mark]
    set ix [lsearch -regexp $tags ^(mark|space)\$]
    if {$ix < 0} {
	return [$win index $mark]
    }
    set what [lindex $tags $ix]

    # Always skip back to the beginning of the previous space range.
    # 1) We are in the middle of the "previous" range.
    # 2) We are in a mark range, which is always preceeded by a space range.
    # 3) We are at the very begining of a space range, so don't move

    lassign {start end} [$win tag prevrange "space" $mark]
    if {[string length $start] == 0} {
	if {[string compare $what "mark"] == 0} {
	    lassign {start end} [Edit_CurrentRange $win "mark" $mark]
	    Text_MarkSet $win $mark $end
	}
	return [$win index $mark]
    }
    if {[string compare $what "space"] == 0} {
	if [$win compare $end < $mark] {
	    # At the very begining of space - don't move
	    return [$win index $mark]
	}
    }
    # Mark_Prev checks for marks in the space range that represent null nodes
    if [$win compare $mark < $end] {
	set end $mark
    }
    Text_MarkSet $win $mark [Mark_Prev $win $start $end]
    return [$win index $mark]
}
# This version goes back to the end of the previous node
# if it is currently at the beginning of a node.
# Used when re-rendering text.
proc Input_AdjustBack { win {mark insert}} {
    set tags [$win tag names "$mark -1 char"]
    set ix [lsearch -regexp $tags ^(mark|space)\$]
    if {$ix < 0} {
	return [$win index $mark]
    }
    lassign {start end} [$win tag prevrange space $mark]
    Text_MarkSet $win $mark [Mark_Prev $win $start $end]
    return [$win index $mark]
}

# Adjust the mark forward over decorative white space.
# This is done in two phases to handle the mark+space tagging of lists.
# A mark range is always preceeded by a space range, so skip space first,
# then skip mark (if any).  Note that it is OK to be right at the begining
# of a space range, which occurs at the end-of-node.

proc Input_AdjustForw { win {mark insert}} {
    set tags [$win tag names $mark]
    if {[lsearch $tags "space"] >= 0} {
	lassign {start end} [Edit_CurrentRange $win "space" $mark]
	if [$win compare $mark == $start] {
	    return [$win index $mark]
	}
	Text_MarkSet $win $mark [Mark_Next $win $mark $end]
	set tags [$win tag names $mark]
    }
    if {[lsearch $tags "mark"] < 0} {
	return [$win index $mark]
    }
    set range [Edit_CurrentRange $win "mark" $mark]
    # Ignore any HTML marks in the "mark" range (e.g., <li>
    Text_MarkSet $win $mark [lindex $range 1]
    return [$win index $mark]
}

proc Input_Update {win {how force}} {
    upvar #0 HM$win var
    Input_Dirty $win
    InputSetTags $win $how
}
# This is similar to InputRemoveHtml, but it may replace the
# deleted selection with a null node.  This is used when overtyping
# the selection.
proc InputRemoveSel? {win} {
    if [catch {$win index sel.first}] {
	return 0
    }
    if {[$win compare sel.first <= insert]
	&& [$win compare sel.last >= insert]} {
	Undo_Mark $win InputRemoveSel
	# Find the bounds of the current node, and put the tag in ptag
	set ptag [Edit_NodeType $win insert ltag]
	if [info exists ltag] {
	    set ltag [ListSelect $win]
	    lassign {m1 m2} [ListSelectItem $win insert $ltag (li|dt|dd)]
	    set ptag [Mark_Htag $win $m1]
	    if {[$win compare $m2 == "$m2 linestart"]} {
		set endmatch [$win compare $m2 == "sel.last +1 char"]
	    } else {
		# special case and end of buffer
		set endmatch [$win compare $m2 == "sel.last"]
	    }
	    if {[$win compare $m1 == sel.first] && $endmatch} {
		# Completely deleting a <dt> or <dd> item, so we
		# need to put one of those tags back in.
		regsub ^H: $ptag {} tag
	    }
	} else {
	    lassign {m1 m2 ptag} [Edit_SelectNode $win insert $ptag]
	    if {[$win compare $m1 == sel.first] &&
		    [$win compare $m2 == "sel.last"]} {
		# Completly deleting a paragraph or heading,
		# so put one of those back in.
		regsub ^H: $ptag {} tag
	    }
	}
	set ptag [Edit_RemoveHtml $win sel.first sel.last]
	InputSetTags $win force
	if {[info exists tag] && [string length $tag]} {
	    # Insert a null node
	    Input_Html $win <$tag> 1
	}
	Input_Dirty $win
	$win see insert  
	Undo_Mark $win InputRemoveSelEnd
	return 1
    }
    return 0
}

proc Input_Html {win html {maxblanklines 0}} {
    upvar #0 HM$win var
    Log $win Input_Html $html
    dputs $html
    HMparse_html $html [list HMrender $win] {}
    Mark_CloseTags $win
#    # Collapse out extra newlines after the inserted HTML
    while {[string compare [$win get insert] \n] == 0 &&
	    [string compare [$win get "insert -1c"] \n] == 0 &&
	    $maxblanklines == 0} {
	$win delete insert
    }
}

# Return needs to decide wheather or not to "break" the current tag.
# The InputReturnMap array indicates what to do depending on what
# HTML tags are currently in effect.

array set InputReturnMap {
    h1	InputBreakTag
    h2	InputBreakTag
    h3	InputBreakTag
    h4	InputBreakTag
    h5	InputBreakTag
    h6	InputBreakTag
    blockquote	InputBreakTag
    p	InputBreakTag
    pre	InputNewline
    ol	List_Item
    ul	List_Item
    menu List_Item
    dir	List_Item
    dl	List_DlItem
}
proc Input_Return { win } {
    upvar #0 HM$win var 
    global InputReturnMap
    foreach htag [Mark_Stack $win] {
	if ![IsList $htag ltag level] {
	    set ltag $htag
	}
	if [info exists InputReturnMap($ltag)] {
	    dputs $InputReturnMap($ltag) $win $htag
	    Undo_Mark $win InputReturn
	    if [catch {eval $InputReturnMap($ltag) $win $htag} err] {
		Status $win $err
	    }
	    Undo_Mark $win InputReturnEnd
	    return
	}
    }
    # Input_P does its own undo marking
    Input_P $win
}

proc Input_P {win} {
    upvar HM$win var
    Undo_Mark $win Input_P
    Mark_AdjustGravity $win
    Input_Html $win <p> 1
    Edit_ChangeNode $win insert p
    Input_Dirty $win
    Undo_Mark $win Input_PEnd
}

proc InputNewline { win htag } {
    Input $win \n
}

# Start a new paragraph of the same type.
# Any open style-like tags are closed.

proc InputBreakTag { win ignore } {
    global StyleMap NodeMap
    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
	}
	if [info exists NodeMap($key)] {
	    set open <$htag>
	}
    }
    Input_Html $win $close$open 1
    Input_Dirty $win
    $win see insert
}

# Use "force" for the how parameter to avoid the state caching done by
# Mark_ReadTags

proc InputSetTags { win {how all} } {
    if [Input_Edit $win] {
	if {$how != "noreadtags"} {
	    Mark_ReadTags $win insert $how
	}
	Toolbar_Update $win
    }
}

# Input_Tag is called from the application to insert an HTML tag.
# These are typically called from the toolbar or the menus.
# InputMap defines special case handling for certain tags

array set InputMap {
    dl		List_Setup_dl
    dir		List_Setup
    menu	List_Setup
    ol		List_Setup
    ul		List_Setup
    li		List_Item

    form	Form_Setup
    input	Form_Item
    option	Form_Item
    select	Form_Item
    textarea	Form_Item

    blockquote  Input_Paragraph
    bq		Input_BlockQuote
    h1          Input_Paragraph
    h2          Input_Paragraph
    h3          Input_Paragraph
    h4          Input_Paragraph
    h5          Input_Paragraph
    h6          Input_Paragraph
    p           Input_Paragraph
    pre         Input_Paragraph
    div         Input_Paragraph

    hr		Input_Rule
    br		Input_Break

    img		Image_Create
}

# Input_Tag
proc Input_Tag { win htag } {
    upvar #0 HM$win var
    global InputMap HMtag_map

    regexp {^[^ 	]+} $htag key
    Feedback $win $key
    if [info exists InputMap($key)] {
	Undo_Mark $win "Input_Tag (Map) $htag"
	eval $InputMap($key) {$win $htag}
    } else {
	if [catch {$win index sel.first}] {
	    global StyleMap HMtag_map
	    Stderr "key $key tags $var(inserttags)"
	    if [info exists StyleMap($key)] {
		set ix [lsearch -glob $var(inserttags) H:$key*]
		if {$ix >= 0 } {
		    regsub ^H: [lindex $var(inserttags) $ix] {} htag
		    regexp {^[^ 	]+} $htag key
		    HMstack/ $win $HMtag_map($key)
		    unset var(T,$htag)
		    Toolbar_HighlightOff $win $key
		} else {
		    HMstack $win $HMtag_map($key)
		    set var(T,$htag) [list H:$htag]
		    Toolbar_Highlight $win $key
		}
		HMcurrent_tags $win
		return
	    } else {
		DialogInfo $win "Make a selection first"
		Feedback $win ready
		return
	    }
	}
	Undo_Mark $win "Input_Tag $htag"
	set ix [lsearch -glob $var(inserttags) H:$key*]
	if {$ix < 0} {
	    Text_TagAdd $win H:$htag sel.first sel.last
	    set how nostyle
	} else {
	    Text_TagRemove $win H:$htag sel.first sel.last
	    Toolbar_HighlightOff $win $key
	    set how force
	}
	Edit_RefreshStyle $win $how
    }
    Input_Dirty $win
    Feedback $win ready
    Undo_Mark $win "Input_Tag $htag End"
}
# remove style tags from the selected range of text
proc Input_PlainText {win} {
    upvar #0 HM$win var
    global StyleMap
    if [catch {$win index sel.first}] {
	DialogInfo $win "Make a selection first"
	return
    }
    Undo_Mark $win Input_PlainText

    set tags [$win tag names sel.first]
    foreach {key value ix} [$win dump -tag sel.first sel.last] {
	if {[lsearch $tags $value] < 0} {
	    lappend tags $value
	}
    }
    foreach tag $tags {
	if {[regexp {^H:([^ 	]+)} $tag x htag] &&
		[info exists StyleMap($htag)]} {
	    Text_TagRemove $win $tag sel.first sel.last
	}
    }
    set end [$win index sel.last]
    set beg [$win index sel.first]
    Mark_ReadTags $win "insert"
    # Clear out the looks that terminate right at this point, which are
    # otherwise picked up by ReadTags (and for good reasons)
    foreach {key value ix} [$win dump -tag sel.first] {
	if {$key == "tagoff" && [regexp {^H:([^ 	]+)} $value x htag] &&
		[info exists StyleMap($htag)]} {
	    set ix [lsearch $var(inserttags) $value]
	    set var(inserttags) [lreplace $var(inserttags) $ix $ix]
	}
    }
    Edit_RefreshRange $win $beg $end noreadtags
    Text_TagAdd $win sel $beg $end
    Input_Dirty $win
    Undo_Mark $win Input_PlainTextEnd
}


proc Input_SaveInsert {win} {
    upvar #0 HM$win var
    Log $win Input_SaveInsert
    Mark_Add $win x-insert {} left insert
    set var(S_insertSaved) 1	;# S_* survives init_state
    dputs insert at [$win index insert]
}
proc HMtag_x-insert {win param textVar} {
    upvar #0 HM$win var
    # Take note of the current index
    set var(S_insertMark) [$win index insert]
    Log $win x-insert $var(S_insertMark)
}
proc Input_RestoreInsert {win} {
    upvar #0 HM$win var
    if [info exists var(S_insertMark)] {
	$win mark set insert $var(S_insertMark)
	dputs set insert $var(S_insertMark)
	unset var(S_insertMark)
    }
    # In refresh, if <x-insert> is at the very end of line, it can
    # get pushed along a bit too far.  In fact, <x-insert> may not be used
    # in this case, and this adjust fixes things up for us.
    Input_Adjust $win
    catch {unset var(S_insertSaved)}
}

# This invokes a procedure based on the name of the current
# paragraph type.
proc InputNodeApply { win procname {mark insert}} {
    upvar #0 HMtag$win tag
    Undo_Mark $win $procname
    Feedback $win $procname
    set x {}
    foreach htag [Mark_Stack $win] {
	if [IsList $htag ltag level] {
	    set proc Input${procname}_$ltag
	} else {
	    set proc Input${procname}_$htag
	}
	if {[info command $proc] == "$proc"} {
	    set x [$proc $win $mark]
	    break
	}
    }
    Feedback $win ready
    Undo_Mark $win ${procname}End
    return $x
}

# <Tab> operations
proc Input_Tab { win } {
    InputNodeApply $win Tab
}
# <Shift-Tab> operations
proc Input_ShiftTab { win } {
    InputNodeApply $win ShiftTab
}


# Header demotion/promotion
proc InputTab_h1 { win mark } { Input_Paragraph $win h2 }
proc InputTab_h2 { win mark } { Input_Paragraph $win h3 }
proc InputTab_h3 { win mark } { Input_Paragraph $win h4 }
proc InputTab_h4 { win mark } { Input_Paragraph $win h5 }
proc InputTab_h5 { win mark } { Input_Paragraph $win h6 }

proc InputShiftTab_h2 { win mark } { Input_Paragraph $win h1 }
proc InputShiftTab_h3 { win mark } { Input_Paragraph $win h2 }
proc InputShiftTab_h4 { win mark } { Input_Paragraph $win h3 }
proc InputShiftTab_h5 { win mark } { Input_Paragraph $win h4 }
proc InputShiftTab_h6 { win mark } { Input_Paragraph $win h5 }

# Setting paragraph type

proc Input_Paragraph {win htag} {
    Edit_ChangeNode $win insert $htag
    Input_Dirty $win
}
proc Input_NoParagraph {win {mark insert}} {
    Undo_Mark $win Input_NoParagraph
    Edit_ClearNode $win $mark
    Undo_Mark $win Input_NoParagraphEnd
}
proc Input_BlockQuote {win htag} {
    Input_Paragraph $win blockquote
}

proc Input_Rule {win htag} {
    Input_Html $win <$htag>
    $win see insert
    Input_Dirty $win
}
proc Input_Break {win {htag br}} {
    Input_Html $win <$htag> 1
    Text_TagAdd $win below$htag insert "insert lineend"
    $win see insert
    Input_Dirty $win
}

proc Input_ClosePre {win} {
    set ptag [Edit_NodeType $win insert nest]
    if {$ptag != "pre"} {
	return
    }
    set mark [Edit_EndNode $win insert pre 0]
    Text_MarkSet $win insert $mark
    Input_Html $win <p> 1
    Input_Update $win
}

proc InputTab_pre {win mark} {
    Input $win \t
}

proc Input_ClearTag {win {mark insert}} {
    upvar #0 cleartag$win cleartag
    set tags [Mark_FullStack $win $mark all]
    set width 0
    foreach t $tags {
	setmax width [string length $t]
    }
    setmin width 70
    set frame [Dialog_Shell $win .cleartag "Clear HTML Tag" \
"The HTML tags that are active at the
insert position are listed below.  Select
a tag and click OK to remove the tag.  This is
like removing the <foo> and </foo> markup elements." \
	[list \
	    [list OK [list set cleartag$win 1]] \
	    [list Cancel [list set cleartag$win 0]]]]
    set l [listbox $frame.list -height [llength $tags] -width $width]
    pack $l -fill both -expand true -padx 10

    eval {$l insert end} $tags

    set cleartag 0
    tkwait variable cleartag$win
    if {$cleartag} {
	if ![catch {$l get [$l curselection]} tag] {
	    Edit_ClearTag $win H:$tag $mark
	    Status $win "Cleared $tag"
	}
    }
    destroy [winfo toplevel $frame]
}
