' Shell fr S T R U K T O und PSEUDOCODE-Dateien, Peter Ubachs 6/89
' Aufruf von Editor und STRUKTO
' beinhaltet Test auf Konsistenz der Kontrollstrukturen
' automatischer Durchlauf EDITOR ==> TEST ==> STRUKTO
' (Vorlage:Shell aus ST-Computer 12/87 von Martin Wunderli & Patrik Seemann)
'
' #########################################################################
' # Diese  Shell sollte  eine  komfortable  Bearbeitung  von  PSEUDOCODE- #
' # Dateien  erm”glichen:  Aufruf  eines   Editor,  Syntax-Check,  Aufruf #
' # von  STRUKTO. Der Test auf  korrekten Abschluž der Kontrollstrukturen #
' # ist  genauer als der innerhalb  von  STRUKTO (z.B.  "ENDIF ohne IF in #
' # Zeile 12")  und der aufgerufene  Editor ist  gleich  in der richtigen #
' # Zeile.                                                                #
' # Leider  strzt diese Shell  manchmal mit 2 Bomben ab, deshalb ist die #
' # compilierte  Version auch  gar nicht erst  dabei. Ich  arbeite  nicht #
' # mehr mit einer  Shell, sondern benutze den EMACS, da kann ich STRUKTO #
' # direkt  aufrufen und Makros fr den Syntax-Check  schreib ich gerade. #
' # Also entwickle  ich die Shell nicht weiter, wer  weiž wo der 2 Bomben #
' # Fehler steckt, kann ihn mir aber trotzdem gerne mitteilen.            #
' #########################################################################
IF EXIST("shell.inf")
  ' shell.inf einlesen
  OPEN "I",#1,"shell.inf"
  INPUT #1,alter_pfad$
  INPUT #1,editorpfad$
  CLOSE
  '
  struktopfad$=DIR$(0)+"\strukto.prg"
  pscdatei$="default.psc"
  gespfad$=""
  '
  anz_schl%=24
  DIM schluessel$(anz_schl%+1),art%(anz_schl%+1)
  RESTORE schluessel
  FOR i%=1 TO anz_schl%
    READ schluessel$(i%),art%(i%)
  NEXT i%
  max_ebenen%=20 !mžte reichen
  DIM str_art%(max_ebenen%)
  '
  ' Men
  ' ------
  anzmenutitel%=30
  DIM menfeld$(anzmenutitel%)
  RESTORE menu
  FOR i%=0 TO anzmenutitel%
    READ menfeld$(i%)
    EXIT IF menfeld$(i%)="* * *"
  NEXT i%
  menfeld$(i%)=""
  menu:
  DATA STRUKTO,  Info
  DATA -----------------------
  DATA      ,     ,     ,     ,     ,     ,""
  DATA Datei,  ausw„hlen,----------------------------,  Editor,  Test,  STRUKTO,----------------------------,  Editor -> Test -> STRUKTO,----------------------------,  beenden,""
  DATA * * *
  @hintergrund
  '
  MENU menfeld$()
  ON MENU  GOSUB menu_bestimmen
  ON MENU KEY GOSUB key_bestimmen
  '
  DO
    ON MENU
  LOOP
ELSE
  PRINT "Shell.INF leider nicht zu finden!!"
  PRINT
  PRINT
  PRINT "Bitte Datei mit folgendem Format im gleichen Ordner wie SHELL.PRG anlegen:"
  PRINT
  PRINT "1. Zeile: Pfad fr PSEUDOCODE-Texte        z.B. \Quellen\PSEUDO"
  PRINT "2. Zeile: Pfad fr Editor (mit Editorname) z.B. \TEMPUS\EDITOR.PRG"
  PRINT
  PRINT
  PRINT "Taste drcken ..."
  REPEAT
  UNTIL LEN(INKEY$)
ENDIF
EDIT
'
PROCEDURE key_bestimmen
  LOCAL code%
  code%=MENU(14) MOD 256
  @select_item(0,code%+32*(code%>93))
RETURN
'
PROCEDURE menu_bestimmen
  @select_item(MENU(0),0)
RETURN
'
PROCEDURE select_item(menu%,code%)
  MENU KILL
  IF menu%=19
    EDIT
  ELSE
    IF menu%=1
      aa$="Shell zu STRUKTO| Ver.1.0 "+CHR$(189)+" 6/89|   Shareware|von Peter Ubachs"
      ALERT 1,aa$,1,"Klar?",dummy%
    ELSE
      IF menu%=11
        @auswahl
      ELSE
        IF menu%=13
          IF NOT ausgewaehlt!
            @auswahl
          ENDIF
          @editor
        ELSE
          IF menu%=14
            IF NOT ausgewaehlt!
              @auswahl
            ENDIF
            @test
          ELSE
            IF menu%=15
              IF NOT ausgewaehlt!
                @auswahl
              ENDIF
              @strukto
            ELSE
              IF menu%=17
                IF NOT ausgewaehlt!
                  @auswahl
                ENDIF
                @editor
                @hintergrund
                @test
                @hintergrund
                @strukto
              ENDIF
            ENDIF
          ENDIF
        ENDIF
      ENDIF
    ENDIF
  ENDIF
  MENU OFF
  '
  @hintergrund
  '
  MENU menfeld$()
  ON MENU  GOSUB menu_bestimmen
  ON MENU KEY GOSUB key_bestimmen
RETURN
'
PROCEDURE split_pfadname(gesamtpfad$,adr_pfad%,adr_dateiname%)
  '  ---------------------------------------------------
  ' zerlegt Gesamtpfad$, wie bei Fileselect erhalten
  ' in den Pfad- u. Dateinamen
  ' (sucht nach letztem \ und trennt dort den String)
  LOCAL backslash_pos%,backslash_pos_alt%
  backslash_pos%=INSTR(gesamtpfad$,"\")
  WHILE backslash_pos%<>0
    backslash_pos_alt%=backslash_pos%
    backslash_pos%=INSTR(gesamtpfad$,"\",backslash_pos_alt%+1)
  WEND
  *adr_pfad%=LEFT$(gesamtpfad$,backslash_pos_alt%-1)
  *adr_dateiname%=MID$(gesamtpfad$,backslash_pos_alt%+1)
RETURN
'
PROCEDURE hintergrund
  '       -----------
  DEFFILL 1,2,4
  PBOX 0,0,639,399
RETURN
'
PROCEDURE auswahl
  '       --------
  FILESELECT alter_pfad$+"\*.PSC",pscdatei$,gespfad$
  IF LEN(gespfad$) AND RIGHT$(gespfad$)<>"\"
    @split_pfadname(gespfad$,*alter_pfad$,*pscdatei$)
    ausgewaehlt!=TRUE
  ELSE
    gespfad$=""
  ENDIF
RETURN
'
PROCEDURE editor
  '       ------
  altfrei%=FRE(0)
  RESERVE 255
  EXEC 0,editorpfad$,CHR$(LEN(gespfad$))+gespfad$+CHR$(0),""
  RESERVE altfrei%-255
RETURN
'
PROCEDURE strukto
  '       -------
  altfrei%=FRE(0)
  RESERVE 255
  EXEC 0,struktopfad$,CHR$(LEN(gespfad$))+gespfad$+CHR$(0),""
  RESERVE altfrei%-255
RETURN
'
PROCEDURE test
  '       ----
  IF EXIST(gespfad$)
    OPEN "I",#1,gespfad$
    CLR zeile%,fehler$,fehler!,ebene%
    str_art%(0)=0
    WHILE (NOT EOF(#1)) AND (NOT fehler!)
      INC zeile%
      LINE INPUT #1,zeile$
      WHILE LEFT$(zeile$)=" " !Leerzeichen an Zeilenanfang entfernen
        zeile$=MID$(zeile$,2)
      WEND
      FOR i%=1 TO anz_schl%
        EXIT IF INSTR(UPPER$(zeile$),UPPER$(schluessel$(i%)))=1
      NEXT i%
      ON art%(i%) GOSUB while,do,repeat,for,if,case_of,wend,enddo,until,endfor,endif,endcase,exit_if,else_if,else,when,otherwise,procedure
    WEND
    CLOSE
    IF ((NOT fehler!) AND (ebene%<>0))
      fehler!=TRUE
      fehler$="ENDE trotz offener|"
      IF str_art%(ebene%)>4
        fehler$=fehler$+"Verzweigung"
      ELSE
        fehler$=fehler$+"Schleife"
      ENDIF
    ENDIF
    IF fehler!
      ALERT 3,fehler$+"|in Zeile "+STR$(zeile%),1,"EDITOR|ABBRUCH",antw%
      IF antw%=1
        altfrei%=FRE(0)
        RESERVE 255
        EXEC 0,editorpfad$,CHR$(LEN(gespfad$+STR$(zeile%))+1)+gespfad$+" "+STR$(zeile%)+CHR$(0),""
        ' TEMPUS ist damit gleich in der fehlerhaften Zeile
        RESERVE altfrei%-255
        @hintergrund
        @test
      ENDIF
    ENDIF
  ELSE
    ALERT 3,"Bitte erst eine|Datei ausw„hlen!",1,"Ja",dummy%
  ENDIF
RETURN
'
schluessel:
DATA while,1,do,2,repeat,3,for,4,if,5,case of,6
DATA wend,7,enddo,8,end do,8,until,9,endfor,10,end for,10,next,10,endif,11
DATA endcase,12,end case,12
DATA exit if,13,else if,14,elsif,14,else,15,when,16,otherwise,17,default,17
DATA procedure,18
'
PROCEDURE while
  INC ebene%
  str_art%(ebene%)=art%(i%)
RETURN
PROCEDURE do
  INC ebene%
  str_art%(ebene%)=art%(i%)
RETURN
PROCEDURE repeat
  INC ebene%
  str_art%(ebene%)=art%(i%)
RETURN
PROCEDURE for
  INC ebene%
  str_art%(ebene%)=art%(i%)
RETURN
PROCEDURE if
  INC ebene%
  str_art%(ebene%)=art%(i%)
RETURN
PROCEDURE case_of
  INC ebene%
  str_art%(ebene%)=art%(i%)
RETURN
PROCEDURE wend
  IF str_art%(ebene%)<>art%(i%)-6
    fehler!=TRUE
    fehler$="WEND ohne WHILE"
  ELSE
    DEC ebene%
  ENDIF
RETURN
PROCEDURE enddo
  IF str_art%(ebene%)<>art%(i%)-6
    fehler!=TRUE
    fehler$=UPPER$(schluessel$(i%))+" ohne DO"
  ELSE
    DEC ebene%
  ENDIF
RETURN
PROCEDURE until
  IF str_art%(ebene%)<>art%(i%)-6
    fehler!=TRUE
    fehler$="UNTIL ohne REPEAT"
  ELSE
    DEC ebene%
  ENDIF
RETURN
PROCEDURE endfor
  IF str_art%(ebene%)<>art%(i%)-6
    fehler!=TRUE
    fehler$=UPPER$(schluessel$(i%))+" ohne FOR"
  ELSE
    DEC ebene%
  ENDIF
RETURN
PROCEDURE endif
  IF str_art%(ebene%)<>art%(i%)-6
    fehler!=TRUE
    fehler$="ENDIF ohne IF"
  ELSE
    DEC ebene%
  ENDIF
RETURN
PROCEDURE endcase
  IF str_art%(ebene%)<>art%(i%)-6
    fehler!=TRUE
    fehler$=UPPER$(schluessel$(i%))+" ohne CASE OF"
  ELSE
    DEC ebene%
  ENDIF
RETURN
PROCEDURE exit_if
  IF str_art%(ebene%)>4
    fehler!=TRUE
    fehler$="EXIT IF ohne Schleife"
  ENDIF
RETURN
PROCEDURE else_if
  IF str_art%(ebene%)<>5
    fehler!=TRUE
    fehler$=UPPER$(schluessel$(i%))+" ohne IF"
  ENDIF
RETURN
PROCEDURE else
  IF str_art%(ebene%)<>5 AND str_art%(ebene%)<>6
    fehler!=TRUE
    fehler$="ELSE ohne Verzweigung"
  ENDIF
RETURN
PROCEDURE when
  IF str_art%(ebene%)<>6
    fehler!=TRUE
    fehler$="WHEN ohne CASE OF"
  ENDIF
RETURN
PROCEDURE otherwise
  IF str_art%(ebene%)<>6
    fehler!=TRUE
    fehler$=UPPER$(schluessel$(i%))+" ohne CASE OF"
  ENDIF
RETURN
PROCEDURE procedure
  IF ebene%<>0
    fehler!=TRUE
    fehler$="PROCEDURE in "
    IF str_art%(ebene%)>4
      fehler$=fehler$+"Verzweigung"
    ELSE
      fehler$=fehler$+"Schleife"
    ENDIF
  ENDIF
RETURN