/* --------------------  rexx procedure  -------------------- */
 ver = "1.04"
/* Name:      SAVELAB                                         *
 *                                                            *
 * Function:  Save, Restore, or Free Labels for an ISPF Edit  *
 *            member.                                         *
 *                                                            *
 * Syntax:    %SAVELAB option                                 *
 *                                                            *
 *            option may be:                                  *
 *            FREE     - free saved labels for this member    *
 *            SAVE     - save all labels                      *
 *            SHOW     - print variable of labels             *
 *            ERASE    - clear the variable and start over    *
 *            member   - restore saved labels as if editing   *
 *                       the member named in the option       *
 *            blank    - restore saved labels (default)       *
 *                       of this member                       *
 *                                                            *
 * Processing:                                                *
 *            The labels for a dataset(member) are saved in   *
 *            the active ISPF Profile in the variable name    *
 *            SAVELBL. Each dataset(member) is added to this  *
 *            variable in the format:                         *
 *            dataset(member) labels #                        *
 *            where the # is the end of each set of labels    *
 *            where labels is the format line:.label          *
 *                                                            *
 * Caveat:    It would be wise to do a SAVE before ending     *
 *            ISPF Edit session and the Restore should        *
 *            occur before any changes are made to the file.  *
 *                                                            *
 * Note:      If the ISPF Session abnormally terminates the   *
 *            PROFILE updates from a SAVE may not be saved    *
 *            in the ISPF Profile data set.                   *
 *                                                            *
 * Author:    Lionel B. Dyck                                  *
 *            Kaiser Permanente Information Technology        *
 *            Walnut Creek, CA 94598                          *
 *            (925) 926-5332                                  *
 *            Internet: lionel.b.dyck@kp.org                  *
 *                                                            *
 * History:                                                   *
 *            10/08/03 - 1.04 by Chip                         *
 *                       cgrantha@notes.state.ne.us           *
 *                     - cleanup spurious ## in variable      *
 *                     - add options show, erase, member      *
 *            07/02/03 - 1.03                                 *
 *                     - Do RESET before RESTORE              *
 *                     - Dynamically get name of macro        *
 *            07/02/03 - 1.02                                 *
 *                     - On Restore insert Info Lines         *
 *                     - Changed name from LABELS to SAVELAB  *
 *            07/01/03 - Creation                             *
 *                                                            *
 * ---------------------------------------------------------- */
 Parse source a b MacName c
 
 Address ISREdit
 "Macro (option) NOPROCESS"
 
/* ----------------------------------- *
 * Get the current data set and member *
 * ----------------------------------- */
  option = Translate(option,,
              'ABCDEFGHIJKLMNOPQRSTUVWXYZ',,
              'abcdefghijklmnopqrstuvwxyz')
 "(member) = member"
 "(dsname) = dataset"
 if "SAVE" = member then do
   zedsmsg = "Error"
   zedlmsg = "Member Name is an Op",
             "tion name ---- opps. Nothing processed."
   Address ISPExec "Setmsg msg(isrz001)"
   exit
 end
 if "FREE" = member then do
   zedsmsg = "Error"
   zedlmsg = "Member Name is an Op",
             "tion name ---- opps. Nothing processed."
   Address ISPExec "Setmsg msg(isrz001)"
   exit
 end
 if "ERASE" = member then do
   zedsmsg = "Error"
   zedlmsg = "Member Name is an Op",
             "tion name ---- opps. Nothing processed."
   Address ISPExec "Setmsg msg(isrz001)"
   exit
 end
 if "SHOW" = member then do
   zedsmsg = "Error"
   zedlmsg = "Member Name is an Op",
             "tion name ---- opps. Nothing processed."
   Address ISPExec "Setmsg msg(isrz001)"
   exit
 end
 
 if option = "" then do
   key = dsname"("member")"
 end
 else do
   if option = "SAVE" then do
     key = dsname"("member")"
   end
   else do
     if option = "FREE" then do
       key = dsname"("member")"
     end
     else do
       if option = "ERASE" then do
         key = dsname"("member")"
       end
       else do
         if option = "SHOW" then do
           key = dsname"("member")"
         end
         else do
           member = Translate(option,,
                  'ABCDEFGHIJKLMNOPQRSTUVWXYZ',,
                  'abcdefghijklmnopqrstuvwxyz')
           key = dsname"("member")"
         end
       end
     end
   end
 end
 
/* ------------------------------ *
 * Process the Edit Macro options *
 * ------------------------------ */
if translate(option) = "SAVE" then do
   call do_save
   exit
   end
 
if translate(option) = "FREE" then do
   call do_free
   exit
   end
 
if translate(option) = "ERASE" then do
   call do_erase
   exit
   end
 
if translate(option) = "SHOW" then do
   call do_show
   exit
   end
 
/* -------------- *
 * Restore Labels *
 * -------------- */
Address ISPExec "Vget (savelbl) Profile"
if wordpos(key,savelbl) > 0 then do
   wpre = wordpos(key,savelbl)
   pre  = subword(savelbl,1,wpre-1)
   rest = subword(savelbl,wpre+1)
   parse value rest with ours "#" left
   end
else do
     zedsmsg = "No Labels"
     zedlmsg = "No Labels have been saved for this",
               "file "key"."
     Address ISPExec "Setmsg msg(isrz001)"
     exit
     end
 
labels = words(ours)
"Reset Label"
"Reset"
do i = 1 to labels
   label = word(ours,i)
   parse value label with line":"label
   "LABEL" line " = "label "0"
   xrc = rc
   end
"LINE_BEFORE 1 = infoline  '"labels" label(s) restored.'"
"LINE_BEFORE 1 = infoline  'It is STRONGLY recommended",
                           "that you do a" macname "SAVE",
                           "before leaving ISPF Edit.'"
"Up Max"
 
zedsmsg = "Restored"
zedlmsg = labels "Labels restored for",
          "file "key"." ,
          "It is STRONGLY recommended that you do a",
          "SAVELAB Save immediately before leaving ISPF",
          "Edit."
Address ISPExec "Setmsg msg(isrz001)"
Exit
 
/* ------------------------ *
 * Save all existing labels *
 * ------------------------ */
Do_Save:
save = key
count = 0
"Locate Label First"
if rc > 0 then do
   zedsmsg = "No Labels"
   zedlmsg = "NO Labels found for",
             "file "key" so no Labels were saved."
   Address ISPExec "Setmsg msg(isrz001)"
   Exit 0
   end
else do while rc = 0
     "(line) = Display_Lines"
     "(l1,l2) = Label" line
     if l1 <> "" then do
        save = save line":"l1
        count = count + 1
     end
     "Locate Label Next"
     end
"Up Max"
call do_free
Address ISPExec "Vget (savelbl) Profile"
savelbl = savelbl save "#"
Address ISPExec "Vput (savelbl) Profile"
zedsmsg = "Saved"
zedlmsg = count "Labels saved for",
          "file "key"."
Address ISPExec "Setmsg msg(isrz001)"
Exit 0
 
/* ------------------------------------- *
 * Free the labels saved for this member *
 * ------------------------------------- */
Do_Free:
Address ISPExec "Vget (savelbl) Profile"
if wordpos(key,savelbl) > 0 then do
   wpre = wordpos(key,savelbl)
   pre  = subword(savelbl,1,wpre-1)
   rest = subword(savelbl,wpre)
   parse value rest with ours "#" left
   if length(strip(pre)) = 0 then do
     savelbl = left
     say 'left only ' left
     say 'savelbl ' savelbl
   end
   else do
     if length(strip(left)) = 0 then do
       savelbl = pre
       say 'pre only ' pre
       say 'savelbl ' savelbl
     end
     else do
       savelbl = pre left
       say 'pre  ' pre
       say 'left ' left
       say 'savelbl ' savelbl
     end
   end
   if length(strip(savelbl)) > 0 then
      Address ISPExec "Vput (savelbl) Profile"
   else
      Address ISPExec "VErase (savelbl) Profile"
   end
zedsmsg = "Freed"
zedlmsg = "All saved labels for",
          "file "key" have been removed."
Address ISPExec "Setmsg msg(isrz001)"
Return
/* ------------------------------------- *
 * Erase all labels to start over        *
 * ------------------------------------- */
Do_Erase:
Address ISPExec "Vget (savelbl) Profile"
Address ISPExec "VErase (savelbl) Profile"
zedsmsg = "Erased"
zedlmsg = "All saved labels have",
          "been erased."
Address ISPExec "Setmsg msg(isrz001)"
Return
/* ------------------------------------- *
 * Show current label variable           *
 * ------------------------------------- */
Do_Show:
Address ISPExec "Vget (savelbl) Profile"
say "Current variable is " savelbl
zedsmsg = "Shown"
zedlmsg = "All saved labels have",
          "been shown."
Address ISPExec "Setmsg msg(isrz001)"
Return