(* © Stellan Lagerström 1994 *)
(* This software is distributed under the "GNU general public license" *)
(* Share and enjoy :-) *)
(* build like this:

 PASCAL CDA$/NOOBJ
 PASCAL DDIF$WRITE_HTML
 LINK /share=sys$share:ddif$write_html sys$input:/opt
UNIVERSAL=DDIF$WRITE_HTML
GSMATCH=LEQUAL,1,0
PSECT=$data,shr,exe,nowrt
CDA_HTML.OBJ
SYS$LIBRARY:CDA$ACCESS/SHARE

 *)





(* how it should have been done:
[inherit('SYS$LIBRARY:CDA$DEF.PEN',
         'SYS$LIBRARY:CDA$MSG.PEN',
         'SYS$LIBRARY:DDIF$DEF.PEN',
         'CDA$.PEN')]
and how the substandard CDA programming files drag us into the C swamp: *)

[inherit('CDA$.PEN')]
MODULE DDIF_TO_HTML;

[HIDDEN] TYPE   (**** Pre-declared data types ****)
        $BYTE = [BYTE] -128..127;
        $WORD = [WORD] -32768..32767;
        $QUAD = [QUAD,UNSAFE] RECORD
                L0:UNSIGNED; L1:INTEGER; END;
        $OCTA = [OCTA,UNSAFE] RECORD
                L0,L1,L2:UNSIGNED; L3:INTEGER; END;
        $UBYTE = [BYTE] 0..255;
        $UWORD = [WORD] 0..65535;
        $UQUAD = [QUAD,UNSAFE] RECORD
                L0,L1:UNSIGNED; END;
        $UOCTA = [OCTA,UNSAFE] RECORD
                L0,L1,L2,L3:UNSIGNED; END;
        $PACKED_DEC = [BIT(4),UNSAFE] 0..15;
        $DEFTYP = [UNSAFE] INTEGER;
        $DEFPTR = [UNSAFE] ^$DEFTYP;
        $BOOL = [BIT(1),UNSAFE] BOOLEAN;
        $BIT  = [BIT(1),UNSAFE] BOOLEAN;
        $BIT2 = [BIT(2),UNSAFE] 0..3;
        $BIT3 = [BIT(3),UNSAFE] 0..7;
        $BIT4 = [BIT(4),UNSAFE] 0..15;
        $BIT5 = [BIT(5),UNSAFE] 0..31;
        $BIT6 = [BIT(6),UNSAFE] 0..63;
        $BIT7 = [BIT(7),UNSAFE] 0..127;
        $BIT8 = [BIT(8),UNSAFE] 0..255;
        $BIT9 = [BIT(9),UNSAFE] 0..511;
        $BIT10 = [BIT(10),UNSAFE] 0..1023;
        $BIT11 = [BIT(11),UNSAFE] 0..2047;
        $BIT12 = [BIT(12),UNSAFE] 0..4095;
        $BIT13 = [BIT(13),UNSAFE] 0..8191;
        $BIT14 = [BIT(14),UNSAFE] 0..16383;
        $BIT15 = [BIT(15),UNSAFE] 0..32767;
        $BIT16 = [BIT(16),UNSAFE] 0..65535;
        $BIT17 = [BIT(17),UNSAFE] 0..131071;
        $BIT18 = [BIT(18),UNSAFE] 0..262143;
        $BIT19 = [BIT(19),UNSAFE] 0..524287;
        $BIT20 = [BIT(20),UNSAFE] 0..1048575;
        $BIT21 = [BIT(21),UNSAFE] 0..2097151;
        $BIT22 = [BIT(22),UNSAFE] 0..4194303;
        $BIT23 = [BIT(23),UNSAFE] 0..8388607;
        $BIT24 = [BIT(24),UNSAFE] 0..16777215;
        $BIT25 = [BIT(25),UNSAFE] 0..33554431;
        $BIT26 = [BIT(26),UNSAFE] 0..67108863;
        $BIT27 = [BIT(27),UNSAFE] 0..134217727;
        $BIT28 = [BIT(28),UNSAFE] 0..268435455;
        $BIT29 = [BIT(29),UNSAFE] 0..536870911;
        $BIT30 = [BIT(30),UNSAFE] 0..1073741823;
        $BIT31 = [BIT(31),UNSAFE] 0..2147483647;
        $BIT32 = [BIT(32),UNSAFE] UNSIGNED;

%INCLUDE 'SYS$LIBRARY:CDA$DEF.PAS'
%INCLUDE 'SYS$LIBRARY:CDA$MSG.PAS'
%INCLUDE 'SYS$LIBRARY:DDIF$DEF.PAS'

CONST
  maxi  = 100;
  csi   = CHR(128+27);

TYPE
  item  = RECORD
            buflen:  INTEGER16;
            itemcode:INTEGER16;
            bufadr:  INTEGER32;
          END;
  itemlist      = PACKED ARRAY[0..maxi-1] OF item;
  str           = PACKED ARRAY[1..256] OF CHAR;
  strp          = ^str;
  rendition     = (bold,italic,underline,underline2,super,sub,struck,changed);
  rendset       = SET OF rendition;
  mhp           = ^cda_msgfile;

  [global]FUNCTION DDIF$WRITE_HTML(
                function_code:  INTEGER; (* normally CDA$_START *)
                standard: itemlist;
                private:  [immediate]INTEGER;(*unspecified format*)
                front:   cda_frontend;
        VAR     context:  INTEGER (* can be used to keep priv data *)
          ):INTEGER;            (* status *)

  VAR
    a,r         :cda_agg;
    t           :cda_aggtype;
    f           :cda_textfile;
    m           :cda_msgfile;
    i,sts,
    ind,bl      :INTEGER;
    fn          :STRING(255);
    ba          :strp;
    po          :itemlist;

    rend_stack  :ARRAY[0..25]OF RENDITION;
    rend_sp     :INTEGER VALUE 0;
    rend_now    :rendset VALUE [];

    [asynchronous]PROCEDURE TRY(s:[unsafe]INTEGER);
      [external]PROCEDURE LIB$STOP(%immed i:INTEGER);EXTERNAL;
    BEGIN
      IF NOT ODD(s) THEN LIB$STOP(s);
    END;

    PROCEDURE WR( s:STRING:=''; h:STRING:='' );
    VAR s2:STRING(s.length+ind+10);
    VAR h2:STRING(h.length+ind+10);
    BEGIN
      s2:=csi+'1m'+s+csi+'m';
      s2:=PAD('',' ',ind)+s2;
      IF m<>NIL THEN CDA$WRITE_TEXT_FILE(f,s2.length,s2.body);
(*      IF m<>NIL THEN CDA$WRITE_MESSAGE(m,17,s2.length,s2.body);*)
      IF LENGTH(h)>0
        THEN BEGIN
          CDA$WRITE_TEXT_FILE(f,h.length,h.body);(*the real thing*)
        END;
    END;

    PROCEDURE BUG(why:STRING);
    BEGIN
      WR('%WRHTML-E-'+why);
    END;

    PROCEDURE HEADER(h:cda_agg);
    VAR addinfo: INTEGER;
    BEGIN
      WR('DHD','<HEAD>');
      IF ODD(CDA$LOCATE_ITEM(r,h,DDIF$_DHD_TITLE,%REF ba,bl,0,addinfo))
        THEN WR('','<TITLE>'+SUBSTR(ba^,1,bl)+'</TITLE>')
        ELSE WR('  No title.');
      IF ODD(CDA$LOCATE_ITEM(r,h,DDIF$_DHD_AUTHOR,%REF ba,bl,0,addinfo))
        THEN WR('  Author: '+SUBSTR(ba^,1,bl))
        ELSE WR('  No author.');
      IF ODD(CDA$LOCATE_ITEM(r,h,DDIF$_DHD_DATE,%REF ba,bl))
        THEN WR('  Date: '+SUBSTR(ba^,1,bl))
        ELSE WR('  No date.');
      WR('','</HEAD>');
    END; { HEADER }
    

    PROCEDURE HARD(h:cda_agg);
    VAR ip: ^INTEGER;
    BEGIN
      WR('HRD');
      IF ODD(CDA$LOCATE_ITEM(r,h,DDIF$_HRD_DIRECTIVE,%REF ip,bl))
        THEN CASE ip^ OF
          DDIF$K_DIR_NEW_PAGE: WR('  New page ');
          DDIF$K_DIR_NEW_LINE: WR('  New line','<BR>');         (* bad html+ *)
          DDIF$K_DIR_NEW_GALLEY: WR('  New galley');
          DDIF$K_DIR_TAB: WR('  Tab',CHR(8));
          DDIF$K_DIR_SPACE: WR('  Space',CHR(160));             (* hard space *)
          DDIF$K_DIR_HYPHEN_NEW_LINE: WR('  Hyphen and new line');
          DDIF$K_DIR_WORD_BREAK_POINT: WR('  Word break point');
          DDIF$K_DIR_LEADERS: WR('  Leaders');
          DDIF$K_DIR_BACKSPACE: WR('  Backspace');
          DDIF$K_DIR_NULL: WR('  Null');
          DDIF$K_DIR_NO_HYPHEN_WORD: WR('  No hyph in next word');
          DDIF$K_DIR_NEW_LEFTPAGE: WR('  New left page');
          DDIF$K_DIR_NEW_RIGHTPAGE: WR('  New right page');
          OTHERWISE WR('  unknown:'+DEC(ip^));
        END;
    END; { HARD }
    
           
    PROCEDURE SOFT(h:cda_agg);
    VAR ip: ^INTEGER;
    BEGIN
      WR('SFT');
      IF ODD(CDA$LOCATE_ITEM(r,h,DDIF$_SFT_DIRECTIVE,%REF ip,bl))
        THEN CASE ip^ OF
          DDIF$K_DIR_NEW_PAGE: WR('  New page ');
          DDIF$K_DIR_NEW_LINE: WR('  New line');
          DDIF$K_DIR_NEW_GALLEY: WR('  New galley');
          DDIF$K_DIR_TAB: WR('  Tab');
          DDIF$K_DIR_SPACE: WR('  Space');
          DDIF$K_DIR_HYPHEN_NEW_LINE: WR('  Hyphen and new line');
          DDIF$K_DIR_WORD_BREAK_POINT: WR('  Word break point');
          DDIF$K_DIR_LEADERS: WR('  Leaders');
          DDIF$K_DIR_BACKSPACE: WR('  Backspace');
          DDIF$K_DIR_NULL: WR('  Null');
          DDIF$K_DIR_NO_HYPHEN_WORD: WR('  No hyph in next word');
          DDIF$K_DIR_NEW_LEFTPAGE: WR('  New left page');
          DDIF$K_DIR_NEW_RIGHTPAGE: WR('  New right page');
          OTHERWISE WR('  unknown:'+DEC(ip^));
        END;
    END; { HARD }
    
           
    PROCEDURE TXT_AGG(h:cda_agg);
    VAR i : INTEGER;
        s : str;
    BEGIN
      IF ODD(CDA$LOCATE_ITEM(r,h,DDIF$_TXT_CONTENT,%REF ba,bl))
        THEN BEGIN
           s:='';
           FOR i:=1 TO bl
            DO
              CASE ba^[i] OF
                '<' : s:=s+'&lt';
                '>' : s:=s+'&gt';
                '&' : s:=s+'&amp';
                OTHERWISE s := s + ba^[i];
              END;  { case }
           WR('TXT',s);
        END;
    END; { TXT_AGG }
    

    PROCEDURE REND_POP;
    BEGIN
      IF rend_sp<= 0 THEN BUG('Poprend') ELSE BEGIN
        CASE rend_stack[rend_sp] OF
          bold: WR(,'</B>');
          italic:WR(,'</I>');
          underline:WR(,'</U>'); (* HTML+ *)
          underline2:WR(,'</U2>');
          super:WR(,'</SUP>');
          sub:WR(,'</SUB>');
          struck:WR(,'</STRIKE>');
(*        struck:WR(,'</S>'); HTML+ *)
          changed:WR(,'<CHANGED IDREF=allan>');
        END;
        rend_now:=rend_now - [rend_stack[rend_sp]];
        rend_sp:=rend_sp-1;
      END;
    END; { REND_POP }


    PROCEDURE REND_PUSH(r:rendition);
    BEGIN
      IF rend_sp>253 THEN BUG('Pushrend') ELSE BEGIN
        rend_sp:=rend_sp+1;
        rend_stack[rend_sp]:=r;
        CASE r OF
          bold:         WR(,'<B>');
          italic:       WR(,'<I>');
          underline:    WR(,'<U>');
          underline2:   WR(,'<U2>');
          super:        WR(,'<SUP>');
          sub:          WR(,'<SUB>');
          struck:       WR(,'<STRIKE>');
(*        struck:       WR(,'<S>'); HTML+ *)
          changed:      WR(,'<CHANGED ID=allan>');
        END;
        rend_now:=rend_now+[r];
      END;
    END; { REND_PUSH }


    PROCEDURE REND_BEGIN(r:INTEGER; VAR newrend : rendset);
    BEGIN
      CASE r OF
        DDIF$K_RND_DEFAULT:BEGIN                        (* Default rendition*)
          WR('  Rend default');
          newrend:=[];
          END;
        DDIF$K_RND_NORMAL:BEGIN                         (* Normal intensity*)
          WR('  Rend normal');
          newrend:=newrend-[bold];
          END;
        DDIF$K_RND_HIGHLIGHT:BEGIN                      (* Highlit intensity*)
          WR('  Rend highlight');
          newrend:=newrend+[bold];
          END;
        DDIF$K_RND_FAINT:       WR('  Rend faint');     (* Faint intensity*)
        DDIF$K_RND_ITALIC:BEGIN                         (* Italic rendition*)
          WR('  Rend italic');
          newrend:=newrend+[italic];
          END;
        DDIF$K_RND_SLOW_BLINK:  WR('  Rend s blink');   (* Slow blinking*)
        DDIF$K_RND_FAST_BLINK:  WR('  Rend f blink');   (* Rapid blinking*)
        DDIF$K_RND_NO_BLINK:    WR('  Rend no blink');  (* Steady(no blinking)*)
        DDIF$K_RND_NEGATIVE:    WR('  Rend negative');  (* Negative image*)
        DDIF$K_RND_POSITIVE:    WR('  Rend positive');  (* Positive image*)
        DDIF$K_RND_CONCEAL:     WR('  Rend conceal');   (* Concealed characters*)
        DDIF$K_RND_NO_CONCEAL:  WR('  Rend reveal');    (* Revealed characters*)
        DDIF$K_RND_UNDERLINE:BEGIN                      (* Underlined*)
          WR('  Rend underline');
          newrend:=newrend+[underline];
          END;
        DDIF$K_RND_2_UNDERLINE:BEGIN                    (* Double underlined*)
          WR('  Rend 2 underline');
          newrend:=newrend+[underline2];
          END;
        DDIF$K_RND_NO_UNDERLINE:BEGIN                   (* Not underlined*)
          WR('  Rend no underline');
          newrend:=newrend-[underline,underline2];
          END;
        DDIF$K_RND_CROSS_OUT:BEGIN                      (* Crossed out*)
          WR('  Rend crossed out');
          newrend:=newrend+[struck];
          END;
        DDIF$K_RND_BOX:         WR('  Rend boxed');     (* Boxed*)
        DDIF$K_RND_ENCIRCLE:    WR('  Rend encircled'); (* Encircled*)
        DDIF$K_RND_OVERLINE:    WR('  Rend overlined'); (* Overlined*)
        DDIF$K_RND_FC_UNDERLINE:WR('  Rend f underline'); (* Fancy underline*)
        DDIF$K_RND_FC_OVERLINE: WR('  Rend f overline'); (* Fancy overline*)
        DDIF$K_RND_CHANGEBARS:BEGIN                     (* Change bars*)
          WR('  Rend changebars');
          newrend:=newrend+[changed];
          END;
        (* ideogrammatics have been left out here *)
        OTHERWISE               WR('  Rend ???');
      END;
    END; { REND_BEGIN }


    PROCEDURE REND_SET(oldrend:rendset);
    VAR r:rendition;
    BEGIN
      WHILE rend_now - oldrend <> []
        DO REND_POP;
      FOR r IN oldrend - rend_now
        DO REND_PUSH(r);
    END; { REND_SET }
    

    PROCEDURE SEG(h:cda_agg; parent_tag:INTEGER);       (* recursive *)
    VAR
      sts,sl,i,x,tag    : INTEGER;
      rend              : ^INTEGER;
      att               : ^cda_agg;
      sp,tagp           : strp;
      a                 : cda_agg;
      t                 : cda_aggtype;
      endmarker         : STRING(80);
      c                 : CHAR;
      startrend,newrend : rendset;

      PROCEDURE SEG_TAG(tt:INTEGER;ts:STRING);
      BEGIN
        CASE tt OF
          DDIF$K_PRIVATE_TAG: WR('  Private tag');      (* Nonstandard          *)
          DDIF$K_CRF_TAG    : WR('  CRF tag'); (* "$CRF" (cross-reference) *)
          DDIF$K_F_TAG      : WR('  F tag'); (* "$F" (figure)            *)
          DDIF$K_P_TAG      : BEGIN                     (* "$P" (paragraph)      *)
            IF parent_tag<>DDIF$K_LE_TAG THEN
            IF parent_tag<>DDIF$K_P_TAG THEN BEGIN
              WR('  P tag '+ts,'<P>'); endmarker:='</P>'
              END;
            END;
          DDIF$K_S_TAG      : WR('  S tag '+ts);(* "$S" (section)                *)
          DDIF$K_I_TAG      : WR('  I tag');    (* "$I" (index)          *)
          DDIF$K_E_TAG      : WR('  E tag');    (* "$E" (emphasized)     *)
          DDIF$K_L_TAG      : BEGIN             (* "$L" (list)  but what kind? *)
             WR('  L tag '+ts,'<UL>'); endmarker:='</UL>';
             (* WR('  L tag','<OL>'); endmarker:='</OL>'; *)
          END;
          DDIF$K_LE_TAG     : WR('  LE tag '+ts,'<LI>'); (* "$LE" (list element)  *)
          DDIF$K_LIT_TAG    : WR('  LIT tag '+ts); (* "$LIT" (literal)   *)
          DDIF$K_FN_TAG     : WR('  FN tag');   (* "$FN" (footnote)      *)
          DDIF$K_AN_TAG     : WR('  AN tag');   (* "$AN" (annotation)    *)
          DDIF$K_LBL_TAG    : WR('  LBL tag '+ts); (* "$LBL" (label)     *)
          DDIF$K_TTL_TAG    : BEGIN             (* "$TTL" (title) but which level *)
             c:=ts[LENGTH(ts)];         (* always the level ???? *)
             IF NOT (c IN ['1'..'6']) THEN c:='6';      (* just in case *)
             WR('  TTL tag '+ts,'<H'+c+'>');
             endmarker:='</H'+c+'>';
          END;
          DDIF$K_GRP_TAG    : WR('  GRP tag'); (* "$GRP" (group member)  *)
          DDIF$K_GO_TAG     : WR('  GO tag'); (* "$GO" (graphics object) *)
          DDIF$K_EN_TAG     : WR('  EN tag'); (* "$EN" (end note)        *)
          DDIF$K_APP_TAG    : WR('  APP tag'); (* "$APP" (appendix)      *)
          DDIF$K_HDR_TAG    : WR('  HDR tag'); (* "$HDR" (header)        *)
          DDIF$K_FTR_TAG    : WR('  FTR tag'); (* "$FTR" (footer)        *)
          DDIF$K_TOC_TAG    : WR('  TOC tag'); (* "$TOC" (table of contents) *)
          OTHERWISE           WR('  ?? Tag '+ts);
        END;
      END;

    BEGIN
      WR('{'); ind:=ind+2; endmarker:='';
      startrend:=rend_now;
      newrend:=rend_now;

      tag:=DDIF$K_PRIVATE_TAG;          (* as default *)
      IF ODD(CDA$LOCATE_ITEM(r,h,DDIF$_SEG_SEGMENT_TYPE,%REF sp,sl))
        THEN WR('Type "'+SUBSTR(sp^,1,sl)+'"');
      IF ODD(CDA$LOCATE_ITEM(r,h,DDIF$_SEG_SPECIFIC_ATTRIBUTES,%REF att,sl))
        THEN BEGIN      (* attribute segment present; process it *)
          WR('SEG_ATT'); IF sl<>4 THEN BUG('Segment handle length error');

          IF ODD(CDA$GET_ARRAY_SIZE(att^,DDIF$_SGA_SEGMENT_TAGS,x))
          THEN FOR i:=0 TO x-1
            DO IF ODD(CDA$LOCATE_ITEM(r,att^,DDIF$_SGA_SEGMENT_TAGS,%REF sp,sl,i,tag))
              THEN SEG_TAG(tag,SUBSTR(sp^,1,sl));

          IF ODD(CDA$GET_ARRAY_SIZE(att^,DDIF$_SGA_TXT_RENDITION,x))
            THEN FOR i:=0 TO x-1
              DO IF ODD(CDA$LOCATE_ITEM(r,att^,DDIF$_SGA_TXT_RENDITION,%REF rend,sl,i))
                THEN REND_BEGIN(rend^,newrend);

          END;(* attributes *)
      REND_SET(newrend);
      REPEAT    (* Now go for the body *)
        sts:=CDA$CONVERT_AGGREGATE(r,front,a,t);
        IF ODD(sts) THEN CASE t OF
          DDIF$_DSC: BUG('DSC in segment');     (* Document descriptor  *)
          DDIF$_DHD: BUG('DHD in segment');     (* Document header      *)
          DDIF$_SEG: SEG(a,tag);                (* Nested segment       *)
          DDIF$_DDF: BUG('HELP!!');             (* DDIF document root   *)
          DDIF$_EOS:                            (* End of segment       *)
            BEGIN ind:=ind-2; WR('}',endmarker); END;
          DDIF$_TXT: TXT_AGG(a);                (* Latin-1 text content *)
          DDIF$_SFT: SOFT(a);                   (* Soft directive       *)
          DDIF$_HRD: HARD(a);                   (* Hard directive       *)

          DDIF$_GTX: WR('GTX') ;                (* General text content NYI *)
          DDIF$_HRV: WR('HRV') ;                (* Hard value directive NYI *)
          DDIF$_SFV: WR('SFV') ;                (* Soft value directive NYI *)
          DDIF$_ARC: WR('ARC') ;                (* Arc content          NYI *)
          DDIF$_BEZ: WR('BEZ') ;                (* Bezier curve content NYI *)
          DDIF$_CRF: WR('CRF') ;                (* Content reference    NYI *)
          DDIF$_ERF: WR('ERF') ;                (* External reference   NYI *)
          DDIF$_EXT: WR('EXT') ;                (* External content     NYI *)
          DDIF$_FAS: WR('FAS') ;                (* Fill area set contentNYI *)
          DDIF$_GLY: WR('GLY') ;                (* Layout galley        NYI *)
          DDIF$_LIN: WR('LIN') ;                (* Polyline content     NYI *)
          DDIF$_PVT: WR('PVT') ;                (* Private content      NYI *)
          DDIF$_IDU: WR('IDU') ;                (* Image data unit      NYI *)
          DDIF$_IMG: WR('IMG') ;                (* Image content        NYI *)
          DDIF$_PTH: WR('PTH') ;                (* Composite path element NYI *)
          (* secondary. Should not be returned by CONVERT AGGREGATE... *)
          DDIF$_SGA: BUG('SGA') ;               (* Segment attributes    *)
          DDIF$_AUD: BUG('AUD') ;               (* Audio content         *)
          DDIF$_ADF: BUG('ADF') ;               (* Audio data frame      *)
          DDIF$_CTD: BUG('CTD') ;               (* Content definition    *)
          DDIF$_FTD: BUG('FTD') ;               (* Font definition       *)
          DDIF$_LSD: BUG('LSD') ;               (* Line style definition *)
          DDIF$_PHD: BUG('PHD') ;               (* Path definition       *)
          DDIF$_PTD: BUG('PTD') ;               (* Pattern definition    *)
          DDIF$_SGB: BUG('SGB') ;               (* Segment binding definition *)
          DDIF$_TYD: BUG('TYD') ;               (* Type definition       *)
          DDIF$_CTS: BUG('CTS') ;               (* Counter style         *)
          DDIF$_OCC: BUG('OCC') ;               (* Occurrence definition *)
          DDIF$_RCD: BUG('RCD') ;               (* Record definition     *)
          DDIF$_RGB: BUG('RGB') ;               (* RGB lookup table entry *)
          DDIF$_TRN: BUG('TRN') ;               (* Transform             *)
          DDIF$_LG1: BUG('LG1') ;               (* Generic layout I      *)
          DDIF$_LS1: BUG('LS1') ;               (* Specific layout I     *)
          DDIF$_LW1: BUG('LW1') ;               (* Wrap attributes I     *)
          DDIF$_LL1: BUG('LL1') ;               (* Layout attributes I   *)
          DDIF$_GLA: BUG('GLA') ;               (* Galley attributes     *)
          DDIF$_PGD: BUG('PGD') ;               (* Page description      *)
          DDIF$_PGL: BUG('PGL') ;               (* Page layout           *)
          DDIF$_PGS: BUG('PGS') ;               (* Page select           *)
          DDIF$_TBS: BUG('TBS') ;               (* Tab stop              *)
          DDIF$_CPH: BUG('CPH') ;               (* Composite path        *)
          DDIF$_PLJ: BUG('PLJ') ;               (* Polyline join description *)
          DDIF$_PJD: BUG('PJD') ;               (* Polyline join definition *)
          OTHERWISE BUG('Unknown aggregate in segment:'+DEC(t));
          END;
        CDA$DELETE_AGGREGATE(r,a);

        UNTIL (t=DDIF$_EOS) OR NOT ODD(sts);
        REND_SET(startrend);                    (* restore rendition *)
      END;                                      (* segment *)


  BEGIN (* Write_HTML body *)
    (* Parse itemlist *)
    ind:=0;
    m:=NIL;
    i:=0;
    WHILE (i<maxi)
    AND_THEN ((standard[i].buflen<>0) OR (standard[i].itemcode<>0))
      DO BEGIN
      CASE standard[i].itemcode OF
        CDA$_MESSAGE_HANDLE:BEGIN       (* Message rtn  *)
          m:=standard[i].bufadr::mhp^;
          END;
        CDA$_OUTPUT_FILE:               (* Output file specification*)
          fn:=SUBSTR(standard[i].bufadr::strp^,1,standard[i].buflen);
        CDA$_OUTPUT_DEFAULT: ;          (* Output default file specification NYI *)
        CDA$_OUTPUT_PROCEDURE: ;        (* Output procedure      NYI *)
        CDA$_OUTPUT_PROCEDURE_PARM: ;   (* Output procedure parameter NYI *)
        CDA$_OUTPUT_PROCEDURE_BUFFER: ; (* Output procedure initial buffer NYI *)
        CDA$_PROCESSING_OPTION: ;       (* Processing option     NYI *)
        OTHERWISE;                      (* forward compatibility *)
        END;(* case *)
      i:=i+1;
      END;
    TRY(CDA$CREATE_TEXT_FILE(fn.length,fn.body,
                             5,'.html',
                             text_file_handle := f));
    WR('Message handle '+HEX(m));
    WR('','<HTML>');

    po:=ZERO;(* empty it *)
    po[0].itemcode:=DDIF$_INHERIT_ATTRIBUTES; (* no parameters *)
(*    po[1].itemcode:=DDIF$_DISCARD_2D_SEGMENTS; (* maybe? no parameters *)
(*    po[2].itemcode:=DDIF$_DISCARD_I_SEGMENTS; (* maybe? no parameters *)
(*    po[3].itemcode:=DDIF$_DISCARD_PDL_SEGMENTS; (* maybe? no parameters *)

    TRY(CDA$CREATE_ROOT_AGGREGATE(processing_options    := %REF po, (* inheritance? *)
                                  aggregate_type        := DDIF$_DDF,
                                  root_aggregate_handle := r ));
    REPEAT
      sts:=CDA$CONVERT_AGGREGATE(r,front,a,t);
      IF ODD(sts) THEN
      CASE t OF
        DDIF$_DDF: BUG('ROOT'); (* DDIF document root; should not be seen *)
        DDIF$_DSC: WR('DSC') ;          (* Document descriptor  NYI *)
        DDIF$_DHD: HEADER(a);           (* Document header       *)
        DDIF$_SEG: BEGIN                 (* Document segment     *)
          WR('','<BODY>');
          SEG(a,DDIF$K_PRIVATE_TAG);
          WR('','</BODY>');
          END;
        OTHERWISE  BUG('Unexpected aggregate in document root');
        END;

      CDA$DELETE_AGGREGATE(r,a);

    UNTIL NOT ODD(sts);

    TRY(CDA$DELETE_ROOT_AGGREGATE(r));

    WR('','</HTML>');

    TRY(CDA$CLOSE_TEXT_FILE(f));
     
    DDIF$WRITE_HTML:=1;         (* hooray *)
    END;



END.