/****************************************************************/
/* FILE: html.scl                                               */
/* AUTHOR: David J. Biesack (sasdjb@unx.sas.com)                */
/* PURPOSE: Generate HTML files to display a class hierarchy    */
/*                                                              */
/* Customization: Change these defaults if necessary            */
/*                                                              */
/*   CLSHIER:  pathname of hierarchical class index             */
/*   NAMEINDX: pathname of index by class name                  */
/*   DESCINDX: pathname of index by class description           */
/*   DSNAME:   name of hierarchy data set name                  */
/*                                                              */
/****************************************************************/

%let CLSHIER   = 'clshier.htm';
%let NAMEINDX  = 'clsindx.htm';
%let DESCINDX  = 'descindx.htm';
%let DSNAME    = WORK.CLSHIER;
   
   /* write a line of text to file                              */
%macro writeln(file, text); 
   do; 
      iorc = fput(&file, &text);
      iorc = fwrite(&file);
   end;
%mend;

                          /* temp variables                     */
length name        $40    /* a class name                       */
       desc        $80    /* a class description                */
       objectClass 8      /* OBJECT class id                    */
       classClass  8      /* CLASS class id                     */
       file        8      /* fileid for html files              */
       i           8      /* loop indices                       */
       rc          8      /* return code                        */
       classes     8      /* list of classes                    */
       class       8      /* class id                           */
       href        $200   /* html hyperref                      */
       subclasses  8      /* list of subclasses                 */
       super       8;     /* id of super class                  */

INIT:
   if not exist("&DSNAME") then do;
      submit continue sql;
            create table &DSNAME as
              select libname, memname, objname
                     from dictionary.catalogs
              where (    (libname = 'SASHELP')
                     and (objtype = 'CLASS')
                     and (   memname = 'FSP'
                          or memname = 'AFCLASS'));
       endsubmit;
   end;

   link load;

      /* Add necessary methods to default meta class            */
   classClass  = loadclass('sashelp.fsp.class');
   name = searchpath('html.scl');
   call send(classClass,'_set_method_','Generate HTML',
             name, 'gen_html');
   call send(classClass,'_set_method_','Get Description',
             name, 'get_desc');
   call send(classClass,'_set_method_','Generate Reference',
             name, 'gen_ref');
   return;

MAIN:
      /* generate hierarchical index                            */
   call method('html.scl', 'open', file, 'HIER', 
               &CLSHIER, 'Class Hierarchy');
   if not file then return;

      /* Recursively generate hierarchical html,                */
      /* starting at OBJECT.CLASS                               */
   objectClass = loadclass('sashelp.fsp.object');
   %writeln(file, '<UL>');
   call send(objectClass, 'Generate HTML', file);
   %writeln(file, '</UL>');
   call method('html.scl', 'close', file, 'HIER');

      /* Generate index by name                                 */
   call method('html.scl', 'index', classes, 'BYNAME', 
                &NAMEINDX, 'Classes by Entry Name');

      /* Generate index by description                          */
   do i = 1 to listlen(classes);
      call send(getitemn(classes,i),'Get Description',desc);
      desc = nameitem(classes, i, desc);
   end;
   call method('html.scl', 'index', classes, 'BYDESC', 
                &DESCINDX, 'Classes by Description');

   rc = dellist(classes, 'Y');
   return;

   /* Generate a linear/sorted class index                      */
INDEX: method classes 8 how $8 fn title $;
   call method('html.scl', 'open', file, how, fn, title);
   if not file then return;
   %writeln(file, '<OL>');
   rc = sortlist(classes, 'NAME');
   do i = 1 to listlen(classes);
      call send(getitemn(classes,i),'Get Description',desc);
      call send(getitemn(classes,i),'Generate Reference',
                href, 1);
      if how = 'BYDESC' then
         %writeln(file, '<LI> ' || desc || ' ' || href);
      else
         %writeln(file, '<LI> ' || href || ' ' || desc);
   end;
   %writeln(file, '</OL>');
   call method('html.scl', 'close', file, how);
   endmethod;

   /* 'Generate HTML': generate HTML for a class                */
GEN_HTML: method file 8;
   call send(_self_, '_get_name_', name);
   call send(_self_, 'Get Description', desc);
   %writeln(file, '<LI><A NAME="' || name || '">'
                     || name || '</A> ' || desc);
   call send(_self_, '_get_super_', super);
   if super then do;
      call send(super, '_get_name_', name);
      %writeln(file,'<A HREF="#'||name||'">(parent)</A>');
   end;
   subclasses = makelist();
   call send(_self_, '_get_subclasses_', subclasses);
   if listlen(subclasses) then do;
      do i = 1 to listlen(subclasses);
         subclass = getitemn(subclasses, i);
         call send(subclass, '_get_name_', name);
         name = nameitem(subclasses, i, name);
      end;
      rc = sortlist(subclasses, 'NAME');
      %writeln(file, '<UL>');
      do i = 1 to listlen(subclasses);
         call send(getitemn(subclasses,i),
                   'Generate HTML', file);
      end;
      %writeln(file, '</UL>');
   end;
   rc = dellist(subclasses);
   endmethod;

   /* 'Generate Reference': gen an HTML link for a class        */
GEN_REF: method link $ optional= needFile 8;

      /* Generate '<a href=...>classname</a>' for CLASS.        */
   call send(_self_, '_get_name_', name);
   link = '<A HREF="';
   if needFile then
      link = link || &CLSHIER;
   link = link || '#' || name || '">' || name || '</A>';
   endmethod;

   /* 'Get Description' returns a class' description string     */
length defaults 8;                 /* list of class defaults    */
GET_DESC: method classdesc $40;
   call send(_self_, '_get_defaults_', defaults);
   classdesc = getnitemc(defaults, 'DESC', 1, 1, '');
   endmethod;

   /* Open an HTML file, generate head/title                    */
OPEN: method file 8 fileref $8 fname title $;
   iorc = filename(fileref, fname);
   if iorc then goto syserr;
   file = fopen(fileref, 'O');
   if not file then goto syserr;
   put 'Generating' fname 'as' fileref;
   %writeln(file, '<HEAD>');
   %writeln(file, '<TITLE>' || title || '</TITLE>');
   %writeln(file, '</HEAD>');
   %writeln(file, '<BODY>');
   %writeln(file, '<H1>' || title || '</H1>');
   endmethod;

   /* close: Close a class index file                           */
CLOSE: method file 8 fileref $8;
   %writeln(file, '<HR>');
   %writeln(file, 'See also listings of class by');
   %writeln(file, '<A HREF="' || &NAMEINDX
                  || '">class entry name</A>,');
   %writeln(file, '<A HREF="' || &DESCINDX
                  || '">description</A>, and');
   %writeln(file, '<A HREF="' || &CLSHIER
                  || '">hierarchy</A>,');
   %writeln(file, '</BODY>');
   %writeln(file, '</HTML>');
   iorc = fclose(file);
   iorc = filename(fileref, '');
   put 'closing' fileref;
   endmethod;

length classesId  8    /* data set id for &DSNAME               */
       libname   $8    /* data set variable LIBNAME             */
       memname   $8    /*                   MEMNAME             */
       objname   $8;   /*                   OBJNAME             */

   /* Load a list of classes named in &DSNAME dataset           */
LOAD:
   classes   = makelist();
   classesId = open("&DSNAME");
   if not classesId then return;
   call set(classesId);

      /* Scan list of class names and load each class           */
   sysrc = fetch(classesId);
   do while (sysrc = 0);
      name = LIBNAME || '.' || MEMNAME || '.' || OBJNAME;
      put 'Loading class: ' name;
      class = loadclass(name);
      if class then
         rc = insertn(classes, class, -1, name);
      else
         put 'WARNING: cannot load class' name;
      sysrc = fetch(classesId);
   end;
   sysrc = close(classesId);
   return;

SYSERR:
   _msg_ = sysmsg();
   rc = sysrc();
   put rc= _msg_;
   _status_ = 'H';
   stop;
   return;

   /* suppress compiler warnings with dummy assignments         */
DUMMY: method;
   libname = libname;
   memname = memname;
   objname = objname;
   _self_  = _self_;
   rc      = rc;
   sysrc   = sysrc;
   endmethod;