home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / pmos2002.zip / SRC / menus.mod < prev    next >
Text File  |  1997-11-28  |  52KB  |  1,276 lines
  1. IMPLEMENTATION MODULE Menus;
  2.  
  3.         (****************************************************************)
  4.         (*                                                              *)
  5.         (*      Displays menus on screen, allows terminal user to       *)
  6.         (*                      select from them.                       *)
  7.         (*                                                              *)
  8.         (*  Programmer:         P. Moylan                               *)
  9.         (*  Last edited:        11 May 1997                             *)
  10.         (*  Status:             OK                                      *)
  11.         (*                                                              *)
  12.         (****************************************************************)
  13.  
  14. FROM SYSTEM IMPORT
  15.     (* proc *)  CAST;
  16.  
  17. FROM Storage IMPORT
  18.     (* proc *)  ALLOCATE, DEALLOCATE;
  19.  
  20. FROM TaskControl IMPORT
  21.     (* type *)  Lock,
  22.     (* proc *)  CreateLock, Obtain, Release;
  23.  
  24. FROM Keyboard IMPORT
  25.     (* proc *)  PutBack, StuffKeyboardBuffer;
  26.  
  27. FROM Windows IMPORT
  28.     (* const*)  MaxColumnNumber,
  29.     (* type *)  Window, Colour, FrameType, DividerType, RowRange, ColumnRange,
  30.     (* proc *)  OpenWindow, CloseWindow, ChangeScrollingRegion,
  31.                 GetKey, WriteChar, WriteString, SetColours, Blink,
  32.                 SetCursor, SaveCursor, ScrollUp, ScrollDown, EraseLine,
  33.                 NewScrollingRegion, ResetScrollingRegion;
  34.  
  35. FROM TextLines IMPORT
  36.     (* type *)  LineType,
  37.     (* proc *)  Box, HLine;
  38.  
  39. FROM Mouse IMPORT
  40.     (* type *)  Buttons, ButtonSet,
  41.     (* proc *)  MouseAvailable, HideMouseCursor, ShowMouseCursor;
  42.  
  43. FROM UserInterface IMPORT
  44.     (* type *)  UIWindow, Capability, CapabilitySet,
  45.     (* proc *)  AllowMouseControl, AddActiveRegion, OutsideWindowHandler;
  46.  
  47. (************************************************************************)
  48.  
  49. CONST
  50.     gap = 1;                    (* space between menu columns *)
  51.     ClickIndicator = CHR(1);    (* special code to indicate mouse click *)
  52.     LeftOnly = ButtonSet{LeftButton};
  53.     Esc = CHR(01BH);            (* keyboard Escape character *)
  54.     NilWindow = CAST(Window,NIL);
  55.  
  56. TYPE
  57.     (* An ItemBuffer record holds the text for the screen display of    *)
  58.     (* one menu item.  The "selpos" field shows which character acts    *)
  59.     (* as the selection character.                                      *)
  60.  
  61.     ItemBuffer = RECORD
  62.                      selpos: CARDINAL;
  63.                      text: ItemText;
  64.                  END (*RECORD*);
  65.  
  66. CONST
  67.     MaxItems = MAX(CARDINAL) DIV SIZE(ItemBuffer);
  68.  
  69. TYPE
  70.     ItemNo = [0..MaxItems];
  71.  
  72.     (* The following declaration uses a large upper subscript bound     *)
  73.     (* because Modula-2 provides no way of declaring a variable-length  *)
  74.     (* array (except as a procedure parameter).  The correct array size *)
  75.     (* will be established on a call to ALLOCATE.                       *)
  76.  
  77.     TextPointer = POINTER TO ARRAY [1..MaxItems] OF ItemBuffer;
  78.  
  79.     Menu = POINTER TO MenuDetails;
  80.  
  81.     (********************************************************************)
  82.     (*                                                                  *)
  83.     (* The fields in a MenuDetails record have the following meaning:   *)
  84.     (*                                                                  *)
  85.     (*  win             The window used to display this menu            *)
  86.     (*                   on the screen                                  *)
  87.     (*  foreground,     The colours to use when displaying the menu     *)
  88.     (*   background,                                                    *)
  89.     (*   selchar,                                                       *)
  90.     (*   highforeground,                                                *)
  91.     (*   highbackground                                                 *)
  92.     (*  ScreenPosition  The row and column numbers which will be        *)
  93.     (*                   occupied by the menu on the screen.  This      *)
  94.     (*                   includes space for the border and title, if    *)
  95.     (*                   present.  The space taken by the menu itself,  *)
  96.     (*                   not including border and title, is given by    *)
  97.     (*                   the LocationInWindow record - see below.       *)
  98.     (*  heading         The text to display in the menu header          *)
  99.     (*  NoOfItems       Number of menu items                            *)
  100.     (*  ItemsPerColumn  Number of items allocated to each column        *)
  101.     (*  NoOfColumns     Number of columns of menu items                 *)
  102.     (*  hstep           The increment in item number resulting from     *)
  103.     (*                   one "cursor right" operation.                  *)
  104.     (*  vstep           The increment in item number resulting from     *)
  105.     (*                   one "cursor down" operation.  Note that hstep  *)
  106.     (*                   and vstep depend on whether the items are      *)
  107.     (*                   numbered horizontally or vertically, and that  *)
  108.     (*                   in turn depends on whether we have a short fat *)
  109.     (*                   display or a tall thin one.                    *)
  110.     (*  LocationInWindow: The location of the menu itself, relative to  *)
  111.     (*                   the window in which it is displayed, and not   *)
  112.     (*                   counting the space taken by borders or a       *)
  113.     (*                   header.  The top left character is at location *)
  114.     (*                   (firstrow,firstcol), the menu takes 'height'   *)
  115.     (*                   screen lines and is 'width' characters wide.   *)
  116.     (*                   To fit the text exactly into this space, we    *)
  117.     (*                   would need                                     *)
  118.     (*                      NoOfItems = height*NoOfColumns              *)
  119.     (*                   If NoOfItems is smaller than this, the menu    *)
  120.     (*                   will be displayed with some blank areas.  If   *)
  121.     (*                   it is larger, the menu scrolls.                *)
  122.     (*  ColumnWidth     The number of characters of TextPtr^[j] which   *)
  123.     (*                   will be written on the screen.  Approximately  *)
  124.     (*                   equal to LocationInWindow.width/NoOfColumns.   *)
  125.     (*  ShowTitle       Says whether to display a menu title.           *)
  126.     (*  ShowBorder      Says whether to put a border around the menu.   *)
  127.     (*  CloseAfterSelection  If TRUE, specifies that the menu window    *)
  128.     (*                   will be closed on return from SelectFromMenu.  *)
  129.     (*  PutBackExitKey  If TRUE, the keystroke that caused a return     *)
  130.     (*                   from SelectFromMenu remains available to the   *)
  131.     (*                   caller.  If FALSE, that key is consumed.       *)
  132.     (*  FastSelect      If TRUE, user can select a menu item without    *)
  133.     (*                   having to confirm with Enter or Space.         *)
  134.     (*  MouseControl    If TRUE, user can move the menu with the mouse. *)
  135.     (*  CloseOnClickOutsideMenu  If TRUE, a mouse click outside the     *)
  136.     (*                   menu will cause a return with a zero result.   *)
  137.     (*  offL, offR,     What to do when the user tries to run off the   *)
  138.     (*    offT, offB    left/right/top/bottom edge of the menu.         *)
  139.     (*  CurrentItemNo   The item number currently selected.             *)
  140.     (*  row             The current menu row selected.  Note that row=1 *)
  141.     (*                   means the top row of items displayed; this is  *)
  142.     (*                   not necessarily the top row of the entire menu *)
  143.     (*                   since some items may have scrolled off the top.*)
  144.     (*  column          The current menu column selected.               *)
  145.     (*  ExtraAtTop      The number of rows which have disappeared off   *)
  146.     (*                          the top of the display.                 *)
  147.     (*  ExtraAtBottom   The number of rows which have disappeared off   *)
  148.     (*                          the bottom of the display.              *)
  149.     (*  RanOffEdge      Set if a cursor movement ran us off the edge    *)
  150.     (*                          of the menu.                            *)
  151.     (*  TextPtr^[j]     The text to display for menu item j.            *)
  152.     (*                                                                  *)
  153.     (********************************************************************)
  154.  
  155.     MenuDetails =
  156.  
  157.            RECORD
  158.                 (* The screen window. *)
  159.  
  160.                 win: Window;
  161.                 foreground, background, selchar,
  162.                         highforeground, highbackground: Colour;
  163.                 ScreenPosition:
  164.                     RECORD
  165.                         firstrow, lastrow: RowRange;
  166.                         firstcol, lastcol: ColumnRange;
  167.                     END (*RECORD*);
  168.                 heading: ItemText;
  169.  
  170.                 (* The layout of the menu within its window, determined *)
  171.                 (* at the time that the menu is created.                *)
  172.  
  173.                 NoOfItems: ItemNo;
  174.                 ItemsPerColumn: ItemNo;
  175.                 NoOfColumns: MenuColumn;
  176.  
  177.                 (* Further layout details, determined at the time we    *)
  178.                 (* discover how much space the menu will be given on    *)
  179.                 (* the screen.                                          *)
  180.  
  181.                 hstep, vstep: CARDINAL;
  182.                 LocationInWindow:
  183.                     RECORD
  184.                         firstrow, firstcol: CARDINAL;
  185.                         height, width: CARDINAL;
  186.                     END (*RECORD*);
  187.                 ColumnWidth: ColumnRange;
  188.  
  189.                 (* Options. *)
  190.  
  191.                 ShowTitle, ShowBorder, CloseAfterSelection,
  192.                         PutBackExitKey, FastSelect, MouseControl,
  193.                         CloseOnClickOutsideMenu: BOOLEAN;
  194.                 offL, offR, offT, offB: OffEdgeOption;
  195.  
  196.                 (* Information about the current state of the menu.     *)
  197.  
  198.                 CurrentItemNo: ItemNo;
  199.                 row: RowRange;
  200.                 column: MenuColumn;
  201.                 ExtraAtTop, ExtraAtBottom: CARDINAL;
  202.                 RanOffEdge: BOOLEAN;
  203.  
  204.                 (* Pointer to the text of the menu items.       *)
  205.  
  206.                 TextPtr: TextPointer;
  207.  
  208.             END (*RECORD*);
  209.  
  210. (************************************************************************)
  211.  
  212. VAR
  213.     (* The following record contains the details of the last mouse      *)
  214.     (* click.  Because users can't move a mouse very fast, we don't     *)
  215.     (* bother to keep a queue of clicks, we just record the last seen.  *)
  216.     (* In the event that a click arrives before the last has been       *)
  217.     (* consumed, the earlier click is lost.  I haven't yet seen an      *)
  218.     (* application where that has been a major problem.                 *)
  219.  
  220.     LastMouseClick: RECORD
  221.                         access: Lock;
  222.                         win: Window;
  223.                         X: ColumnRange;  Y: RowRange;
  224.                         valid: BOOLEAN;
  225.                     END (*RECORD*);
  226.  
  227. (************************************************************************)
  228. (*                      MISCELLANEOUS UTILITIES                         *)
  229. (************************************************************************)
  230.  
  231. PROCEDURE Setselpos (VAR (*INOUT*) item: ItemBuffer);
  232.  
  233.     (* Looks for a "\" in the item text, adjusts item.selpos if found.  *)
  234.  
  235.     CONST high = MAX(ColumnRange);
  236.  
  237.     VAR j, k: CARDINAL;
  238.  
  239.     BEGIN
  240.         j := 0;
  241.         LOOP
  242.             IF (j > high) OR (ORD(item.text[j]) = 0) THEN
  243.                 EXIT (*LOOP*);
  244.             ELSIF item.text[j] = "\" THEN
  245.                 item.selpos := j;
  246.                 FOR k := j TO high-1 DO
  247.                     item.text[k] := item.text[k+1];
  248.                 END (*FOR*);
  249.                 item.text[high] := CHR(0);
  250.                 EXIT (*LOOP*);
  251.             ELSE
  252.                 INC (j);
  253.             END (*IF*);
  254.         END (*LOOP*);
  255.     END Setselpos;
  256.  
  257. (************************************************************************)
  258.  
  259. PROCEDURE resize (VAR (*INOUT*) text: ItemText;  size: CARDINAL);
  260.  
  261.     (* Makes text equal to the given size, by space filling on the      *)
  262.     (* right and inserting a Nul to terminate the text.                 *)
  263.  
  264.     VAR j: CARDINAL;
  265.  
  266.     BEGIN
  267.         j := 0;
  268.         WHILE (j < size) AND (ORD(text[j]) <> 0) DO
  269.             INC(j);
  270.         END (*WHILE*);
  271.         WHILE j < size DO text[j] := " "; INC(j) END (*WHILE*);
  272.         IF j <= MaxColumnNumber THEN text[j] := CHR(0) END (*IF*);
  273.     END resize;
  274.  
  275. (************************************************************************)
  276. (*                         CREATING A MENU                              *)
  277. (************************************************************************)
  278.  
  279. PROCEDURE CreateMenu (VAR (*OUT*) M: Menu; columns: MenuColumn;
  280.                         VAR (*IN*) Messages: ARRAY OF ItemText;
  281.                         NumberOfItems: CARDINAL);
  282.  
  283.     (* Introduces a menu into the system, but does not display it yet.  *)
  284.  
  285.     VAR j, count: CARDINAL;
  286.  
  287.     BEGIN
  288.         NEW (M);
  289.         WITH M^ DO
  290.             win := NilWindow;
  291.             NoOfColumns := columns;
  292.  
  293.             (* Store the header text, with space fill.  *)
  294.  
  295.             heading := Messages[0];
  296.             resize (heading, MaxColumnNumber);
  297.  
  298.             (* Work out how many menu items there are.  *)
  299.  
  300.             count := NumberOfItems;
  301.             IF (count = 0) OR (count > HIGH (Messages)) THEN
  302.                 count := HIGH (Messages);
  303.             END (*IF*);
  304.             NoOfItems := count;
  305.             ItemsPerColumn := (count + NoOfColumns - 1) DIV NoOfColumns;
  306.             CurrentItemNo := 1;
  307.  
  308.             (* Store the item text.     *)
  309.  
  310.             ALLOCATE (TextPtr, NoOfItems*SIZE(ItemBuffer));
  311.             FOR j := 1 TO NoOfItems DO
  312.                 WITH TextPtr^[j] DO
  313.                     selpos := 0;
  314.                     text := Messages[j];
  315.                 END (*WITH*);
  316.                 Setselpos (TextPtr^[j]);
  317.             END (*FOR*);
  318.  
  319.             (* Set default options. *)
  320.  
  321.             ShowTitle := TRUE;  ShowBorder := TRUE;
  322.             CloseAfterSelection := TRUE;  PutBackExitKey := FALSE;
  323.             FastSelect := FALSE;  MouseControl := MouseAvailable();
  324.             CloseOnClickOutsideMenu := TRUE;
  325.             offL := stick;  offR := stick;  offT := stick;  offB := stick;
  326.  
  327.         END (*WITH*);
  328.  
  329.         (* Give the menu a default initial position, size, and colour.  *)
  330.  
  331.         PositionMenu (M, 0, 10, 0, MaxColumnNumber);
  332.         MenuColours (M, blue, white, black, cyan, red);
  333.  
  334.     END CreateMenu;
  335.  
  336. (************************************************************************)
  337.  
  338. PROCEDURE MenuColours (M: Menu;  fore, back, hfore, hback, select: Colour);
  339.  
  340.     (* Set the colours for the screen display of the menu.  The colours *)
  341.     (* fore and back are used as the normal foreground and background   *)
  342.     (* colours, and the highlighted menu item is displayed in colours   *)
  343.     (* hfore, hback.  The "select" colour is for highlighting the       *)
  344.     (* selection character.                                             *)
  345.  
  346.     BEGIN
  347.         WITH M^ DO
  348.             foreground := fore;  background := back;
  349.             highforeground := hfore;  highbackground := hback;
  350.             selchar := select;
  351.         END (*WITH*);
  352.     END MenuColours;
  353.  
  354. (************************************************************************)
  355.  
  356. PROCEDURE SetOptions (M: Menu;  options: MO);
  357.  
  358.     (* See the MenuOption declaration for the possible options. *)
  359.  
  360.     BEGIN
  361.         WITH M^ DO
  362.             IF MTitle IN options THEN ShowTitle := TRUE END (*IF*);
  363.             IF MNoTitle IN options THEN ShowTitle := FALSE END (*IF*);
  364.             IF MBorder IN options THEN ShowBorder := TRUE END (*IF*);
  365.             IF MNoBorder IN options THEN ShowBorder := FALSE END (*IF*);
  366.             IF MClose IN options THEN CloseAfterSelection := TRUE END (*IF*);
  367.             IF MNoClose IN options THEN CloseAfterSelection := FALSE END (*IF*);
  368.             IF MKeyBack IN options THEN PutBackExitKey := TRUE END (*IF*);
  369.             IF MNoKeyBack IN options THEN PutBackExitKey := FALSE END (*IF*);
  370.             IF MFastSelect IN options THEN FastSelect := TRUE END (*IF*);
  371.             IF MNoFastSelect IN options THEN FastSelect := FALSE END (*IF*);
  372.             IF MMouse IN options THEN MouseControl := MouseAvailable() END (*IF*);
  373.             IF MNoMouse IN options THEN MouseControl := FALSE END (*IF*);
  374.             IF MCloseonClickOutside IN options THEN CloseOnClickOutsideMenu := TRUE END (*IF*);
  375.             IF MNoCloseonClickOutside IN options THEN CloseOnClickOutsideMenu := FALSE END (*IF*);
  376.         END (*WITH*);
  377.     END SetOptions;
  378.  
  379. (************************************************************************)
  380.  
  381. PROCEDURE OffEdge (M: Menu;  top, bottom, left, right: OffEdgeOption);
  382.  
  383.     (* Sets the menu behaviour when the user runs the cursor off the    *)
  384.     (* edge of the menu.  There is one parameter for each edge of the   *)
  385.     (* menu.                                                            *)
  386.     (* See the OffEdgeOption type declaration for the possible options. *)
  387.  
  388.     BEGIN
  389.         WITH M^ DO
  390.             offT := top;  offB := bottom;
  391.             offL := left;  offR := right;
  392.         END (*WITH*);
  393.     END OffEdge;
  394.  
  395. (************************************************************************)
  396. (*                        POSITIONING A MENU                            *)
  397. (************************************************************************)
  398.  
  399. PROCEDURE SetRelativeLocation (M: Menu;  row1, col1, rows, columns: CARDINAL);
  400.  
  401.     (* Gives initial values to M^.LocationInWindow and M^.ColumnWidth,  *)
  402.     (* and resizes the item text to the space available.  Also sets     *)
  403.     (* M^.hstep and M^.vstep, based on the following criterion: if the  *)
  404.     (* display will be wider than it is tall then we use row major      *)
  405.     (* ordering (hstep = 1), whereas for tall narrow menus we use       *)
  406.     (* column major ordering (vstep = 1).  This distinction is actually *)
  407.     (* irrelevant to the caller, but it affects the appearance of the   *)
  408.     (* menu, and the decision taken here seems to give a result which   *)
  409.     (* someone reading the screen would consider intuitively logical.   *)
  410.  
  411.     VAR j: ItemNo;
  412.  
  413.     BEGIN
  414.         WITH M^ DO
  415.             WITH LocationInWindow DO
  416.                 firstrow := row1;  firstcol := col1;
  417.                 height := rows;  width := columns;
  418.                 IF ItemsPerColumn <= height THEN
  419.                     height := ItemsPerColumn;
  420.                 END (*IF*);
  421.                 IF NoOfColumns > height THEN
  422.                     hstep := 1;  vstep := NoOfColumns;
  423.                 ELSE
  424.                     hstep := ItemsPerColumn;  vstep := 1;
  425.                 END (*IF*);
  426.             END (*WITH*);
  427.  
  428.             resize (heading, columns);
  429.             ColumnWidth := (columns - (NoOfColumns-1)*gap) DIV NoOfColumns;
  430.             FOR j := 1 TO NoOfItems DO
  431.                 resize (TextPtr^[j].text, ColumnWidth);
  432.             END (*FOR*);
  433.  
  434.         END (*WITH*);
  435.  
  436.     END SetRelativeLocation;
  437.  
  438. (************************************************************************)
  439.  
  440. PROCEDURE PositionMenu (M: Menu;  startline, endline: RowRange;
  441.                                 leftcol, rightcol: ColumnRange);
  442.  
  443.     (* Sets the screen location of the window which will hold the menu. *)
  444.  
  445.     VAR row1, col1, height, width: CARDINAL;
  446.  
  447.     BEGIN
  448.         WITH M^ DO
  449.  
  450.             (* Work out the space available on the screen.      *)
  451.  
  452.             WITH ScreenPosition DO
  453.                 firstrow := startline;  lastrow := endline;
  454.                 firstcol := leftcol;  lastcol := rightcol;
  455.             END (*WITH*);
  456.  
  457.             (* How much of this space is used for the actual menu? *)
  458.  
  459.             row1 := 0;  col1 := 0;
  460.             height := endline - startline + 1;
  461.             width := rightcol - leftcol + 1;
  462.             IF ShowBorder THEN
  463.                 row1 := 1;  col1 := 1;
  464.                 DEC (height, 2);  DEC (width, 2);
  465.             END(*IF*);
  466.             IF ShowTitle THEN
  467.                 INC (row1,2);  DEC (height, 2);
  468.             END(*IF*);
  469.             SetRelativeLocation (M, row1, col1, height, width);
  470.  
  471.         END (*WITH*);
  472.     END PositionMenu;
  473.  
  474. (************************************************************************)
  475. (*                          CLOSING A MENU                              *)
  476. (************************************************************************)
  477.  
  478. PROCEDURE DestroyMenu (M: Menu);
  479.  
  480.     (* Removes a menu from the system, freeing up the space it used.    *)
  481.  
  482.     BEGIN
  483.         WITH M^ DO
  484.             IF (win <> NilWindow) AND CloseAfterSelection THEN
  485.                 CloseWindow (win);
  486.             END (*IF*);
  487.             DEALLOCATE (TextPtr, NoOfItems*SIZE(ItemBuffer));
  488.         END (*WITH*);
  489.         DISPOSE (M);
  490.     END DestroyMenu;
  491.  
  492. (************************************************************************)
  493. (*                          SCREEN DISPLAY                              *)
  494. (************************************************************************)
  495.  
  496. PROCEDURE NewColours (M: Menu;  fore, back, select: Colour);
  497.  
  498.     (* Changes the foreground and background colours of the current     *)
  499.     (* menu item.  The "select" colour is for highlighting the          *)
  500.     (* selection character.                                             *)
  501.  
  502.     BEGIN
  503.         IF MouseAvailable() THEN HideMouseCursor END (*IF*);
  504.         WITH M^ DO
  505.             SetColours (win, LocationInWindow.firstrow+row-1,
  506.                 (column-1)*(ColumnWidth+gap) + LocationInWindow.firstcol,
  507.                         ColumnWidth, fore, back);
  508.             IF CurrentItemNo <= NoOfItems THEN
  509.                 SetColours (win, LocationInWindow.firstrow+row-1,
  510.                         (column-1)*(ColumnWidth+gap) + LocationInWindow.firstcol
  511.                                         + TextPtr^[CurrentItemNo].selpos,
  512.                         1, select, back);
  513.             END (*IF*);
  514.         END (*WITH*);
  515.         IF MouseAvailable() THEN ShowMouseCursor END (*IF*);
  516.     END NewColours;
  517.  
  518. (************************************************************************)
  519.  
  520. PROCEDURE Highlight (M: Menu);
  521.  
  522.     (* Highlights the current menu item.        *)
  523.  
  524.     BEGIN
  525.         NewColours (M, M^.highforeground, M^.highbackground, M^.selchar);
  526.     END Highlight;
  527.  
  528. (************************************************************************)
  529.  
  530. PROCEDURE Unhighlight (M: Menu);
  531.  
  532.     (* Removes any highlighting from the current menu item.     *)
  533.  
  534.     BEGIN
  535.         NewColours (M, M^.foreground, M^.background, M^.selchar);
  536.     END Unhighlight;
  537.  
  538. (************************************************************************)
  539.  
  540. PROCEDURE RefreshRow (M: Menu);
  541.  
  542.     (* Refreshes the current menu row.  *)
  543.  
  544.     VAR screenrow: RowRange;  j: ColumnRange;  savecurrent: ItemNo;
  545.         savecolumn: CARDINAL;
  546.  
  547.     BEGIN
  548.         WITH M^ DO
  549.             savecurrent := CurrentItemNo;  savecolumn := column;
  550.             WITH LocationInWindow DO
  551.                 screenrow := firstrow + row - 1;
  552.                 j := LocationInWindow.firstcol;
  553.             END (*WITH*);
  554.             SetCursor (win, screenrow, j);  EraseLine (win, 1);
  555.             column := 1;
  556.             CurrentItemNo := 1 + vstep*(row + ExtraAtTop - 1);
  557.             LOOP
  558.                 WriteString (win, TextPtr^[CurrentItemNo].text);
  559.                 Unhighlight (M);
  560.                 IF (column = NoOfColumns)
  561.                         OR (CurrentItemNo+hstep > NoOfItems) THEN
  562.                     EXIT (*LOOP*);
  563.                 END (*IF*);
  564.                 INC (column);
  565.                 INC (CurrentItemNo, hstep);  INC (j, ColumnWidth + gap);
  566.                 SetCursor (win, screenrow, j);
  567.             END (*LOOP*);
  568.             column := savecolumn;  CurrentItemNo := savecurrent;
  569.         END (*WITH*);
  570.     END RefreshRow;
  571.  
  572. (************************************************************************)
  573.  
  574. PROCEDURE DisplayMOREatTop (M: Menu);
  575.  
  576.     BEGIN
  577.         WITH M^ DO
  578.             IF ShowTitle OR (ShowBorder AND NOT MouseControl) THEN
  579.                 WITH LocationInWindow DO
  580.                     SetCursor (win, firstrow-1, firstcol+width-6);
  581.                 END (*WITH*);
  582.                 WriteString (win, "*MORE*");
  583.             END (*IF*);
  584.         END (*WITH*);
  585.     END DisplayMOREatTop;
  586.  
  587. (************************************************************************)
  588.  
  589. PROCEDURE RemoveMOREatTop (M: Menu);
  590.  
  591.     CONST DoubleBar = '═';  SingleBar = '─';
  592.  
  593.     VAR j: [1..6];  bar: CHAR;
  594.  
  595.     BEGIN
  596.         WITH M^ DO
  597.             IF ShowTitle OR (ShowBorder AND NOT MouseControl) THEN
  598.                 WITH LocationInWindow DO
  599.                     SetCursor (win, firstrow-1, firstcol+width-6);
  600.                 END (*WITH*);
  601.                 IF ShowTitle THEN bar := DoubleBar
  602.                 ELSE bar := SingleBar
  603.                 END (*IF*);
  604.                 FOR j := 1 TO 6 DO
  605.                     WriteChar (win, bar);
  606.                 END (*FOR*);
  607.             END (*IF*);
  608.         END (*WITH*);
  609.     END RemoveMOREatTop;
  610.  
  611. (************************************************************************)
  612.  
  613. PROCEDURE DisplayMOREatBottom (M: Menu);
  614.  
  615.     BEGIN
  616.         WITH M^ DO
  617.             IF ShowBorder THEN
  618.                 WITH LocationInWindow DO
  619.                     SetCursor (win, firstrow+height, firstcol+width-6);
  620.                 END (*WITH*);
  621.                 WriteString (win, "*MORE*");
  622.             END (*IF*);
  623.         END (*WITH*);
  624.     END DisplayMOREatBottom;
  625.  
  626. (************************************************************************)
  627.  
  628. PROCEDURE RemoveMOREatBottom (M: Menu);
  629.  
  630.     CONST HorizontalBar = '─';
  631.  
  632.     VAR j: [1..6];
  633.  
  634.     BEGIN
  635.         WITH M^ DO
  636.             IF ShowBorder THEN
  637.                 WITH LocationInWindow DO
  638.                     SetCursor (win, firstrow+height, firstcol+width-6);
  639.                 END (*WITH*);
  640.                 FOR j := 1 TO 6 DO
  641.                     WriteChar (win, HorizontalBar);
  642.                 END (*FOR*);
  643.             END (*IF*);
  644.         END (*WITH*);
  645.     END RemoveMOREatBottom;
  646.  
  647. (************************************************************************)
  648.  
  649. (*
  650. PROCEDURE BlinkCurrent (M: Menu);
  651.  
  652.     (* Toggles the blinking state of the current menu item.     *)
  653.  
  654.     BEGIN
  655.         WITH M^ DO
  656.             Blink (win, LocationInWindow.firstrow+row-1,
  657.                 (column-1)*(ColumnWidth+gap) + LocationInWindow.firstcol,
  658.                         ColumnWidth);
  659.         END (*WITH*);
  660.     END BlinkCurrent;
  661. *)
  662.  
  663. (************************************************************************)
  664. (*                          CURSOR MOVEMENTS                            *)
  665. (************************************************************************)
  666.  
  667. PROCEDURE DownARow (M: Menu);  FORWARD;
  668.  
  669. (************************************************************************)
  670.  
  671. PROCEDURE UpARow (M: Menu);
  672.  
  673.     (* Moves to the next item up, if present.  Scrolls if necessary.    *)
  674.  
  675.     BEGIN
  676.         WITH M^ DO
  677.             IF row > 1 THEN
  678.                 DEC (row);  DEC (CurrentItemNo, vstep);
  679.             ELSIF ExtraAtTop > 0 THEN
  680.                 DEC (CurrentItemNo, vstep);
  681.                 ScrollDown (win);
  682.                 DEC (ExtraAtTop);  INC (ExtraAtBottom);
  683.                 RefreshRow (M);
  684.                 IF MouseAvailable() THEN HideMouseCursor END (*IF*);
  685.                 IF ExtraAtTop = 0 THEN RemoveMOREatTop(M) END (*IF*);
  686.                 IF ExtraAtBottom = 1 THEN DisplayMOREatBottom(M) END(*IF*);
  687.                 IF MouseAvailable() THEN ShowMouseCursor END (*IF*);
  688.             ELSE
  689.                 CASE offT OF
  690.                   | stick:      (* no action needed*) ;
  691.                   | wrap:       WHILE (row < LocationInWindow.height)
  692.                                         OR (ExtraAtBottom > 0) DO
  693.                                     DownARow(M);
  694.                                 END (*WHILE*);
  695.                   | escape:     CurrentItemNo := 0;  RanOffEdge := TRUE;
  696.                   | return:     RanOffEdge := TRUE;
  697.                 END (*CASE*);
  698.             END (*IF*);
  699.         END (*WITH*);
  700.     END UpARow;
  701.  
  702. (************************************************************************)
  703.  
  704. PROCEDURE DownARow (M: Menu);
  705.  
  706.     (* Moves to the next item down, if present.  Scrolls if necessary.  *)
  707.  
  708.     BEGIN
  709.         WITH M^ DO
  710.             IF row < LocationInWindow.height THEN
  711.                 INC (row);  INC (CurrentItemNo, vstep);
  712.             ELSIF ExtraAtBottom > 0 THEN
  713.                 INC (CurrentItemNo, vstep);  ScrollUp (win);
  714.                 INC (ExtraAtTop);  DEC (ExtraAtBottom);
  715.                 RefreshRow (M);
  716.                 IF MouseAvailable() THEN HideMouseCursor END (*IF*);
  717.                 IF ExtraAtTop = 1 THEN DisplayMOREatTop(M) END (*IF*);
  718.                 IF ExtraAtBottom = 0 THEN RemoveMOREatBottom(M) END (*IF*);
  719.                 IF MouseAvailable() THEN ShowMouseCursor END (*IF*);
  720.             ELSE
  721.                 CASE offB OF
  722.                   | stick:      (* no action needed*) ;
  723.                   | wrap:       WHILE (row > 1) OR (ExtraAtTop > 0) DO
  724.                                     UpARow (M);
  725.                                 END (*WHILE*);
  726.                   | escape:     CurrentItemNo := 0;  RanOffEdge := TRUE;
  727.                   | return:     RanOffEdge := TRUE;
  728.                 END (*CASE*);
  729.             END (*IF*);
  730.         END (*WITH*);
  731.     END DownARow;
  732.  
  733. (************************************************************************)
  734.  
  735. PROCEDURE MoveRight (M: Menu);
  736.  
  737.     (* Moves to the next item right, if present.        *)
  738.  
  739.     BEGIN
  740.         WITH M^ DO
  741.             IF column < NoOfColumns THEN
  742.                 INC (column);  INC (CurrentItemNo, hstep);
  743.             ELSE
  744.                 CASE offR OF
  745.                   | stick:      (* no action needed*) ;
  746.                   | wrap:       DEC (CurrentItemNo, hstep*(column-1));
  747.                                 column := 1;
  748.                   | escape:     CurrentItemNo := 0;  RanOffEdge := TRUE;
  749.                   | return:     RanOffEdge := TRUE;
  750.                 END (*CASE*);
  751.             END (*IF*);
  752.         END (*WITH*);
  753.     END MoveRight;
  754.  
  755. (************************************************************************)
  756.  
  757. PROCEDURE MoveLeft (M: Menu);
  758.  
  759.     (* Moves to the next item left, if present. *)
  760.  
  761.     BEGIN
  762.         WITH M^ DO
  763.             IF column > 1 THEN
  764.                 DEC (column);  DEC (CurrentItemNo, hstep);
  765.             ELSE
  766.                 CASE offL OF
  767.                   | stick:      (* no action needed*) ;
  768.                   | wrap:       INC (CurrentItemNo, hstep*(NoOfColumns-1));
  769.                                 column := NoOfColumns;
  770.                   | escape:     CurrentItemNo := 0;  RanOffEdge := TRUE;
  771.                   | return:     RanOffEdge := TRUE;
  772.                 END (*CASE*);
  773.             END (*IF*);
  774.         END (*WITH*);
  775.     END MoveLeft;
  776.  
  777. (************************************************************************)
  778.  
  779. PROCEDURE GotoItem (M: Menu;  newitem: ItemNo);
  780.  
  781.     (* Moves to the menu item whose number is specified.  We move a row *)
  782.     (* at a time, rather than taking one big leap, since this is less   *)
  783.     (* disconcerting to the user.                                       *)
  784.  
  785.     BEGIN
  786.         WITH M^ DO
  787.             IF newitem <> CurrentItemNo THEN
  788.                 IF vstep = 1 THEN       (* we are using column major order *)
  789.                     column := ((newitem-1) DIV hstep) + 1;
  790.                 ELSE                    (* we are using row major order *)
  791.                     column := ((newitem-1) MOD vstep) + 1;
  792.                 END (*IF*);
  793.                 CurrentItemNo := (column-1)*hstep
  794.                                         + (ExtraAtTop+row-1)*vstep + 1;
  795.                 WHILE CurrentItemNo > newitem DO UpARow(M) END (*WHILE*);
  796.                 WHILE CurrentItemNo < newitem DO DownARow(M) END (*WHILE*);
  797.             END (*IF*);
  798.         END (*WITH*);
  799.     END GotoItem;
  800.  
  801. (************************************************************************)
  802.  
  803. PROCEDURE RepositionTo (M: Menu;  searchchar: CHAR): BOOLEAN;
  804.  
  805.     (* Finds the next menu item whose selection character matches       *)
  806.     (* selchar, and adjusts the display appropriately.  Returns TRUE if *)
  807.     (* searchchar was actually found; otherwise the current menu item   *)
  808.     (* doesn't change and the function result is FALSE.                 *)
  809.  
  810.     VAR j: ItemNo;  found: BOOLEAN;
  811.  
  812.     BEGIN
  813.         WITH M^ DO
  814.             j := CurrentItemNo;
  815.             REPEAT
  816.                 IF j >= NoOfItems THEN j := 1
  817.                 ELSE INC (j)
  818.                 END (*IF*);
  819.                 WITH TextPtr^[j] DO
  820.                     found := CAP(text[selpos]) = searchchar;
  821.                 END (*WITH*);
  822.             UNTIL found OR (j = CurrentItemNo);
  823.         END (*WITH*);
  824.         GotoItem (M, j);
  825.         RETURN found;
  826.     END RepositionTo;
  827.  
  828. (************************************************************************)
  829.  
  830. PROCEDURE HandleFunctionKey (M: Menu;  VAR (*INOUT*) option: CHAR);
  831.  
  832.     (* Deals with the case where the user typed a function key - i.e.   *)
  833.     (* any key which produces a two-code sequence where the first code  *)
  834.     (* is CHR(0).  On entry, the CHR(0) has already been read.          *)
  835.  
  836.     VAR count: CARDINAL;
  837.  
  838.     BEGIN
  839.         WITH M^ DO
  840.             option := GetKey(win);
  841.             IF option = "H" THEN UpARow(M)              (* cursor up *)
  842.             ELSIF option = "P" THEN DownARow(M)         (* cursor down *)
  843.             ELSIF option = "M" THEN MoveRight(M)        (* cursor right *)
  844.             ELSIF option = "K" THEN MoveLeft(M)         (* cursor left *)
  845.             ELSIF option = "G" THEN                     (* home *)
  846.                 GotoItem (M, 1);
  847.             ELSIF option = "O" THEN                     (* end *)
  848.                 GotoItem (M, NoOfColumns*ItemsPerColumn);
  849.                 GotoItem (M, NoOfItems);
  850.             ELSIF option = "I" THEN                     (* page up *)
  851.                 IF row = 1 THEN
  852.                     IF ExtraAtTop > 0 THEN
  853.                         count := LocationInWindow.height;
  854.                         REPEAT
  855.                             UpARow(M);  DEC (count);
  856.                         UNTIL (count=0) OR (ExtraAtTop=0);
  857.                     END (*IF*)
  858.                 ELSE
  859.                     WHILE row > 1 DO UpARow(M) END (*WHILE*)
  860.                 END (*IF*)
  861.             ELSIF option = "Q" THEN                     (* page down *)
  862.                 IF row = LocationInWindow.height THEN
  863.                     IF ExtraAtBottom > 0 THEN
  864.                         count := LocationInWindow.height;
  865.                         REPEAT
  866.                             DownARow(M);  DEC (count);
  867.                         UNTIL (count=0) OR (ExtraAtBottom=0);
  868.                     END (*IF*)
  869.                 ELSE
  870.                     WHILE row < LocationInWindow.height DO
  871.                         DownARow(M);
  872.                     END (*WHILE*)
  873.                 END (*IF*)
  874.             END (*IF*);
  875.         END (*WITH*);
  876.     END HandleFunctionKey;
  877.  
  878. (************************************************************************)
  879. (*                      DEALING WITH MOUSE CLICKS                       *)
  880. (************************************************************************)
  881.  
  882. PROCEDURE SelectItemAt (M: Menu;  r: RowRange;  c: ColumnRange);
  883.  
  884.     VAR NewItemNo: ItemNo;  OnAnItem: BOOLEAN;
  885.  
  886.     BEGIN
  887.         WITH M^ DO
  888.             WITH LocationInWindow DO
  889.                 DEC (r, firstrow);  DEC (c, firstcol);
  890.             END (*WITH*);
  891.             OnAnItem := c MOD (ColumnWidth+gap) < ColumnWidth;
  892.             c := c DIV (ColumnWidth+gap);
  893.             IF c >= NoOfColumns THEN OnAnItem := FALSE END(*IF*);
  894.  
  895.             IF OnAnItem THEN
  896.                 (* We have now reduced (r,c) to be the coordinates of   *)
  897.                 (* an item in the visible part of the array, with (0,0) *)
  898.                 (* corresponding to the top left position.              *)
  899.  
  900.                 NewItemNo := c*hstep + (ExtraAtTop+r)*vstep + 1;
  901.  
  902.                 (* The first click on an item simply means that we      *)
  903.                 (* should go to that item; a second click on the same   *)
  904.                 (* item means that we should accept it as the result.   *)
  905.                 (* If the FastSelect option is enabled, the first click *)
  906.                 (* will select the item as the result.                  *)
  907.  
  908.                 IF FastSelect OR (NewItemNo = CurrentItemNo) THEN
  909.                     PutBack (" ");
  910.                 END (*IF*);
  911.                 HideMouseCursor;
  912.                 GotoItem (M, NewItemNo);
  913.                 ShowMouseCursor;
  914.             END (*IF*);
  915.  
  916.         END (*WITH*);
  917.  
  918.     END SelectItemAt;
  919.  
  920. (************************************************************************)
  921.  
  922. PROCEDURE InterpretMouseClick (M: Menu);
  923.  
  924.     (* This procedure is called when we know that a mouse click has     *)
  925.     (* been detected and its details stored in LastMouseClick.  This    *)
  926.     (* procedure checks whether the click is relevant to menu M, and    *)
  927.     (* takes the appropriate action if so.                              *)
  928.  
  929.     VAR OK: BOOLEAN;  row: RowRange;  column: ColumnRange;
  930.  
  931.     BEGIN
  932.         WITH LastMouseClick DO
  933.             Obtain (access);
  934.             OK := valid AND (win = M^.win);
  935.             IF OK THEN
  936.                 column := X;  row := Y;
  937.             END (*IF*);
  938.             valid := FALSE;
  939.             Release (access);
  940.         END (*WITH*);
  941.         IF OK THEN
  942.             SelectItemAt (M, row, column);
  943.         END (*IF*);
  944.     END InterpretMouseClick;
  945.  
  946. (************************************************************************)
  947.  
  948. PROCEDURE RecordClick (w: Window;  row: RowRange;  col: ColumnRange);
  949.  
  950.     (* This procedure is called asynchronously as the result of a mouse *)
  951.     (* click.  The parameters tell us which window was clicked on, and  *)
  952.     (* where in that window the click occurred, but they don't tell us  *)
  953.     (* which menu is involved.  Rather than work that out here, we      *)
  954.     (* stuff a special character into the keyboard.  Procedure          *)
  955.     (* MakeTheSelection will pick up that special character and from    *)
  956.     (* that deduce that it needs to look at the LastMouseClick data.    *)
  957.  
  958.     BEGIN
  959.         WITH LastMouseClick DO
  960.             Obtain (access);
  961.             win := w;
  962.             X := col;  Y := row;
  963.             valid := TRUE;
  964.             Release (access);
  965.             StuffKeyboardBuffer (ClickIndicator);
  966.         END (*WITH*);
  967.     END RecordClick;
  968.  
  969. (************************************************************************)
  970.  
  971. PROCEDURE ClickOnTop (w: Window;  row: RowRange;  col: ColumnRange);
  972.  
  973.     (* This procedure is triggered by a mouse click on the window       *)
  974.     (* divider.  We turn this into a "cursor up" command.               *)
  975.  
  976.     BEGIN
  977.         StuffKeyboardBuffer (CHR(0));
  978.         StuffKeyboardBuffer ("H");
  979.     END ClickOnTop;
  980.  
  981. (************************************************************************)
  982.  
  983. PROCEDURE ClickOnTopMORE (w: Window;  row: RowRange;  col: ColumnRange);
  984.  
  985.     (* This procedure is triggered by a mouse click on the top *MORE*   *)
  986.     (* indicator.  We turn this into a "page up" command.               *)
  987.  
  988.     BEGIN
  989.         StuffKeyboardBuffer (CHR(0));
  990.         StuffKeyboardBuffer ("I");
  991.     END ClickOnTopMORE;
  992.  
  993. (************************************************************************)
  994.  
  995. PROCEDURE ClickOnBottom (w: Window;  row: RowRange;  col: ColumnRange);
  996.  
  997.     (* This procedure is triggered by a mouse click on the bottom       *)
  998.     (* of the window frame.  We turn this into a "cursor down" command. *)
  999.  
  1000.     BEGIN
  1001.         StuffKeyboardBuffer (CHR(0));
  1002.         StuffKeyboardBuffer ("P");
  1003.     END ClickOnBottom;
  1004.  
  1005. (************************************************************************)
  1006.  
  1007. PROCEDURE ClickOnBottomMORE (w: Window;  row: RowRange;  col: ColumnRange);
  1008.  
  1009.     (* This procedure is triggered by a mouse click on the bottom       *)
  1010.     (* *MORE* indicator.  We turn this into a "page down" command.      *)
  1011.  
  1012.     BEGIN
  1013.         StuffKeyboardBuffer (CHR(0));
  1014.         StuffKeyboardBuffer ("Q");
  1015.     END ClickOnBottomMORE;
  1016.  
  1017. (************************************************************************)
  1018.  
  1019. PROCEDURE ClickOutsideMenu;
  1020.  
  1021.     (* This procedure is triggered by a mouse click outside the menu.   *)
  1022.     (* We turn this into an Esc keycode.                                *)
  1023.  
  1024.     BEGIN
  1025.         StuffKeyboardBuffer (Esc);
  1026.     END ClickOutsideMenu;
  1027.  
  1028. (************************************************************************)
  1029. (*                          SCREEN DISPLAY                              *)
  1030. (************************************************************************)
  1031.  
  1032. PROCEDURE OpeningDisplay (M: Menu;  initialvalue: CARDINAL);
  1033.  
  1034.     (* Sets up the initial state of the display of M.  It is assumed    *)
  1035.     (* that window M^.win is already open and that the position of the  *)
  1036.     (* menu has already been set.  It is also assumed that the border   *)
  1037.     (* and title, if needed, have already been displayed.               *)
  1038.  
  1039.     VAR j: RowRange;
  1040.  
  1041.     BEGIN
  1042.         WITH M^ DO
  1043.             IF (initialvalue = 0) OR (initialvalue > NoOfItems) THEN
  1044.                 initialvalue := 1;
  1045.             END (*IF*);
  1046.             RanOffEdge := FALSE;
  1047.             CurrentItemNo := 1;  column := 1;  ExtraAtTop := 0;
  1048.             ExtraAtBottom := ItemsPerColumn - LocationInWindow.height;
  1049.             FOR j := 1 TO LocationInWindow.height DO
  1050.                 row := j;  RefreshRow (M);
  1051.             END (*FOR*);
  1052.             row := 1;
  1053.             IF (ExtraAtBottom > 0) THEN
  1054.                 IF MouseAvailable() THEN HideMouseCursor END (*IF*);
  1055.                 DisplayMOREatBottom (M);
  1056.                 IF MouseAvailable() THEN ShowMouseCursor END (*IF*);
  1057.             END (*IF*);
  1058.         END (*WITH*);
  1059.         GotoItem (M, initialvalue);
  1060.     END OpeningDisplay;
  1061.  
  1062. (************************************************************************)
  1063.  
  1064. PROCEDURE DisplayMenu (w: Window;  M: Menu;
  1065.                                 rows, columns, initialvalue: CARDINAL);
  1066.  
  1067.     (* Displays menu M at the current cursor position in window w,      *)
  1068.     (* with initialvalue specifying a field to highlight.               *)
  1069.  
  1070.     VAR row1, col1: CARDINAL;
  1071.  
  1072.     BEGIN
  1073.         SaveCursor (w, row1, col1);
  1074.         WITH M^ DO
  1075.             win := w;
  1076.             IF ShowBorder THEN
  1077.                 Box (w, row1, col1, columns-1, rows-1, single);
  1078.                 INC (row1);  INC (col1);
  1079.                 DEC (rows, 2);  DEC (columns, 2);
  1080.             END (*IF*);
  1081.             IF ShowTitle THEN
  1082.                 INC (row1, 2);  DEC (rows, 2);
  1083.                 IF ShowBorder THEN
  1084.                     HLine (w, row1-1, col1-1, col1+columns, double);
  1085.                 ELSE
  1086.                     HLine (w, row1-1, col1, col1+columns-1, double);
  1087.                 END (*IF*);
  1088.             END (*IF*);
  1089.             SetRelativeLocation (M, row1, col1, rows, columns);
  1090.             IF ShowTitle THEN
  1091.                 SetCursor (w, row1-2, col1);  WriteString (w, heading);
  1092.             END (*IF*);
  1093.         END (*WITH*);
  1094.         NewScrollingRegion (w, row1, row1+rows-1, col1, col1+columns-1);
  1095.         OpeningDisplay (M, initialvalue);
  1096.         Highlight (M);  ResetScrollingRegion (w);
  1097.     END DisplayMenu;
  1098.  
  1099. (************************************************************************)
  1100. (*                   MAKING A SELECTION FROM A MENU                     *)
  1101. (************************************************************************)
  1102.  
  1103. PROCEDURE MakeTheSelection (M: Menu);
  1104.  
  1105.     (* Allows the keyboard user to alter the state of menu M by use of  *)
  1106.     (* the cursor control keys, or by typing the initial letter of a    *)
  1107.     (* menu item.  Returns when Space or Enter is typed, also returns   *)
  1108.     (* with M^.CurrentItem=0 if Esc is typed.  In Special Mode only,    *)
  1109.     (* also returns if a cursor movement key would run us off the edge  *)
  1110.     (* of the menu.  (In Normal Mode, any attempt to run off the edge   *)
  1111.     (* is ignored.)  In addition, in Special Mode the final key typed   *)
  1112.     (* remains available (e.g. by InKey()) to the caller.               *)
  1113.  
  1114.     TYPE CHARSET = SET OF CHAR;
  1115.  
  1116.     CONST CR = CHR(0DH);
  1117.  
  1118.     VAR option: CHAR;
  1119.  
  1120.     BEGIN
  1121.         WITH M^ DO
  1122.             RanOffEdge := FALSE;
  1123.             LOOP
  1124.                 Highlight (M);
  1125.                 option := GetKey (M^.win);
  1126.                 Unhighlight (M);
  1127.                 IF option = ClickIndicator THEN
  1128.                     InterpretMouseClick(M);
  1129.                 ELSIF option = " " THEN EXIT(*LOOP*)
  1130.                 ELSIF option = CR THEN EXIT (*LOOP*)
  1131.                 ELSIF option = Esc THEN
  1132.                     CurrentItemNo := 0;  EXIT (*LOOP*)
  1133.                 ELSIF option IN CHARSET{"0".."9", "A".."Z", "a".."z"} THEN
  1134.                     IF RepositionTo(M, CAP(option)) AND FastSelect THEN
  1135.                         EXIT (*LOOP*);
  1136.                     END (*IF*);
  1137.                 ELSIF option = CHR(0) THEN
  1138.                     HandleFunctionKey (M, option);
  1139.                     IF RanOffEdge THEN
  1140.                         IF PutBackExitKey THEN
  1141.                             PutBack (option);  option := CHR(0);
  1142.                         END (*IF*);
  1143.                         EXIT (*LOOP*);
  1144.                     END (*IF*);
  1145.                 END (*IF*);
  1146.             END (*LOOP*);
  1147.             IF PutBackExitKey THEN
  1148.                 PutBack (option);
  1149.             END (*IF*);
  1150.             IF CurrentItemNo > NoOfItems THEN
  1151.                 CurrentItemNo := 0;
  1152.             END (*IF*);
  1153.         END (*WITH*);
  1154.     END MakeTheSelection;
  1155.  
  1156. (************************************************************************)
  1157.  
  1158. PROCEDURE SelectFromMenu (M: Menu): CARDINAL;
  1159.  
  1160.     (* Displays menu M on the screen, allows terminal user to use       *)
  1161.     (* cursor keys to move about the menu and the ENTER key to select   *)
  1162.     (* an item.  (The space bar is also accepted, as an alternative to  *)
  1163.     (* the ENTER key, to select an item).  An item may also be selected *)
  1164.     (* by typing its initial letter, followed by space or ENTER.        *)
  1165.     (* Returns the number of the item which was selected.               *)
  1166.     (* (Item numbers start from 1).  An answer of 0 indicates that the  *)
  1167.     (* user typed the ESC key to return without selecting anything.     *)
  1168.  
  1169.     (* Remark: it is possible with the cursor keys to "select" a        *)
  1170.     (* nonexistent item at the bottom of the last column.  The result   *)
  1171.     (* will be 0 in this case.  Although this might appear to be a bug, *)
  1172.     (* it is deliberate.  I found by experiment that the more "logical" *)
  1173.     (* approach of stopping the user from moving the cursor into a      *)
  1174.     (* blank region was a nuisance for the user.                        *)
  1175.  
  1176.     VAR UIW: UIWindow;  frame: FrameType;
  1177.         capabilities: CapabilitySet;  framesize: CARDINAL;
  1178.  
  1179.     BEGIN
  1180.         WITH M^ DO
  1181.  
  1182.             (* Open the window, unless it's already open. *)
  1183.  
  1184.             IF win = NilWindow THEN
  1185.                 framesize := 0;
  1186.                 IF MouseAvailable() THEN HideMouseCursor END(*IF*);
  1187.                 WITH ScreenPosition DO
  1188.                     IF ShowBorder THEN
  1189.                         frame := simpleframe;  framesize := 1;
  1190.                     ELSE frame := noframe
  1191.                     END (*IF*);
  1192.                     OpenWindow (win, foreground, background,
  1193.                                 firstrow, lastrow, firstcol, lastcol,
  1194.                                 frame, doubledivider);
  1195.                     IF ShowTitle THEN
  1196.                         WriteString (win, heading);
  1197.                         ChangeScrollingRegion (win, 2+framesize,
  1198.                                                 lastrow-firstrow-framesize);
  1199.                     END (*IF*);
  1200.                 END (*WITH*);
  1201.  
  1202.                 IF MouseAvailable() THEN
  1203.                     IF ShowBorder AND MouseControl THEN
  1204.                         capabilities := CapabilitySet {wshow, wmove, wescape};
  1205.                     ELSE
  1206.                         capabilities := CapabilitySet {wshow};
  1207.                     END (*IF*);
  1208.                     UIW := AllowMouseControl (win, heading, capabilities);
  1209.                     IF CloseOnClickOutsideMenu THEN
  1210.                         OutsideWindowHandler (UIW, ClickOutsideMenu);
  1211.                     END (*IF*);
  1212.                     WITH LocationInWindow DO
  1213.                         AddActiveRegion (UIW, firstrow, firstrow+height-1,
  1214.                                 firstcol, firstcol+width-1,
  1215.                                 LeftOnly, RecordClick);
  1216.                         IF ShowTitle OR (ShowBorder AND NOT MouseControl) THEN
  1217.                             AddActiveRegion (UIW, firstrow-1, firstrow-1,
  1218.                                 firstcol, firstcol+width-7,
  1219.                                 LeftOnly, ClickOnTop);
  1220.                             AddActiveRegion (UIW, firstrow-1, firstrow-1,
  1221.                                 firstcol+width-6, firstcol+width-1,
  1222.                                 LeftOnly, ClickOnTopMORE);
  1223.                         END (*IF*);
  1224.                         IF ShowBorder THEN
  1225.                             AddActiveRegion (UIW, firstrow+height, firstrow+height,
  1226.                                 firstcol, firstcol+width-7,
  1227.                                 LeftOnly, ClickOnBottom);
  1228.                             AddActiveRegion (UIW, firstrow+height, firstrow+height,
  1229.                                 firstcol+width-6, firstcol+width-1,
  1230.                                 LeftOnly, ClickOnBottomMORE);
  1231.                         END (*IF*);
  1232.                     END (*WITH*);
  1233.                     ShowMouseCursor;
  1234.                 END (*IF*);
  1235.  
  1236.                 OpeningDisplay (M, 1);
  1237.  
  1238.             END (*IF*);
  1239.  
  1240.             WITH LocationInWindow DO
  1241.                 NewScrollingRegion (win, firstrow, firstrow+height-1,
  1242.                                         firstcol, firstcol+width-1);
  1243.             END (*WITH*);
  1244.  
  1245.             (* Window is now open, let the user make a selection. *)
  1246.  
  1247.             MakeTheSelection (M);
  1248.             IF CurrentItemNo > 0 THEN
  1249.                 Highlight (M);
  1250.             END (*IF*);
  1251.             ResetScrollingRegion (win);
  1252.  
  1253.             (* Close the window, if appropriate. *)
  1254.  
  1255.             IF CloseAfterSelection THEN
  1256.                 IF MouseAvailable() THEN HideMouseCursor END(*IF*);
  1257.                 CloseWindow (win);  win := NilWindow;
  1258.                 IF MouseAvailable() THEN ShowMouseCursor END(*IF*);
  1259.             END (*IF*);
  1260.  
  1261.             RETURN CurrentItemNo;
  1262.  
  1263.         END (*WITH*);
  1264.  
  1265.     END SelectFromMenu;
  1266.  
  1267. (************************************************************************)
  1268.  
  1269. BEGIN
  1270.     WITH LastMouseClick DO
  1271.         CreateLock (access);
  1272.         valid := FALSE;
  1273.     END (*WITH*);
  1274. END Menus.
  1275.  
  1276.