REM >ModuleInfo
REM By: S.P.Johnson   30-Oct-1996
REM Virtually re-written and hugely improved 31-Mar-1999 to 07-Apr-1999
REM This software is Public Domain.
REM
REM Creates a Director menu giving Module Info for the filename supplied

ON ERROR: ON ERROR OFF: ERROR ERR,REPORT$+" at "+STR$ ERL

XOS_Module=FNswi_number("XOS_Module")
Menu=FNswi_number("Director_Menu")
EndMenu=FNswi_number("Director_EndMenu")
Option=FNswi_number("Director_Option")
Command=FNswi_number("Director_Command")
Dash=FNswi_number("Director_Dash")

DIM timbuf% 8
max_buffer_size% = 199999     :REM Max buffer size to allocate
buffer_size% = 1023           :REM Size of current buffer
helpwidth% = 60               :REM Approx. max width of help text menu entries

DIM dirname$(99)
dmax%=0

SYS"OS_GetEnv" TO A$

PROCskippast
WHILE RIGHT$(A$,1)=" " A$=LEFT$(A$):ENDWHILE
IF FNuc(LEFT$(A$,5))="-QUIT" THEN PROCskippast : PROCskippast
fileonly% = FALSE
swilist% = FALSE
cmdlist% = FALSE
cmdhelp% = FALSE
IF FNuc(LEFT$(A$,9))="-FILEONLY" THEN fileonly% = TRUE : PROCskippast
IF FNuc(LEFT$(A$,8))="-SWILIST" THEN swilist% = TRUE : PROCskippast
IF FNuc(LEFT$(A$,8))="-CMDLIST" THEN cmdlist% = TRUE : PROCskippast
IF FNuc(LEFT$(A$,8))="-CMDHELP" THEN cmdhelp% = TRUE : PROCskippast
IF cmdhelp% THEN cmdname$=FNgetarg : PROCskipspace
path$=A$

IF swilist% THEN PROCswilistMenu : END
IF cmdlist% THEN PROCcmdlistMenu : END
IF cmdhelp% THEN PROCcmdhelpMenu : END

SYS Menu,"""Module Info"" ModuleInfo -temp"
*Set Director$Menu ModuleInfo

ON ERROR: ON ERROR OFF: SYS Option,"""**"+REPORT$+" at "+STR$(ERL)+"**"" -fg <Director$Red>": SYS EndMenu: END

SYS "XOS_File",23,path$ TO typ%,,load%,exec%,len%,att%,ftyp%
timbuf%!0=exec% : timbuf%!4=load%
REM buffer% = FNGetBuffer(len%+1)       :REM This also sets buffer_size%
DIM buffer% buffer_size%

IF typ%=0 THEN
  SYS Option,"""Not found: "+path+""""
ELSE
  fname$=FNleaf(path$)
  SYS Option,"""File: "+fname$+""""
  SYS Option,"""Size: "+STR$ len%+" bytes"""
  SYS Option,"""Date: "+FNdatestr(timbuf%,buffer%,buffer_size%)+""""
  IF ftyp% <> &FFA THEN
    SYS Option,"""Type: "+FNtypename(ftyp%)+" ("+FNhex(ftyp%,3)+")"""
    SYS Option,"""** Not a Module **"" -fg <Director$Red>"
  ELSE
    SYS Dash
    IF FNLoadFile(path$) THEN
      PROCModFileMenu(buffer%,buffer_size%,path$)
    ELSE
      SYS Option,"""** Can't read file - read protected? **"" -fg <Director$Blue>"
    ENDIF
  ENDIF
ENDIF

SYS EndMenu
REM *DirectorShowMenu ModuleInfo
END

REM ================= Main Routines ========================

DEF PROCModFileMenu(buffer%,buffer_size%,path$)
  modname$=FNstradr(buffer%,buffer%!&10,buffer_size%)
  SYS Option,"""Title: "+modname$+""""
  SYS Option,"""Help: "+FNhelpn(buffer%,buffer%!&14,buffer_size%)+""" -sub ""Dynamic:/Director:Menus.System.CommMenu """"Help "+modname$+""""" "" "
  SYS Option,"""Version: "+FNver(buffer%,buffer%!&14,buffer_size%)+""""
  IF buffer%!&18=0 THEN
    SYS Option,"""No *Commands"" -grey"
  ELSE
    SYS Option,"""*Commands"" -sub ""Dynamic:/Director:Menus.System.ModuleInfo -cmdlist "+path$+""""
  ENDIF
  IF buffer%!&20<=0 OR buffer%!&20>len% THEN
    SYS Option,"""No SWI code"" -grey"
  ELSE
    IF buffer%!&24=0 THEN
      swipfx$="(SWI names handled in code)"
    ELSE
      swipfx$=FNstradr(buffer%,buffer%!&24,buffer_size%)+"_"
    ENDIF
    SYS Option,"""SWI Chunk: &"+STR$~(buffer%!&1C)+" "+swipfx$+""" -sub ""Dynamic:/Director:Menus.System.ModuleInfo -swilist "+path$+""""
  ENDIF
  IF NOT fileonly% THEN
    SYS Dash
    PROCdoRMAname(modname$)
    SYS Dash
    PROCgetDirNames("System:Modules")
    SYS "OS_ReadVarVal","System$Dir",buffer%,buffer_size%,0,3 TO ,,syslen%
    REM Assume first len% of all dirname$() entries equals System$Dir
    count%=0
    FOR I% = 1 TO dmax%
      path$ = MID$(dirname$(I%),syslen%-6)  :REM skip back to assumed !System
      SYS "OS_File",17,dirname$(I%)+"."+fname$ TO typ%
      IF typ%=1 THEN
        IF FNLoadFile(dirname$(I%)+"."+fname$) THEN
          SYS Option,"""..."+path$+"."+fname$+": "+FNver(buffer%,buffer%!&14,buffer_size%)+""" -sub ""Dynamic:/Director:Menus.System.ModuleInfo -fileonly "+dirname$(I%)+"."+fname$+""""
          count%+=1
        ENDIF
      ENDIF
    NEXT I%
    IF count%=0 THEN
      SYS Option,"""Not in System:Modules"" -grey"
    ENDIF
  ENDIF
ENDPROC

DEF PROCswilistMenu
  SYS Menu,"""SWI List"" -temp"
  *Set Director$Menu SWI List

  ON ERROR: ON ERROR OFF: SYS Option,"""**"+REPORT$+" at "+STR$(ERL)+"**"" -fg <Director$Red>": SYS EndMenu: END

  IF FNLoadFile(path$) THEN
    swinum% = buffer%!&1C
    ptr% = buffer%!&24
    IF ptr% > buffer_size% THEN
      SYS Option,"""(swi table outside buffer)"" -fg <Director$Blue>"
    ELSE
      swiname$=FN0(buffer%+ptr%)
      ptr% += LEN swiname$+1
      WHILE buffer%?ptr%<>0
        IF ptr% > buffer_size% THEN
          ptr% = buffer_size%
          SYS Option,"""(table extends outside buffer)"" -fg <Director$Blue>"
        ELSE
          name$ = FN0(buffer%+ptr%)
          ptr% += LEN name$+1
          name$ = swiname$+"_"+name$
          SYS Option,"""&"+STR$~(swinum%)+" "+name$+""""
          swinum% += 1
        ENDIF
      ENDWHILE
    ENDIF
  ELSE
    SYS Option,"""** Can't read file - read protected? **"" -fg <Director$Red>"
  ENDIF

  SYS EndMenu

ENDPROC

DEF PROCcmdlistMenu
  SYS Menu,"""Command List"" -temp"
  *Set Director$Menu Command List

  ON ERROR: ON ERROR OFF: SYS Option,"""**"+REPORT$+" at "+STR$(ERL)+"**"" -fg <Director$Red>": SYS EndMenu: END

  IF FNLoadFile(path$) THEN
    ptr% = buffer%!&18
    IF ptr% > buffer_size% THEN
      SYS Option,"""(cmd table outside buffer)"" -fg <Director$Blue>"
    ELSE
      WHILE buffer%?ptr%<>0
        IF ptr% > buffer_size% THEN
          ptr% = buffer_size%
          SYS Option,"""(table extends outside buffer)"" -fg <Director$Blue>"
        ELSE
          name$ = FN0(buffer%+ptr%)
          ptr% += LEN name$+1+3+4+4+4    :REM Jump over Align and word pointers
          ptr% = ptr% AND &FFFFFC       :REM Align offset
          help% = buffer%!ptr%
          ptr% += 4
          sub$ = ""
          IF help% THEN sub$ = " -sub ""Dynamic:/Director:Menus.System.ModuleInfo -cmdhelp "+name$+" "+path$+""""
          SYS Option,"""*"+name$+""""+sub$
        ENDIF
      ENDWHILE
    ENDIF
  ELSE
    SYS Option,"""** Can't read file - read protected? **"" -fg <Director$Red>"
  ENDIF

  SYS EndMenu

ENDPROC

DEF PROCcmdhelpMenu
  SYS Menu,"""Command Help"" -temp"
  *Set Director$Menu Command Help

  ON ERROR: ON ERROR OFF: SYS Option,"""**"+REPORT$+" at "+STR$(ERL)+"**"" -fg <Director$Red>": SYS EndMenu: END

  IF FNLoadFile(path$) THEN
    ptr% = buffer%!&18
    IF ptr% > buffer_size% THEN
      SYS Option,"""(cmd table outside buffer)"" -fg <Director$Blue>"
    ELSE
      WHILE buffer%?ptr%<>0
        IF ptr% > buffer_size% THEN
          ptr% = buffer_size%
          SYS Option,"""(table extends outside buffer)"" -fg <Director$Blue>"
        ELSE
          name$ = FN0(buffer%+ptr%)
          ptr% += LEN name$+1+3+4        :REM Jump over Align and word pointers
          ptr% = ptr% AND &FFFFFC       :REM Align offset
          info% = buffer%!ptr%
          ptr% += 4+4
          help% = buffer%!ptr%
          ptr% += 4
          IF cmdname$=name$ THEN
            SYS Option,"""Raw Help text for command "+cmdname$+":"" -fg <Director$Blue> -bg <Director$Yellow>"
            IF info% AND 1<<29 THEN
              SYS Option,"""Help text generated by code"" -fg <Director$Khaki>"
            ELSE
              PROCgetHelpLines(buffer%,help%,buffer_size%)
            ENDIF
            SYS EndMenu
            ENDPROC
          ENDIF
        ENDIF
      ENDWHILE
      SYS Option,"""Didn't find command "+cmdname$+""" -fg <Director$Red>"
    ENDIF
  ELSE
    SYS Option,"""** Can't read file - read protected? **"" -fg <Director$Red>"
  ENDIF

  SYS EndMenu

ENDPROC

REM ------------------------ Support Routines --------------------------

DEF PROCdoRMAname(modname$)
  SYS "XOS_Module",18,modname$+CHR$0 TO ,,,modaddr%;flag%
  IF flag% AND 1 THEN
    SYS Option,"""Not in module area"" -grey"
  ELSE
    SYS Option,"""In module area: "+FNver(modaddr%,modaddr%!&14,9999)+""" -sub ""Dynamic:/Director:Menus.System.ModulesSub -do "+modname$+""""
  ENDIF
  M%=0 : N%=-1
  REPEAT
    SYS "XOS_Module",20,M%,N% TO ,M%,N%,ptr%,status%,,ver%;flag%
    IF NOT (flag% AND 1) THEN
      IF FNuc(modname$) = FNuc(FN0(ptr%)) THEN
        IF N%=-1 THEN s$="ROM" ELSE IF N%<0 THEN s$="Ext.ROM "+STR$(-1-N%) ELSE s$="Exp. Card "+STR$ N%
        CASE status% OF
        WHEN -1: st$="Unplugged" : col$="Khaki"
        WHEN  0: st$="Dormant"   : col$="Blue"
        WHEN  1: st$="Active"    : col$="Grey6"
        WHEN  2: st$="Running"   : col$="Red"
        ENDCASE
        SYS Option,""""+s$+" ver "+FNverBCD(ver%)+" ("+st$+")"" -fg <Director$"+col$+">"
    ENDIF
  UNTIL flag% AND 1
ENDPROC

DEF FNverBCD(ver%)
  LOCAL ver$
  ver$ = STR$~ver%
  IF LEN ver$<5 THEN ver$=RIGHT$("00000"+ver$,5)
  ver$=LEFT$(ver$,LEN ver$-4)+"."+RIGHT$(ver$,4)
  IF RIGHT$(ver$)="0" THEN ver$=LEFT$(ver$)
  IF RIGHT$(ver$)="0" THEN ver$=LEFT$(ver$)
  =ver$

DEF PROCgetDirNames(path$)          :REM Builds recursive list of unique
  LOCAL ix%, sfx$, fpath$           :REM directory names.  Uses buffer%
  IF INSTR(path$,":") THEN
    SYS "XOS_ReadVarVal",LEFT$(path$,INSTR(path$,":")-1)+"$Path",buffer%,buffer_size%,0,3 TO ,,len%
    IF len% THEN
      sfx$ = MID$(path$,INSTR(path$,":")+1)
      buffer%?len% = 0
      path$=FN0(buffer%)
      REPEAT
        fpath$ = LEFT$(path$,INSTR(path$,",")-1)
        path$ = MID$(path$,LEN fpath$+2)
        IF LEN fpath$ THEN
          PROCgetDirNames(fpath$+sfx$)
        ENDIF
      UNTIL path$=""
    ENDIF
  ENDIF
  IF LEN path$ THEN
    dmax% += 1
    dirname$(dmax%) = path$
    ix% = 0
    REPEAT
      SYS "OS_GBPB",10,path$,buffer%,1,ix%,buffer_size%,0 TO ,,,,ix%
      IF ix%<>-1 THEN
        IF buffer%!16=2 OR buffer%!16=3 THEN
          PROCgetDirNames(path$+"."+FN0(buffer%+20))
        ENDIF
      ENDIF
    UNTIL ix%=-1
  ENDIF
ENDPROC

DEF PROCgetHelpLines(buf%,ptr%,max%)
  LOCAL help$
  help$=""
  IF ptr%>max% THEN
    SYS Option,"""(Help string outside buffer - offset "+STR$~ptr%+")"" -fg <Director$Blue>"
  ELSE
    WHILE buf%?ptr%<>0
      CASE buf%?ptr% OF
        WHEN 27: ptr%+=1:help$+="\"+STR$(buf%?ptr%)
        WHEN 9:  help$+=LEFT$("        ",8-(LEN help$ MOD 8))
        WHEN 13: SYS Option,""""+help$+"""":help$=""
        WHEN 10: IF LEN help$ THEN SYS Option,""""+help$+"""":help$=""
        WHEN 31: help$+=" "
        WHEN 32: IF LEN help$<=helpwidth% THEN help$+=" " ELSE SYS Option,""""+help$+"""":help$=""
        WHEN ASC(""""): help$+=""""""
        OTHERWISE IF buf%?ptr%>31 THEN help$+=CHR$(buf%?ptr%) ELSE help$+="."
      ENDCASE
      IF ptr%<max% THEN ptr%+=1
    ENDWHILE
    IF LEN help$ THEN SYS Option,""""+help$+""""
  ENDIF
ENDPROC

DEF FNLoadFile(fpath$)
  LOCAL ERROR
  ON ERROR LOCAL: =FALSE
  SYS "XOS_File",23,fpath$ TO typ%,,,,len%
  IF typ%=0 THEN =FALSE
  fh% = OPENIN (fpath$)
  IF fh%=0 THEN
    SYS Option,"""** Can't read "+fpath$+" - disappeared? **"" -fg <Director$Blue>"
    =FALSE
  ENDIF
  ON ERROR LOCAL: CLOSE#fh%: SYS Option,"""**"+REPORT$+" at "+STR$(ERL)+"**"" -fg <Director$Red>": =FALSE
  buffer% = FNGetBuffer(len%+1)
  SYS "OS_GBPB",4,fh%,buffer%,buffer_size%-1
  buffer%?buffer_size% = 0
  CLOSE#fh%
=TRUE

DEF FNGetBuffer(siz%)
  REM Only allocates a new block if existing one is too small AND less than
  REM half the max size block to allocate
  IF siz% > buffer_size% AND buffer_size% < max_buffer_size% / 2 THEN
    buffer_size% = siz%
    IF buffer_size% > max_buffer_size% THEN buffer_size% = max_buffer_size%
    DIM buffer% buffer_size%
  ENDIF
  =buffer%

DEF FNdatestr(utc%,buf%,bufsiz%)
  SYS "Territory_ConvertStandardDate",-1,utc%,buf%,bufsiz%
  =FN0(buf%)

DEF FNhelpn(buf%,off%,max%)
  IF off%>max% THEN ="(outside buffer)" ELSE =FN0(buf%+off%)

DEF FNver(buf%,off%,max%)
  LOCAL ptr%
  IF off% > max% THEN ="(outside buffer)"
  ptr% = buf%+off%
  WHILE ?ptr%>13 : ptr%+=1 : ENDWHILE
  WHILE ?ptr%<14 : ptr%+=1 : ENDWHILE
  =FN0(ptr%)

DEF FNstradr(buf%,off%,max%)
  IF off%>max% THEN ="(outside buffer)"
  =FN0(buf%+off%)

DEF FNtypename(ftype%)
  LOCAL len,flag,var_ftype$,ftype$,svc_ret%,ft1%,ft2%,ossvc_ftype$
  SYS "XOS_ReadVarVal","File$Type_"+FNhex(ftype%,3),buffer%,10,0 TO,,len;flag
  buffer%?len=13
  var_ftype$ = $buffer%
  ftype$=var_ftype$
  SYS "OS_ServiceCall",,&42,ftype% TO ,svc_ret%,ft1%,ft2%
  ossvc_ftype$=""
  IF svc_ret%=0 THEN
     buffer%!0 = ft1%
     buffer%!4 = ft2%
     buffer%?8 = 13
     ossvc_ftype$=$buffer%
  ENDIF
  IF(flag AND 1)OR len<1 THEN
     ftype$ = ossvc_ftype$
     IF ftype$="" THEN ftype$=FNhex(ftype%,3)
  ENDIF
  =ftype$

DEF FNswi_number(name$)
  SYS "OS_SWINumberFromString",,name$ TO A%
  =A%

DEF PROCskiptospace WHILE LEFT$(A$,1)<>" "ANDLEN A$<>0 A$=MID$(A$,2):ENDWHILE:ENDPROC
DEF PROCskipspace WHILE LEFT$(A$,1)=" " A$=MID$(A$,2):ENDWHILE:ENDPROC
DEF PROCskippast PROCskiptospace:PROCskipspace:ENDPROC
DEF FNgetarg B$="":WHILE LEFT$(A$,1)<>" "ANDLEN A$<>0 B$=B$+LEFT$(A$,1):A$=MID$(A$,2):ENDWHILE:=B$
DEF FNasc(val%) IF ((val%+1)AND&7f)<33 THEN ="." ELSE =CHR$ val%
DEF FNhex(val%,len%) =RIGHT$("00000000"+STR$~val%,len%)

DEF FNuc(a$)
  LOCAL Z%,z$,b$
  FOR Z%=1TOLEN a$
  z$=MID$(a$,Z%,1)
  IF z$>="a"IF z$<="z" z$=CHR$(ASC z$-32)
  b$+=z$:NEXT
  =b$

DEF FNleaf(path$)
  leaf$=""
  FOR I=LEN path$ TO 1 STEP -1
    IF "." = MID$(path$,I,1) THEN =MID$(path$,I+1)
  NEXT
  =path$

DEF FN0(a%)
  s$=""
  WHILE ?a%>14
   IF ?a% = 34 THEN s$+=CHR$34 : REM doubleup " characters
   s$+=CHR$?a%
   a%+=1
  ENDWHILE
  =s$
