#! /usr/local/pgsql/bin/pgtksh -f
#
# 超シンプルメールアーカイブ検索ツール

# 初期画面を作成する
proc make_widgets {} {
    global Key Sdate Edate

    wm title . "simple mail search tool"
    wm iconname . "smst"
    frame .k

    set f [frame .k.keyword]
    pack [label $f.l -width 10 -text "キーワード"] \
    [entry $f.e -width 20 -textvariable Key] -side left
    pack $f -side top -fill x -anchor w

    set f [frame .k.date]
    pack [label $f.l1 -width 10 -text "日付"] \
    [entry $f.e1 -width 10 -textvariable Sdate] \
    [label $f.l2 -text "〜"] \
    [entry $f.e2 -width 10 -textvariable Edate] -side left
    pack $f -side top -fill x -anchor w

    set f [frame .k.buttons -relief sunken -borderwidth 2]
    set b1 [button $f.b1 -text "検索開始" -command "start_select"]
    set b2 [button $f.b2 -text "終了" -command "cleanup"]
    pack $b1 $b2 -side left -expand yes
    pack $f -side top -fill x

    set f [frame .k.list]
    set w [listbox $f.listbox -xscroll "$f.xscroll set" \
	    -yscroll "$f.yscroll set" -relief sunken -setgrid 1 \
	    -selectmode single -width 80 -font a14 -kanjifont k14]
    bind $w <Double-1> "show"
    set xs [scrollbar $f.xscroll -orient horizontal \
	    -relief sunken -command "$w xview"]
    set ys [scrollbar $f.yscroll -relief sunken -command "$w yview"]
    pack $xs -side bottom -fill x -expand yes
    pack $ys -side  right -fill y -expand yes
    pack $w -side top -fill both -expand yes
    pack $f -side top -fill both -expand yes

    pack .k -fill both -expand yes
}

# 終了ボタンを押された時に呼び出される後始末 procedure
proc cleanup {} {
    global con
    pg_disconnect $con
    destroy .
}

# 検索開始ボタンを押された時に呼び出されて実際に検索を実行する
proc start_select {} {
    global Key Sdate Edate con SeqList

    set query "select b.subject,a.fname,b.date,a.count \
	from words a, header b where \
		    a.word = '$Key' and a.fname = b.fname "
    if {$Sdate != "" && $Edate != ""} {
	append query "and b.date >= '$Sdate' and b.date <= '$Edate'"
    }

    append query " order by a.count desc,b.date"

    puts $query

    catch {set res [pg_exec $con $query]}
    if {[info exist res] == 0 || \
	    [string range $res 0 2] != "pgr" || \
	    [pg_result $res -numTuples] == 0} {
	set msg "該当データがありません。"
	tk_dialog .dialogue "selection failed" $msg error -1 "そうですか"
    } else {
	set n [pg_result $res -numTuples]
	set SeqList ""
	.k.list.listbox delete 0 end

	for {set i 0} {$i < $n} {incr i} {
	    set l [pg_result $res -getTuple $i]
	    set subject [lindex $l 0]
	    set seq [lindex $l 1]
	    .k.list.listbox insert end $subject
	    lappend SeqList $seq
	}
	pg_result $res -clear
    }
}

# 検索結果リストのダブルクリックで呼び出され、メール本体を表示する
proc show {} {
    global SeqList MyArgs

    catch {destroy .d};	# すでにウィンドウが存在したらそれを消してから表示
    toplevel .d;	# 独立したウィンドウにする
    wm title .d "Contents"
    set f [frame .d.t]
    set w [text $f.text -width 80 -wrap none -xscrollcommand "$f.xscroll set" \
	    -yscrollcommand "$f.yscroll set"]
    set xs [scrollbar $f.xscroll -orient horizontal \
	    -relief sunken -command "$w xview"]
    set ys [scrollbar $f.yscroll -relief sunken -command "$w yview"]
    pack $xs -side bottom -fill x
    pack $ys -side  right -fill y
    pack $w -side top -fill both -expand yes
    pack $f -side top -fill both -expand yes

    set f [frame .d.buttons -relief sunken -borderwidth 2]
    set b1 [button $f.b1 -text "閉じる" -command "destroy .d"]
    pack $b1 -side left -expand yes
    pack $f -side top -fill x

    set fname $MyArgs(-dir)
    if {$fname != ""} {append fname "/"}
    append fname [lindex $SeqList [.k.list.listbox curselection]]
    set fd [open $fname]
    while {[gets $fd line] >= 0} {
	$w insert end [format "%s\n" $line]
    }
    close $fd
}

#------------------------------------------------------------------
# ここからメインプログラム
#------------------------------------------------------------------

# 漢字コードを EUC-JP にする
kanji internalCode EUC
kanji defaultOutputCode EUC
kanji defaultInputCode ANY

global MyArgs env
set MyArgs(-host) "localhost"
set MyArgs(-db) $env(USER)
set MyArgs(-dir) ""

# コマンド引数の処理
set argexpect ""
foreach i $argv {
    if {$argexpect != ""} {
	set MyArgs($argexpect) $i
	set argexpect ""
    } else {
	case $i in {
	    {-host} {
		set argexpect $i
	    }
	    {-db} {
		set argexpect $i
	    }
	    {-dir} {
		set argexpect $i
	    }
	    {default} {
		puts stderr {usage: smst [-- -host DBhost -db DBname -dir directory]}
		exit
	    }
	}
    }
}

global con;	# PostgreSQL サーバへの接続ハンドル
catch {set con [pg_connect $MyArgs(-db) -host $MyArgs(-host)]}
if {[info exist con] == 0 || \
	[info exist con] == 1 && \
	[string range $con 0 2] != "pgc"} {
    set msg [format "データベースサーバ %s のデータベース %s と接続できません。" \
	    $MyArgs(-host) $MyArgs(-db)]
    tk_dialog .dialogue "smst Dialogue" $msg error -1 "そうですか"
    exit
}

make_widgets;	# 初期画面の作成