home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
clarion
/
library
/
memoed
/
memoedit.cla
< prev
next >
Wrap
Text File
|
1992-03-21
|
11KB
|
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