00001 /*----------------------------------------------------------------------------*/
00002 /*                                                                            */
00003 /*   Copyright (c) 2004-2009 William  Data  Systems Ltd. and Geoff Stevens.   */
00004 /*   All rights reserved.                                                     */
00005 /*                                                                            */
00006 /*   This program and the  accompanying  materials are made available under   */
00007 /*   the terms of the  Common  Public  License  v1.0 which accompanies this   */
00008 /*   distribution. A  copy  is  also  available  at  the following address:   */
00009 /*   http://www.opensource.org/licenses/cpl1.0.php                            */
00010 /*                                                                            */
00011 /*   Redistribution and use in  source  and  binary  forms, with or without   */
00012 /*   modification, are  permitted  provided  that  the following conditions   */
00013 /*   are met:                                                                 */
00014 /*                                                                            */
00015 /*   Redistributions  of  source  code  must  retain  the  above  copyright   */
00016 /*   notice, this list of conditions and the following disclaimer.            */
00017 /*                                                                            */
00018 /*   Redistributions in  binary  form  must  reproduce  the above copyright   */
00019 /*   notice, this list of  conditions  and  the following disclaimer in the   */
00020 /*   documentation and/or other materials provided with the distribution.     */
00021 /*                                                                            */
00022 /*   Neither the name or trademarks  of  William Data Systems nor the names   */
00023 /*   of its  contributors  may  be  used  to  endorse  or  promote products   */
00024 /*   derived from this software without specific prior written permission.    */
00025 /*                                                                            */
00026 /*   DISCLAIMER                                                               */
00027 /*                                                                            */
00028 /*   THIS SOFTWARE IS PROVIDED  BY  THE  COPYRIGHT HOLDERS AND CONTRIBUTORS   */
00029 /*   "AS IS" AND  ANY  EXPRESS  OR  IMPLIED  WARRANTIES, INCLUDING, BUT NOT   */
00030 /*   LIMITED TO, THE IMPLIED WARRANTIES  OF MERCHANTABILITY AND FITNESS FOR   */
00031 /*   A PARTICULAR PURPOSE ARE DISCLAIMED.  IN  NO EVENT SHALL THE COPYRIGHT   */
00032 /*   OWNER OR CONTRIBUTORS BE LIABLE  FOR ANY DIRECT, INDIRECT, INCIDENTAL,   */
00033 /*   SPECIAL,  EXEMPLARY,  OR  CONSEQUENTIAL  DAMAGES  (INCLUDING,  BUT NOT   */
00034 /*   LIMITED TO, PROCUREMENT OF SUBSTITUTE  GOODS OR SERVICES; LOSS OF USE,   */
00035 /*   DATA, OR PROFITS; OR BUSINESS  INTERRUPTION) HOWEVER CAUSED AND ON ANY   */
00036 /*   THEORY OF LIABILITY, WHETHER  IN  CONTRACT,  STRICT LIABILITY, OR TORT   */
00037 /*   (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN  ANY WAY OUT OF THE USE   */
00038 /*   OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.     */
00039 /*                                                                            */
00040 /*----------------------------------------------------------------------------*/
00041 --  HTML page output static classes
00042 --
00043 --  These could be recast as routines, but making them class methods keeps them
00044 --  out of the namespace
00045 --
00046  
00047   -- html components
00048 ::REQUIRES 'fsobjects.cls'
00049   -- html components
00050 ::REQUIRES 'nodes.cls'
00051   -- html utility
00052 ::REQUIRES 'htmlutil.cls'
00053   -- syntax colouring
00054 ::REQUIRES 'colourable.cls'
00055   -- parser
00056 ::REQUIRES 'rexxprogram.cls'
00057   -- class lookup
00058 ::REQUIRES 'classfinder.cls'
00059  
00060 -- static class to emit html page for a rexx source program
00061 -- all methods are class methods
00062 ::CLASS htmlrexxsource PUBLIC
00063 ::ATTRIBUTE htmlout CLASS
00064  
00065 -- @param htmlout - hthtmlout object
00066 -- @param file - file object of program
00067 -- @param globalix - global index
00068 ::METHOD emit CLASS
00069   use arg htmlout, file, globalix
00070   self~htmlout = htmlout
00071  
00072   tp = .head_html~new~text
00073   tp~queue('<title>'file~filename'</title>')
00074   tp~queue(.nodes~prodssheet)
00075   tp~queue('<link rel="stylesheet" href="tabs.css">')
00076   tp~queue('<link rel="stylesheet" href="syntax.css">')
00077   -- head is complete
00078   tp~queue('</head>')
00079   tp~queue('<body>')
00080  
00081   -- set up menus
00082   .htmlutil~tabshead(tp, self~htmlout~topmenu, 'petfiles')
00083  
00084  
00085   tp~queue('<h2>'file~document~relpath' source</h2>')
00086   tp~queue('<div class="fragment"><pre class="fragment">')
00087  
00088   col = .colourable~new(file~document~src)
00089  
00090   -- add necessary decorations
00091   self~decorate(file~document, col, globalix)
00092  
00093   -- turn into html
00094   do i over col~lines
00095     tp~queue(i~tohtmlstring)
00096   end
00097  
00098   tp~queue('</pre></div>')
00099  
00100   .htmlutil~trailer(self~htmlout, tp)
00101  
00102   tp~queue('</body></html>')
00103  
00104   -- write page as html
00105   towrite = self~htmlout~hdest||file~document~hsrcurl
00106   .htmlutil~writepage(tp, towrite)
00107  
00108 -- decorate the document for Rexx syntax, prefix elements, etc.
00109 -- @param rxdoc - .rexxdocument
00110 -- @param col - .colourable representation of document
00111 -- @param globalix - .globalix for reference lookup
00112 --
00113 ::METHOD decorate CLASS
00114   use arg rxdoc, col, globalix
00115  
00116   -- colour features
00117   anchorname = ''
00118   features = rxdoc~featurelist
00119  
00120   do rdc over features
00121  
00122     clause = rxdoc~featureclause(rdc~feature)
00123     src = rxdoc~getsource(clause)
00124  
00125     -- flatten clause
00126     fc = .flatclause~new(clause, src)
00127  
00128     -- decide at which doc to point the feature
00129     anchor = rdc~hsrcanchor
00130     select
00131       when rdc~feature~objectname = 'CLAS'
00132         then do
00133                anchordoc = rdc~hdocurl -- go to file documentation
00134                anchor = rdc~hdocanchor
00135              end
00136       when rdc~feature~objectname = 'METH'
00137         then do
00138                if rdc~feature~ownerclass <> .nil
00139                  then do
00140                         anchordoc = rdc~feature~ownerclass~user~hdocurl -- go to class documentation
00141                         anchor = rdc~hdocanchor -- go to class documentation
00142                       end
00143                  else anchordoc = rdc~hdocurl -- go to file documentation
00144              end
00145       when rdc~feature~objectname = 'ATTR'
00146         then anchordoc = rdc~feature~ownerclass~user~hdocurl -- go to class documentation
00147       when rdc~feature~objectname = 'REQU'
00148         then do
00149                f = globalix~filix[rdc~rexxname]
00150                if f <> .nil
00151                  then anchordoc = f~document~hdocurl
00152              end
00153       otherwise anchordoc = rxdoc~hdocurl -- go to file documentation
00154     end
00155  
00156     -- get boundaries of feature name
00157     select
00158       when fc~flat~words = 1
00159         then do
00160                x1 = 1
00161                x2 = fc~flat~length - 1
00162              end
00163       when rdc~feature~objectname = 'PROC'
00164         then do
00165                if rdc~feature~rname = '--entry_proc'
00166                  then iterate
00167                -- procedures are named on first word
00168                x1 = 1
00169                x2 = fc~flat~wordindex(1) + fc~flat~word(1)~length 
00170              end
00171       otherwise do
00172                   -- all other features named on second word
00173                   x1 = fc~flat~wordindex(2) - 1
00174                   x2 = x1 + fc~flat~word(2)~length 
00175                 end
00176     end
00177  
00178     -- set up url to docs
00179  
00180     col~fcaddpre(fc, x1, '<a class="el" href="'anchordoc'#'anchor'">')
00181     col~fcaddpost(fc, x2, '</a>')
00182  
00183     -- span whole clause
00184     col~fcaddpre(fc, 1, '<span class="synfeature">')
00185     col~fcaddpost(fc, fc~flat~length, '</span>')
00186  
00187     if rdc~feature~objectname = 'PROC'
00188       then do
00189              -- highlight keywords
00190              if fc~flat~word(2)~translate = 'PROCEDURE'
00191                then do
00192                       x1 = fc~flat~wordindex(2)
00193                       x2 = x1 + fc~flat~word(2)~length - 1
00194                       col~fcaddpre(fc, x1, '<span class="synkeyword">')
00195                       col~fcaddpost(fc, x2, '</span>')
00196                     end
00197              if fc~flat~word(3)~translate = 'EXPOSE'
00198                then do
00199                       x1 = fc~flat~wordindex(3)
00200                       x2 = x1 + fc~flat~word(3)~length - 1
00201                       col~fcaddpre(fc, x1, '<span class="synkeyword">')
00202                       col~fcaddpost(fc, x2, '</span>')
00203                     end
00204           end
00205  
00206     -- cross reference inheritance on class feature
00207     classwords = 'METACLASS MIXINCLASS SUBCLASS PRIVATE PUBLIC INHERIT'
00208     if rdc~feature~objectname = 'CLAS'
00209       then do
00210              do j = 3 to fc~flat~words
00211                w = fc~flat~word(j)
00212                if classwords~wordpos(w~translate) > 0
00213                  then do
00214                         x1 = fc~flat~wordindex(j)
00215                         x2 = x1 + fc~flat~word(j)~length - 1
00216                         col~fcaddpre(fc, x1, '<span class="synkeyword">')
00217                         col~fcaddpost(fc, x2, '</span>')
00218                         iterate
00219                       end
00220                irdc = rdc~document~globalix~classix[w~translate]
00221                if irdc <> .nil
00222                  then do
00223                         x1 = fc~flat~wordindex(j)
00224                         x2 = x1 + fc~flat~word(j)~length - 1
00225                         col~fcaddpre(fc, x1, '<a class="el" href="'irdc~hdocurl'">')
00226                         col~fcaddpost(fc, x2, '</a>')
00227                       end
00228              end
00229            end
00230  
00231     -- highlight method words
00232     methwords = 'CLASS ATTRIBUTE ABSTRACT PUBLIC PRIVATE GUARDED UNGUARDED PROTECTED UNPROTECTED EXTERNAL'
00233     if rdc~feature~objectname = 'METH' | rdc~feature~objectname = 'ATTR'
00234       then do
00235              do j = 3 to fc~flat~words
00236                w = fc~flat~word(j)
00237                if methwords~wordpos(w~translate) > 0
00238                  then do
00239                         x1 = fc~flat~wordindex(j)
00240                         x2 = x1 + fc~flat~word(j)~length - 1
00241                         col~fcaddpre(fc, x1, '<span class="synkeyword">')
00242                         col~fcaddpost(fc, x2, '</span>')
00243                         iterate
00244                       end
00245              end
00246            end
00247  
00248     -- set anchor on the line
00249     col~addpre(rdc~startline, 1, '<a name='rdc~hsrcanchor'></a>')
00250  
00251   end
00252  
00253   -- colour comments
00254   comments = rxdoc~comments
00255   do i over comments
00256     col~addpre(i~startline, i~startcol, '<span class="syncomment">')
00257     col~addpost(i~feature~endline, i~endcol, '</span>')
00258  
00259     -- scan comments for class names and add references when found
00260     src = rxdoc~getsource(i)
00261     fc = .flatclause~new(i, src)
00262     do j = 1 to fc~flat~words
00263       w = fc~flat~word(j)
00264       if w~left(1) = '.'
00265          then do
00266                 cn = w~translate('   ','.,;')~translate~strip
00267                 rdc = .classfinder~findclass(cn, rxdoc, rxdoc~reqfiles)
00268                 if rdc <> .nil
00269                   then do
00270                          x1 = fc~flat~wordindex(j)
00271                          x2 = x1 + w~length - 1
00272                          col~fcaddpre(fc, x1, '<a href="'rdc~hdocurl'#'rdc~hdocanchor'">')
00273                          col~fcaddpost(fc, x2, '</a>')
00274                        end
00275  
00276               end
00277     end
00278   end
00279  
00280   trace o
00281  
00282   -- colour string literals
00283   quotes = rxdoc~quotes
00284   do i over quotes
00285     col~addpre(i~startline, i~startcol, '<span class="syncharliteral">')
00286     col~addpost(i~endline, i~endcol, '</span>')
00287   end
00288  
00289   -- colour rex clauses
00290   clauses = rxdoc~clauses
00291   now = time('R')
00292   anchored = .directory~new  -- keep track of anchored lines
00293   do c over clauses
00294     self~colourclause(c, col)
00295     if c~isreferenced
00296       then do
00297              if \anchored~hasindex(c~startline)
00298                then do
00299                       col~addpre(c~startline, 1, '<a name='c~hsrcanchor'></a>')
00300                       anchored[c~startline] = c
00301                     end
00302            end
00303  
00304   end
00305  
00306   -- add line numbers
00307   do j = 1 to col~lines~items
00308     col~lines[j]~addpre(1, '<span class="synlinecount">'j~right(5,'0')'</span> ')
00309   end
00310  
00311 -- colour clause c
00312 -- @param c - rdclause to colour
00313 -- @param col - .coloured to put colours into
00314 ::METHOD colourclause CLASS
00315   use arg c, col
00316  
00317   rexxkw    = 'ADDRESS ARG CALL DO DROP EXIT EXPOSE',
00318            || ' FORWARD GUARD IF INTERPRET ITERATE LEAVE LOOP NOP',
00319            || ' NUMERIC PARSE PULL PUSH QUEUE RAISE REPLY RETURN',
00320            || ' SAY SELECT SIGNAL TRACE USE',
00321            || ' END WHEN THEN ELSE OTHERWISE'
00322  
00323   -- decorate references with href
00324   do rf over c~references
00325     col~fcaddpre(c~flatclause, rf~token~index, '<a href="'rf~referee~hdocurl'#'rf~referee~hdocanchor'">')
00326     col~fcaddpost(c~flatclause, rf~token~index + rf~token~symbol~length-1, '</a>')
00327   end
00328  
00329   -- decorate other interesting tokens
00330   prevtok = c~tokenized~tokens[1]
00331   do t over c~tokenized~tokens
00332     select
00333       when t~type = 'symbol'
00334         then do
00335                if t~symbol~translate = 'NEW' & prevtok~type = 'twiddle'
00336                  then self~colourspan(c~flatclause, col, t~index, t~index+t~symbol~length-1, 'synclass')
00337                if t~symbol~translate = 'SELF'
00338                  then self~colourspan(c~flatclause, col, t~index, t~index+t~symbol~length-1, 'synself')
00339                if t~symbol~datatype('N')
00340                  then self~colourspan(c~flatclause, col, t~index, t~index+t~symbol~length-1, 'synnumliteral')
00341                if rexxkw~wordpos(t~symbol~translate) > 0
00342                  then do
00343                         if t~symbol~translate <> 'QUEUE' | t~index = 1
00344                           then self~colourspan(c~flatclause, col, t~index, t~index+t~symbol~length-1, 'synkeyword')
00345                       end
00346              end
00347       when t~type = 'lsbrack' | t~type = 'rsbrack'
00348         then self~colourspan(c~flatclause, col, t~index, t~index+t~symbol~length-1, 'synbracket2')
00349       when t~type = 'lmbrack' | t~type = 'rmbrack'
00350         then self~colourspan(c~flatclause, col, t~index, t~index+t~symbol~length-1, 'synbracket1')
00351       otherwise self~colourspan(c~flatclause, col, t~index, t~index+t~symbol~length-1, 'synkeyword')
00352     end
00353  
00354  
00355     prevtok = t
00356   end
00357  
00358 ::METHOD colourspan CLASS
00359   use arg fc, col, l, r, sclass
00360  
00361   col~fcaddpre(fc, l, '<span class="'sclass'">')
00362   col~fcaddpost(fc, r, '</span>')
00363  
00364