summaryrefslogtreecommitdiff
path: root/menugenerator/ls-Menu-Generator 2
blob: e38fc7eb3c927142e1367ff679d25417b838dae6 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
(* 
        
          ********************************************************* 
          ********************************************************* 
          **                                                     ** 
          **                 ls-Menu-Generator 2                 ** 
          **                                                     ** 
          **                     Version 1.0                     ** 
          **                                                     ** 
          **                  (Stand: 30.03.88)                  ** 
          **                                                     ** 
          **                                                     ** 
          **         Autor: Wolfgang Weber, Bielefeld            ** 
          **                                                     ** 
          **                                                     ** 
          ** Copyright (C) 1987, 1988 Eva Latta-Weber, Bielefeld ** 
          **                                                     ** 
          ** Copyright (C) 1988 ERGOS GmbH, Siegburg             ** 
          **                                                     ** 
          ********************************************************* 
          ********************************************************* 
 
                                                                           *) 
 
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;