* SED
* Full Screen Editor
* Copyright (c) 2007 Ladybridge Systems, All Rights Reserved
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
* 
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
* GNU General Public License for more details.
* 
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software Foundation,
* Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
* 
* Ladybridge Systems can be contacted via the www.openqm.com web site.
* 
* START-HISTORY:
* 15 Jan 07  2.4-19 Extended Dive to handle compond I-types.
* 12 Dec 06  2.4-17 Reverted to use of REMOVEF() in SPLIT.INTO.CHUNKS.
* 02 Nov 06  2.4-15 Dictionary record types now case insensitive.
* 31 Oct 06  2.4-15 Use @SYS.BELL to honour BELL ON/OFF setting.
* 18 Jul 06  2.4-10 Parse entire list of command line ids before editing rather
*                   than one by one otherwise executed command kills list.
* 18 May 06  2.4-4 Use TRAPPING ABORTS in CompRun function.
* 02 Jan 06  2.3-3 Bound ^XM as compile and run program.
* 19 Dec 05  2.3-3 Revised handling of id case sensitivity.
* 28 Mar 05  2.1-11 Use PARSER$MFILE.
* 30 Dec 04  2.1-0 Added value edit mode, renaming the up.to.list function
*                  along the way.
* 09 Dec 04  2.1-0 Added STAMP command.
* 22 Oct 04  2.0-7 Handle uppercasing of names correctly over QMNet links.
* 18 Oct 04  2.0-5 Use message handler.
* 04 Oct 04  2.0-4 Use parser on QM. Added support for PATH:xxx to refer to
*                  a record rather than a file.
* 16 Sep 04  2.0-1 OpenQM launch. Earlier history details suppressed.
* END-HISTORY

*
* START-DESCRIPTION:
*
*   0         1         2         3         4         5         6         7
*   01234567890123456789012345678901234567890123456789012345678901234567890123456789
*22 *File record
*23 123456 lines | 12345.234 | Macro | Overlay | Indent  | Search  | Prefix ct
*
*
*         CTRL-             ESC-              CTRL-X            CTRL-X CTRL-
*   A     Start line
*   B     Back char         Back word         Goto buffer      *List buffers
*   C     Repeat            CapInit          *Exit             *Exit
*   D     Del char          Delete word      *Display records   Dive
*   E     End line          Run extension    *Execute macro
*   F     Forward char      Forward word                       *Find file
*   G     Cancel            Goto line
*   H     Backspace
*   I     Tab               Align text        Import
*   J     Newline
*   K     Kill line                           Delete buffer
*   L     Refresh           Lowercase                           Downcase region
*   M     Newline                             Compile & run
*   N     Next line         Next buffer                         Nudge down
*   O     Overlay                             Toggle window
*   P     Up line           Previous buffer                     Nudge up
*   Q     Quote char        Quote char        Query replace
*   R     Reverse search    Reverse search    Replace
*   S     Forward search    Forward search    Save file         Save file
*   T     Toggle
*   U     Repeat            Uppercase         Up to list        Upcase region
*   V     Forward screen    Back screen
*   W     Delete region     Copy region      *Write file       *Write file
*   X     Ctrl-X prefix    *Command           Export            Swap mark
*   Y     Yank kill buffer  Yank kill buffer
*   Z     Up line                                               Nudge up
*   1                                         Unsplit window
*   2                                         Split window
*   (                                        *Start macro
*   )                                        *End macro
*   =                                        *Expand char
*   .                       Set mark
*   <                       Top
*   >                       Bottom
* Bkspc   Backspace         Back del word
* Space                     Close spaces
* Del     Del char
*
* Key sequences marked * cannot be included in a macro and are not repeated
* by the repeat command.
*
* Commands:
*    BASIC         Compile program with error tracking
*    BWORD         Basic program "word" search mode
*    CASE_OFF      Case insensitive searches
*    CASE_ON       Case sensitive searches (default)
*    COMPILE       Save record and compile Basic program or extension
*    EXPAND.TABS   Expand tab characters
*    FANCY.FORMAT  Run FANCY.FORMAT utility
*    FORMAT        Run FORMAT utility
*    FUNDAMENTAL   Set default key bindings
*    INDENT        Toggle indent mode
*    KEYS          Display name of key bindings in use
*    LNUM          Set/clear line numbering
*    LOAD.KEYS     Load key bindings
*    OVERLAY       Toggle overlay mode
*    QUIT          Abort select list edit
*    RELEASE       Release update lock on record
*    RUN           Run program in current buffer (any args cause TCL version)
*    SAVE.KEYS     Save key bindings
*    SPOOL         Spool record without saving
*    STAMP         Add history line
*    TABS          Set tab interval
*    WORD          Word searches
*    XEQ           Execute TCL command
*    __DUMP__      Diagnostic dump
*
* END-DESCRIPTION
*
* START-CODE

program sed

$internal
$catalog $SED
$define ENV.SET
$include err.h
$include keys.h
$include int$keys.h
$include dictdict.h
$include parser.h
$include revstamp.h

   is.windows = system(91)

   parser = '!PARSER'
   source.control = "SOURCE.CONTROL"


   equ MERGE.LOAD    to 50
   equ IDEAL.LOAD    to 100
   equ SPLIT.LOAD    to 200

   equ MAX.BUFFERS   to 20
* Buffer table entry field positions.
   equ BUFF.FILE.NAME   to  1  ;* Null if not associated with a file
   equ BUFF.DICT.FLAG   to  2  ;* 'DICT' or null
   equ BUFF.RECORD.NAME to  3
   equ BUFF.UPDATED     to  4
   equ BUFF.HEAD        to  5
   equ BUFF.LINES       to  6
   equ BUFF.LINE        to  7
   equ BUFF.COL         to  8
   equ BUFF.MARK.LINE   to  9
   equ BUFF.MARK.COL    to 10 
   equ BUFF.READ.ONLY   to 11
   equ BUFF.TYPE        to 12
   equ BUFF.LNUM        to 13  ;* Show line numbers?
   equ BUFF.LOCKED      to 14  ;* Record in this buffer locked for update?
   equ BUFF.UNAMES      to 15  ;* Map names to upper case?
   equ BUFF.COMMENT     to 16  ;* Comment text to append to file name display
   equ BUFF.TAG         to 17  ;* Unique tag for this buffer - never reused
   equ BUFF.PARENT      to 18  ;* Parent buffer tag for EV mode
   equ BUFF.ITYPE       to 19  ;* In EV mode, is this actually an I-type?

   equ BUFF.TYPE.DATA                to 1  ;* Normal data
   equ BUFF.TYPE.EXPLORE             to 2  ;* Record level explore
   equ BUFF.TYPE.FILE.LIST           to 3  ;* File level explore
   equ BUFF.TYPE.EV.PARENT           to 4  ;* Data buffer during value edit
   equ BUFF.TYPE.EV.READ.ONLY.PARENT to 5  ;* Data buffer during value edit
   equ BUFF.TYPE.VALUES              to 6  ;* Value edit buffer

   equ PAN.INCREMENT    to 32


* Actions
* This table must be kept in step with the prelude and action splits and the
* table in set.default.bindings
*
   equ F.NEWLINE       to  1  ;* Insert newline at cursor
   equ F.HOME          to  2  ;* Goto start of line
   equ F.END           to  3  ;* Goto end of line
   equ F.LEFT          to  4  ;* Cursor left
   equ F.RIGHT         to  5  ;* Cursor right
   equ F.UP            to  6  ;* Cursor up
   equ F.DOWN          to  7  ;* Cursor down
   equ F.TOP           to  8  ;* Goto top
   equ F.BOTTOM        to  9  ;* Goto bottom
   equ F.PAGE.UP       to 10  ;* Up by one page
   equ F.PAGE.DOWN     to 11  ;* Down by one page
   equ F.DELETE        to 12  ;* Delete character
   equ F.BACKSPACE     to 13  ;* Backspace character
   equ F.KILL.LINE     to 14  ;* Delete to end of line or wrap up
   equ F.SAVE.RECORD   to 15  ;* Save record
   equ F.QUIT          to 16  ;* Quit
   equ F.OVERLAY       to 17  ;* Toggle overlay mode
   equ F.TAB           to 18  ;* Advance to next tab position
   equ F.GOTO.LINE     to 19  ;* Goto specific line
   equ F.TOGGLE        to 20  ;* Toggle characters
   equ F.FWD.SEARCH    to 21  ;* Forward search
   equ F.REPLACE       to 22  ;* Replace
   equ F.QREPLACE      to 23  ;* Query replace
   equ F.SWAP.MARK     to 24  ;* Swap mark and cursor
   equ F.EXECUTE       to 25  ;* Execute macro
   equ F.NUDGE.DOWN    to 26  ;* Nudge down
   equ F.NUDGE.UP      to 27  ;* Nudge up
   equ F.MARK          to 28  ;* Set mark
   equ F.KILL          to 29  ;* Kill region
   equ F.COPY          to 30  ;* Copy region
   equ F.YANK          to 31  ;* Yank kill buffer
   equ F.FWD.WORD      to 32  ;* Forward word
   equ F.DEL.WORD      to 33  ;* Delete word
   equ F.IMPORT        to 34  ;* Import record
   equ F.REV.SEARCH    to 35  ;* Reverse search
   equ F.LOWER.CASE    to 36  ;* Lower case word
   equ F.UPPER.CASE    to 37  ;* Upper case word
   equ F.CAP.INIT      to 38  ;* Capital initial
   equ F.BACK.WORD     to 39  ;* Backward word
   equ F.DEL.BACK.WORD to 40  ;* Delete word
   equ F.CLOSE.SPACES  to 41  ;* Close spaces
   equ F.NEXT.BUFFER   to 42  ;* Select next buffer
   equ F.PREV.BUFFER   to 43  ;* Select previous buffer
   equ F.GOTO.BUFFER   to 44  ;* Select buffer
   equ F.DELETE.BUFFER to 45  ;* Delete buffer
   equ F.UP.TO.PARENT  to 46  ;* Up to explore list (etc)
   equ F.REPEAT        to 47  ;* Repeat last function
   equ F.REFRESH       to 48  ;* Refresh screen
   equ F.QUOTE.CHAR    to 49  ;* Quote character
   equ F.LIST.BUFFERS  to 50  ;* List buffers
   equ F.FIND.RECORD   to 51  ;* Find record
   equ F.WRITE.RECORD  to 52  ;* Write record
   equ F.START.MACRO   to 53  ;* Start macro definition
   equ F.END.MACRO     to 54  ;* End macro definition
   equ F.EXPAND.CHAR   to 55  ;* Expand character
   equ F.EXPLORE       to 56  ;* Explore
   equ F.EXPORT        to 57  ;* Export
   equ F.COMMAND       to 58  ;* Command
   equ F.CANCEL        to 59  ;* Cancel
   equ F.RUN           to 60  ;* Run extension
   equ F.ALIGN         to 61  ;* Align text
   equ F.UPCASE.REGION to 62  ;* Uppercase region
   equ F.DNCASE.REGION to 63  ;* Lowercase region
   equ F.UNSPLIT       to 64  ;* Remove split window
   equ F.SPLIT         to 65  ;* Split window
   equ F.TOGGLE.WINDOW to 66  ;* Toggle windows
   equ F.DIVE          to 67  ;* Dive into include record
   equ F.COMPRUN       to 68  ;* Compile and run
   equ LAST.BINDABLE.ACTION to 68
* Actions after here are not bound to keys
   equ F.INSERT        to 69  ;* Insert character
   equ F.KEY.CODE      to 70  ;* Expand a key code
   equ F.BOUND.EXT     to 71  ;* Run bound extension
* !!BINDINGS!!
   * The following names are used as the comments in the key binding record.
   * They are also used with a dot prefix and embedded spaces replaced by dots
   * as the tokens for the key function names is extensions and should match
   * the corresponding extension function names.

   actions = 'Newline|Start line|End line|Back char|Fwd char|Up line|'
   actions := 'Down line|Top|Bottom|Page up|Page down|Del char|Backspace|'
   actions := 'Kill line|Save record|Quit|Overlay|Tab|Goto line|'
   actions := 'Toggle chars|Fwd search|Replace|Query replace|Swap mark|'
   actions := 'Execute macro|Nudge down|Nudge up|Set mark|Delete region|'
   actions := 'Copy region|Insert killed|Forward word|Delete word|Import|'
   actions := 'Reverse srch|Lowercase|Uppercase|Capital init|Back word|'
   actions := 'Del back word|Close spaces|Next buffer|Prev buffer|'
   actions := 'Goto buffer|Delete buffer|Up to list|Repeat|Refresh|'
   actions := 'Quote char|List buffers|Find record|Write record|'
   actions := 'Start macro|End macro|Expand char|List records|Export|'
   actions := 'Command|Cancel|Run|Align text|Upcase region|Downcase region|'
   actions := 'Unsplit window|Split window|Toggle window|Dive|'
   actions := 'CompRun|Insert'
* !!BINDINGS!!


   * Extension control

   equ INITIAL.EXT.TABLE.SIZE to 25
   equ EXT.TABLE.SIZE.INCREMENT to 10
   equ MAX.EXT.DEPTH to 15              ;* Maximum nested extension depth
   equ MAX.LCALL.DEPTH to 30            ;* Maximum nested local call depth
   equ E.STACK.SIZE to 100

   * Compilation items
   ext.funcs = ''  ;* Extension function names - Built by extension compiler

   * Execution items
   ext.start.up = @true             ;* Need to run START.UP
   ext.func.bindings = ''           ;* Parallel of action.list

   ext.table.size = INITIAL.EXT.TABLE.SIZE
   dim ext.table(ext.table.size)    ;* Loaded extensions and...
   extensions = ''                  ;* ...corresponding extension names

   last.ext.name = ''               ;* Last run extension from keyboard
   dim e.stack(E.STACK.SIZE)        ;* Evaluation stack

   ext.var.stack.size = 1
   dim ext.vars(ext.var.stack.size) ;* Local variables
   ext.var.base = 0                 ;* First var at this value plus 1

   ext.gvar.stack.size = 1
   dim global.vars(ext.gvar.stack.size) ;* Global variables and...
   mat global.vars = ''
   global.var.names = ''            ;* ...corresponding names        

   key.char = ''                    ;* Data char from get.key if insert mode
   prefix.count = 0                 ;* Last prefix count from get.key
                                     * Negative if prefix count not set

   extension.commands = ''          ;* Extensions bound to command names
                                     * F1 = command names, F2 = extensions
   execution.depth = 0

*-----------------------------------------------------------------------------

* Get screen characteristics

   screen.lines = @crthigh
   if screen.lines < 24 then screen.lines = 24
   displayed.lines = screen.lines - 2
   last.data.line = displayed.lines - 1
   split.line = int((displayed.lines + 1) / 2)  ;* Top line of lower window
   file.line = displayed.lines
   status.line = displayed.lines + 1
   lnum.all = @false
   lcol = 0    ;* Width of line number field
   lcol.fmt = ''
   gosub set.one.window
   scroll.increment = int(live.height / 2)

   screen.width = @crtwide
   if screen.width < 80 then screen.width = 80
   sw.fmt = screen.width : 'L'
   swm1 = screen.width - 1
   swm1.fmt = swm1 : 'L'
   swm2 = screen.width - 2
   swm2.fmt = swm2 : 'L'

   prompt ""

   pending.char = ''

   last.action = 0
   last.rpt = 1
   last.rpt.set = @false
   last.n = 0

   source.control.active = -1     ;* Not yet checked

   no.invert = @false
   keyin.case.conversion = @false
   gosub get.set.term.state

   banned = ''
   for i = 0 to 31
     banned := char(i)
   next i
   banned := char(127)
   replacements = str("?", len(banned))

   sw.space = space(screen.width)
   swm1.space = space(screen.width - 1)

   letters = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789"
   bchars = "$.%_"
   ctrl.char.names = "NULSOHSTXETXEOTENQACKBELBS HT LF VT FF CR SO SI DLEDC1DC2DC3DC4NAKSYNETBCANEM SUBESCFS GS RS US "

   * Buffer management

   dim buffer(MAX.BUFFERS) ; mat buffer = '' ;* Buffer state information store area
   dim file(MAX.BUFFERS)   ; mat file = ''   ;* File var associated with buffer
   current.buffer = 1
   no.of.buffers = 1
   buffer(1) = ''
   current.line = ''
   buffer.comment = ''
   buffer.tag = 0
   buffer.parent = ''
   buffer.itype = @false
   next.buffer.tag = 1

   chunks = 0                       ;* No chunks allocated (includes free)
   free.chunks = 0                  ;* No free chunks
   free.chain = 0

   terminate = 0
   equ TERMINATE.CURRENT to 1       ;* Terminate edit and move to next record
   equ TERMINATE.ALL     to 2       ;* Terminate all, abandoning select list

   * Screen attributes

   attr = @(-14)
   bar.attr = @(-13)

   * Screen image buffer

   dim image(screen.lines + 1) ; mat image = sw.space

   dim refresh(screen.lines + 1)     ;* Refresh this line?
   refresh.file = @true              ;* Refresh file line?
   refresh.other = @false            ;* Refresh "other" window?

   call @parser(PARSER$RESET, 0, @sentence, 0)
   call @parser(PARSER$GET.TOKEN, token.type, token, keyword) ;* Verb

   * Get name of input file

   dict.flag = ""

   call @parser(PARSER$MFILE, token.type, file.name, keyword)
   if file.name = "" then
      prompted.for.file.name = @true
      display sysmsg(6501) :  ;* File name?
      input file.name
      file.name = trimf(trimb(file.name))
      if file.name = "" then goto exit.sed

      if (upcase(file.name[1,5]) = "DICT ") and len(file.name[6,999999]) then
         dict.flag = "DICT"
         file.name = file.name[6,999999]
      end
   end else
      prompted.for.file.name = @false
      if keyword = KW$DICT then
         dict.flag = "DICT"
         call @parser(PARSER$MFILE, token.type, file.name, keyword)
      end
   end

   gosub open.file
   if not(open.ok) then
      message = sysmsg(2019) ;* File not found
      goto stop.sed
   end

   * 1.1-31  Save original file name and file variable for use when processing
   * a select list.

   original.file.name = file.name
   original.dict.flag = dict.flag
   original.file = file(current.buffer)

   * Initialise editing features that are preserved across records in a
   * multi-record edit.

   macro = ""                   ;* No macro active
   overlay = @false             ;* Not overlay mode
   indent = @false              ;* Not indent mode
   search.string = ""           ;* Strings for search, replace and...
   replacement.string = ""      ;* ...query replace functions
   if dict.flag # '' then import.file.name = 'DICT ' : file.name
   else import.file.name = file.name
   import.record.name = ""      ;* ...record names

   * Set default search mode  -  Values are assumed in some places

   equ CASE.SENSITIVE   to 1
   equ CASE.INSENSITIVE to 2
   equ WORD.SEARCH      to 3
   equ BWORD.SEARCH     to 4
   equ NUM.SEARCH.MODES to 4
   search.mode = CASE.SENSITIVE
   match.case = @true
   word.mode = @false

   common /SED.COMMON/ initialised,
                       kill.buffer,    ;* Kill buffer text
                       command.stack,  ;* Command history
                       file.stack      ;* File history
   if not(initialised) then
      kill.buffer = ""             ;* Kill buffer text
      command.stack = ""
      file.stack = ""
      initialised = @true
   end

   tab.interval = 10

   * Default FORMAT parameters

   fmt.indent = 3

   options.rec = ''
   abort.clause.on.write = @true    ;* Until we know otherwise

   read options.rec from @voc, '&SED.OPTIONS&' then
      if options.rec[1,1] = 'X' then

         * Field 2  -  Default modes

         ss = convert(' ', @fm, upcase(trim(options.rec<2>)))
         if len(ss) then
            loop
               token = remove(ss, delim)

               begin case
                  case token = 'BWORD'
                     search.mode = BWORD.SEARCH

                  case token = 'CASE_OFF'
                     search.mode = CASE.INSENSITIVE

                  case token = 'CASE_ON'
                     search.mode = CASE.SENSITIVE

                  case token = 'INDENT'
                     indent = @true

                  case token = 'LNUM'
                     lnum.all = @true

                  case token = 'NO.INVERT'
                     no.invert = @true
                     keyin.case.conversion = @false

                  case token = 'OVERLAY'
                     overlay = @true

                  case token = 'TABS'
                     n = remove(ss, delim)
                     if n matches '1-2N' and n > 0 then tab.interval = n
                     else
                        display sysmsg(6627) ;* Tab interval in &SED.OPTIONS& must be in range 1 to 99
                     end

                  case token = 'WORD'
                     search.mode = WORD.SEARCH

                  case 1
                     display sysmsg(6628, token) ;* Unrecognised option keyword in &SED.OPTIONS& (%1)
               end case
            while delim
            repeat
         end

         * Field 3  -  Key bindings - processed later
         * Field 4  -  Key bindings - processed later

         * Field 5  -  Default tab interval

         ss = trim(options.rec<5>)
         if ss matches '1-2N' and ss > 0 then tab.interval = ss + 0
      end else
         options.rec = ''  ;* Found record but it's not an X type
      end
   end

* Bind keys

   bound = @false
   bindings.file.open = @false
   open '&SED.BINDINGS&' to bindings then
      bindings.file.open = @true

      bindings.name = options.rec<3>
      if len(bindings.name) then   ;* Try as in &SED.OPTIONS&<3>
         read key.rec from bindings, bindings.name then
            gosub load.key.bindings
            bound = @true
         end
      end

      if not(bound) then  ;* Try binding by login type '-' terminal type
         term.name = upcase(@term.type)
         bindings.name = upcase(@logname):'-':term.name
         read key.rec from bindings, bindings.name then
            gosub load.key.bindings
            bound = @true
         end
      end

      if not(bound) then  ;* Try binding by login type with USER. prefix
         bindings.name = 'USER.' : upcase(@logname)
         read key.rec from bindings, bindings.name then
            gosub load.key.bindings
            bound = @true
         end
      end

      if not(bound) then  ;* Try binding by terminal type
         bindings.name = term.name
         read key.rec from bindings, bindings.name then
            gosub load.key.bindings
            bound = @true
         end
      end

      if not(bound) then
         bindings.name = options.rec<4>
         if len(bindings.name) then   ;* Try as in &SED.OPTIONS&<3>
            read key.rec from bindings, bindings.name then
               gosub load.key.bindings
               bound = @true
            end
         end
      end

      if not(bound) then
         bindings.name = 'DEFAULT'
         read key.rec from bindings, bindings.name then
            gosub load.key.bindings
            bound = @true
         end
      end
   end

   if not(bound) then gosub set.default.bindings

   selected.records = 0

   * Get name of source record (if any)

   if is.path then  ;* We actually opened a record by pathname
      record.name = fpath.record.id
      gosub edit
   end else
      call @parser(PARSER$GET.TOKEN, token.type, record.name, keyword)
      if record.name = '' then
         readlist record.name.list then
            selected.records = dcount(record.name.list, @fm)
            selected.record.index = 1
            remove record.name from record.name.list setting record.name.list.delim
            loop
               display sysmsg(2050, record.name) :  ;* Use active select list (First item 'xx: "')?
               input reply
   
               if upcase(reply[1,1]) = "N" then
                  clearselect
                  message = ''
                  goto stop.sed
               end

            until upcase(reply[1,1]) = "Y"
            repeat

            loop
               gosub edit
            until terminate = TERMINATE.ALL
            while record.name.list.delim
               gosub set.one.window

               record.name = remove(record.name.list,record.name.list.delim)            
               selected.record.index += 1

               * 1.1-31  Ensure we are back to our original file before we try
               * to open the next item in the select list

               file(current.buffer) = original.file
               dict.flag = original.dict.flag
               file.name = original.file.name
            repeat
         end else     ;* No select list - prompt for names
            first.record = @true
            loop
               if not(first.record and prompted.for.file.name) then
                  if len(dict.flag) then
                     display sysmsg(6502, 'DICT ' : file.name) ;* File name = xx
                  end else
                     display sysmsg(6502, file.name) ;* File name = xx
                  end
               end
               display sysmsg(6503) :  ;* Record name?
               input record.name
               record.name = trimf(trimb(record.name))
            while len(record.name)
               if first.record and (record.name = "*") then
                  gosub edit.all
                  exit
               end
* 1.2-32 '?' enters explore mode by setting null record id
               if first.record and (record.name = "?" or record.name[1,2] = "? ") then
                  template = field(record.name, ' ', 2, 9999)
                  record.name = ''

                  gosub check.template
                  if len(message) then
                     display message
                     continue
                  end
               end

               gosub edit
               first.record = @false
               gosub set.one.window
            repeat
         end
      end else
         if record.name = "*" then gosub edit.all
         else
            * Build list of record ids to edit
            id.list = record.name
            loop
               call @parser(PARSER$GET.TOKEN, token.type, record.name, keyword)
            until record.name = ''
               id.list<-1> = record.name
            repeat

            * Now do the edits
            loop
               record.name = remove(id.list, more.ids)
               gosub edit
            while more.ids
               gosub set.one.window
         
               * 1.1-31  Ensure we are back to our original file before we try
               * to open the next item
         
               file(current.buffer) = original.file
               dict.flag = original.dict.flag
               file.name = original.file.name
            repeat
         end
      end
   end

exit.sed:
   gosub reset.term.state

final.exit:
   return to final.exit

stop.sed:
   gosub reset.term.state
   stop message

*****************************************************************************
* ALLOCATE.CHUNKS  -  Allocate N more chunks to free chain

allocate.chunks:
   n += chunks
   dim chunk(n)
   dim chunk.next(n)
   dim chunk.lines(n)

   loop
      chunks += 1
      chunk(chunks) = ""
      chunk.lines(chunks) = 0
      chunk.next(chunks) = free.chain
      free.chain = chunks
      free.chunks += 1
   until chunks = n
   repeat

   return

* *****************************************************************************
* Release a chunk chain
*
* hd = head of chain to release

release.chunks:
   i = hd + 0
   n = 1
   loop
      chunk(i) = ""
      j = chunk.next(i)
   while j
      n += 1
      i = j
   repeat

   * Add to head of free chain
   chunk.next(i) = free.chain
   free.chain = hd + 0
   free.chunks += n

   return

*****************************************************************************
* EDIT.ALL  -  Edit all records in file

edit.all:
   select file(current.buffer)
   readlist record.name.list then
      selected.records = dcount(record.name.list, @fm)
      selected.record.index = 0
      loop
         record.name = remove(record.name.list,record.name.list.delim)
         selected.record.index += 1
         gosub edit
      until terminate = TERMINATE.ALL
         gosub set.one.window

         * 1.1-31  Ensure we are back to our original file before we try
         * to open the next item in the select list

         file(current.buffer) = original.file
         dict.flag = original.dict.flag
         file.name = original.file.name
      while record.name.list.delim
      repeat
   end
   return

*****************************************************************************
* EDIT  -  Edit current record

edit:
   terminate = 0
   last.low.level.action = 0
   collect = @false                        ;* Not collecting macro
   executing.macro = @false
   gosub refresh.all

   if selected.records then
      buffer.comment = ' (':selected.record.index:'/':selected.records:')'
   end else
      buffer.comment = ''
   end

   gosub read.record
   if read.blocked.by.lock then goto exit.edit

   top.line = 1
   pan = 1

   gosub refresh.all

   gosub get.current

   if ext.start.up then   ;* Look for START.UP extension
      key.char = '' ; prefix.count = 1
      ext.name = 'START.UP' ; ext.arg.count = 0 ; gosub run.extension
      ext.start.up = @false
   end

   loop
      line.len = len(current.line)

      gosub check.keyready
      if not(keyready) then
         gosub update.screen
         gosub place.cursor
      end
      gosub get.key

      if action # F.REPEAT then macro.qualifiers = ''

      on action goto null.prelude,      ;* F.NEWLINE
                     null.prelude,      ;* F.HOME
                     null.prelude,      ;* F.END
                     null.prelude,      ;* F.LEFT
                     null.prelude,      ;* F.RIGHT
                     null.prelude,      ;* F.UP
                     null.prelude,      ;* F.DOWN
                     null.prelude,      ;* F.TOP
                     null.prelude,      ;* F.BOTTOM
                     null.prelude,      ;* F.PAGE.UP
                     null.prelude,      ;* F.PAGE.DOWN
                     null.prelude,      ;* F.DELETE
                     null.prelude,      ;* F.BACKSPACE
                     null.prelude,      ;* F.KILL.LINE
                     null.prelude,      ;* F.SAVE.RECORD
                     pre.quit,          ;* F.QUIT
                     null.prelude,      ;* F.OVERLAY
                     null.prelude,      ;* F.TAB
                     pre.goto.line,     ;* F.GOTO.LINE
                     null.prelude,      ;* F.TOGGLE
                     pre.search,        ;* F.FWD.SEARCH
                     pre.replace,       ;* F.REPLACE
                     pre.replace,       ;* F.QREPLACE
                     null.prelude,      ;* F.SWAP.MARK
                     pre.execute,       ;* F.EXECUTE
                     null.prelude,      ;* F.NUDGE.DOWN
                     null.prelude,      ;* F.NUDGE.UP
                     null.prelude,      ;* F.MARK
                     null.prelude,      ;* F.KILL
                     null.prelude,      ;* F.COPY
                     null.prelude,      ;* F.YANK
                     null.prelude,      ;* F.FWD.WORD
                     null.prelude,      ;* F.DEL.WORD
                     pre.import,        ;* F.IMPORT
                     pre.search,        ;* F.REV.SEARCH
                     null.prelude,      ;* F.LOWER.CASE
                     null.prelude,      ;* F.UPPER.CASE
                     null.prelude,      ;* F.CAP.INIT
                     null.prelude,      ;* F.BACK.WORD
                     null.prelude,      ;* F.DEL.BACK.WORD
                     null.prelude,      ;* F.CLOSE.SPACES
                     null.prelude,      ;* F.NEXT.BUFFER
                     null.prelude,      ;* F.PREV.BUFFER
                     null.prelude,      ;* F.GOTO.BUFFER
                     null.prelude,      ;* F.DELETE.BUFFER
                     null.prelude,      ;* F.UP.TO.PARENT
                     pre.repeat,        ;* F.REPEAT
                     null.prelude,      ;* F.REFRESH
                     null.prelude,      ;* F.QUOTE.CHAR - Can never happen
                     pre.not.in.macro,  ;* F.LIST.BUFFERS
                     pre.find.record,   ;* F.FIND.RECORD
                     pre.write.record,  ;* F.WRITE.RECORD
                     pre.start.macro,   ;* F.START.MACRO
                     pre.end.macro,     ;* F.END.MACRO
                     pre.expand.char,   ;* F.EXPAND.CHAR
                     pre.not.in.macro,  ;* F.EXPLORE
                     pre.export,        ;* F.EXPORT
                     pre.command,       ;* F.COMMAND
                     null.prelude,      ;* F.CANCEL
                     pre.run,           ;* F.RUN
                     null.prelude,      ;* F.ALIGN
                     null.prelude,      ;* F.UPPER.CASE.REGION
                     null.prelude,      ;* F.LOWER.CASE.REGION
                     null.prelude,      ;* F.UNSPLIT.WINDOW
                     null.prelude,      ;* F.SPLIT.WINDOW
                     null.prelude,      ;* F.TOGGLE.WINDOW
                     null.prelude,      ;* F.DIVE
                     null.prelude,      ;* F.COMPRUN
                     null.prelude,      ;* F.INSERT
                     pre.key.code,      ;* F.KEY.CODE
                     null.prelude       ;* F.BOUND.EXT
* !!BINDINGS!!

pre.not.in.macro:
   if collect then
      gosub not.now
      goto skip.function
   end
   goto do.action

pre.start.macro:
   if collect then gosub not.now
   else
      collect = @true
      macro = ""
   end
   goto skip.function

pre.end.macro:
   if collect then collect = @false
   else gosub not.now
   goto skip.function

pre.execute:
   if collect then
      gosub not.now
      goto skip.function
   end
   goto do.action

pre.quit:
   if collect then gosub not.now
   else
      gosub check.quit
      if not(aborted) then terminate = TERMINATE.CURRENT
   end
   goto skip.function

pre.goto.line:
   if not(rpt.set) then
      prefix = 'Line: ' ; s = ''
      gosub get.string
      if s = '' then goto skip.function

      * Validate components

      for i = 1 to 3
         ss = field(s, ',', 1)
         if ss matches "1N0N" and ss > 0 then continue
         if ss # '' and ss # '*' then
            message = sysmsg(6629) ;* Require line number or field,value,subvalue position
            goto error
            goto skip.function
         end
      next i

      if index(s, ',', 3) then
         message = sysmsg(6630) ;* Error in field,value,subvalue position
         goto error
         goto skip.function
      end

      rpt = s ; rpt.set = @true
   end
   goto do.action

pre.repeat:
   action = last.action
   if not(action) then goto skip.function
   if not(rpt.set) then
      rpt = last.rpt
      rpt.set = last.rpt.set
   end
   n = last.n
   if num(n) then c = char(n)
   goto null.prelude

pre.search:
   gosub parse.search
   if aborted then goto skip.function
   macro.qualifiers = @fm : search.string
   goto null.prelude

pre.replace:
   if read.only then
      gosub read.only.buffer
      goto skip.function
   end else
      prefix = sysmsg(if action = F.REPLACE then 6631 else 6632) ;* Replace:/Query replace:
      s = search.string
      gosub get.search.string
      if aborted then goto skip.function
        
      search.string = s
      prefix = sysmsg(6633) ;* Replace by:
      s = replacement.string
      gosub get.string
      if aborted then goto skip.function

      replacement.string = s
      macro.qualifiers = @fm : search.string : @fm : replacement.string
   end
   goto null.prelude

pre.find.record:
   if collect then gosub not.now
   else
      if no.of.buffers < MAX.BUFFERS then gosub find.file
      else
         message = sysmsg(6634) ;* Too many buffers
         gosub error
      end
   end
   goto skip.function

pre.write.record:
   if buffer.type = BUFF.TYPE.EV.READ.ONLY.PARENT or buffer.type = BUFF.TYPE.EV.PARENT then
      message = sysmsg(6974) ;* A value edit buffer exists for this record
      gosub error
      return
   end

   if buffer.type = BUFF.TYPE.VALUES then
      message = sysmsg(6975) ;* This is a value edit buffer
      gosub error
      return
   end

   if collect then gosub not.now
   else gosub write.record
   goto skip.function

pre.expand.char:
   if collect then gosub not.now
   else
      ss = "             |                   "

      if col > line.len then s = sysmsg(6635) ;* End of line
      else
         n = seq(current.line[col, 1])
         s =  "Char(" : n : ") "
         if n < 32 then s := trimb(ctrl.char.names[(n * 3) + 1, 3])
         else if n >= 251 then s := ('TSVFI'[n-250,1]) : 'M'
      end
      ss[1,12] = s

      s = current.line[1,col-1]
      vpos = count(s, @vm) + 1
      spos = count(s<1,vpos>, @sm) + 1
      ss[16,18] = '<' : line : ',' : vpos : ',' : spos : '>'

      display @(0, status.line) : bar.attr : ss : attr :
      gosub wait.input
      gosub refresh.status
   end
   goto skip.function

pre.import:
   if read.only then
      gosub read.only.buffer
   end else
      prefix = sysmsg(6636) ;* Import file:
      s = import.file.name
      gosub get.string
      s = trimb(trimf(s))
      if s = '' then aborted = @true

      if not(aborted) then
         if s[1,5] = 'DICT ' then
            import.file.name = field(s, ' ', 1, 2)
            s = field(s, ' ', 3)
         end else
            import.file.name = field(s, ' ', 1)
            s = field(s, ' ', 2)
         end

         if s = '' then
            prefix = sysmsg(6637) ;* Record:
            s = import.record.name
            gosub get.string
            s = trimb(trimf(s))
            if s = '' then aborted = @true
         end

         if not(aborted) then
            import.record.name = s
            macro.qualifiers = @fm : import.file.name : @fm : import.record.name
            goto null.prelude
         end
      end
   end
   goto skip.function

pre.export:
   if collect then gosub not.now
   else gosub export
   goto skip.function

pre.command:
   if collect then gosub not.now
   else gosub command
   goto skip.function

pre.key.code:
   gosub insert.key.code
   goto skip.function

pre.run:
   prefix = sysmsg(6638) ;* Extension:
   s = last.ext.name
   gosub get.string
   s = trimb(trimf(s))
   if s = '' then goto skip.function
   last.ext.name = upcase(s)
   macro.qualifiers = @fm : last.ext.name
   ext.name = last.ext.name
   goto null.prelude

null.prelude:
      * Save for macro?

      if collect then
         macro<-1> = rpt : @fm : action : @fm : n : macro.qualifiers
      end

do.action:    ;* Come here from prelude split if not to save in macro
      last.action = action
      last.rpt = rpt
      last.rpt.set = rpt.set
      last.n = n

      gosub action.split           ;* Do the action
      last.low.level.action = action

skip.function:
   until terminate
   repeat

   gosub clear.screen

exit.edit:

   * Free all buffers and chunks so that re-entry does not see old data

   for i = 1 to no.of.buffers
      if len(buffer(i)<BUFF.FILE.NAME>) then
         if buffer(i)<BUFF.LOCKED> then
            release file(i), buffer(i)<BUFF.RECORD.NAME>
         end
         if i # 1 and fileinfo(file(i), FL$OPEN) then close file(i)
      end
   next i

   current.buffer = 1
   no.of.buffers = 1
   buffer(1) = ''

   chunks = 0                       ;* No chunks allocated (includes free)
   free.chunks = 0                  ;* No free chunks
   free.chain = 0

   return


action.split:
   on action goto a.newline,          ;* Insert newline at cursor
                  a.home,             ;* Goto start of line
                  a.end,              ;* Goto end of line
                  a.left,             ;* Cursor left
                  a.right,            ;* Cursor right
                  a.up,               ;* Cursor up
                  a.down,             ;* Cursor down
                  a.top,              ;* Goto top
                  a.bottom,           ;* Goto bottom
                  a.page.up,          ;* Up by 17 lines
                  a.page.down,        ;* Down by 17 lines
                  a.delete,           ;* Delete character
                  a.backspace,        ;* Backspace character
                  a.kill.line,        ;* Delete to end of line or wrap up
                  save.record,        ;* Save record
                  null.action,        ;* Quit - All done in prelude
                  a.overlay,          ;* Toggle overlay
                  a.tab,              ;* TAB
                  a.goto.line,        ;* Goto line
                  a.toggle,           ;* Toggle characters
                  a.fwd.search,       ;* Forward search
                  a.replace,          ;* Replace
                  a.qreplace,         ;* Query replace
                  a.swap.mark,        ;* Swap mark and cursor
                  a.execute,          ;* Execute macro
                  a.nudge.down,       ;* Nudge down
                  a.nudge.up,         ;* Nudge up
                  a.mark,             ;* Set mark
                  a.kill,             ;* Kill region
                  a.copy,             ;* Copy region
                  a.yank,             ;* Yank kill buffer
                  a.fwd.word,         ;* Forward word
                  a.del.word,         ;* Delete word
                  a.import,           ;* Import
                  a.rev.search,       ;* Reverse search
                  a.dncase,           ;* Lower case word
                  a.upcase,           ;* Upper case word
                  a.cap.init,         ;* Capital initial
                  a.back.word,        ;* Backward word
                  a.del.back.word,    ;* Delete backward word
                  a.close.spaces,     ;* Close spaces around cursor
                  a.next.buffer,      ;* Select next buffer
                  a.prev.buffer,      ;* Select previous buffer
                  a.goto.buffer,      ;* Select buffer
                  a.delete.buffer,    ;* Delete buffer
                  a.up.to.parent,     ;* Up to explore list (etc)
                  null.action,        ;* Repeat - should never happen
                  a.refresh,          ;* Refresh screen
                  null.action,        ;* Quote char - should never happen
                  a.show.buffer.list, ;* Show buffer list
                  null.action,        ;* Find record - done in prelude
                  null.action,        ;* Write record - done in prelude
                  null.action,        ;* Start macro definition
                  null.action,        ;* End macro definition
                  null.action,        ;* Expand.char - done in prelude
                  a.explore,          ;* Explore
                  null.action,        ;* Export
                  null.action,        ;* Command
                  null.action,        ;* Cancel
                  a.run,              ;* Run
                  a.align,            ;* Align text
                  a.upcase.region,    ;* Uppercase region
                  a.dncase.region,    ;* Lowercase region
                  a.unsplit.window,   ;* Unsplit window
                  a.split.window,     ;* Split window
                  a.toggle.window,    ;* Toggle window
                  a.dive,             ;* Dive
                  a.comprun,          ;* Compile and run
                  a.insert,           ;* Insert character
                  null.action,        ;* Key code expansion
                  a.bound.ext         ;* Run bound extension
* !!BINDINGS!!

null.action:   ;* Come here when the action has all been done in the prelude
   return

* *****************************************************************************
* Simple cursor movements

a.home:
   col = 1
   return

* -----------------------------------------------------------------------------

a.end:
   col = line.len + 1
   return

* -----------------------------------------------------------------------------

a.left:
   if col > line.len then col = line.len + 1
   loop
      if col > 1 then
         if col > rpt then n = rpt
         else n = col - 1
         col -= n
         rpt -= n
      end else
         if line = 1 then exit
         gosub save.current
         line -= 1
         gosub get.current
         col = line.len + 1
         rpt -= 1
      end
   while rpt
   repeat
   return

* -----------------------------------------------------------------------------

a.right:
   if col > line.len then col = line.len + 1
   loop
      n = line.len + 1 - col
      if n > rpt then n = rpt
      if n <= 0 then
         if line >= lines then exit
         gosub save.current
         line += 1
         gosub get.current
         col = 1
         rpt -= 1
      end else
         col += n
         rpt -= n
      end
   while rpt
   repeat
   return

* -----------------------------------------------------------------------------

a.up:
   gosub save.current
   line -= rpt
   if line < 1 then line = 1
   gosub get.current
   return

* -----------------------------------------------------------------------------

a.down:
   gosub save.current
   line += rpt
   if line > lines then
      line = if read.only then lines else lines + 1
   end
   gosub get.current
   return

* -----------------------------------------------------------------------------

a.top:
   gosub save.current
   line = 1
   col = 1
   gosub get.current
   return

* -----------------------------------------------------------------------------

a.bottom:
   gosub save.current
   line = if read.only then lines else lines + 1
   col = 1
   gosub get.current
   return

* -----------------------------------------------------------------------------

a.page.up:
   gosub save.current
   n = live.height * rpt
   line -= n ; if line < 1 then line = 1
   top.line -= n ; if top.line < 1 then top.line = 1
   gosub get.current
   gosub refresh.all
   return

* -----------------------------------------------------------------------------

a.page.down:
   gosub save.current
   n = live.height * rpt
   line += n 
   if line > lines then
      line = if read.only then lines else lines + 1
   end
   top.line += n
   if top.line > lines then
      top.line = lines - scroll.increment
      if top.line < 1 then top.line = 1
   end
   gosub get.current
   gosub refresh.all
   return

* -----------------------------------------------------------------------------

a.tab:
   if read.only then
      gosub read.only.buffer
      return
   end

   if col > line.len then col = line.len + 1
   col = col + (tab.interval * rpt) - mod(col - 1, tab.interval)
   i = col - (line.len + 1)
   if i > 0 then
      current.line := space(i)
      line.len += i
      line.updated = @true
   end
   return

* -----------------------------------------------------------------------------

a.goto.line:
   gosub save.current

   ss = current.line[1,col-1]
   vpos = count(ss, @vm) + 1           ;* Current value position...
   svpos = count(ss<1,vpos>, @sm) + 1  ;* ...and subvalue position
   dflt.vpos = vpos

   * Process field position

   fn = field(rpt, ',', 1)
   if fn matches "1N0N" then                  ;* Actual line number
      if fn > lines then
         fn = if read.only then lines else lines + 1
      end
      dflt.vpos = 1
   end else fn = line                         ;* Must be '' or '*'

   * Process value position

   vn = field(rpt, ',', 2)
   begin case
     case vn = ''        ;* Use default (1 if fn specified, else current)
        vn = dflt.vpos

     case vn = '*'
        vn = vpos        ;* Keep value position unchanged

     case vn matches '1N0N' and vn > 0
        vn += 0
   end case

   * Process subvalue position

   svn = field(rpt, ',', 3)
   begin case
     case svn = ''
        svn = 1

     case svn = '*'
        svn = svpos

     case svn matches '1N0N' and svn > 0
        svn += 0
   end case

   * fn holds line position of desired field
   line = fn
   gosub get.current
   col = 1

   * Find required value/subvalue

   if vn = 1 then vx = 1
   else
      vx = index(current.line, @vm, vn - 1)
      if vx then vx += 1
   end

   if svn = 1 then svx = 1
   else
      svx = index(current.line<1,vn>, @svm, svn - 1)
      if svx then svx += 1
   end

   if (vx = 0 or svx = 0) and not(read.only) then
      loop
         prefix = sysmsg(6639) ;* Value/subvalue not present. Extend item?
         s = ''
         gosub get.string
         if aborted or s = '' then return
         s = upcase(s)
      until s = 'Y' or s = 'N'
      repeat

      if s = 'N' then return

      current.line<1,vn,svn> = ''
      if line > lines then gosub save.current  ;* Make new line
      line.updated = @true
      gosub refresh.line

      if vn = 1 then vx = 1
      else
         vx = index(current.line, @vm, vn - 1)
         if vx then vx += 1
      end

      if svn = 1 then svx = 1
      else
         svx = index(current.line<1,vn>, @svm, svn - 1)
         if svx then svx += 1
      end
   end

   col = vx + svx - 1

   return

* -----------------------------------------------------------------------------

a.fwd.word:
   loop
      gosub fwd.letter
      gosub fwd.non.letter
      rpt -= 1
   while rpt and line <= lines
   repeat
   return

* -----------------------------------------------------------------------------

a.back.word:
   if col > line.len then col = line.len + 1
   if col = 1 then
      if line = 1 then return
      gosub save.current
      line -= 1
      gosub get.current
      col = line.len + 1
   end

   loop
      gosub bkwd.letter
   while index(letters, current.line[col, 1], 1)
      gosub bkwd.non.letter
      rpt -= 1
   while rpt
   repeat

   if col > line.len then
      if line = lines then return
      gosub save.current
      line += 1
      gosub get.current
      col = 1
   end
   else if not(line = 1 and col = 1) then col += 1

   return

* -----------------------------------------------------------------------------

a.mark:
   if col > line.len then col = line.len + 1
   mark.line = line
   mark.col = col
   return

* -----------------------------------------------------------------------------

a.swap.mark:
   if mark.line then
      if col > line.len then col = line.len + 1
      gosub save.current
      n = mark.line
      mark.line = line
      line = n
      n = mark.col
      mark.col = col
      col = n
      gosub get.current
   end
   else gosub no.mark
   return

* *****************************************************************************
* Display window handling

* Refresh screen

a.refresh:
   gosub save.current
   if rpt.set and rpt >= 1 and rpt <= live.height then
      top.line = line - (rpt - 1)
   end
   else top.line = line - int(live.height / 2)
   if top.line < 1 then top.line = 1
   gosub get.current
   gosub clear.screen
   gosub refresh.all
   return

* -----------------------------------------------------------------------------

a.nudge.down:
   gosub save.current
   loop
   while top.line < lines
      top.line += 1
      if line < top.line then line += 1
      rpt -= 1
   while rpt
   repeat
   gosub get.current
   gosub refresh.all
   return

* -----------------------------------------------------------------------------

a.nudge.up:
   gosub save.current
   loop
   while top.line > 1
      top.line -= 1
      if line >= (top.line + live.height) then line -= 1
      rpt -= 1
   while rpt
   repeat
   gosub get.current
   gosub refresh.all
   return

* -----------------------------------------------------------------------------

a.unsplit.window:
   if split.window then
      gosub set.one.window
      gosub clear.screen
      gosub refresh.all
   end
   return

* -----------------------------------------------------------------------------

a.split.window:
   if split.window = 0 then
      split.window = 1  ;* Make upper window live
      live.top = 0
      live.btm = split.line - 2
      live.height = live.btm - live.top + 1
      scroll.increment = int(live.height / 2)

      other.buffer = current.buffer

      other.top = split.line
      other.btm = last.data.line
      other.live = @true   ;* Other window is also live buffer
      other.line = line
      other.col = col
!     other.height = other.btm - other.top + 1
      other.lcol.fmt= lcol.fmt
      other.top.line = top.line
      gosub clear.screen
      gosub refresh.all
   end
   return

* -----------------------------------------------------------------------------

a.toggle.window:
   if split.window then
      gosub save.buffer

      n = other.buffer
      other.buffer = current.buffer
      current.buffer = n

      other.cache = other.top.line
      if other.live then
         other.cache<2> = other.line
         other.cache<3> = other.col
      end
      other.top.line = top.line
      other.line = line
      other.col = col

      gosub get.buffer
      top.line = other.cache<1> + 0
      if other.live then
         line = other.cache<2> + 0
         col = other.cache<3> + 0
      end
      gosub get.current

      if split.window = 1 then  ;* Make lower window live
         split.window = 2
         live.top = split.line
         live.btm = last.data.line
         other.top = 0
         other.btm = split.line - 2
      end else                  ;* Make upper window live
         split.window = 1
         live.top = 0
         live.btm = split.line - 2
         live.height = live.btm - live.top + 1
         scroll.increment = int(live.height / 2)
         other.top = split.line
         other.btm = last.data.line
      end
!     other.height = other.btm - other.top + 1
      gosub clear.screen
      gosub refresh.all
   end
   return

set.one.window:
   split.window = 0  ;* 0 = no split, 1 = upper live, 2 = lower live
   live.top = 0
   live.btm = last.data.line
   live.height = live.btm - live.top + 1
   scroll.increment = int(live.height / 2)
   other.live = @false
   return

* *****************************************************************************
* Search and replacement

a.fwd.search:
   if col > line.len then col = line.len + 1
   first.search = @true
   loop
      advance = 1
      gosub fsearch
      rpt -= 1
   while rpt and found
   repeat
   if not(found) then
      message = "Not found."
      gosub error
   end
   gosub refresh.status
   return

* -----------------------------------------------------------------------------

a.rev.search:
   if col > line.len then col = line.len + 1
   first.search = @true
   loop
      gosub rsearch
      rpt -= 1
   while rpt and found
   repeat
   if not(found) then
      message = sysmsg(6640) ;* Not found.
      gosub error
   end
   gosub refresh.status
   return

* -----------------------------------------------------------------------------

a.replace:
   if read.only then
      gosub read.only.buffer
      return
   end
   if col > line.len then col = line.len + 1
   query.replacement = @false
   gosub replace
   return

* -----------------------------------------------------------------------------

a.qreplace:
   if read.only then
      gosub read.only.buffer
      return
   end
   if col > line.len then col = line.len + 1
   query.replacement = @true
   gosub replace
   return

* *****************************************************************************
* Insertion and deletion

a.insert:
   if read.only then
      gosub read.only.buffer
      return
   end

   if col > line.len then col = line.len + 1
   if overlay then
      if rpt = 1 then current.line = current.line[1, col - 1] : c : current.line[col + rpt, 99999999]
      else current.line = current.line[1, col - 1] : str(c, rpt) : current.line[col + rpt, 99999999]
   end else
      if rpt = 1 then current.line = current.line[1, col - 1] : c : current.line[col, 99999999]
      else current.line = current.line[1, col - 1] : str(c, rpt) : current.line[col, 99999999]

      if line = mark.line then
         if mark.col >= col then mark.col += rpt
      end
   end

   col += rpt
   line.updated = @true
   if line > lines then gosub save.current  ;* Make new line
   gosub refresh.line
   return

* -----------------------------------------------------------------------------

a.overlay:
   overlay = not(overlay)
   return

* -----------------------------------------------------------------------------

a.newline:
   if read.only then
      begin case
         case buffer.type = BUFF.TYPE.EXPLORE
            if len(current.line) and not(current.line matches '--- 0X ---') then
               gosub dive
            end

         case buffer.type = BUFF.TYPE.FILE.LIST
            if len(current.line) then
               gosub dive.to.file
            end

         case 1
            gosub read.only.buffer
      end case
   end else
      if col > line.len then col = line.len + 1
      if mark.line >= line then
         if mark.line > line then mark.line += 1
         else if mark.col >= col then
            mark.line += 1
            mark.col -= col - 1
         end
      end
      if other.live then
         if line <= other.line then other.line += 1
         if line <= other.top.line then other.top.line += 1
      end

      s = current.line[col, 99999999]
      if indent then
         ss = current.line[1, col - 1]
         i = 1
         loop
         while ss[i,1] = ' '
            i += 1
         repeat
         indentation = i - 1

         i = 1
         loop
         while s[i,1] = ' '
            i += 1
         repeat
         s = s[i,9999999]
      end
      else indentation = 0

      gosub refresh.below
      current.line = current.line[1, col - 1]
      line.updated = @true
      gosub save.current
      gosub insert.line
      current.line = space(indentation) : s
      line.len = len(current.line)
      col = indentation + 1
      line.updated = @true
      gosub check.lcol
   end
   return

* -----------------------------------------------------------------------------

a.delete:
   if read.only then
      gosub read.only.buffer
      return
   end

   if col > line.len then col = line.len + 1
   loop
      n = line.len + 1 - col
      if n > rpt then n = rpt
      if n <= 0 then       ;* At end of line
         if line = lines then exit
         if line < mark.line then mark.line -= 1
         if other.live then
            if line < other.line then other.line -= 1
            if line < other.top.line then other.top.line -= 1
         end
         gosub refresh.below
         s = current.line
         gosub delete.current
         current.line = s : current.line
         line.updated = @true
         rpt -= 1
      end else  ;* Delete n characters to right of cursor
         if line = mark.line and col < mark.col then
             mark.col -= n
             if mark.col < col then mark.line = 0  ;* Deleted mark
         end
         current.line = current.line[1, col - 1] : current.line[col + n, 99999999]
         line.len -= n
         line.updated = @true
         gosub refresh.line
         rpt -= n
      end
   while rpt
   repeat
   return

* -----------------------------------------------------------------------------

a.backspace:
   if read.only then
      gosub read.only.buffer
      return
   end

   if col > line.len then col = line.len + 1
   loop
      if col > 1 then
         if col > rpt then n = rpt
         else n = col - 1
         if line = mark.line then
            if col <= mark.col then mark.col -= n
         end
         col -= n
         current.line = current.line[1, col - 1] : current.line[col + n, 99999999]
         line.updated = @true
         gosub refresh.line
         rpt -= n
      end else
         if line = 1 then return
         gosub refresh.all
         s = current.line
         gosub delete.current
         if line > 1 then line -= 1
         gosub get.current
         if mark.line > line then
            mark.line -= 1
            mark.col += line.len
         end
         if other.live then
            if other.line > line then other.line -= 1
            if other.top.line > line then other.top.line -= 1
         end
         col = line.len + 1
         current.line := s
         line.len = len(current.line)
         line.updated = @true
         rpt -= 1
      end
   while rpt
   repeat
   return

* -----------------------------------------------------------------------------

a.del.word:
   if read.only then
      gosub read.only.buffer
      return
   end
   if line <= lines then
      if col > line.len then col = line.len + 1
      gosub save.current
      n = line
      gosub find.line
      region.start.chunk = ch
      region.start.fld = fld
      region.start.line = line
      region.start.col = col
      loop
         gosub fwd.letter
         gosub fwd.non.letter
         rpt -= 1
      while rpt and line <= lines
      repeat
      if line <= lines then
         n = line
         gosub find.line
         region.end.chunk = ch
         region.end.fld = fld
         region.end.line = line
         region.end.col = col
         gosub delete.region
      end
   end
   return

* -----------------------------------------------------------------------------

a.del.back.word:
   if read.only then
      gosub read.only.buffer
      return
   end
   gosub save.current
   if col > line.len then col = line.len + 1
   n = line
   gosub find.line
   region.end.chunk = ch
   region.end.fld = fld
   region.end.line = line
   region.end.col = col
   if col = 1 then
      if line = 1 then return
      gosub save.current
      line -= 1
      gosub get.current
      col = line.len + 1
   end

   loop
      gosub bkwd.letter
   while index(letters, current.line[col, 1], 1)
      gosub bkwd.non.letter
      rpt -= 1
   while rpt
   repeat

   if col > line.len then
      if line = lines then return
      gosub save.current
      line += 1
      gosub get.current
      col = 1
   end
   else if not(line = 1 and col = 1) then col += 1

   n = line
   gosub find.line
   region.start.chunk = ch
   region.start.fld = fld
   region.start.line = line
   region.start.col = col
   gosub delete.region
   return

* -----------------------------------------------------------------------------

a.kill.line:
   if read.only then
      begin case
         case buffer.type = BUFF.TYPE.EXPLORE
            if len(current.line) and not(current.line matches '--- 0X ---') then
               prefix = "Delete " : current.line : "?"
               gosub yes.no
               if aborted or not(yes) then return

               * Check if we have this record loaded

               s = file.name : @fm : current.line : @fm : dict.flag
               for k = 1 to no.of.buffers
                  if buffer(k)<BUFF.FILE.NAME>:@fm:buffer(k)<BUFF.RECORD.NAME>:@fm:buffer(k)<BUFF.DICT.FLAG> = s then
                     if buffer(k)<BUFF.UPDATED> then
                        prefix = sysmsg(6641) ;* Modified edit buffer for this record will be lost. Continue with delete?
                     end else
                        prefix = sysmsg(6642) ;* The buffer for this record will also be deleted. Continue with delete?
                     end
                     gosub yes.no
                     if aborted or not(yes) then return

                     if split.window then
                        if k = other.buffer then gosub set.one.window
                     end

                     * Free memory for chunks currently in use
                     hd = buffer(k)<BUFF.HEAD> ; gosub release.chunks

                     if buffer(k)<BUFF.LOCKED> then
                        release file(k), buffer(k)<BUFF.RECORD.NAME>
                     end

                     * Free buffer, packing table if necessary   
                     if k < no.of.buffers then ;* Pack buffer table
                        for i = k to no.of.buffers - 1
                           buffer(i) = buffer(i + 1)
                           file(i) = file(i + 1)
                        next i
                     end

                     if len(buffer(no.of.buffers)<BUFF.FILE.NAME>) then
                        file(no.of.buffers) = 0 ;* Unidata fails with CLOSE
                     end
                     buffer(no.of.buffers) = ''
                     no.of.buffers -= 1

                     if k < current.buffer then current.buffer -= 1

                     exit
                  end
               next k

               * Go delete the record
               hush on   ;* Suppress error message re access rights
               recordlocku file(current.buffer), current.line
               delete file(current.buffer), current.line
               on error
                  message = sysmsg(6643) ;* Unable to delete item
                  goto error
               end
               hush off

               * Remove it from the explore display
               if line < mark.line then mark.line -= 1
               if other.live then 
                  if other.line > line then other.line -= 1
                  if other.top.line > line then other.top.line -= 1
               end
               gosub refresh.below
               if lines = 1 then  ;* Deleting last displayed record
                  current.line = '--- ' : sysmsg(6958) : ' ---'  ;* No records
                  line.updated = @true
                  gosub save.current
                  record.updated = @false
               end else
                  gosub delete.current
                  if line > lines then line -= 1
               end    
               gosub get.current  
               col = 1
            end

         case 1
            gosub read.only.buffer
      end case
   end else
      if last.low.level.action # F.KILL.LINE then kill.buffer = ""

      loop
         if col > line.len then col = line.len + 1

         if col > line.len then  ;* Wrap up next line
            if line <= lines then
               if mark.line > line then
                  mark.line -= 1
                  if mark.line = line then mark.col += col - 1
               end
               if other.live then
                  if other.line > line then other.line -= 1
                  if other.top.line > line then other.top.line -= 1
               end
               gosub refresh.below
               s = current.line

               if line = lines and s = '' then kill.buffer := @fm ;* 3.0-39

               gosub delete.current
               if line <= lines or s # '' then
                  kill.buffer := @fm
                  current.line = s : current.line
                  line.updated = @true
                  gosub save.current
               end
            end
         end else
            if mark.line = line then
               if mark.col >= col then mark.line = 0
            end
            kill.buffer := current.line[col, 99999999]
            current.line = current.line[1, col - 1]
            line.updated = @true
            gosub refresh.line
         end
         line.len = len(current.line)
         rpt -= 1
      while rpt and (line <= lines)
      repeat
   end
   return

* -----------------------------------------------------------------------------

a.toggle:
   if read.only then
      gosub read.only.buffer
      return
   end
   if col > line.len then col = line.len + 1
   if (col > 1) and (col <= line.len) then
      s = current.line[col - 1, 2]
      current.line[col - 1, 2] = s[2,1] : s[1,1]
      if line = mark.line then
         if col - 1 = mark.col then mark.col += 1
         else if col = mark.col then mark.col -= 1
      end
      line.updated = @true
      gosub refresh.line
   end
   return

* -----------------------------------------------------------------------------

a.align:
   if read.only then
      gosub read.only.buffer
      return
   end

   if line > 1 then
      * Fetch previous line
      n = line - 1
      gosub find.line
      s = chunk(ch)<fld>

      * Establish number of leading spaces in line
      n = len(s)
      for i = 1 to n
         if s[i,1] # ' ' then
            n = i - 1
            exit
         end
      next i

      * Establish number of leading spaces on current line
      z = line.len
      for i = 1 to z
         if current.line[i,1] # ' ' then
            z = i - 1
            exit
         end
      next i

      begin case
         case z < n    ;* Must add leading spaces
            n = n - z
            current.line = space(n) : current.line
            line.len = len(current.line)
            line.updated = @true
            gosub refresh.line

            if line = mark.line then mark.col += n
            col += n

         case z > n    ;* Must remove leading spaces
            n = z - n
            current.line = current.line[n + 1,99999999]
            line.len = len(current.line)
            line.updated = @true
            gosub refresh.line

            if line = mark.line then
               mark.col -= n
               if mark.col <= 0 then mark.line = 0
            end

            col -= n
            if col < 1 then col = 1
      end case
   end

   return

* -----------------------------------------------------------------------------

a.dncase.region:
   if not(mark.line) then goto no.mark
   gosub set.region
   processing.region = @true
   goto a.dncase.common

a.dncase:
   processing.region = @false

a.dncase.common:
   if read.only then
      gosub read.only.buffer
      return
   end
   loop
      gosub fwd.letter
   while line <= lines
      i = col
      loop
      while i <= line.len
         c = current.line[i, 1]
      while index(letters, c, 1)
         current.line[i, 1] = downcase(c)
         line.updated = @true
         i += 1
      repeat
      gosub save.current
      gosub refresh.line
      col = i

      if processing.region then
         if line > mark.line then exit
         if line = mark.line and col >= mark.col then exit
         continue
      end

      rpt -= 1
   while rpt
   repeat
   return

* -----------------------------------------------------------------------------

a.upcase.region:
   if not(mark.line) then goto no.mark
   gosub set.region
   processing.region = @true
   goto a.upcase.common

a.upcase:
   processing.region = @false

a.upcase.common:
   if read.only then
      gosub read.only.buffer
      return
   end

   loop
      gosub fwd.letter
   while line <= lines
      i = col
      loop
      while i <= line.len
         c = current.line[i, 1]
      while index(letters, c, 1)
         current.line[i, 1] = upcase(c)
         line.updated = @true
         i += 1
      repeat
      gosub save.current
      gosub refresh.line
      col = i

      if processing.region then
         if line > mark.line then exit
         if line = mark.line and col >= mark.col then exit
         continue
      end

      rpt -= 1
   while rpt
   repeat
   return

* -----------------------------------------------------------------------------

a.cap.init:
   if read.only then
      gosub read.only.buffer
      return
   end
   loop
      gosub fwd.letter
   while line <= lines
      i = col
      c = current.line[i, 1]
   while index(letters, c, 1)
      current.line[i, 1] = upcase(c)
      line.updated = @true
      i += 1

      loop
      while i <= line.len
         c = current.line[i, 1]
      while index(letters, c, 1)
         current.line[i, 1] = downcase(c)
         line.updated = @true
         i += 1
      repeat

      gosub save.current
      gosub refresh.line
      col = i

      rpt -= 1
   while rpt
   repeat
   return

* -----------------------------------------------------------------------------

a.close.spaces:
   if read.only then
      gosub read.only.buffer
      return
   end
   if current.line[col,1] = ' ' then
      i = col
      loop   ;* Slide col back to point to first space
      while col > 1
      while current.line[col - 1, 1] = ' '
         col -= 1
      repeat

      loop   ;* Set i to point after last space
        i += 1
      while current.line[i, 1] = ' '
      repeat

      current.line = current.line[1,col] : current.line[i,9999999]
      line.len = len(current.line)
      line.updated = @true

      if line = mark.line then
         if mark.col >= col and mark.col < i then mark.col = col
      end

      gosub refresh.line
   end
   return

* *****************************************************************************
* Cut and paste

a.kill:
   if read.only then
      gosub read.only.buffer
   end else
      if mark.line then
         gosub copy.region
         kill.buffer = region.text
         region.text = ''
         gosub delete.region
         mark.line = 0
      end
      else gosub no.mark
   end
   return

* -----------------------------------------------------------------------------

a.copy:
   gosub copy.region
   kill.buffer = region.text
   region.text = ''
   return

* -----------------------------------------------------------------------------

a.yank:
   if read.only then
      gosub read.only.buffer
      return
   end

   * 3.0-39  Make a copy of the kill buffer.  If we are inserting at the
   * bottom of the record and we have a trailing field mark, remove it.

   s = kill.buffer
   if line > lines and s[1] = @fm then
      s = s[1,len(s)-1]
      yank.at.bottom = @true
   end else
      yank.at.bottom = @false
   end

   kill.lines = count(s, @fm)
   final.line.len = if kill.lines then len(s<kill.lines + 1>) else len(s)

   loop
      if kill.lines then gosub refresh.below
      else gosub refresh.line

      current.line = current.line[1, col - 1] : s : current.line[col, 99999999]
      line.updated = @true
      gosub save.current

      if mark.line >= line then
         if mark.line > line then mark.line += kill.lines
         else if mark.col >= col then
            if kill.lines then
               mark.line += kill.lines
               mark.col += final.line.len + 1 - col
            end
            else mark.col += final.line.len
         end
      end
      if other.live then
         if other.line > line then other.line += kill.lines
         if other.top.line > line then other.top.line += kill.lines
      end

      if kill.lines then
         lines += kill.lines
         last.base = 99999999  ;* Restart line calculations
         chunk.lines(current.chunk) += kill.lines
         if chunk.lines(current.chunk) > SPLIT.LOAD then gosub split

         line += kill.lines
         col = final.line.len + 1
      end
      else col += final.line.len

      if yank.at.bottom then  ;* 3.0-39  Reposition if inserting at bottom
         line = lines + 1
         col = 1
      end

      gosub get.current

      rpt -= 1
   while rpt
   repeat

   gosub check.lcol
   return

* *****************************************************************************
* Macro processing

a.execute:
   if len(macro) then
      macro.rpt = rpt
      abort.macro = @false
      executing.macro = @true
      loop
         macro = macro   ;* Ensure no remove pointers
         loop
            remove rpt from macro setting macro.delim
         while macro.delim
            remove action from macro setting macro.delim
            remove n from macro setting macro.delim
            if num(n) then c = char(n)
            begin case
               case action = F.FWD.SEARCH or action = F.REV.SEARCH
                  remove search.string from macro setting macro.delim
                  if macro.delim and macro.delim # 2 then
                     loop
                        search.string := char(256 - macro.delim)
                        remove s from macro setting macro.delim
                        search.string := s
                     while macro.delim and macro.delim # 2
                     repeat
                  end

               case (action = F.REPLACE) or (action = F.QREPLACE)
                  remove search.string from macro setting macro.delim
                  if macro.delim and macro.delim # 2 then
                     loop
                        search.string := char(256 - macro.delim)
                        remove s from macro setting macro.delim
                        search.string := s
                     while macro.delim and macro.delim # 2
                     repeat
                  end

                  remove replacement.string from macro setting macro.delim
                  if macro.delim and macro.delim # 2 then
                     loop
                        replacement.string := char(256 - macro.delim)
                        remove s from macro setting macro.delim
                        replacement.string := s
                     while macro.delim and macro.delim # 2
                     repeat
                  end

               case action = F.IMPORT
                  remove import.file.name from macro setting macro.delim
                  if macro.delim and macro.delim # 2 then
                     loop
                        import.file.name := char(256 - macro.delim)
                        remove s from macro setting macro.delim
                        search.string := s
                     while macro.delim and macro.delim # 2
                     repeat
                  end

                  remove import.record.name from macro setting macro.delim
                  if macro.delim and macro.delim # 2 then
                     loop
                        import.record.name := char(256 - macro.delim)
                        remove s from macro setting macro.delim
                        replacement.string := s
                     while macro.delim and macro.delim # 2
                     repeat
                  end

               case action = F.RUN
                  remove ext.name from macro setting macro.delim

            end case

            gosub action.split
            last.low.level.action = action
            line.len = len(current.line)
         until abort.macro
         repeat
         macro.rpt -= 1
      until abort.macro
      while macro.rpt
      repeat
      executing.macro = @false
   end
   return

* *****************************************************************************
* Extension processing

a.bound.ext:
   ext.name = n

a.run:
   key.char = ''
   prefix.count = if rpt.set then rpt else -1
   ext.arg.count = 0
   abort.macro = @false
   gosub run.extension
   if ext.code then
      begin case
         case ext.code = 1
            message = sysmsg(6644, ext.name) ;* Extension %1 not found
         case ext.code = 2      ;* Terminated by (stop)
            message = ''
         case ext.code = 3      ;* Func where proc required
            message = 'Cannot run a FUNC extension'
         case ext.code = 6      ;* XEQ'd command failure
            message = ''
         case ext.code = 9      ;* Quit executed
            message = ''
         case 1
            message = sysmsg(6645, ext.code) ;* Error %1 running extension
      end case
      if len(message) then gosub error
   end
   return

* *****************************************************************************
* File handling

a.import:
   if read.only then
      gosub read.only.buffer
      return
   end

   open import.file.name to import.file else
      import.file.name = upcase(import.file.name)
      open import.file.name to import.file else
         message = "File not found. Press RETURN to continue."
         gosub file.msg
         gosub wait.return
         refresh.file = @true
         return
      end
   end

   read s from import.file, import.record.name then
      i = count(s, @fm) * rpt
      s = str(s, rpt)
      import.lines = count(s, @fm)
      if import.lines then final.line.len = len(s<import.lines + 1>)
      else final.line.len = len(s)

      current.line = current.line[1, col - 1] : s : current.line[col, 99999999]

      if mark.line >= line then
         if mark.line > line then mark.line += import.lines
         else if mark.col >= col then
            if import.lines then
               mark.line += import.lines
               mark.col += final.line.len + 1 - col
            end
            else mark.col += final.line.len
         end
      end
      if other.live then
         if other.line > line then other.line += import.lines
         if other.top.line > line then other.top.line += import.lines
      end

      lines += i
      chunk.lines(current.chunk) += i
      last.base = 99999999  ;* Restart line calculations
      line.updated = @true
      gosub save.current

      if chunk.lines(current.chunk) > SPLIT.LOAD then gosub split
      gosub get.current
      if i then gosub refresh.all
      else gosub refresh.line

      gosub check.lcol
   end else
      message = sysmsg(6646) ;* Record not found. Press RETURN to continue.
      gosub file.msg
      gosub wait.return
      refresh.file = @true
   end

   close import.file
   return

* -----------------------------------------------------------------------------

a.up.to.parent:
   if file.name = '' then goto scratch.buffer.err

   if buffer.type = BUFF.TYPE.VALUES then
      * Return from edit value mode, saving changes
      gosub save.current
      gosub assemble.record

      * Delete the value buffer
      if split.window then
         if other.live then gosub set.one.window
      end

      if buffer.itype then
         rec = change(rec, @fm, ';')
      end else
         rec = lower(rec)
      end
      hd = head ; gosub release.chunks ;* Free memory currently in use

      gosub return.to.parent.buffer

      * Write data back into parent record
      gosub get.current
      current.line = rec
      line.updated = @true
      gosub save.current
   end else if buffer.type # BUFF.TYPE.FILE.LIST then
      force.select = @false
      gosub explore
   end
   return

* *****************************************************************************
* Buffer management

a.next.buffer:
   i = mod(current.buffer + rpt - 1, no.of.buffers) + 1
   if i # current.buffer then
      gosub save.buffer
      current.buffer = i
      gosub get.buffer
   end
   if split.window then
      other.live = (current.buffer = other.buffer)
      if other.live then
         other.line = line
         other.col = col
      end
   end
   return

* -----------------------------------------------------------------------------

a.prev.buffer:
   i = current.buffer - mod(rpt, no.of.buffers)
   if i < 1 then i += no.of.buffers
   if i # current.buffer then
      gosub save.buffer
      current.buffer = i
      gosub get.buffer
   end
   if split.window then
      other.live = (current.buffer = other.buffer)
      if other.live then
         other.line = line
         other.col = col
      end
   end
   return

* -----------------------------------------------------------------------------

a.goto.buffer:
   if rpt > 0 and rpt <= no.of.buffers then
      if rpt # current.buffer then
         gosub save.buffer
         current.buffer = rpt
         gosub get.buffer
      end
      if split.window then
         other.live = (current.buffer = other.buffer)
         if other.live then
            other.line = line
            other.col = col
         end
      end
   end else
      message = sysmsg(6647) ;* Illegal buffer number
      gosub error
   end
   return

* -----------------------------------------------------------------------------

a.delete.buffer:
   loop
      begin case
         case no.of.buffers = 1
            message = sysmsg(6648) ;* Cannot delete only buffer
            gosub error
            return

         case buffer.type = BUFF.TYPE.EV.READ.ONLY.PARENT or buffer.type = BUFF.TYPE.EV.PARENT
            message = sysmsg(6974) ;* A value edit buffer exists for this record
            gosub error
            return

         case 1
            gosub save.buffer
   
            if record.updated then
               prefix = sysmsg(6649) ;* Delete modified buffer?
               gosub yes.no
               if aborted or not(yes) then return
            end

            if split.window then
               if other.live then gosub set.one.window
            end

            hd = head ; gosub release.chunks ;* Free memory currently in use
   
            if buffer(current.buffer)<BUFF.LOCKED> then
               release file(current.buffer), buffer(current.buffer)<BUFF.RECORD.NAME>
            end

            if buffer.type = BUFF.TYPE.VALUES then
               gosub return.to.parent.buffer
            end else 
               gosub delete.current.buffer  
               if current.buffer > no.of.buffers then current.buffer = no.of.buffers
               gosub get.buffer
            end

            gosub get.current
      end case
      rpt -= 1
   while rpt
   repeat
   return

* -----------------------------------------------------------------------------

a.comprun:
   begin case
      case len(dict.flag)
         message = sysmsg(6684) ;* Cannot compile dictionary item.
         gosub error
         return

      case read.only
         gosub read.only.buffer
         return

      case 1
         gosub save.current
         if record.updated then gosub save.record
         gosub clear.screen
         printer close
         printer reset
         execute 'BASIC ' : file.name : ' ' : record.name
         unload.object
         if @system.return.code = 0 then    ;* Compilation failed
            gosub press.return
            gosub clear.screen
            gosub refresh.all
            return
         end

         * Now run the program

         gosub clear.screen
         gosub reset.term.state
         execute 'RUN ' : file.name : ' ' : record.name trapping aborts
         gosub get.set.term.state
         gosub press.return
         gosub clear.screen
         gosub refresh.all
   end case

   return

* ****************************************************************************
*                              SUPPORT FUNCTIONS
* ****************************************************************************
* Word based functions

fwd.letter:
   loop
      loop
      while col > line.len
         if line > lines then return
         gosub save.current
         line += 1
         col = 1
         gosub get.current
      repeat
   until index(letters, current.line[col, 1], 1) or line > lines
      col += 1
   repeat
   return

* -----------------------------------------------------------------------------

fwd.non.letter:
   i = col
   loop
   while i <= line.len
   while index(letters, current.line[i, 1], 1) and line <= lines
      i += 1
   repeat
   col = i
   return

* -----------------------------------------------------------------------------

bkwd.letter:
   loop
      loop
      while col = 1
         if line = 1 then return
         gosub save.current
         line -= 1
         gosub get.current
         col = line.len + 1
      repeat
      col -= 1
   until index(letters, current.line[col, 1], 1)
   repeat
   return

* -----------------------------------------------------------------------------

bkwd.non.letter:
   loop
      if col = 1 then
         if line = 1 then return
         gosub save.current
         line -= 1
         gosub get.current
         col = line.len + 1
         return
      end
      col -= 1
   while index(letters, current.line[col, 1], 1)
   repeat
   return

*****************************************************************************
* Text region functions

set.region:
   if col > line.len then col = line.len + 1
   gosub save.current

   if mark.line < line or (mark.line = line and mark.col < col) then
      n = mark.line
      mark.line = line
      line = n
      n = mark.col
      mark.col = col
      col = n
      gosub get.current
   end

   return


find.region:
   gosub save.current
   if (mark.line < line) or ((mark.line = line) and (mark.col <= col)) then
      region.start.line = mark.line
      region.start.col = mark.col
      region.end.line = line
      region.end.col = col
   end
   else
      region.start.line = line
      region.start.col = col
      region.end.line = mark.line
      region.end.col = mark.col
   end

   if region.start.line > lines then
      region.start.line = lines
      region.start.col = 1
   end

   n = region.start.line
   gosub find.line
   region.start.chunk = ch
   region.start.fld = fld

   if region.end.line > lines then
      region.end.line = lines
      region.end.col = 999999
   end
   n = region.end.line

   gosub find.line
   region.end.chunk = ch
   region.end.fld = fld

   return

copy.region:   ;* Returns region in region.text
   if col > line.len then col = line.len + 1
   region.text = ''
   if mark.line then
      gosub find.region
      if region.start.chunk = region.end.chunk then ;* All in one chunk
         if region.start.fld = region.end.fld then  ;* All in one field
            n = region.end.col - region.start.col
            region.text = chunk(region.start.chunk)<region.start.fld>[region.start.col, n]
         end
         else                                       ;* Spans fields in chunk
            if region.start.fld = 1 then i = region.start.col
            else i = index(chunk(region.start.chunk), @fm, region.start.fld - 1) + region.start.col
            j = index(chunk(region.end.chunk), @fm, region.end.fld - 1) + region.end.col
            region.text = chunk(region.start.chunk)[i, j - i]
         end
      end
      else                                          ;* Spans chunks
         region.text = field(chunk(region.start.chunk), @fm, region.start.fld, 999999)[region.start.col,99999999]
         n = region.start.chunk
         loop
            n = chunk.next(n)
         while n # region.end.chunk
            region.text<-1> = chunk(n)
         repeat
         if region.end.fld > 1 then
            region.text<-1> = field(chunk(region.end.chunk), @fm, 1, region.end.fld - 1)
         end
         region.text<-1> = chunk(region.end.chunk)<region.end.fld>[1, region.end.col - 1]
      end
   end
   else gosub no.mark
   return

delete.region:
   * Make a new chunk containing all of the region start chunk before the
   * region start position and all of the region end chunk after the region
   * end position

   i = region.start.col - 1
   if region.start.fld > 1 then
      i += index(chunk(region.start.chunk), @fm, region.start.fld - 1)
   end
   s = chunk(region.start.chunk)[1,i]

*  if region.start.fld > 1 then
*     s = field(chunk(region.start.chunk), @fm, 1, region.start.fld - 1)
*     if len(s) then s := @fm
*  end
*  else s = ""
*
*  s := chunk(region.start.chunk)<region.start.fld>[1, region.start.col - 1]

   if region.end.fld = 1 then i = region.end.col
   else i = index(chunk(region.end.chunk), @fm, region.end.fld - 1) + region.end.col
   s := chunk(region.end.chunk)[i,99999999]

   chunk(region.start.chunk) = s
   i = dcount(chunk(region.start.chunk), @fm)
   if i = 0 then i = 1
   chunk.lines(region.start.chunk) = i
      
   if region.start.chunk # region.end.chunk then
      * Delete all chunks after the start chunk up to and including the end
      * chunk.

      n = chunk.next(region.start.chunk)         ;* First to delete
      chunk.next(region.start.chunk) = chunk.next(region.end.chunk)  ;* Dechain

      * Release memory used by chunk text
      i = n
      loop
         chunk(i) = ""
         free.chunks += 1
      until i = region.end.chunk
         i = chunk.next(i)
      repeat

      * Add deleted chunks to head of free chain
      chunk.next(region.end.chunk) = free.chain
      free.chain = n
   end

   if region.start.line = region.end.line then
      if line > lines then line = lines  ;* 1.1-30 Deleted final line
      gosub get.current
      gosub refresh.line
   end else 
      lines -= region.end.line - region.start.line
      line = region.start.line

      last.base = 99999999 ;* Force restart of line calculations
      gosub get.current
      if chunk.lines(ch) < MERGE.LOAD then gosub merge
      gosub refresh.all
   end

   record.updated = @true
   col = region.start.col

   if mark.line >= region.start.line then
      if mark.line >= region.end.line then  ;* Mark on or after end line
         if mark.line = region.end.line then
            if mark.col >= region.end.col then
               mark.col -= region.end.col - region.start.col
            end
            else mark.line = 0 ;* Mark was in deleted part
         end
         else mark.line -= region.end.line - region.start.line
      end
      else mark.line = 0       ;* Mark was on a line which has been deleted
   end

   if other.live then
      if other.line >= region.start.line then
         if other.line < region.end.line then  ;* Was in deleted text
            other.line = region.start.line + 1
         end else                              ;* Was after deleted text
            other.line -= region.end.line - region.start.line
         end
      end
      if other.top.line >= region.start.line then
         if other.top.line < region.end.line then  ;* Was in deleted text
            other.top.line = region.start.line + 1
         end else                              ;* Was after deleted text
            other.top.line -= region.end.line - region.start.line
         end
      end
   end

   return

*****************************************************************************
* FSEARCH  -  Forward search
*
* advance = columns to advance before search start (0 or 1)

fsearch:
   begin case
      case search.mode = CASE.SENSITIVE
         match.case = @true
         word.mode = @false
      case search.mode = CASE.INSENSITIVE
         match.case = @false
         word.mode = @false
      case search.mode = WORD.SEARCH
         match.case = @false
         word.mode = @true
         word.chars = letters
      case search.mode = BWORD.SEARCH
         match.case = @false
         word.mode = @true
         word.chars = letters : bchars
   end case

   if not(match.case) then u.search.string = upcase(search.string)

   if not(executing.macro or execution.depth) then
      if first.search then
         message = "Searching..."
         gosub file.msg
         first.search = @false
         refresh.file = @true
      end
   end

   found = @true

   * Check current line
   if match.case then i = index(current.line[col + advance, 99999999], search.string, 1)
   else i = index(upcase(current.line[col + advance, 99999999]), u.search.string, 1)

   if word.mode and i then
      j = col + advance + i - 1
      if j > 1 and index(word.chars, current.line[j - 1,1], 1) then i = 0
      c = current.line[j + len(search.string),1]
      if c # '' and index(word.chars, c, 1) then i = 0
   end

   if i then
      col += advance + i - 1
      return
   end

   * Check the rest of the current chunk

   gosub save.current

   n = line + 1
   gosub find.line           ;* Find the next line details if...
   if ch then                ;* ...there is a next line
      s = field(chunk(ch), @fm, fld, 9999999)
      if not(match.case) then s = upcase(s)
      occ = 1
      loop
         if match.case then i = index(s, search.string, occ)
         else i = index(s, u.search.string, occ)
      while word.mode and i  ;* Found string during word search
      c = s[i + len(search.string),1]
      while (c # '' and index(word.chars, c, 1)) or (i > 1 and index(word.chars, s[i - 1,1], 1))
         occ += 1
      repeat

      if i then
         line += count(s[1,i], @fm) + 1
         gosub get.current

         * We now have the line that contains the string. If we are doing a
         * word search we still need to skip over leading matches that are
         * not words.

         occ = 1
         loop
            if match.case then col = index(current.line, search.string, occ)
            else col = index(upcase(current.line), u.search.string, occ)
         while word.mode 
         c = current.line[col + len(search.string),1]
         while (c # '' and index(word.chars, c, 1)) or (col > 1 and index(word.chars, current.line[col - 1,1], 1))
            occ += 1
         repeat

         return
      end

      * Check subsequent chunks

      offset = last.base - line
      loop
         offset += chunk.lines(ch)
         ch = chunk.next(ch)
      while ch
         s = chunk(ch)
         if not(match.case) then s = upcase(s)
         occ = 1
         loop
            if match.case then i = index(s, search.string, occ)
            else i = index(s, u.search.string, occ)
         while word.mode and i  ;* Found string during word search
         c = s[i + len(search.string),1]
         while (c # '' and index(word.chars, c, 1)) or (i > 1 and index(word.chars, s[i - 1,1], 1))
            occ += 1
         repeat

         if i then
            line += offset + count(chunk(ch)[1,i], @fm)
            gosub get.current

            * We now have the line that contains the string. If we are doing a
            * word search we still need to skip over leading matches that are
            * not words.

            occ = 1
            loop
               if match.case then col = index(current.line, search.string, occ)
               else col = index(upcase(current.line), u.search.string, occ)
            while word.mode 
            c = current.line[col + len(search.string),1]
            while (c # '' and index(word.chars, c, 1)) or (col > 1 and index(word.chars, current.line[col - 1,1], 1))
               occ += 1
            repeat

            return
         end
      repeat
   end

   found = @false
   return

*****************************************************************************
* RSEARCH  -  Reverse search

rsearch:
   begin case
      case search.mode = CASE.SENSITIVE
         match.case = @true
         word.mode = @false
      case search.mode = CASE.INSENSITIVE
         match.case = @false
         word.mode = @false
      case search.mode = WORD.SEARCH
         match.case = @false
         word.mode = @true
         word.chars = letters
      case search.mode = BWORD.SEARCH
         match.case = @false
         word.mode = @true
         word.chars = letters : bchars
   end case

   if not(match.case) then u.search.string = upcase(search.string)

   if not(executing.macro or execution.depth) then
      if first.search then
         message = "Searching..."
         gosub file.msg
         first.search = @false
         refresh.file = @true
      end
   end

   found = @true

   * Check current line
   s = current.line[1, col + len(search.string) - 2]
   if match.case then
      occ = count(s, search.string)
   end else
      s = upcase(s)
      occ = count(s, u.search.string)
   end

   loop
      i = 0
   while occ
      if match.case then i = index(s, search.string, occ)
      else i = index(s, u.search.string, occ)
   while word.mode and i  ;* Found string during word search
   c = s[i + len(search.string),1]
   while (c # '' and index(word.chars, c, 1)) or (i > 1 and index(word.chars, s[i - 1,1], 1))
      occ -= 1
   repeat

   if i then
      col = i
      return
   end

   * Check the current chunk prior to the current line

   gosub save.current
   if current.fld > 1 then        ;* ...this is not the first line in the chunk
      s = field(chunk(current.chunk), @fm, 1, current.fld - 1)
      if match.case then
         occ = count(s, search.string)
      end else
         s = upcase(s)
         occ = count(s, u.search.string)
      end
   
      loop
         i = 0
      while occ
         if match.case then i = index(s, search.string, occ)
         else i = index(s, u.search.string, occ)
      while word.mode and i  ;* Found string during word search
      c = s[i + len(search.string),1]
      while (c # '' and index(word.chars, c, 1)) or (i > 1 and index(word.chars, s[i - 1,1], 1))
         occ -= 1
      repeat

      if i then
         line -= current.fld - (count(s[1,i], @fm) + 1)
         gosub get.current

         * We now have the line that contains the string. If we are doing a
         * word search we still need to skip over trailing matches that are
         * not words.

         if match.case then
            s = current.line
            occ = count(s, search.string)
         end else
            s = upcase(current.line)
            occ = count(s, u.search.string)
         end

         loop
            if match.case then col = index(s, search.string, occ)
            else col = index(s, u.search.string, occ)
         while word.mode 
         c = current.line[col + len(search.string),1]
         while (c # '' and index(word.chars, c, 1)) or (col > 1 and index(word.chars, current.line[col - 1,1], 1))
            occ -= 1
         repeat

         return
      end
   end

   * Check earlier chunks

   n = line
   gosub find.line

   loop
      n -= fld     ;* Last line in previous chunk
   while n
      gosub find.line

      if match.case then
         s = chunk(ch)
         occ = count(s, search.string)
      end else
         s = upcase(chunk(ch))
         occ = count(s, u.search.string)
      end
   
      loop
         i = 0
      while occ
         if match.case then i = index(s, search.string, occ)
         else i = index(s, u.search.string, occ)
      while word.mode and i  ;* Found string during word search
      c = s[i + len(search.string),1]
      while (c # '' and index(word.chars, c, 1)) or (i > 1 and index(word.chars, s[i - 1,1], 1))
         occ -= 1
      repeat

      if i then
         line = (n - fld) + count(s[1,i], @fm) + 1
         gosub get.current

         * We now have the line that contains the string. If we are doing a
         * word search we still need to skip over trailing matches that are
         * not words.

         if match.case then
            s = current.line
            occ = count(s, search.string)
         end else
            s = upcase(current.line)
            occ = count(s, u.search.string)
         end

         loop
            if match.case then col = index(s, search.string, occ)
            else col = index(s, u.search.string, occ)
         while word.mode 
         c = current.line[col + len(search.string),1]
         while (c # ''and index(word.chars, c, 1)) or (col > 1 and index(word.chars, current.line[col - 1,1], 1))
            occ -= 1
         repeat

         return
      end
   repeat

   found = @false
   return

*****************************************************************************
* REPLACE  -  Replace strings

replace:
   first.search = @true
   loop
      advance = 0
      gosub fsearch
   while found
      if query.replacement then
         first.search = @true   ;* Display 'Searching...' again next time
         gosub update.screen

         message = sysmsg(6650) ;* Replace? (Space = replace, Return = skip, Cancel = abort)
         gosub file.msg
         gosub place.cursor

         loop
            gosub get.key
            begin case
               case action = F.CANCEL
                  goto abort.replace
               case action = F.NEWLINE
                  col += 1
                  goto no.replace
               case action = F.INSERT and c = ' '
                  exit
               case 1
                  display @sys.bell :
            end case
         repeat
      end

      i = col + len(search.string)

      if line = mark.line then
         if mark.col >= col then
            if mark.col >= i then mark.col += len(replacement.string) - len(search.string)
            else mark.line = 0  ;* Mark was in replaced text
         end
      end

      current.line = current.line[1, col - 1] : replacement.string : current.line[i, 99999999]
      col += len(replacement.string)
      gosub refresh.line
      line.updated = @true

no.replace:
   repeat

abort.replace:
   refresh.file = @true
   return

*****************************************************************************
* GET.CURRENT  -  Get current line

get.current:
   if line <= lines then
      n = line
      gosub find.line
      current.chunk = ch
      current.fld = fld
      current.line = chunk(ch)<fld>
   end else 
     n = lines
     gosub find.line
     current.chunk = ch
     current.fld = fld + 1
     current.line = ""
   end
   line.len = len(current.line)
   line.updated = @false
   return

*****************************************************************************
* SAVE.CURRENT  -  Save current line

save.current:
   if line.updated then
      if not(record.updated) then
         refresh.file = @true
         record.updated = @true
      end

      chunk(current.chunk)<current.fld> = current.line
      if line > lines then     ;* Adding new line at end
* 0060  Was chunk.lines(ch) += 1
         chunk.lines(current.chunk) += 1
         lines += 1
      end
      line.updated = @false
   end

   return

*****************************************************************************
* FIND.LINE  -  Return chunk and offset of a line
*
* Input:      N    Desired line number (not changed)
*
* Output:     CH   Chunk index (0 if not found)
*             FLD  Field number 

find.line:
   if n < last.base then  ;* Start at head of chain
      ch = head
      base = 1
   end else               ;* Use current line as shortcut
      ch = last.chunk
      base = last.base
   end

   loop
   while n >= (base + chunk.lines(ch))
       base += chunk.lines(ch)
       ch = chunk.next(ch)
       if ch = 0 then return
   repeat

   last.base = base
   last.chunk = ch

   fld = (n - base) + 1

   return

*****************************************************************************
* INSERT.LINE  -  Insert a new line below the current line, making current

insert.line:
   current.fld += 1
   ins "" before chunk(current.chunk)<current.fld>
   chunk.lines(current.chunk) += 1
   lines += 1
   line += 1
   if chunk.lines(current.chunk) > SPLIT.LOAD then gosub split
   return

*****************************************************************************
* DELETE.CURRENT  -  Delete current record, make next (if any) current

delete.current:
   if line <= lines then
      n = line
      gosub find.line

      if (lines > 1) then
         del chunk(ch)<fld>
         chunk.lines(ch) -= 1
         lines -= 1

         if chunk.lines(ch) < MERGE.LOAD then gosub merge
      end
      else             ;* Deleting only line - replace it by a blank line
         chunk(ch)<fld> = ""
      end

      gosub get.current
   end

   return

*****************************************************************************
* SPLIT  -  Split current chunk

split:
   loop
   while chunk.lines(current.chunk) > SPLIT.LOAD
      if free.chain = 0 then      ;* Must allocate new free chunk
         n = 10
         gosub allocate.chunks
      end

      next.chunk = free.chain
      free.chain = chunk.next(next.chunk)
      free.chunks -= 1

      chunk(next.chunk) = field(chunk(current.chunk), @fm, IDEAL.LOAD + 1, 999999)
      chunk.lines(next.chunk) = chunk.lines(current.chunk) - IDEAL.LOAD
      chunk.next(next.chunk) = chunk.next(current.chunk)

      chunk(current.chunk) = field(chunk(current.chunk), @fm, 1, IDEAL.LOAD)
      chunk.lines(current.chunk) = IDEAL.LOAD
      chunk.next(current.chunk) = next.chunk

      if current.fld > IDEAL.LOAD then ;* Current line in new chunk
         current.fld -= IDEAL.LOAD
         current.chunk = next.chunk
      end
   repeat

   return

*****************************************************************************
* MERGE  -  Merge current chunk with an adjacent one

merge:
   * We merge with the adjacent chunk that has fewest lines

   * Find the previous chunk (if any)

   if current.chunk # head then
      prev.chunk = head
      loop
         z = chunk.next(prev.chunk)
      until z = current.chunk
         prev.chunk = z
      repeat
   end
   else prev.chunk = 0

   next.chunk = chunk.next(current.chunk)
   if next.chunk = 0 then                      ;* This is the final chunk
      if prev.chunk = 0 then return        ;* This is the only chunk
      * Fall through to merge with previous chunk
   end else                            ;* There is a next chunk
      if prev.chunk # 0 then
         if chunk.lines(prev.chunk) < chunk.lines(next.chunk) then
            goto merge.previous
         end
      end

      * Merge with following chunk

      chunk(current.chunk)<-1> = chunk(next.chunk)
      chunk.lines(current.chunk) += chunk.lines(next.chunk)
      chunk.next(current.chunk) = chunk.next(next.chunk)
      
      chunk.next(next.chunk) = free.chain
      free.chain = next.chunk
      free.chunks += 1

      goto check.split
   end

merge.previous:
   * Merge with previous chunk

   chunk(prev.chunk)<-1> = chunk(current.chunk)
   current.fld += chunk.lines(prev.chunk)

   chunk.lines(prev.chunk) += chunk.lines(current.chunk)
   chunk.next(prev.chunk) = chunk.next(current.chunk)
     
   chunk.next(current.chunk) = free.chain
   free.chain = current.chunk
   free.chunks += 1

   current.chunk = prev.chunk
   last.base = 99999999

check.split:
   * Although we have just merged two chunks, we could need to split the
   * newly formed chunk to even out the load.

   if chunk.lines(current.chunk) > SPLIT.LOAD then gosub split

   return

*****************************************************************************
* SAVE.RECORD  -  Save modified record

save.record:
   if file.name = '' then goto scratch.buffer.err

   if read.only then
      gosub read.only.buffer
      return
   end

   if buffer.type = BUFF.TYPE.EV.READ.ONLY.PARENT or buffer.type = BUFF.TYPE.EV.PARENT then
      message = sysmsg(6974) ;* A value edit buffer exists for this record
      gosub error
      return
   end

   if buffer.type = BUFF.TYPE.VALUES then
      message = sysmsg(6975) ;* This is a value edit buffer
      gosub error
      return
   end

   gosub save.current
   gosub save.buffer

   message = sysmsg(6651) ;* Writing record...
   gosub status.msg
   gosub refresh.status
   gosub assemble.record

   write.allowed = @true

   * Process source control actions if required

   if source.control.active < 0 then
      source.control.active = catalogued(source.control)
   end

   source.control.update = @false

   if source.control.active then
      call @source.control((dict.flag),
                           (file.name),
                           (record.name),
                            rec,
                           1,                  ;* Full screen editor
                           write.allowed,
                           source.control.update)
      prompt ''
      gosub clear.screen
      gosub refresh.all
   end

   if write.allowed then
      saved.ok = @true
      if abort.clause.on.write then
         writeu rec to file(current.buffer), record.name
         on error
            saved.ok = @false
            message = sysmsg(6652, status()) ;* Error %1 writing record
            if status() = ER$TRIGGER then
               message = sysmsg(3007, @trigger.return.code) ;* Data valdation error xx
            end
            gosub error
         end
      end else
         writeu rec to file(current.buffer), record.name
      end
   end else
      saved.ok = @false
      message = sysmsg(6653) ;* This record may not be written
      gosub error
   end

   if saved.ok then
      if source.control.update then gosub rebuild.chunks

      * Reconstruct full file/record name as it may have changed

      if len(dict.flag) then full.name = "DICT " : file.name : " " : record.name
      else full.name = file.name : " " : record.name
      full.name := buffer.comment

      gosub get.current
      record.updated = @false
   end else
      s = buffer(current.buffer)
      file.name = s<BUFF.FILE.NAME>
      dict.flag = s<BUFF.DICT.FLAG>
      record.name = s<BUFF.RECORD.NAME>
   end

   rec = ""
   refresh.file = @true

   return

* *****************************************************************************
*                          SCREEN HANDLING FUNCTIONS
* *****************************************************************************

yes.no:
   prefix := ' '
   loop
      s = ''
      gosub get.string
      c = upcase(s[1,1])
   until c = "Y" or c = "N" or aborted
      display @sys.bell :
   repeat

   yes = c = "Y"
   refresh.file = @true

   return

*****************************************************************************
parse.search:
   prefix = sysmsg(6654) ;* Search:
   s = search.string
   gosub get.search.string
   if not(aborted) then search.string = s
   return

*****************************************************************************
* get.string  -  Prompt for a string

   equ G.COMMAND to 1
   equ G.FILE    to 2
   equ G.SEARCH  to 3

get.command:
   get.mode = G.COMMAND
   get.line = status.line
   stack = command.stack
   goto get.string.common

get.file:
   get.mode = G.FILE
   get.line = status.line
   stack = file.stack
   goto get.string.common

get.search.string:
   get.mode = G.SEARCH
   get.line = file.line
   goto get.string.common

get.string:
   get.mode = 0
   get.line = status.line

get.string.common:
   stack.ptr = 0

* Save get.key return values
   gs.action = action
   gs.rpt = rpt
   gs.rpt.set = rpt.set
   gs.c = c
   gs.n = n

   gs.width = swm1 - len(prefix)
   gs.pan = 1
   gs = s

   aborted = @false
   gosub update.screen

   ss = prefix : gs[1,gs.width]
   display bar.attr :
   ln = get.line
   gosub zoned.update
   display attr :

   display @(len(prefix), get.line) :

   gosub get.key
   if action = F.NEWLINE then goto exit.get.string   ;* Use last string

   if action = F.INSERT then gs = ""   ;* Clear unless control character
   x = 1

   loop
      begin case
         case action = F.INSERT
            if overlay then
               if x <= len(gs) then gs[x, 1] = c
               else gs := c
            end else
               gs = gs[1, x - 1] : c : gs[x, 999]
            end
            x += 1

         case action = F.HOME
            x = 1

         case action = F.LEFT
            if x > 1 then x -= 1

         case action = F.DELETE
            gs = gs[1, x - 1] : gs[x + 1, 999]

         case action = F.END
            x = len(gs) + 1

         case action = F.RIGHT
            if x <= len(gs) then x += 1

         case action = F.CANCEL
            aborted = @true
            action = 0
            exit

         case action = F.BACKSPACE
            if x > 1 then
               x -= 1
               gs = gs[1, x - 1] : gs[x + 1, 999]
            end

         case action = F.KILL.LINE
            gs = gs[1, x - 1]

         case action = F.NEWLINE
            exit

         case action = F.YANK
            gs = gs[1, x - 1] : kill.buffer<1> : gs[x, 999]
            x += len(kill.buffer<1>)
            
         case action = F.REFRESH
            gosub clear.screen
            gosub refresh.all
            gosub update.screen

         case action = F.DOWN
            begin case
               case get.mode = G.COMMAND or get.mode = G.FILE
                  if stack.ptr > 1 then
                     stack.ptr -= 1
                     gs = stack<stack.ptr>
                  end else
                     stack.ptr = 0
                     gs = ''
                  end
                  x = 1

               case get.mode = G.SEARCH and not(collect)
                  search.mode -= 1
                  if search.mode = 0 then search.mode = NUM.SEARCH.MODES
                  gosub paint.status.line

               case 1
                  display @sys.bell :
            end case

         case action = F.UP
            begin case
               case get.mode = G.COMMAND or get.mode = G.FILE
                  if stack.ptr < dcount(stack, @fm) then
                     stack.ptr += 1
                     gs = stack<stack.ptr>
                     x = 1
                  end

               case get.mode = G.SEARCH and not(collect)
                  search.mode = rem(search.mode, NUM.SEARCH.MODES) + 1
                  gosub paint.status.line

               case 1
                  display @sys.bell :
            end case

         case 1
            display @sys.bell :
      end case

      if (x < gs.pan) or (x >= (gs.pan + gs.width)) then
         gs.pan = (int((x - 1) / PAN.INCREMENT) * PAN.INCREMENT) - 20
         if gs.pan <= 0 then gs.pan = 1
      end

      ss = prefix : gs[gs.pan, gs.width]
      display bar.attr :
      ln = get.line
      gosub zoned.update
      display attr :

      display @(len(prefix) + x - gs.pan, get.line) :
      gosub get.key
   repeat

   if not(aborted) then
      s = gs
      begin case
         case get.mode = G.COMMAND   ;* Update command stack
            if len(s) and s # command.stack<1> then
               ins s before command.stack<1>
               del command.stack<100>
            end
      end case
   end

exit.get.string:
   if get.line = file.line then gosub paint.file.line

* Restore get.key return values
   action = gs.action
   rpt = gs.rpt
   rpt.set = gs.rpt.set
   c = gs.c
   n = gs.n
   return

*****************************************************************************
* UPDATE.SCREEN  -  Update screen image

update.screen:
   if not(record.updated) then   ;* Ensure update flag shown on first change
      if line.updated then
         refresh.file = @true
         record.updated = @true
      end
   end

   * Horizontal panning checks

   if col > line.len then pan.col = line.len + 1
   else pan.col = col
   if (pan.col < pan) or (pan.col >= (pan + screen.width - lcol)) then
      pan = (int((pan.col - 1) / PAN.INCREMENT) * PAN.INCREMENT) - 20
      if pan <= 0 then pan = 1
      gosub refresh.all
   end

   * Vertical scrolling checks

   if (line < top.line) or (line >= (top.line + live.height)) then
      top.line = line - int(live.height / 2)
      if top.line < 1 then top.line = 1
      gosub refresh.all
   end

   * Refresh lines that have changed

   n = top.line       ;* Data record line
   for ln = live.top to live.btm
      i = ln + 1
      gosub check.keyready ; if keyready then goto exit.update.screen

      if refresh(i) then
         if n > lines then
            if image(i) # sw.space then
               display @(0, ln) : @(-4) :
               image(i) = sw.space
            end
         end else
            if n = line then ss = current.line[pan, screen.width]
            else
               gosub find.line
               ss = chunk(ch)<fld>[pan, screen.width]
            end

            if lcol then ss = (fmt(n, lcol.fmt) : ': ' : ss)[1, screen.width]
            gosub zoned.update
         end
         refresh(i) = @false
      end
      n += 1
   next ln

   if split.window then  ;* Update non-live half of window ("other" window)
      if other.live then     ;* Other window is live buffer
         * Refresh lines that have changed
         n = other.top.line       ;* Data record line
         for ln = other.top to other.btm
            i = ln + 1
            gosub check.keyready ; if keyready then goto exit.update.screen

            if refresh(i) then
               if n > lines then
                  if image(i) # sw.space then
                     display @(0, ln) : @(-4) :
                     image(i) = sw.space
                  end
               end else
                  if n = line then ss = current.line[pan, screen.width]
                  else
                     gosub find.line
                     ss = chunk(ch)<fld>[pan, screen.width]
                  end

                  if lcol then ss = (fmt(n, lcol.fmt) : ': ' : ss)[1, screen.width]
                  gosub zoned.update
               end
               refresh(i) = @false
            end
            n += 1
         next ln
      end else               ;* Some other buffer
         if refresh.other then       ;* Doing full refresh
            other.buff = buffer(other.buffer)

            other.file.line = if other.buff<BUFF.UPDATED> then '*' else ' '
            if len(other.buff<BUFF.DICT.FLAG>) then other.file.line := "DICT "
            other.file.line := other.buff<BUFF.FILE.NAME> : " " : other.buff<BUFF.RECORD.NAME>

            other.lcol = other.buff<BUFF.LNUM> + 0
            n = len(other.buff<BUFF.LINES>)
            if n < 4 then n = 4
            other.lcol.fmt = n : "'0'R"

            n = other.top.line       ;* Data record line
            ch = other.buff<BUFF.HEAD> + 0
            other.lines = other.buff<BUFF.LINES> + 0
            base = 1

            for ln = other.top to other.btm
               i = ln + 1
               if n > other.lines then
                  if image(i) # sw.space then
                     display @(0, ln) : @(-4) :
                     image(i) = sw.space
                  end
               end else
                  loop
                  while n >= (base + chunk.lines(ch))
                     base += chunk.lines(ch)
                     ch = chunk.next(ch)
                  while ch
                  repeat
                  ss = chunk(ch)<(n - base) + 1>[pan, screen.width]
   
                  if other.lcol then ss = (fmt(n, other.lcol.fmt) : ': ' : ss)[1, screen.width]
                  gosub zoned.update
               end
               refresh(i) = @false  ;* Ensure left clear
               n += 1
            next ln

            refresh.other = @false
         end
      end
   end

   if refresh.file and not(execution.depth) then
      gosub check.keyready  ; if keyready then goto exit.update.screen
      * Force repaint of entire line
      image(file.line + 1) = str(char(255), swm1) : ' '
      gosub paint.file.line ; refresh.file = @false
   end

   gosub check.keyready
   if keyready then goto exit.update.screen
   gosub paint.status.line

exit.update.screen:
   return

paint.file.line:
   display bar.attr :

   * Live window

   if record.updated then ss = "*"
   else ss = " "
   ss := fmt(full.name[1,swm2], swm2.fmt)
   ln = if split.window = 1 then split.line - 1 else file.line
   image(ln+1) = str(char(255), swm1):' ' ;* Force repaint of entire line
   gosub zoned.update

   if split.window then   ;* Do other window too
      ln = if split.window = 1 then file.line else split.line - 1
      image(ln+1) = str(char(255), swm1):' ' ;* Force repaint of entire line
      if other.live then   ;* Other window is live buffer
         if record.updated then ss = "*" else ss = " "
         ss := fmt(full.name[1,swm2], swm2.fmt)
      end else             ;* Other window is some other buffer
         ss = fmt(other.file.line[1,swm2], swm2.fmt)
      end
      gosub zoned.update
   end

   display attr :

   return


paint.status.line:
*          1         2         3         4         5         6         7         8
* 12345678901234567890123456789012345678901234567890123456789012345678901234567890
*              |           |       |         |         |         |
*  lines         cur posn    macro   overlay   indent    search    prefix ct

   ss = "             |           |       |         |         |         |"
   ss[1, 12] = lines : " lines"

   if col > line.len then cc = line.len + 1
   else cc = col
   ss[16, 10] = line : "." : cc

   if collect then ss[28,5] = "Macro"

   if overlay then ss[36,7] = "Overlay"

   if indent then ss[46,7] = "Indent"

   begin case
      case search.mode = CASE.SENSITIVE
         ss[56,7] = "Case on"
      case search.mode = CASE.INSENSITIVE
         ss[55,8] = "Case off"
      case search.mode = WORD.SEARCH
         ss[55,9] = "Word"
      case search.mode = BWORD.SEARCH
         ss[55,9] = "BWord"
   end case

   display bar.attr :
   ln = status.line
   gosub zoned.update
   display attr :

   return

******************************************************************************
* Position cursor

place.cursor:
   if col > line.len then
      cx = (line.len + 1) - pan
      if cx < 0 then cx = 0
   end else
      cx = col - pan
   end

   display @(cx + lcol, live.top + line - top.line) :

   return

* **********************************************************************

check.lcol:
   if lcol = 0 then return
   if lines <= lcol.threshold then return

set.lcol:
   n = if lines < 10000 then 4 else len(lines)
   lcol.threshold = str('9', n) + 0  ;* Max lines without expanding
   lcol.fmt = n : "'0'R"
   lcol = n + 2
   gosub refresh.all
   return

* *****************************************************************************
* zoned.update  -  Update mimimum area of screen
* ln = line number
* ss = data for line

zoned.update:
   left = 0
   image.line = image(ln + 1)
   text.line = convert(banned, replacements, ss) : sw.space

   for cl = 1 to screen.width
      if text.line[cl,1] # image.line[cl,1] then
         left = cl ; right = cl
         loop
            cl += 1
         while cl <= screen.width
            if text.line[cl,1] # image.line[cl,1] then right = cl
         repeat

         w = (right - left) + 1
         zone.string = text.line[left,w]
         crt @(left-1, ln) : zone.string :
         image(ln+1)[left,w] = zone.string
         exit
      end
   next cl

   return

*****************************************************************************
* REFRESH.BELOW  -  Set refresh flags for current line and below

refresh.below:
   i = line - top.line
   if i < 0 then i = 0
   loop
   while i <= live.btm
      i += 1
      refresh(i) = @true
   repeat

   if other.live then
      i = line - other.top.line
      if i < 0 then i = 0
      loop
      while i <= other.btm
         i += 1
         refresh(i) = @true
      repeat
   end
   return

*****************************************************************************
refresh.line:
   refresh.line = live.top + line - top.line
   if refresh.line >= 0 and refresh.line <= live.btm then
      refresh(refresh.line + 1) = @true
   end

   if other.live then
      refresh.line = other.top + line - other.top.line
      if refresh.line >= 0 and refresh.line <= other.btm then
         refresh(refresh.line + 1) = @true
      end
   end
   return

*****************************************************************************
* REFRESH.ALL  -  Set all refresh flags

clear.screen:
   mat image = sw.space
   display attr : @(-1) :
   return

refresh.all:
   mat refresh = @true
   refresh.other = @true

refresh.status:
   ss = str(char(255), swm1) : ' '
   image(file.line + 1) = ss
   image(status.line + 1) = ss
   refresh.file = @true
   return

*****************************************************************************
* Get current terminal settings and set those we need

get.set.term.state:
   tty.modes = ttyget()
   execute "PTERM BREAK OFF"

   if pterm(PT$INVERT, -1) and not(no.invert) then
      execute 'PTERM CASE NOINVERT'
      keyin.case.conversion = @true
      keyin.from = 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ'
      keyin.to = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
   end

   return

* *****************************************************************************

reset.term.state:
   ttyset tty.modes

   return

*****************************************************************************

get.key:
* Returns action, c and n, rpt, rpt.set

   rpt = 1
   rpt.set = @false

   loop
      gosub getch

parse.key:
      n = seq(c)
      action = seq(action.list[n,1])
      if action then       ;* Single character action
         if action = F.BOUND.EXT then
            n = ext.func.bindings<n>
            return
         end
         exit
      end
      key.string = c 

      if n = 27 then  ;* Esc - Check for prefix count
         gosub getch
         c = upcase(c)
         if index("123456789", c, 1) then
            rpt = c + 0
            gosub update.screen
            loop
               display bar.attr : @(65, status.line) : (("Repeat " : rpt) "14L") : attr :
               gosub place.cursor
               gosub getch

            while index("0123456789", c, 1)
               rpt = (rpt * 10) + c
               if rpt > 99999 then
                  display @sys.bell :
                  display bar.attr : @(65, status.line) : space(14) : attr :
                  goto get.key  ;* Start again
               end
            repeat
            display bar.attr : @(65, status.line) : space(14) : attr :
            rpt.set = @true
            goto parse.key
         end
         key.string := c
      end

      loop
         locate key.string in keys<1> by 'AL' setting i then
            action = key.actions<i,1>
            goto key.found
         end

      while keys<i>[1,len(key.string)] = key.string
         gosub getch
         key.string := upcase(c)
      repeat

      display @sys.bell :
      rpt = 1
      rpt.set = @false
   repeat

key.found:
   begin case
      case action = F.BOUND.EXT
         n = key.actions<i,2>   ;* Extension name

      case action = F.QUOTE.CHAR
         action = F.INSERT  ;* For all except K mode below
         display bar.attr : @(0, file.line) : ("Quote char" swm1.fmt) : attr :
         gosub place.cursor

         gosub getch
         n = seq(c)
         u.c = upcase(c)
         begin case
            case n >= 48 and n <= 50   ;* Digit 0 - 2
               n -= 48
               for i = 1 to 2
                  display bar.attr : @(11, file.line) : fmt(n, "3'0'R") : attr :
                  gosub place.cursor
                  gosub getch
               while index("0123456789", c, 1)
                  n = (n * 10) + (seq(c) - 48)
               next i

               if n < 254 then  ;* Allow all except field mark and item mark
                  c = char(n)
               end else
                  display @sys.bell :
                  refresh.file = @true
                  gosub update.screen
                  goto get.key   ;* Start again
               end

            case u.c = 'V'
               c = @vm ; n = 253

            case u.c = 'S'
               c = @sm ; n = 252

            case u.c = 'T'
               c = @tm ; n = 251

            case u.c = 'K'
               action = F.KEY.CODE

            case n >= 254               ;* Field mark or item mark
               display @sys.bell :
               goto get.key   ;* Start again
         end case

         display bar.attr : @(0, file.line) : swm1.space : attr :
         refresh.file = @true
   end case

   return

*****************************************************************************
* check.keyready  -  Test if input waiting

check.keyready:
   if len(pending.char) then
      keyready = @true
      return
   end

   keyready = keyready()

   return

*****************************************************************************
* getch  -  Get a single keystroke to c

getch:
   if len(pending.char) then
      c = pending.char[1,1]
      pending.char = pending.char[2,999999]
   end else
      c = keyin()
      if keyin.case.conversion then convert keyin.from to keyin.to in c
   end

   return

*****************************************************************************
* Set default key bindings
 
set.default.bindings:
   bindings.name = ''

   key.rec = '@J@M'                ;* F.NEWLINE
   key.rec<-1> = '@A':char(209)    ;* F.HOME
   key.rec<-1> = '@E':char(210)    ;* F.END
   key.rec<-1> = '@B@[[D@[OD':char(203)    ;* F.LEFT
   key.rec<-1> = '@F@[[C@[OC':char(204)    ;* F.RIGHT
   key.rec<-1> = '@P@Z@[[A@[OA':char(205) ;* F.UP
   key.rec<-1> = '@N@[[B@[OB':char(206)    ;* F.DOWN
   key.rec<-1> = '@[<'              ;* F.TOP
   key.rec<-1> = '@[>'              ;* F.BOTTOM
   key.rec<-1> = '@[V':char(207)   ;* F.PAGE.UP
   key.rec<-1> = '@V':char(208)    ;* F.PAGE.DOWN
   key.rec<-1> = '@D':char(212)  ;* F.DELETE
   key.rec<-1> = '@H'               ;* F.BACKSPACE
   key.rec<-1> = '@K'               ;* F.KILL.LINE
   key.rec<-1> = '@X@S@XS'         ;* F.SAVE.RECORD
   key.rec<-1> = '@X@C@XC'         ;* F.QUIT
   key.rec<-1> = '@O':char(211)    ;* F.OVERLAY
   key.rec<-1> = '@I'               ;* F.TAB
   key.rec<-1> = '@[G'              ;* F.GOTO.LINE
   key.rec<-1> = '@T'               ;* F.TOGGLE
   key.rec<-1> = '@S@[S'           ;* F.FWD.SEARCH
   key.rec<-1> = '@XR'              ;* F.REPLACE
   key.rec<-1> = '@XQ'              ;* F.QREPLACE
   key.rec<-1> = '@X@X'             ;* F.SWAP.MARK
   key.rec<-1> = '@XE'              ;* F.EXECUTE
   key.rec<-1> = '@X@N'             ;* F.NUDGE.DOWN
   key.rec<-1> = '@X@P@X@Z'        ;* F.NUDGE.UP
   key.rec<-1> = '@[.'              ;* F.MARK
   key.rec<-1> = '@W'               ;* F.KILL
   key.rec<-1> = '@[W'              ;* F.COPY
   key.rec<-1> = '@[Y@Y'           ;* F.YANK
   key.rec<-1> = '@[F'              ;* F.FWD.WORD
   key.rec<-1> = '@[D'              ;* F.DEL.WORD
   key.rec<-1> = '@XI'              ;* F.IMPORT
   key.rec<-1> = '@R@[R'           ;* F.REV.SEARCH
   key.rec<-1> = '@[L'              ;* F.LOWER.CASE
   key.rec<-1> = '@[U'              ;* F.UPPER.CASE
   key.rec<-1> = '@[C'              ;* F.CAP.INIT
   key.rec<-1> = '@[B'              ;* F.BACK.WORD
   key.rec<-1> = '@[@H'             ;* F.DEL.BACK.WORD
   key.rec<-1> = '@[ '              ;* F.CLOSE.SPACES
   key.rec<-1> = '@[N'              ;* F.NEXT.BUFFER
   key.rec<-1> = '@[P'              ;* F.PREV.BUFFER
   key.rec<-1> = '@XB'              ;* F.GOTO.BUFFER
   key.rec<-1> = '@XK'              ;* F.DELETE.BUFFER
   key.rec<-1> = '@XU'              ;* F.UP.TO.PARENT
   key.rec<-1> = '@C@U'            ;* F.REPEAT
   key.rec<-1> = '@L'               ;* F.REFRESH
   key.rec<-1> = '@Q@[Q'           ;* F.QUOTE.CHAR
   key.rec<-1> = '@X@B'             ;* F.LIST.BUFFERS
   key.rec<-1> = '@X@F'             ;* F.FIND.RECORD
   key.rec<-1> = '@X@W@XW'         ;* F.WRITE.RECORD
   key.rec<-1> = '@X('              ;* F.START.MACRO
   key.rec<-1> = '@X)'              ;* F.END.MACRO
   key.rec<-1> = '@X='              ;* F.EXPAND.CHAR
   key.rec<-1> = '@XD'              ;* F.EXPLORE
   key.rec<-1> = '@XX'              ;* F.EXPORT
   key.rec<-1> = '@[X'              ;* F.COMMAND
   key.rec<-1> = '@G'               ;* F.CANCEL
   key.rec<-1> = '@[E'              ;* F.RUN
   key.rec<-1> = '@[@I'             ;* F.ALIGN
   key.rec<-1> = '@X@U'             ;* F.UPCASE.REGION
   key.rec<-1> = '@X@L'             ;* F.DNCASE.REGION
   key.rec<-1> = '@X1'              ;* F.UNSPLIT.WINDOW
   key.rec<-1> = '@X2'              ;* F.SPLIT.WINDOW
   key.rec<-1> = '@XO'              ;* F.TOGGLE.WINDOW
   key.rec<-1> = '@X@D'             ;* F.DIVE
   key.rec<-1> = '@XM'              ;* F.COMPRUN
* !!BINDINGS!!

   gosub load.key.bindings

   return

*****************************************************************************

load.key.bindings:
   action.list = str(char(0), 31) : str(char(F.INSERT), 224)
   action.list[254,1] = char(0)  ;* Ban field mark
   action.list[255,1] = char(0)  ;* Ban item mark

   keys = ''
   key.actions = ''
   err = @false

   action = 1
   loop
      remove z from key.rec setting delim
      n = len(z)
      i = 1
      loop
      while i <= n
         c = z[i,1]
         j = seq(c)
      until c = '@' or j < 32 or j >= 127
         i += 1
      repeat

      z = z[i, 9999]   ;* Remove leading comment
      n = len(z)
      if n then
         for i = 1 to n
            if z[i,1] = '@' then
               j = index('ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_',z[i+1,1],1)
               if j then
                  z = z[1,i-1] : char(j) : z[i+2,999]
                  n -= 1
               end else if z[i,2] = '@@' then 
                  z = z[1,i] : z[i+2,999]
               end
            end
         next i

         n = seq(z[1,1])
         if n > 31 and n < 127 then
            display sysmsg(6655, action)
            * Key binding for action %1 does not start with a control character
            err = @true
         end else
            if len(z) = 1 then
               if n >= 127 or seq(action.list[n,1]) = 0 then
                  action.list[n,1] = char(action)
               end else
                  display sysmsg(6656, seq(action.list[n,1]), action)
                  * Duplicate key bindings. Actions %1 and %2
                  err = @true
               end
            end else
               if seq(action.list[n,1]) # 0 then
                  display sysmsg(6657, seq(action.list[n,1]), action)
                  * Ambiguous key bindings. Actions %1 and %2
                  err = @true
               end else
                  locate z in keys<1> by 'AL' setting i then
                  display sysmsg(6656, key.actions<i>, action)
                  * Duplicate key bindings. Actions %1 and %2
                     err = @true
                  end else
                     ins z before keys<i>
                     ins action before key.actions<i>
                  end
               end
            end
         end
      end
   while delim
      if delim = 2 then action += 1
   while action <= LAST.BINDABLE.ACTION
   repeat

   if err then gosub set.default.bindings

   return

* *****************************************************************************

insert.key.code:
   message = sysmsg(6658) ;* Press key for which encoding is to be inserted
   gosub file.msg

   c = keyin()  ;* This one must use keyin() directly, not getch

   sleep 1
   loop
      key.code = seq(c)
      if key.code < 32 then
         c = '@'
         rpt = 1
         gosub a.insert
         line.len = len(current.line)
         c = char(key.code+64)
      end
      rpt = 1
      gosub a.insert
      line.len = len(current.line)
      input c, -1
   while c
      c = keyin()  ;* This one must use keyin() directly, not getch
   repeat

   refresh.file = @true

   return

* *****************************************************************************
* binding.record.name = record name

save.key.bindings:
   gosub get.key.bindings

   key.rec = ''
   z = len(s)
   for i = 1 to z
      c = s[i,1]
      n = seq(c)
      if n < 32 then key.rec := '@' : char(n + 64)
      else key.rec := c
   next i

   for i = 1 to LAST.BINDABLE.ACTION
      key.rec<i> = fmt(field(actions, '|', i, 1), '16L') : key.rec<i>
   next i

   recordlocku bindings, binding.record.name
   write key.rec to bindings, binding.record.name

   return

* *****************************************************************************

get.key.bindings:
   s = ''

   for i = 1 to 255
      n = seq(action.list[i,1])
      if n and n <= LAST.BINDABLE.ACTION then s<n,-1> = char(i)
   next i

   z = dcount(keys, @fm)
   for i = 1 to z
      j = key.actions<i,1>
      if j <= LAST.BINDABLE.ACTION then s<j,-1> = keys<i>
   next i

   return

*****************************************************************************
* PRESS.RETURN - Display "Press return..." message and wait
* WAIT.RETURN  - Wait until return key is pressed

press.return:
   display sysmsg(6659) ;* Press RETURN to resume editing.

wait.return:
   loop
      gosub get.key
   until action = F.NEWLINE or action = F.CANCEL
   repeat

   return

*****************************************************************************
* WAIT.INPUT  -  Wait until a key is pressed

wait.input:
   if len(pending.char) = 0 then
      gosub place.cursor
      pending.char = keyin()
      if keyin.case.conversion then convert keyin.from to keyin.to in pending.char
   end

   return

*****************************************************************************
* READ.RECORD  -  Read record into current buffer

read.record:
   new.record = @false
   line.updated = @false
   record.updated = @false                 ;* No changes to record
   read.blocked.by.lock = @false
   aborted = @false
   line = 1        ;* Needed in status display below
   lines = 1
   col = 1
   pan = 1
   top.line = 1
   mark.line = 0              ;* No mark
   mark.col = 0
   line.len = 0
   line.updated = @false
   if lnum.all then gosub set.lcol else lcol = 0

   gosub clear.screen

* 1.2-32  Enter explore mode if record.name is null

   if record.name = '' then
      record.name = '--Explore--'
      if len(template) then record.name := ' ' : template

      message = sysmsg(6660) ;* Building list of records in file...
      gosub status.msg

      gosub build.explore.list

      lines = dcount(rec, @fm)
      read.only = @true
      record.locked = @false
      buffer.type = BUFF.TYPE.EXPLORE
      buffer.comment = ''
      gosub split.into.chunks
      gosub save.buffer
      gosub get.buffer    ;* Force reset of all sorts of things
   end else
      gosub set.unames

      if len(dict.flag) then full.name = "DICT "
      else full.name = ""
      full.name := file.name : " " : record.name : buffer.comment
      display bar.attr : @(0, file.line) : ((" " : full.name[1, swm2]) swm1.fmt) : attr
      display @(0,status.line) : bar.attr : swm1.space : attr :

      * Read record

      display @(0, status.line) : bar.attr : sysmsg(6661) : attr : ;* Reading record...

      read.only = @false
      record.locked = @true
      gosub set.unames
      buffer.type = BUFF.TYPE.DATA

      readu rec from file(current.buffer), record.name
      locked
         read rec from file(current.buffer), record.name then
            read.only = @true
            record.locked = @false
         end else
            message = sysmsg(6662) ;* Record is locked for creation by another user.
            gosub error
            read.blocked.by.lock = @true
            return
         end
      end else
         if current.buffer # 1 then
            current.line = ''     ;* Ensure old data not painted
            prefix = sysmsg(6663) ;* Create new record?
            gosub yes.no
            if aborted or not(yes) then
               release file(current.buffer), record.name
               record.locked = @false
               aborted = @true
               return
            end
         end

         rec = ""
         lines = 1
         new.record = @true
      end

* If this is a dictionary I-type item, truncate it to remove the compiled code.

      s = upcase(rec[1,1])
      if len(dict.flag) and listindex('A,C,I,S', ',', s) then
         rec = trim(field(rec, @fm, 1, DICT.SYS.INFO - 1), @fm, 'T')
      end

      lines = dcount(rec, @fm)
      if lines = 0 then lines = 1

      gosub split.into.chunks

      if read.only then
         gosub get.current
         message = sysmsg(6664) ;* Record is locked by another user. Read only access available
         gosub error
      end
   end

   if new.record then
      other.live = @false
      gosub get.current
      gosub refresh.all
      gosub update.screen
      display bar.attr : @(0, status.line) : ((sysmsg(6665) : '  ' : line : "." : col) swm1.fmt) : attr :
      gosub wait.input
   end

   gosub refresh.status
   return

* *****************************************************************************
* Reload current record

reload.record:
   readu rec from file(current.buffer), record.name then
      * Free memory for chunks currently in use
      hd = head ; gosub release.chunks

      lines = dcount(rec, @fm)
      if lines = 0 then lines = 1

      mark.line = 0              ;* Mark position lost
      mark.col = 0 

      * Split modified record
      gosub split.into.chunks
      gosub get.current
   end else
      message = sysmsg(6666) ;* Error reloading record.
      gosub error
   end

   return

*******************************************************************************
* split.into.chunks  -  Split record and set control variables

split.into.chunks:
   n = int((lines + IDEAL.LOAD - 1) / IDEAL.LOAD)   ;* No of required chunks
   n += 5 - free.chunks     ;* Allow 5 spare and use free space
   if n > 0 then gosub allocate.chunks

   head = free.chain

   j = IDEAL.LOAD
   remaining.lines = lines
   setrem 0 on rec
   loop
      i = free.chain               ;* Select chunk from free chain
      free.chain = chunk.next(i)
      free.chunks -= 1

      if j > remaining.lines then j = remaining.lines
      chunk(i) = removef(rec, j)
      chunk.lines(i) = j
      remaining.lines -= j
   while remaining.lines
      chunk.next(i) = free.chain
   repeat

   chunk.next(i) = 0
   rec = ""

   last.base = 999999999
   record.updated = @false                 ;* No changes to record
   line = 1
   line.len = 0
   col = 1
   top.line = 1
   pan = 1

   gosub refresh.all

   return

* *****************************************************************************
* Rebuild record chunks from rec dynamic array

rebuild.chunks:
   * Free memory for chunks currently in use
   hd = head ; gosub release.chunks

   lines = dcount(rec, @fm)
   if lines = 0 then lines = 1

   mark.line = 0              ;* Mark position lost
   mark.col = 0 

   * Split modified record
   gosub split.into.chunks

   return

*****************************************************************************
* assemble.record  -  Reconstruct rec from chunk chain

assemble.record:
   rec = chunk(head)
   ch = chunk.next(head)
   loop
   while ch
      rec := @fm : chunk(ch)
      ch = chunk.next(ch)
   repeat
   return

*****************************************************************************
* OPEN.FILE

open.file:
   open.ok = @true
   is.path = @false

   open dict.flag, file.name to file(current.buffer) else
      open dict.flag, upcase(file.name) to file(current.buffer) then
         file.name = upcase(file.name)
      end else open.ok = @false
   end

   if not(open.ok) then
      if dict.flag = '' and upcase(file.name)[1,5] = 'PATH:' then
         * Looks like we are opening by pathname. If the name specified is the
         * actual record to be opened, we need to modify the file name to be
         * the parent directory and return the final component of the pathname
         * as the record id. We need to do it this way so that the QM file table
         * is maintained properly and locking works.

         fpath = file.name[6,9999]
         if is.windows then fpath = change(fpath, '/', @ds) ;* PATH uses / on all platforms

         openseq fpath to fpath.f else
            fpath = upcase(fpath)
            openseq fpath to fpath.f else
               open.ok = @false
               return
            end
         end

         * We have found it

         closeseq fpath.f

         fpath.components = dcount(fpath, @ds)
         fpath.record.id = field(fpath, @ds, fpath.components)
         file.name = 'PATH:':field(fpath, @ds, 1, fpath.components - 1)
         if index(file.name, @ds, 1) = 0 then file.name := @ds

         open file.name to file(current.buffer) then
            open.ok = @true
            is.path = @true
         end
      end
   end

   return

*****************************************************************************
* FIND.FILE

find.file:
   if other.live then  ;* Was split live but no longer
      line = other.line
      col = other.col
   end

   gosub save.buffer

   prefix = sysmsg(6667) ;* File name:
   if len(dict.flag) then s = 'DICT ' : file.name
   else s = file.name
   gosub get.file
   s = trim(s)  ;* 2.2-35  Ensure no spaces after name
   if aborted or s = '' then return
   file.name = s

   if s # file.stack<1> then
      ins s before file.stack<1>
      del file.stack<10>
   end

   if (upcase(file.name[1,5]) = "DICT ") and len(file.name[6,999999]) then
      dict.flag = "DICT"
      file.name = file.name[6,999999]
   end else
      dict.flag = ""
   end

   rn = ''
   if index(file.name, ' ', 1) then
      open file.name to temp then
         temp = 0
      end else
         rn = field(file.name, ' ', 2)
         file.name = field(file.name, ' ', 1)
      end
   end

read.specific.record:     ;* Side entry from dive function

   no.of.buffers += 1
   old.buffer = current.buffer
   current.buffer = no.of.buffers
   buffer(current.buffer) = ''

   gosub open.file
   if not(open.ok) then
      message = sysmsg(2019) ;* File not found
      gosub error
      no.of.buffers -= 1
      current.buffer = old.buffer
      gosub get.buffer
      return
   end

   if len(rn) then
      s = rn
   end else
      prefix = sysmsg(6637) ;* Record:
      s = ""
      gosub get.string
      s = trimb(trimf(s))
   end

   if aborted or s = '' then
      no.of.buffers -= 1
      current.buffer = old.buffer
      gosub get.buffer
      return
   end
   record.name = s

   if len(rn) = 0 then file.stack<1> = file.stack<1> : ' ' : record.name

   * Check if we already have this record
   * Ensure we perform a string comparison otherwise buffer 0 and 00 are
   * the same

   for i = 1 to no.of.buffers - 1
      * Compare file names

      if compare(buffer(i)<BUFF.FILE.NAME>, file.name) then continue

      * Compare dictionary flags

      if compare(buffer(i)<BUFF.DICT.FLAG>, dict.flag) then continue

      * Compare record names, taking case insensitivity into account

      if buffer(i)<BUFF.UNAMES> then
         if compare(upcase(buffer(i)<BUFF.RECORD.NAME>), upcase(record.name)) then continue
      end else
         if compare(buffer(i)<BUFF.RECORD.NAME>, record.name) then continue
      end

      no.of.buffers -= 1
      current.buffer = i
      gosub get.buffer
      message = sysmsg(6668) ;* Old buffer
      gosub error
      return
   next i

   gosub read.record
   if read.blocked.by.lock or aborted then
      no.of.buffers -= 1
      current.buffer = old.buffer
      gosub get.buffer
      return
   end

   buffer.comment = ''

   buffer.tag = next.buffer.tag
   next.buffer.tag += 1

   gosub save.buffer      ;* Just to force...
   gosub get.buffer       ;* ...update of variables and screen

   if split.window then
      other.live = (current.buffer = other.buffer)
      refresh.other = @true
   end

   return

*****************************************************************************

write.record:
   refresh.file = @true
   prefix = sysmsg(6669) ;* Write file:
   if len(dict.flag) then s = "DICT " : file.name
   else s = file.name
   gosub get.string
   write.file.name = trimb(trimf(s))
   if write.file.name = '' or aborted then return

   if (upcase(write.file.name[1,5]) = "DICT ") and len(write.file.name[6,999999]) then
      write.dict.flag = "DICT"
      write.file.name = write.file.name[6,999999]
   end
   else write.dict.flag = ""

   write.record.name = field(write.file.name, ' ', 2) ;* Possible record id
   write.file.name = field(write.file.name, ' ', 1)   ;* File name

   open write.dict.flag, write.file.name to write.file else
      write.file.name = upcase(write.file.name)
      open write.dict.flag, write.file.name to write.file else
         message = sysmsg(6670) ;* File not found. Press RETURN to continue.
         gosub file.msg
         gosub wait.return
         refresh.file = @true
         return
      end
   end

   if write.record.name = '' then
      prefix = sysmsg(6637) ;* Record:
      s = if buffer.type = BUFF.TYPE.DATA then record.name else ''
      gosub get.string
      write.record.name = trimb(trimf(s))
      if write.record.name = '' then aborted = @true
   end


   if not(aborted) then
      readvu s from write.file, write.record.name, 0 locked
         message = sysmsg(1429, status()) ;* Record is locked by user %1
         gosub error
         aborted = @true
      end
      then
         prefix = sysmsg(6671) ;* Record exists. Overwrite?
         gosub yes.no
         aborted = aborted or not(yes)
         if aborted then release write.file, write.record.name
      end
   end

   if not(aborted) then
      if dict.flag # write.dict.flag or file.name # write.file.name or record.name # write.record.name then
         if not(read.only) and len(file.name) then
            release file(current.buffer), record.name  ;* Release existing lock
         end

         file(current.buffer) = write.file
         dict.flag = write.dict.flag
         file.name = write.file.name
         gosub set.unames
         record.name = write.record.name
         read.only = @false
         record.locked = @true
         buffer.type = BUFF.TYPE.DATA
      end
      gosub save.record

      * Check if this write has invalidated any explore buffers.  If so, we
      * need to regenerate the explore list.

      gosub rebuild.explore.buffer
   end

   write.file = 0

   return

*****************************************************************************

export:
   if not(mark.line) then
      gosub no.mark
      return
   end

   gosub copy.region

   refresh.file = @true
   prefix = "Export to file: "
   if len(dict.flag) then s = "DICT " : file.name
   else s = file.name
   gosub get.string
   write.file.name = trimb(trimf(s))
   if write.file.name = '' or aborted then return

   if (upcase(write.file.name[1,5]) = "DICT ") and len(write.file.name[6,999999]) then
      write.dict.flag = "DICT"
      write.file.name = write.file.name[6,999999]
   end
   else write.dict.flag = ""

   write.record.name = field(write.file.name, ' ', 2) ;* Possible record id
   write.file.name = field(write.file.name, ' ', 1)   ;* File name

   open write.dict.flag, write.file.name to write.file else
      write.file.name = upcase(write.file.name)
      open write.dict.flag, write.file.name to write.file else
         message = sysmsg(6670) ;* File not found. Press RETURN to continue.
         gosub file.msg
         gosub wait.return
         refresh.file = @true
         return
      end
   end

   if write.record.name = '' then
      prefix = sysmsg(6672) ;* Export record:
      s = ''
      gosub get.string
      write.record.name = trimb(trimf(s))
      if write.record.name = '' then aborted = @true
   end


   if not(aborted) then
      readvu s from write.file, write.record.name, 0 locked
         message = sysmsg(1429, status()) ;* Record is locked by user xx
         gosub error
         aborted = @true
      end
      then
         prefix = sysmsg(6671) ;* Record exists. Overwrite?
         gosub yes.no
         aborted = aborted or not(yes)
         if aborted then release write.file, write.record.name
      end
   end

   if not(aborted) then
      if abort.clause.on.write then
         write region.text to write.file, write.record.name
         on error
            message = sysmsg(6652, status()) ;* Error xx writing record
            gosub error
         end
      end else
         write region.text to write.file, write.record.name
      end

      * Check if this write has invalidated any explore buffers.  If so, we
      * need to regenerate the explore list.

      gosub rebuild.explore.buffer
   end

   write.file = 0
   region.text = ''

   return

******************************************************************************

a.dive:
   s = upcase(trim(field(current.line, ';', 1)))
   begin case
      case collect
         gosub not.now

      case no.of.buffers = MAX.BUFFERS
         message = sysmsg(6634) ;* Too many buffers.
         gosub error

      case buffer.type = BUFF.TYPE.EXPLORE
         if len(current.line) and not(current.line matches '--- 0X ---') then
            gosub dive
        end

      case buffer.type = BUFF.TYPE.FILE.LIST
         if len(current.line) then
            gosub dive.to.file
         end

      case field(s, ' ', 1) = '$INCLUDE' and dcount(s, ' ') >= 2
         if other.live then  ;* Was split live but no longer
            line = other.line
            col = other.col
         end
         gosub save.buffer
         s = trim(field(current.line, ';', 1))
         rn = field(s, ' ', 3)
         if rn = '' then rn = field(s, ' ', 2)
         else file.name = field(s, ' ', 2)
         dict.flag = ''
         gosub read.specific.record

      case buffer.type = BUFF.TYPE.DATA
         * Enter edit value mode by constructing a new buffer to hold a
         * raised copy of the current line.

         buffer.type = if read.only then BUFF.TYPE.EV.READ.ONLY.PARENT else BUFF.TYPE.EV.PARENT
         read.only = @true
         gosub save.buffer

         if dict.flag = 'DICT' and line = 2 and chunk(head)[1,1] = 'I' then
            * Split the I-type line sensibly (quotes and brackets 'protect' stuff)
            rec = ''
            parenthesis.level = 0
            s = current.line
            loop            
               c = s[1,1]
               begin case
                  case c = ''
                     exit

                  case c = '"' or c = "'" or c = '\'
                     j = index(s[1,9999999], c, 2)
                     if j = 0 then j = len(s)
                     rec := current.line[i,j]
                     s = s[j+1,9999999]

                  case parenthesis.level
                     rec := c
                     s = s[2,9999999]
                     if c = ')' then parenthesis.level -= 1

                  case c = ';'
                     rec := @fm
                     s = s[2,9999999]

                  case c = '('
                     parenthesis.level += 1
                     rec := c
                     s = s[2,9999999]

                  case 1
                     rec := c
                     s = s[2,9999999]
               end case
            repeat
            buffer.itype = @true
         end else
            rec = raise(current.line)
            buffer.itype = @false
         end

         record.name = record.name:' <Values>'
         buffer.parent = buffer.tag  ;* Remember where we came from
         no.of.buffers += 1
         current.buffer = no.of.buffers
         buffer(no.of.buffers) = ''
         buffer.type = BUFF.TYPE.VALUES
         buffer.comment = ''
         buffer.tag = next.buffer.tag
         next.buffer.tag += 1
         record.updated = @false
         read.only = @false
         record.locked = @false
         lines = dcount(rec, @fm) ; gosub split.into.chunks
         mark.line = 0 ; mark.col = 0
         lcol = 0
         gosub save.buffer
         gosub get.buffer    ;* Force reset of all sorts of things
         gosub get.current

      case 1
         gosub not.now
   end case

   return

******************************************************************************
dive.to.file:
   force.select = @false
   goto explore

a.explore:
   force.select = @true

explore:
   if other.live then  ;* Was split live but no longer
      line = other.line
      col = other.col
   end

   gosub save.buffer
   old.buffer = current.buffer

   template = ''
   building.file.list = @false

   if force.select then ;* Invite entry of file name, defaulting to current
      prefix = sysmsg(6667) ;* File name:
* 1.1-30 Include dict.flag in default file name
      if len(dict.flag) then s = 'DICT ' : file.name
      else s = file.name
* 1.1-30 end
      gosub get.string
      s = trimb(trimf(s))
      if aborted or s = '' then return
      file.name = s

      if (upcase(file.name[1,5]) = "DICT ") and len(file.name[6,999999]) then
         dict.flag = "DICT"
         file.name = file.name[6,999999]
      end
      else dict.flag = ""

      if index(file.name, ' ', 1) then
         template = field(file.name, ' ', 2, 999)
         file.name = field(file.name, ' ', 1)

         gosub check.template
         if len(message) then
            gosub error
            goto abort.explore
         end
      end
   end else
      begin case
         case buffer.type = BUFF.TYPE.EXPLORE
            file.name = 'VOC'
            dict.flag = ''
            template = 'WITH TYPE = "F"'   ;* UV Pick needs "F", not 'F'
            building.file.list = @true

         case buffer.type = BUFF.TYPE.FILE.LIST
            file.name = current.line
            template = ''
      end case
   end

   * Look for an explore buffer with this file name.
   * If not found, create it and set force.select flag.

   found = @false
   if building.file.list then
      for i = 1 to no.of.buffers
         if buffer(i)<BUFF.TYPE> = BUFF.TYPE.FILE.LIST then
            current.buffer = i
            gosub get.buffer
            found = @true
            exit
         end
      next i
   end else
      for i = 1 to no.of.buffers
         if buffer(i)<BUFF.TYPE> # BUFF.TYPE.EXPLORE then continue
         if buffer(i)<BUFF.FILE.NAME> # file.name then continue
         if buffer(i)<BUFF.DICT.FLAG> # dict.flag then continue

         current.buffer = i
         gosub get.buffer
         found = @true
         exit
      next i
   end

   if not(found) then
      if no.of.buffers = MAX.BUFFERS then
         message = sysmsg(6673) ;* No buffers available
         gosub error
         goto abort.explore
      end

      no.of.buffers += 1
      current.buffer = no.of.buffers
      buffer(no.of.buffers) = ''
      if building.file.list then
         record.name = '--Files--'
         buffer.type = BUFF.TYPE.FILE.LIST
      end else
         record.name = '--Explore--'
         if len(template) then record.name := ' ' : template
         buffer.type = BUFF.TYPE.EXPLORE
      end
      read.only = @true
      record.locked = @false
      buffer.comment = ''
      buffer.tag = next.buffer.tag
      next.buffer.tag += 1
      head = 0

      gosub open.file
      if not(open.ok) then
         message = "File not found."
         gosub error
         no.of.buffers -= 1
         goto abort.explore
      end

      force.select = @true
   end

   if force.select then  ;* Empty explore buffer and build new list
      if head then
         * Free memory for chunks currently in use
         hd = head ; gosub release.chunks
      end

      * Ensure buffer name is correct
      if building.file.list then
         record.name = '--Files--'
         message = "Building list of files in VOC..."
      end else
         record.name = '--Explore--'
         if len(template) then record.name := ' ' : template
         message = "Building list of records in file..."
      end
      gosub status.msg
      gosub build.explore.list

      lines = dcount(rec, @fm)
      gosub split.into.chunks

      if lnum.all then gosub set.lcol else lcol = 0

      gosub save.buffer
      gosub get.buffer    ;* Force reset of all sorts of things
   end

   if building.file.list then
      * Position cursor on file from which we entered this list

      s = buffer(old.buffer)<BUFF.FILE.NAME>
      i = head
      n = 0
      loop
         locate s in chunk(i)<1> setting j then
            line = j + n
            gosub get.current
            exit
         end
         n += chunk.lines(i)
         i = chunk.next(i)
      while i
      repeat
   end else
      * If we are exploring the file from which the previously displayed record
      * came, try to find that record in the list and position the cursor at it.

      if buffer(old.buffer)<BUFF.FILE.NAME> = file.name then
         if buffer(old.buffer)<BUFF.DICT.FLAG> = dict.flag then
            s = buffer(old.buffer)<BUFF.RECORD.NAME>
            i = head
            n = 0
            loop
               if buffer(old.buffer)<BUFF.UNAMES> then
                  z = upcase(chunk(i))
                  locate upcase(s) in z<1> setting j else j = 0
               end else
                  locate s in chunk(i)<1> setting j else j = 0
               end
               if j then
                  line = j + n
                  gosub get.current
                  exit
               end
               n += chunk.lines(i)
               i = chunk.next(i)
            while i
            repeat
         end
      end
   end

   return

abort.explore:
   current.buffer = old.buffer
   gosub get.buffer
   return

* **********************************************************************
* Build list of records in a file.
*
* In:
*   file.name = name of file to process
*   dict.flag = DICT or null
*   template  = selection criteria
* Out:
*   rec = result

build.explore.list:
   gosub set.unames

   if len(template) then
      s = 'SSELECT '
      if len(dict.flag) then s := 'DICT '
      s := file.name : ' ' : template : ' TO 1'
      hush on
      execute s
      hush off
   end else
      sselect file(current.buffer) to 1
   end

   readlist rec from 1 then
   end else rec = '--- ' : sysmsg(6958) : ' ---'

   return

*****************************************************************************

dive:
   if other.live then  ;* Was split live but no longer
      line = other.line
      col = other.col
   end

   gosub save.buffer
   old.buffer = current.buffer

   * Check if we already have this record

   s = file.name : @fm : current.line : @fm : dict.flag ;* Ensure string compare

   for i = 1 to no.of.buffers
      if buffer(i)<BUFF.FILE.NAME>:@fm:buffer(i)<BUFF.RECORD.NAME>:@fm:buffer(i)<BUFF.DICT.FLAG> = s then
         current.buffer = i
         gosub get.buffer
         return
      end
   next i

   if no.of.buffers = MAX.BUFFERS then
      message = sysmsg(6673) ;* No buffers available
      gosub error
      current.buffer = old.buffer
      gosub get.buffer
      return
   end

   no.of.buffers += 1
   current.buffer = no.of.buffers
   buffer(current.buffer) = ''
   file(current.buffer) = file(old.buffer)
   record.name = current.line
   gosub read.record
   if read.blocked.by.lock or aborted then
      no.of.buffers -= 1
      current.buffer = old.buffer
      gosub get.buffer
      return
   end

   buffer.tag = next.buffer.tag
   next.buffer.tag += 1

   gosub save.buffer      ;* Just to force...
   gosub get.buffer       ;* ...update of variables and screen

   return

*****************************************************************************

* Validate explore template

check.template:
   message = ''
   if len(template) then
      c = upcase(template[1,5])
      if c # 'LIKE ' and c # 'WITH ' then
         c = template[1,1]
         if index(\'"\, c, 1) then
            if template[1] = c then ;* Quoted string
               if index(template, c, 2) # len(template) then
                  message = sysmsg(6674) ;* Quoted string contains delimiter
                  return
               end
            end else
               c = convert(\'"\, \"'\, c)
               if index(template, c, 1) then
                  message = sysmsg(6675) ;* Template string may not contain both single and double quotes
                  return
               end
               template = 'WITH @ID LIKE ' : c : template : c
            end
         end else
            template = 'WITH @ID LIKE "' : template : '"'
         end
      end
   end

   return

*****************************************************************************
* Rebuild explore buffer if affected by write or export

rebuild.explore.buffer:
   for z = 1 to no.of.buffers
      if buffer(z)<BUFF.TYPE> # BUFF.TYPE.EXPLORE then continue
      if buffer(z)<BUFF.FILE.NAME> # write.file.name then continue
      if buffer(z)<BUFF.DICT.FLAG> # dict.flag then continue

      s = buffer(z)<BUFF.RECORD.NAME>
      template = field(s, ' ', 2, 9999)  ;* Extract selection criteria

      message = sysmsg(6676) ;* Rebuilding explore buffer...
      gosub status.msg

      gosub build.explore.list

      * Rebuild data chunk chain

      hd = buffer(z)<BUFF.HEAD> ; gosub release.chunks

      ln = dcount(rec, @fm)
      n = int((ln + IDEAL.LOAD - 1) / IDEAL.LOAD)   ;* No of required chunks
      n += 5 - free.chunks     ;* Allow 5 spare and use free space
      if n > 0 then gosub allocate.chunks

      buffer(z)<BUFF.HEAD> = free.chain
      buffer(z)<BUFF.LINES> = ln
      buffer(z)<BUFF.LINE> = 1
      buffer(z)<BUFF.COL> = 1

      j = IDEAL.LOAD
      remaining.lines = ln
      k = 1
      loop
         i = free.chain               ;* Select chunk from free chain
         free.chain = chunk.next(i)
         free.chunks -= 1

         if j > remaining.lines then j = remaining.lines
         chunk(i) = field(rec, @fm, k, j)
         k += j
         chunk.lines(i) = j
         remaining.lines -= j
      while remaining.lines
         chunk.next(i) = free.chain
      repeat

      chunk.next(i) = 0
      rec = ""
   next z

   return

*****************************************************************************
* SAVE.BUFFER

save.buffer:
   gosub save.current
   s = ""
   s<BUFF.FILE.NAME> = file.name
   s<BUFF.DICT.FLAG> = dict.flag
   s<BUFF.RECORD.NAME> = record.name
   s<BUFF.UPDATED> = record.updated
   s<BUFF.HEAD> = head
   s<BUFF.LINES> = lines
   s<BUFF.LINE> = line
   s<BUFF.COL> = col
   s<BUFF.MARK.LINE> = mark.line
   s<BUFF.MARK.COL> = mark.col
   s<BUFF.READ.ONLY> = read.only
   s<BUFF.TYPE> = buffer.type
   s<BUFF.LNUM> = lcol # 0
   s<BUFF.LOCKED> = record.locked
   s<BUFF.UNAMES> = uppercase.names
   s<BUFF.COMMENT> = buffer.comment
   s<BUFF.TAG> = buffer.tag
   s<BUFF.PARENT> = buffer.parent
   s<BUFF.ITYPE> = buffer.itype

   buffer(current.buffer) = s
   return

*****************************************************************************
* GET.BUFFER

get.buffer:
   s = buffer(current.buffer)
   file.name = s<BUFF.FILE.NAME>
   dict.flag = s<BUFF.DICT.FLAG>
   record.name = s<BUFF.RECORD.NAME>
   record.updated = s<BUFF.UPDATED> + 0
   head = s<BUFF.HEAD> + 0
   lines = s<BUFF.LINES> + 0
   line = s<BUFF.LINE> + 0
   col = s<BUFF.COL> + 0
   mark.line = s<BUFF.MARK.LINE> + 0
   mark.col = s<BUFF.MARK.COL> + 0
   read.only = s<BUFF.READ.ONLY> + 0
   buffer.type = s<BUFF.TYPE> + 0
   if s<BUFF.LNUM> then gosub set.lcol else lcol = 0
   record.locked = s<BUFF.LOCKED> + 0
   uppercase.names = s<BUFF.UNAMES> + 0
   buffer.comment = s<BUFF.COMMENT>
   buffer.tag = s<BUFF.TAG>
   buffer.parent = s<BUFF.PARENT>
   buffer.itype = s<BUFF.ITYPE>

   if len(dict.flag) then full.name = "DICT " : file.name : " " : record.name
   else full.name = file.name : " " : record.name : buffer.comment
   refresh.file = @true

   if split.window then other.live = (current.buffer = other.buffer)

   last.base = 999999999
   gosub get.current

   top.line = line - int(live.height / 2)
   if top.line < 1 then top.line = 1
   gosub refresh.all

   return

* *****************************************************************************
set.unames:
   uppercase.names = @false
   if file.name # '' then
      if fileinfo(file(current.buffer), FL$TYPE) = FL$TYPE.DIR then
         uppercase.names =  fileinfo(file(current.buffer), FL$NOCASE)
      end
   end

   return

*****************************************************************************
* SHOW.BUFFER.LIST

a.show.buffer.list:
   gosub save.buffer

   selected.buffer = current.buffer
   for i = 1 to no.of.buffers
      gosub show.buffer.info
   next i

   ln = no.of.buffers
   s = str('=', screen.width)
   display @(0, ln) : s : @(0, file.line) :
   image(ln + 1) = s

   selected.buffer = current.buffer
   loop
      gosub get.key
      begin case
         case action = F.NEWLINE
            if selected.buffer # current.buffer then
               gosub save.buffer
               current.buffer = selected.buffer
               gosub get.buffer
            end
            exit

         case action = F.UP
            if selected.buffer > 1 then
               i = selected.buffer
               selected.buffer -= 1
               gosub show.buffer.info
               i = selected.buffer
               gosub show.buffer.info
            end

         case action = F.DOWN
            if selected.buffer < no.of.buffers then
               i = selected.buffer
               selected.buffer += 1
               gosub show.buffer.info
               i = selected.buffer
               gosub show.buffer.info
            end

         case action = F.CANCEL
            exit
      end case
   repeat

   gosub refresh.all

   return


show.buffer.info:    ;* Show information for buffer i
   s = (if i = selected.buffer then '>' else ' ') : fmt(i, '2R')

   begin case
      case buffer(i)<BUFF.UPDATED>
         s := "* "
      case buffer(i)<BUFF.READ.ONLY>
         s := "- "
      case 1
         s := ": "
   end case

   if len(buffer(i)<BUFF.DICT.FLAG>) then s := "DICT "

   ss = buffer(i)<BUFF.FILE.NAME>
   if len(ss) then s := ss : ' '

   s := buffer(i)<BUFF.RECORD.NAME>

   if buffer(i)<BUFF.TYPE> = BUFF.TYPE.DATA then
      if not(buffer(i)<BUFF.LOCKED>) then s := ' ' : sysmsg(6677) ;* (no lock)
   end

   s = fmt(s[1,screen.width], sw.fmt)
   display @(0, i - 1) : s : @(0, file.line) :
   image(i) = s

   return

*****************************************************************************
no.mark:
   message = sysmsg(6678) ;* No mark
   goto error

not.now:
   message = sysmsg(6679) ;* Not now
   goto error

scratch.buffer.err:
   message = sysmsg(6680) ;* Buffer has no associated file
   goto error

read.only.buffer:
   message = sysmsg(6681) ;* Read only buffer

error:
   gosub update.screen
   display @sys.bell :
   gosub file.msg
   gosub wait.input
   refresh.file = @true
   abort.macro = @true
   return

file.msg:
   display bar.attr : @(0,file.line) : (message swm1.fmt) : attr :
   return

status.msg:
   display bar.attr : @(0,status.line) : (message swm1.fmt) : attr :
   return

*****************************************************************************
check.quit:
   aborted = @false

   gosub save.current
   gosub save.buffer

   for current.buffer = 1 to no.of.buffers
      if buffer(current.buffer)<BUFF.UPDATED> then
         gosub get.buffer
         loop
            prefix = sysmsg(6682) ;* Record changed.  Quit without saving?
            s = ""
            gosub get.string
            s = upcase(s)
            begin case
               case aborted or (s = "N") or (s = "NO")
                  aborted = @true
                  return
               case (s = "Y") or (s = "YES")
                  exit
               case 1
                  display @sys.bell :
            end case
         repeat
      end
   next current.buffer

   return

*****************************************************************************

command:
   s = ""
   prefix = sysmsg(6683) ;* Command:
   gosub get.command
   s = trimf(s)
   if aborted or s = '' then return
   suppress.command.cr = @false

ext.command:
   s = convert(' ', @fm, s)
   c = upcase(s<1>)

   if not(execution.depth) then  ;* Try extensions bound as commands
      locate c in extension.commands<1,1> setting i then
         ext.name = extension.commands<2,i>
         gosub a.run
         return
      end
   end

   begin case
      case upcase(s) = "BASIC"
         begin case
            case len(dict.flag)
               message = sysmsg(6684) ;* Cannot compile dictionary item.
               gosub error

            case read.only
               gosub read.only.buffer

            case 1
               * Remove any existing error tag lines

               gosub a.top

               first.search = @false
               saved.search.mode = search.mode
               search.mode = CASE.INSENSITIVE
               advance = 0
               loop
                  search.string = '!!ERROR: '
                  if col > line.len then col = line.len + 1
                  gosub fsearch
                  advance = 1
               while found
                  if col = 1 then
                     gosub delete.current
                     advance = 0
                  end
               repeat

               * Remove any existing warning tag lines

               gosub a.top

               first.search = @false
               saved.search.mode = search.mode
               search.mode = CASE.INSENSITIVE
               advance = 0
               loop
                  search.string = '!!WARNING: '
                  if col > line.len then col = line.len + 1
                  gosub fsearch
                  advance = 1
               while found
                  if col = 1 then
                     gosub delete.current
                     advance = 0
                  end
               repeat
               search.mode = saved.search.mode

               * Save the record

               if record.updated then gosub save.record
               gosub clear.screen

               display sysmsg(6685, file.name, record.name) ;* Compiling %1 %2

               printer reset
               execute 'BASIC ' : file.name : ' ' : record.name capturing basic.output
               src = @system.return.code
               if src then  ;* Successful  -  Show any warnings
                  loop
                     z = remove(basic.output, delim)
                     begin case
                        case z matches "0N1N': WARNING:'0X":@vm:"'WARNING:'0X"
                           display z
                     end case
                  while delim
                  repeat
                  display sysmsg(6686) ;* Compilation complete
               end else    ;* Failed  -  Insert error tags
                  display sysmsg(6687) ;* Compiled with errors
                  tag.line = 0
                  tag.offset = 0    ;* Offset for inserted error tag lines
                  loop
                     z = remove(basic.output, delim)
                     begin case
                        case z matches "1N...:..."
                           tag.line = matchfield(z,'0N0X',1) + 0
                           tag.error = trimf(field(z,':',2,999))

                           * Position to this source line

                           rpt = tag.line + tag.offset
                           gosub a.goto.line
                           line.len = len(current.line)

                           * Insert the error tag

                           gosub insert.line
                           if tag.error[1,8] = 'WARNING:' then
                              current.line = '!!' : tag.error
                           end else
                              current.line = '!!ERROR: ' : tag.error
                           end
                           line.updated = @true
                           tag.offset += 1

                        case z matches "'WARNING:'0X"
                           gosub a.bottom
                           tag.error = trimf(field(z,':',2,999))
                           current.line = '!!WARNING: ' : tag.error
                           line.updated = @true

                        case z matches "1N0N' error(s)..."
                           display z
                     end case
                  while delim
                  repeat

                  * Position to first error (if any tagged)

                  gosub a.top

                  if tag.line then  ;* At least one tag inserted
                     first.search = @false
                     saved.search.mode = search.mode
                     search.mode = CASE.INSENSITIVE
                     advance = 0
                     search.string = '!!ERROR: '
                     gosub fsearch
                     search.mode = saved.search.mode
                  end
               end

               if src then gosub auto.catalog  ;* Catalog?

               if not(suppress.command.cr) then
                  gosub press.return
                  gosub clear.screen
                  gosub refresh.all
               end
         end case

      case c = "BWORD"
         search.mode = BWORD.SEARCH

      case c = "CASE_OFF"
         search.mode = CASE.INSENSITIVE

      case c = "CASE_ON"
         search.mode = CASE.SENSITIVE

      case c = "COMPILE"
         begin case
            case len(dict.flag)
               message = sysmsg(6684) ;* Cannot compile dictionary item.
               gosub error

            case read.only
               gosub read.only.buffer

            case 1
               gosub save.current
               if record.updated then gosub save.record
               gosub clear.screen

               * Are we compiling an extension?

               s = chunk(head)
               ch = chunk.next(head)
               j = @false
               loop
                  n = dcount(s, @fm)
                  for i = 1 to n
                     z = upcase(trimf(s<i>))
                     if len(z) and z[1,1] # '*' and z[1,1] # '!' and z[1,4] # 'REM ' then
                        j = @true
                        exit
                     end
                  next i
               until j
               while ch
                  s = chunk(ch)
                  ch = chunk.next(ch)
               repeat

               z = trim(field(z, '(', 1))
               if j and (z = 'PROC' or z = 'FUNC') then  ;* Extension
                  gosub assemble.record
                  display sysmsg(6688) ;* Compiling extension...
                  gosub compile
                  rec = ''      ;* Release memory
               end else
                  printer close
                  printer reset
                  execute 'BASIC ' : file.name : ' ' : record.name
                  unload.object
                  if @system.return.code then gosub auto.catalog  ;* Catalog?
               end

               if not(suppress.command.cr) then
                  gosub press.return
                  gosub clear.screen
                  gosub refresh.all
               end
         end case

      case c = 'EXPAND.TABS'
         if read.only then gosub read.only.buffer
         else
            gosub save.current
            ch =  head
            loop
            while ch
               s = chunk(ch)
               n = dcount(s, @fm)
               if index(s, char(9), 1) then
                  for i = 1 to n
                     ss = s<i>
                     j = index(ss, char(9), 1)
                     if j then
                        loop
                           k = tab.interval - mod(j - 1,tab.interval)
                           ss = ss[1,j-1] : space(k) : ss[j+1,999999]
                           j = index(ss, char(9), 1)
                        while j
                        repeat
                        s<i> = ss
                     end
                  next i
                  chunk(ch) = s
                  record.updated = @true
               end
               ch = chunk.next(ch)
            repeat

            last.base = 99999999 ;* Force re-extraction of record
            gosub get.current
            gosub refresh.all
         end

      case c = "FORMAT"
         begin case
            case len(dict.flag)
               message = sysmsg(6561) ;* Cannot format dictionary item
               gosub error

            case read.only
               gosub read.only.buffer

            case 1
               gosub save.current
               gosub clear.screen

               gosub assemble.record
               call !format(rec, rec, file.name, fmt.indent, @false, i)
               if i then gosub press.return   ;* Allow user to see errors
               gosub clear.screen

               saved.line = line
               gosub rebuild.chunks ;* split rec back into chunks
               if line <= lines then line = saved.line
               else line = lines + 1
               gosub get.current
               gosub refresh.all
               record.updated = @true
         end case
   
      case c = 'FUNDAMENTAL'
         gosub set.default.bindings

      case c = 'HELP'
         hush on
         execute convert(@fm, ' ', s) trapping aborts
         hush off

      case c = 'INDENT'
         indent = not(indent)

      case c = "KEYS"
         if len(bindings.name) then
            message = sysmsg(6689, bindings.name) ;* Key bindings = %1
         end else
            message = sysmsg(6690) ;* Default (fundamental) key bindings in use
         end
         gosub file.msg
         gosub wait.input
         refresh.file = @true

      case c = "LNUM"
         ss = trim(upcase(s<2> : ' ' : s<3>))

         begin case
            case ss = 'ON'      ;* Set on for this buffer
               gosub set.lcol

            case ss = 'OFF'      ;* Set off for this buffer
               lcol = 0
               gosub refresh.all

            case ss = ''         ;* Toggle for this buffer
               if lcol then
                  lcol = 0
                  gosub refresh.all
               end
               else gosub set.lcol

            case ss = 'ALL' or s = 'ON ALL'
               lnum.all = @true
               gosub set.lcol
               for i = 1 to no.of.buffers
                  buffer(i)<BUFF.LNUM> = @true
               next i

            case ss = 'OFF ALL'
               lnum.all = @false
               lcol = 0
               gosub refresh.all
               for i = 1 to no.of.buffers
                  buffer(i)<BUFF.LNUM> = @false
               next i

            case 1
               message = sysmsg(6691) ;* Unrecognised LNUM option - Expected ON, OFF, ALL, ON ALL or OFF ALL
               gosub error
         end case

      case c = "LOAD.KEYS"
         binding.record.name = upcase(s<2>)
         begin case
            case binding.record.name = ''
               message = sysmsg(6692) ;* No key binding record name given
               gosub error

            case bindings.file.open
               read key.rec from bindings, binding.record.name then
                  bindings.name = binding.record.name
                  gosub load.key.bindings
               end else
                  message = sysmsg(6693) ;* Key binding record not found
                  gosub error
               end

            case 1
               message = sysmsg(6694) ;* Cannot load key bindings - &SED.BINDINGS& file not open
               gosub error
         end case

      case c = 'OVERLAY'
         overlay = not(overlay)

      case c = "QUIT"
         gosub check.quit
         if not(aborted) then terminate = TERMINATE.ALL

      case upcase(s) = 'RELEASE'
         if record.locked then
            release file(current.buffer), record.name
            record.locked = @false
         end

      case upcase(s) = 'RUN'
         gosub clear.screen
         gosub reset.term.state
         execute 'RUN ' : file.name : ' ' : record.name
         gosub get.set.term.state
         gosub press.return
         gosub clear.screen
         gosub refresh.all

      case c = "SAVE.KEYS"
         binding.record.name = upcase(s<2>)
         begin case
            case not(bindings.file.open)
               message = sysmsg(6695) ;* Cannot save key bindings - &SED.BINDINGS& file not open
               gosub error

            case binding.record.name = ''
               message = sysmsg(6692) ;* No key binding record name given
               gosub error

            case 1
               gosub save.key.bindings
               gosub clear.screen
               gosub refresh.all
         end case

      case c = 'SPOOL'
         gosub save.current

         numbering = @false
         spool.region = @false
         spool.at = ''

         s = trim(s, @fm, 'R')
         c = remove(s, delim) ;* Skip command name
         loop
         while delim
            c = upcase(remove(s, delim))
            begin case
               case c = 'AT' or c = '-AT'
                  if delim then
                     spool.at = remove(s, delim)
                  end else
                     message = sysmsg(6696, c) ;* Destination printer name required after %1
                     gosub error
                     return
                  end

               case c = 'LNUM'
                  numbering = @true

               case c = 'REGION'
                  if mark.line = 0 then
                     gosub no.mark
                     return
                  end
                  spool.region = @true

               case 1
                  message = sysmsg(6698) ;* Unexpected arguments in SPOOL command
                  gosub error
                  return
            end case
         repeat

         message = sysmsg(6698) ;* Wait...
         gosub status.msg

         printer on

         call !GETPU(PU$MODE, 0, spool.mode, code)
         if spool.mode # 3 then
            call !GETPU(PU$BANNER, 0, old.spool.banner, code)
            call !SETPU(PU$BANNER, 0, record.name[1,32], code)
         end

         if spool.at # '' then
            call !GETPU(PU$LOCATION, 0, spool.old.at, code)
            call !SETPU(PU$LOCATION, 0, spool.at, code)
            if code then
               message = sysmsg(6699, code) ;* Destination printer not available. Error %1
               gosub error
               return
            end
         end

         ss = full.name
         if record.updated then ss := ' ' : sysmsg(6910) ;* (modified)
         heading ss : "   'TGSL'"
         width = @lptrwide

         if numbering then
            numbering = len(lines)
            if numbering < 4 then numbering = 4
            width -= numbering + 2
         end

         if spool.region then
            gosub find.region
            ln = region.start.line
            if region.end.col # 1 then region.end.line += 1

            ch = region.start.chunk
            j = region.start.fld
            loop
               s = chunk(ch)
               n = chunk.lines(ch)
               for i = j to n
                  ss = s<i>
                  if numbering then
                     print fmt(ln, numbering : "'0'R") : ": " :
                  end
                  loop
                     print ss[1, width]
                  while len(ss) > width
                     ss = ss[width + 1, 99999]
                     if numbering then print space(numbering + 2) :
                  repeat
                  ln += 1
               while ln < region.end.line
               next i
            while ln < region.end.line
               ch = chunk.next(ch)
               j = 1
            while ch
            repeat
         end else
            ch = head
            ln = 1
            loop
               s = chunk(ch)
               n = chunk.lines(ch)
               for i = 1 to n
                  ss = s<i>
                  if numbering then
                     print fmt(ln, numbering : "'0'R") : ": " :
                  end
                  loop
                     print ss[1, width]
                  while len(ss) > width
                     ss = ss[width + 1, 99999]
                     if numbering then print space(numbering + 2) :
                  repeat
                  ln += 1
               next i
               ch = chunk.next(ch)
            while ch
            repeat
         end

         printer off

         hush on
         printer close
         hush off

         printer on
         if spool.mode # 3 then
            call !SETPU(PU$BANNER, 0, old.spool.banner, code)
         end

         if spool.at # '' then
            call !SETPU(PU$LOCATION, 0, spool.old.at, code)
         end

         printer off
         printer close

         display @(0,status.line) : bar.attr : swm1.space : attr :

      case c = 'STAMP'
         if read.only then
            gosub read.only.buffer
            return
         end

         s = '* Updated by ' : @who : ' (' : @logname :') ' : timedate()
         if line <= lines then s := @fm

         gosub refresh.below
         current.line = s : current.line
         line.updated = @true
         gosub save.current

         if mark.line >= line then mark.line += 1

         if other.live then
            if other.line > line then other.line += 1
            if other.top.line > line then other.top.line += 1
         end

         lines += 1
         last.base = 99999999  ;* Restart line calculations
         chunk.lines(current.chunk) += 1
         if chunk.lines(current.chunk) > SPLIT.LOAD then gosub split

         line += 1
         gosub get.current
         gosub check.lcol

      case c = 'TABS'
         n = trim(s<2>)
         if n matches '1-2N' and n > 0 then tab.interval = n
         else
            message = sysmsg(6911) ;* Tab interval must be in range 1 to 99
            gosub error
         end

      case c = "WORD"
         search.mode = WORD.SEARCH

      case c = "XEQ"
         gosub clear.screen
         s = convert(@fm, ' ', s)
         gosub reset.term.state
         execute trimf(trimb(s[5,999999])) trapping aborts
         gosub get.set.term.state

         if not(suppress.command.cr) then
            gosub press.return
            gosub clear.screen
            gosub refresh.all
         end

      case c = "__DUMP__"
         gosub dump

      case 1
         if not(suppress.command.cr) then gosub clear.screen
         s = convert(@fm, ' ', s)
         gosub reset.term.state
         execute trimf(trimb(s)) trapping aborts
         gosub get.set.term.state
         if not(suppress.command.cr) then
            gosub press.return
            gosub clear.screen
            gosub refresh.all
         end
   end case

   return

* *****************************************************************************
* auto.catalog  -  Catalog program if *$catalog is present

auto.catalog:
   s = chunk(head)
   ch = chunk.next(head)
   z = ''
   loop
      n = dcount(s, @fm)
      for i = 1 to n
         z = upcase(trimf(s<i>))
      until z[1,9] = '*$CATALOG'
      next i
   until z[1,9] = '*$CATALOG'
   while ch
      s = chunk(ch)
      ch = chunk.next(ch)
   repeat

   if z[1,9] = '*$CATALOG' then
      execute 'CATALOG ' : file.name : ' ' : field(trim(s<i>), ' ', 2) : ' ' : record.name : ' ' : field(trim(s<i>), ' ', 3, 99)
   end

   return

* *****************************************************************************
* Diagnostic dump (__DUMP__ command)

dump:
   execute "SETPTR 1,,,,,3,BRIEF"

   print on 1 "file.name " : file.name
   print on 1 "dict.flag " : dict.flag
   print on 1 "record.name " : record.name
   print on 1 "record.updated " : record.updated
   print on 1 "head " : head
   print on 1 "lines " : lines
   print on 1 "line " : line
   print on 1 "col " : col
   print on 1 "mark.line " : mark.line
   print on 1 "mark.col " : mark.col
   print on 1 "read.only " : read.only
   print on 1 "buffer.type " : buffer.type
   print on 1

   if len(macro) then
      print on 1 "Macro:"
      j = dcount(macro, @fm)
      if j > 1000 then
         print on 1 "(truncated)"
         j = 1000
      end

      loop
         print on 1 macro<i>, '' :
         s = macro<i+1>
         print on 1 s, macro<i+2> :
         begin case
            case s = F.FWD.SEARCH or s = F.REV.SEARCH
               print on 1 "'" : macro<i+3> : "'"
               i += 4
            case s = F.REPLACE or s = F.QREPLACE or s = F.IMPORT
               print on 1 "'" : macro<i+3> : "', '" : macro<i+4> : "'"
               i += 5
            case 1
               print on 1
               i += 3
         end case
      while i <= j
      repeat
      print on 1
   end

   i = head
   loop
      print on 1 i : ": " : chunk.lines(i) : " lines"
      s = chunk(i)
      n = dcount(s, @fm)
      if n # chunk.lines(i) then print on 1 "*** Actual line count " : n
      z = fmt(i, '3"0"R') : '.'
      for j = 1 to n
         print on 1 z : fmt(j, '3"0"R') : ' "' : s<j> : '"'
      next j
      i = chunk.next(i)
   while i
      print on 1
   repeat

   printer close on 1

   gosub clear.screen
   gosub refresh.all

   return

* ======================================================================

return.to.parent.buffer:
   gosub delete.current.buffer   

   * Now find parent buffer
   for i = 1 to no.of.buffers
      if buffer(i)<BUFF.TAG> = buffer.parent then
         current.buffer = i
         if record.updated then buffer(i)<BUFF.UPDATED> = @true
         exit
      end
   next i

   gosub get.buffer
   read.only = (buffer.type = BUFF.TYPE.EV.READ.ONLY.PARENT)
   buffer.type = BUFF.TYPE.DATA

   return

* ======================================================================

delete.current.buffer:
   if current.buffer < no.of.buffers then
      for i = current.buffer to no.of.buffers - 1
         buffer(i) = buffer(i + 1)
         file(i) = file(i + 1)
      next i
   end

   if fileinfo(file(no.of.buffers), FL$OPEN) then
      close file(no.of.buffers)
   end

   buffer(no.of.buffers) = ''
   no.of.buffers -= 1

   return

* **********************************************************************

* ======================================================================
* compile  -  Compile extension program in rec

compile:
*  Extension header:
*     1  x31
*     2  0 if proc, 1 if func
*     3  Arg count   (max 250)
*     4  Var count   (max 250)
*
* Optional bits:
*     Value 2 = SED revision
*     Value 3 = Date/time of compilation
*
*     End marker (field mark)

   equ EXT.HEADER.LEN to 5

   equ EXT.JUMP.WIDTH to 5  ;* Digits in initial format of jump addresses

   equ TKN.END to 0
   equ TKN.LBR to 1
   equ TKN.RBR to 2
   equ TKN.STR to 3
   equ TKN.SYS to 4    ;* @var or %var
   equ TKN.NAM to 5    ;* name
   equ TKN.NUM to 6    ;* number
   equ TKN.GVR to 7    ;* $name
   equ TKN.COM to 8    ;* Comma
   equ TKN.ERR to 99

   equ OP.LDLIT to 1     ;* Load string literal
   equ OP.LDVAR to 2     ;* Load user variable reference
   equ OP.UPROC to 3     ;* Run user procedure
   equ OP.UFUNC to 4     ;* Run user function
   equ OP.JZE   to 5     ;* Jump if zero (or null)
   equ OP.JNZ   to 6     ;* Jump if non-zero
   equ OP.JMP   to 7     ;* Unconditional jump
   equ OP.LDGVR to 8     ;* Load global variable
   equ OP.SETGV to 9     ;* Set global variable
   equ OP.JNE   to 10    ;* Jump if not equal
   equ OP.POP   to 11    ;* Pop top stack item
   equ OP.LDNUM to 12    ;* Load numeric literal
   equ OP.LCALL to 13    ;* Local call
   equ OP.LRETN to 14    ;* Local return
   equ OP.FUNC  to 30    ;* Opcode for first built-in function

   if len(ext.funcs) = 0 then  ;* Not yet built function tables

      * Function table. This must match the ext.split subroutine list
      * The first value is the number of arguments required. A negative
      * value has special meaning:
      *   -1   An unrecognised (and hence user) function or procedure for
      *        which we have not yet determined the number of arguments.
      *
      * The second value is the number of values returned. A negative
      * value indicates that a procedure should follow the arguments.

      func.defs = 'ADD 2 1|SUB 2 1|MUL 2 1|DIV 2 1'
      func.defs := '|CAT 2 -1|SUBSTR 3 1|PAD 2 1|LEN 1 1'
      func.defs := '|TRIMF 1 1|TRIMB 1 1'
      func.defs := '|EXTRACT 4 1|REP 5 1|DEL 4 1|INS 5 1|FIELD 4 1'
      func.defs := '|EQ 2 1|NE 2 1|GT 2 1|GE 2 1|LT 2 1|LE 2 1'
      func.defs := '|AND 2 -1|OR 2 -1|NOT 1 1'
      func.defs := '|IF 1 -1|SWITCH 1 -1|LOOP 0 -1|EXIT 0 -1|STOP 0 0'
      func.defs := '|RETURN 0 -1'
      func.defs := '|SET 0 -1'
      func.defs := '|BACK.CHAR,LEFT 1 0|FWD.CHAR,RIGHT 1 0|TAB 1 0'
      func.defs := '|PAGE.UP 1 0|PAGE.DOWN 1 0'
      func.defs := '|UP.LINE,UP 1 0|DOWN.LINE,DOWN 1 0'
      func.defs := '|TOP 0 0|BOTTOM 0 0|START.LINE,HOME 0 0|END.LINE,END 0 0'
      func.defs := '|DEL.CHAR 1 0|BACKSPACE 1 0|KILL.LINE 1 0'
      func.defs := '|INSERT 1 -1|NEWLINE 1 0|RETYPE 1 0|%KILL.BUFFER 0 1'
      func.defs := '|FSEARCH 2 1|RSEARCH 2 1'
      func.defs := '|%FILE 0 1|%ID 0 1|%BUFFER.NO 0 1|%BUFFER.TYPE 0 1|%READ.ONLY 0 1'
      func.defs := '|%CURRENT.LINE 0 1|%CURRENT.CHAR 0 1'
      func.defs := '|%COL 0 1|%LINE.LEN 0 1|%LINE 0 1|%LINES 0 1'
      func.defs := '|%MARK.LINE 0 1|%MARK.COL 0 1|SET.MARK 0 0|SWAP.MARK 0 0'
      func.defs := '|GOTO.LINE 1 0|GOTO.COL 1 0'
      func.defs := '|PROMPT 2 1|%KEY.READY 0 1|GET.CHAR 0 1|GET.KEY 0 1'
      func.defs := '|WAIT.INPUT 0 0'
      func.defs := '|%KEY.CHAR 0 1|%PREFIX.COUNT 0 1|%PREFIX.SET 0 1'
      func.defs := '|PAINT 1 0|STATUS.MSG 1 0|BEEP 0 0'
      func.defs := '|%SCROLL 0 1|%PAN 0 1|SET.SCROLL 1 0|SET.PAN 1 0'
      func.defs := '|XEQ 1 0'
      func.defs := '|BIND.COMMAND 2 0|BIND.KEY 2 1|UNLOAD 0 0'
      func.defs := '|@IM 0 1|@FM 0 1|@VM 0 1|@SM 0 1|@TM 0 1'
      func.defs := '|@LOGNAME 0 1|@CRTHIGH 0 1|@CRTWIDE 0 1|@DATE 0 1'
      func.defs := '|@PATH 0 1|@SENTENCE 0 1|@TERM.TYPE 0 1|@TIME 0 1'
      func.defs := '|@TTY 0 1|@USERNO 0 1|@WHO 0 1'
      func.defs := '|MAKE.BUFFER 1 1'
      func.defs := '|FIND.RECORD 2 1|SAVE.RECORD 0 0|WRITE.RECORD 2 0'
      func.defs := '|READ 2 1|WRITE 3 0|DELETE 2 0|EXISTS 2 1'
      func.defs := '|%OVERLAY 0 1|SET.OVERLAY 1 0'
      func.defs := '|%CHANGED 0 1|SET.CHANGED 1 0'
      func.defs := '|SET.CASE 2 0|TOGGLE.CHARS 0 0'
      func.defs := '|COPY.REGION 0 0|DELETE.REGION 0 0'
      func.defs := '|FWD.WORD 1 0|BACK.WORD 1 0|DEL.WORD 1 0|DEL.BACK.WORD 1 0'
      func.defs := '|CLOSE.SPACES 0 0'
      func.defs := '|NEXT.BUFFER 1 0|PREV.BUFFER 1 0|GOTO.BUFFER 1 0'
      func.defs := '|DELETE.BUFFER 0 0'
      func.defs := '|%KEY.BINDINGS 0 1'
      func.defs := '|NUM 1 1|ALPHA 1 1|CONVERT 3 1|DCOUNT 2 1|COUNT 2 1'
      func.defs := '|INDEX 3 1|REM 2 1|SEQ 1 1|CHAR 1 1|ICONV 2 1|OCONV 2 1'
      func.defs := '|%TAB.INTERVAL 0 1|SET.TAB.INTERVAL 1 0'
      func.defs := '|INT 1 1|FIND.BUFFER 2 1|SET.READ.ONLY 1 0'
      func.defs := '|%MACRO.STATE 0 1|QUIT 1 0|EXECUTE 1 0'
      func.defs := '|%WIDTH 0 1|%HEIGHT 0 1|MIN 2 1|MAX 2 1'
      func.defs := '|MATCHES 2 1|MATCHFIELD 3 1|TRIM 1 1'
      func.defs := '|UPCASE 1 1 |DOWNCASE 1 1'


      func.defs = convert('| ', @fm:@vm, func.defs)
      ext.func.args = ''
      ext.func.rets = ''

      loop
         ext.funcs<-1> = convert(',', @vm, remove(func.defs, delim))
         ext.func.args<-1> = remove(func.defs, delim)
         ext.func.rets<-1> = remove(func.defs, delim)
      while delim
      repeat
      func.defs = ''
      num.funcs = dcount(ext.funcs, @fm)

      name.chars = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ.1234567890$'
      mark.chars = @im:@fm:@vm:@sm:@tm
   end else  ;* Been here before - remove user procs and funcs
      ext.funcs = field(ext.funcs, @fm, 1, num.funcs)
      ext.func.args = field(ext.func.args, @fm, 1, num.funcs)
      ext.func.rets = field(ext.func.rets, @fm, 1, num.funcs)
   end

   recordlocku file(current.buffer), record.name : '-EXT'
   delete file(current.buffer), record.name : '-EXT'    ;* Delete old version

   locate record.name in extensions<1> setting i then   ;* Unload old version
      ext.table(i) = ''
      extensions<i> = ''
   end

   ext.err = @false
   func.stack = ''
   arg.stack = ''
   ret.stack = ''
   proc.stack = ''
   ext.loop.depth = 0
   local.vars = ''
   ret.args = 0  ;* Initialised for error paths
   ext.code = char(31) : str(char(0),EXT.HEADER.LEN - 1) 
   ext.code<1,2> = QM.REV.STAMP
   ext.code<1,3> = date() * 86400 + int(time())
   ext.jump.format = EXT.JUMP.WIDTH:"'0'R"

   * Local procedure stuff

   lproc.no = 0
   local.procs = ''      ;* LPROC/LFUNC list.  Fields are...
   equ LPROC.NAME to 1   ;* Local PROC/FUNC name
   equ LPROC.FUNC to 2   ;* LFUNC?
   equ LPROC.ARGS to 3   ;* Arg count
   equ LPROC.ADDR to 4   ;* Start address
   equ LPROC.USED to 5   ;* Referenced?

   * Set up source indexing

   src.idx = 1
   ext.line = 1
   ext.line.start = 1

   * Process PROC/FUNC token

   gosub get.ext.token
   begin case
      case token.type = TKN.NAM and token = 'FUNC'
         compiling.func = @true
         ext.code[2,1] = char(1)
      case token.type = TKN.NAM and token = 'PROC'
         compiling.func = @false
      case 1
         message = sysmsg(6912) ;* Expected PROC or FUNC
         goto ext.error
   end case

   * Set RETURN to expect arg in FUNC, none in PROC

   locate 'RETURN' in ext.funcs<1> setting j then
      ext.func.args<j> = compiling.func
   end

   * Look for PROC.FUNC qualifiers

   gosub get.ext.token
   loop
   while token.type = TKN.NAM
      begin case
         case token = 'ARGS'
            if len(local.vars) then
               message = sysmsg(6913) ;* Arguments already defined
               goto ext.error
            end

            loop
               gosub get.ext.token
               if token.type # TKN.NAM then
                  message = sysmsg(6914) ;* Argument name not found where expected
                  goto ext.error
               end

               locate token in local.vars<1> setting i then
                  message = sysmsg(6915) ;* Duplicated argument name
                  goto ext.error
               end
               local.vars<i> = token

               gosub get.ext.token
            while token.type = TKN.COM
            repeat

            n = dcount(local.vars, @fm)
            if n > 250 then
               message = sysmsg(6916) ;* Too many arguments
               goto ext.error
            end
            ext.code[3,1] = char(n)

            continue  ;* Already got next token

         case 1
            message = sysmsg(6917, token) ;* Unrecognised option : %1
            goto ext.error
      end case
      gosub get.ext.token
   repeat

   * Process left bracket at start of procedure/function

   if token.type # TKN.LBR then
      message = sysmsg(6918) ;* Expected left bracket before procedure/function body
      goto ext.error
   end

   gosub parse.procedure

   if compiling.func then ext.code<-1> = char(OP.LDNUM):0 ;* Default value

   locate 'RETURN' in ext.funcs<1> setting j then
      ext.code<-1> = char(j + OP.FUNC - 1)
   end

   if token.type # TKN.RBR then
      message = sysmsg(6919)  ;* Expected right bracket
      goto ext.error
   end

   * Check for local PROCs and FUNCs

   loop
      gosub get.ext.token
      
   while token.type = TKN.NAM
   
      begin case
         case token = 'LPROC' or token = 'LFUNC'  ;* Local PROC/FUNC
            lproc.no += 1
            compiling.func = (token = 'LFUNC')
            
            gosub get.ext.token
            if token.type # TKN.NAM then
               message = sysmsg(6920) ;* Expected name for local PROC/FUNC
               gosub ext.error
               exit
            end

            locate token in local.procs<LPROC.NAME,1> setting i then
               message = sysmsg(6921) ;* Duplicate local PROC/FUNC name
               gosub ext.error
               exit
            end
            
            local.procs<LPROC.NAME,-1> = token
            local.procs<LPROC.FUNC,-1> = compiling.func
            local.procs<LPROC.ADDR,-1> = dcount(ext.code, @fm) + 1
            local.procs<LPROC.USED,-1> = @false  ;* Not yet been used
            local.args = ''
            
            * Set RETURN to expect arg in FUNC, none in PROC

            locate 'RETURN' in ext.funcs<1> setting j then
               ext.func.args<j> = compiling.func
            end

            gosub get.ext.token
            loop
            while token.type = TKN.NAM
               begin case
                  case token = 'ARGS'
                     * Arguments for local procs/funcs are just local variables
                     * alongside the rest for the main proc/func.  There is
                     * nothing to stop a program using these in any way the
                     * programmer wishes.
                     * Collect the names and then generate code to save the
                     * values in reverse stack order.
                     
                     loop
                        gosub get.ext.token
                        if token.type # TKN.NAM then
                           message = sysmsg(6914) ;* Argument name not found where expected
                           goto ext.error
                        end

                        local.args<-1> = token

                        gosub get.ext.token
                     while token.type = TKN.COM
                     repeat

                     n = dcount(local.args, @fm)
                     for i = n to 1 step -1
                        s = local.args<i>
                        locate s in local.vars<1> setting j else
                           local.vars<j> = s  ;* Add new local var
                        end

                        locate 'SET' in ext.funcs<1> setting k then
                           ext.code<-1> = char(k + OP.FUNC - 1):j
                        end
                     next i
                     
                     continue  ;* Already got next token

                  case 1
                     message = 'Unrecognised option : ' : token
                     goto ext.error
               end case
               gosub get.ext.token
            repeat

            local.procs<LPROC.ARGS,-1> = dcount(local.args, @fm)
            
            * Process left bracket at start of procedure/function

            if token.type # TKN.LBR then
               message = sysmsg(6918) ;* Expected left bracket before procedure/function body
               goto ext.error
            end

            gosub parse.procedure

            if token.type # TKN.RBR then
               message = sysmsg(6919) ;* Expected right bracket
               goto ext.error
            end

            if compiling.func then ext.code<-1> = char(OP.LDNUM):0
            ext.code<-1> = char(OP.LRETN)

         case 1                ;* Something else...
            exit               ;* ...let procedure end check catch error
      end case
   until ext.err
   repeat

   * Should now be at end of source
   
   if not(ext.err) then
      if token.type # TKN.END then
         message = sysmsg(6922) ;* Expected end of source
         goto ext.error
      end
   end

   if not(ext.err) then
      display  ;* Terminate ... progress line
      
      * Fix up local proc/func references

      if len(local.procs) then
         n = dcount(ext.code, @fm)
         for i = 2 to n
            s = ext.code<i>
            j = seq(s[1,1])
            if j = OP.UPROC or j = OP.UFUNC then
               ss = field(s[2,99999], '.', 2, 999)  ;* Name
               locate ss in local.procs<LPROC.NAME,1> setting k then
                  local.procs<LPROC.USED,k> = @true  ;* Mark as used

                  if (j = OP.UFUNC) # local.procs<LPROC.FUNC,k> then
                     ss = local.procs<LPROC.NAME,k>
                     if j = OP.UFUNC then
                        message = sysmsg(6923, ss) ;* Local PROC %1 used as FUNC
                     end else
                        message = sysmsg(6924, ss) ;* Local FUNC %1 used as PROC
                     end
                     goto ext.error
                  end
                  
                  if field(s[2,99999], '.', 1) # local.procs<LPROC.ARGS,k> then
                     message = sysmsg(6925, local.procs<LPROC.NAME,k>)
                     * Argument count mismatch in local PROC/FUNC %1
                     goto ext.error
                  end
                  ext.code<i> = char(OP.LCALL):fmt(local.procs<LPROC.ADDR,k>, ext.jump.format)
               end
            end
         next i
      end
   end
   
   if not(ext.err) then
      n = dcount(local.procs<LPROC.NAME>, @vm)
      for i = 1 to n
         if not(local.procs<LPROC.USED,i>) then
            if local.procs<LPROC.FUNC,i> then
               display sysmsg(6926) ;* Local PROC not referenced
            end else
               display sysmsg(6927) ;* Local FUNC not referenced
            end
         end
      next i
   end

   if not(ext.err) then
      n = dcount(ext.funcs, @FM)
      if n > num.funcs then
         k = @true
         for i = num.funcs + 1 to n
            s = ext.funcs<i>
            locate s in local.procs<LPROC.NAME,1> setting j else
               if k then   ;* First one
                  display sysmsg(6928) ;* External references:
                  k = @false
               end
               display s : ' (' :
               if ext.func.rets<i> then
                  display sysmsg(6929, s,  ext.func.args<i>)
                  * %1 (function, %2 arguments)
               end else
                  display sysmsg(6930, s,  ext.func.args<i>)
                  * %1 (%2 arguments)
               end
            end
         next i
      end

      n = dcount(local.vars, @fm)
      ext.code[4,1] = char(n)
      if n > 253 then  ;* Must avoid field mark as variable count
         message = sysmsg(6931) ;* Procedure has too many local variables
         gosub ext.error
      end
   end

   if not(ext.err) then
      if len(len(ext.code)) > EXT.JUMP.WIDTH then
         message = sysmsg(6932) ;* Object code is too large to process
         gosub ext.error
      end else  ;* Convert jump addresses to character offsets for setrem

         * Construct list of all opcodes requiring conversion

         ss = OP.JZE:@fm:OP.JNZ:@fm:OP.JMP:@fm:OP.JNE:@fm:OP.LCALL
         locate 'LOOP' in ext.funcs<1> setting j then ss<-1> = j + OP.FUNC - 1

         * How wide does jump address need to be?
         * For the second pass to work, we must be replacing each jump field
         * number with a character offset of the same number of digits. Work
         * out the width we will use.

         k = len(len(ext.code))      ;* No of digits to address any byte
         z = 2 + EXT.JUMP.WIDTH - k  ;* Position to start extraction
         ext.jump.format = k:"'0'R"  ;* Revised format for compacted jumps

         n = dcount(ext.code, @fm)

         * First pass - Change all jump field numbers to this width

         for i = 2 to n
            s = ext.code<i>
            locate seq(s[1,1]) in ss<1> setting j then
               ext.code<i> = s[1,1]:s[z,99]
            end
         next i

         * Second pass - Replace field numbers with offsets

         for i = 2 to n
            s = ext.code<i>
            locate seq(s[1,1]) in ss<1> setting j then
               ext.code<i> = s[1,1]:fmt(index(ext.code, @fm, s[2,99]-1), ext.jump.format)
            end
         next i
      end
   end

   if not(ext.err) then
      s = ext.code<1> : @fm : convert(@fm, char(0), field(ext.code, @fm, 2, 9999999))
      recordlocku file(current.buffer), record.name : '-EXT'
      write s to file(current.buffer), record.name : '-EXT'
      s = ''
      ext.code = ''
   end

   return

* ======================================================================

parse.procedure:
   gosub get.ext.token
   if token.type # TKN.LBR then
      message = sysmsg(6933) ;* Expected left bracket
      goto ext.error
   end

   loop
   while token.type = TKN.LBR

      is.func = @false ; gosub parse.function

   until ext.err

      if ret.args then
         message = sysmsg(6934) ;* Misuse of function that returns a value
         goto ext.error
      end         

      gosub get.ext.token

   repeat

   return

* ======================================================================

parse.function:
   * Get function name

   gosub get.ext.token
   if token.type # TKN.NAM then
      message = sysmsg(6935) ;* Expected function name
      goto ext.error
   end

   find token in ext.funcs setting func.no else
      func.no = dcount(ext.funcs,@fm) + 1
      ext.funcs<func.no> = token
      ext.func.args<func.no> = -1       ;* Don't yet know arg count
      ext.func.rets<func.no> = is.func  ;* 1 if function (want return value)
   end

   * Push details

   ins func.no before func.stack<1>
   ins ext.func.args<func.no> before arg.stack<1>
   ins ext.func.rets<func.no> before ret.stack<1>

   * Collect arguments

   loop
      n = arg.stack<1> + 0
   while n
      gosub get.ext.token

      if token.type = TKN.RBR then
         n = arg.stack<1> + 0
         i = func.stack<1>
         if n > 0 then
            message = sysmsg(6936, ext.funcs<i>, ext.func.args<i>)
            * Insufficient arguments in %1 function. Expected %2.
            goto ext.error
         end

         * This is a user function/procedure for which we did not
         * previously know the expected agument count.

         exit
      end

      gosub parse.value
      if ext.err then return
   repeat

   ret.args = ret.stack<1>
   if ret.args < 0 then   ;* Special case
      ret.stack<1> = 0
      n = ext.funcs<func.stack<1>>
      begin case
         case n = 'CAT' or n = 'OR' or n = 'AND'
            loop
               ext.code<-1> = char(func.stack<1> + OP.FUNC - 1)  ;* opcode
               gosub get.ext.token
            until token.type = TKN.RBR
            until token.type = TKN.END
            until token.type = TKN.ERR
               gosub parse.value
            repeat

            if token.type # TKN.RBR then
               message = sysmsg(6919) ;* Expected right bracket
               goto ext.error
            end
            ret.stack<1> = 1

         case n = 'EXIT'
            if ext.loop.depth = 0 then
               message = sysmsg(6937) ;* EXIT not in LOOP
               goto ext.error
            end

            ext.code<-1> = char(func.stack<1> + OP.FUNC - 1)

            gosub get.ext.token
            if token.type # TKN.RBR then
               message = sysmsg(6919) ;* Expected right bracket
               goto ext.error
            end

         case n = 'IF'
            ext.code<-1> = char(OP.JZE)
            ins dcount(ext.code, @fm) before proc.stack<1>

            gosub parse.procedure
            if ext.err then return

            if token.type = TKN.NAM and upcase(token) = 'ELSE' then
               ext.code<-1> = char(OP.JMP)
               n = proc.stack<1> + 0
               ext.code<n> = ext.code<n> : fmt(dcount(ext.code, @fm) + 1, ext.jump.format) ;* Exit addr
               proc.stack<1> = dcount(ext.code, @fm)

               gosub parse.procedure
               if ext.err then return
            end

            n = proc.stack<1> + 0
            ext.code<n> = ext.code<n> : fmt(dcount(ext.code, @fm) + 1, ext.jump.format) ;* Exit addr

            if token.type # TKN.RBR then
               message = sysmsg(6919) ;* Expected right bracket
               goto ext.error
            end

            del proc.stack<1>

         case n = 'INSERT'
            loop
               ext.code<-1> = char(func.stack<1> + OP.FUNC - 1)  ;* INSERT
               gosub get.ext.token
            until token.type = TKN.RBR
            until token.type = TKN.END
            until token.type = TKN.ERR
               gosub parse.value
            repeat

            if token.type # TKN.RBR then
               message = sysmsg(6919) ;* Expected right bracket
               goto ext.error
            end
            ret.stack<1> = 0

         case n = 'LOOP'
            ext.code<-1> = char(func.stack<1> + OP.FUNC - 1)
            ins dcount(ext.code, @fm) before proc.stack<1>
            ext.loop.depth += 1

            gosub parse.procedure
            if ext.err then return

            n = proc.stack<1> + 0
            ext.code<-1> = char(OP.JMP): fmt(n+1, ext.jump.format)  ;* Repeat loop
            ext.loop.depth -= 1
            ext.code<n> = ext.code<n> : fmt(dcount(ext.code, @fm) + 1, ext.jump.format)   ;* Fix up exit link

            if token.type # TKN.RBR then
               message = sysmsg(6919) ;* Expected right bracket
               goto ext.error
            end

            del proc.stack<1>

         case n = 'RETURN'
            if lproc.no then  ext.code<-1> = char(OP.LRETN)
            else ext.code<-1> = char(func.stack<1> + OP.FUNC - 1)

            gosub get.ext.token
            if token.type # TKN.RBR then
               message = sysmsg(6919) ;* Expected right bracket
               goto ext.error
            end

         case n = 'SET'
            gosub get.ext.token   ;* Get variable name
            begin case
               case token.type = TKN.NAM
                  locate token in local.vars<1> setting i else local.vars<-1> = token
                  ins i before proc.stack<1>

                  gosub get.ext.token
                  gosub parse.value  ;* Get value
                  if ext.err then return

                  ext.code<-1> = char(func.stack<1> + OP.FUNC - 1) : proc.stack<1>
                  del proc.stack<1>

               case token.type = TKN.GVR
                  ins token before proc.stack<1>

                  gosub get.ext.token
                  gosub parse.value  ;* Get value
                  if ext.err then return

                  ext.code<-1> = char(OP.SETGV) : proc.stack<1>
                  del proc.stack<1>

               case 1
                  message = sysmsg(6938) ;* Expected variable name
                  goto ext.error
            end case


            gosub get.ext.token
            if token.type # TKN.RBR then
               message = sysmsg(6919) ;* Expected right bracket
               goto ext.error
            end

         case n = 'SWITCH'
            ins '' before proc.stack<1>

            gosub get.ext.token
            loop
            while token.type = TKN.NAM and token = 'CASE'
               gosub get.ext.token
               gosub parse.value
               ext.code<-1> = char(OP.JNE)
               proc.stack<1,1> = dcount(ext.code, @fm) ;* Forward link

               gosub parse.procedure
               if ext.err then return

               ext.code<-1> = char(OP.JMP)
               n = dcount(ext.code, @fm)
               proc.stack<1,-1> = n ;* Exit link

               i = proc.stack<1,1>
               ext.code<i> = ext.code<i>:fmt(n+1, ext.jump.format)  ;* Fix up forward link
            repeat

            ext.code<-1> = char(OP.POP)
            if token.type = TKN.NAM and token = 'ELSE' then
               gosub parse.procedure
               if ext.err then return
            end

            * Now fix up all exit links
            
            s = proc.stack<1>
            del s<1,1>
            if len(s) then
               n = fmt(dcount(ext.code, @fm) + 1, ext.jump.format)
               loop
                  j = remove(s, delim)
                  ext.code<j> = ext.code<j>:n
               while delim
               repeat
            end

            del proc.stack<1>

            if token.type # TKN.RBR then
               message = sysmsg(6919) ;* Expected right bracket
               goto ext.error
            end

         case 1
            message = sysmsg(6939) ;* Internal error - Invalid function for proc stack
            goto ext.error
      end case
      ret.args = ret.stack<1>
   end else
      n = arg.stack<1>
      if n < 0 then         ;* User function for which we did not know arg count
         ext.func.args<i> = -(n + 1)  ;* Set it for next usage
      end else              ;* Built-in or previously used user function
                             * Check right bracket next
         gosub get.ext.token
         if token.type # TKN.RBR then
            message = sysmsg(6919) ;* Expected right bracket
            goto ext.error
         end
      end

      * Generate code to perform function

      n = func.stack<1>
      if n > num.funcs then   ;* User function
         if ext.func.rets<n> > 0 then
            ext.code<-1> = char(OP.UFUNC):ext.func.args<n>:'.':ext.funcs<n>
         end else
            ext.code<-1> = char(OP.UPROC):ext.func.args<n>:'.':ext.funcs<n>
         end
      end else                ;* Built-in function
         ext.code<-1> = char(n + OP.FUNC - 1)
      end
   end

   * Pop function details

   del func.stack<1>
   del arg.stack<1>
   del ret.stack<1>

   return

ext.error:
   display  ;* Terminate ... progress line
   display ext.line : '.' : (src.idx - ext.line.start) : ': ' : message
   ext.err = @true
   return

* ======================================================================

parse.value:
   begin case
      case token.type = TKN.END
         message = sysmsg(6940) ;* Unexpected end of source program
         goto ext.error

      case token.type = TKN.LBR
         is.func = @true ; gosub parse.function
         if ext.err then return
         if ret.args = 0 then
            message = sysmsg(6941) ;* Function returns no value
            goto ext.error
         end
         arg.stack<1> = arg.stack<1> - ret.args

      case token.type = TKN.STR
         ext.code<-1> = char(OP.LDLIT):token  ;* Push string
         arg.stack<1> = arg.stack<1> - 1

      case token.type = TKN.NAM
         locate token in local.vars<1> setting i else local.vars<i> = token
         ext.code<-1> = char(OP.LDVAR):i
         arg.stack<1> = arg.stack<1> - 1

      case token.type = TKN.NUM
         token += 0  ;* Remove extraneous zeros by conversion
         ext.code<-1> = char(OP.LDNUM):token
         arg.stack<1> = arg.stack<1> - 1

      case token.type = TKN.SYS
         find token in ext.funcs setting n then
            ext.code<-1> = char(n + OP.FUNC - 1)
            arg.stack<1> = arg.stack<1> - 1
         end else
            message = sysmsg(6942, token) ;* Unrecognised system variable : %1
            goto ext.error
         end

      case token.type = TKN.GVR
         ext.code<-1> = char(OP.LDGVR):token
         arg.stack<1> = arg.stack<1> - 1

      case 1
         message = sysmsg(6943) ;* Syntax error
         gosub ext.error
         return
   end case

   return

* ======================================================================

get.ext.token:
   c = rec[src.idx,1]
   src.idx += 1
   token = ''

   begin case
      case len(c) = 0
         token.type = TKN.END

      case c = @fm   ;* (Must be before alpha() for Unidata)
         ext.line += 1
         ext.line.start = src.idx
         if rem(ext.line, 10) = 0 then display '.' :
         goto get.ext.token

      case c = '('
         token.type = TKN.LBR

      case c = ')'
         token.type = TKN.RBR

      case alpha(c)
         token.type = TKN.NAM
         token = upcase(c)
         loop
            c = upcase(rec[src.idx,1])
         while index(name.chars, c, 1)
            token := c
            src.idx += 1
         repeat

      case c = '"' or c = "'"
         i = index(rec[src.idx,9999999], c, 1)
         if i then
            token.type = TKN.STR
            token = rec[src.idx, i - 1]
            src.idx += i
            if convert(mark.chars, '', token) # token then
               message = sysmsg(6944) ;* Mark characters not allowed in string literals
               goto ext.error
               token.type = TKN.ERR
            end
         end else
            token.type = TKN.ERR
         end

      case c = '@' or c = '%'
         token.type = TKN.SYS
         token = c
         loop
            c = upcase(rec[src.idx,1])
         while index(name.chars, c, 1)
            token := c
            src.idx += 1
         repeat

      case num(c) or c= '-' or c = '+'
         token.type = TKN.NUM
         loop
            token := c
            c = rec[src.idx,1]
         while num(token:c)
            src.idx += 1
         repeat

      case c = '$'
         token.type = TKN.GVR
         token = '$'
         loop
            c = upcase(rec[src.idx,1])
         while index(name.chars, c, 1)
            token := c
            src.idx += 1
         repeat

      case c = ' '
         goto get.ext.token

      case c = '.'      ;* Key token constant
         token = ''
         loop
            c = upcase(rec[src.idx,1])
         while index(name.chars, c, 1)
            token := c
            src.idx += 1
         repeat

         s = upcase(convert('| ', @fm:'.', actions))
         locate token in s<1> setting i then
            if i > LAST.BINDABLE.ACTION then i += 500 - LAST.BINDABLE.ACTION
            token.type = TKN.NUM
            token = i
         end else
            token.type = TKN.ERR
         end

      case c = ','
         token.type = TKN.COM

      case c = '*'   ;* Start of comment
         i = index(rec[src.idx,99999999], @fm, 1)
         if i then
            src.idx += i - 1  ;* Don't walk past @fm, want it for line counting
            goto get.ext.token
         end
         token.type = TKN.END

      case 1
         token.type = TKN.ERR
   end case

   return

* ======================================================================
* Run extension named in ext.name
*
* ext.arg.count contains number of arguments being passed
*
* Returns ext.code = 0  OK
*                    1  Extension not found
*                    2  Terminated by (stop)
*                    3  Trying to run func as proc
*                    4  Trying to run proc as func
*                    5  Nested too deep
*                    6  XEQ'd command failure
*                    7  Argument count mismatch
*                    8  Local procs nested too deep
*                    9  Quit executed

run.extension:
   unload.extensions = @false
   loop.stack = ''
   call.stack = ''    ;* V1 = ext.idx
                       * V2 = index into proc
                       * V3 = ext.var.base
                       * V4 = lcall.stack
   is.func = @false
   e.stack.ptr = 0

recursive:
   locate ext.name in extensions<1> setting ext.idx else
      * Must load extension

      locate '' in extensions<1> setting j then ext.idx = j ;* Reuse dead entry

      * Get list of files to search

      s = '$$EXTENSION.FILES' ; gosub find.gvar
      if global.vars(i) = '' then global.vars(i) = '&SED.EXTENSIONS&'
      ss = convert(' ', @fm, trim(global.vars(i)))

      j = @false
      if len(ss) then
         loop
            open remove(ss, delim) to ext.f then
               read s from ext.f, ext.name:'-EXT' then
                  j = @true
                  exit
               end
            end
         while delim
         repeat
      end

      if not(j) then
         ext.code = 1
         return
      end

      if ext.idx > ext.table.size then  ;* Must extend extensions table
         ext.table.size += EXT.TABLE.SIZE.INCREMENT
         dim ext.table(ext.table.size)
      end

      extensions<ext.idx> = ext.name
      ext.table(ext.idx) = s<1> : @fm : convert(char(0), @fm, field(s, @fm, 2, 999999))
   end

   ext.proc = ext.table(ext.idx)

   if seq(ext.proc[2,1]) # is.func then
      ext.code = 3 + is.func
      return
   end

   if seq(ext.proc[3,1]) # ext.arg.count then  ;* Arg count mismatch
      ext.code = 7
      return
   end

   execution.depth += 1

   i = seq(ext.proc[4,1])  ;* Local variable count
   if i then
      j = ext.var.base + i  ;* Index of highest local variable
      if j > ext.var.stack.size then
         ext.var.stack.size = j
         dim ext.vars(ext.var.stack.size)
      end

      for j = 1 to i
         ext.vars(ext.var.base + j) = ''
      next j
   end

   * Transfer arguments to local variables

   if ext.arg.count then
      for i = ext.arg.count to 1 step -1
         ext.vars(ext.var.base+i) = e.stack(e.stack.ptr)
         e.stack.ptr -= 1
      next i
   end

   * Initialise local call stack

   lcall.stack = ''

   setrem index(ext.proc, @fm, 1) on ext.proc

   loop
      ext.op = remove(ext.proc, delim)
      opcode = seq(ext.op[1,1])
      on opcode gosub extop.ldlit,     ;* Load literal
                      extop.ldvar,     ;* Load user variable reference
                      extop.uproc,     ;* Run user procedure
                      extop.ufunc,     ;* Run user function
                      extop.jze,       ;* Jump if zero (or null)
                      extop.jnz,       ;* Jump if non-zero
                      extop.jmp,       ;* Unconditional jump
                      extop.ldgvr,     ;* Load global variable
                      extop.setgvar,   ;* Set global variable
                      extop.jne,       ;* Jump if not equal
                      extop.pop,       ;* Pop top stack item
                      extop.ldnum,     ;* Load numeric literal
                      extop.lcall,     ;* Local call
                      extop.lretn,     ;* Local return
                      extop.illegal,
                      extop.illegal,
                      extop.illegal,
                      extop.illegal,
                      extop.illegal,
                      extop.illegal,
                      extop.illegal,
                      extop.illegal,
                      extop.illegal,
                      extop.illegal,
                      extop.illegal,
                      extop.illegal,
                      extop.illegal,
                      extop.illegal,
                      extop.illegal,
                      extop.add,            ;* Add
                      extop.sub,            ;* Sub
                      extop.mul,            ;* Mul
                      extop.div,            ;* Div
                      extop.concat,         ;* Concat
                      extop.substr,         ;* Substr
                      extop.pad,            ;* Pad
                      extop.len,            ;* Len
                      extop.trimf,          ;* Trimf
                      extop.trimb,          ;* Trimb
                      extop.extract,        ;* Extract
                      extop.rep,            ;* Rep
                      extop.del,            ;* Del
                      extop.ins,            ;* Ins
                      extop.field,          ;* Field
                      extop.eq,             ;* Eq
                      extop.ne,             ;* Ne
                      extop.gt,             ;* Gt
                      extop.ge,             ;* Ge
                      extop.lt,             ;* Lt
                      extop.le,             ;* Le
                      extop.and,            ;* And
                      extop.or,             ;* Or
                      extop.not,            ;* Not
                      extop.illegal,        ;* If (Should never be executed)
                      extop.illegal,        ;* Switch (Should never be executed)
                      extop.loop,           ;* Loop
                      extop.exit,           ;* Exit
                      extop.stop,           ;* Stop
                      extop.return,         ;* Return
                      extop.set,            ;* Set
                      extop.left,           ;* Back.char
                      extop.right,          ;* Fwd.char
                      extop.tab,            ;* Tab
                      extop.page.up,        ;* Page.up
                      extop.page.down,      ;* Page.down
                      extop.up,             ;* Up.line
                      extop.down,           ;* Down.line
                      extop.top,            ;* Top
                      extop.bottom,         ;* Bottom
                      extop.start.line,     ;* Start.line
                      extop.end.line,       ;* End.line
                      extop.del.char,       ;* Del.char
                      extop.backspace,      ;* Backspace
                      extop.kill.line,      ;* Kill.line
                      extop.insert,         ;* Insert
                      extop.newline,        ;* Newline
                      extop.retype,         ;* Retype
                      extop.kill.buffer,    ;* %Kill.buffer
                      extop.fsearch,        ;* Fsearch
                      extop.rsearch,        ;* Rsearch
                      extop.file,           ;* File
                      extop.id,             ;* Id
                      extop.buffer.no,      ;* Buffer.no
                      extop.buffer.type,    ;* Buffer.type
                      extop.read.only,      ;* Read.only
                      extop.current.line,   ;* Current line
                      extop.current.char,   ;* Current char
                      extop.col,            ;* Col
                      extop.line.len,       ;* Line.len
                      extop.line,           ;* Line
                      extop.lines,          ;* Lines
                      extop.mark.line,      ;* Mark.line
                      extop.mark.col,       ;* Mark.col
                      extop.set.mark,       ;* Set.mark
                      extop.swap.mark,      ;* Swap.mark
                      extop.goto.line,      ;* Goto.line
                      extop.goto.col,       ;* Goto.col
                      extop.prompt,         ;* Prompt
                      extop.key.ready,      ;* Key.ready
                      extop.get.char,       ;* Get.char
                      extop.get.key,        ;* Get.key
                      extop.wait.input,     ;* Wait.input
                      extop.key.char,       ;* Key.char
                      extop.prefix.count,   ;* Prefix.count
                      extop.prefix.set,     ;* Prefix.set
                      extop.paint,          ;* Paint
                      extop.status.msg,     ;* Status.msg
                      extop.beep,           ;* Beep
                      extop.scroll,         ;* %Scroll
                      extop.pan,            ;* %Pan
                      extop.set.scroll,     ;* Set.scroll
                      extop.set.pan,        ;* Set.pan
                      extop.xeq,            ;* Xeq
                      extop.bind.command,   ;* Bind.command
                      extop.bind.key,       ;* Bind.key
                      extop.unload,         ;* Unload extensions
                      extop.at.im,
                      extop.at.fm,
                      extop.at.vm,
                      extop.at.sm,
                      extop.at.tm,
                      extop.at.logname,
                      extop.at.crthigh,
                      extop.at.crtwide,
                      extop.at.date,
                      extop.at.path,
                      extop.at.sentence,
                      extop.at.term.type,
                      extop.at.time,
                      extop.at.tty,
                      extop.at.userno,
                      extop.at.who,
                      extop.make.buffer,
                      extop.find.record,    ;* Find.record
                      extop.save.record,    ;* Save.record
                      extop.write.record,   ;* Write.record
                      extop.read,           ;* Read
                      extop.write,          ;* Write
                      extop.delete,         ;* Delete
                      extop.exists,         ;* Exists
                      extop.overlay,        ;* %overlay
                      extop.set.overlay,    ;* Set.overlay
                      extop.changed,        ;* %changed
                      extop.set.changed,    ;* Set.changed
                      extop.set.case,       ;* Set.case
                      extop.toggle.chars,   ;* Toggle.chars
                      extop.copy.region,    ;* Copy.region
                      extop.delete.region,  ;* Delete.region
                      extop.fwd.word,       ;* Fwd.word
                      extop.back.word,      ;* Back.word
                      extop.del.word,       ;* Del.word
                      extop.del.back.word,  ;* Del.back.word
                      extop.close.spaces,   ;* Close.spaces
                      extop.next.buffer,    ;* Next.buffer
                      extop.prev.buffer,    ;* Prev.buffer
                      extop.goto.buffer,    ;* Goto.buffer
                      extop.delete.buffer,  ;* Delete.buffer
                      extop.key.bindings,   ;* %Key.bindings
                      extop.num,            ;* Num
                      extop.alpha,          ;* Alpha
                      extop.convert,        ;* Convert
                      extop.dcount,         ;* Dcount
                      extop.count,          ;* Count
                      extop.index,          ;* Index
                      extop.rem,            ;* Rem
                      extop.seq,            ;* Seq
                      extop.char,           ;* Char
                      extop.iconv,          ;* Iconv
                      extop.oconv,          ;* Oconv
                      extop.tab.interval,   ;* %Tab.interval
                      extop.set.tab.interval, ;* Set.tab.interval
                      extop.int,            ;* Int
                      extop.find.buffer,    ;* Find.buffer
                      extop.set.read.only,  ;* Set.read.only
                      extop.macro.state,    ;* %Macro.state
                      extop.quit,           ;* Quit
                      extop.execute,        ;* Execute
                      extop.width,          ;* %width
                      extop.height,         ;* %height
                      extop.min,            ;* min
                      extop.max,            ;* max
                      extop.matches,        ;* matches
                      extop.matchfield,     ;* matchfield
                      extop.trim,           ;* trim
                      extop.upcase,         ;* upcase
                      extop.downcase,       ;* downcase
                      extop.illegal         ;* Catch out of range opcode
   repeat


ext.return:
   execution.depth -= 1
   if execution.depth = 0 and refresh.file then
      gosub paint.file.line
      refresh.file = @false
   end

   if unload.extensions then
      extensions = ''
      mat ext.table = ''
   end

   return


extop.ldlit:     ;* Load string literal
   e.stack.ptr += 1
   e.stack(e.stack.ptr) = ext.op[2,9999999]
   return

extop.ldvar:     ;* Load user variable reference
   e.stack.ptr += 1
   e.stack(e.stack.ptr) = ext.vars(ext.var.base + ext.op[2,9999])
   return

extop.ufunc:     ;* Run user function
extop.uproc:     ;* Run user procedure
   if dcount(call.stack, @fm) = MAX.EXT.DEPTH then
      ext.code = 5
      return to ext.return  ;* Break out of dispatch loop
   end

   s = ext.idx:@vm:getrem(ext.proc):@vm:ext.var.base
   ins s before call.stack<1>           ;* Save return information
   ext.var.base += seq(ext.proc[4,1])   ;* Adjust local variable stack

   s = ext.op[2,9999]
   ext.arg.count = field(s, '.', 1)
   ext.name = field(s, '.', 2, 9999)
   is.func = (opcode = OP.UFUNC)
   gosub recursive

   ext.idx = call.stack<1,1> + 0
   ext.proc = ext.table(ext.idx)
   setrem call.stack<1,2> on ext.proc
   ext.var.base = call.stack<1,3> + 0

   del call.stack<1>

   if ext.code then return to ext.return  ;* Stop or error - unwind 
   return

extop.return:    ;* Return to caller
   ext.code = 0
   return to ext.return  ;* Break out of dispatch loop

extop.jze:
   n = e.stack(e.stack.ptr)
   e.stack.ptr -= 1
   if not(n) then setrem ext.op[2,99] on ext.proc
   return

extop.jnz:
   n = e.stack(e.stack.ptr)
   e.stack.ptr -= 1
   if n then setrem ext.op[2,99] on ext.proc
   return

extop.jmp:
   setrem ext.op[2,99] on ext.proc
   return

extop.ldgvr:
   s = ext.op[2,9999]
   gosub find.gvar
   e.stack.ptr += 1
   e.stack(e.stack.ptr) = global.vars(i)
   return

extop.setgvar:
   s = ext.op[2,9999]
   gosub find.gvar
   global.vars(i) = e.stack(e.stack.ptr)
   e.stack.ptr -= 1
   return

extop.jne:
   if (e.stack(e.stack.ptr) # e.stack(e.stack.ptr-1)) then
      e.stack.ptr -= 1
      setrem ext.op[2,99] on ext.proc
   end else
      e.stack.ptr -= 2
   end
   return

extop.pop:
   e.stack.ptr -= 1
   return

extop.ldnum:     ;* Load numeric literal
   e.stack.ptr += 1
   e.stack(e.stack.ptr) = ext.op[2,9999999] + 0
   return

extop.lcall:
   if dcount(lcall.stack, @sm) > MAX.LCALL.DEPTH then
      ext.code = 8
      return to ext.return  ;* Break out of dispatch loop
   end
   ins getrem(ext.proc) before lcall.stack<1,1,1>
   setrem ext.op[2,999] on ext.proc
   return

extop.lretn:
   setrem lcall.stack<1,1,1> on ext.proc
   del lcall.stack<1,1,1>
   return

extop.loop:
   ins ext.op[2,99] before loop.stack<1>
   return

extop.exit:
   setrem loop.stack<1> on ext.proc
   del loop.stack<1>
   return

extop.stop:
   ext.code = 2
   return to ext.return  ;* Break out of dispatch loop

extop.illegal:
   stop 'Illegal opcode in extension'

extop.add:       ;* Add
   i = e.stack(e.stack.ptr) ; if not(num(i)) then i = 0
   e.stack.ptr -= 1
   j = e.stack(e.stack.ptr) ; if not(num(i)) then i = 0
   e.stack(e.stack.ptr) = i + j
   return

extop.sub:       ;* Sub
   i = e.stack(e.stack.ptr) ; if not(num(i)) then i = 0
   e.stack.ptr -= 1
   j = e.stack(e.stack.ptr) ; if not(num(i)) then i = 0
   e.stack(e.stack.ptr) = j - i
   return

extop.mul:       ;* Mul
   i = e.stack(e.stack.ptr) ; if not(num(i)) then i = 0
   e.stack.ptr -= 1
   j = e.stack(e.stack.ptr) ; if not(num(i)) then i = 0
   e.stack(e.stack.ptr) = i * j
   return

extop.div:       ;* Div
   i = e.stack(e.stack.ptr) ; if not(num(i)) then i = 1
   e.stack.ptr -= 1
   j = e.stack(e.stack.ptr) ; if not(num(i)) then i = 0
   e.stack(e.stack.ptr) = j / i
   return

extop.concat:
   e.stack.ptr -= 1
   e.stack(e.stack.ptr) := e.stack(e.stack.ptr+1)
   return
   
extop.substr:
   e.stack.ptr -= 2
   i = e.stack(e.stack.ptr+2) ; if not(num(i)) then i = 1 ;* Length
   j = e.stack(e.stack.ptr+1)   ; if not(num(J)) then j = 0 ;* Start
   e.stack(e.stack.ptr) = e.stack(e.stack.ptr)[j, i]
   return

extop.pad:
   i = e.stack(e.stack.ptr)
   e.stack.ptr -=1
   if num(i) then
      s = e.stack(e.stack.ptr)
      if len(s) < i then e.stack(e.stack.ptr) := space(i - len(s)) 
   end
   return

extop.len:
   e.stack(e.stack.ptr) = len(e.stack(e.stack.ptr))
   return

extop.trimf:
   e.stack(e.stack.ptr) = trimf(e.stack(e.stack.ptr))
   return

extop.trimb:
   e.stack(e.stack.ptr) = trimb(e.stack(e.stack.ptr))
   return

extop.extract:
   e.stack.ptr -= 3
   i = e.stack(e.stack.ptr+1) ; if not(num(i)) then i = 1 ;* Field
   j = e.stack(e.stack.ptr+2) ; if not(num(j)) then j = 0 ;* Value
   k = e.stack(e.stack.ptr+3) ; if not(num(k)) then k = 0 ;* Subvalue
   e.stack(e.stack.ptr) = e.stack(e.stack.ptr)<i,j,k>
   return

extop.rep:
   e.stack.ptr -= 4
   i = e.stack(e.stack.ptr+1) ; if not(num(i)) then i = 1 ;* Field
   j = e.stack(e.stack.ptr+2) ; if not(num(j)) then j = 0 ;* Value
   k = e.stack(e.stack.ptr+3) ; if not(num(k)) then k = 0 ;* Subvalue
   e.stack(e.stack.ptr)<i,j,k> = e.stack(e.stack.ptr+4)
   return

extop.del:
   e.stack.ptr -= 3
   i = e.stack(e.stack.ptr+1) ; if not(num(i)) then i = 1 ;* Field
   j = e.stack(e.stack.ptr+2) ; if not(num(j)) then j = 0 ;* Value
   k = e.stack(e.stack.ptr+3) ; if not(num(k)) then k = 0 ;* Subvalue
   del e.stack(e.stack.ptr)<i,j,k>
   return

extop.ins:
   e.stack.ptr -= 4
   i = e.stack(e.stack.ptr+1) ; if not(num(i)) then i = 1 ;* Field
   j = e.stack(e.stack.ptr+2) ; if not(num(j)) then j = 0 ;* Value
   k = e.stack(e.stack.ptr+3) ; if not(num(k)) then k = 0 ;* Subvalue
   ins e.stack(e.stack.ptr+4) before e.stack(e.stack.ptr)<i,j,k>
   return

extop.field:
   e.stack.ptr -= 3
   j = e.stack(e.stack.ptr+2) ; if not(num(j)) then j = 1 ;* Occurrence
   k = e.stack(e.stack.ptr+3) ; if not(num(k)) then k = 1 ;* Count
   e.stack(e.stack.ptr) = field(e.stack(e.stack.ptr), e.stack(e.stack.ptr+1), j, k)
   return

extop.eq:
   e.stack.ptr -= 1
   e.stack(e.stack.ptr) = (e.stack(e.stack.ptr) = e.stack(e.stack.ptr+1))
   return

extop.ne:
   e.stack.ptr -= 1
   e.stack(e.stack.ptr) = (e.stack(e.stack.ptr) # e.stack(e.stack.ptr+1))
   return

extop.gt:
   e.stack.ptr -= 1
   e.stack(e.stack.ptr) = (e.stack(e.stack.ptr) > e.stack(e.stack.ptr+1))
   return

extop.ge:
   e.stack.ptr -= 1
   e.stack(e.stack.ptr) = (e.stack(e.stack.ptr) >= e.stack(e.stack.ptr+1))
   return

extop.lt:
   e.stack.ptr -= 1
   e.stack(e.stack.ptr) = (e.stack(e.stack.ptr) < e.stack(e.stack.ptr+1))
   return

extop.le:
   e.stack.ptr -= 1
   e.stack(e.stack.ptr) = (e.stack(e.stack.ptr) <= e.stack(e.stack.ptr+1))
   return

extop.and:
   e.stack.ptr -= 1
   e.stack(e.stack.ptr) = (e.stack(e.stack.ptr) and e.stack(e.stack.ptr+1))
   return

extop.or:
   e.stack.ptr -= 1
   e.stack(e.stack.ptr) = (e.stack(e.stack.ptr) or e.stack(e.stack.ptr+1))
   return

extop.not:
   e.stack(e.stack.ptr) = not(e.stack(e.stack.ptr))
   return

extop.set:
   ext.vars(ext.var.base + ext.op[2,9999]) = e.stack(e.stack.ptr)
   e.stack.ptr -= 1
   return
   
extop.left:      ;* Left
   i = e.stack(e.stack.ptr) ; e.stack.ptr -= 1
   if num(i) and i > 0 then
      rpt = int(i)
      gosub a.left
   end
   return

extop.right:     ;* Right
   i = e.stack(e.stack.ptr) ; e.stack.ptr -= 1
   if num(i) and i > 0 then
      rpt = int(i)
      gosub a.right
   end
   return

extop.tab:
   i = e.stack(e.stack.ptr) ; e.stack.ptr -= 1
   if num(i) and i > 0 and not(read.only) then
      rpt = int(i)
      gosub a.tab
   end
   return

extop.page.up:     ;* Page.up
   i = e.stack(e.stack.ptr) ; e.stack.ptr -= 1
   if num(i) and i > 0 then
      rpt = int(i)
      gosub a.page.up
      line.len = len(current.line)
   end
   return

extop.page.down:     ;* Page.down
   i = e.stack(e.stack.ptr) ; e.stack.ptr -= 1
   if num(i) and i > 0 then
      rpt = int(i)
      gosub a.page.down
      line.len = len(current.line)
   end
   return

extop.up:     ;* Up
   i = e.stack(e.stack.ptr) ; e.stack.ptr -= 1
   if num(i) and i > 0 then
      rpt = int(i)
      gosub a.up
      line.len = len(current.line)
   end
   return

extop.down:     ;* Down
   i = e.stack(e.stack.ptr) ; e.stack.ptr -= 1
   if num(i) and i > 0 then
      rpt = int(i)
      gosub a.down
      line.len = len(current.line)
   end
   return

extop.top:
   gosub a.top
   return

extop.bottom:
   gosub a.bottom
   return

extop.start.line:
   gosub a.home
   return

extop.end.line:
   gosub a.end
   return

extop.del.char:
   i = e.stack(e.stack.ptr) ; e.stack.ptr -= 1
   if not(read.only) and num(i) and i > 0 then
      rpt = int(i)
      gosub a.delete
      line.len = len(current.line)
   end
   return

extop.backspace:
   i = e.stack(e.stack.ptr) ; e.stack.ptr -= 1
   if not(read.only) and int(i) and i > 0 then
      rpt = int(i)
      gosub a.backspace
      line.len = len(current.line)
   end
   return

extop.kill.line:
   i = e.stack(e.stack.ptr) ; e.stack.ptr -= 1
   if not(read.only) and num(i) and i > 0 then
      rpt = int(i)
      gosub a.kill.line
      line.len = len(current.line)
   end
   return

extop.insert:
   if not(read.only) then
      loop
      while len(e.stack(e.stack.ptr))
         c = field(e.stack(e.stack.ptr), @fm, 1)
         e.stack(e.stack.ptr) = e.stack(e.stack.ptr)[col2(),9999999]
         if len(c) then
            if col > line.len then col = line.len + 1
            if overlay then
               current.line = current.line[1, col - 1] : c : current.line[col + len(c), 99999999]
            end else
               current.line = current.line[1, col - 1] : c : current.line[col, 99999999]
               if line = mark.line then
                  if mark.col >= col then mark.col += len(c)
               end
            end

            col += len(c)
            line.len = len(current.line)
            line.updated = @true
            if line > lines then gosub save.current  ;* Make new line
            gosub refresh.line
         end

         loop
         while e.stack(e.stack.ptr)[1,1] = @fm
            e.stack(e.stack.ptr) = e.stack(e.stack.ptr)[2,999999]
            rpt = 1 ; gosub a.newline
            line.len = len(current.line)
         repeat
      repeat
   end
   e.stack.ptr -= 1
   return

extop.newline:
   i = e.stack(e.stack.ptr) ; e.stack.ptr -= 1
   if not(read.only) and num(i) and i > 0 then
      rpt = int(i)
      gosub a.newline
      line.len = len(current.line)
   end
   return

extop.retype:
   if not(read.only) then
      current.line = e.stack(e.stack.ptr)
      line.len = len(current.line)
      line.updated = @true
      if line > lines then gosub save.current  ;* Make new line
      gosub refresh.line
   end
   e.stack.ptr -= 1
   return

extop.kill.buffer:
   e.stack.ptr += 1
   e.stack(e.stack.ptr) = kill.buffer
   return

extop.fsearch:
   search.string = e.stack(e.stack.ptr) ; e.stack.ptr -= 1
   saved.search.mode = search.mode
   search.mode = e.stack(e.stack.ptr)
   if not(num(search.mode)) then search.mode = 0
   if col > line.len then col = line.len + 1
   advance = 1
   gosub fsearch
   e.stack(e.stack.ptr) = found

   search.mode = saved.search.mode

   return

extop.rsearch:
   search.string = e.stack(e.stack.ptr) ; e.stack.ptr -= 1
   saved.search.mode = search.mode
   search.mode = e.stack(e.stack.ptr)
   if not(num(search.mode)) then search.mode = 0
   if col > line.len then col = line.len + 1
   gosub rsearch
   e.stack(e.stack.ptr) = found

   search.mode = saved.search.mode

   return

extop.file:
   e.stack.ptr += 1
   e.stack(e.stack.ptr) = if len(dict.flag) then ('DICT ':file.name) else file.name
   return

extop.id:
   e.stack.ptr += 1
   e.stack(e.stack.ptr) = record.name
   return

extop.buffer.no:
   e.stack.ptr += 1
   e.stack(e.stack.ptr) = current.buffer
   return

extop.buffer.type:
   e.stack.ptr += 1
   e.stack(e.stack.ptr) = buffer.type
   return

extop.read.only:
   e.stack.ptr += 1
   e.stack(e.stack.ptr) = read.only
   return

extop.current.line:
   e.stack.ptr += 1
   e.stack(e.stack.ptr) = current.line
   return

extop.current.char:
   e.stack.ptr += 1
   e.stack(e.stack.ptr) = current.line[col,1]
   return

extop.col:
   e.stack.ptr += 1
   e.stack(e.stack.ptr) = col
   return
   
extop.line.len:
   e.stack.ptr += 1
   e.stack(e.stack.ptr) = len(current.line)
   return
   
extop.line:
   e.stack.ptr += 1
   e.stack(e.stack.ptr) = line
   return
   
extop.lines:
   e.stack.ptr += 1
   e.stack(e.stack.ptr) = lines
   return

extop.mark.line:
   e.stack.ptr += 1
   e.stack(e.stack.ptr) = mark.line
   return

extop.mark.col:
   e.stack.ptr += 1
   e.stack(e.stack.ptr) = if mark.line then mark.col else 0
   return

extop.set.mark:
   gosub a.mark
   return

extop.swap.mark:
   if mark.line then gosub a.swap.mark
   return

extop.goto.line:
   i = e.stack(e.stack.ptr) ; e.stack.ptr -= 1
   if num(i) and i > 0 then
      rpt = int(i)
      gosub a.goto.line
      line.len = len(current.line)
   end
   return

extop.goto.col:
   j = e.stack(e.stack.ptr)
   e.stack.ptr -= 1
   if num(j) and j > 0 then
      col = j
      i = col - (line.len + 1)
      if i > 0 then
         current.line := space(i)
         line.len += i
         line.updated = @true
      end
   end
   return

extop.prompt:
   s = e.stack(e.stack.ptr)
   e.stack.ptr -= 1
   prefix = e.stack(e.stack.ptr) : ': '
   gosub get.string
   if aborted then s = ''
   e.stack(e.stack.ptr) = s
   return

extop.key.ready:
   gosub check.keyready
   e.stack.ptr += 1
   e.stack(e.stack.ptr) = keyready
   return

extop.get.char:
   gosub getch
   e.stack.ptr += 1
   e.stack(e.stack.ptr) = c
   return

extop.get.key:
   gosub update.screen
   gosub place.cursor
   gosub get.key
   e.stack.ptr += 1
   if action > LAST.BINDABLE.ACTION then
      e.stack(e.stack.ptr) = 500 + action - LAST.BINDABLE.ACTION
   end else
      e.stack(e.stack.ptr) = action
   end
   key.char = if action = F.INSERT then c else ''
   prefix.count = if rpt.set then rpt else -1
   return

extop.wait.input:
   gosub wait.input
   return

extop.key.char:
   e.stack.ptr += 1
   e.stack(e.stack.ptr) = key.char
   return

extop.prefix.count:
   e.stack.ptr += 1
   e.stack(e.stack.ptr) = if prefix.count < 0 then 1 else prefix.count
   return

extop.prefix.set:
   e.stack.ptr += 1
   e.stack(e.stack.ptr) = (prefix.count >= 0)
   return

extop.paint:
   i = e.stack(e.stack.ptr) ; e.stack.ptr -= 1
   if i then
      gosub clear.screen
      gosub refresh.all
   end
   gosub update.screen
   gosub place.cursor
   return   

extop.status.msg:
   message = e.stack(e.stack.ptr)[1,swm1]
   e.stack.ptr -= 1
   if len(message) then gosub file.msg else gosub paint.file.line
   refresh.file = @true
   return

extop.beep:
   display @sys.bell :
   return

extop.scroll:
   e.stack.ptr += 1
   e.stack(e.stack.ptr) = top.line
   return

extop.pan:
   e.stack.ptr += 1
   e.stack(e.stack.ptr) = pan
   return

extop.set.scroll:
   i = e.stack(e.stack.ptr) ; e.stack.ptr -= 1
   if num(i) and i > 0 and i <= lines then
      top.line = i
      gosub refresh.all
   end
   return

extop.set.pan:
   i = e.stack(e.stack.ptr) ; e.stack.ptr -= 1
   if num(i) and i > 0 then
      pan = i
      gosub refresh.all
   end
   return

extop.xeq:
   suppress.command.cr = @false
   goto extop.xeq.common
extop.execute:
   suppress.command.cr = @true
extop.xeq.common:
   s = e.stack(e.stack.ptr) ; e.stack.ptr -= 1
   gosub ext.command
   if abort.macro then
      ext.code = 6
      return to ext.return  ;* Break out of dispatch loop
   end
   return

extop.bind.command:
   e.stack.ptr -= 2
   s = e.stack(e.stack.ptr+2)
   locate s in extension.commands<1,1> setting i else
      extension.commands<1,i> = s
   end
   extension.commands<2,i> = upcase(e.stack(e.stack.ptr+1))
   return

extop.bind.key:
   z = e.stack(e.stack.ptr) ; e.stack.ptr -= 1   ;* Key sequence
   k = upcase(e.stack(e.stack.ptr))              ;* Extension name
   e.stack(e.stack.ptr) = @false                  ;* Initialise for failure

   n = len(z)
   begin case
      case n = 0
         return

      case n = 1   ;* Single key binding
         n = seq(z[1,1])
         if n >= 127 or seq(action.list[n,1]) = 0 then
            action.list[n,1] = char(F.BOUND.EXT)
            ext.func.bindings<n> = k    ;* Proc name
            e.stack(e.stack.ptr) = @true
         end

      case 1
         n = seq(z[1,1])
         if n < 32 or n >= 127 then
            if seq(action.list[n,1]) = 0 then
               locate z in keys<1> by 'AL' setting i else
                  ins z before keys<i>
                  ins F.BOUND.EXT:@vm:k before key.actions<i>
                  e.stack(e.stack.ptr) = @true
               end
            end
         end
   end case
   return

extop.unload:
   unload.extensions = @true
   return

extop.at.im:
   e.stack.ptr += 1
   e.stack(e.stack.ptr) = @im
   return

extop.at.fm:
   e.stack.ptr += 1
   e.stack(e.stack.ptr) = @fm
   return

extop.at.vm:
   e.stack.ptr += 1
   e.stack(e.stack.ptr) = @vm
   return

extop.at.sm:
   e.stack.ptr += 1
   e.stack(e.stack.ptr) = @sm
   return

extop.at.tm:
   e.stack.ptr += 1
   e.stack(e.stack.ptr) = @tm
   return

extop.at.logname:
   e.stack.ptr += 1
   e.stack(e.stack.ptr) = @logname
   return

extop.at.crthigh:
   e.stack.ptr += 1
   e.stack(e.stack.ptr) = @crthigh
   return

extop.at.crtwide:
   e.stack.ptr += 1
   e.stack(e.stack.ptr) = @crtwide
   return

extop.at.date:
   e.stack.ptr += 1
   e.stack(e.stack.ptr) = date()
   return

extop.at.path:
   e.stack.ptr += 1
   e.stack(e.stack.ptr) = @path
   return

extop.at.sentence:
   e.stack.ptr += 1
   e.stack(e.stack.ptr) = @sentence
   return

extop.at.term.type:
   e.stack.ptr += 1
   e.stack(e.stack.ptr) = @term.type
   return

extop.at.time:
   e.stack.ptr += 1
   e.stack(e.stack.ptr) = time()
   return

extop.at.tty:
   e.stack.ptr += 1
   e.stack(e.stack.ptr) = @tty
   return

extop.at.userno:
   e.stack.ptr += 1
   e.stack(e.stack.ptr) = @userno
   return

extop.at.who:
   e.stack.ptr += 1
   e.stack(e.stack.ptr) = @who
   return

extop.make.buffer:
   gosub save.buffer

   s = e.stack(e.stack.ptr)   ;* Buffer name

   * Look for a buffer of the required name

   for i = 1 to no.of.buffers
      if buffer(i)<BUFF.TYPE> # BUFF.TYPE.DATA then continue
      if buffer(i)<BUFF.FILE.NAME> # '' then continue
      if buffer(i)<BUFF.DICT.FLAG> # '' then continue
      if buffer(i)<BUFF.RECORD.NAME> # s then continue

      current.buffer = i
      gosub get.buffer
      e.stack(e.stack.ptr) = @true
      return
   next i

   if no.of.buffers < MAX.BUFFERS then
      no.of.buffers += 1
      current.buffer = no.of.buffers
      buffer(no.of.buffers) = ''
      file.name = ''
      dict.flag = ''
      gosub set.unames
      if uppercase.names then record.name = upcase(e.stack(e.stack.ptr)[1,40])
      else record.name = e.stack(e.stack.ptr)[1,40]
      buffer.type = BUFF.TYPE.DATA
      buffer.comment = ''
      buffer.tag = next.buffer.tag
      next.buffer.tag += 1
      record.updated = @false
      read.only = @false
      record.locked = @false
      rec = '' ; lines = 1 ; gosub split.into.chunks
      mark.line = 0 ; mark.col = 0
      lcol = 0
      gosub save.buffer
      gosub get.buffer    ;* Force reset of all sorts of things
      gosub get.current

      e.stack(e.stack.ptr) = @true
   end else
      e.stack(e.stack.ptr) = @false
   end
   return

extop.find.record:
   if other.live then  ;* Was split live but no longer
      line = other.line
      col = other.col
   end

   gosub save.buffer
   record.name = e.stack(e.stack.ptr) ; e.stack.ptr -= 1
   file.name = e.stack(e.stack.ptr)
   e.stack(e.stack.ptr) = 0  ;* Initialise for failure
   if no.of.buffers >= MAX.BUFFERS then return
   if len(file.name) = 0 then return
   if len(record.name) = 0 then return

   if (upcase(file.name[1,5]) = "DICT ") and len(file.name[6,999999]) then
      dict.flag = "DICT"
      file.name = file.name[6,999999]
   end else
      dict.flag = ""
   end

   no.of.buffers += 1
   old.buffer = current.buffer
   current.buffer = no.of.buffers
   buffer(current.buffer) = ''

   gosub open.file
   if not(open.ok) then
      no.of.buffers -= 1
      current.buffer = old.buffer
      gosub get.buffer
      return
   end

   * Check if we already have this record
   * Ensure we perform a string comparison otherwise buffer 0 and 00 are
   * the same

   for i = 1 to no.of.buffers - 1
      if buffer(i)<BUFF.UNAMES> then
         s = file.name : @fm : upcase(record.name) : @fm : dict.flag
      end else
         s = file.name : @fm : record.name : @fm : dict.flag
      end

      if buffer(i)<BUFF.FILE.NAME>:@fm:buffer(i)<BUFF.RECORD.NAME>:@fm:buffer(i)<BUFF.DICT.FLAG> = s then
         no.of.buffers -= 1
         current.buffer = i
         gosub get.buffer
         e.stack(e.stack.ptr) = @true
         return
      end
   next i

   gosub read.record
   if read.blocked.by.lock or aborted then
      no.of.buffers -= 1
      current.buffer = old.buffer
      gosub get.buffer
      return
   end

   buffer.tag = next.buffer.tag
   next.buffer.tag += 1

   gosub save.buffer      ;* Just to force...
   gosub get.buffer       ;* ...update of variables and screen
   gosub update.screen
   gosub place.cursor
   return

extop.save.record:
   if len(file.name) and not(read.only) then gosub save.record
   return

extop.write.record:
   write.record.name = e.stack(e.stack.ptr) ; e.stack.ptr -= 1
   write.file.name = e.stack(e.stack.ptr) ; e.stack.ptr -= 1

   if (upcase(write.file.name[1,5]) = "DICT ") and len(write.file.name[6,999999]) then
      write.dict.flag = "DICT"
      write.file.name = write.file.name[6,999999]
   end
   else write.dict.flag = ""

   open write.dict.flag, write.file.name to write.file else
      write.file.name = upcase(write.file.name)
      open write.dict.flag, write.file.name to write.file else
         return
      end
   end

   gosub set.unames
   if uppercase.names then write.record.name = upcase(write.record.name)

   * Use readvu rather than recordlocku for UniVerse rev 7 compatibility
   readvu s from write.file, write.record.name, 0 locked
      return   ;* Ignore write to locked record
   end
   then
      null
   end

   if dict.flag # write.dict.flag or file.name # write.file.name or record.name # write.record.name then
      if record.locked then
         release file(current.buffer), record.name  ;* Release existing lock
         record.locked = @false
      end

      dict.flag = write.dict.flag
      file.name = write.file.name
      record.name = write.record.name
      file(current.buffer) = write.file
      buffer.type = BUFF.TYPE.DATA
   end

   read.only = @false
   record.locked = @true
   gosub save.record
   write.file = 0
   return

extop.read:
   i = e.stack(e.stack.ptr) ; e.stack.ptr -= 1  ;* Record id
   j = e.stack(e.stack.ptr)                     ;* File name
   e.stack(e.stack.ptr) = ''
   if len(i) and len(j) then
      open j to temp.f then
         read s from temp.f, i then e.stack(e.stack.ptr) = s
         close temp.f
      end
   end
   return

extop.write:
   s = e.stack(e.stack.ptr) ; e.stack.ptr -= 1  ;* Data to write
   i = e.stack(e.stack.ptr) ; e.stack.ptr -= 1  ;* Record id
   j = e.stack(e.stack.ptr) ; e.stack.ptr -= 1  ;* File name

   if len(i) and len(j) then
      open j to temp.f then
         recordlocku temp.f, i
         write s to temp.f, i
         close temp.f
      end
   end
   return

extop.delete:
   i = e.stack(e.stack.ptr) ; e.stack.ptr -= 1  ;* Record id
   j = e.stack(e.stack.ptr) ; e.stack.ptr -= 1  ;* File name
   if len(i) and len(j) then
      open j to temp.f then
         recordlocku temp.f, i
         delete temp.f, i
         close temp.f
      end
   end
   return

extop.exists:
   i = e.stack(e.stack.ptr) ; e.stack.ptr -= 1  ;* Record id
   j = e.stack(e.stack.ptr)                     ;* File name
   e.stack(e.stack.ptr) = @false
   if len(i) and len(j) then
      open j to temp.f then
         readv s from temp.f, i, 0 then e.stack(e.stack.ptr) = @true
         close temp.f
      end
   end
   return

extop.overlay:
   e.stack.ptr += 1
   e.stack(e.stack.ptr) = overlay
   return

extop.set.overlay:
   overlay = (e.stack(e.stack.ptr) # 0)
   e.stack.ptr -= 1
   return

extop.changed:
   gosub save.current
   e.stack.ptr += 1
   e.stack(e.stack.ptr) = record.updated
   return

extop.set.changed:
   gosub save.current
   record.updated = (e.stack(e.stack.ptr) # 0)
   e.stack.ptr -= 1
   refresh.file = @true
   return

extop.set.case:
   i = e.stack(e.stack.ptr) ; e.stack.ptr -= 1
   n = e.stack(e.stack.ptr) ; e.stack.ptr -= 1
   if not(read.only) and num(i) and i > 0 then
      rpt = int(i)
      begin case
         case n = 0 ; gosub a.dncase
         case n = 1 ; gosub a.upcase
         case n = 2 ; gosub a.cap.init
      end case
   end
   return

extop.toggle.chars:
   if not(read.only) then gosub a.toggle
   return

extop.copy.region:
   if mark.line then
      gosub copy.region
      kill.buffer = region.text
      region.text = ''
   end
   return

extop.delete.region:
   if not(read.only) and mark.line then
      gosub copy.region
      kill.buffer = region.text
      region.text = ''
      gosub delete.region
      mark.line = 0
   end
   return

extop.fwd.word:
   i = e.stack(e.stack.ptr) ; e.stack.ptr -= 1
   if num(i) and i > 0 then
      rpt = int(i)
      gosub a.fwd.word
   end
   return

extop.back.word:
   i = e.stack(e.stack.ptr) ; e.stack.ptr -= 1
   if num(i) and i > 0 then
      rpt = int(i)
      gosub a.back.word
   end
   return

extop.del.word:
   i = e.stack(e.stack.ptr) ; e.stack.ptr -= 1
   if not(read.only) and num(i) and i > 0 then
      rpt = int(i)
      gosub a.del.word
   end
   return

extop.del.back.word:
   i = e.stack(e.stack.ptr) ; e.stack.ptr -= 1
   if not(read.only) and num(i) and i > 0 then
      rpt = int(i)
      gosub a.del.back.word
   end
   return

extop.close.spaces:
   if not(read.only) then gosub a.close.spaces
   return

extop.next.buffer:
   i = e.stack(e.stack.ptr) ; e.stack.ptr -= 1
   if num(i) and i > 0 then
      rpt = int(i)
      gosub a.next.buffer
   end
   return

extop.prev.buffer:
   i = e.stack(e.stack.ptr) ; e.stack.ptr -= 1
   if num(i) and i > 0 then
      rpt = int(i)
      gosub a.prev.buffer
   end
   return

extop.goto.buffer:
   rpt = e.stack(e.stack.ptr) ; e.stack.ptr -= 1
   if num(rpt) and rpt > 0 and rpt <= no.of.buffers and rpt # current.buffer then
      gosub save.buffer
      current.buffer = int(rpt)
      gosub get.buffer
   end
   return

extop.delete.buffer:
   if no.of.buffers > 1 then
      gosub save.buffer

      * Free memory for chunks currently in use
      hd = head ; gosub release.chunks
   
      if not(read.only) and len(buffer(current.buffer)<BUFF.FILE.NAME>) then
         release file(current.buffer), buffer(current.buffer)<BUFF.RECORD.NAME>
      end
   
      gosub delete.current.buffer

      if current.buffer > no.of.buffers then current.buffer = no.of.buffers
      gosub get.buffer
      gosub get.current
   end
   return

extop.key.bindings:
   gosub get.key.bindings
   e.stack.ptr += 1 ; e.stack(e.stack.ptr) = s
   return

extop.num:
   e.stack(e.stack.ptr) = num(e.stack(e.stack.ptr))
   return

extop.alpha:
   e.stack(e.stack.ptr) = alpha(e.stack(e.stack.ptr))
   return

extop.convert:
   s = e.stack(e.stack.ptr) ; e.stack.ptr -= 1
   j = e.stack(e.stack.ptr) ; e.stack.ptr -= 1
   i = e.stack(e.stack.ptr)
   e.stack(e.stack.ptr) = convert(i, j, s)
   return

extop.dcount:
   s = e.stack(e.stack.ptr)[1,1] ; e.stack.ptr -= 1
   e.stack(e.stack.ptr) = dcount(e.stack(e.stack.ptr), s)
   return

extop.count:
   s = e.stack(e.stack.ptr) ; e.stack.ptr -= 1
   e.stack(e.stack.ptr) = dcount(e.stack(e.stack.ptr), s)
   return

extop.index:
   j = e.stack(e.stack.ptr) ; e.stack.ptr -= 1
   if not(num(j)) then j = 1
   i = e.stack(e.stack.ptr) ; e.stack.ptr -= 1
   s = e.stack(e.stack.ptr)
   e.stack(e.stack.ptr) = index(s, i, j)
   return

extop.rem:
   i = e.stack(e.stack.ptr) ; e.stack.ptr -= 1
   if not(num(i)) or i = 0 then i = 1
   j = e.stack(e.stack.ptr) ; if not(num(j)) then j = 0
   e.stack(e.stack.ptr) = rem(j,i)
   return

extop.seq:
   e.stack(e.stack.ptr) = seq(e.stack(e.stack.ptr)[1,1])
   return

extop.char:
   i = e.stack(e.stack.ptr)
   e.stack(e.stack.ptr) = if num(i) then char(i) else ''
   return

extop.iconv:
   s = e.stack(e.stack.ptr) ; e.stack.ptr -= 1
   e.stack(e.stack.ptr) = iconv(e.stack(e.stack.ptr), s)
   return

extop.oconv:
   s = e.stack(e.stack.ptr) ; e.stack.ptr -= 1
   e.stack(e.stack.ptr) = oconv(e.stack(e.stack.ptr), s)
   return

extop.tab.interval:
   e.stack.ptr += 1
   e.stack(e.stack.ptr) = tab.interval
   return

extop.set.tab.interval:
   i = e.stack(e.stack.ptr) ; e.stack.ptr -= 1
   if num(i) and i > 0 and i < 100 then tab.interval = int(i)
   return

extop.int:
   i = e.stack(e.stack.ptr)
   if num(i) then e.stack(e.stack.ptr) = int(i)
   return

extop.find.buffer:
   rn = e.stack(e.stack.ptr) ; e.stack.ptr -= 1  ;* Record name
   s = e.stack(e.stack.ptr)   ;* File name
   if len(s) > 5 and s[1,5] = 'DICT ' then
      j = 'DICT'
      s = trimf(s[6,99999])
   end else
      j = ''
   end

   * Look for a buffer of the required name

   for i = 1 to no.of.buffers
      if buffer(i)<BUFF.FILE.NAME> # s then continue
      if buffer(i)<BUFF.DICT.FLAG> # j then continue
      if buffer(i)<BUFF.RECORD.NAME> # rn then continue
      e.stack(e.stack.ptr) = i
      return
   next i
   e.stack(e.stack.ptr) = 0
   return

extop.set.read.only:
   if buffer.type = BUFF.TYPE.DATA then
      read.only = (e.stack(e.stack.ptr) # 0)
      refresh.file = @true
   end
   e.stack.ptr -= 1
   return

extop.macro.state:
   e.stack.ptr += 1
   begin case
      case collect         ; e.stack(e.stack.ptr) = 1
      case executing.macro ; e.stack(e.stack.ptr) = 2
      case 1               ; e.stack(e.stack.ptr) = 0
   end case
   return

extop.quit:
   gosub save.current
   gosub save.buffer

   j = e.stack(e.stack.ptr) ; e.stack.ptr -= 1

   for i = 1 to no.of.buffers
      if buffer(i)<BUFF.UPDATED> then return
   next i

   terminate = if j = 0 then TERMINATE.CURRENT else TERMINATE.ALL
   ext.code = 9
   return to ext.return  ;* Break out of dispatch loop

   return

extop.width:
   e.stack.ptr += 1
   e.stack(e.stack.ptr) = screen.width
   return

extop.height:
   e.stack.ptr += 1
   e.stack(e.stack.ptr) = displayed.lines
   return

extop.min:
   e.stack.ptr -= 1
   if e.stack(e.stack.ptr+1) < e.stack(e.stack.ptr) then
      e.stack(e.stack.ptr) = e.stack(e.stack.ptr+1)
   end
   return

extop.max:
   e.stack.ptr -= 1
   if e.stack(e.stack.ptr+1) > e.stack(e.stack.ptr) then
      e.stack(e.stack.ptr) = e.stack(e.stack.ptr+1)
   end
   return

extop.matches:
   e.stack.ptr -= 1
   e.stack(e.stack.ptr) = e.stack(e.stack.ptr) matches e.stack(e.stack.ptr+1)
   return

extop.matchfield:
   e.stack.ptr -= 2
   e.stack(e.stack.ptr) = matchfield(e.stack(e.stack.ptr), e.stack(e.stack.ptr+1), e.stack(e.stack.ptr+2))
   return
   
extop.trim:
   e.stack(e.stack.ptr) = trim(e.stack(e.stack.ptr))
   return

extop.upcase:
   e.stack(e.stack.ptr) = upcase(e.stack(e.stack.ptr))
   return

extop.downcase:
   e.stack(e.stack.ptr) = downcase(e.stack(e.stack.ptr))
   return

find.gvar:
   locate s in global.var.names<1> setting i else
      if i > ext.gvar.stack.size then
         j = ext.gvar.stack.size + 10
         dim global.vars(j)
         loop
            ext.gvar.stack.size += 1
            global.vars(ext.gvar.stack.size) = ''
         until ext.gvar.stack.size = j
         repeat
      end
      global.var.names<i> = s
   end
   return

* To do:
* Track e.stack depth and allocate on entry
* Undo for previous or last step of query replace, insert kill, import,
* replace (all).  Do not do if damage done in macro (tough!)
* Maintain file line using zoned update. Not so easy 'cos of error messages.

* Context based help

  * Avoid compiler warnings
  temp = temp
end

* END-CODE
