123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857 |
- %
- % REFRESH.RED - Screen/Window/Refresh utilities for EMODE.
- %
- % Author: William F. Galway
- % Symbolic Computation Group
- % Computer Science Dept.
- % University of Utah
- % Date: 8 June 1982
- % Copyright (c) 1982 University of Utah
- %
- % Uses the "virtual-screen" package in VIRTUAL-SCREEN.SL.
- FLUID '(
- ShiftDisplayColumn % Amount to shift things to the left by
- % before (re)displaying lines.
- WindowList % List of active windows
- minor_window_list % List of windows to be ignored by the
- % "next_window" routine.
- pos_for_line_refresh
- % Offsets into virtual screen, adjusted depending on whether screen is
- % framed, labled, etc.
- row_offset
- column_offset
- );
- % pos_for_line_refresh is kept around so that we don't have to keep consing
- % up new coordinate pairs--an efficiency hack. '(NIL . NIL) may cause
- % problems on Vax (when we do RPLACA/RPLACD), since it goes to "pure
- % space"?
- pos_for_line_refresh := cons(NIL , NIL);
- ShiftDisplayColumn := 0;
- %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
- % Construct a screen coordinate pair (x,y) = (column,row)
- Symbolic Procedure Coords(col,rw);
- Cons(col,rw);
- Symbolic Procedure Column pos; %. X-coordinate (Column)
- car pos;
- Symbolic Procedure Row pos; %. Y-coordinate (Row)
- cdr pos;
- % Note: All regions defined in terms of Lower Corner (base) and distance
- % (delta values) to other corner INCLUSIVE, using 0-origin system.
- % Thus 0..3 has base 0, delta 3
- % 1..4 has base 1, delta 3
- Symbolic Procedure FrameScreen(scrn);
- % Generate a border for a screen.
- <<
- % Dashes for top and bottom rows.
- for i := 0:VirtualScreenWidth(scrn) do
- <<
- WriteToScreen(scrn, char !-, 0, i);
- WriteToScreen(scrn, char !-, VirtualScreenHeight(scrn), i);
- >>;
- % Vertical bars for the left and right sides.
- for i := 0:VirtualScreenHeight(scrn) do
- <<
- WriteToScreen(scrn, char !|, i, 0);
- WriteToScreen(scrn, char !|, i, VirtualScreenWidth(scrn));
- >>;
- % Finally, put plus signs in the corners.
- WriteToScreen(scrn, char !+, 0, 0);
- WriteToScreen(scrn, char !+, 0, VirtualScreenWidth(scrn));
- WriteToScreen(scrn, char !+, VirtualScreenHeight(scrn), 0);
- WriteToScreen(scrn, char !+,
- VirtualScreenHeight(scrn), VirtualScreenWidth(scrn));
- >>;
- Symbolic Procedure FramedWindowDescriptor(BufferName, upperleft, dxdy);
- % Create a "descriptor" for a "framed window" (into a text buffer), given
- % its associated buffer name, coord. of upper left corner, and its size as
- % (Delta X, Delta Y).
- begin scalar WindowDescriptor, newscreen;
- % The virtual screen includes room for a border around the edges.
- % (Add one to dimensions, to compensate for 0 indexing.)
- newscreen :=
- CreateVirtualScreen(1 + Row dxdy, 1 + Column dxdy,
- Row upperleft, Column upperleft);
- % Generate the border.
- FrameScreen(newscreen);
- WindowDescriptor :=
- list(
- % The refresh routine to use.
- 'windows_refresher . 'refresh_framed_window,
- 'WindowsBufferName . BufferName, % Associated Buffer
- % Routine to "throw away" the current view.
- 'views_cleanup_routine . 'cleanup_text_view,
- % Dimensions, (delta x . delta y), chop off a bit for the
- % frames. (Remember the 0 indexing! )
- 'CurrentWindowDelta .
- ( (Column(dxdy) - 2) . (Row(dxdy) - 2) ),
- % "Window image" information for refresh.
- % Note that Row dxdy = number of lines minus 1
- % (since it is an INCLUSIVE value). Each entry in NLIST gives
- % info on (Horizontal scroll . line in buffer)
- 'Window_Image .
- % ShiftdisplayColumn better than 0 here?
- Nlist(Row(dxdy)+1, '(0 . NIL)),
- % The last "buffer name" that was shown in the label, this can
- % change if the window starts looking into another buffer.
- 'LABEL_BufferName . NIL,
- % The filename associated with this window's buffer (at last
- % refresh).
- 'last_filename . NIL,
- % Value of CurrentLineIndex during last refresh.
- 'Last_LineIndex . 0,
- % Size of buffer (number of lines) during last refresh.
- 'Last_BufferSize . 0,
- 'CurrentVirtualScreen . newscreen,
- 'ShiftDisplayColumn . 0, % Horizontal Scroll value
- % Location in buffer that corresponds to top line in window.
- % Zero is rather implausible if "point" is somewhere in the
- % middle of the buffer, but that's OK since it gets adjusted to
- % the right value.
- 'TopOfDisplayIndex . 0
- );
- return WindowDescriptor;
- end;
- Symbolic Procedure UnframedWindowDescriptor(BufferName, upperleft, dxdy);
- % Create a "descriptor" for an "unframed window", given its
- % associated buffer name, coord. of upper left corner, and its size as
- % (Delta X, Delta Y). (This version is really meant for one line windows
- % only, results may be quite wierd otherwise.)
- begin scalar WindowDescriptor, newscreen;
- % The associated virtual screen ...
- % (Add one to dimensions, to compensate for 0 indexing.)
- newscreen :=
- CreateVirtualScreen(1 + Row dxdy, 1 + Column dxdy,
- Row upperleft, Column upperleft);
- WindowDescriptor :=
- list(
- % The refresh routine to use.
- 'windows_refresher . 'refresh_unframed_window,
- 'WindowsBufferName . BufferName, % Associated Buffer
- 'views_cleanup_routine . 'cleanup_text_view,
- % A "label" to appear at the beginning line of the window.
- 'window_label . "",
- % Value of window_label at last refresh, make it differ from
- % window_label to force initial refresh of label.
- 'old_window_label . NIL,
- % Window dimensions as (delta x . delta y).
- 'CurrentWindowDelta .
- ( (Column dxdy) . (Row dxdy) ),
- % "Window image" information for refresh.
- % Note that Row dxdy = number of lines minus 1
- % (since it is an INCLUSIVE value). Each entry in NLIST gives
- % info on (Horizontal scroll . line in buffer)
- 'Window_Image .
- % ShiftdisplayColumn better than 0 here?
- Nlist(Row(dxdy)+1, '(0 . NIL)),
- 'CurrentVirtualScreen . newscreen,
- 'ShiftDisplayColumn . 0, % Horizontal Scroll value
- % Location in buffer that corresponds to top line in window.
- % Zero is rather implausible if "point" is somewhere in the
- % middle of the buffer, but that's OK since it gets adjusted to
- % the right value.
- 'TopOfDisplayIndex . 0
- );
- return WindowDescriptor;
- end;
- fluid '(Prompt_Window Message_Window);
- Symbolic Procedure OneWindow();
- % Dispatch to this routine to enter one-window mode.
- if MajorWindowCount() neq 1 then % If not already one-window
- % then setup windows for one window mode.
- begin scalar old_prompt, old_msg, NewWindow ;
- % Preserve the "prompt" and "message" labels from old windows.
- old_prompt :=
- if Prompt_Window then cdr atsoc('window_label, Prompt_Window);
- old_msg :=
- if Message_Window then cdr atsoc('window_label, Message_Window);
- Setup_Windows
- list(
- % This window looks into the current buffer, other arguments
- % are location of upper left corner, and the size (0
- % indexed).
- % The window is made slightly wider than the screen, so that
- % the left and right frame boundaries don't actually show.
- NewWindow :=
- FramedWindowDescriptor(CurrentBufferName,
- % Upper left corner
- coords(Column ScreenBase - 1,
- Row ScreenBase - 1),
- % Size uses entire width, leaves room for
- % two one line windows at the bottom
- Coords(Column ScreenDelta + 2,
- Row(ScreenDelta) - 1)),
- % Looks into the "prompt line" buffer. Note this is
- % unframed, so we make it a bit smaller to have it all fit on
- % the screen.
- Prompt_Window :=
- UnframedWindowDescriptor('PROMPT_BUFFER,
- % Base is one line above bottom
- Coords(Column ScreenBase,
- Row ScreenBase + Row ScreenDelta - 1),
- % a single line (so delta row = 0)
- Coords(Column ScreenDelta, 0)),
- % Looks into the "message buffer", used for error messages
- % and general stuff.
- Message_Window :=
- UnframedWindowDescriptor('MESSAGE_BUFFER,
- % Base is at bottom
- Coords(Column ScreenBase,
- Row ScreenBase + Row ScreenDelta),
- % a single line (so delta row = 0)
- Coords(Column ScreenDelta, 0))
- );
- % Restore the labels from their old values (if any).
- SelectWindowContext(Prompt_Window);
- window_label := old_prompt;
- SelectWindowContext(Message_Window);
- window_label := old_msg;
- % Keep track of "minor windows".
- minor_window_list := list(Prompt_Window, Message_Window);
-
- SelectWindow NewWindow; % ??? needs more thought.
- end;
- Symbolic Procedure MajorWindowCount();
- % Return a count of the "major windows" in WindowList;
- length(WindowList) - length(minor_window_list);
- Symbolic Procedure next_window();
- % Dispatch to this routine to select "the next" (or "other") window
- begin scalar current_window_pointer;
- current_window_pointer := WindowList;
- % Look up the location of the current window in WindowList.
- while not((car current_window_pointer) eq CurrentWindowDescriptor)
- do
- current_window_pointer := cdr current_window_pointer;
- SelectWindow next_major_window(cdr(current_window_pointer), WindowList);
- end;
- Symbolic Procedure previous_window_command();
- % Dispatch to this routine to select the "previous" window.
- begin scalar current_window_pointer, rev_windowlist;
- rev_windowlist := reverse WindowList;
- current_window_pointer := rev_windowlist;
- % Look up the location of the current window in WindowList.
- while not((car current_window_pointer) eq CurrentWindowDescriptor)
- do
- current_window_pointer := cdr current_window_pointer;
- SelectWindow
- next_major_window(cdr(current_window_pointer), rev_windowlist);
- end;
- Symbolic Procedure next_major_window(pntr, wlist);
- % Return the window descriptor for the next "major" window at or after pntr
- % in wlist. It's assumed that there is at least one major window.
- if null pntr then
- next_major_window(wlist,wlist)
- else if not MemQ(car pntr, minor_window_list) then
- car pntr
- else
- next_major_window(cdr pntr, wlist);
- % Return T if the buffer is present in some "active" window (not
- % necessarily visible, it may be covered up).
- Symbolic Procedure Buffer_VisibleP(BufferName);
- begin scalar result, Wlist;
- Wlist := WindowList;
- while Wlist and null(result) do
- <<
- result :=
- cdr(atsoc('WindowsBufferName, car Wlist)) eq BufferName;
- Wlist := cdr Wlist;
- >>;
- return result;
- end;
- Symbolic Procedure Setup_Windows(WindowDescriptorList);
- % (Re)build the list of currently active windows.
- <<
- % Get rid of the old virtual screens first.
- for each WindowDescriptor in WindowList do
- DeselectScreen cdr atsoc('CurrentVirtualScreen, WindowDescriptor);
- CurrentWindowDescriptor := NIL;
- WindowList := NIL;
- for each WindowDescriptor in WindowDescriptorList do
- SelectWindow WindowDescriptor;
- >>;
- Symbolic Procedure SelectWindow(WindowDescriptor);
- % Select a window's "context", and also put it on top of the screen.
- <<
- SelectWindowContext(WindowDescriptor);
- SelectScreen(CurrentVirtualScreen);
- >>;
- Symbolic Procedure SelectWindowContext(WindowDescriptor);
- % Select a new window context (environment)--add it to the list of active
- % windows if not already present.
- begin
- % Should this (putting onto active WindowList) be part of
- % "SelectWindow" instead of "SelectWindowContext"?
- if null( MemQ(WindowDescriptor, WindowList)) then
- WindowList := WindowDescriptor . WindowList;
- if CurrentWindowDescriptor then
- DeselectCurrentWindow();
- RestoreEnv WindowDescriptor;
- % Additional cleanup after "restoring" environment. THIS IS A KLUDGE,
- % NEEDS MORE THOUGHT! Restore the buffer (given its name)
- SelectBuffer(WindowsBufferName);
- CurrentWindowDescriptor := WindowDescriptor;
- end;
- Symbolic Procedure DeselectCurrentWindow();
- % Save current window's environment. Note that this routine does NOT
- % remove the current window from the list of active windows, nor does it
- % affect the window's "virtual screen".
- begin
- % Do this first! Save current environment.
- SaveEnv(CurrentWindowDescriptor);
- if CurrentBufferName then
- DeSelectBuffer(CurrentBufferName); % Important to do this after!
- CurrentWindowDescriptor := NIL;
- end;
- % Generic version--"clean" current view out of the list of views to be
- % refreshed.
- Symbolic Procedure remove_current_view();
- <<
- WindowList := DelQIP(CurrentWindowDescriptor, WindowList);
- apply(views_cleanup_routine, NIL);
- % Save the current window's environment, not really a "deselect", but
- % does set CurrentWindowDescriptor to NIL.
- DeselectCurrentWindow();
- >>;
- % Cleanup a current text "view".
- Symbolic Procedure cleanup_text_view();
- % "Throw away" the view's virtual screen, that should suffice for
- % cleanup.
- DeselectScreen CurrentVirtualScreen;
- Symbolic Procedure CntrlXCscroll();
- Begin scalar x;
- x := OneLispRead("Column (left/right) Scroll by:");
- if numberp x then ShiftDisplayColumn := x;
- End;
- Symbolic Procedure SetScreen;
- % Initialise Screen Space, obviously needs more thought, since it does so
- % little.
- <<
- WindowList := NIL;
- InitializeScreenPackage(); % ??? (Experimental version! )
- >>;
- %. ------------------- Window-Buffer-Screen Refresh ---------
- Symbolic Procedure WriteScreenPhoto();
- % Dispatch to this routine to write a photograph of the screen. May want
- % to get fancy and copy the screen before prompting for the file name?
- begin scalar Outchannel;
- Outchannel := Open(prompt_for_string("File for photo: ", NIL), 'OUTPUT);
- WriteScreenImage(PhysicalScreenImage, Outchannel);
- Close Outchannel;
- end;
- Symbolic Procedure Refresh();
- Begin Scalar SaveW;
- SaveW := CurrentWindowDescriptor; % Remember the current window.
- % Refresh all windows in the list
- for each WindowDescriptor in WindowList do
- <<
- % Select the window's "context" (per-window variable bindings).
- SelectWindowContext WindowDescriptor;
- % Call the per-window refresh algorithm.
- apply(windows_refresher, NIL);
- >>;
- SelectWindowContext SaveW; % Back to "current window"
- % Refresh up to this point has been to a "physical screen image", now
- % actually update the physical screen.
- RefreshPhysicalScreen(T);
- End;
- Symbolic Procedure optional_refresh();
- % If nothing's waiting in the input buffer then refresh the screen
- if CharsInInputBuffer() = 0 then
- Refresh();
- Symbolic Procedure refresh_unframed_window();
- <<
- row_offset := 0;
- column_offset := 1 + size(window_label);
- % Refresh the label first (may clear to end of line).
- refresh_unframed_label();
- % then refresh the text (probably on the same line as label).
- refresh_text();
- >>;
- Symbolic Procedure refresh_unframed_label();
- % Refresh the label for an "unframed window".
- % NOTE use of EQ test, avoid destructive operations on the label
- % string since they won't be detected here.
- if not(window_label eq old_window_label) then
- <<
- for i := 0:size(window_label) do
- WriteToScreen(CurrentVirtualScreen, window_label[i],
- 0,i % Row, column
- );
- % Then, clear to the end of the old label. (Note that old label
- % can be NIL, in which case the size is -1.)
- WriteToScreenRange(CurrentVirtualScreen, char BLANK,
- 0, % Row
- size(window_label) + 1, % Left margin
- size(old_window_label) % Right margin
- );
- % "Remember" the new label.
- old_window_label := window_label;
- >>;
- Symbolic Procedure refresh_framed_window();
- % Refresh the currently selected "framed window" (into a text buffer).
- <<
- % Set up offsets to compensate for the frame.
- row_offset := 1;
- column_offset := 1;
- refresh_text();
- refresh_frame_label();
- >>;
- Symbolic Procedure refresh_frame_label();
- % Refresh the "label line" for the current (framed) window. Note that this
- % is called on every refresh (typically on every character typed by the
- % user), so it should avoid doing too much--and should be as incremental as
- % possible. NOTE: should really be template driven.
- begin scalar strng, lastcol;
- % If the name of the current buffer differs from what it used to be...
- if not(CurrentBufferName eq LABEL_BufferName) then
- <<
- strng := Id2String CurrentBufferName;
- for i := 0:size(strng) do
- % 5 is rather arbitrary point to start ...
- WriteToScreen(CurrentVirtualScreen, strng[i],
- VirtualScreenHeight(CurrentVirtualScreen), i+5);
- % Write dashes to erase any of the old label that might be left.
- % (Might be better to WriteToScreenRange?)
- for i := 1+size(strng) : size(Id2String LABEL_BufferName) do
- WriteToScreen(CurrentVirtualScreen, char '!-,
- VirtualScreenHeight(CurrentVirtualScreen), i+5);
- LABEL_BufferName := CurrentBufferName;
- >>;
- % Now, refresh the filename associated with this buffer.
- if not(buffers_file eq last_filename) then
- <<
- % Note the first free column (roughly speaking) past the name of
- % the buffer.
- lastcol := size(Id2String CurrentBufferName)+5;
- % Write a dash to clear things out.
- WriteToScreen(CurrentVirtualScreen, char !-,
- VirtualScreenHeight(CurrentVirtualScreen),
- lastcol + 1);
- % Write out the new name, a bit to the right of the buffername,
- % within square brackets.
- WriteToScreen(CurrentVirtualScreen, char '![,
- VirtualScreenHeight(CurrentVirtualScreen),
- lastcol + 2);
- % Write out the new filename
- lastcol := lastcol + 3;
- for i := 0:size(buffers_file) do
- WriteToScreen(CurrentVirtualScreen, buffers_file[i],
- VirtualScreenHeight(CurrentVirtualScreen),
- i + lastcol);
- % Hum, rather awkward to constantly keep track of column, anyway,
- % now write the closing bracket.
- WriteToScreen(CurrentVirtualScreen, char '!],
- VirtualScreenHeight(CurrentVirtualScreen),
- 1 + size(buffers_file) + lastcol);
-
- % Finally (?) write out a bunch of dashes to clear any old stuff.
- % Dashes go out to point where "percentage position" starts.
- WriteToScreenRange(CurrentVirtualScreen, char !-,
- VirtualScreenHeight(CurrentVirtualScreen),
- 2 + size(buffers_file) + lastcol,
- VirtualScreenWidth(CurrentVirtualScreen) - 7);
- % "Remember" the filename shown in the label.
- last_filename := CurrentBufferName;
- >>;
- % Now, refresh our "percentage position within buffer" stuff.
- if Last_BufferSize neq CurrentBufferSize
- OR Last_LineIndex neq CurrentLineIndex then
- if CurrentBufferSize >= 0 then
- <<
- strng := PrintF_into_string(MkString(3,char !-), 0, "%w%%",
- (100*CurrentLineIndex)/CurrentBufferSize);
- % Write it into the label line, use "-" for any digits missing.
- for i := 0:3 do
- WriteToScreen(CurrentVirtualScreen, strng[i],
- VirtualScreenHeight(CurrentVirtualScreen),
- VirtualScreenWidth(CurrentVirtualScreen) - 6 + i);
- Last_LineIndex := CurrentLineIndex;
- Last_BufferSize := CurrentBufferSize;
- >>;
- end;
- Symbolic Procedure refresh_text();
- % Refresh for both framed and unframed windows into text buffers.
- begin scalar l,l1,l2;
- % re-center display if needed
- AdjustTopOfDisplayIndex();
- l1 := TopOfDisplayIndex;
- l := 0; % start at Virtual row 0;
- while not EndOfBufferP(l1)
- and (l <= Row CurrentWindowDelta) do
- <<
- RefreshLine(l1,l);
- l := l + 1;
- l1 := NextIndex(l1);
- >>;
- ClearToEndOfWindow(l);
- % Position the (virtual) cursor at its final location.
- MoveToScreenLocation(
- CurrentVirtualScreen,
- % Row
- row_offset + CountLinesFrom(TopOfDisplayIndex,CurrentLineIndex),
- % Column
- column_offset + LineColumn(Point,CurrentLine)-ShiftDisplayColumn
- );
- end;
- % Return a list with n NIL's
- Symbolic Procedure Nils(n);
- Nlist(n,NIL);
- % Return a list with n copies of element.
- Symbolic Procedure Nlist(n,element);
- If n<=0 then NIL
- else (copy element) . Nlist(n-1,element);
- % Return a list of n 0's.
- Symbolic Procedure Zeroes(n);
- Nlist(n,0);
- Symbolic Procedure ClearToEndOfWindow(x);
- % Clear in the vertical direction, down the window. X gives line number to
- % start at.
- begin
- while x <= Row CurrentWindowDelta do
- <<
- if not null cdr Window_Image[x] then
- << % If something is in screen image, clear it and the screen.
- % Store (current column . no text at all)! in image.
- Window_Image[x] := ShiftDisplayColumn . NIL;
- ClearEol(Coords(0,x));
- >>;
- x := x+1;
- >>;
- end;
- Symbolic Procedure ClearEol(x);
- % Clear to end of line in current window, starting at coordinate x.
- DisplaySpaces(x, 1 + Column(CurrentWindowDelta) - Column(x));
- Symbolic Procedure DisplaySpaces(pos, N);
- begin scalar VirtualScreenRow, VirtualScreenColumn;
- % Put N spaces in window, starting at pos.
- VirtualScreenRow := row_offset + row(pos);
- VirtualScreenColumn := column_offset + column(pos);
- WriteToScreenRange(CurrentVirtualScreen,
- char BLANK, % Character to write
- VirtualScreenRow, % Row to start at
- VirtualScreenColumn, % Left margin
- % Compensate for zero indexing to get right margin.
- N - 1 + VirtualScreenColumn);
- end;
- Symbolic Procedure RefreshLine(lineindex,image_linenumber);
- % Refresh line if it has changed
- begin scalar newline, old_shift, old_line,
- old_shift_and_line, i, tabcolumn, ch;
- if lineindex neq CurrentLineIndex then
- newline := GetBufferText(lineindex)
- else
- newline := CurrentLine; % Special case (currently a list of
- % character codes)
- % Get dotted pair of last stored (ShiftDisplayColumn . newline)
- old_shift_and_line := Window_Image[image_linenumber];
- old_shift := car old_shift_and_line;
- old_line := cdr old_shift_and_line;
- % See if line is unchanged. NOTE "equal" test, not "eq" test--this may
- % be a bad decision, since "equal" without "eq" is unlikely, and should
- % be handled by the following code. (So, in some sense, use of equal
- % is redundant, and may run slower.)
- % ALSO NOTE that this test is WRONG if "destructive" changes were made to
- % the line. (Changes that preserved eq while changing the contents.)
- if ShiftDisplayColumn = old_shift
- and newline eq old_line % (Use eq after all!)
- then return;
- % The following code doesn't really handle horizontal scrolling
- % correctly, since matching length is the number of characters that
- % match in original strings, which might not correspond to what would
- % be displayed (due to tabs, etc.) (Need to change the "units" that
- % MatchLength returns?)
- % Get index of starting point for redisplay
- if ShiftDisplayColumn = old_shift then
- i := MatchLength(old_line,newline)
- else
- i := ShiftDisplayColumn;
- % Save new line and shift value in screen "image"
- RPLACA(old_shift_and_line,ShiftDisplayColumn);
- RPLACD(old_shift_and_line, newline);
- % Get coordinate of starting point (first mismatch, roughly speaking).
- pos_for_line_refresh := coords(LineColumn(i,newline) - ShiftDisplayColumn,
- image_linenumber);
- while not null newline
- and i <= size newline
- and Column pos_for_line_refresh <= Column CurrentWindowDelta do
- <<
- % More kludges!
- ch := newline[i];
- if ch eq char TAB then
- <<
- % May print unnecessary characters
- tabcolumn := 8*(1 + Column(pos_for_line_refresh)/8);
- while Column pos_for_line_refresh < tabcolumn do
- % DESTRUCTIVELY updates pos_for_line_refresh
- DisplayCharacter(pos_for_line_refresh, char BLANK);
- >>
- else if ch < char BLANK % ch is a control character.
- then
- <<
- DisplayCharacter(pos_for_line_refresh, char !^);
- % Convert the control character to a "normal" character.
- DisplayCharacter(pos_for_line_refresh, ch + 8#100);
- >>
- else
- % DESTRUCTIVELY updates pos_for_line_refresh
- DisplayCharacter(pos_for_line_refresh, ch);
- i := i + 1;
- >>;
- ClearEol(pos_for_line_refresh);
- end;
- Symbolic Procedure DisplayCharacter(pos,chr);
- % Display chr at position pos, DESTRUCTIVELY update pos to next column,
- % same row. (Character is written to a "virtual screen", with an offset
- % given by row_offset and column_offset.)
- begin
- % Map from "window coordinates" to "virtual screen coordinates" and
- % write out the character.
- WriteToScreen(CurrentVirtualScreen, chr,
- row_offset + Row(pos),
- column_offset + column(pos)
- );
- % Destructively update pos too
- RPLACA(pos, 1 + Column pos); % New column
- return pos;
- end;
- Symbolic Procedure nxt_item(strm);
- % Get next item in a stream--represented as a pair of
- % ("generalized-vector" . last-index), see "create_stream" below.
- % Returns NIL if nothing left in stream--so you can't store NIL in the
- % middle.
- % A quick kludge so that we can step through lists without costly INDX
- % function (which always starts at the front and CDRs down).
- begin scalar itm, i;
- if PairP car strm then
- <<
- if (itm := cdr strm) then
- <<
- RPLACD(strm, cdr itm);
- itm := car itm;
- >>
- >>
- else
- <<
- i := cdr strm;
- if i <= size (car strm) then
- itm := (car strm)[i]
- else
- itm := NIL;
- RPLACD(strm, i + 1);
- >>;
- return itm;
- end;
- Symbolic Procedure create_stream(gvec);
- if PairP gvec then
- (gvec . gvec)
- else
- (gvec . 0);
- Symbolic Procedure MatchLength(l1,l2);
- % Measure lengths of matching heads for l1,l2.
- begin scalar itm1, itm2; integer n;
- if null l1 or null l2 then
- return 0;
- l1 := create_stream(l1);
- l2 := create_stream(l2);
- n := 0;
- while (itm1 := nxt_item l1) and (itm2 := nxt_item l2) and itm1 = itm2 do
- n := n + 1;
- return n;
- end;
- Symbolic Procedure LineColumn(N,line);
- % Map character position N within string line into true column position.
- % Somewhat non-trivial if string contains tabs or other control characters.
- if null line or line = "" then
- 0
- else
- begin scalar pos, itm;
- pos := 0;
- line := create_stream(line);
- while n > 0 and (itm := nxt_item line) do
- <<
- n := n - 1;
- if itm = char TAB then
- pos := 8*(1 + pos/8) % Kludge
- else if itm < char BLANK then
- pos := pos + 2
- else
- pos := pos + 1;
- >>;
- return pos;
- end;
- Symbolic Procedure FullRefresh();
- % Force a complete refresh of the screen (but only work at the "virtual
- % screen" level, don't bother to delve more deeply into the underlying
- % buffers.
- <<
- ClearPhysicalScreen();
- RefreshPhysicalScreen();
- >>;
- Symbolic Procedure AdjustTopOfDisplayIndex();
- % Center the display around point. Modify global TopOfDisplayIndex
- begin scalar LinesInBuffer,LinesToPoint,LinesInScreen,MidScreen,LinesToTop;
- LinesInBuffer := CountAllLines(); % Size of file
- LinesInScreen := Row CurrentWindowDelta; %/ (MAY BE OFF BY ONE?) WFG
- MidScreen := LinesInScreen/2;
- if LinesInBuffer<=LinesInScreen then % Use top of buffer if it
- return(TopOfDisplayIndex := 0); % all fits on screen.
- % Lines from start of buffer to first line displayed (exclusive)
- LinesToTop := CountLinesFrom(0,TopOfDisplayIndex);
- % Lines from start of buffer to line where Point is.
- LinesToPoint := CountLinesBefore();
- if LinesToTop<=LinesToPoint % Point below top and above bottom
- and LinesToPoint <=(LinesToTop+LinesInScreen)
- then
- return(TopOfDisplayIndex);
- LinesToTop := LinesToPoint-MidScreen; % Desired
- % TopOfDisplayIndex := 0;
- % While LinesToTop > 0 do
- % <<
- % TopOfDisplayIndex := NextIndex TopOfDisplayIndex;
- % LinesToTop := LinesToTop -1
- % >>;
- %
- % return TopOfDisplayIndex;
- %%%%%%%%%%%%%%%%%%%% above code is more general, but very inefficient
- % (Depends on fact that "DisplayIndexes" are integers in this
- % implementation.)
- return (TopOfDisplayIndex := max(0,LinesToTop));
- end;
|