; Description: Reads directory structures and creates an HTML file which
; allows you to navigate the directories.
;
; Requires: amigalibs.res
; NeilsReqToolsLib
;
; Type: SYSTEM
WBStartup
WbToScreen 0
WBenchToFront_
*s._Screen = Peek.l(Addr Screen(0))
#TABSTEP = 4
#CI_OK = 0
#CI_LOWMEM = 1
#CI_NODIR = 2
#CI_WRITEERR= 4
#CI_NOOPEN = 8
#CI_NOTHINGOPEN = 0
#CI_SINGLEOPEN = 1
#CI_MULTIPLEOPEN= 2
#GAD_MX_INDEX = 1
#GAD_ST_PATH = 2
#GAD_BU_REQ = 3
#GAD_CB_INFO = 4
#GAD_ST_XTRA = 5
#GAD_BU_START = 6
NEWTYPE.MyNode
ANode.MinNode
ln_Type.b
ln_Pri.b
ln_Name.s
End NEWTYPE
singlefh.l = 0
mode.w = 0
DEFTYPE.FileInfoBlock myfib
Function.w createindex{root$, subdrawer$, relpath$, tabsize.w}
SHARED mode,myfib,singlefh
DEFTYPE.w fileopened : fileopened = #CI_NOTHINGOPEN
DEFTYPE.List filelist
DEFTYPE.MyNode *ptr,*ptr2,*ptr3
retval.w = #CI_OK
DEFTYPE.l multiplefh
filelist\lh_Head = &filelist\lh_Tail
filelist\lh_TailPred = &filelist\lh_Head
filelist\lh_Tail = 0
If Right$(relpath$,1)<>"/" AND relpath$<>"" Then relpath$=relpath$+"/"
If Right$(subdrawer$,1)<>"/" AND subdrawer$<>"" Then subdrawer$=subdrawer$+"/"
If Right$(root$,1)<>"/" AND Right$(root$,1)<>":" AND root$<>"" Then root$=root$+"/"
drawer$ = root$ + subdrawer$
; Scan directory, one entry at a time, and insert into the alphabetically correct
; position in the list. Also allows .info files to be ignored.
lock.l = Lock_(&drawer$, #ACCESS_READ)
If lock <> 0
If Examine_(lock,&myfib) <> 0
While ExNext_(lock, &myfib)
fyle$ = Peek$(&myfib\fib_FileName)
If LCase$(Right$(fyle$,5))<>".info" OR GTStatus(0,#GAD_CB_INFO)<>0
*ptr = AllocMem_(SizeOf.MyNode, #MEMF_PUBLIC|#MEMF_CLEAR)
If *ptr
*ptr\ln_Name = fyle$
If myfib\fib_DirEntryType<0 Then *ptr\ln_Type=-1 Else *ptr\ln_Type=1
; Find correct insertion point
If filelist\lh_Head\ln_Succ=0
AddHead_ &filelist,*ptr
Else
*ptr2 = filelist\lh_TailPred
If UCase$(*ptr2\ln_Name) < UCase$(*ptr\ln_Name)
AddTail_ &filelist,*ptr
Else
*ptr2 = filelist\lh_Head
While *ptr2\ANode\mln_Succ
If UCase$(*ptr2\ln_Name) > UCase$(*ptr\ln_Name)
Insert_ &filelist,*ptr,*ptr2\ANode\mln_Pred
*ptr2 = filelist\lh_TailPred
If *ptr2\ANode\mln_Succ = 0 Then *ptr2 = *ptr2\ANode\mln_Pred
End If
*ptr2 = *ptr2\ANode\mln_Succ
Wend
End If
End If
Else
If NOT(retval & #CI_LOWMEM) Then retval = retval + #CI_LOWMEM
End If
End If
Wend
End If
UnLock_ lock
Else
Function Return #CI_NODIR
End If
If mode=0 ; mode=0 for 1 html file total
If singlefh=0
singlefh = Open_(root$+"index.html",#MODE_NEWFILE)
If singlefh
fileopened = #CI_SINGLEOPEN
Else
retval = #CI_NOOPEN
Goto freelist
End If
End If
If FPuts_(singlefh,""+Chr$(10)) = -1
retval = #CI_WRITEERR
Goto closeandfree
End If
*ptr2 = filelist\lh_Head
While *ptr2\ANode\mln_Succ
out$ = ""
out$ = out$ + "- "
If *ptr2\ln_Type < 0
out$ = out$ + "" + *ptr2\ln_Name + ""
Else
out$ = out$ + " (Dir)"
End If
out$ = out$ + "
" + Chr$(10)
If FPuts_(singlefh,out$)=-1
; if there is an error writing the file, then quit this.
retval = #CI_WRITEERR
Goto closeandfree
End If
If *ptr2\ln_Type > 0
retval = createindex{root$,subdrawer$+*ptr2\ln_Name,relpath$,tabsize+#TABSTEP}
If retval & (#CI_NODIR | #CI_WRITEERR | #CI_NOOPEN) Then Goto closeandfree
End If
*ptr2 = *ptr2\ANode\mln_Succ
Wend
If FPuts_(singlefh,"
"+Chr$(10)) = -1
retval = #CI_WRITEERR
Goto closeandfree
End If
Else ; can only really be 1, for 1 index per directory
multiplefh = Open_(root$+subdrawer$+"index.html",#MODE_NEWFILE)
If multiplefh
fileopened=#CI_MULTIPLEOPEN
Else
retval=#CI_NOOPEN
Goto freelist
End If
If FPuts_(multiplefh,subdrawer$+"
"+Chr$(10)) = -1
retval = #CI_WRITEERR
Goto closeandfree
End If
If subdrawer$<>""
out$ = "- .. (Parent dir)"+Chr$(10)
If FPuts_(multiplefh,out$) = -1
retval = #CI_WRITEERR
Goto closeandfree
End If
End If
*ptr2 = filelist\lh_Head
While *ptr2\ANode\mln_Succ
out$ = ""
out$ = out$ + "
- "
out$ = out$ + "" + *ptr2\ln_Name
If *ptr2\ln_Type > 0 Then out$ = out$ + " (Dir)"
out$ = out$ + "
" + Chr$(10)
If FPuts_(multiplefh,out$)=-1
; if there is an error writing the file, then quit this.
retval = #CI_WRITEERR
Goto closeandfree
End If
If *ptr2\ln_Type > 0
retval = createindex{root$,subdrawer$+*ptr2\ln_Name,relpath$,tabsize+#TABSTEP}
If retval & (#CI_NODIR | #CI_WRITEERR | #CI_NOOPEN) Then Goto closeandfree
End If
*ptr2 = *ptr2\ANode\mln_Succ
Wend
If FPuts_(multiplefh,"
"+Chr$(10)) = -1
retval = #CI_WRITEERR
Goto closeandfree
End If
End If
closeandfree:
Select fileopened
Case #CI_SINGLEOPEN
Close_ singlefh
Case #CI_MULTIPLEOPEN
Close_ multiplefh
End Select
freelist:
*ptr = filelist\lh_Head
While *ptr\ANode\mln_Succ
*ptr2 = *ptr
*ptr = *ptr\ANode\mln_Succ
Remove_ *ptr2
FreeMem_ *ptr2,SizeOf.MyNode
Wend
Function Return retval
End Function
Function.w TLen{a$}
DEFTYPE._RastPort rp
InitRastPort_ &rp
SetFont_ &rp,Peek.l(Addr IntuiFont(0) + 8)
Function Return TextLength_(&rp,&a$,Len(a$))
End Function
Function.w Longest{a.w, b.w}
If a > b Then Function Return a Else Function Return b
End Function
LoadFont 0,Peek$(*s\Font\ta_Name),*s\Font\ta_YSize,*s\Font\ta_Style
;gh.w = *s\Font\ta_YSize + 6
iw.w=0
gt.w = 4
gl.w = 4
gh.w = 2 * *s\Font\ta_YSize + 6
gw.w = #MX_WIDTH + Longest{TLen{"1 HTML index"}, TLen{"Index per directory"}}
iw = Longest{iw,gl+gw+4}
GTMX 0,#GAD_MX_INDEX,gl,gt,gw,gh,"",#PLACETEXT_RIGHT,"1 HTML index|Index per directory",0
gt = gt + gh + 4
gl = TLen{"Path"}+12
gh = *s\Font\ta_YSize + 6
gw = 150
iw = Longest{iw,gl+gw+4}
GTString 0,#GAD_ST_PATH,gl,gt,gw,gh,"_Path",#PLACETEXT_LEFT,256
gl = gl + gw + 4
gh = *s\Font\ta_YSize + 6
gw = TLen{" (?) "}
iw = Longest{iw,gl+gw+4}
GTButton 0,#GAD_BU_REQ,gl,gt,gw,gh,"(_?)",#PLACETEXT_IN
gt = gt + gh + 4
gl = 4
gh = *s\Font\ta_YSize + 6
gw = #CHECKBOX_WIDTH + 12 + TLen{"Show .info files?"}
iw = Longest{iw,gl+gw+4}
GTCheckBox 0,#GAD_CB_INFO,gl,gt,gw,gh,"Show ._info files?",#PLACETEXT_RIGHT
gt = gt + gh + 4
gl = TLen{"Xtra"}+12
gh = *s\Font\ta_YSize + 6
gw = 150
iw = Longest{iw,gl+gw+4}
;ih = Longest{ih,gt+gh+4}
GTString 0,#GAD_ST_XTRA,gl,gt,gw,gh,"_Xtra",#PLACETEXT_LEFT,256
gt = gt + gh + 4
gl = (iw - TLen{" Start "}) / 2
gh = *s\Font\ta_YSize + 6
gw = TLen{" Start "}
iw = Longest{iw,gl+gw+4}
ih.w = Longest{ih,gt+gh+4}
GTButton 0,#GAD_BU_START,gl,gt,gw,gh,"_Start",#PLACETEXT_IN
Dim tags.TagItem(6)
tags(0)\ti_Tag =#WA_InnerWidth,iw
tags(1)\ti_Tag =#WA_InnerHeight,ih
tags(2)\ti_Tag =#WA_AutoAdjust,True
tags(3)\ti_Tag =#WA_Left,20
tags(4)\ti_Tag =#WA_Top,20
tags(5)\ti_Tag =#TAG_END
AddIDCMP #IDCMP_VANILLAKEY
WindowTags 0,$100f,"Options for Dir2HTML",&tags(0)
AttachGTList 0,0
GTToggle 0,#GAD_CB_INFO,Off
ActivateString 0,#GAD_ST_PATH
DefaultOutput
While ev.l<>#IDCMP_CLOSEWINDOW
ev=WaitEvent
Select ev
Case #IDCMP_VANILLAKEY
Select EventCode & $FFFFFFDF
Case Asc("S")
Select createindex{GTGetString(0,#GAD_ST_PATH),"",GTGetString(0,#GAD_ST_XTRA),0}
Case #CI_OK
message$ = "Index written OK"
Case #CI_LOWMEM
message$ = "Some emtries may not have been written"+Chr$(10)
message$ + "due to low memory when allocating list nodes!"
Case #CI_NODIR
message$ = "Could not open one of the directories in path!"
Case #CI_WRITEERR
message$ = "Error writing to file"
Case #CI_NOOPEN
message$ = "Could not write (one of) the index file(s)"
End Select
dummy = RTEZRequest("Information",message$,"OK")
Case Asc("I")
GTSetAttrs 0,#GAD_CB_INFO,#GTCB_Checked,1-GTStatus(0,#GAD_CB_INFO)
Case Asc("X")
ActivateString 0,#GAD_ST_XTRA
Case Asc("?")-32
RTEZSetDefaultDirectory 2,GTGetString(0,#GAD_ST_PATH)
GTSetString 0,#GAD_ST_PATH,RTEZPathRequest("Select path to index")
Case Asc("P")
ActivateString 0,#GAD_ST_PATH
Case 0
mode = 1 - mode
GTSetAttrs 0,#GAD_MX_INDEX,#GTMX_Active,mode
End Select
Case #IDCMP_GADGETUP
Select GadgetHit
Case #GAD_BU_START
Select createindex{GTGetString(0,#GAD_ST_PATH),"",GTGetString(0,#GAD_ST_XTRA),0}
Case #CI_OK
message$ = "Index written OK"
Case #CI_LOWMEM
message$ = "Some emtries may not have been written"+Chr$(10)
message$ + "due to low memory when allocating list nodes!"
Case #CI_NODIR
message$ = "Could not open one of the directories in path!"
Case #CI_WRITEERR
message$ = "Error writing to file"
Case #CI_NOOPEN
message$ = "Could not write (one of) the index file(s)"
End Select
dummy = RTEZRequest("Information",message$,"OK")
Case 3
RTEZSetDefaultDirectory 2,GTGetString(0,#GAD_ST_PATH)
GTSetString 0,#GAD_ST_PATH,RTEZPathRequest("Select path to index")
End Select
Case #IDCMP_GADGETDOWN
If GadgetHit = #GAD_MX_INDEX Then mode=EventCode
End Select
Wend
DetachGTList 0
End