#!/usr/local/bin/munger

; Copyright (c) 2005-2019 James Bailie <jimmy@mammothcheese.ca>
; All rights reserved.
;
; Redistribution in source form, with or without modification, is permitted
; provided that the following conditions are met:
;
;     * Redistributions of source code must retain the above copyright
; notice, this list of conditions and the following disclaimer.
;     * The name of James Bailie may not be used to endorse or promote
; products derived from this software without specific prior written permission.
;
; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDER AND CONTRIBUTORS "AS IS"
; AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
; ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
; LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
; CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
; ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
; POSSIBILITY OF SUCH DAMAGE.

; Make lisp errors fatal to interpreter.

(fatal)

; Make GC more frequent.  This keeps the garbage small and results in no
; noticeable pause during collection.

(gc_freq 65536)

(unless (and (isatty 0) (isatty 1))
   (die "The stdin and stdout of dkns must be connected to a terminal device."))

; Version number as a string.

(setq dkns_version "1.100")

; Makes SIGINT and SIGTERM harmless.

(block)

; Used to specify a repeat count for a future command.

(setq count 0)

; Use to notify toplevel loop when SIGWINCH has been received.

(setq winch 0)

; Opens a buffer to hold text, and another to be the clipboard.

(setq current_buffer (open))
(setq clipboard (open))

; The undo and redo buffers.

(setq undo (open))
(setq redo (open))

(switch current_buffer)

; Stack to hold saved clipboards.

(setq clipboard_stack (stack))

; Stack to hold saved files.

(setq file_stack (stack))

; Table to hold tags

(setq tags (table))

; Last modification time of tags file.

(setq tags_mtime 0)

; Boolean indicates whether there are unsaved changes in the buffer.

(setq dirty 0)

; Bound to closure implementing last user command.

(setq last_cmd 0)
(setq last_count 0)

; Booleans to indicate whether auto_wrapping and auto_indenting are active.

(setq auto_indent 0)
(setq auto_wrap 0)

; Regular expression to detect whether or not lines are terminated.

(setq term_rx (regcomp (stringify (char 10) "$")))

; Regular expressions to match delimiter characters.

(setq paren_rx (regcomp "\\(|\\)"))
(setq bracket_rx (regcomp "\\[|\\]"))
(setq brace_rx (regcomp "\\{|\\}"))

; Regular expressions for detecting blank lines, and lines with leading
; whitespace.

(setq whitespace_rx (regcomp "^[\b\t]*$"))
(setq leading_whitespace_rx (regcomp "^[\b\t]+"))

; Regular expressions used to find the ending points of sentences and
; paragraphs, and the starting points of function bodies.

(setq sent_rx (regcomp "[.?!][\"']?(\b\b|$)"))
(setq para_rx (regcomp "^([\b\t]*|\\..*)$"))

; Note that this regexp contains an escaped opening parenthesis and so will
; screw up the showmatch feature of your editor.

(setq func_rx (regcomp "^(\\(|\\{|\\.S)"))

; History list of filenames.  Maintained by get_string.

(setq history ())

; List of buffer coordinates specifying one endpoint of the region.  The other
; is the cursor position.

(setq mark ())

; Coordinates in buffer of cursor location.  y starts at 1.

(setq y 1)
(setq x 0)

; Coordinates on screen of cursor location.  r starts at 0.

(setq r 0)
(setq c 0)

; Last modification time of file associated with the buffer.

(setq mtime (time))

; The filenname currently associated with the buffer.

(setq filename "")

; The tab_stop frequency.

(setq tab_stop 8)

; The auto_wrapper's desired line-length.

(setq line_length 75)

; Boolean indicating whether the showmatch facility is turned on or off.

(setq show_match 0)

; The index of the column at the left edge of the screen (> 0 when the screen
; has been horizontally scrolled).

(setq base 0)

; The screen column the cursor "desires" to remain on, when moving to different lines.

(setq goal 0)

; The number of lines and columns on the screen.

(setq num_lines (lines))
(setq num_cols (cols))

; The screen line index of the status line.

(setq status_line (- num_lines 1))

; Wrapper function for the "insert" intrinsic, to save undo information.

(setq do_insert
   (lambda (idx line how)
      (switch redo)
      (when (lastline) (empty))
      (switch current_buffer)

      (cond ((eq how 0) (save_change (if (lastline) "R" "D") idx undo))
            ((> how 0) (save_change "D" (+ idx 1) undo))
            (1 (save_change "D" idx undo)))

      (insert idx line how)))

; Wrapper function for the "delete" intrinsic to save undo information.

(setq do_delete
   (lambda (idx)
      (switch redo)
      (when (lastline) (empty))
      (switch current_buffer)

      (save_change "I" idx undo)
      (delete idx)))

; Function to store undo and redo information.

(let ((saved ""))

   (setq save_change
      (lambda (type idx buf)
         (setq saved
            (if (or (eq type "R") (eq type "I"))
               (retrieve idx)
               ""))

         (when (eq type "I") (dec idx))

         (switch buf)
         (insert (lastline) (join ":" type (stringify idx) (stringify x) saved) 1)
         (switch current_buffer))))

; Function to perform undo and redo operations.

(let ((buf 0)
      (buf_name "")
      (other_buf 0)
      (line ())
      (restored "")
      (type "")
      (nx 0)
      (idx 0))

   (setq restore_change
      (lambda (rdo)
         (setq buf undo)
         (setq buf_name "Undo")
         (setq other_buf redo)

         (when rdo
            (setq buf redo)
            (setq buf_name "Redo")
            (setq other_buf undo))

         (switch buf)

         (if (not (lastline))
            (progn
               (switch current_buffer)
               (message (stringify buf_name " buffer is empty.") 1))

            (setq mark ())
            (setq dirty 1)

            (setq line (split ":" (retrieve (lastline)) 4))
            (delete (lastline))
            (switch current_buffer)

            (setq type (car line))
            (setq idx (digitize (cadr line)))
            (setq nx (digitize (caddr line)))
            (setq restored (cadddr line))

            (cond ((eq type "R")
                   (save_change "R" idx other_buf)
                   (insert idx restored 0))

                  ((eq type "I")
                   (save_change "D" (+ idx 1) other_buf)
                   (insert idx restored 1))

                  (1 (save_change "I" idx other_buf)
                     (delete idx))))

            (if (not (lastline))
               (progn
                  (clearline 0 0)
                  (print "~")
                  (goto 0 0))

               (goto_location idx (if (eq idx y) nx 0) 1)
               (display (- y r) base tab_stop)
               (goto r c)))))

; Wrapper functions for restore_change.

(setq undo_change
   (lambda (repeat)
      (while repeat
         (restore_change 0)
         (dec repeat))))

(setq redo_change
   (lambda (repeat)
      (while repeat
         (restore_change 1)
         (dec repeat))))

; Function to scroll screen horizontally if cursor position
; has been moved to a non-visible location.

(setq compensate
   (lambda ()

      (let ((len (- num_cols 1)))

         (cond ((< c base)
                (setq base c)
                (setq c 0)
                (display (- y r) base tab_stop))

                ((> (- c base) len)
                 (setq base (- c len))
                 (setq c len)
                 (display (- y r) base tab_stop))

                (base (setq c (- c base)))))

      (goto r c)))

; Function to move cursor as close as possible to the goal column.

(let ((off 0)
      (len 0)
      (last 0))

   (setq seek_goal
      (lambda ()
         (setq off (and x (cadr (slice y 0 x tab_stop 1))))
         (setq len (car (slice y 0 0 tab_stop 1)))
         (setq last (and len (- len 1)))

         (when (> x last) (setq x last))

         (while (and (< x last) (< (+ x off) goal))
            (inc x)
            (setq off (cadr (slice y 0 x tab_stop 1))))

         (while (and x (> (+ x off) goal))
            (dec x)
            (setq off (cadr (slice y 0 x tab_stop 1))))

         (setq c (+ x off))
         (compensate))))

; Function to adjust cursor x position to account for tab expansion.

(setq add_offset
   (lambda ()
      (let ((off (and x (cadr (slice y 0 x tab_stop 1)))))
         (setq c (+ x off)))))

; Function to move cursor one character forward in buffer.

(let ((len 0)
      (end 0)
      (last 0))

   (setq forw_char
      (lambda (repeat)
         (setq last (lastline))
         (setq len (car (slice y 0 0 1 1)))
         (setq end (and len (- len 1)))

         (while repeat
            (if (eq x end)
               (unless (eq y last)
                  (forw_line 1)
                  (start_of_line 0))

               (inc x))
            (dec repeat))

         (add_offset)
         (compensate)
         (setq goal (+ base c)))))

; Function to move cursor one character backward in buffer.

(setq back_char
   (lambda (repeat)
      (while repeat
         (if (eq x 0)
            (unless (eq y 1)
               (back_line 1)
               (end_of_line 1))

            (dec x))
         (dec repeat))

      (add_offset)
      (compensate)
      (setq goal (+ base c))))

; Functions to determine classification of specified character.  Used by word
; motion functions.

(setq is_word
   (lambda (c)
      (setq c (code c))
      (or (and (<= c 57) (>= c 48))
          (and (<= c 90) (>= c 65))
          (and (<= c 122) (>= c 97)))))

(setq is_special
   (lambda (c)
      (setq c (code c))
      (or (and (<= c 47) (>= c 33))
          (and (<= c 64) (>= c 58))
          (and (<= c 96) (>= c 91))
          (and (<= c 126) (>= c 123)))))

(setq is_space
   (lambda (c)
      (and (not (is_word c)) (not (is_special c)))))

; Function to find word boundaries.  Used by forw_word.

(let ((chars ())
      (goal "")
      (other 0))

   (setq find_word_forw
      (lambda ((start))
         (when (lastline)
            (setq chars (split "" (slice y (if start (car start) x) 0 1 0)))
            (setq goal "")
            (setq other 0)

            (if (or (not chars) (not (car chars)))
               (progn
                  (setq x (- (car (slice y 0 0 tab_stop 1)) 1))
                  0)

               (cond  ((is_word (car chars))
                       (setq goal is_word)
                       (setq other is_space))

                       ((is_special (car chars))
                        (setq goal is_special)
                        (setq other is_space))

                       (1 (setq goal is_space)))

               (while (and chars (goal (car chars)))
                  (setq x (+ x 1))
                  (setq chars (cdr chars)))

               (while (and other chars (other (car chars)))
                  (setq x (+ x 1))
                  (setq chars (cdr chars)))

               (if chars
                  1
                  (tailcall 0 (+ x 80))))))))

(let ((last 0)
      (line ""))

   (setq forw_word
      (lambda (repeat)
         (hide)
         (setq last (lastline))
         (setq tmp "")

         (while repeat
            (catch
               (while (and (not (find_word_forw)) (< y last))
                  (forw_line 1)
                  (start_of_line 0)
                  (unless (or (match whitespace_rx (chomp (setq line (retrieve y))))
                              (match leading_whitespace_rx line))
                     (throw 1))))

            (dec repeat))

         (add_offset)
         (compensate)
         (show)
         (setq goal (+ base c)))))

(setq find_word_back
   (lambda ((start))

      (if (not x)
         0

         (when (lastline)
            (if start
               (setq start (car start))
               (setq start (- x 80)))

            (when (< start 0)
               (setq start 0))

            (let ((chars (reverse (split "" (slice y start (- x start) 1 0))))
                  (goal "")
                  (other 0))

               (if (not chars)
                  0

                  (cond  ((is_word (car chars))
                          (setq goal is_word))

                         ((is_special (car chars))
                          (setq goal is_special))

                         (1
                           (setq goal is_space)
                           (setq other 1)))

                  (while (and chars (goal (car chars)))
                     (setq x (- x 1))
                     (set 'chars (cdr chars)))

                  (if (or (not x) (not other))
                     1

                     (if (not chars)
                        (tailcall find_word_back (- start 80))

                        (cond  ((is_word (car chars))
                                (setq goal is_word))

                               ((is_special (car chars))
                                (setq goal is_special)))

                        (while (and chars (goal (car chars)))
                           (setq x (- x 1))
                           (set 'chars (cdr chars)))

                        1))))))))

(setq back_word
   (lambda (repeat)
      (hide)

      (while repeat
         (while (and (not (find_word_back)) (> y 1))
            (back_line 1)
            (setq x (car (slice y 0 0 1 1))))
         (dec repeat))

      (add_offset)
      (compensate)
      (show)
      (setq goal (+ base c))))

; Function to move cursor forward one line.

(let ((last 0)
      (bottom 0)
      (flag 0))

   (setq forw_line
      (lambda (repeat)
         (when (setq last (lastline))
            (setq bottom (- num_lines 2))
            (setq flag 0)

            (while (and repeat (< y last))
               (dec repeat)
               (inc y)
               (if (< r bottom)
                  (inc r)
                  (inc flag)))

            (when flag
               (if (> flag 1)
                  (display (- y r) base tab_stop)

                  (scrollup)
                  (goto bottom 0)
                  (print (chomp (slice y base num_cols tab_stop 0)))))

            (seek_goal)))))

; Function to move cursor backward one line.

(let ((flag 0))

   (setq back_line
      (lambda (repeat)
         (setq flag 0)

         (while (and repeat (> y 1))
            (dec repeat)
            (dec y)
            (if (> r 0)
               (dec r)
               (inc flag)))

         (when flag
            (if (> flag 1)
               (display (- y r) base tab_stop)

               (scrolldn)
               (clearline status_line 0)
               (goto 0 0)
               (print (chomp (slice y base num_cols tab_stop 0)))))

         (seek_goal))))

; Function to move cursor to the beginning of the line.

(setq start_of_line
   (lambda (show)
      (when base
         (setq base 0)
         (clearline status_line 0)
         (display (- y r) base tab_stop))

      (setq x 0)
      (setq c 0)
      (setq goal 0)
      (when show
         (goto r c))))

; Function to move cursor to the end of the line.

(setq end_of_line
   (lambda (ignored)
      (setq x (- (car (slice y 0 0 1 1)) 1))
      (add_offset)
      (compensate)
      (setq goal (+ base c))))

; Wrapper function to scroll buffer up by one screenful.

(setq forw_screen
   (lambda (repeat)
      (low 1)
      (forw_lines (* repeat (- num_lines 2)))
      (high 1)))

; Wrapper function to scroll buffer down by one screenful.

(setq back_screen
   (lambda (repeat)
      (high 1)
      (back_lines (* repeat (- num_lines 2)))
      (low 1)))

; Function to perform up-scrolling of buffer by multiple lines.  Cursor is
; moved to last screen line, or last buffer line, whichever is further down
; on the screen.

(let ((last 0))

   (setq forw_lines
      (lambda (add)
         (setq last (lastline))

         (when (< y last)
            (if (> (+ y add) last)
               (progn
                  (setq y last)
                  (when (< last num_lines)
                     (setq r (- last 1))))

               (setq r (- num_lines 2))
               (setq y (+ y add))))

         (display (- y r) base tab_stop)
         (seek_goal))))

; Function to perform down-scrolling of buffer by multiple lines.
; Cursor is moved to first screen line.

(setq back_lines
   (lambda (sub)
      (when (> y 1)
         (setq r 0)
         (setq y (if (< (- y sub) 1) 1 (- y sub))))

      (setq base 0)
      (setq c 0)
      (setq x 0)

      (display (- y r) base tab_stop)
      (seek_goal)))

; Function to scroll buffer upward by one line, without altering cursor
; position relative to buffer content, if possible.

(let ((bottom 0)
      (last 0))

   (setq forw_scroll
      (lambda (repeat)
         (setq last (lastline))

         (while repeat
            (when (not (eq (- y r) last))
               (when (< (dec r) 0)
                  (setq r 0)
                  (inc y))

               (scrollup)
               (goto (- status_line 1) 0)
               (setq bottom (+ (- y r) (- status_line 1)))

               (if (> bottom last)
                  (print "~")
                  (print (chomp (slice bottom base num_cols tab_stop 0)))))

               (dec repeat))

         (seek_goal))))

; Function to scroll buffer downward by one line, without altering
; cursor position relative to buffer content, if possible.

(let ((top 0))

   (setq back_scroll
      (lambda (repeat)
         (setq top (- y r))

         (while repeat
            (unless (eq top 1)
               (dec top)
               (inc r)

               (when (eq r status_line)
                  (dec r)
                  (setq x base)
                  (setq c 0)
                  (dec y))

               (scrolldn)
               (clearline status_line 0)
               (goto 0 0)
               (print (chomp (slice top base num_cols tab_stop 0)))
               (seek_goal))

            (dec repeat)))))

; Function to rotate a history list forward.  Called by get_string.

(let ((back ())
      (forw ())
      (new ""))

   (setq forw_history
      (lambda (str)
         (setq back ())
         (setq forw ())
         (setq new "")

         (when history
            (setq back (car history))
            (setq forw (cadr history)))

         (if (not forw)
            str

            (unless (or (match whitespace_rx str)
                        (and back (eq (car back) str)))
               (setq back (cons str back)))

            (setq new (car forw))
            (setq forw (cdr forw))
            (setq history (list back forw))

            new))))

; A function to rotate a history list backward.  Called by get_string.

(let ((back ())
      (forw ())
      (new ""))

   (setq back_history
      (lambda (str)
         (setq back ())
         (setq forw ())
         (setq new "")

         (when history
            (setq back (car history))
            (setq forw (cadr history)))

         (if (not back)
            str

            (unless (and forw (eq (car forw) str))
               (setq forw (cons str forw)))

            (setq new (car back))
            (setq back (cdr back))
            (setq history (list back forw))

            new))))

; Function to rebuild a history list, removing empty string elements.

(let ((back ())
      (forw ()))

   (setq consolidate_history
      (lambda (ch lh str)
         (setq back ())
         (setq forw ())

         (when history
            (setq back (remove str (remove lh (remove "" (car history)))))
            (setq forw (remove str (remove lh (remove "" (cadr history))))))

         (setq forw (reverse forw))

         (when (and lh (not (eq lh str)))
           (setq forw (append forw (list lh))))

         (when str
            (setq forw (cons str forw)))

         (setq history (list (append forw back) ()))

         str)))

; Function to perform filename completion and display the results to the user.
; Called by get_string.

(let ((ch "")
      (str "")
      (top "--")
      (complete_func complete)
      (len 0))

   (setq set_complete_func
      (lambda (func)
         (setq complete_func func)))

   (setq complete_string
      (lambda (str)
         (setq top "--")

         (setq ch (complete_func str))
         (setq str (car ch))
         (setq ch (cdr ch))

         (display (if (lastline) (- y r) 0) base tab_stop)

         (setq len (length ch))

         (if (< len status_line)
            (inc len)
            (setq len status_line)
            (setq top "- list truncated -"))

         (clearline (- status_line len) 0)
         (print top)
         (dec len)

         (while len
            (clearline (- status_line len) 0)
            (print (car ch))
            (dec len)
            (setq ch (cdr ch)))

         str)))

; Function to get a string from the terminal with minimal editing features, a
; browsable history and filename completion.

(let ((len 0)
      (len2 0)
      (line "")
      (lh "")
      (mess 0)
      (str2 "")
      (m ())
      (complete_rx (regcomp "^[\b\t]*(([^\b\t]+[\b\t]+)*)([^\b\t]+)"))
      (werase_rx (regcomp "^(.*[-_./:\b\t])?[^\b\t]+[\b\t]*$"))
      (ch ""))

   (setq get_string
      (lambda (prompt str compl hist (allow_empty))
         (setq line "")
         (setq lh "")
         (setq mess 0)
         (setq m ())
         (setq ch "")
         (setq len (length prompt))
         (setq str (expand tab_stop str))
         (setq len2 (length str))

         (setq line (concat prompt
            (if (< (+ len len2) num_cols)
               str
               (substring str (- len2 (- (- num_cols len) 1)) 0))))

         (setq len2 (length line))
         (clearline status_line 0)
         (print line)
         (goto status_line len2)

         (catch
            (while (not (eq (setq ch (get_char)) 10))

               (cond ((eq ch 3) (throw 0))
                     ((eq ch 8) (setq str (chop str)))

                     ((and compl (eq ch 9))
                      (setq m (matches complete_rx str))
                      (setq mess 1)
                      (setq str2 (complete_string (if m (car (cdddr m)) "")))
                      (when m (setq str (concat (cadr m) str2))))

                     ((and hist (eq ch 14))
                      (setq str (forw_history lh))
                      (setq lh str))

                     ((and hist (eq ch 16))
                      (setq str (back_history lh))
                      (setq lh str))

                     ((eq ch 21) (setq str ""))
                     ((eq ch 22) (setq str (join "" str (char (get_char)))))
                     ((eq ch 23) (setq str (substitute werase_rx "\1" str)))
                     ((eq ch -2) (throw 0))

                     ((eq ch 1) (setq str (concat str (char 9))))
                     ((or (eq ch 9) (>= ch 32))
                      (setq str (join "" str (char ch))))

                     (1 (beep)))

               (setq len2 (length (setq str2 (expand tab_stop str))))

               (setq line (join "" prompt
                  (if (< (+ len len2) num_cols)
                     str2
                     (substring str2 (- len2 (- (- num_cols len) 1)) 0))))

               (setq len2 (length line))
               (clearline status_line 0)
               (print line)
               (goto status_line len2)))

         (when mess (display (if (lastline) (- y r) 0) base tab_stop))
         (goto r c)

         (when hist
            (consolidate_history ch lh str))

         (if (and (not (eq ch 3)) (or allow_empty str))
            str
            (message "Cancelled." 1)
            0))))

; Functions to save and load buffer.

(setq reset_buffer
   (lambda (file new)
      (empty)

      (setq dirty 0)
      (setq y 1)
      (setq x 0)
      (setq r 0)
      (setq c 0)
      (setq goal 0)
      (setq base 0)
      (setq mark ())

      (switch undo)
      (empty)
      (switch redo)
      (empty)
      (switch current_buffer)

      (if new
         (setq mtime (time))
         (setq mtime (car (cdddr (stat file)))))

      (setq filename file)
      (message (stringify (basename file) (if new ": new file" "")) 0)))

(let ((file "")
      (type 0)
      (fn "")
      (nl_rx (regcomp (concat (char 10) "$")))
      (mk 0)
      (mt 0)
      (my 0)
      (mx 0))

   (setq load_file_wrapper
      (lambda (ignored)
         (load_file 1)))

   (setq save_settings
      (lambda ()
         (setq mt mtime)
         (setq my y)
         (setq mx x)
         (setq mk mark)
         (setq fn filename)))

   (setq restore_settings
      (lambda (reload)
         (if (and reload (< (read 0 (setq filename fn)) 0))
            (display 0 0 0)
            (goto_location my mx))
         (setq mtime mt)))

   ; Function load the buffer from a disk file.

   (setq load_file
      (lambda (new (supplied))
         (catch
            (when dirty
               (message "Unsaved changes!  Continue? (y/n) " 1)
               (goto status_line 34)
               (unless (eq (get_char) 121)
                   (clearline status_line 0)
                   (goto r c)
                   (throw 0)))

            (if supplied
               (setq file (car supplied))
               (unless (setq file (get_string "File: " "" 1 1))
                  (throw 0)))

            (save_settings)

            (when (not (setq type (exists file)))
               (when new
                  (display 0 0 0)
                  (reset_buffer file 1)
                  (throw 1))

               (restore_settings 0)
               (message "file does not exist" 1)
               (throw 0))

            (when (eq type -1)
               (restore_settings 0)
               (message "path does not exist or search permission denied" 1)
               (throw 0))

            (when (not (eq type 1))
               (restore_settings 0)
               (message (stringify file " is not a regular file.") 1)
               (throw 0))

            (reset_buffer file 0)
            (setq type (read 0 file))

            (cond ((stringp type)
                   (restore_settings 1)
                   (message type 1)
                   (throw 0))

                  ((eq type -2)
                   (restore_settings 1)
                   (message "permission denied" 1)
                   (throw 0))

                  (1 (setq filename file)
                     (when (lastline)
                        (unless (match nl_rx (retrieve (lastline)))
                           (insert (lastline) (concat (retrieve (lastline)) (char 10)) 0)))
                     (message (stringify type " lines.") 0)))

            (display (if (lastline) 1 0) base tab_stop)
            (goto r c))))

   ; Function to write buffer content to disk file.

   (setq save_file
      (lambda (ignored)
         (catch
            (if filename
               (setq file filename)

               (unless (setq file (get_string "filename: " "" 1 1))
                  (throw 0)))

            (when (setq type (exists file))
               (cond ((eq type -1)
                      (message "permission denied" 1)
                      (throw 0))

                     ((not (eq type 1))
                      (message (stringify file " is not a regular file.") 1)
                      (throw 0))

                     (1 (setq type (car (cdddr (stat file))))
                        (when (not (eq type mtime))
                           (message "File has changed on disk.  Continue? (y/n) " 1)
                           (unless (eq (get_char) 121)
                              (message "Cancelled." 1)
                              (throw 0))))))

            (when type
               (setq filename file))

            (setq type
               (if (lastline)
                  (write 1 (lastline) filename 1 0)
                  (write 0 0 filename 1 0)))

            (when (stringp type)
               (message type 1)
               (throw 0))

            (setq mtime (car (cdddr (stat filename))))
            (setq dirty 0)
            (message (stringify type " lines.") 0)
            1))))

; Function to set filename associated with buffer.

(let ((file ""))

   (setq set_filename
      (lambda (ignored)
         (when (setq file (get_string "new filename: " "" 1 1))
            (when (lastline) (setq dirty 1))
            (setq filename file)))))

; Function to get an integer from the terminal.

(let ((len 0)
      (ch ""))

   (setq get_number
      (lambda (prompt num (allow_zero))
         (setq len (length prompt))
         (clearline status_line 0)
         (setq num (stringify num))
         (print prompt num)

         (catch
            (while (not (eq (setq ch (get_char)) 10))

               (cond  ((eq ch 8) (setq num (chop num)))
                      ((eq ch 3) (throw 0))
                      ((eq ch 21) (setq num ""))
                      ((and (> ch 47) (< ch 58))
                       (setq num (stringify num (char ch))))

                      (1 (beep)))

               (clearline status_line 0)
               (print prompt num)
               (goto status_line (+ len (length num)))))

         (setq num (digitize num))
         (clearline status_line 0)
         (goto r c)

         (if (and (not (eq ch 3)) (or allow_zero num))
            num
            (message "Cancelled." 1)
            -1))))

; Function to move cursor to specified buffer location.

(let ((top 0)
      (gap 0)
      (last 0)
      (half 0))

   (setq goto_location
      (lambda (line col (udo))

         (if (or (not (setq last (lastline))) (< line 1) (> line last))
            (if udo
               (tailcall 0 (lastline) col 1)
               (message "Line number out of range." 1))

            (setq top (- y r))
            (setq gap (- line top))
            (setq half (/ status_line 2))
            (setq y line)

            (if (and (>= gap 0) (< gap status_line))
               (setq r (- y top))

               (setq r (if (<= y half) (- y 1) half))
               (display (- y r) base tab_stop))

            (if (or (< col 0) (>= col (car (slice line 0 0 tab_stop 1))))
               (if udo
                  (tailcall 0 line 0 1)
                  (message "Column out of range." 1))

               (setq x col)
               (add_offset)
               (compensate)
               (setq goal (+ base c))
               1)))))

; Wrapper function to move cursor to the start of a specified buffer line.

(let ((number 0))

   (setq goto_line_number
      (lambda (ignored)
         (when (>= (setq number (get_number "line: " "")) 0)
            (goto_location number 0)))))

; Wrapper function to move the cursor to the last line of the buffer.

(let ((len 0)
      (last 0))

   (setq end_of_buffer
      (lambda (ignored)
         (when (setq last (lastline))
            (setq len (- (car (slice last 0 0 tab_stop 1)) 1))
            (goto_location last len)))))

; Wrapper function to move the cursor to the first line of the buffer.

(setq start_of_buffer
   (lambda (ignored)
      (goto_location 1 0)))

; Function to place cursor on highest or lowest line on screen.

(let ((last 0)
      (number 0))

   (setq goto_top_bottom
      (lambda (idx)

         (cond ((eq idx 0)
                (setq number (- y r)))

               ((eq idx 1)
                (setq last (lastline))
                (setq number (if (> (setq number (+ (- y r) (- status_line 1))) last)
                                 last
                                 number))))

         (goto_location number 0))))

; Wrapper functions to move cursor to the highest or lowest line on screen.

(setq high
   (lambda (ignored)
      (goto_top_bottom 0)))

(setq low
   (lambda (ignored)
      (goto_top_bottom 1)))

; Function to place cursor at start of middle screen line.

(let ((last 0)
      (top 0)
      (half 0))

   (setq goto_middle
      (lambda (ignored)
         (setq last (lastline))
         (setq top (- y r))
         (setq half (/ status_line 2))

         (setq c 0)
         (setq base 0)
         (setq goal 0)
         (setq x 0)

         (if (< (- last top) status_line)
            (progn
               (setq r (/ (- last top) 2))
               (setq y (+ r top)))

            (setq y (- (+ top half) 1))
            (setq r (- half 1)))

         (goto r c))))

; Function to set mark.  Used by deletion functions.  Not settable by user.

(setq set_mark
   (lambda ()
      (setq mark (list y x))))

; Function to put the endpoints of the region in ascending order.  Called by
; clipboard_operation.

(setq order_region
   (lambda (first second)
      (cond ((> (car first) (car second))
             (list second first))

            ((eq (car first) (car second))
             (cond ((eq (cadr first) (cadr second))
                    ())

                   ((> (cadr first) (cadr second))
                    (list second first))

                   (1 (list first second))))

            (1 (list first second)))))

; Function which appends the region to the clipboard.  Called by clipboard_operation.

(let ((line "")
      (diff 0)
      (idx 0))

   (setq copy_region
      (lambda (first second)

         (setq line (substring (retrieve (car first))
                               (cadr first)
                               (if (eq (car first) (car second))
                                   (- (cadr second) (cadr first))
                                   0)))

         (switch clipboard)

         (setq idx (lastline))
         (if (or (not idx) (match term_rx (retrieve idx)))
            (insert idx line 1)
            (insert idx (join "" (retrieve idx) line) 0)
            (dec idx))

         (switch current_buffer)

         (when (setq diff (- (car second) (car first)))
            (inc idx)

            (when (> diff 1)
               (transfer current_buffer (+ (car first) 1) (- (car second) 1) clipboard idx)
               (setq idx (+ idx (- diff 1))))

            (setq line (if (cadr second) (substring (retrieve (car second)) 0 (cadr second)) ""))

            (when line
               (switch clipboard)
               (insert idx line 1)
               (switch current_buffer))))))

; Function which deletes region from buffer.  Called by clipboard_operation.

(let ((idx 0))

   (setq delete_region
      (lambda (first second)
         (if (or (eq (car first) (car second)) (cadr first))
            (progn
               (do_insert (car first)
                  (join ""
                     (if (cadr first) (substring (retrieve (car first)) 0 (cadr first)) "")
                     (substring (retrieve (car second)) (cadr second) 0))
                  0)

               (when (- (car second) (car first))
                  (setq idx (+ (car first) 1))
                  (for (n idx (car second))
                     (do_delete idx))))

            (setq idx (car first))
            (for (n idx (- (car second) 1))
               (do_delete idx))
            (when (cadr second)
               (do_insert idx (substring (retrieve idx) (cadr second) 0) 0))))))

; Master function to perform deletions to the clipboard.

(let ((first ())
      (second ())
      (tmp ()))

   (setq clipboard_operation
      (lambda (kill append)

         ; Refuse to operate on an empty region.

         (if (or (not mark) (not (setq tmp (order_region (list y x) mark))))
            (message "Nothing to delete." 1)

            (setq first (car tmp))
            (setq second (cadr tmp))

            ; Clear the clipboard if we're not deleting multiple whole
            ; lines.

            (unless append
               (switch clipboard)
               (empty)
               (switch current_buffer))

            ; Copy the region to the clipboard.

            (message "Working..." 0)
            (copy_region first second)

            (if (not kill)
               (message "Region saved." 0)

               ; Replace the lines of the region with the result of removing
               ; the selected text.

               (delete_region first second)
               (setq dirty 1)

               ; Update the screen.

               (redisplay_after_deletion first second)

               ; Clear the mark so the user cannot accidentally use it.

               (setq mark ()))))))

; Function to redraw the screen after a deletion has been performed.

(let ((row 0)
      (line 0)
      (last 0)
      (top 0))

   (setq redisplay_after_deletion
      (lambda (first second)
         (setq last (lastline))

         (if (eq (car first) (car second))
            (progn
               (clearline r 0)
               (print (slice y base num_cols tab_stop 0)))

            (setq top (- y r))
            (when (> top (setq line (car first)))
               (setq line top))

            (setq row (- line top))

            (while (< row status_line)
               (clearline row 0)
               (print (if (> line last) "~" (slice line base num_cols tab_stop 0)))
               (inc row)
               (inc line)))

         (clearline status_line 0)
         (goto_location (car first) (cadr first)))))

; Wrapper functions to delete characters.

(setq delete_char_forw
   (lambda (repeat)
      (set_mark)
      (forw_char repeat)
      (clipboard_operation 1 0)))

(setq delete_char_back
   (lambda (repeat)
      (set_mark)
      (back_char repeat)
      (clipboard_operation 1 0)))

; Wrapper functions to delete words.

(setq delete_word_forw
   (lambda (repeat)
      (set_mark)
      (forw_word repeat)
      (clipboard_operation 1 0)))

(setq delete_word_back
   (lambda (repeat)
      (set_mark)
      (back_word repeat)
      (clipboard_operation 1 0)))

; Function to delete whitespace from cursor position to next non-whitespace
; character, or end of line.

(let ((line ""))

   (setq delete_whitespace
      (lambda (ignored)
         (setq line (retrieve y))

         (do_insert y
            (join ""
               (if x (substring line 0 x) "")
               (substitute leading_whitespace_rx "" (substring line x 0)))
            0)

         (clearline r 0)
         (print (slice y base num_cols tab_stop 0))
         (goto r c))))

; Wrapper functions to delete portions of lines before or after cursor position.

(setq delete_end_of_line
   (lambda (repeat)
      (set_mark)
      (forw_line (dec repeat))
      (end_of_line 1)

      (if repeat
         (progn
            (forw_line 1)
            (start_of_line 0))

         (when (and (eq y (car mark)) (eq x (cadr mark)) (< y (lastline)))
            (forw_char 1)))

      (clipboard_operation 1 (eq last_cmd delete_end_of_line))))

(setq delete_start_of_line
   (lambda (ignored)
      (set_mark)
      (start_of_line 1)
      (clipboard_operation 1 0)))

(setq delete_start_of_text
   (lambda (ignored)
      (set_mark)
      (start_of_text 1)
      (clipboard_operation 1 0)))

; Function to copy the region to the clipboard.

(setq copy_user_region
   (lambda (ignored)
      (clipboard_operation 0 0)))

; Functions to set bookmarks and move to cursor to the beginning of
; bookmarked lines.

(let ((bookmark "")
      (bookmark_history ())
      (tmp "")
      (old ()))

   (setq set_bookmark
      (lambda (ignored)
         (setq old history)
         (setq history bookmark_history)

         (when (setq bookmark (get_string "bookmark: " "" 0 1))
            (setmark bookmark y))

         (setq bookmark_history history)
         (setq history old)))

   (setq goto_bookmark
      (lambda (ignored)
         (setq old history)
         (setq history bookmark_history)
         (setq tmp -1)

         (when (setq bookmark (get_string "bookmark: " "" 0 1))
            (cond ((eq 0 (setq tmp (getmark bookmark)))
                   (message (stringify "Bookmark " bookmark " not set.") 1))

                  ((eq -1 tmp)
                   (message "Bookmarked line deleted." 1))

                  (1 (goto_location tmp 0)
                     (start_of_text 1))))

         (setq bookmark_history history)
         (setq history old)
         tmp)))

; Functions to move cursor to beginning of text on current, previous and next buffer
; lines.

(let ((line ""))

   (setq start_of_text
      (lambda (ignored)
         (when base
            (setq base 0)
            (clearline status_line 0)
            (display (- y r) base tab_stop))

         (setq x 0)
         (setq c 0)
         (setq goal 0)

         (setq line (chomp (retrieve y)))

         (when (and (match leading_whitespace_rx line)
                    (not (match whitespace_rx line)))
            (forw_word 1))

         (setq goal (+ base c))
         (seek_goal))))

(setq back_start_of_text
   (lambda (repeat)
      (hide)
      (back_line repeat)
      (start_of_text 1)
      (show)))

(setq forw_start_of_text
   (lambda (repeat)
      (hide)
      (forw_line repeat)
      (start_of_text 1)
      (show)))

; Functions to move the cursor to the location of matches on regular
; expressions.

(setq forw_sent
   (lambda (repeat)
      (while (and repeat (find_pattern 1 sent_rx 1 0))
         (dec repeat)
         (setq goal (+ base c)))))

(setq back_sent
   (lambda (repeat)
      (while (and repeat (find_pattern -1 sent_rx 1 0))
         (dec repeat)
         (setq goal (+ base c)))))

(setq forw_para
   (lambda (repeat)
      (while (and repeat (find_pattern 1 para_rx 1 0))
         (dec repeat)
         (setq goal (+ base c)))))

(setq back_para
   (lambda (repeat)
      (while (and repeat (find_pattern -1 para_rx 1 0))
         (dec repeat)
         (setq goal (+ base c)))))

(setq forw_func
   (lambda (repeat)
      (while (and repeat (find_pattern 1 func_rx 1 0))
         (dec repeat)
         (setq goal (+ base c)))))

(setq back_func
   (lambda (repeat)
      (while (and repeat (find_pattern -1 func_rx 1 0))
         (dec repeat)
         (setq goal (+ base c)))))

; Functions to move the cursor to the location of matches on
; user-specified regular expressions.

(let ((search_history ())
      (last_rx "")
      (old ())
      (pat "")
      (rx ""))

   (setq search
      (lambda (dir last wrap repeat)
         (setq pat "")

         (if (and last (not (regexpp last_rx)))
            (progn
               (message "No stored pattern." 1)
               0)

            (if last
               (setq rx last_rx)

               (setq old history)
               (setq history search_history)

               (when (setq pat (get_string "Pattern: " "" 0 1))
                  (if (stringp (setq rx (regcomp pat)))
                     (message rx 1)
                     (when pat (setq last_rx rx))))

               (setq search_history history)
               (setq history old))

            (when (and (regexpp rx) (or last pat))
               (while (and repeat (find_pattern dir rx 0 wrap))
                  (dec repeat))
               (not repeat))))))

(setq forw_search
   (lambda (repeat)
      (search 1 0 1 repeat)))

(setq back_search
   (lambda (repeat)
      (search -1 0 1 repeat)))

(setq forw_search_again
   (lambda (repeat)
      (search 1 1 1 repeat)))

(setq back_search_again
   (lambda (repeat)
      (search -1 1 1 repeat)))

; Core function which performs the actual search for matches on regular
; expressions in the buffer.

;  dir irection of search
;  rx compiled regexp
;  last move to last line on failure
;  wrap search wraps around on failure

(let ((f ())
      (oy 0)
      (ox 0))

   (setq find_pattern
      (lambda (dir rx last wrap)
         (setq oy y)
         (setq ox x)

         (if (not (car (setq f (find dir y x rx (and (not last) wrap)))))
            (if (not last)
               (progn
                  (message "Not found." 1)
                  0)

               (when last
                  (if (< dir 0)
                     (goto_location 1 0)
                     (end_of_buffer 0)
                     (end_of_line 0)
                     1)))

            (goto_location (car f) (cadr f))

            (when (or (and (> dir 0) (or (< (car f) oy) (and (eq (car f) oy) (<= (cadr f) ox))))
                      (and (< dir 0) (or (> (car f) oy) (and (eq (car f) oy) (>= (cadr f) ox)))))
               (message "Search wrapped." 1))

            1))))

; Functions to delete text from the cursor to the next occurrence of a regular
; expression.

(setq delete_rx_forw
   (lambda (repeat)
      (set_mark)
      (search 1 0 0 repeat)
      (clipboard_operation 1 0)))

(setq delete_rx_back
   (lambda (repeat)
      (set_mark)
      (search -1 0 0 repeat)
      (clipboard_operation 1 0)))

; Functions to delete sentences.

(setq delete_sent_forw
   (lambda (repeat)
      (set_mark)
      (while (and repeat (find_pattern 1 sent_rx 1 0))
         (dec repeat))
      (clipboard_operation 1 0)))

(setq delete_sent_back
   (lambda (repeat)
      (set_mark)
      (while (and repeat (find_pattern -1 sent_rx 1 0))
         (dec repeat))
      (clipboard_operation 1 0)))

; Functions to delete paragraphs.

(setq delete_para_back
   (lambda (repeat)
      (set_mark)
      (while (and repeat (find_pattern -1 para_rx 1 0))
         (dec repeat))
      (clipboard_operation 1 0)))

(setq delete_para_forw
   (lambda (repeat)
      (set_mark)
      (while (and repeat (find_pattern 1 para_rx 1 0))
         (dec repeat))
      (clipboard_operation 1 0)))

; Functions to delete text from cursor position to buffer endpoints.

(setq delete_end_of_buffer
   (lambda (ignored)
      (set_mark)
      (end_of_buffer 0)
      (clipboard_operation 1 0)))

(setq delete_start_of_buffer
   (lambda (ignored)
      (set_mark)
      (start_of_buffer 0)
      (clipboard_operation 1 0)))

; Function to delete text to bookmarked line.

(let ((tmp ()))

   (setq delete_to_bookmark
      (lambda (ignored)
         (set_mark)
         (if (and (fixnump (setq tmp (goto_bookmark 1))) (> tmp 0))
            (clipboard_operation 1 0)
            (setq mark ())))))

; Function to delete text from user-defined region.

(setq delete_user_region
   (lambda (ignored)
      (if mark
         (clipboard_operation 1 0)
         (message "Mark unset." 1))))

; Function to insert clipboard content into buffer.

(let ((limit 0)
      (line "")
      (leftover "")
      (last ())
      (old_top 0)
      (insert_segment 0))

   (setq insert_segment
      (lambda (segment)
         (setq line (retrieve y))
         (setq leftover 1)

         (do_insert y (join "" (if x (substring line 0 x) "")
                            segment
                            (if (match term_rx segment)
                               ""
                               (setq leftover 0)
                               (substring line x 0)))
                   0)

         (if (not leftover)
            (progn
               (setq x (+ x (length segment)))
               (add_offset)
               (compensate))

            (inc y)
            (when (< r limit)
               (inc r))

            (do_insert y (substring line x 0) -1)
            (setq x 0)
            (setq c 0)
            (setq base 0))))

   (setq paste
      (lambda (ignored)
         (catch
            (setq limit (- status_line 1))

            (unless (lastline)
               (do_insert 1 (char 10) 0))

            (switch clipboard)
            (setq last (lastline))

            (unless last
               (message "Clipboard is empty." 1)
               (switch current_buffer)
               (throw 1))

            (setq old_top (- y r))
            (setq first_line y)
            (setq dirty 1)
            (setq mark (list y x))

            (message "Working..." 0)

            (setq line (retrieve 1))
            (switch current_buffer)
            (insert_segment line)

            (if (and (eq last 1) (not (match term_rx line)))
               (progn
                  (clearline r 0)
                  (print (slice y base num_cols tab_stop 0))
                  (goto r c))

               (when (> (dec last) 1)
                  (transfer clipboard 2 last current_buffer (- y 1))
                  (for (n y (+ y (- last 2))) (save_change "D" n undo))
                  (setq y (+ y (dec last)))
                  (when (> (setq r (+ r last)) limit)
                     (setq r limit))
                  (inc last))

               (when last
                  (switch clipboard)
                  (setq line (retrieve (inc last)))
                  (switch current_buffer)
                  (insert_segment line))

               (redisplay_after_paste first_line old_top))))))

(let ((top 0)
      (last 0)
      (row 0))

   (setq redisplay_after_paste
      (lambda (line old_top)
         (setq last (lastline))
         (setq top (- y r))

         (when (> top old_top)
            (setq line top))

         (setq row (- line top))

         (while (< row status_line)
            (clearline row 0)
            (print (if (> line last) "~" (slice line base num_cols tab_stop 0)))
            (inc row)
            (inc line))

         (clearline status_line 0)
         (goto r c))))

; Core function to perform regular-expression-based substitutions.

(let ((line ""))

   (setq alter_region
      (lambda (first second rx replace repeat)
         (setq dirty 1)

         (for (n (car first) (car second))
            (setq line (retrieve n))

            (cond ((eq n (car first))
                   (if (eq (car first) (car second))
                      (do_insert n
                        (join "" (if (cadr first) (substring line 0 (cadr first)) "")
                                 (substitute
                                    rx
                                    replace
                                    (substring line (cadr first) (- (cadr second) (cadr first)))
                                    repeat)
                                 (substring line (cadr second) 0))
                        0)

                      (do_insert n
                         (join "" (if (cadr first) (substring line 0 (cadr first)) "")
                                  (substitute rx replace (chomp (substring line (cadr first) 0)) repeat)
                                  (char 10))
                         0)))

                  ((eq n (car second))
                   (do_insert n
                     (join "" (if (cadr second) (substitute rx replace (substring line 0 (cadr second)) repeat) "")
                              (substring line (cadr second) 0))
                     0))

                  (1 (do_insert n (join "" (substitute rx replace (chomp line) repeat) (char 10)) 0)))))))

; Function to get parameters from terminal for substitution operation.

(let ((first ())
      (second ())
      (tmp ())
      (pattern "")
      (rx "")
      (replace "")
      (repeat 0)
      (old ())
      (replace_history ())
      (pattern_history ()))

   (setq substitute_with_params
      (lambda ()
         (catch

            ; Refuse to operate on an empty region.

            (when (not (and mark (setq tmp (order_region (list y x) mark))))
               (message "Nothing to alter." 1)
               (throw 1))

            (setq first (car tmp))
            (setq second (cadr tmp))

            (setq old history)
            (setq history pattern_history)

            (setq pattern (get_string "Pattern: " "" 0 1))

            (setq pattern_history history)
            (setq history old)

            (unless pattern
               (display (- y r) base tab_stop)
               (goto_location (car first) (cadr first))
               (throw 1))

            (when (stringp (setq rx (regcomp pattern)))
               (message rx 1)
               (display (- y r) base tab_stop)
               (goto_location (car first) (cadr first))
               (throw 1))

            (clearline (- status_line 2) 0)
            (print "--")
            (clearline (- status_line 1) 0)
            (print "Pattern: " pattern)

            (setq old history)
            (setq history replace_history)

            (setq replace (get_string "Replacement: " "" 0 1 1))

            (setq replace_history history)
            (setq history old)

            (unless (stringp replace)
               (display (- y r) base tab_stop)
               (goto_location (car first) (cadr first))
               (throw 1))

            (clearline (- status_line 3) 0)
            (print "--")
            (clearline (- status_line 2) 0)
            (print "Pattern: " pattern)
            (clearline (- status_line 1) 0)
            (print "Replacement: " replace)

            (when (< (setq repeat (get_number "Repeat: " "0" 1)) 0)
               (display (- y r) base tab_stop)
               (goto_location (car first) (cadr first))
               (throw 1))

            (display (- y r) base tab_stop)
            (alter_region first second rx replace repeat)
            (redisplay_after_substitution first second))

         ; Clear the mark to prevent the user from accidentally accessing
         ; it.

         (setq mark ()))))

; Function update screen after a substitution operation.

(let ((top 0)
      (row 0)
      (line 0))

   (setq redisplay_after_substitution
      (lambda (first second)
         (setq top (- y r))

         (if (> top (car first))
            (progn
               (setq line top)
               (setq row 0))

            (setq line (car first))
            (setq row (- (car first) top)))

         (while (and (<= line (car second)) (< row status_line))
             (clearline row 0)
             (print (slice line base num_cols tab_stop 0))
             (inc row)
             (inc line))

         (goto_location (car first) (cadr first)))))

; Wrapper functions for performing substitutions on lines and paragraphs.

(setq substitute_end_of_line
   (lambda (ignored)
      (set_mark)
      (end_of_line 0)
      (substitute_with_params)))

(setq substitute_start_of_line
   (lambda (ignored)
      (set_mark)
      (start_of_line 1)
      (substitute_with_params)))

(setq substitute_para_forw
   (lambda (repeat)
      (set_mark)
      (forw_para repeat)
      (substitute_with_params)))

(setq substitute_para_back
   (lambda (repeat)
      (set_mark)
      (back_para repeat)
      (substitute_with_params)))

; Wrapper functions to perform substitutions on region from cursor position
; to the location of a bookmark, to one of the buffer endpoints, or to a
; match on a regular expression.

(setq substitute_to_bookmark
   (lambda (ignored)
      (set_mark)
      (if (> (goto_bookmark 1) 0)
         (substitute_with_params)
         (setq mark ()))))

(setq substitute_rx_forw
   (lambda (repeat)
      (set_mark)
      (search 1 0 0 repeat)
      (substitute_with_params)))

(setq substitute_rx_back
   (lambda (repeat)
      (set_mark)
      (search -1 0 0 repeat)
      (substitute_with_params)))

(setq substitute_end_of_buffer
   (lambda (ignored)
      (set_mark)
      (end_of_buffer 0)
      (substitute_with_params)))

(setq substitute_start_of_buffer
   (lambda (ignored)
      (set_mark)
      (start_of_buffer 0)
      (substitute_with_params)))

; Wrapper function to perform substitution on region.

(setq substitute_user_region
   (lambda (ignored)
      (substitute_with_params)))

; Function to allow user to set mark.

(setq user_setmark
   (lambda (ignored)
      (set_mark)
      (message "Marked." 0)))

; Function to write the region to a file.

(let ((tmp ())
      (file "")
      (first ())
      (second ()))

   (setq write_region
      (lambda (ignored)
         (catch
            (when (not mark)
               (message "Mark unset." 1)
               (throw 1))

            (when (or (not mark) (not (setq tmp (order_region (list y x) mark))))
               (message "Nothing to write." 1)
               (throw 1))

            (setq first (car tmp))
            (setq second (cadr tmp))

            (when (setq file (get_string "filename: " "" 1 1))
               (if (stringp (setq tmp (write (car first) (car second) file 1 0)))
                  (message tmp 1)
                  (message (stringify tmp " lines.") 0)))))))

; Function to insert a file into the buffer content after a specified line.

(let ((file "")
      (not_empty 0)
      (c "")
      (tmp ""))

   (setq insert_file
      (lambda (ignored)
         (when (setq file (get_string "file: " "" 1 1))

            (setq not_empty (lastline))
            (setq c (substring file 0 1))

            (cond ((not not_empty) (setq tmp (read 0 file)))

                  ((eq y 1)
                   (clearline status_line 0)
                   (print "Before or after current line? (b/a) ")
                   (print (char (setq tmp (get_char))))

                   (cond ((eq tmp 97) (setq tmp (read 1 file)))
                         ((eq tmp 98) (setq tmp (read 0 file)) (setq not_empty 0))
                         (1 (message "Not understood." 1)
                            (setq tmp 0))))

                  (1 (setq tmp (read y file))))

            (cond ((eq -1 tmp) (message "No such file." 1))
                  ((eq -2 tmp) (message "Permission denied." 1))

                  ((stringp tmp) (message tmp 1))

                  ((fixnump tmp)

                   (let ((first (if not_empty (+ y 1) 1))
                         (last (if not_empty (+ y tmp) tmp)))

                      (insert last (concat (chomp (retrieve last)) (char 10)) 0)

                      (for (n first last ) (save_change "D" n undo)))

                   (setq dirty 1)

                   (display (- y r) base tab_stop)
                   (goto_location (if not_empty (+ y tmp) tmp) 0)

                   (message (stringify tmp " lines.") 0)))))))

; Functions modifying the indentation of lines, with functions for
; formatting paragraphs and the function to change the value of the tab_stop
; variable, all together in a shared closure so that changes to the tab_stop
; variable may be propagated to local variables used these functions.

(letn ((cmd1 (join "/" (libdir) (stringify "fmt.munger -l" line_length " -t" tab_stop)))
       (cmd2 (stringify cmd1 " -p")))

   (let ((first ())
         (second ())
         (filter_history ())
         (old ())
         (tmp "")
         (cmd ""))

      (setq filter_region
         (lambda (ignored (program))
            (catch
               (when (not mark)
                  (message "mark unset." 1)
                  (throw 1))

               (unless (and (lastline) mark (setq tmp (order_region (list y x) mark)))
                  (message "Nothing to filter." 1)
                  (throw 1))

               (setq first (car tmp))
               (setq second (cadr tmp))

               (setq old history)
               (setq history filter_history)

               (setq cmd (if program (car program) (get_string "Program: " "" 1 1)))

               (setq filter_history history)
               (setq history old)

               (unless cmd
                  (throw 1))

               (for (n (car second) (car first))
                  (save_change "I" n undo))

               (setq dirty 1)
               (setq tmp (filter (car first) (car second) cmd))

               (if tmp
                  (for (n (car first) (+ (car first) (- tmp 1)))
                     (save_change "D" n undo))

                  (switch undo)
                  (for (n (car first) (car second))
                     (delete (lastline)))
                  (switch current_buffer))

               (goto_location (car first) 0)
               (display (- y r) base tab_stop)
               (message (stringify tmp " lines.") 0)))))

   (setq format_para_forw
      (lambda (repeat)
         (set_mark)
         (forw_para repeat)
         (when (not (eq y (lastline)))
            (back_line 1))
         (filter_region 0 cmd1)))

   (setq format_para_back
      (lambda (repeat)
         (set_mark)
         (back_para repeat)
         (when (not (eq 1 y))
            (forw_line 1))
         (filter_region 0 cmd1)))

   (setq format_para_prefix_forw
      (lambda (repeat)
         (set_mark)
         (forw_para repeat)
         (when (not (eq y (lastline)))
            (back_line 1))
         (filter_region 0 cmd2)))

   (setq format_para_prefix_back
      (lambda (repeat)
         (set_mark)
         (back_para repeat)
         (when (not (eq y 1))
            (forw_line 1))
         (filter_region 0 cmd2)))

   (let ((left_rx (regcomp (stringify "^(\t|\b{1," tab_stop "})")))
         (right_rx (regcomp "^[\b\t]*[^\b\t]"))
         (right_replace "\t\&")
         (left_replace "")
         (tmp ())
         (rx "")
         (replace "")
         (first ())
         (second ()))

      (setq set_line_length_wrapper
         (lambda (ignored)
            (set_line_length)))

      (setq set_tab_stop_wrapper
         (lambda (ignored)
            (set_tab_stop)))

      (setq set_line_length
         (lambda ((provided))
            (catch
               (if (and (not provided) (setq tmp (get_number "Line length: " line_length)))
                  (if (> tmp 0) (setq line_length tmp) (throw 0))
                  (setq line_length (car provided)))

               (setq cmd1 (join "/" (libdir) (stringify "fmt.munger -l" line_length " -t" tab_stop)))
               (setq cmd2 (stringify cmd1 " -p"))

               (when (lastline)
                  (display (- y r) base tab_stop)
                  (goto r c))
               (message (stringify "line length = " line_length) 0))))

      ; Function to set the value of the tab_stop variable.

      (setq set_tab_stop
         (lambda ((provided))
            (catch
               (if (and (not provided) (setq tmp (get_number "Tabstop frequency: " tab_stop)))
                  (if (> tmp 0) (setq tab_stop tmp) (throw 0))
                  (setq tab_stop (car provided)))

               (setq left_rx (regcomp (stringify "^(\t|\b{1," tab_stop "})")))
               (setq cmd1 (join "/" (libdir) (stringify "fmt.munger -l" line_length " -t" tab_stop)))
               (setq cmd2 (stringify cmd1 " -p"))

               (when (lastline)
                  (display (- y r) base tab_stop)
                  (start_of_text 1))
               (message (stringify "tab_stop = " tab_stop) 0))))

      ; Core function to modify the indentation of lines.

      (setq shift_operation
         (lambda (left)
            (if (or (not (lastline)) (not mark) (not (setq tmp (order_region (list y x) mark))))
               (message "Nothing to shift." 1)

               (setq first (car tmp))
               (setq second (cadr tmp))

               (setq rx (if left left_rx right_rx))
               (setq replace (if left left_replace right_replace))

               (for (n (car first) (car second))
                  (do_insert n (substitute rx replace (retrieve n)) 0))

               (when (>= (car first) (- y r))
                  (display (- y r) base tab_stop))

               (setq mark ())
               (setq dirty 1)

               (goto_location (car first) 0)
               (start_of_text 1))))))

; Functions to shift lines.

(setq shift_line_right
   (lambda (repeat)
      (set_mark)
      (if (eq repeat 1)
         (progn
            (end_of_line 1)
            (when (eq (cadr mark) x)
               (start_of_line 1)))
         (forw_line (dec repeat)))
      (shift_operation 0)))

(setq shift_line_left
   (lambda (repeat)
      (set_mark)
      (if (eq repeat 1)
         (progn
            (end_of_line 1)
            (when (eq (cadr mark) x)
               (start_of_line 1)))
         (forw_line (dec repeat)))
      (shift_operation 1)))

; Functions to shift paragraphs.

(setq shift_para_right_forw
   (lambda (repeat)
      (set_mark)
      (forw_para repeat)
      (shift_operation 0)))

(setq shift_para_left_forw
   (lambda (repeat)
      (set_mark)
      (forw_para repeat)
      (shift_operation 1)))

(setq shift_para_right_back
   (lambda (repeat)
      (set_mark)
      (back_para repeat)
      (shift_operation 0)))

(setq shift_para_left_back
   (lambda (repeat)
      (set_mark)
      (back_para repeat)
      (shift_operation 1)))

; Functions to shift a region of lines from the cursor position to the next
; line containing a match on a regular expression.

(setq shift_rx_left_forw
   (lambda (repeat)
      (set_mark)
      (when (search 1 0 0 repeat)
         (shift_operation 1))))

(setq shift_rx_left_back
   (lambda (repeat)
      (set_mark)
      (when (search -1 0 0 repeat)
         (shift_operation 1))))

(setq shift_rx_right_forw
   (lambda (repeat)
      (set_mark)
      (when (search 1 0 0 repeat)
         (shift_operation 0))))

(setq shift_rx_right_back
   (lambda (repeat)
      (set_mark)
      (when (search -1 0 0 repeat)
         (shift_operation 0))))

; Functions to shift the region.

(setq shift_region_right
   (lambda (ignored)
      (shift_region 0)))

(setq shift_region_left
   (lambda (ignored)
      (shift_region 1)))

(setq shift_region
   (lambda (left)

      (let ((saved_mark (and mark (car mark)))
            (saved_y y))

         (shift_operation left)
         (when saved_mark
            (setq mark (list saved_y 0))
            (goto_location saved_mark 0)
            (start_of_text 1)))))

; Functions to shift a region delimited by parentheses, brackets, or braces.

(setq shift_delim_left
   (lambda (ignored)
      (set_mark)
      (when (jump_to_other_end 0)
         (shift_operation 1))))

(setq shift_delim_right
   (lambda (ignored)
      (set_mark)
      (when (jump_to_other_end 0)
         (shift_operation 0))))

; Functions to find and display matching delimiters.

(setq jump_to_other_end
   (lambda (ignored)
      (hide)

      (let ((ch (slice y x 1 1 0)))

         (cond ((eq ch "[")
                (find_delim ch 1 bracket_rx y x 0
                 (find 1 y x func_rx 0) > 1))

               ((eq ch "(")
                (find_delim ch 1 paren_rx y x 0
                 (find 1 y x func_rx 0) > 1))

               ((eq ch "{")
                (find_delim ch 1 brace_rx y x 0
                 (find 1 y x func_rx 0) > 1))

               ((eq ch "]")
                (find_delim ch -1 bracket_rx y x 0
                 (find -1 y x func_rx 0) < 1))

               ((eq ch ")")
                (find_delim ch -1 paren_rx y x 0
                 (find -1 y x func_rx 0) < 1))

               ((eq ch "}")
                (find_delim ch -1 brace_rx y x 0
                 (find -1 y x func_rx 0) < 1))

               (1 (message "Not a delimiter." 1)
                  0)))

      (show)))

; Shows location of matching opening delimiters as the corresponding
; closing delimiters are input.  These delimiter pairs are recognized:
; ( ) [ ] { }.

(setq showmatch
   (lambda (ch)
      (cond ((eq ch 41)
             (find_delim ")" -1 paren_rx y (- x 1) 0
                 (find -1 y x func_rx 0) < 0))

            ((eq ch 93)
             (find_delim "]" -1 bracket_rx y (- x 1) 0
                 (find -1 y x func_rx 0) < 0))

            ((eq ch 125)
             (find_delim "}" -1 brace_rx y (- x 1) 0
                 (find -1 y x func_rx 0) < 0)))))

; Does the actual searching for delimiters.

(let ((f ()))

   (setq find_delim
      (lambda (ch d rx ny nx s l p j)

         (setq f (find d ny nx rx 0))

         (when (and (eq d 1) (not (car l)))
            (setq l (list (lastline) 0)))

         (catch
            (while (car f)

                (cond ((eq (slice (car f) (cadr f) 1 1 0) ch)
                       (setq ny (car f))
                       (setq nx (cadr f))
                       (inc s)
                       (setq f (find d ny nx rx 0))
                       (when (p (car f) (car l))
                          (throw (setq f (list 0 0)))))

                      (s
                        (setq ny (car f))
                        (setq nx (cadr f))
                        (dec s)
                        (setq f (find d ny nx rx 0))
                        (when (p (car f) (car l))
                           (throw (setq f (list 0 0)))))

                       (1 (throw f)))))

         (if (not (car f))
            (message "No match" 1)

            (if j
               (goto_location (car f) (cadr f))

               (let ((off (and (cadr f) (cadr (slice (car f) 0 (cadr f) tab_stop 1)))))

                  (setq nx (+ off (cadr f)))
                  (when (and (>= (car f) (- y r))
                             (>= nx base)
                             (< nx (+ base num_cols)))

                      (goto (- (car f) (- y r)) (- nx base))
                      (pause 200000)
                      (goto r c))))))))

; Functions to change the capitalization of words.

(setq capitalize_word
   (lambda (repeat)
      (while repeat
         (change_case 1 0)
         (dec repeat))))

(setq uppercase_word
   (lambda (repeat)
      (while repeat
         (change_case 1 1)
         (dec repeat))))

(setq lowercase_word
   (lambda (repeat)
      (while repeat
         (change_case 0 1)
         (dec repeat))))

(let ((line "")
      (word "")
      (before "")
      (after ""))

   (setq change_case
      (lambda (up all)

         (catch
            (when (eq " " (slice y (+ base c) 1 tab_stop 0))
               (forw_word 1))

            (set_mark)
            (forw_word 1)

            (while (not (eq y (car mark)))
               (back_line 1)
               (end_of_line 1))

            (when (eq x (cadr mark))
               (throw 0))

            (setq line (retrieve y))
            (setq before (if (cadr mark) (substring line 0 (cadr mark)) ""))
            (setq word (substring line (cadr mark) (- x (cadr mark))))
            (setq after (substring line x 0))

            (setq dirty 1)

            (if up
               (if all
                  (setq word (upcase word all))
                  (setq word (upcase (downcase word 1) all)))
               (setq word (downcase word all)))

            (do_insert y (join word before after) 0)
            (clearline r 0)
            (print (chomp (slice y base num_cols tab_stop 0)))
            (goto r c)))))

; Function to suspend the interpreter.

(setq suspend_editor
   (lambda (ignored)
      (clearline status_line 0)
      (canon)
      (suspend)
      (nocanon)

      (let ((diff (- num_lines (lines))))
         (setq num_lines (lines))
         (setq status_line (- num_lines 1))
         (setq num_cols (cols))

         (setq x 0)
         (setq c 0)
         (setq base 0)
         (setq goal 0)

         (when (>= r status_line)
            (when (< (setq r (- r diff)) 0)
               (setq r 0))))

      (display (if (lastline) (- y r) 0) 0 tab_stop)
      (clearline status_line 0)
      (goto r c)))

; Function to pass a command to the shell.

(let ((cmd "")
      (old ())
      (cmd_history ()))

   (setq shell_cmd
      (lambda (ignored)
         (setq old history)
         (setq history cmd_history)

         (setq cmd (get_string "Command: " "" 1 1))

         (setq cmd_history history)
         (setq history old)

         (when cmd
            (clearscreen)
            (canon)
            (system cmd)

            (newline)
            (print "Any key to continue...")
            (nocanon)
            (get_char)

            (let ((diff (- num_lines (lines))))
               (setq num_lines (lines))
               (setq status_line (- num_lines 1))
               (setq num_cols (cols))

               (when (>= r status_line)
                  (setq r (- r diff))))

            (display (if (lastline) (- y r) 0) base tab_stop)
            (clearline status_line 0)
            (goto r c)))))

; Functions to toggle the state of the auto_wrap and auto_indent variables.

(setq toggle_auto_wrap
   (lambda ((ignored))
      (setq auto_wrap (and (or auto_wrap 1) (not (and auto_wrap 1))))
      (message (stringify "auto_wrap " (if auto_wrap "on" "off")) 0)))

(setq toggle_auto_indent
   (lambda ((ignored))
      (setq auto_indent (and (or auto_indent 1) (not (and auto_indent 1))))
      (message (stringify "auto_indent " (if auto_indent "on" "off")) 0)))

(setq toggle_show_match
   (lambda ((ignored))
      (setq show_match (and (or show_match 1) (not (and show_match 1))))
      (message (stringify "show_match " (if show_match "on" "off")) 0)))

; Function to display the settings of the user-modifiable variables.

(let ((on 0)
      (off 0)
      (col 0)
      (top 0)
      (config 0)
      (len 0))

   (setq show_config
      (lambda (ignored)
         (setq on "on")
         (setq off "off")
         (setq col " columns")
         (setq top "--")

         (setq config (list (stringify "tab_stop:     every " tab_stop col)
                            (stringify "auto_indent:  " (if auto_indent on off))
                            (stringify "auto_wrap:    " (if auto_wrap on off))
                            (stringify "show_match:   " (if show_match on off))
                            (stringify "line_length:  " line_length col)
                            top))

         (setq len (length config))

         (if (< len status_line)
            (inc len)
            (setq len status_line)
            (setq top "- list truncated -"))

         (clearline (- status_line len) 0)
         (print top)
         (dec len)

         (while len
            (clearline (- status_line len) 0)
            (print (car config))
            (dec len)
            (setq config (cdr config)))

         (clearline status_line 0)
         (print "Any key to continue...")
         (get_char)
         (display (if (lastline) (- y r)) base tab_stop)
         (clearline status_line 0)
         (goto r c))))

; Function to insert a blank line before the cursor position.

(let ((m ()))

   (setq insert_blank_line
      (lambda (repeat)
         (while repeat
            (when (not (lastline))
               (do_insert y (char 10) 0))

            (if (and auto_indent (setq m (matches leading_whitespace_rx (retrieve y))))
               (do_insert y (stringify (car m) (char 10)) -1)
               (do_insert y (char 10) -1))

            (dec repeat))

         (setq dirty 1)
         (display (- y r) base tab_stop)
         (end_of_line 1))))

; Function to insert the output of a shell command into the buffer.

(let ((cmd "")
      (cmd_history ())
      (new 0)
      (not_empty 0)
      (tmp ())
      (old ()))

   (setq insert_cmd_output
      (lambda (ignored)
         (setq old history)
         (setq history cmd_history)

         (setq cmd (get_string "Command: " "" 1 1))

         (setq cmd_history history)
         (setq history old)

         (when cmd
            (setq old (- y r))
            (setq dirty 1)

            (if (lastline)
               (progn
                  (setq not_empty 1)
                  (setq tmp (+ y (setq new (input y cmd)))))

               (setq tmp (setq new (input 0 cmd)))
               (setq not_empty 0))

            ; Ensure last line input is terminated.

            (if (not (and (> tmp 0) (> new 0)))
               (redisplay 0)

               (insert tmp (concat (chomp (retrieve tmp)) (char 10)) 0)

               (for (n (if not_empty (+ y 1) 1) tmp)
                  (save_change "D" n undo))

               (if (>= (- tmp old) status_line)
                  (goto_location tmp 0)

                  (display old base tab_stop)
                  (setq y tmp)
                  (setq r (- tmp old))
                  (setq x (setq c 0))
                  (goto r 0))

               (message (stringify new " lines.") 0)))))

   ; Function to write a range of lines to the stdin of a shell command.

   (setq output_to_cmd
      (lambda (ignored)
         (if (or (not (lastline)) (not mark) (not (setq tmp (order_region (list y x) mark))))
            (message "Nothing to output." 1)

            (setq old history)
            (setq history cmd_history)

            (setq cmd (get_string "Command: " "" 1 1))

            (setq cmd_history history)
            (setq history old)

            (when cmd
               (clearscreen)
               (canon)
               (setq cmd (output (caar tmp) (car (cadr tmp)) cmd))
               (newline)
               (print "Any key to continue...")
               (nocanon)
               (get_char)
               (display (- y r) base tab_stop)
               (clearline status_line 0)
               (goto r c)
               (message (stringify cmd " lines.") 0))))))

; Function to push the current clipboard onto the clipboard stack, and
; create a new clipboard.

(setq push_clipboard
   (lambda (ignored)
      (switch clipboard)
      (if (not (lastline))
         (progn
            (switch current_buffer)
            (message "Clipboard is empty.  Not saved." 1))

         (push clipboard_stack clipboard)
         (setq clipboard (open))
         (switch current_buffer)
         (message "Clipboard saved." 0))))

; Function to replace the current clipboard with one from the top of
; the clipboard stack.

(setq pop_clipboard
   (lambda (ignored)
      (if (not (used clipboard_stack))
         (progn
            (message "No saved clipboards." 1)
            0)

         (switch clipboard)
         (close)
         (setq clipboard (pop clipboard_stack))
         (switch current_buffer)
         (message "Clipboard restored." 0)
         1)))

; Function to delete the region, unshift the current clipboard onto the
; bottom of the clipboard stack, and pop the top clipboard as the new
; current clipboard, then paste the content.

(setq delete_rotate_and_paste
   (lambda (ignored)
      (if (not (used clipboard_stack))
         (message "No saved clipboards." 1)

         (delete_user_region ignored)
         (unshift clipboard_stack clipboard)
         (setq clipboard (pop clipboard_stack))
         (paste ignored))))

; Function to pop the clipboard stack and paste the new content
; from the current clipboard.

(setq pop_and_paste
   (lambda (ignored)
      (when (pop_clipboard ignored)
         (paste ignored))))

; Function to transfer the content of the clipboard on the top of
; the clipboard stack, to the current clipboard, and then paste it.

(let ((top 0))
   (setq transfer_clipboard
      (lambda (ignored)
         (if (not (used clipboard_stack))
            (message "No saved clipboard." 1)

            (switch clipboard)
            (empty)

            (setq top (index clipboard_stack (topidx clipboard_stack)))
            (switch top)
            (transfer top 1 (lastline) clipboard 0)
            (switch current_buffer)
            (paste ignored)))))

; Function to paste item from user-specified clipboard on clipboard
; stack.

(let ((cb 0)
      (tc 0))

   (setq paste_clipboard
      (lambda (ignored)
         (if (not (setq tc (used clipboard_stack)))
            (message "No saved clipboards." 1)

            (when (>= (setq cb (get_number "Clipboard: " 1 1)) 0)
               (if (> cb tc)
                  (message (stringify "Only " tc " clipboards saved.") 1)

                  (if (not cb)
                     (message (stringify tc " clipboards saved.") 0)

                     (dynamic_let (clipboard (index clipboard_stack (- cb 1)))
                        (paste 1)))))))))

; Function to exchange the position of the cursor and the mark.

(let ((new_y 0)
      (new_x 0))

   (setq exchange_point_mark
      (lambda (ignored)
         (if (not mark)
            (message "Mark is unset." 1)

            (setq new_y (car mark))
            (setq new_x (cadr mark))
            (setq mark (list y x))
            (goto_location new_y new_x)))))

; Function to list the filenames on the file stack.

(let ((len 0)
      (items ())
      (top ""))

   (setq show_file_stack
      (lambda (ignored)
         (setq items (reverse (flatten file_stack)))
         (setq len (length items))
         (setq top "--")

         (if (< len status_line)
            (inc len)
            (setq len status_line)
            (setq top "- list truncated -"))

         (clearline (- status_line len) 0)
         (print top)
         (dec len)

         (while len
            (clearline (- status_line len) 0)
            (print (basename (caar items)))
            (dec len)
            (setq items (cdr items)))

         (clearline status_line 0)
         (print "Any key to continue...")
         (get_char)
         (display (if (lastline) (- y r)) base tab_stop)
         (clearline status_line 0)
         (goto r c))))

; Functions to save file and cursor location before loading new file.

(setq push_and_load
   (lambda (ignored (rotate))
      (if (not filename)
         (progn
            (message "No filename associated with buffer." 1)
            0)

         (push file_stack (list filename y x))
         (unless rotate
            (unless (load_file 0)
               (pop file_stack)))

         1)))

; Function to rotate file stack, pushing currently-loaded file, and loading
; bottom item, shifting it off the stack.

(setq rotate_file_stack
   (lambda (ignored)
      (if (not (used file_stack))
         (message "No saved files." 1)

         (when (push_and_load 0 1)
            (push file_stack (shift file_stack))
            (pop_and_load 1)))))

; Function to load buffer from file on top of file stack.

(let ((tmp ()))

   (setq pop_and_load
      (lambda (ignored)
         (catch
            (cond ((not (used file_stack))
                   (message "No saved files." 1)
                   (throw 0))

                  (dirty
                     (message "Unsaved changes!  Continue? (y/n) " 1)
                     (goto status_line 34)
                     (if (eq (get_char) 121)
                         (setq dirty 0)

                         (clearline status_line 0)
                         (goto r c)
                         (throw 0))))

            (setq tmp (pop file_stack))
            (when (not (eq filename (car tmp)))
               (load_file 0 (car tmp)))
            (when (lastline)
               (goto_location (cadr tmp) (car (cddr tmp))))))))

; Function to exchange the current file with the one on top of the file stack.

(let ((top ()))

   (setq switch_and_load
      (lambda (ignored)
         (if (not (used file_stack))
            (message "No saved files." 1)

            (if (not filename)
               (message "No filename associated with buffer." 1)

               (setq top (list filename y x))
               (when (pop_and_load 1)
                  (push file_stack top)))))))

; Functions to send lisp from the buffer to an inferior Munger for evaluation.

(setq evaluate_lisp
   (lambda (ignored)
      (when (not (child_running))
         (child_open "/usr/local/bin/munger"))

      (set_mark)
      (back_char 1)

      (if (not (jump_to_other_end 0))
         (forw_char 1)

         (for (a y (car mark))
            (cond ((eq a y)
                   (child_write (slice a x 0 1 0)))

                   ((eq a (car mark))
                    (child_write (slice a 0 (cadr mark) 1 0)))

                   (1 (child_write (retrieve a)))))

         (page_lisp)
         (jump_to_other_end 0)
         (forw_char 1))))

(setq get_more_lisp
   (lambda (ignored)
      (if (child_running)
         (page_lisp)
         (message "No inferior lisp is running." 1))))

(setq page_lisp
   (lambda ()
      (let ((line "")
            (lns "")
            (len 0)
            (n 0)
            (top "--"))

         (setq n 0)
         (while (and (< n 100) (child_running) (child_ready))
            (setq line (child_read))
            (setq lns (stringify lns line))
            (inc n))

         (cond ((eq lns "")
                (if (not (child_running))
                  (message "Inferior lisp has exited." 1)
                  (message "No output from inferior lisp." 1)))

               (1
                  (setq lns (split (stringify (char 10)) lns))
                  (setq len (length lns))

                  (do
                     (if (< len status_line)
                        (inc len)
                        (setq len status_line))

                     (clearline (- status_line len) 0)
                     (print top)
                     (dec len)

                     (while len
                        (clearline (- status_line len) 0)
                        (print (car lns))
                        (dec len)
                        (setq lns (cdr lns)))

                     (clearline status_line 0)
                     (if (setq len (length lns))
                        (print "More...")
                        (print "Any key to continue..."))
                     (get_char)
                     (clearline status_line 0)
                     (display (- y r) base tab_stop)
                     (goto r c)

                     len))))))

(setq close_lisp
   (lambda (ignored)
      (if (child_running)
         (progn
            (child_close)
            (message "Inferior lisp terminated." 0))

         (message "No inferior lisp is running." 1))))

; Function to redraw the screen, centering the current line.

(setq redisplay
   (lambda (ignored)
      (if (< y (/ num_lines 2))
        (setq r (- y 1))
        (setq r (- (/ num_lines 2) 1)))

      (display (if (lastline) (- y r) 0) base tab_stop)
      (goto r c)))

; Function to scroll buffer up until current line is at top of screen.

(setq reposition_high
   (lambda (ignored)
      (setq r 0)
      (display (- y r) base tab_stop)
      (goto r c)))

; Function to scroll buffer down until current line is at bottom of screen.

(setq reposition_low
   (lambda (ignored)
      (if (< y status_line)
         (setq r (- y 1))
         (setq r (- num_lines 2)))

      (display (- y r) base tab_stop)
      (goto r c)))

; Function to describe cursor location on status line.

(let ((last 0))

   (setq show_coordinates
      (lambda (ignored)
         (setq last (lastline))
         (message (stringify (if filename (basename filename) "(no filename)")
                             ": " y "." (+ base c) "/" last " "
                             "(" (and last (/ (* y 100) last)) "%) "
                             (if dirty "modified" "unmodified"))
                  0))))

; Function to print message on status line.

(setq message
   (lambda (msg bel)
      (clearline status_line 0)
      (print (and msg (substring msg 0 num_cols)))
      (when bel (beep))
      (goto r c)))

; Function to repaint the screen after a manual linebreak.

(setq redisplay_after_linebreak
   (lambda ()
      (setq x 0)
      (setq c 0)
      (setq goal 0)

      (if base

         ; If the screen was horizontally-scrolled, scroll back to column zero.

         (progn
            (setq base 0)
            (clearline status_line 0)
            (display (- y r) base tab_stop)
            (forw_line 1))

         ; Otherwise, repaint only the affected lines.

         (clearline r 0)
         (print (chomp (slice y base num_cols tab_stop 0)))
         (forw_line 1)
         (insertln)
         (print (chomp (slice y base num_cols tab_stop 0))))

      (clearline status_line 0)
      (goto r c)))

; Function which inserts characters into the buffer.  It handles manual and
; automatic linebreaks and auto_indenting.

(let ((wrap_regexp (regcomp "^(.*[^\b\t])?[\b\t]+([^\b\t]+)?$"))
      (line 0)
      (before 0)
      (after 0)
      (m ()))

   (setq insert_char
      (lambda (ch)

         ; Mark the buffer dirty.

         (setq dirty 1)

         (if (not (lastline))

            ; Inserting into an empty buffer.

            (if (or (eq ch 10) (eq ch 13))
               (progn
                  (do_insert y (char 10) 0)
                  (do_insert y (char 10) 1)
                  (clearline 0 0)
                  (print " ")
                  (forw_line 1))

               (do_insert y (concat (char ch) (char 10)) 0)
               (clearline r 0)
               (print (char ch))
               (forw_char 1))

            ; Inserting into a non-empty buffer.  Split the line up into before
            ; and after segments for further examination.

            (setq line (retrieve y))
            (setq before (stringify (if x (substring line 0 x) "")
                                    (if (eq ch 13) (char 10) (char ch))))
            (setq after (substring line x 0))
            (setq m ())

            (cond

               ; Code to handle a manual linebreak.

               ((or (eq ch 10) (eq ch 13))

                (if auto_indent
                  (progn

                     ; If we're auto_indenting, prevent the creation of lines of
                     ; only whitespace.

                     (if (match whitespace_rx (chomp before))
                       (do_insert y (char 10) 0)
                       (do_insert y before 0))

                     ; Propagate leading whitespace to new line.

                     (setq m (matches leading_whitespace_rx before))
                     (do_insert y (stringify (if m (car m) "") after) 1))

                  (do_insert y before 0)
                  (do_insert y after 1))

                ; Repaint altered screen lines, and move cursor to next line.

                (redisplay_after_linebreak)

                ; If autoidenting, move cursor past indentation.

                (when (and auto_indent (setq m (if m (length (car m)) 0)))
                   (while m
                      (forw_char 1)
                      (dec m))))

                ; Code to handle an automatic line break.

                ((and auto_wrap
                     (> (length (expand tab_stop before)) line_length)
                     (setq m (matches wrap_regexp before)))

                 ; If we have found whitespace to break the line at,
                 ; then break it, terminating the section before the cursor.

                 (do_insert y (stringify (cadr m) (char 10)) 0)
                 (do_insert y (stringify (car (cddr m)) after) 1)

                 ; Repaint the altered lines and advance the cursor by one
                 ; line.

                 (redisplay_after_linebreak)

                 ; If we broke the line before the cursor position on the
                 ; old line, then we must advance the cursor past those
                 ; characters, on the new line.

                 (setq m (length (car (cddr m))))
                 (while m
                    (forw_char 1)
                    (dec m)))

                ; Ordinary character insertion.

                (1
                  (do_insert y (join "" before after) 0)
                  (clearline r c)
                  (print (chomp (slice y (+ base c) (- num_cols c) tab_stop 0)))
                  (forw_char 1)
                  (and show_match (showmatch ch))))))))

; Function to exit editor.

(let ((len 0)
      (msg ""))

   (setq terminate
      (lambda (ignored)
         (if dirty
            (progn
               (setq msg "Unsaved changes!  Exit? (y/n)")
               (setq len (length msg))
               (message msg 1)
               (goto status_line (+ len 1))

               (when (eq (get_char) 121)
                   (print "y")
                   (canon)
                   (newline)
                   (quit))

               (clearline status_line 0)
               (goto r c))

            (canon)
            (newline)
            (quit)))))

; Function to save the buffer and exit.

(setq save_and_exit
   (lambda (ignored)
      (catch
         (when dirty
            (unless (save_file 0)
               (throw 0)))
         (goto status_line 0)
         (canon)
         (newline)
         (quit))))

; Function to display version and copyright message.

(let ((v (version)))
   (setq show_version
      (lambda (ignored)
         (message
            (stringify "Dickens " dkns_version
                       " / Munger " (car v) "." (cadr v)
                       " (c) 2005-19 James Bailie <jimmy@mammothcheese.ca>") 0))))

; Function to count the words in the buffer and display the count on the
; status line.

(setq show_word_count
   (lambda (ignored)
      (message (stringify (words) " words.") 0)))

; Functions to copy the lines onto the clipboard.

(setq copy_line
   (lambda (repeat)
      (set_mark)
      (forw_line (dec repeat))
      (end_of_line 1)
      (clipboard_operation 0 0)
      (exchange_point_mark 1)
      (setq mark ())))

(setq copy_para
   (lambda (repeat)
      (set_mark)
      (forw_para repeat)
      (clipboard_operation 0 0)
      (exchange_point_mark 1)
      (setq mark ())))

; Allows the insertion of any non-control character.

(setq escape_insert_char
   (lambda (repeat)
      (message "Type character" 0)
      (while repeat
         (insert_char (get_char))
         (dec repeat))
      (message "" 0)))

; Sets repeat count for next command.

(setq get_repeat_count
   (lambda (ignored)
      (let ((cnt (get_number "Count: " "")))
         (when (> cnt 0)
            (setq count cnt)))))

; Function to drop down to the lisp prompt for debugging purposes.

(setq debug
   (lambda (ignored)
      (canon)
      (newline)
      (interact)
      (nocanon)

      (let ((diff (- num_lines (lines))))
         (setq num_lines (lines))
         (setq status_line (- num_lines 1))
         (setq num_cols (cols))

         (when (>= r status_line)
            (setq r (- r diff))))

      (display (if (lastline) (- y r) 0) base tab_stop)
      (clearline status_line 0)
      (goto r c)))

; Functions to work with tags.

(let ((line "")
      (tmp ()))

   (setq check_tags
      (lambda ()
         (when (and (unless (exists "tags") (message "No tags file found." 1) "")
                    (unless (access "tags" 0) (message "You do not have permission to read the tags file." 1) "")
                    (or (not (keys tags))
                        (not (eq tags_mtime (car (cdddr (stat "tags")))))))

            (foreach (lambda (k) (unhash tags k)) (keys tags))

            (with_input_file "tags"
               (while (stringp (setq line (getline)))
                  (setq tmp (split (char 9) (chomp line) 3))

                  (when (< (length tmp) 3)
                     (continue))

                  (hash tags (if (and (eq (substring (car tmp) 0 1) "M")
                                      (cdr tmp)
                                      (eq (substring (car tmp) 1 0) (rootname (cadr tmp))))
                                 "main"
                                 (car tmp))

                             (list (cadr tmp)
                                   (regcomp (chop (chop (substring (car (cddr tmp)) 2 0)))
                                            1 1)))))

            (setq tags_mtime (car (cdddr (stat "tags"))))))))

(let ((word_rx (regcomp "^[A-Za-z_0-9]+")))

   (setq find_symbol_under_cursor
      (lambda ()
         (if (not (lastline))
            ""

            (if (setq m (matches word_rx (slice y x 0 tab_stop 0)))
               (car m)
               "")))))

(let ((width 0)
      (len 0)
      (item "")
      (target "")
      (unformatted (stack))
      (formatted (stack))
      (column 0)
      (columns 0)
      (rows 0)
      (max 0)
      (tmp 0)
      (tmp2 0)
      (total 0))

   (setq format_possibilities
      (lambda (items)
         (when items
            (message "Working..." 0)

            (assign unformatted items)
            (setq len (used unformatted))
            (setq max (length (car items)))

            (for (n 0 (topidx unformatted))
               (when (> (setq tmp2 (length (index unformatted n))) max)
                  (setq max tmp2)))

            (inc max)
            (setq width (cols))

            (setq columns (or (/ (- width 1) max) 1))
            (setq rows (/ (+ len columns) columns))
            (setq total (* rows columns))

            (dec max)
            (clear formatted (used formatted))
            (setq item "")

            (for (n 0 total)
               (setq column (% n columns))
               (setq target (+ (* column rows) (/ n columns)))

               (when (< target len)
                  (setq tmp (index unformatted target))
                  (if (< (setq tmp2 (length tmp)) max)
                     (setq tmp2 (+ (- max tmp2) 1))
                     (setq tmp2 1))

                  (setq item (join "" item (substring tmp 0 max)))

                  (while tmp2
                     (setq item (join "" item " "))
                     (dec tmp2)))

               (when (eq column (- columns 1))
                  (while (< (length item) width)
                     (setq item (join "" item " ")))

                  (push formatted item)
                  (setq item "")))

            (clear unformatted (used unformatted))
            (flatten formatted)))))

(let ((len 0)
      (symbols ())
      (long "")
      (results ()))

   (setq complete_tag
      (lambda (tag)
         (setq len (length tag))
         (setq symbols (sortlist (keys tags)))
         (setq long tag)
         (setq results ())

         (if (or (not tag) (not tags))
            (cons tag (format_possibilities symbols))

            (while symbols
               (when (eq (substring (car symbols) 0 len) tag)
                  (setq results (cons (car symbols) results)))
               (setq symbols (cdr symbols)))

            (cond ((eq (length results) 1)
                   (setq long (car results))
                   (setq results ()))

                  ((eq results ())
                   (setq long tag))

                  (1 (catch
                       (while 1
                          (setq symbols results)

                          (while symbols
                             (when (not (cdr symbols))
                                (setq symbols (cdr symbols))
                                (continue))

                             (when (or (<= (length (car symbols)) len)
                                       (<= (length (cadr symbols)) len))
                                (throw long))

                             (when (not (eq (substring (car symbols) len 1)
                                            (substring (cadr symbols) len 1)))
                                (throw long))

                             (setq symbols (cdr symbols)))

                          (setq long (join "" long (substring (car results) len 1)))
                          (inc len)))))

            (cons long (and results (format_possibilities results)))))))

(let ((tag ())
      (init "")
      (old ())
      (tmp "")
      (tag_history ()))

   (setq goto_tag
      (lambda (ignored)
         (catch

            (when (stringp (check_tags))
               (throw 0))

            (setq old history)
            (setq history tag_history)

            (setq init (find_symbol_under_cursor))
            (set_complete_func complete_tag)
            (setq tag (get_string "Tag: " init 1 1))
            (set_complete_func complete)

            (setq tag_history history)
            (setq history old)

            (when tag
               (if (not (setq tag (lookup tags tag)))
                  (message "No such tag." 1)

                  (if (eq (basename filename) (car tag))
                     (push file_stack (list filename y x))

                     (if (setq tmp (exists (car tag)))
                        (cond ((eq tmp -1)
                               (message (stringify "permission to access " (car tag) " denied") 1)
                               (throw 0))

                              ((not (eq tmp 1))
                               (message (stringify (car tag) " is a not a regular file") 1)
                               (throw 0)))

                        (message (stringify (car tag) " does not exist") 1)
                        (throw 0))

                     (setq old (list filename y x))

                     (unless (load_file 0 (car tag))
                        (throw 0))

                     (when (car old)
                        (push file_stack old)))

                  (when (find_pattern 1 (cadr tag) 0 1)
                     (start_of_text 1))))))))

; Function to get a single character from the terminal.  Resizes screen upon
; receipt of SIGWINCH.

(let ((ch "")
      (recording 0)
      (pending ())
      (macro_keys ()))

   (setq toggle_recording
      (lambda (ignored)
         (if recording
            (progn
               (setq recording 0)
               (setq macro_keys (reverse (cddr macro_keys)))
               (message "Recording stopped." 0))

            (setq recording 1)
            (setq macro_keys ())
            (message "Recording started." 0))))

   (setq play_macro
      (lambda (repeat)
         (cond (recording
                  (message "Cannot play keystrokes while recording keystrokes." 1)
                  (setq macro_keys (cdr macro_keys)))

               (pending (message "Macro is already playing." 1))

               ((not macro_keys) (message "No keystrokes have been recorded." 1))

               (1 (let ((tmp ()))
                     (while (> repeat 0)
                        (setq tmp (append tmp macro_keys))
                        (dec repeat))
                     (setq pending tmp))))))

   (setq get_char
      (lambda ((win))
         (cond (pending
                (setq ch (car pending))
                (setq pending (cdr pending))
                ch)

               ((not (eq (setq ch (getchar)) -2))
                (setq ch
                   (case ch
                      (13 10)
                      (27 (+ (getchar) 128))
                      (-1 4)
                      (? ch)))

                (when recording
                   (setq macro_keys (cons ch macro_keys)))

                (when win
                   (display (if (lastline) (- y r) 0) 0 tab_stop)
                   (setq winch 1)
                   (goto r c))

                ch)

               (1
                  (let ((diff (- num_lines (lines))))
                     (setq num_lines (lines))
                     (setq status_line (- num_lines 1))
                     (setq num_cols (cols))

                     (setq x 0)
                     (setq c 0)
                     (setq base 0)
                     (setq goal 0)

                     (when (>= r status_line)
                        (when (< (setq r (- r diff)) 0)
                           (setq r 0))))

                  (tailcall get_char 1))))))

(let ((trailing_whitespace_rx (regcomp "[\b\t]+$"))
      (f ()))

   (setq strip_whitespace
      (lambda (ignored)
         (setq f '(1 0 0))

         (while (car f)
            (insert (car f)
               (concat (substitute trailing_whitespace_rx
                                   ""
                                   (chomp (retrieve (car f)))
                                   1)
                       (char 10))
               0)
            (setq f (find 1 (car f) 0 trailing_whitespace_rx 0)))

         (start_of_line 1)
         (setq dirty 1))))

; Tables mapping character codes to functions.

(setq commands (table))
(setq extended (table))

; Initial mappings for commands.

(hash commands 24 1)                           ; C-x
(hash commands 7 0)                            ; C-g

(hash commands 6 forw_char)                    ; C-f
(hash commands 2 back_char)                    ; C-b

(hash commands 230 forw_word)                  ; M-f
(hash commands 226 back_word)                  ; M-b

(hash commands 14 forw_line)                   ; C-n
(hash commands 16 back_line)                   ; C-p

(hash commands 1 start_of_line)                ; C-a
(hash commands 5 end_of_line)                  ; C-e

(hash commands 22 forw_screen)                 ; C-v
(hash commands 246 back_screen)                ; M-v

(hash commands 238 forw_scroll)                ; M-n
(hash commands 240 back_scroll)                ; M-p

(hash commands 20 reposition_high)             ; C-t
(hash commands 3 reposition_low)               ; C-c

(hash commands 12 redisplay)                   ; C-l
(hash extended 103 show_coordinates)           ; C-x g

(hash extended 76 evaluate_lisp)               ; C-x L
(hash extended 63 get_more_lisp)               ; C-x ?
(hash extended 12 close_lisp)                  ; C-x C-l

(hash extended 3 terminate)                    ; C-x C-c
(hash extended 61 delete_start_of_text)        ; C-x =

(hash commands 188 start_of_buffer)             ; M-<
(hash commands 190 end_of_buffer)               ; M->

(hash extended 6 load_file_wrapper)            ; C-x C-f
(hash extended 35 goto_line_number)            ; C-x #

(hash extended 19 save_file)                   ; C-x C-s
(hash extended 70 set_filename)                ; C-x F

(hash extended 108 goto_middle)                ; C-x l

(hash commands 4 delete_char_forw)             ; C-d
(hash commands 8 delete_char_back)             ; C-h

(hash commands 228 delete_word_forw)           ; M-d
(hash commands 232 delete_word_back)           ; M-h

(hash commands 11 delete_end_of_line)          ; C-k
(hash commands 235 delete_start_of_line)       ; M-k

(hash extended 48 high)                        ; C-x 0
(hash extended 49 low)                         ; C-x 1

(hash extended 109 set_bookmark)               ; C-x m
(hash extended 106 goto_bookmark)              ; C-x j

(hash commands 222 start_of_text)              ; M-^
(hash commands 171 forw_start_of_text)         ; M-+
(hash commands 173 back_start_of_text)         ; M--

(hash commands 19 forw_search)                 ; C-s
(hash commands 18 back_search)                 ; C-r

(hash commands 243 forw_search_again)          ; M-s
(hash commands 242 back_search_again)          ; M-r

(hash commands 229 forw_sent)                  ; M-e
(hash commands 225 back_sent)                  ; M-a

(hash commands 253 forw_para)                  ; M-}
(hash commands 251 back_para)                  ; M-{

(hash commands 221 forw_func)                  ; M-]
(hash commands 219 back_func)                  ; M-[

(hash extended 119 delete_rx_forw)             ; C-x w
(hash extended 113 delete_rx_back)             ; C-x q

(hash extended 69 delete_sent_forw)            ; C-x E
(hash extended 65 delete_sent_back)            ; C-x A

(hash extended 105 delete_para_forw)           ; C-x i
(hash extended 111 delete_para_back)           ; C-x o

(hash extended 121 delete_end_of_buffer)       ; C-x y
(hash extended 117 delete_start_of_buffer)     ; C-x u

(hash extended 75 delete_to_bookmark)          ; C-x K
(hash commands 25 paste)                       ; C-y
(hash commands 249 delete_rotate_and_paste)    ; M-y

(hash extended 4 delete_user_region)           ; C-x C-d
(hash commands 0 user_setmark)                 ; C-[space]

(hash extended 116 substitute_end_of_line)     ; C-x t
(hash extended 84 substitute_start_of_line)    ; C-x T

(hash extended 74 substitute_to_bookmark)      ; C-x J
(hash extended 18 substitute_user_region)      ; C-x C-r

(hash extended 41 substitute_para_forw)        ; C-x )
(hash extended 40 substitute_para_back)        ; C-x (

(hash extended 83 substitute_rx_forw)          ; C-x S
(hash extended 82 substitute_rx_back)          ; C-x R

(hash extended 46 substitute_end_of_buffer)    ; C-x .
(hash extended 44 substitute_start_of_buffer)  ; C-x ,

(hash extended 87 write_region)                ; C-x W
(hash extended 9 insert_file)                  ; C-x C-i

(hash extended 13 filter_region)               ; C-x C-m

(hash commands 21 undo_change)                 ; C-u
(hash extended 95 redo_change)                 ; C-x _

(hash commands 250 shift_line_left)            ; M-z
(hash commands 248 shift_line_right)           ; M-x

(hash extended 122 shift_para_left_forw)       ; C-x z
(hash extended 120 shift_para_right_forw)      ; C-x x

(hash extended 26 shift_para_left_back)        ; C-x C-z
(hash extended 24 shift_para_right_back)       ; C-x C-x

(hash extended 96 shift_rx_right_forw)         ; C-x `
(hash extended 126 shift_rx_right_back)        ; C-x ~

(hash extended 124 shift_rx_left_back)         ; C-x |
(hash extended 92 shift_rx_left_forw)          ; C-x \

(hash commands 165 jump_to_other_end)          ; M-%

(hash commands 187 capitalize_word)            ; M-;
(hash commands 162 lowercase_word)             ; M-"
(hash commands 186 uppercase_word)             ; M-:

(hash extended 36 suspend_editor)              ; C-x $
(hash extended 33 shell_cmd)                   ; C-x !

(hash extended 85 toggle_auto_wrap)            ; C-x U
(hash extended 73 toggle_auto_indent)          ; C-x I
(hash extended 77 toggle_show_match)           ; C-x M

(hash extended 66 set_tab_stop_wrapper)        ; C-x B
(hash extended 78 set_line_length_wrapper)     ; C-x N

(hash extended 64 show_config)                 ; C-x @
(hash commands 15 insert_blank_line)           ; C-o

(hash commands 241 format_para_forw)           ; M-q
(hash commands 247 format_para_back)           ; M-w

(hash commands 17 format_para_prefix_forw)     ; C-q
(hash commands 23 format_para_prefix_back)     ; C-w

(hash extended 38 insert_cmd_output)           ; C-x &
(hash extended 42 output_to_cmd)               ; C-x *

(hash commands 244 push_clipboard)             ; M-t
(hash commands 231 pop_clipboard)              ; M-g

(hash extended 81 transfer_clipboard)          ; C-x Q
(hash extended 59 paste_clipboard)             ; C-x ;
(hash extended 241 pop_and_paste)              ; C-x M-q

(hash extended 67 copy_user_region)            ; C-x C
(hash extended 5 exchange_point_mark)          ; C-x C-e

(hash extended 50 push_and_load)               ; C-x 2
(hash extended 51 pop_and_load)                ; C-x 3
(hash extended 68 rotate_file_stack)           ; C-x D

(hash extended 52 switch_and_load)             ; C-x 4
(hash extended 57 save_and_exit)               ; C-x 9

(hash extended 53 shift_delim_left)            ; C-x 5
(hash extended 54 shift_delim_right)           ; C-x 6

(hash extended 55 shift_region_left)           ; C-x 7
(hash extended 56 shift_region_right)          ; C-x 8

(hash extended 86 show_version)                ; C-x V
(hash extended 22 show_word_count)             ; C-x C-v

(hash extended 71 debug)                       ; C-x G
(hash extended 1 show_file_stack)              ; C-x C-a

(hash extended 7 goto_tag)                     ; C-x C-g
(hash extended 16 delete_whitespace)           ; C-x C-p

(hash extended 32 toggle_recording)            ; C-x [space]
(hash commands 160 play_macro)                 ; M-[space]

(hash commands 227 copy_line)                  ; M-c
(hash commands 195 copy_para)                  ; M-C

(hash commands 233 escape_insert_char)         ; M-i
(hash commands 239 get_repeat_count)           ; M-o

(hash extended 115 strip_whitespace)           ; C-x s

(setq dickens '(
   "      _qWQQQQQQQQQQQQQQQQQQQQQQQQQQQQQQQQ>         ..:+{a...:::::"
   "     _wWWWWQQQQQQQQQQQQQQQQQQQQQQQQQQQQQQmw,    ._==;=:=Y+=..-:::"
   "   .<SYn#mQWQQQQQQQQQQQQQQQWQQQQQQQQQQQQQm1o;. . -{i. ::::=: -:.:"
   "    -::i|XWWWQQQQQQQQQQWQQQQQQQQWQQQQQQQQm>o; .. .- .  =:  ..::::"
   "     ..::)SWWWQQQQQQQQQQQQQQQQQQWBVTVWWWQQQ%1 ....         :-::-."
   "       . .<XWQQQWQQWQWQQQQQQQQWWmwaaawmW#WWQwc --.        .::.-::"
   "  _s,    .-?WBWBVY?Y!!YV$QQQQQQQW#RVQB$$mWWWWmc .      .::;::::.."
   " :*\"+.     .)!~-:=aaa>,:-3WQWQQ#Saas)nmmQWWQQQmc=_.   .=:;:::.--:"
   "   . .    . . ..aQD$BVc:  \"$QQQQQQWWQQQQWQQQQQQQwmg..::::::.:.::."
   "    .          .~-.:Symga,_]QQQQQQQQQQQQQQQQQQQQWQB(:==;:;::::-:."
   "    .    .      .=dWWQQQQE>=XQQQQQQQQQQQQQQQQQQQQQQC=;==;;:::-:-:"
   "          ......=uwmWWQW#c:.+WWQQQQQQQQQQQQQQQQQQQWe-;==;;:::-:.:"
   "          ..=iowuwm#mWWWE+...3WQQQQQQQQQQQQQQQQQWV!:===;;;::::::-"
   "           ..=|3W#mWWQWWh.::-~$WQQP?QWQQQQQQWQQQW; =;==::;:::::.:"
   "=_.         ..:+{SXmWWWWX: .   -+qgyWQQQQQQQQQQQW(:::=;;;:;:::-::"
   "inqas,        .:=<IXXmmmX>.    .]RVUWQQWWWWWBQWQQ[:;;=:;:;::::-:."
   "<XWWWQwc.      ..:=|13XXXxi=,.=oc .-!YU#US*1#mWQQC;===;=;::::.:::"
   "=3#WWWWWgc.    ...:-=-++++xuqc=o1>+  =a+---+)YXmQmw===:;:;:::-:::"
   " -3WWQQQWmw.     . .... .--\"~^+YaawwmWQwc  .==~3QQm}|l=:.:=::::::"
   " .]WWQQQQQWm,   . ..    .... ..-!??!<mWWQa.  -{mQQQc<n2n;:-=+|=|="
   " .mQQQQQQQQWz.     .    ..... ._.xmQWQQWWD`  _mQQQQzio2Soa,. =iix"
   "_wQQQQQQQQQQQc    ... .   . ...:<#WBWWW#X(...jQQQQQc=nXXSXX>..:IS"
   "QQQQQQQQQQQQWk   . . .      ....+!{2YY*:-.. )WQQQQQF{XXS2X2q>..:{"
   "QQQQQQQQQWQQW(  ::     .  ..==.|:.- .:==:-=+<mQQQQQ(xXXX2S2XX;..-"))

; Load user start-up code.

(let ((init (join "/" (getenv "HOME") ".dkns"))
      (tmp 0))

   (when (setq tmp (exists init))
      (cond ((eq -1 tmp) (message "permission to read home directory denied" 1))
            ((not (eq tmp 1)) (message "~/.dkns is not a regular file" 1))
            ((not (access init 0)) (message "permission to read ~/.dkns denied" 1))
            (1 (load init)))))

; Process command-line arguments.

(let ((start 1))
   (next)

   (catch
      (display 0 0 0)

      (if (next)
         (progn
            (if (eq (substring (current) 0 1) "+")
               (if (< (length (current)) 2)
                  (throw (message "Empty line number argument." 1))

                  (setq start (or (digitize (substring (current) 1 0)) 1))
                  (if (not (next))
                     (throw (message "Line number argument present without filename argument." 1))
                     (load_file 0 (current))))

               (setq start 1)
               (load_file 1 (current)))

            (while (next)
               (unshift file_stack (list (current) 1 0)))

            (consolidate_history 1 "" (current))
            (when (lastline)
               (goto_location start 0)))

         ; Initial screen for an empty buffer.

         (let ((x (/ (- num_cols (length (car dickens))) 2))
               (y (/ (- (- num_lines 1) (length dickens)) 2))
               (txt dickens))

            (when (< y 0)
               (setq y 0))
            (when (< x 0)
               (setq x 0))

            (while (and (< y status_line) txt)
               (goto y x)
               (print (car txt))
               (inc y)
               (setq txt (cdr txt))))

         (goto r c))))


; Takes terminal device out of canonical mode. This used to be near the top of
; the script, but the Xterm on Xquartz will not reliably refresh the screen
; when the editor starts if (nocanon) occurs earlier in the script. Go figure.

(nocanon)

(let ((ch 0)
      (start 0)
      (local_count 0)
      (cmd "")
      (extended_cmd 0)
      (allow_on_empty 0))

   (let ((allowed (list terminate load_file_wrapper save_file set_filename insert_file
                        suspend_editor shell_cmd toggle_auto_wrap toggle_auto_indent
                        pop_clipboard transfer_clipboard pop_and_paste delete_rotate_and_paste
                        toggle_show_match show_coordinates paste show_version
                        set_tab_stop set_line_length show_config debug goto_tag
                        insert_blank_line insert_cmd_output redo_change undo_change
                        escape_insert_char switch_and_load push_and_load pop_and_load show_file_stack)))

      (setq allow_on_empty
         (lambda (cmd)
            (if (member cmd allowed)
               1
               (message "Buffer is empty." 1)
               0))))

   ; Launches multi-key commands.

   (setq extended_cmd
      (lambda ()
         (message "C-x ?" 0)

         (if (not (setq cmd (lookup extended (setq ch (get_char)))))
            (if (eq ch 21)
               (message "Cancelled." 1)
               (message "Unbound extended key sequence." 1))

            (clearline status_line 0)

            (when (or (lastline) (allow_on_empty cmd))
               (cmd local_count)
               (setq last_count local_count)
               (setq last_cmd cmd)))))

   ; Clear the ASCII art from the screen

   (when (fixnump (setq cmd (get_char)))
      (pushback cmd))

   (redisplay 1)

   ; Toplevel Loop.

   (loop
      (unless (setq local_count count)
         (setq local_count 1))

      (setq count 0)

      (cond ((setq cmd (lookup commands (setq ch (get_char))))
             (if (not winch)
                (clearline status_line 0)
                (message "Window resized." 1)
                (setq winch 0))

             (goto r c)

             (if (eq cmd 1)
               (extended_cmd)

               (when (or (lastline) (allow_on_empty cmd))
                  (cmd local_count)
                  (setq last_count local_count)
                  (setq last_cmd cmd))))

            ((eq 0 cmd)
             (if (not last_cmd)
                (message "No previous command to repeat." 1)
                (last_cmd last_count)))

            (1 (if (or (and (fixnump ch) (> ch 31) (< ch 127)) (eq ch 9) (eq ch 10) (eq ch 13))
                     (while local_count
                        (insert_char ch)
                        (dec local_count))

                     (if (stringp ch)
                        (suspend_editor 0)
                        (message "Unbound key code" 1)))))))
