documents.cls source

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 --
00042 -- files, folders, rexx and text documents,
00043 --
00044  
00045 -- generate unique ids for html output
00046 ::REQUIRES 'hashfunction.cls'
00047  
00048 -- parse rexx
00049 ::REQUIRES 'rexxprogram.cls'
00050  
00051 -- tokenizer
00052 ::REQUIRES 'tokenizer.cls'
00053  
00054 -- fs path separator
00055 ::REQUIRES 'pathsep.cls'
00056  
00057 -- class lookup
00058 ::REQUIRES 'classfinder.cls'
00059  
00060 -- html nodes
00061 ::REQUIRES 'nodes.cls'
00062  
00063 -- flyweight to describe a doc text module
00064 ::CLASS docmodule
00065 ::ATTRIBUTE modname
00066 ::ATTRIBUTE description
00067 ::ATTRIBUTE text
00068 ::METHOD init
00069   self~text = .queue~new
00070  
00071 -- mixin for extensible objects
00072 -- and extensible object can have attributes added
00073 -- to it
00074 ::CLASS extensible MIXINCLASS object
00075  
00076 -- add an attribute
00077 -- @parm attrname - name of the attribute to add
00078 ::METHOD addattribute
00079   use arg attrname
00080   self~setmethod(attrname'=', 'expose' attrname'; use arg' attrname)
00081   self~setmethod(attrname, 'expose' attrname '; return' attrname)
00082  
00083 -- abstract class for documents
00084 --
00085 -- all documents are associated with a file object at the end
00086 -- of a path. Various tags are also provided for use in
00087 -- output document naming
00088 --
00089 ::CLASS adocument PUBLIC INHERIT extensible
00090 ::ATTRIBUTE filepath -- canonical file path
00091 ::ATTRIBUTE relpath  -- path relative to base path
00092 ::ATTRIBUTE filename -- end of file path
00093 ::ATTRIBUTE file     -- file object associated with document
00094 ::ATTRIBUTE uniqueid -- unique id for output
00095 ::ATTRIBUTE prefix   -- collapsed filename
00096 ::METHOD init
00097   use strict arg file, basepath
00098  
00099   self~file     = file
00100   self~filepath = file~folder~folderpath||file~filename
00101   self~relpath  = self~filepath~right(self~filepath~length - basepath~length+1)
00102  
00103   self~filename = file~filename
00104   self~uniqueid = .hashfunction~mod32(self~filepath, '1234')
00105   self~prefix = self~filename~translate('_','.')
00106  
00107 -- represents a rexx document
00108 -- a facade for rexxprogram, with some ids, paths and urls
00109 -- plus tokenized clauses after xref runs
00110 ::CLASS rexxdocument PUBLIC SUBCLASS adocument
00111 ::ATTRIBUTE rxprogram      -- parsed rexx program
00112 -- ::ATTRIBUTE docurlpre PUBLIC  -- the prefix of the url the doc is written as
00113 ::ATTRIBUTE cfeaturelist PRIVATE  -- code features as .rdfeature
00114 ::ATTRIBUTE clauselist PRIVATE  -- clauses as .rdclause built by xref
00115 ::ATTRIBUTE classix  -- .directory of classes as .rdclass, index name~translate
00116 ::ATTRIBUTE procix   -- .directory of procedures as .rdprocedure, index name~translate
00117 ::ATTRIBUTE routinix  -- .directory of routines as .rdprocedure, index name~translate
00118 ::ATTRIBUTE reqrefs  -- ::requires references
00119 ::ATTRIBUTE reqfiles  -- ::requires required files
00120 ::ATTRIBUTE globalix  -- .globalix global index
00121 ::ATTRIBUTE procexpose  -- procedure level expose list directory, key: exposed var, item: .rdprocedure
00122 ::ATTRIBUTE proclist  -- procedures list
00123 ::ATTRIBUTE labelix  -- label directory, key: label name, item: .rdclause
00124  
00125 -- @param file - associated file object
00126 -- @param basepath - the path to the file object
00127 -- @param globalix - global index object
00128 ::METHOD init
00129   use strict arg file, basepath, globalix
00130   self~init:super(file, basepath)
00131   self~globalix = globalix
00132   self~rxprogram = .rexxprogram~new(self~filepath)
00133   self~rxprogram~user = self -- to get back to the document from code features
00134  
00135   self~cfeaturelist = .queue~new
00136   self~clauselist = .queue~new
00137   self~classix = .directory~new
00138   self~procix = .directory~new
00139   self~routinix = .directory~new
00140   self~reqrefs = .queue~new
00141   self~reqfiles = .queue~new
00142   self~procexpose = .directory~new
00143   self~proclist = .queue~new
00144   self~labelix = .directory~new
00145  
00146   prevmethod = .nil
00147   container = .nil
00148  
00149   classlist = .queue~new -- local class list
00150  
00151   -- index classes and determine method and label containment
00152   do c over self~rxprogram~codefeatures
00153     select
00154       when c~objectname = 'LABL'
00155         then do
00156                -- set up rdlabel
00157                rf = .rdlabel~new(self, c)
00158                self~cfeaturelist~queue(rf)
00159                globalix~labels~queue(rf)
00160                self~labelix[rf~rexxname~translate] = rf
00161                -- check for label contained by previous method
00162                if prevmethod <> .nil
00163                  then do
00164                         if prevmethod~feature~contains(c)
00165                           then prevmethod~feature~ownerclass~user~methods~queue(rf)
00166                       end
00167              end
00168       when c~objectname = 'CLAS'
00169         then do
00170                -- note rdclass to contained methods and labels
00171                rf = .rdclass~new(self, c)
00172                classlist~queue(rf)
00173                self~cfeaturelist~queue(rf)
00174                globalix~classes~queue(rf)
00175                globalix~classix~put(rf, rf~rexxname~translate)
00176                self~classix~put(rf, rf~rexxname~translate)
00177                container = rf
00178              end
00179       when c~objectname = 'PROC'
00180         then do
00181                rf = .rdprocedure~new(self, c)
00182                self~cfeaturelist~queue(rf)
00183                globalix~procedures~queue(rf)
00184                self~procix~put(rf, rf~rexxname~translate)
00185                container = rf
00186              end
00187       when c~objectname = 'METH'
00188         then do
00189                rf = .rdmethod~new(self, c)
00190                rf~owner = container
00191                self~cfeaturelist~queue(rf)
00192                globalix~methods~queue(rf)
00193                globalix~methix~put(rf, rf~rexxname~translate)
00194                if c~ownerclass <> .nil
00195                  then do
00196                         c~ownerclass~user~methods~queue(rf)
00197                       end
00198                prevmethod = rf
00199              end
00200       when c~objectname = 'ATTR'
00201         then do
00202                rf = .rdattribute~new(self, c)
00203                rf~owner = container
00204                self~cfeaturelist~queue(rf)
00205                globalix~attributes~queue(rf)
00206                globalix~attrix~put(rf, rf~rexxname~translate)
00207                if c~ownerclass <> .nil
00208                  then do
00209                         c~ownerclass~user~methods~queue(rf)
00210                       end
00211              end
00212       when c~objectname = 'ROUT'
00213         then do
00214                rf = .rdprocedure~new(self, c)
00215                self~cfeaturelist~queue(rf)
00216                self~routinix~put(rf, rf~rexxname~translate)
00217                globalix~routines~queue(rf)
00218                globalix~routinix~put(rf, rf~rexxname~translate)
00219              end
00220       when c~objectname = 'REQU'
00221         then do
00222                rf = .rdrequires~new(self, c)
00223                self~cfeaturelist~queue(rf)
00224                globalix~requires~queue(rf)
00225              end
00226       when c~objectname = 'OPTS'
00227         then do
00228                rf = .rdoptions~new(self, c)
00229                self~cfeaturelist~queue(rf)
00230                globalix~options~queue(rf)
00231              end
00232       when c~objectname = 'CONS'
00233         then do
00234                rf = .rdconstant~new(self, c)
00235                rf~owner = container
00236                self~cfeaturelist~queue(rf)
00237                globalix~constants~queue(rf)
00238                globalix~constix~put(rf, rf~rexxname~translate)
00239                if c~ownerclass <> .nil
00240                  then do
00241                         c~ownerclass~user~methods~queue(rf)
00242                       end
00243              end
00244       otherwise raise SYNTAX 93 ARRAY('unknown feature' c~objectname)
00245     end
00246   end
00247  
00248   -- classify methods in the classes
00249   do cl over classlist
00250     cl~methclassify
00251   end
00252  
00253 -- @return .true - program uses OORexx
00254 -- @return .false - program uses Classic Rexx
00255 ::METHOD isoo
00256   return \self~rxprogram~procedural
00257  
00258 -- @return list of code features in the program
00259 ::METHOD featurelist
00260   return self~cfeaturelist
00261 --  return self~rxprogram~codefeatures
00262  
00263 -- get the first block comment in the program
00264 -- @return blockcomment object
00265 ::METHOD getfirstblock
00266   if self~rxprogram~blockcomments~items > 0
00267     then do
00268            bc = self~rxprogram~getsource(self~rxprogram~blockcomments[1])
00269           end
00270     else bc = .queue~new
00271  
00272   return .blockcomment~new(bc)
00273  
00274 -- get the block comment previous to the feature
00275 -- @param feature - filechunk of feature of interest
00276 -- @return blockcomment object
00277 ::METHOD getprevblock
00278   use strict arg feature
00279  
00280   prev = self~rxprogram~getprevcomment(feature)
00281   if prev = .nil
00282     then src = .nil
00283     else src = self~rxprogram~getsource(prev)
00284  
00285   return .blockcomment~new(src)
00286  
00287 -- get any available comments for feature
00288 ::METHOD getanycomment
00289   use strict arg feature
00290  
00291   bc = self~getprevblock(feature)
00292   if bc~dirty~items > 0
00293     then return bc
00294  
00295   -- ok, look for line comments
00296   src = .queue~new
00297   lc = self~rxprogram~getlinecomment(feature)
00298   if lc <> .nil
00299     then do
00300            src = self~rxprogram~getsource(lc)
00301          end
00302   return .blockcomment~new(src)
00303  
00304 -- return program source
00305 ::METHOD src
00306    return self~rxprogram~src
00307  
00308 -- return the code for a clause
00309 ::METHOD getsource
00310   use strict arg clause
00311   return self~rxprogram~getsource(clause)
00312  
00313 -- return the code for a clause, with literals set to '*'
00314 ::METHOD getnoppedsource
00315   use strict arg clause
00316   return self~rxprogram~getnoppedsource(clause)
00317  
00318 -- return all comments in document
00319 -- @return queue of rdfeatures
00320 ::METHOD comments
00321   rdfq = .queue~new
00322   do i over self~rxprogram~comments
00323     rdfq~queue(.rdfeature~new(self, i))
00324   end
00325   return rdfq
00326  
00327 -- return all comments at line
00328 -- @param lineno - line number for which to return comments
00329 -- @return queue of rdfeatures
00330 ::METHOD commentsat
00331   use strict arg lineno
00332 --  fcq = self~rxprogram~commentmap~allat(lineno)
00333   fcq = self~rxprogram~safeallat(self~rxprogram~commentmap, lineno)
00334   rdfq = .queue~new
00335   do i over fcq
00336     rdfq~queue(.rdfeature~new(self, i))
00337   end
00338   return rdfq
00339  
00340 -- return all quotes at line
00341 -- @param lineno -  line number for which to return quotes
00342 -- @return queue of rdfeatures
00343 ::METHOD quotesat
00344   use strict arg lineno
00345 --  fcq = self~rxprogram~quotemap~allat(lineno)
00346   fcq = self~rxprogram~safeallat(self~rxprogram~quotemap, lineno)
00347   rdfq = .queue~new
00348   do i over fcq
00349     rdfq~queue(.rdfeature~new(self, i))
00350   end
00351   return rdfq
00352  
00353 -- return all quotes 
00354 -- @return queue of rdfeatures
00355 ::METHOD quotes
00356   rdfq = .queue~new
00357   do i over self~rxprogram~quotes
00358     rdfq~queue(.rdfeature~new(self, i))
00359   end
00360   return rdfq
00361  
00362 -- return all features at line
00363 -- @param lineno - line number for which to return features
00364 ::METHOD featuresat
00365   use strict arg lineno
00366 --  return self~rxprogram~codefeaturemap~allat(lineno)
00367   return self~rxproram~safeallat(self~rxprogram~codefeaturemap~allat(lineno))
00368  
00369 -- return all clauses on a line
00370 -- @param lineno - line number for which to return clauses
00371 ::METHOD clausesat
00372   use strict arg lineno
00373   return self~rxprogram~getclausesat(lineno)
00374  
00375 -- return all clauses
00376 ::METHOD clauses
00377 --  rdfq = .queue~new
00378 --  do i over self~rxprogram~clauses
00379 --    rdfq~queue(.rdfeature~new(self, i))
00380 --  end
00381 --  return rdfq
00382   return self~clauselist
00383  
00384 ::METHOD mixedclauses
00385   rdfq = .queue~new
00386   do i over self~rxprogram~mixedclauses
00387     rdfq~queue(.rdfeature~new(self, i))
00388   end
00389   return rdfq
00390  
00391 -- get the first clause in a feature
00392 -- @param feature - the feature for which to return first clause
00393 ::METHOD featureclause
00394   use strict arg feature
00395  
00396   -- get all clauses on line
00397   clauses = self~rxprogram~getclausesat(feature~startline)
00398  
00399   -- decide which clause we want
00400   do i over clauses
00401     if i~startcol = feature~startcol
00402       then return i
00403   end
00404   return .nil
00405  
00406  
00407 -- return all requires clauses in the document
00408 ::METHOD requires
00409   return self~rxprogram~requires
00410  
00411 -- return next interesting feature
00412 -- @param f - codelist feature from which to commence search
00413 -- @param goodlist - list of objectnames which will terminate search
00414 -- @return feature - the following matching feature
00415 -- @return .nil - no following matching feature
00416 ::METHOD nextfeature
00417   use strict arg f, goodlist
00418   return self~rxprogram~nextfeature(f, goodlist)
00419  
00420 -- cross reference the document
00421 -- @param globalix - global index
00422 ::METHOD xref
00423   use strict arg globalix
00424  
00425   reqfiles = .queue~new
00426  
00427   -- process ::requires and develop list of
00428   -- files from which we could instantiate classes
00429   do c over self~rxprogram~requires
00430     -- get included file
00431     src = c~rname
00432     -- strip quotes
00433     q = src~left(1)
00434     if q = ''''
00435       then parse var src ''''src''''
00436     if q = '"'
00437       then parse var src '"'src'"'
00438     -- get all files with that name
00439 --    files = globalix~filix~allat(src)
00440     files = .array~new
00441     if globalix~filix~hasindex(src)
00442       then files = globalix~filix~allat(src)
00443     -- pick best match
00444     f = self~findfile(self~file, files)
00445     if f <> .nil
00446       then do
00447              -- candidate file for later
00448              reqfiles~queue(f)
00449              -- queue owning feature to xref
00450              f~document~reqrefs~queue(.reference~new(c~user, f~document, .nil, 'REQ'))
00451            end
00452       else nop -- say 'REQU:' src 'unknown'
00453  
00454   end
00455   self~reqfiles = reqfiles
00456  
00457   -- parse all clauses and find instantiations
00458  
00459   -- make a rexx tokenizer
00460   toker = .rexxtokenizer~new
00461  
00462   currowner = .nil
00463   do c over self~rxprogram~mixedclauses
00464     select
00465       when c~objectname = 'CLAU'
00466         then do
00467                -- make an rdclause for later use
00468                rdl = .rdclause~new(self, c, currowner, toker, reqfiles)
00469                self~clauselist~queue(rdl)
00470              end
00471       when c~objectname = 'CLAS',
00472          | c~objectname = 'METH',
00473          | c~objectname = 'PROC',
00474          | c~objectname = 'ROUT',
00475          | c~objectname = 'CONS'
00476           then do
00477                 currowner = c~user
00478                end
00479  
00480       otherwise nop -- say c~objectname c~rname
00481     end
00482   end
00483  
00484  
00485   -- xref class hierarchy and exposed variables
00486   do cl over self~classix
00487     self~classix[cl]~xrefinheritance(reqfiles)
00488     self~classix[cl]~xrefexposed
00489   end
00490  
00491   -- xref procedures and exposed vars
00492   do p over self~procix
00493     pl = self~procix[p]
00494     self~proclist~queue(pl)
00495     texpose = pl~exposelist
00496     do while texpose~words > 0
00497       parse var texpose exposed texpose
00498       if \self~procexpose~hasindex(exposed)
00499         then self~procexpose[exposed] = .queue~new
00500       self~procexpose[exposed]~queue(pl)
00501     end
00502   end
00503  
00504  
00505  
00506   return
00507  
00508 -- discover which file in files is closest to f by path
00509 -- @param f - a file
00510 -- @param files - a queue of files
00511 -- @return a file or .nil
00512 ::METHOD findfile
00513   use strict arg f, files
00514   if files~items = 0
00515     then return .nil
00516  
00517   if files~items = 1
00518     then return files[1]
00519  
00520   -- try for same folder
00521   do i over files
00522     if f~folder~folderpath = i~folder~folderpath
00523       then return i
00524   end
00525  
00526   -- try for subfolder
00527   do i over files
00528     if f~folder~folderpath = i~folder~folderpath~left(f~folder~folderpath~length)
00529       then return i
00530   end
00531  
00532   -- give up and return the first one
00533   return files[1]
00534  
00535 -- abstract class to represent something in a rexx program
00536 ::CLASS rdatom PUBLIC INHERIT extensible
00537 ::ATTRIBUTE document PUBLIC -- owner rexxdocument
00538 ::ATTRIBUTE feature PUBLIC -- filechunk of the feature
00539  
00540 ::METHOD init
00541   use strict arg document, feature
00542   self~document = document
00543   self~feature = feature
00544  
00545 -- type of the atom
00546 ::METHOD type
00547   return self~feature~objectname
00548  
00549 -- start column
00550 ::METHOD startcol
00551   return self~feature~startcol
00552  
00553 -- end column
00554 ::METHOD endcol
00555   return self~feature~endcol
00556  
00557 -- start line
00558 ::METHOD startline
00559   return self~feature~startline
00560  
00561 -- end line
00562 ::METHOD endline
00563   return self~feature~endline
00564  
00565 -- class to represent a clause in a rexx program
00566 ::CLASS rdclause PUBLIC SUBCLASS rdatom
00567 ::ATTRIBUTE owner -- containing rdfeature
00568 ::ATTRIBUTE flatclause -- the clause as a flat clause, strings nopped for easy parse
00569 ::ATTRIBUTE tokenized -- token list of the flat clause
00570 ::ATTRIBUTE isreferenced    -- when true, clause has been referenced
00571 ::ATTRIBUTE references  -- references within this clause
00572  
00573 -- @param document - containing document
00574 -- @param feature  - filechunk of this feature
00575 -- @param docurl   - url of the document
00576 -- @param owner    - containing feature
00577 -- @param tokenizer - a rexx tokenizer
00578 -- @param reqfiles - queue of candidate files in which to look up possible instantiations
00579 ::METHOD init
00580   use strict arg document, feature, owner, tokenizer, reqfiles
00581   self~init:super(document, feature)
00582  
00583   self~owner = owner
00584  
00585   src = self~document~getnoppedsource(self~feature)
00586   self~flatclause = .flatclause~new(self~feature, src)
00587  
00588   self~tokenized = tokenizer~toke(self~flatclause~flat)
00589   self~isreferenced = .false
00590   self~references = .queue~new
00591  
00592  
00593   -- look for instantiations in the token list
00594   tkl = self~tokenized~tokens
00595  
00596   do j = 1 to tkl~items
00597     tk = tkl[j]
00598  
00599     -- look for a dot, call to a class method
00600     if tk~type = 'dot'
00601       then do
00602              -- detect stem variable dots
00603              -- dot in pos 1 is not a stem
00604              if j <> 1
00605                 then do
00606                        if tkl[j-1]~type = 'symbol'
00607                         -- it's a stem dot, ignore
00608                          then iterate
00609                      end
00610  
00611              if j + 3 > tkl~items
00612                 -- not enough tokens, ignore
00613                 then iterate
00614  
00615              select
00616                 -- if the next tokens are ~new then it's an instantiation
00617                 when tkl[j+2]~type = 'twiddle',
00618                       & tkl[j+3]~symbol~translate = 'NEW'
00619                   then do
00620                           -- mark instantiation
00621                           self~instantiation(reqfiles, tkl[j+1])
00622                        end
00623                  -- or a class method
00624                 when tkl[j+2]~type = 'twiddle'
00625                    then do
00626                           -- mark class method
00627                           self~classmethod(reqfiles, tkl[j+1], tkl[j+3])
00628                         end
00629                 otherwise nop
00630              end
00631            end
00632  
00633     -- look for procedure or routine call
00634     if tk~type = 'symbol' & tk~symbol~translate = 'CALL'
00635       then do
00636              self~procedurecall(tkl[j+2])
00637            end
00638     if tk~type = 'lmbrack' 
00639       then do
00640              self~procedurecall(tkl[j-1])
00641            end
00642  
00643     -- do we want to cross-reference methods?
00644     if \self~document~globalix~dynamicmethods
00645       then iterate
00646  
00647     -- cross reference methods in the token list
00648     if tkl[j]~type = 'twiddle' & j <> 1 & j <> tkl~items
00649       then do
00650              if j > 2
00651                then do
00652                       -- exclude static references
00653                       if tkl[j-2]~type = 'dot'
00654                         then iterate
00655                     end
00656              recvr = tkl[j-1]~symbol~translate
00657              meth  = tkl[j+1]~symbol~translate
00658              self~methodreference(recvr, meth, tkl[j+1])
00659            end
00660   end
00661  
00662 -- analyze a procedure or routine call
00663 -- @param rtk  - class token of procedure or routine name
00664 ::METHOD procedurecall PRIVATE
00665   use strict arg rtk
00666   procname = rtk~symbol~translate
00667  
00668   if procname = 'LOOFAH' then trace ?i
00669  
00670   rdp = self~document~procix[procname]
00671   if rdp = .nil
00672     then do
00673            rdp = self~document~labelix[procname]
00674            if rdp \= .nil
00675              then do
00676                     -- found called procedure in label list: promote
00677                     self~document~procix[procname] = rdp
00678                     self~document~proclist~queue(rdp)
00679                   end
00680          end
00681  
00682   if rdp = .nil
00683     then do
00684            rdp = .classfinder~findroutine(procname, self~document, self~document~reqfiles)
00685          end
00686  
00687   if rdp <> .nil
00688     then do
00689            self~isreferenced = .true
00690            rf =.reference~new(self, rdp, rtk, 'PROC')
00691            self~references~queue(rf)
00692            rdp~callrefs~queue(rf)
00693          end
00694 -- analyze a dynamic reference
00695 -- @param recvr - receiver
00696 -- @param meth  - message (method) name
00697 -- @param token  - token of message (method) name
00698 ::METHOD methodreference PRIVATE
00699   use strict arg recvr, meth, token
00700  
00701  
00702   -- ignore static references
00703   if recvr~left(1) = '.'
00704     then return
00705  
00706   if recvr~translate = 'SELF' 
00707     then do
00708             -- look in container class hierarchy
00709             containermethod = self~owner
00710             containerclass = .nil
00711             if containermethod <> .nil 
00712               then containerclass = containermethod~owner
00713             if containerclass = .nil
00714               then return
00715  
00716             rdm = self~findmethod(containerclass, meth)
00717             if rdm <> .nil
00718               then do
00719                      self~isreferenced = .true
00720                      rf  = .reference~new(self, rdm, token, 'DREF')
00721                      rdm~dynrefs~queue(rf)
00722                      self~references~queue(rf)
00723                    end
00724  
00725             return
00726          end
00727  
00728   -- look in global methods
00729   rdma = self~document~globalix~methix~allat(meth)
00730   do rdm over rdma
00731     if \rdm~public | rdm~cclass
00732       then iterate
00733     if rdm~owner <> .nil
00734       then if \rdm~owner~public
00735              then iterate
00736     self~isreferenced = .true
00737     rf =.reference~new(self, rdm, token, 'DREF')
00738     rdm~dynrefs~queue(rf)
00739     self~references~queue(rf)
00740   end
00741  
00742   -- look in global attributes
00743   rdma = self~document~globalix~attrix~allat(meth)
00744   do rdm over rdma
00745     if \rdm~public | rdm~cclass
00746       then iterate
00747     if rdm~owner <> .nil
00748       then if \rdm~owner~public
00749              then iterate
00750     self~isreferenced = .true
00751     rf =.reference~new(self, rdm, token, 'DREF')
00752     rdm~dynrefs~queue(rf)
00753     self~references~queue(rf)
00754   end
00755  
00756 -- local a method in class hierarchy
00757 -- @param rdc -  .rdclass root of class hierarchy
00758 -- @param methodname - name of method for which to search
00759 -- @return .rdmethod or .nil
00760 ::METHOD findmethod PRIVATE
00761   use arg rdc, methodname
00762  
00763 --  if methodname = 'BUFFER'
00764 --    then trace ?i
00765  
00766   do rdm over rdc~methods
00767     if rdm~feature~rname~translate = methodname
00768       then return rdm
00769   end
00770  
00771   if rdc~inherit <> ''
00772     then do
00773             mixins = rdc~inherit~space(1)~makearray(' ')
00774             do m over mixins
00775               irdc = self~document~globalix~classix~at(m~translate)
00776               if irdc <> .nil
00777                 then do
00778                        rdm = self~findmethod(irdc, methodname)
00779                        if rdm <> .nil
00780                          then return rdm
00781                      end
00782             end
00783           end
00784  
00785   if rdc~mixinclass <> ''
00786      then do
00787             mrdc = self~document~globalix~classix~at(rdc~mixinclass~translate)
00788             if mrdc <> .nil
00789               then do
00790                      rdm = self~findmethod(mrdc, methodname)
00791                      if rdm <> .nil
00792                        then return rdm
00793                    end
00794           end
00795  
00796   if rdc~subclass <> ''
00797     then do
00798            srdc = self~document~globalix~classix~at(rdc~subclass~translate)
00799            if srdc <> .nil
00800              then do
00801                     rdm = self~findmethod(srdc, methodname)
00802                     if rdm <> .nil
00803                       then return rdm
00804                   end
00805          end
00806  
00807  
00808   return .nil
00809  
00810  
00811 -- analyze and cross-reference an instantiation
00812 -- @param reqfiles - queue of candidate files in which to look up possible instantiations
00813 -- @param token - token object for class name
00814 ::METHOD instantiation PRIVATE
00815   use strict arg reqfiles, token
00816  
00817   classname = token~symbol~translate
00818  
00819   -- have we heard of it?
00820   rdc = .classfinder~findclass(classname, self~document, reqfiles)
00821  
00822   if rdc <> .nil
00823     then do
00824            -- queue reference for class documentation
00825            rf = .reference~new(self, rdc, token, 'INST')
00826            rdc~instrefs~queue(rf)
00827            self~references~queue(rf)
00828            -- anchor this clause in source listing and set reference to instantiated class
00829            self~isreferenced = .true
00830          end
00831  
00832 -- analyze and cross-reference class method use
00833 -- @param reqfiles - queue of candidate files in which to look up possible declarations
00834 -- @param classtoken - token object for class name
00835 -- @param methtoken - token object for method name
00836 ::METHOD classmethod PRIVATE
00837   use strict arg reqfiles, classtoken, methtoken
00838  
00839   classname = classtoken~symbol~translate
00840  
00841   -- have we heard of it?
00842   rdc = .classfinder~findclass(classname, self~document, reqfiles)
00843  
00844   if rdc <> .nil
00845     then do
00846            -- record static reference to class method
00847            methname = methtoken~symbol~translate
00848            do m over rdc~cpubmethods
00849               if m~rexxname~translate = methname
00850                 then do
00851                        rf = .reference~new(self, m, methtoken, 'CMTH')
00852                        m~statrefs~queue(rf)
00853                        self~references~queue(rf)
00854                        leave
00855                      end
00856            end
00857            do m over rdc~cpubattribs
00858               if m~rexxname~translate = methname
00859                 then do
00860                        rf = .reference~new(self, m, methtoken, 'CMTH')
00861                        m~statrefs~queue(rf)
00862                        self~references~queue(rf)
00863                        leave
00864                      end
00865            end
00866            -- anchor this clause in source listing and set reference to instantiated class
00867            self~isreferenced = .true
00868          end
00869  
00870 -- locate declaration of class
00871 -- @param reqfiles - queue of candidate files in which to look up possible declarations
00872 -- @param classname - target class name, uppercase
00873 -- @return class object
00874 -- @return .nil - can't locate class object
00875 ::METHOD findclass PRIVATE
00876   use strict arg reqfiles, classname
00877  
00878   rdc = .nil
00879   if self~document~classix~hasindex(classname)
00880     then do
00881             -- class is in this file
00882             rdc = self~document~classix[classname]
00883          end
00884     else do
00885            do f over reqfiles
00886              if f~document~classix~hasindex(classname)
00887                then do
00888                       -- class is in other file
00889                       rdc = f~document~classix[classname]
00890                       leave
00891                     end
00892            end
00893          end
00894   return rdc
00895  
00896 -- class to represent a feature in a document context,
00897 -- provides a complete facade to filechunk of feature
00898 ::CLASS rdfeature PUBLIC SUBCLASS rdatom inherit Comparable
00899  
00900 ::METHOD init
00901   use strict arg document, feature
00902   self~init:super(document, feature)
00903  
00904   -- chain back to me
00905   feature~user = self
00906  
00907  
00908 ::METHOD rexxname
00909   if self~feature~objectname = 'COMT' | self~feature~objectname = 'QUOT'
00910     then return 'LITS'
00911   if self~feature~objectname = 'REQU' 
00912     then do
00913            rq = self~feature~rname
00914            if rq~left(1) = ''''
00915              then parse var rq '''' rq ''''
00916            if rq~left(1) = '"'
00917              then parse var rq '"' rq '"'
00918            return rq
00919          end
00920  
00921   return self~feature~rname
00922  
00923 ::METHOD arglist
00924   return ''
00925  
00926 ::METHOD exposelist
00927   return ''
00928  
00929 ::METHOD public
00930   return .false
00931  
00932 ::METHOD guarded
00933   return .false
00934  
00935 ::METHOD protected
00936   return .false
00937  
00938 ::METHOD abstract
00939   return .false
00940  
00941 ::METHOD cclass
00942   return .false
00943  
00944 ::METHOD ownerclass
00945   return .nil
00946  
00947 ::METHOD metaclass
00948   return ''
00949  
00950 ::METHOD mixinclass
00951   return ''
00952  
00953 ::METHOD subclass
00954   return ''
00955  
00956 ::METHOD inherit
00957   return ''
00958  
00959 /*
00960 ::METHOD arglist
00961   if self~type <> 'METH' & self~type <> 'PROC' & self~type <> 'ROUT'
00962     then return ''
00963   return self~feature~arglist
00964  
00965 ::METHOD exposelist
00966   if self~type <> 'METH' & self~type <> 'PROC'
00967     then return ''
00968   return self~feature~exposelist
00969  
00970 ::METHOD public
00971   if self~type <> 'METH' & self~type <> 'ATTR' & self~type <> 'CLAS' & self~type <> 'ROUT'
00972     then return .false
00973   return self~feature~public
00974  
00975 ::METHOD guarded
00976   if self~type <> 'METH' & self~type <> 'ATTR'
00977     then return .false
00978   return self~feature~guarded
00979  
00980 ::METHOD protected
00981   if self~type <> 'METH' & self~type <> 'ATTR'
00982     then return .false
00983   return self~feature~protected
00984  
00985 ::METHOD abstract
00986   if self~type <> 'METH' & self~type <> 'ATTR'
00987     then return .false
00988   return self~feature~abstract
00989  
00990 ::METHOD cclass
00991   if self~type <> 'METH' & self~type <> 'ATTR'
00992     then return .false
00993   return self~feature~cclass
00994  
00995 ::METHOD ownerclass
00996   if self~type <> 'METH' & self~type <> 'ATTR' & self~type <> 'CONS'
00997     then return .nil
00998   return self~feature~ownerclass~user
00999  
01000 ::METHOD metaclass
01001   if self~type <> 'CLAS' 
01002     then return ''
01003   return self~feature~metaclass
01004  
01005 ::METHOD mixinclass
01006   if self~type <> 'CLAS' 
01007     then return ''
01008   return self~feature~mixinclass
01009  
01010 ::METHOD subclass
01011   if self~type <> 'CLAS' 
01012     then return ''
01013   return self~feature~subclass
01014  
01015 ::METHOD inherit
01016   if self~type <> 'CLAS' 
01017     then return ''
01018   return self~feature~inherit
01019 */
01020  
01021 -- comparison routine for Comparable
01022 -- @param other - rdfeature with which to compare
01023 -- @return -1 self less than other
01024 -- @return 0 self equal other
01025 -- @return 1 self greater than other
01026 ::METHOD compareTo
01027   use arg other
01028   if other~feature~rname > self~feature~rname
01029     then return -1
01030   if other~feature~rname < self~feature~rname
01031     then return 1
01032   return 0
01033  
01034 -- specialised rdfeature to represent a class within a rexx document
01035 ::CLASS rdclass PUBLIC SUBCLASS rdfeature
01036 ::ATTRIBUTE methods    -- contained rdfeatures
01037 ::ATTRIBUTE pubmethods -- public methods
01038 ::ATTRIBUTE primethods -- private methods
01039 ::ATTRIBUTE pubattribs -- public attributes
01040 ::ATTRIBUTE priattribs -- private attributes
01041 ::ATTRIBUTE pubconsts  -- public constants
01042 ::ATTRIBUTE priconsts  -- private constants
01043 ::ATTRIBUTE cpubmethods -- class public methods
01044 ::ATTRIBUTE cprimethods -- class private methods
01045 ::ATTRIBUTE cpubattribs -- class public attributes
01046 ::ATTRIBUTE cpriattribs -- class private attributes
01047 ::ATTRIBUTE cpubconsts  -- class public constants
01048 ::ATTRIBUTE cpriconsts  -- class private constants
01049 ::ATTRIBUTE instrefs  -- instantiation references
01050 ::ATTRIBUTE subclassedby -- subclass references
01051 ::ATTRIBUTE inheritedby -- inherit references
01052 ::ATTRIBUTE mixedinby -- mixin references references
01053 ::ATTRIBUTE exposedvars -- exposed variable directory key: exposed variable name, item: queue of methods
01054  
01055 ::ATTRIBUTE classified -- when .true, methods have been classified
01056  
01057 ::METHOD init
01058   use strict arg document, feature
01059   self~init:super(document, feature)
01060  
01061  
01062   self~methods = .queue~new
01063   self~pubmethods = .queue~new
01064   self~primethods = .queue~new
01065   self~pubattribs = .queue~new
01066   self~priattribs = .queue~new
01067   self~pubconsts  = .queue~new
01068   self~priconsts  = .queue~new
01069   self~cpubmethods = .queue~new
01070   self~cprimethods = .queue~new
01071   self~cpubattribs = .queue~new
01072   self~cpriattribs = .queue~new
01073   self~cpubconsts  = .queue~new
01074   self~cpriconsts  = .queue~new
01075   self~instrefs = .queue~new
01076   self~subclassedby = .queue~new
01077   self~inheritedby = .queue~new
01078   self~mixedinby = .queue~new
01079   self~exposedvars = .directory~new
01080   self~classified = .false
01081  
01082  
01083  
01084 -- classify methods in this class
01085 ::METHOD methclassify
01086  
01087   if self~classified
01088     then return
01089   self~classified = .true
01090  
01091   do m over self~methods
01092     select
01093       when m~type = 'LABL'
01094         then iterate
01095       when m~type = 'METH' & m~public & m~cclass
01096         then self~cpubmethods~queue(m)
01097       when m~type = 'METH' & \m~public & m~cclass
01098         then self~cprimethods~queue(m)
01099       when m~type = 'ATTR' & m~public & m~cclass
01100         then self~cpubattribs~queue(m)
01101       when m~type = 'ATTR' & \m~public & m~cclass
01102         then self~cpriattribs~queue(m)
01103       when m~type = 'CONS' & m~public & m~cclass
01104         then self~cpubconsts~queue(m)
01105       when m~type = 'CONS' & \m~public & m~cclass
01106         then self~cpriconsts~queue(m)
01107       when m~type = 'METH' & m~public & \m~cclass
01108         then self~pubmethods~queue(m)
01109       when m~type = 'METH' & \m~public & \m~cclass
01110         then self~primethods~queue(m)
01111       when m~type = 'ATTR' & m~public & \m~cclass
01112         then self~pubattribs~queue(m)
01113       when m~type = 'ATTR' & \m~public & \m~cclass
01114         then self~priattribs~queue(m)
01115       when m~type = 'CONS' & m~public & \m~cclass
01116         then self~pubconsts~queue(m)
01117       when m~type = 'CONS' & \m~public & \m~cclass
01118         then self~priconsts~queue(m)
01119       otherwise raise SYNTAX 93 ARRAY('unknown feature' m)
01120     end
01121   end
01122  
01123 -- crossreference inheritance
01124 -- @param reqfiles - list of files in ::REQUIRES list
01125 -- @post inheritance lists complete
01126 ::METHOD xrefinheritance
01127   use arg reqfiles
01128  
01129   if self~feature~subclass <> ''
01130     then do
01131            rdc = .classfinder~findclass(self~feature~subclass~translate, self~document, self~document~reqfiles)
01132            if rdc <> .nil
01133              then rdc~subclassedby~queue(self)
01134          end
01135  
01136   if self~feature~mixinclass <> ''
01137     then do
01138            rdc = .classfinder~findclass(self~feature~mixinclass~translate, self~document, self~document~reqfiles)
01139            if rdc <> .nil
01140              then rdc~mixedinby~queue(self)
01141          end
01142  
01143   if self~feature~inherit <> ''
01144     then do
01145            do j = 1 to words(self~feature~inherit)
01146              iclass = self~feature~inherit~word(j)~translate
01147              rdc = .classfinder~findclass(iclass, self~document, self~document~reqfiles)
01148              if rdc <> .nil
01149                then rdc~inheritedby~queue(self)
01150            end
01151          end
01152  
01153 -- crossreference exposed variables
01154 ::METHOD xrefexposed
01155  
01156   do m over self~methods
01157     if m~exposelist~words = 0
01158       then iterate
01159     do j = 1 to m~exposelist~words
01160       ev = m~exposelist~word(j)
01161       if \self~exposedvars~hasindex(ev)
01162         then self~exposedvars[ev] = .queue~new
01163       self~exposedvars[ev]~queue(m)
01164     end
01165   end
01166  
01167 ::METHOD public
01168   return self~feature~public
01169  
01170 ::METHOD metaclass
01171   return self~feature~metaclass
01172  
01173 ::METHOD mixinclass
01174   return self~feature~mixinclass
01175  
01176 ::METHOD subclass
01177   return self~feature~subclass
01178  
01179 ::METHOD inherit
01180   return self~feature~inherit
01181  
01182 ::METHOD largeicon
01183   select
01184     when self~public
01185       then return .nodes~rclas
01186     when \self~public
01187       then return .nodes~rclasp
01188     otherwise return .nil
01189   end
01190  
01191 ::METHOD smallicon
01192   select
01193     when self~public
01194       then return .nodes~rsclas
01195     when \self~public
01196       then return .nodes~rsclasp
01197     otherwise return .nil
01198   end
01199  
01200 -- specialised rdfeature to represent a method within a rexx document
01201 ::CLASS rdmethod PUBLIC SUBCLASS rdfeature
01202 ::ATTRIBUTE statrefs   -- static references
01203 ::ATTRIBUTE dynrefs    -- dynamic references
01204 ::ATTRIBUTE owner      -- containing .rdclass or .nil
01205  
01206 ::METHOD init
01207   use strict arg document, feature
01208   self~init:super(document, feature)
01209   self~statrefs = .queue~new
01210   self~dynrefs = .queue~new
01211   self~owner = .nil
01212  
01213 ::METHOD arglist
01214   return self~feature~arglist
01215  
01216 ::METHOD exposelist
01217   return self~feature~exposelist
01218  
01219 ::METHOD public
01220   return self~feature~public
01221  
01222 ::METHOD guarded
01223   return self~feature~guarded
01224  
01225 ::METHOD protected
01226   return self~feature~protected
01227  
01228 ::METHOD abstract
01229   return self~feature~abstract
01230  
01231 ::METHOD cclass
01232   return self~feature~cclass
01233  
01234 ::METHOD ownerclass
01235   return self~feature~ownerclass~user
01236  
01237 ::METHOD largeicon
01238   select
01239     when self~public & \self~cclass & self~guarded & \self~abstract
01240       then return .nodes~rmeth
01241     when self~public & \self~cclass & self~guarded & self~abstract
01242       then return .nodes~rmetha
01243     when self~public & \self~cclass & \self~guarded & \self~abstract
01244       then return .nodes~rmethu
01245     when self~public & \self~cclass & \self~guarded & self~abstract
01246       then return .nodes~rmethua
01247     when self~public & self~cclass & self~guarded & \self~abstract
01248       then return .nodes~rmethc
01249     when self~public & self~cclass & self~guarded & self~abstract
01250       then return .nodes~rmethca
01251     when self~public & self~cclass & \self~guarded & \self~abstract
01252       then return .nodes~rmethcu
01253     when self~public & self~cclass & \self~guarded & self~abstract
01254       then return .nodes~rmethcua
01255     when \self~public & \self~cclass & self~guarded & \self~abstract
01256       then return .nodes~rmethp
01257     when \self~public & \self~cclass & self~guarded & self~abstract
01258       then return .nodes~rmethpa
01259     when \self~public & \self~cclass & \self~guarded & \self~abstract
01260       then return .nodes~rmethpu
01261     when \self~public & \self~cclass & \self~guarded & self~abstract
01262       then return .nodes~rmethpua
01263     when \self~public & self~cclass & self~guarded & \self~abstract
01264       then return .nodes~rmethpc
01265     when \self~public & self~cclass & self~guarded & self~abstract
01266       then return .nodes~rmethpca
01267     when \self~public & self~cclass & \self~guarded & \self~abstract
01268       then return .nodes~rmethpcu
01269     when \self~public & self~cclass & \self~guarded & self~abstract
01270       then return .nodes~rmethpcua
01271     otherwise return .nil
01272   end
01273  
01274 ::METHOD smallicon
01275   select
01276     when self~public & \self~cclass & self~guarded & \self~abstract
01277       then return .nodes~rsmeth
01278     when self~public & \self~cclass & self~guarded & self~abstract
01279       then return .nodes~rsmetha
01280     when self~public & \self~cclass & \self~guarded & \self~abstract
01281       then return .nodes~rsmethu
01282     when self~public & \self~cclass & \self~guarded & self~abstract
01283       then return .nodes~rsmethua
01284     when self~public & self~cclass & self~guarded & \self~abstract
01285       then return .nodes~rsmethc
01286     when self~public & self~cclass & self~guarded & self~abstract
01287       then return .nodes~rsmethca
01288     when self~public & self~cclass & \self~guarded & \self~abstract
01289       then return .nodes~rsmethcu
01290     when self~public & self~cclass & \self~guarded & self~abstract
01291       then return .nodes~rsmethcua
01292     when \self~public & \self~cclass & self~guarded & \self~abstract
01293       then return .nodes~rsmethp
01294     when \self~public & \self~cclass & self~guarded & self~abstract
01295       then return .nodes~rsmethpa
01296     when \self~public & \self~cclass & \self~guarded & \self~abstract
01297       then return .nodes~rsmethpu
01298     when \self~public & \self~cclass & \self~guarded & self~abstract
01299       then return .nodes~rsmethpua
01300     when \self~public & self~cclass & self~guarded & \self~abstract
01301       then return .nodes~rsmethpc
01302     when \self~public & self~cclass & self~guarded & self~abstract
01303       then return .nodes~rsmethpca
01304     when \self~public & self~cclass & \self~guarded & \self~abstract
01305       then return .nodes~rsmethpcu
01306     when \self~public & self~cclass & \self~guarded & self~abstract
01307       then return .nodes~rsmethpcua
01308     otherwise return .nil
01309   end
01310  
01311 ::CLASS rdattribute PUBLIC SUBCLASS rdmethod
01312  
01313 ::METHOD exposelist
01314   return ''
01315  
01316 ::METHOD largeicon
01317   select
01318     when self~public & \self~cclass & self~guarded
01319       then return .nodes~rattr
01320     when self~public & \self~cclass & \self~guarded
01321       then return .nodes~rattru
01322     when self~public & self~cclass & self~guarded
01323       then return .nodes~rattrc
01324     when self~public & self~cclass & \self~guarded
01325       then return .nodes~rattrcu
01326     when \self~public & \self~cclass & self~guarded
01327       then return .nodes~rattrp
01328     when \self~public & \self~cclass & \self~guarded
01329       then return .nodes~rattrpu
01330     when \self~public & self~cclass & self~guarded
01331       then return .nodes~rattrpc
01332     when \self~public & self~cclass & \self~guarded
01333       then return .nodes~rattrpcu
01334     otherwise return .nil
01335   end
01336  
01337 ::METHOD smallicon
01338   select
01339     when self~public & \self~cclass & self~guarded
01340       then return .nodes~rsattr
01341     when self~public & \self~cclass & \self~guarded
01342       then return .nodes~rsattru
01343     when self~public & self~cclass & self~guarded
01344       then return .nodes~rsattrc
01345     when self~public & self~cclass & \self~guarded
01346       then return .nodes~rsattrcu
01347     when \self~public & \self~cclass & self~guarded
01348       then return .nodes~rsattrp
01349     when \self~public & \self~cclass & \self~guarded
01350       then return .nodes~rsattrpu
01351     when \self~public & self~cclass & self~guarded
01352       then return .nodes~rsattrpc
01353     when \self~public & self~cclass & \self~guarded
01354       then return .nodes~rsattrpcu
01355     otherwise return .nil
01356   end
01357  
01358 ::CLASS rdconstant PUBLIC SUBCLASS rdmethod
01359 ::METHOD exposelist
01360   return ''
01361  
01362 ::METHOD ownerclass
01363   return self~feature~ownerclass~user
01364  
01365  
01366 ::CLASS rdrequires PUBLIC SUBCLASS rdfeature
01367  
01368 ::METHOD largeicon
01369   return .nodes~rrequ
01370 ::METHOD smallicon
01371   return .nodes~rsrequ
01372  
01373 ::CLASS rdoptions PUBLIC SUBCLASS rdfeature
01374  
01375 ::METHOD largeicon
01376   return .nodes~ropti
01377 ::METHOD smallicon
01378   return .nodes~rsopti
01379  
01380 -- specialised rdfeature to represent a callable feature
01381 ::CLASS rdcallable PUBLIC SUBCLASS rdfeature
01382 ::ATTRIBUTE callrefs   -- call references
01383  
01384 ::METHOD init
01385   use strict arg document, feature
01386   self~init:super(document, feature)
01387   self~callrefs = .queue~new
01388  
01389  
01390 -- specialised rdfeature to represent a procedure within a rexx document
01391 ::CLASS rdprocedure PUBLIC SUBCLASS rdcallable
01392  
01393 ::METHOD arglist
01394   return self~feature~arglist
01395  
01396 ::METHOD exposelist
01397   return self~feature~exposelist
01398  
01399 ::METHOD largeicon
01400   return .nodes~rproc
01401 ::METHOD smallicon
01402   return .nodes~rsproc
01403  
01404 ::CLASS rdlabel PUBLIC SUBCLASS rdcallable
01405  
01406 ::METHOD largeicon
01407   return .nodes~rlabe
01408 ::METHOD smallicon
01409   return .nodes~rslabe
01410  
01411 ::CLASS rdroutine PUBLIC SUBCLASS rdcallable
01412  
01413 ::METHOD arglist
01414   return self~feature~arglist
01415  
01416 ::METHOD public
01417   return self~feature~public
01418  
01419 ::METHOD largeicon
01420   select
01421     when self~public
01422       then return .nodes~rrout
01423     when \self~public
01424       then return .nodes~rroutp
01425     otherwise return .nil
01426   end
01427 ::METHOD smallicon
01428   select
01429     when self~public
01430       then return .nodes~rsrout
01431     when \self~public
01432       then return .nodes~rsroutp
01433     otherwise return .nil
01434   end
01435  
01436 -- represents a text document
01437 ::CLASS textdocument PUBLIC SUBCLASS adocument
01438 ::ATTRIBUTE text          -- lines of text file
01439 ::ATTRIBUTE rexxdoc       -- any contained rexxdocs
01440 ::ATTRIBUTE moddoc        -- any contained module docs
01441  
01442 ::METHOD init
01443   use strict arg file, basepath, rexxdoc, modules
01444   self~init:super(file, basepath)
01445  
01446   s = .stream~new(self~filepath)
01447   self~text = s~arrayin
01448   s~close
01449  
01450   -- locate any rexxdoc docs in the text file
01451   self~rexxdoc = .queue~new
01452   self~moddoc = .directory~new
01453  
01454   self~finddocs(rexxdoc, modules, file)
01455  
01456 -- extract any rexx docs in a text file
01457 ::METHOD finddocs PRIVATE
01458   use arg rexxdoc, modules, file
01459  
01460   startdoc = '/**'
01461   enddoc = '*/'
01462   currq = rexxdoc
01463   indoc = .false
01464  
01465   do i over self~text
01466     select
01467       when i~words = 0 
01468         then do
01469                if indoc
01470                  then currq~queue(i)
01471              end
01472       when i~word(1) = startdoc
01473         then do
01474                parse var i . sd
01475                if sd~words > 0
01476                  then do
01477                          parse var sd modkey sd
01478                          if \modules~hasindex(modkey~translate)
01479                            then do
01480                                   m = .docmodule~new
01481                                   m~modname = modkey
01482                                   m~description = sd
01483                                   modules[modkey~translate] = m
01484                                   currq = m~text
01485                                 end
01486                            else do
01487                                   m = modules[modkey~translate]
01488                                   currq = m~text
01489                                 end
01490                       end
01491  
01492                  else do
01493                         currq = rexxdoc
01494                         currq~queue(sd)
01495                       end
01496                indoc = .true
01497              end
01498       when i~word(i~words) = enddoc & indoc
01499         then do
01500                parse value i~reverse with . sd
01501                currq~queue(sd~reverse)
01502                indoc = .false
01503              end
01504       when indoc
01505         then do
01506                currq~queue(i)
01507              end
01508       otherwise nop
01509     end
01510   end
01511  
01512 -- represents a parsed block comment
01513 ::CLASS blockcomment PUBLIC
01514 ::ATTRIBUTE rexxdoc -- when .true the comment is prefixed /** 
01515 ::ATTRIBUTE text    -- cleaned text of comment
01516 ::ATTRIBUTE parms   -- parameters
01517 ::ATTRIBUTE returns -- return values
01518 ::ATTRIBUTE pres    -- preconditions
01519 ::ATTRIBUTE posts   -- postconditions
01520 ::ATTRIBUTE dirty   -- original text of comment
01521  
01522 -- create parsed block comment
01523 -- @param dirty - a queue of raw block comment from the code
01524 ::METHOD init
01525   use arg dirty
01526  
01527   self~text = .queue~new
01528   self~parms = .queue~new
01529   self~returns = .queue~new
01530   self~pres = .queue~new
01531   self~posts = .queue~new
01532   self~rexxdoc = .false
01533   if dirty = .nil
01534     then do
01535            self~dirty = .queue~new
01536            return
01537          end
01538  
01539   self~dirty = dirty
01540  
01541   inblock = .false
01542   blockstart = '/*'
01543   rblockstart = '/**'
01544   blockend = '*/'
01545   linestart = '--'
01546  
01547   do d over dirty
01548     if d = blockstart||blockend
01549       then do
01550              self~text~queue('')
01551              iterate
01552            end
01553     if d~length < 2
01554       then do
01555              self~text~queue(d)
01556              iterate
01557            end
01558  
01559     -- two char lookbehind buffer
01560     lookback = .CircularQueue~new(2)
01561     newd = ''
01562     do while d~length > 0
01563       parse var d 1 c 2 lookahead 3 d
01564       d = lookahead||d
01565  
01566       lookback~queue(c)
01567  
01568       if \inblock & lookback~string('') = blockstart
01569         then do
01570                inblock = .true
01571                if lookback~string('') || lookahead = rblockstart
01572                  then do
01573                         self~rexxdoc = .true
01574                         parse var d 1 . 2 d
01575                       end
01576                newd = left(newd, newd~length-1)
01577                iterate
01578              end
01579       if inblock & lookback~string('') = blockend
01580         then do
01581                inblock = .false
01582                newd = left(newd, newd~length-1)
01583                iterate
01584              end
01585       if \inblock & lookback~string('') = linestart
01586         then do
01587                newd = left(newd, newd~length-1)
01588                newd = newd||d
01589                d = ''
01590                iterate
01591              end
01592  
01593       newd = newd || c
01594     end
01595  
01596     parse var newd prefix parmo
01597  
01598     self~text~queue(newd)
01599  
01600  
01601   end
01602  
01603   -- reprocess to extract extra docs
01604   oldtext = self~text
01605   self~text = .queue~new
01606   metas = '@param @return @pre @post'
01607   do j = 1 to oldtext~items
01608     line = oldtext[j]
01609     parse var line prefix parmo
01610     select
01611       when prefix = '@param'
01612         then do 
01613                fulltext = parmo~strip
01614                do j = j+1 to oldtext~items
01615                  la = oldtext[j]
01616                  if metas~wordpos(la~word(1)) > 0 | la~words = 0
01617                    then do
01618                           j = j - 1
01619                           leave
01620                         end
01621                  fulltext = fulltext la~strip
01622                end
01623                self~parms~queue(fulltext)
01624              end
01625       when prefix = '@return'
01626         then do 
01627                fulltext = parmo~strip
01628                do j = j+1 to oldtext~items
01629                  la = oldtext[j]
01630                  if metas~wordpos(la~word(1)) > 0 | la~words = 0
01631                    then do
01632                           j = j - 1
01633                           leave
01634                         end
01635                  fulltext = fulltext la~strip
01636                end
01637                self~returns~queue(fulltext)
01638              end
01639       when prefix = '@pre'
01640         then do 
01641                fulltext = parmo~strip
01642                do j = j+1 to oldtext~items
01643                  la = oldtext[j]
01644                  if metas~wordpos(la~word(1)) > 0 | la~words = 0
01645                    then do
01646                           j = j - 1
01647                           leave
01648                         end
01649                  fulltext = fulltext la~strip
01650                end
01651                self~pres~queue(fulltext)
01652              end
01653       when prefix = '@post'
01654         then do 
01655                fulltext = parmo~strip
01656                do j = j+1 to oldtext~items
01657                  la = oldtext[j]
01658                  if metas~wordpos(la~word(1)) > 0 | la~words = 0
01659                    then do
01660                           j = j - 1
01661                           leave
01662                         end
01663                  fulltext = fulltext la~strip
01664                end
01665                self~posts~queue(fulltext)
01666              end
01667       otherwise self~text~queue(line)
01668     end
01669   end
01670  
01671 -- represents a folder
01672 ::CLASS folder PUBLIC inherit Comparable
01673 ::ATTRIBUTE foldername PUBLIC -- this folder's name
01674 ::ATTRIBUTE folderpath PUBLIC -- this folder's canonical path
01675 ::ATTRIBUTE folders PUBLIC    -- queue of subfolders
01676 ::ATTRIBUTE files PUBLIC      -- queue of files
01677 ::METHOD init
01678   use strict arg folderpath
01679   self~folderpath = folderpath~strip
01680   sep = .pathsep~sep
01681   parse value folderpath~reverse with (sep) foldername (sep) .
01682   self~foldername = foldername~reverse
01683   self~folders = .queue~new
01684   self~files = .queue~new
01685  
01686 ::METHOD compareTo
01687   use arg other
01688   if self~folderpath > other~folderpath
01689     then return 1
01690   if self~folderpath < other~folderpath
01691     then return -1
01692   return 0
01693  
01694  
01695 -- represents a file
01696 ::CLASS file PUBLIC inherit Comparable
01697 ::ATTRIBUTE filename PUBLIC -- this file
01698 ::ATTRIBUTE folder   PUBLIC -- owning folder
01699 ::ATTRIBUTE istxt    PUBLIC -- when true, file is text
01700 ::ATTRIBUTE isrexx   PUBLIC -- when true, file is rexx
01701 ::ATTRIBUTE document PUBLIC -- the document associated with the file
01702 ::ATTRIBUTE references PUBLIC -- ::requires references
01703 ::METHOD init
01704   use strict arg filename, folder
01705   rexxfiles = 'REX REXX CLS RTN'
01706   txtfiles = 'TXT NOTES'
01707   self~filename = filename~strip
01708   self~folder = folder
01709   self~istxt = .false
01710   self~isrexx = .false
01711   self~references = .queue~new
01712  
01713   parse value filename~reverse with ft '.' .
01714   ft = ft~reverse~translate
01715   select
01716     when rexxfiles~wordpos(ft) > 0
01717       then self~isrexx = .true
01718     when txtfiles~wordpos(ft) > 0
01719       then self~istxt = .true
01720     otherwise raise SYNTAX 94 ARRAY('unrecognized:' filename)
01721   end
01722  
01723 ::METHOD compareTo
01724   use arg other
01725   if self~filename > other~filename
01726     then return 1
01727   if self~filename < other~filename
01728     then return -1
01729   return 0
01730  
01731 -- specialisation of tokenizer for Rexx programs
01732 ::CLASS rexxtokenizer PRIVATE SUBCLASS tokenizer
01733 ::ATTRIBUTE delims CLASS
01734 ::ATTRIBUTE lookaheads CLASS
01735  
01736 -- set up tokenizer in class init
01737 ::METHOD init CLASS
01738   ken = .queue~new
01739   ken~queue(.array~of(' ','space'))
01740   ken~queue(.array~of('(','lmbrack'))
01741   ken~queue(.array~of(')','rmbrack'))
01742   ken~queue(.array~of('[','lsbrack'))
01743   ken~queue(.array~of(']','rsbrack'))
01744   ken~queue(.array~of('=','equals'))
01745   ken~queue(.array~of('~','twiddle'))
01746   ken~queue(.array~of('.','dot'))
01747   ken~queue(.array~of(',','comma'))
01748   ken~queue(.array~of('||','concat'))
01749   ken~queue(.array~of('\=','notequal'))
01750   ken~queue(.array~of('<>','notequal'))
01751   ken~queue(.array~of('><','notequal'))
01752   ken~queue(.array~of('>','greaterthan'))
01753   ken~queue(.array~of('<','lessthan'))
01754   ken~queue(.array~of('>=','gteqthan'))
01755   ken~queue(.array~of('<=','leeqthan'))
01756   ken~queue(.array~of('\>','notgreaterthan'))
01757   ken~queue(.array~of('\<','notlessthan'))
01758   ken~queue(.array~of('==','sequal'))
01759   ken~queue(.array~of('\==','snotequal'))
01760   ken~queue(.array~of('>>','sgreaterthan'))
01761   ken~queue(.array~of('<<','slessthan'))
01762   ken~queue(.array~of('>>=','sgteqthan'))
01763   ken~queue(.array~of('<<=','sleeqthan'))
01764   ken~queue(.array~of('\>>','snotgreaterthan'))
01765   ken~queue(.array~of('\<<','snotlessthan'))
01766   ken~queue(.array~of('+','plus'))
01767   ken~queue(.array~of('-','minus'))
01768   ken~queue(.array~of('*','mult'))
01769   ken~queue(.array~of('/','div'))
01770   ken~queue(.array~of('//','idiv'))
01771   ken~queue(.array~of('%','rdiv'))
01772   ken~queue(.array~of('|','or'))
01773   ken~queue(.array~of('&','and'))
01774  
01775   array = .tokenizer~setup(ken)
01776   self~lookaheads = array[1]
01777   self~delims = array[2]
01778  
01779 -- instance init just copies class init
01780 ::METHOD init
01781   self~delims = .rexxtokenizer~delims
01782   self~lookaheads = .rexxtokenizer~lookaheads
01783  
01784 -- flyweight to contain a reference
01785 ::CLASS reference PUBLIC
01786 ::ATTRIBUTE rdatom      -- .rdatom containing reference
01787 ::ATTRIBUTE referee     -- .rdfeature or .adocument referred to
01788 ::ATTRIBUTE token       -- .the .token in the .rdatom which makes the reference or .nil
01789 ::ATTRIBUTE reftype     -- reference type 
01790 -- @param rdatom - ,rdatom containing reference
01791 -- @param reftype - reference type
01792 ::METHOD init
01793   expose rdatom referee token reftype
01794   use arg rdatom, referee, token, reftype

Get RexxLiterate at SourceForge.net. Fast, secure and Free Open Source software downloads
Generated on 31 Aug 2010 05:20:06 for RexxLiterate by rexxliterate  0.0.1