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 -- Provide index page services
00042 --
00043 --
00044  
00045 -- for tabs header building
00046 ::REQUIRES 'htmlutil.cls'
00047 ::REQUIRES 'pathsep.cls'
00048  
00049 --
00050 -- An indexable element
00051 -- This consists of three things: the indexed element,
00052 -- its URL and what to display for the URL
00053 --
00054 ::CLASS htmlindexelement PUBLIC inherit Comparable
00055  
00056 ::ATTRIBUTE displayname
00057 ::ATTRIBUTE urlrefs
00058  
00059 -- @param displayname - what to show in the index
00060 -- @param urlrefs     - queue of urldisplay urlloc pairs
00061 ::METHOD init
00062   use strict arg displayname, urlrefs
00063   self~displayname = displayname
00064   self~urlrefs = urlrefs
00065  
00066 -- comparable on display name
00067 ::METHOD compareTo
00068   use arg other
00069   if other~displayname~translate > self~displayname~translate
00070     then return -1
00071   if other~displayname~translate < self~displayname~translate
00072     then return 1
00073   return 0
00074  
00075 -- flyweight to contain index entries
00076 ::CLASS i_index
00077 ::ATTRIBUTE iname
00078 ::ATTRIBUTE contains  -- htmlindexelements
00079 ::ATTRIBUTE url_tail
00080 ::METHOD init
00081   use arg iname
00082   self~iname = iname
00083   self~contains = .queue~new
00084   self~url_tail = ''
00085  
00086 -- flyweight to describe a page
00087 ::CLASS i_page
00088 ::ATTRIBUTE pname
00089 ::ATTRIBUTE items
00090 ::ATTRIBUTE contains -- i_index
00091 ::METHOD init
00092   use arg pname
00093   self~pname = pname
00094   self~contains = .queue~new
00095   self~items = 0
00096  
00097 -- Convert array of elements to HTML index pages
00098 -- @param elementlist - an Array of htmlindexelement
00099 -- @param prefix - to add to the name of all files written
00100 -- @param firstpage - name of first page in the index
00101 -- @param fpath - where to write files
00102 -- @param header - queue of lines comprising complete html header
00103 --        as far as start of index
00104 -- @param trailer - queue of lines comprising complete html trailer
00105 -- @return
00106 ::ROUTINE hiea2html PUBLIC
00107   use strict arg elementlist, prefix, firstpage, fpath, pagemax, header, trailer
00108  
00109   -- null page for null list
00110   if elementlist~items = 0
00111     then do
00112            fn = fpath||.pathsep~sep||prefix||firstpage'.html'
00113            tp = .queue~new
00114            tp = tp~union(header)
00115            tp~queue('<p></p><p></p>')
00116            tp~queue('<h3>No entries</h3>')
00117            tp = tp~union(trailer)
00118            .htmlutil~writepage(tp, fn)
00119            return
00120          end
00121  
00122   -- ensure alphabetical order
00123   elementlist~sort
00124  
00125   -- prepare indices
00126   tlindices = .queue~new
00127   initial = ''
00128   curr = .nil
00129  
00130   -- pack elements into indices
00131   do e over elementlist
00132     tinit = e~displayname~left(1)~translate
00133     if tinit <> initial
00134       then do
00135              initial = tinit
00136              curr = .i_index~new(initial)
00137              tlindices~queue(curr)
00138            end
00139     curr~contains~queue(e)
00140   end
00141  
00142  
00143   -- assign indices to pages
00144   -- pages is a queue of arrays of a string and a queue of i_index
00145  
00146   pages = .queue~new
00147   pagename = prefix||firstpage
00148  
00149   pgents = tlindices[1]~contains~items
00150   pageq = .queue~new
00151   pages~queue(.array~of(pagename, pageq))
00152  
00153   do i over tlindices
00154     if pgents + i~contains~items > pagemax
00155       then do
00156              if i <> tlindices[1]
00157                then do
00158                       pagename = prefix'_index_'i~iname~c2x
00159                       pageq = .queue~new
00160                       pages~queue(.array~of(pagename, pageq))
00161                       pgents = 0
00162                     end
00163            end
00164  
00165     pgents = pgents + i~contains~items
00166     pageq~queue(i)
00167     i~url_tail = pagename
00168   end
00169  
00170   -- prepare top menu
00171   topmenu = .queue~new
00172   do i over tlindices
00173     topmenu~queue(.array~of(i~iname,       i~url_tail'.html#'i~iname,       'pet'i~iname))
00174   end
00175  
00176   -- emit pages
00177   do i over pages
00178  
00179     fn = fpath||.pathsep~sep||i[1]'.html'
00180  
00181     tp = .queue~new
00182     tp = tp~union(header)
00183  
00184     .htmlutil~tabshead(tp, topmenu, 'pet'i[2][1]~iname)
00185     tp~queue('<p></p><p></p>')
00186  
00187     do j over i[2]
00188       tp~queue('<h3><a class="anchor" name="'j~iname'"> -' j~iname '-</a></h3>')
00189       tp~queue('<ul>')
00190       do k over j~contains
00191         tp~queue('<li>' k~displayname)
00192         do m over k~urlrefs
00193           if m[1] = ''
00194             then tp~queue('<a class="el" href="'m[2]'">' k~displayname '</a>')
00195             else tp~queue('<a class="el" href="'m[2]'">' m[1] '</a>')
00196         end
00197         tp~queue('</li>')
00198       end
00199       tp~queue('</ul>')
00200     end
00201     tp = tp~union(trailer)
00202  
00203     .htmlutil~writepage(tp, fn)
00204  
00205   end
00206  
00207  
00208