home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Shareware BBS: 10 Tools
/
10-Tools.zip
/
pmos2002.zip
/
SRC
/
LISTEDIT.MOD
< prev
next >
Wrap
Text File
|
1996-10-02
|
14KB
|
345 lines
IMPLEMENTATION MODULE ListEditor;
(********************************************************)
(* *)
(* "Generic" list editor *)
(* *)
(* Programmer: P. Moylan *)
(* Last edited: 2 October 1996 *)
(* Status: Seems OK *)
(* *)
(********************************************************)
FROM SYSTEM IMPORT
(* type *) ADDRESS;
FROM FieldEditor IMPORT
(* type *) FieldType,
(* proc *) WriteField, EditField;
FROM Windows IMPORT
(* type *) Window, ColumnRange,
(* proc *) SaveCursor, SetCursor, WriteString;
FROM Storage IMPORT
(* proc *) ALLOCATE, DEALLOCATE;
FROM Keyboard IMPORT
(* proc *) InKey, PutBack;
(************************************************************************)
CONST CursorLeftCode = "K"; CursorRightCode = "M";
TYPE
String = ARRAY ColumnRange OF CHAR;
(* The following definition shows the general structure of the sort *)
(* of lists which we can handle. *)
InternalList = POINTER TO InternalListElement;
InternalListElement = RECORD
next: InternalList;
component: ADDRESS;
END (*RECORD*);
(* Details needed for displaying a list on the screen. *)
ListFormat = POINTER TO ListFormatRecord;
ListFormatRecord = RECORD
header, separator, trailer: String;
ctype: FieldType;
END (*RECORD*);
(************************************************************************)
(* DEFINING A NEW LIST FORMAT *)
(************************************************************************)
PROCEDURE CopyString (source: ARRAY OF CHAR; VAR (*OUT*) destination: String);
(* Copies the source string to the destination string. Care is *)
(* needed here in getting the terminator right, because of the *)
(* strange way the FTL compiler deals with string constants. *)
VAR j, last: ColumnRange;
BEGIN
last := MAX(ColumnRange);
IF last > HIGH(source) THEN
last := HIGH(source);
destination[last+1] := CHR(0);
END (*IF*);
FOR j := 0 TO last DO
destination[j] := source[j];
END (*FOR*);
END CopyString;
(************************************************************************)
PROCEDURE DefineListFormat (s1, s2, s3: ARRAY OF CHAR;
ComponentType: FieldType): ListFormat;
(* Sets up the output format for a class of lists. *)
VAR result: ListFormat;
BEGIN
NEW (result);
WITH result^ DO
CopyString (s1, header);
CopyString (s2, separator);
CopyString (s3, trailer);
ctype := ComponentType;
END (*WITH*);
RETURN result;
END DefineListFormat;
(************************************************************************)
PROCEDURE DiscardFormat (format: ListFormat);
(* A notification from the user that this format will not be used *)
(* again (unless it is redefined by another call to procedure *)
(* DefineListFormat). Use of this procedure is optional, but is *)
(* recommended for the sake of "clean" memory management. *)
BEGIN
DISPOSE (format);
END DiscardFormat;
(************************************************************************)
(* SCREEN OUTPUT *)
(************************************************************************)
PROCEDURE WriteTail (w: Window; L: InternalList; format: ListFormat);
(* Writes L on the screen, without its header string. The screen *)
(* cursor is left at the character position following the trailer. *)
BEGIN
IF L <> NIL THEN
LOOP
WriteField (w, L^.component, format^.ctype, 0);
L := L^.next;
IF L = NIL THEN EXIT(*LOOP*) END(*IF*);
WriteString (w, format^.separator);
END (*LOOP*);
END (*IF*);
WriteString (w, format^.trailer);
END WriteTail;
(************************************************************************)
PROCEDURE WriteList (w: Window; L: List; format: ListFormat);
(* Writes L on the screen, including its delimiters. This *)
(* procedure is not actually used in this module, but is provided *)
(* as something that a client module may find useful. *)
BEGIN
WriteString (w, format^.header);
WriteTail (w, L, format);
END WriteList;
(************************************************************************)
(* KEYBOARD INPUT *)
(************************************************************************)
PROCEDURE FunctionKey (code: CHAR): BOOLEAN;
(* Checks for CHR(0) followed by the given code from the keyboard. *)
(* If found, returns TRUE. If not found, returns FALSE and no *)
(* keyboard input is consumed. *)
VAR ch: CHAR;
BEGIN
ch := InKey();
IF ch <> CHR(0) THEN
PutBack (ch); RETURN FALSE;
END (*IF*);
ch := InKey();
IF ch <> code THEN
PutBack (ch); PutBack (CHR(0)); RETURN FALSE;
END (*IF*);
RETURN TRUE;
END FunctionKey;
(************************************************************************)
(* EDITING *)
(************************************************************************)
(* *)
(* Each of the editing procedures in this module has the properties: *)
(* *)
(* 1. We leave the procedure on seeing a keyboard character which *)
(* does not belong to us. The terminating keystroke is returned *)
(* to the keyboard driver so that it can still be read by the *)
(* caller. *)
(* 2. The window cursor is left just beyond the "trailer" string *)
(* which terminates the written form of the list. *)
(* 3. The list being edited may be empty on entry and/or exit. *)
(* *)
(* The differences among the procedures are in terms of the starting *)
(* point on the screen - that is, whether we start by writing a list *)
(* separator, a component, or a header string. *)
(* *)
(************************************************************************)
PROCEDURE EditFromSeparator (w: Window; VAR (*INOUT*) L: InternalList;
format: ListFormat); FORWARD;
(************************************************************************)
PROCEDURE EditFromComponent (w: Window; VAR (*INOUT*) L: InternalList;
format: ListFormat);
(* This procedure is the one which does most of the real work. *)
(* On entry, the screen cursor is at the place where the first *)
(* component must be written, i.e. the header or separator, as *)
(* appropriate, has already been written. The screen display is *)
(* correct on exit in all cases except where an empty list is *)
(* returned and the caller had placed a separator in front of the *)
(* displayed list. In that case, it is the caller's responsibility *)
(* to get rid of the separator. *)
VAR temp: InternalList;
startrow, newrow, startcolumn, newcolumn: CARDINAL;
BEGIN
(* If we are at the end of a list, extend it to allow a new *)
(* component to be added. (If the user does not take us up on *)
(* that offer, the new element will be deleted - see below.) *)
IF L = NIL THEN
NEW (L);
WITH L^ DO
next := NIL; component := NIL;
END (*WITH*);
END (*IF*);
SaveCursor (w, startrow, startcolumn);
WriteTail (w, L, format);
LOOP
SetCursor (w, startrow, startcolumn);
(* Edit the current list component. Assumption: the *)
(* component editor will leave the window cursor at the *)
(* character position beyond the end of that component. *)
EditField (w, L^.component, format^.ctype, 0);
(* If the user deleted this component - either as an *)
(* explicit deletion or by ignoring the invitation to add a *)
(* new component - discard the corresponding list element. *)
IF L^.component = NIL THEN
temp := L; L := L^.next; DISPOSE (temp);
SetCursor (w, startrow, startcolumn);
WriteTail (w, L, format);
(* If the list is now empty, even after we have given *)
(* the user the chance to extend it, we can conclude *)
(* that the user has finished editing this list. *)
IF L = NIL THEN
EXIT (*LOOP*);
END (*IF*);
(* If the user wants to move right at this stage, *)
(* consume one "cursor right" keypress, because we are *)
(* already at the element which used to be to the right *)
(* of the now-deleted one. *)
IF FunctionKey (CursorRightCode) THEN
(* do nothing with the keypress *)
END (*IF*);
ELSE (* component <> NIL *)
(* Just in case the component editor has messed up *)
(* some of the screen display, write a clean copy. *)
SaveCursor (w, newrow, newcolumn);
SetCursor (w, startrow, startcolumn);
WriteTail (w, L, format);
(* At this stage, a "cursor right" means that we should *)
(* move on to the next group, and any other key should *)
(* be given to the caller to deal with. *)
IF NOT FunctionKey (CursorRightCode) THEN
EXIT (*LOOP*);
END (*IF*);
(* We have indeed received a "cursor right" code. *)
SetCursor (w, newrow, newcolumn);
EditFromSeparator (w, L^.next, format);
IF NOT FunctionKey (CursorLeftCode) THEN
EXIT (*LOOP*)
END (*IF*);
END (*IF*);
END (*LOOP*);
END EditFromComponent;
(************************************************************************)
PROCEDURE EditFromSeparator (w: Window; VAR (*INOUT*) L: InternalList;
format: ListFormat);
(* On entry, the screen cursor is at the place where the separator *)
(* must be written, or the trailer in the case L = NIL. The case *)
(* L = NIL is possible on entry and/or exit. On exit, the screen *)
(* display has been correctly updated. *)
VAR startrow, startcolumn: CARDINAL;
BEGIN
SaveCursor (w, startrow, startcolumn);
(* Write the separator, and do the actual editing. *)
WriteString (w, format^.separator);
EditFromComponent (w, L, format);
(* If we are left with an empty list, overwrite the redundant *)
(* separator. *)
IF L = NIL THEN
SetCursor (w, startrow, startcolumn);
WriteString (w, format^.trailer);
END (*IF*);
END EditFromSeparator;
(************************************************************************)
PROCEDURE EditList (w: Window; VAR (*INOUT*) L: List; format: ListFormat);
(* Edits a list at the current cursor position in window w. We *)
(* leave this procedure on seeing a keyboard character which does *)
(* not belong to us. The terminating keystroke is returned to the *)
(* keyboard driver so that it can still be read by the caller. *)
(* The window cursor is left just beyond the "trailer" string which *)
(* terminates the written form of the list. *)
VAR Alias: InternalList;
BEGIN
Alias := L;
WriteString (w, format^.header);
EditFromComponent (w, Alias, format);
L := Alias;
END EditList;
(************************************************************************)
END ListEditor.
