# bindings trying to mimic some of acme(1)'s mouse chords
#
# © 2010 Michael Teichgräber
#
#
# basically supported are
# 	1-2	(cut)
#	1-3	(paste)
#	2	(execute; a widget specific action can be
#		 installed via acmechords::Setaction)


namespace eval acmechords {

	variable b1pressed 0
	variable actions

	array set actions { }

	proc Bind {tag} {
		bind $tag <Button-1> "incr acmechords::b1pressed; [bind $tag <Button-1>]"
		bind $tag <ButtonRelease-1> "set acmechords::b1pressed 0; [bind $tag <ButtonRelease-1>]"

		bind $tag <ButtonRelease-2> { }
		bind $tag <Button-2> {acmechords::button2 %W}
		bind $tag <Button-3> [list acmechords::button3 %W $tag]

		bind $tag <Double-Button-1> [namespace code {incr b1pressed; markline %W %x %y}]
		bind $tag <Escape> {
			if {[%W tag ranges sel ] != {}} {
				event generate %W <<Cut>>
			}
		}
	}

	proc xword {p} {
		variable actions

		$actions($p) [$p get "current wordstart" "current wordend"]
	}
	proc button2 {p} {
		variable b1pressed
		variable actions

		if {$b1pressed} {
			event generate $p <<Cut>>
		} elseif {[info exists actions($p)]} {
			if {[$p tag ranges sel] ==  {} } {
				xword $p
			} elseif {[$p compare sel.first <= current] && [$p compare current <= sel.last]} {
				$actions($p) [$p get sel.first sel.last]
			} else {
				xword $p
			}
		}
	}
	proc button3 {p tag} {
		variable b1pressed

		if { $b1pressed } {
			# Insert the contents of the clipboard,
			# and select it
			if {$tag == "Text"} {
				$p mark set acmesel0 insert
				$p mark gravity acmesel0 left
				$p mark set acmesel1 insert
				$p mark gravity acmesel1 right
			}
			event generate $p <<Paste>>
			if {$tag == "Text"} {
				$p tag add sel acmesel0 acmesel1
			}
		}
	}

	proc markline { t x y} {
		set pt @$x,$y
		if { [$t compare $pt == "$pt lineend"] || [$t compare $pt == "$pt linestart"]} {
			$t tag add sel "$pt linestart" "$pt lineend"
		} else {
			$t tag add sel "$pt wordstart" "$pt wordend"
		}
	}

	proc Setaction {p f} {
		variable actions

		set actions($p) $f
	}
}