(!********************************************************
* Mosel Example Programs
* ======================
*
* file moseldoc.mos
* `````````````````
* Example for the use of the Mosel language
* (A documentation generator for Mosel files)
*
* (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.2.4
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 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
!***************************************************
!* 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))
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
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+={"0params","1consts","2types","3vars","4fcts","5anns"}
finalise(locs)
sections("").bn:=bn
sections("0params").bn:=addnode(xd,bn,XML_ELT,"chapter")
n:=addnode(xd,sections("0params").bn,XML_ELT,"title","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
setattr(xd,p,"name",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
setattr(xd,p,"name",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
setattr(xd,p,"name",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
setattr(xd,p,"name",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
setattr(xd,p,"name",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
!**************************
!* 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)
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
n2:=addnode(xd,narg,XML_ELT,"fctArgText")
n2:=copynode(xd,n,xd,n2,XML_FIRSTCHILD)
delnode(xd,n)
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
!*****************************************************************************
!*****************************************************************************
!*
!* 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")
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)
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
|
