FICO
FICO Xpress Optimization Examples Repository
FICO Optimization Community FICO Xpress Optimization Home
Back to examples browserPrevious exampleNext example

Using moseldoc

Description
  • defining and using annotations
  • text handling
  • generating XML and HTML files with Mosel
  • subroutines
This moseldoc program can be used either from Mosel:
mosel moseldoc F=mddoc.bim
where the BIM file to which it is applied (here: mddoc.bim) must have been compiled specifying the option '-D'. (NB: The default value for 'F' is '*.bim' meaning all bim files in current directory)

Or it can be turned into an executable using 'deploy' with the command (requires a C compiler):
mosel comp -s moseldoc.mos -o deploy.exe:moseldoc,css-z=moseldoc.css
The resulting program expects as its parameters a list of files:
moseldoc mddoc.bim
The provided set of files also contains the dictionary template (.pot) generated with the xprnls tool and sets of translations for German and French.

Further explanation of this example: 'Mosel Language Reference', Section 2.19 Documenting models using annotations and 'Mosel User Guide', Section 18.2 moseldoc: Generating model documentation.


Source Files

Data Files





moseldoc.mos

(!********************************************************
  * Mosel Example Programs                              
  * ======================                              
  *                                                     
  * file moseldoc.mos                                   
  * `````````````````                                   
  * Example for the use of the Mosel language           
  * (A documentation generator for Mosel files)  
  *
  * See file mddoc.mos for usage examples and explanations
  *                                                     
  * (c) 2015 Fair Isaac Corporation                     
  *     author: Y. Colombani, S. Heipcke, rev. Sep. 2017
  *******************************************************!)

! This program can be used either from Mosel:
! >mosel moseldoc F=filename
! (default value for 'F' is '*.bim' => all bim files in current directory)
!
! Or it can be turned into an executable using 'deploy' with the command:
! >mosel comp -s moseldoc.mos -o deploy.exe:moseldoc,css-z=moseldoc.css
! The resulting program expects as its parameters a list of files:
! >moseldoc filename

model moseldoc
version 1.4.0
uses 'mmjobs','mmxml','deploy'

parameters
 F="*.bim"
 out=""
 force=true
 mode=0
 css="moseldoc.css"
 exerr=false
 keepundef=false
end-parameters

forward procedure process_file(fn:text)
forward procedure banner
forward procedure showhelp
forward function basename(f:text):text
forward function gendocxml(fno:text,repl:boolean,rmode:integer,outfile:text):boolean
forward procedure gendochtml(fname:text,repl:boolean,outdir:text)
forward procedure add_fieldval(fa:array(fld:set of string,vals:set of string) of string,val:text)

declarations
 lsfile:list of string
 lsf2:list of text
 repl:boolean
 exitonerror:boolean
 keepundefannot:boolean
 rmode:integer
 rout:text
 xd:xmldoc
 public xmltext:text

 ! for dochtml
 DEFCHAP="defchap.html"
 firstchap:text
 glbcom,glbcom1,glbcom2:text
end-declarations

 if argc=1 and argv(1)="mosel" then	! not deployed: use parameter
  lsfile:=[F]
  repl:=force
  keepundefannot:=keepundef
  rmode:=mode
  rout:=out
  exitonerror:=exerr
 elif argc=2 and argv(2)="-V" then
  banner
  exit(0)
 elif argc<2 then
  banner
  showhelp
  exit(1)
 else
  li:=2
  repeat
   if argv(li)="-f" then
    repl:=true
    li+=1
   elif argv(li)="-u" then
    keepundefannot:=true
    li+=1
   elif argv(li)='-xml' then
    rmode:=1
    li+=1
   elif argv(li)='-ixml' then
    rmode:=3
    li+=1
   elif argv(li)='-html' then
    rmode:=2
    li+=1
   elif argv(li)="-o" and li+1<argc then
    rout:=text(argv(li+1))
    li+=2
   elif argv(li)="-e" then
    exitonerror:=true
    li+=1
   else
    break
   end-if
  until li=argc
  forall(i in li..argc)
   lsfile+=[argv(i)]
 end-if

 setparam("datetimefmt","%d/%m/%y %0H:%0M:%0S")
 forall(f in lsfile) do
  lsf2:=[]
  findfiles(SYS_NODIR,lsf2,f)
  if lsf2.size>0 then
   forall(f2 in lsf2)
    if bittest(getfstat(f2),SYS_TYP)<>SYS_DIR then
     process_file(f2)
    end-if
  elif bittest(getfstat(f),SYS_TYP)<>SYS_DIR then
   process_file(f)
  end-if
 end-do

!**************************
!* Process a single file
!**************************
procedure process_file(fn:text)
 if rmode=0 then
  if gendocxml(fn,repl,0,"") then
   gendochtml(fn,repl,rout)
  end-if
 elif rmode=1 or rmode=3 then
  dummy:=gendocxml(fn,repl,rmode,rout)
 else
  gendochtml(fn,repl,rout)
 end-if
end-procedure

!***********************
!* Display Banner
!***********************
procedure banner
 writeln("FICO Xpress ",basename(argv(1))," v",getparam("model_version"))
 writeln("(c) Copyright Fair Isaac Corporation 2015-2017. All rights reserved")
 writeln(_("Link date"),": ",getparam("parser_date")," ",getparam("parser_time"))
end-procedure

!***********************
!* Display some help
!***********************
procedure showhelp
 writeln_("\nUsage: ",argv(1)," [-f] [-u] [-xml|-ixml|-html] [-o of] bimf|mosf [bimf|mosf...]\n")
 write_(`
Generate documentation from annotated bim files or mosel sources.
  -f     force creation of the document even if it already exists
  -u     keep documentation of annotations that are not defined via 'mc.def'
  -xml   generate only the XML file
  -ixml  generate only the XML file without header/root node (for inclusion)
  -html  generate only the HTML document (from an existing XML file)
  -o of  write to file 'of' if xml, or directory 'of' if html
  -e     exit on XML error
`)
end-procedure

!**********************************************************************
!* Extract the basename of a path (i.e. strip directory and extension)
!**********************************************************************
function basename(f:text):text
 returned:=pathsplit(SYS_FNAME,f)
 dummy:=pathsplit(SYS_EXTN,returned,returned)
end-function

!*****************************************************************************
!*****************************************************************************
!*
!*  Generation of the xml file from a bim file (with annotations)
!*
!*****************************************************************************
!*****************************************************************************

declarations
 Location=record
   bn:integer		! 'base' node
   pn:integer		! 'parameters' node
   cn:integer		! 'constants' node
   tn:integer		! 'constants' node
   vn:integer		! 'variables' node
   fn:integer		! 'functions' node
   pp:integer		! paragraphs
 end-record
end-declarations

forward procedure reindent(xd:xmldoc,n:integer,spc:integer)
forward function createlocs(sections:array(locs:set of string) of Location,relocs:array(alocs:set of string) of string,bn:integer,glbann:array(glbs:set of string) of string):boolean
forward procedure process_glb(bn:integer,ann:string,elt:string,glbann:array(glbs:set of string) of string)
forward procedure process_glb(bn:integer,ann:string,elt:string,glbann:array(glbs:set of string) of string,txthtml:boolean)
forward function ignored(m:Model,p:string):boolean
forward function findparams(m:Model,s:set of string):set of string
forward function findtypes(m:Model,s:set of string):set of string
forward function findfcts(m:Model,s:set of string):set of string
forward function findcsts(m:Model,s:set of string):set of string
forward procedure process_param(m:Model,sections:array(set of string) of Location,relocs:array(set of string) of string,ndx:string,par:string)
forward procedure process_const(m:Model,sections:array(set of string) of Location,relocs:array(set of string) of string,ndx:string,cst:string)
forward procedure process_typdef(m:Model,sections:array(set of string) of Location,relocs:array(set of string) of string,ndx:string,typ:string)
forward procedure process_var(m:Model,sections:array(set of string) of Location,relocs:array(set of string) of string,ndx:string,cst:string)
forward procedure process_fct(m:Model,sections:array(set of string) of Location,relocs:array(set of string) of string,ndx:string,cst:string)
forward procedure process_annots(annotMod:Model,sections:array(locs:set of string) of Location,relocs:array(set of string) of string,ndx:string)
forward procedure process_cparams(m:Model,sections:array(locs:set of string) of Location,relocs:array(set of string) of string,ndx:string)
forward function startswith(t:text,ls:set of string):boolean
forward procedure addvalues(t:text, nd:integer)
forward procedure addbounds(t:text, nd:integer)
forward function getindex(l:list of string,locs:set of string,relocs:array(alocs:set of string) of string):string
forward procedure add_fctpar(pe:integer,elt:string,attr:string,val:text)
forward procedure add_fctparval(pe:integer,val:text)
forward procedure add_field(fa:array(fld:set of string) of string,val:text)
forward procedure add_entries(nid:integer,nds:list of string,gn:string,subgn:string,val:string)
forward procedure add_entries(nid:integer,gn:string,subgn:string,val:string)
forward function storeparag(val:text,nd:integer,w:integer,parg:string,src:string):integer
forward procedure text2xml(val:text,nid:integer)
forward procedure text2xml(val:text,nid:integer,wh:integer)
forward procedure text2xmlhdr(val:text,nid:integer)
forward procedure quoteconst(p:integer,n:string)
forward function addafter(p:integer,name:string,nds:list of string):integer
forward function split_tloc(tl:text):set of string
forward function fixxmlid(id:text):text
forward procedure setsafeentname(nid:integer,name:string)

!***************************************************
!* Generate the XML documentation from a bim
!***************************************************
function gendocxml(fno:text,repl:boolean,rmode:integer,outfile:text):boolean
 declarations
  m:Model
  xt:xmldoc
  glbs,sa:set of string
  glbann:array(glbs) of string
  l,parg:list of string
  lsd:list of integer
  fname,extn,bname:text
  parset,fctset,typset,varset,cstset:set of string
  rootbn:integer
  locs,alocs:set of string
  sections:array(locs) of Location
  relocs:array(alocs) of string
 end-declarations

 fname:=fno
 inname:=""
 if findtext(fname,".",1)<1 then
  if outfile="" then
   outfile:=fname+"_doc.xml"
  end-if
  fname+=".bim"
  extn:="bim"
 else
  extn:=pathsplit(SYS_EXTN,fname,bname)
  if extn="mos" then
   if compile("Ds",string(fname),"mem:bim")=0 then
    inname:="mem:bim"
    extn:="bim"
   end-if
  end-if
  if outfile="" then
   outfile:=bname+"_doc.xml"
  end-if
 end-if

 if extn="bim" then 	! we silently skip files with an unkown extension
  if not repl and getfstat(outfile)<>0 then
   writeln_("+ File `",outfile,"' already exists. Not regenerating it.")
   returned:=true
  else
   setparam("ioctrl",true)
    load(m,if(inname="",string(fname),inname),"l","","","")
   setparam("ioctrl",false)
   if getparam("iostatus")<>0 then
    writeln_("+ File `",fname,"' cannot be loaded. Ignored.")
   else
    getannotations(m,"","doc.",glbs,glbann)
    if glbs.size<1 then
     writeln_("+ File `",fname,"' does not include documentation annotations. Ignored.")
    else
     getannidents(m,sa)
     ready_for_gen:=true
    end-if
   end-if
  end-if

  if ready_for_gen and (glbs.size>0 or sa.size>0) then
   comnode:=addnode(xd,0,XML_COM,text("\nGenerated by moseldoc v")+
   		getparam("model_version")+
   		" from "+pathsplit(SYS_FNAME,fname)+"\n"+
   		"Creation date:"+text(datetime(SYS_NOW))+"\n")

   if ("doc.xmlheader" in glbs) and glbann("doc.xmlheader")<>"" then
    text2xmlhdr(glbann("doc.xmlheader"),0)
   end-if
   if ("doc.xmlroot" in glbs) and glbann("doc.xmlroot")<>"" then
    rootbn:=getnode(xd,glbann("doc.xmlroot"))
    if rootbn<=0 then
     writeln_("Root node `",glbann("doc.xmlroot"),"' does not exist")
     rootbn:=addnode(xd,0,XML_ELT,"mosel-doc")
    end-if
   else
    rootbn:=getnode(xd,"mosel-doc")
    if rootbn<1 then
     rootbn:=addnode(xd,0,XML_ELT,"mosel-doc")
    end-if
   end-if

   if rmode<>3 then
    process_glb(rootbn,"doc.title","title",glbann,true)
    process_glb(rootbn,"doc.subtitle","subtitle",glbann,true)
    process_glb(rootbn,"doc.name","name",glbann)
    process_glb(rootbn,"doc.version","version",glbann)
    process_glb(rootbn,"doc.date","date",glbann)
   end-if

   havesecs:=createlocs(sections,relocs,rootbn,glbann)
   
   parset:=findparams(m,sa)
   sa-=parset
   typset:=findtypes(m,sa)
   sa-=typset
   fctset:=findfcts(m,sa)
   sa-=fctset
   cstset:=findcsts(m,sa)
   forall(v in sa-cstset|not ignored(m,v))
    varset+={v}

   if havesecs then
    getannotations(m,"","doc._pps.",parg)
    while(parg.size>0) do
     ndx:=substr(getfirst(parg),10,100)
     cuthead(parg,1)
     val:=getfirst(parg)
     cuthead(parg,1)
     sections(ndx).pp:=storeparag(val,sections(ndx).pp,XML_NEXT,"p","pre")
    end-do
   end-if

   process_cparams(m,sections,relocs,if(havesecs,"","0ctrls"))

   if parset.size>0 then
    l:=sum(p in parset) [p]
    qsort(SYS_UP,l)
    forall(p in l)
     process_param(m,sections,relocs,if(havesecs,"","0params"),p)
   end-if

   if cstset.size>0 then
    l:=sum(c in cstset) [c]
    qsort(SYS_UP,l)
    forall(c in l)
     process_const(m,sections,relocs,if(havesecs,"","1consts"),c)
   end-if

   if typset.size>0 then
    l:=sum(c in typset) [c]
    qsort(SYS_UP,l)
    forall(c in l)
     process_typdef(m,sections,relocs,if(havesecs,"","2types"),c)
   end-if

   if varset.size>0 then
    l:=sum(c in varset) [c]
    qsort(SYS_UP,l)
    forall(c in l)
     process_var(m,sections,relocs,if(havesecs,"","3vars"),c)
   end-if

   if fctset.size>0 then
    l:=sum(c in fctset) [c]
    qsort(SYS_UP,l)
    forall(c in l)
     process_fct(m,sections,relocs,if(havesecs,"","4fcts"),c)
   end-if

   process_annots(m,sections,relocs,if(havesecs,"","5anns"))

   if not havesecs then
    sn:=0
    forall(s in locs| s<>"") do
     if sections(s).pn=0 and sections(s).cn=0 and sections(s).tn=0 and
        sections(s).vn=0 and sections(s).fn=0 and sections(s).pp=0 then
      delnode(xd, sections(s).bn)
     else
      sn+=1
      setattr(xd,sections(s).bn,"id","chp-"+textfmt(sn,3,1,10))
     end-if
    end-do
   end-if

   forall(s in locs)
    if sections(s).fn<>0 then
     if sections(s).vn>0 then
      p:=sections(s).vn
     elif sections(s).tn>0 then
      p:=sections(s).tn
     elif sections(s).cn>0 then
      p:=sections(s).cn
     elif sections(s).pn>0 then
      p:=sections(s).pn
     elif sections(s).pp>0 then
      p:=sections(s).pp
     else
      p:=getnode(xd,sections(s).bn,"title")
     end-if
     if p<1 then
      p:=addnode(xd,sections(s).bn,XML_FIRSTCHILD,XML_ELT,"fctList")
     else
      p:=addnode(xd,p,XML_NEXT,XML_ELT,"fctList")
     end-if
    end-if

   writeln_("+ Creating `",outfile,"' from `",fname,"'")
   setindentmode(xd,XML_MANUAL)
   reindent(xd,rootbn,0)
   if rmode=3 then
    save(xd,comnode,outfile)
    n:=getfirstchild(xd,rootbn)
    while(n>0) do
     save(xd,n,"tmp:partxml")
     fcopy("tmp:partxml",0,outfile,F_APPEND)
     fdelete("tmp:partxml")
     n:=getnext(xd,n)
    end-do
   else
    save(xd,outfile)
   end-if
   returned:=true
  else
   if ready_for_gen then
    writeln_("+ File `",fname,"' does not contain any `doc.' annotation. Ignored.")
   end-if
  end-if
  reset(xd)
  unload(m)
 end-if
end-function

!********************************
!* Re-indent the XML document
!********************************
procedure reindent(xd:xmldoc,n:integer,spc:integer)
 declarations
  noindent={"fctFurtherinfo","fctFurtherinfoItem","fctExampleText","title","entDescr","fctDescr","p"}
  l:list of integer
 end-declarations

 sethspace(xd,n,spc)
 setvspace(xd,n,1)
 if getname(xd,n) not in noindent then
  getnodes(xd,n,"node()",l)
  forall(nn in l|gettype(xd,nn)=XML_ELT)
   reindent(xd,nn,spc+1)
 end-if
end-procedure

!*******************************
!* Create the 'sections' table
!*******************************
function createlocs(sections:array(locs:set of string) of Location,relocs:array(alocs:set of string) of string,bn:integer,glbann:array(glbs:set of string) of string):boolean
 locs:={""}
 forall(i in glbs)
  if copytext(i,1,9)="doc._chs." then
   locs+={substr(i,10,i.size)}
  elif copytext(i,1,9)="doc._ses." then
   locs+={substr(i,10,i.size)}
  elif copytext(i,1,9)="doc._sus." then
   locs+={substr(i,10,i.size)}
  elif copytext(i,1,9)="doc._tls." then
   alocs+=split_tloc(glbann(i))
  end-if
 if locs.size>1 then
  finalise(locs)
  finalise(alocs)
  sections("").bn:=bn
  forall(i in glbs)
   if copytext(i,1,9)="doc._chs." then
    ndx:=substr(i,10,i.size)
    sections(ndx).bn:=addnode(xd,bn,XML_ELT,"chapter")
    sections(ndx).pp:=addnode(xd,sections(ndx).bn,XML_ELT,"title")
    if "doc._sts."+ndx in glbs then
     setattr(xd,sections(ndx).pp,"cont",glbann("doc._sts."+ndx))
    end-if
    text2xml(glbann(i),sections(ndx).pp)
    id:="doc._ids."+ndx
    if id in glbs and glbann(id)<>"" then
     setattr(xd,sections(ndx).bn,"id",glbann(id))
    else
     setattr(xd,sections(ndx).bn,"id",text("chp-")+fixxmlid(copytext(i,10,i.size)))
    end-if
   elif copytext(i,1,9)="doc._ses." then
    ndx:=substr(i,10,i.size)
    ndxsec:=substr(ndx,1,ndx.size-4)
    sections(ndx).bn:=addnode(xd,sections(ndxsec).bn,XML_ELT,"section")
    sections(ndx).pp:=addnode(xd,sections(ndx).bn,XML_ELT,"title")
    if "doc._sts."+ndx in glbs then
     setattr(xd,sections(ndx).pp,"cont",glbann("doc._sts."+ndx))
    end-if
    text2xml(glbann(i),sections(ndx).pp)
    id:="doc._ids."+ndx
    if id in glbs and glbann(id)<>"" then
     setattr(xd,sections(ndx).bn,"id",glbann(id))
    else
     setattr(xd,sections(ndx).bn,"id",text("sec-")+fixxmlid(copytext(i,10,i.size)))
    end-if
   elif copytext(i,1,9)="doc._sus." then
    ndx:=substr(i,10,i.size)
    ndxsec:=substr(ndx,1,ndx.size-4)
    sections(ndx).bn:=addnode(xd,sections(ndxsec).bn,XML_ELT,"subsection")
    sections(ndx).pp:=addnode(xd,sections(ndx).bn,XML_ELT,"title")
    if "doc._sts."+ndx in glbs then
     setattr(xd,sections(ndx).pp,"cont",glbann("doc._sts."+ndx))
    end-if
    text2xml(glbann(i),sections(ndx).pp)
    id:="doc._ids."+ndx
    if id in glbs and glbann(id)<>"" then
     setattr(xd,sections(ndx).bn,"id",glbann(id))
    else
     setattr(xd,sections(ndx).bn,"id",text("sub-")+fixxmlid(copytext(i,10,i.size)))
    end-if
   elif copytext(i,1,9)="doc._tls." then
    ndx:=substr(i,10,i.size)
    forall(l in split_tloc(glbann(i)))
     relocs(l):=ndx
   end-if
   returned:=true
  else
   locs+={"0ctrls","0params","1consts","2types","3vars","4fcts","5anns"}
   finalise(locs)
   sections("").bn:=bn
   sections("0ctrls").bn:=addnode(xd,bn,XML_ELT,"chapter")
   n:=addnode(xd,sections("0ctrls").bn,XML_ELT,"title","Control parameters")
   sections("0params").bn:=addnode(xd,bn,XML_ELT,"chapter")
   n:=addnode(xd,sections("0params").bn,XML_ELT,"title","Runtime parameters")
   sections("1consts").bn:=addnode(xd,bn,XML_ELT,"chapter")
   n:=addnode(xd,sections("1consts").bn,XML_ELT,"title","Constants")
   sections("2types").bn:=addnode(xd,bn,XML_ELT,"chapter")
   n:=addnode(xd,sections("2types").bn,XML_ELT,"title","Types")
   sections("3vars").bn:=addnode(xd,bn,XML_ELT,"chapter")
   n:=addnode(xd,sections("3vars").bn,XML_ELT,"title","Variables")
   sections("4fcts").bn:=addnode(xd,bn,XML_ELT,"chapter")
   n:=addnode(xd,sections("4fcts").bn,XML_ELT,"title","Subroutines")
   sections("5anns").bn:=addnode(xd,bn,XML_ELT,"chapter")
   n:=addnode(xd,sections("5anns").bn,XML_ELT,"title","Annotations")
   returned:=false
  end-if
end-function

!*****************************
!* Handle global definitions
!*****************************
procedure process_glb(bn:integer,ann:string,elt:string,glbann:array(glbs:set of string) of string,txthtml:boolean)
 if ann in glbs then
  if txthtml then
   n:=addnode(xd,bn,XML_ELT,elt)
   text2xml(glbann(ann),n)
  else
   n:=addnode(xd,bn,XML_ELT,elt,glbann(ann))
  end-if
 end-if
end-procedure

procedure process_glb(bn:integer,ann:string,elt:string,glbann:array(glbs:set of string) of string)
 process_glb(bn,ann,elt,glbann,false)
end-procedure

!*************************************
!* Check whether a symbol is ignored
!*************************************
function ignored(m:Model,p:string):boolean
 declarations
  l:list of string
 end-declarations
 getannotations(m,p,"doc.ignore",l)
 if l.size>0 then
  returned:=getlast(l)="true"
 end-if
end-function

!**********************
!* Find parameters
!**********************
function findparams(m:Model,s:set of string):set of string
 declarations
  l:list of string
 end-declarations
 forall(p in s) do
  getannotations(m,p,"doc.default",l)
  if l.size>0 and not ignored(m,p) then
   returned+={p}
  end-if
 end-do
end-function

!**********************
!* Find types
!**********************
function findtypes(m:Model,s:set of string):set of string
 declarations
  l:list of string
 end-declarations
 forall(p in s) do
  getannotations(m,p,"doc.typedef",l)
  if l.size>0 and not ignored(m,p) then
   returned+={p}
  end-if
 end-do
end-function

!**********************
!* Find functions
!**********************
function findfcts(m:Model,s:set of string):set of string
 declarations
  l:list of string
 end-declarations
 forall(p in s) do
  getannotations(m,p,"doc.syntax",l)
  if l.size>0 and not ignored(m,p) then
   returned+={p}
  end-if
 end-do
end-function

!**********************
!* Find constants
!**********************
function findcsts(m:Model,s:set of string):set of string
 declarations
  l:list of string
 end-declarations
 forall(p in s) do
  getannotations(m,p,"doc.const",l)
  if l.size>0 and not ignored(m,p) then
   returned+={p}
  end-if
 end-do
end-function

!***********************
!* Process a parameter
!***********************
procedure process_param(m:Model,sections:array(locs:set of string) of Location,relocs:array(set of string) of string,ndx:string,par:string)
 declarations
  l:list of string
  p,pv:integer
  inn:integer
 end-declarations

 getannotations(m,par,"doc.",l)
 if ndx="" then ndx:=getindex(l,locs,relocs); end-if
 if sections(ndx).pn=0 then
  p:=addnode(xd,sections(ndx).bn,XML_ELT,"entity")
 else
  p:=addnode(xd,sections(ndx).pn,XML_NEXT,XML_ELT,"entity")
 end-if
 sections(ndx).pn:=p
 setsafeentname(p,par)
 setattr(xd,p,"cat","param")
 while (l.size>0) do
  ann:=getfirst(l)
  cuthead(l,1)
  val:=getfirst(l)
  cuthead(l,1)
  if val<>"" then
   case ann of
    "doc.type":
	do
	 nid:=addnode(xd,p,XML_ELT,"entType",val)
	 if val="string" then
	  quoteconst(p,"entDefault")
	 end-if
	end-do
    "doc.descr":
	do
	 nid:=addnode(xd,p,XML_ELT,"entDescr")
	 text2xml(val,nid)
	end-do
    "doc.default":
	nid:=addnode(xd,p,XML_ELT,"entDefault",val)
    "doc.info":
	add_entries(p,"entNote","entNoteItem",val)
    "doc.value":
	do
	 if pv<1 then
	  pv:=addnode(xd,p,XML_ELT,"entValues")
	 end-if
	 add_fctpar(pv,"entVal","value",val)
	end-do
   end-case
  end-if
 end-do
end-procedure

!***********************
!* Process a constant
!***********************
procedure process_const(m:Model,sections:array(locs:set of string) of Location,relocs:array(set of string) of string,ndx:string,cst:string)
 declarations
  l:list of string
  p:integer
  inn:integer
 end-declarations

 getannotations(m,cst,"doc.",l)
 if ndx="" then ndx:=getindex(l,locs,relocs); end-if
 if sections(ndx).cn=0 then
  p:=addnode(xd,sections(ndx).bn,XML_ELT,"entity")
 else
  p:=addnode(xd,sections(ndx).cn,XML_NEXT,XML_ELT,"entity")
 end-if
 sections(ndx).cn:=p
 setsafeentname(p,cst)
 setattr(xd,p,"cat","constant")
 while (l.size>0) do
  ann:=getfirst(l)
  cuthead(l,1)
  val:=getfirst(l)
  cuthead(l,1)
  if val<>"" then
   case ann of
    "doc.type":
	do
	 nid:=addnode(xd,p,XML_ELT,"entType",val)
	 if val="string" then
	  quoteconst(p,"entConst")
	 end-if
	end-do
    "doc.descr":
	do
	 nid:=addnode(xd,p,XML_ELT,"entDescr")
	 text2xml(val,nid)
	end-do
    "doc.const":
	nid:=addnode(xd,p,XML_ELT,"entConst",val)
    "doc.info":
	add_entries(p,"entNote","entNoteItem",val)
   end-case
  end-if
 end-do
end-procedure

!*****************************
!* Process a type definition
!*****************************
procedure process_typdef(m:Model,sections:array(locs:set of string) of Location,relocs:array(set of string) of string,ndx:string,typ:string)
 declarations
  l:list of string
  p:integer
  inn:integer
  fields:set of string
  ftyp,fdesc:array(fields) of string
  fvals:dynamic array(fields,vals:set of string) of string
 end-declarations

 getannotations(m,typ,"doc.",l)
 if ndx="" then ndx:=getindex(l,locs,relocs); end-if
 if sections(ndx).cn=0 then
  p:=addnode(xd,sections(ndx).bn,XML_ELT,"entity")
 else
  p:=addnode(xd,sections(ndx).cn,XML_NEXT,XML_ELT,"entity")
 end-if
 sections(ndx).cn:=p
 setsafeentname(p,typ)
 setattr(xd,p,"cat","type")
 while (l.size>0) do
  ann:=getfirst(l)
  cuthead(l,1)
  val:=getfirst(l)
  cuthead(l,1)
  if val<>"" then
   case ann of
    "doc.typedef":
	nid:=addnode(xd,p,XML_ELT,"entType",val)
    "doc.descr":
	do
	 nid:=addnode(xd,p,XML_ELT,"entDescr")
	 text2xml(val,nid)
	end-do
    "doc.info":
	add_entries(p,"entNote","entNoteItem",val)
    "doc.recfldtype":
    	add_field(ftyp,val)
    "doc.recflddescr":
    	add_field(fdesc,val)
    "doc.recfldval":
    	add_fieldval(fvals,val)
   end-case
  end-if
 end-do
 if fields.size>0 then
  forall(f in fields) do
   nid:=addnode(xd,p,XML_ELT,"entField")
   setattr(xd,nid,"name",f)
   n2:=addnode(xd,nid,XML_ELT,"entType",ftyp(f))
   if fdesc(f)<>"" then
    n2:=addnode(xd,nid,XML_ELT,"entDescr")
    text2xml(fdesc(f),n2)
   end-if
   if or(v in vals | exists(fvals(f,v))) true then
    n2:=addnode(xd,nid,XML_ELT,"entValues")
    forall(v in vals | exists(fvals(f,v))) do
     n3:=addnode(xd,n2,XML_ELT,"entVal")
     setattr(xd,n3,"value",v)
     text2xml(fvals(f,v),n3)
    end-do
   end-if
  end-do
 end-if
end-procedure

!***********************
!* Process a variable
!***********************
procedure process_var(m:Model,sections:array(locs:set of string) of Location,relocs:array(set of string) of string,ndx:string,v:string)
 declarations
  l:list of string
  p,pv:integer
  inn:integer
  fields:set of string
  ftyp,fdesc:array(fields) of string
 end-declarations

 getannotations(m,v,"doc.",l)
 if l.size>0 then
  if ndx="" then ndx:=getindex(l,locs,relocs); end-if
  if sections(ndx).vn=0 then
   p:=addnode(xd,sections(ndx).bn,XML_ELT,"entity")
  else
   p:=addnode(xd,sections(ndx).vn,XML_NEXT,XML_ELT,"entity")
  end-if
  sections(ndx).vn:=p
  setsafeentname(p,v)
  setattr(xd,p,"cat","variable")
  while (l.size>0) do
   ann:=getfirst(l)
   cuthead(l,1)
   val:=getfirst(l)
   cuthead(l,1)
   if val<>"" then
    case ann of
     "doc.type":
	nid:=addnode(xd,p,XML_ELT,"entType",val)
     "doc.descr":
	do
	 nid:=addnode(xd,p,XML_ELT,"entDescr")
	 text2xml(val,nid)
	end-do
     "doc.info":
	add_entries(p,"entNote","entNoteItem",val)
     "doc.recfldtype":
    	add_field(ftyp,val)
     "doc.recflddescr":
    	add_field(fdesc,val)
     "doc.setby":
	do
	 nid:=addnode(xd,p,XML_ELT,"entSetby")
	 text2xml(val,nid)
	end-do
     "doc.value":
	do
	 if pv<1 then
	  pv:=addnode(xd,p,XML_ELT,"entValues")
	 end-if
	 add_fctpar(pv,"entVal","value",val)
	end-do
    end-case
   end-if
  end-do
  if fields.size>0 then
   forall(f in fields) do
    nid:=addnode(xd,p,XML_ELT,"entField")
    setattr(xd,nid,"name",f)
    n2:=addnode(xd,nid,XML_ELT,"entType",ftyp(f))
    if fdesc(f)<>"" then
     n2:=addnode(xd,nid,XML_ELT,"entDescr")
     text2xml(fdesc(f),n2)
    end-if
   end-do
  end-if
 end-if
end-procedure

!***********************
!* Process a function
!***********************
procedure process_fct(m:Model,sections:array(locs:set of string) of Location,relocs:array(set of string) of string,ndx:string,fct:string)
 declarations
  l,lg:list of string
  p,per,pe,ee:integer
  inn:integer
  group:string
 end-declarations

 getannotations(m,fct,"doc.",l)
 if ndx="" then ndx:=getindex(l,locs,relocs); end-if
 if sections(ndx).fn=0 then
  p:=addnode(xd,sections(ndx).bn,XML_ELT,"fct")
  getannotations(m,fct,"doc.group",lg)
  if lg.size=2 and getfirst(lg)="doc.group" then
    writeln_("Cannot group `",fct,"' with `",getlast(lg),"' (name not found)")
  end-if
 else
  getannotations(m,fct,"doc.group",lg)
  if lg.size=2 and getfirst(lg)="doc.group" then
   group:=getlast(lg)
   p:=getnode(xd,sections(ndx).bn,"fct[@name='"+group+"']")
   if p>0 then
    if getattr(xd,p,"name2")="" then
     setattr(xd,p,"name2",fct)
    elif getattr(xd,p,"name3")="" then
     setattr(xd,p,"name3",fct)
    end-if
   else
    writeln_("Cannot group `",fct,"' with `",group,"' (name not found)")
    p:=addnode(xd,sections(ndx).fn,XML_NEXT,XML_ELT,"fct")
    group:=""
   end-if
  else
   p:=addnode(xd,sections(ndx).fn,XML_NEXT,XML_ELT,"fct")
  end-if
 end-if
 if group="" then
  sections(ndx).fn:=p
  setsafeentname(p,fct)
 end-if
 while (l.size>0) do
  ann:=getfirst(l)
  cuthead(l,1)
  val:=getfirst(l)
  cuthead(l,1)
  if val<>"" then
   case ann of
    "doc.descr":
	if group="" then
	 nid:=addnode(xd,p,XML_FIRSTCHILD,XML_ELT,"fctDescr")
	 text2xml(val,nid)
	end-if
    "doc.shortdescr":
	setattr(xd,p,"descr",val)
    "doc.syntax":
	 add_entries(p,["fctDescr"],"fctSyntax","fctSyntaxItem",val)
    "doc.param":
	do
	 if pe<1 then
	  pe:=addafter(p,"fctArguments",["fctSyntax","fctDescr"])
	 end-if
	 add_fctpar(pe,"fctArg","name",val)
	end-do
    "doc.paramval":
	 add_fctparval(pe,val)
    "doc.err":
	do
	 if per<1 then
	  per:=addafter(p,"fctErrors",["fctArguments","fctSyntax","fctDescr"])
	 end-if
	 add_fctpar(per,"fctErr","num",val)
	end-do
    "doc.return":
	if group="" then
	 nid:=addafter(p,"fctReturn",["fctErrors","fctArguments","fctSyntax","fctDescr"])
	 text2xml(val,nid)
!	 setvalue(xd,nid,val)
	end-if
    "doc.related":
	if group="" then
	 nid:=addafter(p,"fctRelated",["fctFurtherinfo","fctExample","fctReturn","fctErrors","fctArguments","fctSyntax","fctDescr"])
	 text2xml(val,nid)
	end-if
    "doc.info":
	add_entries(p,["fctExample","fctReturn","fctErrors","fctArguments","fctSyntax","fctDescr"],"fctFurtherinfo","fctFurtherinfoItem",val)
    "doc.example":
	do
	 if ee<1 then
	  ee:=addafter(p,"fctExample",["fctReturn","fctErrors","fctArguments","fctSyntax","fctDescr"])
	 end-if
         nid:=storeparag(val,ee,XML_LASTCHILD,"fctExampleText","fctExampleCode")
(!
	 if copytext(ann,1,18)="doc.example.source" then
	  nid:=addnode(xd,ee,XML_ELT,"fctExampleCode")
	  nid:=addnode(xd,nid,XML_CDATA,val)
	 elif copytext(ann,1,17)="doc.example.descr" then
	  nid:=addnode(xd,ee,XML_ELT,"fctExampleText")
	  text2xml(val,nid)
	 end-if
!)
	end-do
   end-case
  end-if
 end-do
end-procedure

!**************************
!* Process annotations
!**************************
procedure process_annots(annotMod:Model,sections:array(locs:set of string) of Location,relocs:array(set of string) of string,ndx:string)
 declarations
   AnnList: list of string             !@descr Annotation values
   aname,atype,aval: text              !@descr Annotation definition
   atext: text
   pctx,actx: parsectx
   anode, n, avalues, parnode: integer
   NList: list of integer
   rep:integer
   parname,dummy: text
   parlist: list of text
 end-declarations

 getannotations(annotMod,"","doc.annotloc",AnnList)
 if ndx="" and AnnList.size=2 then
  ndx:=getindex(["doc.loc",getlast(AnnList)],locs,relocs)
 end-if
 if ndx="" then
  forall(ll in locs)
   ndx:=ll
 end-if

 ! Get all global annotations "doc.annot." to decide which annotations are to be documented:
 AnnList:=[]
 getannotations(annotMod, "", "doc.annotcat", AnnList)
 pctx.sepchar:=32
 pctx.qtype:=-1              ! no quotes
 if AnnList.size>0 then
  forall(i in AnnList | not startswith(i,"doc.annotcat")) do
   atext:=i
   rep:=regreplace(atext,"\n"," ")
   pctx.endparse:=0
   while(nextfield(atext,pctx))
    AnnDoc+={string(parsetext(atext,pctx))}
  end-do
  if AnnDoc.size=0 then
   AnnDoc:={''}
  end-if
 end-if

 ! Get all global annotations "mc.def" defined in a package:
 getannotations(annotMod, "", "mc.def", AnnList)
 pctx.sepchar:=32
 pctx.qtype:=-1
 actx.sepchar:=46
 actx.qtype:=-1
 forall(a in AnnList | a<>"mc.def") do   
   atext:=text(a)
   pctx.endparse:=1
   aname:=parsetext(atext,pctx)
   if AnnDoc.size=0 or startswith(aname,AnnDoc) then    ! Only document selected categories
     res:=nextfield(atext,pctx)
     atype:=parsetext(atext,pctx)
     if nextfield(atext,pctx) then
       aval:=copytext(atext,pctx.endparse,atext.size)
     else
       aval:=""
     end-if
     if sections(ndx).vn=0 then
      anode:=addnode(xd,sections(ndx).bn,XML_ELT,"entity")
     else
      anode:=addnode(xd,sections(ndx).vn,XML_NEXT,XML_ELT,"entity")
     end-if
     sections(ndx).vn:=anode
     if getchar(aname,aname.size)=46 then        ! Remove trailing "."
       deltext(aname,aname.size,aname.size)
     end-if
     setattr(xd, anode, "name", aname)
     setattr(xd, anode, "cat", "annot")

     forall(c in 1..atype.size) do
       case getchar(atype,c) of
       !"T"
       84 : case getchar(atype,c+1)-48 of
          2: n:=addnode(xd, anode, XML_ELT, "entType", "text")
          3: n:=addnode(xd, anode, XML_ELT, "entType", "integer")
          4: n:=addnode(xd, anode, XML_ELT, "entType", "real")
          5: n:=addnode(xd, anode, XML_ELT, "entType", "boolean")
          6: n:=addnode(xd, anode, XML_ELT, "entType", "alias")
         end-case
       !"P"
       80 : case getchar(atype,c+1)-48 of
          0: n:=addnode(xd, anode, XML_ELT, "entPolicy", "last")
          1: n:=addnode(xd, anode, XML_ELT, "entPolicy", "first")
          2: n:=addnode(xd, anode, XML_ELT, "entPolicy", "merge")
          3: n:=addnode(xd, anode, XML_ELT, "entPolicy", "multi")
         end-case
       !"S"
       83: case getchar(atype,c+1)-48 of
          0: n:=addnode(xd, anode, XML_ELT, "entScope", "any")
          1: n:=addnode(xd, anode, XML_ELT, "entScope", "specific")
          2: n:=addnode(xd, anode, XML_ELT, "entScope", "global")
         end-case
       !"D"
       68: case getchar(atype,c+1)-48 of
          1: do 
              avalues:=addnode(xd, anode, XML_ELT, "entValues")
              addvalues(aval, avalues)
            end-do
          2:  do 
              avalues:=addnode(xd, anode, XML_ELT, "entValues")
              addbounds(aval, avalues)
            end-do
         end-case
       end-case
     end-do
   end-if   ! aname in AnnDoc
 end-do

(! Annotation type codes:
T - type: 2 text 3 integer 4 real 5 boolean 6 alias
P - policy: 0 last 1 first 2 merge 3 multi
S - scope: 0 any 1 specific 2 global
D - domain: 0 no constraints 1 list of values 2 range
followed by list of values or range bounds if D1 or D2
!)

 ! Complete annotation documentation with other doc.annot* information
 getannotations(annotMod, "", "doc.annot.", AnnList)
 lasta:=""
 forall(a in AnnList) do
   if not startswith(a,"doc.annot.") then  
     atext:=text(a)
     pctx.endparse:=1
     aname:=parsetext(atext,pctx)
     if AnnDoc.size=0 or startswith(aname,AnnDoc) then    ! Only document selected categories
       anode:=getnode(xd, "//entity[@name='"+aname+"']")

       if anode<1 and keepundefannot then
         dummy:=pathsplit(SYS_EXTN,aname,parname)     ! Move up one category
         parnode:=0
         while (parname<>"" and parname<>"." and parnode<1) do
           parlist+=[copytext(parname,1,parname.size)]
           parnode:=getnode(xd, "//entity[@name='"+parname+"']")
	   dummy:=pathsplit(SYS_EXTN,parname,parname)
         end-do
         if parnode>0 then  ! Create (subtree of) XMLnode(s) for annotation name
           cuttail(parlist,1)
           while (parlist<>[]) do
             parname:=getlast(parlist)
             cuttail(parlist,1)
             parnode:=addnode(xd, parnode, XML_NEXT, XML_ELT, "entity")
             setattr(xd, parnode, "name", parname)
             setattr(xd, parnode, "cat", "annot")
           end-do
           anode:=addnode(xd, parnode, XML_NEXT, XML_ELT, "entity")
           setattr(xd, anode, "name", aname)
           setattr(xd, anode, "cat", "annot")
         end-if
       end-if

       case string(lasta) of
         "doc.annot.descr": do
             if anode>0 then
               nd:=addnode(xd, anode, XML_ELT, "entDescr")
               if nextfield(atext,pctx) then
	         text2xml(copytext(atext,pctx.endparse,atext.size), nd)
               end-if
             else
               writeln_("Annotation '", aname,"' not found (", lasta, ")")
             end-if
           end-do
         "doc.annot.type": do
             if anode>0 then
               nd:=addnode(xd, anode, XML_ELT, "entType")
               if nextfield(atext,pctx) then
	         text2xml(copytext(atext,pctx.endparse,atext.size), nd)
               end-if
             else
               writeln_("Annotation '", aname,"' not found (", lasta, ")")
             end-if
           end-do
         "doc.annot.default": do
             if anode>0 then
               nd:=addnode(xd, anode, XML_ELT, "entDefault")
               if nextfield(atext,pctx) then
	         text2xml(copytext(atext,pctx.endparse,atext.size), nd)
               end-if
             else
               writeln_("Annotation '", aname,"' not found (", lasta, ")")
             end-if
           end-do
         "doc.annot.value": do
             if anode>0 then
	       nd:=getnode(xd, anode, "entValues")
	       if nd<0 then
                 nd:=addnode(xd, anode, XML_ELT, "entValues")
	       end-if	 
               if nextfield(atext,pctx) then
	         aname:=parsetext(atext,pctx)
	         ndv:=getnode(xd, nd, "entVal[@value='"+aname+"']")
	         if ndv<0 then
                   ndv:=addnode(xd, nd, XML_ELT, "entVal")
		   setattr(xd, ndv, "value", aname)
	         end-if	 
                 if nextfield(atext,pctx) then
	           text2xml(copytext(atext,pctx.endparse,atext.size), ndv)
                 end-if
               end-if
             else
               writeln_("Annotation '", aname,"' not found (", lasta, ")")
             end-if
           end-do
         "doc.annot.info": do
             if anode>0 then
	       nd:=getnode(xd, anode, "entNote")
	       if nd<0 then
                 nd:=addnode(xd, anode, XML_ELT, "entNote")
	       else
	         if getnode(xd, nd, "entNoteItem")<0 then
		   ndv:=addnode(xd, getnode(xd,"*"), XML_ELT, "temp")
		   ndv:=copynode(xd, nd, xd, ndv, XML_FIRSTCHILD)
		   setname(xd, ndv, "entNoteItem")
		   getnodes(xd,nd,"child::node()",NList)		 
		   forall(j in NList) delnode(xd,j)
		   res2:=copynode(xd, ndv, xd, nd, XML_FIRSTCHILD)
                  delnode(xd, ndv)
		 end-if
	         nd:=addnode(xd, nd, XML_ELT, "entNoteItem")
	       end-if	 
               if nextfield(atext,pctx) then
	         text2xml(copytext(atext,pctx.endparse,atext.size), nd)
               end-if
             else
               writeln_("Annotation '", aname,"' not found (", lasta, ")")
             end-if
           end-do
         "doc.annot.related": do
             if anode>0 then
               nd:=addnode(xd, anode, XML_ELT, "entRelated")
               if nextfield(atext,pctx) then
	         text2xml(copytext(atext,pctx.endparse,atext.size), nd)
               end-if
             else
               writeln_("Annotation '", aname,"' not found (", lasta, ")")
             end-if
           end-do
       end-case
     end-if   ! aname in AnnDoc
   else  
     lasta:=a
   end-if  
 end-do
end-procedure

!*****************************
!* Process control parameters
!*****************************
procedure process_cparams(m:Model,sections:array(locs:set of string) of Location,relocs:array(set of string) of string,ndx:string)
 declarations
   AnnList: list of string
   aname: text
   atext: text
   pctx: parsectx
   anode: integer
   NList: list of integer
   parms: set of string
 end-declarations

 getannotations(m,"","doc.cparamloc",AnnList)
 if ndx="" and AnnList.size=2 then
  ndx:=getindex(["doc.loc",getlast(AnnList)],locs,relocs)
 end-if
 if ndx="" then
  forall(ll in locs)
   ndx:=ll
 end-if

 getannotations(m, "", "doc.cparam.type", AnnList)
 forall(a in AnnList)
   if not startswith(a,"doc.cparam.type") then
     atext:=text(a)
     trim(atext)
     pctx.endparse:=1
     aname:=parsetext(atext,pctx)
     if string(aname) not in parms then
      if sections(ndx).vn=0 then
       anode:=addnode(xd,sections(ndx).bn,XML_ELT,"entity")
      else
       anode:=addnode(xd,sections(ndx).vn,XML_NEXT,XML_ELT,"entity")
      end-if
      sections(ndx).vn:=anode
      setattr(xd, anode, "name", aname)
      setattr(xd, anode, "cat", "ctrl")
      nd:=addnode(xd, anode, XML_ELT, "entType")
      if nextfield(atext,pctx) then
        text2xml(copytext(atext,pctx.endparse,atext.size), nd)
      end-if
      parms+={string(aname)}
     end-if
   end-if

 if parms.size>0 then
   getannotations(m, "", "doc.cparam.", AnnList)
   lasta:=""
   forall(a in AnnList) do
     if not startswith(a,"doc.cparam.") then  
       atext:=text(a)
       trim(atext,SYS_LEFT)
       pctx.endparse:=1
       aname:=parsetext(atext,pctx)
       if string(aname) not in parms then
         writeln_("Control parameter '", aname,"' not found (", lasta, ")")
       else
        anode:=getnode(xd, "//entity[@name='"+aname+"']")
        case string(lasta) of
         "doc.cparam.descr": do
             nd:=addnode(xd, anode, XML_ELT, "entDescr")
             if nextfield(atext,pctx) then
               text2xml(copytext(atext,pctx.endparse,atext.size), nd)
             end-if
           end-do
         "doc.cparam.default": do
             nd:=addnode(xd, anode, XML_ELT, "entDefault")
             if nextfield(atext,pctx) then
               text2xml(copytext(atext,pctx.endparse,atext.size), nd)
             end-if
           end-do
         "doc.cparam.value": do
             nd:=getnode(xd, anode, "entValues")
             if nd<0 then
               nd:=addnode(xd, anode, XML_ELT, "entValues")
             end-if	 
             if nextfield(atext,pctx) then
               aname:=parsetext(atext,pctx)
               ndv:=getnode(xd, nd, "entVal[@value='"+aname+"']")
               if ndv<0 then
                 ndv:=addnode(xd, nd, XML_ELT, "entVal")
        	       setattr(xd, ndv, "value", aname)
               end-if	 
               if nextfield(atext,pctx) then
                 text2xml(copytext(atext,pctx.endparse,atext.size), ndv)
               end-if
             end-if
           end-do
         "doc.cparam.info": do
             nd:=getnode(xd, anode, "entNote")
             if nd<0 then
               nd:=addnode(xd, anode, XML_ELT, "entNote")
             else
               if getnode(xd, nd, "entNoteItem")<0 then
        	       ndv:=addnode(xd, getnode(xd,"*"), XML_ELT, "temp")
        	       ndv:=copynode(xd, nd, xd, ndv, XML_FIRSTCHILD)
        	       setname(xd, ndv, "entNoteItem")
        	       getnodes(xd,nd,"child::node()",NList)		 
        	       forall(j in NList) delnode(xd,j)
        	         res2:=copynode(xd, ndv, xd, nd, XML_FIRSTCHILD)
                 delnode(xd, ndv)
        	     end-if
               nd:=addnode(xd, nd, XML_ELT, "entNoteItem")
             end-if	 
             if nextfield(atext,pctx) then
               text2xml(copytext(atext,pctx.endparse,atext.size), nd)
             end-if
           end-do
         "doc.cparam.related": do
             nd:=addnode(xd, anode, XML_ELT, "entRelated")
             if nextfield(atext,pctx) then
               text2xml(copytext(atext,pctx.endparse,atext.size), nd)
             end-if
           end-do
        end-case
       end-if
     else
       lasta:=a
     end-if
   end-do
 end-if
end-procedure

!**************************
!* starts with on a list
!**************************
function startswith(t:text,ls:set of string):boolean
 forall(l in ls)
  if startswith(t,l) then
   returned:=true
   break
  end-if
end-function

!**************************
!* Add values (annotations)
!**************************
procedure addvalues(t:text, nd:integer)
  declarations
    lpctx:parsectx
  end-declarations

  lpctx.sepchar:=32            ! ' '
  lpctx.qtype:=-1              ! no quotes
  while(nextfield(t,lpctx)) do
    v:=parsetext(t,lpctx)
    an:=addnode(xd, nd, XML_ELT, "entVal")
    setattr(xd, an, "value", v)
  end-do
end-procedure

!**************************
!* Add bounds (annotations)
!**************************
procedure addbounds(t:text, nd:integer)
  declarations
    lpctx:parsectx
    v,v2: text
  end-declarations

  lpctx.sepchar:=32            ! ' '
  lpctx.qtype:=-1              ! no quotes
  if (nextfield(t,lpctx)) then
    v:=parsetext(t,lpctx)
    if (nextfield(t,lpctx)) then
      v2:=parsetext(t,lpctx)
    end-if
    setvalue(xd, nd, v+if(v2.size>0, ".."+v2, ""))
  end-if
end-procedure


!**************************
!* Retrieve location index
!**************************
function getindex(l:list of string,locs:set of string,relocs:array(alocs:set of string) of string):string
 i:=findfirst(l,"doc.loc")
 if i=0 then
  returned:=""
 else
  l2:=gettail(l,-i)
  returned:=getfirst(l2)
  if returned not in locs then
   if returned in alocs then
    returned:=relocs(returned)
   else
    writeln_("! Target location `",getfirst(l2),"' not found")
    returned:=""
   end-if
  end-if
 end-if
end-function

!***************************
!* Add a function argument
!***************************
procedure add_fctpar(pe:integer,elt:string,attr:string,val:text)
 trim(val)
 i:=findtext(val," ",1)
 if i=0 then
  name:=val
  val:=""
 else
  name:=cuttext(val,1,i-1)
  trim(val)
 end-if

 if getnode(xd,pe,elt+"[@name='"+string(name)+"']")<0 then
  fctp:=addnode(xd,pe,XML_ELT,elt)
  text2xml(val,fctp)
  setattr(xd,fctp,attr,name)
 end-if
end-procedure

!*********************************
!* Add a function argument value
!*********************************
procedure add_fctparval(pe:integer,val:text)
 declarations
  l:list of integer
 end-declarations

 trim(val)
 i:=findtext(val," ",1)
 if i>1 and pe>1 then
  name:=cuttext(val,1,i-1)
  narg:=getnode(xd,pe,"fctArg[@name='"+string(name)+"']")
  trim(val)
  j:=findtext(val," ",1)
  if j<1 then
   pval:=val
   val:=""
  else
   pval:=cuttext(val,1,j-1)
   trim(val)
  end-if
 end-if
 if pe<1 or i<1 or narg<1 then
  writeln_("Cannot find argument `",name,"' for value `",pval,"' (ignored)")
 else
  n:=getfirstchild(xd,narg)
  if n>1 and getname(xd,n)<>"fctArgVal" and getname(xd,n)<>"fctArgText" then
   getnodes(xd,narg,l)
   n2:=addnode(xd,narg,XML_ELT,"fctArgText")
   forall(nn in l) do
    asproc(copynode(xd,nn,xd,n2,XML_LASTCHILD))
    delnode(xd,nn)
   end-do
  end-if
  fctpv:=addnode(xd,narg,XML_ELT,"fctArgVal")
  text2xml(val,fctpv)
  setattr(xd,fctpv,"value",pval)
 end-if
end-procedure

!****************************************
!* Add a field descr or type to a record
!****************************************
procedure add_field(fa:array(fld:set of string) of string,val:text)
 trim(val)
 i:=findtext(val," ",1)
 if i=0 then
  name:=val
  val:=""
 else
  name:=cuttext(val,1,i-1)
  trim(val)
 end-if

 fa(string(name)):=string(val)
end-procedure

!****************************************
!* Add a value descr for a record field
!****************************************
procedure add_fieldval(fa:array(fld:set of string,vals:set of string) of string,val:text)
 trim(val)
 i:=findtext(val," ",1)
 if i<>0 then
  name:=cuttext(val,1,i-1)
  trim(val)
  j:=findtext(val," ",1)
  if j=0 then
   arg:=val
   val:=""
  else
   arg:=cuttext(val,1,j-1)
   trim(val)
  end-if
  fa(string(name),string(arg)):=string(val)
 end-if
end-procedure

!******************************
!* Handle a growing element
!******************************
procedure add_entries(nid:integer,nds:list of string,gn:string,subgn:string,val:string)
 declarations
  lsd:list of integer
 end-declarations

 getnodes(xd,nid,gn+"/node()",lsd)
 if lsd.size>0 then
  n:=getfirst(lsd)
  if gettype(xd,n)<>XML_ELT or getname(xd,n)<>subgn then
   td:=getlast(lsd)
   n:=addnode(xd,td,XML_NEXT,XML_ELT,subgn)
   forall(i in lsd) do
    n2:=copynode(xd,i,xd,n,XML_LASTCHILD)
    delnode(xd,i)
   end-do
  else
   n:=getlast(lsd)
  end-if
  n:=addnode(xd,n,XML_NEXT,XML_ELT,subgn)
  if gn="fctSyntax" then
   setvalue(xd,n,val)
  else
   text2xml(val,n)
  end-if
 else
  n:=addafter(nid,gn,nds)
  text2xml(val,n)
 end-if
end-procedure

procedure add_entries(nid:integer,gn:string,subgn:string,val:string)
 add_entries(nid,[],gn,subgn,val)
end-procedure

!*****************************************
!* Store a paragraph respecting data type
!*****************************************
function storeparag(val:text,nd:integer,w:integer,parg:string,src:string):integer
 if getchar(val,1)=91 then ! symbol '['
  tt:=copytext(val,2,5)
  if tt="TXT]" then
   deltext(val,1,5)
   if getchar(val,1)=10 then ! symbol '\n'
    deltext(val,1,1)
   end-if
   returned:=addnode(xd,nd,w,XML_ELT,parg,val)
  elif tt="SRC]" then
   deltext(val,1,5)
   if getchar(val,1)=10 then ! symbol '\n'
    deltext(val,1,1)
   end-if
   returned:=addnode(xd,nd,w,XML_ELT,src)
   n2:=addnode(xd,returned,XML_CDATA,val)
  elif tt="XML]" then
   deltext(val,1,5)
   if getchar(val,1)=10 then ! symbol '\n'
    deltext(val,1,1)
   end-if
   returned:=addnode(xd,nd,w,XML_ELT,parg)
   text2xml(val,returned)
  elif tt="NOD]" then
   deltext(val,1,5)
   if getchar(val,1)=10 then ! symbol '\n'
    deltext(val,1,1)
   end-if
   returned:=nd
   text2xml(val,returned,XML_NEXT)
  else
   returned:=addnode(xd,nd,w,XML_ELT,parg)
   text2xml(val,returned)
  end-if
 else
  returned:=addnode(xd,nd,w,XML_ELT,parg)
  text2xml(val,returned)
 end-if
end-function

!***********************************
!* Load a text as an XML document
!***********************************
procedure text2xml(val:text,nid:integer)
 text2xml(val,nid,XML_LASTCHILD)
end-procedure

!*****************************************************
!* Load a text as an XML document (setting position)
!*****************************************************
procedure text2xml(val:text,nid:integer,wh:integer)
 declarations
  xt:xmldoc
  lsd:list of integer
 end-declarations
 xmltext:=text("<myroot>")+val+"</myroot>"
 setparam("ioctrl",true)
 load(xt,"text:xmltext")
 setparam("ioctrl",false)
 if getparam("iostatus")<>0 then
  writeln_("The following text is not valid XML (",if(exitonerror,_("abort"),_("ignored")),"):\n",val)
  if exitonerror then
   exit(1)
  end-if
 else
  getnodes(xt,"/myroot/node()",lsd)
  forall(i in lsd)
   n:=copynode(xt,i,xd,nid,wh)
 end-if
end-procedure

!***********************************
!* Load a text as an XML header
!***********************************
procedure text2xmlhdr(val:text,nid:integer)
 declarations
  xt:xmldoc
  lsd:list of integer
 end-declarations
 xmltext:=text("<?xml version=\"1.0\"?>")+val
 setparam("ioctrl",true)
 load(xt,"text:xmltext")
 setparam("ioctrl",false)
 if getparam("iostatus")<>0 then
  writeln_("The following text is not valid XML (",if(exitonerror,_("abort"),_("ignored")),"):\n",val)
  if exitonerror then
   exit(1)
  end-if
 else
  getnodes(xt,"node()",lsd)
  forall(i in lsd)
   n:=copynode(xt,i,xd,nid,XML_LASTCHILD)
 end-if
end-procedure

!***************************************
!* Add quotes to a constant value node
!***************************************
procedure quoteconst(p:integer,n:string)
 nid:=getnode(xd,p,n)
 if nid>0 then
  str:=getvalue(xd,nid)
  if findtext(str,"'",1)=0 then
   setvalue(xd,nid,text("'")+str+"'")
  else
   setvalue(xd,nid,text('"')+str+'"')
  end-if
 end-if
end-procedure

!*******************************************
!* Return the last existing node of a list
!*******************************************
function addafter(p:integer,name:string,nds:list of string):integer
 forall(n in nds) do
  nid:=getnode(xd,p,n)
  if nid>0 then
   break
  end-if
 end-do
 if nid<=0 then
  returned:=addnode(xd,p,XML_ELT,name)
 else
  returned:=addnode(xd,nid,XML_NEXT,XML_ELT,name)
 end-if
end-function

!****************************************
!* Split a location definition
!****************************************
function split_tloc(tl:text):set of string
 setparam("sys_sepchar",10)
 setparam("sys_endparse",0)
 while(nextfield(tl)) do
  returned+={string(parsetext(tl))}
 end-do
end-function

!************************
!* replace '_' by '-'
!************************
function fixxmlid(id:text):text
 returned:=id
 forall(i in 1..id.size)
  if getchar(returned,i)=95 then
   setchar(returned,i,45)
  end-if
end-function

!*********************************************
! set entity name and add xname if required
!*********************************************
procedure setsafeentname(nid:integer,name:string)
 declarations
  nt:text
 end-declarations
 setattr(xd,nid,"name",name)
 i:=findtext(name,"~",1)
 if i>0 then
  nt:=name
  repeat
   setchar(nt,i,771)
   i:=findtext(name,"~",i+1)
  until i=0
  setattr(xd,nid,"xname",nt)
 end-if
end-procedure

!*****************************************************************************
!*****************************************************************************
!*
!*  Generation of an HTML document from an XML file
!*
!*****************************************************************************
!*****************************************************************************

declarations
 s_hctx=
   record
    xt:xmldoc
    bdir:text
    chap:text
    where:integer ! 0:nowhere, 1: chapter 2:section 3:subsection
    nd:integer
   end-record
end-declarations

forward procedure buildindex(bdir,ndxfile,tocfile,coverfile:text,links:array(string) of text)
forward procedure addtoc_entry(xt:xmldoc,b:integer,cls:integer,ref:text,name:text)
forward procedure addtoc_entry(xt:xmldoc,b:integer,cls:integer,ref:text,node:integer,links:array(string) of text)
forward procedure enumtoc(n:integer,xt:xmldoc,body:integer,cls:integer,chap:text,links:array(string) of text)
forward function sethtmlhead(xt:xmldoc,title:text):integer
forward procedure sethtmlfoot(xt:xmldoc,links:array(string) of text)
forward function starttoc(xt:xmldoc):integer
forward procedure buildtoc(tocfile:text,links:array(string) of text)
forward procedure output_text(n:integer,xt:xmldoc,nd:integer,name:string,cls:string,links:array(string) of text)
forward procedure output_code(n:integer,xt:xmldoc,nd:integer,name:string,cls:string)
forward procedure output_entity(n:integer,xt:xmldoc,nd:integer,links:array(string) of text)
forward procedure output_fct(bdir:text,n:integer,prev:text,links:array(string) of text)
forward procedure output_fctargval(xt:xmldoc,nv:integer,nd:integer,links:array(string) of text)
forward procedure output_fctlist(lfct:list of integer,xt:xmldoc,nd:integer,links:array(string) of text)
forward procedure update_tags(xt:xmldoc,n2:integer,links:array(string) of text)
forward procedure handle_tt(xt:xmldoc,l:list of integer)
forward procedure enumchap(n:integer,hctx:s_hctx,links:array(string) of text)
forward procedure buildchaps(bdir:text,links:array(string) of text)

!********************************************
!* Create an html tree for a given document
!********************************************
procedure gendochtml(fno:text,repl:boolean,rout:text)
 declarations
  fname,extn,bname,outdir:text
  ids:set of string
  links:dynamic array(ids) of text
 end-declarations

 outdir:=rout
 fname:=fno
 if findtext(fname,".",1)<1 then
  if outdir="" then
   outdir:=fname+"_html"
  end-if
  fname+="_doc.xml"
  extn:="xml"
 else
  if copytext(fname,fname.size-7,fname.size)="_doc.xml" then
   bname:=copytext(fname,1,fname.size-8)
   extn:="xml"
  else
   extn:=pathsplit(SYS_EXTN,fname,bname)
   if extn="mos" or extn="bim" then
    fname:=bname+"_doc.xml"
    extn:="xml"
   end-if
  end-if
  if outdir="" then
   outdir:=bname+"_html"
  end-if
 end-if

 if extn="xml" then 	! we silently skip files with an unkown extension
  if not repl and getfstat(outdir)<>0 then
   writeln_("+ Directory `",outdir,"' already exists. Not regenerating it.")
  else
   setparam("ioctrl",true)
    load(xd,fname)
   setparam("ioctrl",false)
   if getparam("iostatus")<>0 then
    writeln_("+ File `",fname,"' cannot be loaded. Ignored.")
   else
    makedir(outdir)
    if bittest(getfstat(outdir),SYS_TYP)<>SYS_DIR then
     writeln_("+ Directory `",outdir,"' cannot be created. Ignored.")
    else
     ready_for_gen:=true
    end-if
   end-if
  end-if

  if ready_for_gen then
   writeln_("+ Creating `",outdir,"' from `",fname,"'")
   fcopy(css,outdir+"/moseldoc.css")
   glbcom1:=text("Generated by moseldoc v")+
   		getparam("model_version")+
   		" from '"+pathsplit(SYS_FNAME,fname)+"'"
   glbcom2:=text(datetime(SYS_NOW))
   glbcom:=text("\n")+glbcom1+"\nCreation date:"+glbcom2+"\n"
   buildtoc(outdir+"/toc.html",links)
   buildchaps(outdir,links)
   buildindex(outdir,"index.html","toc.html","cover.html",links)
  end-if
 end-if
 reset(xd)
end-procedure

!******************************
!* Create the index and cover
!******************************
procedure buildindex(bdir,ndxfile,tocfile,coverfile:text,links:array(string) of text)
 declarations
  xt:xmldoc
  title:text
 end-declarations

 ! Index file
 n3:=getnode(xd,0,"/*/name")
 n:=sethtmlhead(xt,if(n3>0,getvalue(xd,n3),text("Mosel Doc")))
 n:=addnode(xt,n,XML_NEXT,XML_ELT,"frameset")
 setattr(xt,n,"cols","25%,*")
 n2:=addnode(xt,n,XML_ELT,"frame")
 setattr(xt,n2,"src",tocfile)
 setattr(xt,n2,"name","toc")
 n2:=addnode(xt,n,XML_ELT,"frame")
 setattr(xt,n2,"src",coverfile)
 setattr(xt,n2,"name","main")
 save(xt,getnode(xt,0,"html"),bdir+"/"+ndxfile)
 
 reset(xt)
 ! Cover file
 n:=sethtmlhead(xt,if(n3>0,getvalue(xd,n3),text("Mosel Doc")))
 n:=addnode(xt,n,XML_NEXT,XML_ELT,"body")
 n:=addnode(xt,n,XML_ELT,"blockquote")
 n2:=addnode(xt,n,XML_ELT,"br")
 n2:=addnode(xt,n,XML_ELT,"br")
 n4:=getnode(xd,0,"/*/title")
 if n4>0 then
  n2:=copynode(xd,n4,xt,n,XML_LASTCHILD)
  update_tags(xt,n2,links)
  setname(xt,n2,"h1")
  setattr(xt,n2,"class","TitleColor")
  setattr(xt,n2,"align","center")
  n4:=getnode(xd,0,"/*/subtitle")
  if n4>0 then
   n2:=copynode(xd,n4,xt,n,XML_LASTCHILD)
   update_tags(xt,n2,links)
   setname(xt,n2,"h2")
   setattr(xt,n2,"class","TitleColor")
   setattr(xt,n2,"align","center")
  end-if
 else
  if n3>0 then
   title:=getvalue(xd,n3)+" manual"
  else
   title:="Reference manual"
  end-if
  n2:=addnode(xt,n,XML_ELT,"h1")
  setattr(xt,n2,"class","TitleColor")
  setattr(xt,n2,"align","center")
  setvalue(xt,n2,title)
 end-if
 forall(i in 1..7) n2:=addnode(xt,n,XML_ELT,"br")
 n2:=addnode(xt,n,XML_ELT,"h4")
 setattr(xt,n2,"align","center")
 n4:=getnode(xd,0,"/*/version")
 if n4>0 then
  setvalue(xt,n2,text("Release ")+getvalue(xd,n4))
 else
  n2:=addnode(xt,n,XML_ELT,"br")
 end-if
 forall(i in 1..4) n2:=addnode(xt,n,XML_ELT,"br")
 n4:=getnode(xd,0,"/*/date")
 if n4>0 then
  dte:=getvalue(xd,n4)
 else
  dte:=text(date(SYS_NOW))
 end-if
 n2:=addnode(xt,n,XML_ELT,"p")
 setattr(xt,n2,"class","body")
 n2:=addnode(xt,n,XML_ELT,"b")
 setvalue(xt,n2,text("Last modification ")+dte)
 forall(i in 1..4) n2:=addnode(xt,n,XML_ELT,"br")
 n2:=addnode(xt,n,XML_ELT,"div")
 setattr(xt,n2,"class","navi")
 n2:=addnode(xt,n2,XML_TXT,"[")
 n2:=addnode(xt,n2,XML_NEXT,XML_ELT,"a")
 setattr(xt,n2,"href",firstchap)
 setvalue(xt,n2,"Next")
 n2:=addnode(xt,n2,XML_NEXT,XML_TXT,"]")
 save(xt,getnode(xt,0,"html"),bdir+"/"+coverfile)
end-procedure

!***********************************
!* Add an entry to the TOC (string)
!***********************************
procedure addtoc_entry(xt:xmldoc,b:integer,cls:integer,ref:text,name:text)
 p:=addnode(xt,b,XML_ELT,"p")
 setattr(xt,p,"class",text("TOC")+cls)
 p:=addnode(xt,p,XML_ELT,"a",name)
 setattr(xt,p,"href",ref)
 setattr(xt,p,"class",text("TOC")+cls+"a")
end-procedure

!***********************************
!* Add an entry to the TOC (node)
!***********************************
procedure addtoc_entry(xt:xmldoc,b:integer,cls:integer,ref:text,node:integer,links:array(string) of text)
 p:=addnode(xt,b,XML_ELT,"p")
 setattr(xt,p,"class",text("TOC")+cls)
 if testattr(xd,node,"cont") then
  p:=addnode(xt,p,XML_ELT,"a",getattr(xd,node,"cont"))
 else
  p:=copynode(xd,node,xt,p,XML_LASTCHILD)
  update_tags(xt,p,links)
  setname(xt,p,"a")
 end-if
 setattr(xt,p,"href",ref)
 setattr(xt,p,"class",text("TOC")+cls+"a")
end-procedure

!********************************
!* Gnerete the TOC XML document
!********************************
procedure enumtoc(n:integer,xt:xmldoc,body:integer,cls:integer,chap:text,links:array(string) of text)
 n:=getfirstchild(xd,n)
 while(n>=0) do
  case getname(xd,n) of
   "chapter":
	do
	 href:=getattr(xd,n,"id")+".html"
	 links(string(getattr(xd,n,"id"))):=href
	 title:=getnode(xd,n,"title")
	 links(string(getattr(xd,n,"id")+"-title")):=
	 	if(testattr(xd,title,"cont"),getattr(xd,title,"cont"),getvalue(xd,title))
	 if firstchap=DEFCHAP then firstchap:=href; end-if
	 addtoc_entry(xt,body,cls,href,title,links)
	 enumtoc(n,xt,body,cls+1,href,links)
	end-do
   "section":
	do
	 href:=chap+"#"+getattr(xd,n,"id")
	 links(string(getattr(xd,n,"id"))):=href
	 title:=getnode(xd,n,"title")
	 links(string(getattr(xd,n,"id")+"-title")):=
	 	if(testattr(xd,title,"cont"),getattr(xd,title,"cont"),getvalue(xd,title))
	 addtoc_entry(xt,body,cls,href,title,links)
	 enumtoc(n,xt,body,cls+1,chap,links)
	end-do
   "subsection":
	do
	 href:=chap+"#"+getattr(xd,n,"id")
	 links(string(getattr(xd,n,"id"))):=href
	 title:=getnode(xd,n,"title")
	 links(string(getattr(xd,n,"id")+"-title")):=
	 	if(testattr(xd,title,"cont"),getattr(xd,title,"cont"),getvalue(xd,title))
	 if cls=1 then
	  addtoc_entry(xt,body,cls,href,title,links)
	  enumtoc(n,xt,body,cls+1,chap,links)
	 else
	  enumtoc(n,xt,body,cls,chap,links)
	 end-if
	end-do
   "entity":
	do
	 href:=chap+"#"+getattr(xd,n,"name")
	 links(string(getattr(xd,n,"name"))):=href
	 addtoc_entry(xt,body,cls,href,getattr(xd,n,"name"))
	end-do
   "fct":
	do
	 href:=getattr(xd,n,"name")+".html"
	 fname:=getattr(xd,n,"name")
	 if getattr(xd,n,"name2")<>"" then
	  fname+=text(", ")+getattr(xd,n,"name2")
	  if getattr(xd,n,"name3")<>"" then
	   fname+=text(", ")+getattr(xd,n,"name3")
	  end-if
	 end-if
	 addtoc_entry(xt,body,cls,href,fname)
	end-do
  end-case
  n:=getnext(xd,n)
 end-do
end-procedure

!*************************************
!* Initial setting of a new HTML file
!*************************************
function sethtmlhead(xt:xmldoc,title:text):integer
 n:=addnode(xt,0,XML_ELT,"html")
 n2:=addnode(xt,n,XML_COM,glbcom)
 setvspace(xt,n2,1)
 returned:=addnode(xt,n,XML_ELT,"head")
 setvspace(xt,returned,1)
 n2:=addnode(xt,returned,XML_ELT,"meta")
 setvspace(xt,n2,1)
 setattr(xt,n2,"http-equiv","Content-Type")
 setattr(xt,n2,"content","text/html; charset=UTF-8")
 if title<>"" then
  n2:=addnode(xt,returned,XML_ELT,"title",title)
 end-if
 n2:=addnode(xt,returned,XML_ELT,"link")
 setattr(xt,n2,"rel","stylesheet")
 setattr(xt,n2,"href","moseldoc.css")
 setattr(xt,n2,"type","text/css")
end-function

!*****************************
!* Add a footer to a page
!*****************************
procedure sethtmlfoot(xt:xmldoc,links:array(string) of text)
 n:=getnode(xt,0,'/html/body/blockquote/div[@class="Navi"]')
 n2:=addnode(xt,getnode(xt,0,'/html/body/blockquote'),XML_LASTCHILD,XML_ELT,"br")
 setvspace(xt,n2,2)
 if n>0 then
  n2:=copynode(xt,n,xt,n2,XML_NEXT)
  update_tags(xt,n2,links)
 end-if
 n:=addnode(xt,n2,XML_NEXT,XML_ELT,"hr")
 setattr(xt,n,"noshade","")
 setattr(xt,n,"class","ChapterLine")
 n:=addnode(xt,n,XML_NEXT,XML_ELT,"address")
 setvspace(xt,n,1)
 setvalue(xt,n,glbcom1+" on "+glbcom2)
end-procedure

!*********************************
!* Create the header of the TOC
!*********************************
function starttoc(xt:xmldoc):integer
 h:=sethtmlhead(xt,"Table of contents")
 n2:=addnode(xt,h,XML_ELT,"base")
 setattr(xt,n2,"target","main")
 returned:=addnode(xt,h,XML_NEXT,XML_ELT,"body")
 setattr(xt,returned,"style","background-color:#f2f2f2;")
end-function

!*****************************
!* Create the TOC
!*****************************
procedure buildtoc(tocfile:text,links:array(string) of text)
 declarations
  xt:xmldoc
 end-declarations
 n:=getnode(xd,"mosel-doc")
 if n<0 then
  n:=getnode(xd,"manual")
 end-if
 b:=starttoc(xt)
 firstchap:=DEFCHAP
 enumtoc(n,xt,b,1,firstchap,links)
 save(xt,getnode(xt,0,"html"),tocfile)
end-procedure

!*********************************************
!* Insert an XML text and fix the references
!*********************************************
procedure output_text(n:integer,xt:xmldoc,nd:integer,name:string,cls:string,links:array(string) of text)
 n2:=copynode(xd,n,xt,nd,XML_LASTCHILD)
 setname(xt,n2,name)
 setvspace(xt,n2,1)
 setattr(xt,n2,"class",cls)
 update_tags(xt,n2,links)
end-procedure

!*********************************
!* Insert a code extract (CDATA)
!*********************************
procedure output_code(n:integer,xt:xmldoc,nd:integer,name:string,cls:string)
 declarations
  l:list of integer
  t:string
  f:text
 end-declarations
 n2:=addnode(xt,nd,XML_ELT,name)
 setattr(xt,n2,"class",cls)
 if gettype(xd,getfirstchild(xd,n))=XML_CDATA then
  n:=getfirstchild(xd,n)
  if name<>"pre" then
   n2:=addnode(xt,n2,XML_ELT,"pre")
  end-if
  setvalue(xt,n2,getvalue(xd,n))
 else
  n2:=copynode(xd,n,xt,n2,XML_LASTCHILD)
 end-if
end-procedure

!**************************************
!* Process an entity (cst,typ,par,var)
!**************************************
procedure output_entity(n:integer,xt:xmldoc,nd:integer,links:array(string) of text)
 declarations
  nlist: list of integer
 end-declarations
 nd:=addnode(xt,nd,XML_ELT,"dl")
 n2:=addnode(xt,nd,XML_ELT,"dt")
 n2:=addnode(xt,n2,XML_ELT,"div")
 setattr(xt,n2,"class","Entity")
 n3:=addnode(xt,n2,XML_ELT,"a")
 setattr(xt,n3,"name",getattr(xd,n,"name"))
 setvalue(xt,n3," ")
 n3:=addnode(xt,n2,XML_TXT,getattr(xd,n,"name")+" ")
 cat:=getattr(xd,n,"cat")
 if cat<>"annot" then
  n3:=addnode(xt,n2,XML_ELT,"span")
  setattr(xt,n3,"class","code")
  if getnode(xd,n,"entConst")>0 then
   cstv:=getvalue(xd,getnode(xd,n,"entConst"))
   if cstv.size>55 then
    deltext(cstv,55,cstv.size)
    cstv+="..."
   end-if
   setvalue(xt,n3,text("= ")+cstv)
  elif getnode(xd,n,"entType")>0 then
   setvalue(xt,n3,text(": ")+getvalue(xd,getnode(xd,n,"entType")))
  end-if
 end-if

 nl:=addnode(xt,nd,XML_ELT,"dd")
 nl:=addnode(xt,nl,XML_ELT,"table")
 setattr(xt,nl,"border","0")
 setattr(xt,nl,"cellpadding","2")
 setattr(xt,nl,"cellspacing","0")
 setattr(xt,nl,"style","margin-left: -5pt; margin-top: 0pt; margin-bottom: 3pt")
 n2:=addnode(xt,nl,XML_TXT)

 ns:=getnode(xd,n,"entDescr")
 if ns>0 then
  n2:=addnode(xt,nl,XML_ELT,"tr")
  n2:=addnode(xt,n2,XML_ELT,"td")
  setattr(xt,n2,"valign","top")
  setattr(xt,n2,"colspan","2")
  output_text(ns,xt,n2,"div","CellBody",links)
 end-if

 ns:=getnode(xd,n,"entField")
 while (ns>0) do
  n2:=addnode(xt,nl,XML_ELT,"tr")
  n2:=addnode(xt,n2,XML_ELT,"td")
  setattr(xt,n2,"valign","top")
  setattr(xt,n2,"colspan","2")
  n2:=addnode(xt,n2,XML_ELT,"div")
  setattr(xt,n2,"class","EntItem")
  n3:=addnode(xt,n2,XML_TXT,getattr(xd,ns,"name")+" ")
  ns2:=getnode(xd,ns,"entType")
  if ns2>0 then
   n3:=addnode(xt,n2,XML_ELT,"span")
   setattr(xt,n3,"class","code")
   setvalue(xt,n3,text(": ")+getvalue(xd,ns2))
  end-if
  ns2:=getnode(xd,ns,"entDescr")
  ns3:=getnode(xd,ns,"entValues")
  if ns2>0 or ns3>0 then
   n2:=addnode(xt,nl,XML_ELT,"tr")
   n3:=addnode(xt,n2,XML_ELT,"td")
   setvalue(xt,n3," ")
   n2:=addnode(xt,n2,XML_ELT,"td")
   setattr(xt,n2,"valign","top")
   n2:=addnode(xt,n2,XML_ELT,"table")
   setattr(xt,n2,"border","0")
   setattr(xt,n2,"cellpadding","0")
   setattr(xt,n2,"cellspacing","0")
   setattr(xt,n2,"style","margin-left: 0pt; margin-top: 0pt; margin-bottom: 0pt")
   if ns2>0 then
    n3:=addnode(xt,n2,XML_ELT,"tr")
    n3:=addnode(xt,n3,XML_ELT,"td")
    setattr(xt,n3,"colspan","2")
    n3:=addnode(xt,n3,XML_ELT,"tr")
    n3:=addnode(xt,n3,XML_ELT,"td")
    setattr(xt,n3,"valign","top")
    setattr(xt,n3,"colspan","2")
    output_text(ns2,xt,n3,"div","CellBody",links)
   end-if  
   if ns3>0 then
    n3:=addnode(xt,n2,XML_ELT,"tr")
    n3:=addnode(xt,n3,XML_ELT,"td")
    setattr(xt,n3,"valign","top")
    n3:=addnode(xt,n3,XML_ELT,"div", "Values")
    setattr(xt,n3,"class","EntItem")
    n3:=addnode(xt,n2,XML_ELT,"td")
    setattr(xt,n3,"valign","top")
    n3:=addnode(xt,n3,XML_ELT,"div")
    setattr(xt,n3,"class","CellBody")
    n3:=addnode(xt,n3,XML_ELT,"table")
    setattr(xt,n3,"border","0")
    setattr(xt,n3,"cellpadding","0")
    setattr(xt,n3,"cellspacing","0")
    setattr(xt,n3,"style","margin-left: -0pt; margin-top: 0pt; margin-bottom: 0pt")
    getnodes(xd,ns3,"entVal",nlist)
    forall(j in nlist) do
     n4:=addnode(xt,n3,XML_ELT,"tr")
     n5:=addnode(xt,n4,XML_ELT,"td")
     setattr(xt,n5,"valign","top")
     setattr(xt,n5,"nowrap","nowrap")
     setattr(xt,n5,"width","28")
     n5:=addnode(xt,n5,XML_ELT,"div",getattr(xd,j,"value"))
     setattr(xt,n5,"class","EntLabel")
     n5:=addnode(xt,n4,XML_ELT,"td")
     setattr(xt,n5,"valign","top")
     output_text(j,xt,n5,"div","CellBody",links)
    end-do
   end-if
  end-if
  ns:=getnext(xd,ns)
 end-do

 if cat="annot" then
  ns:=getnode(xd,n,"entType")
  if ns>0 then
   n2:=addnode(xt,nl,XML_ELT,"tr")
   n3:=addnode(xt,n2,XML_ELT,"td")
   setattr(xt,n3,"valign","top")
   setattr(xt,n3,"width","150px")
   n3:=addnode(xt,n3,XML_ELT,"div")
   setattr(xt,n3,"class","EntItem")
   setvalue(xt,n3,"Type")
   n3:=addnode(xt,n2,XML_ELT,"td")
   setattr(xt,n3,"valign","top")
   output_text(ns,xt,n3,"div","EntLabel",links)
  end-if
 end-if

 ns:=getnode(xd,n,"entDefault")
 if ns>0 then
  n2:=addnode(xt,nl,XML_ELT,"tr")
  n3:=addnode(xt,n2,XML_ELT,"td")
  setattr(xt,n3,"valign","top")
  setattr(xt,n3,"width","150px")
  n3:=addnode(xt,n3,XML_ELT,"div")
  setattr(xt,n3,"class","EntItem")
  setvalue(xt,n3,"Default value")
  n3:=addnode(xt,n2,XML_ELT,"td")
  setattr(xt,n3,"valign","top")
  output_text(ns,xt,n3,"div","CellBody",links)
 end-if

 ns:=getnode(xd,n,"entValues")
 if ns>0 then
  n2:=addnode(xt,nl,XML_ELT,"tr")
  n3:=addnode(xt,n2,XML_ELT,"td")
  setattr(xt,n3,"valign","top")
  n3:=addnode(xt,n3,XML_ELT,"div")
  setattr(xt,n3,"class","EntItem")
  setvalue(xt,n3,"Values")
  n3:=addnode(xt,n2,XML_ELT,"td")
  setattr(xt,n3,"valign","top")
  n3:=addnode(xt,n3,XML_ELT,"div")
  setattr(xt,n3,"class","CellBody")
  n3:=addnode(xt,n3,XML_ELT,"table")
  setattr(xt,n3,"border","0")
  setattr(xt,n3,"cellpadding","0")
  setattr(xt,n3,"cellspacing","0")
  setattr(xt,n3,"style","margin-left: -0pt; margin-top: 0pt; margin-bottom: 0pt")
  ns2:=getfirstchild(xd,ns)
  while(ns2>0) do
   ne:=addnode(xt,n3,XML_ELT,"tr")
   n4:=addnode(xt,ne,XML_ELT,"td")
   setattr(xt,n4,"valign","top")
   setattr(xt,n4,"nowrap","")
   setattr(xt,n4,"width","28")
   if getname(xd,ns2)="entVal" then
    n4:=addnode(xt,n4,XML_ELT,"div",getattr(xd,ns2,"value"))
    setattr(xt,n4,"class","EntLabel")
    n4:=addnode(xt,ne,XML_ELT,"td")
    setattr(xt,n4,"valign","top")
    delattr(xd,ns2,"value")
    output_text(ns2,xt,n4,"div","CellBody",links)
   else
    n4:=addnode(xt,n4,XML_ELT,"div",getvalue(xd,ns2))
   end-if
   ns2:=getnext(xd,ns2)
  end-do
 end-if

 ns:=getnode(xd,n,"entSetby")
 if ns>0 then
  n2:=addnode(xt,nl,XML_ELT,"tr")
  n3:=addnode(xt,n2,XML_ELT,"td")
  setattr(xt,n3,"valign","top")
  setattr(xt,n3,"width","150px")
  n3:=addnode(xt,n3,XML_ELT,"div")
  setattr(xt,n3,"class","EntItem")
  setvalue(xt,n3,"Set by routines ")
  n3:=addnode(xt,n2,XML_ELT,"td")
  setattr(xt,n3,"valign","top")
  output_text(ns,xt,n3,"div","CellBody",links)
 end-if

 ns:=getnode(xd,n,"entScope")
 if ns>0 then
  n2:=addnode(xt,nl,XML_ELT,"tr")
  n3:=addnode(xt,n2,XML_ELT,"td")
  setattr(xt,n3,"valign","top")
  setattr(xt,n3,"width","150px")
  n3:=addnode(xt,n3,XML_ELT,"div")
  setattr(xt,n3,"class","EntItem")
  setvalue(xt,n3,"Scope")
  n3:=addnode(xt,n2,XML_ELT,"td")
  setattr(xt,n3,"valign","top")
  tval:=getvalue(xd,ns)
  if tval="specific" then
   n3:=addnode(xt,n3,XML_ELT,"div", "specific (must be attached to a declaration)")
   setattr(xt,n3,"class","CellBody")
  elif tval="global" then
   n3:=addnode(xt,n3,XML_ELT,"div", "global (not attached to any declaration)")
   setattr(xt,n3,"class","CellBody")
  elif tval="any" then
   n3:=addnode(xt,n3,XML_ELT,"div", "any (can be global or attached to a declaration)")
   setattr(xt,n3,"class","CellBody")
  else
   output_text(ns,xt,n3,"div","CellBody",links)
  end-if
 end-if

 ns:=getnode(xd,n,"entPolicy")
 if ns>0 then
  n2:=addnode(xt,nl,XML_ELT,"tr")
  n3:=addnode(xt,n2,XML_ELT,"td")
  setattr(xt,n3,"valign","top")
  setattr(xt,n3,"width","150px")
  n3:=addnode(xt,n3,XML_ELT,"div")
  setattr(xt,n3,"class","EntItem")
  setvalue(xt,n3,"Duplicates policy")
  n3:=addnode(xt,n2,XML_ELT,"td")
  setattr(xt,n3,"valign","top")
  tval:=getvalue(xd,ns)
  if tval="last" then
   n3:=addnode(xt,n3,XML_ELT,"div", "last (the last definition is kept)")
   setattr(xt,n3,"class","CellBody")
  elif tval="first" then
   n3:=addnode(xt,n3,XML_ELT,"div", "first (the first definition is kept ignoring all others)")
   setattr(xt,n3,"class","CellBody")
  elif tval="merge" then
   n3:=addnode(xt,n3,XML_ELT,"div", "merge (definitions are concatenated)")
   setattr(xt,n3,"class","CellBody")
  elif tval="multi" then
   n3:=addnode(xt,n3,XML_ELT,"div", "multi (all definitions are kept)")
   setattr(xt,n3,"class","CellBody")
  else
   output_text(ns,xt,n3,"div","CellBody",links)
  end-if
 end-if

 ns:=getnode(xd,n,"entNote")
 if ns>0 then
  n2:=addnode(xt,nl,XML_ELT,"tr")
  n3:=addnode(xt,n2,XML_ELT,"td")
  setattr(xt,n3,"valign","top")
  n3:=addnode(xt,n3,XML_ELT,"div")
  setattr(xt,n3,"class","EntItem")
  setvalue(xt,n3,"Note ")
  n3:=addnode(xt,n2,XML_ELT,"td")
  setattr(xt,n3,"valign","top")
  ns:=getfirstchild(xd,ns)
  if getname(xd,ns)="entNoteItem" then
   nbit:=1
   repeat
    output_text(ns,xt,n3,"div","ParamInfo",links)
    n2:=getlastchild(xt,n3)
    n2:=addnode(xt,n2,XML_FIRSTCHILD,XML_TXT,text(nbit)+".\t ")
    nbit+=1
    ns:=getnext(xd,ns)
   until(ns<1)
  else
   output_text(getnode(xd,n,"entNote"),xt,n3,"div","CellBody",links)
  end-if
 end-if

end-procedure

!**************************************
!* Process a subroutine
!**************************************
procedure output_fct(bdir:text,n:integer,prev:text,links:array(string) of text)
 declarations
  xt:xmldoc
 end-declarations

 hname:=getattr(xd,n,"name")
 if getattr(xd,n,"name2")<>"" then
  hname+=text(" ")+getattr(xd,n,"name2")
  if getattr(xd,n,"name3")<>"" then
  hname+=text(" ")+getattr(xd,n,"name3")
  end-if 
 end-if
 n2:=sethtmlhead(xt,hname)
 n2:=addnode(xt,n2,XML_NEXT,XML_ELT,"body")
 nd:=addnode(xt,n2,XML_ELT,"blockquote")
 setvspace(xt,nd,1)
 n2:=addnode(xt,nd,XML_ELT,"div")
 setattr(xt,n2,"class","Navi")
 if prev<>"" then
  n3:=addnode(xt,n2,XML_TXT,"[")
  n3:=addnode(xt,n3,XML_NEXT,XML_ELT,"a")
  setattr(xt,n3,"href",prev)
  setvalue(xt,n3,"Previous")
  n3:=addnode(xt,n3,XML_NEXT,XML_TXT,"]")
 end-if
 n3:=getnext(xd,n)
 if n3>0 and getname(xd,n3)="fct" then
  nextfct:=getattr(xd,n3,"name")+".html"
  n3:=addnode(xt,n2,XML_TXT,"[")
  n3:=addnode(xt,n3,XML_NEXT,XML_ELT,"a")
  setattr(xt,n3,"href",nextfct)
  setvalue(xt,n3,"Next")
  n3:=addnode(xt,n3,XML_NEXT,XML_TXT,"]")
 end-if
 prev:=getattr(xd,n,"name")+".html"

 n2:=addnode(xt,nd,XML_ELT,"table")
 setattr(xt,n2,"width","90%")
 setattr(xt,n2,"border","0")
 setattr(xt,n2,"style","margin-top: 14pt;")
 setattr(xt,n2,"cellpadding","0pt")
 setattr(xt,n2,"cellspacing","0pt")
 n2:=addnode(xt,n2,XML_ELT,"tr")
 n3:=addnode(xt,n2,XML_ELT,"td")
 n3:=addnode(xt,n3,XML_ELT,"h1")
 setattr(xt,n3,"class","FctName")
 setvspace(xt,n3,2)

 n3:=addnode(xt,n3,XML_ELT,"a")
 setattr(xt,n3,"name",getattr(xd,n,"name"))
 setvalue(xt,n3," ")
 n3:=addnode(xt,n3,XML_NEXT,XML_TXT,getattr(xd,n,"name"))
 if getattr(xd,n,"name2")<>"" then
  n3:=addnode(xt,n3,XML_NEXT,XML_TXT,", ")
  n3:=addnode(xt,n3,XML_NEXT,XML_ELT,"a")
  setattr(xt,n3,"name",getattr(xd,n,"name2"))
  setvalue(xt,n3," ")
  n3:=addnode(xt,n3,XML_NEXT,XML_TXT,getattr(xd,n,"name2"))
  if getattr(xd,n,"name3")<>"" then
   n3:=addnode(xt,n3,XML_NEXT,XML_TXT,", ")
   n3:=addnode(xt,n3,XML_NEXT,XML_ELT,"a")
   setattr(xt,n3,"name",getattr(xd,n,"name3"))
   setvalue(xt,n3," ")
   n3:=addnode(xt,n3,XML_NEXT,XML_TXT,getattr(xd,n,"name3"))
  end-if
 end-if

 n3:=addnode(xt,n2,XML_ELT,"td")
 setvalue(xt,n3," ");

 n2:=addnode(xt,nd,XML_ELT,"hr")
 setattr(xt,n2,"noshade","")
 setattr(xt,n2,"class","FctLine")

 ns:=getnode(xd,n,"fctDescr")
 if ns>0 then
  n2:=addnode(xt,nd,XML_ELT,"div")
  setattr(xt,n2,"class","FctItem")
  setvspace(xt,n2,1)
  n3:=addnode(xt,n2,XML_TXT,"Purpose")
  n3:=addnode(xt,n2,XML_ELT,"br")
  output_text(ns,xt,nd,"div","FctItemText",links)
 end-if

 ns:=getnode(xd,n,"fctSyntax")
 if ns>0 then
  n2:=addnode(xt,nd,XML_ELT,"div")
  setattr(xt,n2,"class","FctItem")
  setvspace(xt,n2,1)
  n3:=addnode(xt,n2,XML_TXT,"Synopsis")
  n3:=addnode(xt,n2,XML_ELT,"br")
  ns:=getfirstchild(xd,ns)
  while(ns>0) do
   n2:=addnode(xt,nd,XML_ELT,"div")
   setattr(xt,n2,"class","FctSynopsis")
   setvspace(xt,n2,1)
   n3:=addnode(xt,n2,XML_ELT,"code")
   n3:=addnode(xt,n3,XML_TXT,getvalue(xd,ns))
   n3:=addnode(xt,n2,XML_ELT,"br")
   ns:=getnext(xd,ns)
  end-do
 end-if

 ns:=getnode(xd,n,"fctArguments")
 if ns>0 then
  n2:=addnode(xt,nd,XML_ELT,"div")
  setattr(xt,n2,"class","FctItem")
  setvspace(xt,n2,1)
  n3:=addnode(xt,n2,XML_TXT,"Arguments")
  n3:=addnode(xt,n2,XML_ELT,"br")

  n2:=addnode(xt,nd,XML_ELT,"table")
  setvspace(xt,n2,1)
  setattr(xt,n2,"border","0")
  setattr(xt,n2,"cellpadding","1")
  setattr(xt,n2,"cellspacing","0")
  setattr(xt,n2,"style","margin-left: 40pt")
  ns:=getfirstchild(xd,ns)
  while(ns>0) do
   ne:=addnode(xt,n2,XML_ELT,"tr")
   setvspace(xt,ne,1)
   n3:=addnode(xt,ne,XML_ELT,"td")
   setattr(xt,n3,"valign","top")
   setattr(xt,n3,"nowrap","")
   n3:=addnode(xt,n3,XML_ELT,"div")
   setattr(xt,n3,"class","FctArg")
   setvalue(xt,n3,getattr(xd,ns,"name")+"\240")
   delattr(xd,ns,"name")  ! useless in HTML

   n3:=addnode(xt,ne,XML_ELT,"td")
   setattr(xt,n3,"valign","top")
   setattr(xt,n3,"nowrap","")
   nsfc:=getfirstchild(xd,ns)
   if nsfc>1 and getname(xd,nsfc)="fctArgText" then
    output_text(nsfc,xt,n3,"div","CellBody",links)
    nsfc:=getnext(xd,nsfc)
    if nsfc>1 then
     output_fctargval(xt,nsfc,n3,links)
    end-if
   else
    output_text(ns,xt,n3,"div","CellBody",links)
   end-if

   ns:=getnext(xd,ns)
  end-do
 end-if

 ns:=getnode(xd,n,"fctErrors")
 if ns>0 then
  n2:=addnode(xt,nd,XML_ELT,"div")
  setattr(xt,n2,"class","FctItem")
  setvspace(xt,n2,1)
  n3:=addnode(xt,n2,XML_TXT,"Error values")
  n3:=addnode(xt,n2,XML_ELT,"br")

  n2:=addnode(xt,nd,XML_ELT,"table")
  setattr(xt,n2,"border","0")
  setattr(xt,n2,"cellpadding","1")
  setattr(xt,n2,"cellspacing","0")
  setattr(xt,n2,"style","margin-left: 40pt")
  setvspace(xt,n2,1)
  ns:=getfirstchild(xd,ns)
  while(ns>0) do
   ne:=addnode(xt,n2,XML_ELT,"tr")
   n3:=addnode(xt,ne,XML_ELT,"td")
   setattr(xt,n3,"valign","top")
   n3:=addnode(xt,n3,XML_ELT,"div")
   setattr(xt,n3,"class","FctArg")
   setvspace(xt,n3,1)
   ername:=string(getattr(xd,ns,"num"))
   if links(ername)<>"" then
    n3:=addnode(xt,n3,XML_ELT,"a")
    setattr(xt,n3,"href",links(ername))
    setvalue(xt,n3,ername)
    n3:=addnode(xt,n3,XML_NEXT,XML_TXT,"\240")
   else
    setvalue(xt,n3,getattr(xd,ns,"num")+"\240")
   end-if

   n3:=addnode(xt,ne,XML_ELT,"td")
   setattr(xt,n3,"valign","top")
   output_text(ns,xt,n3,"div","CellBody",links)

   ns:=getnext(xd,ns)
  end-do
 end-if

 ns:=getnode(xd,n,"fctReturn")
 if ns>0 then
  n2:=addnode(xt,nd,XML_ELT,"div")
  setattr(xt,n2,"class","FctItem")
  setvspace(xt,n2,1)
  n3:=addnode(xt,n2,XML_TXT,"Return value")
  n3:=addnode(xt,n2,XML_ELT,"br")
  output_text(ns,xt,nd,"div","FctItemText",links)
 end-if

 ns:=getnode(xd,n,"fctExample")
 if ns>0 then
  n2:=addnode(xt,nd,XML_ELT,"div")
  setattr(xt,n2,"class","FctItem")
  setvspace(xt,n2,1)
  n3:=addnode(xt,n2,XML_TXT,"Example")
  n3:=addnode(xt,n2,XML_ELT,"br")
  ns:=getfirstchild(xd,ns)
  while (ns>0) do
   if getname(xd,ns)="fctExampleText" then
    output_text(ns,xt,nd,"div","FctItemText",links)
   elif getname(xd,ns)="fctExampleCode" then
    output_code(ns,xt,nd,"div","FctCode")
   end-if
   ns:=getnext(xd,ns)
  end-do
 end-if

 ns:=getnode(xd,n,"fctFurtherinfo")
 if ns>0 then
  n2:=addnode(xt,nd,XML_ELT,"div")
  setattr(xt,n2,"class","FctItem")
  setvspace(xt,n2,1)
  n3:=addnode(xt,n2,XML_TXT,"Further information")
  n3:=addnode(xt,n2,XML_ELT,"br")
  ns:=getfirstchild(xd,ns)
  if getname(xd,ns)="fctFurtherinfoItem" then
   nbit:=1
   repeat
    output_text(ns,xt,nd,"div","FctInfo",links)
    n3:=getlastchild(xt,nd)
    n3:=addnode(xt,n3,XML_FIRSTCHILD,XML_TXT,text(nbit)+".\t ")
    nbit+=1
    ns:=getnext(xd,ns)
   until(ns<1)
  else
   output_text(getnode(xd,n,"fctFurtherinfo"),xt,nd,"div","FctItemText",links)
  end-if
 end-if

 ns:=getnode(xd,n,"fctRelated")
 if ns>0 then
  n2:=addnode(xt,nd,XML_ELT,"div")
  setattr(xt,n2,"class","FctItem")
  setvspace(xt,n2,1)
  n3:=addnode(xt,n2,XML_TXT,"Related Topics")
  n3:=addnode(xt,n2,XML_ELT,"br")
  output_text(ns,xt,nd,"div","FctItemText",links)
 end-if

 sethtmlfoot(xt,links)
 setindentmode(xt,XML_MANUAL)
 save(xt,getnode(xt,0,"html"),bdir+"/"+getattr(xd,n,"name")+".html")
 if getattr(xd,n,"name2")<>"" then
  fcopy(bdir+"/"+getattr(xd,n,"name")+".html",bdir+"/"+getattr(xd,n,"name2")+".html")
  if getattr(xd,n,"name3")<>"" then
   fcopy(bdir+"/"+getattr(xd,n,"name")+".html",bdir+"/"+getattr(xd,n,"name3")+".html")
  end-if 
 end-if
end-procedure

!***************************************************
!* Output function argument values
!***************************************************
procedure output_fctargval(xt:xmldoc,nv:integer,nd:integer,links:array(string) of text)
 n2:=addnode(xt,nd,XML_ELT,"table")
 setvspace(xt,n2,1)
 setattr(xt,n2,"border","0")
 setattr(xt,n2,"cellpadding","1")
 setattr(xt,n2,"cellspacing","0")
 setattr(xt,n2,"style","margin-left: 0pt")
 repeat
  ne:=addnode(xt,n2,XML_ELT,"tr")
  setvspace(xt,ne,1)
  n3:=addnode(xt,ne,XML_ELT,"td")
  setattr(xt,n3,"valign","top")
  setattr(xt,n3,"nowrap","")
  setattr(xt,n3,"width","28")
  n3:=addnode(xt,n3,XML_ELT,"div")
  setattr(xt,n3,"class","FctArg")
  setvalue(xt,n3,getattr(xd,nv,"value")+"\240")
  delattr(xd,nv,"value")  ! useless in HTML
  n3:=addnode(xt,ne,XML_ELT,"td")
  setattr(xt,n3,"valign","top")
  output_text(nv,xt,n3,"div","CellBody",links)
  nv:=getnext(xd,nv)
 until nv<0
 
end-procedure

!***************************************************
!* Output the function list of the current section
!***************************************************
procedure output_fctlist(lfct:list of integer,xt:xmldoc,nd:integer,links:array(string) of text)
 nt:=addnode(xt,nd,XML_NEXT,XML_ELT,"table")
 setattr(xt,nt,"border","0")
 setattr(xt,nt,"cellpadding","5")
 setattr(xt,nt,"cellspacing","0")
 setattr(xt,nt,"class","FctList")
 forall(f in lfct)
 do
  ne:=addnode(xt,nt,XML_ELT,"tr")
  n4:=addnode(xt,ne,XML_ELT,"td")
  setattr(xt,n4,"valign","top")
  n4:=addnode(xt,n4,XML_ELT,"span")
  setattr(xt,n4,"class","Code")
  n4:=addnode(xt,n4,XML_NEXT,XML_ELT,"a")
  setattr(xt,n4,"href",getattr(xd,f,"name")+".html")
  fn:=getattr(xd,f,"name")
  if getattr(xd,f,"name2")<>"" then
   fn+=text(", ")+getattr(xd,f,"name2")
   if getattr(xd,f,"name3")<>"" then
    fn+=text(", ")+getattr(xd,f,"name3")
   end-if
  end-if
  setvalue(xt,n4,fn)
  sdesc:=getattr(xd,f,"descr")
  if sdesc<>"" then
   n4:=addnode(xt,ne,XML_ELT,"td")
   setattr(xt,n4,"valign","top")
   n4:=addnode(xt,n4,"div",sdesc)
   setattr(xt,n4,"class","CellBody")
  else
   desc:=getnode(xd,f,"fctDescr")
   if desc>0 then
    n4:=addnode(xt,ne,XML_ELT,"td")
    setattr(xt,n4,"valign","top")
    output_text(desc,xt,n4,"div","CellBody",links)
   end-if
  end-if
 end-do
 
end-procedure

!**************************************
!* Update references and special tags
!**************************************
procedure update_tags(xt:xmldoc,n2:integer,links:array(LS:set of string) of text)
 declarations
  l:list of integer
 end-declarations

 getnodes(xt,n2,"//ref",l)
 forall(hr in l) do
  t:=string(getvalue(xt,hr))
  if t<>"" then
   setname(xt,hr,"a")
   setattr(xt,hr,"href",links(t))
   if t+"-title" in LS then
    setvalue(xt,hr,links(t+"-title"))
   end-if
  end-if
 end-do

 getnodes(xt,n2,"//entRef",l)
 forall(hr in l) do
  t:=string(getvalue(xt,hr))
  if t<>"" then
   setvalue(xt,getfirstchild(xt,hr),"")
   setname(xt,hr,"span")
   setattr(xt,hr,"class","Code")
   n3:=addnode(xt,hr,XML_ELT,"a")
   setattr(xt,n3,"href",links(t))
   setvalue(xt,n3,t)
  end-if
 end-do

 getnodes(xt,n2,"//fctRef",l)
 forall(hr in l) do
  f:=getvalue(xt,hr)
  if f<>"" then
   setvalue(xt,getfirstchild(xt,hr),"")
   setname(xt,hr,"span")
   setattr(xt,hr,"class","Code")
   n3:=addnode(xt,hr,XML_ELT,"a")
   setattr(xt,n3,"href",f+".html")
   setvalue(xt,n3,f)
  end-if
 end-do

 getnodes(xt,n2,"//tt",l)
 handle_tt(xt,l)

 getnodes(xt,n2,"//fctInd",l)
 handle_tt(xt,l)

 getnodes(xt,n2,"//entInd",l)
 handle_tt(xt,l)

end-procedure

!***********************************************
!* Generate appropriate HTML code for tt font
!***********************************************
procedure handle_tt(xt:xmldoc,l:list of integer)
 forall(hr in l) do
  f:=getvalue(xt,hr)
  if f<>"" then
   setvalue(xt,getfirstchild(xt,hr),"")
   setname(xt,hr,"span")
   setattr(xt,hr,"class","Code")
   setvalue(xt,hr,f)
  end-if
 end-do
end-procedure

!********************************
!* Generate the chapters
!********************************
procedure enumchap(n:integer,hctx:s_hctx,links:array(string) of text)
 declarations
  prevfct:text
  lfct:list of integer
 end-declarations
 n:=getfirstchild(xd,n)
 while(n>=0) do
  case getname(xd,n) of
   "chapter":
	do
	 if hctx.where>0 then
          sethtmlfoot(hctx.xt,links)
  	  setindentmode(hctx.xt,XML_MANUAL)
 	  save(hctx.xt,getnode(hctx.xt,0,"html"),hctx.bdir+"/"+hctx.chap)
	 else
	  hctx.chap:=""
	 end-if
	 reset(hctx.xt)
	 n2:=sethtmlhead(hctx.xt,"")
	 n2:=addnode(hctx.xt,n2,XML_NEXT,XML_ELT,"body")
 	 setvspace(hctx.xt,n2,1)
	 hctx.nd:=addnode(hctx.xt,n2,XML_ELT,"blockquote")
 	 setvspace(hctx.xt,hctx.nd,1)
	 n2:=addnode(hctx.xt,hctx.nd,XML_ELT,"div")
	 setattr(hctx.xt,n2,"class","Navi")
	 if hctx.chap<>"" then
	  n3:=addnode(hctx.xt,n2,XML_TXT,"[")
	  n3:=addnode(hctx.xt,n3,XML_NEXT,XML_ELT,"a")
	  setattr(hctx.xt,n3,"href",hctx.chap)
	  setvalue(hctx.xt,n3,"Previous chapter")
	  n3:=addnode(hctx.xt,n3,XML_NEXT,XML_TXT,"]")
	 end-if
         n3:=getnext(xd,n)
	 if n3>0 and getname(xd,n3)="chapter" then
	  hctx.chap:=getattr(xd,n3,"id")+".html"
	  n3:=addnode(hctx.xt,n2,XML_TXT,"[")
	  n3:=addnode(hctx.xt,n3,XML_NEXT,XML_ELT,"a")
	  setattr(hctx.xt,n3,"href",hctx.chap)
	  setvalue(hctx.xt,n3,"Next chapter")
	  n3:=addnode(hctx.xt,n3,XML_NEXT,XML_TXT,"]")
	 end-if
	 output_text(getnode(xd,n,"title"),hctx.xt,hctx.nd,"h1","Chapter",links)
	 n2:=addnode(hctx.xt,hctx.nd,XML_ELT,"hr")
	 setattr(hctx.xt,n2,"noshade","")
	 setattr(hctx.xt,n2,"class","ChapterLine")
	 n2:=addnode(hctx.xt,hctx.nd,XML_ELT,"br")
	 
	 hctx.chap:=getattr(xd,n,"id")+".html"
	 hctx.where:=1
	 enumchap(n,hctx,links)
	end-do
   "section":
	do
	 n2:=addnode(hctx.xt,hctx.nd,XML_ELT,"a")
	 setattr(hctx.xt,n2,"name",getattr(xd,n,"id"))
	 setvalue(hctx.xt,n2," ")
	 output_text(getnode(xd,n,"title"),hctx.xt,hctx.nd,"h2","Section",links)
	 hctx.where:=2
	 enumchap(n,hctx,links)
	end-do
   "subsection":
	do
	 n2:=addnode(hctx.xt,hctx.nd,XML_ELT,"a")
	 setattr(hctx.xt,n2,"name",getattr(xd,n,"id"))
	 setvalue(hctx.xt,n2," ")
	 output_text(getnode(xd,n,"title"),hctx.xt,hctx.nd,"h3","SubSection",links)
	 hctx.where:=3
	 enumchap(n,hctx,links)
	end-do
   "entity":
	do
	 output_entity(n,hctx.xt,hctx.nd,links)
	 hctx.where:=4
	end-do
   "fct":
	do
	 lfct+=[n]
	 output_fct(hctx.bdir,n,prevfct,links)
	 hctx.where:=4
	end-do
   "fctList":
	if hctx.nd>0 then
	 fctlist:=getlastchild(hctx.xt,hctx.nd)
	end-if
   "p":
	do
	 output_text(n,hctx.xt,hctx.nd,"p","body",links)
	 hctx.where:=4
	end-do
   "pre":
	do
	 output_code(n,hctx.xt,hctx.nd,"pre","PreCode")
	 hctx.where:=4
	end-do
  end-case
  n:=getnext(xd,n)
 end-do
 if fctlist>0 and lfct.size>0 then
  output_fctlist(lfct,hctx.xt,fctlist,links)
 end-if

end-procedure

!*****************************
!* Create the chapter files
!*****************************
procedure buildchaps(bdir:text,links:array(string) of text)
 declarations
  hctx:s_hctx
 end-declarations
 n:=getnode(xd,"mosel-doc")
 if n<0 then
  n:=getnode(xd,"manual")
 end-if
 hctx.bdir:=bdir
 hctx.chap:=DEFCHAP
 enumchap(n,hctx,links)
 if hctx.where>0 then
  sethtmlfoot(hctx.xt,links)
  setindentmode(hctx.xt,XML_MANUAL)
  save(hctx.xt,getnode(hctx.xt,0,"html"),bdir+"/"+hctx.chap)
 end-if
end-procedure

end-model

Back to examples browserPrevious exampleNext example