#!../mofe --f
#

set iconfile edelweb.xpm

set helpText { 
  In French I would call this "HilariT&eacute; MabouLe",
  in German "Sylvesterscherz".  Well, this is the result
  of some few days of learning Tcl, Motif, and mofe.  The
  thing cannot really be called HTML editor but it is
  already helpful.  (Note: This is not a well structured
  documentation of the program. You need to read the
  source if you want to know everything.)

  You can move around in a HTML document directory,
  browse, edit and preview HTML files.  Load a file using
  the Open option. The file is automagically
  previewed. You can now browse through the file and the
  HTML view. If you edit the file, the HTML view is
  automagically updated when you stop editing for a
  second.

  (In order to avoid some nasty remarks from the HTML
  widget the editor always adds some > if you type a <,
  or a < if you type a > The code is just an example how
  to use the modifyVerifyCallBack.

  If you don't like the magic previewing, you can select
  an explicit previewing in the view option menu, or you
  can select really immediate previewing each type you
  change something. This menu (like all the others) can
  be torn off so you can place the "explicit button" at a
  convenient location on your screen.

  You might also want to view the HTML output in a
  separate window, nothing easier than this, choose the
  "window" option in view. You can follow links, at least
  some of them.  The program makes a few tests whether
  the link really points to a file in the assumed
  hierarchy. In The File menu there is a Back Button, the
  program maintains a stack of followed files.

  The document base directory is either the current
  directory or the value of an environment variable
  HTMLBASEDIR.

  It is obvious that you don't maintain the HTML files by
  hand, the program assumes that you actually create them
  using make and that you use for example a preprocessor
  like m4.  If you open a file with a suffix .m4 the
  program let's you edit the file but shows you the
  generated .html file. In this case the explicit preview
  mode is selected because each preview involves calling
  make. In addition preview saves the file if you have
  modified it. Furthermore, if you follow a link from
  while you are in a .m4 file (you can set an environment
  variable HTMLM4, default value is m4), and the link has
  an .html extension, and there is a corresponding .m4
  file, the m4 file will be used.

  In Europe it is quite common that texts contain special
  characters like French accents and German Umlaute. HTML
  texts are written in iso latin1, i.e.,
  iso8859-1. Typing such stuff is sometimes difficult.
  For some reason I have not been able to find out why on
  a sun keyword using an openwin x server, but X11R5
  libraries, the COMPOSE key doesn't work as I would like
  it, anyway, typing three things in order to type one is
  not really nice. Thus, I have introduced another way:
  Whenever some characters like " * ' ~ ` / are entered
  they are considered as introducing characters for Iso
  Latin 1 stuff.  The "message" line shows a list of what
  you can type later and the result. Typing an
  introducing character twice, or followed by a blank
  just gives the character. If you don't like that
  behavior you have to change the source, for example you
  might add some Alt or Mod5 before the translations for
  the introducing characters.

  The "Tags" pulldown menu allows you to enter some HTML
  tags in a more convenient way. For mixed tags like <EM>
  </EM> or <UL> </UL> either the actual primary selection
  is surrounded. If there is no selection the current
  insert cursor is used as well as for tags like <li>
  <pi>.

  Known inconveniences:

  - There is of course no disaster recovery, if your
    system breaks while you are saving a file. The
    previewing and Back does not yet preserve the
    position in the HTML document.
  - The Tags list is not complete.

  Features:

  - If you try to follow a link that is just a directory,
    the program DOES NOT create some internal index
    documents. That is an intentional behavior.

  Known bugs/problems:

  - If you start modifying an empty file, then the Save
    Button should remain insensitive, only SaveAs should
    work.
  - The HTML widget sometimes writes to stderr.

  Caution:

  - Pasting more than 4K of data blows up mofe in
    versions before 1.0.8 (In order to be able to cut
    larger amounts of text into the editor in versions up
    to 1.0.7, set the MESSAGE_COMMAND_LENGTH in wafe.h to
    some larger value.


  This program requires mofe 1.0.7 (or newer) compiled
  with HTML support.  It was tested with Motif 1.2.4 and
  Motif 2.0.

  Many thanks to Gustaf Neumann how participated actively
  in the creation of this program.  That is a nice
  cooperation: he currently works 6 hours away, so we
  almost had two shifts.  Some people call this
  telecooperation I guess. 10 years ago I practiced that
  quite heavily with people in Los Angeles.

}
#" comment with quote to help fontlock...
  
set signature {
       ______________
      / ____________/  Peter Sylvester
     / /  __           __
    / /__/ /_         / /  EdelWeb France
   / ___/ /_/ __     / /
  / /__/_/___/ /_   / /      <Peter.Sylvester@edelweb.fr>
 /__________/ /_/  / /
     / /___/ /____/ /
    /______________/
}

# To do: lot's of things:
#
# The editing functions of a real editor (cut paste and all that) should
# be included.
# Change the translations of the HTML widget.
#
# Mainly for debugging purposes but also for other things there are
# current some logging outputs to stdout. This should be done in somewhere
# else, in a file, and viewable in a scrolled text.
#

set defaultButtonFont -*-helvetica-medium-r-normal-*-12-*-iso8859-1
set smallFont         -b&h-*-medium-r-normal-*-12-*-iso8859-1

# things, we allow the user to change via app-defaults or Xdefaults
fallbackResources topLevel \
    *search_label.labelString          "Search Pattern:"  \
    *replace_label.labelString         "Replace Pattern:" \
    *searchmenu.next.labelString       "Find Next"        \
    *searchmenu.next.mnemonic           N                 \
    *searchmenu.find.labelString       "Find All"         \
    *searchmenu.find.mnemonic           A                 \
    *searchmenu.replace.labelString    "Replace All"      \
    *searchmenu.replace.mnemonic        R                 \
    *searchmenu.clear.labelString      "Clear"            \
    *searchmenu.clear.mnemonic          C                 \
    *searchmenu.Pattern.mnemonic        P                 \
    *File*Open-okLabelString            Open              \
    *File*Open-dialogTitle             "Open File ..."    \
    *File*SaveAs-okLabelString          Save              \
    *File*SaveAs-dialogTitle           "Save File as ..." \
    *followLink*Save.labelString       "Save the File"    \
    *followLink*SaveAs.labelString     "Save the File as ..." \
    *followLink*DontSave.labelString   "Do NOT Save Changes" \
    *menubar.File.mnemonic              F                 \
    *menubar.Edit.mnemonic              E                 \
    *menubar.Styles.mnemonic            y                 \
    *menubar.Search.mnemonic            S                 \
    *menubar.Help.mnemonic              H                 \
    *menubar.View.mnemonic              V                 \
    *filemenu.Open.mnemonic             O                 \
    *filemenu.Save.mnemonic             S                 \
    *filemenu.SaveAs.mnemonic           A                 \
    *filemenu.SaveAs.labelString       "Save as ..."      \
    *filemenu.Back.mnemonic             B                \
    *filemenu.Quit.mnemonic             Q                 \
    *editmenu.Cut.mnemonic              C                 \
    *editmenu.Copy.mnemonic             o                 \
    *editmenu.Paste.mnemonic            P                 \
    *editmenu.Clear.mnemonic            l                 \
    *viewmenu.Paned.mnemonic            P                 \
    *viewmenu.Window.mnemonic           W                 \
    *viewmenu.Immediate.mnemonic        I                 \
    *viewmenu.Batched.mnemonic          B                 \
    *viewmenu.Explicit.mnemonic         E                 \
    *Foreground                         \#000000000000    \
    *XmScrollBar*Foreground            \#bfbfbfbfbfbf    \
    *XmLabel*Foreground                 \#1d1d15155b5b    \
    *XmPushButton*Foreground            \#5b5b00000000    \
    *Background                         \#bfbfbfbfbfbf    \
    *XmTextField*Background             \#9c9c9c9c9c9c    \
    *e*Background                       \#dfdfdfdfdfdf    \
    *e*Foreground                       \#000000000000    \
    *XmList*Background                  \#dfdfdfdfdfdf    \
    *TopShadowColor                     \#e7e7e7e7e7e7    \
  *XmCascadeButton.fontList     -*-helvetica-bold-o-normal-*-14-*-iso8859-1 \
  *XmLabel*fontList     -*-helvetica-bold-r-normal-*-14-*-*-*-*-*-iso8859-1 \
  *stylemenu*XmPushButtonGadget*fontList    $smallFont \
  *XmPushButtonGadget*fontList    $defaultButtonFont \
  *XmToggleButtonGadget*fontList  $defaultButtonFont \
  *XmText.fontList                $smallFont \
  *XmTextField.fontList           $smallFont \
  *scrolledHelpText*fontList      $smallFont \
  *XmPushButton*fontList          $defaultButtonFont \
  *XmList*fontList                $defaultButtonFont \
  *searchmenu*Pattern.set         true \
  *menubar.?.?.tearOffModel       TEAR_OFF_ENABLED

# things, we do not want the user to change..
mergeResources topLevel \
    *leftAttachment ATTACH_FORM \
    *rightAttachment ATTACH_FORM \
    *editmenu*activateCallback {editcb %w} \
    *stylemenu*activateCallback {stylecb %w} \
    *style2menu*activateCallback {stylecb %w} \
    *searchmenu*activateCallback {searchcb %w} \
    *searchmenu*Pattern*valueChangedCallback {showpattern %w %s} \
    *filemenu*activateCallback { fileRequest %w } \
    *viewmenu*indicatorType ONE_OF_MANY \
    *e*valueChangedCallback { fileChanged e h } \
    *SearchPanel*valueChangedCallback { searchChanged %w} \
    *e*modifyVerifyCallback { insertHTML %i "%s" } \
    *helpmenu.?.activateCallback \
         "lazyDialog %wbox {DIALOG_CANCEL_BUTTON DIALOG_HELP_BUTTON} 1"

set inputTranslationsISO8859 {#override
    Shift<Key>*: exec(setmodifier %W asterisk *)
         <Key>\": exec(setmodifier %W %s %a)
         <Key>`: exec(setmodifier %W %s %a)
    Shift<Key>^: exec(setmodifier %W %s %adsdf  sdfds sdf )
   ~Shift<Key>\\: exec(setmodifier %W slash \\)
         <Key>a: exec(insertChar %W %a)
         <Key>e: exec(insertChar %W %a)
         <Key>o: exec(insertChar %W %a)
         <Key>i: exec(insertChar %W %a)
         <Key>n: exec(insertChar %W %a)
         <Key>c: exec(insertChar %W %a)
         <Key>u: exec(insertChar %W %a)
         <Key>t: exec(insertChar %W %a)
         <Key>y: exec(insertChar %W %a)
         <Key>space: exec(insertChar %W { })
   ~Shift<Key>s: exec(insertChar %W s)
}
#     <FocusOut>: exec(resetmodifier %W)

set m(slash)        \\
set m(quotedbl)     \"
set m(asciitilde)   ~
set m(apostrophe)   '
set m(quotedbl)     \"
set m(grave)        `
set m(asciicircum)  ^
set m(asterisk)     *

#
# The code and expl parameters are not supported at all. The
# first is intended to be supported by some global change function
# maybe only applicable to a selection if we don't real 8 bit
# iso latin 1, or the other way around, to replace the escapes
# by readable text since we able to support that stuff.
#
proc setcode {escape char col line code expl} {
   global m mi
   set m($escape,$char) [format %c [expr int(16*$col+$line)]]
  if ![info exists m($escape)] {puts stderr "missing: $escape"}
   set m($escape,\ ) $m($escape)
   append mi($escape) " $char:$m($escape,$char)"
}

setcode slash       A 12 06 AElig   "capital AE diphtong (ligature)"
setcode apostrophe  A 12 01 Aacute  "capital A, acute accent"
setcode asciicircum A 12 02 Acirc   "capital A, circumflex accent"
setcode grave       A 12 00 Agrave  "capital A, grave accent"
setcode asterisk    A 12 05 Aring   "capital A, ring"
setcode asciitilde  A 12 03 Atilde  "capital A, ring"
setcode quotedbl    A 12 04 Auml    "capital A, dieresis or umlaut mark"
setcode asciitilde  C 12 07 Ccedil  "capital C, cedilla"
setcode slash       E 13 00 ETH     "capital Eth, Icelandic"
setcode apostrophe  E 12 09 Eacute  "capital E, acute accent"
setcode asciicircum E 12 10 Ecirc   "capital E, circumflex accent"
setcode grave       E 12 08 Egrave  "capital E, grave accent"
setcode quotedbl    E 12 11 Euml    "capital E, dieresis or umlaut mark"
setcode apostrophe  I 12 13 Iacute  "capital I, acute accent"
setcode asciicircum I 12 14 Icirc   "capital I, circumflex accent"
setcode grave       I 12 12 Igrave  "capital I, grave accent"
setcode quotedbl    I 12 15 Iuml    "capital I, dieresis or umlaut mark"
setcode asciitilde  N 13 01 Ntilde  "capital N, tilde"
setcode apostrophe  O 13 03 Oacute  "capital O, acute accent"
setcode asciicircum O 13 04 Ocirc   "capital O, circumflex accent"
setcode grave       O 13 02 Ograve  "capital O, grave accent"
setcode slash       O 13 08 Oslash  "capital O, slash"
setcode asciitilde  O 13 05 Otilde  "capital O, tilde"
setcode quotedbl    O 13 06 Ouml    "capital O, dieresis or umlaut mark"
setcode slash       T 13 14 THORN   "capital THORN"
setcode apostrophe  U 13 10 Uacute  "capital U, acute accent"
setcode asciicircum U 13 11 Ucirc   "capital U, circumflex accent"
setcode grave       U 13 09 Ugrave  "capital U, grave accent"
setcode quotedbl    U 13 12 Uuml    "capital U, dieresis or umlaut mark"
setcode apostrophe  Y 13 13 Yacute  "capital Y, acute accent"
setcode apostrophe  a 14 01 aacute  "small a, acute accent"
setcode asciicircum a 14 02 acirc   "small a, circumflex accent"
setcode slash       a 14 06 aelig   "small aE diphtong (ligature)"
setcode grave       a 14 00 agrave  "small a, grave accent"
setcode asterisk    a 14 05 aring   "small a, ring"
setcode asciitilde  a 14 03 atilde  "small a, ring"
setcode quotedbl    a 14 04 auml    "small a, dieresis or umlaut mark"
setcode asciitilde  c 14 07 ccedil  "small c, cedilla"
setcode apostrophe  e 14 09 eacute  "small e, acute accent"
setcode asciicircum e 14 10 ecirc   "small e, circumflex accent"
setcode grave       e 14 08 egrave  "small e, grave accent"
setcode slash       e 15 00 eth     "small eth, Icelandic"
setcode quotedbl    e 14 11 euml    "small e, dieresis or umlaut mark"
setcode apostrophe  i 14 13 iacute  "small i, acute accent"
setcode asciicircum i 14 14 icirc   "small i, circumflex accent"
setcode grave       i 14 12 igrave  "small i, grave accent"
setcode quotedbl    i 14 15 iuml    "small i, dieresis or umlaut mark"
setcode asciitilde  n 15 01 ntilde  "small n, tilde"
setcode apostrophe  o 15 03 oacute  "small o, acute accent"
setcode asciicircum o 15 04 ocirc   "small o, circumflex accent"
setcode grave       o 15 02 ograve  "small o, grave accent"
setcode slash       o 15 08 oslash  "small o, slash"
setcode asciitilde  o 15 05 otilde  "small o, tilde"
setcode quotedbl    o 15 06 ouml    "small o, dieresis or umlaut mark"
setcode slash       s 13 15 szlig   "small sharp s, German (sz ligature)"
setcode slash       t 15 14 thorn   "small thorn, Icelandic"
setcode apostrophe  u 15 10 uacute  "small u, acute accent"
setcode asciicircum u 15 11 ucirc   "small u, circumflex accent"
setcode grave       u 15 09 ugrave  "small u, grave accent"
setcode quotedbl    u 15 12 uuml    "small u, dieresis or umlaut mark"
setcode apostrophe  y 15 13 yacute  "small y, acute accent"
setcode quotedbl    y 15 15 yuml    "small y, dieresis or umlaut mark"

#
# There is only ONE global modifier, shared
# by all three input widgets. This has the effect that you
# can start typying a modifier in one and continue to type the
# second char in another, and you get the result there. I'm
# not sure whether this is a bug or a feature, actually I
# like the behaviour.
#
set modifier ""
proc resetmodifier { {w { } } } {
  global modifier
  set modifier ""
  infomsg ""
}

set lastinput ""
proc setmodifier {w mo c} {
  global modifier mi m mw
  #   echo "setmodifier $modifier $mo $c"
  if ![string compare $modifier $mo] {
    [getClass $w]Insert $w [gV $w cursorPosition] $c
    resetmodifier
  } else {
    set modifier $mo
    infomsg "Modifier $m($mo): $mi($mo)"
  }
}

proc insertChar {w c} {
  global modifier m mw
  #    echo "insertChar $modifier $c"
  if [info exists m($modifier,$c)] {
    set c $m($modifier,$c)
  } elseif [string compare "" $modifier] {
    #
    # The following is commented out because unless having it
    # for ALL characters, the effect is confusing.
    # I have to think about how to specify translations for
    # all real characters, and maybe even for things like delete
    # and other stuff.
    #
    # The idea of the following is to type have 1*2 entered as 1*2 and not
    # by typing 1**2.
    #
    # a possible other solution is to introduce the modifiers via Alt
    # or just the reverse Alt * creates a *.
    #
    #     set c $m($modifier)$c
  }
  resetmodifier
  [getClass $w]Insert $w [gV $w cursorPosition] $c
}


#
# Attention: There is a call to resetmodifier in the Changedcallback of
# the edit fields. This avoids to have translations for all keys.
#

# Now that we have our tables I can treat the help text a bit:
#

regsub  "&eacute;" $helpText $m(apostrophe,e) helpText

if [file exists $iconfile] {
   changePixmap topLevel iconPixmap $iconfile
}

#  Now the main part of the user interface

XmMainWindow main topLevel
  XmMenuBar menubar main

    XmPulldownMenu filemenu menubar unmanaged
        XmPushButtonGadget Open filemenu
        XmPushButtonGadget Save filemenu sensitive False
        XmPushButtonGadget SaveAs filemenu sensitive False
        XmSeparatorGadget sep filemenu
        XmPushButtonGadget Back filemenu sensitive False
        XmSeparatorGadget sep filemenu
        XmPushButtonGadget Quit filemenu activateCallback {quitcb %w}  \
               accelerator Ctrl<Key>C acceleratorText Ctrl+C
    XmCascadeButton File menubar subMenuId filemenu

    XmPulldownMenu editmenu menubar unmanaged
        XmPushButtonGadget Cut editmenu
        XmPushButtonGadget Copy editmenu
        XmPushButtonGadget Paste editmenu
        XmSeparatorGadget sep editmenu
        XmPushButtonGadget Clear editmenu
    XmCascadeButton Edit menubar subMenuId editmenu

    XmPulldownMenu stylemenu menubar unmanaged
      foreach t {ADDRESS BODY CITE CODE DFN EM HEAD HTML OL PRE 
                 SAMP STRONG VAR} {XmPushButtonGadget $t stylemenu}
     XmPulldownMenu style2menu stylemenu unmanaged
        foreach t {H1 H2 H3 H4 H5 H6} {XmPushButtonGadget $t style2menu}
     XmCascadeButtonGadget Heading stylemenu subMenuId style2menu

     XmSeparatorGadget sep stylemenu
     foreach t {B I U TT} {XmPushButtonGadget $t stylemenu}
     XmSeparatorGadget sep stylemenu
     foreach t {DL OL UL} {XmPushButtonGadget $t stylemenu}
     XmSeparatorGadget sep stylemenu
     foreach t {dt dl li} {XmPushButtonGadget $t stylemenu}
     XmSeparatorGadget sep stylemenu
     foreach t {p br hr} {XmPushButtonGadget $t stylemenu}

    XmCascadeButton Styles menubar subMenuId stylemenu

    XmPulldownMenu searchmenu menubar unmanaged
        XmPushButtonGadget next searchmenu
        XmPushButtonGadget find searchmenu
        XmPushButtonGadget replace searchmenu
        XmSeparatorGadget sep searchmenu
        XmPushButtonGadget clear searchmenu
        XmToggleButtonGadget Pattern searchmenu
    XmCascadeButton Search menubar subMenuId searchmenu

    XmPulldownMenu viewmenu menubar unmanaged
        XmToggleButtonGadget Paned viewmenu set true \
	    valueChangedCallback {swToggle %w {Paned Window} %s}
        XmToggleButtonGadget Window viewmenu \
	    valueChangedCallback {swToggle %w {Paned Window} %s}
        XmSeparatorGadget sep viewmenu
        XmToggleButtonGadget Immediate viewmenu \
	    valueChangedCallback {swToggle %w {Immediate Batched Explicit} %s}
        XmToggleButtonGadget Batched viewmenu  set true \
	    valueChangedCallback {swToggle %w {Immediate Batched Explicit} %s}
        XmToggleButtonGadget Explicit viewmenu \
	    valueChangedCallback {swToggle %w {Immediate Batched Explicit} %s}
    XmCascadeButton View menubar subMenuId viewmenu

    XmPulldownMenu helpmenu menubar unmanaged
        XmPushButtonGadget Help helpmenu
        XmPushButtonGadget Version helpmenu
    XmCascadeButton Help menubar subMenuId helpmenu

    sV menubar menuHelpWidget Help

XmForm form main

  XmRowColumn SearchPanel form \
         orientation HORIZONTAL packing PACK_TIGHT \
         topAttachment ATTACH_FORM
    XmLabel search_label SearchPanel
    XmTextField search_text SearchPanel \
    translations $inputTranslationsISO8859 \
    fontList -b&h-*-medium-r-normal-*-12-*-iso8859-1
    XmLabel replace_label SearchPanel marginLeft 16
    XmTextField replace_text SearchPanel \
    translations $inputTranslationsISO8859 \
     fontList -b&h-*-medium-r-normal-*-12-*-iso8859-1

  XmRowColumn text_output form bottomAttachment ATTACH_FORM \
     orientation VERTICAL packing PACK_TIGHT
  XmText messages text_output editable False value { } \
         cursorPositionVisible False shadowThickness 0

  XmPanedWindow pane form \
         bottomAttachment ATTACH_WIDGET bottomWidget text_output \
         topAttachment ATTACH_WIDGET topWidget SearchPanel

  XmScrolledText e pane \
      autoShowCursorPosition True \
      wordWrap True \
      scrollVertical True \
      scrollHorizontal False \
      rows 12 columns 80 editMode MULTI_LINE_EDIT \
    fontList -b&h-*-medium-r-normal-*-12-*-iso8859-1 \
      allowResize true paneMinimum 20 \
    translations $inputTranslationsISO8859

  XmFrame fr pane height 300 paneMinimum 20
     HTML h0 fr {
        width 570 height 300
        marginWidth 10
        anchorUnderlines 1
        anchorColor slateBlue
        anchorCallback {followAnchorRequest %h}
     }

  TopLevelShell HtmlView main \
      mappedWhenManaged true \
      deleteResponse DO_NOTHING \
      translations {#override
         <Message>WM_PROTOCOLS: exec(handleWMmessage %p)
      }

    HTML h1 HtmlView {
        width 570 height 300
        marginWidth 10
        anchorUnderlines 1
        anchorColor slateBlue
        anchorCallback {followAnchorRequest %h}
      }


 realize
 XmProcessTraversal e TRAVERSE_CURRENT

# ---------------------- tcl procedures --------------------

proc writeLog {op text} {
  echo $op : $text
}

# still simple minded, but a start to get "cleaner" paths ....
proc pathAppend {part1 part2} {
  set part1 [string trimright $part1 /]
  if ![string compare $part2 .] { return $part1 }
  set part2 [string trimright $part2 /]
  if ![string compare "" $part2] {return $part1}
  if [string compare "" $part1] { return $part1/$part2 }
      return $part2
}

# operations on names of the current file
proc currentFile {{request ""} {name ""}} {
  global fullName
  switch $request {
    {}        -
    fullname  { return $fullName }
    dirname   -
    root      -
    extension { return [file $request $fullName] }
    set       { set fullName $name }
    push      { htmlPush $fullName }
    default   { puts stderr "unknown request '$request'"; return ""}
  }
}

# get resources for the "shared" open / save file selection dialog
foreach d {Open SaveAs} {
  set wTitle($d)  [getApplicationResource File $d-dialogTitle String]
  set okLabel($d) [getApplicationResource File $d-okLabelString String]
}

if [info exists env(HTMLBASEDIR)] {
  writeLog HtmlBaseDir $env(HTMLBASEDIR)
  currentFile set $env(HTMLBASEDIR)/
} else {
  set env(HTMLBASEDIR) /
  currentFile set [pwd]/
}

# The following variable should be http://server.domain.name/
# If an http link starts with the value of that variable we
# assume to have a file under the HTMLBASEDIR

if [info exists env(HTTPHOSTNAME)] {
  set httpHostName $env(HTTPHOSTNAME)
  writeLog HttpHostName $httpHostName
}

# This is a name of a private directory below each home directory
# to support the ~login feature. The supporting logic is not yet
# implemented.

if [info exists env(HTTPPUBLICHOME)] {
   set httpPublicHome $env(HTTPPUBLICHOME)
}

# if the resource startDir is set, use it as start directory under HTMLBASEDIR
set startDir [getApplicationResource topLevel startDir String]
if [string compare "" $startDir] {
  currentFile set [pathAppend $env(HTMLBASEDIR) $startDir]/
}
unset startDir

# look for .gif and .xpm files in the start directory
append FILESEARCHPATH :[currentFile dirname]/%N

set m4 m4
if [info exists env(HTMLM4)] {
  sV mv value $env(HTMLM4)
}

# The following procedure is used to create dialogs in a lazy manner;
# the first time a dialog is needed, it is created. Lazy creation
# of widgets helps to improve startup time.

proc lazyDialog {name withoutButton autoManage} {
  if [isWidget $name] {
    set sh [widgetId $name]
  } else {
    switch $name {
      followLink {
	set sh [XmWarningDialog $name main unmanaged \
	    dialogTitle "Follow Link when File Modified..." \
	    messageString "\n\
              The Current File in the Editor has Unsaved Changes!\n\
              Do you want to:\n" \
	    okLabelString "Follow Link" \
	    okCallback "set dialogResponse follow; unmanageChild %w" \
	    cancelLabelString "Stay in File" \
	    cancelCallback "set dialogResponse stay; unmanageChild %w"]
	set B [XmRadioBox radioBox$name $sh]
	  XmToggleButtonGadget Save $B set true
	  XmToggleButtonGadget SaveAs $B
	  XmToggleButtonGadget DontSave $B
      }
      fileModified {
	set sh [XmWarningDialog $name main unmanaged \
	    dialogTitle "File Modifified ..." \
	    messageString {
              The Current File in the Editor has Unsaved Changes!

              Do you want to
              - Discard Changes and Open a New File,
              - Save the File First and Open a New File, or
              - Cancel Open Request?
            } \
	    okLabelString "Open New File" \
	    okCallback "set dialogResponse open; unmanageChild %w" \
	    cancelLabelString "Save and Open" \
	    cancelCallback "set dialogResponse save; unmanageChild %w" \
	    helpLabelString "Cancel" \
	    helpCallback "set dialogResponse cancel; unmanageChild %w"]
      }
      fileQuit {
	set sh [XmWarningDialog $name main unmanaged \
	    dialogTitle "File Modifified ..." \
	    messageString {
              The current File in the Editor has Unsaved Changes!

              Do you want to
              - Discard Changes and Quit the Program,
              - Save the File First and then Quit, or
              - Cancel Quit Request?
            } \
	    okLabelString "Discard and Quit" \
	    okCallback "set dialogResponse quit; unmanageChild %w" \
	    cancelLabelString "Save and Quit" \
	    cancelCallback "set dialogResponse save; unmanageChild %w" \
	    helpLabelString "Cancel" \
	    helpCallback "set dialogResponse cancel; unmanageChild %w"]
      }
      fsDialog {
	set sh [XmFileSelectionDialog $name File unmanaged \
	    directory [currentFile dirname]  \
	    cancelCallback "unmanageChild %W" \
	    unmapCallback "set fsdialogResponse 1"]
      }
      Versionbox {
        global signature
	set sh [XmMessageDialog $name helpmenu unmanaged \
	    dialogTitle "Motif Editor demo Program using Mofe" \
	    okLabelString "Close" \
	    messageString "(nc) No Copyright Peter Sylvester, Gustaf Neumann 1994$signature"]
      }
      Helpbox {
	global helpText signature
	set sh [XmMessageDialog $name helpmenu unmanaged \
        dialogTitle "Help" \
        okLabelString "Close" \
        messageString "General Help m-htmlEdit" ]
	XmScrolledWindow scrolledHelpText $sh \
	    height 500 width 550 \
	    scrollingPolicy AUTOMATIC
        XmLabel helpText $sh*scrolledHelpText \
	    labelString  $helpText$signature alignment alignment_beginning
      }
    }
    if [string compare "" $withoutButton] {
      set cmd unmanageChild
      foreach b $withoutButton {
	append cmd \ [[getClass $sh]GetChild $sh $b]
      }
      eval $cmd
    }
  }
  if $autoManage {manageChild $sh}
  return $sh
}

#####################################################################
# there are three major requests that the user might have:
#  1) follow an Anchor
#  2) some file specific requests
#     (Opening a new file or saving the current file)
#  3) view request (separate window vs. paned)

set changedafterpreview 0

proc followAnchorRequest {h {pathtype "html"}} {
  global changedafterpreview m4 httpHostName
  # There was a nice bug here. If the preview mode is on you might
  # have clicked to the wrong thing. Thus, we should keep a variable
  # somewhere and refuse following links without a recent preview.

  switch $pathtype {
    full {
      set reqFullName $h
      set reqDir [file dir $h]
      set reqLabel ""
    }
    html {

      if $changedafterpreview {
	errmsg "preview file first"
	return
      }
      # Here we try to detect whether an http link points to us
      # I am not trying to implement ALL possiblities of an httpd
      # to specify local file, in our server we have some rules anyway.
       
      if [info exists httpHostName] {
	if ![string first $httpHostName [string tolower $h]] {
	  set h /[string range $h [string length $httpHostName] end]
	}
      }

      if ![string first http: [string tolower $h]] {
	errmsg "cannot follow http link $h"
	return
      }

      # We have to determine the full file name for a link to
      # be followed. It is assumed that we don't change the server
      # at the moment. We could add some test for <protocol>:/ here
      # but it doesn't matter because we won't find such a file
      # anyway. So for the moment. Files can be relative or absolute,
      # if the start with a / they are absolute and must be prepended
      # by the HTMLBASEDIR. If they are relative, they are relative
      # to the active directory. If a link is a directory, we are
      # going to look show a file index.html (or $m4) instead).

      switch [string range $h 0 0] {
        ~ -
        / {
         global env
           set reqLabel ""
          set reqDir   [pathAppend $env(HTMLBASEDIR) [file dirname $h]]
          set reqFile  [file tail $h]
          scan $reqFile {%[^#]#%s} reqFile reqLabel
        }
        # {
          htmlMoveCursor h[gV Window set] [string range $h 1 end]
          return
        }
        default {
          set reqLabel ""
          scan $h {%[^#]#%s} reqFile reqLabel
          set reqFile  [file tail $reqFile]
          set reqDir [pathAppend [currentFile dirname] [file dirname $h]]
        }
      }

      set reqFullName $reqDir
      if [string compare $reqFile ""] {
         append reqFullName /$reqFile
      }

      if [file isdirectory $reqFullName] {append reqFullName /index.html}

      if ![string compare [currentFile] $reqFullName] {
        errmsg "reference is in the same file"
        return
      }

      # Ok, if we have been in the m4 source of a file and we want to follow
      # a link to an .html file we first look whether there exists an .m4 file
      # so that we can follow our "parallel editing tree".

      set m4file [file root $reqFullName].$m4
      if {![string compare .html [file extension $reqFullName]]
          && ![string compare .$m4 [currentFile extension]]
          && [file exists $m4file] } {
         set reqFullName $m4file
       } elseif ![file exists $reqFullName] {
        errmsg "cannot follow reference '$reqFullName', file does not exist"
        return
      }
    }
  }

  # if we change the file, let's look what we have to do with the old one.
  # I am not sure whether I like the behaviour here, the user CANNOT
  # avoid following the link. What I actually would like is a way so that
  # the user can either decide
  #
  # to save the file and follow the link

  # not to save the file and to follow the link (I cannot do that at
  # the moment) not to save the file and not to follow the link
  #
  # A file has to be saved, ask the use, what he wants to do with it
  #
  if [gV Save sensitive] {
    lazyDialog followLink {} 1
    setBusy main true
    global dialogResponse; waitForVariable dialogResponse
    setBusy main false

    switch $dialogResponse {
      follow {        }
      stay   {infomsg "Link not followed, no data saved."
             return }
    }

    foreach b [gV radioBoxfollowLink children] {
      if [gV $b set] {
	switch [widgetName $b] {
	  Save   {
	    fileRequest Save
	  }
	  SaveAs {
	    fileRequest SaveAs
	    setBusy main true
	    global fsdialogResponse; waitForVariable fsdialogResponse
	    setBusy main false
	  }
	}
	break
      }
    }

  }

  # now we are done with the old file.

  currentFile push
  filecb Open $reqDir $reqFullName

  # During the anchor callback the active filename was changed. Since
  # this is not (yet) reflected in the fsdialog, we do it here.
  # I am not sure whether there is an easier way to do this,
  # anyway it works so far.

  set fullpath [currentFile]
  if [string compare "" $fullpath] {
    set dir [file dirname $fullpath]
    XmFileSelectionDoSearch fsDialog $dir/
    set list [XmFileSelectionBoxGetChild fsDialog DIALOG_LIST]
    set pos [XmListItemPos $list $fullpath]
    if $pos {
      XmListSelectPos $list $pos 0
      sV fsDialog dirSpec $fullpath
    }
  }
  # Here we would now try an do a scrolling toward the link inside the
  # file.
  if [string compare "" $reqLabel] {
    htmlMoveCursor h[gV Window set] $reqLabel
  }
}

proc quitcb {w} {
  if [gV Save sensitive] {
    lazyDialog fileQuit {} 1
    setBusy main true
    global dialogResponse; waitForVariable dialogResponse
    setBusy main false

    switch $dialogResponse {
      quit {
      }
      save {
	fileRequest Save
	setBusy main true
	global fsdialogResponse; waitForVariable fsdialogResponse
	setBusy main false
      }
      cancel {
	return
      }
    }
  }
  quit
}

proc fileRequest {op} {
  switch $op {
    Back {

      # The following is wrong when backing to the first entry, it
      # tries to open the index.html instead. I need to fix this later
      # somehow (together with the Save/SaveAs anomally.)

      # Furthermore, it doesn't work at all, I need some additional
      # parameter saying that either the reference is a full filename
      # so that followAnchor knows also that it doesn't have to push?
      # Do I want to push if I need to save the file, so I get some
      # swap effect.

      followAnchorRequest [htmlPop] full
      # followAnchorRequest pushes the actual file;
      htmlPop
      return
    }
    Save {
      filecb $op [currentFile dirname] [currentFile]
      return
    }
    SaveAs { }
    Open {
      # check, whether the current editbuffer is dirty....
      if [gV Save sensitive] {
	lazyDialog fileModified {} 1
	setBusy main true
	global dialogResponse; waitForVariable dialogResponse
	setBusy main false
	
	switch $dialogResponse {
	  open {  }
	  save {
	    fileRequest Save
	    setBusy main true
	    global fsdialogResponse; waitForVariable fsdialogResponse
	    setBusy main false
	  }
	  cancel { return }
  } } } }

  global wTitle okLabel
  sV [lazyDialog fsDialog DIALOG_HELP_BUTTON 0] \
      dialogTitle $wTitle($op) \
      okLabelString $okLabel($op) \
      okCallback "filecb $op %d \"%s\""

  manageChild fsDialog
  raiseWindow [parent fsDialog]
}

# The idea of the Paned/Window stuff is: A paned view has the edit and
# html widgets in a pane. In a window view the html widget is in a
# separate window.

# One can either direct the editor to update the html widget on each
# modification, or just when you press the preview button. In order
# to have the preview button at a convenient place the pull down menu
# can be pinned (oops, that's sun wording), I mean torn off)

proc switchViewRequest {w} {
  switch $w {
    Paned {
      unmanageChild HtmlView
      set x [expr ([gV pane height]/2)]
      sV fr paneMinimum $x
      manageChild fr
      sV fr paneMinimum 20
    }
    Window {
      unmanageChild fr
      manageChild HtmlView
      raiseWindow HtmlView
    }
  }
  preview e h
}

proc searchChanged {w} {
  resetmodifier
}

proc fileChanged {edit html} {
  global changedafterpreview bgProcess
  resetmodifier
  if [gV Immediate set] {
    preview $edit $html
  } elseif [gV Batched set] {
    # if one stops typing for one second, the html widget is refreshed
    if [info exists bgProcess] { removeTimeOut $bgProcess }
    set bgProcess [addTimeOut 1000 "bgPreview $edit $html"]
  } else {
    set changedafterpreview 1
  }
}

proc bgPreview {editw htmlw} {
  global bgProcess
  preview $editw $htmlw
  if [info exists bgProcess] {unset bgProcess}
}

proc preview {edit html {notfirst 1} } {
  global changedafterpreview m4

  set xt [currentFile extension]
  set hpos [htmlGetCurrentPosition $html[gV Window set]]
  if ![string compare .html $xt] {
    sV $html[gV Window set] text [gV $edit value]
  } elseif ![string compare "" $xt] {
    sV $html[gV Window set] text [gV $edit value]
  } elseif ![string compare .$m4 $xt] {

    if [gV Save sensitive] {
      fileRequest Save
    }

    writeLog Make \
	[exec  sh -c "cd [file dir [currentFile]];  make 2>&1 || true "]

    set of [open [file root [currentFile]].html]
    # echo getting data from [file root [currentFile]].html
    sV $html[gV Window set] text [read $of nonewline]
    close $of
  }
  if {$notfirst} { htmlSetCurrentPosition $html[gV Window set] $hpos}
  set changedafterpreview 0
}

proc htmlMoveCursor {widget href} {
  HTMLClearSelection $widget

  set newID [HTMLAnchorToId $widget $href]
  if {$newID==0} {
    errmsg "Could not find this Reference in the Document: $href."
    return
  }
  set scrollId [expr $newID-10]
  if {$scrollId<0} {set scrollId 1}
  HTMLGotoId $widget $scrollId

  # Fake Cursor: Select first character
  set selStart(id) $newID
  set selEnd(id) $newID
  set selStart(pos) 0
  set selEnd(pos) 1
  HTMLSetSelection $widget selStart selEnd
}

# This is just a dirty hack to avoid some obvious errors. If the
# html widget doesn't find a closing > it starts crying on stderr.
# here one would actually replace the editing by some semantic
# oriented stuff.
#

proc insertHTML {insertPos string} {
  if ![string compare < $string] {
    append string >
    incr insertPos
#  } elseif ![string compare > $string] {
#    append string <
#    incr insertPos
  } else {
    set insertPos -1
  }

  XmModifyVerifyCBset true $insertPos -1 -1 $string

  if ![gV Save sensitive] {
    sV topLevel title "HTMLedit: [currentFile] (edited)"
    saveSensitive True
  }
}

proc showpattern {w showPattern} {
  if $showPattern {
    manageChild SearchPanel
    sV pane  topAttachment ATTACH_WIDGET topWidget SearchPanel
  } else {
    unmanageChild SearchPanel
    sV pane  topAttachment ATTACH_FORM
  }
}

# various utility functions...

proc errmsg {txt} {
  infomsg $txt
  bell topLevel 0
}

proc infomsg {txt} {
  sV messages value $txt
}

proc filecb {op dir fileName} {
  if {[string match "" $fileName] || ![string compare $dir $fileName]} {
    errmsg "Choose a file."
    return
  }
  # echo filecb $op $dir $fileName
  writeLog $op $fileName
  switch $op {
    Open {
      if ![file readable $fileName] {
	errmsg "Cannot read file '$fileName'"
	return
      }
      # missing: test for binary file
      set f [open $fileName]
      set content [read $f nonewline]
      close $f
      # otherwise, file loading will fo "through" modifyVerify
      set oldMVcb [gV e modifyVerifyCallback]
      set oldVCcb [gV e valueChangedCallback]
      sV e value $content modifyVerifyCallback {} valueChangedCallback {}
      sV e modifyVerifyCallback $oldMVcb valueChangedCallback $oldVCcb
      if [string compare [file extension $fileName] .html] {
	swToggle Explicit {Immediate Batched Explicit} 1
        swWrap False
      } else {
        swWrap True
      }
      currentFile set $fileName
      preview e h 0
      infomsg "Loaded [XmTextGetLastPosition e] bytes from '$fileName'."
    }
    Save -
    SaveAs {
      if [catch {set f [open $fileName w]}] {
	errmsg "Cannot write into file '$fileName'."
	return
      }
      puts -nonewline $f [gV e value]
      close $f
      currentFile set $fileName
      set written [file size $fileName]
      if [string compare $written [XmTextGetLastPosition e]] {
	errmsg "Warning did not write entire file."
      } else {
	infomsg "Saved $written bytes to '$fileName'."
      }
    }
  }
  sV topLevel title "HTMLedit: $fileName"
  sV HtmlView title "HTMLview: $fileName"
  saveSensitive False
  unmanageChild fsDialog
}

proc searchcb {op} {
  set endPos [XmTextGetLastPosition e]
  if ![string compare $op clear] {
    XmTextSetHighlight e 0 $endPos HIGHLIGHT_NORMAL
    return
  }
  if ![string compare $endPos 0] {
    errmg "No text to search."
    return
  }
  set search_length [string length [gV search_text value]]
  if ![string compare 0 $search_length] {
    errmsg "Specify a search pattern."
    return
  }

  if ![string compare $op next] {
    set p [expr [gV e cursorPosition]+1]
    if [XmTextFindString e $p [gV search_text value] TEXT_FORWARD found_pos] {
      XmTextSetHighlight e $found_pos \
	  [expr $found_pos+$search_length] HIGHLIGHT_SELECTED
      infomsg "Pattern found at position $found_pos."
      sV e cursorPosition $found_pos
      return
    }
  } else {
    # we have to handle now findall and replace, which iterate over
    # the whole file
    set p 0
    set count 0
    set found_pos 0
    set rpl [gV replace_text value]
    set rpl_length [string length $rpl]
    # unset old highlighing
    XmTextSetHighlight e 0 $endPos HIGHLIGHT_NORMAL
    set srch [gV search_text value]
    while {[XmTextFindString e $p $srch TEXT_FORWARD found_pos]} {
      set p [expr $found_pos+$search_length]
      if ![string compare $op replace] {
	XmTextReplace e $found_pos $p $rpl
	set p [expr $found_pos+$rpl_length]
      }
      XmTextSetHighlight e $found_pos $p HIGHLIGHT_SELECTED
      incr p
      incr count
    }
    if {$count>0} {
      switch $op {
	find    { infomsg "Found $count occurences." }
	replace { infomsg "Made $count replacements."}
      }
      return
    }
  }
  errmsg "Pattern not found."
}

proc stylecb {w} {
  set d [string length $w]
  incr d 2
  # uppercase markups are for blocks
  if [string compare $w [string toupper $w]] {
    set anfang [gV e cursorPosition]
    XmTextInsert e $anfang <$w>
    incr anfang $d
  } elseif [XmTextGetSelectionPosition e anfang ende] {
    XmTextInsert e $ende </$w>
    XmTextInsert e $anfang <$w>
    # XmTextClearSelection e
    incr anfang $d
    incr ende $d
    XmTextSetSelection e $anfang $ende
  } else {
    set anfang [gV e cursorPosition]
    XmTextInsert e $anfang <$w></$w>
    incr anfang $d
  }
  sV e cursorPosition $anfang
}

proc editcb {op} {
  if  ![string compare $op Html] {
     set s [XmTextGetSelectionPosition e anfang ende]
     echo $s $anfang $ende [gV e cursorPosition]
  } elseif ![string compare $op Clear] {
    XmTextClearSelection e
    infomsg ""
  } else {
    switch [XmText$op e] {
      1 { infomsg ""}
      0 { ermsg "There is no selection" }
    }
  }
}

proc swWrap {state} {
  sV e wordWrap $state
}

proc swToggle {w widgets state} {
  if $state {
    # the toggle was not selected
    [getClass $w]SetState $w $state 0
    foreach t $widgets {
      if [string compare $w $t] { [getClass $t]SetState $t 0 0 }
    }
  } else {
    # keep the toggle selected
    [getClass $w]SetState $w 1 0
  }
  switchViewRequest $w
}

proc handleWMmessage {msg} {
  if ![string compare $msg WM_DELETE_WINDOW] {swToggle Paned {Paned Window} 1}
}

proc saveSensitive {bool} {
  sV Save sensitive $bool
  sV SaveAs sensitive $bool
}

proc htmlGetCurrentPosition {widget} {
  XmScrollBarGetValues $widget.Vbar val size incr page
  # puts stderr "XmScrollBarGetValues $widget.Vbar $val $size $incr $page"
  # the returned val from XmScrollBarGetValues appears to be incorrect
  # in Motif 1.2.3; so we are using gV instead.
  return [list [gV $widget.Vbar value] $size $incr $page]
}

proc htmlSetCurrentPosition {widget l} {

  # I am not sure whether the following is actually good. What I want
  # is to set the actual position "close" to the previous one. It
  # might happen that the values of the slider size are so different
  # now, that the actual position the incr is too big. This might
  # occur if one deletes a lot of text at the end of the data?
  #  XmScrollBarGetValues $widget.Vbar val size incr page

  set pos [lindex $l 0]
  set size [lindex $l 1]
  set incr [lindex $l 2]
  set page [lindex $l 3]

  # puts stderr "XmScrollBarSetValues $widget.Vbar $pos $size $incr $page true"

  XmScrollBarSetValues $widget.Vbar $pos $size $incr $page true
}

# I am not sure whether Back should really follow a stack.

set htmlStack {}

# Manage the HTML stack: Push
proc htmlPush {ref} {
  global htmlStack
  lappend htmlStack $ref
  sV Back sensitive True
}

# Manage the href stack: Pop
proc htmlPop {} {
  global htmlStack

  set len [llength $htmlStack]
  if {$len == 0} {
    return ""
  } else {
    if {$len == 1} {sV Back sensitive False}
    incr len -1
    set last [lindex $htmlStack $len]
    set htmlStack [lreplace $htmlStack $len $len]
    return $last
  }
}

# echo [currentFile]

set followlink [lindex $ARGV 1]
if ![string match "" $followlink] {
    lazyDialog fsDialog {} 0
    followAnchorRequest $followlink
}

