# jhtml-mode.tcl - mode for rich-text hypertext documents
######################################################################

::jldb::set_defaults {
  {menu:jhtml {HTML} 1}
  {menu:sections {Sections} 0}
  {mode:jhtml:show_tags {Show Tags at Insert...} -1 {} {[5]}}
  {mode:jhtml:mkx_anchor {Anchor Name...} 7 {} {[6]}}
  {mode:jhtml:mkx_anchor_link {Local Cross Reference...} 0 {} {[7]}}
  {mode:jhtml:mkx_url {Link to URL...} 8 {} {[8]}}
  {mode:jhtml:mkx_manpage {Man Page Reference...} 4 {} {[9]}}
  {mode:jhtml:mkx_email {Email Reference...} 1}
  {mode:jhtml:literal {Literal HTML Text} 8}
  {mode:jhtml:ps_literal {Literal PostScript Text}}
  {mode:jhtml:hr {Horizontal Rule} 11}
  {mode:jhtml:title {Document Title} 9}
  {mode:jhtml:stylesheet {CSS Stylesheet} -1}
  {mode:jhtml:body_background {Background Image}}
  {mode:jhtml:body_bgcolor {Background Colour}}
  {mode:jhtml:body_text {Text Colour}}
  {mode:jhtml:body_link {Link Colour}}
  {mode:jhtml:body_vlink {Visited Link Colour}}
  {mode:jhtml:body_alink {Active Link Colour}}
  {mode:jhtml:import {Import...} 0}
  
  {{(new file)} {(new file)}}
  {{Link Name} {Link Name}}
  {{Link to:} {Link to:}}
  {{Anchor Name} {Anchor Name}}
  {{Anchor name:} {Anchor name:}}
  {{Manual page} {Manual page}}
  {{Manual page:} {Manual page:}}
  {{URL} {URL}}
  {{URL:} {URL:}}
  {{Email Address} {Email Address}}
  {{Email Address:} {Email Address:}}
  {{Top} {Top}}
  {{Bottom} {Bottom}}
  
  {{Help on jhtml Mode} {Help on `jhtml' Mode}}
}

proc mode:jhtml:init { t } {
  global JEDIT_MODEPREFS
  
  j:read_prefs -array JEDIT_MODEPREFS -prefix jhtml \
    -directory ~/.tk/jeditmodes -file jhtml-defaults {
    {textfont default}
    {textwidth 80}
    {textheight 24}
    {textwrap word}
    {sabbrev 0}
    {dabbrev 0}
    {autobreak 0}
    {autoindent 0}
    {savestate 0}
    {buttonbar 1}
    {buttons {
      jedit:cmd:save
      jedit:cmd:done
      jedit:cmd:print_postscript
    }}
    {docs {
      -
      {{Help on jhtml Mode} {jeditmodes/jhtml-mode.jdoc}}
    }}
    {menu,editor 1}
    {menu,file 1}
    {menu,edit 1}
    {menu,prefs 0}
    {menu,abbrev 1}
    {menu,filter 1}
    {menu,format 1}
    {menu,font 1}
    {menu,display 1}
    {menu,mode1 1}
    {menu,mode2 1}
    {menu,user 1}
  }

  $t tag bind jdoc:xref:link <Control-ButtonRelease-1> \
    {jdoc:x_link %W %x %y}
  $t tag bind jdoc:xref:manpage <Control-ButtonRelease-1> \
    {jdoc:x_manpage %W %x %y}
  
  $t tag configure jdoc:xref:link -underline 1
  $t tag configure jdoc:xref:manpage -underline 1
    
  $t tag configure special:html:literal -borderwidth 2 -relief sunken
  $t tag configure special:ps:literal -borderwidth 2 -relief groove
  catch {
    $t tag configure special:html:literal \
      -font -*-courier-bold-r-*-*-*-120-*-*-*-*-*-*
  }
  catch {
    $t tag configure special:ps:literal \
      -font -*-helvetica-bold-r-*-*-*-120-*-*-*-*-*-*
  }
  $t tag configure special:hr:normal \
    -font nil2 -background black
  
  # need to wait until normal font tags have been created for following:
  after idle [list $t tag raise special:hr:normal]
  after idle [list $t tag raise special:html:literal]
  after idle [list $t tag raise special:ps:literal]
  
  # not marked in browsers, but marked here so you get visual feedback
  # when you create them:
  $t tag configure jdoc:anchor:anchorname -relief sunken -borderwidth 2
  $t tag lower jdoc:anchor:anchorname
  $t tag configure jhtml:anchor:anchorname -relief sunken -borderwidth 2
  $t tag lower jhtml:anchor:anchorname
  
  # (and list tags are set after loading a file or when invoking list commands)
}

######################################################################
# save entire contents of text widget, including tags and marks
#   (overrides normal write procedure)
######################################################################

proc mode:jhtml:write { filename t } {
  ::aq::tag::archive_text_widget $t $filename
  
  regsub -- {\.[^.]*$} $filename {} basename
  
  if [string match {*.jhtml} $filename] {
    set htmlname $basename.html
  } else {
    if [string match {*.jht} $filename] {
      set htmlname $basename.htm
    } else {
      set htmlname $filename.html
    }
  }
  
  ::aq::write_file $htmlname [::aq::tc::html_convert_text $t]
}

######################################################################
# read in archive of text widget, including tags and marks
#   (overrides normal read procedure)
######################################################################

proc mode:jhtml:read { filename t } {
  jedit:font:roman $t				;# start tagging as roman
  if { ! [file exists $filename] } then {
    $t delete 1.0 end
      if {[string match -nocase http://* $filename]} {
        # this is out of ::aq::tag::restore_text_widget;
        # should be consolidated.
        set archive [::aq::read_file $filename]
        
        set text [lindex $archive 0]
        set state [lindex $archive 1]
        set metainfo [lindex $archive 2]
        
        set state_option \
          [lindex [$t configure -state] 4]		;# in case it's disabled
        $t configure -state normal			;# make sure we can change
        
        $t delete 1.0 end
        $t insert end $text
        ::aq::tag::set_annotation $t $state		;# set tags and marks
        
        $t configure -state $state_option		;# might have been disabled
        set j_textinfo($t) $metainfo			;# set out-of-band metainfo
      }
    $t mark set insert 1.0
    jedit:set_label $t "$filename [::jldb::long_text {(new file)}]"
  } else {					;# file exists
    ::aq::tag::restore_text_widget $t $filename
    global JEDIT_MODEPREFS
    if { ! $JEDIT_MODEPREFS(jhtml,savestate) } {
      $t tag remove sel 1.0 end
      $t mark set insert 1.0
      $t yview 1.0
    }
  }
  set body_link [::aq::tag::get_metainfo $t body_link]
  if ![string match {} $body_link] {
    catch {
      $t tag configure jdoc:xref:link -foreground $body_link -underline 0
    }
    catch {
      $t tag configure jdoc:xref:manpage -foreground $body_link -underline 0
    }
  } else {
    $t tag configure jdoc:xref:link -underline 1
    $t tag configure jdoc:xref:manpage -underline 1
  }
  
  set body_text [::aq::tag::get_metainfo $t body_text]
  if ![string match {} $body_text] {
    catch {$t configure -foreground $body_text}
  }

  set body_bgcolor [::aq::tag::get_metainfo $t body_bgcolor]
  if ![string match {} $body_bgcolor] {
    catch {$t configure -background $body_bgcolor}
  }
  jedit:format:configure_all_list_tags $t
}

######################################################################
# show tags at insert point (useful for seeing anchor names, etc.)
######################################################################
### THIS SHOULD BE ADDED TO BASE JEDIT FUNCTIONALITY

::aq::command_register mode:jhtml:show_tags {}
proc mode:jhtml:show_tags { t } {
  set tags [$t tag names insert]
  ::aq::more \
    -title [= "Current Tags"] \
    -width 40 -height 10 \
    -text [join [lsort $tags] "\n"]
}

######################################################################
# literal HTML text
######################################################################

::aq::command_register mode:jhtml:literal {}
proc mode:jhtml:literal { t } {
  set start [$t index sel.first]
  set end [$t index sel.last]
  
  # make sure it's all a single range:
  foreach tag [$t tag names] {
    $t tag remove $tag $start $end
  }
  
  $t tag add special:html:literal $start $end
  
  # because default is typewriter if there's no font tag:
  $t tag add richtext:font:roman $start $end
}

######################################################################
# literal PostScript text
# This really shouldn't be here, but jhtml mode is what I use for
#   generating things like labels, bar codes, etc., and letting me
#   insert literal PostScript lets me set margins, position text,
#   set colours, etc.
######################################################################

::aq::command_register mode:jhtml:ps_literal {}
proc mode:jhtml:ps_literal { t } {
  set start [$t index sel.first]
  set end [$t index sel.last]
  
  # make sure it's all a single range:
  foreach tag [$t tag names] {
    $t tag remove $tag $start $end
  }
  
  $t tag add special:ps:literal $start $end
  
  # because default is typewriter if there's no font tag:
  $t tag add richtext:font:roman $start $end
}


######################################################################
# horizontal rule
######################################################################

::aq::command_register mode:jhtml:hr {}
proc mode:jhtml:hr { t } {
  set start [$t index insert]
  j:text:insert_string $t "\n"		;# coloured newline for rule
  $t tag add special:hr:normal $start	;# list item at level 1
}

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

proc mode:jhtml:mkx_anchor { t } {
  set from [$t index sel.first]
  set to [$t index sel.last]
  set anchor [string trim [$t get $from $to]]
  regsub -all -- {[ +-]} $anchor {_} anchor
  set anchor [::aq::prompt -title "Anchor Name" -text "Anchor name:" \
    -default $anchor]
  
  if {"x$anchor" == "x"} {
    return 1
  }
  
  foreach tag [list \
    jhtml:anchor:anchorname \
    jhtml:anchorname:$anchor \
  ] {
    ::aq::tag::tag_text $t $tag $from $to
  }
  return 0
}

proc mode:jhtml:mkx_url { t } {
  set from [$t index sel.first]
  set to [$t index sel.last]
  set selection [string trim [$t get $from $to]]
  switch -glob -- $selection {
    *<*@*>* {
      regsub -- {.*<([^@]*@[^>]*)>.*} $selection {mailto:\1} link
    }
    *.txt -		*.htm -		*.html -
    *.zip -		*.gz -		*.tgz -
    *.tar -		*.hqx -		*.gif -
    *.jpg -		*.jpeg -	*.png -
    *.snd -		*.wav -		*.au -
    *.aiff -		*.ps -		*.eps -
    *.pdf -		*.pdb -		*.prc -
    *.TXT -		*.HTM -		*.HTML -
    *.ZIP -		*.GZ -		*.TGZ -
    *.TAR -		*.HQX -		*.GIF -
    *.JPG -		*.JPEG -	*.PNG -
    *.SND -		*.WAV -		*.AU -
    *.AIFF -		*.PS -		*.EPS -
    *.PDF -		*.PDB -		*.PRC -
    mailto:* -
    */ -
    *://* {
      set link $selection
    }
    *@* {
      set link mailto:$selection
    }
    default {
      set link $selection.html
      set link "[string trim [$t get $from $to]].html"
      regsub -all -- {[ +-]} $link {_} link
    }
  }
  
  set link [::aq::prompt -file 1 -title "URL" -text "URL:" \
    -default $link -file 1 -history url]
  
  if {"x$link" == "x"} {
    return 1
  }
  
  foreach tag [list \
    jdoc:xref:link \
    jdoc:link:$link \
  ] {
    ::aq::tag::tag_text $t $tag $from $to
  }
  return 0
}

proc mode:jhtml:mkx_anchor_link { t } {
  set from [$t index sel.first]
  set to [$t index sel.last]
  set link "#[string trim [$t get $from $to]]"
  regsub -all -- {[ +-]} $link {_} link
  set link [::aq::prompt -title "Link Name" -text "Link to:" \
    -default $link -file 1]
  
  if {"x$link" == "x"} {
    return 1
  }
  
  foreach tag [list \
    jdoc:xref:link \
    jdoc:link:$link \
  ] {
    ::aq::tag::tag_text $t $tag $from $to
  }
  return 0
}

proc mode:jhtml:mkx_manpage { t } {
  set from [$t index sel.first]
  set to [$t index sel.last]
  set manpage [string trim [$t get $from $to]]
  set manpage [::aq::prompt -title "Link Name" -text "Manual page:" \
    -default $manpage -history manpage]
  
  if {"x$manpage" == "x"} {
    return 1
  }
  
  foreach tag [list \
    jdoc:xref:manpage \
    jdoc:manpage:$manpage \
    richtext:font:typewriter \
  ] {
    ::aq::tag::tag_text $t $tag $from $to
  }
  return 0
}


######################################################################
# make email reference (fixed-pitch font, in <>, mailto: link)
######################################################################
### PROBLEM - should remember current tags

proc mode:jhtml:mkx_email { t } {
  set emailaddr [::aq::prompt \
    -title "Email Address" \
    -text "Email Address:" \
    -history email \
    -default [::aq::selection_if_any]]
  if {[j:text:has_selection $t] && [j:text:insert_touches_selection $t]} {
    j:text:delete $t sel.first sel.last
  }
  ::aq::tag::set_tag $t richtext:font:l_samp
  ::aq::tag::set_tag $t jdoc:xref:link
  ::aq::tag::set_tag $t jdoc:link:mailto:$emailaddr
  j:text:insert_string $t "<$emailaddr>"
  ::aq::tag::clear_tags $t
  jedit:font:roman $t
}
######################################################################
# mode:jhtml:mksectionsmenu menu t - find all level 1 headings in text
######################################################################

proc mode:jhtml:mksectionsmenu { menu t } {
  set ranges [$t tag ranges richtext:font:heading1]
  set sections {}
  
  ;# step through ranges two-at-a-time (start and end)
  while { [llength $ranges] > 0 } {
    set start [lindex $ranges 0]
    set end [lindex $ranges 1]
    set ranges [lreplace $ranges 0 1]	;# with nothing, ie shift
    set section_name [string trim [$t get $start $end]]
    set section_name [lindex [split $section_name "\n"] 0]
    lappend sections [list $section_name $start]
  }
  
  $menu delete 0 last
  
  $menu add command -label [::jldb::long_text "Top"] -command \
    "$t mark set insert 1.0; $t yview -pickplace insert"
  $menu add separator
  foreach pair $sections {
    set section [lindex $pair 0]
    set location [lindex $pair 1]
    $menu add command -label $section \
      -command "$t mark set insert $location; $t yview insert"
  }
  $menu add separator
  $menu add command -label [::jldb::long_text "Bottom"] -command \
    "$t mark set insert end; $t yview -pickplace insert"
}

######################################################################
# specify document title
######################################################################

::aq::command_register mode:jhtml:title {}
proc mode:jhtml:title { t args } {
  set current_title [::aq::tag::get_metainfo $t title]
  set title [::aq::prompt \
    -text [::jldb::long_text mode:jhtml:title] \
    -default $current_title \
    -file 1]
  if [string length $title] {
    ::aq::tag::set_metainfo $t title $title
  } else {
    ::aq::tag::delete_metainfo $t title
  }
}

######################################################################
# specify document CSS stylesheet
######################################################################

::aq::command_register mode:jhtml:stylesheet {}
proc mode:jhtml:stylesheet { t args } {
  set current_stylesheet [::aq::tag::get_metainfo $t stylesheet]
  set stylesheet [::aq::prompt \
    -text [::jldb::long_text mode:jhtml:stylesheet] \
    -default $current_stylesheet \
    -file 1]
  if [string length $stylesheet] {
    ::aq::tag::set_metainfo $t stylesheet $stylesheet
  } else {
    ::aq::tag::delete_metainfo $t stylesheet
  }
}

######################################################################
# specify background image
######################################################################

::aq::command_register mode:jhtml:body_background {}
proc mode:jhtml:body_background { t args } {
  set background [::aq::prompt \
    -text [::jldb::long_text mode:jhtml:body_background] \
    -file 1]
  if [string length $background] {
    ::aq::tag::set_metainfo $t body_background $background
  } else {
    ::aq::tag::delete_metainfo $t body_background
  }
}

######################################################################
# specify colours
######################################################################

::aq::command_register mode:jhtml:body_bgcolor {}
proc mode:jhtml:body_bgcolor { t args } {
  set bgcolor [::aq::tag::get_metainfo $t body_bgcolor -default #ffffff]
  set bgcolor [::aq::prompt_colour_rgb \
    -default $bgcolor \
    -prompt [::jldb::long_text mode:jhtml:body_bgcolor]]
  ::aq::tag::set_metainfo $t body_bgcolor $bgcolor
  catch {$t configure -background $bgcolor}
}

::aq::command_register mode:jhtml:body_text {}
proc mode:jhtml:body_text { t args } {
  set text [::aq::tag::get_metainfo $t body_text -default #000000]
  set text [::aq::prompt_colour_rgb \
    -default $text \
    -prompt [::jldb::long_text mode:jhtml:body_text]]
  ::aq::tag::set_metainfo $t body_text $text
  catch {$t configure -foreground $text}
}

::aq::command_register mode:jhtml:body_link {}
proc mode:jhtml:body_link { t args } {
  set link [::aq::tag::get_metainfo $t body_link -default #0000ff]
  set link [::aq::prompt_colour_rgb \
    -default $link \
    -prompt [::jldb::long_text mode:jhtml:body_link]]
  ::aq::tag::set_metainfo $t body_link $link
  catch {$t tag configure jdoc:xref:link -foreground $link -underline 0}
  catch {$t tag configure jdoc:xref:manpage -foreground $link -underline 0}
}

::aq::command_register mode:jhtml:body_vlink {}
proc mode:jhtml:body_vlink { t args } {
  set vlink [::aq::tag::get_metainfo $t body_vlink -default #000080]
  set vlink [::aq::prompt_colour_rgb \
    -default $vlink \
    -prompt [::jldb::long_text mode:jhtml:body_vlink]]
  ::aq::tag::set_metainfo $t body_vlink $vlink
}

::aq::command_register mode:jhtml:body_alink {}
proc mode:jhtml:body_alink { t args } {
  set alink [::aq::tag::get_metainfo $t body_alink -default #ff0000]
  set alink [::aq::prompt_colour_rgb \
    -default $alink \
    -prompt [::jldb::long_text mode:jhtml:body_alink]]
  ::aq::tag::set_metainfo $t body_alink $alink
}

######################################################################
######################################################################
### HTML IMPORT PROCEDURES
######################################################################
######################################################################

######################################################################
proc mode:jhtml:put_text { WIDGET text } {
  regsub -all -nocase -- {&lbrace;} $text \{ text
  regsub -all -nocase -- {&rbrace;} $text \} text
  regsub -all -nocase -- {&bslash;} $text {\\} text
  regsub -all -nocase -- {&lt;} $text {<} text
  regsub -all -nocase -- {&gt;} $text {>} text
  regsub -all -nocase -- {&amp;} $text {\&} text

  ::aq::tag::insert_string $WIDGET $text
  $WIDGET see end
  update
}

proc mode:jhtml:start_tag { WIDGET html_tag } {
  switch -glob -- [string tolower $html_tag] {
    {<i>} {
      ::aq::tag::set_tag $WIDGET richtext:font:italic
    }
    {<b>} {
      ::aq::tag::set_tag $WIDGET richtext:font:bold
    }
    {<tt>} {
      ::aq::tag::set_tag $WIDGET richtext:font:typewriter
    }
    {<em>} {
      ::aq::tag::set_tag $WIDGET richtext:font:l_em
    }
    {<cite>} {
      ::aq::tag::set_tag $WIDGET richtext:font:l_cite
    }
    {<var>} {
      ::aq::tag::set_tag $WIDGET richtext:font:l_var
    }
    {<dfn>} {
      ::aq::tag::set_tag $WIDGET richtext:font:l_dfn
    }
    {<strong>} {
      ::aq::tag::set_tag $WIDGET richtext:font:l_strong
    }
    {<kbd>} {
      ::aq::tag::set_tag $WIDGET richtext:font:l_kbd
    }
    {<code>} {
      ::aq::tag::set_tag $WIDGET richtext:font:l_code
    }
    {<samp>} {
      ::aq::tag::set_tag $WIDGET richtext:font:l_samp
    }
    {<p *>} -
    {<p>} {
      $WIDGET insert end "\n\n" richtext:font:roman
    }
    {<hr>} {
      if {[$WIDGET compare insert != {insert linestart}]} {
        ::aq::tag::insert_string $WIDGET "\n"
      }        
      $WIDGET insert end "\n" {special:hr:normal richtext:font:roman}
    }
    {<h1>} {
      if {[$WIDGET compare insert != {insert linestart}]} {
        ::aq::tag::insert_string $WIDGET "\n"
      }        
      ::aq::tag::set_tag $WIDGET richtext:font:heading0
    }
    {<h2>} {
      if {[$WIDGET compare insert != {insert linestart}]} {
        ::aq::tag::insert_string $WIDGET "\n"
      }        
      ::aq::tag::set_tag $WIDGET richtext:font:heading1
    }
    {<h3>} {
      if {[$WIDGET compare insert != {insert linestart}]} {
        ::aq::tag::insert_string $WIDGET "\n"
      }        
      ::aq::tag::set_tag $WIDGET richtext:font:heading2
    }
    {<h4>} {
      if {[$WIDGET compare insert != {insert linestart}]} {
        ::aq::tag::insert_string $WIDGET "\n"
      }        
      ::aq::tag::set_tag $WIDGET richtext:font:heading3
    }
    {<h5>} {
      if {[$WIDGET compare insert != {insert linestart}]} {
        ::aq::tag::insert_string $WIDGET "\n"
      }        
      ::aq::tag::set_tag $WIDGET richtext:font:heading4
    }
    {<h6>} {
      if {[$WIDGET compare insert != {insert linestart}]} {
        ::aq::tag::insert_string $WIDGET "\n"
      }        
      ::aq::tag::set_tag $WIDGET richtext:font:heading5
    }
    {<br>} {
      if {[$WIDGET compare insert != {insert linestart}]} {
        ::aq::tag::insert_string $WIDGET "\n"
      }        
    }
    {</ol>} -
    {<ul>} {
      if {[$WIDGET compare insert != {insert linestart}]} {
        ::aq::tag::insert_string $WIDGET "\n"
      }        
      jedit:format:nest_list $WIDGET
    }
    {<li>} {
      if {[$WIDGET compare insert != {insert linestart}]} {
        ::aq::tag::insert_string $WIDGET "\n"
      }        
      jedit:format:list_item $WIDGET
    }
    {<a *href=*} {
      set link ""
      regsub -nocase -all -- {.* href="([^">]*).*} $html_tag {\1} link
      if {[string length $link]} {
        ::aq::tag::set_tag $WIDGET jdoc:xref:link
        ::aq::tag::set_tag $WIDGET jdoc:link:$link
      }
    }
    {<a *name=*} {
      set name ""
      regsub -nocase -all -- {.* name="([^">]*).*} $html_tag {\1} name
      if {[string length $name]} {
        ::aq::tag::set_tag $WIDGET jdoc:anchor:anchorname
        ::aq::tag::set_tag $WIDGET jdoc:anchorname:$name
      }
    }
    {<a[^a-z]*} {
      # some <a> tag I don't understand; ignore it
    }
    {<!doctype*>} -
    {<html>} -
    {<head>} -
    {<body*>} {
      # ignore these tags
    }
    default {
      $WIDGET insert insert $html_tag {special:html:literal richtext:font:roman}
    }
  }
}

proc mode:jhtml:end_tag { WIDGET html_tag } {
  switch -glob -- [string tolower $html_tag] {
    {</i>} -
    {</b>} -
    {</tt>} -
    {</em>} -
    {</cite>} -
    {</var>} -
    {</dfn>} -
    {</strong>} -
    {</kbd>} -
    {</code>} -
    {</samp>} {
      ::aq::tag::set_tag $WIDGET richtext:font:roman
    }
    {</h[0-9]>} {
      if {[$WIDGET compare insert != {insert linestart}]} {
        ::aq::tag::insert_string $WIDGET "\n"
      }        
      ::aq::tag::set_tag $WIDGET richtext:font:roman
    }
    {</a>} {
      ::aq::tag::clear_tag $WIDGET *:xref:*
      ::aq::tag::clear_tag $WIDGET *:link:*
      ::aq::tag::clear_tag $WIDGET *:anchor:*
      ::aq::tag::clear_tag $WIDGET *:anchorname:*
    }
    {</ol>} -
    {</ul>} {
      if {[$WIDGET compare insert != {insert linestart}]} {
        ::aq::tag::insert_string $WIDGET "\n"
      }        
      jedit:format:unnest_list $WIDGET
    }
    {</p>} -
    {</html>} -
    {</head>} -
    {</body>} {
      # ignore these tags
    }
    default {
      $WIDGET insert insert $html_tag {special:html:literal richtext:font:roman}
    }
  }
}

::aq::command_register mode:jhtml:import {}
proc mode:jhtml:import {w args} {
  global WIDGET
  set WIDGET $w
  ::aq::tag::set_tags $w richtext:font:roman
  
  set file [::aq::fs]
  set fd [open $file r]
  set html [read $fd]
  close $fd
  
  ######################################################################
  # get rid of characters that might mess up Tcl list processing:
  
  set html [join [split $html "\n"] "&newline;"]
  regsub -all \{ $html {\&lbrace;} html
  regsub -all \} $html {\&rbrace;} html
  regsub -all {\\} $html {\&bslash;} html
  
  # change newlines (in original HTML source) into spaces
  regsub -all {(&newline;)+} $html { } html
  
  # fold sequences of whitespace into a single space character
  regsub -all "\[\t \]\[\t \]+" $html { } html
  
  # eliminate whitespace around paragraphs, breaks, or rules
  regsub -nocase -all " *<p> *" $html {<p>} html
  regsub -nocase -all " *</p> *" $html {</p>} html
  regsub -nocase -all " *<br> *" $html {<br>} html
  regsub -nocase -all " *<hr> *" $html {<hr>} html
  
  # eliminate whitespace after opening tags and before closing tags
  regsub -all {(<[^/][^>]*>) } $html {\1} html
  regsub -all { (</[^>]*>)} $html {\1} html
  
  ######################################################################
  # simulate some stuff we don't handle yet:
  regsub -all {<ol>} $html {<ul>} html
  regsub -all {<dl>} $html {<ul>} html
  regsub -all {</ol>} $html {</ul>} html
  regsub -all {</dl>} $html {</ul>} html
  regsub -all {<dt>} $html {<li>} html
  regsub -all {<dd>} $html {<br>} html
  ######################################################################

  set html "mode:jhtml:put_text [list $w] {$html}"
  
  # convert opening tags into "mode:jhtml:start_tag $w <tag>" commands
  regsub -all {<[^/<>][^<>]*>} $html \
    "\}\nmode:jhtml:start_tag $w {&}\nmode:jhtml:put_text $w \{" html
  # convert closing tags into "mode:jhtml:end_tag $w <tag>" commands
  regsub -all {</[^<>]*>} $html \
    "\}\nmode:jhtml:end_tag $w {&}\nmode:jhtml:put_text $w \{" html

  # execute the sequence of commands we've just turned the HTML into
  eval $html
}

######################################################################
######################################################################
### END HTML IMPORT PROCEDURES
######################################################################
######################################################################

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

proc mode:jhtml:mkmenu1 { menu t } {
  j:menu:menubutton $menu $menu.m menu:jhtml
  
  j:menu:commands $menu.m $t {
    mode:jhtml:show_tags
    mode:jhtml:mkx_anchor
    mode:jhtml:mkx_anchor_link
    mode:jhtml:mkx_url
    mode:jhtml:mkx_manpage
    mode:jhtml:mkx_email
    -
    mode:jhtml:literal
    -
    mode:jhtml:hr
    -
    mode:jhtml:title
    mode:jhtml:stylesheet
    mode:jhtml:body_background
    mode:jhtml:body_bgcolor
    mode:jhtml:body_text
    mode:jhtml:body_link
    mode:jhtml:body_vlink
    mode:jhtml:body_alink
    -
    mode:jhtml:ps_literal
    -
    mode:jhtml:import
  }
  
  bind $t <Meta-Key-1> "jedit:font:heading1 $t"
  bind $t <Meta-Key-2> "jedit:font:heading2 $t"
  bind $t <Meta-Key-3> "jedit:font:heading3 $t"
  bind $t <Meta-Key-5> "mode:jhtml:show_tags $t"
  bind $t <Meta-Key-6> "mode:jhtml:mkx_anchor $t"
  bind $t <Meta-Key-7> "mode:jhtml:mkx_anchor_link $t"
  bind $t <Meta-Key-8> "mode:jhtml:mkx_url $t"
  bind $t <Meta-Key-9> "mode:jhtml:mkx_manpage $t"
}

proc mode:jhtml:mkmenu2 { menu t } {
  j:menu:menubutton $menu $menu.m menu:sections
  
  $menu.m configure -postcommand "mode:jhtml:mksectionsmenu $menu.m $t"
}




