#!/usr/local/bin/wish -f

# this is the main tcl script.

wm title . "tkmr"

# global variables

set header_type "h"
set sort_type "s"
set search_type 0
set search_types "C c"
set fname "mbox"
set sstring ""
set cust_string "shabdSfD"
set files 0
set print_msg "P"

# frames for various sections of the window

frame .buttons -border 2
frame .list -border 2
frame .message -border 2
frame .search -border 2

# now create the row of buttons

# eek
button .buttons.display -text "Display" -command { 
	send [ concat $print_msg [ lindex [.list.hdrlist get \
	[lindex [ .list.hdrlist curselection ] 0 ] ] 0 ] ]
}

button .message.label -text "First load a mail file" -command "make_msglist" \
  -relief sunken
pack .message.label -fill x -expand yes

button .buttons.exit -text "Exit" -command { send "q"
						exit }

button .buttons.load -text "Load (add)" -command { loadit $fname }
button .buttons.loadnew -text "Load anew" -command { loadnew $fname }

button .buttons.files -text "Files" -command { \
	make_mboxlist }  -relief raised

button .buttons.help -text "Help" -command { make_helpwin } -relief raised

menubutton .buttons.headers -text "Headers" -menu .buttons.headers.menu \
	-relief raised
menu .buttons.headers.menu
	.buttons.headers.menu add radiobutton -label "Normal" \
	  -variable header_type -value "h" -command "headers h"
	.buttons.headers.menu add radiobutton -label "With filename" \
	  -variable header_type -value "hf" -command "headers hf"
	.buttons.headers.menu add radiobutton -label "With hits" \
	  -variable header_type -value "hh" -command "headers hh"
# note: there is an "entryconfigure" on this later, be careful if you rearrange
# this menu!
	.buttons.headers.menu add radiobutton -label "Custom" \
	  -variable header_type -value [ concat "H" $cust_string ] \
	  -command do_custom_string
	.buttons.headers.menu add separator
	.buttons.headers.menu add checkbutton -label "Nonzero hits only" \
	  -variable nonzero_hits -command { send "z" ; headers $header_type } 
label .buttons.fn -text "Mail file:"
entry .buttons.efn -relief sunken -width 30 -textvariable fname

label .search.label -text "Search string:"
entry .search.entry -relief sunken  -textvariable sstring
button .search.button -text "Search" -command { dosearch $sstring }
checkbutton .search.case -text "Case sensitive" -variable search_type \
	-command { send [lindex $search_types $search_type ] }

bind .search.entry <Return> { dosearch $sstring }
bind .buttons.efn <Return> { loadit $fname }


menubutton .buttons.sort -text "Sort" -menu .buttons.sort.menu \
	-relief raised
menu .buttons.sort.menu
	.buttons.sort.menu add radiobutton -label "Original" \
	  -variable sort_type -value "s"  -command "dosort s" 
	.buttons.sort.menu add radiobutton -label "Time and Date" \
	  -variable sort_type -value "sd" -command "dosort sd"
	.buttons.sort.menu add radiobutton -label "Sender" \
	  -variable sort_type -value "sa" -command "dosort sa"
	.buttons.sort.menu add radiobutton -label "Subject" \
	  -variable sort_type -value "ss" -command "dosort ss"
	.buttons.sort.menu add radiobutton -label "Hits" \
	  -variable sort_type -value "sh" -command "dosort sh"

scrollbar .list.scroll -relief sunken -command ".list.hdrlist yview"
scrollbar .list.xscroll -relief sunken -orient horizontal \
	-command ".list.hdrlist xview"
listbox .list.hdrlist -geometry 90x12 -yscroll ".list.scroll set" \
	-xscroll ".list.xscroll set" -exportselection false \
	-font 7x14 -relief sunken -setgrid 1
pack .list.scroll -side right -fill y
pack .list.xscroll -side bottom -fill x
pack .list.hdrlist -side left -expand yes -fill both
bind .list.hdrlist <Double-Button-1> {
	send [ concat $print_msg [ lindex [.list.hdrlist get  \
	[lindex [ .list.hdrlist curselection ] 0 ] ] 0 ] ]
}

set hdrlist_binding [ bind .list.hdrlist <Button-1> ]

toplevel .msglist
wm title .msglist "Notice history"
scrollbar .msglist.ys -relief sunken -command ".msglist.l yview"
scrollbar .msglist.xs -relief sunken -command ".msglist.l xview" -orient horizontal
listbox .msglist.l -geometry 50x6 -yscroll ".msglist.ys set" \
	-xscroll ".msglist.xs set" -relief sunken -setgrid 1
#button .msglist.b -text "Dismiss" -command "destroy .msglist"
button .msglist.b -text "Dismiss" -command "wm withdraw .msglist"
label .msglist.t -text "Past notices:"
pack .msglist.t -side top
pack .msglist.b -side bottom 
pack .msglist.ys -side right -fill y
pack .msglist.xs -side bottom -fill x
pack .msglist.l -side left -expand yes -fill both
wm withdraw .msglist

pack .buttons.exit .buttons.display .buttons.headers .buttons.sort \
	.buttons.load .buttons.fn .buttons.efn .buttons.loadnew \
        .buttons.files -side left
pack .buttons.help -side right
pack .buttons -side top
pack .search.label .search.entry .search.button .search.case -side left
pack .buttons .message -fill x
pack .list -expand yes -fill both
pack .search -fill x

# fill in c1 - c8 from $cust_string 
proc parse_cust {} {
	global cust_string c1 c2 c3 c4 c5 c6 c7 c8 
	scan $cust_string "%1s%1s%1s%1s%1s%1s%1s%1s" c1 c2 c3 c4 c5 c6 c7 c8 
}

proc makebusy val {
#	catch {destroy .busy }
	toplevel .busy -class Dialog
	wm title .busy "Message"

	frame .busy.frame -border 10
	message .busy.frame.msg -justify center -text $val -width 400

	pack .busy.frame.msg -expand yes
	pack .busy.frame

	grab .busy

}

# destroy busy window

proc makeunbusy {} {
	catch {destroy .busy}
	return	

}


proc loadit fname {
	global header_type
	global files
	puts stderr "making busy"
	makebusy "Loading..."
	set fnamelist ""
	set x [ split $fname ]
	foreach y $x {
		set fnamelist [ glob -nocomplain $y ]
		foreach name $fnamelist {	
			if { $name != "" } {
				send "a $name"
#				.buttons.files.menu add command -label $name
				incr files		
			}
		}
	}
	if { $files > 0 } { 
		send $header_type 
		.buttons.sort configure -state normal
		.search.button configure -state normal
		.search.entry configure -state normal
		.buttons.display configure -state normal 
# oops couldn't load any files
	} else { 
	  makeunbusy
#	    .message.label configure -text "Couldn't load any files" \
#	      -foreground red
	send_message "Couldn't load any files" "red"	
	} 
}

proc loadnew fname {
	global header_type
	if { [ llength [glob $fname ]] == 1 } {
		makebusy "Loading..."
		send "l $fname"
		send $header_type
	} else {
#	.message.label configure \
#	-text "Specify single file only for 'Load anew' function" \
#	-foreground black
	send_message "Specify single file only for 'Load anew' function" black
}
}


proc headers val {
	global files
	if { $files > 0 } {send $val }
}

proc print val {
	puts stderr $val
	flush stderr
}
proc send val {
	puts stdout $val
	flush stdout
}

proc dosort val {
	global header_type
	send $val
	send $header_type
}

proc dosearch val {
	global header_type
	global sort_type
	set a "/"
	send $a$val 
	set sort_type "sh"
	dosort "sh"
}

# set up tags for highlighting 


# The utility procedure below searches for all instances of a
# given string in a text widget and applies a given tag to each
# instance found.
# Arguments:
#
# w -		The window in which to search.  Must be a text widget.
# string -	The string to search for.  The search is done using
#		exact matching only;  no special characters.
# tag -		Tag to apply to each instance of a matching string.

proc TextSearch {w string tag} {
    if {[tk colormodel $w] == "color"} {
#	TextToggle "$w tag configure search -background \
#		SeaGreen4 -foreground white" 800 "$w tag configure \
#		search -background {} -foreground {}" 200
	$w tag configure search -background SeaGreen4 -foreground white
    } else {
#	TextToggle "$w tag configure search -background \
#		black -foreground white" 800 "$w tag configure \
#		search -background {} -foreground {}" 200
      $w tag configure search -background black -foreground white
      
    }


    $w tag remove search 0.0 end
    scan [$w index end] %d numLines
    set l [string length $string]
    for {set i 1} {$i <= $numLines} {incr i} {
	if {[string first $string [$w get $i.0 $i.1000]] == -1} {
	    continue
	}
	set line [$w get $i.0 $i.1000]
	set offset 0
	while 1 {
	    set index [string first $string $line]
	    if {$index < 0} {
		break
	    }
	    incr offset $index
	    $w tag add $tag $i.[expr $offset] $i.[expr $offset+$l]
	    incr offset $l
	    set line [string range $line [expr $index+$l] 1000]
	}
    }
}

# The procedure below is invoked repeatedly to invoke two commands
# at periodic intervals.  It normally reschedules itself after each
# execution but if an error occurs (e.g. because the window was
# deleted) then it doesn't reschedule itself.
# Arguments:
#
# cmd1 -	Command to execute when procedure is called.
# sleep1 -	Ms to sleep after executing cmd1 before executing cmd2.
# cmd2 -	Command to execute in the *next* invocation of this
#		procedure.
# sleep2 -	Ms to sleep after executing cmd2 before executing cmd1 again.

proc TextToggle {cmd1 sleep1 cmd2 sleep2} {
    catch {
	eval $cmd1
	after $sleep1 [list TextToggle $cmd2 $sleep2 $cmd1 $sleep1]
    }
}

# pop up a window which grabs input focus while busy

proc do_custom_string {} {
	global cust_string
 	custom_string
	return [ concat "H" $cust_string ]
}

proc custom_string {} {
	global cust_string
	global c1 c2 c3 c4 c5 c6 c7 c8

	toplevel .custom -class Dialog
	wm title .custom "Custom Header Setup"
	
	frame .custom.c
	frame .custom.bs

#		set cust_string ${c1}${c2}${c3}${c4}${c5}${c6}${c7}${c8}

	set i 8
	set names "Blank Date(num) file Subject bytes date address hits sequence"
	set letters "x D f S b d a h s"

	label .custom.l -text "Select an item to display in each position.\n\
		You may select an item twice if you wish."
	while {  [ expr { $i > 0} ] } {
		set x .custom.c.column$i
		frame $x

		for { set j 0 } { $j < 9 } { incr j 1 } {
		  radiobutton .custom.c.column${i}.butt${j}  \
			-variable c$i -value [lindex $letters $j ] \
			-text [ lindex $names $j ] -width 9 \
			-relief flat -anchor w
		  pack .custom.c.column${i}.butt${j} -side bottom
		  if { $i == 1 } { 
			.custom.c.column${i}.butt${j} configure \
				-state disabled
		  }
		}
		pack .custom.c.column${i} -side right
		incr i -1
	}	
	button .custom.bs.b -text "Check" -command {
		set cust_string ${c1}${c2}${c3}${c4}${c5}${c6}${c7}${c8}
		.custom.bs.finally configure -text \
		[concat "set cust_string" $cust_string ]
	}

	button .custom.bs.accept -text "Accept" -command {
	set cust_string ${c1}${c2}${c3}${c4}${c5}${c6}${c7}${c8}
	set header_type [ concat "H" $cust_string ]
	.buttons.headers.menu entryconfigure 3 -value [ concat "H" $cust_string ]

	headers $header_type
		destroy .custom
	}
	button .custom.bs.cancel -text "Cancel" -command {
		destroy .custom
	}

	label .custom.bs.finally -foreground darkgreen \
	   -text [concat "set cust_string" ${c1}${c2}${c3}${c4}${c5}${c6}${c7}${c8}  ]
	pack .custom.bs.b .custom.bs.accept .custom.bs.cancel  -side left
	pack .custom.bs.finally 	-side right

	pack .custom.l .custom.c .custom.bs -side top
}

proc make_mboxlist {}  {
if { ! [winfo exists .mboxlist ] } {
toplevel .mboxlist
scrollbar .mboxlist.ys -relief sunken -command ".mboxlist.l yview"
scrollbar .mboxlist.xs -relief sunken -command ".mboxlist.l xview" -orient horizontal
listbox .mboxlist.l -geometry 16x4 -yscroll ".mboxlist.ys set" \
	-xscroll ".mboxlist.xs set" -relief sunken -setgrid 1
#button .mboxlist.b -text "Dismiss" -command "destroy .mboxlist"
button .mboxlist.b -text "Dismiss" -command "wm withdraw .mboxlist"
label .mboxlist.t -text "Loaded mail files:"
pack .mboxlist.t -side top
pack .mboxlist.b -side bottom 
pack .mboxlist.ys -side right -fill y
pack .mboxlist.xs -side bottom -fill x
pack .mboxlist.l -side left -expand yes -fill both
} else { .mboxlist.l delete 0 [.mboxlist.l size ]; wm deiconify .mboxlist }
send "f"
}

proc make_msglist {}  {
if { ! [winfo exists .msglist ] } {
} else { wm deiconify .msglist }
}

proc send_message { msg color } {
	.message.label configure -text $msg -foreground $color
#	make_msglist
	.msglist.l insert [.msglist.l size] $msg 
	  if { [.msglist.l size] > 100 } { .msglist.l delete 0 }
#	.msglist.l -foreground $color
}

proc make_artwin val {
global print_msg
global hdrlist_binding
#catch { destroy .textwin }
if { ! [winfo exists .textwin ] } {
toplevel .textwin
frame .textwin.b
frame .textwin.b2
button .textwin.b.ok -text Dismiss -command "\
	bind .list.hdrlist <Button-1> \$hdrlist_binding; destroy .textwin"
button .textwin.b.prev -text Prev -command "prev"
button .textwin.b.next -text Next -command "next"
button .textwin.b2.toggle -text "Toggle full/brief headers" -command \
	"toggle_fullhdr ;\
	 reget -1"
button .textwin.b2.highlight -text "Highlight search string" -command \
 "TextSearch .textwin.t \$sstring search"
text .textwin.t -relief raised -bd 2 -yscrollcommand ".textwin.s set" \
 -setgrid true
scrollbar .textwin.s -relief flat -command ".textwin.t yview"
pack .textwin.b.prev -side left
pack .textwin.b.next -side right -fill x
pack .textwin.b.ok -side left -ipadx 40 -expand 1 -fill x
pack .textwin.b2.highlight  .textwin.b2.toggle -side left  -expand 1 -fill x
pack .textwin.b .textwin.b2  -side bottom -fill x
pack .textwin.s -side right -fill y
pack .textwin.t -expand yes -fill both

bind .list.hdrlist <Button-1> { 
	.list.hdrlist select clear
	.list.hdrlist select from [ .list.hdrlist nearest %y ] 
	send [ concat $print_msg [.list.hdrlist get \
	[lindex [ .list.hdrlist curselection ] 0 ] ] ] 
}

} else {
.textwin.t delete 0.0 end
}
wm title .textwin "Message $val"
}

proc prev {} {
	set a [lindex [ .list.hdrlist curselection ] 0]
#	set a [ lindex [ wm title .textwin ] 1 ] 
	if { $a == 0 } return

	incr a -1
	.list.hdrlist select clear
	.list.hdrlist select from $a
#	.list.hdrlist select to $a

	reget $a
}

proc toggle_fullhdr {} {
	global print_msg
	if { $print_msg == "p" } { set print_msg "P" } else { set print_msg "p" }
}



proc reget a {
	global print_msg
	if { $a == -1 }  { set a [ lindex [ wm title .textwin ] 1 ] } else {
	set a [ lindex [.list.hdrlist get $a ] 0 ]  
}

	send [concat $print_msg $a ] 

# ok here if no curselection we should highlight the selection

#	.list.hdrlist select clear
#	.list.hdrlist select from $a
#	.list.hdrlist select to $a
}

proc next {} {
# this would be a problem if the selection got lost but
# it doesn't seem to do that anymore.
	set a [lindex [ .list.hdrlist curselection ] 0 ]

#	set a [ lindex [ wm title .textwin ] 1 ] 

	if { $a == [.list.hdrlist size] } return

	incr a 1

	.list.hdrlist select clear
	.list.hdrlist select from $a

#	.list.hdrlist select to $a
	reget $a
}


# ok now everything is parsed... now we set up

.buttons.display configure -state disabled
.search.button configure -state disabled
.search.entry configure -state disabled
.buttons.sort configure -state disabled
tk_listboxSingleSelect .list.hdrlist

if [ file exists "$env(HOME)/.tkmrrc" ] {
	source $env(HOME)/.tkmrrc
}

parse_cust

proc make_helpwin {} {
if { ! [ winfo exists .helpwin ] } {
toplevel .helpwin
wm title .helpwin "tkmr help"
text .helpwin.t -relief raised -bd 2 -yscrollcommand ".helpwin.s set" \
  -setgrid true
scrollbar .helpwin.s -relief flat -command ".helpwin.t yview"
button .helpwin.b -text Ok -command "destroy .helpwin"
pack .helpwin.s -side right -fill y
pack .helpwin.t -expand yes -fill both
pack .helpwin.b -fill x
.helpwin.t insert 1.0 {General Note:

When the mouse pointer is over something you can click on, the something
will generally turn colors to indicate that. 

When tkmr first starts, the main window will be displayed.
If you specified any filenames on the command line, they will be
loaded and their names listed in the "Mail file" text entry area.
If you load any files in your .tkmrrc file, they will also be loaded.

If you did not specify any filenames, the "Mail file" text entry area
will suggest a default filename. Enter a mail file or a list of
filenames as you would specify them to the shell -- wildcards are
allowed, and multiple filenames can be separated by spaces.  You can
be rather liberal in the files you specify; non-mail files will be
ignored (I like to load "Mail/* News/*").  You can keep typing
filenames and adding them as long as you wish.  The number is limited
mostly by the amount of memory and your shell's open file limit (see
"limit" for csh users and "ulimit" for sh users, and set it before
you fire up tkmr).

There is no check for duplication. You can load a single mailfile
more than once, so be careful.

The "Load anew" button removes all mail files from memory and starts
over with the new file specified. You can only specify one filename
for this funcion. 

The "Files" button pops up a scrolling list of the loaded files.

Below the buttons is a message area. This is also a large button.
If you click on it you will get a scrolling list containing the
last 100 notices displayed.

DISPLAYING MESSAGES

Once one or more mail files are loaded, their headers will be listed
in a scrolling list in a default format (more on choosing header
formats later). To display a message, select it in the list and click
on the "Display" button, or double-click on its header.

A new window is created to display the article text. This may be
resized and scrolled as desired, but keep in mind if you dismiss it,
displaying another article will return it to its default geometry.

When a message is already being displayed, single-clicking in the
header list will display a new message.

Bordering the Dismiss button in the article window are Prev and Next,
with the obvious functions.

Above them is a "Highlight search string" window. If a search has
been performed, this will highlight instances of the search string.
Note: although searches can be case insensitive, the highlighting is
case sensitive. If you search for "this", "This" will not be highlighted.
Sorry -- I got that code from the Tk examples.

One other button toggles between the full headers in the message,
or just selected (hopefully useful) headers.

SORTING HEADERS

The headers can be sorted in a few ways: by sequence number (the
sequence number represents the original message order and is always
the leftmost column in the header list), by subject, by time and date,
or by sender. You can also sort in order of the number of matches
found in the previous search ("hits"), from most to least.

To sort, choose an option from the "Sort" menu.

SEARCHING

To search messages (including headers) for a string, enter the string
in the box at the bottom of the main window, set case sensitivity
appropriately by clicking on the "Case sensitive" button if necessary,
and hit Return or click on Search.

Only simple searches are provided (no "OR" or "AND" functionality).
You can search for strings with spaces in them ("x terminals" for example).
Searches don't have to match full words.

After a search the headers are automatically displayed in "hits"
order.

CHOOSING HEADER COLUMNS

You can customize the header display in a variety of ways. 
The "Headers" menu contains three simple choices: Normal (lists
message number, sender, date, and subject), "With filename"
(adds the filename of each message in column 2), or "With hits"
(lists the hits from the previous search in column 2). These are
the most common ways I like to display the headers.

The "Headers" menu also contains an option to display only messages
which contained any hits in the last search. This is convenient
when there are a lot of messages. This option toggles on and off.

The menu also contains a powerful "Custom" entry. Choosing this
will create a window with one column for each possible column in
the header list, and a row for each item that can be displayed.
Simply select the information you want in the order you want it.
The first column is the message ("sequence") number and cannot be changed.
If you want less than eight items displayed, select "Blank" for the
extra columns ("Blank" does not leave any blank space, but is just
used as a placeholder in this screen).

After you have selected your headers, you can click on "Accept"
or "Cancel" with the obvious effect. You can also click on "Check"
which will update the "set cust_string" command in green at the bottom
of that window -- this is the command you can put in your .tkmrrc
file to permanently set a custom header arrangement (see section on
.tkmrrc files).

EXCLUDING HEADER LINES

If you see a "Delete" button, you can use it to delete messages from
the header list. 

NOTE: tkmr never writes to your mail files. "Delete" only removes the
header from the list; it does not really delete the message.

This functionality is of limited usefulness so it may not always
be available.

You can also exclude header lines with 0 hits using the "Nonzero hits only"
option in the "Headers" menu.

THE .tkmrrc FILE

If you have a file called .tkmrrc in your home directory, tkmr will
"source" it after its initial setup. Thus it should contain valid
tcl commands. While it could theoretically do just about anything, 
its main uses are setting custom options. The format of the command
to do so is:

set optionname value

The useful options are:

header_type	set to one of the following: "h" (normal), "hf"
		(include filename), "hh" (include hits)
sstring		set to default search string
sort_type	set to: "s" (message order), "sd" (time and date),
		"sa" (sender's address), "ss" (subject), "sh" (hits)
custom_string	set as shown in custom header dialog box.
print_msg	set to: "p" (full headers), "P" (brief headers)
		(mail headers shown in message display window)

Use of any other options is at your own risk (because an error in
your .tkmrrc file can cause tkmr not to operate properly).

You can specify that a default set of mailfiles be loaded by
including the command

loadit "files"

where "files" is a space-separated list of filenames (quotes
mandatory). You can use normal shell wildcards in it, but no shell
variables ($HOME, etc.). 
}
}
}
