#!/usr/local/bin/wish -f
#
# A bible program front end interface
#
# Written by Alan Mak (HKUST) in 1994


catch {tk colormodel . color}		;# colour even on a 2-bit display

global VERSION
global NAME			;# user's login name
global HOME			;# user's home directory
global AUTOPOSITION		;# centre dialogue boxes and alerts
global CONFIRM			;# annoying confirmation dialogues

set VERSION 2.0
set NAME $env(USER)
set HOME $env(HOME)
set AUTOPOSITION 0
set CONFIRM 1
if {! [info exists env(PRINTER)]} {set env(PRINTER) lp}

# some default values that can be redefined in .edittkrc.tcl:

global TEXTBG; set TEXTBG white		;# Tk default background is {#4eee94}
global TEXTFG; set TEXTFG black
global TEXTSB; set TEXTSB black		;# selected bg; Tk default is lt blue
global TEXTSF; set TEXTSF white		;# selected fg
global TEXTBW; set TEXTBW 0		;# selection border width
global TEXTWRAP; set TEXTWRAP char	;# none, char, word
global TEXTFONT; set TEXTFONT default	;# if default, font won't be set

global Bible				;# Bible program location
#set Bible "/usr/bin/bible"
set p1 [ open |$Bible r+ ]

global LP; set LP 0.0			;# Last cursor insert position


# Definition of frames

frame .text
#############
label .text.l -relief raised  ;# -bg bisque3 -fg black 
scrollbar .text.s -command {.text.t yview}
text .text.t -yscroll ".text.s set" -setgrid true -width 80 -height 24 \
-background white

pack append .text \
  .text.l {top fillx} \
  .text.t {right expand fill} \
  .text.s {right filly}
#############

frame .menu
#############
menubutton .menu.file -bd 1 -text {File} -menu .menu.file.m

# You may add more menu function from here
menu .menu.file.m
.menu.file.m add command -label {Clear}  \
  -command { 
	.text.t yview -pickplace end
	.text.t delete 0.0 end 
}
.menu.file.m add command -label {Save}  \
  -command {
		cmd_save
                focus .menu.field
}
.menu.file.m add separator
.menu.file.m add command -label {Quit}  \
  -command {
		destroy .
}
entry .menu.field -relief sunken 
button .menu.info -text {Info} -bd 1 -command { show_info }

pack append .menu .menu.file {left padx 10}
pack append .menu .menu.field {left expand fillx pady 10}
pack append .menu .menu.info {left padx 10}
#############

pack append . .menu {top fillx}
pack append . .text {top expand fill}

bind .menu.field <Return> {
	set prompt_result [.menu.field get]
	# Controls on special input can insert here
	.text.l config -text "Please Wait ..."
	.menu.field delete 0 end
	.text.t yview -pickplace end
	update
	puts $p1 $prompt_result
	flush $p1
	sprintw $p1 .text.t
}
bind .text.t <KeyPress> {
	focus .menu.field
}

# Procedures
proc tkerror { errortext } {
  puts stdout $errortext
  destroy .
}

proc tke_confirm { msg } {
  global confirm_result
  global CONFIRM                ;# user preference---whether to ask
 
  if { ! $CONFIRM } {
    return 1
  }
 
  toplevel .confirm
  message .confirm.msg -width 300 -anchor w -text $msg
  frame .confirm.b
  frame .confirm.b.r -height 2 -width 200 -borderwidth 1 -relief sunken
  button .confirm.b.ok -text OK -bd 4 -width 8 -command {
    set confirm_result 1
    focus .menu.field 
    destroy .confirm
  }
  button .confirm.b.cancel -text Cancel -width 8 -command {
    set confirm_result 0
    focus .menu.field 
    destroy .confirm
 }
 
  pack append .confirm.b \
    .confirm.b.r {top fillx} \
    .confirm.b.ok {right padx 10 pady 10} \
    .confirm.b.cancel {right pady 10}
  pack append .confirm  \
    .confirm.msg {top fill expand padx 10} \
    .confirm.b {bottom fillx}
 
  bind .confirm <Return> {.confirm.b.ok invoke}
  bind .confirm <Control-c> {.confirm.b.cancel invoke}

  focus .confirm
  grab .confirm
  tkwait window .confirm
  return $confirm_result
}

proc tke_prompt { {prompt "File name?"} } {
  append FILENAME {}            ;# make sure it's defined
 
  global prompt_result
 
  toplevel .save
  message .save.msg -width 300 -anchor w -text $prompt
  entry .save.field -relief sunken -width 40
  frame .save.b -relief sunken
  frame .save.b.r -height 2 -width 200 -borderwidth 1 -relief sunken
  button .save.b.ok -text OK -bd 4 -width 8 -command {
    set prompt_result [.save.field get]
    if {$prompt_result != {}} then {
      focus .menu.field 
      destroy .save
    }
  }
  # return a sentinel value on cancel:
  button .save.b.cancel -text Cancel -width 8 -command {
    set prompt_result {././/CANCEL//./.}
      focus .menu.field 
      destroy .save
  }
 
  set prompt_result {././/CANCEL//./.}
  pack append .save.b \
    .save.b.r {top fillx} \
    .save.b.ok {right padx 10 pady 10} \
    .save.b.cancel {right pady 10}
  pack append .save \
    .save.msg {top fill expand padx 10} \
    .save.field {top padx 10 pady 10} \
    .save.b {bottom fillx}
 
  .save.field delete 0 end
  .save.field insert end $FILENAME
 
  bind .save.field <Return> {.save.b.ok invoke}
  bind .save.field <Control-c> {.save.b.cancel invoke}

  grab .save
  focus .save.field
  tkwait window .save
  return $prompt_result
}

proc cmd_save {} {
  global FILENAME
 
  set prompt_result [tke_prompt "Save as:"]
  if {$prompt_result != {././/CANCEL//./.} && \
     ( ![file exists $prompt_result] || \
      [tke_confirm "File \"$prompt_result\" exists; replace it?"] )} then {
    set FILENAME $prompt_result
    .text.l config -text [ concat "Save into file: " $prompt_result ]
    exec cat > $FILENAME << [.text.t get 1.0 end]
  }
}

proc show_info {} {
 
  toplevel .info
  message .info.msg -width 300 -anchor w -justify center -text \
"\n    Author: Alan Mak Siu Kei\n    E-mail: siumk@cs.ust.hk\n"
  frame .info.b
  frame .info.b.r -height 2 -width 200 -borderwidth 1 -relief sunken
  button .info.b.ok -text OK -bd 4 -width 8 -command {
    focus .menu.field 
    destroy .info
  }
 
  pack append .info.b \
    .info.b.r {top fillx} \
    .info.b.ok {right padx 10 pady 10}
  pack append .info  \
    .info.msg {top fill expand padx 10} \
    .info.b {bottom fillx}
 
  bind .info <Return> {.info.b.ok invoke}

  focus .info
  grab .info
  tkwait window .info
  return 1
}

proc sprintw { pipe textfield } {
global LP
$textfield mark set insert $LP 
set a {}
set b {}
while {[set i [read $pipe 1]] != ">" || $a != "]"} {
     if {[eof $pipe] == 1} {exit}
     $textfield insert insert $i 
     set a $i
     if {$i == "\n"} {set b {done}}
}
if {[eof $pipe] == 1} {exit}
set i [read $pipe 1]
.text.l config -text [lreplace [$textfield get {end linestart} end] 0 0]
$textfield delete {end linestart} end
if {$b == {done}} { $textfield insert insert "\n" }
set LP [ $textfield index insert ]
}

sprintw $p1 .text.t
focus .menu.field
