home *** CD-ROM | disk | FTP | other *** search
/ High Voltage Shareware / high1.zip / high1 / DIR36 / KEXX.ZIP / POP.KEX < prev    next >
Text File  |  1992-12-29  |  4KB  |  139 lines
  1. ************************************************
  2. * POP.KEX
  3. *
  4. * Function: POP function for a simple KEDIT context stack
  5. * To run:   See PROGMACS.DOC
  6. * Requires: KEDIT 5.0
  7. * Version:  1.1 (December, 1992)
  8. *
  9. * Parameters:
  10. *  Name        - The name of the entry on the stack to be popped
  11. *  OldLocation - "NO" says don't change the current file and location
  12. *
  13. *  This macro POPs all stacked contexts thru named context
  14. *
  15. ************************************************
  16.  
  17. Parse Arg Name OldLocation
  18. Name = Upper(Name)
  19.  
  20. If OldLocation = "NO" Then Do
  21.    CurrentFile = Fileid.1()
  22.    "SOS Save"
  23. End
  24.  
  25. If Name = "" Then Name = "DEFAULT"
  26.  
  27. Call ErrorCheck 'Editv Get StackEntries.'Name
  28. Entries = StackEntries.Name
  29. If \DataType(Entries, 'n') | Entries = '0' Then
  30.    Return 0
  31.  
  32. If Name \= "" Then Do
  33.  
  34.    Do Until PoppedName = Name | PoppedName = "STACKEMPTY"
  35.       PoppedName = PopEntry(Name)
  36.    End
  37.  
  38. End
  39. Else
  40.    Call PopEntry
  41.  
  42. Call ErrorCheck 'Editv Set StackEntries.'Name Entries - 1
  43.  
  44. If OldLocation = "NO" Then Do
  45.    "Kedit" CurrentFile
  46.    "SOS Restore"
  47. End
  48.  
  49. Return Entries
  50.  
  51. ************************************************
  52. * Function to POP a single context from the stack
  53. *  Returns the name of the entry if it had been named
  54. ************************************************
  55. PopEntry: Procedure
  56.  
  57. Parse Arg Name
  58.  
  59. * Get the size of the stack
  60. 'NoMsg Editv Get StackSize'
  61. If \DataType(StackSize, "N") | StackSize = 0 Then
  62.    Return "STACKEMPTY"
  63.  
  64. * Get stuff for top entry
  65. Call ErrorCheck "Editv Get StackFID."StackSize
  66. Call ErrorCheck "Editv Get StackName."StackSize
  67. Call ErrorCheck "Editv Get StackKeys."StackSize
  68. Parse Var StackFID.StackSize Fid C1 C2
  69. NameSave = StackName.StackSize
  70. KeysToDef = StackKeys.StackSize
  71.  
  72. * Back to original file and location
  73. Call ErrorCheck "Kedit" Fid "(New"
  74. If Size.1() \= 0 Then Do
  75.    * The file is still in the ring
  76.    'Locate .stack'StackSize
  77.    * Note: RC = 1 would mean TOF or EOF
  78.    If RC \= 0 & RC \= 1 Then Do
  79.       "EMsg Unable to relocate the old location in this file"
  80.       "EMsg It's likely the line was deleted or the file was removed from the ring"
  81.    End
  82.    Call ErrorCheck "Cursor Screen" C1 C2
  83.    'Set Point .stack'StackSize 'Off'
  84. End
  85. Else 'QQuit'
  86.  
  87. Do While KeysToDef \= ""
  88.  
  89.    * Redefine saved key
  90.    Parse Var KeysToDef NextKey KeysToDef
  91.    * Lowercase to circumvent a bug handling case in Editv variable tails
  92.    NextKey = Translate(NextKey, 'abcdefghijklmnopqrstuvwxyz', 'ABCDEFGHIJKLMNOPQRSTUVWXYZ')
  93.    Call ErrorCheck "Editv Get StackKey."StackSize"."NextKey
  94.    Call ErrorCheck "Define" NextKey StackKey.StackSize.NextKey
  95.  
  96.    * Delete entry
  97.    Call ErrorCheck "Editv Set StackKey."StackSize"."NextKey
  98.  
  99. End
  100.  
  101. * Remove stack values
  102. Call ErrorCheck "Editv Set StackFID."StackSize
  103. Call ErrorCheck "Editv Set StackName."StackSize
  104. Call ErrorCheck "Editv Set StackKeys."StackSize
  105.  
  106. * Set new stack size
  107. StackSize = StackSize - 1
  108. Call ErrorCheck "Editv Put StackSize"
  109.  
  110. If NameSave \= Name Then Do
  111.    Call ErrorCheck 'Editv Get StackEntries.'Name
  112.    Entries = StackEntries.Name
  113.    If DataType(Entries, 'n') & Entries \= '0'
  114.       Then Call ErrorCheck 'Editv Set StackEntries.'Name Entries - 1
  115.       Else Call FatalErr 99 "Internal error in context stack."
  116. End
  117.  
  118. Return NameSave
  119.  
  120. ************************************************
  121. * Subroutine to bail out with error message in alert box
  122. *  Note: This subroutine never returns to it's caller
  123. ************************************************
  124. FatalErr:
  125.    Parse Arg ReturnCode ErrorMessage
  126.    'Alert' Delimit(ErrorMessage) 'Title $POP$'
  127.    Exit ReturnCode
  128.  
  129. ************************************************
  130. * Execute command and check for zero return code
  131. *  If RC is not 0, then bail out with FatalErr
  132. ************************************************
  133. ErrorCheck:
  134.    Parse Arg CmdString
  135.    "NoMsg" CmdString
  136.    If RC \= 0 Then
  137.       Call FatalErr RC LastMsg.1()
  138.    Return
  139.