# user.tcl
#
# User hooks.
#
# Copyright (c) 1993 Xerox Corporation.
# Use and copying of this software and preparation of derivative works based
# upon this software are permitted. Any distribution of this software or
# derivative works must comply with all applicable United States export
# control laws. This software is made available AS IS, and Xerox Corporation
# makes no warranty about the software, its performance or its conformity to
# any specification.

# updating TclIndex
# wish: auto_mkindex . *.tcl

# k.furukawa, jan.17.1997.  add User_Message_Apply_{Linac_Archive|Vms_Filter}
# k.furukawa, feb.6.1997.   add User_Message_Annotate
# k.furukawa, feb.12.1997.  add User_Message_Apply_Pfnet_Archive
# k.furukawa, feb.12.1997.  add User_Message_Apply_LinacCom_Archive
# k.furukawa, apr.8.1997.   add Annotation to Archive commands
# k.furukawa, apr.18.1997.  add User_Message_Processed
# k.furukawa, apr.18.1997.  add User_Message_Processed
# k.furukawa, sep.4.1997.   add Hook_SeditInit_WhoisAddr/User_WhoisAddr_*
# k.furukawa, jan.15.1998.  move User_Whois* to whois.tcl
# k.furukawa, sep.21.1998.  add User_Message_Apply_JHF_Acon_Archive
# k.furukawa, sep.20.2000.  add User_Message_Apply_Chan_Pos_Archive

# @(#) user.tcl v1.9, kazuro furukawa, apr.1997.-sep.2000.

# Archive the message into Linac-Mails
proc User_Message_Apply_Linac_Archive {} {
    global print exmh msg

    set temp $print(unixcmd)
    set print(unixcmd) {linac-mail-archive $file}
    Message_Apply
    set print(unixcmd) $temp
    MhExec anno +$exmh(folder) $msg(id) -component Archived -text Linac -inplace

    # "A" is specified for Archived in scan format
    User_Update_FtocAnno A
}

# Archive the message into LinacCom-Mails
proc User_Message_Apply_LinacCom_Archive {} {
    global print exmh msg

    set temp $print(unixcmd)
    set print(unixcmd) {linac-com-mail-archive $file}
    Message_Apply
    set print(unixcmd) $temp
    MhExec anno +$exmh(folder) $msg(id) -component Archived -text Linac-Com -inplace

    # "A" is specified for Archived in scan format
    User_Update_FtocAnno A
}

# Archive the message into JHF-Acon-Mails
proc User_Message_Apply_JHF_Acon_Archive {} {
    global print exmh msg

    set temp $print(unixcmd)
    set print(unixcmd) {jhf-acon-mail-archive $file}
    Message_Apply
    set print(unixcmd) $temp
    MhExec anno +$exmh(folder) $msg(id) -component Archived -text JHF-Acon -inplace

    # "A" is specified for Archived in scan format
    User_Update_FtocAnno A
}

# Archive the message into ChanPos-Mails
proc User_Message_Apply_Chan_Pos_Archive {} {
    global print exmh msg

    set temp $print(unixcmd)
    set print(unixcmd) {mail-archive /usr/new/etc/apache/home/mail/chan-pos/current $file}
    Message_Apply
    set print(unixcmd) $temp
    MhExec anno +$exmh(folder) $msg(id) -component Archived -text Chan-Pos -inplace

    # "A" is specified for Archived in scan format
    User_Update_FtocAnno A
}

# Archive the message into Pfnet-Mails
proc User_Message_Apply_Pfnet_Archive {} {
    global print exmh msg

    set temp $print(unixcmd)
    set print(unixcmd) {pfnet-mail-archive $file}
    Message_Apply
    set print(unixcmd) $temp
    MhExec anno +$exmh(folder) $msg(id) -component Archived -text Pfnet -inplace

    # "A" is specified for Archived in scan format
    User_Update_FtocAnno A
}

# Archive the message into Test-Mails
proc User_Message_Apply_Test_Archive {} {
    global print exmh msg

    set temp $print(unixcmd)
    set print(unixcmd) {test-mail-archive $file}
    Message_Apply
    set print(unixcmd) $temp
    MhExec anno +$exmh(folder) $msg(id) -component Archived -text Test -inplace

    # "A" is specified for Archived in scan format
    User_Update_FtocAnno A
}

# Filter the vms message
proc User_Message_Apply_Vms_Filter {} {
    global print

    set temp $print(unixcmd)
    set print(unixcmd) {vmsmail-filter $file}
    Message_Apply
    set print(unixcmd) $temp
}

# Annotate message as Important
proc User_Message_Annotate {} {
    global exmh msg

#    MhExec anno +$exmh(folder) $msg(id) -component Annotation -nodate -text Important -inplace
    MhExec anno +$exmh(folder) $msg(id) -component Comment -nodate -text Important -inplace

    # "C" is specified for Comment in scan format
    User_Update_FtocAnno C
}

# Annotate message as Processed
proc User_Message_Processed {} {
    global exmh msg

    # MhExec anno +$exmh(folder) $msg(id) -component Comment -nodate -text Important -inplace
    MhExec anno +$exmh(folder) $msg(id) -component Comment -nodate -text Processed -inplace

    # "C" is specified for Comment in scan format
    User_Update_FtocAnno C
}

# Update Annotation Indication in Ftoc
proc User_Update_FtocAnno { plus } {
    global msg

    set ix [Ftoc_FindMsg $msg(id)]
    if {$ix != {}} {
	User_Ftoc_RescanLine $ix $plus
    }
}

# User_Ftoc_RescanLine is almost the same as Ftoc_RescanLine in ftoc.tcl
proc User_Ftoc_RescanLine { ix {plus X} } {
    global exmh exwin ftoc
    if [catch {
	set text [$exwin(ftext) get ${ix}.0 ${ix}.end]
	set ok 0
	# Stick $plus after the number
	set ok [regsub {( *[0-9]+.)(.)} $text "\\1$plus" newtext]
	# scancomps is assumed to be %<{comment}C%?{archived}A%?{replied}-%?...
	# Annotations result in writes to the directory.
	# Here we mark the display dirty to force an update
	# of the cache and prevent later rescans.
	set ftoc(displayDirty) 1
	if {$ok} {
	    set tags [$exwin(ftext) tag names ${ix}.0]
	    $exwin(ftext) configure -state normal
	    $exwin(ftext) delete ${ix}.0 ${ix}.end
	    $exwin(ftext) insert ${ix}.0 $newtext
	    $exwin(ftext) configure -state disabled
	    foreach tag $tags {
		$exwin(ftext) tag add $tag ${ix}.0 ${ix}.end
	    }
	}
    } msg] {
	Exmh_Error "UserFtocRescanLine $ix : $msg"
    }
}
    
# Hook_TextBind_WhoisAddr is called from Sedit_ClassBindings in seditBind.tcl
#proc Hook_TextBind_WhoisAddr { tclass } {
#
#    bind $tclass <Shift-Key-Tab> {User_WhoisAddr_KeyExpand %W}
#}

# above didn't work since user.tcl is not read yet, thus ...

# k.furukawa, sep.4.1997.   add Hook_SeditInit_WhoisAddr/User_WhoisAddr_*
# k.furukawa, dec.24.1997.  refine ...

# Hook_SeditInit_WhoisAddr is called from Sedit_Start in sedit.tcl
#proc Hook_SeditInit_WhoisAddr { draft t } {
#    # here t is like .sedit12.f.t
#    bind $t <Shift-Key-Tab> {User_WhoisAddr_KeyExpand %W}
#    bind $t <Meta-Key-Tab> {User_WhoisAddr_KeyExpand %W}
#    bind $t <Key-Escape><Key-Tab> {User_WhoisAddr_KeyExpand %W}
#}

# User_WhoisAddr_KeyExpand is based on Addr_KeyExpand in addr.tcl
proc User_WhoisAddr_KeyExpand { w } {

    ## AddrDebug "User_WhoisAddr_KeyExpand: w=$w"
    set line [string trim [$w get {insert linestart} {insert lineend}]]
    ## AddrDebug "  got line \"$line\""
    # Only allows expansion on addressable header lines.
    if [regexp -nocase {^(to: *|resent-to: *|cc: *|resent-cc: *|bcc: *|dcc: *)(.*)} $line t0 t1 t2] {
        ## AddrDebug  "  matched! keep is \"$t1\", partial name=\"$t2\""
        if [regexp -indices ",?.*, *" $t2 t0] {
            set t0 [lindex $t0 end]
            ## AddrDebug "got comma at $t0"
            set t3 [string range $t2 0 $t0]
            append t1 $t3
            set t2 [string range $t2 [expr $t0 + 1] end]
            ## AddrDebug "  multi, will keep \"$t1\", new partial name=\"$t2\""
        }

	set result [busy User_WhoisAddr_Lookup $t2]
	if {[string compare $result ""] == 0} return

	if {[llength $result] == 1} {
	    # unique match
	    $w delete  {insert linestart} {insert lineend}
	    $w insert insert [format "%s%s" $t1 [lindex $result 0]]
	    catch {destroy $w.addrs}
	} else {
	    # must be multiple hits
	    ## AddrDebug "  Multiple hits: $result"
	    set new [AddrShowDialog $w $result]
	    # if no selection is made, leave the string where it is
	    if [ string compare $new "" ] {
		$w delete  {insert linestart} {insert lineend}
		$w insert insert [format "%s%s" $t1 $new]
	    }
	}
    } else {
        Exmh_Status "Error in name expansion: not on To: field"
        return
    }
}

# User_WhoisAddr_Lookup is based on TkWhois
proc User_WhoisAddr_Lookup { key } {
    set whois_port 43
    set whois_host whois.kek.jp
    if [catch {set sock [socket $whois_host $whois_port]} err] {
	Exmh_Status "Whois Error: $err"
	return ""
    }
    puts $sock $key
    flush $sock
    set reply [read $sock]
    close $sock
    set result ""
    foreach word $reply {
	if {[string first @kek.jp $word] != -1} {
	    append result "$word "
	}
    }
    return $result
}

#
# Below are the original sample procedures

proc User_Init {} {
    # The main routine calls User_Init early on, after only
    # Mh_Init, Preferences_Init, and ExmhLogInit (for Exmh_Debug)

    if {0} {
	# Arrange to have some folders labels displayed as icons, not text
	global folderInfo
	set folderInfo(bitmap,exmh) @/tilde/welch/bitmaps/exmh
    }
    return
}

proc User_Layout {} {
    # This is called just after Exwin_Layout that creates the main 
    # widget tree.  Here you could wedge in more buttons, or override
    # some of their behavior.  Look at exwin.tcl and buttons.tcl to
    # find what elements of the exwin() array and the buttons() array
    # are used to store widget pathnames.
    if {0} {
	global buttons
	set incButton $buttons(folderF).inc
	$incButton configure -command UserInc
    }
}

proc UserInc {} {
    #
    # The default Inc procedure only calls Inc_Inbox.
    # The following configuration does an Flist call that
    # hunts around for new messages in all folders, which
    # is useful if an external agent is delivering mail to
    # some folders (like newsgroups)
    #
    Inc_Inbox
    Flist_FindUnseen
}

proc User_Bindings { w } {
    #
    # This is called from Bindings_Main to bind acceleration keystrokes
    # to the message display and folder table-of-contents windows
    # w is a text widget
}