Power-Programmierung/CD1.mdf/clarion/library/memoed/memoedit.cla

Text File | 1992-03-21 | 11.0 KB | 293 lines

!═════════════════════════════════════════════════════════════════════════
!
!  %%keyword%% '%n'
!  'MEMOEDIT.CLA' - Clarion Memo Field Editor
!
!  %%keyword%% '%v'
!  Revision Number: '5'
!  %%keyword%% '%d'
!  Revision Date  : '21-Mar-92'
!
!  Copyright : Bobcat Systems (c) 1992
!  Author    : Robert J. Pupazzoni
!           CIS:[70441,204]
!
!  Compiler  : Clarion Professional Developer v.2.1, Batch 2105
!
!
!  BACKGROUND
!
!    In the course of developing a Clarion vertical market application, I
!    had a requirement for basic word processing functions in memo fields.
!
!    I tried Eckenroed & Associates's MEMO3, but was disappointed by its
!    large RAM requirements (30K minimum) and its inflexibility with regards
!    to keystroke handling and customization.  These lmitations made it
!    unacceptable for my application.
!
!    There were no other products that seemed to fit the bill, so I wrote
!    one.  MEMOEDIT is the result.
!
!
!  FEATURES
!
!    This module replaces the standard Clarion memo field editor, and adds the
!    following features:
!
!       Dynamic word wrapping and paragraph reformatting
!
!       Block operations: Copy, Move, Delete
!
!       Written entirely in Clarion - can be overlayed.
!
!       All source is provided - you can selectively add/remove features
!
!
!  REVISION HISTORY
!
!    1.00 - Initial release
!
!    1.01 - Fixed the following bugs:
!          1. Delete to EOL would leave an extra space in line
!          2. Filling a memo line with unbroken sequence of characters
!         would cause word wrap to hang
!          3. Exceeding the memo buffer line limit would result in
!         a 'Subscript out of Range' error.
!
!    1.10 - Major overhauls:
!          1. Converted most routines to procs/funcs
!          2. Modifications to support Designer apps
!          3. Added support for 'hard' carriage return codes
!         (Codes compatible with Eckenroed's MEMO3)
!
!    1.15 - Fixed the following bugs:
!             1. Insert/Overwrite would always Insert regardless
!             2. Typing a space on last column of last line did not
!                Move cursor correctly.
!
!═════════════════════════════════════════════════════════════════════════

         MEMBER()

!═════════════════════════════════════════════════════════════════════════
!               Edit a memo field
!═════════════════════════════════════════════════════════════════════════
Edit_Memo    PROCEDURE( xMemo )

         ! Parameters:
xMemo         EXTERNAL,DIM(1)             ! Memo field array

         ! Locals:
tTable         TABLE,PRE(TAB)             ! Edit buffer
           STRING(255)             !
         .                     !

tHold         TABLE,PRE(HLD)             ! Hold area for block ops.
           STRING(255)             !
         .                     !

ilRowTop     LONG                 ! Top row table index
ibRow         BYTE                 ! Cursor row
ibCol         BYTE                 ! Cursor column

isKeystroke  SHORT                 ! Last keystroke typed

bbInsertMode BYTE                 ! Insert mode flag

sTemp         STRING(255)             ! Temporary line buffer

ilTblNdx     LONG                 ! Edit table index
ilHoldNdx    LONG                 ! Hold table index
ilMemoNdx    LONG                 ! Memo array index

  CODE
  bbInsertMode = 1                 ! Set Insert mode ON
  ibRow           = 1                 ! Start on first row
  ibCol           = 1                 ! Start in first column

  MED:bbModified  = 0                 ! Clear modified flag
  MED:bbShowCodes = 0                 ! Hide format codes

  MED:bbMarking       = 0                 ! Marking mode is OFF
  MED:ilMarkBegRow = 0                 !
  MED:ibMarkBegCol = 0                 !
  MED:ilMarkEndRow = 0                 !
  MED:ibMarkEndCol = 0                 !

  MED:ilMemoRows = MAXIMUM(xMemo[], 1)         ! Set memo size
  MED:ibWrapCol     = MED:ibCols - 1         ! and word wrap column

  HELP( , eHelpID)                 ! Set help window

  DO LoadMemo                     ! Load memo into edit buffer
  First_Page(tTable, ilRowTop, ibRow)         ! Display first page
  DO EditLoop                     ! Edit the memo
  DO SaveMemo                     ! Save edit buffer to memo

  HELP(, '')                     ! Deactivate help window
  SETCURSOR                     ! Turn offf cursor
  FREE(tTable)                     ! Clean up
  FREE(tHold)                     !
  RETURN                     !

!──────────────────────────────────────────────────────────────────────────
EditLoop     ROUTINE      ! Main edit loop
!──────────────────────────────────────────────────────────────────────────
  LOOP                         ! Loop
                         !   Set cursor position
    SETCURSOR(MED:ibRowOfs+ibRow,MED:ibColOfs+ibCol)
    Cursor_Size( bbInsertMode )             !   Set cursor size
    ASK                         !   Wait for keystroke
    isKeystroke = KEYCODE()             !   Save it

    GET(tTable, ilRowTop+ibRow)             !   Get current line

    CASE isKeystroke                 !   Process keystroke
      OF Esc_Key;    BREAK             !
      OF F1_Key;     HELP             !

      OF Left_Key;   Move_Left(ibCol)         !   Horizontal movement
      OF Right_Key;  Move_Right(ibCol)         !
      OF Ctrl_Left;  Move_WLeft(tTable, ibCol)     !
      OF Ctrl_Right; Move_WRight(tTable, ibCol)     !
      OF Tab_Key;    Tab_Right(ibCol)         !
      OF Home_Key;   Move_BOL(ibCol)         !
      OF End_Key;    Move_EOL(tTable, ibCol)     !

                         !   Vertical movement
      OF Up_Key;     Move_Up(tTable, ilRowTop, ibRow)
      OF Down_Key;   Move_Down(tTable, ilRowTop, ibRow)
      OF PgUp_Key;   Page_Up(tTable, ilRowTop, ibRow)
      OF PgDn_Key;   Page_Down(tTable, ilRowTop, ibRow)
      OF Ctrl_PgUp;  First_Page(tTable, ilRowTop, ibRow)
      OF Ctrl_PgDn;  Last_Page(tTable, ilRowTop, ibRow)

      OF Enter_Key;  DO Newline             !   Insertion/deletion
      OF Ins_Key;    DO Toggle_Ins         !
      OF Del_Key;    DO Delete_Char         !
      OF BS_Key;     DO Backspace         !
      OF Ctrl_End;   DO Delete_EOL         !

                         !   Block operations
      OF Alt_K;         Block_Mark(ilRowTop+ibRow, ibCol)
      OF Alt_D;         Block_Delete(tTable, ilRowTop, ibRow, ibCol)
      OF Alt_Y;         Block_Copy(tHold, tTable, ilRowTop, ibRow, ibCol)
      OF Alt_M;         Block_Move(tHold, tTable, ilRowTop, ibRow, ibCol)

      OF Alt_C;         DO Toggle_Codes         !   Special keys
      OF F4_Key;     DO Today             !

    ELSE                     !   Else
      IF ALERTED(isKeystroke) THEN BREAK.     !     Return on alerted key
      IF INRANGE(isKeystroke, 32, 255)         !     If it's a printable char
    DO Insert_Char                 !     Insert it
      ELSE                     !     Else
    BEEP                     !     Garbage
    . .                         !   End case

    GET(tTable, ilRowTop+ibRow)             !   Get current line
    ibCol = Fix_Column(tTable, ibCol)         !   Adjust cursor column

    IF MED:bbMarking                 !   If marking a block
      MED:ilMarkEndRow = ilRowTop + ibRow     !     Update block end row
      MED:ibMarkEndCol = ibCol             !     Update block end column
      Show_Page(tTable, ilRowTop, 1, MED:ibRows) ! Update marking on screen
  . .                         ! End loop


!
!             Text Insertion Routines
!

!──────────────────────────────────────────────────────────────────────────
Toggle_Ins   ROUTINE      ! Toggle insert/overwrite mode
!──────────────────────────────────────────────────────────────────────────
  bbInsertMode = BXOR(bbInsertMode, 1)         ! Toggle insert flag

!──────────────────────────────────────────────────────────────────────────
Insert_Char  ROUTINE      ! Insert a character
!──────────────────────────────────────────────────────────────────────────
  MED:bbModified = 1                 ! Set modified flag
  Insert_Text(tTable, ilRowTop, ibRow, ibCol, CHR(isKeystroke), bbInsertMode)

!──────────────────────────────────────────────────────────────────────────
Today         ROUTINE      ! Insert today's date
!──────────────────────────────────────────────────────────────────────────
  MED:bbModified = 1                 ! Set modified flag
  Insert_Text(tTable, ilRowTop, ibRow, ibCol, FORMAT(TODAY(), @D1))

!──────────────────────────────────────────────────────────────────────────
NewLine         ROUTINE      ! Process the Enter key
!──────────────────────────────────────────────────────────────────────────
  MED:bbModified = 1                 ! Set modified flag
  IF bbInsertMode                 ! If insert mode
    Insert_HCR(tTable, ilRowTop, ibRow, ibCol)     !   Insert a hard CR code
  .                         ! Endif
  Move_BOL(ibCol)                 ! Move to BOL
  Move_Down(tTable, ilRowTop, ibRow)         ! Move down


!
!             Text Deletion Routines
!

!──────────────────────────────────────────────────────────────────────────
Delete_Char  ROUTINE      ! Delete character under cursor
!──────────────────────────────────────────────────────────────────────────
  MED:bbModified = 1                 ! Set modified flag
  Delete_Char(tTable, ilRowTop, ibRow, ibCol)     !

!──────────────────────────────────────────────────────────────────────────
Backspace    ROUTINE      ! Delete character before cursor
!──────────────────────────────────────────────────────────────────────────
  IF ibCol = 1 THEN EXIT.             ! Quit if at BOL
  MED:bbModified = 1                 ! Set modified flag
  ibCol -= 1                     ! Move left one column
  Delete_Char(tTable, ilRowTop, ibRow, ibCol)     !

!──────────────────────────────────────────────────────────────────────────
Delete_EOL   ROUTINE      ! Delete to end-of-line
!──────────────────────────────────────────────────────────────────────────
  MED:bbModified = 1                 ! Set modified flag
  Delete_EOL(tTable, ilRowTop, ibRow, ibCol)     !


!
!               Display Routines
!

!──────────────────────────────────────────────────────────────────────────
Toggle_Codes ROUTINE      ! Toggle display of formatting codes
!──────────────────────────────────────────────────────────────────────────
  MED:bbShowCodes = BXOR(MED:bbShowCodes,1)     ! Toggle flag
  Show_Page(tTable, ilRowTop, 1, MED:ibRows)     ! Redisplay page


!
!            Memo Read/Write Routines
!

!──────────────────────────────────────────────────────────────────────────
LoadMemo     ROUTINE      ! Load memo field into edit table
!──────────────────────────────────────────────────────────────────────────
  FREE(tTable)                     ! Clear edit buffer
  LOOP ilMemoNdx = MED:ilMemoRows TO 2 BY -1     ! Loop back thru each line
    IF xMemo[ilMemoNdx] THEN BREAK.         !   Find last non-blank line
  .                         ! End loop
  LOOP ilTblNdx = 1 TO ilMemoNdx         ! Loop for each line
    tTable = xMemo[ilTblNdx]             !   Add to edit buffer
    ADD(tTable)                     !
  .                         ! End loop

!──────────────────────────────────────────────────────────────────────────
SaveMemo     ROUTINE      ! Save edit table back to memo field
!──────────────────────────────────────────────────────────────────────────
  CLEAR(xMemo[])                 ! Clear memo field
  LOOP ilTblNdx = 1 TO MED:ilMemoRows         ! Loop for each line
    GET(tTable, ilTblNdx)             !   Get buffer entry
    IF ERRORCODE() THEN CLEAR(tTable).         !
    xMemo[ilTblNdx] = tTable             !   Save to memo field
  .                         ! End loop