#!/usr/local/Bin/wish
# EDITCL - editor for tcl/tk scripts - 27.11.1996/12.12.1996
#
# copyright by Karsten Goetze       email: goetze@iht.e-technik.th-darmstadt.de
#
# please edit the following lines:

set plist_font fixed                                 ;#font for proclist window
set button_font fixed                                        ;#font for buttons
set insert 2               ;#nr. of indetion characters used in function format
set make_backups 1                    ;#1 = perform backup copies before saving
set append .bak                                  ;#appended on backup filenames
set textcolor {}
# uncomment the next line for black background & white foreground
#set textcolor {-background black -foreground white -selectforeground black -selectbackground white -insertbackground white}


####

set filename [lindex $argv 0]                  ;#get filename from command-line
wm title . "EDITCL   $filename"
wm iconname . $filename

#main text widget
eval "text .t -height 40 -yscroll {.s set} -cursor top_left_arrow $textcolor"

scrollbar .s -command ".t yview"
frame .b
button .b.open -text "OPEN" -command {set of $filename; freq filename} -font $button_font
button .b.load -text "LOAD" -command load -font $button_font
button .b.save -text "SAVE" -command save -font $button_font
button .b.exit -text "EXIT" -command {after idle end} -font $button_font
entry .b.name -textvar filename -relief ridge -font $button_font
label .b.koords -text "NO FILE" -width 16 -relief ridge -font $button_font
button .b.format -text "FORMAT" -command format -font $button_font
button .b.plist -text "PROCLIST" -command plist -font $button_font
button .b.exec -text "SAVE&WISH" -command savewish -font $button_font
button .b.help -text "?" -command help -font $button_font


bind .t <Any-Key> printcoords
bind .t <Shift-Delete> cut
bind .t <Shift-Insert> paste

pack .b.open .b.load .b.save .b.exit .b.name .b.koords -side left
pack .b.help .b.exec .b.plist .b.format -side right

pack .b -side top -fill x                                           ;#statusbar
pack .s -side right -fill y                                         ;#scrollbar
pack .t -fill both -expand 1                            ;#main edit text-widget


set buffer {}                            ;#init empty text-buffer for cut&paste

proc cut {} {                            ;#cut selected text & copies to buffer
  global buffer
 
  set selection [.t tag ranges sel]
  set buffer [.t get [lindex $selection 0] [lindex $selection 1]]
}


proc paste {} {                                                  ;#paste buffer
  global buffer

  set curspos [.t index insert]
  .t insert $curspos $buffer
}


proc strstr_count { str char } {                       ;#counts "char" in "str"
  set a [string first $char $str]
  if {$a > -1} {
    set len [string length $str]
    set count [expr 1+[strstr_count [string range $str [expr $a+1] $len] $char]]
  } else { set count 0 }
  return $count
}


proc format {} {                                     ;#format text in widget .t
  global insert

  set semi_gadde \;
  set semi_gadde ${semi_gadde}#
  set spc {                                             }
  set spc $spc$spc$spc$spc
  set i 0

  wm title . "formatting ... please wait"
  update
  set str {}
  for {set line 1} {$line<=[.t index end]} {incr line} {
    set strprev $str
    set strorig [.t get $line.0 $line.end]
    set str [string trim $strorig]
    if {[string length $str]>0} {
      set cpos [string first $semi_gadde $str]
      set comment {}
      if {$cpos>-1} {                                       ;#Kommentare suchen
        set comment [string range $str [expr $cpos + 2] [string length $str]]
        set str [string range $str 0 [expr $cpos - 1]]
      }
      set str [string trim $str]
      set comment [string trim $comment]
    
      set pre_i 0
      set post_i 0

      if {[string first "\}" $str] == 0} { incr pre_i -$insert } else {
        if {[strstr_count $str \{]+1==[strstr_count $str \}]} {
          incr post_i -$insert
        }
      }
      if {[string length $str]>0} {
        if {[string last "\{" $str] == [string length $str]-1} { incr post_i $insert }
      }
      if {[string last \\ " $strprev"]!=[string length $strprev]} {
        incr i $pre_i
        set strnew [string range $spc 1 $i]$str
        incr i $post_i
      } else {set strnew $strorig}

      if {[string length $comment]>0} {                           ;#format line
        set nrspc [expr 77 - [string length ${strnew}${comment}]]
        set strnew ${strnew}[string range $spc 1 $nrspc]${semi_gadde}${comment}
      }



      .t delete $line.0 $line.end
      .t insert $line.0 $strnew

    }
  }
  wm title . "formatting ready"
  after 2000 {settitle}
}


proc plist {} {                                  ;#shows all procs in a listbox
  global plist_font

  set w .proclistwindow
  catch {destroy $w}
  toplevel $w
  wm title $w "Go to:"
  wm geometry $w +500+300
  listbox $w.lb -width 60 -height 20 -font $plist_font -yscrollcommand "$w.scr set"
  scrollbar $w.scr -command "$w.lb yview"
  button $w.cancel -text "Close" -command "destroy $w"
  pack $w.cancel -side bottom -fill x
  pack $w.scr $w.lb -side right -fill both

  for {set line 1} {$line < [.t index end]} {incr line} {
    set str [.t get ${line}.0 ${line}.end]
    if {[string first "proc " $str]>-1} {
      $w.lb insert end [string range "$line :    $str" 0 58]
    }
  }

  bind $w.lb <Double-ButtonPress> "plist_select $w"
}

proc plist_select {w} {                                     ;#jump to selection
  regexp {^([0-9]*) :} [$w.lb get [$w.lb curselection]] dummy line
  .t see 1.0
  .t see ${line}.0
  $w.lb selection clear $line
}


proc printcoords {} {                             ;#update coords in status bar
  after idle {
    set curspos [.t index insert]
    set lines [expr int([.t index end])]
    .b.koords configure -text "$curspos (${lines})"
    #wm title . "EDITH        [ .t index insert ]      [ .t index end ] "
  }
}


proc savewish {} {                            ;#save text and [wish <filename>]
  global filename
  makebackups
  if {[save] == 0} {
    exec wish $filename &
  }
}


proc load {} {
  global filename
  global of

  set curspos [.t index insert]
  set endpos [.t index end]

  if {![file exists $filename]} {
    tk_dialog .load_dialog LOAD "File \"$filename\" not found." warning 0 OK
  } else {
    set answ 0
    if {$endpos > 4} {
      set answ [tk_dialog .load_dialog LOAD {Text exists} warning 2 Load Append Cancel]
    }
    if {$answ == 0} {                                              ;#erase Text
      while {[.t index end]>2} {.t delete 1.0 2.0}
    }

    if {$answ != 2} {                                               ;#load File
      wm title . "loading $filename"
      set file [ open $filename "r" ]
      while { ! [ eof $file ] } {
        gets $file a
        .t insert end "${a}\n"
      }
      close $file
      printcoords
      after 2000 {settitle}
    }

    if {$answ == 1} {
      set filename $of
    }
  }
}


proc save {} {
  global filename

  set answ 0
  if [file exists $filename] {
    if {abs([file size $filename]-[string length [.t get 1.0 end]])>100} {
      set answ [tk_dialog .save_dialog SAVE "Overwrite file: \"$filename \"?" warning 1 OK Cancel]
    }
  }

  if {$answ == 0} save2
  return $answ                                            ;#needed in save&wish
}

proc save2 {} {
  global filename

  wm title . "writing $filename"
  set file [ open [ .b.name get ] "w" ]
 
  puts $file [.t get 0.0 end]
  close $file
  after 2000 {settitle}
}

proc settitle {} {
  global filename
  wm title . "EDITCL  -  $filename"
  wm iconname . $filename
}

proc makebackups {} {                      ;#make copy from disk-file $filename
  global filename
  global make_backups
  global append

  if $make_backups {
    catch { exec cp $filename ${filename}$append }
  }
}


proc end {} {                                                      ;#exit edith
  global filename

  set save 1
  if {[file exists $filename] && [string length $filename]} {
    if {abs([file size $filename]-[string length [.t get 1.0 end]])<10} {
      set save 0
    }
  }


  if $save {
    set answ 0
    set answ [tk_dialog .save_dialog SAVE "Save file: \"$filename\" ?" warning 0 Yes No]
    if {$answ == 0} save2
  }
  exit
}


proc freq { name } {                                           ;#file requester
  set w .freq
  catch {destroy $w}
  toplevel $w
 
  button $w.bcancel -text CANCEL -command "destroy $w"
  listbox $w.l -height 20 -width 40 -font fixed -yscroll "$w.s set"
  scrollbar $w.s -command "$w.l yview"
  pack $w.bcancel -side bottom -fill x
  pack $w.s $w.l -side right -fill y
  update
  bind $w.l <Double-ButtonPress> "freq_select $w $name"
  freq_getdir $w
}

proc freq_select {w n} {
  global $n
  set index [$w.l curselection]
  set str [$w.l get $index]
  set name [lindex $str [expr [llength $str]-1]]
  if [file isdirectory $name] {
    cd $name
    freq_getdir $w
  } else {
    set $n $name
    after 2000 {settitle}
    after idle "destroy $w ; load"                  ;#close filerequester, load
  }
}

proc freq_getdir {w} {
  wm title $w scanning...
  update
  $w.l delete 0 end
  set a [concat {..} [lsort [glob *]]]
  foreach file $a {
    if [file isdirectory $file] {
      $w.l insert end "D $file"
    } else {
      $w.l insert end "  $file"
    }
  }
  wm title $w [pwd]
}


proc help {} {                                                    ;#need help ?
  set w .help
  catch "destroy $w"
  toplevel $w
  wm title $w

  text $w.t -wrap word -yscrollcommand "$w.s set" -width 60
  scrollbar $w.s -command "$w.t yview"
  button $w.b -text "Close" -command "destroy $w"
  pack $w.b -side bottom -fill x
  pack $w.s -side right -fill y
  pack $w.t -fill both -expand 1
  set line "------------------------------------------------------------\n"

  $w.t insert end $line
  $w.t insert end "EDITCL - text editor for Tcl/Tk - Release B - 12.Dec.96\n"
  $w.t insert end $line
  $w.t insert end "\n"
  $w.t insert end "special edit keys:\n"
  $w.t insert end "\n"
  $w.t insert end "<shift>-<delete>      cut selected text (copies to buffer)\n"
  $w.t insert end "<shift>-<insert>      paste text (from buffer)\n"
  $w.t insert end "<shift>-<crskeys>     select text\n"
  $w.t insert end "\n"
  $w.t insert end "text operations:\n"
  $w.t insert end "\n"
  $w.t insert end "OPEN/LOAD/SAVE        standard file operations\n"
  $w.t insert end "FORMAT                formats text in editor window\n"
  $w.t insert end "PROCLIST              jump to subroutine\n"
  $w.t insert end "SAVE&WISH             save and interpret text using 'wish'\n"
  $w.t insert end "\n"
  $w.t insert end "\n"
  $w.t insert end "This is my personal editor for developping Tcl/Tk apps."
  $w.t insert end "My largest program is about 2000 lines long; syntax-formatting "
  $w.t insert end "gets somewhat slow, but is still useable. "
  $w.t insert end "Saving functions my be buggy, so better leave option \"backup-copies\" enabled (see code for options). "
  $w.t insert end "Pressing the save-button is not required, as long as you are useing the \"save&wish\" function. "
  $w.t insert end "\n\n"
  $w.t insert end $line
  $w.t insert end "THIS CODE COMES WITH NO WARRANTY - USE AT YOUR OWN RISK\n"
  $w.t insert end $line
  $w.t insert end "\n"
  $w.t insert end "copyright by Karsten Goetze\n"
  $w.t insert end "\n"
  $w.t insert end "email: goetze@iht.e-technik.th-darmstadt.de\n"
  $w.t insert end "       meuch@hrz2.hrz.th-darmstadt.de\n"
  $w.t insert end "\n"
  $w.t insert end $line
}



if {[string length $filename]>0} load                ;#load file while start-up







































