Programmer 7500/MAX_PROGRAMMERS.iso/CLIPPER/MISC/MAKEHELP.ZIP/MAKEHELP.PRG

Text File | 1987-01-27 | 17.8 KB | 607 lines

* MAKEHELP.PRG
*
* Used to create and maintain HELP messages for use with CLIPPER'ed programs.
* These are the program's functions:
*
*    EDIT (add new message, or modify existing message)
*    SUBSTRING data into a report
*       DELETE message or entire record
*       DISPLAY memo field for a variable without allowing changes
*
* Database layout for both input and resulting files:
*
*       Database: xxxxxHLP.DBF - 2 fields, HELP_VAR (c 10), HELP_MSG (memo)
*       Index:    xxxxxHLP.NTX - Key:      HELP_VAR
*       ('xxxxx' in the file names are the 1-to5 character system acronym)
*
* Creation:
*    Randy Richter, CALCULON Corporation, March 17, 1986
* Revision:
*    Randy Richter, 8/19/86: Modify to use PARMSET programming conventions
*    Randy Richter, 8/28/86: Revise SUBSTRING to improve performance;
*                            Add 'END OF MESSAGE' automatically to messages;
*                            Strip 'END OF MESSAGE' prior to change
*    Randy Richter, 9/2/86:  Combine former ADD and CHANGE options into
*                            one EDIT option;  create new CHANGE FILES option.
*    Randy Richter,10/15/86: Expand name field for database to provide space
*                            for inclusion of drive and path.
*    Randy Richter, 1/2/87:  Update exit routine to clean up memo storage.
*    Randy Richter, 1/27/87: Show all current HELP_VARs on <F1> from entry
*                            screen, as part of help message.
*
external memotran
set echo off
set debug off
set confirm off
set scoreboard off
restore from makehelp      && Get parameter variables
public sys_pgm, sys_dir, sys_acronm, sys_norm, sys_invers, sys_invers, all_var
public fname, build_nme, sc_color, chg_doen, del_done, pagex, linex
build_nme = space(17)
chg_done = .F.             && Flag for 'changes have been made'
del_done = .F.             && Flag for 'deletions have been done'
do painter with [HELP MESSAGE CREATION UTILITY]
do chng_fil                     && Define HELP file to be used
var = [          ]
menu_done = .F.
do while .not. menu_done
   do setcolor with [&sys_norm]
   clear
   do painter with [HELP MESSAGE CREATION UTILITY]
   @ 8,30 prompt [EDIT a new or existing message]
   @ 9,30 prompt [DELETE a message]
   @10,30 prompt [PRINT all messages]
   @11,30 prompt [SHOW a message]
   @12,30 prompt [CHANGE help files]
   @13,30 prompt [QUIT]
   menu to choice
   do case
      case choice = 1
         do EDIT
      case choice = 2
         do DELETE
      case choice = 3
         do SUBSTRING
      case choice = 4
         do SHOW_MEM
      case choice = 5
         do painter with [CHANGE HELP FILE]
         do CHNG_FIL
      case choice = 6 .or. choice = 0
         menu_done = .t.
         do exit_proc
   endcase
   keyboard ""
enddo
close databases
clear
cancel


PROCEDURE EDIT
*
* CASE 1:  ADD NEW DATA OR CHANGE EXISTING DATA
* Logic:   If no record exists, append blank and replace appropriate data.
*          If record exists, edit existing message.  Note that a <CR>, 31
*          spaces, and 'END OF MESSAGE' are added to the end of each message
*          it is written as a visual reminder to user; these do not display
*          during message creation.
*
do setcolor with [&sys_norm]
clear
do painter with [EDIT MESSAGE]
done_edit = .F.
do while .not. done_edit
   do setcolor with [&sys_norm]
   set function 2 to
   set key 28 to HELP
   @ 11,0 clear
   var = [          ]
   @ 10,1 say [ENTER VARIABLE NAME: ] get var picture [!!!!!!!!!!]
   read
   if lastkey() = 27 .or. len(trim(var)) = 0
      done_edit = .T.
      exit
   endif
   seek upper(var)
   do setcolor with [&sys_invers]
   frame = chr(201) + chr(205) + chr(187) + chr(186) + chr(188) + ;
           chr(205) + chr(200) + chr(186)
   @ 14,0,21,79 box frame
   @ 21,16 say "  Press <F2> to SAVE message, or <ESC> to quit.  "
   set key 28 to
   set function 1 to
   set function 2 to chr(23)
   if .not. found()
      temp_msg = memoedit(help_msg,15,1,20,78,.T.) + chr(13) + ;
            space(31) + 'END OF MESSAGE'
      if len(trim(var)) > 0
         append blank
         replace help_var with var
         replace help_msg with temp_msg
         if at("No variables are currently defined in this database...",all_var) > 1
            all_var = substr(all_var,1,at("No variables are currently defined in this database...",all_var)-1) + ;
              "Variables currently in this file include:" + chr(13) + chr(10)
         endif
         all_var = all_var + var + space(10-len(var))
      endif
   else
      chg_done = .T.
      temp_msg = substr(help_msg,1,at('END OF MESSAGE',help_msg)-31)
      new_msg = memoedit(temp_msg,15,1,20,78,.T.) + chr(13) + ;
           space(31) + 'END OF MESSAGE'
      replace help_msg with new_msg
   endif
enddo while .not. done_edit
set function 2 to
return


PROCEDURE DELETE
*
* CASE 2: DELETE DISCUSSION WITHIN EXISTING RECORD OR ENTIRE RECORD
*
do setcolor with [&sys_norm]
clear
do painter with [DELETE HELP MESSAGE]
done_del = .F.             && Flag for 'all done with deletions menu choice'
do while .not. done_del
   var = [          ]
   @ 10,1 say [ENTER VARIABLE NAME: ] get var picture [!!!!!!!!!!]
   read
   if lastkey() = 27 .or. len(trim(var)) = 0
      done_del = .T.
      exit
   endif
   seek upper(var)
   if found()
      and_var = "N"
      @ 12,1 say [DO YOU WISH TO DELETE THE ENTIRE RECORD ? ] get and_var picture '!'
      read
      if lastkey() = 27
         return
      endif
      if and_var <> "Y"
         @ 12,1 say "Deleting the record's help message only, please be patient..."
         new_var = help_var
         delete
         append blank
         replace help_var with new_var
         pack
         done = .T.
         @ 12,1 say space(78)
      else
         @ 12,1 say "Deleting the entire record, please be patient..."
         delete
         del_done = .T.
         pack
         done = .T.
         @ 12,1 say space(78)
      endif
   else
      do setcolor with [&sys_says]
      @ 12,1 say "Record not found..."
      set console off
      ? inkey(5)
      set console on
      do setcolor with [&sys_norm]
      @ 12,1 say space(25)
      loop
   endif
enddo while .not. done_del
return


PROCEDURE SUBSTRING
*
* CASE 3: PRINT REPORTS WITH SUBSTRING
*
do setcolor with [&sys_norm]
clear
do painter with [PRINT HELP MESSAGES]
declare memarray[256]               && LIMITING VALUE; MAY NEED TO CHANGE
count to numrecs
go top
if numrecs > 0
   @ 11,1 say "This HELP file contains " + str(numrecs,3) + " messages."
   @ 14,10 prompt "BEGIN printing or "
   @ 14,28 prompt "RETURN to the Main Menu"
   menu to pchoice
   if pchoice = 2
      return
   endif
else
   do setcolor with [&sys_says]
   @ 12,1 say "Record not found..."
   set console off
   ? inkey(5)
   set console on
   do setcolor with [&sys_norm]
   @ 12,1 say space(25)
   return
endif
@ 14,10 say 'Press <ESC> to stop printing at any time.'
linex=1
pagex=1
keyboard ""
do header
msgctr = 1
do while .not. eof()
   set console off
   ? inkey(1)
   set console on
   if lastkey() = 27
      yn = 'N'
      @ 14,1 say space(78)
      @ 14,1 say 'Continue printing (Y/N)? ' get yn picture '!'
      read
      if yn = 'N'
         eject
         return
      else
         @ 14,1 say space(78)
         @ 14,10 say 'Press <ESC> to stop printing at any time.'
      endif
   endif
   keyboard ""
   @ 12,1 say space(78)
   @ 12,1 say "Now printing message " + str(msgctr,2) + space(3)
   temp_msg = substr(help_msg,1,at('END OF MESSAGE',help_msg)-31)
   set color to B/B,B/B,B/B,B
   newmem = memotran(memoedit(temp_msg,18,1,24,78,.F.),' ',' ')
   do setcolor with [&sys_norm]
   arrayctr = 1
   DLINECTR = 1
   DO WHILE .NOT. DLINECTR > LEN(NEWMEM)
      IF DLINECTR + 77 < LEN(NEWMEM)
         LAST_SP = LAT(" ",SUBSTR(NEWMEM,DLINECTR,78))
         IF LAST_SP > 0
            MEMARRAY[ARRAYCTR] = SUBSTR(NEWMEM,DLINECTR,LAST_SP - 1)
            DLINECTR = DLINECTR + LAST_SP
            ARRAYCTR = ARRAYCTR + 1
         ELSE
            MEMARRAY[ARRAYCTR] = SUBSTR(NEWMEM,DLINECTR,77)
            DLINECTR = DLINECTR + 77
            ARRAYCTR = ARRAYCTR + 1
         ENDIF LAST_SP > 0
      ELSE
         MEMARRAY[ARRAYCTR] = SUBSTR(NEWMEM,DLINECTR)
         DLINECTR = LEN(NEWMEM) + 1
         ARRAYCTR = ARRAYCTR + 1
      ENDIF DLINECTR + 77 <= LEN(NEWMEM)
   ENDDO WHILE .NOT. DLINECTR > LEN(NEWMEM)
   * End of substringing section.  Note that ARRAYCTR is 1 more than # of
   * elements in the array.
   if linex + arrayctr > 58
      do header
   endif
   set device to print
   set print on
   set console off
   @ linex,35 say upper(help_var)
   linex = linex + 2
   lctr = 1
   do while lctr < arrayctr
      @ linex,1 say memarray[lctr]
      lctr = lctr + 1
      linex = linex + 1
   enddo
   linex = linex + 2
   set device to screen
   set print off
   set console on
   if .not. eof()
      skip
   endif
   msgctr = msgctr + 1
enddo
@ 11,1 say space(78)
@ 12,1 say space(78)
return


PROCEDURE SHOW_MEM
*
* CASE 4: DISPLAY MEMO FIELD WITHOUT ALLOWING CHANGES
*
do setcolor with [&sys_norm]
clear
do painter with [DISPLAY HELP MESSAGE]
done_show = .F.
do while .not. done_show
   do setcolor with [&sys_norm]
   @ 11,0 clear
   var = [          ]
   @ 10,1 say [ENTER VARIABLE NAME: ] get var picture [!!!!!!!!!!]
   read
   if lastkey() = 27 .or. len(trim(var)) = 0
      done_show = .T.
      exit
   endif
   seek upper(var)
   save screen
   if found()
      set key 28 to                   && TURN OFF HELP FEATURE TO AVOID W '85 BUG
      set function 1 to chr(23)       && DEFINE F1 AS CTRL-U
      go_on = .F.
      frame = chr(201) + chr(205) + chr(187) + chr(186) + chr(188) + ;
              chr(205) + chr(200) + chr(186)
      @ 21,0,24,79 box frame
      do setcolor with [&sys_says]
      @ 24,23 say "  PRESS <F1> TO EXIT FROM HELP  "
      keyboard ""
      if "" = memoedit(help_msg,22,1,23,78,.T.)
      endif
      do setcolor with [&sys_norm]
      restore screen
      done = .T.
      set key 28 to help
   else
      do setcolor with [&sys_says]
      @ 12,1 say "Record not found..."
      set console off
      ? inkey(5)
      set console on
      do setcolor with [&sys_norm]
      @ 12,1 say space(25)
      loop
   endif
enddo while .not. done_show
return


PROCEDURE CHNG_FIL
*
*  CASE 5:  CHANGE HELP FILES
*
do setcolor with [&sys_norm]
@  4,0 clear
@ 22,20 say 'PRESS <F1> FOR HELP AT ANY INPUT PROMPT'
done_name = .F.
@ 11,18 say 'Enter the system acronym: '
do while .not. done_name
   @ 14,10 say space(68)
   @ 11,44 get build_nme picture '@!'
   read
   if len(trim(build_nme)) = 0 .or. at('.',build_nme) > 0
      @ 14,12 say 'Sorry, you must enter a valid acronym...'
      set console off
      ? chr(7)
      ? inkey(5)
      set console on
      loop
   else
      fname = trim(build_nme) + 'HLP'
      done_name = .T.
   endif
   if file('&fname..DBF')
      select 1
      use &fname
      if file('&fname..NTX')
         use &fname index &fname
      else
         index on help_var to &fname
         use &fname index &fname
      endif
      go top
      count to numrecs
      go top
      @ 14,18 say "This HELP file contains " + str(numrecs,3) + " records."
      go top
      if numrecs > 0
         all_var = chr(13) + chr(10) + "Variables currently in this file include:" + chr(13)
         do while .not. eof()
            all_var = all_var + help_var + space(11-len(help_var))
            skip
         enddo
      else
         all_var = chr(13) + chr(10) + "No variables are currently defined in this database..."
      endif
      set console off
      ? inkey(5)
      set console on
   else
      use MAKEHLP
      copy structure to &fname
      use &fname
      index on help_var to &fname
      select 1
      use &fname index &fname
      all_var = chr(13) + chr(10) + "No variables are currently defined in this database..."
   endif
enddo while .not. done_name
return


PROCEDURE EXIT_PROC
*
*  CASE 6: CLEAN UP DATABASES AND EXIT
*  Logic:  If any text has been changed or deleted, EXIT_PROC copies the old
*          memo data into a new file, then renames to the old; this makes for
*          more efficient use of space...
*
if del_done .or. chg_done
   do painter with [UPDATING THE DATABASE]
   @ 14,24 say 'This will take several minutes;'
   @ 15,24 say 'please be patient.'
   if del_done
      pack
   endif
   copy structure to maketemp
   copy to maketemp
   use
   erase &fname..dbf
   erase &fname..dbt
   erase &fname..ntx
   rename maketemp.dbf to &fname..dbf
   rename maketemp.dbt to &fname..dbt
   use &fname
   index on help_var to &fname  && We're exiting, so don't need to use index...
endif
return


*
* END OF MAIN PROGRAM - subroutines and functions follow
*


PROCEDURE PAINTER
*  Syntax:  DO PAINTER WITH [screen title]
*  Based on routine by Tom Landini, modified for Clipper by Randy Richter
*
PARAMETERS PTITLE
CLEAR
do setcolor with [&sys_invers]
frame = chr(201) + chr(205) + chr(187) + chr(186) + chr(188) + ;
        chr(205) + chr(200) + chr(186)
@ 0,0,3,79 box frame
@ 1,1 say space(78)
@ 2,1 say space(78)
@ 2,2 SAY PTITLE
@ 2,66 SAY AMPM(TIME())
do setcolor with [&sys_norm]
RETURN

PROCEDURE HEADER
*  Simple routine to print report header; accepts no parameters
*
SET DEVICE TO PRINT
SET PRINT ON
SET CONSOLE OFF
EJECT
@ 1,1 SAY DATE()
@ 1,20 SAY 'HELP MESSAGE LISTING FOR THE ' + TRIM(BUILD_NME) + ' SYSTEM'
@ 1,72 SAY AMPM(TIME())
@ 2,36 SAY 'Page ' + STR(PAGEX,2)
@ 4,1 SAY REPLICATE('-',78)
@ 5,20 SAY '           VARIABLE NAME'
@ 7,20 SAY '*********  HELP  MESSAGE  *********'
@ 8,1 SAY REPLICATE('-',78)
LINEX = 10
PAGEX = PAGEX + 1
SET DEVICE TO SCREEN
SET PRINT OFF
SET CONSOLE ON
RETURN

FUNCTION AMPM
* Syntax: AMPM( <time string> )
* Return: An 11 byte character string with the time in a 12-hour am/pm format.
* Revised 8/19/86 by Randy Richter to return only "HH:MM xM"
*
PARAMETERS cl_time
RETURN IF( VAL(cl_time)<12, substr(cl_time,1,5-(8-len(cl_time))) + " am",;
           IF(    VAL(cl_time)=12, substr(cl_time,1,5) + " pm",;
              STR(VAL(cl_time)-12,2) + SUBSTR(cl_time,3,3) + " pm" ) )

FUNCTION LAT
* Syntax: LAT( string to look for, string to look in)
* Returns numeric value defining rightmost position of a string
* within a string.
*
* Randy Richter  4/30/86
*
PARAMETERS FIND_VAL,WHOLE
POS=LEN(WHOLE)
PLACE = 0
DO WHILE POS > 1
   POS = POS - 1
   FOUND_VAL =  SUBSTR(WHOLE,POS,LEN(FIND_VAL))
   IF FOUND_VAL = FIND_VAL
      PLACE = POS
      EXIT
   ENDIF
ENDDO
RETURN PLACE

PROCEDURE SETCOLOR
* Does nothing more then SET COLOR to the parameter passed.
* This provides a means of determining the current color setting to insure
* correct color setting on return from HELP.
*
* Randy Richter, 9/2/86
*
PARAMETERS SCRN_COLOR
SC_COLOR = SCRN_COLOR
SET COLOR TO &SCRN_COLOR
RETURN

PROCEDURE HELP
* HELP.PRG
*
* SUMMARY:  This is a generic help routine, usable only with CLIPPER.  Help
* messages are displayed in a box on lines 21 through 24, allowing for a
* 2-line "window".
*
* DATABASE STRUCTURE:  HELP uses one database, named "xxxxxHLP.DBF" (with
* "xxxxx" replaced by the 1-to-5 character system acronym).  This database
* contains 2 fields:
*              HELP_VAR     Character     10
*              HELP_MSG     Memo
* The database is indexed on HELP_VAR to xxxxxHLP.NTX, and stores its
* memo data in file xxxxxHLP.DBT.
*
* Creation:
*   Randy Richter, CALCULON Corporation, March 17, 1986
* Revision:
*   Randy Richter, 9/2/86:  THIS FILE ONLY uses SC_COLOR to set color on exit.
*   Randy Richter, 9/3/86:  Changed SET FILTER to SEEK; this means that
*                           HELP_VAR must be upper case (MAKEHELP.PRG sets
*                           correct case; other file creation means must also)
*   Randy Richter, 1/27/87: Add test for HELP_VAR = "VAR" to allow for display
*                           of current variables
PARAMETERS FILENAME, LINE_NUM, VAR_NAME
set key 28 to                   && TURN OFF HELP FEATURE TO AVOID W '85 BUG
set function 1 to chr(23)       && DEFINE F1 AS CTRL-U
sel_area = select()
sel_area2 = chr(sel_area + 64)
if len(sys_pgm ) = 0
   hname = trim(sys_dir) + trim(sys_acronm) + "HLP"
else
   hname = sys_pgm + ':' + trim(sys_dir) + trim(sys_acronm) + "HLP"
endif
if .not. file('&hname..DBF')
   return
endif
select 9
use &hname index &hname
seek upper(var_name)            && ASSUMES THAT 'HELP_VAR' IS UPPER CASE !!
save screen
frame = chr(201) + chr(205) + chr(187) + chr(186) + chr(188) + ;
        chr(205) + chr(200) + chr(186)
set color to &sys_invers
@ 21,0,24,79 box frame
if found()
   go_on = .F.
   @ 24,25 say "[PRESS <F1> TO EXIT FROM HELP]"
   keyboard ""
   *
   * NOTE: The first branch of the following IF..ENDIF is designed for use
   *       within MAKEHELP; remove for other programs...
   if trim(upper(var_name)) = "VAR"
      msg = substr(help_msg,1,at(space(31),help_msg)-2) + all_var
      if "" = memoedit(msg,22,1,23,78,.T.)
      endif
   else
      if "" = memoedit(help_msg,22,1,23,78,.T.)
      endif
   endif
   done = .T.
else
   @ 22,1 say space(78)
   @ 23,1 say space(78)
   @ 23,25 say "Sorry, no help is available."
   set console off
   ? inkey(5)
   set console on
endif
restore screen
set color to &sc_color                       && BE SURE TO INITIALIZE VARIABLE
set key 28 to HELP
select &sel_area2
return
* EOF   HELP.PRG

* EOF MAKEHELP.PRG