#!/bin/sh
#
# xmessage replacement, which groks non-ascii
#
# tkmessage [-buttons Label1:exitcode#[,Label2:exitcode#...]]
# [-default Label1] [-print] [-timeout secs#]
# [-title titlestring]
# message | [-file msgfile ][-message message]
#
# Arguments are parsed in system encoding
#
# New features not in xmessage:
# -buttons L:x -buttons L:x	Multiple -buttons argument allowed
# -message "msg"	Explicit message option.
#			-message "msg" -file - will prepend "msg"
# -title "title string"	Set window title
#
# Other xmessage options not implemented yet:
# -center -nearmouse
#
# $Id: tkmessage,v 1.2 2007/10/22 11:47:32 kabe Exp $
#
# the next line restarts using wish \
exec wish "$0" "$@"

# $argv is already parsed in system encoding!
#encoding system euc-jp

set lbuttons [list]	;# {{Label1 exitcode#} {Label2 exitcode#}}
catch {unset defaultbutton.label}
catch {unset message}
set wm.title "tkmessage"	;#default
set doprint 0	;# false
catch {unset timeout}
set optind 0
while {[string match {-*} [lindex $argv $optind]] && $optind < [llength $argv]} {
	switch -exact -- [lindex $argv $optind] {
	  -buttons {
		incr optind
		# x={{Label1:code#} {Label2:code#}}
		set x [split [lindex $argv $optind] ","]
		foreach lc $x { ;#lc="Label1:code#"
			set colon [string last ":" $lc]
			if {$colon < 0} {
				# no ":code", use default (buttoncount+100)
				lappend lbuttons [list $lc [expr [llength $lbuttons] + 101]]
				continue
			}
			# split by ":" and numerify the code
			set label [string range $lc 0 [expr $colon - 1]]
			set code  [string range $lc [expr $colon + 1] end]
			lappend lbuttons [list $label [expr $code + 0]]
			unset label; unset code
		}
		unset x
	  }
	  -default {
		incr optind
		set defaultbutton.label [lindex $argv $optind]
	  }
	  -file {
		incr optind
		if ![string compare [lindex $argv $optind] "-"] {
			set m stdin
		} elseif [catch {set m [open [lindex $argv $optind] "r"]}] {
			puts stderr "Cannot open -file [lindex $argv $optind]"
			exit 1
		}
		append message [read $m]	;# use system encoding
		close $m
		unset m
	  }
	  -message {
		incr optind
		append message [lindex $argv $optind] "\n"
	  }
	  -title {
		incr optind
		set wm.title [lindex $argv $optind]
	  }
	  -print {
		set doprint 1
	  }
	  -timeout {
		incr optind
		set timeout [lindex $argv $optind]
	  }
	  default {
		puts stderr "Unknown option: [lindex $argv $optind]"
		exit 1
	  }
	}
	incr optind
}

## fill in defaults
if ![llength $lbuttons] {
	#No buttons specified; define default button
	lappend lbuttons [list "Ok" 0]	;# TODO subject i18n

	## xmessage never sets default button without -default option,
	## but not setting it even by the only default "Ok" isn't very nice.
	if ![info exists defaultbutton.label] {
		#use the Ok button for default
		set defaultbutton.label [lindex [lindex $lbuttons 0] 0]
	}
}

if {[info exists message]} {
	# if $message exists, it was filled by -file option
	# would not parse args for message
} else {
	if {$optind >= [llength $argv]} {
		puts stderr "Missing argument for message text"
		exit 1
	} else {
		## parse remaining args for message
		append message [join [lrange $argv $optind end]]
	}
}

## create widgets
set buttoncount 0	;# start from 0; widget .button_0
set buttonwidgets [list]	;# {button_0 button_1}
foreach lc $lbuttons {
	set label [lindex $lc 0]
	set code  [lindex $lc 1]
	button .button_$buttoncount -text $label -command "set quit $code; set quitlabel $label"
	if {[info exists defaultbutton.label] && ![string compare ${defaultbutton.label} $label]} {
		.button_$buttoncount configure -default active
		set defaultbutton.widget ".button_$buttoncount"
	}
	lappend buttonwidgets ".button_$buttoncount"
	incr buttoncount
}

label .message -justify left -bitmap error -compound left -padx 10 -text $message

wm title . ${wm.title}
wm iconname . ${wm.title}
wm protocol . WM_DELETE_WINDOW  {exit [set quit 1]}
## (how to center the toplevel window?)

pack .message -side top

## left-justified packing
#foreach b $buttonwidgets {
#	pack $b -side left -padx 10 -pady 10
#}

## right-justified packing; pack them in reverse order
set lb $buttonwidgets
while {[llength $lb]} {
	set b [lindex $lb end]
	set lb [lrange $lb 0 end-1]
	pack $b -side right -padx 10 -pady 10
}
unset lb

if [info exists defaultbutton.widget] { focus ${defaultbutton.widget} }
# TODO [space] will activate default, but [Enter] still does not.

if [info exists timeout] {
	## XXX original xmessage -timeout is defined 
	## XXX to exit with 0, not default
	after [expr $timeout {*} 1000] {set quit 0}
}

## Main loop
vwait quit
if {$doprint && [info exists quitlabel]} { puts $quitlabel }
exit $quit