# body.icn: Object to represent an input file for webstyler.icn
#--

$ifndef __BODY_ICN__
$define __BODY_ICN__

$define  BODY_REVISION  "$Revision: 1.21 $"
$define  BODY_DATE      "$Date: 1996/10/24 21:29:23 $"

#================================================================
# NOTATIONAL DEFINITIONS
#----------------------------------------------------------------
# effective next target of a body file ==
#     if the body file contains a <NEXT NONE> tag -> &null
#     else if there is a <NEXT ID="foo"> tag ->
#       target representing shortname foo
#     else if the body's topic has a right-hand sibling ->
#       target representing that sibling
#     else -> &null
#     (If a body file has multiple <NEXT> tags, the last one wins.)
#
# effective previous target of a body file ==
#     if the body file contains a <PREV NONE> tag -> &null
#     else if there is a <PREV ID="foo"> tag ->
#       target representing shortname foo
#     else if the body's topic has a left-hand sibling ->
#       target representing that sibling
#     else -> &null
#     (If a body file has multiple <PREV> tags, the last one wins.)
#
# effective see list ==
#     a list consisting of:
#       (a) a target representing the parent topic of this body's
#           topic, unless a <SEE NONE> occurs in the body file; followed by
#       (b) any targets mentioned in <SEE ID="..."> tags (after the
#           last <SEE NONE> if any)
#
# effective template ==
#     if the body file contains a <TEMPLATE ID="fileName"> tag and
#     that fileName names a valid template file ->
#       a template object representing fileName
#     else ->
#       the default template object from the body's topic's plan
#
# our tag == { <AUTHOR>, <G>, <HEAD>, <NEXT>, <PREV>, <R>, <RR>, <SEE>,
#              <TEMPLATE>, <UPDATED }
#     if a single tag -> just the tag
#     if a paired tag -> the open tag, all text from there through the
#       closing tag (or EOF if there is none)
#
# single tag == { <G>, <NEXT>, <PREV>, <R>, <SEE>, <TEMPLATE>, <UPDATED> }
#
# paired tag == { <AUTHOR>, <RR> }
#
# header tag == { <AUTHOR>, <NEXT>, <PREV>, <SEE>, <TEMPLATE>, <UPDATED> }
#
# Note: <HEAD> is basically a no-op; see Body_Parse_Head_Tag for
# more comments on the treatment of <HEAD> and </HEAD>
#
#================================================================
# Class Body: Each instance represents one input (body) file.
#----------------------------------------------------------------
  record bodyTag (  # State for the body object
    fileName,       # Source file name
    plan,           # Related plan object
    topic,          # Topic of this body
    author,         # Author string, or &null if there is none
    seeList,        # Effective see list
    enext,          # Effective next target
    eprev,          # Effective previous target
    etemplate,      # Effective template
    text,           # Expanded body text, or "" if invalid
    updated,        # Last-updated timestamp, or &null
    scan )          # Scan object during parsing
#================================================================
# INVARIANTS FOR THE BODY OBJECT
#   .plan == The Plan object containing .topic
#   .topic == The Topic object related to this body file
#   .author == The author string, or &null if there is none
#   .seeList == The effective see list
#   .enext == The effective next target
#   .eprev == The effective previous target
#   .etemplate == The effective template
#   .text == Expanded body text, or "" if invalid
#   .updated == Last-updated timestamp, or &null if there is none
#----------------------------------------------------------------
# body  :=  Body_New ( plan, topic, fileName )
#   [ if (plan) and (topic) satisfy the corresponding invariants ->
#       if fileName points to a valid body file ->
#         returns a new body object with those fields, plus
#         remaining fields as per the invariants
#       else ->
#         plan.log  ||:=  error message(s)
#         fail
#   ]
#--
# string  :=  Body_Author ( body )
#   [ if body contains no <AUTHOR> tag -> fail
#   | else -> return author string
#   ]
#--
# integer  :=  Body_N_Sees ( body )
#   [ returns the number of targets in the effective see list
#   ]
#--
# topic  :=  Body_Gen_Sees ( body )
#   [ generates the effective see list as a sequence of Target objects
#   ]
#--
# topic  :=  Body_Next ( body )     [ returns effective next target of body ]
#--
# topic  :=  Body_Prev ( body )     [ returns effective previous target ]
#--
# string  :=  Body_Updated ( body )
#   [ if body contains a valid <UPDATED> tag -> returns the update timestamp
#   | else -> fail
#   ]
#--
# Body_Expand ( body, outFile )
#   [ outFile  ||:=  expansion of the text in the body
#   ]
#--
# Body_Topic ( body )               [ returns body.topic ]
#--
# template  :=  Body_Template ( body )
#   [ returns the effective template of body
#   ]
#--
# string  :=  Body_Version ( body )
#   [ returns a string identifying the version of the body object ]
#----------------------------------------------------------------


# - - -   B o d y _ A u t h o r   - - -

procedure Body_Author ( body )
  return \ body.author;
end


# - - -   B o d y _ N _ S e e s   - - -

procedure Body_N_Sees ( body )
  return ( * \ body.seeList ) | 0;
end


# - - -   B o d y _ G e n _ S e e s   - - -

procedure Body_Gen_Sees ( body )
  every suspend ( ! \ body.seeList );
end


# - - -   B o d y _ N e x t   - - -

procedure Body_Next ( body )
  return \ body.enext;
end


# - - -   B o d y _ P r e v   - - -

procedure Body_Prev ( body )
  return  \ body.eprev;
end


# - - -   B o d y _ U p d a t e d   - - -

procedure Body_Updated ( body )
  return  \ body.updated;
end


# - - -   B o d y _ E x p a n d   - - -

procedure Body_Expand ( body, outFile )
  writes ( outFile, \ body.text );
end


# - - -   B o d y _ T o p i c   - - -

procedure Body_Topic ( body )
  return body.topic;
end


# - - -   B o d y _ T e m p l a t e   - - -

procedure Body_Template ( body )
  return body.etemplate;
end


# - - -   B o d y _ V e r s i o n   - - -

procedure Body_Version ( body )
  return "Body " || RCS_Extract ( BODY_REVISION ) || " " ||
         RCS_Extract ( BODY_DATE );
end


# - - -   B o d y _ N e w   - - -

procedure Body_New ( plan, topic, fileName )
  #-- 1 --
  #-[ body  :=  a new bodyTag with fields:
  #     .fileName   :=  fileName
  #     .plan       :=  plan
  #     .topic      :=  topic
  #     .seeList    :=  empty list
  #     .etemplate  :=  the default template from plan
  #     (.author, .enext, .eprev, .text, .updated, .scan) := &null
  #-]
  local body

  body            :=  bodyTag ( );
  body.fileName   :=  fileName;
  body.plan       :=  plan;
  body.topic      :=  topic;
  body.seeList    :=  [];
  body.etemplate  :=  Plan_Lookup_Template ( plan, &null );

  #-- 2 --
  #-[ body.enext    :=    Target object representing body.topic's
  #                       right-hand sibling in topic tree if any, else &null
  #   body.eprev    :=    Target object representing body.topic's
  #                       left-hand sibling in topic tree if any, else &null
  #   body.seeList  ||:=  Target object representing body.topic's
  #                       parent topic, if any
  #-]
  Body_Find_Siblings ( body );

  #-- 3 --
  #-[ if body.fileName points to a valid body file ->
  #     body       :=   body modified to reflect contents of body.fileName
  #     body.plan  +:=  link variants from body.fileName
  # | else ->
  #     body.plan.log  :=  syntax error message(s)
  #     body           :=  body modified to reflect the valid parts
  #                        of body.fileName
  #     fail
  #-]
  if  not Body_Read ( body ) then
    fail;

  #-- 4 --
  return body;
end # --- Body_New ---


# - - -   B o d y _ F i n d _ S i b l i n g s   - - -

#-[ body.enext    :=    Target object representing body.topic's
#                       right-hand sibling in topic tree if any, else &null
#   body.eprev    :=    Target object representing body.topic's
#                       left-hand sibling in topic tree if any, else &null
#   body.seeList  ||:=  Target object representing body.topic's
#                       parent in topic tree, if any
#-]

procedure Body_Find_Siblings ( body )
  #-- 1 --
  local parent      # Parent topic in topic tree, if any
  local leftSib     # Birth order of left sibling
  local rightSib    # Birth order of right sibling

  body.enext  :=  &null;
  body.eprev  :=  &null;

  #-- 1 --
  #-[ if body.topic has no parent -> return
  # | else ->
  #     parent        :=    parent(body.topic)
  #     body.seeList  ||:=  Target for parent(body.topic)
  #-]
  if  not ( parent := Topic_Parent ( body.topic ) )  then
    return;

  put ( body.seeList, Target_New ( parent ) );

  #-- 2 --
  #-[ if there is no left sibling -> I
  # | else ->
  #     body.eprev  :=  Target for left sibling
  #-]
  leftSib  :=  Topic_Birth_Order ( body.topic ) - 1;

  if  leftSib >= 1  then
    body.eprev  :=  Target_New ( Topic_Nth_Child ( parent, leftSib ) );

  #-- 3 --
  #-[ if there is no right sibling -> I
  #-| else ->
  #     body.enext  :=  Target for right sibling
  #-]
  rightSib  :=  Topic_Birth_Order ( body.topic ) + 1;

  if  rightSib <= Topic_N_Children ( parent )  then
    body.enext  :=  Target_New ( Topic_Nth_Child ( parent, rightSib ) );
end # --- Body_Find_Siblings ---


# - - -   B o d y _ R e a d   - - -

procedure Body_Read ( body )
  #-- 1 --
  local token
  local oldCount

  oldCount   :=  Log_Error_Count ( body.plan.log );
  body.scan  :=  &null;
  body.text  :=  "";

  #-- 2 --
  #-[ if body.fileName is readable ->
  #     body.scan  :=  a scan object pointing to the start of
  #                    body.fileName, using body.plan.log for logging
  # | else ->
  #     body.plan.log  ||:=  error message, can't open (body.fileName)
  #     fail
  #-]
  if  not ( body.scan := Scan_Open ( body.fileName, body.plan.log ) )  then
    return Log_Error ( body.plan.log, "Can't open body file `",
                       body.fileName, "'." );

  #-- 3 --
  #-[ if body.scan is a valid body file ->
  #     body       :=   body, modified to reflect contents of body.scan
  #     body.plan  +:=  link variants from body.scan
  # | else ->
  #     body.scan.log  ||:=  error message(s)
  #     body           :=    body, modified to reflect valid parts, if any
  #     body.plan      +:=   link variants from valid parts of body
  #-]
  while  not Scan_End_File ( body.scan )  do
  { #-- 3.1 --
    #-[ if body.scan starts with one of our tags ->
    #     body           :=    body modifiedto reflect that tag
    #     body.scan      :=    body.scan advanced over the valid part
    #                          (at least one character) or to the end
    #                          of the tag if it is valid
    #     body.scan.log  ||:=  scan error(s) from expansion, if any
    #     body.plan      +:=   link variants from tag, if any
    # | else ->
    #     body.text  ||:=  characters from body.scan up to our next tag
    #                      or EOF
    #     body.scan  :=    body.scan advanced up to our next tag or EOF
    #-]
    Body_Read_Token ( body );
  } #-- 3.1 --

  #-- 4 --
  #-[ if body.scan.log has any errors -> fail
  # | else -> return body
  #-]
  if  Log_Error_Count ( body.scan.log ) > oldCount  then
    fail
  else
    return body;
end # --- Body_Read ---


# - - -   B o d y _ R e a d _ T o k e n   - - -

#-Let `valid tag' mean:
#   (a) for our tags, syntactically and semantically valid;
#   (b) for pass-through tags, syntactically valid;
# in:
# [ if current subject starts with a tag but it's invalid ->
#     body.scan.log  ||:=  scan error(s)
#     body.scan      :=    body.scan advanced the valid part, at least
#                          one character
# | else if body.scan starts with one of our valid tags ->
#     body       :=    body modified to reflect any header content
#                      of that tag
#     body.text  ||:=  expansion of tag, if any
#     body.plan  +:=   link variants from that tag, if any
#     body.scan  :=    body.scan advanced past that tag
# | else ->
#     body.text  ||:=  characters from body.scan up to our next tag, or EOF
#     body.scan  :=    body.scan advanced up to our next tag, or EOF
#-]

procedure Body_Read_Token ( body )
  #-- 1 --
  #-[ if input starts with a "<" but that begins no valid HTML tag ->
  #     body.scan.log  ||:=  scan error(s)
  #     body.scan      :=    body.scan advanced after next ">" or EOF,
  #                          whichever comes first
  # | else if input is a "<" starting a syntactically valid HTML tag ->
  #     body       :=    body modified to reflect any header content
  #                      content, if the tag is one of our header tags
  #     body.text  ||:=  the expansion of that tag, if ours, or its
  #                      source, if not one of our tags
  #     body.scan  :=    body.scan advanced after the tag
  #     body.plan  +:=   any link text variants from the tag
  # | else ->
  #     body.text  ||:=  characters from body.scan up to next "<" or EOF,
  #                      translating each end of line to a newline
  #     body.scan  :=    body.scan advanced to the next "<" or EOF
  #-]
  if  match ( "<" )  then
  { #-- 1.1 --
    #-[ if input starts with a "<" but that begins no valid HTML tag ->
    #     body.scan.log  ||:=  scan error(s)
    #     body.scan      :=    body.scan advanced after next ">" or EOF,
    #                          whichever comes first
    # | else if input is a "<" starting a syntactically valid HTML tag ->
    #     body       :=    body modified to reflect any header content
    #                      content, if the tag is one of our header tags
    #     body.text  ||:=  the expansion of that tag, if ours, or its
    #                      source, if not one of our tags
    #     body.scan  :=    body.scan advanced after the tag
    #     body.plan  +:=   any link text variant from the tag
    #-]
    Body_Read_Tag ( body )          #-- Cases 1 and 2 above, minus the "<"
  } #-- 1.1 --
  else
  { #-- 1.2 --
    #-[ body.text  ||:=  characters from body.scan up to next "<" or EOF,
    #                    translating each end of line to a newline
    #   body.scan  :=    body.scan advanced to the next "<" or EOF
    #-]
    Body_Read_Non_Tag ( body );     #-- Case 3 above
  } #-- 1.2 --

  #-- 2 --
  return;
end # --- Body_Read_Token ---


# - - -   B o d y _ R e a d _ N o n _ T a g   - - -

#-[ if body.scan is at EOF -> fail
# | else ->
#     body.text  ||:=  text from body.scan up to next "<" or EOF, whichever
#                      comes first, translating each end of line to newline
#     body.scan  :=    body.scan advanced up to next "<" or EOf,
#     return &null
#-]

procedure Body_Read_Non_Tag ( body )
  #-- 1 --
  while  not Scan_End_File ( body.scan )  do
  { #-- 1.1 --
    #-[ if there is a "<" on this line ->
    #     body.text  ||:=  text from body.scan up to but not including "<"
    #     body.scan  :=    body.scan advanced up to "<"
    #     return
    # | else if this is the last line in body.scan ->
    #     body.text  ||:=  remainder of subject || "\n"
    #     body.scan  :=    body.scan at EOF
    # | else if this is not the last line in body.scan ->
    #     body.text  ||:=  remainder of subject || "\n"
    #     body.scan  :=    body.scan advanced to next line
    #-]
    if  find ( "<" )  then
    { #-- 1.1.1 --  Case A of above
      body.text  ||:=  tab ( find ( "<" ) );
      return;
    } #-- 1.1.1 --
    else
    { #-- 1.1.2 --  Cases B and C above
      body.text  ||:=  tab ( 0 ) || "\n";
      Scan_Next_Line ( body.scan );
    } #-- 1.1.2 --
  } #-- 1 --
end # --- Body_Read_Non_Tag ---


# - - -   B o d y _ R e a d _ T a g   - - -

#-[ if body.scan starts with a "<" but it's not part of a valid HTML tag ->
#     body.scan.log  ||:=  scan error(s)
#     body.scan      :=    body.scan advanced past the next ">", and
#                          also advanced the closing tag if it is one
#                          our paired tags, or to EOF
#     fail
# | else ->
#     body.text  ||:=  expansion of that tag, if ours, else its source
#     body.scan  :=    body.scan advanced past the tag
#     body.plan  +:=   link variant from the tag, if any
#     body       :=    body modified to reflect any header info from
#                      the tag, if it is ours
#     return &null
# | else ->
#     fail
#-]

procedure Body_Read_Tag ( body )
  local webtag      # Web tag object (see webtag.icn)

  #-- 1 --
  #-[ if body.scan starts with a syntactically invalid HTML tag ->
  #     body.scan.log  ||:=  scan error(s)
  #     body.scan      :=    body.scan advanced past the valid-looking part
  #     fail
  # | else if body.scan starts with a syntactically valid HTML tag ->
  #     webtag     :=  a webtag object representing same with tag
  #                    and attribute names lowercased
  #     body.scan  :=  body.scan advanced past the tag
  # | else ->
  #     fail
  #-]
  if  not ( webtag := Webtag_Scan ( body.scan ) )  then
    fail;

  #-- 2 --
  #-[ if webtag is not one of ours ->
  #     body.text  ||:=  source equivalent of webtag
  #     return &null
  # | if webtag is ours but invalid ->
  #     body.scan      :=   body.scan advanced (if paired) past the
  #                         closing tag if any, or to EOF
  #     body.scan.log  +:=  scan error(s)
  # | if webtag is valid (and, if it is a paired tag, body.scan
  #   contains a closing tag) ->
  #     body.scan  :=    body.scan advanced past the closing tag, if any,
  #                      else unchanged
  #     body.text  ||:=  expansion of the tag
  #     body.plan  +:=   link variant from the tag, if any
  #     body       :=    body modified to reflect any header information
  #                      in the tag
  #-]
  if  not Body_Dispatch_Tag ( body, webtag )  then
    fail;

  #-- 3 --
  return;
end # -- Body_Read_Tag ---


# - - -   B o d y _ D i s p a t c h _ T a g   - - -

#-[ if webtag is not one of ours ->
#     body.text  ||:=  source equivalent of webtag
#     return &null
# | if webtag is ours but invalid ->
#     body.scan      :=   body.scan advanced (if paired) past the
#                         closing tag if any, or to EOF
#     body.scan.log  +:=  scan error(s)
#     fail
# | if webtag is valid (and, if it is a paired tag, body.scan
#   contains a closing tag) ->
#     body.scan  :=    body.scan advanced past the closing tag, if any,
#                      else unchanged
#     body.text  ||:=  expansion of the tag
#     body.plan  +:=   link variant from the tag, if any
#     body       :=    body modified to reflect any header information
#                      in the tag
#     return &null
#-]

procedure Body_Dispatch_Tag ( body, webtag )
  local dispatch        # The appropriate parsing function for the tag type
  static dispatchTable  # Table: maps tag string -> parsing function
  initial
  { #-- All functions must have this argument list:
    #     ( body, webtag )
    #--
    dispatchTable  :=  table ( );
    dispatchTable["author"   ]  :=  Body_Parse_Author_Tag;
    dispatchTable["g"        ]  :=  Body_Parse_G_Tag;
    dispatchTable["head"     ]  :=  Body_Parse_Head_Tag;
    dispatchTable["next"     ]  :=  Body_Parse_Next_Tag;
    dispatchTable["prev"     ]  :=  Body_Parse_Prev_Tag;
    dispatchTable["r"        ]  :=  Body_Parse_R_Tag;
    dispatchTable["rr"       ]  :=  Body_Parse_RR_Tag;
    dispatchTable["see"      ]  :=  Body_Parse_See_Tag;
    dispatchTable["template" ]  :=  Body_Parse_Template_Tag;
    dispatchTable["updated"  ]  :=  Body_Parse_Updated_Tag;
  }

  #-- 1 --
  #-[ if webtag is not one of ours ->
  #     body.text  ||:=  expansion of webtag
  #     return
  # | else ->
  #     dispatch  :=  parser function for webtag
  #-]
  if  not ( dispatch := \ dispatchTable [ Webtag_Name ( webtag ) ] )  then
  { #-- Not one of ours
    body.text  ||:=  Webtag_Source ( webtag );
    return;
  } #-- Not one of ours
  
  #-- 2 --
  #-[ if webtag is a closing tag and the name is not "head" ->
  #     body.scan  ||:=  error, no opening tag corresp. to this
  #     fail
  # | else -> I
  #-]
  if  ( Webtag_Is_Close ( webtag ) ) &
      ( Webtag_Name ( webtag ) ~== "head" )  then
    return Scan_Error ( body.scan,
      "There is no opening tag corresponding to this closing tag." );

  #-- 3 --
  #-[ if webtag is ours but the dispatch function finds it invalid ->
  #     body.scan      :=    body.scan advanced past the open tag, and
  #                          also past the closing tag if any, or to EOF
  #     body.scan.log  ||:=  scan error(s)
  #     fail
  # | if webtag is valid (and, if it is a paired tag, body.scan
  #   contains a closing tag) ->
  #     body.scan  :=    body.scan advanced past the closing tag, if any,
  #                      else unchanged
  #     body.text  ||:=  expansion of the tag
  #     body.plan  +:=   link variant from the tag, if any
  #     body       :=    body modified to reflect any header information
  #                      in the tag
  #-]
  if  not dispatch ( body, webtag )  then
    fail;

  #-- 4 --
  return webtag
end # --- Body_Dispatch_Tag ---


#================================================================
# Generic intended function for all procedures in dispatchTable:
#----------------------------------------------------------------
#
#-[ if webtag is unpaired and invalid ->
#     body.scan.log  ||:=  scan error(s)
#     fail
# | if webtag is unpaired and valid ->
#     body.text  ||:=  expansion of webtag, if any
#     body       :=    body modified to reflect any header
#                      information from the tag
#     return &null
# | if webtag is paired and invalid ->
#     body.scan      :=    body.scan advanced past the closing tag,
#                          if present, or EOF if it is missing
#     body.scan.log  ||:=  scan error(s)
#     fail
# | if webtag is paired and valid ->
#     body.scan  :=    body.scan advanced past the closing tag
#     body.text  ||:=  expansion of webtag, if any
#     body.plan  +:=   link variant from tag, if any
#     body       :=    body modified to reflect any header
#                      information from the tag
#     return &null
#-]


#----------------------------------------------------------------


# - - -   B o d y _ P a r s e _ A u t h o r _ T a g   - - -

#-[ if webtag is not a valid <AUTHOR> tag ->
#     body.scan      :=    body.scan advanced past the </AUTHOR> tag,
#                          if any, or to EOF
#     body.scan.log  ||:=  scan error(s)
#     fail
# | else ->
#     body.scan  :=  body.scan advanced past </AUTHOR> tag
#     body       :=  body with author set to text from scan.log up
#                    to </AUTHOR> tag
#     return &null
#-]

procedure Body_Parse_Author_Tag ( body, webtag )
  #-- 1 --
  #-[ if webtag is a closing tag, or no </AUTHOR> tag follows in body.scan ->
  #     body.scan.log  ||:=  error message(s)
  #     body.scan      :=    body.scan at EOF
  #     fail
  # | else ->
  #     body.author  :=  text up to </AUTHOR> tag
  #     body.scan    :=  body.scan advanced past </AUTHOR> tag
  #-]
  if  Webtag_Is_Close ( webtag )  then
    return Scan_Error ( body.scan,
      "There is no opening <AUTHOR> tag to match this closing tag." );

  if  not ( body.author := Body_Parse_To_Closing_Tag ( body, "author" ) ) then
    fail;

  #-- 2 --
  #-[ if webtag has any attributes ->
  #     body.scan.log  ||:=  error message(s)
  #     fail
  # | else -> I
  # ]
  if  Webtag_N_Attrs ( webtag ) > 0  then
    return Scan_Error ( body.scan,
      "No attributes are allowed on the <AUTHOR> tag." );

  #-- 3 --
  return;
end # --- Body_Parse_Author_Tag ---


# - - -   B o d y _ P a r s e _ G _ T a g   - - -

#-[ if webtag is not a valid <G> tag ->
#     body.scan.log  ||:=  scan error(s)
#     fail
# | else ->
#     body.text  ||:=  link to target topic || title of same topic || "</A>"
#     return &null
#-]

procedure Body_Parse_G_Tag ( body, webtag )
  local target

  #-- 1 --
  #-[ if webtag has one ID attribute that names a valid shortName in plan ->
  #     target  :=  a Target object representing that shortName
  # | else ->
  #     body.scan.log  ||:=  error message(s)
  #     fail
  #-]
  if  not ( target  := Body_Find_Target ( body, webtag ) )  then
    fail;

  #-- 2 --
  #-[ body.text  ||:=  The text `<A HREF="x">y</A>' where x is
  #                    the relative pathname from the body's topic
  #                    to target and y is target's topic's title
  #-]
  Body_Make_Link ( body,
                   Topic_Relative_Path ( body.topic, target ),
                   Topic_Title ( Target_Topic ( target ) ) );

  #-- 3 --
  return;
end # --- Body_Parse_G_Tag ---


# - - -   B o d y _ P a r s e _ H e a d _ T a g   - - -

procedure Body_Parse_Head_Tag ( body, webtag )
#--
# We don't actually check that <HEAD> tags are balanced, or valid, or
# even that the <AUTHOR> and other tags are located between them.
# They are treated as syntactic sugar.  In practice, the <AUTHOR> and
# other head-section tags can occur anywhere.
#--
  return;
end


# - - -   B o d y _ P a r s e _ N e x t _ T a g   - - -

#-[ if webtag is a valid tag of the form <NEXT ID="foo"> ->
#     body.enext  :=  Target object representing foo
#     return &null
# | else if webtag is a valid tag of the form <NEXT NONE> ->
#     body.enext  :=  &null
#     return &null
# | else ->
#     body.scan.log  ||:=  scan error(s)
#     fail
#-]

procedure Body_Parse_Next_Tag ( body, webtag )
  local target     # Topic referred to by <NEXT> tag, if any

  #-- 1 --
  #-[ if webtag has one ID attribute whose value is a shortName found
  #   in body.plan ->
  #     target  :=  a Target object representing that shortName
  # | else if webtag has one NONE attribute with no value ->
  #     target  :=  &null
  # | else ->
  #     body.scan.log  ||:=  scan error message(s)
  #     fail
  #-]
  if  not ( target := Body_Find_Effective_Target ( body, webtag ) )  then
    fail;

  #-- 2 --
  body.enext  :=  target;

  #-- 3 --
  return;
end # --- Body_Parse_Next_Tag ---


# - - -   B o d y _ P a r s e _ P r e v _ T a g   - - -

#-[ if webtag is a valid tag of the form <PREV ID="foo"> ->
#     body.eprev  :=  a Target object representing foo
#     return &null
# | else if webtag is a valid tag of the form <PREV NONE> ->
#     body.eprev  :=  &null
#     return &null
# | else ->
#     body.scan.log  ||:=  scan error(s)
#     fail
#-]

procedure Body_Parse_Prev_Tag ( body, webtag )
  local target     # Topic referred to by <PREV> tag, if any

  #-- 1 --
  #-[ if webtag has one ID attribute whose value is a shortName found
  #   in body.plan ->
  #     target  :=  a Target object representing that shortName
  # | else if webtag has one NONE attribute with no value ->
  #     target  :=  &null
  # | else ->
  #     body.scan.log  ||:=  scan error message(s)
  #     fail
  #-]
  if  not ( target := Body_Find_Effective_Target ( body, webtag ) )  then
    fail;

  #-- 2 --
  body.eprev  :=  target;

  #-- 3 --
  return;
end # --- Body_Parse_Prev_Tag ---


# - - -   B o d y _ P a r s e _ R _ T a g   - - -

#-[ if webtag is a valid tag of the form <R ID="foo"> ->
#     body.text  ||:=  link to target foo || "`" ||
#                      title of target foo's topic || "'</A>"
#     return &null
# | else ->
#     body.scan.log  ||:=  scan error(s)
#     fail
#-]

procedure Body_Parse_R_Tag ( body, webtag )
  local target

  #-- 1 --
  #-[ if webtag has one ID attribute that names a valid shortName in plan ->
  #     target  :=  a Target object represeting that shortName
  # | else ->
  #     body.scan.log  ||:=  error message(s)
  #     fail
  #-]
  if  not ( target := Body_Find_Target ( body, webtag ) )  then
    fail;

  #-- 2 --
  #-[ body.text  ||:=  The text `<A HREF="x">y</A>' where x is
  #                    the relative pathname from the body's topic
  #                    to target and y is target's title
  #                    enclosed in paired single quotes
  #-]
  Body_Make_Link ( body,
                   Topic_Relative_Path ( body.topic, target ),
                   "`" || Topic_Title ( Target_Topic ( target ) ) || "'" );

  #-- 3 --
  return;
end # --- Body_Parse_R_Tag ---


# - - -   B o d y _ P a r s e _ R R _ T a g   - - -

#-[ if webtag is not a valid tag of the form <RR ID="foo"> ->
#     body.scan.log  ||:=  scan error(s)
#     fail
# | else if an </RR> tag does not follow in body.scan ->
#     body.scan      :=    body.scan advanced to EOF
#     body.scan.log  ||:=  scan error, missing </RR>
#     fail
# | else ->
#     body.scan  :=    body.scan advanced past the </RR>
#     body.text  ||:=  link to topic foo ||
#                      text from body.scan up to the </RR> tag || "</A>"
#     body.plan  +:=   a linkvar object with fields:
#       .text       :=  text from body.scan up to the </RR> tag
#       .shortName  :=  body.topic.shortName
#       .lineNo     :=  line number from body.scan
#     return &null
#-]

procedure Body_Parse_RR_Tag ( body, webtag )
  local target         # Topic referred to in ID= attribute
  local linkText            # Text between <RR> and </RR>
  local linkvar             # Linkvar object for linkText
  local lineNo

  #-- 1 --
  #-[ lineNo  :=  current line number from body.scan
  #-]
  lineNo  :=  Scan_Line_Number ( body.scan );

  #-- 2 --
  #-[ if webtag is a closing tag ->
  #     body.scan  ||:=  error, no opening tag
  #     fail
  # | else -> I
  #-]
  if  Webtag_Is_Close ( webtag )  then
    return Scan_Error ( body.scan,
      "There is no opening <RR> tag to match this closing tag." );

  #-- 3 --
  #-[ if </RR> follows somewhere in body.scan ->
  #     linkText   :=  text from body.scan to but not including </RR> tag
  #     body.scan  :=  body.scan advanced past the </RR> tag
  # | else ->
  #     body.scan.log  ||:=  scan error, missing </RR> tag
  #     body.scan      :=    body.scan advanced to EOF
  #     fail
  #-]
  if  not ( linkText := Body_Parse_To_Closing_Tag ( body, "rr" ) )  then
    fail;

  #-- 4 --
  #-[ if webtag has one ID attributed referring to a shortName valid in
  #   body.plan ->
  #     target  :=  a Target object representing that shortName
  # | else ->
  #     body.scan.log  ||:=  error message(s)
  #     fail
  #-]
  if  not ( target := Body_Find_Target ( body, webtag ) )  then
    fail;

  #-- 5 --
  #-[ body.text  ||:=  The text `<A HREF="x">y</A>' where x is
  #                    the relative pathname from the body's topic
  #                    to target and y is target's title
  #-]
  Body_Make_Link ( body,
                   Topic_Relative_Path ( body.topic, target ),
                   linkText );

  #-- 6 --
  #-[ body.plan  :=  body.plan with a link variant recorded for the short
  #                  name of topic `target' and link text `linkText' at
  #                  line number lineNo in the current file
  #-]
  linkvar  :=  Linkvar_New ( linkText, Topic_Short_Name ( body.topic ),
                             lineNo );
  Topic_Add_Linkvar ( Target_Topic ( target ), linkvar );

  #-- 7 --
  return;
end # --- Body_Parse_RR_Tag ---


# - - -   B o d y _ P a r s e _ S e e _ T a g   - - -

#-[ if webtag is a valid tag of the form <SEE ID="foo"> ->
#     body.seeList  ||:=  a Target object representing foo
#     return &null
# | else if webtag has the form <SEE NONE> ->
#     body.seeList  :=  an empty list
# | else ->
#     body.scan.log  ||:=  scan error(s)
#     fail
#-]

procedure Body_Parse_See_Tag ( body, webtag )
  local target     # Topic referred to by <SEE> tag, if any

  #-- 1 --
  #-[ if webtag has one ID attribute whose value is a shortName found
  #   in body.plan ->
  #     target  :=  a Target object representing that shortName
  # | else if webtag has one NONE attribute with no value ->
  #     target  :=  &null
  # | else ->
  #     body.scan.log  ||:=  scan error message(s)
  #     fail
  #-]
  if  not ( target := Body_Find_Effective_Target ( body, webtag ) )  then
    fail;

  #-- 2 --
  #-[ if target is &null ->
  #     body.seeList  :=  an empty list
  # | else ->
  #     body.seeList  ||:=  target
  #-]
  if  / target  then
    body.seeList  :=  []
  else
    put ( body.seeList, target );

  #-- 3 --
  return;
end # --- Body_Parse_See_Tag ---


# - - -   B o d y _ P a r s e _ T e m p l a t e _ T a g   - - -

#-[ if webtag does not have one attribute of the form ID="..." ->
#     body.scan.log  ||:=  scan error(s)
#     fail
# | else if the file named in the ID value is not a valid template
#   file (relative to the starting directory) ->
#     body's topic's plan's tmplPool's log  ||:=  scan error(s)
#     fail
# | else ->
#     body  :=  body with effective template changed to a Template
#               object representing the file named in the ID value
#-]

procedure Body_Parse_Template_Tag ( body, webtag )
  local tagAttr         # Tag attribute object
  local value           # Value from tag attribute
  local template        # Template object

  #-- 1 --
  #-[ if webtag has one attribute ->
  #     tagAttr  :=  a TagAttr object for that attribute
  # | else ->
  #     body.scan.log  ||:=  scan error, wrong # of attrs
  #     fail
  #-]
  if  Webtag_N_Attrs ( webtag ) ~= 1  then
    return Scan_Error ( body.scan,
      "This tag must have exactly one ID attribute." );

  tagAttr  :=  Webtag_Gen_Attrs ( webtag );

  #-- 2 --
  #-[ if tagAttr has name "id" and a value ->
  #     value  :=  tagAttr's value
  # | else ->
  #     body.scan.log  ||:=  scan error
  #     fail
  #-]
  if  Tag_Attr_Name ( tagAttr ) ~== "id"  then
    return Scan_Error ( body.scan,
      "The attribute name of this tag must be `ID'." );

  if  not ( value := Tag_Attr_Value ( tagAttr ) )  then
    return Scan_Error ( body.scan,
      "The ID attribute must have the file name, in quotes, as a value." );

  #-- 3 --
  #-[ if value names a valid template file relative to the starting
  #   directory ->
  #     template  :=  a Template object representing that file
  # | else ->
  #     body's topic's plan's tmplPool's log  ||:=  error message(s)
  #     fail
  #-]
  if  not ( template := Plan_Lookup_Template ( Topic_Plan ( body.topic ),
                                               value ) )  then
    fail;

  #-- 4 --
  body.etemplate  :=  template;
  return &null;
end # --- Body_Parse_Template_Tag ---


# - - -   B o d y _ P a r s e _ U p d a t e d _ T a g   - - -

#-[ if webtag does not have one attribute of the form DATE="...", with
#   the quoted string containing a valid RCS date keyword ->
#     body.scan.log  ||:=  scan error(s)
#     fail
# | else ->
#     body.updated  :=  timestamp from that tag
#     return &null
#-]

procedure Body_Parse_Updated_Tag ( body, webtag )
  local attr
  local keyword
  local timestamp

  #-- 1 --
  #-[ if webtag has exactly one attribute ->
  #     attr  :=  a tagAttr object for that attribute
  # | else ->
  #     body.scan.log  ||:=  scan error, must have exactly 1 attr
  #     fail
  #-]
  if  Webtag_N_Attrs ( webtag ) ~= 1  then
    return Scan_Error ( body.scan,
      "This tag should have the form `<UPDATED DATE=\"$",
      "Date$\">'" );

  attr  :=  Webtag_Gen_Attrs ( webtag );

  #-- 2 --
  #-[ if attr has name "date" and a value ->
  #     keyword :=  attr's value
  # | else ->
  #     body.scan.log  ||:=  scan error, must have `date=' and value
  #     fail
  #-]
  if  ( not ( Tag_Attr_Name ( attr ) == "date" ) ) |
      ( not ( keyword := Tag_Attr_Value ( attr ) ) )  then
    return Scan_Error ( body.scan,
      "This tag should have the form `<UPDATED DATE=\"$",
      "Date$\">'" );

  #-- 3 --
  #-[ &subject  :=  keyword
  #   &pos      :=  1
  #-]
  keyword ?
  { #-- Dissect the keyword

    #-- 4 --
    #-[ if subject begins with "$" followed by "Date" ->
    #     advance subject past same
    # | else ->
    #     body.scan.log  ||:=  scan error
    #     fail
    #-]
    if  not = "$"  then
      return Scan_Error ( body.scan,
        "The DATE string must start with a dollar sign ($)" );

    if  not = "Date"  then
      return Scan_Error ( body.scan,
        "The DATE string must be an RCS Date keyword." );

    #-- 5 --
    #-[ if the subject starts with a ":" ->
    #     subject  :=  subject advanced past the ":"
    # | else ->
    #     body.scan.log  ||:=  scan error, never checked in
    #     fail
    #-]
    if  not = ":"  then
      return Scan_Error ( body.scan,
        "This file has never been checked in." );

    #-- 6 --
    #-[ subject  :=  subject with any leading whitespace removed
    #-]
    tab ( many ( ' \t' ) );

    #-- 7 --
    #-[ if "$" occurs somewhere in the subject ->
    #     timestamp  :=  text from subject up to the "$", with right
    #                    blanks trimmed
    # | else ->
    #     body.scan.log  ||:=  scan error, badly formed RCS date
    #     fail
    #-]
    if  not ( timestamp := trim ( tab ( upto ( '$' ) ) ) )  then
      return Scan_Error ( body.scan,
        "Badly formed RCS Date keyword." );
  } #-- Dissect the keyword

  #-- 8 --
  body.updated  :=  timestamp;
  return;
end # --- Body_Parse_Updated_Tag ---


#================================================================
# UTILITY FUNCTIONS
#================================================================


# - - -   A r b _ F i n d   - - -

procedure Arb_Find ( target )
#--
# Like find(target), but case-insensitive
#--
  local lowTarget       # Target, lowercased
  local savePos         # &pos value on entry

  lowTarget  :=  map ( target );
  savePos    :=  &pos;

  map ( &subject ) ?
  { #-- Subject is lowercased
    &pos  :=  savePos;      # Restore the saved position

    every suspend ( find ( target ) );
  } #-- Subject is lowercased
end # --- Arb_Find ---


# - - -   B o d y _ F i n d _ T a r g e t   - - -

#-[ if webtag has one ID attribute whose value is a shortName found
#   in body.plan ->
#     return the Target object representing that shortName
# | else ->
#     body.scan.log  ||:=  scan error message(s)
#     fail
#-]

procedure Body_Find_Target ( body, webtag )
  #-- 1 --
  #-[ anchor := &null ]
  #-]

  local target          # Target object representing the shortName
  local tagAttr         # First attribute object
  local value           # Value part of attribute
  local anchorPos       # Position of the anchor within the value, if any
  local anchor          # Anchor string, if any

  #-- 2 --
  #-[ if webtag has one attribute ->
  #     tagAttr  :=  that attribute
  # | else ->
  #     body.scan.log  ||:=  scan error, wrong # of attrs
  #     fail
  #-]
  if  Webtag_N_Attrs ( webtag ) ~= 1  then
    return Scan_Error ( body.scan,
      "This tag must have exactly one ID attribute." );

  tagAttr  :=  Webtag_Gen_Attrs ( webtag );

  #-- 3 --
  #-[ if tagAttr has name "id" and a value ->
  #     value  :=  that attribute's value
  # | else ->
  #     body.scan.log  ||:=  scan error(s)
  #     fail
  #-]
  if  Tag_Attr_Name ( tagAttr ) ~== "id"  then
    return Scan_Error ( body.scan,
      "The attribute name of this tag must be `ID'" );

  if  not ( value := Tag_Attr_Value ( tagAttr ) )  then
    return Scan_Error ( body.scan,
      "The ID attribute must have a quoted string value." );

  #-- 4 --
  #-[ if value contains a '#' anywhere ->
  #     value   :=  value with the first '#' and all following text removed
  #     anchor  :=  "#" || characters following the first '#' in value
  #-]
  if  anchorPos := find ( value, "#" )  then
  { anchor  :=  value[anchorPos:0];
    value   :=  value[1:anchorPos];
  }

  #-- 5 --
  #-[ if value is a shortName found in body.plan ->
  #     target  :=  the Target object for shortName (value)
  # | else ->
  #     body.scan.log  ||:=  scan error, unknown shortName
  #     fail
  #-]
  if  not ( target  := Plan_Lookup_Short_Name ( body.plan, value ) )  then
    return Scan_Error ( body.scan,
      "Unknown short reference `", value, "'." );

  #-- 6 --
  return target;
end # --- Body_Find_Target ---


# - - -   B o d y _ F i n d _ E f f e c t i v e _ T a r g e t   - - -

#-[ if webtag has one ID attribute whose value is a shortName found
#   in body.plan ->
#     return the topic of that shortName
# | else if webtag has one NONE attribute with no value ->
#     return &null
# | else ->
#     body.scan.log  ||:=  scan error message(s)
#     fail
#-]

procedure Body_Find_Effective_Target ( body, webtag )
  local target          # Target topic referred to by "ID="
  local tagAttr         # First attribute object
  local value           # Value part of attribute
  local anchorPos       # Position of '#' in value, if any
  local anchor          # The "#anchor" part of value, if any

  #-- 1 --
  #-[ if webtag has one attribute ->
  #     tagAttr  :=  that attribute
  # | else ->
  #     body.scan.log  ||:=  scan error, wrong # of attrs
  #-]
  if  Webtag_N_Attrs ( webtag ) ~= 1  then
    return Scan_Error ( body.scan,
      "This tag must have exactly one ID attribute." );

  tagAttr  :=  Webtag_Gen_Attrs ( webtag );

  #-- 2 --
  #-[ if tagAttr has name "none" and no value ->
  #     return &null
  # | else if tagAttr has name "none" and a value ->
  #     body.scan.log  ||:=  scan error, no value allowed
  #     fail
  # | else -> I
  #-]
  if  Tag_Attr_Name ( tagAttr ) == "none"  then
  { if Tag_Attr_Value ( tagAttr )  then
      return Scan_Error ( body.scan,
        "The NONE attribute must have no value." );
      return &null;
  }

  #-- 3 --
  #-[ if tagAttr has name "id" and one value ->
  #     value  :=  that attribute
  # | else ->
  #     body.scan.log  ||:=  scan error(s)
  #     fail
  #-]
  if  Tag_Attr_Name ( tagAttr ) ~== "id"  then
    return Scan_Error ( body.scan,
      "The attribute name of this tag must be `ID'" );

  if  not ( value := Tag_Attr_Value ( tagAttr ) )  then
    return Scan_Error ( body.scan,
      "The ID attribute must have a quoted string value." );

  #-- 4 --
  #-[ if value contains a '#' anywhere ->
  #     value   :=  value with the first '#' and all following text removed
  #     anchor  :=  "#" || characters following the first '#' in value
  #-]
  if  anchorPos := find ( value, "#" )  then
  { anchor  :=  value[anchorPos:0];
    value   :=  value[1:anchorPos];
  }

  #-- 5 --
  #-[ if value is a shortName found in body.plan ->
  #     targetTopic  :=  the Topic object for shortName (value)
  # | else ->
  #     body.scan.log  ||:=  scan error, unknown shortName
  #     fail
  #-]
  if  not ( target := Plan_Lookup_Short_Name ( body.plan, value ) )  then
    return Scan_Error ( body.scan,
      "Unknown short reference `", value, "'." );

  #-- 6 --
  return target;
end # --- Body_Find_Effective_Target ---


# - - -   B o d y _ M a k e _ L i n k   - - -

#-[ body.text  ||:=  The text `<A HREF="path">linkText</A>'
#-]

procedure Body_Make_Link ( body, path, linkText )
  body.text  ||:=  "<A HREF=\"" || path || "\">" || linkText || "</A>";
end # --- Body_Make_Link ---


# - - -   B o d y _ P a r s e _ T o _ C l o s i n g _ T a g   - - -

#-[ if the tag "</" || tagName || ">" exists in body.scan, using
#   case insensitive comparison ->
#     body.scan  :=  body.scan advanced past the tag
#     returns text up to but not including the tag
# | else ->
#     body.scan.log  ||:=  scan error, missing close tag
#     body.scan      :=    body.scan advanced to EOF
#     fail
#-]

procedure Body_Parse_To_Closing_Tag ( body, tagName )
  #-- 1 --
  #-[ linkText  :=  ""  #
  #   target    :=  "</" || (tagName, lowercased) || ">"
  #-]
  local linkText        # Text between the tags, to be returned
  local target          # The tag text we're looking for
  local closePos        # Position of the closing "<" on the line

  linkText  :=  "";
  target    :=  "</" || map ( tagName ) || ">";

  #-- 2 --
  #-[ if target exists somewhere in body.scan ->
  #     linkText    ||:=  text from body.scan up to the next occurrence
  #                       of the target
  #     body.scan   :=    body.scan advanced up to the next occurrence
  #                       of the target
  # | else ->
  #     linkText    ||:=  text from body.scan up to EOF
  #     body.scan   :=    body.scan advanced to EOF
  #-]
  while  not Scan_End_File ( body.scan )  do
  { #-- 2.1 --
    #-[ if closing tag is on the current line ->
    #     linkText   ||:=  text up to but not including the tag
    #     body.scan  :=    body.scan advanced after the tag
    #     return linkText
    # | else -> I
    #-]
    if  ( closePos := Arb_Find ( target ) )  then
    { linkText  ||:=  tab ( closePos );
      move ( * target );
      return linkText;
    }

    #-- 2.2 --
    #-[ linkText  ||:=  remainder of current line plus a newline
    #-]
    linkText  ||:=  tab ( 0 ) || "\n";

    #-- 2.3 --
    #-[ if no lines remain in body.scan ->
    #     body.scan  :=  body.scan at EOF
    # | else ->
    #     body.scan  :=  body.scan advanced to next line
    #-]
    Scan_Next_Line ( body.scan );
  } #-- 2.1 --

  #-- 3 --
  #-[ body.scan.log  ||:=  scan error, no closing (target)
  #   fail
  #-]
  return Scan_Error ( body.scan,
    "There was no closing `", map ( target, &lcase, &ucase ), "' tag." );
end # --- Body_Parse_To_Closing_Tag ---

$endif