diff options
Diffstat (limited to 'menugenerator/ls-Menu-Generator 2')
| -rw-r--r-- | menugenerator/ls-Menu-Generator 2 | 720 |
1 files changed, 673 insertions, 47 deletions
diff --git a/menugenerator/ls-Menu-Generator 2 b/menugenerator/ls-Menu-Generator 2 index 608f680..e38fc7e 100644 --- a/menugenerator/ls-Menu-Generator 2 +++ b/menugenerator/ls-Menu-Generator 2 @@ -22,51 +22,677 @@ *) -PACKET ls menu generator 2 DEFINES{} oeffne menukarte,{} oeffne menu,{} oberbegriff,{} menufunktion,{} trennlinie,{} schliesse menu,{} schliesse menukarte,{} testinstallation:{}LET menutafeltype = 1954,{} kennung = "ls - Menu - Generator",{} mm taskname = "ls-MENUKARTEN",{} menutafelpraefix = "ls-MENUKARTE:",{} menu grundtext = "ls-MENUBASISTEXTE",{} zwischenablagename = "MENU-ZWISCHENABLAGEDATEI INTERN";{} -LET maxmenus = 6,{} maxmenutexte = 300,{} maxinfotexte = 2000,{} maxhauptmenupunkte = 10,{} maxuntermenupunkte = 15,{} maxmenubreite = 71; (* Breite der Hauptmenüzeile - 2 *){}LET blank = " ",{} cleop = ""4"",{} piep = ""7"",{} trennzeilensymbol = "###",{} bleibt leer symbol = "***",{} hauptmenuluecke = " ";{}LET dummyname = "Dummy für Anwendertexte",{} - install finished = "Installation abgeschlossen!",{} card finished = "Menukartengenerierung abgeschlossen!",{} filetype = 1003;{}TYPE MENUPUNKT = STRUCT (TEXT punktkuerzel,{} punktname,{} procname,{} boxtext,{} BOOL aktiv,{} angewaehlt),{} EINZELMENU = STRUCT (INT belegt,{} TEXT ueberschrift,{} - INT anfangsposition,{} maxlaenge,{} ROW maxuntermenupunkte MENUPUNKT menupunkt,{} INT aktueller untermenupunkt,{} TEXT startprozedurname,{} leaveprozedurname),{} MENU = STRUCT (TEXT menuname,{} INT anzahl hauptmenupunkte,{} ROW maxhauptmenupunkte EINZELMENU einzelmenu,{} - TEXT menueingangsprozedur,{} menuausgangsprozedur,{} menuinfo,{} lizenznummer,{} versionsnummer,{} INT hauptmenuzeiger,{} untermenuanfang,{} untermenuzeiger),{} INFOTEXT = STRUCT (INT anzahl infotexte,{} ROW maxinfotexte TEXT stelle),{} - MENUTEXT = STRUCT (INT anzahl menutexte,{} ROW maxmenutexte TEXT platz),{} MENULEISTE = STRUCT (INT belegt, zeigeraktuell, zeigerhintergrund,{} ROW maxmenus MENU menu,{} MENUTEXT menutext,{} INFOTEXT infotext);{}ROW 14 TEXT CONST aussage :: ROW 14 TEXT : ({}"ACHTUNG - Eine Menukarte mit diesem Namen existiert bereits - ACHTUNG",{}"Kann die bereits existierende Menukarte gelöscht werden",{} -"Dann kann keine neue Menukarte mit diesem Namen erstellt werden!",{}"Zum Weitermachen bitte irgendeine Taste tippen!",{}"Sollen auch Anwendungstexte in die Menukarte aufgenommen werden",{}"Auswahl der Datei, in der die Anwendungstexte stehen.",{}"Bitte die gewünschte Datei ankreuzen!",{}"Durchgang 1 von 2 Durchgängen - in Arbeit ist Zeile: ",{}"Durchgang 2 von 2 Durchgängen - in Arbeit ist Zeile: ",{}"",{}"Einlesen von Texten aus Datei : ",{}"Bearbeitet wird Menu : ",{}"Eingetragen wird Oberbegriff : ",{} -"Eingetragen wird Menufunktion : "{});{}ROW 22 TEXT CONST fehlermeldung :: ROW 22 TEXT : ({}"Ohne die Datei '",{}"' "13""10""10" ist die Menuerstellung "15"unmöglich "14"!!",{}"Hier muß unbedingt eine Datei angekreuzt werden!",{}"Ausgewählte Datei hat falschen Typ (<> 1003) )",{}"Zu viele Anwendungstexte in der Datei ",{}"Anführungszeichen fehlt am Anfang oder Ende der Zeile ",{}"Anführungszeichen fehlt irgendwo in Zeile ",{}"Die angegebene Datei existiert nicht!",{}"Menukarte noch nicht geöffnet ('oeffne menukarte' fehlt)! ",{} -"Vorausgehendes Menu nicht geschlossen! ",{}"Zu viele Menus in der Menukarte (> " + text (maxmenus) + ")!",{}"Menuname ist mehrfach vorhanden!",{}"Menu noch nicht geoeffnet ('oeffne menu' fehlt)!",{}"Zu viele Oberbegriffe in einem Menu (> " + text (maxhauptmenupunkte) + ")!",{}"Die Kopfzeile ist zu lang (> " + text (maxmenubreite) + ")!",{}"Menupunkt-Kürzel ist länger als ein Zeichen!",{}"Menupunkt-Kürzel kommt mehrfach vor (nicht eindeutig)!",{}"Menupunkt-Bezeichnung ist zu lang!",{}"Zu viele (> " + text (maxuntermenupunkte) + ") Menupunkte in einem Pull-Down-Menu!",{} -"Menukarte '",{}"' gibt es nicht in dieser Task!",{}"' hat falsche(n) Typ/Bezeichnung"{});{}TEXT VAR menuinfotextdateiname,{} aktueller menudateiname;{}BOOL VAR menuleiste ist bereit :: FALSE,{} menu ist geoeffnet :: FALSE;{}BOUND MENULEISTE VAR menuleiste;{}BOUND MENUTEXT VAR basistexte;{}BOUND MENU VAR aktuelles menu;{}DATASPACE VAR ds;{}OP := (MENUTEXT VAR ziel, MENUTEXT VAR quelle):{} INT VAR z;{} ziel.anzahl menutexte := quelle.anzahl menutexte;{} FOR z FROM 1 UPTO quelle.anzahl menutexte REP{} - ziel.platz [z] := quelle.platz [z]{} PER{}END OP :=;{}OP := (MENU VAR ziel, MENU CONST quelle):{} CONCR (ziel) := CONCR (quelle){}END OP :=;{}OP := (EINZELMENU VAR ziel, EINZELMENU CONST quelle):{} CONCR (ziel) := CONCR (quelle){}END OP :=;{}OP := (MENUPUNKT VAR ziel, MENUPUNKT CONST quelle):{} CONCR (ziel) := CONCR (quelle){}END OP :=;{}PROC oeffne menukarte (TEXT CONST menukartenname):{} gib bildschirmhinweis aus;{} ueberpruefe voraussetzungen;{} erfrage den namen der datei mit den anwendertexten;{} - erstelle neue menuleiste.{} gib bildschirmhinweis aus:{} page; out (center (invers (kennung))).{} ueberpruefe voraussetzungen:{} ueberpruefe ob basistexte vorhanden sind;{} ueberpruefe ob menukarte schon vorhanden ist.{} ueberpruefe ob basistexte vorhanden sind:{} IF NOT exists (menu grundtext){} THEN gib hinweis und brich ab{} FI.{} gib hinweis und brich ab:{} disable stop;{} fetch (menu grundtext, /mm taskname);{} IF is error{} THEN clear error;{} enable stop;{} - cursor (1, 4); out (cleop);{} errorstop (fehlermeldung [1] + menu grundtext + fehlermeldung [2]){} ELSE clear error;{} enable stop{} FI.{} ueberpruefe ob menukarte schon vorhanden ist:{} IF exists (menukarte){} THEN gib hinweis auf vorhandene menukarte;{} frage ob die alte karte geloescht werden darf{} FI.{} menukarte:{} menutafelpraefix + menukartenname.{} gib hinweis auf vorhandene menukarte:{} cursor (1, 4); out (cleop);{} - cursor (1, 4); out (center (menukarte));{} cursor (1, 6); out (center (invers (aussage [1]))).{} frage ob die alte karte geloescht werden darf:{} cursor (2, 9);{} IF yes (aussage [2]){} THEN forget (menukarte, quiet){} ELSE weiterarbeit ist unmoeglich{} FI.{} weiterarbeit ist unmoeglich:{} cursor (1, 12); out (center (invers (aussage [3])));{} cursor (2, 15); out (aussage [4]);{} cursor (2, 16); pause; page;{} errorstop ("").{} erfrage den namen der datei mit den anwendertexten:{} - cursor (1, 4); out (cleop);{} IF yes (aussage [5]){} THEN biete dateiauswahl an{} ELSE erzeuge dateidummy{} FI.{} biete dateiauswahl an:{} menuinfotextdateiname := one (2, 6, 77, 19, ALL myself,{} aussage [6], aussage [7]);{} ueberpruefe den dateinamen;{} ueberpruefe den dateityp.{} ueberpruefe den dateinamen:{} IF compress (menuinfotextdateiname) = ""{} THEN page; errorstop (fehlermeldung [3]){} FI.{} ueberpruefe den dateityp:{} - IF datei hat falschen typ{} THEN page; errorstop (fehlermeldung [4]){} FI.{} datei hat falschen typ:{} ds := old (menuinfotextdateiname);{} IF type (ds) <> filetype{} THEN forget (ds); TRUE{} ELSE forget (ds); FALSE{} FI.{} erzeuge dateidummy:{} forget (dummyname, quiet);{} FILE VAR datei :: sequential file (modify, dummyname);{} to line (datei, 1);{} menuinfotextdateiname := dummyname.{} erstelle neue menuleiste:{} INT VAR zeiger;{} TEXT VAR zeileninhalt;{} - initialisiere werte;{} aktueller menudateiname := menukarte;{} menuleiste := new (aktueller menudateiname);{} type (old (aktueller menudateiname), menutafeltype);{} menuleiste.belegt := 0;{} menuleiste ist bereit := TRUE;{} trage menubasistexte ein;{} trage anwendungstexte ein.{} initialisiere werte:{} menuleiste ist bereit := FALSE;{} menu ist geoeffnet := FALSE.{} trage menubasistexte ein:{} basistexte := old (menu grundtext);{} - menuleiste.menutext := basistexte.{} trage anwendungstexte ein:{} konvertiere (menuinfotextdateiname, zwischenablagename,{} menuleiste.infotext.anzahl infotexte);{} ueberpruefe anwendungstextanzahl;{} trage anwendungstexte in die menuleiste.{} ueberpruefe anwendungstextanzahl:{} IF menuleiste.infotext.anzahl infotexte > maxinfotexte{} THEN forget (zwischenablagename, quiet);{} forget (aktueller menudateiname, quiet);{} errorstop (fehlermeldung [5] + "'" + menuinfotextdateiname + "'"){} - FI.{} trage anwendungstexte in die menuleiste:{} gib hinweis auf anwendungstexteintrag;{} FILE VAR ein :: sequential file (input, zwischenablagename);{} FOR zeiger FROM 1 UPTO menuleiste.infotext.anzahl infotexte REP{} getline (ein, zeileninhalt);{} menuleiste.infotext.stelle [zeiger] := zeileninhalt;{} cout (zeiger){} PER;{} forget (zwischenablagename, quiet);{} forget (dummyname , quiet).{} gib hinweis auf anwendungstexteintrag:{} cursor (1, 7); out (aussage [9]).{} -END PROC oeffne menukarte;{}PROC konvertiere (TEXT CONST eingabedatei, ausgabedatei,{} INT VAR anzahl konvertierter saetze):{} loesche ausgabedatei;{} untersuche eingabedatei;{} konvertiere saetze.{} loesche ausgabedatei:{} IF exists (ausgabedatei){} THEN forget (ausgabedatei, quiet){} FI.{} untersuche eingabedatei:{} IF NOT exists (eingabedatei){} THEN errorstop (fehlermeldung [8]){} FI.{} konvertiere saetze:{} gib hinweis;{} konvertiere satzweise.{} - gib hinweis:{} cursor (1, 4); out (cleop);{} cursor (1, 4); out (aussage [11] + "'" + eingabedatei + "'");{} cursor (1, 6); out (aussage [ 8]);{} anzahl konvertierter saetze := 0.{} konvertiere satzweise:{} TEXT VAR zeileninhalt :: "";{} FILE VAR eingabe :: sequential file (input, eingabedatei);{} WHILE NOT eof (eingabe) REP{} behandle eine dateizeile{} PER;{} optimiere ausgabedatei.{} behandle eine dateizeile:{} getline (eingabe, zeileninhalt);{} anzahl konvertierter saetze INCR 1;{} - cout (anzahl konvertierter saetze);{} untersuche zeile;{} wandle die zeile um;{} FILE VAR aus :: sequential file (output, ausgabedatei);{} write (aus, textausgabe).{} untersuche zeile:{} zeileninhalt := compress (zeileninhalt);{} IF zeileninhalt = ""{} THEN zeileninhalt := """"""{} FI;{} IF (zeileninhalt SUB 1) <> """"{} OR (zeileninhalt SUB length (zeileninhalt)) <> """"{} THEN bereite abgang vor;{} errorstop (fehlermeldung [6] + text (anzahl konvertierter saetze)){} - FI.{} wandle die zeile um:{} TEXT VAR textausgabe :: "", codekette;{} zeileninhalt := subtext (zeileninhalt, 2, length (zeileninhalt) - 1);{} WHILE gaensefuesschenposition > 0 REP{} textausgabe CAT subtext (zeileninhalt, 1, gaensefuesschenposition - 1);{} zeileninhalt := subtext (zeileninhalt, gaensefuesschenposition);{} codekette := subtext (zeileninhalt, 1, pos (zeileninhalt, """", 2));{} IF codekette = """7"""{} THEN textausgabe CAT ""7""{} - ELIF codekette = """5"""{} THEN textausgabe CAT ""5""{} ELIF codekette = """4"""{} THEN textausgabe CAT ""4""{} ELIF codekette = """10"""{} THEN textausgabe CAT ""10""{} ELIF codekette = """13"""{} THEN textausgabe CAT ""13""{} ELIF codekette = """14"""{} THEN textausgabe CAT ""14""{} ELIF codekette = """15"""{} THEN textausgabe CAT ""15""{} ELIF codekette = """"""{} THEN textausgabe CAT """"{} - ELSE errorstop (fehlermeldung [7] +{} text (anzahl konvertierter saetze)){} FI;{} zeileninhalt := subtext (zeileninhalt, 1 + length (codekette)){} PER;{} textausgabe CAT zeileninhalt.{} gaensefuesschenposition:{} pos (zeileninhalt, """").{} bereite abgang vor:{} forget (ausgabedatei, quiet);{} line (2).{} optimiere ausgabedatei:{} FILE VAR ausgabe :: sequential file (modify, ausgabedatei);{} WHILE lines (ausgabe) > 0 CAND letzter satz ist leer REP{} - to line (ausgabe, lines (ausgabe));{} delete record (ausgabe);{} anzahl konvertierter saetze DECR 1;{} cout (anzahl konvertierter saetze ){} PER.{} letzter satz ist leer:{} TEXT VAR satz;{} to line (ausgabe,lines (ausgabe));{} read record (ausgabe, satz);{} IF compress (satz) = "" OR compress (satz) = ""13""{} THEN TRUE{} ELSE FALSE{} FI.{}END PROC konvertiere;{}PROC oeffne menu (TEXT CONST name, einstiegsproc, ausstiegsproc,{} itext, ltext, vtext):{} - gib hinweis auf geoeffnetes menu;{} ueberpruefe auf ungereimtheiten;{} nimm eintragungen in datenraum vor.{} gib hinweis auf geoeffnetes menu:{} cursor (1, 4); out (cleop);{} out (aussage [12]); out (invers (name));{} cursor (1, 6).{} ueberpruefe auf ungereimtheiten:{} pruefe auf bereits geoeffnete menuliste;{} pruefe auf noch geoeffnetes menu;{} pruefe auf noch freie menuplaetze;{} pruefe auf schon vorhandenen menunamen.{} pruefe auf bereits geoeffnete menuliste:{} IF NOT menuleiste ist bereit{} - THEN bereinige eintragungen (9){} FI.{} pruefe auf noch geoeffnetes menu:{} IF menu ist geoeffnet{} THEN bereinige eintragungen (10){} FI.{} pruefe auf noch freie menuplaetze:{} IF menuleiste.belegt = maxmenus{} THEN bereinige eintragungen (11){} FI.{} pruefe auf schon vorhandenen menunamen:{} IF menuname schon vorhanden{} THEN bereinige eintragungen (12){} FI.{} menuname schon vorhanden:{} INT VAR i;{} FOR i FROM 1 UPTO menuleiste.belegt REP{} - untersuche einzelnen menunamen{} PER;{} FALSE.{} untersuche einzelnen menunamen:{} IF menuleiste.menu [i].menuname = compress (name){} THEN LEAVE menuname schon vorhanden WITH TRUE{} FI.{} nimm eintragungen in datenraum vor:{} forget (ds);{} ds := nilspace;{} aktuelles menu := ds;{} init (aktuelles menu);{} aktuelles menu.menuname := compress (name);{} aktuelles menu.menueingangsprozedur := compress (einstiegsproc);{} - aktuelles menu.menuausgangsprozedur := compress (ausstiegsproc);{} IF itext <> ""{} THEN aktuelles menu.menuinfo := itext;{} aktuelles menu.lizenznummer := ltext;{} aktuelles menu.versionsnummer := vtext{} ELSE aktuelles menu.menuinfo := bleibt leer symbol;{} aktuelles menu.lizenznummer := "";{} aktuelles menu.versionsnummer := ""{} FI;{} menu ist geoeffnet := TRUE.{}END PROC oeffne menu;{} -PROC oeffne menu (TEXT CONST name, einstiegsproc, ausstiegsproc):{} oeffne menu (name, einstiegsproc, ausstiegsproc, "", "", ""){}END PROC oeffne menu;{}PROC oeffne menu (TEXT CONST name):{} oeffne menu (name, "", "", "", "", ""){}END PROC oeffne menu;{}PROC bereinige eintragungen (INT CONST nummer):{} forget (ds);{} forget (aktueller menudateiname, quiet);{} menuleiste ist bereit := FALSE;{} menu ist geoeffnet := FALSE;{} errorstop (fehlermeldung [nummer]){}END PROC bereinige eintragungen;{} -PROC init (MENU VAR m):{} m.menuname := "";{} m.hauptmenuzeiger := 1;{} m.untermenuanfang := 0;{} m.untermenuzeiger := 0;{} m.menueingangsprozedur := "";{} m.menuausgangsprozedur := "";{} m.menuinfo := "";{} m.versionsnummer := "";{} m.anzahl hauptmenupunkte := 0;{} belege hauptmenupunkte.{} belege hauptmenupunkte:{} INT VAR i;{} FOR i FROM 1 UPTO maxhauptmenupunkte REP{} - aktuelles einzelmenu.belegt := 0;{} aktuelles einzelmenu.ueberschrift := "";{} aktuelles einzelmenu.anfangsposition := 0;{} aktuelles einzelmenu.maxlaenge := 0;{} aktuelles einzelmenu.aktueller untermenupunkt := 1;{} aktuelles einzelmenu.startprozedurname := "";{} aktuelles einzelmenu.leaveprozedurname := "";{} belege untermenuepunkte{} PER.{} belege untermenuepunkte:{} - INT VAR j;{} FOR j FROM 1 UPTO maxuntermenupunkte REP{} aktueller menupunkt.punktkuerzel := "";{} aktueller menupunkt.punktname := "";{} aktueller menupunkt.procname := "";{} aktueller menupunkt.boxtext := "";{} aktueller menupunkt.aktiv := TRUE;{} aktueller menupunkt.angewaehlt := FALSE{} PER.{} aktuelles einzelmenu: m.einzelmenu [i].{} aktueller menupunkt: aktuelles einzelmenu.menupunkt [j].{}END PROC init;{}PROC oberbegriff (TEXT CONST punktname, startprocname, leaveprocname):{} - gib hinweis auf oberbegriff;{} untersuche ob menu geoeffnet und bereit ist;{} untersuche oberbegriffe;{} trage neuen oberbegriff ein;{} notiere die anfangsposition;{} notiere start und leaveprozedur;{} erhoehe die anzahl der oberbegriffe.{} gib hinweis auf oberbegriff:{} cursor (1, 6); out (cleop);{} cursor (1, 6); out (aussage [13]); out (invers (punktname)); line.{} untersuche ob menu geoeffnet und bereit ist:{} IF NOT menuleiste ist bereit{} THEN bereinige eintragungen ( 9){} - FI;{} IF NOT menu ist geoeffnet{} THEN bereinige eintragungen (13){} FI.{} untersuche oberbegriffe:{} IF zu viele oberbegriffe{} THEN bereinige eintragungen (14){} FI;{} IF gesamtlaenge > maxmenubreite{} THEN bereinige eintragungen (15){} FI.{} zu viele oberbegriffe:{} aktuelles menu.anzahl hauptmenupunkte = maxhauptmenupunkte.{} gesamtlaenge:{} gesamtlaenge ohne letzten punkt + length (compress (punktname)).{} gesamtlaenge ohne letzten punkt:{} length (hauptmenuzeile).{} - hauptmenuzeile:{} INT VAR zaehler;{} TEXT VAR zeile :: "";{} schreibe menunamen;{} schreibe oberbegriffe;{} zeile.{} schreibe menunamen:{} IF aktuelles menu. menuname <> ""{} THEN zeile CAT aktuelles menu.menuname;{} zeile CAT ":"{} FI.{} schreibe oberbegriffe:{} FOR zaehler FROM 1 UPTO aktuelles menu.anzahl hauptmenupunkte REP{} zeile CAT hauptmenuluecke;{} zeile CAT aktuelles menu. einzelmenu [zaehler].ueberschrift{} PER;{} zeile CAT hauptmenuluecke.{} - trage neuen oberbegriff ein:{} neuer menupunkt.ueberschrift := compress (punktname).{} notiere die anfangsposition:{} neuer menupunkt.anfangsposition := gesamtlaenge ohne letzten punkt + 1.{} notiere start und leaveprozedur:{} neuer menupunkt.startprozedurname := compress (startprocname);{} neuer menupunkt.leaveprozedurname := compress (leaveprocname).{} neuer menupunkt:{} aktuelles menu.einzelmenu [aktuelles menu.anzahl hauptmenupunkte + 1].{} erhoehe die anzahl der oberbegriffe:{} - aktuelles menu.anzahl hauptmenupunkte INCR 1.{}END PROC oberbegriff;{}PROC oberbegriff (TEXT CONST punktname):{} oberbegriff (punktname, "", ""){}END PROC oberbegriff;{}PROC menufunktionseintrag (TEXT CONST kuerzel,{} punktbezeichnung,{} prozedurname,{} infotext,{} BOOL CONST ist aktiv):{} gib hinweis auf menufunktionseintrag;{} trage menupunkt ein;{} organisiere menu neu.{} - gib hinweis auf menufunktionseintrag:{} line;{} out (aussage [14]);{} out ("'" + kuerzelzeichen + "' - " + punktname).{} kuerzelzeichen:{} IF kuerzel = "" THEN " " ELSE kuerzel FI.{} punktname:{} IF punktbezeichnung = trennzeilensymbol{} THEN "----------"{} ELSE punktbezeichnung{} FI.{} trage menupunkt ein:{} ueberpruefe das kuerzel;{} ueberpruefe die punktbreite;{} ueberpruefe die eintragsnummer;{} aktuelles menu.einzelmenu [stelle].belegt INCR 1;{} - aktueller menupunkt.punktkuerzel := compress (kuerzel);{} aktueller menupunkt.punktname := normierter menupunkt;{} aktueller menupunkt.procname := compress (prozedurname);{} aktueller menupunkt.boxtext := infotext;{} aktueller menupunkt.aktiv := ist aktiv;{} aktueller menupunkt.angewaehlt := FALSE.{} aktueller menupunkt:{} aktuelles untermenu.menupunkt [aktuelles untermenu.belegt].{} aktuelles untermenu:{} aktuelles menu.einzelmenu [stelle].{} - stelle:{} aktuelles menu.anzahl hauptmenupunkte.{} normierter menupunkt:{} blank + compress (punktbezeichnung).{} ueberpruefe das kuerzel:{} TEXT VAR kurz :: compress (kuerzel);{} IF kuerzel ist zu lang{} THEN bereinige eintragungen (16){} ELIF kuerzel ist schon vorhanden{} THEN bereinige eintragungen (17){} FI.{} kuerzel ist zu lang:{} length (kurz) > 1.{} kuerzel ist schon vorhanden:{} (length (kurz) = 1) AND (pos (vorhandene kuerzel, kurz) > 0).{} - vorhandene kuerzel:{} TEXT VAR liste :: "";{} INT VAR zeiger;{} FOR zeiger FROM 1 UPTO aktuelles untermenu.belegt REP{} liste CAT aktuelles untermenu.menupunkt [zeiger].punktkuerzel{} PER;{} liste.{} ueberpruefe die punktbreite:{} IF length (compress (punktbezeichnung)) > maxmenubreite - 10{} THEN bereinige eintragungen (18){} FI.{} ueberpruefe die eintragsnummer:{} IF aktuelles untermenu.belegt = maxuntermenupunkte{} THEN bereinige eintragungen (19){} - FI.{} organisiere menu neu:{} IF neue punktlaenge > aktuelles untermenu.maxlaenge{} THEN aktuelles untermenu.maxlaenge := neue punktlaenge{} FI.{} neue punktlaenge:{} length (aktueller menupunkt.punktname).{}END PROC menufunktionseintrag;{}PROC menufunktion (TEXT CONST kuerzel, punktbezeichnung,{} prozedurname, infotext):{} menufunktionseintrag (kuerzel, punktbezeichnung, prozedurname, infotext,{} TRUE){}END PROC menufunktion;{} -PROC trennlinie:{} menufunktionseintrag ("", trennzeilensymbol, "", "", FALSE){}END PROC trennlinie;{}PROC schliesse menu:{} menuleiste. belegt INCR 1;{} menuleiste.menu [menuleiste.belegt] := aktuelles menu;{} menu ist geoeffnet := FALSE{}END PROC schliesse menu;{}PROC schliesse menukarte:{} forget (ds);{} page; out (piep); put (card finished){}END PROC schliesse menukarte;{}PROC testinstallation (TEXT CONST kartenname):{} ueberpruefe menukarte;{} nimm installation vor.{} - ueberpruefe menukarte:{} IF NOT exists (kartenname){} THEN errorstop (fehlermeldung [20] + kartenname + fehlermeldung [21]){} ELIF (pos (kartenname, menutafelpraefix) <> 1){} OR (type (old (kartenname)) <> menutafeltype){} THEN errorstop (fehlermeldung [20] + kartenname + fehlermeldung [22]){} FI.{} nimm installation vor:{} TEXT CONST neuer kartenname{} :: kartenname + " von Task '" + name (myself) + "'";{} command dialogue (FALSE);{} - rename (kartenname, neuer kartenname);{} save (neuer kartenname,task (mmtaskname));{} forget (neuer kartenname, quiet);{} reset dialog;{} install menu (neuer kartenname, FALSE);{} fetch (neuer kartenname, task (mmtaskname));{} rename (neuer kartenname, kartenname);{} command dialogue (TRUE);{} page; out (piep); put (install finished){}END PROC testinstallation;{}END PACKET ls menu generator 2;{} +PACKET ls menu generator 2 DEFINES + oeffne menukarte, + oeffne menu, + oberbegriff, + menufunktion, + trennlinie, + schliesse menu, + schliesse menukarte, + testinstallation: +LET menutafeltype = 1954, + kennung = "ls - Menu - Generator", + mm taskname = "ls-MENUKARTEN", + menutafelpraefix = "ls-MENUKARTE:", + menu grundtext = "ls-MENUBASISTEXTE", + zwischenablagename = "MENU-ZWISCHENABLAGEDATEI INTERN"; + +LET maxmenus = 6, + maxmenutexte = 300, + maxinfotexte = 2000, + maxhauptmenupunkte = 10, + maxuntermenupunkte = 15, + maxmenubreite = 71; (* Breite der Hauptmenüzeile - 2 *) +LET blank = " ", + cleop = ""4"", + piep = ""7"", + trennzeilensymbol = "###", + bleibt leer symbol = "***", + hauptmenuluecke = " "; +LET dummyname = "Dummy für Anwendertexte", + + install finished = "Installation abgeschlossen!", + card finished = "Menukartengenerierung abgeschlossen!", + filetype = 1003; +TYPE MENUPUNKT = STRUCT (TEXT punktkuerzel, + punktname, + procname, + boxtext, + BOOL aktiv, + angewaehlt), + EINZELMENU = STRUCT (INT belegt, + TEXT ueberschrift, + + INT anfangsposition, + maxlaenge, + ROW maxuntermenupunkte MENUPUNKT menupunkt, + INT aktueller untermenupunkt, + TEXT startprozedurname, + leaveprozedurname), + MENU = STRUCT (TEXT menuname, + INT anzahl hauptmenupunkte, + ROW maxhauptmenupunkte EINZELMENU einzelmenu, + + TEXT menueingangsprozedur, + menuausgangsprozedur, + menuinfo, + lizenznummer, + versionsnummer, + INT hauptmenuzeiger, + untermenuanfang, + untermenuzeiger), + INFOTEXT = STRUCT (INT anzahl infotexte, + ROW maxinfotexte TEXT stelle), + + MENUTEXT = STRUCT (INT anzahl menutexte, + ROW maxmenutexte TEXT platz), + MENULEISTE = STRUCT (INT belegt, zeigeraktuell, zeigerhintergrund, + ROW maxmenus MENU menu, + MENUTEXT menutext, + INFOTEXT infotext); +ROW 14 TEXT CONST aussage :: ROW 14 TEXT : ( +"ACHTUNG - Eine Menukarte mit diesem Namen existiert bereits - ACHTUNG", +"Kann die bereits existierende Menukarte gelöscht werden", + +"Dann kann keine neue Menukarte mit diesem Namen erstellt werden!", +"Zum Weitermachen bitte irgendeine Taste tippen!", +"Sollen auch Anwendungstexte in die Menukarte aufgenommen werden", +"Auswahl der Datei, in der die Anwendungstexte stehen.", +"Bitte die gewünschte Datei ankreuzen!", +"Durchgang 1 von 2 Durchgängen - in Arbeit ist Zeile: ", +"Durchgang 2 von 2 Durchgängen - in Arbeit ist Zeile: ", +"", +"Einlesen von Texten aus Datei : ", +"Bearbeitet wird Menu : ", +"Eingetragen wird Oberbegriff : ", + +"Eingetragen wird Menufunktion : " +); +ROW 22 TEXT CONST fehlermeldung :: ROW 22 TEXT : ( +"Ohne die Datei '", +"' "13""10""10" ist die Menuerstellung "15"unmöglich "14"!!", +"Hier muß unbedingt eine Datei angekreuzt werden!", +"Ausgewählte Datei hat falschen Typ (<> 1003) )", +"Zu viele Anwendungstexte in der Datei ", +"Anführungszeichen fehlt am Anfang oder Ende der Zeile ", +"Anführungszeichen fehlt irgendwo in Zeile ", +"Die angegebene Datei existiert nicht!", +"Menukarte noch nicht geöffnet ('oeffne menukarte' fehlt)! ", + +"Vorausgehendes Menu nicht geschlossen! ", +"Zu viele Menus in der Menukarte (> " + text (maxmenus) + ")!", +"Menuname ist mehrfach vorhanden!", +"Menu noch nicht geoeffnet ('oeffne menu' fehlt)!", +"Zu viele Oberbegriffe in einem Menu (> " + text (maxhauptmenupunkte) + ")!", +"Die Kopfzeile ist zu lang (> " + text (maxmenubreite) + ")!", +"Menupunkt-Kürzel ist länger als ein Zeichen!", +"Menupunkt-Kürzel kommt mehrfach vor (nicht eindeutig)!", +"Menupunkt-Bezeichnung ist zu lang!", +"Zu viele (> " + text (maxuntermenupunkte) + ") Menupunkte in einem Pull-Down-Menu!", + +"Menukarte '", +"' gibt es nicht in dieser Task!", +"' hat falsche(n) Typ/Bezeichnung" +); +TEXT VAR menuinfotextdateiname, + aktueller menudateiname; +BOOL VAR menuleiste ist bereit :: FALSE, + menu ist geoeffnet :: FALSE; +BOUND MENULEISTE VAR menuleiste; +BOUND MENUTEXT VAR basistexte; +BOUND MENU VAR aktuelles menu; +DATASPACE VAR ds; +OP := (MENUTEXT VAR ziel, MENUTEXT VAR quelle): + INT VAR z; + ziel.anzahl menutexte := quelle.anzahl menutexte; + FOR z FROM 1 UPTO quelle.anzahl menutexte REP + + ziel.platz [z] := quelle.platz [z] + PER +END OP :=; +OP := (MENU VAR ziel, MENU CONST quelle): + CONCR (ziel) := CONCR (quelle) +END OP :=; +OP := (EINZELMENU VAR ziel, EINZELMENU CONST quelle): + CONCR (ziel) := CONCR (quelle) +END OP :=; +OP := (MENUPUNKT VAR ziel, MENUPUNKT CONST quelle): + CONCR (ziel) := CONCR (quelle) +END OP :=; +PROC oeffne menukarte (TEXT CONST menukartenname): + gib bildschirmhinweis aus; + ueberpruefe voraussetzungen; + erfrage den namen der datei mit den anwendertexten; + + erstelle neue menuleiste. + gib bildschirmhinweis aus: + page; out (center (invers (kennung))). + ueberpruefe voraussetzungen: + ueberpruefe ob basistexte vorhanden sind; + ueberpruefe ob menukarte schon vorhanden ist. + ueberpruefe ob basistexte vorhanden sind: + IF NOT exists (menu grundtext) + THEN gib hinweis und brich ab + FI. + gib hinweis und brich ab: + disable stop; + fetch (menu grundtext, /mm taskname); + IF is error + THEN clear error; + enable stop; + + cursor (1, 4); out (cleop); + errorstop (fehlermeldung [1] + menu grundtext + fehlermeldung [2]) + ELSE clear error; + enable stop + FI. + ueberpruefe ob menukarte schon vorhanden ist: + IF exists (menukarte) + THEN gib hinweis auf vorhandene menukarte; + frage ob die alte karte geloescht werden darf + FI. + menukarte: + menutafelpraefix + menukartenname. + gib hinweis auf vorhandene menukarte: + cursor (1, 4); out (cleop); + + cursor (1, 4); out (center (menukarte)); + cursor (1, 6); out (center (invers (aussage [1]))). + frage ob die alte karte geloescht werden darf: + cursor (2, 9); + IF yes (aussage [2]) + THEN forget (menukarte, quiet) + ELSE weiterarbeit ist unmoeglich + FI. + weiterarbeit ist unmoeglich: + cursor (1, 12); out (center (invers (aussage [3]))); + cursor (2, 15); out (aussage [4]); + cursor (2, 16); pause; page; + errorstop (""). + erfrage den namen der datei mit den anwendertexten: + + cursor (1, 4); out (cleop); + IF yes (aussage [5]) + THEN biete dateiauswahl an + ELSE erzeuge dateidummy + FI. + biete dateiauswahl an: + menuinfotextdateiname := one (2, 6, 77, 19, ALL myself, + aussage [6], aussage [7]); + ueberpruefe den dateinamen; + ueberpruefe den dateityp. + ueberpruefe den dateinamen: + IF compress (menuinfotextdateiname) = "" + THEN page; errorstop (fehlermeldung [3]) + FI. + ueberpruefe den dateityp: + + IF datei hat falschen typ + THEN page; errorstop (fehlermeldung [4]) + FI. + datei hat falschen typ: + ds := old (menuinfotextdateiname); + IF type (ds) <> filetype + THEN forget (ds); TRUE + ELSE forget (ds); FALSE + FI. + erzeuge dateidummy: + forget (dummyname, quiet); + FILE VAR datei :: sequential file (modify, dummyname); + to line (datei, 1); + menuinfotextdateiname := dummyname. + erstelle neue menuleiste: + INT VAR zeiger; + TEXT VAR zeileninhalt; + + initialisiere werte; + aktueller menudateiname := menukarte; + menuleiste := new (aktueller menudateiname); + type (old (aktueller menudateiname), menutafeltype); + menuleiste.belegt := 0; + menuleiste ist bereit := TRUE; + trage menubasistexte ein; + trage anwendungstexte ein. + initialisiere werte: + menuleiste ist bereit := FALSE; + menu ist geoeffnet := FALSE. + trage menubasistexte ein: + basistexte := old (menu grundtext); + + menuleiste.menutext := basistexte. + trage anwendungstexte ein: + konvertiere (menuinfotextdateiname, zwischenablagename, + menuleiste.infotext.anzahl infotexte); + ueberpruefe anwendungstextanzahl; + trage anwendungstexte in die menuleiste. + ueberpruefe anwendungstextanzahl: + IF menuleiste.infotext.anzahl infotexte > maxinfotexte + THEN forget (zwischenablagename, quiet); + forget (aktueller menudateiname, quiet); + errorstop (fehlermeldung [5] + "'" + menuinfotextdateiname + "'") + + FI. + trage anwendungstexte in die menuleiste: + gib hinweis auf anwendungstexteintrag; + FILE VAR ein :: sequential file (input, zwischenablagename); + FOR zeiger FROM 1 UPTO menuleiste.infotext.anzahl infotexte REP + getline (ein, zeileninhalt); + menuleiste.infotext.stelle [zeiger] := zeileninhalt; + cout (zeiger) + PER; + forget (zwischenablagename, quiet); + forget (dummyname , quiet). + gib hinweis auf anwendungstexteintrag: + cursor (1, 7); out (aussage [9]). + +END PROC oeffne menukarte; +PROC konvertiere (TEXT CONST eingabedatei, ausgabedatei, + INT VAR anzahl konvertierter saetze): + loesche ausgabedatei; + untersuche eingabedatei; + konvertiere saetze. + loesche ausgabedatei: + IF exists (ausgabedatei) + THEN forget (ausgabedatei, quiet) + FI. + untersuche eingabedatei: + IF NOT exists (eingabedatei) + THEN errorstop (fehlermeldung [8]) + FI. + konvertiere saetze: + gib hinweis; + konvertiere satzweise. + + gib hinweis: + cursor (1, 4); out (cleop); + cursor (1, 4); out (aussage [11] + "'" + eingabedatei + "'"); + cursor (1, 6); out (aussage [ 8]); + anzahl konvertierter saetze := 0. + konvertiere satzweise: + TEXT VAR zeileninhalt :: ""; + FILE VAR eingabe :: sequential file (input, eingabedatei); + WHILE NOT eof (eingabe) REP + behandle eine dateizeile + PER; + optimiere ausgabedatei. + behandle eine dateizeile: + getline (eingabe, zeileninhalt); + anzahl konvertierter saetze INCR 1; + + cout (anzahl konvertierter saetze); + untersuche zeile; + wandle die zeile um; + FILE VAR aus :: sequential file (output, ausgabedatei); + write (aus, textausgabe). + untersuche zeile: + zeileninhalt := compress (zeileninhalt); + IF zeileninhalt = "" + THEN zeileninhalt := """""" + FI; + IF (zeileninhalt SUB 1) <> """" + OR (zeileninhalt SUB length (zeileninhalt)) <> """" + THEN bereite abgang vor; + errorstop (fehlermeldung [6] + text (anzahl konvertierter saetze)) + + FI. + wandle die zeile um: + TEXT VAR textausgabe :: "", codekette; + zeileninhalt := subtext (zeileninhalt, 2, length (zeileninhalt) - 1); + WHILE gaensefuesschenposition > 0 REP + textausgabe CAT subtext (zeileninhalt, 1, gaensefuesschenposition - 1); + zeileninhalt := subtext (zeileninhalt, gaensefuesschenposition); + codekette := subtext (zeileninhalt, 1, pos (zeileninhalt, """", 2)); + IF codekette = """7""" + THEN textausgabe CAT ""7"" + + ELIF codekette = """5""" + THEN textausgabe CAT ""5"" + ELIF codekette = """4""" + THEN textausgabe CAT ""4"" + ELIF codekette = """10""" + THEN textausgabe CAT ""10"" + ELIF codekette = """13""" + THEN textausgabe CAT ""13"" + ELIF codekette = """14""" + THEN textausgabe CAT ""14"" + ELIF codekette = """15""" + THEN textausgabe CAT ""15"" + ELIF codekette = """""" + THEN textausgabe CAT """" + + ELSE errorstop (fehlermeldung [7] + + text (anzahl konvertierter saetze)) + FI; + zeileninhalt := subtext (zeileninhalt, 1 + length (codekette)) + PER; + textausgabe CAT zeileninhalt. + gaensefuesschenposition: + pos (zeileninhalt, """"). + bereite abgang vor: + forget (ausgabedatei, quiet); + line (2). + optimiere ausgabedatei: + FILE VAR ausgabe :: sequential file (modify, ausgabedatei); + WHILE lines (ausgabe) > 0 CAND letzter satz ist leer REP + + to line (ausgabe, lines (ausgabe)); + delete record (ausgabe); + anzahl konvertierter saetze DECR 1; + cout (anzahl konvertierter saetze ) + PER. + letzter satz ist leer: + TEXT VAR satz; + to line (ausgabe,lines (ausgabe)); + read record (ausgabe, satz); + IF compress (satz) = "" OR compress (satz) = ""13"" + THEN TRUE + ELSE FALSE + FI. +END PROC konvertiere; +PROC oeffne menu (TEXT CONST name, einstiegsproc, ausstiegsproc, + itext, ltext, vtext): + + gib hinweis auf geoeffnetes menu; + ueberpruefe auf ungereimtheiten; + nimm eintragungen in datenraum vor. + gib hinweis auf geoeffnetes menu: + cursor (1, 4); out (cleop); + out (aussage [12]); out (invers (name)); + cursor (1, 6). + ueberpruefe auf ungereimtheiten: + pruefe auf bereits geoeffnete menuliste; + pruefe auf noch geoeffnetes menu; + pruefe auf noch freie menuplaetze; + pruefe auf schon vorhandenen menunamen. + pruefe auf bereits geoeffnete menuliste: + IF NOT menuleiste ist bereit + + THEN bereinige eintragungen (9) + FI. + pruefe auf noch geoeffnetes menu: + IF menu ist geoeffnet + THEN bereinige eintragungen (10) + FI. + pruefe auf noch freie menuplaetze: + IF menuleiste.belegt = maxmenus + THEN bereinige eintragungen (11) + FI. + pruefe auf schon vorhandenen menunamen: + IF menuname schon vorhanden + THEN bereinige eintragungen (12) + FI. + menuname schon vorhanden: + INT VAR i; + FOR i FROM 1 UPTO menuleiste.belegt REP + + untersuche einzelnen menunamen + PER; + FALSE. + untersuche einzelnen menunamen: + IF menuleiste.menu [i].menuname = compress (name) + THEN LEAVE menuname schon vorhanden WITH TRUE + FI. + nimm eintragungen in datenraum vor: + forget (ds); + ds := nilspace; + aktuelles menu := ds; + init (aktuelles menu); + aktuelles menu.menuname := compress (name); + aktuelles menu.menueingangsprozedur := compress (einstiegsproc); + + aktuelles menu.menuausgangsprozedur := compress (ausstiegsproc); + IF itext <> "" + THEN aktuelles menu.menuinfo := itext; + aktuelles menu.lizenznummer := ltext; + aktuelles menu.versionsnummer := vtext + ELSE aktuelles menu.menuinfo := bleibt leer symbol; + aktuelles menu.lizenznummer := ""; + aktuelles menu.versionsnummer := "" + FI; + menu ist geoeffnet := TRUE. +END PROC oeffne menu; + +PROC oeffne menu (TEXT CONST name, einstiegsproc, ausstiegsproc): + oeffne menu (name, einstiegsproc, ausstiegsproc, "", "", "") +END PROC oeffne menu; +PROC oeffne menu (TEXT CONST name): + oeffne menu (name, "", "", "", "", "") +END PROC oeffne menu; +PROC bereinige eintragungen (INT CONST nummer): + forget (ds); + forget (aktueller menudateiname, quiet); + menuleiste ist bereit := FALSE; + menu ist geoeffnet := FALSE; + errorstop (fehlermeldung [nummer]) +END PROC bereinige eintragungen; + +PROC init (MENU VAR m): + m.menuname := ""; + m.hauptmenuzeiger := 1; + m.untermenuanfang := 0; + m.untermenuzeiger := 0; + m.menueingangsprozedur := ""; + m.menuausgangsprozedur := ""; + m.menuinfo := ""; + m.versionsnummer := ""; + m.anzahl hauptmenupunkte := 0; + belege hauptmenupunkte. + belege hauptmenupunkte: + INT VAR i; + FOR i FROM 1 UPTO maxhauptmenupunkte REP + + aktuelles einzelmenu.belegt := 0; + aktuelles einzelmenu.ueberschrift := ""; + aktuelles einzelmenu.anfangsposition := 0; + aktuelles einzelmenu.maxlaenge := 0; + aktuelles einzelmenu.aktueller untermenupunkt := 1; + aktuelles einzelmenu.startprozedurname := ""; + aktuelles einzelmenu.leaveprozedurname := ""; + belege untermenuepunkte + PER. + belege untermenuepunkte: + + INT VAR j; + FOR j FROM 1 UPTO maxuntermenupunkte REP + aktueller menupunkt.punktkuerzel := ""; + aktueller menupunkt.punktname := ""; + aktueller menupunkt.procname := ""; + aktueller menupunkt.boxtext := ""; + aktueller menupunkt.aktiv := TRUE; + aktueller menupunkt.angewaehlt := FALSE + PER. + aktuelles einzelmenu: m.einzelmenu [i]. + aktueller menupunkt: aktuelles einzelmenu.menupunkt [j]. +END PROC init; +PROC oberbegriff (TEXT CONST punktname, startprocname, leaveprocname): + + gib hinweis auf oberbegriff; + untersuche ob menu geoeffnet und bereit ist; + untersuche oberbegriffe; + trage neuen oberbegriff ein; + notiere die anfangsposition; + notiere start und leaveprozedur; + erhoehe die anzahl der oberbegriffe. + gib hinweis auf oberbegriff: + cursor (1, 6); out (cleop); + cursor (1, 6); out (aussage [13]); out (invers (punktname)); line. + untersuche ob menu geoeffnet und bereit ist: + IF NOT menuleiste ist bereit + THEN bereinige eintragungen ( 9) + + FI; + IF NOT menu ist geoeffnet + THEN bereinige eintragungen (13) + FI. + untersuche oberbegriffe: + IF zu viele oberbegriffe + THEN bereinige eintragungen (14) + FI; + IF gesamtlaenge > maxmenubreite + THEN bereinige eintragungen (15) + FI. + zu viele oberbegriffe: + aktuelles menu.anzahl hauptmenupunkte = maxhauptmenupunkte. + gesamtlaenge: + gesamtlaenge ohne letzten punkt + length (compress (punktname)). + gesamtlaenge ohne letzten punkt: + length (hauptmenuzeile). + + hauptmenuzeile: + INT VAR zaehler; + TEXT VAR zeile :: ""; + schreibe menunamen; + schreibe oberbegriffe; + zeile. + schreibe menunamen: + IF aktuelles menu. menuname <> "" + THEN zeile CAT aktuelles menu.menuname; + zeile CAT ":" + FI. + schreibe oberbegriffe: + FOR zaehler FROM 1 UPTO aktuelles menu.anzahl hauptmenupunkte REP + zeile CAT hauptmenuluecke; + zeile CAT aktuelles menu. einzelmenu [zaehler].ueberschrift + PER; + zeile CAT hauptmenuluecke. + + trage neuen oberbegriff ein: + neuer menupunkt.ueberschrift := compress (punktname). + notiere die anfangsposition: + neuer menupunkt.anfangsposition := gesamtlaenge ohne letzten punkt + 1. + notiere start und leaveprozedur: + neuer menupunkt.startprozedurname := compress (startprocname); + neuer menupunkt.leaveprozedurname := compress (leaveprocname). + neuer menupunkt: + aktuelles menu.einzelmenu [aktuelles menu.anzahl hauptmenupunkte + 1]. + erhoehe die anzahl der oberbegriffe: + + aktuelles menu.anzahl hauptmenupunkte INCR 1. +END PROC oberbegriff; +PROC oberbegriff (TEXT CONST punktname): + oberbegriff (punktname, "", "") +END PROC oberbegriff; +PROC menufunktionseintrag (TEXT CONST kuerzel, + punktbezeichnung, + prozedurname, + infotext, + BOOL CONST ist aktiv): + gib hinweis auf menufunktionseintrag; + trage menupunkt ein; + organisiere menu neu. + + gib hinweis auf menufunktionseintrag: + line; + out (aussage [14]); + out ("'" + kuerzelzeichen + "' - " + punktname). + kuerzelzeichen: + IF kuerzel = "" THEN " " ELSE kuerzel FI. + punktname: + IF punktbezeichnung = trennzeilensymbol + THEN "----------" + ELSE punktbezeichnung + FI. + trage menupunkt ein: + ueberpruefe das kuerzel; + ueberpruefe die punktbreite; + ueberpruefe die eintragsnummer; + aktuelles menu.einzelmenu [stelle].belegt INCR 1; + + aktueller menupunkt.punktkuerzel := compress (kuerzel); + aktueller menupunkt.punktname := normierter menupunkt; + aktueller menupunkt.procname := compress (prozedurname); + aktueller menupunkt.boxtext := infotext; + aktueller menupunkt.aktiv := ist aktiv; + aktueller menupunkt.angewaehlt := FALSE. + aktueller menupunkt: + aktuelles untermenu.menupunkt [aktuelles untermenu.belegt]. + aktuelles untermenu: + aktuelles menu.einzelmenu [stelle]. + + stelle: + aktuelles menu.anzahl hauptmenupunkte. + normierter menupunkt: + blank + compress (punktbezeichnung). + ueberpruefe das kuerzel: + TEXT VAR kurz :: compress (kuerzel); + IF kuerzel ist zu lang + THEN bereinige eintragungen (16) + ELIF kuerzel ist schon vorhanden + THEN bereinige eintragungen (17) + FI. + kuerzel ist zu lang: + length (kurz) > 1. + kuerzel ist schon vorhanden: + (length (kurz) = 1) AND (pos (vorhandene kuerzel, kurz) > 0). + + vorhandene kuerzel: + TEXT VAR liste :: ""; + INT VAR zeiger; + FOR zeiger FROM 1 UPTO aktuelles untermenu.belegt REP + liste CAT aktuelles untermenu.menupunkt [zeiger].punktkuerzel + PER; + liste. + ueberpruefe die punktbreite: + IF length (compress (punktbezeichnung)) > maxmenubreite - 10 + THEN bereinige eintragungen (18) + FI. + ueberpruefe die eintragsnummer: + IF aktuelles untermenu.belegt = maxuntermenupunkte + THEN bereinige eintragungen (19) + + FI. + organisiere menu neu: + IF neue punktlaenge > aktuelles untermenu.maxlaenge + THEN aktuelles untermenu.maxlaenge := neue punktlaenge + FI. + neue punktlaenge: + length (aktueller menupunkt.punktname). +END PROC menufunktionseintrag; +PROC menufunktion (TEXT CONST kuerzel, punktbezeichnung, + prozedurname, infotext): + menufunktionseintrag (kuerzel, punktbezeichnung, prozedurname, infotext, + TRUE) +END PROC menufunktion; + +PROC trennlinie: + menufunktionseintrag ("", trennzeilensymbol, "", "", FALSE) +END PROC trennlinie; +PROC schliesse menu: + menuleiste. belegt INCR 1; + menuleiste.menu [menuleiste.belegt] := aktuelles menu; + menu ist geoeffnet := FALSE +END PROC schliesse menu; +PROC schliesse menukarte: + forget (ds); + page; out (piep); put (card finished) +END PROC schliesse menukarte; +PROC testinstallation (TEXT CONST kartenname): + ueberpruefe menukarte; + nimm installation vor. + + ueberpruefe menukarte: + IF NOT exists (kartenname) + THEN errorstop (fehlermeldung [20] + kartenname + fehlermeldung [21]) + ELIF (pos (kartenname, menutafelpraefix) <> 1) + OR (type (old (kartenname)) <> menutafeltype) + THEN errorstop (fehlermeldung [20] + kartenname + fehlermeldung [22]) + FI. + nimm installation vor: + TEXT CONST neuer kartenname + :: kartenname + " von Task '" + name (myself) + "'"; + command dialogue (FALSE); + + rename (kartenname, neuer kartenname); + save (neuer kartenname,task (mmtaskname)); + forget (neuer kartenname, quiet); + reset dialog; + install menu (neuer kartenname, FALSE); + fetch (neuer kartenname, task (mmtaskname)); + rename (neuer kartenname, kartenname); + command dialogue (TRUE); + page; out (piep); put (install finished) +END PROC testinstallation; +END PACKET ls menu generator 2; + |