refresh.red 30 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857
  1. %
  2. % REFRESH.RED - Screen/Window/Refresh utilities for EMODE.
  3. %
  4. % Author: William F. Galway
  5. % Symbolic Computation Group
  6. % Computer Science Dept.
  7. % University of Utah
  8. % Date: 8 June 1982
  9. % Copyright (c) 1982 University of Utah
  10. %
  11. % Uses the "virtual-screen" package in VIRTUAL-SCREEN.SL.
  12. FLUID '(
  13. ShiftDisplayColumn % Amount to shift things to the left by
  14. % before (re)displaying lines.
  15. WindowList % List of active windows
  16. minor_window_list % List of windows to be ignored by the
  17. % "next_window" routine.
  18. pos_for_line_refresh
  19. % Offsets into virtual screen, adjusted depending on whether screen is
  20. % framed, labled, etc.
  21. row_offset
  22. column_offset
  23. );
  24. % pos_for_line_refresh is kept around so that we don't have to keep consing
  25. % up new coordinate pairs--an efficiency hack. '(NIL . NIL) may cause
  26. % problems on Vax (when we do RPLACA/RPLACD), since it goes to "pure
  27. % space"?
  28. pos_for_line_refresh := cons(NIL , NIL);
  29. ShiftDisplayColumn := 0;
  30. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  31. % Construct a screen coordinate pair (x,y) = (column,row)
  32. Symbolic Procedure Coords(col,rw);
  33. Cons(col,rw);
  34. Symbolic Procedure Column pos; %. X-coordinate (Column)
  35. car pos;
  36. Symbolic Procedure Row pos; %. Y-coordinate (Row)
  37. cdr pos;
  38. % Note: All regions defined in terms of Lower Corner (base) and distance
  39. % (delta values) to other corner INCLUSIVE, using 0-origin system.
  40. % Thus 0..3 has base 0, delta 3
  41. % 1..4 has base 1, delta 3
  42. Symbolic Procedure FrameScreen(scrn);
  43. % Generate a border for a screen.
  44. <<
  45. % Dashes for top and bottom rows.
  46. for i := 0:VirtualScreenWidth(scrn) do
  47. <<
  48. WriteToScreen(scrn, char !-, 0, i);
  49. WriteToScreen(scrn, char !-, VirtualScreenHeight(scrn), i);
  50. >>;
  51. % Vertical bars for the left and right sides.
  52. for i := 0:VirtualScreenHeight(scrn) do
  53. <<
  54. WriteToScreen(scrn, char !|, i, 0);
  55. WriteToScreen(scrn, char !|, i, VirtualScreenWidth(scrn));
  56. >>;
  57. % Finally, put plus signs in the corners.
  58. WriteToScreen(scrn, char !+, 0, 0);
  59. WriteToScreen(scrn, char !+, 0, VirtualScreenWidth(scrn));
  60. WriteToScreen(scrn, char !+, VirtualScreenHeight(scrn), 0);
  61. WriteToScreen(scrn, char !+,
  62. VirtualScreenHeight(scrn), VirtualScreenWidth(scrn));
  63. >>;
  64. Symbolic Procedure FramedWindowDescriptor(BufferName, upperleft, dxdy);
  65. % Create a "descriptor" for a "framed window" (into a text buffer), given
  66. % its associated buffer name, coord. of upper left corner, and its size as
  67. % (Delta X, Delta Y).
  68. begin scalar WindowDescriptor, newscreen;
  69. % The virtual screen includes room for a border around the edges.
  70. % (Add one to dimensions, to compensate for 0 indexing.)
  71. newscreen :=
  72. CreateVirtualScreen(1 + Row dxdy, 1 + Column dxdy,
  73. Row upperleft, Column upperleft);
  74. % Generate the border.
  75. FrameScreen(newscreen);
  76. WindowDescriptor :=
  77. list(
  78. % The refresh routine to use.
  79. 'windows_refresher . 'refresh_framed_window,
  80. 'WindowsBufferName . BufferName, % Associated Buffer
  81. % Routine to "throw away" the current view.
  82. 'views_cleanup_routine . 'cleanup_text_view,
  83. % Dimensions, (delta x . delta y), chop off a bit for the
  84. % frames. (Remember the 0 indexing! )
  85. 'CurrentWindowDelta .
  86. ( (Column(dxdy) - 2) . (Row(dxdy) - 2) ),
  87. % "Window image" information for refresh.
  88. % Note that Row dxdy = number of lines minus 1
  89. % (since it is an INCLUSIVE value). Each entry in NLIST gives
  90. % info on (Horizontal scroll . line in buffer)
  91. 'Window_Image .
  92. % ShiftdisplayColumn better than 0 here?
  93. Nlist(Row(dxdy)+1, '(0 . NIL)),
  94. % The last "buffer name" that was shown in the label, this can
  95. % change if the window starts looking into another buffer.
  96. 'LABEL_BufferName . NIL,
  97. % The filename associated with this window's buffer (at last
  98. % refresh).
  99. 'last_filename . NIL,
  100. % Value of CurrentLineIndex during last refresh.
  101. 'Last_LineIndex . 0,
  102. % Size of buffer (number of lines) during last refresh.
  103. 'Last_BufferSize . 0,
  104. 'CurrentVirtualScreen . newscreen,
  105. 'ShiftDisplayColumn . 0, % Horizontal Scroll value
  106. % Location in buffer that corresponds to top line in window.
  107. % Zero is rather implausible if "point" is somewhere in the
  108. % middle of the buffer, but that's OK since it gets adjusted to
  109. % the right value.
  110. 'TopOfDisplayIndex . 0
  111. );
  112. return WindowDescriptor;
  113. end;
  114. Symbolic Procedure UnframedWindowDescriptor(BufferName, upperleft, dxdy);
  115. % Create a "descriptor" for an "unframed window", given its
  116. % associated buffer name, coord. of upper left corner, and its size as
  117. % (Delta X, Delta Y). (This version is really meant for one line windows
  118. % only, results may be quite wierd otherwise.)
  119. begin scalar WindowDescriptor, newscreen;
  120. % The associated virtual screen ...
  121. % (Add one to dimensions, to compensate for 0 indexing.)
  122. newscreen :=
  123. CreateVirtualScreen(1 + Row dxdy, 1 + Column dxdy,
  124. Row upperleft, Column upperleft);
  125. WindowDescriptor :=
  126. list(
  127. % The refresh routine to use.
  128. 'windows_refresher . 'refresh_unframed_window,
  129. 'WindowsBufferName . BufferName, % Associated Buffer
  130. 'views_cleanup_routine . 'cleanup_text_view,
  131. % A "label" to appear at the beginning line of the window.
  132. 'window_label . "",
  133. % Value of window_label at last refresh, make it differ from
  134. % window_label to force initial refresh of label.
  135. 'old_window_label . NIL,
  136. % Window dimensions as (delta x . delta y).
  137. 'CurrentWindowDelta .
  138. ( (Column dxdy) . (Row dxdy) ),
  139. % "Window image" information for refresh.
  140. % Note that Row dxdy = number of lines minus 1
  141. % (since it is an INCLUSIVE value). Each entry in NLIST gives
  142. % info on (Horizontal scroll . line in buffer)
  143. 'Window_Image .
  144. % ShiftdisplayColumn better than 0 here?
  145. Nlist(Row(dxdy)+1, '(0 . NIL)),
  146. 'CurrentVirtualScreen . newscreen,
  147. 'ShiftDisplayColumn . 0, % Horizontal Scroll value
  148. % Location in buffer that corresponds to top line in window.
  149. % Zero is rather implausible if "point" is somewhere in the
  150. % middle of the buffer, but that's OK since it gets adjusted to
  151. % the right value.
  152. 'TopOfDisplayIndex . 0
  153. );
  154. return WindowDescriptor;
  155. end;
  156. fluid '(Prompt_Window Message_Window);
  157. Symbolic Procedure OneWindow();
  158. % Dispatch to this routine to enter one-window mode.
  159. if MajorWindowCount() neq 1 then % If not already one-window
  160. % then setup windows for one window mode.
  161. begin scalar old_prompt, old_msg, NewWindow ;
  162. % Preserve the "prompt" and "message" labels from old windows.
  163. old_prompt :=
  164. if Prompt_Window then cdr atsoc('window_label, Prompt_Window);
  165. old_msg :=
  166. if Message_Window then cdr atsoc('window_label, Message_Window);
  167. Setup_Windows
  168. list(
  169. % This window looks into the current buffer, other arguments
  170. % are location of upper left corner, and the size (0
  171. % indexed).
  172. % The window is made slightly wider than the screen, so that
  173. % the left and right frame boundaries don't actually show.
  174. NewWindow :=
  175. FramedWindowDescriptor(CurrentBufferName,
  176. % Upper left corner
  177. coords(Column ScreenBase - 1,
  178. Row ScreenBase - 1),
  179. % Size uses entire width, leaves room for
  180. % two one line windows at the bottom
  181. Coords(Column ScreenDelta + 2,
  182. Row(ScreenDelta) - 1)),
  183. % Looks into the "prompt line" buffer. Note this is
  184. % unframed, so we make it a bit smaller to have it all fit on
  185. % the screen.
  186. Prompt_Window :=
  187. UnframedWindowDescriptor('PROMPT_BUFFER,
  188. % Base is one line above bottom
  189. Coords(Column ScreenBase,
  190. Row ScreenBase + Row ScreenDelta - 1),
  191. % a single line (so delta row = 0)
  192. Coords(Column ScreenDelta, 0)),
  193. % Looks into the "message buffer", used for error messages
  194. % and general stuff.
  195. Message_Window :=
  196. UnframedWindowDescriptor('MESSAGE_BUFFER,
  197. % Base is at bottom
  198. Coords(Column ScreenBase,
  199. Row ScreenBase + Row ScreenDelta),
  200. % a single line (so delta row = 0)
  201. Coords(Column ScreenDelta, 0))
  202. );
  203. % Restore the labels from their old values (if any).
  204. SelectWindowContext(Prompt_Window);
  205. window_label := old_prompt;
  206. SelectWindowContext(Message_Window);
  207. window_label := old_msg;
  208. % Keep track of "minor windows".
  209. minor_window_list := list(Prompt_Window, Message_Window);
  210. SelectWindow NewWindow; % ??? needs more thought.
  211. end;
  212. Symbolic Procedure MajorWindowCount();
  213. % Return a count of the "major windows" in WindowList;
  214. length(WindowList) - length(minor_window_list);
  215. Symbolic Procedure next_window();
  216. % Dispatch to this routine to select "the next" (or "other") window
  217. begin scalar current_window_pointer;
  218. current_window_pointer := WindowList;
  219. % Look up the location of the current window in WindowList.
  220. while not((car current_window_pointer) eq CurrentWindowDescriptor)
  221. do
  222. current_window_pointer := cdr current_window_pointer;
  223. SelectWindow next_major_window(cdr(current_window_pointer), WindowList);
  224. end;
  225. Symbolic Procedure previous_window_command();
  226. % Dispatch to this routine to select the "previous" window.
  227. begin scalar current_window_pointer, rev_windowlist;
  228. rev_windowlist := reverse WindowList;
  229. current_window_pointer := rev_windowlist;
  230. % Look up the location of the current window in WindowList.
  231. while not((car current_window_pointer) eq CurrentWindowDescriptor)
  232. do
  233. current_window_pointer := cdr current_window_pointer;
  234. SelectWindow
  235. next_major_window(cdr(current_window_pointer), rev_windowlist);
  236. end;
  237. Symbolic Procedure next_major_window(pntr, wlist);
  238. % Return the window descriptor for the next "major" window at or after pntr
  239. % in wlist. It's assumed that there is at least one major window.
  240. if null pntr then
  241. next_major_window(wlist,wlist)
  242. else if not MemQ(car pntr, minor_window_list) then
  243. car pntr
  244. else
  245. next_major_window(cdr pntr, wlist);
  246. % Return T if the buffer is present in some "active" window (not
  247. % necessarily visible, it may be covered up).
  248. Symbolic Procedure Buffer_VisibleP(BufferName);
  249. begin scalar result, Wlist;
  250. Wlist := WindowList;
  251. while Wlist and null(result) do
  252. <<
  253. result :=
  254. cdr(atsoc('WindowsBufferName, car Wlist)) eq BufferName;
  255. Wlist := cdr Wlist;
  256. >>;
  257. return result;
  258. end;
  259. Symbolic Procedure Setup_Windows(WindowDescriptorList);
  260. % (Re)build the list of currently active windows.
  261. <<
  262. % Get rid of the old virtual screens first.
  263. for each WindowDescriptor in WindowList do
  264. DeselectScreen cdr atsoc('CurrentVirtualScreen, WindowDescriptor);
  265. CurrentWindowDescriptor := NIL;
  266. WindowList := NIL;
  267. for each WindowDescriptor in WindowDescriptorList do
  268. SelectWindow WindowDescriptor;
  269. >>;
  270. Symbolic Procedure SelectWindow(WindowDescriptor);
  271. % Select a window's "context", and also put it on top of the screen.
  272. <<
  273. SelectWindowContext(WindowDescriptor);
  274. SelectScreen(CurrentVirtualScreen);
  275. >>;
  276. Symbolic Procedure SelectWindowContext(WindowDescriptor);
  277. % Select a new window context (environment)--add it to the list of active
  278. % windows if not already present.
  279. begin
  280. % Should this (putting onto active WindowList) be part of
  281. % "SelectWindow" instead of "SelectWindowContext"?
  282. if null( MemQ(WindowDescriptor, WindowList)) then
  283. WindowList := WindowDescriptor . WindowList;
  284. if CurrentWindowDescriptor then
  285. DeselectCurrentWindow();
  286. RestoreEnv WindowDescriptor;
  287. % Additional cleanup after "restoring" environment. THIS IS A KLUDGE,
  288. % NEEDS MORE THOUGHT! Restore the buffer (given its name)
  289. SelectBuffer(WindowsBufferName);
  290. CurrentWindowDescriptor := WindowDescriptor;
  291. end;
  292. Symbolic Procedure DeselectCurrentWindow();
  293. % Save current window's environment. Note that this routine does NOT
  294. % remove the current window from the list of active windows, nor does it
  295. % affect the window's "virtual screen".
  296. begin
  297. % Do this first! Save current environment.
  298. SaveEnv(CurrentWindowDescriptor);
  299. if CurrentBufferName then
  300. DeSelectBuffer(CurrentBufferName); % Important to do this after!
  301. CurrentWindowDescriptor := NIL;
  302. end;
  303. % Generic version--"clean" current view out of the list of views to be
  304. % refreshed.
  305. Symbolic Procedure remove_current_view();
  306. <<
  307. WindowList := DelQIP(CurrentWindowDescriptor, WindowList);
  308. apply(views_cleanup_routine, NIL);
  309. % Save the current window's environment, not really a "deselect", but
  310. % does set CurrentWindowDescriptor to NIL.
  311. DeselectCurrentWindow();
  312. >>;
  313. % Cleanup a current text "view".
  314. Symbolic Procedure cleanup_text_view();
  315. % "Throw away" the view's virtual screen, that should suffice for
  316. % cleanup.
  317. DeselectScreen CurrentVirtualScreen;
  318. Symbolic Procedure CntrlXCscroll();
  319. Begin scalar x;
  320. x := OneLispRead("Column (left/right) Scroll by:");
  321. if numberp x then ShiftDisplayColumn := x;
  322. End;
  323. Symbolic Procedure SetScreen;
  324. % Initialise Screen Space, obviously needs more thought, since it does so
  325. % little.
  326. <<
  327. WindowList := NIL;
  328. InitializeScreenPackage(); % ??? (Experimental version! )
  329. >>;
  330. %. ------------------- Window-Buffer-Screen Refresh ---------
  331. Symbolic Procedure WriteScreenPhoto();
  332. % Dispatch to this routine to write a photograph of the screen. May want
  333. % to get fancy and copy the screen before prompting for the file name?
  334. begin scalar Outchannel;
  335. Outchannel := Open(prompt_for_string("File for photo: ", NIL), 'OUTPUT);
  336. WriteScreenImage(PhysicalScreenImage, Outchannel);
  337. Close Outchannel;
  338. end;
  339. Symbolic Procedure Refresh();
  340. Begin Scalar SaveW;
  341. SaveW := CurrentWindowDescriptor; % Remember the current window.
  342. % Refresh all windows in the list
  343. for each WindowDescriptor in WindowList do
  344. <<
  345. % Select the window's "context" (per-window variable bindings).
  346. SelectWindowContext WindowDescriptor;
  347. % Call the per-window refresh algorithm.
  348. apply(windows_refresher, NIL);
  349. >>;
  350. SelectWindowContext SaveW; % Back to "current window"
  351. % Refresh up to this point has been to a "physical screen image", now
  352. % actually update the physical screen.
  353. RefreshPhysicalScreen(T);
  354. End;
  355. Symbolic Procedure optional_refresh();
  356. % If nothing's waiting in the input buffer then refresh the screen
  357. if CharsInInputBuffer() = 0 then
  358. Refresh();
  359. Symbolic Procedure refresh_unframed_window();
  360. <<
  361. row_offset := 0;
  362. column_offset := 1 + size(window_label);
  363. % Refresh the label first (may clear to end of line).
  364. refresh_unframed_label();
  365. % then refresh the text (probably on the same line as label).
  366. refresh_text();
  367. >>;
  368. Symbolic Procedure refresh_unframed_label();
  369. % Refresh the label for an "unframed window".
  370. % NOTE use of EQ test, avoid destructive operations on the label
  371. % string since they won't be detected here.
  372. if not(window_label eq old_window_label) then
  373. <<
  374. for i := 0:size(window_label) do
  375. WriteToScreen(CurrentVirtualScreen, window_label[i],
  376. 0,i % Row, column
  377. );
  378. % Then, clear to the end of the old label. (Note that old label
  379. % can be NIL, in which case the size is -1.)
  380. WriteToScreenRange(CurrentVirtualScreen, char BLANK,
  381. 0, % Row
  382. size(window_label) + 1, % Left margin
  383. size(old_window_label) % Right margin
  384. );
  385. % "Remember" the new label.
  386. old_window_label := window_label;
  387. >>;
  388. Symbolic Procedure refresh_framed_window();
  389. % Refresh the currently selected "framed window" (into a text buffer).
  390. <<
  391. % Set up offsets to compensate for the frame.
  392. row_offset := 1;
  393. column_offset := 1;
  394. refresh_text();
  395. refresh_frame_label();
  396. >>;
  397. Symbolic Procedure refresh_frame_label();
  398. % Refresh the "label line" for the current (framed) window. Note that this
  399. % is called on every refresh (typically on every character typed by the
  400. % user), so it should avoid doing too much--and should be as incremental as
  401. % possible. NOTE: should really be template driven.
  402. begin scalar strng, lastcol;
  403. % If the name of the current buffer differs from what it used to be...
  404. if not(CurrentBufferName eq LABEL_BufferName) then
  405. <<
  406. strng := Id2String CurrentBufferName;
  407. for i := 0:size(strng) do
  408. % 5 is rather arbitrary point to start ...
  409. WriteToScreen(CurrentVirtualScreen, strng[i],
  410. VirtualScreenHeight(CurrentVirtualScreen), i+5);
  411. % Write dashes to erase any of the old label that might be left.
  412. % (Might be better to WriteToScreenRange?)
  413. for i := 1+size(strng) : size(Id2String LABEL_BufferName) do
  414. WriteToScreen(CurrentVirtualScreen, char '!-,
  415. VirtualScreenHeight(CurrentVirtualScreen), i+5);
  416. LABEL_BufferName := CurrentBufferName;
  417. >>;
  418. % Now, refresh the filename associated with this buffer.
  419. if not(buffers_file eq last_filename) then
  420. <<
  421. % Note the first free column (roughly speaking) past the name of
  422. % the buffer.
  423. lastcol := size(Id2String CurrentBufferName)+5;
  424. % Write a dash to clear things out.
  425. WriteToScreen(CurrentVirtualScreen, char !-,
  426. VirtualScreenHeight(CurrentVirtualScreen),
  427. lastcol + 1);
  428. % Write out the new name, a bit to the right of the buffername,
  429. % within square brackets.
  430. WriteToScreen(CurrentVirtualScreen, char '![,
  431. VirtualScreenHeight(CurrentVirtualScreen),
  432. lastcol + 2);
  433. % Write out the new filename
  434. lastcol := lastcol + 3;
  435. for i := 0:size(buffers_file) do
  436. WriteToScreen(CurrentVirtualScreen, buffers_file[i],
  437. VirtualScreenHeight(CurrentVirtualScreen),
  438. i + lastcol);
  439. % Hum, rather awkward to constantly keep track of column, anyway,
  440. % now write the closing bracket.
  441. WriteToScreen(CurrentVirtualScreen, char '!],
  442. VirtualScreenHeight(CurrentVirtualScreen),
  443. 1 + size(buffers_file) + lastcol);
  444. % Finally (?) write out a bunch of dashes to clear any old stuff.
  445. % Dashes go out to point where "percentage position" starts.
  446. WriteToScreenRange(CurrentVirtualScreen, char !-,
  447. VirtualScreenHeight(CurrentVirtualScreen),
  448. 2 + size(buffers_file) + lastcol,
  449. VirtualScreenWidth(CurrentVirtualScreen) - 7);
  450. % "Remember" the filename shown in the label.
  451. last_filename := CurrentBufferName;
  452. >>;
  453. % Now, refresh our "percentage position within buffer" stuff.
  454. if Last_BufferSize neq CurrentBufferSize
  455. OR Last_LineIndex neq CurrentLineIndex then
  456. if CurrentBufferSize >= 0 then
  457. <<
  458. strng := PrintF_into_string(MkString(3,char !-), 0, "%w%%",
  459. (100*CurrentLineIndex)/CurrentBufferSize);
  460. % Write it into the label line, use "-" for any digits missing.
  461. for i := 0:3 do
  462. WriteToScreen(CurrentVirtualScreen, strng[i],
  463. VirtualScreenHeight(CurrentVirtualScreen),
  464. VirtualScreenWidth(CurrentVirtualScreen) - 6 + i);
  465. Last_LineIndex := CurrentLineIndex;
  466. Last_BufferSize := CurrentBufferSize;
  467. >>;
  468. end;
  469. Symbolic Procedure refresh_text();
  470. % Refresh for both framed and unframed windows into text buffers.
  471. begin scalar l,l1,l2;
  472. % re-center display if needed
  473. AdjustTopOfDisplayIndex();
  474. l1 := TopOfDisplayIndex;
  475. l := 0; % start at Virtual row 0;
  476. while not EndOfBufferP(l1)
  477. and (l <= Row CurrentWindowDelta) do
  478. <<
  479. RefreshLine(l1,l);
  480. l := l + 1;
  481. l1 := NextIndex(l1);
  482. >>;
  483. ClearToEndOfWindow(l);
  484. % Position the (virtual) cursor at its final location.
  485. MoveToScreenLocation(
  486. CurrentVirtualScreen,
  487. % Row
  488. row_offset + CountLinesFrom(TopOfDisplayIndex,CurrentLineIndex),
  489. % Column
  490. column_offset + LineColumn(Point,CurrentLine)-ShiftDisplayColumn
  491. );
  492. end;
  493. % Return a list with n NIL's
  494. Symbolic Procedure Nils(n);
  495. Nlist(n,NIL);
  496. % Return a list with n copies of element.
  497. Symbolic Procedure Nlist(n,element);
  498. If n<=0 then NIL
  499. else (copy element) . Nlist(n-1,element);
  500. % Return a list of n 0's.
  501. Symbolic Procedure Zeroes(n);
  502. Nlist(n,0);
  503. Symbolic Procedure ClearToEndOfWindow(x);
  504. % Clear in the vertical direction, down the window. X gives line number to
  505. % start at.
  506. begin
  507. while x <= Row CurrentWindowDelta do
  508. <<
  509. if not null cdr Window_Image[x] then
  510. << % If something is in screen image, clear it and the screen.
  511. % Store (current column . no text at all)! in image.
  512. Window_Image[x] := ShiftDisplayColumn . NIL;
  513. ClearEol(Coords(0,x));
  514. >>;
  515. x := x+1;
  516. >>;
  517. end;
  518. Symbolic Procedure ClearEol(x);
  519. % Clear to end of line in current window, starting at coordinate x.
  520. DisplaySpaces(x, 1 + Column(CurrentWindowDelta) - Column(x));
  521. Symbolic Procedure DisplaySpaces(pos, N);
  522. begin scalar VirtualScreenRow, VirtualScreenColumn;
  523. % Put N spaces in window, starting at pos.
  524. VirtualScreenRow := row_offset + row(pos);
  525. VirtualScreenColumn := column_offset + column(pos);
  526. WriteToScreenRange(CurrentVirtualScreen,
  527. char BLANK, % Character to write
  528. VirtualScreenRow, % Row to start at
  529. VirtualScreenColumn, % Left margin
  530. % Compensate for zero indexing to get right margin.
  531. N - 1 + VirtualScreenColumn);
  532. end;
  533. Symbolic Procedure RefreshLine(lineindex,image_linenumber);
  534. % Refresh line if it has changed
  535. begin scalar newline, old_shift, old_line,
  536. old_shift_and_line, i, tabcolumn, ch;
  537. if lineindex neq CurrentLineIndex then
  538. newline := GetBufferText(lineindex)
  539. else
  540. newline := CurrentLine; % Special case (currently a list of
  541. % character codes)
  542. % Get dotted pair of last stored (ShiftDisplayColumn . newline)
  543. old_shift_and_line := Window_Image[image_linenumber];
  544. old_shift := car old_shift_and_line;
  545. old_line := cdr old_shift_and_line;
  546. % See if line is unchanged. NOTE "equal" test, not "eq" test--this may
  547. % be a bad decision, since "equal" without "eq" is unlikely, and should
  548. % be handled by the following code. (So, in some sense, use of equal
  549. % is redundant, and may run slower.)
  550. % ALSO NOTE that this test is WRONG if "destructive" changes were made to
  551. % the line. (Changes that preserved eq while changing the contents.)
  552. if ShiftDisplayColumn = old_shift
  553. and newline eq old_line % (Use eq after all!)
  554. then return;
  555. % The following code doesn't really handle horizontal scrolling
  556. % correctly, since matching length is the number of characters that
  557. % match in original strings, which might not correspond to what would
  558. % be displayed (due to tabs, etc.) (Need to change the "units" that
  559. % MatchLength returns?)
  560. % Get index of starting point for redisplay
  561. if ShiftDisplayColumn = old_shift then
  562. i := MatchLength(old_line,newline)
  563. else
  564. i := ShiftDisplayColumn;
  565. % Save new line and shift value in screen "image"
  566. RPLACA(old_shift_and_line,ShiftDisplayColumn);
  567. RPLACD(old_shift_and_line, newline);
  568. % Get coordinate of starting point (first mismatch, roughly speaking).
  569. pos_for_line_refresh := coords(LineColumn(i,newline) - ShiftDisplayColumn,
  570. image_linenumber);
  571. while not null newline
  572. and i <= size newline
  573. and Column pos_for_line_refresh <= Column CurrentWindowDelta do
  574. <<
  575. % More kludges!
  576. ch := newline[i];
  577. if ch eq char TAB then
  578. <<
  579. % May print unnecessary characters
  580. tabcolumn := 8*(1 + Column(pos_for_line_refresh)/8);
  581. while Column pos_for_line_refresh < tabcolumn do
  582. % DESTRUCTIVELY updates pos_for_line_refresh
  583. DisplayCharacter(pos_for_line_refresh, char BLANK);
  584. >>
  585. else if ch < char BLANK % ch is a control character.
  586. then
  587. <<
  588. DisplayCharacter(pos_for_line_refresh, char !^);
  589. % Convert the control character to a "normal" character.
  590. DisplayCharacter(pos_for_line_refresh, ch + 8#100);
  591. >>
  592. else
  593. % DESTRUCTIVELY updates pos_for_line_refresh
  594. DisplayCharacter(pos_for_line_refresh, ch);
  595. i := i + 1;
  596. >>;
  597. ClearEol(pos_for_line_refresh);
  598. end;
  599. Symbolic Procedure DisplayCharacter(pos,chr);
  600. % Display chr at position pos, DESTRUCTIVELY update pos to next column,
  601. % same row. (Character is written to a "virtual screen", with an offset
  602. % given by row_offset and column_offset.)
  603. begin
  604. % Map from "window coordinates" to "virtual screen coordinates" and
  605. % write out the character.
  606. WriteToScreen(CurrentVirtualScreen, chr,
  607. row_offset + Row(pos),
  608. column_offset + column(pos)
  609. );
  610. % Destructively update pos too
  611. RPLACA(pos, 1 + Column pos); % New column
  612. return pos;
  613. end;
  614. Symbolic Procedure nxt_item(strm);
  615. % Get next item in a stream--represented as a pair of
  616. % ("generalized-vector" . last-index), see "create_stream" below.
  617. % Returns NIL if nothing left in stream--so you can't store NIL in the
  618. % middle.
  619. % A quick kludge so that we can step through lists without costly INDX
  620. % function (which always starts at the front and CDRs down).
  621. begin scalar itm, i;
  622. if PairP car strm then
  623. <<
  624. if (itm := cdr strm) then
  625. <<
  626. RPLACD(strm, cdr itm);
  627. itm := car itm;
  628. >>
  629. >>
  630. else
  631. <<
  632. i := cdr strm;
  633. if i <= size (car strm) then
  634. itm := (car strm)[i]
  635. else
  636. itm := NIL;
  637. RPLACD(strm, i + 1);
  638. >>;
  639. return itm;
  640. end;
  641. Symbolic Procedure create_stream(gvec);
  642. if PairP gvec then
  643. (gvec . gvec)
  644. else
  645. (gvec . 0);
  646. Symbolic Procedure MatchLength(l1,l2);
  647. % Measure lengths of matching heads for l1,l2.
  648. begin scalar itm1, itm2; integer n;
  649. if null l1 or null l2 then
  650. return 0;
  651. l1 := create_stream(l1);
  652. l2 := create_stream(l2);
  653. n := 0;
  654. while (itm1 := nxt_item l1) and (itm2 := nxt_item l2) and itm1 = itm2 do
  655. n := n + 1;
  656. return n;
  657. end;
  658. Symbolic Procedure LineColumn(N,line);
  659. % Map character position N within string line into true column position.
  660. % Somewhat non-trivial if string contains tabs or other control characters.
  661. if null line or line = "" then
  662. 0
  663. else
  664. begin scalar pos, itm;
  665. pos := 0;
  666. line := create_stream(line);
  667. while n > 0 and (itm := nxt_item line) do
  668. <<
  669. n := n - 1;
  670. if itm = char TAB then
  671. pos := 8*(1 + pos/8) % Kludge
  672. else if itm < char BLANK then
  673. pos := pos + 2
  674. else
  675. pos := pos + 1;
  676. >>;
  677. return pos;
  678. end;
  679. Symbolic Procedure FullRefresh();
  680. % Force a complete refresh of the screen (but only work at the "virtual
  681. % screen" level, don't bother to delve more deeply into the underlying
  682. % buffers.
  683. <<
  684. ClearPhysicalScreen();
  685. RefreshPhysicalScreen();
  686. >>;
  687. Symbolic Procedure AdjustTopOfDisplayIndex();
  688. % Center the display around point. Modify global TopOfDisplayIndex
  689. begin scalar LinesInBuffer,LinesToPoint,LinesInScreen,MidScreen,LinesToTop;
  690. LinesInBuffer := CountAllLines(); % Size of file
  691. LinesInScreen := Row CurrentWindowDelta; %/ (MAY BE OFF BY ONE?) WFG
  692. MidScreen := LinesInScreen/2;
  693. if LinesInBuffer<=LinesInScreen then % Use top of buffer if it
  694. return(TopOfDisplayIndex := 0); % all fits on screen.
  695. % Lines from start of buffer to first line displayed (exclusive)
  696. LinesToTop := CountLinesFrom(0,TopOfDisplayIndex);
  697. % Lines from start of buffer to line where Point is.
  698. LinesToPoint := CountLinesBefore();
  699. if LinesToTop<=LinesToPoint % Point below top and above bottom
  700. and LinesToPoint <=(LinesToTop+LinesInScreen)
  701. then
  702. return(TopOfDisplayIndex);
  703. LinesToTop := LinesToPoint-MidScreen; % Desired
  704. % TopOfDisplayIndex := 0;
  705. % While LinesToTop > 0 do
  706. % <<
  707. % TopOfDisplayIndex := NextIndex TopOfDisplayIndex;
  708. % LinesToTop := LinesToTop -1
  709. % >>;
  710. %
  711. % return TopOfDisplayIndex;
  712. %%%%%%%%%%%%%%%%%%%% above code is more general, but very inefficient
  713. % (Depends on fact that "DisplayIndexes" are integers in this
  714. % implementation.)
  715. return (TopOfDisplayIndex := max(0,LinesToTop));
  716. end;