! EVE$WINDOWS.TPU 31-DEC-1992 12:20 Page 1 module eve$windows ident "V03-012" ! ! COPYRIGHT © 1987,1992 BY ! DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASSACHUSETTS ! ALL RIGHTS RESERVED ! ! THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED ! ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE ! INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER ! COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY ! OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY ! TRANSFERRED. ! ! THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE ! AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT ! CORPORATION. ! ! DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS ! SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL. ! !++ ! FACILITY: ! DECTPU - Text Processing Utility ! EVE - Extensible Versatile Editor ! ! ABSTRACT: ! This is the source program for EVE windowing. ! ! ENVIRONMENT: ! OpenVMS VAX, OpenVMS AXP, RISC/ULTRIX ! !Author: Jim Burrows ! !-- ! EVE$WINDOWS.TPU Page 2 !++ ! Table of Contents ! ! EVE$WINDOWS.TPU ! 31-DEC-1992 12:20 ! ! Procedure name Page Description ! -------------- ---- ------------ ! ! eve$goto_command_window 4 Pre-command window positioning ! eve$show_first_line 5 Insure inserted text shows ! eve$position_in_middle 6 Move to middle of window ! eve$set_status_line 7 Set a window status line ! eve$get_status_line 8 Get the standard status line ! eve$buffer_name_field 9 Buffer name field ! eve$direction_status_field 10 Direction field ! eve$mode_status_field 11 Insert/overstike field ! eve$set_fixed_status_line 12 Set buffer status line [un]modifiable ! eve$get_fixed_status_line 13 User-defined status-line, if any ! eve$update_status_lines 14 Update all current buffer status lines ! eve$update_all_status_lines 15 Update all status lines ! eve$check_bad_window 16 Test for non-user window ! eve$unmap_if_mapped 17 Unmap a window ! eve$map_if_not_mapped 17 Map a window if not mapped ! eve$map_help 18 Map help/show buffer to info_window ! eve$unmap_help 18 Unmap info_window ! eve$main_window 19 return the main window ! eve$top_window 19 return the top window ! eve$bottom_window 19 return the bottom window ! eve_one_window 20 One window ! eve_next_window 21 Move cursor to the next window ! eve_other_window 21 Synonym of NEXT WINDOW ! eve_previous_window 22 Move cursor to the previous window ! eve_split_window 23 Split current window into n (2) windows ! eve_two_windows 23 Synonym of split window ! eve_delete_window 24 Delete current window ! eve$delete_window 25 Delete a window and close the gap ! eve$$get_window_number 26 Get number of current_window ! eve$get_window 27 Get a window from its number ! eve$remap_windows 28 Remap from old to new buffer ! eve$get_mapped_window 29 Find first window mapped to buffer ! eve$$open_window_gap 30 Make room for a window ! eve$$remove_window 31 Remove window from array and screen ! eve_enlarge_window 32 Enlarge current window ! eve_shrink_window 33 Shrink current window ! eve$enlarge_window 34 Enlarge/Shrink window subprocedure ! eve$$shift_window_boundary 35 Shift 2 windows' boundary ! eve$$mod 36 Modulo function ! eve_shift_left 37 Shift window to left ! eve_shift_right 37 Shift window to right ! eve_set_scroll_margins 38 Set window scroll margins ! eve$set_scroll_margins 39 Change window scroll margins ! eve$set_all_windows 40 SET (xxx, WINDOW) on all windows ! eve$teardown_windows 41 Remove all windows ! eve$setup_windows 42 Set-up EVE's windows ! eve$$map_window 43 Map (create if needed) a window ! eve$$unmap_all_windows 44 Remove all windows ! eve$eve_in_control 45 Test if EVE has control of interface ! eve$move_by_screen 46 Next/prev screen subprocedure ! eve$map_choices 47 Display the choice buffer ! eve$get_screen_height 48 Return screen height ! eve_refresh 49 Refresh all windows ! eve_set_width 50 Set width of all windows to 80/132 ! eve$set_width 51 SET WIDTH subprocedure ! eve$$show_window_status 52 Show buffer/window status line ! eve$$sys_window_status 53 Create system window status line ! eve_set_scroll_on 54 Turn scrolling on ! eve_set_scroll_off 54 Turn off scrolling ! eve_set_scroll_smooth 55 Set smooth scrolling ! eve_set_scroll_jump 55 Set jump scrolling !-- ! EVE$WINDOWS.TPU Page 3 ! ! ! --- NOTE --- ! ! As part of our effort to maintain consistency in naming conventions the ! following synonyms have been implemented : ! ! ! old variable new name ! ------------ -------- ! ! INFO_WINDOW TPU$X_SHOW_WINDOW ! SHOW_BUFFER TPU$X_SHOW_BUFFER ! MESSAGE_BUFFER TPU$X_MESSAGE_BUFFER ! ! Please note the new names are SYNONYMS - they are equivalent in that if ! you change one it alters the other. Your old code will still work, ! however in the future the above convention should be followed. ! ! EVE$WINDOWS.TPU Page 4 procedure eve$goto_command_window ! Pre-command window positioning ! Routine to position to the command window, making sure that it is mapped ! and on-screen. on_error [TPU$_WINDNOTMAPPED]: map (eve$command_window, eve$command_buffer); position (eve$command_window); [OTHERWISE]: endon_error if eve$eve_in_control then position (eve$command_window); shift (eve$command_window, -65535); else return (FALSE); endif; endprocedure; ! eve$goto_command_window ! EVE$WINDOWS.TPU Page 5 procedure eve$show_first_line ! Insure inserted text shows ! Procedure to insure that a change that inserts text before the ! top of the window displays the last line of that text on the ! first line of the window. local saved_mark, ! Marker of position before scroll new_position; ! Marker of position after scroll on_error [TPU$_CONTROLC]: eve$$restore_position (saved_mark); eve$learn_abort; abort; [OTHERWISE]: eve$$restore_position (saved_mark); endon_error; update (current_window); if (get_info (current_window, "current_row") = get_info (current_window, "visible_top")) and !*** V2.0 Compat (current_column = 1) then saved_mark := mark (FREE_CURSOR); scroll (current_window, -1); ! returns 0 at start of buffer new_position := mark (FREE_CURSOR); ! Make sure we scrolled before doing the cursor_vertical if new_position <> saved_mark then if cursor_vertical (1) = 0 then ! 1-line window has to be scrolled scroll (current_window, 1); endif; endif; endif; endprocedure; ! eve$show_first_line ! EVE$WINDOWS.TPU Page 6 procedure eve$position_in_middle ! Move to middle of window (new_position) ! mark to position to - input local scroll_offset, ! New value for scroll_top and scroll_bottom saved_scrolls, ! Boolean set if saved_scroll_xxx are valid saved_scroll_top, ! Original value of scroll_top saved_scroll_bottom, ! Original value of scroll_bottom saved_scroll_amount, ! Original value of scroll_amount saved_window, ! Current window saved_mark; ! Current position on_error [TPU$_CONTROLC]: if saved_scrolls then set (SCROLLING, saved_window, eve$x_scrolling, saved_scroll_top, saved_scroll_bottom, saved_scroll_amount); eve$$restore_position (new_position); update (saved_window); else eve$$restore_position (saved_mark); endif; eve$learn_abort; abort; [OTHERWISE]: if saved_scrolls then set (SCROLLING, saved_window, eve$x_scrolling, saved_scroll_top, saved_scroll_bottom, saved_scroll_amount); eve$$restore_position (new_position); update (saved_window); else eve$$restore_position (saved_mark); endif; endon_error; saved_window := current_window; saved_mark := mark (FREE_CURSOR); scroll_offset := (get_info (saved_window, "visible_length") / 2) - 2;!*** V2.0 Compat if scroll_offset < 0 then scroll_offset := 0; else if scroll_offset > eve$x_max_scroll_offset then scroll_offset := eve$x_max_scroll_offset; endif; endif; saved_scroll_top := get_info (saved_window, "scroll_top"); saved_scroll_bottom := get_info (saved_window, "scroll_bottom"); saved_scroll_amount := get_info (saved_window, "scroll_amount"); if (saved_scroll_top = 0) and (saved_scroll_bottom = 0) and (saved_scroll_amount = 0) then ! No scroll regions set, force one <= 4 lines saved_scrolls := TRUE; set (SCROLLING, saved_window, eve$x_scrolling, scroll_offset, scroll_offset, 0); position (new_position); update (saved_window); set (SCROLLING, saved_window, eve$x_scrolling, saved_scroll_top, saved_scroll_bottom, saved_scroll_amount); else ! Use current scroll regions position (new_position); update (saved_window); endif; endprocedure; ! eve$position_in_middle ! EVE$WINDOWS.TPU Page 7 procedure eve$set_status_line ! Set a window status line (this_window) ! Window whose status line is being set - input ! Set status line of a window to include buffer name and mode indications. local this_buffer, ! Current_buffer saved_mark, ! Current position saved_window, ! Current window status_string; ! String for status_line on_error [OTHERWISE]: eve$$restore_position (saved_window, saved_mark); endon_error; if get_info (this_window, "visible") then if get_info (this_window, "status_line") <> 0 then saved_window := current_window; saved_mark := mark (FREE_CURSOR); position (this_window); this_buffer := get_info (this_window, "buffer"); ! If the buffer's status line is not to be modified by EVE, then ! put up the fixed status line status_string := eve$get_fixed_status_line (this_buffer); if status_string = "" then status_string := eve$get_status_line (this_window); endif; if status_string <> 0 then if get_info (this_window, "status_line") <> status_string then set (STATUS_LINE, this_window, REVERSE, status_string); endif; endif; eve$$restore_position (saved_window, saved_mark); endif; endif; endprocedure; ! eve$set_status_line ! EVE$WINDOWS.TPU Page 8 procedure eve$get_status_line ! Get the standard status line (this_window) local this_buffer, ! Current buffer saved_mark, ! Current position saved_window, ! Current window status_string, ! String for status line the_width, ! Width ofthe window buffer_field, ! String containing name of current buffer buffer_field_length, ! Length available for buffer name extra_fields, ! String containing other data extra_length; ! Length available for extra_fields on_error [OTHERWISE]: eve$$restore_position (saved_window, saved_mark); endon_error; this_buffer := get_info (this_window, "buffer"); ! Don't add a status line to windows without a status line if this_buffer <> 0 then saved_window := current_window; saved_mark := mark (FREE_CURSOR); position (this_window); buffer_field := eve$buffer_name_field (this_buffer); buffer_field_length := length (buffer_field); the_width := get_info (this_window, "width"); extra_length := the_width - (buffer_field_length + 2); if (extra_length > 0) then extra_fields := eve$get_status_fields (extra_length, eve$$x_extra_field_format); else extra_fields := ""; endif; status_string := buffer_field + (" " * (the_width - (buffer_field_length + length (extra_fields) + 1))) + extra_fields; eve$$restore_position (saved_window, saved_mark); endif; return status_string; endprocedure; ! eve$get_status_line ! EVE$WINDOWS.TPU Page 9 procedure eve$buffer_name_field ! Buffer name field (the_buffer) return fao (" Buffer: !AS", get_info (the_buffer, "name")); endprocedure; ! eve$buffer_name_field ! EVE$WINDOWS.TPU Page 10 procedure eve$direction_status_field ! Direction field (the_length, the_format) on_error [OTHERWISE]: endon_error; if get_info (current_buffer, "direction") = FORWARD then return fao (the_format, eve$x_forward); else return fao (the_format, eve$x_reverse); endif; endprocedure; ! eve$direction_status_field ! EVE$WINDOWS.TPU Page 11 procedure eve$mode_status_field ! Insert/overstike field (the_length, the_format) on_error [OTHERWISE]: endon_error; if get_info (current_buffer, "modifiable") then if get_info (current_buffer, "mode") = INSERT then return fao (the_format, eve$x_insert); else return fao (the_format, eve$x_overstrike); endif; else return fao (the_format, eve$x_unmodifiable); endif; endprocedure; ! eve$mode_status_field ! EVE$WINDOWS.TPU Page 12 procedure eve$set_fixed_status_line ! Set buffer status line [un]modifiable (the_buffer, ! buffer to mark status_arg) ! string if status line should not be modified, or ! "" if status line can be modified (negates prior ! call with status_string = string) ! Mark a buffer status line as modifiable or not by EVE. on_error [OTHERWISE]: endon_error; if get_info (the_buffer, "type") <> BUFFER then return (FALSE); endif; if get_info (eve$$x_fixed_status_array, "type") <> ARRAY then eve$$x_fixed_status_array := create_array; endif; case get_info (status_arg, "type") [STRING, PROGRAM]: if status_arg <> "" then eve$$x_fixed_status_array {the_buffer} := status_arg; else eve$$x_fixed_status_array {the_buffer} := tpu$k_unspecified; endif; [OTHERWISE]: return (FALSE); endcase; return (TRUE); endprocedure; ! eve$set_fixed_status_line ! EVE$WINDOWS.TPU Page 13 procedure eve$get_fixed_status_line ! User-defined status-line, if any (the_buffer) ! Get the buffer-specific status-line, if there is one local the_line, saved_mark, ! Current position saved_window; ! Current window on_error [OTHERWISE]: eve$$restore_position (saved_window, saved_mark); endon_error; the_line := eve$$x_fixed_status_array {the_buffer}; case get_info (the_line, "type") [STRING]: return (the_line); [PROGRAM]: saved_window := current_window; saved_mark := mark (FREE_CURSOR); position (the_buffer); the_line := execute (the_line); eve$$restore_position (saved_window, saved_mark); if get_info (the_line, "type") = STRING then return (the_line); else return (""); endif; [UNSPECIFIED, OTHERWISE]: return (""); endcase; endprocedure; ! eve$get_fixed_status_line ! EVE$WINDOWS.TPU Page 14 procedure eve$update_status_lines ! Update all current buffer status lines ! Update the status line in all windows mapped to the current buffer local this_buffer, ! Current buffer loop_window; ! Window currently being checked in loop on_error [OTHERWISE]: endon_error; this_buffer := current_buffer; if get_info (this_buffer, "map_count") > 1 then loop_window := get_info (WINDOW, "first"); loop exitif loop_window = 0; if get_info (loop_window, "buffer") = this_buffer then eve$set_status_line (loop_window); endif; loop_window := get_info (WINDOW, "next"); endloop; else eve$set_status_line (current_window); endif; endprocedure; ! eve$update_status_lines ! EVE$WINDOWS.TPU Page 15 procedure eve$update_all_status_lines ! Update all status lines ! Update the status line in all windows local saved_mark, ! Current position saved_window, ! Current window this_buffer, ! Buffer in loop loop_window; ! Window currently being checked in loop on_error [OTHERWISE]: eve$$restore_position (saved_window, saved_mark); endon_error; saved_window := current_window; saved_mark := mark (FREE_CURSOR); loop_window := get_info (WINDOW, "first"); loop exitif loop_window = 0; this_buffer := get_info (loop_window, "buffer"); if this_buffer <> 0 then position (this_buffer); ! make it the current_buffer for ! eve$get_status_fields and ! _status_field procedures eve$set_status_line (loop_window); endif; loop_window := get_info (WINDOW, "next"); endloop; eve$$restore_position (saved_window, saved_mark); endprocedure; ! eve$update_all_status_lines ! EVE$WINDOWS.TPU Page 16 procedure eve$check_bad_window ! Test for non-user window ! Used before issuing window/buffer manipulation commands. Returns true if ! current window is message, command, prompt, or show window, in ! which we may not want to do the command. In these cases, the ! cursor is repositioned to the main window. This helps people ! who accidentally get stuck in one of these windows. The calling procedure ! determines the error message or other action. In other cases, ! returns false. local new_buffer; on_error [TPU$_CONTROLC]: eve$check_bad_window; eve$learn_abort; abort; [TPU$_NOTARRAY]: if eve$eve_in_control then eve$message (error_text, error); endif; eve$learn_abort; return (FALSE); [OTHERWISE]: endon_error; if not eve$eve_in_control then return (FALSE); ! for DECwindows resize endif; eve$main_window_length := eve$get_screen_height - eve$$x_message_window_size - eve$$x_command_window_size; if current_window = tpu$x_show_window then eve$unmap_help; endif; if (current_window = message_window) or (current_window = eve$command_window) or (current_window = eve$prompt_window) then if current_window = eve$prompt_window then if get_info (tpu$x_show_window, "buffer") = help_buffer then return (TRUE); ! help is prompting, stay in prompt_window endif; unmap (eve$prompt_window); endif; if (current_window = eve$command_window) or (current_window = message_window) then if get_info (eve$main_window, "type") = WINDOW then if get_info (eve$main_window, "buffer") <> 0 then position (eve$main_window); return (TRUE); endif; endif; endif; if get_info (eve$main_window, "type") = WINDOW then if get_info (eve$main_window, "visible") then return (TRUE); endif; else eve$$x_windows {1} := create_window (1, eve$main_window_length, ON); %if eve$x_option_decwindows %then eve$$set_scroll_bars (eve$$x_windows {1}); %endif endif; set (KEY_MAP_LIST, eve$x_mouse_list, eve$$x_windows {1}); new_buffer := get_info (BUFFERS, "first"); loop exitif new_buffer = 0; exitif not get_info (new_buffer, "system"); new_buffer := get_info (BUFFERS, "next"); endloop; if new_buffer = 0 then if eve$x_buf_str_main = tpu$k_unspecified then eve$x_buf_str_main := "MAIN"; endif; new_buffer := get_info (BUFFERS, "find_buffer", eve$x_buf_str_main); endif; if new_buffer = 0 then eve$create_main_buffer; ! creates and maps to eve$main_window else map (eve$main_window, new_buffer); eve$set_status_line (eve$main_window); endif; return (TRUE); else return (FALSE); endif; endprocedure; ! eve$check_bad_window ! EVE$WINDOWS.TPU Page 17 procedure eve$unmap_if_mapped ! Unmap a window (window_to_unmap) ! Window that needs unmapping ! Routine to unmap a window only if it is mapped on_error [OTHERWISE]: endon_error; if (get_info (window_to_unmap, "buffer") <> 0) then unmap (window_to_unmap); endif; endprocedure; ! eve$unmap_if_mapped procedure eve$map_if_not_mapped ! Map a window if not mapped (window_to_map, ! Window that needs mapping buffer_to_map) ! And the buffer to map it to ! Procedure to map the named window to the named buffer only if ! the window is not mapped to the named buffer. on_error [OTHERWISE]: endon_error; if (get_info (window_to_map, "buffer") <> buffer_to_map) then map (window_to_map, buffer_to_map); endif; endprocedure; ! eve$map_if_not_mapped ! EVE$WINDOWS.TPU Page 18 procedure eve$map_help ! Map help/show buffer to info_window (which_buffer) ! Procedures to map/unmap the info_window for layered products with complex ! window mapping logic. on_error [OTHERWISE]: endon_error; map (tpu$x_show_window, which_buffer); endprocedure; ! eve$map_help procedure eve$unmap_help ! Unmap info_window unmap (tpu$x_show_window); endprocedure; ! eve$unmap_help ! EVE$WINDOWS.TPU Page 19 procedure eve$main_window ! return the main window on_error [TPU$_NOTARRAY]: if eve$eve_in_control then eve$message (error_text, error); endif; eve$learn_abort; return (0); [OTHERWISE]: endon_error; return eve$$x_windows {1}; endprocedure; ! eve$main_window procedure eve$top_window ! return the top window on_error [TPU$_NOTARRAY]: if eve$eve_in_control then eve$message (error_text, error); endif; eve$learn_abort; return (0); [OTHERWISE]: endon_error; return eve$$x_windows {1}; endprocedure; ! eve$top_window procedure eve$bottom_window ! return the bottom window on_error [TPU$_NOTARRAY]: if eve$eve_in_control then eve$message (error_text, error); endif; eve$learn_abort; return (0); [OTHERWISE]: endon_error; return eve$$x_windows {eve$x_number_of_windows}; endprocedure; ! eve$bottom_window ! EVE$WINDOWS.TPU Page 20 procedure eve_one_window ! One window ! Delete windows and map only one window on the screen local this_window, ! Current window the_number; on_error [TPU$_CONTROLC]: if eve$x_number_of_windows = 1 then eve$x_number_of_windows := 2; ! get past onlyone test below endif; eve_one_window; eve$learn_abort; abort; [TPU$_NOTARRAY]: if eve$eve_in_control then eve$message (error_text, error); endif; eve$learn_abort; return (0); [OTHERWISE]: endon_error; eve$check_bad_window; this_window := current_window; the_number := eve$$get_window_number; if (eve$x_number_of_windows = 1) or (the_number = 0) then eve$message (EVE$_ONLYONE); ! no learn_abort here else if get_info (eve$$x_ruler_window, "type") = WINDOW then if get_info (eve$$x_ruler_window, "buffer") <> 0 then eve$$exit_ruler; endif; endif; ! eve$x_number_of_windows can exceed actual window count, and the ! following will still work loop exitif eve$x_number_of_windows < 1; if (eve$$x_windows {eve$x_number_of_windows} <> this_window) and (get_info (eve$$x_windows {eve$x_number_of_windows}, "type") = WINDOW) ! in case ^C aborted this loop after deleting a window then ! but before decrementing the count delete (eve$$x_windows {eve$x_number_of_windows}); endif; eve$x_number_of_windows := eve$x_number_of_windows - 1; endloop; eve$x_number_of_windows := 1; eve$$x_windows {the_number} := tpu$k_unspecified; eve$$x_windows {1} := this_window; adjust_window (this_window, 1 - get_info (this_window, "top", WINDOW), eve$main_window_length - get_info (this_window, "bottom", WINDOW)); ! reset the window's attributes that changed due to adjust_window if (eve$x_scroll_top <> 0) or (eve$x_scroll_bottom <> 0) then eve$set_scroll_margins (this_window, eve$x_scroll_top, eve$x_scroll_bottom); endif; endif; return (TRUE); endprocedure; ! eve_one_window ! EVE$WINDOWS.TPU Page 21 procedure eve_next_window ! Move cursor to the next window ! Go to the next window. If current wondow is the bottom window, then go to ! the top one. local next_window; ! next window on_error [TPU$_CONTROLC]: eve_next_window; eve$learn_abort; abort; [TPU$_NOTARRAY]: if eve$eve_in_control then eve$message (error_text, error); endif; eve$learn_abort; return (0); [OTHERWISE]: endon_error; if get_info (eve$choice_window, "buffer") <> 0 then if (current_window = eve$command_window) or ((current_window = eve$prompt_window) and (get_info (eve$prompt_window, "buffer") = eve$help_prompt_buffer)) then position (eve$choice_window); return (TRUE); else if current_window = eve$choice_window then if (get_info (eve$prompt_window, "buffer") <> eve$help_prompt_buffer) then position (eve$command_window); else position (eve$prompt_window); endif; return (TRUE); endif; endif; endif; if not eve$declare_intention (eve$k_action_new_window) then return (FALSE); endif; eve$check_bad_window; if eve$x_number_of_windows = 1 then eve$message (EVE$_ONLYONE); else next_window := eve$$mod (eve$$get_window_number, eve$x_number_of_windows) + 1; position (eve$$x_windows {next_window}); endif; return (TRUE); endprocedure; ! eve_next_window procedure eve_other_window ! Synonym of NEXT WINDOW return (eve_next_window); endprocedure; ! eve_other_window ! EVE$WINDOWS.TPU Page 22 procedure eve_previous_window ! Move cursor to the previous window ! go to the previous window ! if in the top window, then goto the bottom window local previous_window; ! previous window on_error [TPU$_CONTROLC]: eve_previous_window; eve$learn_abort; abort; [TPU$_NOTARRAY]: if eve$eve_in_control then eve$message (error_text, error); endif; eve$learn_abort; return (0); [OTHERWISE]: endon_error; if get_info (eve$choice_window, "buffer") <> 0 then if (current_window = eve$command_window) or ((current_window = eve$prompt_window) and (get_info (eve$prompt_window, "buffer") = eve$help_prompt_buffer)) then position (eve$choice_window); return (TRUE); else if current_window = eve$choice_window then if (get_info (eve$prompt_window, "buffer") <> eve$help_prompt_buffer) then position (eve$command_window); else position (eve$prompt_window); endif; return (TRUE); endif; endif; endif; if not eve$declare_intention (eve$k_action_new_window) then return (FALSE); endif; eve$check_bad_window; if eve$x_number_of_windows = 1 then eve$message (EVE$_ONLYONE); else previous_window := eve$$mod (eve$$get_window_number - 2, eve$x_number_of_windows) + 1; position (eve$$x_windows {previous_window}); endif; return (TRUE); endprocedure; ! eve_previous_window ! EVE$WINDOWS.TPU Page 23 procedure eve_split_window ! Split current window into n (2) windows (; n) ! procedure to split current window into two windows local this_window, ! current window number, ! next window number window_length, ! visible length of current window new_window_top, ! visible top of new window how_many, ! Local copy of the number requested new_height, ! Height for newly created windows status_line_flag, ! Indicates if current_window has status line overhead, ! Amount of space for statu line/scroll bar etc. the_pad, ! Current window attributes... the_text, the_video, the_width, the_blink, the_bold, the_reverse, state_flag, the_underline; on_error [TPU$_CONTROLC]: if state_flag <> 4 ! don't set video attributes after mapping then if state_flag >= 1 then ! reverse the adjustment adjust_window (this_window, 0, window_length - new_height); if (eve$x_scroll_top <> 0) or (eve$x_scroll_bottom <> 0) then eve$set_scroll_margins (this_window, eve$x_scroll_top, eve$x_scroll_bottom); endif; endif; if state_flag = 2 then ! remove the gap from the window array loop exitif number = eve$x_number_of_windows; eve$$x_windows {number} := eve$$x_windows {number + 1}; number := number + 1; endloop; eve$$x_windows {eve$x_number_of_windows} := tpu$k_unspecified; eve$x_number_of_windows := eve$x_number_of_windows - 1; state_flag := 1; endif; if state_flag = 3 then ! delete the created (but not mapped) window eve$$remove_window (number); state_flag := 1; endif; endif; eve$learn_abort; abort; [TPU$_NOTARRAY]: if eve$eve_in_control then eve$message (error_text, error); endif; eve$learn_abort; return (0); [OTHERWISE]: endon_error; eve$check_bad_window; eve$x_temp_buffer := current_buffer; how_many := n; if (how_many = eve$k_no_arg) or (how_many = 0) then how_many := 2; endif; if get_info (how_many, "type") <> INTEGER then eve$message (EVE$_EXPECTNUM, 0, "SPLIT WINDOW", 1); eve$learn_abort; return (FALSE); endif; if how_many < 2 then eve$message (EVE$_CANTDIVIDENEG, 0, how_many); eve$learn_abort; return (FALSE); endif; if get_info (current_window, "status_line") <> 0 then status_line_flag := ON; else status_line_flag := OFF; endif; overhead := get_info (current_window, "length", WINDOW) - get_info (current_window, "length", TEXT); ! minimum window length = 1 text line [+ 1 status line] window_length := get_info (current_window, "original_length"); !*** V2.0 Compat if (window_length / how_many) < (1 + overhead) then eve$message (EVE$_CANTDIVWINDOW); eve$learn_abort; return (FALSE); else this_window := current_window; if get_info (eve$$x_ruler_window, "type") = WINDOW then if get_info (eve$$x_ruler_window, "buffer") <> 0 then eve$$exit_ruler; endif; endif; ! get the window's attributes the_pad := get_info (this_window, "pad"); the_text := get_info (this_window, "text"); the_width := get_info (this_window, "width"); the_video := get_info (this_window, "video"); ! keyword or int(1) if the_video = 1 then the_blink := get_info (this_window, "blink_video"); the_bold := get_info (this_window, "bold_video"); the_reverse := get_info (this_window, "reverse_video"); the_underline := get_info (this_window, "underline_video"); endif; loop state_flag := 0; number := eve$$get_window_number + 1; new_height := window_length / how_many; new_window_top := get_info (this_window, "visible_top") + new_height; !*** V2.0 Compat window_length := get_info (this_window, "original_length"); !*** V2.0 Compat adjust_window (this_window, 0, new_height - window_length); state_flag := 1; if (eve$x_scroll_top <> 0) or (eve$x_scroll_bottom <> 0) then eve$set_scroll_margins (this_window, eve$x_scroll_top, eve$x_scroll_bottom); endif; eve$set_status_line (this_window); state_flag := 2; eve$$open_window_gap (number); eve$$x_windows {number} := create_window (new_window_top, window_length - new_height, status_line_flag); %if eve$x_option_decwindows %then eve$$set_scroll_bars (eve$$x_windows {number}); %endif state_flag := 3; set (KEY_MAP_LIST, eve$x_mouse_list, eve$$x_windows {number}); map (eve$$x_windows {number}, eve$x_temp_buffer); state_flag := 4; ! set window's attributes this_window := current_window; set (TEXT, this_window, the_text); set (WIDTH, this_window, the_width); if the_pad then set (PAD, this_window, ON); endif; if the_video = 1 then if the_blink then set (VIDEO, this_window, BLINK); endif; if the_bold then set (VIDEO, this_window, BOLD); endif; if the_reverse then set (VIDEO, this_window, REVERSE); endif; if the_underline then set (VIDEO, this_window, UNDERLINE); endif; else set (VIDEO, this_window, the_video); endif; if (eve$x_scroll_top <> 0) or (eve$x_scroll_bottom <> 0) then eve$set_scroll_margins (this_window, eve$x_scroll_top, eve$x_scroll_bottom); endif; eve$set_status_line (this_window); window_length := window_length - new_height; how_many := how_many - 1; exitif how_many <= 1; endloop; return (TRUE); endif; endprocedure; ! eve_split_window procedure eve_two_windows ! Synonym of split window return (eve_split_window (2)); endprocedure; ! eve_two_windows ! EVE$WINDOWS.TPU Page 24 procedure eve_delete_window ! Delete current window ! delete current_window and enlarge previous window local number, ! Current window_number state_flag, enlarge_length, enlarge_window; if not eve$declare_intention (eve$k_action_new_window) then return (FALSE); endif; eve$check_bad_window; if eve$x_number_of_windows = 1 then eve$message (EVE$_CANTDELWINDOW); eve$learn_abort; return (FALSE); else if get_info (eve$$x_ruler_window, "type") = WINDOW then if get_info (eve$$x_ruler_window, "buffer") <> 0 then eve$$exit_ruler; endif; endif; number := eve$$get_window_number; eve$delete_window (number); state_flag := 3; endif; return (TRUE); endprocedure; ! eve_delete_window ! EVE$WINDOWS.TPU Page 25 procedure eve$delete_window ! Delete a window and close the gap (number) local enlarge_window, enlarge_length, state_flag; on_error [TPU$_CONTROLC]: if state_flag = 1 then position (eve$get_window (number)); state_flag := 0; else if state_flag = 2 then eve$set_scroll_margins (enlarge_window, eve$x_scroll_top, eve$x_scroll_bottom); eve$$remove_window (number); state_flag := 0; endif; endif; eve$learn_abort; abort; [TPU$_NOTARRAY]: if eve$eve_in_control then eve$message (error_text, error); endif; eve$learn_abort; return (FALSE); [OTHERWISE]: endon_error; if eve$x_number_of_windows < 2 then return (FALSE); endif; if number = 1 then ! enlarge the next window down enlarge_window := eve$$x_windows {2}; else ! enlarge the previous window enlarge_window := eve$$x_windows {number - 1}; endif; enlarge_length := get_info (eve$$x_windows {number}, "original_length"); !*** V2.0 Compat position (enlarge_window); state_flag := 1; if number = 1 then adjust_window (enlarge_window, -enlarge_length, 0); else adjust_window (enlarge_window, 0, enlarge_length); endif; state_flag := 2; eve$$remove_window (number); eve$set_scroll_margins (enlarge_window, eve$x_scroll_top, eve$x_scroll_bottom); return (TRUE); endprocedure; ! eve$delete_window ! EVE$WINDOWS.TPU Page 26 procedure eve$$get_window_number ! Get number of current_window (; a_window) ! procedure to get window number of current (or optional specified) window local the_window, the_count; on_error [TPU$_NOTARRAY]: if eve$eve_in_control then eve$message (error_text, error); endif; eve$learn_abort; return (FALSE); [OTHERWISE]: endon_error; if a_window <> tpu$k_unspecified then the_window := a_window; else the_window := current_window; endif; the_count := 1; loop exitif the_count > eve$x_number_of_windows; if the_window = eve$$x_windows {the_count} then return (the_count); endif; the_count := the_count + 1; endloop; return (0); endprocedure; ! eve$$get_window_number ! EVE$WINDOWS.TPU Page 27 procedure eve$get_window ! Get a window from its number (number) on_error [TPU$_NOTARRAY]: if eve$eve_in_control then eve$message (error_text, error); endif; eve$learn_abort; return (FALSE); [OTHERWISE]: endon_error; if (number <= 0) or (number > eve$x_number_of_windows) then return (0); else return (eve$$x_windows {number}); endif; endprocedure; ! eve$get_window ! EVE$WINDOWS.TPU Page 28 procedure eve$remap_windows ! Remap from old to new buffer (old_buffer, new_buffer) ! remap all windows to new_buffer that are currently mapped to old_buffer local window_number, saved_window; on_error [TPU$_NOTARRAY]: if eve$eve_in_control then eve$message (error_text, error); endif; eve$learn_abort; return (FALSE); [OTHERWISE]: endon_error; if get_info (old_buffer, "map_count") = 0 then return (FALSE); endif; saved_window := current_window; window_number := 1; loop exitif window_number > eve$x_number_of_windows; if get_info (eve$$x_windows {window_number}, "buffer") = old_buffer then map (eve$$x_windows {window_number}, new_buffer); eve$set_status_line (eve$$x_windows {window_number}); endif; window_number := window_number + 1; endloop; position (saved_window); return (TRUE); endprocedure; ! eve$remap_windows ! EVE$WINDOWS.TPU Page 29 procedure eve$get_mapped_window ! Find first window mapped to buffer (the_buffer) local window_number; on_error [TPU$_NOTARRAY]: if eve$eve_in_control then eve$message (error_text, error); endif; eve$learn_abort; return (FALSE); [OTHERWISE]: endon_error; window_number := 1; loop exitif window_number > eve$x_number_of_windows; if get_info (eve$$x_windows {window_number}, "buffer") = the_buffer then return (eve$$x_windows {window_number}); endif; window_number := window_number + 1; endloop; return (0); endprocedure; ! eve$get_mapped_window ! EVE$WINDOWS.TPU Page 30 procedure eve$$open_window_gap ! Make room for a window (num) ! Open a gap in the window array for a new window local the_count, state_flag, array_size, temp; on_error [TPU$_CONTROLC]: ! insure the gap is opened so caller can remove it if state_flag = 1 then if eve$$x_windows {the_count + 1} = eve$$x_windows {the_count} then the_count := the_count - 1; ! ^C before the_count decr'd endif; loop exitif the_count < num; eve$$x_windows {the_count + 1} := eve$$x_windows {the_count}; the_count := the_count - 1; endloop; state_flag := 2; eve$x_number_of_windows := eve$x_number_of_windows + 1; state_flag := 3; else if state_flag = 2 then eve$x_number_of_windows := eve$x_number_of_windows + 1; state_flag := 3; endif; endif; eve$learn_abort; abort; [TPU$_NOTARRAY]: if eve$eve_in_control then eve$message (error_text, error); endif; eve$learn_abort; return (FALSE); [OTHERWISE]: endon_error; ! double the array size if it's full array_size := get_info (eve$$x_windows, "high_index"); if eve$x_number_of_windows >= array_size then temp := create_array (array_size * 2); the_count := eve$x_number_of_windows; loop exitif the_count < 1; temp {the_count} := eve$$x_windows {the_count}; the_count := the_count - 1; endloop; eve$$x_windows := temp; endif; ! make room for the new window by bumping existing windows (that are ! at indices above the requested gap) to higher indices the_count := eve$x_number_of_windows; state_flag := 1; loop exitif the_count < num; eve$$x_windows {the_count + 1} := eve$$x_windows {the_count}; the_count := the_count - 1; endloop; state_flag := 2; eve$x_number_of_windows := eve$x_number_of_windows + 1; state_flag := 3; endprocedure; ! eve$$open_window_gap ! EVE$WINDOWS.TPU Page 31 procedure eve$$remove_window ! Remove window from array and screen (num) ! delete a window and bump existing windows above it to lower indices local state_flag, the_count; on_error [TPU$_CONTROLC]: ! insure the window is removed if state_flag = 1 then if eve$$x_windows {the_count} = eve$$x_windows {the_count + 1} then the_count := the_count + 1; ! ^C before the_count incr'd endif; loop exitif the_count = eve$x_number_of_windows; eve$$x_windows {the_count} := eve$$x_windows {the_count + 1}; the_count := the_count + 1; endloop; state_flag := 2; eve$$x_windows {eve$x_number_of_windows} := tpu$k_unspecified; eve$x_number_of_windows := eve$x_number_of_windows - 1; state_flag := 3; else if state_flag = 2 then eve$$x_windows {eve$x_number_of_windows} := tpu$k_unspecified; eve$x_number_of_windows := eve$x_number_of_windows - 1; state_flag := 3; endif; endif; [TPU$_NOTARRAY]: if eve$eve_in_control then eve$message (error_text, error); endif; eve$learn_abort; return (FALSE); [OTHERWISE]: endon_error; the_count := num; delete (eve$$x_windows {the_count}); state_flag := 1; loop exitif the_count = eve$x_number_of_windows; eve$$x_windows {the_count} := eve$$x_windows {the_count + 1}; the_count := the_count + 1; endloop; state_flag := 2; eve$$x_windows {eve$x_number_of_windows} := tpu$k_unspecified; eve$x_number_of_windows := eve$x_number_of_windows - 1; state_flag := 3; endprocedure; ! eve$$remove_window ! EVE$WINDOWS.TPU Page 32 procedure eve_enlarge_window ! Enlarge current window (enlarge_lines) ! Enlarge a window local lines, status, lines_enlarged; on_error [OTHERWISE]: endon_error; eve$check_bad_window; if eve$x_number_of_windows > 1 then if eve$prompt_number (enlarge_lines, lines, message_text (EVE$_ENLARGEPROMPT, 1), message_text (EVE$_NOLINES, 0)) then lines_enlarged := lines; status := eve$enlarge_window (lines, lines_enlarged); if status = TRUE then eve$message (EVE$_ENLARGEWINDOW, 0, lines_enlarged); return (TRUE); else if status = eve$k_error then eve$message (EVE$_ENLARGERROR, 0, lines_enlarged); endif; eve$learn_abort; return (FALSE); endif; endif; else eve$message (EVE$_ONLYONE); endif; eve$learn_abort; return (FALSE); endprocedure; ! eve_enlarge_window ! EVE$WINDOWS.TPU Page 33 procedure eve_shrink_window ! Shrink current window (shrink_lines) ! Shrink current window local lines, status, lines_shrunk; on_error [OTHERWISE]: endon_error; eve$check_bad_window; if eve$x_number_of_windows > 1 then if eve$prompt_number (shrink_lines, lines, message_text (EVE$_SHRINKPROMPT, 1), message_text (EVE$_NOLINES, 0)) then lines_shrunk := lines; status := eve$enlarge_window (-lines, lines_shrunk); if status = TRUE then eve$message (EVE$_SHRINKWINDOW, 0, lines_shrunk); return (TRUE); else if status = eve$k_error then eve$message (EVE$_SHRINKERROR, 0, lines_shrunk); endif; eve$learn_abort; return (FALSE); endif; endif; else eve$message (EVE$_ONLYONE); endif; eve$learn_abort; return (FALSE); endprocedure; ! eve_shrink_window ! EVE$WINDOWS.TPU Page 34 procedure eve$enlarge_window ! Enlarge/Shrink window subprocedure (lines, lines_changed) ! Enlarge/Shrink window local this_window, prev_window, next_window; on_error [TPU$_NOTARRAY]: if eve$eve_in_control then eve$message (error_text, error); endif; eve$learn_abort; return (FALSE); [OTHERWISE]: endon_error; if eve$x_number_of_windows > 1 then this_window := current_window; next_window := eve$$get_window_number + 1; prev_window := next_window - 2; if get_info (eve$$x_ruler_window, "type") = WINDOW then if get_info (eve$$x_ruler_window, "buffer") <> 0 then eve$$exit_ruler; endif; endif; if next_window <= eve$x_number_of_windows then ! this_window <> bottom (last) window return (eve$$shift_window_boundary (this_window, eve$$x_windows {next_window}, -lines, lines_changed)); else if prev_window > 0 ! this_window = bottom (last) window then return (eve$$shift_window_boundary (eve$$x_windows {prev_window}, this_window, lines, lines_changed)); endif; endif; else eve$message (EVE$_ONLYONE); return (FALSE); endif; endprocedure; ! eve$enlarge_window ! EVE$WINDOWS.TPU Page 35 procedure eve$$shift_window_boundary ! Shift 2 windows' boundary (top_window, bottom_window, shift_lines, lines_shifted) ! Support procedure for shift_window local distance, lines, status, state_flag, this_window; on_error [TPU$_CONTROLC]: if state_flag = 1 then adjust_window (bottom_window, -lines, 0); state_flag := 2; else if state_flag = 3 then adjust_window (top_window, 0, lines); state_flag := 4; endif; endif; if (state_flag = 2) or (state_flag = 4) then eve$set_scroll_margins (top_window, eve$x_scroll_top, eve$x_scroll_bottom); eve$set_scroll_margins (bottom_window, eve$x_scroll_top, eve$x_scroll_bottom); position (this_window); endif; eve$learn_abort; abort; [TPU$_NOTARRAY]: if eve$eve_in_control then eve$message (error_text, error); endif; eve$learn_abort; return (FALSE); [OTHERWISE]: endon_error; status := eve$k_success; lines := shift_lines; this_window := current_window; if lines > 0 then distance := get_info (top_window, "visible_bottom") !*** V2.0 Compat - get_info (top_window, "visible_top"); !*** V2.0 Compat if distance > 0 then if lines > distance then lines := distance; status := eve$k_error; endif; lines_shifted := lines; adjust_window (top_window, 0, -lines); state_flag := 1; adjust_window (bottom_window, -lines, 0); state_flag := 2; else eve$message (EVE$_CANTSHIFTWINDOW); return (FALSE); endif; else lines := -lines; distance := get_info (bottom_window, "visible_bottom") !*** V2.0 Compat - get_info (bottom_window, "visible_top"); !*** V2.0 Compat if distance > 0 then if lines > distance then lines := distance; status := eve$k_error; endif; lines_shifted := lines; adjust_window (bottom_window, lines, 0); state_flag := 3; adjust_window (top_window, 0, lines); state_flag := 4; else eve$message (EVE$_CANTSHIFTWINDOW); return (FALSE); endif; endif; if (eve$x_scroll_top <> 0) or (eve$x_scroll_bottom <> 0) then eve$set_scroll_margins (top_window, eve$x_scroll_top, eve$x_scroll_bottom); eve$set_scroll_margins (bottom_window, eve$x_scroll_top, eve$x_scroll_bottom); endif; position (this_window); return (status); endprocedure; ! eve$$shift_window_boundary ! EVE$WINDOWS.TPU Page 36 procedure eve$$mod ! Modulo function (arg_1, arg_2) ! Module function. Negative value for arg_2 is illegal (return -1). local rest; on_error [OTHERWISE]: endon_error; if arg_2 < 1 then return (-1); else rest := arg_1 - (arg_1 / arg_2) * arg_2; if rest < 0 then rest := rest + arg_2; endif; return (rest); endif; endprocedure; ! eve$$mod ! EVE$WINDOWS.TPU Page 37 procedure eve_shift_left ! Shift window to left (shift_parameter) ! Number of columns to shift left - input ! Shift left to reverse effects of shift right. local shift_amount; ! Local copy of shift_parameter on_error [OTHERWISE]: endon_error; if current_window = eve$command_window then eve$message (EVE$_CANTCMDWINDOW); eve$learn_abort; return (FALSE); endif; if eve$prompt_number (shift_parameter, shift_amount, message_text (EVE$_SHIFTLEFTPROMPT, 1), message_text (EVE$_NOTSHIFT, 0)) then if shift_amount < 0 then eve$message (EVE$_CANTSHIFTLNEG); else if get_info (eve$$x_ruler_window, "type") = WINDOW then if get_info (eve$$x_ruler_window, "buffer") <> 0 then eve$$exit_ruler; endif; endif; eve$message (EVE$_SHIFTCOUNTNOW, 0, shift (current_window, -shift_amount)); return (TRUE); endif; endif; eve$learn_abort; return (FALSE); endprocedure; ! eve_shift_left procedure eve_shift_right ! Shift window to right (shift_parameter) ! Number of columns to shift right - input ! Shift right to see rest of line beyond right-hand screen boundary. local shift_amount; ! Local copy of shift_parameter on_error [OTHERWISE]: endon_error; if current_window = eve$command_window then eve$message (EVE$_CANTCMDWINDOW); eve$learn_abort; return (FALSE); endif; if eve$prompt_number (shift_parameter, shift_amount, message_text (EVE$_SHIFTRTPROMPT, 1), message_text (EVE$_NOTSHIFT, 0)) then if shift_amount < 0 then eve$message (EVE$_CANTSHIFTRNEG); else if get_info (eve$$x_ruler_window, "type") = WINDOW then if get_info (eve$$x_ruler_window, "buffer") <> 0 then eve$$exit_ruler; endif; endif; eve$message (EVE$_SHIFTCOUNTNOW, 0, shift (current_window, shift_amount)); return (TRUE); endif; endif; eve$learn_abort; return (FALSE); endprocedure; ! eve_shift_right ! EVE$WINDOWS.TPU Page 38 procedure eve_set_scroll_margins ! Set window scroll margins (top_margin, ! Number of lines in current window's top margin, ! of type string (integers are converted) - input, ! or percentage of window visible length in top margin bottom_margin) ! Number of lines in current window's bottom margin, ! of type string (integers are converted) - input, or ! Percentage of window visible length in bottom margin ! Description ! Set scroll regions in EVE windows. Scroll margins are the lines ! at the top and bottoms of windows that the cursor is NOT allowed to ! enter. ! Scroll margin may be specified in two ways: ! 1. Number of lines in the CURRENT WINDOW. ! A line count of 0 = no margins, count of 1 = cursor can not enter ! the top or bottom line of the windows (i.e., scrolling occurs), etc. ! The line count is changed into a percentage of the window length. ! 2. % of the CURRENT WINDOW. ! Sum of both margins > 100% of the length of the current window (excluding ! the status line) are rejected. ! Once the top and bottom percentages are determined, then procedure ! EVE$SET_ALL_WINDOWS is called for all known windows. Smaller or ! bigger windows have their margins set proportionally. ! ! NOTE: If cross_window_bounds is set on, then ! free cursor motion WILL let the cursor ! enter the scroll margins. local percent_index, scroll_top_percent, scroll_bottom_percent, which_parameter, the_window, window_length, top_null, bottom_null, top_adjust_flag, ! indicate if truncation occurs when number- bottom_adjust_flag, ! of-lines is converted to percentage-of-window temp_top_percent, temp_bottom_percent, the_top_percent, the_bottom_percent, status; on_error [TPU$_INVNUMSTR]: if which_parameter = 0 then eve$message (EVE$_BADTOPSCROLL, 0, the_top_percent); else eve$message (EVE$_BADBOTSCROLL, 0, the_bottom_percent); endif; eve$learn_abort; return (FALSE); [OTHERWISE]: endon_error; if current_window = eve$command_window then eve$message (EVE$_CANTCMDWINDOW); eve$learn_abort; return (FALSE); endif; the_window := current_window; window_length := (get_info (the_window, "visible_length") - !*** V2.0 Compat (get_info (the_window, "status_line") <> "")); ! TOP MARGIN if get_info (top_margin, "type") = STRING then status := eve$prompt_string (top_margin, the_top_percent, message_text (EVE$_TOPSCROLLPROMPT), ""); if not status then eve$learn_abort; return (FALSE); endif; edit (the_top_percent, COMPRESS, TRIM); if the_top_percent <> "" then ! look for a "%" character percent_index := index (the_top_percent, "%"); if percent_index = 1 ! invalid then eve$message (EVE$_BADTOPSCROLL, 0, the_top_percent); eve$learn_abort; return (FALSE); endif; else top_null := TRUE; endif; else eve$prompt_number (top_margin, the_top_percent, message_text (EVE$_TOPSCROLLPROMPT), ""); endif; if percent_index <> 0 then ! % temp_top_percent := int (substr (the_top_percent, 1, percent_index - 1)); else ! number of lines if not top_null then if get_info (the_top_percent, "type") = STRING then the_top_percent := int (the_top_percent); endif; temp_top_percent := (the_top_percent * 100) / window_length; if (10000 * the_top_percent / window_length) <> (temp_top_percent * 100) then top_adjust_flag := TRUE; ! percent has been truncated endif; endif; endif; which_parameter := TRUE; percent_index := 0; ! BOTTOM MARGIN if get_info (bottom_margin, "type") = STRING then status := eve$prompt_string (bottom_margin, the_bottom_percent, message_text (EVE$_BOTSCROLLPROMPT), ""); if not status then eve$learn_abort; return (FALSE); endif; edit (the_bottom_percent, COMPRESS, TRIM); if the_bottom_percent <> "" then ! look for a "%" character percent_index := index (the_bottom_percent, "%"); if percent_index = 1 ! invalid then eve$message (EVE$_BADBOTSCROLL, 0, the_bottom_percent); eve$learn_abort; return (FALSE); endif; else bottom_null := TRUE; endif; else eve$prompt_number (bottom_margin, the_bottom_percent, message_text (EVE$_BOTSCROLLPROMPT), ""); endif; ! look for a "%" character if percent_index <> 0 then ! % temp_bottom_percent := int (substr (the_bottom_percent, 1, percent_index - 1)); else ! number of lines if not bottom_null then if get_info (the_bottom_percent, "type") = STRING then the_bottom_percent := int (the_bottom_percent); endif; temp_bottom_percent := (the_bottom_percent * 100) / window_length; if (10000 * the_bottom_percent / window_length) <> (temp_bottom_percent * 100) then bottom_adjust_flag := TRUE; ! percent has been truncated endif; endif; endif; if (top_null) and (bottom_null) ! "" "" = no change then eve$message (EVE$_SCROLLNOTCHNG); return (FALSE); ! no learn_abort here endif; if (temp_top_percent + temp_bottom_percent) > 100 then eve$message (EVE$_NOOVERLAP); eve$learn_abort; return (FALSE); endif; eve$x_top_margin_adjust := top_adjust_flag; eve$x_bottom_margin_adjust := bottom_adjust_flag; eve$x_scroll_top := temp_top_percent; eve$x_scroll_bottom := temp_bottom_percent; eve$set_all_windows (SCROLLING, eve$x_scroll_top, eve$x_scroll_bottom); eve$message (EVE$_SCROLLSET, 0, eve$x_scroll_top, eve$x_scroll_bottom); return (TRUE); endprocedure; ! eve_set_scroll_margins ! EVE$WINDOWS.TPU Page 39 procedure eve$set_scroll_margins ! Change window scroll margins (the_window, ! window in which to set scroll margins top_percent, ! top margin as % of window length - input bottom_percent) ! bottom margin as % of window length - input ! Description ! Set the scroll regions in a window. ! Implicit Inputs ! eve$x_top_margin_adjust = flag indicating truncation occurred when numbers ! of lines was converted to a percentage of the ! window - adds 1 to number of lines in margin ! eve$x_bottom_margin_adjust = ditto local total_lines, top_lines, bottom_lines; on_error [OTHERWISE]: endon_error; total_lines := get_info (the_window, "length", WINDOW) - (get_info (the_window, "status_line") <> ""); top_lines := (total_lines * top_percent / 100) + eve$x_top_margin_adjust; bottom_lines := (total_lines * bottom_percent / 100) + eve$x_bottom_margin_adjust; if top_lines >= total_lines then top_lines := total_lines - 1; endif; if (top_lines + bottom_lines) >= total_lines then bottom_lines := total_lines - (top_lines + 1); endif; set (SCROLLING, the_window, eve$x_scrolling, top_lines, bottom_lines, 0); endprocedure; ! eve$set_scroll_margins ! EVE$WINDOWS.TPU Page 40 procedure eve$set_all_windows ! SET (xxx, WINDOW) on all windows (arg_1, arg_3; arg_4) ! SET (arg_1, all_windows, arg_3 [, arg_4]) ! where arg_1 = PAD/SCROLLING/TEXT/VIDEO/WIDTH local the_count, the_window; on_error [OTHERWISE]: endon_error; the_count := 1; loop exitif the_count > eve$x_number_of_windows; the_window := eve$$x_windows {the_count}; if get_info (the_window, "type") = WINDOW then if arg_4 = tpu$k_unspecified then set (arg_1, the_window, arg_3); else if arg_1 = SCROLLING then ! arg_3/4 = top/bottom margins (%'s) if get_info (the_window, "visible") then ! ignore (temporarily, as by help) occluded windows eve$set_scroll_margins (the_window, arg_3, arg_4); endif; else set (arg_1, the_window, arg_3, arg_4); endif; endif; endif; the_count := the_count + 1; endloop; endprocedure; ! eve$set_all_windows ! EVE$WINDOWS.TPU Page 41 procedure eve$teardown_windows ! Remove all windows (; context) ! EVE$TEARDOWN_WINDOWS will remove all of EVE's windows from the ! screen, and optionally return a "window context block" describing ! the state of the windows at the time of the teardown. The caller ! can save the context block and pass it back to EVE$SETUP_WINDOWS ! to reconstruct the windows. ! ! The internal structure of a context block is not documented for ! customer use. Context blocks should be handled completely blindly. ! They are created by EVE$TEARDOWN_WINDOWS and can be passed to ! EVE$SETUP_WINDOWS. Any used beyond that is not supported. ! ! Undocument fact for future EVE developers: *Currently*, the way EVE ! stores context blocks is as arrays identified by having ! a specific value stored in the array under the index TYPE. The ! specific value is based on the EVE facility code. local the_count, the_window, saved_buffer, the_row, temp; on_error [TPU$_CONTROLC]: if get_info (saved_buffer, "type") = BUFFER then eve$message (EVE$_REBLDWINDOWS); eve$setup_windows (saved_buffer); eve$message (EVE$_WINDOWSREBLT); update (ALL); ! in case ^C aborted the QIO endif; eve$learn_abort; abort; [OTHERWISE]: endon_error; the_count := 0; the_window := get_info (WINDOWS, "first"); loop exitif the_window = 0; if get_info (the_window, "buffer") <> 0 then the_count := the_count + 1; endif; the_window := get_info (WINDOWS, "next"); endloop; context := create_array (the_count + 1, 0); context {TYPE} := eve$$k_window_context; context {0} := eve$x_number_of_windows; the_window := eve$main_window; if get_info (the_window, "type") = WINDOW then saved_buffer := get_info (the_window, "buffer"); endif; loop exitif the_count = 0; the_window := current_window; exitif the_window = 0; temp := create_array (30); temp {1} := the_window; temp {2} := get_info (the_window, "buffer"); temp {3} := get_info (the_window, "top", WINDOW); temp {4} := get_info (the_window, "length", WINDOW); temp {8} := get_info (the_window, "status_line"); if temp {8} <> 0 then temp {5} := ON; else temp {5} := OFF; endif; position (the_window); temp {6} := mark (FREE_CURSOR); the_row := get_info (the_window, "current_row"); if the_row = 0 then the_row := temp {3}; endif; temp {7} := the_row + 1 - temp {3}; temp {9} := get_info (the_window, "width"); temp {10} := get_info (the_window, "scroll_top"); temp {11} := get_info (the_window, "scroll_bottom"); temp {12} := get_info (the_window, "scroll_amount"); temp {13} := get_info (the_window, "text"); temp {14} := get_info (the_window, "blink_video"); temp {15} := get_info (the_window, "blink_status"); temp {16} := get_info (the_window, "bold_video"); temp {17} := get_info (the_window, "bold_status"); temp {18} := get_info (the_window, "reverse_video"); temp {19} := get_info (the_window, "reverse_status"); temp {20} := get_info (the_window, "underline_video"); temp {21} := get_info (the_window, "underline_status"); temp {22} := get_info (the_window, "special_graphics_status"); if get_info (the_window, "pad") then temp {23} := ON; else temp {23} := OFF; endif; temp {24} := get_info (the_window, "shift_amount"); temp {25} := eve$$get_window_number; if temp {25} <> 0 then eve$$x_windows {temp {25}} := tpu$k_unspecified; else if the_window = eve$command_window then temp {25} := -1; else if the_window = message_window then temp {25} := -2; else if the_window = eve$prompt_window then temp {25} := -3; else if the_window = tpu$x_show_window then temp {25} := -4; else if the_window = eve$$x_ruler_window then temp {25} := -5; else if the_window = eve$choice_window then temp {25} := -6; endif; endif; endif; endif; endif; endif; endif; temp {26} := get_info (the_window, "key_map_list"); %if eve$x_option_decwindows %then if eve$x_decwindows_active then temp {27} := (get_info (the_window, "scroll_bar", VERTICAL) <> 0); if temp {27} ! vertical scroll on, save info then temp {28} := get_info (the_window, "scroll_bar_auto_thumb", VERTICAL); endif; temp {29} := (get_info (the_window, "scroll_bar", HORIZONTAL) <> 0); if temp {29} then temp {30} := get_info (the_window, "scroll_bar_auto_thumb", HORIZONTAL); endif; endif; %else temp {27} := FALSE; temp {28} := FALSE; temp {29} := FALSE; temp {30} := FALSE; %endif context {the_count} := temp; unmap (the_window); the_count := the_count - 1; endloop; eve$x_number_of_windows := 0; eve$$x_state_array {eve$$k_windows_active} := FALSE; %if eve$x_option_decwindows %then if eve$x_decwindows_active then if not eve$$x_menubar_already_managed ! set by EVE$SETUP_WINDOWS then eve$unmanage_menu_bar; ! else, leave it managed, i.e., it was endif; ! managed when EVE previously didn't endif; ! have control of the interface %endif endprocedure; ! eve$teardown_windows ! EVE$WINDOWS.TPU Page 42 procedure eve$setup_windows ! Set-up EVE's windows (arg) ! ! ARG may be one of: ! ! A buffer EVE comes up in 1 window mode and maps ! the main window to the specied buffer. ! ! An array Array {0} contains the number of windows. ! Array {1} through array {array (0}} are ! buffers. EVE comes up with the specified ! number of windows. The top window is mapped ! to the buffer specified in Array {1} etc. ! ! A context Context block created by EVE$TEARDOWN_WINDOWS. ! The internal structure of the block is not ! documented and is subject to change. EVE ! will recreate the windows as they were when ! the call to tear-down was made. ! local arg_type, temp, the_length, length_remaining, the_top, the_count, scroll_bar_widget, ! for DECWindows scroll bars screen_length; constant a_buffer := 1; constant an_array := 2; constant a_context := 3; on_error [TPU$_CONTROLC]: eve$message (EVE$_RESETUPWINDOWS); eve$setup_windows (arg); update (ALL); ! in case ^C aborted the QIO eve$learn_abort; abort; [OTHERWISE]: endon_error; case get_info (arg, "type") [BUFFER]: arg_type := a_buffer; [ARRAY]: if arg {TYPE} <> tpu$k_unspecified then if arg {TYPE} = eve$$k_window_context then arg_type := a_context; else eve$learn_abort; return FALSE; endif; else if get_info (arg {0}, "type") = INTEGER then if (arg {0} > 0) and (arg {0} <= get_info (arg, "high_index")) then arg_type := an_array; else eve$learn_abort; return FALSE; endif; else eve$learn_abort; return FALSE; endif; endif; [INRANGE, OUTRANGE]: eve$learn_abort; return FALSE; endcase; screen_length := eve$get_screen_height; eve$$unmap_all_windows; case arg_type [a_buffer]: eve$$map_window (eve$command_window, eve$command_buffer, screen_length - eve$$x_message_window_size - eve$$x_command_window_size + 1, eve$$x_command_window_size, OFF,); set (PROMPT_AREA, screen_length - eve$$x_message_window_size - eve$$x_command_window_size + 1, 1, REVERSE); eve$$map_window (message_window, tpu$x_message_buffer, screen_length - eve$$x_message_window_size + 1, eve$$x_message_window_size, OFF); eve$x_number_of_windows := 1; eve$$map_window (eve$$x_windows {1}, arg, 1, screen_length - 2, ON); %if eve$x_option_decwindows %then eve$$set_scroll_bars (eve$$x_windows {1}); %endif eve$set_status_line (eve$$x_windows {1}); [an_array]: eve$$map_window (eve$command_window, eve$command_buffer, screen_length - eve$$x_message_window_size - eve$$x_command_window_size + 1, eve$$x_command_window_size, OFF); set (PROMPT_AREA, screen_length - eve$$x_message_window_size - eve$$x_command_window_size + 1, 1, REVERSE); eve$$map_window (message_window, tpu$x_message_buffer, screen_length - eve$$x_message_window_size + 1, eve$$x_message_window_size, OFF); the_count := 1; the_top := 1; length_remaining := screen_length - 2; loop eve$$open_window_gap (the_count); the_length := length_remaining / (1 + arg {0} - the_count); eve$$map_window (eve$$x_windows {the_count}, arg {the_count}, the_top, the_length, ON); eve$set_status_line (eve$$x_windows {the_count}); the_top := the_top + the_length; length_remaining := length_remaining - the_length; exitif the_count >= arg {0}; the_count := the_count + 1; endloop; [a_context]: eve$x_number_of_windows := arg {0}; the_count := 1; loop exitif the_count > get_info (arg, "high_index"); temp := arg {the_count}; ! create and map the window and setup last position in the buffer eve$$map_window (temp {1}, temp {2}, temp {3}, temp {4}, temp {5}, temp {6}, temp {7}, temp {29}, temp {30}); if temp {5} = ON then set (STATUS_LINE, temp {1}, NONE, temp {8}); if temp {15} then set (STATUS_LINE, temp {1}, BLINK, temp {8}); endif; if temp {17} then set (STATUS_LINE, temp {1}, BOLD, temp {8}); endif; if temp {19} then set (STATUS_LINE, temp {1}, REVERSE, temp {8}); endif; if temp {21} then set (STATUS_LINE, temp {1}, UNDERLINE, temp {8}); endif; if temp {22} then set (STATUS_LINE, temp {1}, SPECIAL_GRAPHICS, temp {8}); endif; endif; set (WIDTH, temp {1}, temp {9}); set (TEXT, temp {1}, temp {13}); if temp {14} then set (VIDEO, temp {1}, BLINK); endif; if temp {16} then set (VIDEO, temp {1}, BOLD); endif; if temp {18} then set (VIDEO, temp {1}, REVERSE); endif; if temp {20} then set (VIDEO, temp {1}, UNDERLINE); endif; set (PAD, temp {1}, temp {23}); shift (temp {1}, temp {24}); if temp {25} > 0 then eve$$x_windows {temp {25}} := temp {1}; else case temp {25} [-1]: eve$command_window := temp {1}; [-2]: message_window := temp {1}; [-3]: eve$prompt_window := temp {1}; [-4]: tpu$x_show_window := temp {1}; [-5]: eve$$x_ruler_window := temp {1}; [-6]: eve$choice_window := temp {1}; endcase; endif; the_count := the_count + 1; endloop; if get_info (temp {26}, "type") = STRING then set (KEY_MAP_LIST, temp {26}, temp {1}); endif; %if eve$x_option_decwindows %then if eve$x_decwindows_active then if temp {27} then ! set the vertical scroll bar - horizontal already set scroll_bar_widget := set (SCROLL_BAR, temp {1}, VERTICAL, ON); set (WIDGET_CALLBACK, scroll_bar_widget, "eve$scroll_dispatch", 'v'); set (WIDGET, scroll_bar_widget, eve$$x_scroll_bar_callbacks); eve$$x_scroll_bar_window (scroll_bar_widget) := temp {1}; if temp {28} then set (SCROLL_BAR_AUTO_THUMB, temp {1}, VERTICAL, ON); endif; endif; endif; %endif update (ALL); the_count := 1; ! Set scroll margins loop exitif the_count > get_info (arg, "high_index"); temp := arg {the_count}; set (SCROLLING, temp {1}, eve$x_scrolling, temp {10}, temp {11}, temp {12}); the_count := the_count + 1; endloop; set (PROMPT_AREA, screen_length - 1, 1, REVERSE); endcase; eve$$x_state_array {eve$$k_windows_active} := TRUE; %if eve$x_option_decwindows %then if eve$x_decwindows_active then if eve$$x_menubar_managed then eve$$x_menubar_already_managed := TRUE; ! tested by EVE$TEARDOWN_WINDOWS else eve$$x_menubar_already_managed := FALSE; eve$manage_menu_bar; endif; endif; %endif endprocedure; ! eve$setup_windows ! EVE$WINDOWS.TPU Page 43 procedure eve$$map_window ! Map (create if needed) a window (the_window, ! the window the_buffer; ! the buffer the_top, ! screen line number of top line in window the_length, ! window length status_flag, ! status line = keyword ON or OFF the_marker, ! current position in buffer the_line, ! screen line number of current line in window hscroll_bar, ! boolean horizontal scroll bar exists hauto_thumb) ! boolean horizontal scroll bar auto-thumb exists local this_top, this_length, top_adjust, scroll_bar_widget, length_adjust; on_error [TPU$_CONTROLC]: eve$$map_window (the_window, the_buffer, the_top, the_length, status_flag, the_marker, the_line, hscroll_bar, hauto_thumb); eve$learn_abort; abort; [OTHERWISE]: endon_error; if get_info (the_window, "type") <> WINDOW then the_window := create_window (the_top, the_length, status_flag); endif; set (KEY_MAP_LIST, eve$x_mouse_list, the_window); if status_flag = ON then ! eve$set_status_line handles user status lines eve$set_status_line (the_window); else if get_info (the_window, "status_line") <> 0 then set (STATUS_LINE, the_window, NONE, ""); endif; endif; if get_info (the_window, "buffer") <> the_buffer then map (the_window, the_buffer); endif; this_top := get_info (the_window, "top", WINDOW); this_length := get_info (the_window, "length", WINDOW); top_adjust := the_top - this_top; length_adjust := the_length - this_length; if (top_adjust <> 0) or (length_adjust <> 0) then adjust_window (the_window, top_adjust, top_adjust + length_adjust); endif; ! Add the horizontal scroll bar, if any, so we can correctly calculate the ! bottom scroll margin when forcing the current position to the correct row. %if eve$x_option_decwindows %then if eve$x_decwindows_active then if hscroll_bar = TRUE then scroll_bar_widget := set (SCROLL_BAR, the_window, HORIZONTAL, ON); set (WIDGET_CALLBACK, scroll_bar_widget, "eve$scroll_dispatch", 'h'); set (WIDGET, scroll_bar_widget, eve$$x_scroll_bar_callbacks); eve$$x_scroll_bar_window (scroll_bar_widget) := the_window; if hauto_thumb = TRUE then set (SCROLL_BAR_AUTO_THUMB, the_window, HORIZONTAL, ON); endif; endif; endif; %endif ! Move to the row we were in last by squeezing scroll margins down to 1 line. if get_info (the_marker, "type") = MARKER then position (the_window); position (the_marker); if the_line <> tpu$k_unspecified then set (SCROLLING, the_window, eve$x_scrolling, the_line - 1, get_info (the_window, "length", WINDOW) - (the_line + (get_info (the_window, "status_line") <> 0) + (hscroll_bar = TRUE)), 0); endif; endif; endprocedure; ! eve$$map_window ! EVE$WINDOWS.TPU Page 44 procedure eve$$unmap_all_windows ! Remove all windows local the_window; loop exitif eve$x_number_of_windows <= 0; eve$$x_windows {eve$x_number_of_windows} := tpu$k_unspecified; eve$x_number_of_windows := eve$x_number_of_windows - 1; endloop; the_window := get_info (WINDOWS, "first"); loop exitif the_window = 0; if get_info (the_window, "buffer") <> 0 then unmap (the_window); endif; the_window := get_info (WINDOWS, "next"); endloop; endprocedure; ! eve$$unmap_all_windows ! EVE$WINDOWS.TPU Page 45 procedure eve$eve_in_control ! Test if EVE has control of interface if not eve$$x_state_array {eve$$k_windows_active} then return (FALSE); endif; return (TRUE); endprocedure; ! eve$eve_in_control ! EVE$WINDOWS.TPU Page 46 procedure eve$move_by_screen ! Next/prev screen subprocedure (how_many_screens) ! Number of screens to move - input ! Procedure to move by screen - used by eve_next_screen and eve_previous_screen ! Positive numbers move forward (like next screen), negative numbers backward. ! Returns false if an error is encountered; otherwise returns true. local how_much_scroll, ! How many lines to scroll scroll_window, ! Window to be scrolled saved_window, ! Current window saved_window_mark, ! Current window's position saved_mark, ! Position to move from (may be choices/cmd) this_column, ! Column were in now this_row, ! Current row in scroll_window new_top, ! Temporary top scroll margin new_bottom, ! Temporary bottom scroll margin saved_scrolls, ! Boolean set if saved_scroll_xxx are valid saved_scroll_top, ! Original value of scroll_top saved_scroll_bottom, ! Original value of scroll_bottom saved_scroll_amount; ! Original value of scroll_amount on_error [TPU$_CONTROLC]: eve$$restore_position (scroll_window); if (get_info (saved_mark, "type") = MARKER) and (not eve$x_bound_cursor) then ! restore the cursor position when free cursoring position (LINE_BEGIN); ! snap cursor to column 1 if mark (NONE) = end_of (current_buffer) then cursor_horizontal (get_info (saved_mark, "offset_column") - 1); else cursor_horizontal (get_info (saved_mark, "offset_column") - get_info (mark (FREE_CURSOR), "offset_column")); endif; endif; if saved_scrolls then set (SCROLLING, scroll_window, eve$x_scrolling, saved_scroll_top, saved_scroll_bottom, saved_scroll_amount); update (scroll_window); endif; if saved_window <> scroll_window then eve$$restore_position (saved_window, saved_window_mark); endif; eve$learn_abort; abort; [TPU$_BEGOFBUF, TPU$_ENDOFBUF]: ! Ignore beyond buffer errors, move to eve$move_by_screen := FALSE; ! boundary and continue. [OTHERWISE]: eve$$restore_position (scroll_window); if (get_info (saved_mark, "type") = MARKER) and (not eve$x_bound_cursor) then ! restore the cursor position when free cursoring position (LINE_BEGIN); ! snap cursor to column 1 if mark (NONE) = end_of (current_buffer) then cursor_horizontal (get_info (saved_mark, "offset_column") - 1); else cursor_horizontal (get_info (saved_mark, "offset_column") - get_info (mark (FREE_CURSOR), "offset_column")); endif; endif; if saved_scrolls then set (SCROLLING, scroll_window, eve$x_scrolling, saved_scroll_top, saved_scroll_bottom, saved_scroll_amount); update (scroll_window); endif; if saved_window <> scroll_window then eve$$restore_position (saved_window, saved_window_mark); endif; endon_error; saved_window := current_window; saved_window_mark := mark (FREE_CURSOR); eve$move_by_screen := TRUE; if saved_window = eve$command_window then if eve$$x_state_array {eve$$k_ambiguous_parse} then scroll_window := eve$choice_window; else scroll_window := eve$$x_pre_command_window; endif; position (scroll_window); else scroll_window := saved_window; endif; saved_mark := mark (FREE_CURSOR); this_column := get_info (saved_mark, "offset_column"); position (LINE_BEGIN); ! snap cursor to column 1 how_much_scroll := get_info (scroll_window, "visible_length"); !*** V2.0 Compat ! Provide an overlap of so some old text remains in the window if get_info (scroll_window, "status_line") <> "" then how_much_scroll := how_much_scroll - 3; else how_much_scroll := how_much_scroll - 2; endif; if how_much_scroll <= 0 then how_much_scroll := 1; endif; if eve$x_units = COORDINATES then how_much_scroll := how_much_scroll * get_info (CHARACTERS, "height"); endif; ! Move, keeping the cursor stationary and scrolling the text under the cursor ! (except when within scroll margin at either top or bottom of buffer, in ! which case the cursor will have to move to the scroll margin after movement). ! By using a scrolling region and move_vertical, we can move to the first or ! last line on the screen when on the first or last screen in the buffer. Also ! is much faster for scrolling a select range than using the scroll builtin. this_row := get_info (scroll_window, "current_row"); if this_row = 0 then ! Screen info is not all updated yet this_row := get_info (scroll_window, "visible_top"); !*** V2.0 Compat endif; saved_scroll_top := get_info (scroll_window, "scroll_top"); saved_scroll_bottom := get_info (scroll_window, "scroll_bottom"); saved_scroll_amount := get_info (scroll_window, "scroll_amount"); saved_scrolls := TRUE; ! for error handler ! adjust temporary scroll margins to preclude screen manager adjusting for ! scroll margins (when cursor is at top or bottom of buffer) new_top := this_row - get_info (scroll_window, "visible_top"); !*** V2.0 Compat new_bottom := get_info (scroll_window, "visible_bottom") - this_row; !*** V2.0 Compat if how_many_screens >= 0 then if new_top < saved_scroll_top then new_top := saved_scroll_top; new_bottom := new_bottom - new_top; endif; else if new_bottom < saved_scroll_bottom then new_bottom := saved_scroll_bottom; new_top := new_top - new_bottom; endif; endif; set (SCROLLING, scroll_window, eve$x_scrolling, new_top, new_bottom, 0); move_vertical (how_many_screens * how_much_scroll); ! MOVE if not eve$x_bound_cursor then ! restore the cursor position when free cursoring if mark (NONE) = end_of (current_buffer) then cursor_horizontal (this_column - 1); else cursor_horizontal (this_column - get_info (mark (FREE_CURSOR), "offset_column")); endif; endif; ! *** Someday we should not have to force a screen update *** update (scroll_window); set (SCROLLING, scroll_window, eve$x_scrolling, saved_scroll_top, saved_scroll_bottom, saved_scroll_amount); if saved_window <> scroll_window then eve$$restore_position (saved_window, saved_window_mark); endif; endprocedure; ! eve$move_by_screen ! EVE$WINDOWS.TPU Page 47 procedure eve$map_choices ! Display the choice buffer ! Procedure to map the choice buffer and set its status line local number_choices, scroll_bar_widget, too_narrow, too_many; on_error [OTHERWISE]: endon_error; if get_info (eve$choice_window, "buffer") = 0 then map (eve$choice_window, eve$choice_buffer); else position (eve$choice_window); endif; if get_info (current_window, "width") < eve$$x_choices_column_width then too_narrow := TRUE; ! need a DECwindows horizontal scroll bar endif; number_choices := get_info (eve$choice_buffer, "record_count"); %if eve$x_option_decwindows %then if eve$x_decwindows_active then if number_choices >= eve$x_choice_window_length - (too_narrow = TRUE) ! for the horizontal scroll_bar then too_many := TRUE; endif; else if number_choices >= eve$x_choice_window_length then too_many := TRUE; endif; endif; %else if number_choices >= eve$x_choice_window_length then too_many := TRUE; endif; %endif if too_many then %if eve$x_option_decwindows %then if eve$x_decwindows_active then if too_narrow then eve$$set_scroll_bars (eve$choice_window);! horiz + vertical else ! sync the following with eve$$set_scroll_bars scroll_bar_widget := set (SCROLL_BAR, eve$choice_window, VERTICAL, ON); set (SCROLL_BAR_AUTO_THUMB, eve$choice_window, VERTICAL, ON); set (WIDGET_CALLBACK, scroll_bar_widget, "eve$scroll_dispatch", 'v'); set (WIDGET, scroll_bar_widget, eve$$x_scroll_bar_callbacks); eve$$x_scroll_bar_window {scroll_bar_widget} := eve$choice_window; endif; endif; %endif else %if eve$x_option_decwindows %then if eve$x_decwindows_active then if too_narrow then ! sync the following with eve$$set_scroll_bars scroll_bar_widget := set (SCROLL_BAR, eve$choice_window, HORIZONTAL, ON); set (SCROLL_BAR_AUTO_THUMB, eve$choice_window, HORIZONTAL, ON); set (WIDGET_CALLBACK, scroll_bar_widget, "eve$scroll_dispatch", 'h'); set (WIDGET, scroll_bar_widget, eve$$x_scroll_bar_callbacks); eve$$x_scroll_bar_window {scroll_bar_widget} := eve$choice_window; endif; endif; %endif endif; eve$set_status_line (eve$choice_window); update (eve$choice_window); endprocedure; ! eve$map_choices ! EVE$WINDOWS.TPU Page 48 procedure eve$get_screen_height ! Return screen height local screen_length; %if eve$x_option_decwindows %then if eve$x_decwindows_active then ! for use during DECwindows resize screen_length := get_info (SCREEN, "new_length"); else screen_length := get_info (SCREEN, "visible_length");!*** V2.0 COMPAT endif; %else screen_length := get_info (SCREEN, "visible_length"); !*** V2.0 Compat %endif return (screen_length); endprocedure; ! eve$get_screen_height ! EVE$WINDOWS.TPU Page 49 procedure eve_refresh ! Refresh all windows ! Refresh screen and clear message window eve$clear_message; ! clear message window without deleting messages refresh; return (TRUE); endprocedure; ! eve_refresh ! EVE$WINDOWS.TPU Page 50 procedure eve_set_width ! Set width of all windows to 80/132 (set_parameter) ! Number of columns per line - input ! Set width for all windows local new_width, ! Local copy of set parameter actual_width; ! Width actually set on_error [OTHERWISE]: endon_error; if not (eve$prompt_number (set_parameter, new_width, message_text (EVE$_WIDTHPROMPT, 1), message_text (EVE$_WIDNOTCHNG, 0))) then eve$learn_abort; return (FALSE); endif; if new_width <= 0 then eve$message (EVE$_CANTSETWID, 0, new_width); eve$learn_abort; return (FALSE); endif; actual_width := eve$set_width (new_width); if actual_width <> 0 then eve$message (EVE$_WIDSETTO, 0, actual_width); return (TRUE); else eve$message (EVE$_CANTSETWID, 0, new_width); return (FALSE); endif; endprocedure; ! eve_set_width ! EVE$WINDOWS.TPU Page 51 procedure eve$set_width ! SET WIDTH subprocedure (new_width) local loop_window, ! Window currently being checked in loop last_window; ! Last DECTPU window on_error [OTHERWISE]: endon_error; if get_info (eve$$x_ruler_window, "type") = WINDOW then if get_info (eve$$x_ruler_window, "buffer") <> 0 then eve$$exit_ruler; endif; endif; last_window := get_info (WINDOWS, "last"); loop_window := get_info (WINDOWS, "first"); loop set (WIDTH, loop_window, new_width); exitif loop_window = last_window; loop_window := get_info (WINDOWS, "next"); endloop; ! Change default buffer's right margin so newly created buffers follow suit if get_info (eve$default_buffer, "type") = BUFFER then set (RIGHT_MARGIN, eve$default_buffer, new_width - eve$x_default_right_margin); endif; eve$update_all_status_lines; return (get_info (last_window, "width")); endprocedure; ! eve$set_width ! EVE$WINDOWS.TPU Page 52 procedure eve$$show_window_status ! Show buffer/window status line local temp, the_width; if get_info (tpu$x_show_window, "type") = WINDOW then if get_info (tpu$x_show_window, "buffer") = tpu$x_show_buffer then temp := message_text (EVE$_SYSSTATUS, 1, get_info (tpu$x_show_buffer, "name")); the_width := get_info (tpu$x_show_window, "width") - (length (temp) + length (eve$$x_show_window_caption)); if the_width > 0 then temp := temp + (" " * the_width) + eve$$x_show_window_caption; endif; return (temp); endif; endif; return (""); endprocedure; ! eve$$show_window_status ! EVE$WINDOWS.TPU Page 53 procedure eve$$sys_window_status ! Create system window status line local left_side, ! The "Buffer: " part right_side, ! The next/prev screen indicators the_width; ! Unused width in the status line left_side := eve$buffer_name_field (current_buffer); right_side := ""; the_width := get_info (current_window, "width") - (length (left_side) + 1); if get_info (current_buffer, "record_count") > get_info (current_window, "length", TEXT) then if eve$on_a_pre_lk201 then right_side := message_text (EVE$_UPDOWNMORE); else right_side := fao (eve$$x_extra_field_format, message_text (EVE$_PREVEVESCREEN)) + fao (eve$$x_extra_field_format, message_text (EVE$_NEXTSCREEN)); endif; the_width := the_width - length (right_side); if the_width < 0 then right_side := ""; else the_width := the_width - length (eve$$x_sys_window_caption); if the_width > 0 then right_side := eve$$x_sys_window_caption + right_side; endif; endif; endif; if the_width < 0 then the_width := 0; endif; return (left_side + (" " * the_width) + right_side); endprocedure; ! eve$$sys_window_status ! EVE$WINDOWS.TPU Page 54 procedure eve_set_scroll_on ! Turn scrolling on on_error [OTHERWISE]: endon_error; eve$x_scrolling := ON; eve$set_all_windows (SCROLLING, eve$x_scroll_top, eve$x_scroll_bottom); eve$define_attr ("eve_set_scroll_on", "eve_set_scroll_on;", message_text (EVE$_SCROLLING, tpu$k_message_text)); eve$message (EVE$_SCROLLING); return (TRUE); endprocedure; ! eve_set_scroll_on procedure eve_set_scroll_off ! Turn off scrolling on_error [OTHERWISE]: endon_error; eve$x_scrolling := OFF; eve$set_all_windows (SCROLLING, eve$x_scroll_top, eve$x_scroll_bottom); eve$define_attr ("eve_set_scroll_on", "eve_set_scroll_off;", message_text (EVE$_NOSCROLLING, tpu$k_message_text)); eve$message (EVE$_NOSCROLLING); return (TRUE); endprocedure; ! eve_set_scroll_off ! EVE$WINDOWS.TPU Page 55 procedure eve_set_scroll_smooth ! Set smooth scrolling on_error [OTHERWISE]: endon_error; eve$x_jump := SMOOTH; set (SCROLLING, SMOOTH); eve$define_attr ("eve_set_scroll_smooth", "eve_set_scroll_smooth;", message_text (EVE$_SMOOTHSCROLL, tpu$k_message_text)); eve$message (EVE$_SMOOTHSCROLL); return (TRUE); endprocedure; ! eve_set_scroll_smooth procedure eve_set_scroll_jump ! Set jump scrolling on_error [OTHERWISE]: endon_error; eve$x_jump := JUMP; set (SCROLLING, JUMP); eve$define_attr ("eve_set_scroll_smooth", "eve_set_scroll_jump;", message_text (EVE$_JUMPSCROLL, tpu$k_message_text)); eve$message (EVE$_JUMPSCROLL); return (TRUE); endprocedure; ! eve_set_scroll_jump ! EVE$WINDOWS.TPU Page 56 ! Module initialization code local screen_length; ! screen length on_error [OTHERWISE]: eve$$x_state_array {eve$$k_windows_active} := FALSE; endon_error; eve$x_top_margin_adjust := 0; eve$x_bottom_margin_adjust := 0; eve$$x_extra_field_format := message_text (EVE$_STATUSFIELD, 1); eve$$x_extra_field_format_length := length (fao (eve$$x_extra_field_format, "")); eve$x_unmodifiable := message_text (EVE$_UNMODIFIABLE, 1); eve$x_modifiable := message_text (EVE$_MODIFIABLE, 1); eve$arg1_split_window := "integer"; eve$arg1_enlarge_window := "integer"; eve$arg1_shrink_window := "integer"; eve$x_scroll_top := 0; ! % top scroll margin eve$x_scroll_bottom := 0; ! % bottom scroll margin ! SET SCROLL ON/OFF/JUMP/SMOOTH variables eve$x_scrolling := ON; eve$x_jump := SMOOTH; ! Create all the necessary default windows screen_length := get_info (SCREEN, "visible_length"); !*** V2.0 Compat eve$main_window_length := screen_length - eve$$x_message_window_size - eve$$x_command_window_size; eve$$x_state_array {eve$$k_windows_active} := FALSE; eve$$x_windows := create_array (10); eve$$x_windows {1} := create_window (1, eve$main_window_length, ON); %if eve$x_option_decwindows %then eve$$set_scroll_bars (eve$$x_windows {1}); %endif eve$x_number_of_windows := 1; set (KEY_MAP_LIST, eve$x_mouse_list, eve$$x_windows {1}); ! Create the info window (used for HELP and SHOW) using the same size as ! the main window if get_info (tpu$x_show_window, "type") <> WINDOW then tpu$x_show_window := create_window (1, eve$main_window_length, ON); endif; %if eve$x_option_decwindows %then eve$$set_scroll_bars (tpu$x_show_window); %endif set (KEY_MAP_LIST, eve$x_mouse_list, tpu$x_show_window); eve$$x_show_window_caption := ""; eve$$x_sys_window_caption := message_text (EVE$_SYSTEMCAPTION, tpu$k_message_text); eve$$x_state_array {eve$$k_windows_active} := TRUE; ! FALSE after EVE$TEARDOWN_WINDOWS or /NODISPLAY eve$$x_menubar_already_managed := FALSE; ! Set TRUE by EVE$SETUP_WINDOWS if already ! managed, set false by EVE$TEARDOWN_WINDOWS ! which doesn't unmanage the menu_bar if TRUE. ! Define attributes eve$define_attr ("eve_set_scroll_on", "eve_set_scroll_on;", message_text (EVE$_SCROLLING, tpu$k_message_text)); eve$define_attr ("eve_set_scroll_smooth", "eve_set_scroll_smooth;", message_text (EVE$_SMOOTHSCROLL, tpu$k_message_text)); endmodule; ! EVE$WINDOWS.TPU Page 57 ! ! Global constant and variable declarations ! variable eve$choice_buffer; variable eve$x_forward; variable eve$x_reverse; variable eve$x_insert; variable eve$x_overstrike; ! ! EVE$BUILD time executable code ! ! The minimal EVE editor requires EVE$WINDOWS.TPU plus the following modules. ! Some are commented out because eve$$require doesn't work for modules ! positioned after this one in EVE$MASTER.FILE. Forward procedure references ! to those modules are allowed. eve$$require ("eve$terminals"); ! Build dependency !eve$$require ("eve$file"); !eve$$require ("eve$core");