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

set ka(0)		{}
set nka			0
set fields		{}
set nfields		0
set kamod		0
set curcard		-1
set curfilename		{}
set fparam		{}
set printsettings()	0

set defaults(print)	{lp}
set defaults(preview)	{ghostview -}
set defaults(multilp)	{/users/pda/Wish/multilp -s}
set defaults(fparam)	{print yes style normal printifempty no title {}}
set defaults(printset)	{110 4 portrait Helvetica-Narrow}
set defaults(fonts)	{Helvetica-Narrow Times-Roman Helvetica Courier}
set defaults(file)	noname.adrs

set bitmap(exclam)	/usr/local/X11R5/include/X11/bitmaps/Excl

#
# Format of the ka file :
# - string "ka-v1"			(first version of this format)
# - name of the fields			(separator = "|")
# - printer settings
# - print characteristics of the first field
# - print characteristics of the second field
# - ...
# - print characteristics of the last field
# - first field of first card
# - ...
# - last field of first card
# - first field of second card
# - ...
# - last field of last card
#

#
# Format of the printer settings
#   <int:lines> <int:cols> <string:lansdcape> <string:font>
#
# Format of a print characteristic for a field
#  print <yes|no> style <bold|normal|italic> printifempty <yes|no> title <list>
#

##############################################################################
# Name : readka
# Purpose : read the current ka
# Input :
#   - file : file to read
# Output : -
# History :
#   92/09/13 : pda@masi.ibp.fr : creation
#   92/09/27 : pda@masi.ibp.fr : added file header
##############################################################################

proc readka {file} {
    global ka nka kamod
    global fields nfields
    global fparam
    global printsettings
    global defaults

    catch {unset ka}

    .bottom.list.lb delete 0 end

    set c 0
    if {[file exists $file]} then {
	set fd [open $file "r"]

	#
	# Read file version header
	#

	if {[gets $fd line] == -1} then {
	    toperror "Cannot read $file." 0
	    catch {close $fd}
	    return
	}
	if {[string compare $line ka-v1] != 0} then {
	    toperror "$file is not a ka file." 0
	    catch {close $fd}
	    return
	}

	#
	# Read field names
	#

	if {[gets $fd line] == -1} then {
	    toperror "Cannot read $file." 0
	    catch {close $fd}
	    return
	}
	set fields [split $line "|"]
	set nfields [llength $fields]
	if {$nfields == 0 || $nfields > 100} then {
	    toperror "Invalid number of fields ($nfields)" 0
	    catch {close $fd}
	    return
	}

	#
	# Read printer settings
	#

	if {[gets $fd line] == -1} then {
	    toperror "Cannot read $file." 0
	    catch {close $fd}
	    return
	}
	set printsettings(lines)	[lindex $line 0]
	set printsettings(cols)		[lindex $line 1]
	set printsettings(landscape)	[lindex $line 2]
	set printsettings(font)		[lindex $line 3]

	#
	# Read field print characteristics
	#

	set fparam {}
	for {set i 0} {$i < $nfields} {incr i} {
	    if {[gets $fd line] == -1} then {
		toperror "Cannot read $file." 0
		catch {close $fd}
		return
	    }
	    lappend fparam $line
	}

	#
	# Read the ka
	#

	while {[gets $fd line] > -1} {
	    set nom $line
	    set s [list $line]
	    for {set i 1} {$i < $nfields} {incr i} {
		gets $fd line
		lappend s $line
	    }
	    set ka($c) $s
	    incr c
	}
	close $fd
    } else {
	set fields {Name}
	set nfields [llength $fields]
	set fparam [list $defaults(fparam)]
	defaultprintersettings
    }

    set nka $c

    set kamod 0
    setstatus
}

##############################################################################
# Name : writeka
# Purpose : write the current ka
# Input :
#   - file : file to write
# Output : -
# History :
#   92/09/22 : pda@masi.ibp.fr : creation
#   92/09/27 : pda@masi.ibp.fr : added file header
##############################################################################

proc writeka {file} {
    global ka nka kamod
    global fields nfields
    global fparam
    global printsettings

    set fd [open $file "w"]

    #
    # file signature
    #

    puts $fd ka-v1

    #
    # Field names
    #

    set s [lindex $fields 0]
    for {set j 1} {$j < $nfields} {incr j} {
	append s "|[lindex $fields $j]"
    }
    puts $fd $s

    #
    # Printer settings
    #

    set s $printsettings(lines)
    append s " $printsettings(cols)"
    append s " $printsettings(landscape)"
    append s " $printsettings(font)"
    puts $fd $s

    #
    # Fields print parameters
    #

    for {set j 0} {$j < $nfields} {incr j} {
	puts $fd [lindex $fparam $j]
    }

    #
    # The ka itself
    #

    for {set i 0} {$i < $nka} {incr i} {
	set l $ka($i)
	for {set j 0} {$j < $nfields} {incr j} {
	    puts $fd [lindex $l $j]
	}
    }
    close $fd

    set kamod 0
    setstatus
}

##############################################################################
# Name : initfparam
# Purpose : split the fparam variable into 4 arrays
# Input : -
# Output : -
# History :
#   92/10/04 : pda@masi.ibp.fr : creation
##############################################################################

set fparamprint(0)	{}
set fparamstyle(0)	{}
set fparamempty(0)	{}
set fparamtitle(0)	{}

proc splitfparam {} {
    global nfields
    global fparam
    global fparamprint fparamstyle fparamempty fparamtitle
    global defaults

    for {set i 0} {$i < $nfields} {incr i} {
	set s $defaults(fparam)
	append s " [lindex $fparam $i]"
	while {[llength $s] > 0} {
	    case [lindex $s 0] in {
		print		{ set fparamprint($i)	[lindex $s 1] }
		style		{ set fparamstyle($i)	[lindex $s 1] }
		printifempty	{ set fparamempty($i)	[lindex $s 1] }
		title		{ set fparamtitle($i)	[lindex $s 1] }
		* { puts stderr "unknown print parameter : '[lindex $s 0]'" }
	    }
	    set s [lreplace $s 0 1]
	}
    }
}

##############################################################################
# Name : mergefparam
# Purpose : merge the 4 arrays into the fparam variable
# Input : -
# Output : -
# History :
#   92/10/04 : pda@masi.ibp.fr : creation
##############################################################################

proc mergefparam {} {
    global kamod
    global nfields
    global fparam
    global fparamprint fparamstyle fparamempty fparamtitle

    set fparam {}
    for {set i 0} {$i < $nfields} {incr i} {
	set l {}

	append l "print         $fparamprint($i) "
	append l "style         $fparamstyle($i) "
	append l "printifempty  $fparamempty($i) "
	append l "title         {$fparamtitle($i)}"

	lappend fparam $l
    }

    set kamod 1
    setstatus
}

##############################################################################
# Name : insertka
# Purpose : insert a card into the ka
# Input :
#   - card : the list of fields
# Output : -
# History :
#   92/09/21 : pda@masi.ibp.fr : creation
##############################################################################

proc insertka {card} {
    global ka nka kamod

    set name  [string tolower [lindex $card 0]]

    for {set i $nka} {$i > 0} {incr i -1} {
	set j [expr "$i - 1"]
	
	set k [string tolower [lindex $ka($j) 0]]
	set r [string compare $name $k]
	if {$r == 0 || $r == 1} then {
	    break
	}
	set ka($i) $ka($j)
    }
    set ka($i) $card
    set nka [expr "$nka + 1"]
    set kamod 1
    setstatus

    .bottom.list.lb insert $i [lindex $card 0]
    .bottom.list.lb yview $i
    .bottom.list.lb xview 0
    selectname .bottom.list.lb $i .bottom.card
}

##############################################################################
# Name : dispka
# Purpose : display the current ka
# Input : -
# Output : -
# History :
#   92/09/27 : pda@masi.ibp.fr : creation
##############################################################################

proc dispka {} {
    global ka nka

    catch {destroy .bottom.card}
    createcard .bottom.card 0
    .bottom.list.lb delete 0 end
    for {set i 0} {$i < $nka} {incr i} {
	.bottom.list.lb insert end [lindex $ka($i) 0]
    }
    pack before .bottom.list \
	.bottom.card {left expand fill}
    dispcard -1 .bottom.card 0
}

##############################################################################
# Name : modok
# Purpose : if the ka is modified, asks for confirmation
# Input :
#   - op : name of the operation
# Output :
#   - 1 if operation ok (ka not modified, or user aknowledged), 0 if not
# History :
#   92/10/04 : pda@masi.ibp.fr : creation
##############################################################################

proc modok {op} {
    global kamod

    if {$kamod == 1} then {
	set ok [toperror "Some cards have been modified.\n$op anyway ?" 1]
    } else {
	set ok 1
    }
    return $ok
}

##############################################################################
# Name : quit
# Purpose : quit this application
# Event : from the "quit" button in the main window
# Input : -
# Output : -
# History :
#   92/09/13 : pda@masi.ibp.fr : creation
#   92/09/20 : pda@masi.ibp.fr : completion
#   92/10/04 : pda@masi.ibp.fr : used modok procedure
##############################################################################

proc quit {} {
    if {[modok "Quit"]} then {
	destroy .
    }
}

##############################################################################
# Name : entrymovecursor
# Purpose : move the cursor in an entry widget, in response to an cursor move
# Event : key-left or key-right in an entry
# Input :
#   - w : name of the entry widget
#   - inc : direction to move to (-1or 1)
# Output : -
# History :
#   92/10/04 : pda@masi.ibp.fr : creation
#   93/05/08 : pda@masi.ibp.fr : adaptation to tk 3
##############################################################################

proc entrymovecursor {w inc} {
    set x [expr "[$w index insert] + $inc"]
    if {$x == -1} then {set x 0}
    if {$x >= [$w index end]} then {set x end}
    $w icursor $x
}

##############################################################################
# Name : labent
# Purpose : create a frame with a label and an entry widgets
# Input :
#   - w : name of the frame to create
#   - txt : text to display in the label
#   - lw : width of the label widget
#   - ew : width of the entry widget
# Output : -
# History :
#   92/09/20 : pda@masi.ibp.fr, jt@ratp.fr : creation
##############################################################################

proc labent {w txt lw ew} {
    frame $w
    label $w.lbl -width $lw -text $txt -anchor e
    entry $w.ent -width $ew -relief sunken
    pack append $w \
	$w.lbl {left expand fill} \
	$w.ent {left expand fill}
}

##############################################################################
# Name : listscroll
# Purpose : create a frame with a listbox and a scrollbar
# Input :
#   - w : name of the frame to create
# Output : -
# History :
#   92/09/26 : pda@masi.ibp.fr : creation
##############################################################################

proc listscroll {w} {
    frame $w
    scrollbar $w.sb -command "$w.lb yview"
    listbox $w.lb -relief sunken -yscrollcommand "$w.sb set"
    pack append $w \
	$w.lb {left expand fill} \
	$w.sb {left filly}
}


##############################################################################
# Name : topwidget
# Purpose : create top level frame with two buttons
# Input :
#   - w : name of the top-level to create
#   - name : name of the top-level
#   - geom : position of the top-level
#   - acceptproc : procedure to call when the accept button is pressed
# Output : -
# History :
#   92/10/04 : pda@masi.ibp.fr : creation
##############################################################################

proc topwidget {w name geom acceptproc} {
    catch {destroy $w}

    toplevel $w
    wm title	$w $name
    wm iconname	$w [string tolower $name]
    wm minsize	$w 10 10
    wm geometry $w $geom

    frame  $w.buttons
    button $w.buttons.accept -text "Accept" -width 8 -command "$acceptproc"
    button $w.buttons.cancel -text "Cancel" -width 8 -command "destroy $w"
    pack append $w.buttons \
	$w.buttons.accept	{left expand fill} \
	$w.buttons.cancel	{left expand fill}

    pack append $w \
	$w.buttons		{top fillx}
}


##############################################################################
# Name : termop
# Purpose : verify that no specified current operations are on the way
# Input :
#   - op : a list of {<window> <operation-name>}
# Output :
#   - 1 if all went ok, 0 if an operation was not closed
# Note : this function grabs the mouse
# History :
#   92/09/26 : pda@masi.ibp.fr : creation
##############################################################################

proc termop {op} {
    foreach i $op {
	set win [lindex $i 0]
	set name [lindex $i 1]

	set status [catch "pack info $win"]
	if {$status == 0} then {
	    toperror "Close the current $name opeation first." 0
	    return 0
	}
    }
    return 1
}

##############################################################################
# Name : toperror
# Purpose : create a top level widget, display a message and waits for
#   one of the buttons to be pressed
# Input :
#   - msg : text to display
#   - cancel : 1 if a "cancel" button must be created
# Output :
#   - 0 if the "ok" button has been pressed, 1 if "cancel"
# Note : this function grabs the mouse
# History :
#   92/09/20 : pda@masi.ibp.fr, jt@ratp.fr : creation
#   92/09/21 : pda@masi.ibp.fr : added exclamation bitmap
##############################################################################

proc toperror {msg cancel} {
    global ok
    global bitmap

    #
    # Creation of the top level widget
    #

    catch {destroy .err}
    toplevel    .err
    wm title    .err "Message Dialog"
    wm iconname .err "message dialog"
    wm minsize  .err 10 10
    wm geometry .err 300x150+200+200

    #
    # Creation of the button(s)
    #

    frame .err.b
    button .err.b.ok -text "Ok" -width 8 -command {setOk 1}
    pack append .err.b \
	.err.b.ok {left expand fillx}
    if {$cancel == 1} then {
	button .err.b.cancel -text "Cancel" -width 8 -command {setOk 0}
	pack append .err.b \
	    .err.b.cancel {left expand fillx}
    }

    message .err.m -text $msg -aspect 1000 -justify center
    label   .err.l -bitmap @$bitmap(exclam)

    pack append .err \
	.err.m	{top expand fill} \
	.err.l  {top expand fill} \
	.err.b	{top fillx}
    
    #
    # Grab the mouse and wait for input
    #

    set wf [focus]
    focus .err.b
    bind .err.b <Key-Return> {setOk 1}

    grab .err
    tkwait window .err

    if {[string compare $wf none] != 0} then {focus $wf}
    return $ok
}

proc setOk {val} {
    global ok
    set ok $val
    destroy .err
}

##############################################################################
# Name : bindentarray
# Purpose : bind keys in an array of entry widgets
# Input :
#   - w : name of the existing frame containing $w.f$max.ent entry widgets
#   - max : number of entry widgets (0 ... $max-1)
#   - accept : name of procedure to call when accepting the last entry
# Output : -
# History :
#   92/09/26 : pda@masi.ibp.fr : creation
##############################################################################

proc bindentarray {w max accept} {
    for {set i 0} {$i < $max} {incr i} {
	set j [expr "$i + 1"]
	set k [expr "$i - 1"]
	if {$j == $max} then {set j 0}
	if {$k == -1} then {set k [expr "$max - 1"]}
	bind $w.f$i.ent <Key-Return>    "focus $w.f$j.ent"
	bind $w.f$i.ent <Key-Tab>       "focus $w.f$j.ent"
	bind $w.f$i.ent <Key-Up>        "focus $w.f$k.ent"
	bind $w.f$i.ent <Key-Down>      "focus $w.f$j.ent"
    }
    focus $w.f0.ent
    set j [expr "$max - 1"]
    bind $w.f$j.ent <Key-Return> $accept
}

##############################################################################
# Name : srch
# Purpose : create a top level widget for name input
# Input :
#   - wname : widget name
#   - label : string to display in label part
#   - fieldlist : list of fields to search for
# Output : -
# History :
#   92/10/04 : pda@masi.ibp.fr : creation
##############################################################################

proc srch {wname label fieldlist} {
    topwidget .search "$wname" +300+300 "searchcard {$fieldlist} 0"

    .search.buttons.accept configure -text "Search"
    button .search.buttons.next \
	-text "Next" -width 8 -command "searchnext {$fieldlist}"
    pack after .search.buttons.accept \
	.search.buttons.next	{left expand fillx} 

    labent .search.n "$label" 10 30

    pack append .search \
	.search.n {top expand fillx}

    #
    # The Return key is the same that the "search" button
    # (to search from the beginning)
    #

    bind .search.n.ent <Key-Return>	"searchcard {$fieldlist} 0"
    bind .search.n.ent <Control-n>	"searchnext {$fieldlist}"
    focus .search.n.ent
}

##############################################################################
# Name : searchnext
# Purpose : search for next occurrence of the name
# Event : from "next" button in the search window
# Input :
#   - selectedfields : list of all fields to search
# Output : -
# History :
#   92/09/20 : pda@masi.ibp.fr, jt@ratp.fr : creation
##############################################################################

proc searchnext {selectedfields} {
    global curcard

    if {$curcard == -1} then {
	set initial 0
    } else {
	#
	# On suppose (c'est normalement assure par le mecanisme
	# de selection unique "tk_listboxSingleSelect") qu'il
	# n'y a qu'une seule selection active dans la listbox.
	#
	set initial [expr "$curcard + 1"]
    }
    searchcard $selectedfields $initial
}

##############################################################################
# Name : searchcard
# Purpose : search for an occurrence of the name from an initial position
# Input :
#   - initial : index of the item from which the name is searched
# Output : -
# History :
#   92/09/20 : pda@masi.ibp.fr, jt@ratp.fr : creation
##############################################################################

proc searchcard {fieldlist initial} {
    global ka nka

    set orgname [.search.n.ent get]
    if {[string length $orgname] > 0} then {
	set name [string tolower $orgname]
	append name "*"

	set found 0
	for {set i $initial} {$i < $nka} {incr i} {
	    foreach j $fieldlist {
		set m [string tolower [lindex $ka($i) $j]]
		if {[string match $name $m]} then {
		    set found 1
		    break
		}
	    }
	    if {$found == 1} then { break }
	}

	if {$found == 1} then {
	    .bottom.list.lb yview $i
	    .bottom.list.lb xview 0
	    selectname .bottom.list.lb $i .bottom.card
	} else {
	    toperror "$orgname not found" 0
	}
    } else {
	destroy .search
    }
}

##############################################################################
# Name : srchname
# Purpose : create a top level widget for name input
# Event : from "search" menu in the main window
# Input : -
# Output : -
# History :
#   92/09/20 : pda@masi.ibp.fr, jt@ratp.fr : creation
#   92/10/04 : pda@masi.ibp.fr : used srch
##############################################################################

proc srchname {} {
    srch "Search First Field" "Name" {0}
}

##############################################################################
# Name : srchfield
# Purpose : create a top level widget for field selection, then a new one for
#   search in that field
# Event : from "search" menu in the main window
# Input : -
# Output : -
# History :
#   92/10/04 : pda@masi.ibp.fr : creation
##############################################################################

proc srchfield {} {
    global fields nfields

    if {[termop {{.field field}}] == 0} then {
	return
    }

    topwidget .field "Field Selection" +500+500 srchfaccept
    message .field.msg -text "Select the fields you want to search" -aspect 1000
    listscroll .field.list
    .field.list.lb configure -geometry 40x$nfields
    foreach i $fields {
	.field.list.lb insert end $i
    }

    pack append .field \
	.field.msg     {top expand fill} \
	.field.list    {top expand fill}
}

proc srchfaccept {} {
    set lf [.field.list.lb curselection]
    destroy .field
    if {[llength $lf] > 0} then {
	srch "Search Selected Field" "String" $lf
    }
}

##############################################################################
# Name : srchall
# Purpose : create a top level widget for search in all fields
# Event : from "search everywhere" menu in the main window
# Input : -
# Output : -
# History :
#   92/10/04 : pda@masi.ibp.fr : creation
##############################################################################

proc srchall {} {
    global nfields

    set lf {}
    for {set i 0} {$i < $nfields} {incr i} {
	lappend lf $i
    }
    srch "Search Everywhere" "String" $lf
}


##############################################################################
# newfield
#
# Purpose : add a new field at the end
# Event : from the "new field" menu entry in the main window
# Input : -
# Output : -
# History :
#   92/09/26 : pda@masi.ibp.fr : creation
##############################################################################

proc newfield {} {
    if {[termop {{.t edition} {.field field}}] == 0} then {
	return
    }

    topwidget .field "New Field" +500+500 newfaccept

    labent .field.name "Field name" 14 30
    focus .field.name.ent
    bind .field.name.ent <Key-Return> newfaccept

    pack append .field \
	.field.name    {top expand fill}
}

proc newfaccept {} {
    global ka nka kamod
    global fields nfields
    global fparam
    global defaults

    set fname [.field.name.ent get]
    if {[string length $fname] > 0} then {
	if {[string first "|" $fname] != -1} then {
	    toperror "No '|' character allowed in field names" 0
	} else {
	    for {set i 0} {$i < $nka} {incr i} {
		lappend ka($i) {}
	    }
	    lappend fields $fname
	    lappend fparam $defaults(fparam)
	    cardfield .bottom.card $fname $nfields 0
	    incr nfields
	    destroy .field
	}
    }
}

##############################################################################
# editfield
#
# Purpose : edit the field names and properties
# Input : -
# Output : -
# History :
#   92/09/26 : pda@masi.ibp.fr : specification
##############################################################################

proc editfield {} {
    global fields nfields

    if {[termop {{.t edition} {.field field}}] == 0} then {
	return
    }

    topwidget .field "Edit Field" +500+500 editfaccept

    frame  .field.f
    for {set i 0} {$i < $nfields} {incr i} {
	global print$i

	frame .field.f.f$i
	label .field.f.f$i.lbl \
	    -text "Field $i" \
	    -anchor w \
	    -width 10
	entry .field.f.f$i.ent \
	    -width 20 \
	    -relief sunken
	.field.f.f$i.ent insert 0 [lindex $fields $i]
	set print$i 1
	pack append .field.f.f$i \
	    .field.f.f$i.lbl {left} \
	    .field.f.f$i.ent {left expand fillx}
	pack append .field.f \
	    .field.f.f$i {top expand fill}
    }

    bindentarray .field.f $nfields editfaccept

    pack append .field \
	.field.f       {top expand fill} \
}

proc editfaccept {} {
    global kamod
    global fields nfields

    set new {}
    for {set i 0} {$i < $nfields} {incr i} {
	set f [.field.f.f$i.ent get]
	if {[string first "|" $f] != -1} then {
	    toperror "Invalid character ('|') in field name." 0
	    return
	}
	lappend new $f
    }

    set fields $new
    for {set i 0} {$i < $nfields} {incr i} {
	.bottom.card.f$i.lbl configure -text [lindex $fields $i]
    }

    destroy .field
    set kamod 1
    setstatus
}

##############################################################################
# removefield
#
# Purpose : remove a field
# Input : -
# Output : -
# History :
#   92/09/26 : pda@masi.ibp.fr : specification
##############################################################################

proc removefield {} {
    global fields nfields

    if {[termop {{.t edition} {.field field}}] == 0} then {
	return
    }

    topwidget .field "Remove Field" +500+500 remfaccept

    message .field.msg -text "Select the fields you want to remove" -aspect 1000
    listscroll .field.list
    .field.list.lb configure -geometry 40x[expr "$nfields - 1"]
    foreach i [lreplace $fields 0 0] {
	.field.list.lb insert end $i
    }

    pack append .field \
	.field.msg     {top expand fill} \
	.field.list    {top expand fill}
}

proc remfaccept {} {
    global ka nka kamod
    global fields nfields
    global curcard

    set sel [.field.list.lb curselection]
    set nsel [llength $sel]
    if {$nsel > 0 && $nsel < $nfields} then {
	#
	# Remove all fields in the ka
	#

	set elem {}
	for {set j [expr "$nsel - 1"]} {$j >= 0} {incr j -1} {
	    lappend elem [expr [lindex $sel $j]+1]
	}

	for {set i 0} {$i < $nka} {incr i} {
	    foreach j $elem {
		set ka($i) [lreplace $ka($i) $j $j]
	    }
	}

	#
	# Adjust global variables
	#

	foreach j $elem {
	    set fields [lreplace $fields $j $j]
	}
	set nfields [expr "$nfields - $nsel"]

	#
	# Remove all fields in the displayed card
	#

	destroy .bottom.card
	createcard .bottom.card 0
	pack before .bottom.list \
	    .bottom.card {left expand fill}
	dispcard $curcard .bottom.card 0

	#
	# The ka is modified
	#

	set kamod 1
	setstatus
    }
    destroy .field
}

##############################################################################
# re-order the fields
#
# Purpose : re-order the field names
# Input : -
# Output : -
# History :
#   92/09/26 : pda@masi.ibp.fr : specification
##############################################################################

proc orderfield {} {
    global fields nfields

    if {[termop {{.t edition} {.field field}}] == 0} then {
	return
    }

    topwidget .field "Order Field" +500+500 ordfaccept

    message .field.msg -text "Select the field(s) you want to move with mouse button 1.\nSpecify the new position with mouse button 2." \
	-aspect 600

    listscroll .field.list
    .field.list.lb configure -geometry 40x[expr "$nfields - 1"]
    set i 1
    foreach f [lreplace $fields 0 0] {
	.field.list.lb insert end "($i) $f"
	incr i
    }

    pack append .field \
	.field.msg	{top fillx} \
	.field.list	{top expand fill}
    
    bind .field.list.lb <Button-2>	{orderput %W %y}
    bind .field.list.lb <B2-Motion>	{ }
}

proc orderput {lb pos} {
    set sel [$lb curselection]
    set nsel [llength $sel]
    if {$nsel > 0} then {
	set x {}
	foreach s $sel {
	    lappend x [$lb get $s]
	}

	set ind [$lb nearest $pos]

	set first [lindex $sel 0]
	set last  [lindex $sel [expr "$nsel - 1"]]
	if {$ind < $first} then {
	    $lb delete $first $last
	    foreach i $x {
		$lb insert $ind $i
		incr ind
	    }
	} else {
	    if {$ind > $last} then {
		foreach i $x {
		    $lb insert $ind $i
		    incr ind
		}
		$lb delete $first $last
	    } else {
		toperror "Impossible field move" 0
	    }
	}
    }
}

proc ordfaccept {} {
    global ka nka kamod
    global fields nfields fparam
    global curcard

    #
    # Get the new field order
    #

    set neworder {0}
    set n [.field.list.lb size]
    for {set i 0} {$i < $n} {incr i} {
	set s [.field.list.lb get $i]
	set s [lindex [split $s ")"] 0]
	set s [string range $s 1 end]
	lappend neworder $s
    }

    #
    # Re-order the ka header (field names and parameters)
    #

    set nf  {}
    set nfp {}
    foreach f $neworder {
	lappend nf  [lindex $fields $f]
	lappend nfp [lindex $fparam $f]
    }
    set fields $nf
    set fparam $nfp

    #
    # Re-order the ka
    #

    for {set i 0} {$i < $nka} {incr i} {
	set nk {}
	foreach f $neworder {
	    lappend nk [lindex $ka($i) $f]
	}
	set ka($i) $nk
    }

    #
    # Re-order the field names inside the main window
    #

    for {set i 0} {$i < $nfields} {incr i} {
	.bottom.card.f$i.lbl configure -text [lindex $fields $i]
    }

    #
    # Redraw the main window
    #

    if {$curcard != -1} then {
	.bottom.list.lb select clear
	.bottom.list.lb select from $curcard
    }

    dispcard $curcard .bottom.card 0
    set kamod 1
    setstatus

    destroy .field
}

##############################################################################
# Name : editcard
# Purpose : edit the current card
# Event : from the "edit" button in the main window
# Input : -
# Output : -
# History :
#   92/09/20 : pda@masi.ibp.fr, jt@ratp.fr : creation
##############################################################################

proc editcard {} {
    global curcard

    if {$curcard == -1} then {
	toperror "Select a card first" 0
    } else {
	inputcard "Edit Card" editaccept
	dispcard $curcard .t.bottom 1
    }
}

proc editaccept {} {
    global curcard
    global ka

    set s [getcard .t.bottom]

    set newname [string tolower [lindex $s 0]]
    set oldname [string tolower [lindex $ka($curcard) 0]]
    if {[string compare $newname $oldname] == 0} then {
	set ka($curcard) $s
	dispcard $curcard .bottom.card 0
    } else {
	deletecard
	insertka $s
    }
    set kamod 1
    setstatus
}

##############################################################################
# Name : copycard
# Purpose : copy the current card
# Event : from the "copy" menu entry in the main window
# Input : -
# Output : -
# History :
#   92/10/04 : pda@masi.ibp.fr : specification
##############################################################################

proc copycard {} {
    global curcard
    global ka

    if {$curcard == -1} then {
	toperror "Select a card first" 0
    } else {
	insertka $ka($curcard)
	set kamod 1
	setstatus
    }
}


##############################################################################
# Name : newcard
# Purpose : input a new card
# Event : from the "new" button in the main window
# Input : -
# Output : -
# History :
#   92/09/20 : pda@masi.ibp.fr, jt@ratp.fr : specification
##############################################################################

proc newcard {} {
    inputcard "Input Card" newaccept
}

proc newaccept {} {
    set s [getcard .t.bottom]
    insertka $s
}

##############################################################################
# Name : inputcard
# Purpose : create a top level window to input a new/edit a card
# Input :
#   - name : name of the top-level widget
#   - acceptproc : procedure to call when the card is accepted
# Output : -
# History :
#   92/09/13 : pda@masi.ibp.fr : creation
#   92/10/03 : pda@masi.ibp.fr : added "accept" parameter
##############################################################################

proc inputcard {name acceptproc} {
    global nfields

    if {[termop {{.t edition} {.field field}}] == 0} then {
	return
    }

    topwidget .t $name +500+500 "$acceptproc ; destroy .t"

    createcard .t.bottom 1
    bindentarray .t.bottom $nfields "$acceptproc ; destroy .t"

    pack append .t \
	.t.bottom  {top expand fill}
}

##############################################################################
# Name : getcard
# Purpose : get the current card from the edited card
# Input :
#   - w : frame widget
# Output :
#   - a list in the "ka" format
# History :
#   92/09/21 : pda@masi.ibp.fr : creation
##############################################################################

proc getcard {w} {
    global nfields

    set res {}
    for {set i 0} {$i < $nfields} {incr i} {
	lappend res [.t.bottom.f$i.ent get]
    }
    return $res
}

##############################################################################
# Name : removecard
# Purpose : remove the current card
# Event : from the "remove" button in the main window
# Input : -
# Output : -
# History :
#   92/09/20 : pda@masi.ibp.fr : creation
##############################################################################

proc removecard {} {
    global ka
    global curcard

    if {$curcard == -1} then {
	toperror "Select a card first" 0
    } else {
	set name [lindex $ka($curcard) 0]
	set ok [toperror "Delete $name ?" 1]
	if {$ok == 1} then {
	    deletecard
	}
    }
}

##############################################################################
# Name : deletecard
# Purpose : delete the current card from the ka
# Input : -
# Output : -
# History :
#   92/10/03 : pda@masi.ibp.fr : creation
##############################################################################

proc deletecard {} {
    global curcard
    global ka nka kamod

    #
    # Remove the card from the array
    #

    set n [expr "$nka - 1"]
    for {set i $curcard} {$i < $n} {incr i} {
	set j [expr "$i + 1"]
	set ka($i) $ka($j)
    }
    unset ka($n)
    set nka $n

    #
    # Remove the card from the listbox
    #

    .bottom.list.lb delete $curcard

    #
    # As this card was the selected card,
    # remove this current card from display
    #
    set curcard -1
    dispcard -1 .bottom.card 0

    set kamod 1
    setstatus
}

##############################################################################
# Name : cardfield
# Purpose : create a frame with a field of a card in it
# Input :
#   - c : name of the frame containing all fields
#   - txt : name of the field
#   - ind : index of the field
#   - type : type of widget for fields (0 = label, 1 = entry)
# Output : -
# History :
#   92/09/26 : pda@masi.ibp.fr : creation
##############################################################################

proc cardfield {c txt ind type} {
    frame $c.f$ind
    label $c.f$ind.lbl -text $txt -anchor w -width 12
    if {$type == 0} then {
	label $c.f$ind.ent -relief sunken -width 45 -anchor w
    } else {
	entry $c.f$ind.ent -relief sunken -width 45
    }
    pack append $c.f$ind \
	$c.f$ind.lbl {left} \
	$c.f$ind.ent {left expand fillx}
    pack append $c \
	$c.f$ind {top expand fill}
}

##############################################################################
# Name : createcard
# Purpose : create a frame with a card in it
# Input :
#   - c : name of a to be created frame
#   - type : type of widget for fields (0 = label, 1 = entry)
# Output : -
# History :
#   92/09/13 : pda@masi.ibp.fr : creation
#   92/09/26 : pda@masi.ibp.fr : call to cardfield
#   92/09/27 : pda@masi.ibp.fr : destroy frame first
##############################################################################

proc createcard {c type} {
    global fields

    frame $c
    set i 0
    foreach txt $fields {
	cardfield $c $txt $i $type
	incr i
    }
}

##############################################################################
# Name : dispcard
# Purpose : display the given card into a card created with "createcard"
# Input :
#   - ind : index of the card into the array (-1 : all fields are null)
#   - c : name of a the frame
#   - type : type of widget for fields (0 = label, 1 = entry)
# Output : -
# History :
#   92/09/13 : pda@masi.ibp.fr : creation
##############################################################################

proc dispcard {ind c type} {
    global ka nfields

    if {$ind == -1} then {
	set k {}
    } else {
	set k $ka($ind)
    }

    for {set i 0} {$i < $nfields} {incr i} {
	if {$type == 0} then {
	    $c.f$i.ent configure -text [lindex $k $i]
	} else {
	    $c.f$i.ent delete 0 end
	    $c.f$i.ent insert 0 [lindex $k $i]
	}
    }
}


proc selectlb {lb pos c} {
    set ind [$lb nearest $pos]
    selectname $lb $ind $c
}

proc selectname {lb ind c} {
    global curcard

    set curcard $ind
    dispcard $curcard $c 0
    $lb select clear
    $lb select from $ind
}

##############################################################################
# Name : setfparam
# Purpose : set fields print parameters
# Event : from the "set params" button in the main window
# Input : -
# Output : -
# History :
#   92/10/03 : pda@masi.ibp.fr : specification
##############################################################################

proc setfparam {} {
    global fields nfields
    global fparam
    global fparamprint fparamempty fparamstyle fparamtitle

    if {[termop {{.t edition} {.field field}}] == 0} then {
	return
    }

    topwidget .fparam "Print Parameters" +500+200 fpaccept
    
    #
    # Split fparam variables into 4 distinct arrays
    #

    splitfparam

    #
    # Initialize window
    #

    for {set i 0} {$i < $nfields} {incr i} {
	frame .fparam.f$i -relief raised -borderwidth 1

	label .fparam.f$i.lbl \
	    -text [lindex $fields $i] -width 30 -relief raised -borderwidth 1

	frame .fparam.f$i.frm -relief raised -borderwidth 1
	frame .fparam.f$i.frm.pr
	checkbutton .fparam.f$i.frm.pr.print \
	    -anchor w \
	    -text "Print" \
	    -relief flat \
	    -variable fparamprint($i) \
	    -onvalue yes -offvalue no
	checkbutton .fparam.f$i.frm.pr.premp \
	    -anchor w \
	    -text "Print if empty" \
	    -relief flat \
	    -variable fparamempty($i) \
	    -onvalue yes -offvalue no
	pack append .fparam.f$i.frm.pr \
	    .fparam.f$i.frm.pr.print {left expand fill} \
	    .fparam.f$i.frm.pr.premp {left expand fill}

	frame .fparam.f$i.frm.sty
	radiobutton .fparam.f$i.frm.sty.norm \
	    -text "Normal" \
	    -relief flat \
	    -variable fparamstyle($i) \
	    -width 8 \
	    -value "normal"
	radiobutton .fparam.f$i.frm.sty.bold \
	    -text "Bold" \
	    -relief flat \
	    -variable fparamstyle($i) \
	    -width 8 \
	    -value "bold"
	radiobutton .fparam.f$i.frm.sty.ital \
	    -text "Italic" \
	    -relief flat \
	    -variable fparamstyle($i) \
	    -width 8 \
	    -value "italic"
	pack append .fparam.f$i.frm.sty \
	    .fparam.f$i.frm.sty.norm {left fillx} \
	    .fparam.f$i.frm.sty.bold {left fillx} \
	    .fparam.f$i.frm.sty.ital {left fillx}
	
	labent .fparam.f$i.frm.title "Title" 5 20
	.fparam.f$i.frm.title.ent configure -textvariable fparamtitle($i)

	pack append .fparam.f$i.frm \
	    .fparam.f$i.frm.pr    {top expand fill} \
	    .fparam.f$i.frm.sty   {top expand fill} \
	    .fparam.f$i.frm.title {top expand fill}
	
	pack append .fparam.f$i \
	    .fparam.f$i.lbl {left fill} \
	    .fparam.f$i.frm {left expand fill}
	    
	pack append .fparam \
	    .fparam.f$i {top expand fill}
    }
}

proc fpaccept {} {
    mergefparam
    destroy .fparam
}

##############################################################################
# Name : print
# Purpose : print the ka
# Event : from the "print" button in the main window
# Input : -
# Output : -
# History :
#   92/10/03 : pda@masi.ibp.fr : specification
##############################################################################

proc print {} {
    global defaults

    printersettings printcmd
}

##############################################################################
# Name : preview
# Purpose : preview the ka
# Event : from the "preview" button in the main window
# Input : -
# Output : -
# History :
#   92/10/04 : pda@masi.ibp.fr : specification
##############################################################################

proc preview {} {
    global defaults

    printersettings previewcmd
}

##############################################################################
# Name : printersettings
# Purpose : create a top level window to modify display settings
# Input :
#   - varname : name of the variable containing the print command
# Output : -
# History :
#   92/10/04 : pda@masi.ibp.fr : specification
##############################################################################

set cmd {}

proc printersettings {varname} {
    global printsettings
    global defaults
    global printcmd previewcmd

    if {[termop {{.print print/preview}}] == 0} then {
	return
    }

    topwidget .print "Print/Preview" +500+500 \
		"sendtoprinter $varname ; destroy .print"

    button .print.buttons.default \
	-text "Default" \
	-width 8 \
	-command defaultprintersettings
    pack after .print.buttons.accept \
	.print.buttons.default		{left expand fill}
    
    frame .print.bottom
    labent .print.bottom.cmd "Command" 10 20
    .print.bottom.cmd.ent configure -textvariable $varname
    labent .print.bottom.lig "Lines"   10 20
    .print.bottom.lig.ent configure -textvariable printsettings(lines)
    labent .print.bottom.col "Columns" 10 20
    .print.bottom.col.ent configure -textvariable printsettings(cols)
    radiobutton .print.bottom.p \
	-text "Portrait" \
	-value portrait \
	-variable printsettings(landscape)
    radiobutton .print.bottom.l \
	-text "Landscape" \
	-value landscape \
	-variable printsettings(landscape)
    menubutton .print.bottom.font \
	-textvariable printsettings(font) \
	-menu .print.bottom.font.menu \
	-relief raised
    menu .print.bottom.font.menu
    foreach f $defaults(fonts) {
	.print.bottom.font.menu add checkbutton \
	    -label $f -variable printsettings(font) -onvalue "$f"
    }

    pack append .print.bottom \
	.print.bottom.cmd		{top expand fill} \
	.print.bottom.lig		{top expand fill} \
	.print.bottom.col		{top expand fill} \
	.print.bottom.p			{top expand fill} \
	.print.bottom.l			{top expand fill} \
	.print.bottom.font		{top expand fill}

    pack append .print \
	.print.bottom  {top expand fill}
}

proc defaultprintersettings {} {
    global printsettings
    global defaults

    set printsettings(lines)		[lindex $defaults(printset) 0]
    set printsettings(cols)		[lindex $defaults(printset) 1]
    set printsettings(landscape)	[lindex $defaults(printset) 2]
    set printsettings(font)		[lindex $defaults(printset) 3]
}

##############################################################################
# Name : sendtoprinter
# Purpose : formats the ka to send to the printer
# Input :
#   - printer : command to send to printer
# Output : -
# History :
#   92/10/04 : pda@masi.ibp.fr : specification
#   92/10/04 : pda@masi.ibp.fr : creation
##############################################################################

proc sendtoprinter {printvar} {
    global nfields
    global ka nka
    global printsettings
    global fparamprint fparamempty fparamstyle fparamtitle
    global printcmd previewcmd
    global defaults

    set printer [eval set $printvar]

    splitfparam

    set cmd $defaults(multilp)
    append cmd " -l $printsettings(lines)"
    append cmd " -c $printsettings(cols)"
    append cmd " -m $printsettings(landscape)"
    append cmd " -f $printsettings(font)"
    set fd [open "| $cmd | $printer" "w"]

    set nlines 0
    for {set i 0} {$i < $nka} {incr i} {
	#
	# Compute the number of lines
	#

	set crd $ka($i)
	set nc 0
	for {set j 0} {$j < $nfields} {incr j} {
	    if {[string compare $fparamprint($j) yes] == 0 &&
		([string compare [lindex $crd $j] ""] != 0 ||
		 [string compare $fparamempty($j) yes] == 0)} then {
		incr nc
	    }
	}

	#
	# Card too big to fit in the remainder of the current column ?
	#

	if {$nlines + 1 + $nc > $printsettings(lines)} then {
	    for {set k $nlines} {$k < $printsettings(lines)} {incr k} {
		puts $fd ""
	    }
	    set nlines 0
	} else {
	    if {$nlines > 0} then {
		puts $fd ""
		incr nlines
	    }
	}

	#
	# Print the card
	#

	for {set j 0} {$j < $nfields} {incr j} {
	    set s [lindex $crd $j]
	    if {[string compare $fparamprint($j) yes] == 0 &&
		([string compare $s ""] != 0 ||
		 [string compare $fparamempty($j) yes] == 0)} then {

		set l $fparamtitle($j)
		case $fparamstyle($j) in {
		    normal { }
		    bold
			{
			    set ll [string length $s]
			    set ns ""
			    for {set k 0} {$k < $ll} {incr k} {
				set c [string index $s $k]
				append ns "$c\b$c\b$c"
			    }
			    set s $ns
			}
		    italic
			{
			    set ll [string length $s]
			    set ns ""
			    for {set k 0} {$k < $ll} {incr k} {
				set c [string index $s $k]
				append ns "_\b$c"
			    }
			    set s $ns
			}
		}
		puts $fd "$l$s"
	    }
	}
	incr nlines $nc
    }
    catch {close $fd}
}

##############################################################################
# Name : fileselect
# Purpose : create a top level window to input a file name
# Input :
#   - win : name of a to-be created toplevel widget
#   - title : title bar message
#   - defdir : default directory
#   - deffile : default file
#   - all : allow non existing files to be selected
#   - okproc : procedure to call with selected file name
#   - cancelproc : procedure to call when [cancel] button is pressed
# Output : -
# History :
#   92/09/22 : pda@masi.ibp.fr : creation
#   92/09/26 : pda@masi.ibp.fr : added window title parameter
##############################################################################

proc fileselect {win title defdir deffile defgeom all okproc cancelproc} {
    global env

    catch "destroy $win"

    #
    # Creation of the top level widget
    #

    toplevel    $win
    wm title    $win $title
    wm iconname $win [string tolower $title]
    wm minsize  $win 10 10

    if {[string length $defgeom] > 0} then {
	wm geometry $win $defgeom
    }

    #
    # Creation of various elements :
    #
    # -label for current directory name

    label  $win.dir -anchor c

    # - listbox + scrollbar for directory contents

    frame $win.list
    listbox $win.list.lb \
	-relief sunken \
	-yscrollcommand "$win.list.sb set"
    tk_listboxSingleSelect $win.list.lb
    scrollbar $win.list.sb -command "$win.list.lb yview"
    pack append $win.list \
	$win.list.lb {left expand fill} \
	$win.list.sb {right filly}
    
    # - entry for manual file entry

    entry  $win.file -relief sunken -width 30

    # - bottom buttons

    frame  $win.buttons
    button $win.buttons.home \
	-text "Home" \
	-width 8 \
	-command "fsChangeDir $win $env(HOME)"
    button $win.buttons.cancel \
	-text "Cancel" \
	-width 8 \
	-command "fsCancel $win $cancelproc"
    button $win.buttons.ok \
	-text "Ok" \
	-width 8 \
	-command "fsSelect $win $all $okproc"
    pack append $win.buttons \
	$win.buttons.home   {left expand fillx} \
	$win.buttons.cancel {left expand fillx} \
	$win.buttons.ok     {left expand fillx}

    pack append $win \
	$win.dir     {top fillx} \
	$win.list    {top expand fill} \
	$win.file    {top fillx} \
	$win.buttons {top fillx}

    #
    # First, all input is redirected to the manual entry 
    #

    focus $win.file

    #
    # Next, select actions to perform in response to user events
    #

    bind $win.list.lb <Button-1>        "fsInstall $win %y"
    bind $win.list.lb <B1-Motion>       { }
    bind $win.list.lb <Shift-Button-1>  { }
    bind $win.list.lb <Shift-B1-Motion> { }

    bind $win.list.lb <Double-Button-1> "fsSelect $win $all $okproc"

    bind $win.file    <Key-Return>      "fsSelect $win $all $okproc"

    #
    # Install the starting directory
    #

    fsChangeDir $win $defdir
    if {[string length $deffile] > 0} then {
	$win.file insert 0 $deffile
    }
}

proc fsCancel {win cancelproc} {
    destroy $win
    $cancelproc
}

proc fsInstall {win pos} {
    set ind [$win.list.lb nearest $pos]
    set new [$win.list.lb get $ind]

    $win.list.lb select clear
    $win.list.lb select from $ind

    $win.file delete 0 end
    $win.file insert 0 $new
}

proc fsSelect {win all okproc} {
    set olddir [lindex [$win.dir configure -text] 4]

    set new [$win.file get]
    if {[string match "/*" $new] == 0} then {
	set new "$olddir/$new"
    }

    if {[file exists $new]} then {
	if {[file isdirectory $new]} then {
	    fsChangeDir $win $new
	    $win.file delete 0 end
	} else {
	    $okproc $new
	    destroy $win
	}
    } else {
	if {$all == 1} then {
	    $okproc $new
	    destroy $win
	}
    }
}

proc fsChangeDir {win dir} {
    if {[file isdirectory $dir]} then {
	set curdir [pwd]
	cd $dir
	set dir [pwd]
	cd $curdir
	$win.dir configure -text $dir
	$win.list.lb delete 0 end
	set l [exec ls -a $dir]
	foreach f $l {
	    $win.list.lb insert end $f
	}
    }
}

##############################################################################
# Name : save
# Purpose : display a top level widget to save a ka
# Input : -
# Output : -
# History :
#   92/09/21 : pda@masi.ibp.fr : creation
#   92/09/23 : pda@masi.ibp.fr : added saveas
##############################################################################

proc save {} {
    global curfilename

    if {[string length $curfilename] == 0} then {
	saveas
    } else {
	writeka $curfilename
    }
}

proc saveas {} {
    fileselect .filesel "Save File" . noname.adrs "" 1 saveok savecancel
}

proc saveok {filename} {
    global curfilename

    if {[file exists $filename]} then {
	set ok [toperror "File exists. Write anyway ?" 1]
    } else {
	set ok 1
    }

    if {$ok == 1} then {
	if {[string length $curfilename] == 0} then {
	    set curfilename $filename
	    setstatus
	}
	writeka $filename
    }
}

proc savecancel {} {
}

##############################################################################
# Name : load
# Purpose : display a top level widget to load a ka
# Input : -
# Output : -
# History :
#   92/09/23 : pda@masi.ibp.fr : creation
##############################################################################

proc load {} {
    if {[modok "Load"]} then {
	fileselect .filesel "Load File" . noname.adrs "" 1 loadok loadcancel
    }
}

proc loadok {filename} {
    global curfilename

    set curfilename $filename
    readka $filename
    dispka
    setstatus
}

proc loadcancel {} {
}

proc reload {} {
    global ka nka
    global curfilename

    if {[string length $curfilename] == 0} then {
	toperror "No current file." 0
    } else {
	if {[modok "Re-load"]} then {
	    readka $curfilename
	    for {set i 0} {$i < $nka} {incr i} {
		.bottom.list.lb insert end [lindex $ka($i) 0]
	    }
	}
    }
}

##############################################################################
# Name : moveline, movepage
# Purpose : move the selector in the listbox
# Input :
#   - dir : direction, 1 (Down) or -1 (Up)
# Output : -
# History :
#   92/09/24 : pda@masi.ibp.fr : creation
##############################################################################

proc moveline {dir} {
    global nka
    global curcard

    set min [.bottom.list.lb nearest 0]
    set max [.bottom.list.lb nearest 99999]
    set n [expr "$max - $min + 1"]

    incr curcard $dir
    if {$curcard < 0} then {
	set curcard 0
    }
    if {$curcard >= $nka} then {
	set curcard [expr "$nka - 1"]
    }

    if {$curcard < $min} then {
	set start [expr "$curcard - ($n / 2)"]
	if {$start < 0} then {set start 0}
	.bottom.list.lb yview $start
    }
    if {$curcard > $max} then {
	set start [expr "$curcard - ($n / 2)"]
	if {$start >= $nka} then {set start [expr "$nka - 1"]}
	.bottom.list.lb yview $start
    }

    selectname .bottom.list.lb $curcard .bottom.card
}

proc movepage {dir} {
    global nka
    global curcard

    if {$curcard == -1} then {set curcard 0}

    set min [.bottom.list.lb nearest 0]
    set max [.bottom.list.lb nearest 99999]
    set n [expr "$min == $max ? 5 : $max - $min + 1"]
    set offset [expr "$curcard - $min"]


    if {$dir >= 0} then {
	set start $max
	set curcard [expr "$max + $offset"]
    } else {
	set start [expr "$min - $n"]
	set curcard [expr "$min - $n + $offset"]
    }

    if {$curcard < 0} then {
	set start 0
	set curcard 0
    }
    if {$curcard >= $nka} then {
	set start [expr "$nka - 1"]
	set curcard [expr "$nka - 1"]
    }

    .bottom.list.lb yview $start

    selectname .bottom.list.lb $curcard .bottom.card
}

##############################################################################
# Name : setstatus
# Purpose : display the current filename and number of cards in the status line
# Input : -
# Output : -
# History :
#   92/10/03 : pda@masi.ibp.fr : creation
##############################################################################

proc setstatus {} {
    global curfilename
    global nka kamod

    set msg "$curfilename"
    append msg "          $nka cards          "
    append msg [expr "$kamod == 1 ? {modified} : {not modified}"]

    .status configure -text "$msg"
}


##############################################################################
# Name : mkwin
# Purpose : create the main window
# Input : -
# Output : -
# History :
#   92/09/13 : pda@masi.ibp.fr : creation
#   92/10/03 : pda@masi.ibp.fr : added status line
##############################################################################

proc mkwin {} {
    global curfilename

    frame  .buttons
    menubutton .buttons.search \
	-text "Search" \
	-width 8 \
	-relief raised \
	-menu .buttons.search.menu
    menubutton .buttons.field \
	-text "Field" \
	-width 8 \
	-relief raised \
	-menu .buttons.field.menu
    menubutton .buttons.card \
	-text "Card" \
	-width 8 \
	-relief raised \
	-menu .buttons.card.menu
    menubutton .buttons.print \
	-text "Print" \
	-width 8 \
	-relief raised \
	-menu .buttons.print.menu
    menubutton .buttons.file \
	-text "File" \
	-width 8 \
	-relief raised \
	-menu .buttons.file.menu
    menubutton .buttons.quit \
	-text "Quit" \
	-width 8 \
	-relief raised \
	-menu .buttons.quit.menu
    pack append .buttons \
	.buttons.search   {left expand fill} \
	.buttons.field    {left expand fill} \
	.buttons.card     {left expand fill} \
	.buttons.print    {left expand fill} \
	.buttons.file     {left expand fill} \
	.buttons.quit     {left expand fill}

    menu .buttons.search.menu
    .buttons.search.menu add command -label "First Field"    -command srchname
    .buttons.search.menu add command -label "Selected Field" -command srchfield
    .buttons.search.menu add command -label "Everywhere"     -command srchall

    menu .buttons.field.menu
    .buttons.field.menu  add command -label "New"     -command newfield
    .buttons.field.menu  add command -label "Edit"    -command editfield
    .buttons.field.menu  add command -label "Remove"  -command removefield
    .buttons.field.menu  add command -label "Order"   -command orderfield

    menu .buttons.card.menu
    .buttons.card.menu   add command -label "New"     -command newcard
    .buttons.card.menu   add command -label "Edit"    -command editcard
    .buttons.card.menu   add command -label "Copy"    -command copycard
    .buttons.card.menu   add command -label "Remove"  -command removecard

    menu .buttons.print.menu
    .buttons.print.menu  add command -label "Set Fields" -command setfparam
    .buttons.print.menu  add command -label "Preview"    -command preview
    .buttons.print.menu  add command -label "Print"      -command print

    menu .buttons.file.menu
    .buttons.file.menu   add command -label "Save"    -command save
    .buttons.file.menu   add command -label "Save as" -command saveas
    .buttons.file.menu   add command -label "Load"    -command load
    .buttons.file.menu   add command -label "Reload"  -command reload

    menu .buttons.quit.menu
    .buttons.quit.menu   add command -label "Quit"    -command quit
    .buttons.quit.menu   add command -label "Abort"   -command {destroy .}

    frame .bottom
    createcard .bottom.card 0

    listscroll .bottom.list
    .bottom.list.lb configure -geometry 40x15
    tk_listboxSingleSelect .bottom.list.lb
    
    pack append .bottom \
	.bottom.card {left expand fill} \
	.bottom.list {left expand fill}

    label .status -relief sunken

    pack append . \
	.buttons {top fillx} \
	.bottom {top expand fill} \
	.status {top fillx}
    
    wm minsize . 100 100

    bind .bottom.list.lb <Button-1> {selectlb %W %y .bottom.card}

    bind all <Control-s>	{srchname}
    bind all <Control-e>	{editcard}
    bind all <Control-r>	{removecard}
    bind all <Control-n>	{newcard}
    bind all <Control-q>	{quit}
    bind all <Control-w>	{save}

    bind all <Key-Up>		{moveline -1}
    bind all <Key-Down>		{moveline 1}
    bind all <Key-Prior>	{movepage -1}
    bind all <Key-Next>		{movepage 1}

    bind Entry <Control-s>	{srchname}
    bind Entry <Control-e>	{editcard}
    bind Entry <Control-r>	{removecard}
    bind Entry <Control-q>	{quit}
    bind Entry <Control-n>	{newcard}
    bind Entry <Control-w>	{save}

    bind Entry <Key-Left>	{entrymovecursor %W -1}
    bind Entry <Key-Right>	{entrymovecursor %W 1}
}

case $argc in {
    0
	{ set curfilename $defaults(file) }
    1
	{ set curfilename [lindex $argv 0] }
    *
	{
	    puts stderr "usage: xka \[filename\]"
	    destroy .
	}
}

mkwin
readka $curfilename
dispka
set printcmd	$defaults(print)
set previewcmd	$defaults(preview)
# Needed for Tk 3 new focus policy
focus default .
