######################################################################
# ~/.tk/edittkmodes/tcl-mode.tcl - mode for editing Tcl code
######################################################################

# things it handles well:
#
# frame .foo \
#   -width 10 -height 20 \
#   -background blue
# 
# proc foo {} {
#   global bar
#   if $bar {   ; # comment
#     baz
#   } else { }
# }
# 
# format {
#   %d dollars,
#   %d cents.
# } $dollars $cents
#
# things it handles badly:
#
# proc foo {} { global bar
#   if $bar {
#     baz
#   } else {
#   }    ;# nothing but newline between open and close braces
# }
# 
# set foo {
#   bar
#   baz} ;# close brace not at beginning of line
# 
# catch {
#   $t tag configure comment -foreground grey50 \
#     -font -*-lucida-medium-r-normal-sans-10-100-*
# } ;# last line before close brace is a continuation

j:ldb:set_defaults {
  {menu:tcl_mode1 {Tcl} 0}
  {menu:tcl_mode2 {Procs} 2}
  {mode:tcl:hash {Comment with #} 0}
    {SHORT-mode:tcl:hash {#}}
  {mode:tcl:hashes {Comment with ###} 1}
    {SHORT-mode:tcl:hashes {###}}
  {mode:tcl:uncomment {Un-#} 0}
  {mode:tcl:border {Make Border} 5 <Meta-Key-3>}
    {SHORT-mode:tcl:border {Border}}
  
  {tcl_pref:hilight_comments {Hilight Comments}}
  
  {{Help on tcl Mode} {Help on `tcl' Mode}}
}

proc mode:tcl:init { t } {
  global JEDIT_MODEPREFS
  
  j:read_prefs -array JEDIT_MODEPREFS -prefix tcl \
    -directory ~/.tk/jeditmodes -file tcl-defaults {
    {textfont default}
    {textwidth 80}
    {textheight 24}
    {textwrap char}
    {sabbrev 0}
    {dabbrev 0}
    {autobreak 0}
    {autoindent 1}
    {parenflash 1}
    {savestate 0}
    {buttonbar 1}
    {buttons {
      jedit:cmd:save
      mode:tcl:hash
      mode:tcl:hashes
      mode:tcl:uncomment
      mode:tcl:border
    }}
    {docs {
      -
      {{Help on tcl Mode} {jeditmodes/tcl-mode.jdoc}}
    }}
    {menu,editor 1}
    {menu,file 1}
    {menu,edit 1}
    {menu,prefs 0}
    {menu,abbrev 1}
    {menu,filter 1}
    {menu,format 0}
    {menu,display 0}
    {menu,mode1 1}
    {menu,mode2 1}
    {menu,user 1}
    {tcl_hilight_comments 0}
  }
  
  # There should be a mode-specific preferences panel for this:
  global TCL_MODE
  set TCL_MODE(indent) 2		;# number of chars per nesting level
  
  ######################################################################
  # tags
  
  catch {
    $t tag configure comment \
      -foreground {#4000ff} \
      -font -*-lucida-medium-r-normal-sans-10-100-*
  }
}

######################################################################
# make Tcl menu
######################################################################

proc mode:tcl:mkmenu1 { menu t } {
  global JEDIT_MODEPREFS
  j:menu:menubutton $menu $menu.m menu:tcl_mode1
  
  j:menu:checkbuttons $menu.m [list \
    [list tcl_pref:hilight_comments JEDIT_MODEPREFS(tcl,tcl_hilight_comments)] \
  ]
  j:menu:commands $menu.m $t {
    -
    mode:tcl:hash
    mode:tcl:hashes
    mode:tcl:uncomment
    mode:tcl:border
  }
  
  bind $t <Meta-Key-3> "mode:tcl:border $t"
}

######################################################################
# make Procs menu (mostly done by mode:tcl:mkprocsmenu)
######################################################################

proc mode:tcl:mkmenu2 {menu t} {
  j:menu:menubutton $menu $menu.m menu:tcl_mode2
  
  $menu.m configure -postcommand "mode:tcl:mkprocsmenu $menu $t"
}

######################################################################
# adjust indentation based on nesting
######################################################################

proc mode:tcl:autoindent { t } {
  global TCL_MODE
  
  set indentlevel 0
  set current [$t get {insert linestart} {insert}]
  set prevline [$t get {insert -1lines linestart} {insert -1lines lineend}]
  set antepenult [$t get {insert -2lines linestart} {insert -2lines lineend}]
  
  set indent ""
  regexp "^  *" $prevline indent
  set indentlevel [string length $indent]
  
  set anteindent ""
  regexp "^  *" $antepenult anteindent
  set antelevel [string length $anteindent]
  
  set close "^\[ \t\]*\}"			;# brace at beginning of line
  if {[regexp $close $prevline]} {
    if {$indentlevel == $antelevel && $indentlevel >= $TCL_MODE(indent)} {
      # change current indentation level:
      incr indentlevel -$TCL_MODE(indent)
      # and adjust previous line's indentation:
      $t delete {insert -1lines linestart} \
        "insert -1lines linestart +$TCL_MODE(indent)chars"
    }
  }
  set comment "\{\[ \t;\]*#\[^\}\]*$"		;# brace followed by comment
  if {[regexp "\{$" $prevline] || [regexp $comment $prevline]} {
    incr indentlevel $TCL_MODE(indent)
  }
  if {[string match {*[\]} $prevline]} {	;# line continued
    if {![string match {*[\]} $antepenult]} {
      incr indentlevel $TCL_MODE(indent)
    }
  } else {
    if {[string match {*[\]} $antepenult]} {
      # last line was a continuation, but this one isn't
      incr indentlevel -$TCL_MODE(indent)
    }
  }
  if {$indentlevel < 0} {set indentlevel 0}
  
  for {set i 0} {$i < $indentlevel} {incr i} {
    $t insert insert " "
  }
}

######################################################################
# highlight comments in previous line
######################################################################

proc mode:tcl:post_returnkey_hook { t } {
  set lineno [lindex [split [$t index insert] .] 0]
  if {$lineno == 1} {return 0}
  mode:tcl:tag_line [expr {$lineno - 1}] $t
}

######################################################################
# parse/tag all lines
######################################################################

proc mode:tcl:post_read_hook { filename t } {
  set lastline [lindex [split [$t index end] .] 0]
  for {set i 1} {$i < $lastline} {incr i} {
    mode:tcl:tag_line $i $t
  }
}

######################################################################
# remember insert so we can scan pasted lines
######################################################################

proc mode:tcl:pre_paste_hook { t } {
  global pre_paste_line
  set pre_paste_line [lindex [split [$t index insert] .] 0]
}

######################################################################
# scan all the pasted lines
######################################################################

proc mode:tcl:post_paste_hook { t } {
  global pre_paste_line
  set post_paste_line [lindex [split [$t index insert] .] 0]
  for {set i $pre_paste_line} {$i < $post_paste_line} {incr i} {
    mode:tcl:tag_line $i $t
  }
}

######################################################################
# remember insert so we can scan pasted lines
######################################################################

proc mode:tcl:pre_xpaste_hook { t } {
  global pre_paste_line
  set pre_paste_line [lindex [split [$t index insert] .] 0]
}

######################################################################
# scan all the pasted lines
######################################################################

proc mode:tcl:post_xpaste_hook { t } {
  global pre_paste_line
  set post_paste_line [lindex [split [$t index insert] .] 0]
  for {set i $pre_paste_line} {$i < $post_paste_line} {incr i} {
    mode:tcl:tag_line $i $t
  }
}
  
######################################################################
# find all the procedures and add them to mode2 menu
#   this is the -command parameter for .menu.mode2
######################################################################

proc mode:tcl:mkprocsmenu {menu t} {
  set lines [lindex [split [$t index end] .] 0]
  set linelist {}
  
  for {set line 0} {$line <= $lines} {incr line} {
    if [string match "proc\[ \t\]" [$t get $line.0 "$line.0 +5chars"]] {
      lappend linelist $line
    }
  }
  
  $menu.m delete 0 last
  
  $menu.m add command -label "Top" -command "
    $t mark set insert 0.0
    $t yview -pickplace insert
  "
  $menu.m add separator
  
  foreach line $linelist {
    set text [$t get $line.0 "$line.0 lineend"]
    regsub "^proc\[ \t]*(\[^ \t\]*).*" $text {\1} text
    $menu.m add command -label "$text" -command "
      $t mark set insert $line.0
      $t yview -pickplace insert
    "
  }
  
  $menu.m add separator
  $menu.m add command -label "End" -command "
    $t mark set insert end
    $t yview -pickplace insert
  "
  
  update
}

######################################################################
# highlight comments
######################################################################
#### THIS IS TOO SLOW!
proc mode:tcl:tag_line { lineno t } {
  global JEDIT_MODEPREFS
  if {!$JEDIT_MODEPREFS(tcl,tcl_hilight_comments)} {return 0}
  
  # make sure there's no highlighting already:
  $t tag remove comment "$lineno.0" "$lineno.0 lineend"

  set line [$t get "$lineno.0" "$lineno.0 lineend"]
  
  # if entire line is comment:
  if [regexp -indices "^\[ ;\t]*(#.*)" $line foo indices] {
    set first "$lineno.0 +[lindex $indices 0]chars"
    set last "$lineno.0 lineend"
    $t tag add comment $first $last
    return 0
  }
  # if comment immediately follows a semicolon:
  if [regexp -indices "(;#.*)" $line foo indices] {
    set first "$lineno.0 +[lindex $indices 0]chars"
    set last "$lineno.0 lineend"
    $t tag add comment $first $last
    return 0
  }
}

######################################################################
# apply a prefix to selected lines (or current line)
######################################################################

proc mode:tcl:prefix { prefix t } {
  jedit:guarantee_selection $t
  jedit:text_regsub $t \
    [format {(^|%s)} "\n"] \
    [format {\1%s} $prefix]
}

######################################################################
### command procedures:
######################################################################

j:command:register mode:tcl:hashes {Comment with ###}
proc mode:tcl:hashes { t args } {
  jedit:guarantee_selection $t
  mode:tcl:prefix "### " $t
}

j:command:register mode:tcl:hash {Comment with #}
proc mode:tcl:hash { t args } {
  jedit:guarantee_selection $t
  mode:tcl:prefix "# " $t
}

j:command:register mode:tcl:uncomment {Uncomment}
proc mode:tcl:uncomment { t args } {
  jedit:guarantee_selection $t
  jedit:text_regsub $t \
    [format {(^|%s)#* } "\n"] \
    {\1}
}

j:command:register mode:tcl:border {Make Border}
proc mode:tcl:border { t } {
  j:text:insert_string $t \
    "######################################################################\n"
}







