#! /usr/bin/wish8.0jp -f
# $Id: tkmemo,v 1.18 1994/12/22 10:21:13 ishisone Exp $
#
#  tkmemo -- xmemo Tk $BHG(B ($BF|K\8lHG(B wish $B$,I,MW$G$9(B)
#	ishisone@sra.co.jp
#
# Copyright (c) 1993  Software Research Associates, Inc.
#
# Permission to use, copy, modify, and distribute this software and its
# documentation for any purpose and without fee is hereby granted, provided
# that the above copyright notice appear in all copies and that both that
# copyright notice and this permission notice appear in supporting
# documentation, and that the name of Software Research Associates not be
# used in advertising or publicity pertaining to distribution of the
# software without specific, written prior permission.  Software Research
# Associates makes no representations about the suitability of this software
# for any purpose.  It is provided "as is" without express or implied
# warranty.
#
# Author:  Makoto Ishisone, Software Research Associates, Inc., Japan
#

# $BFbIt%3!<%I$r(B EUC $B$K$9$k!#(B($BJL$K(B SJIS $B$G$b$$$$$s$@$1$I(B)
kanji internalCode EUC

# $B%0%m!<%P%k%Q%i%a!<%?(B
#	$CPOSITION	-- $B%3%s%H%m!<%i$N%8%*%a%H%j(B
#	$DIR		-- $B%9%H%j%C%W$NG[NsJ}8~(B (LR/RL/TB/BT)
#	$ALIGN		-- $B%9%H%j%C%W$N$I$NJU$r9g$o$;$k$+(B (L/R/T/B)
#	$GAP		-- $B3F%9%H%j%C%W4V$N5wN%(B
#	$WM_BORDER	-- $B%&%#%s%I%&%^%M!<%8%c$,IU$1$k%&%#%s%I%&%\!<%@!<$N(B
#			   $BI}(B
#
# $B$3$l$i$N%Q%i%a!<%?$O(B $HOME/.tkmemo $B$G@_Dj$5$l$k!#(B
#
set CPOSITION {}
set DIR TB
set ALIGN L
set GAP 8
set WM_BORDER 2


# $B%0%m!<%P%kJQ?t(B
set strips {}
set msgs {}
set visible 1
set initial_invocation 0


#
# $B%S%C%H%^%C%W3HD%(B (defbitmap $B%3%^%s%I(B) $B$,$"$l$P$=$l$r;H$&!#(B
# $B$J$1$l$P(B BLT $B3HD%$N(B blt_bitmap $B%3%^%s%I$r;H$&!#$=$l$b$J$1$l$P(B
# $B%3%s%H%m!<%i$K%S%C%H%^%C%W$rI=<($7$J$$$@$1!#(B
# defbitmap $B%3%^%s%I$N%=!<%9$O(B
#	<a href="ftp://ftp.sra.co.jp/pub/lang/tcl/contrib/defbitmap.shar.gz">ftp://ftp.sra.co.jp/pub/lang/tcl/contrib/defbitmap.shar.gz</a>
# $B$+$iF~<j2DG=!#(B
#
set usebitmap 0
if {"[info commands defbitmap]" != ""} {
    # $B%3%s%H%m!<%i$KI=<($9$k%S%C%H%^%C%W(B (by toshiko@sra.co.jp)
    defbitmap xmemo 24 24 {
	0000001c00003e0000fa0000 360f003cf00050000f880070
	080040080440080a40043e20 04c021040022040020020010
	02301002f8101e0011e00108 001e0800e00900000e000000
    }
    set usebitmap 1
} elseif {"[info commands blt_bitmap]" != ""} {
    blt_bitmap define xmemo {
	{ 24 24 }
	{00 00 00 1c 00 00 3e 00 00 fa 00 00
	 36 0f 00 3c f0 00 50 00 0f 88 00 70
	 08 00 40 08 04 40 08 0a 40 04 3e 20
	 04 c0 21 04 00 22 04 00 20 02 00 10
	 02 30 10 02 f8 10 1e 00 11 e0 01 08
	 00 1e 08 00 e0 09 00 00 0e 00 00 00}
    }
    set usebitmap 1
}


#
# emacs $B$N$h$&$J%P%$%s%G%#%s%0(B ($B4JC1$J$N$@$1(B)
# $B;HMQ$G$-$k$N$O%+!<%=%k0\F0$H>C5n(B
#
proc move_point {w where} {
    $w mark set insert "insert $where"
    $w yview -pickplace insert
}
bind Text <Control-f> {move_point %W +1chars}
bind Text <Control-b> {move_point %W -1chars}
bind Text <Control-n> {move_point %W +1lines}
bind Text <Control-p> {move_point %W -1lines}
bind Text <Control-a> {move_point %W linestart}
bind Text <Control-e> {move_point %W lineend}
bind Text <Control-w> {%W delete sel.first sel.last}
bind Text <Control-k> {
    if {[%W compare "insert linestart" == "insert lineend"]} {
	%W delete insert "insert +1chars"
    } else {
	%W delete insert "insert lineend"
    }
    %W yview -pickplace insert
}


#
# $B%]%C%W%"%C%W%a%K%e!<%O%s%I%j%s%0(B
#

# $B:n$C$?%a%K%e!<$r%]%C%W%"%C%WMQ$K@_Dj$9$k(B
proc popup_conf {w} {
    bind $w <Any-ButtonRelease> "popup_unpost $w"
    bind $w <Any-Motion> {if {"$tk_priv(window)" == "%W"} {%W activate @%y}}
    global tk_strictMotif
    if {$tk_strictMotif} {
	$w configure -activebackground [lindex [$w config -background] 4]
	$w configure -activeforeground [lindex [$w config -foreground] 4]
    }
}

# $B%a%K%e!<$r%]%C%W%"%C%W$9$k(B
proc popup_post {popup from rootx rooty} {
    global _popup_priv tk_priv
    set _popup_priv($popup) $from
    set _popup_priv(root) $popup
    $popup post [expr {$rootx-10}] [expr {$rooty-10}]
    $popup activate @10
    set tk_priv(window) $popup
    grab set $popup
}

# $B%a%K%e!<$r%]%C%W%@%&%s$9$k(B
proc popup_unpost {popup} {
    global _popup_priv tk_priv

    # $B%0%i%V$5$l$?$^$^$@$HBgJQ:$$k$N$G!"2?$O$H$b$"$l(B ungrab $B$9$k(B
    catch {grab release [grab current .]}
    if {[info exists _popup_priv(root)]} {
	$_popup_priv(root) unpost
    } else {
	$popup unpost
    }
    $popup invoke [$popup index active]
    set tk_priv(window) {}
    catch {unset _popup_priv($popup)}
    catch {unset _popup_priv(root)}
}

# $B$I$N(B widget $B$+$i%]%C%W%"%C%W$5$l$?$+$rJV$9(B
proc popup_from {popup} {
    global _popup_priv
    return $_popup_priv($popup)
}

# $B0z?t$K%]%C%W%"%C%W85$N(B widget $B$rDI2C$7$F%3%^%s%I$r<B9T$9$k(B
proc popup_invoke {w command args} {
    set from [popup_from $w]
    if {"$from" == ""} return
    eval [concat $command $from $args]
}


#
# $B%a%bF~NO!&JQ99MQ%@%$%"%m%0(B
#

# $B%@%$%"%m%0$r=P$7$F%f!<%6$K%a%b$NFbMF$rF~NO$5$;$k(B
proc get_memo {msg} {
    catch {destroy .dialog}
    toplevel .dialog -class Dialog

    # $B%?%$%H%k(B ($B%&%#%s%I%&%^%M!<%8%c$,$D$1$k$d$D(B) $B$N@_Dj(B
    wm title .dialog "Dialog"

    # $B%j%5%$%:2DG=$K$9$k(B (minsize $B$+(B max $B%5%$%:$r;XDj$7$F$d$l$P$h$$(B)
    wm minsize .dialog 100 100

    # .dialog $B$N2<$K$O(B 3 $B$D$N(B widget $B$r:n$k(B
    #   .dialog.l -- $B%@%$%"%m%0$N%?%$%H%k(B
    #   .dialog.f1 -- $BF~NOMQ%F%-%9%H(B widget $B$rD%$jIU$1$k%U%l!<%`(B
    #   .dialog.f2 -- OK/$B%-%c%s%;%k%\%?%s$rD%$jIU$1$k%U%l!<%`(B

    label .dialog.l -borderwidth 1 -relief raised \
	-padx 8 -pady 8 \
	-anchor w -text "$B%a%bF~NO!&JQ99(B"

    frame .dialog.f1 -borderwidth 1 -relief raised
    text .dialog.f1.t -width 40 -height 8 -relief sunken -borderwidth 2
    .dialog.f1.t insert 1.0 $msg
    pack .dialog.f1.t -expand on -fill both -padx 8 -pady 8

    frame .dialog.f2 -borderwidth 1 -relief raised
    # $B%\%?%s$OI}$r;XDj$7$FBg$-$5$rB7$($k(B
    button .dialog.f2.b1 -text "$B#O#K(B" -width 10 \
	-command "dialog_ack ok"
    button .dialog.f2.b2 -text "$B%-%c%s%;%k(B" -width 10 \
	-command "dialog_ack cancel"
    pack .dialog.f2.b1 -side left -padx 30 -pady 10
    pack .dialog.f2.b2 -side right -padx 30 -pady 10

    # Y $BJ}8~$K%j%5%$%:$7$?;~$K%F%-%9%H$N%U%l!<%`$@$1$,(B
    # $BBg$-$/$J$k$h$&$K(B expand $B$H(B fill $B$r@_Dj$9$k!#(B
    pack .dialog.l -fill x
    pack .dialog.f1 -fill both -expand on
    pack .dialog.f2 -fill x

    # $BF~NOCf$KB>$NF0:n$r$5$l$k$H:$$k(B ($BNc$($P8=:_JT=8Cf$N(B
    # $B%9%H%j%C%W$r>C5n$5$l$k$H$+(B) $B$N$G!"%m!<%+%k%0%i%V$9$k(B
    grab set .dialog

    # $B$o$6$o$6%^%&%9$G%/%j%C%/$7$J$/$F$bF~NO$G$-$k$h$&$K(B
    # $B%F%-%9%H(B widget $B$K%U%)!<%+%9$r@_Dj$7$F$*$/(B
    focus .dialog.f1.t

    # $B%9%/%j!<%s$NBgBNCf1{$K=P$9(B
    set x [expr {[winfo screenwidth .dialog]/2 - 150}] 
    set y [expr {[winfo screenheight .dialog]/2-100}]
    wm geometry .dialog +$x+$y

    # $BF~NO$,=*$k$^$GBT$D(B
    global _text
    tkwait variable _text

    destroy .dialog

    # $BF~NO$5$l$?J8;zNs$rJV$9(B
    return $_text
}

# get_memo $B$N%3!<%k%P%C%/%k!<%A%s(B
proc dialog_ack {action} {
    # OK $B%\%?%s$,2!$5$l$l$PF~NOMQ%F%-%9%H(B widget $B$NFbMF$r!"(B
    # $B%-%c%s%;%k%\%?%s$J$i6uJ8;zNs$rJV$9!#(B
    global _text
    if {$action == "ok"} {
	set _text [.dialog.f1.t get 1.0 end]
    } else {
	set _text {}
    }
}


#
# $B%3%s%H%m!<%i(B
#

# $B%3%s%H%m!<%i(B widget $B$r:n$k(B
proc cr_control {} {
    global CPOSITION usebitmap

    if {$usebitmap} {
	label .bm -borderwidth 0 -bitmap xmemo
	pack .bm -side left -fill y
	bind .bm <1> "popup_post .cmenu .l %X %Y"
    }

    label .control -borderwidth 0 -text "$B%a%b%Q%C%I(B "
    pack .control -side left -fill both -expand on

    # $B%]%C%W%"%C%W%a%K%e!<$N@_Dj(B
    bind .control <1> "popup_post .cmenu .l %X %Y"

    # $BI=<(0LCV$,;XDj$5$l$F$$$l$P$=$3$K=P$9!#(B
    if {$CPOSITION != ""} {
	wm geometry . $CPOSITION
    }
}


#
# $B%a%b%9%H%j%C%W(B
#

# $BJQ?t(B msgs $B$KF~$C$F$$$?%a%C%;!<%8$N%9%H%j%C%W$r:n$C$FI=<($9$k(B
proc create_strips {} {
    global msgs

    foreach msg $msgs {
	cr_strip $msg
    }
    position_strips
}

# $B?7$?$J%9%H%j%C%W$r:n$C$FI=<($9$k(B
proc new_strip {} {
    # $B%@%$%"%m%0$r=P$7$FJ8;zNs$rF~NO$5$;$k!#:G8e$NM>7W$J6u9T$O<h$j5n$k!#(B
    set msg [string trim [get_memo {}] "\n"]

    # $B6uJ8;zNs$@$C$?$i:n$i$J$$!#(B
    if {"$msg"==""} return

    # $B;XDj$5$l$?J8;zNs$G%9%H%j%C%W$r:n$j!"G[CV$9$k!#(B
    set w [cr_strip $msg]
    position_new_strip

    # $BI=<($7$J$$@_Dj$J$i>C$9!#(B
    global visible
    if {! $visible} {wm withdraw $w}

    save_memo
}

# $B;XDj$5$l$?%a%C%;!<%8$N%9%H%j%C%W$r:n$k(B
proc cr_strip {str} {
    global strips

    # widget $BL>$N@8@.(B
    set w .[new_id]

    toplevel $w -class memopad -borderwidth 0
    wm transient $w .

    # message widget $B$O%"%9%Z%/%HHf$rBg$-$/$7$F!">!<j$K2~9T$7$J$$$h$&$K$9$k!#(B
    message $w.m -aspect 10000 -borderwidth 0 -width 0 -text $str

    # $B%]%C%W%"%C%W%a%K%e!<$N@_Dj(B
    bind $w.m <1> "popup_post .smenu $w.m %X %Y"

    pack $w.m -fill both

    # $B%9%H%j%C%WL>$N%j%9%H$KEPO?(B
    lappend strips $w

    # $B:n$C$?%H%C%W%l%Y%k(B widget $B$N%Q%9L>$rJV$9!#(B
    return $w
}

# $B%9%H%j%C%W$NFbMF$NJQ99(B
proc ch_strip {w} {
    # $B8=:_$NI=<(FbMF$r=i4|CM$H$7$F%a%b$NF~NO%@%$%"%m%0$r8F$S=P$9!#(B
    set msg [string trim [get_memo [lindex [$w configure -text] 4]] "\n"]

    if {"$msg" != ""} {
	$w configure -text $msg
	save_memo
    }
}

# $B%9%H%j%C%W$N>C5n(B
proc del_strip {w} {
    global strips

    # $B0z?t$GEO$5$l$k$N$O(B message $B$J$N$G!"$=$N?F$N(B toplevel $B$r5a$a$k(B
    set s [winfo parent $w]
    destroy $s

    # $B>C5n$7$?%9%H%j%C%WL>$r%j%9%H$+$i30$9(B
    set i [lsearch $strips $s]
    if {$i >= 0} {
	set strips [lreplace $strips $i $i]
    }
    save_memo
}

# $B%9%H%j%C%W$NI=<(@ZBX$((B
proc change_visibility {} {
    global strips visible
    if {$visible} {
	set cmd deiconify
    } else {
	set cmd withdraw
    }
    foreach s $strips {wm $cmd $s}
}


#
# $B%]%C%W%"%C%W%a%K%e!<(B
#

# $B%3%s%H%m!<%k%a%K%e!<(B
proc cr_cmenu {} {
    global DIR ALIGN

    menu .cmenu
    .cmenu add command -label "$B:n@.(B" -command "new_strip"
    .cmenu add command -label "$BJB$YD>$7(B" -command "layout_strips"
    .cmenu add cascade -label "$B%l%$%"%&%HJQ99(B" -menu .cmenu.lmenu
    .cmenu add checkbutton -label "$BI=<((B" \
	-variable visible -onvalue 1 -offvalue 0 \
	-command change_visibility
    .cmenu add command -label "$B%;!<%V(B" -command "save_memo"
    .cmenu add command -label "$B%X%k%W(B" -command "help"
    .cmenu add command -label "$B=*N;(B" -command "destroy ."
    popup_conf .cmenu

    menu .cmenu.lmenu
    set items {
	{"$B>e"*2<(B ($B:84s$;(B)" TB L}
	{"$B>e"*2<(B ($B1&4s$;(B)" TB R}
	{"$B2<"*>e(B ($B:84s$;(B)" BT L}
	{"$B2<"*>e(B ($B1&4s$;(B)" BT R}
	{"$B:8"*1&(B ($B>e4s$;(B)" LR T}
	{"$B:8"*1&(B ($B2<4s$;(B)" LR B}
	{"$B1&"*:8(B ($B>e4s$;(B)" RL T}
	{"$B1&"*:8(B ($B2<4s$;(B)" RL B}}
    foreach item $items {
	set d [lindex $item 1]
	set a [lindex $item 2]
	.cmenu.lmenu add radiobutton -label [lindex $item 0]
	if {"$d/$a" == "$DIR/$ALIGN"} {
	    .cmenu.lmenu invoke last
	}
	.cmenu.lmenu entryconfigure last -command "change_layout $d $a"
    }
    popup_conf .cmenu.lmenu
}

# $B%9%H%j%C%W%a%K%e!<(B
proc cr_smenu {} {
    menu .smenu
    .smenu add command -label " $BJQ99(B " -command "popup_invoke .smenu ch_strip"
    .smenu add command -label " $B>C5n(B " -command "popup_invoke .smenu del_strip"
    popup_conf .smenu
}


#
# $B%a%b%U%!%$%kF~=PNO(B
#

set memofile $env(HOME)/.tkmemo		;# $B%a%b%U%!%$%k%Q%9L>(B
set memomagic {# <tkmemo>}		;# $B%a%b%U%!%$%k<1JLMQJ8;zNs(B
set oldfile $env(HOME)/.memopad		;# xmemo $B$N%a%b%U%!%$%k(B

# $B%a%b%U%!%$%k$NFI$_9~$_(B
proc load_memo {} {
    global memofile memomagic oldfile msgs

    if {[file exists $memofile]} {
	# $B%*!<%W%s$7$F%^%8%C%/%J%s%P!<$rD4$Y$k(B
	if {[catch {open $memofile r} f]} {
	    show_error {\
$B%a%b%U%!%$%k(B $memofile $B$r%*!<%W%s$9$k$3$H$+$G$-$^$;$s!#(B
$B%"%/%;%98"$rD4$Y$F$+$i$b$&0lEY5/F0$7$F$/$@$5$$!#(B}
	    destroy .
	    exit 1
	}
	if {"[gets $f]" != "$memomagic"} {
	    show_error {\
$B%a%b%U%!%$%k(B $memofile $B$,2u$l$F$$$k$+!"7A<0$,$"$C$F$$$^$;$s!#(B
$BD>$9$+!"$"$k$$$O0lC6>C$7$F$+$i$b$&0lEY5/F0$7$F$/$@$5$$!#(B}
	    destroy .
	    exit 1
	}
	close $f

	# $B%a%b%U%!%$%k$O(B Tcl $B$N%9%/%j%W%H$K$J$C$F$$$k$N$G(B eval $B$9$l$P$h$$(B
	uplevel #0 source $memofile
	return
    } elseif {[file readable $oldfile]} {
	# xmemo $B$N%U%!%$%k(B (~/.memopad) $B$r%m!<%I$9$k(B
	set f [open $oldfile r]
	set msg {}
	set internalcode [kanji internalCode]
	while {[gets $f str] >= 0} {
	    if {"$str" == "\001"} {
		lappend msgs [string trimright $msg "\n"]
		set msg {}
	    } else {
		set str [kanji conversion EUC $internalcode $str]
		append msg $str "\n"
	    }
	}
	close $f
    }

    # .tkmemo $B$,$J$$(B -- $B$D$^$jB?J,=i$a$F;HMQ$7$?$H$$$&$3$H(B
    global initial_invocation
    set initial_invocation 1
}

# $B%a%b%U%!%$%k$N=q$-9~$_(B
proc save_memo {} {
    global CPOSITION DIR ALIGN GAP WM_BORDER strips memofile memomagic

    if {[catch {open $memofile w} f]} {
	show_error "$memofile $B$K=q$-9~$`$3$H$,$G$-$^$;$s!#(B" 1
	return
    }

    puts $f $memomagic
    # puts $f "# last saved at: [exec date]\n"
    puts $f "# CPOSITION: $B%a%b%3%s%H%m!<%i$NI=<(0LCV(B ($B%8%*%a%H%j(B)"
    puts $f "set CPOSITION {$CPOSITION}"
    puts $f "# DIR: $B%a%b$rJB$Y$kJ}8~(B"
    puts $f "# ALIGN: $B$=$N:]$K$=$m$($kJU$N;XDj(B"
    puts $f "# GAP: $B%a%b$H%a%b$N4V$N%9%Z!<%9(B ($BC10L%T%/%;%k(B)"
    puts $f "# WM_BORDER: $B%&%#%s%I%&%^%M!<%8%c$,$D$1$k%\!<%@!<$NI}(B"
    puts $f "set DIR $DIR\nset ALIGN $ALIGN"
    puts $f "set GAP $GAP\nset WM_BORDER $WM_BORDER"

    foreach s $strips {
	set msg [lindex [$s.m configure -text] 4]
	puts $f [list memo $msg]
    }
    close $f
}

# $B%a%b$NDI2C(B
proc memo {msg} {
    global msgs
    lappend msgs $msg
}


#
# $B%l%$%"%&%H(B
#

# $B%l%$%"%&%H%]%j%7!<$NJQ99(B
proc change_layout {dir align} {
    global DIR ALIGN
    set DIR $dir
    set ALIGN $align
    check_params
    position_strips
    save_memo
}

# $B%9%H%j%C%W$rJB$YD>$9(B
proc layout_strips {} {
    # $B%9%H%j%C%W%j%9%H$rG[CVJ}8~$K9g$o$;$F%=!<%H(B
    sort_strip_list
    # $B%9%H%j%C%W$rJB$Y$k(B
    position_strips
    save_memo
}

# $B;XDj$5$l$?(B widget $B$N0LCV$+$i4p=`E@$N:BI8$r5a$a$k(B
proc get_reference_point {w} {
    global DIR ALIGN WM_BORDER

    # $BG[CV$N4p=`$H$J$k(B widget $B$N:BI8$r$H$k(B
    # $B$?$@$7%&%#%s%I%&%^%M!<%8%c$NIU$1$k%\!<%@!<$N1F6A$r=|$/(B
    set cx [expr {[winfo rootx $w] - $WM_BORDER}]
    set cy [expr {[winfo rooty $w] - $WM_BORDER}]
    set cw [winfo width $w]
    set ch [winfo height $w]

    #
    # $B4p=`E@$O!"G[CVJ}8~(B/$B%"%i%$%s%a%s%H$,(B
    #	TB/L, LR/T -- widget $B$N:8>e(B
    #	TB/R, RL/T -- widget $B$N1&>e(B
    #	BT/L, LR/B -- widget $B$N:82<(B
    #	BT/R, RL/B -- widget $B$N1&2<(B
    # $B$K$H$k!#(B
    #
    case $DIR/$ALIGN in {
	{TB/L LR/T} {list $cx $cy}
	{TB/R RL/T} {list [expr {$cx+$cw}] $cy}
	{BT/L LR/B} {list $cx [expr {$cy+$ch}]}
	{BT/R RL/B} {list [expr {$cx+$cw}] [expr {$cy+$ch}]}
    }
}

# $B<!$N(B widget $B$N4p=`E@$r5a$a$k(B
proc next_reference_point {w xy} {
    global DIR GAP
    set x [lindex $xy 0]
    set y [lindex $xy 1]
    case $DIR in {
	TB {list $x [expr {$y + [strip_height $w] + $GAP}]}
	BT {list $x [expr {$y - [strip_height $w] - $GAP}]}
	LR {list [expr {$x + [strip_width $w] + $GAP}] $y}
	RL {list [expr {$x - [strip_width $w] - $GAP}] $y}
    }
}

# widget $B$r4p=`E@$N>l=j$K;}$C$F$/$k(B
proc move_widget_to_reference_point {w xy} {
    global DIR ALIGN
    set x [lindex $xy 0]
    set y [lindex $xy 1]
    case $DIR/$ALIGN in {
	{TB/L LR/T} {}
	{TB/R RL/T} {incr x -[strip_width $w]}
	{BT/L LR/B} {incr y -[strip_height $w]}
	{BT/R RL/B} {incr x -[strip_width $w]; incr y -[strip_height $w]}
    }

    #
    # tk3.2 $B$G$O!"%9%/%j!<%s30$N0LCV$r;XDj$9$k$H%O%s%0$7$F(B
    # $B$7$^$&$?$a!"%A%'%C%/$7$FI,MW$J$i0LCV$r$:$i$9(B
    #
    if {$x < 0} {
	set x 0
    } elseif {$x >= [winfo vrootwidth $w]} {
	set x [expr {[winfo vrootwidth $w] - 1}]
    }
    if {$y < 0} {
	set y 0
    } elseif {$y >= [winfo vrootheight $w]} {
	set y [expr {[winfo vrootheight $w] - 1}]
    }

    wm geometry $w +$x+$y
}

# $B3F%9%H%j%C%W$r!"%j%9%H$r85$KG[CV$7$J$*$9(B
proc position_strips {} {
    global DIR ALIGN GAP strips

    # $B%3%s%H%m!<%i$r4p=`$K$7$FG[CV$9$k(B
    set xy [get_reference_point .]
    set xy [next_reference_point . $xy]

    foreach s $strips {
	# widget $B$r$=$N0LCV$KCV$/(B
	move_widget_to_reference_point $s $xy
	# $B?7$?$J4p=`E@$r7W;;$9$k(B
	set xy [next_reference_point $s $xy]
    }
}

# $B:G8e$KDI2C$5$l$?%9%H%j%C%W$rG[CV$9$k(B
proc position_new_strip {} {
    global strips

    set nl [llength $strips]
    set new [lindex $strips [expr {$nl - 1}]]

    if {$nl > 1} {
	set ref [lindex $strips [expr {$nl - 2}]]
    } else {
	set ref .
    }
    set xy [next_reference_point $ref [get_reference_point $ref]]
    move_widget_to_reference_point $new $xy
}

# $B8=:_$"$k%9%H%j%C%W$r:#$N:BI8$H%l%$%"%&%H%]%j%7!<$r85$K%=!<%H$9$k(B
proc sort_strip_list {} {
    global DIR strips

    case $DIR in {
	LR {set lr 1; set rev 0}
	RL {set lr 1; set rev 1}
	TB {set lr 0; set rev 0}
	default {set lr 0; set rev 1}
    }

    #
    # $B%=!<%HMQ$K(B
    #    {X$B$^$?$O(BY$B:BI8CM(B  $B%9%H%j%C%WL>(B}
    # $B$H$$$&%j%9%H$r:n$k(B
    #
    set llist {}
    foreach strip $strips {
	if {$lr} {
	    lappend llist [list [format "%05d" [winfo rootx $strip]] $strip]
	} else {
	    lappend llist [list [format "%05d" [winfo rooty $strip]] $strip]
	}
    }
    # lsort $B$G%=!<%H$9$k(B
    set llist [lsort $llist]
    # $BI,MW$J$i5U=g$K$9$k(B
    if {$rev} {
	set llist [lreverse $llist]
    }

    # $B%=!<%H$5$l$?%j%9%H$+$i!"%9%H%j%C%WL>$@$1$N%j%9%H$r:n$k(B
    set strips {}
    foreach strip $llist {
	lappend strips [lindex $strip 1]
    }
}


#
# $B%X%k%W(B
#

# $B%X%k%W%a%C%;!<%8$rI=<($9$k(B
proc help {} {
    show_msg "tkmemo Help" "$B%X%k%W(B" {\
tkmemo $B$O(B xmemo $B$rF|K\8lHG(B Tcl/Tk $B$G=q$-D>$7$?$b$N$G$9!#(B

$B!z;H$$J}(B
$B!V%a%b%Q%C%I!W$H=q$+$l$?%&%#%s%I%&$G:8%\%?%s$r2!$9$H(B
$B<!$N$h$&$J%a%K%e!<$,8=$l$^$9!#(B

  $B:n@.(B -- $B?7$?$K%a%b$rDI2C$7$^$9!#F~NOMQ%@%$%"%m%0$,=P$^$9!#(B
  $BJB$YD>$7(B -- $B%a%b$r@_Dj$5$l$?%l%$%"%&%HJ}K!$K$7$?$,$C$F(B
              $BJB$YD>$7$^$9!#(B
  $B%l%$%"%&%HJQ99(B -- $B%a%b$N%l%$%"%&%HJ}K!$rJQ99$7$^$9!#(B
  $BI=<((B -- $B%a%b$rI=<($9$k$+$I$&$+$r@ZBX$($^$9!#(B
  $B%;!<%V(B -- $B%a%b$NFbMF$r%;!<%V$7$^$9!#DL>o$O<+F0E*$K%;!<%V(B
            $B$5$l$k$N$G;HMQ$9$kI,MW$O$J$$$G$7$g$&!#(B
  $B%X%k%W(B -- $B$3$N%a%C%;!<%8$rI=<($7$^$9!#(B
  $B=*N;(B -- $B=*N;$7$^$9!#(B

$B3F%a%b%&%#%s%I%&$G:8%\%?%s$r2!$9$H!"<!$N$h$&$J%a%K%e!<$,=P(B
$B$^$9!#(B

  $BJQ99(B -- $B%a%b$NFbMF$rJQ99$7$^$9!#(B
  $B>C5n(B -- $B%a%b$r>C$7$^$9!#(B

$B!zCm0U(B
NCD $B$G$O!"%a%K%e!<$r=P$7$?;~$K%^%&%9$r$"$^$jMpK=$KF0$+$9$H(B 
X $B%5!<%P$,%-!<%\!<%I$H%^%&%9$KH?1~$7$J$/$J$C$F$7$^$&$3$H$,(B
$B$"$j$^$9!#$3$l$O(B tkmemo $B$,%-!<%\!<%I$H%^%&%9$r%0%i%V$7$?$^(B
$B$^;_$^$C$F$7$^$&$?$a$G!"$3$&$$$&>uBV$K$J$C$?;~$O$7$P$i$/BT$C(B
$B$F$_$F$/$@$5$$!#$d$,$F;H$($k$h$&$K$J$k$H;W$$$^$9!#(BTk $B$N%P!<(B
$B%8%g%s$K$h$C$F$O$$$D$^$G$?$C$F$b;_$^$C$?$^$^$N$3$H$b$"$j$^(B
$B$9!#$3$N>l9g$K$O;DG0$J$,$iB>$NC<Kv$+$i(B tkmemo $B$N%W%m%;%9$r(B
$B;&$9$7$+$"$j$^$;$s!#%a%K%e!<$r=P$7$?;~$O5$$rIU$1$F$/$@$5$$!#(B

$B$^$?!"$3$N8=>]$O:#$N=j(B NCD $B$N$_$G4QB,$5$l$F$$$^$9$,!"$b$7(B
$BB>$N%5!<%P$G$b5/$3$j$^$7$?$i8fO"Mm$/$@$5$$!#(B(NEWS $B$N%5!<%P(B
$B$G$b5/$3$k$H$$$&Js9p$,$"$j$^$7$?(B)

$B!z%a%b%U%!%$%k$N%U%)!<%^%C%H(B
$B%a%b$O(B ~/.tkmemo $B$H$$$&%U%!%$%k$K%;!<%V$5$l$^$9!#$3$l$O(B 
Tcl $B$N%9%/%j%W%H$G$9!#3F%a%b$O(B

    memo {$B%a%C%;!<%8(B}

$B$N7A<0$GF~$C$F$$$^$9$+$i!"%(%G%#%?$rMxMQ$7$FJQ99$7$?$jDI2C(B
$B$7$?$j$9$k$3$H$b$G$-$^$9!#$^$?!"$3$N%U%!%$%k$K$O%a%b$NFbMF(B
$B$@$1$G$O$J$/!"%l%$%"%&%H>pJs$J$I$bF~$C$F$$$^$9!#(B

tkmemo $B$O(B ~/.tkmemo $B$,8+$D$+$i$J$$;~$K$O(B xmemo $B$N%a%b%U%!(B
$B%$%k(B (~/.memopad) $B$rC5$7!"$"$l$PFI$_9~$_$^$9!#$=$7$F$=$l$r(B
$B?7$7$$%U%)!<%^%C%H$K<+F0JQ49$7$^$9!#(B

$B!z%l%$%"%&%HJ}K!$K$D$$$F(B
$B3F%a%b$O%a%b%Q%C%I%&%#%s%I%&$r4p=`$H$7$F!";XDj$5$l$?%l%$%"(B
$B%&%H$GG[Ns$5$l$^$9!#;XDj$G$-$k$N$O(B

    $BJB$Y$kJ}8~(B ($B>e"*2<!&2<"*>e!&:8"*1&!&1&"*:8(B)
    $B$=$m$($kJU(B ($B>e!&2<!&:8!&1&(B)

$B$NFs$D$G$9!#(B

$BNc$($PJB$Y$kJ}8~$H$7$F!V>e"*2<!W$r!"$=$m$($kJU$H$7$F!V1&!W(B
$B$rA*$s$@>l9g$K$O!"3F%a%b$O%a%b%Q%C%I%&%#%s%I%&$N2<$+$i$O$8(B
$B$^$j>e$+$i2<$N=g=x$G!"$^$?%&%#%s%I%&$N1&C<$,%a%b%Q%C%I%&%#(B
$B%s%I%&$N1&C<$HB7$&$h$&$KJB$Y$i$l$^$9!#(B

$BJB$Y$kJ}8~$HB7$($kJU$O<+M3$KAH$_9g$o$;$k$3$H$,$G$-$k$o$1$G(B
$B$O$J$/!"Nc$($P>e"*2<$KJB$Y$k>l9g$K$OB7$($kJU$H$7$F;XDj$G$-(B
$B$k$N$O:8$+1&$N$I$A$i$+$G$9!#(B

$B<B9TCf$K%l%$%"%&%HJQ99$9$k$3$H$b$G$-$^$9!#$?$@$7!"%l%$%"%&(B
$B%H7k2L$,%G%#%9%W%l%$$r$O$_=P$9$H!"(Btk $B$N%P%0$GF0:n$,;_$^$C(B
$B$F$7$^$&$3$H$,$"$j$^$9$N$G!"%G%#%9%W%l%$C<$+$i$O$_=P$5$J$$(B
$B$h$&$K$7$F$"$j$^$9!#(B

$BJB$YD>$7$r$9$k;~$K!"%a%b$N=gHV$rJQ$($k$3$H$,$G$-$^$9!#3F%a(B
$B%b$OJB$YD>$9D>A0$N0LCV$N=g$KJB$SJQ$($i$l$k$N$G!"%&%#%s%I%&(B
$B%^%M!<%8%c$G%a%b$N%&%#%s%I%&$r9%$-$J=gHV$K$J$k$h$&$KF0$+$7(B
$B$F$+$i%a%K%e!<$GJB$YD>$7$rA*Br$9$l$P$$$$$N$G$9!#(B

$B$J$*!"(Bvtwm $B$J$I$N$h$&$J!V2>A[%k!<%H%&%#%s%I%&!W$r;}$D%&%#(B
$B%s%I%&%^%M!<%8%c$r;HMQ$7$F$$$k>l9g!"%a%b%Q%C%I$N@0Ns$,$&$^(B
$B$/$$$+$J$$$3$H$,$"$j$^$9!#(B

$B!z%&%#%s%I%&%^%M!<%8%c$N@_Dj(B
$B3F%a%b%&%#%s%I%&$K%?%$%H%k$,$D$+$J$$$h$&$K$9$k$K$O!"<!$N$h(B
$B$&$K$7$F$/$@$5$$!#(B

  $B""(B mwm
  $B%j%=!<%9$K<!$N9T$r2C$($F$/$@$5$$!#(B

      Mwm*memopad*clientDecoration: none

  $B""(B twm
  $B%G%U%)%k%H$G$O$D$-$^$;$s$,!"(B.twmrc $B$G(B DecorateTransient
  $B$r;XDj$7$F$$$k$H$D$$$F$7$^$$$^$9!#$=$N>l9g(B .twmrc $B$N(B
  NoTitle $B$N%j%9%H$K(B "memopad" $B$rF~$l$F$/$@$5$$!#(B

$B!z0LCV;XDj(B
$B%a%b%Q%C%I%&%#%s%I%&$NI=<(0LCV$r8GDj$K$9$k$K$OFs$D$NJ}K!$,(B
$B$"$j$^$9!#0l$D$O(B tkmemo $B$r<B9T$9$k;~$K(B -geometry $B%*%W%7%g(B
$B%s$G;XDj$9$kJ}K!$G$9!#Nc$($P(B

    % tkmemo -geometry +10+10  -- $B2hLL$N:8>e(B

$B$N$h$&$K;XDj$7$^$9!#$b$&0l$D$O%a%b%U%!%$%k(B ~/.tkmemo $B$NCf(B
$B$G;XDj$9$kJ}K!$G!"JQ?t(B CPOSITION $B$K%8%*%a%H%j;XDj$r@_Dj$7(B
$B$^$9!#Nc$($P(B

    set CPOSITION +10-10  -- $B2hLL$N:82<(B

$B!z%U%)%s%H!&?'$N;XDj(B
$B%U%)%s%H$d?'$O%j%=!<%9%U%!%$%k$G;XDj$9$k$3$H$,$G$-$^$9!#(B
$B<!$N$h$&$J;XDj$r(B X $B$N%j%=!<%9%U%!%$%k(B (~/.Xresources $B$J$I(B) 
$B$KF~$l$F$/$@$5$$!#(B

    tkmemo*font: <$B%"%9%-!<%U%)%s%HL>(B>
    tkmemo*kanjiFont: <$B4A;z%U%)%s%HL>(B>
    tkmemo*foreground: <$B?'L>(B>
    tkmemo*background: <$B?'L>(B>

$B%a%b%Q%C%I%&%#%s%I%&$H3F%a%b%&%#%s%I%&$N@_Dj$rJ,$1$?$$;~$K(B
$B$O!"%a%b%&%#%s%I%&$K$O(B tkmemo $B$NBe$o$j$K(B tkmemo*m $B$r;HMQ$7(B
$B$F$/$@$5$$!#Nc$($P(B

    tkmemo*m*font: <$B3F%a%b%&%#%s%I%&MQ$N%U%)%s%H(B>

$B$N$h$&$K$7$^$9!#(B

$B!z<ALd!&%P%0%l%]!<%H(B
tkmemo $B$K4X$9$k$*Ld$$9g$o$;$O(B ishisone@sra.co.jp $B$^$G$*4j(B
$B$$$7$^$9!#(B
}
}

# $B$O$8$a$N0';"$r$9$k(B
proc greeting {} {
    show_msg "tkmemo Greetings" "$B$4$"$$$5$D(B" {\
$B$O$8$a$^$7$F!#(Btkmemo $B$G$9!#(B

tkmemo $B$O%G%#%9%W%l%$$K%a%b$rD%$jIU$1$F$*$/$?$a$N%3%^%s%I(B
$B$G$9!#%G%#%9%W%l%$$N1o$KMQ7o$r=q$$$?%]%9%H%$%C%H$rD%$jIU$1(B
$B$kBe$o$j$K!"%a%b$N%&%#%s%I%&$r%G%#%9%W%l%$$KI=<($7$F$7$^$*(B
$B$&$H$$$&$b$N$G$9!#(B

xmemo $B$H$$$&%3%^%s%I$rCN$C$F$$$kJ}$J$i!"$=$N(B Tcl/Tk $BHG$G$"(B
$B$k$H$$$($P$o$+$C$F$$$?$@$1$k$G$7$g$&!#$?$@$7!"%a%b$r%;!<%V(B
$B$9$k%U%!%$%k$N%Q%9L>$H%U%)!<%^%C%H$,0[$J$j$^$9!#$b$7(B 
tkmemo $B$r:G=i$K5/F0$7$?;~(B ($B$D$^$j:#$N$3$H$G$9(B) $B$K(B xmemo $B$N(B
$B%G!<%?%U%!%$%k$,$"$l$P!"(Btkmemo $B$O<+F0E*$K$=$l$r(B tkmemo $B$N(B
$B%U%)!<%^%C%H$KJQ49$7!"%;!<%V$7$^$9!#(B

$B;H$$J}$J$I>\$7$/$O%X%k%W$r8+$F$/$@$5$$!#(Btkmemo $B$N%3%s%H%m!<(B
$B%k%&%#%s%I%&(B ($B!V%a%b%Q%C%I!W$H=q$+$l$?%&%#%s%I%&$N$3$H$G$9(B) 
$B$G%^%&%9$N:8%\%?%s$r2!$9$H%]%C%W%"%C%W%a%K%e!<$,8=$l$^$9$,!"(B
$B$=$N!V%X%k%W!W$rA*Br$9$k$H8+$k$3$H$,$G$-$^$9!#(B

$B5?Ld$dITL@$JE@$J$I$"$j$^$7$?$i(B ishisone@sra.co.jp $B$^$G$*Ld(B
$B$$9g$o$;$/$@$5$$!#(B

$B$=$l$G$O(B tkmemo $B$r$*3Z$7$_$/$@$5$$!#(B
} 1
}

# $B;XDj$5$l$?%a%C%;!<%8$rI=<($9$k(B
proc show_msg {title head msg {grab 0}} {
    # $BA0$N$,$"$l$P>C$9(B
    catch {destroy .help}

    toplevel .help -class Help
    wm title .help $title

    # $B%j%5%$%:2DG=$K$7$F$*$/(B
    wm minsize .help 100 100

    # $B%P!<%8%g%sHV9f$O(B RCS $B$N%j%S%8%g%s$+$i$H$k!#(B
    set version [lindex {$Revision: 1.18 $} 1]

    # .help $B$N2<$K$O(B 3$B$D$N(B widget $B$r:n$k!#(B
    #   .help.l -- $B%@%$%"%m%0$N%?%$%H%k(B
    #   .help.f2 -- $B%a%C%;!<%8I=<(MQ$N%F%-%9%H$rD%$jIU$1$k%U%l!<%`(B
    #   .help.f3 -- OK $B%\%?%s$rD%$jIU$1$k%U%l!<%`(B

    label .help.l -border 1 -relief raised -padx 10 -pady 4 -anchor w \
	-text "tkmemo ver$version  $head"

    # $B%F%-%9%H$H%9%/%m!<%k%P!<$NF~$C$?%U%l!<%`$r:n$k(B
    frame .help.f2 -border 2 -relief raised
    text .help.f2.text -width 60 -height 20 -border 2 -relief sunken\
	-yscrollcommand {.help.f2.scroll set}
    scrollbar .help.f2.scroll -border 2 -relief sunken \
	-command {.help.f2.text yview}
    pack .help.f2.text -side left -padx 4 -pady 4 -fill both -expand on
    pack .help.f2.scroll -side right -padx 4 -pady 4 -fill y

    frame .help.f3 -border 1 -relief raised
    button .help.f3.ok -text "$B#O#K(B" -padx 1c -command {destroy .help}
    pack .help.f3.ok -pady 4

    pack .help.l -fill x
    pack .help.f2 -fill both -expand on
    pack .help.f3 -fill x

    # $B2hLL$NCf1{$K;}$C$F$/$k!#(B
    # $B%&%#%s%I%&$NBg$-$5$O%^%C%W$5$l$J$$$H$o$+$i$J$$$N$G!"(B
    # $B%F%-%9%H$N(B reqwidth/reqheight $B$+$iE,Ev$K7W;;$9$k!#(B
    # $B@53N$JCM$rD4$Y$kJ}K!$b$"$k(B (tk_dialog $B$N%=!<%9;2>H(B) $B$,!"(B
    # $BLLE]$J$N$G!#(B
    set scrw [winfo screenwidth .help]		;# $B%G%#%9%W%l%$$NI}(B
    set scrh [winfo screenheight .help]		;# $B%G%#%9%W%l%$$N9b$5(B
    set tw [winfo reqwidth .help.f2.text]	;# $B%F%-%9%H$N<+A3$JI}(B
    set th [winfo reqheight .help.f2.text]	;# $B%F%-%9%H$N<+A3$J9b$5(B
    wm geometry .help +[expr {($scrw-$tw-20)/2}]+[expr {($scrh-$th-40)/2}]

    # $B%F%-%9%H$r$$$l!"(Breadonly $B$K$9$k!#(B
    .help.f2.text insert 1.0 $msg
    .help.f2.text configure -state disabled

    # grab $B$,(B 0 $B$G$J$1$l$P%m!<%+%k%0%i%V$9$k!#(B
    if {$grab} {
	grab set .help
    }

    # OK $B%\%?%s$,2!$5$l$k$N$rBT$D!#(B
    tkwait window .help
}

# $B%(%i!<%a%C%;!<%8$rI=<($9$k(B
proc show_error {msg {warning 0}} {
    if {$warning} {
	set bm warning
	set head $B7Y9p(B
	set title "Warning message"
    } else {
	set bm error
	set head $B%(%i!<(B
	set title "Error message"
    }

    # $BA0$N$,$"$l$P>C$9(B
    catch {destroy .error}

    toplevel .error -class Error
    wm title .error $title

    frame .error.top -borderwidth 1 -relief raised
    frame .error.bot -borderwidth 1 -relief raised

    label .error.top.b -bitmap $bm
    message .error.top.msg -text $msg -aspect 300
    pack .error.top.b -side left -fill y -padx 10
    pack .error.top.msg -side right -fill y -padx 5 -pady 10

    button .error.bot.ok -text "$BN;2r(B" -command "destroy .error"
    pack .error.bot.ok -pady 10

    pack .error.top .error.bot -fill x

    set scrw [winfo screenwidth .error]
    set scrh [winfo screenheight .error]
    wm geometry .error +[expr {($scrw-200)/2}]+[expr {($scrh-150)/2}]

    # $B%m!<%+%k%0%i%V$9$k(B
    grab set .error

    # OK $B%\%?%s$,2!$5$l$k$N$rBT$D(B
    tkwait window .error
}


#
# $B$=$NB>(B
#

set _id 0

# $B%f%K!<%/$J(B widget $BL>$N@8@.(B
proc new_id {} {
    global _id
    incr _id
    return pad$_id
}

# $B%9%H%j%C%W$"$k$$$O%3%s%H%m!<%i$NI}$r5a$a$k(B
proc strip_width {w} {
    # pack $B$O(B widget $B$,%^%C%W$5$l$?;~$K9T$o$l$k$N$G$=$l$^$G$O(B
    # $BI}(B 1 $B$K$J$C$F$7$^$&!#$=$N;~$K$OCf$N%a%C%;!<%8(B widget $B$N(B
    # reqwidth $B$r;H$&!#(B
    set wid [winfo width $w]
    expr {$wid < 2 ? [winfo reqwidth $w.m] : $wid}
}

# $B%9%H%j%C%W$"$k$$$O%3%s%H%m!<%i$N9b$5$r5a$a$k(B
proc strip_height {w} {
    # pack $B$O(B widget $B$,%^%C%W$5$l$?;~$K9T$o$l$k$N$G$=$l$^$G$O(B
    # $B9b$5(B 1 $B$K$J$C$F$7$^$&!#$=$N;~$K$OCf$N%a%C%;!<%8(B widget $B$N(B
    # reqheight $B$r;H$&!#(B
    set h [winfo height $w]
    expr {$h < 2 ? [winfo reqheight $w.m] : $h}
}

# $B%Q%i%a!<%?$NCM$,@5$7$$$+%A%'%C%/(B
proc check_params {} {
    global DIR ALIGN GAP
    set possible_combinations {LR/T LR/B RL/T RL/B TB/L TB/R BT/L BT/R}

    if {[lsearch $possible_combinations $DIR/$ALIGN] < 0} {
	show_error "\
$B%a%b%G!<%?(B (~/.tkmemo) $B$K@_Dj$5$l$?%Q%i%a!<%?$N(B\
DIR $B$+(B ALIGN $B$N$I$A$i$+$NCM$,4V0c$C$F$$$k$+!"(B\
$B$"$k$$$O$=$NAH9g$;$,4V0c$C$F$$$^$9!#(B\
$B@5$7$$AH9g$;$O<!$NDL$j$G$9!#(B
$possible_combinations
DIR $B$r(B TB$B!"(BALIGN $B$r(B L $B$K%j%;%C%H$7$^$9!#(B" 1
	set DIR TB
	set ALIGN L
    }
}

# $B%j%9%H$r5U$KJB$Y$k(B
proc lreverse {l} {
    set r {}
    foreach e $l {
	set r [linsert $r 0 $e]
    }
    return $r
}


#
# $B%a%$%s(B
#

wm withdraw .

# $B%a%b%G!<%?$rFI$_9~$_!"@_Dj$5$l$?%Q%i%a!<%?$,@5$7$$$+%A%'%C%/$9$k(B
load_memo
check_params

# $B%3%s%H%m!<%i$r:n$k(B
cr_control

# $B%a%K%e!<$r:n$k(B
cr_cmenu
cr_smenu

update
wm deiconify .
update

# $B%a%b$r:n$C$FJB$Y$k(B
create_strips

# $B=i$a$F5/F0$7$?;~$K$O@_Dj%U%!%$%k$r:n$j!"$"$$$5$D$9$k(B
if {$initial_invocation} {
    save_memo
    greeting
}
