# ~/.tk/edittkmodes/help-init.tcl - set up to edit jhelp help files
######################################################################

proc mode:help:init { t } {
  global JEDIT_MODEPREFS TEXTWIDGET CURRENTSECTION
  
  j:read_prefs -array JEDIT_MODEPREFS -prefix help \
    -directory ~/.tk/jeditmodes -file help-defaults {
    {textfont default}
    {textwidth 70}
    {textheight 24}
    {textwrap word}
    {sabbrev 0}
    {dabbrev 0}
    {autobreak 0}
    {autoindent 1}
    {savestate 0}
    {buttonbar 1}
    {menu,editor 1}
    {menu,file 1}
    {menu,edit 1}
    {menu,prefs 0}
    {menu,abbrev 1}
    {menu,filter 1}
    {menu,format 1}
    {menu,display 1}
    {menu,mode1 0}
    {menu,mode2 0}
    {menu,user 1}
  }

  global TEXTWIDGET; set TEXTWIDGET $t
  global CURRENTSECTION; set CURRENTSECTION {}
  toplevel .l
  label .l.section -textvariable CURRENTSECTION
  pack .l -expand yes
  
  j:rt:mkabbrevs

  $TEXTWIDGET tag configure xref-topic \
    -underline 1
  $TEXTWIDGET tag configure xref-section \
    -underline 1
  $TEXTWIDGET tag configure xref-manpage \
    -underline 1
  
  $TEXTWIDGET tag bind xref-topic <ButtonRelease-1> {x_topic %W %x %y}
  $TEXTWIDGET tag bind xref-section <ButtonRelease-1> {x_section %W %x %y}
  $TEXTWIDGET tag bind xref-manpage <ButtonRelease-1> {x_manpage %W %x %y}
}

proc configure_widget {{w .main.t}} {
  $w tag configure j:rt:rm -font *-helvetica-medium-r-normal--*-120-*
  $w configure -font *-helvetica-medium-r-normal--*-120-*
  $w tag configure j:rt:it -font *-helvetica-medium-o-normal--*-120-* \
    -background grey66 -borderwidth 2 -relief raised
  $w tag configure j:rt:bf -font *-helvetica-bold-r-normal--*-120-* \
    -background grey66 -borderwidth 2 -relief raised
  $w tag configure j:rt:bi -font *-helvetica-bold-o-normal--*-120-* \
    -background grey66 -borderwidth 2 -relief raised
  $w tag configure j:rt:tt -font *-courier-medium-r-normal--*-120-* \
    -background grey66 -borderwidth 2 -relief raised
  $w tag configure j:rt:hl -font *-helvetica-bold-o-normal--*-140-* \
    -background grey66 -borderwidth 2 -relief raised
  
  $w configure -state normal
}

######################################################################

proc section {title body} {
  global TEXTWIDGET

  if {![winfo exists .menu.sections]} {
    menubutton .menu.sections -text {Sections} -menu .menu.sections.m
    menu .menu.sections.m
    pack append .menu .menu.sections left
  }

  .menu.sections.m add command -label $title -command [format {
    global CURRENTSECTION
    set CURRENTSECTION {%s}
    $TEXTWIDGET configure -state normal
    $TEXTWIDGET delete 1.0 end
    j:rt text $TEXTWIDGET
    eval {%s}
    configure_widget $TEXTWIDGET
    focus $TEXTWIDGET
  } $title $body]
}

######################################################################

proc qsection {title text state} {
  global TEXTWIDGET

  if {![winfo exists .menu.sections]} {
    menubutton .menu.sections -text {Sections} -menu .menu.sections.m
    menu .menu.sections.m
    pack append .menu .menu.sections left
  }

  .menu.sections.m add command -label $title -command [format {
    global CURRENTSECTION
    set CURRENTSECTION {%s}
    $TEXTWIDGET configure -state normal
    $TEXTWIDGET delete 1.0 end
    j:rt text $TEXTWIDGET
    $TEXTWIDGET insert 1.0 %s
    j:tag:set_state $TEXTWIDGET {%s}
    configure_widget $TEXTWIDGET
    focus $TEXTWIDGET
  } $title $text $state]
}

######################################################################

proc tagsel {{tag {}}} {
  set first [.main.t index sel.first]
  set last [.main.t index sel.last]
  set alltags [.main.t tag names]

  foreach oldtag $alltags {
    .main.t tag remove $oldtag $first $last
  }

  if {$tag != {}} {
    .main.t tag add $tag $first $last
  }
}

######################################################################

proc mkx_topic {} {
  set from [.main.t index sel.first]
  set to [.main.t index sel.last]
  set topic [.main.t get $from $to]
  
  .main.t tag add xref-topic $from $to		;# triggers tag binding
  .main.t tag add TOPIC:$topic $from $to	;# used to figure out what
  						;# to show
}

proc mkx_section {} {
  set from [.main.t index sel.first]
  set to [.main.t index sel.last]
  set section [.main.t get $from $to]
  
  .main.t tag add xref-section $from $to	;# triggers tag binding
  .main.t tag add SECTION:$section $from $to	;# used to figure out
  						;# where to go
}

proc mkx_manpage {} {
  set from [.main.t index sel.first]
  set to [.main.t index sel.last]
  set manpage [.main.t get $from $to]
  
  .main.t tag add xref-manpage $from $to	;# triggers tag binding
  .main.t tag add MANPAGE:$manpage $from $to	;# used to figure out
  						;# where to go
}

######################################################################
# x_topic w x y - view help topic clicked on (hypertext)
######################################################################

proc x_topic { {w} {x} {y} } {
  set tags [$w tag names @$x,$y]
  
  foreach tag $tags {				;# find "TOPIC:..." tag
    if [string match "TOPIC:*" $tag] {
      set topic [lindex [split $tag ":"] 1]	;# get topic name
      if [j:confirm -priority 100 -text "View help for `$topic'?"] {
        exec jhelp $topic &
      }
      break
    }
  }
}

######################################################################
# x_section w x y - go to section name clicked on (hypertext)
######################################################################

proc x_section { {w} {x} {y} } {
  set tags [$w tag names @$x,$y]
  
  foreach tag $tags {				;# find "SECTION:..." tag
    if [string match "SECTION:*" $tag] {
      set section [lindex [split $tag ":"] 1]	;# get section name
      if [j:confirm -priority 100 -text "View `$section'?"] {
        .menu.sections.m invoke $section
      }
      break
    }
  }
}

######################################################################
# x_manpage w x y - go to section name clicked on (hypertext)
######################################################################

proc x_manpage { {w} {x} {y} } {
  set tags [$w tag names @$x,$y]
  
  foreach tag $tags {				;# find "SECTION:..." tag
    if [string match "MANPAGE:*" $tag] {
      set manpage [lindex [split $tag ":"] 1]	;# get section name
      if [j:confirm -priority 100 -text "View `$manpage'?"] {
        j:more -height 30 \
          -title "Manual page for `$manpage'" \
          -text [exec man $manpage |& ul -Tdumb 2>@ stdout]
      }
      break
    }
  }
}

######################################################################

proc write_section {{section_name {No Name}}} {
  global FILENAME		;# so it can be default
  append FILENAME {}		;# make sure it's defined

  set prompt_result [j:fs -prompt "Save as:"]
  if {$prompt_result != {} && \
     ( ! [file exists $prompt_result] || \
      [j:confirm \
        -text "File \"$prompt_result\" exists; replace it?"] )} then {
    set FILENAME $prompt_result
  } else {
    return 1
  }
  write_section_to_file $section_name $FILENAME
}

proc write_section_to_file {{section_name} {filename}} {
  set file [open $filename w]
  output_one_section $section_name $file
  close $file
}

proc output_one_section {section_name file} {
  puts $file [list "qsection" "$section_name" \
    [list [.main.t get 1.0 end]] \
    [j:tag:get_state .main.t] \
  ]
  puts $file ""
}

######################################################################

proc compare_indices {i1 i2} {
  set i1split [split $i1 .]
  set i2split [split $i2 .]
  set i1line [lindex $i1split 0]
  set i1column [lindex $i1split 1]
  set i2line [lindex $i2split 0]
  set i2column [lindex $i2split 1]
  
  if {$i1line < $i2line} {
    return -1
  }
  if {$i1line > $i2line} {
    return 1
  }
  if {$i1column < $i2column} {
    return -1
  }
  if {$i1column > $i2column} {
    return 1
  }
  return 0
}

######################################################################

proc get_section_as_richtext {} {
  # needs to handle hypertext
  set w .main.t
  
  set result ""
  set indices [get_indices $w]
  set length [expr {[llength $indices] - 1}]
  
  for {set i 0} {$i < $length} {incr i} {
    set first [lindex $indices $i]
    set last [lindex $indices [expr {$i + 1}]]
    set string [$w get $first $last]
    switch -glob [$w tag names $first] {
      *j:rt:rm* {
        set style rm
      }
      *j:rt:it* {
        set style it
      }
      *j:rt:bf* {
        set style bf
      }
      *j:rt:tt* {
        set style tt
      }
      *j:rt:hl* {
        set style hl
      }
      default {
        set style rm
      }
    }
    append result "$style [list $string]\n"
  }
  return $result
}
    
######################################################################

proc get_indices {w} {
  catch {unset places}
  
  # get a list of unique places in the text where the tagging changes
  set places(1.0) {}
  set places([$w index end]) {}
  foreach tag [$w tag names] {
    foreach index [$w tag ranges $tag] {
      set places($index) {}
    }
  }
  
  set indices [array names places]
  set indices [lsort -command compare_indices $indices]
  return $indices
}

######################################################################

proc jedit:mode_read_proc {filename args} {
  if {[winfo exists .menu.sections]} {
    destroy .menu.sections
  }
  source $filename
  # display the first section of help:
  .menu.sections.m invoke 0
  focus .main.t
}

######################################################################
# define the help menu:

if [winfo exists .menu.help] {
  destroy .menu.help
}

menubutton .menu.help -text {Help} -menu .menu.help.m

menu .menu.help.m
####
.menu.help.m add command -label {View Richtext} -command {
  j:more -text [get_section_as_richtext]
}
.menu.help.m add separator
.menu.help.m add command -label {Roman} -command {tagsel {}}
.menu.help.m add command -label {Italic} -command {tagsel j:rt:it}
.menu.help.m add command -label {Bold} -command {tagsel j:rt:bf}
.menu.help.m add command -label {Bold Italic} -command {tagsel j:rt:bi}
.menu.help.m add command -label {Typewriter} -command {tagsel j:rt:tt}
.menu.help.m add command -label {Headline} -command {tagsel j:rt:hl}
.menu.help.m add separator
.menu.help.m add command -label {Section Cross Reference} \
  -command {mkx_section}
.menu.help.m add command -label {Topic Cross Reference} \
  -command {mkx_topic}
.menu.help.m add command -label {Man Page Cross Reference} \
  -command {mkx_manpage}
.menu.help.m add separator
.menu.help.m add command -label {New Section . . .} -command {
  set title [j:prompt -prompt {Section Title:}]
  section $title {}
  .menu.sections.m invoke $title
}

pack append .menu .menu.help left

j:buttonbar .main.actions -padx 0 -pady 0 -buttons {
  {
    done Done {
      apply_changes_to_section
      jedit:cmd:save
      exit 0
    }
  }
  {
    apply Apply {
      apply_changes_to_section
    }
  }
  {
    topic Topic {
      mkx_topic
    }
  }
  {
    section Section {
      mkx_section
    }
  }
  {
    manpage "Man" {
      mkx_manpage
    }
  }
}

j:buttonbar .main.styles -padx 0 -pady 0 -buttons {
  {roman Roman {tagsel {}}}
  {italic Italic {tagsel j:rt:it}}
  {bold Bold {tagsel j:rt:bf}}
  {bi "BI" {tagsel j:rt:bi}}
  {fixed Fixed {tagsel j:rt:tt}}
  {head "Head" {tagsel j:rt:hl}}
  {newsect "New Section" {
      set title [j:prompt -prompt {Section Title:}]
      section $title {}
      .menu.sections.m invoke $title
    }
  }
}

bind .main.t <Meta-minus> {.main.t insert insert "\255"}

pack .main.actions .main.styles -after .main.status -side top -fill x

proc jedit:mode_cleanup { t } {
  pack unpack .menu.help
  destroy .menu.help
  pack unpack .menu.sections
  destroy .menu.sections
  pack unpack .main.actions
  destroy .main.actions
  pack unpack .main.styles
  destroy .main.styles
  pack unpack .main.status.section
  destroy .main.status.section
  rename configure_widget {}
  rename section {}
  rename qsection {}
  rename tagsel {}
  rename mkx_topic {}
  rename mkx_section {}
  rename x_topic {}
  rename x_section {}
  rename write_section {}
  rename write_section_to_file {}
  rename output_one_section {}
  rename apply_changes_to_section {}
}

