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

::jldb::set_defaults {
  {menu:perl_mode1 {Perl} 0}
  {menu:perl_mode2 {Subs} 2}
  {mode:perl:hash {Comment with #} 0}
    {SHORT-mode:perl:hash {#}}
  {mode:perl:hashes {Comment with ###} 1}
    {SHORT-mode:perl:hashes {###}}
  {mode:perl:uncomment {Uncomment} 0}
  {mode:perl:border {Make Border} 5 <Meta-Key-3>}
    {SHORT-mode:perl:border {Border}}
  
  {perl_pref:hilight_comments {Hilight Comments}}
  
  {{Help on perl Mode} {Help on `perl' Mode}}
}

proc mode:perl:init { t } {
  global JEDIT_MODEPREFS
  
  j:read_prefs -array JEDIT_MODEPREFS -prefix perl \
    -directory ~/.tk/jeditmodes -file perl-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:perl:hash
      mode:perl:hashes
      mode:perl:uncomment
      mode:perl:border
    }}
    {docs {
      -
      {{Help on perl Mode} {jeditmodes/perl-mode.jdoc}}
    }}
    {menu,editor 1}
    {menu,file 1}
    {menu,edit 1}
    {menu,prefs 0}
    {menu,abbrev 1}
    {menu,filter 1}
    {menu,format 0}
    {menu,font 0}
    {menu,display 0}
    {menu,mode1 1}
    {menu,mode2 1}
    {menu,user 1}
    {perl_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 -*-times-medium-i-normal-*-*-120-*
  }
}

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

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

######################################################################
# make Subs menu (mostly done by mode:perl:mksubsmenu)
######################################################################

proc mode:perl:mkmenu2 {menu t} {
  j:menu:menubutton $menu $menu.m menu:perl_mode2
  
  $menu.m configure -postcommand "mode:perl:mksubsmenu $menu $t"
}

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

proc mode:perl: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:perl:post_returnkey_hook { t } {
  set lineno [lindex [split [$t index insert] .] 0]
  if {$lineno == 1} {return 0}
  mode:perl:tag_line [expr {$lineno - 1}] $t
}

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

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

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

proc mode:perl: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:perl: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:perl:tag_line $i $t
  }
}

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

proc mode:perl: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:perl: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:perl:tag_line $i $t
  }
}
  
######################################################################
# find all the subroutines and add them to mode2 menu
#   this is the -command parameter for .menu.mode2
######################################################################

proc mode:perl:mksubsmenu {menu t} {
  set lines [lindex [split [$t index end] .] 0]
  set linelist {}
  
  for {set line 0} {$line <= $lines} {incr line} {
    if [regexp {^sub[ 	]+[a-zA-Z0-9_:.]+.*\{} \
      [$t get $line.0 "$line.0 lineend"]] {
      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 {^sub[ 	]+([a-zA-Z0-9_:.]+).*} $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:perl:tag_line { lineno t } {
  global JEDIT_MODEPREFS
  if {!$JEDIT_MODEPREFS(perl,perl_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 whitespace
  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
  }
}

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

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

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

::aq::command_register mode:perl:hashes {Comment with ###}
proc mode:perl:hashes { t args } {
  jedit:guarantee_selection $t
  mode:perl:prefix "### " $t
}

::aq::command_register mode:perl:hash {Comment with #}
proc mode:perl:hash { t args } {
  jedit:guarantee_selection $t
  mode:perl:prefix "# " $t
}

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

::aq::command_register mode:perl:border {Make Border}
proc mode:perl:border { t } {
  j:text:insert_string $t \
    "###############################################################################\n"
}







