!++ ! ! MODULE: WPS_PLUS_EXTENSIONS ! ! SOURCE CODE FILE: ARC_SOURCE:[MENUSYS]WPSPLUS.TPU ! ! VERSION: 1-001 ! ! FACILITY: Financial Managemen Menu System ! ! ABSTRACT: Defines extensions to the DEC supplied ! WPS/Plus emulator, built on EVE. ! ! ENVIRONMENT: User Mode, AST Reentrant ! ! AUTHOR: Don Stevens-Rayburn ! ! COPYRIGHT: Applied Research Corporation ! ! CREATION DATE: 13--Mar-1989 ! ! MODIFICATION HISTORY: ! ! FUNCTIONAL DESCRIPTION: ! ! Defines the following TPU procedures: ! ! wps_underline inserts the QMS ^D underline codes at each ! end of the select range. This procedure is ! bound to KP9. ! ! wps_bold inserts the QMS ^F bold codes at each end of ! the select range. This procedure is bound to KP6. ! ! wps_italic inserts the QMS ^V italic codes at each end ! of the select range. This procedure is bound to ! GOLD/KP9. ! ! wps_subscript inserts the QMS ^B partial line down code at ! the beginning of the select range and the ^A ! partial line up code at the end. Bound to GOLD/A. ! ! wps_superscript inserts the QMS ^A partial line up code at the ! beginning of the select range and the ^B partial ! line down code at the end. Bound to GOLD/Q. ! ! reveal_codes copies the current buffer into a temporary buffer. ! It then searches for all occurrences of QMSPRINT ! control codes and replaces them with mnemonics; ! thus implementing the WordPerfect style "Reveal ! Codes". This procedure is adapted from the example ! procedure "view_controls" on page A-3 of the VAX ! Text Processing Utility Manual. Bound to GOLD/KP6. ! ! translate_control performs the actual translation for a WordPerfect ! style "Reveal Codes". This procedure is adapted ! from the example procedure on page A-2 of the VAX ! Text Processing Utility Manual. This procedure is ! not bound to any key; it is called by reveal_codes. ! ! wps_where_am_i determines the page number and line number within ! the page that contains the cursor and displays them ! on the message line. Bound to GOLD/L. ! ! wps_line_number returns the line number in the current buffer that ! contains the editing point. This routine is adapted ! from the routine "eve_what_line" found in ! SYS$EXAMPLES:EVE$EDIT.TPU. This procedure is not ! bound to any key; it is called by wps_where_am_i. ! ! CALLING SEQUENCE: ! ! 1. As a TPU command file: ! ! $ EDIT/TPU/COMMAND=FMN_SOURCE:WPSPLUS.TPU file-spec ! ! 2. As a TPU section file: ! ! $ EDIT/TPU/SECTION=section-file-spec file-spec ! ! BUILDING THE SECTION FILE: ! ! To build a section file from this command file, execute the ! following commands: ! ! $ EDIT/TPU/COMMAND=FMN_SOURCE:WPSPLUS.TPU ! ! When TPU has begun, press the key. At the command prompt, ! enter the command: ! ! Command: SAVE EXTENDED TPU section-file-spec. ! !-- PROCEDURE wps_underline !++ ! ! Inserts the QMS ^D underline codes at each end of the select range. ! !-- LOCAL marker1, marker2, lower_range; ON_ERROR [OTHERWISE]: ENDON_ERROR; eve$wps_set_direction (FORWARD); lower_range := eve$selection (1); IF lower_range <> 0 THEN marker1 := BEGINNING_OF ( lower_range ); marker2 := END_OF ( lower_range ); POSITION ( marker1 ); COPY_TEXT ( ASCII ( 4 ) ); POSITION ( marker2 ); MOVE_HORIZONTAL ( 1 ); COPY_TEXT ( ASCII ( 4 ) ); lower_range := 0; ENDIF; eve$clear_message; RETURN (1); ENDPROCEDURE PROCEDURE wps_bold !++ ! ! Inserts the QMS ^F bold codes at each end of the select range. ! !-- LOCAL marker1, marker2, lower_range; ON_ERROR [OTHERWISE]: ENDON_ERROR; eve$wps_set_direction (FORWARD); lower_range := eve$selection (1); IF lower_range <> 0 THEN marker1 := BEGINNING_OF ( lower_range ); marker2 := END_OF ( lower_range ); POSITION ( marker1 ); COPY_TEXT ( ASCII ( 6 ) ); POSITION ( marker2 ); MOVE_HORIZONTAL ( 1 ); COPY_TEXT ( ASCII ( 6 ) ); lower_range := 0; ENDIF; eve$clear_message; RETURN (1); ENDPROCEDURE PROCEDURE wps_italic !++ ! ! Inserts the QMS ^V italic codes at each end of the select range. ! !-- LOCAL marker1, marker2, lower_range; ON_ERROR [OTHERWISE]: ENDON_ERROR; eve$wps_set_direction (FORWARD); lower_range := eve$selection (1); IF lower_range <> 0 THEN marker1 := BEGINNING_OF ( lower_range ); marker2 := END_OF ( lower_range ); POSITION ( marker1 ); COPY_TEXT ( ASCII ( 22 ) ); POSITION ( marker2 ); MOVE_HORIZONTAL ( 1 ); COPY_TEXT ( ASCII ( 22 ) ); lower_range := 0; ENDIF; eve$clear_message; RETURN (1); ENDPROCEDURE PROCEDURE wps_subscript !++ ! ! Inserts the QMS ^B partial line down code at the beginning of the ! select range and the ^A partial line up at the end. ! !-- LOCAL marker1, marker2, lower_range; ON_ERROR [OTHERWISE]: ENDON_ERROR; eve$wps_set_direction (FORWARD); lower_range := eve$selection (1); IF lower_range <> 0 THEN marker1 := BEGINNING_OF ( lower_range ); marker2 := END_OF ( lower_range ); POSITION ( marker1 ); COPY_TEXT ( ASCII ( 2 ) ); POSITION ( marker2 ); MOVE_HORIZONTAL ( 1 ); COPY_TEXT ( ASCII ( 1 ) ); lower_range := 0; ENDIF; eve$clear_message; RETURN (1); ENDPROCEDURE PROCEDURE wps_superscript !++ ! ! Inserts the QMS ^A partial line up code at the beginning of the ! select range and the ^B partial line down at the end. ! !-- LOCAL marker1, marker2, lower_range; ON_ERROR [OTHERWISE]: ENDON_ERROR; eve$wps_set_direction (FORWARD); lower_range := eve$selection (1); IF lower_range <> 0 THEN marker1 := BEGINNING_OF ( lower_range ); marker2 := END_OF ( lower_range ); POSITION ( marker1 ); COPY_TEXT ( ASCII ( 1 ) ); POSITION ( marker2 ); MOVE_HORIZONTAL ( 1 ); COPY_TEXT ( ASCII ( 2 ) ); lower_range := 0; ENDIF; eve$clear_message; RETURN (1); ENDPROCEDURE PROCEDURE reveal_codes !++ ! ! Copies the current buffer into a temporary buffer. It then searches ! for all occurrences of QMSPRINT control codes and replaces them with ! mnemonics; thus implementing the WordPerfect style "Reveal Codes". ! This procedure is adapted from the example procedure "view_controls" ! on page A-3 of the VAX Text Processing Utility Manual. ! !-- CONSTANT ctrl_char_str := ASCII ( 1) + ASCII ( 2) + ASCII ( 4) + ASCII ( 6) + ASCII (22); LOCAL current_line_number, ctrl_char_pattern, ctrl_char_range; old_buffer := CURRENT_BUFFER; IF translate_buffer = TPU$K_UNSPECIFIED THEN translate_buffer := CREATE_BUFFER ( "translation" ); SET (NO_WRITE, translate_buffer ); translate_window := CREATE_WINDOW (1, 11, OFF); SET (STATUS_LINE, translate_window, REVERSE, "Press GOLD/KP6 again to return to the edit buffer."); ENDIF; IF old_buffer = translate_buffer ! Implements a "toggle". THEN SET (MODIFIABLE, translate_buffer, ON); ERASE (translate_buffer); UNMAP (translate_window); RETURN 1; ENDIF; current_line_number := wps_line_number; POSITION ( BEGINNING_OF (translate_buffer)); COPY_TEXT ( old_buffer); POSITION ( BEGINNING_OF (translate_buffer)); ctrl_char_pattern := ANY ( ctrl_char_str ); LOOP ctrl_char_range := SEARCH_QUIETLY (ctrl_char_pattern, FORWARD); EXITIF ctrl_char_range = 0; POSITION (ctrl_char_range); IF NOT translate_controls (ctrl_char_range) THEN MOVE_HORIZONTAL (1); ENDIF; ENDLOOP; SET (MODIFIABLE, translate_buffer, OFF); POSITION ( BEGINNING_OF (translate_buffer)); MAP (translate_window, translate_buffer); IF current_line_number > 1 THEN MOVE_VERTICAL ( current_line_number - 1 ); ENDIF; RETURN 1; ENDPROCEDURE; PROCEDURE translate_controls ( char_range ) !++ ! ! Performs the actual translation for a WordPerfect style "Reveal Codes". ! This procedure is adapted from the example procedure on page A-2 of the ! VAX Text Processing Utility Manual. ! !-- LOCAL replace_text; IF translate_array = TPU$K_UNSPECIFIED THEN translate_array := CREATE_ARRAY ( 32, 0 ); translate_array { 1 } := '{PLU}'; translate_array { 2 } := '{PLD}'; translate_array { 4 } := '{Under}'; translate_array { 6 } := '{Bold}'; translate_array { 22 } := '{Ital}'; ENDIF; IF LENGTH ( char_range ) <> 1 THEN RETURN 0; ENDIF; replace_text := translate_array {ASCII ( STR (char_range) )}; IF replace_text = TPU$K_UNSPECIFIED THEN RETURN 0; ENDIF; ERASE (char_range); COPY_TEXT (replace_text); RETURN 1; ENDPROCEDURE PROCEDURE wps_where_am_i !++ ! ! Determines the page number and line number within the page that ! contains the cursor and displays them on the message line. ! !-- LOCAL page_number, ! Integer - current page number. line_num, ! Integer - current line number. page_line_num, ! Integer - line number at top of current page. page_break_range, ! Range - contains the previous form feed. text_mark, ! Marker - after snapping to text. saved_mark; ! Marker - current position. ON_ERROR [TPU$_CONTROLC]: eve$$restore_position (saved_mark); eve$learn_abort; abort; [OTHERWISE]: eve$$restore_position (saved_mark); ENDON_ERROR; ! Initialization saved_mark := MARK (FREE_CURSOR); POSITION (SEARCH (ANCHOR, FORWARD)); ! snap the cursor (move_vertical pads) text_mark := MARK (NONE); line_num := wps_line_number; page_number := 1; page_break_range := SEARCH_QUIETLY (PAGE_BREAK, REVERSE); IF page_break_range = 0 THEN page_line_num := 1; line_num := line_num - page_line_num + 1; ELSE IF BEGINNING_OF (page_break_range) = BEGINNING_OF (CURRENT_BUFFER) THEN page_number := 1; ELSE POSITION (BEGINNING_OF (page_break_range)); page_line_num := wps_line_number; line_num := line_num - page_line_num + 1; ENDIF; ENDIF; LOOP EXITIF page_break_range = 0; EXITIF BEGINNING_OF (page_break_range) = BEGINNING_OF (CURRENT_BUFFER); POSITION (BEGINNING_OF (page_break_range)); MOVE_HORIZONTAL (-1); page_number := page_number + 1; page_break_range := SEARCH_QUIETLY (PAGE_BREAK, REVERSE); ENDLOOP; POSITION( saved_mark); MESSAGE( "You are at line !SL on page !SL.", 0, line_num, page_number); ENDPROCEDURE PROCEDURE wps_line_number !++ ! ! Returns the line number, measured from the top of the buffer, in the ! current buffer that contains the editing point. This routine is adapted ! from the routine eve_what_line found in SYS$EXAMPLES:EVE$EDIT.TPU. ! !-- LOCAL saved_mark, ! Marker - at current position. text_mark, ! Marker - after snapping to text. this_line_position, ! Marker - at start of this line. total_lines, ! Integer - total lines in buffer. high_line, ! Integer - high line limit for binary search. low_line, ! Integer - low line limit for binary search. this_line, ! Integer - line number of current guess. low_position; ! Marker - beginning of low line. ON_ERROR [TPU$_CONTROLC]: eve$$restore_position (saved_mark); ! restore free cursor position eve$learn_abort; abort; [OTHERWISE]: eve$$restore_position (saved_mark); ENDON_ERROR; ! Initialization saved_mark := MARK (FREE_CURSOR); POSITION (SEARCH (ANCHOR, FORWARD)); ! snap the cursor (move_vertical pads) text_mark := MARK (NONE); total_lines := GET_INFO (CURRENT_BUFFER, "record_count"); IF total_lines = 0 THEN POSITION (saved_mark); RETURN (0); ENDIF; high_line := total_lines + 1; IF text_mark = END_OF (CURRENT_BUFFER) THEN POSITION (saved_mark); RETURN (total_lines); ENDIF; IF text_mark = BEGINNING_OF (CURRENT_BUFFER) THEN POSITION (saved_mark); RETURN (0); ENDIF; low_line := 1; low_position := beginning_of (current_buffer); ! Binary search LOOP EXITIF high_line - low_line <= 1; this_line := (high_line + low_line) / 2; POSITION (low_position); MOVE_VERTICAL (this_line - low_line); if MARK (FREE_CURSOR) > saved_mark THEN high_line := this_line; ELSE low_line := this_line; low_position := MARK (FREE_CURSOR); IF MARK (FREE_CURSOR) = saved_mark THEN high_line := this_line; ENDIF; ENDIF; ENDLOOP; POSITION (saved_mark); RETURN (low_line); ENDPROCEDURE; !++ ! ! Bind procedure definitions to keys. ! !-- DEFINE_KEY ( "wps_underline", KEY_NAME ( KP9 ), "under_line" ); DEFINE_KEY ( "wps_bold", KEY_NAME ( KP6 ), "bold" ); DEFINE_KEY ( "wps_italic", KEY_NAME ( KP9, SHIFT_KEY ), "italic" ); DEFINE_KEY ( "wps_subscript", KEY_NAME ( "A", SHIFT_KEY ), "subscript" ); DEFINE_KEY ( "wps_superscript", KEY_NAME ( "Q", SHIFT_KEY ), "superscript" ); DEFINE_KEY ( "reveal_codes", KEY_NAME ( KP6, SHIFT_KEY ), "reveal_codes" ); DEFINE_KEY ( "wps_where_am_i", KEY_NAME ( "L", SHIFT_KEY ), "where_am_i" );