#!/bin/sh

# Supports japanese and english versions of wish\
exec wishsel "$0" "$@"

###   pTkEdit ver0.3.1 by iga, 28 april 1997   ###

# Make copy/cut/paste buffer file
if {![file exists /tmp/.buffer]} {
  exec touch /tmp/.buffer
}

### Viewer Configuration ###
set MenuFont "-*-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*"
set TextFont "-*-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*"

### Main Window configurations ###
wm title . "pTkEdit"

## Menu Bar ##
frame .mbar -relief raise -bd 2
pack .mbar -fill x -side top
  menubutton .mbar.file -menu {.mbar.file.menu} -text "File" -underline 0 -font $MenuFont
  menu .mbar.file.menu -tearoff {0}
    .mbar.file.menu add command  -accelerator {Ctrl-L} -command {GetFile} \
       -label {Load...} -underline 0 -font $MenuFont
    .mbar.file.menu add command  -accelerator {Ctrl-S} -command {SaveFile $FileName} \
      -label {Save} -underline 0 -font $MenuFont
    .mbar.file.menu add command  -accelerator {Ctrl-A} -command {RenameFile} \
      -label {Save as...} -underline 5 -font $MenuFont
    .mbar.file.menu add command -command {CloseExit CloseFile} \
      -label {Close} -underline 0 -font $MenuFont
    .mbar.file.menu add separator
    .mbar.file.menu add command  -accelerator {Ctrl-E} -command {exec ptkedit &} \
       -label {New Editor} -underline 4 -font $MenuFont
    .mbar.file.menu add separator
    .mbar.file.menu add command -accelerator {Alt+X} -command {CloseExit exit} \
      -label {Exit} -underline 1 -font $MenuFont

  menubutton .mbar.edit -menu {.mbar.edit.menu} -text "Edit" -underline 0 -font $MenuFont
  menu .mbar.edit.menu -tearoff {0}
    .mbar.edit.menu add command -accelerator {Ctrl+C} -command {Copy} \
      -label {Copy} -underline 0 -font $MenuFont
    .mbar.edit.menu add command -accelerator {Ctrl+X} -command {Cut} \
      -label {Cut} -underline 2 -font $MenuFont
    .mbar.edit.menu add command -accelerator {Ctrl+V} -command {Paste} \
      -label {Paste} -underline 0 -font $MenuFont
    .mbar.edit.menu add separator
    .mbar.edit.menu add command -accelerator {Ctrl+F} -command {SearchRepl} \
      -label {Find/Replace...} -underline 0 -font $MenuFont
    .mbar.edit.menu add separator
    .mbar.edit.menu add command -accelerator {Ctrl+G} -command {Goto} \
      -label {Go to...} -underline 0 -font $MenuFont

  menubutton .mbar.help -menu {.mbar.help.menu} -text {Help} -underline 0 -font $MenuFont
  menu .mbar.help.menu -tearoff {0}
    .mbar.help.menu add command -command { AboutBox } -label {About...} -underline 0 -font $MenuFont

  pack .mbar.file .mbar.edit -side left
  pack .mbar.help -side right

## Main Window ##
frame .win
pack .win -expand yes -side top  -fill both -padx 3 -pady 3
  scrollbar .win.scroll -command ".win.text yview"
  text .win.text -yscroll ".win.scroll set" -setgrid yes -width 80 -bg white -font $TextFont -wrap char
  pack .win.scroll -side right -fill y -padx 1
  pack .win.text -side left -fill both -expand yes -padx 1

## Status bar ##
frame .st -relief groove -bd 3
pack .st -side bottom -fill x
  label .st.lblF -text "File: " -font $TextFont
  label .st.fname -textvariable FileName -font $TextFont
  pack .st.lblF .st.fname -side left
  label .st.lblL -text "Line: " -font $TextFont
  label .st.pos -textvariable CurPos -font $TextFont -width 7
  pack .st.pos .st.lblL  -side right

## Key and Mouse Bindings ##
bind all <Alt-KeyPress> {  }
bind all <Control-Key-l> { GetFile }
bind all <Control-Key-s> { SaveFile $FileName }
bind all <Control-Key-a> { RenameFile }
bind all <Control-Key-e> { exec ptkedit }
bind all <Alt-Key-x> { CloseExit exit}
bind .win.text <Control-Key-c> { Copy }
bind .win.text <Control-Key-x> { Cut }
bind .win.text <Control-Key-v> { Paste }
bind all <Control-Key-f> { SearchRepl }
bind all <Control-Key-g> { GotoLine }
bind .win.text <KeyPress> { set Change 1 }
bind all <Control-Key-Prior> { .win.text yview moveto 0 }
bind all <Control-Key-Next> { .win.text yview moveto 1 }
bind all <Alt-Key-f> { tkMbPost .mbar.file }
bind all <Alt-Key-e> { tkMbPost .mbar.edit }
bind all <Alt-Key-h> { tkMbPost .mbar.help }
bind .win.text <ButtonRelease> { GetLine }
bind .win.text <KeyRelease> { GetLine }

### Procedures ###

## File Handling ##

proc GetFile {} {
  global FileName
  set types {
    {"Text files"		{.txt .doc}	}
    {"All files"		*}
    }
  set tmpName [tk_getOpenFile -filetypes $types -parent .]
  if {$tmpName != ""} {
    CloseExit CloseFile
    if {$FileName == ""} {
      set FileName $tmpName
      OpenFile $FileName
    } else {
      return
    }
  }
}

proc OpenFile {File} {
  .win.text delete 1.0 end
  set f [open $File]
  .win.text insert end [read -nonewline $f]
  close $f
}

proc RenameFile {} {
  global FileName
  set types {
    {"Text files"		{.txt .doc}	}
    {"All files"		*}
    }
  set tmpName [tk_getSaveFile -filetypes $types -parent . \
    -initialfile $FileName -defaultextension .txt]
  if {$tmpName != ""} {
    set FileName $tmpName
    SaveFile $FileName
  }
}

proc SaveFile {File} {
  global Change
  if {$File == ""} {
    RenameFile
    return
  }
  set f [open $File w]
  puts -nonewline $f [.win.text get 0.0 end]
  close $f
  set Change 0
}

proc CloseExit { tmp } {
  global Change FileName Action
  set Action $tmp
  if {$Change} {
    toplevel .alert 
    wm title .alert "Not saved"
    label .alert.lbl1 -text "The changes will be lost."
    label .alert.lbl2 -text " Continue?"
    pack .alert.lbl1 .alert.lbl2 -side top -padx 5 -pady 5
    frame .alert.btn -relief groove -bd 3
    pack .alert.btn -side bottom
      button .alert.btn.ok -width 5 -text "OK" -command {destroy .alert; $Action}
      button .alert.btn.save -width 5 -text "Save" -command {destroy .alert;SaveFile $FileName;$Action }
      button .alert.btn.cancel -width 5 -text "Cancel" -command {destroy .alert; return}
      pack .alert.btn.ok .alert.btn.save .alert.btn.cancel -side left -padx 5 -pady 5
      bind .alert <KeyPress-Escape> {destroy .alert; return}
      bind .alert.btn.ok <KeyPress-Return> {destroy .alert; $Action}
      bind .alert.btn.cancel <KeyPress-Return> {destroy .alert; return}
      focus .alert.btn.ok
      tkwait window .alert
  } else {
    $Action
  }
}

proc CloseFile {} {
  global FileName Change
  set Change 0
  set FileName ""
  .win.text delete 1.0 end
}

## Clipboard  ##

proc Copy {} {
  set file [open /tmp/.buffer w]
  catch { puts -nonewline $file [selection get] }
  close $file
}  

proc Cut {} {
  global Change
  catch {
    set file [open /tmp/.buffer w]
    puts -nonewline $file [selection get]
    set lim [.win.text tag nextrange sel 1.0 end]
    .win.text delete [lrange $lim 0 0] [lrange $lim 1 1]
    close $file
    set Change 1
  }
}  

proc Paste {} {
  global Change
  set file [open /tmp/.buffer r]
  .win.text insert insert [read $file]
  close $file
  set Change 1
}  

## Search and Replace  procedures ##
# Search dialog #
proc SearchRepl {} {
  global StrLen
  toplevel .srch
  wm title .srch "Search"
  frame .srch.sea
  pack .srch.sea -side top -fill x -expand yes -padx 5 -pady 5
    label .srch.sea.lbl -text "Search: " -width 12
    entry .srch.sea.name -relief sunken -bg white -textvariable SearchString
    pack .srch.sea.lbl -side left
    pack .srch.sea.name -side left -fill x -expand yes
  frame .srch.to
  pack .srch.to -side top -fill x -expand yes -padx 5 -pady 5
    label .srch.to.lbl -text "Replace to: " -width 12
    entry .srch.to.name -relief sunken -bg white -textvariable ReplString
    pack .srch.to.lbl -side left
    pack .srch.to.name -side left -fill x -expand yes
  frame .srch.btn -relief groove -bd 3
  pack .srch.btn -side bottom -fill x -expand yes
    button .srch.btn.next -width 5 -text "Search" -command {Search $SearchString}
    button .srch.btn.repl -width 5 -text "Replace" -command {Replace $ReplString}
    button .srch.btn.replall -width 10 -text "Replace All" -command {ReplaceAll $SearchString $ReplString}
    button .srch.btn.cancel -width 5 -text "Cancel" -command {.win.text tag remove emph 0.0 end; set SeaCur 1.0; destroy .srch}
    pack .srch.btn.next .srch.btn.repl .srch.btn.replall -side left -padx 5 -pady 5
    pack .srch.btn.cancel -side right -padx 5 -pady 5
  bind .srch.sea.name <KeyPress-Return> { Search $SearchString }
  bind .srch.to.name <KeyPress-Return> { Search $SearchString }
  bind .srch.btn.next <KeyPress-Return> { Search $SearchString }
  bind .srch.btn.repl <KeyPress-Return> { Replace $ReplString }
  bind .srch.btn.replall <KeyPress-Return> {  ReplaceAll $SearchString $ReplString }
  bind .srch.btn.cancel <KeyPress-Return> { .win.text tag remove emph 0.0 end; set SeaCur 1.0; destroy .srch; return }
  bind all <KeyPress-Escape> { .win.text tag remove emph 0.0 end; set SeaCur 1.0; destroy .srch; return }
  focus .srch.sea.name
}

# Search procedure #
proc Search {string} {
  global StringFound SeaCur StrLen
  if {$string == ""} {
    return
  }
  catch {
    .win.text tag remove emph $SeaCur "$SeaCur + $StrLen char"
    set SeaCur [.win.text index "$SeaCur + $StrLen char"]
    set SeaCur [.win.text search -count StrLen $string $SeaCur end]
    if {$SeaCur == ""} {
      toplevel .end
      wm title .end "End of file"
      label .end.lbl1 -text "End of file."
      label .end.lbl2 -text "Click on window to finish."
      pack .end.lbl1 .end.lbl2 -side top -padx 5 -pady 5
      bind .end <ButtonPress> {destroy .end}
      tkwait window .end
      set SeaCur 1.0
      set StrLen 0
      set StringFound 0
    } else {
      .win.text tag add emph $SeaCur "$SeaCur + $StrLen char"
      .win.text see $SeaCur
      set StringFound 1
      .win.text tag configure emph -background black -foreground white
    }
  }
}

# Replace procedure #
proc Replace {replstr} {
  global StringFound SeaCur StrLen
  if {!$StringFound} {
    return
  } else {
    .win.text delete $SeaCur "$SeaCur + $StrLen char" 
    .win.text insert  $SeaCur $replstr
    set StringFound 0
    set Change 1
  }
}

# Replace all procedure #
proc ReplaceAll {seastr replstr} {
  set cur 1.0
  set counter 0
  if {$seastr == ""} {
    return
  }
  while 1 {
    .win.text tag remove search 0.0 end
    set cur [.win.text search -count length $seastr $cur end]
    if {$cur == ""} {
      break
    }
    .win.text delete $cur "$cur + $length char" 
    .win.text insert  $cur $replstr
    set cur [.win.text index "$cur + $length char"]
    incr counter 1
  }
  catch {
    toplevel .finish
    wm title .finish "Finished"
    label .finish.lbl1 -text "$counter words were substitued."
    label .finish.lbl2 -text "Click on window to finish."
    pack .finish.lbl1 .finish.lbl2 -side top -padx 5 -pady 5
    bind .finish <ButtonPress> {destroy .finish}
    set Change 1
  }
}

## Junp procedure ##
proc GotoLine {} {
  toplevel .goto
  wm title .goto "Go to"
  frame .goto.line
  pack .goto.line -side top
    label .goto.line.lbl -text "Go to line: "
    entry .goto.line.ent -textvariable goline
    pack .goto.line.lbl .goto.line.ent -padx 5 -pady 5 -side left
  frame .goto.btn -relief groove -bd 3
  pack .goto.btn -side bottom -fill x
    button .goto.btn.go -text "Go" -width 5 -command {set tmp $goline ; catch {.win.text yview -pickplace [append tmp ".1"] } }
    button .goto.btn.cancel -text "Cancel" -width 5 -command {destroy .goto; return}
    pack .goto.btn.go -side left -padx 5 -pady 5 -fill x
    pack .goto.btn.cancel -side right -padx 5 -pady 5 -fill x
  bind .goto.line.ent <KeyPress-Return> {set tmp $goline ;catch {.win.text yview -pickplace [append tmp ".1"] } }
  bind .goto.btn.go <KeyPress-Return> {set tmp $goline ;catch {.win.text yview -pickplace [append tmp ".1"] } }
  bind .goto <KeyPress-Escape> { destroy .goto; return }
  bind .goto.btn.cancel <KeyPress-Return> { destroy .goto; return }
  focus .goto.line.ent
}

## Get SeaCursor position ##
proc GetLine {} {
  global CurPos
  set pos [.win.text index insert] 
  set CurPos [string range $pos 0 [expr [string first "." $pos]-1]]
  append CurPos ":" [expr [string range $pos [expr [string first "." $pos]+1] end]+1]
}

## Help procedures ##
# About Box #
proc AboutBox {} {
  toplevel .about
  wm title .about "About..."
  wm maxsize .about 120 80
  wm minsize .about 120 80
  text .about.text
  pack .about.text -side top
  .about.text tag configure Big -font "-*-times-bold-i-normal-*-*-240-*-*-*-*-*-*" -foreground DarkBlue
  .about.text tag configure Name -font "-*-helvetica-bold-r-normal-*-*-140-*-*-*-*-*-*"
  .about.text insert end "  pTkEdit\n" Big
  .about.text insert end "     ver0.3.1\n"
  .about.text insert end "       by "
  .about.text insert end "iga\n" Name
  .about.text insert end "   1997.04.26"
  .about.text configure -state disabled
  bind .about <Button-1> {destroy .about}
}

### Main Routine ###
set tk_strictMotif 1
set FileName ""
set SeaCur 1.0
set StrLen 0
set CurPos 1:1
set StringFound 0
set Change 0

# Open command line file #
if $argc>0 {
  set FileName [lindex $argv 0]
  if {[file exists $FileName] == 1} {
    OpenFile $FileName
  }
}

# eof
