Module:       deuce-internals
Synopsis:     The Deuce editor
Author:       Scott McKay
Copyright:    Original Code is Copyright (c) 1995-2004 Functional Objects, Inc.
              All rights reserved.
License:      See License.txt in this distribution for details.
Warranty:     Distributed WITHOUT WARRANTY OF ANY KIND

/// The Deuce commands

/// Note that since most commands cons up simple BPs to hold their
/// intermediate results, there is an implicit assumption that *buffer*
/// is bound to the appropriate buffer.  Beware!

/// Note that command methods assume that *editor-frame* is bound to the
/// same value as the 'frame' argument.  Beware!

//---*** These commands really need to worry about locking...

// This just does 'define method' of the named function on <editor-state-mixin>,
// and installs the help for the command
define macro command-definer
  { define ?modifiers:* command ?:name (?frame:name, ?opt-args:*)
        ?documentation:expression
      ?:body
    end }
    => { define open generic ?name (?frame :: <editor-state-mixin>, ?opt-args) => ();
         define ?modifiers method ?name (?frame :: <editor-state-mixin>, ?opt-args) => ()
           ?body;
         end method ?name;
         initialize-command-help(?name, ?documentation); }
  { define ?modifiers:* command ?:name (?frame:name :: ?type:name, ?opt-args:*)
        ?documentation:expression
      ?:body
    end }
    => { define open generic ?name (?frame :: <editor-state-mixin>, ?opt-args) => ();
         define ?modifiers method ?name (?frame :: ?type, ?opt-args) => ()
           ?body;
         end method ?name;
         initialize-command-help(?name, ?documentation); }
end macro command-definer;

/*
//--- This is nicer, but it doesn't work in the emulator
define macro command-definer
  { define ?modifiers:* command ?:name (?frame:name ?opt-type, ?opt-args:*)
        ?documentation:expression
      ?:body
    end }
    => { define open generic ?name (?frame :: <editor-state-mixin>, ?opt-args) => ();
         define ?modifiers method ?name (?frame ?opt-type, ?opt-args) => ()
           ?body;
         end method ?name;
         initialize-command-help(?name, ?documentation); }
 opt-type:
  { :: ?type:expression } => { :: ?type }
  { } => { :: <editor-state-mixin> }
end macro command-definer;
*/


define variable $brief-command-help :: <object-table> = make(<table>);
define variable $long-command-help  :: <object-table> = make(<table>);

define function initialize-command-help
    (command :: <function>, documentation :: <string>) => ()
  let nl = position(documentation, '\n');
  if (nl)
    // If there's a newline in the documentation string, use the first
    // part as the brief documentation and use the entire string as the
    // long documentation
    $brief-command-help[command] := copy-sequence(documentation, end: nl);
    $long-command-help[command]  := documentation
  else
    // Otherwise, the string serves as both brief and long documentation
    $brief-command-help[command] := documentation
  end
end function initialize-command-help;


/// Command errors

define sealed class <simple-command-error> (<command-error>)
end class <simple-command-error>;

define sealed inline method make
    (class == <command-error>, #rest initargs, #key, #all-keys)
 => (error :: <simple-command-error>)
  apply(make, <simple-command-error>, initargs)
end method make;

define sealed domain make (singleton(<simple-command-error>));
define sealed domain initialize (<simple-command-error>);

// Reset command reading state and signal a command error
define function command-error
    (format-string :: <string>, #rest format-args)
  let frame :: <editor-state-mixin> = *editor-frame*;
  let window = frame-window(frame);
  frame-last-command-type(frame) := #f;
  frame-numeric-arg(frame)       := 1;
  frame-numeric-arg-state(frame) := #f;
  abort-keyboard-macro-definition(frame);
  error(make(<command-error>,
             window: window,
             format-string:    concatenate-as(<string>, "Error: ", format-string),
             format-arguments: copy-sequence(format-args)))
end function command-error;


/// Read-only errors

define sealed class <read-only-command-error> (<command-error>)
end class <read-only-command-error>;

define sealed domain make (singleton(<read-only-command-error>));
define sealed domain initialize (<read-only-command-error>);

define function read-only-command-error
    (format-string :: <string>, #rest format-args)
  let frame :: <editor-state-mixin> = *editor-frame*;
  let window = frame-window(frame);
  frame-last-command-type(frame) := #f;
  frame-numeric-arg(frame)       := 1;
  frame-numeric-arg-state(frame) := #f;
  abort-keyboard-macro-definition(frame);
  error(make(<read-only-command-error>,
             window: window,
             format-string:    concatenate-as(<string>, "Error: ", format-string),
             format-arguments: copy-sequence(format-args)))
end function read-only-command-error;

define sealed method check-read-only
    (bp :: <basic-bp>) => ()
  check-read-only-line(bp-line(bp))
end method check-read-only;

define sealed method check-read-only
    (line :: <basic-line>) => ()
  check-read-only-line(line)
end method check-read-only;

define sealed inline method check-read-only-line
    (line :: <basic-line>) => ()
  let buffer = *buffer*;
  let home   = if (composite-buffer?(buffer)) section-home-buffer(line-section(line))
               else buffer end;
  when (buffer-read-only?(buffer)
        | (home & buffer-read-only?(home))
        | line-read-only?(line))
    read-only-command-error("Can't modify a read-only region")
  end
end method check-read-only-line;

define sealed method check-read-only
    (interval :: <basic-interval>) => ()
  let buffer     = interval-buffer(interval);
  let composite? = composite-buffer?(buffer);
  when (buffer-read-only?(buffer))
    read-only-command-error("Can't modify a read-only region")
  end;
  local method read-only? (line :: <basic-line>, si, ei, last?)
          ignore(si, ei, last?);
          let home = if (composite?) section-home-buffer(line-section(line))
                     else buffer end;
          when ((home & buffer-read-only?(home))
                | line-read-only?(line))
            read-only-command-error("Can't modify a read-only region")
          end
        end method;
  do-lines(read-only?, interval)
end method check-read-only;


/// Character insertion

define command self-insert (frame)
    "Insert the character you just typed.\n"
    "With a numeric argument, inserts that many copies of the character."
  let char :: <byte-character> = frame-command-character(frame);
  let state = frame-numeric-arg-state(frame);
  if (member?(state, #[#"universal", #"universal-digits", #"universal-sign"])
      & frame-last-command-type(frame) == #"number"
      & (digit-char?(char) | char == '-'))
    // The user typed something like control-U 1 0, treat it as a numeric arg
    let window :: <basic-window> = frame-window(frame);
    if (char == '-')
      let n     :: <integer> = if (state == #"universal") 1 else frame-numeric-arg(frame) end;
      frame-numeric-arg(frame)       := -abs(n);
      frame-numeric-arg-state(frame) := #"universal-sign"
    else
      let n     :: <integer> = if (state == #"universal-digits") frame-numeric-arg(frame) else 0 end;
      let sign  :: <integer> = if (n < 0 | state == #"universal-sign") -1 else 1 end;
      let digit :: <integer> = as(<integer>, char) - as(<integer>, '0');
      frame-numeric-arg(frame)       := n * 10 + digit * sign;
      frame-numeric-arg-state(frame) := #"universal-digits"
    end;
    display-message(window, "%d-", frame-numeric-arg(frame))
  else
    insert-character(frame, char)
  end
end command self-insert;

define command quoted-insert (frame)
    "Insert the non-standard character you just typed.\n"
    "With a numeric argument, inserts the character with that code."
  let window :: <basic-window> = frame-window(frame);
  if (frame-numeric-arg-state(frame) == #"digits")
    let char = as(<byte-character>, logand(frame-numeric-arg(frame), #o377));
    frame-numeric-arg(frame) := 1;
    insert-character(frame, char)
  else
    display-message(window, "Insert character: ");
    let char = read-character(window);
    insert-character(frame, char)
  end
end command quoted-insert;

define command insert-tab (frame)
    "Insert a tab at the current position.\n"
    "With a numeric argument, inserts that many tab characters."
  let char :: <byte-character> = '\t';
  insert-character(frame, char)
end command insert-tab;

define method insert-character
    (frame :: <editor-state-mixin>, char) => ()
  let window :: <basic-window> = frame-window(frame);
  let buffer :: <basic-buffer> = frame-buffer(frame);
  let n :: <integer> = frame-numeric-arg(frame);
  if (n <= 0)
    command-error("Can't insert a negative number of characters")
  else
    let bp  = point();
    let bp2 = typing-replaces-selection?(editor-policy(frame-editor(frame))) & mark();
    check-read-only(bp);
    let thing = if (n > 1) make(<byte-string>, size: n, fill: char)
                else char end;
    if (bp2)
      with-change-recording (buffer, <replace-change-record>,
                             start-bp: bp, end-bp: bp2, moving?: #t)
        let interval = make-interval(bp, bp2);
        check-read-only(interval);
        queue-region-redisplay(window, bp, bp2);
        bp := kill!(interval)
              | command-error("Can't delete across hard sections");
        clear-mark!();
        insert-moving!(bp, thing)
      end
    else
      with-change-recording (buffer, <insert-change-record>, start-bp: bp)
        clear-mark!();
        insert-moving!(bp, thing)
      end
    end;
    move-point!(bp);
    if (char == '\n')
      queue-redisplay(window, $display-text, centering: n)
    else
      queue-redisplay(window, $display-line,
                      line: bp-line(bp), index: bp-index(bp) - n)
    end
  end;
  frame-last-command-type(frame) := #"insert"
end method insert-character;


define command toggle-overwrite (frame)
    "Toggle overwrite mode for this buffer."
  let buffer :: <basic-buffer> = frame-buffer(frame);
  let overwrite-mode = find-mode(<overwrite-mode>);
  if (member?(overwrite-mode, buffer-minor-modes(buffer)))
    exit-mode(buffer, overwrite-mode)
  else
    enter-mode(buffer, overwrite-mode)
  end
end command toggle-overwrite;


/// Numeric arguments

define command numeric-argument (frame)
    "Accumulate another digit into the numeric argument."
  let window :: <basic-window> = frame-window(frame);
  let state = frame-numeric-arg-state(frame);
  let n     :: <integer> = if (state & state ~== #"sign") frame-numeric-arg(frame) else 0 end;
  let sign  :: <integer> = if (n < 0 | state == #"sign") -1 else 1 end;
  let char  :: <byte-character> = frame-command-character(frame);
  let digit :: <integer> = as(<integer>, char) - as(<integer>, '0');
  frame-numeric-arg(frame)       := n * 10 + digit * sign;
  frame-numeric-arg-state(frame) := #"digits";
  display-message(window, "%d-", frame-numeric-arg(frame));
  frame-last-command-type(frame) := #"number"
end command numeric-argument;

define command numeric-negative (frame)
    "Make the accumulated numeric argument be negative."
  let window :: <basic-window> = frame-window(frame);
  let n :: <integer> = frame-numeric-arg(frame);
  frame-numeric-arg(frame) := -abs(n);
  frame-numeric-arg-state(frame) := #"sign";
  display-message(window, "%d-", frame-numeric-arg(frame));
  frame-last-command-type(frame) := #"number";
end command numeric-negative;

define command universal-argument (frame)
    "Multiply the current numeric argument by 4."
  let window :: <basic-window> = frame-window(frame);
  let n :: <integer> = frame-numeric-arg(frame);
  frame-numeric-arg(frame)       := n * 4;
  frame-numeric-arg-state(frame) := #"universal";
  display-message(window, "%d-", frame-numeric-arg(frame));
  frame-last-command-type(frame) := #"number"
end command universal-argument;


define command cancel-command (frame)
    "Cancel the current command."
  let window :: <basic-window> = frame-window(frame);
  frame-numeric-arg(frame)       := 1;
  frame-numeric-arg-state(frame) := #f;
  let aborted? = abort-keyboard-macro-definition(frame);
  if (frame-command-state(frame) == standard-command-table(frame-command-set(frame)))
    clear-mark!();
    queue-redisplay(window, $display-region)
  else
    frame-command-state(frame) := standard-command-table(frame-command-set(frame))
  end;
  if (aborted?)
    display-error-message(window, "Cancel macro definition")
  else
    display-error-message(window, "Cancel")
  end;
  frame-last-command-type(frame) := #"cancel"
end command cancel-command;


/// Help

define variable $editor-help-cache = vector(#f, #f, #f);

define command editor-help (frame)
    "Show help for all the current key bindings."
  let window :: <basic-window> = frame-window(frame);
  local method get-command
            (window :: <basic-window>, comtab :: <command-table>, message :: <byte-string>)
         => (command)
          block (return)
            while (#t)
              display-message(window, message);
              let (keysym, char, modifiers) = read-gesture(window);
              let gesture = vector(char | keysym, modifiers);
              let command = find-command(comtab, gesture);
              case
                instance?(command, <command-table>) =>
                  // It's a command prefix (c-X), so change the state
                  comtab := command;
                command =>
                  // We've gotten to a command, all done
                  return(command);
                otherwise =>
                  return(#f);
              end
            end
          end
        end method;
  display-message(window, "Help: ");
  let char = read-character(window);
  select (char)
    '?' =>
      display-message(window,
                      "Help: Use 'b' to see all bindings, 'k' to see what a key is bound to.");
    'b', 'B' =>
      display-message(window,
                      "Help: All current key bindings.");
      editor-key-bindings(frame);
    'c', 'C' =>
      let comtab  = standard-command-table(frame-command-set(frame));
      let command = get-command(window, comtab, "Brief help for key: ");
      if (command)
        let documentation
          = gethash($brief-command-help, command);
        when (documentation)
          display-message(window, "%s", documentation)
        end
      else
        display-error-message(window, "No binding for that key")
      end;
    'k', 'K' =>
      let comtab  = standard-command-table(frame-command-set(frame));
      let command = get-command(window, comtab, "Help for key: ");
      if (command)
        let documentation
          = gethash($long-command-help, command) | gethash($brief-command-help, command);
        when (documentation)
          display-message(window, "%s", documentation)
        end
      else
        display-error-message(window, "No binding for that key")
      end;
    otherwise =>
      error(make(<command-error>, window: window));
  end;
  frame-last-command-type(frame) := #"display"
end command editor-help;

define command editor-key-bindings (frame)
    "Show help for all the current key bindings."
  let window :: <basic-window> = frame-window(frame);
  let name   = "Key bindings";
  let editor = frame-editor(frame);
  let buffer = find-buffer(editor, name)
               | make-empty-buffer(<simple-display-buffer>,
                                   name:       name,
                                   major-mode: find-mode(<text-mode>),
                                   read-only?: #t,
                                   editor:     editor);
  let command-set = frame-command-set(frame);
  let set-name    = command-set-name(command-set);
  unless (get-property(buffer-properties(buffer), #"command-set") == command-set
          & get-property(buffer-properties(buffer), #"command-set-name") == set-name)
    put-property!(buffer-properties(buffer), #"command-set", command-set);
    put-property!(buffer-properties(buffer), #"command-set-name", set-name);
    let lines   = compute-key-binding-documentation(command-set);
    let section = make(<section>,
                       start-line: #f, end-line: #f);
    let first-line :: false-or(<basic-line>) = #f;
    let last-line  :: false-or(<basic-line>) = #f;
    for (line in lines)
      let line = make(<text-line>,
                      contents: line,
                      section: section);
      unless (first-line)
        first-line := line
      end;
      line-previous(line) := last-line;
      when (last-line)
        line-next(last-line) := line
      end;
      last-line := line
    end;
    if (first-line)
      // Be flashy and use italics...
      let contents = "Binding\t\tCommand";
      let changes  = vector(make(<style-change>,
                                 index: 0,
                                 font:  window-default-italic-font(window)));
      let line     = make(<rich-text-line>,
                          contents: contents,
                          length:   size(contents),
                          section:  section,
                          style-changes: changes);
      line-next(line) := first-line;
      line-previous(first-line) := line;
      first-line := line
    else
      first-line := make(<text-line>,
                         contents: "No help available",
                         section: section);
      last-line  := first-line
    end;
    section-start-line(section) := first-line;
    section-end-line(section)   := last-line;
    let node = make-section-node(buffer, section);
    node-buffer(node)         := buffer;
    section-nodes(section)    := list(node);
    buffer-start-node(buffer) := node;
    buffer-end-node(buffer)   := node
  end;
  select-buffer-in-appropriate-window(window, buffer);
  frame-last-command-type(frame) := #"display"
end command editor-key-bindings;

define method compute-key-binding-documentation
    (command-set :: <command-set>) => (commands :: <stretchy-object-vector>)
  let set-name    = command-set-name(command-set);
  unless ($editor-help-cache[0] == command-set
          & $editor-help-cache[1] == set-name)
    let standard-commands  = standard-command-table(command-set);
    let control-X-commands = control-X-command-table(command-set);
    let control-C-commands = control-C-command-table(command-set);
    let escape-commands    = escape-command-table(command-set);
    local method find-binding
              (comtab :: <command-table>, command) => (binding)
            block (return)
              for (bucket in comtab.%key-table,
                   code :: <integer> from 0)
                let bits = position(bucket, command);
                when (bits)
                  let char :: <byte-character> = as(<byte-character>, code);
                  when (upper-case?(char))
                    bits := logior(bits, $shift-key)
                  end;
                  return(vector(char, bits))
                end
              end;
              for (bucket keyed-by keysym in comtab.%keysym-table)
                let bits = position(bucket, command);
                when (bits)
                  return(vector(keysym, bits))
                end
              end;
              #f
            end
          end method;
    let commands :: <stretchy-object-vector> = make(<stretchy-vector>);
    local method print-bindings
              (comtab :: false-or(<command-table>), #key prefix) => ()
            when (comtab)
              for (bucket in comtab.%key-table,
                   code :: <integer> from 0)
                for (command in bucket,
                     bits :: <integer> from 0)
                  let keysym = as(<byte-character>, code);
                  let bits :: <integer>
                    = if (upper-case?(keysym)) logior(bits, $shift-key) else bits end;
                  print-binding(prefix, bits, if (keysym = ' ') "Space" else as-uppercase(keysym) end, command)
                end
              end;
              for (bucket keyed-by keysym in comtab.%keysym-table)
                for (command in bucket,
                     bits :: <integer> from 0)
                  let keysym
                    = select (keysym)
                        #"prior"  => "PageUp";
                        #"next"   => "PageDn";
                        otherwise => string-capitalize(as(<string>, keysym));
                      end;
                  print-binding(prefix, bits, keysym, command)
                end
              end
            end
          end method,
          method print-binding
              (prefix, bits :: <integer>, keysym, command) => ()
            when (command
                  & command ~== self-insert
                  & command ~== numeric-argument)
              let documentation = gethash($brief-command-help, command);
              when (documentation)
                let binding
                  = if (prefix)
                      format-to-string("%s %s%s", prefix, $modifier-key-names[bits], keysym)
                    else
                      format-to-string("%s%s", $modifier-key-names[bits], keysym)
                    end;
                if (size(binding) < 8)
                  add!(commands, format-to-string("%s\t\t%s", binding, documentation))
                else
                  add!(commands, format-to-string("%s\t%s", binding, documentation))
                end
              end
            end
          end method;
    when (find-binding(standard-commands, numeric-argument))
      add!(commands, "c-<digit>\tNumeric argument");
      add!(commands, "m-<digit>\tNumeric argument")
    end;
    print-bindings(standard-commands);
    print-bindings(control-X-commands, prefix: "c-X");
    print-bindings(control-C-commands, prefix: "c-C");
    print-bindings(escape-commands,    prefix: "Esc");
    $editor-help-cache[0] := command-set;
    $editor-help-cache[1] := set-name;
    $editor-help-cache[2] := commands
  end;
  let commands = $editor-help-cache[2];
  commands
end method compute-key-binding-documentation;


/// Scrolling and redisplay

define command scroll-forward (frame)
    "Scroll forward a page, or N lines.\n"
    "With a numeric argument, scroll by lines; otherwise scroll a page."
  let n :: <integer> = frame-numeric-arg(frame);
  unless (n = 0)
    let state = frame-numeric-arg-state(frame);
    let direction = if (n < 0) #"backward" else #"forward" end;
    scroll-forward-or-backward(frame, direction, abs(n), state)
  end
end command scroll-forward;

define command scroll-backward (frame)
    "Scroll backward a page, or N lines.\n"
    "With a numeric argument, scroll by lines; otherwise scroll a page."
  let n :: <integer> = frame-numeric-arg(frame);
  unless (n = 0)
    let state = frame-numeric-arg-state(frame);
    let direction = if (n < 0) #"forward" else #"backward" end;
    scroll-forward-or-backward(frame, direction, abs(n), state)
  end
end command scroll-backward;

define command scroll-forward-ext (frame)
    "Scroll forward a page, or N lines, extending the selection if the Shift key is held down.\n"
    "With a numeric argument, scroll by lines; otherwise scroll a page."
  let n :: <integer> = frame-numeric-arg(frame);
  unless (n = 0)
    let state = frame-numeric-arg-state(frame);
    let direction = if (n < 0) #"backward" else #"forward" end;
    set-or-clear-mark(frame);
    scroll-forward-or-backward(frame, direction, abs(n), state)
  end
end command scroll-forward-ext;

define command scroll-backward-ext (frame)
    "Scroll backward a page, or N lines, extending the selection if the Shift key is held down.\n"
    "With a numeric argument, scroll by lines; otherwise scroll a page."
  let n :: <integer> = frame-numeric-arg(frame);
  unless (n = 0)
    let state = frame-numeric-arg-state(frame);
    let direction = if (n < 0) #"forward" else #"backward" end;
    set-or-clear-mark(frame);
    scroll-forward-or-backward(frame, direction, abs(n), state)
  end
end command scroll-backward-ext;

define method scroll-forward-or-backward
    (frame :: <editor-state-mixin>, direction, n :: <integer>, state) => ()
  let window   :: <basic-window> = frame-window(frame);
  let buffer   :: <basic-buffer> = frame-buffer(frame);
  let dlines   :: <simple-object-vector> = window-display-lines(window);
  let n-lines  :: <integer> = window-n-display-lines(window);
  let degree   :: <redisplay-degree> = $display-all;
  let line     :: <basic-line> = bp-line(point());
  let fraction :: false-or(<real>) = #f;
  block (break)
    let (dline, hint) = find-display-line(window, line);
    let index = dline & (hint - 1);
    case
      state == #f | state == #"sign" =>
        // Scrolling forward/backward one page
        select (direction)
          #"forward" =>
            if (line == bp-line(interval-end-bp(buffer)) & index & index = 0)
              break()
            else
              let dline :: <display-line> = dlines[n-lines - 1];
              let line  :: <basic-line>   = display-line-line(dline);
              move-point!(line, index: 0);
              recenter-window(window, line, #"top");
              fraction := 0.0;                // caret goes to the top of the window
            end;
          #"backward" =>
            if (line == bp-line(interval-start-bp(buffer)))
              break()
            else
              let dline :: <display-line> = dlines[0];
              let line  :: <basic-line>   = display-line-line(dline);
              move-point!(line, index: 0);
              recenter-window(window, line, #"bottom");
              fraction := 1.0;                // caret goes to the bottom of the window
            end;
        end;
      otherwise =>
        // Otherwise scroll forward/backward n lines
        select (direction)
          #"forward" =>
            case
              line == bp-line(interval-end-bp(buffer)) & index & index = 0 =>
                break();
              n < n-lines =>
                // If we're only scrolling a little, we can do this faster
                scroll-n-lines(window, n, move-point?: #t);
                break();
              otherwise =>
                scroll-n-lines-slowly(window, n, move-point?: #t);
                break();
            end;
          #"backward" =>
            case
              line == bp-line(interval-start-bp(buffer)) =>
                break();
              n < n-lines =>
                scroll-n-lines(window, -n, move-point?: #t);
                break();
              otherwise =>
                scroll-n-lines-slowly(window, -n, move-point?: #t);
                break();
            end;
        end;
    end;
    window-centering-fraction(window) := fraction;
    queue-redisplay(window, degree)
  end;
  frame-last-command-type(frame) := #"scroll"
end method scroll-forward-or-backward;


define command start-of-page (frame)
    "Put the point at the starting line on the page."
  let window :: <basic-window> = frame-window(frame);
  let buffer :: <basic-buffer> = window-buffer(window);
  block (break)
    local method find-page-break (line :: <basic-line>, si, ei, last?)
            ignore(last?);
            let index = position(line-contents(line), '\f', start: si, end: ei, from-end?: #t);
            when (index)
              move-point!(line, index: index);
              break()
            end
          end method;
    let interval = make-interval(interval-start-bp(buffer), point());
    do-lines(find-page-break, interval, from-end?: #t);
    move-point!(interval-start-bp(buffer))
  end;
  queue-redisplay(window, $display-point, centering: -1);
  frame-last-command-type(frame) := #"motion"
end command start-of-page;

define command end-of-page (frame)
    "Put the point at the ending line on the page."
  let window :: <basic-window> = frame-window(frame);
  let buffer :: <basic-buffer> = window-buffer(window);
  block (break)
    local method find-page-break (line :: <basic-line>, si, ei, last?)
            ignore(last?);
            let index = position(line-contents(line), '\f', start: si, end: ei, from-end?: #f);
            when (index)
              move-point!(line, index: index + 1);
              break()
            end
          end method;
    let interval = make-interval(point(), interval-end-bp(buffer));
    do-lines(find-page-break, interval, from-end?: #f);
    move-point!(interval-end-bp(buffer))
  end;
  queue-redisplay(window, $display-point, centering: 1);
  frame-last-command-type(frame) := #"motion"
end command end-of-page;


define command force-recenter (frame)
    "Recenter the point in this window.\n"
    "With no numeric argument, put the current line at the center of the window.\n"
    "With a positive numeric argument, put the current line near the top.\n"
    "With a negative numeric argument, put the current line near the bottom."
  let window :: <basic-window> = frame-window(frame);
  let n :: <integer> = frame-numeric-arg(frame);
  let state = frame-numeric-arg-state(frame);
  let line = bp-line(point());
  case
    state =>
      // Put this line at the n'th line on the screen
      recenter-window(window, line, n);
    otherwise =>
      // Put this line at the center of the screen
      recenter-window(window, line, #"center");
  end;
  set-scroll-position(window, 0, #f);
  do-force-redisplay(frame)
end command force-recenter;

define command force-redisplay (frame)
    "Forcibly redisplay the window."
  do-force-redisplay(frame)
end command force-redisplay;

// Split this out from 'force-redisplay' so that 'force-recenter'
// doesn't inadvertently reload colorization information
//--- It's a modularity kludge that we do it this way, but what the heck
define method do-force-redisplay
    (frame :: <editor-state-mixin>) => ()
  let window :: <basic-window> = frame-window(frame);
  let buffer :: <basic-buffer> = window-buffer(window);
  // Re-sectionize any changed sections
  resectionize-changed-sections(buffer);
  // Clear the whole window so all the bits get repainted
  let (width, height) = window-size(window);
  clear-area(window, 0, 0, width, height);
  queue-redisplay(window, $display-all);
  frame-last-command-type(frame) := #"display"
end method do-force-redisplay;


define command show-position (frame)
    "Display information about the current position"
  let window :: <basic-window> = frame-window(frame);
  let buffer :: <basic-buffer> = frame-buffer(frame);
  let interval
    = if (mark()) make-interval(point(), mark())
      else buffer end;
  let in-region
    = if (mark()) "in region " else "" end;
  let n-lines = count-lines(interval);
  let line-no = count-lines(make-interval(interval-start-bp(interval), point()));
  let percent = floor(100 * as(<single-float>, line-no) / as(<single-float>, n-lines));
  let index   = bp-index(point()) + 1;
  let char    = bp-character(point());
  let code    = as(<integer>, char);
  if (code < #o40 | code > #o176)
    display-message(window, "Line %d of %d %s(%d%%), column %d, char code #o%o #x%x",
                    line-no, n-lines, in-region, percent, index, code, code);
  else
    display-message(window, "Line %d of %d %s(%d%%), column %d, char '%c' (#o%o #x%x)",
                    line-no, n-lines, in-region, percent, index, char, code, code);
  end;
  frame-last-command-type(frame) := #"display"
end command show-position;


/// Simple forward and backward motion

define command forward-character (frame)
    "Move forward N characters."
  let n :: <integer> = frame-numeric-arg(frame);
  forward-or-backward-thing(frame, move-over-characters, n)
end command forward-character;

define command backward-character (frame)
    "Move backward N characters."
  let n :: <integer> = frame-numeric-arg(frame);
  forward-or-backward-thing(frame, move-over-characters, -n)
end command backward-character;


// The Windows-like version of 'forward-character'
define command forward-character-ext (frame)
    "Move forward N characters, extending the selection if the Shift key is held down."
  let n :: <integer> = frame-numeric-arg(frame);
  set-or-clear-mark(frame);
  forward-or-backward-thing(frame, move-over-characters, n)
end command forward-character-ext;

define command backward-character-ext (frame)
    "Move backward N characters, extending the selection if the Shift key is held down."
  let n :: <integer> = frame-numeric-arg(frame);
  set-or-clear-mark(frame);
  forward-or-backward-thing(frame, move-over-characters, -n)
end command backward-character-ext;

define method set-or-clear-mark (frame :: <editor-state-mixin>) => ()
  let state = frame-command-modifiers(frame);
  if (mark())
    // If there is already a mark and the motion command is not "shifted",
    // but we set the original mark with a shift, then we clear the mark
    when ((logand(state, $shift-key) = 0)
            & (frame.frame-window.window-mark-with-shift))
      clear-mark!()
    end
  else
    // If there is not already a mark and the motion command is "shifted",
    // then we set the mark
    unless (logand(state, $shift-key) = 0)
      move-mark!(point(), volatile?: #t)
    end
  end
end method set-or-clear-mark;


define command forward-word (frame)
    "Move forward N words."
  let n :: <integer> = frame-numeric-arg(frame);
  forward-or-backward-thing(frame, move-over-words, n)
end command forward-word;

define command backward-word (frame)
    "Move backward N words."
  let n :: <integer> = frame-numeric-arg(frame);
  forward-or-backward-thing(frame, move-over-words, -n)
end command backward-word;


// The Windows-like version of 'forward-word'
define command forward-word-ext (frame)
    "Move forward N words, extending the selection if the Shift key is held down."
  let n :: <integer> = frame-numeric-arg(frame);
  set-or-clear-mark(frame);
  forward-or-backward-thing(frame, move-over-words, n)
end command forward-word-ext;

define command backward-word-ext (frame)
    "Move backward N words, extending the selection if the Shift key is held down."
  let n :: <integer> = frame-numeric-arg(frame);
  set-or-clear-mark(frame);
  forward-or-backward-thing(frame, move-over-words, -n)
end command backward-word-ext;


define command forward-list (frame)
    "Move forward over N balanced lists -- (), [], {}."
  let n :: <integer> = frame-numeric-arg(frame);
  let bp   = point();
  let node = bp-node(bp) | bp-buffer(bp);
  local method move (bp :: <basic-bp>, n :: <integer>, #key fixup? = #t)
                 => (bp :: false-or(<basic-bp>))
          move-over-lists(bp, n, fixup?: fixup?, interval: node)
        end method;
  forward-or-backward-thing(frame, move, n, message: "Unbalanced parentheses")
end command forward-list;

define command backward-list (frame)
    "Move backward over N balanced lists -- (), [], {}."
  let n :: <integer> = frame-numeric-arg(frame);
  let bp   = point();
  let node = bp-node(bp) | bp-buffer(bp);
  local method move (bp :: <basic-bp>, n :: <integer>, #key fixup? = #t)
                 => (bp :: false-or(<basic-bp>))
          move-over-lists(bp, n, fixup?: fixup?, interval: node)
        end method;
  forward-or-backward-thing(frame, move, -n, message: "Unbalanced parentheses")
end command backward-list;


define command forward-expression (frame)
    "Move forward over N language expressions."
  let n :: <integer> = frame-numeric-arg(frame);
  let bp   = point();
  let node = bp-node(bp) | bp-buffer(bp);
  local method move (bp :: <basic-bp>, n :: <integer>, #key fixup? = #t)
                 => (bp :: false-or(<basic-bp>))
          move-over-expressions(bp, n, fixup?: fixup?, interval: node)
        end method;
  forward-or-backward-thing(frame, move, n, message: "Unbalanced parentheses")
end command forward-expression;

define command backward-expression (frame)
    "Move backward over N language expressions."
  let n :: <integer> = frame-numeric-arg(frame);
  let bp   = point();
  let node = bp-node(bp) | bp-buffer(bp);
  local method move (bp :: <basic-bp>, n :: <integer>, #key fixup? = #t)
                 => (bp :: false-or(<basic-bp>))
          move-over-expressions(bp, n, fixup?: fixup?, interval: node)
        end method;
  forward-or-backward-thing(frame, move, -n, message: "Unbalanced parentheses")
end command backward-expression;


define method forward-or-backward-thing
    (frame :: <editor-state-mixin>, function :: <function>, n :: <integer>,
     #key message) => ()
  let window :: <basic-window> = frame-window(frame);
  let bp :: false-or(<basic-bp>) = function(point(), n, fixup?: abs(n) > 1);
  if (bp)
    move-point!(bp);
    queue-redisplay(window, $display-point, centering: n);
    frame-last-command-type(frame) := #"motion"
  else
    command-error(message | "Can't move any further")
  end
end method forward-or-backward-thing;


/// Simple "up" and "down" motion

define command next-line (frame)
    "Move to the N'th next line."
  let n :: <integer> = frame-numeric-arg(frame);
  next-or-previous-line(frame, n)
end command next-line;

define command previous-line (frame)
    "Move to the N'th previous line."
  let n :: <integer> = frame-numeric-arg(frame);
  next-or-previous-line(frame, -n)
end command previous-line;

// The Windows-like version of 'next-line'
define command next-line-ext (frame)
    "Move to the N'th next line, extending the selection if the Shift key is held down."
  let n :: <integer> = frame-numeric-arg(frame);
  set-or-clear-mark(frame);
  next-or-previous-line(frame, n)
end command next-line-ext;

define command previous-line-ext (frame)
    "Move to the N'th previous line, extending the selection if the Shift key is held down."
  let n :: <integer> = frame-numeric-arg(frame);
  set-or-clear-mark(frame);
  next-or-previous-line(frame, -n)
end command previous-line-ext;

define method next-or-previous-line
    (frame :: <editor-state-mixin>, n :: <integer>, #key preferred-x = #f) => ()
  let window :: <basic-window> = frame-window(frame);
  let buffer :: <basic-buffer> = frame-buffer(frame);
  let mode = buffer-major-mode(buffer);
  let bp  = point();
  let nbp = move-over-lines(bp, n, fixup?: abs(n) > 1);
  if (~nbp)
    // Moved past the end of the buffer
    if (n < 0 | ~next-line-adds-newline?(editor-policy(frame-editor(frame))))
      command-error("Can't move any further");
    else
      // Moved one line past the end -- insert a new line
      let ebp = interval-end-bp(buffer);
      check-read-only(ebp);
      with-change-recording (buffer, <paste-change-record>, start-bp: ebp)
        move-point!(insert-moving!(ebp, '\n'))
      end;
      queue-redisplay(window, $display-text, centering: n)
    end
  else
    let line   = bp-line(nbp);
    let goal-x = preferred-x
                 | window-goal-x-position(window)
                 | index->position(bp-line(bp), mode, window, bp-index(bp));
    let index  = position->index(line, mode, window, goal-x);
    move-point!(line, index: index);
    queue-redisplay(window, $display-point, centering: n)
  end;
  frame-last-command-type(frame) := #"line-motion"
end method next-or-previous-line;


define command start-of-line (frame)
    "Move to the start of the current line."
  let window :: <basic-window> = frame-window(frame);
  let line = bp-line(point());
  move-point!(line, index: 0);
  queue-redisplay(window, $display-point, centering: -1);
  frame-last-command-type(frame) := #"motion"
end command start-of-line;

define command end-of-line (frame)
    "Move to the end of the current line."
  let window :: <basic-window> = frame-window(frame);
  let line = bp-line(point());
  move-point!(line, index: line-length(line));
  queue-redisplay(window, $display-point, centering: 1);
  frame-last-command-type(frame) := #"motion"
end command end-of-line;


// The Windows-like version of 'start-of-line'
define command start-of-line-ext (frame)
    "Move to the start of the current line, extending the selection if the Shift key is held down."
  let window :: <basic-window> = frame-window(frame);
  let bp   = point();
  let line = bp-line(bp);
  set-or-clear-mark(frame);
  if (bp-index(bp) ~= 0)
    move-point!(line, index: 0)
  else
    // If already at the beginning of the line, move over the whitespace
    let bp = forward-over!(line-start(line), #[' ', '\t']);
    move-point!(bp)
  end;
  queue-redisplay(window, $display-point, centering: -1);
  frame-last-command-type(frame) := #"motion"
end command start-of-line-ext;

define command end-of-line-ext (frame)
    "Move to the end of the current line, extending the selection if the Shift key is held down."
  let window :: <basic-window> = frame-window(frame);
  let line = bp-line(point());
  set-or-clear-mark(frame);
  move-point!(line, index: line-length(line));
  queue-redisplay(window, $display-point, centering: 1);
  frame-last-command-type(frame) := #"motion"
end command end-of-line-ext;


define command start-of-buffer (frame)
    "Move to the start of the buffer."
  let window :: <basic-window> = frame-window(frame);
  let buffer :: <basic-buffer> = frame-buffer(frame);
  push-point-pdl!(window, point());
  move-point!(interval-start-bp(buffer));
  queue-redisplay(window, $display-point, centering: -1);
  frame-last-command-type(frame) := #"motion"
end command start-of-buffer;

define command end-of-buffer (frame)
    "Move to the end of the buffer."
  let window :: <basic-window> = frame-window(frame);
  let buffer :: <basic-buffer> = frame-buffer(frame);
  push-point-pdl!(window, point());
  move-point!(interval-end-bp(buffer));
  queue-redisplay(window, $display-point, centering: 1);
  frame-last-command-type(frame) := #"motion"
end command end-of-buffer;


define command start-of-section (frame)
    "Move to the start of the section."
  let window :: <basic-window> = frame-window(frame);
  let bp = point();
  push-point-pdl!(window, bp);
  let line = section-start-line(line-section(bp-line(bp)));
  when (bp-line(bp) == line)
    // Already at the beginning of this section, move to the previous one
    let node = line-node(line);
    let prev = node & node-previous(node);
    when (prev)
      line := section-start-line(node-section(prev))
     end
  end;
  move-point!(line, index: 0);
  queue-redisplay(window, $display-point, centering: -1);
  frame-last-command-type(frame) := #"motion"
end command start-of-section;

define command end-of-section (frame)
    "Move to the end of the section."
  let window :: <basic-window> = frame-window(frame);
  let bp = point();
  push-point-pdl!(window, bp);
  let line = section-end-line(line-section(bp-line(bp)));
  when (bp-line(bp) == line)
    // Already at the end of this section, move to the next one
    let node = line-node(line);
    let next = node & node-next(node);
    when (next)
      line := section-end-line(node-section(next))
     end
  end;
  move-point!(line, index: 0);
  queue-redisplay(window, $display-point, centering: 1);
  frame-last-command-type(frame) := #"motion"
end command end-of-section;


/// Complex motion

define command down-list (frame)
    "Move down into the next nested list -- (), [], {}."
  let window :: <basic-window> = frame-window(frame);
  let n :: <integer> = frame-numeric-arg(frame);
  let bp   = point();
  let node = bp-node(bp) | bp-buffer(bp);
  move-point!(move-up-or-down-lists(bp, n, fixup?: abs(n) > 1, interval: node)
              | command-error("Can't move any further down in the nesting"));
  queue-redisplay(window, $display-point, centering: n);
  frame-last-command-type(frame) := #"motion"
end command down-list;

define command up-list (frame)
    "Move up out of this nested list -- (), [], {}."
  let window :: <basic-window> = frame-window(frame);
  let n :: <integer> = frame-numeric-arg(frame);
  let bp   = point();
  let node = bp-node(bp) | bp-buffer(bp);
  move-point!(move-up-or-down-lists(bp, -n, fixup?: abs(n) > 1, interval: node)
              | command-error("Can't move any further up in the nesting"));
  queue-redisplay(window, $display-point, centering: -n);
  frame-last-command-type(frame) := #"motion"
end command up-list;


define command down-expression (frame)
    "Move down into the next nested language expression."
  let window :: <basic-window> = frame-window(frame);
  let n :: <integer> = frame-numeric-arg(frame);
  let bp   = point();
  let node = bp-node(bp) | bp-buffer(bp);
  move-point!(move-up-or-down-expressions(bp, n, fixup?: abs(n) > 1, interval: node)
              | command-error("Can't move any further"));
  queue-redisplay(window, $display-point, centering: n);
  frame-last-command-type(frame) := #"motion"
end command down-expression;

define command up-expression (frame)
    "Move up out of this nested language expression."
  let window :: <basic-window> = frame-window(frame);
  let n :: <integer> = frame-numeric-arg(frame);
  let bp   = point();
  let node = bp-node(bp) | bp-buffer(bp);
  move-point!(move-up-or-down-expressions(bp, -n, fixup?: abs(n) > 1, interval: node)
              | command-error("Can't move any further"));
  queue-redisplay(window, $display-point, centering: -n);
  frame-last-command-type(frame) := #"motion"
end command up-expression;


/// Direct navigation

define command goto-character (frame)
    "Go to the N'th character in the buffer."
  goto-thing(frame, #"character");
end command goto-character;

define command goto-line (frame)
    "Go to the N'th line in the buffer."
  goto-thing(frame, #"line");
end command goto-line;

define method goto-thing
    (frame :: <editor-state-mixin>, what :: false-or(<goto-target-type>)) => ()
  let window :: <basic-window> = frame-window(frame);
  let buffer :: <basic-buffer> = frame-buffer(frame);
  let n :: false-or(<integer>) = #f;
  if (frame-numeric-arg-state(frame))
    // Use the numeric arg...
    n := frame-numeric-arg(frame)
  else
    // ...or pop up a dialog if no arg was set (usual on Windows)
    let (_n, _what) = goto-position-dialog(window, what | #"line");
    n    := _n;
    what := _what
  end;
  when (n & (n > 0))
    let bp
      = select (what)
          #"line"      => line-index->bp(buffer, n - 1);
          #"character" => char-index->bp(buffer, n - 1);
        end;
    when (bp)
      queue-redisplay(window, $display-point, centering: 0);
      unless (bp-line(bp) = bp-line(point()))
        push-point-pdl!(window, point())
      end;
      move-point!(bp)
    end
  end;
  frame-last-command-type(frame) := #"motion"
end method goto-thing;


/// Deletion

define command delete-character (frame)
    "Delete the next N characters, or the current selection."
  let n :: <integer> = frame-numeric-arg(frame);
  delete-or-rubout-char(frame, n)
end command delete-character;

define command rubout-character (frame)
    "Delete the previous N characters, or the current selection."
  let n :: <integer> = frame-numeric-arg(frame);
  delete-or-rubout-char(frame, -n)
end command rubout-character;

define method delete-or-rubout-char
    (frame :: <editor-state-mixin>, n :: <integer>) => ()
  let window :: <basic-window> = frame-window(frame);
  let buffer :: <basic-buffer> = frame-buffer(frame);
  if (typing-replaces-selection?(editor-policy(frame-editor(frame))) & mark())
    let bp1 = point();
    let bp2 = mark();
    let interval = make-interval(bp1, bp2);
    check-read-only(interval);
    clear-mark!();
    queue-region-redisplay(window, bp1, bp2);
    with-change-recording (buffer, <kill-change-record>, interval: interval)
      move-point!(kill!(interval,
                        merge?: frame-last-command-type(frame) == #"kill")
                  | command-error("Can't delete across hard sections"))
    end;
    frame-last-command-type(frame) := #"delete"
  else
    let bp1 = point();
    let bp2 = move-over-characters(bp1, n);
    let interval = make-interval(bp1, bp2);
    check-read-only(interval);
    clear-mark!();
    queue-region-redisplay(window, bp1, bp2);
    // Regions longer than a single character and diagram lines go onto
    // the kill ring, otherwise let undo take care of it
    let kill? = (diagram-line?(bp-line(bp1)) | abs(n) > 1);
    let class = if (kill?) <kill-change-record> else <delete-change-record> end;
    with-change-recording (buffer, class, interval: interval)
      if (kill?)
        move-point!(kill!(interval,
                          merge?:   frame-last-command-type(frame) == #"kill",
                          reverse?: n < 0)
                    | command-error("Can't delete across hard sections"));
        frame-last-command-type(frame) := #"kill"
      else
        move-point!(delete!(interval)
                    | command-error("Can't delete across hard sections"));
        frame-last-command-type(frame) := #"delete"
      end
    end
  end
end method delete-or-rubout-char;


define command delete-word (frame)
    "Delete the next N words."
  let n :: <integer> = frame-numeric-arg(frame);
  kill-region(frame, n, move-over-words)
end command delete-word;

define command rubout-word (frame)
    "Delete the previous N words."
  let n :: <integer> = frame-numeric-arg(frame);
  kill-region(frame, -n, move-over-words)
end command rubout-word;


define command delete-list (frame)
    "Delete the next N lists -- (), [], {}."
  let n :: <integer> = frame-numeric-arg(frame);
  kill-region(frame, n, move-over-lists)
end command delete-list;

define command rubout-list (frame)
    "Delete the previous N lists -- (), [], {}."
  let n :: <integer> = frame-numeric-arg(frame);
  kill-region(frame, -n, move-over-lists)
end command rubout-list;


define command delete-expression (frame)
    "Delete the next N language expressions."
  let n :: <integer> = frame-numeric-arg(frame);
  kill-region(frame, n, move-over-expressions)
end command delete-expression;

define command rubout-expression (frame)
    "Delete the previous N language expressions."
  let n :: <integer> = frame-numeric-arg(frame);
  kill-region(frame, -n, move-over-expressions)
end command rubout-expression;


define method kill-region
    (frame :: <editor-state-mixin>, n :: <integer>, function :: <function>) => ()
  let window :: <basic-window> = frame-window(frame);
  let buffer :: <basic-buffer> = frame-buffer(frame);
  let bp1 = point();
  let bp2 = function(bp1, n);
  let interval = make-interval(bp1, bp2);
  check-read-only(interval);
  clear-mark!();
  queue-region-redisplay(window, bp1, bp2, centering: n);
  with-change-recording (buffer, <kill-change-record>, interval: interval)
    move-point!(kill!(interval,
                      merge?:   frame-last-command-type(frame) == #"kill",
                      reverse?: n < 0)
                | command-error("Can't delete across hard sections"))
  end;
  frame-last-command-type(frame) := #"kill"
end method kill-region;


/// Cut and paste

define command cut-region (frame)
    "Cut the current selection and add to the clipboard and the kill ring."
  cut-or-delete-region(frame, clipboard?: #t)
end command cut-region;

define command delete-region (frame)
    "Delete the current selection and add it to the kill ring but not the clipboard."
  if (mark())
    cut-or-delete-region(frame, clipboard?: #f)
  else
    delete-character(frame)                //--- kludge for Delete accelerator on Windows
  end
end command delete-region;

define method cut-or-delete-region
    (frame :: <editor-state-mixin>, #key clipboard? = $unsupplied) => ()
  let window :: <basic-window> = frame-window(frame);
  let buffer :: <basic-buffer> = frame-buffer(frame);
  let bp1 = point();
  let bp2 = mark();
  if (bp2)
    let interval = make-interval(bp1, bp2);
    check-read-only(interval);
    clear-mark!();
    queue-region-redisplay(window, bp1, bp2);
    with-change-recording (buffer, <kill-change-record>, interval: interval)
      move-point!(kill!(interval,
                        merge?: frame-last-command-type(frame) == #"kill",
                        clipboard?: clipboard?)
                  | command-error("Can't delete across hard sections"))
    end;
    frame-last-command-type(frame) := #"kill"
  else
    command-error("There is no selected region")
  end
end method cut-or-delete-region;

define command copy-region (frame)
    "Copy the current selection to the clipboard and the kill ring."
  let window :: <basic-window> = frame-window(frame);
  let bp1 = point();
  let bp2 = mark();
  let policy = editor-policy(frame-editor(frame));
  when (~bp2 & unselected-copy-policy(policy) == #"copy-line")
    let nbp = move-over-lines(bp1, 1, fixup?: #f);
    bp1 := line-start(bp-line(bp1));
    bp2 := if (nbp) line-start(bp-line(nbp)) else line-end(bp-line(bp1)) end
  end;
  if (bp2)
    unless (typing-replaces-selection?(policy))                // i.e., when Emacs-like
      clear-mark!()
    end;
    queue-redisplay(window, $display-region);
    let interval = make-interval(bp1, bp2);
    add-to-clipboard(window, interval);
    let kill-ring = editor-kill-history(frame-editor(frame));
    history-push(kill-ring, copy-interval(interval));
    frame-last-command-type(frame) := #"kill"
  else
    command-error("There is no selected region")
  end
end command copy-region;

define command paste (frame)
    "Paste the most recent clipboard item at the current position."
  let window :: <basic-window> = frame-window(frame);
  let elt      = get-from-clipboard(window, <byte-string>);
  let temp?    = window-temporary-mark?(window);
  let replace? = mark() & typing-replaces-selection?(editor-policy(frame-editor(frame)));
  if (elt)
    when (temp? & temp? ~== #t)
      // If it's a temporary region indicated by a BP, move the
      // point to that BP.  See 'with-temporary-region' for details
      move-point!(temp?)
    end;
    insert-yanked-element(frame, elt, replace?: replace? & ~temp?)
  else
    command-error("There is nothing on the clipboard")
  end
end command paste;

define command yank (frame)
    "Paste the most recent clipboard or kill ring item at the current position.\n"
    "With a numeric argument N, insert the N'th most recently killed selection."
  let window :: <basic-window> = frame-window(frame);
  let state = frame-numeric-arg-state(frame);
  let n :: <integer> = frame-numeric-arg(frame);
  unless (n = 0)
    let kill-ring = editor-kill-history(frame-editor(frame));
    initialize-yank-state(kill-ring);
    let index = (state & state ~== #"universal") & n;
    let elt   = yank-from-kill-ring(kill-ring, window, index: index);
    if (elt)
      insert-yanked-element(frame, elt)
    else
      command-error("There is nothing on the kill ring")
    end
  end
end command yank;

define command yank-next (frame)
    "Paste the next kill ring item at the current position, rotating the kill ring.\n"
    "With a numeric argument N, insert the N'th most recently killed selection."
  if (frame-last-command-type(frame) == #"yank"
      | frame-last-command-type(frame) == #"yank-no-motion")
    let window :: <basic-window> = frame-window(frame);
    let state = frame-numeric-arg-state(frame);
    let n :: <integer> = frame-numeric-arg(frame);
    unless (n = 0)
      let kill-ring = editor-kill-history(frame-editor(frame));
      let index = (state & state ~== #"universal") & n;
      let elt   = yank-from-kill-ring(kill-ring, window, index: index);
      when (elt)
        insert-yanked-element(frame, elt, replace?: #t)
      end
    end
  else
    command-error("The last command was not a yank")
  end
end command yank-next;

define method insert-yanked-element
    (frame :: <editor-state-mixin>, elt, #key replace? = #f) => ()
  let window :: <basic-window> = frame-window(frame);
  let buffer :: <basic-buffer> = frame-buffer(frame);
  let bp1    = copy-bp(point());
  let bp2    = replace? & (mark() | window-last-mark(window));
  let nlines = 0;
  // Don't move the point on commands like c-U c-Y...
  let move?  = ~(frame-numeric-arg-state(frame) == #"universal"
                 | frame-last-command-type(frame) == #"yank-no-motion");
  clear-mark!();
  with-change-recording (buffer, <paste-change-record>, start-bp: bp1, end-bp: bp2)
    when (bp2)
      let interval = make-interval(bp1, bp2);
      check-read-only(interval);
      dec!(nlines, count-lines(interval, skip-test: #f) - 1);
      bp1 := delete!(interval)
    end;
    check-read-only(bp1);
    // We don't set the mark directly, because that will cause the yanked
    // stuff to get highlighted, which is both ugly and slows down redisplay
    inc!(nlines, count-lines(elt, skip-test: #f) - 1);
    let bp2 = insert!(bp1, elt);
    if (move?)
      window-last-mark(window) := copy-bp(bp1);
      move-point!(bp2)
    else
      window-last-mark(window) := copy-bp(bp2);
    end;
    // Try to use $display-blt if it will do us some good
    let line  = bp-line(bp1);
    let (dline, hint) = find-display-line(window, line);
    let index = dline & (hint - 1);
    case
      nlines <= 0 =>
        // If we're not adding any new line, there's no need to recenter
        queue-region-redisplay(window, bp1, bp2, centering: #f);
      index + nlines >= window-n-display-lines(window) =>
        // The end of the display is off the screen, so we need to recenter
        queue-region-redisplay(window, bp1, bp2, centering: 1);
      otherwise =>
        // All the new lines will be on-screen, so we can use bitblt
        queue-redisplay(window, $display-blt, line: line, index: nlines);
    end
  end;
  frame-last-command-type(frame) := (if (move?) #"yank" else #"yank-no-motion" end);
end method insert-yanked-element;


/// Line hacking

define command insert-newline (frame)
    "Insert a newline at the current position."
  do-insert-newline(frame);
  frame-last-command-type(frame) := #"insert"
end command insert-newline;

define command indent-newline (frame)
    "Insert a newline at the current position and indent the new line."
  do-insert-newline(frame);
  indent-line(frame);
  frame-last-command-type(frame) := #"insert"
end command indent-newline;

define method do-insert-newline
    (frame :: <editor-state-mixin>) => (bp :: <basic-bp>)
  let window :: <basic-window> = frame-window(frame);
  let buffer :: <basic-buffer> = frame-buffer(frame);
  let bp  = point();
  let bp2 = typing-replaces-selection?(editor-policy(frame-editor(frame))) & mark();
  check-read-only(bp);
  if (bp2)
    with-change-recording (buffer, <replace-change-record>,
                           start-bp: bp, end-bp: bp2, moving?: #t)
      let interval = make-interval(bp, bp2);
      check-read-only(interval);
      queue-region-redisplay(window, bp, bp2);
      bp := kill!(interval)
            | command-error("Can't delete across hard sections");
      clear-mark!();
      move-point!(insert-moving!(bp, '\n'))
    end
  else
    clear-mark!();
    let line = bp-line(bp);
    with-change-recording (buffer, <paste-change-record>, start-bp: bp)
      move-point!(insert-moving!(bp, '\n'))
    end;
    // Center the new line near the bottom of the window, avoiding bitblt
    // if it's a new final line in the buffer
    let last? = (bp-line(bp) == bp-line(interval-end-bp(buffer)));
    if (last?)
      queue-redisplay(window, $display-text, centering: 1)
    else
      queue-redisplay(window, $display-blt, line: line, index: 1, centering: 1)
    end
  end;
  bp
end method do-insert-newline;


define command open-line (frame)
    "Open up a new line at the current position."
  let window :: <basic-window> = frame-window(frame);
  let buffer :: <basic-buffer> = frame-buffer(frame);
  let bp   = copy-bp(point());
  let line = bp-line(bp);
  check-read-only(bp);
  clear-mark!();
  with-change-recording (buffer, <paste-change-record>, start-bp: bp)
    insert!(bp, '\n');
  end;
  queue-redisplay(window, $display-blt, line: line, index: 1);
  frame-last-command-type(frame) := #"insert"
end command open-line;

define command split-line (frame)
    "Split the line at the current position."
  let window :: <basic-window> = frame-window(frame);
  let buffer :: <basic-buffer> = frame-buffer(frame);
  let mode = buffer-major-mode(buffer);
  let bp   = copy-bp(point());
  let line = bp-line(bp);
  check-read-only(bp);
  clear-mark!();
  with-change-recording (buffer, <paste-change-record>, start-bp: bp)
    let space-width = string-size(window, " ");
    let indentation = index->position(line, mode, window, bp-index(bp)) - line-margin(line, mode, window);
    let n-spaces = floor/(indentation, space-width);
    let spaces = make(<byte-string>, size: n-spaces, fill: ' ');
    insert-moving!(bp, '\n');
    insert-moving!(bp, spaces)
  end;
  queue-redisplay(window, $display-blt, line: line, index: 1);
  frame-last-command-type(frame) := #"insert"
end command split-line;


define command kill-line (frame)
    "Kill the current line starting from the current position.\n"
    "With a numeric argument, kill that many lines."
  let window :: <basic-window> = frame-window(frame);
  let buffer :: <basic-buffer> = frame-buffer(frame);
  let bp1 = point();
  let bp2 = #f;
  let line  = bp-line(bp1);
  let index = bp-index(bp1);
  let reverse? = #f;
  clear-mark!();
  case
    frame-numeric-arg-state(frame) =>
      // Numeric arg means to kill that many lines
      let n :: <integer> = frame-numeric-arg(frame);
      unless (n = 0)
        bp2 := move-over-lines(bp1, n);
        reverse? := (n < 0)
      end;
    line-empty?(line, index: index) =>
      // If the line has nothing but whitespace past the current position,
      // merge the next line to the end of this one
      let next = line-next-in-buffer(line, buffer);
      if (next)
        bp2 := line-start(next)
      else
        command-error("Nothing to delete")
      end;
    otherwise =>
      // Otherwise just truncate this line from the current point
      bp2 := line-end(line);
  end;
  when (bp2)
    let interval = make-interval(bp1, bp2);
    check-read-only(interval);
    //--- This should somehow use $display-blt as its redisplay degree
    queue-region-redisplay(window, bp1, bp2);
    with-change-recording (buffer, <kill-change-record>, interval: interval)
      move-point!(kill!(interval,
                        merge?:   frame-last-command-type(frame) == #"kill",
                        reverse?: reverse?)
                  | command-error("Can't delete across hard sections"))
    end
  end;
  frame-last-command-type(frame) := #"kill"
end command kill-line;

define command join-lines (frame)
    "Join this line to the previous line."
  let window :: <basic-window> = frame-window(frame);
  let buffer :: <basic-buffer> = frame-buffer(frame);
  let bp = point();
  let this-bp = if (line-empty?(bp-line(bp))) bp
                else forward-over!(line-start(bp-line(bp)), #[' ', '\t']) end;
  let prev-bp = move-over-lines(this-bp, -1);
  let this-line = bp-line(this-bp);
  let prev-line = bp-line(prev-bp);
  unless (this-line == prev-line)
    let bp1 = line-end(prev-line);
    let bp2 = this-bp;
    let interval = make-interval(bp1, bp2);
    check-read-only(interval);
    queue-redisplay(window, $display-text);
    with-change-recording (buffer, <replace-change-record>, interval: interval)
      let bp = delete!(interval);
      if (  word-syntax(bp-character(bp)) == $word-alphabetic
          & word-syntax(bp-character-before(bp)) == $word-alphabetic)
        move-point!(insert-moving!(bp, ' '))
      else
        move-point!(bp)
      end
    end
  end;
  frame-last-command-type(frame) := #"delete"
end command join-lines;


/// Tranposition commands

define command transpose-characters (frame)
    "Transpose the two characters around the current position."
  let window :: <basic-window> = frame-window(frame);
  let buffer :: <basic-buffer> = frame-buffer(frame);
  let this = copy-bp(point());
  when (end-of-line?(this))
    this := decrement-bp!(this, fixup?: #f)
  end;
  let n :: <integer> = if (start-of-line?(this)) -2 else -1 end;
  let prev = this & move-over-characters(this, n, fixup?: #f);
  let next = this & move-over-characters(this, 1, fixup?: #f);
  when (prev & next)
    let ch1 = bp-character(this);
    let ch2 = bp-character(prev);
    unless (ch1 = '\n' | ch2 = '\n')
      check-read-only(this);
      check-read-only(prev);
      with-change-recording (buffer, <replace-change-record>,
                             start-bp: prev, end-bp: next)
        bp-character(this) := ch2;
        bp-character(prev) := ch1;
        note-line-changed(bp-line(this));
        note-line-changed(bp-line(prev))
      end;
      queue-region-redisplay(window, prev, this);
      move-point!(increment-bp!(this))
    end
  end;
  frame-last-command-type(frame) := #"insert"
end command transpose-characters;


define command transpose-words (frame)
    "Transpose the two words around the current position."
  transpose-regions(frame, move-over-words)
end command transpose-words;

define command transpose-lists (frame)
    "Transpose the two lists around the current position."
  transpose-regions(frame, move-over-lists)
end command transpose-lists;

define command transpose-expressions (frame)
    "Transpose the two language expressions around the current position."
  transpose-regions(frame, move-over-expressions)
end command transpose-expressions;

define command transpose-lines (frame)
    "Transpose the current line with the previous one."
  let buffer :: <basic-buffer> = frame-buffer(frame);
  let line = bp-line(point());
  let prev = line-previous-in-buffer(line, buffer);
  if (prev)
    do-transpose-regions
      (frame, line-start(prev), line-end(prev), line-start(line), line-end(line))
  else
    command-error("There is no previous line")
  end
end command transpose-lines;

define method transpose-regions
    (frame :: <editor-state-mixin>, function :: <function>) => ()
  let bp     = point();
  let end2   = function(bp, 1, fixup?: #f);
  let start2 = end2 & function(end2, -1, fixup?: #f);
  let start1 = start2 & function(start2, -1, fixup?: #f);
  let end1   = start1 & function(start1, 1, fixup?: #f);
  when (end1 & start1 ~= start2)
    do-transpose-regions(frame, start1, end1, start2, end2)
  end
end method transpose-regions;

define method do-transpose-regions
    (frame :: <editor-state-mixin>,
     start1 :: <basic-bp>, end1 :: <basic-bp>,
     start2 :: <basic-bp>, end2 :: <basic-bp>) => ()
  let window :: <basic-window> = frame-window(frame);
  let buffer :: <basic-buffer> = frame-buffer(frame);
  let interval1 = make-interval(start1, end1, in-order?: #t);
  let interval2 = make-interval(end1, start2, in-order?: #t);
  let interval3 = make-interval(start2, end2, in-order?: #t);
  check-read-only(interval1);
  check-read-only(interval2);
  let s1 = as(<byte-string>, interval1);
  let s2 = as(<byte-string>, interval2);
  let s3 = as(<byte-string>, interval3);
  queue-region-redisplay(window, start1, end2);
  with-change-recording (buffer, <replace-change-record>,
                         start-bp: start1, end-bp: end2)
    if (s2 = "\n")
      // Be a bit more efficient when twiddling around a newline
      delete!(interval1);
      delete!(interval3);
      insert!(start1, s3);
      insert-moving!(start2, s1);
      move-point!(start2)
    else
      delete!(make-interval(start1, end2, in-order?: #t));
      insert-moving!(start1, s3);
      insert-moving!(start1, s2);
      insert-moving!(start1, s1);
      move-point!(start1)
    end
  end;
  frame-last-command-type(frame) := #"insert"
end method do-transpose-regions;


/// Case-changing commands

define command upcase-word (frame)
    "Make the next N words be all uppercase."
  let n :: <integer> = frame-numeric-arg(frame);
  change-word-case(frame, n, as-uppercase)
end command upcase-word;

define command downcase-word (frame)
    "Make the next N words be all lowercase."
  let n :: <integer> = frame-numeric-arg(frame);
  change-word-case(frame, n, as-lowercase)
end command downcase-word;

define method change-word-case
    (frame :: <editor-state-mixin>, n :: <integer>, function :: <function>) => ()
  let bp1 = copy-bp(point());
  let bp2 = move-over-words(bp1, n);
  change-region-case(frame, bp1, bp2, function, n < 0)
end method change-word-case;


define command upcase-region (frame)
    "Uppercase the current selection."
  let bp1 = copy-bp(point());
  let bp2 = mark();
  if (bp2)
    change-region-case(frame, bp1, bp2, as-uppercase, bp-less?(bp2, bp1))
  else
    upcase-word(frame)                // upcase the next word if there's no region
  end
end command upcase-region;

define command downcase-region (frame)
    "Lowercase the current selection."
  let bp1 = copy-bp(point());
  let bp2 = mark();
  if (bp2)
    change-region-case(frame, bp1, bp2, as-lowercase, bp-less?(bp2, bp1))
  else
    downcase-word(frame)        // downcase the next word if there's no region
  end
end command downcase-region;

define method change-region-case
    (frame :: <editor-state-mixin>, bp1 :: <basic-bp>, bp2 :: <basic-bp>,
     function :: <function>, reverse? :: <boolean>) => ()
  let window :: <basic-window> = frame-window(frame);
  let buffer :: <basic-buffer> = frame-buffer(frame);
  let interval = make-interval(bp1, bp2);
  check-read-only(interval);
  local method change-case (line :: <line>, si :: <integer>, ei :: <integer>, last?)
          ignore(last?);
          let line = note-line-changed(line);
          let contents = line-contents(line);
          for (i :: <integer> from si below ei)
            let old = contents[i];
            let new = function(old);
            contents[i] := new;
            // Start redisplay at the first changed character
            unless (old == new)
              move-bp!(bp1, line, i)
            end
          end
        end method;
  clear-mark!();
  queue-region-redisplay(window, bp1, bp2, centering: #f);
  with-change-recording (buffer, <replace-change-record>, interval: interval)
    do-lines(change-case, interval, skip-test: diagram-line?)
  end;
  move-point!(interval-end-bp(interval));
  frame-last-command-type(frame) := #"insert"
end method change-region-case;


define command capitalize-word (frame)
    "Capitalize the next N words."
  let window :: <basic-window> = frame-window(frame);
  let buffer :: <basic-buffer> = frame-buffer(frame);
  let n :: <integer> = frame-numeric-arg(frame);
  let bp = copy-bp(point());
  when (n < 0)
    bp := move-over-words(bp, n, fixup?: #t);
    n  := abs(n)
  end;
  when (n > 0)
    for (i :: <integer> from 0 below n,
         while: bp)
      let sbp = bp;
      let ebp = move-over-words(sbp, 1, fixup?: #f);
      when (ebp)
        let interval = make-interval(sbp, ebp);
        check-read-only(interval);
        clear-mark!();
        queue-region-redisplay(window, sbp, ebp, centering: 1);
        with-change-recording (buffer, <replace-change-record>, interval: interval)
          do-lines(method (line :: <line>, si, ei, last?)
                     ignore(si, ei, last?);
                     note-line-changed(line)
                   end method, interval, skip-test: diagram-line?);
          let state = #f;
          until (sbp = ebp)
            let ch :: <byte-character> = bp-character(sbp);
            if (state)
              if (alpha-char?(ch))
                bp-character(sbp) := as-lowercase(ch)
              else
                state := #f
              end
            else
              when (alpha-char?(ch))
                bp-character(sbp) := as-uppercase(ch);
                state := #t
              end
            end;
            increment-bp!(sbp)
          end
        end;
        move-point!(ebp)
      end;
      bp := ebp
    end
  end;
end command capitalize-word;


/// Font-changing commands

define command change-region-font (frame)
    "Change the font of the current selection."
  let window :: <basic-window> = frame-window(frame);
  let n :: <integer> = frame-numeric-arg(frame);
  let (bp1, bp2)
    = if (mark())
        values(point(), mark())
      else
        let bp1 = copy-bp(point());
        let bp2 = move-over-words(bp1, n);
        values(bp1, bp2)
      end;
  display-message(window, "Change font: ");
  let char = read-character(window);
  select (char)
    'b', 'B' =>
      display-message(window, "Change font: weight to bold");
      change-font(frame, bp1, bp2, weight: #"bold");
    'n', 'N' =>
      display-message(window, "Change font: weight to normal");
      change-font(frame, bp1, bp2, weight: #"normal");
    'i', 'I' =>
      display-message(window, "Change font: slant to italic");
      change-font(frame, bp1, bp2, slant: #"italic");
    'r', 'R' =>
      display-message(window, "Change font: slant to roman");
      change-font(frame, bp1, bp2, slant: #"roman");
    '+' =>
      display-message(window, "Change font: larger size");
      change-font(frame, bp1, bp2, size: #"larger");
    '-' =>
      display-message(window, "Change font: smaller size");
      change-font(frame, bp1, bp2, size: #"smaller");
    'f', 'F' =>
      display-message(window, "Change font: face: ");
      let char = read-character(window);
      let face = select (char)
                   's', 'S' => #"serif";        // 's' for Swiss or Serif
                   'n', 'N' => #"sans-serif";        // 'n' for saNs-serif
                   'h', 'H' => #"sans-serif";        // 'h' for Helvetica
                   'f', 'F' => #"fixed";        // 'f' for Fixed
                   'c', 'C' => #"fixed";        // 'c' for Courier
                   '?' =>
                     display-message(window,
                                     "'s' for serif, 'n' for sans-serif, 'f' for fixed.");
                     #f;
                   otherwise =>
                     error(make(<command-error>, window: window));
                 end;
      when (face)
        display-message(window, "Change font: face to %s",
                        if (face == #"serif") "serif"
                        elseif (face == #"sans-serif") "sans-serif"
                        else "fix" end);
        change-font(frame, bp1, bp2, face: face)
      end;
    '?' =>
      display-message(window,
                      "'b' or 'n' for weight, 'i' or 'r' for slant, "
                      "'+' or '-' for size, 'f' for face.");
    otherwise =>
      error(make(<command-error>, window: window));
  end
end command change-region-font;

// We define this as a standalone command for use by tool bars
define command change-region-weight (frame)
    "Change the weight of the current selection to be bold (or back to normal)."
  let (bp1, bp2)
    = if (mark()) values(point(), mark()) else atom-under-bp(point()) end;
  let weight
    = if (frame-numeric-arg-state(frame)) #"normal" else #"bold" end;
  change-font(frame, bp1, bp2, weight: weight)
end command change-region-weight;

// We define this as a standalone command for use by tool bars
define command change-region-slant (frame)
    "Change the slant of the current selection to be italic (or back to roman)."
  let (bp1, bp2)
    = if (mark()) values(point(), mark()) else atom-under-bp(point()) end;
  let slant
    = if (frame-numeric-arg-state(frame)) #"roman" else #"italic" end;
  change-font(frame, bp1, bp2, slant: slant)
end command change-region-slant;

define method change-font
    (frame :: <editor-state-mixin>, bp1 :: <basic-bp>, bp2 :: <basic-bp>,
     #key face = #f, weight = #f, slant = #f, size = #f) => ()
  let window :: <basic-window> = frame-window(frame);
  let buffer :: <basic-buffer> = frame-buffer(frame);
  let reverse? = bp-less?(bp2, bp1);
  let interval = make-interval(bp1, bp2, in-order?: ~reverse?);
  check-read-only(interval);
  local method set-font (line :: <line>, si :: <integer>, ei :: <integer>, last?)
          ignore(last?);
          let line = note-line-changed(line);
          //---*** Do it
          //---*** Requires "fattening" and "thinning" lines as needed,
          //---*** but how do we maintain line identity in the current design?
        end method;
  clear-mark!();
  queue-region-redisplay(window, bp1, bp2, centering: #f);
  with-change-recording (buffer, <replace-change-record>, interval: interval)
    do-lines(set-font, interval, skip-test: diagram-line?)
  end;
  move-point!(interval-end-bp(interval));
  frame-last-command-type(frame) := #"insert"
end method change-font;


/// Searching and replacing

define command find-string (frame)
    "Display the string search dialog."
  let window :: <basic-window> = frame-window(frame);
  let editor :: <basic-editor> = frame-editor(frame);
  // Display the modeless string search dialog, which updates the
  // frame state as the user messes around with it
  string-search-dialog(window,
                       string:   editor-search-string(editor),
                       reverse?: editor-reverse-search?(editor),
                       case-sensitive?: editor-case-sensitive-search?(editor),
                       whole-word?:     editor-whole-word-search?(editor))
end command find-string;

define command find-next-string (frame)
    "Find the next occurrence of the search string."
  let editor :: <basic-editor> = frame-editor(frame);
  if (editor-search-string(editor) & ~empty?(editor-search-string(editor)))
    find-next-or-previous-string(frame, reverse?: #f)
  else
    editor-reverse-search?(editor) := #f;
    find-string(frame)
  end
end command find-next-string;

define command find-previous-string (frame)
    "Find the previous occurrence of the search string."
  let editor :: <basic-editor> = frame-editor(frame);
  if (editor-search-string(editor) & ~empty?(editor-search-string(editor)))
    find-next-or-previous-string(frame, reverse?: #t)
  else
    editor-reverse-search?(editor) := #t;
    find-string(frame)
  end
end command find-previous-string;

define method find-next-or-previous-string
    (frame :: <editor-state-mixin>,
     #key reverse? = $unsupplied) => ()
  let window :: <basic-window> = frame-window(frame);
  let buffer :: <basic-buffer> = frame-buffer(frame);
  let editor :: <basic-editor> = frame-editor(frame);
  let string   = editor-search-string(editor);
  let reverse? = if (supplied?(reverse?)) reverse? else editor-reverse-search?(editor) end;
  let policy       = editor-policy(editor);
  let wrap-search? = wrap-searches?(policy);
  let whole-word?  = editor-whole-word-search?(editor);
  let syntax-table = whole-word? & list-syntax-table(buffer-major-mode(buffer));
  let case-sensitive? = editor-case-sensitive-search?(editor);
  when (string)
    clear-mark!(window: window, redisplay?: #t);
    let test = if (case-sensitive?) \= else char-equal? end;
    unless (editor-skip-table(editor) & editor-reoccurrence-table(editor))
      let (skip-table, reoccurrence-table)
        = compute-boyer-tables(string,
                               skip-table: editor-skip-table(editor),
                               reoccurrence-table: editor-reoccurrence-table(editor),
                               test: test);
      editor-skip-table(editor) := skip-table;
      editor-reoccurrence-table(editor) := reoccurrence-table
    end;
    let start-bp = point();
    let state :: <boolean> = #t;
    display-message(window, "Searching for: %s", string);
    while (state)
      let bp = search(point(), string,
                      test: test, reverse?: reverse?,
                      syntax-table: syntax-table,
                      skip-table:   editor-skip-table(editor),
                      reoccurrence-table: editor-reoccurrence-table(editor));
      if (bp)
        frame-search-string-found?(frame) := buffer;
        let length = size(string);
        let (pbp, mbp)
          = if (reverse?) values(bp, move-over-characters(bp, length))
            else values(move-over-characters(bp, length), bp) end;
        move-point!(pbp, window: window);
        when (mbp)
          move-mark!(mbp, window: window)
        end;
        queue-redisplay(window, $display-point, centering: 0);
        state := #f                // force the search to end
      else
        frame-search-string-found?(frame) := #f;
        if (wrap-search?)
          display-message(window, "Wrapping search for: %s", string);
          if (reverse?)
            move-point!(interval-end-bp(buffer), window: window);
          else
            move-point!(interval-start-bp(buffer), window: window);
          end;
          state := wrap-search?;
          wrap-search? := #f        // give up next time around
        else
          move-point!(start-bp, window: window);
          command-error("Search failed for: %s", string)
        end
      end;
      frame-last-command-type(frame) := #"motion"
    end
  end
end method find-next-or-previous-string;


define command replace-string (frame)
    "Display the string replace dialog."
  let window :: <basic-window> = frame-window(frame);
  let editor :: <basic-editor> = frame-editor(frame);
  string-replace-dialog(window,
                        string:   editor-search-string(editor),
                        replace:  editor-replace-string(editor),
                        reverse?: editor-reverse-search?(editor),
                        case-sensitive?: editor-case-sensitive-search?(editor),
                        whole-word?:     editor-whole-word-search?(editor))
end command replace-string;

define command query-replace-string (frame)
    "Display the string replace dialog."
  let window :: <basic-window> = frame-window(frame);
  let editor :: <basic-editor> = frame-editor(frame);
  string-replace-dialog(window,
                        string:   editor-search-string(editor),
                        replace:  editor-replace-string(editor),
                        reverse?: editor-reverse-search?(editor),
                        case-sensitive?: editor-case-sensitive-search?(editor),
                        whole-word?:     editor-whole-word-search?(editor))
end command query-replace-string;

define method replace-next-or-previous-string
    (frame :: <editor-state-mixin>,
     #key reverse? = $unsupplied, replace-all? :: <boolean> = #f) => ()
  local method compare-strings
            (char-test :: <function>, s1 :: <byte-string>, s2 :: <byte-string>)
         => (equal? :: <boolean>)
          // Automatically not equal if they're not the same size.
          let equal? = (size(s1) = size(s2));
          for (c1 in s1, c2 in s2, until: ~equal?)
            equal? := char-test(c1, c2)
          end;
          equal?
        end method;
  let window :: <basic-window> = frame-window(frame);
  let buffer :: <basic-buffer> = frame-buffer(frame);
  let editor :: <basic-editor> = frame-editor(frame);
  let string   = editor-search-string(editor);
  let replace  = editor-replace-string(editor);
  let reverse? = if (supplied?(reverse?)) reverse? else editor-reverse-search?(editor) end;
  let whole-word?  = editor-whole-word-search?(editor);
  let syntax-table = whole-word? & list-syntax-table(buffer-major-mode(buffer));
  let case-sensitive? = editor-case-sensitive-search?(editor);
  let n-replaced :: <integer> = 0;
  when (string)
    let test = if (case-sensitive?) \= else char-equal? end;
    unless (editor-skip-table(editor) & editor-reoccurrence-table(editor))
      let (skip-table, reoccurrence-table)
        = compute-boyer-tables(string,
                               skip-table: editor-skip-table(editor),
                               reoccurrence-table: editor-reoccurrence-table(editor),
                               test: test);
      editor-skip-table(editor) := skip-table;
      editor-reoccurrence-table(editor) := reoccurrence-table
    end;
    let bp = point();
    let found? = frame-search-string-found?(frame);
    frame-search-string-found?(frame) := #f;        // string is now unfound...
    while (bp)
      let ebp = window-mark(window);
      let interval = ebp & make-interval(bp, ebp);
      // If the search string has already been found and there's a selected
      // region matching it, use that; otherwise, go searching
      unless (found? == buffer & interval
              & compare-strings(test, as(<string>, interval), string))
        // String was found but is not selected now, so we'll have to search
        bp := search(bp, string,
                     test: test, reverse?: reverse?,
                     syntax-table: syntax-table,
                     skip-table:   editor-skip-table(editor),
                     reoccurrence-table: editor-reoccurrence-table(editor));
        if (bp)
          ebp := move-over-characters(bp, size(string));
          interval := make-interval(bp, ebp)
        else
          interval := #f
        end
      end;
      if (interval)
        check-read-only(interval);
        queue-region-redisplay(window, bp, ebp, centering: #f);
        inc!(n-replaced);
        if (replace)
          with-change-recording (buffer, <replace-change-record>,
                                 interval: interval, moving?: #t)
            let dbp = delete!(interval);
            let nbp = insert!(interval-start-bp(interval), replace);
            bp := if (reverse?) dbp else nbp end
          end
        else
          with-change-recording (buffer, <kill-change-record>, interval: interval)
            let dbp = delete!(interval);
            bp := dbp
          end
        end;
        move-point!(bp)
      else
        if (replace-all?)
          display-message(window, "Replaced %d items", n-replaced)
        else
          //--- What about search wrapping?
          command-error("Search failed for: %s", string)
        end
      end;
      // Stop after one replacement if we're not replacing everything
      unless (replace-all?)
        bp := #f
      end;
    end
  end
end method replace-next-or-previous-string;


/// Show matching/non-matching lines, sort lines, etc...

define command hack-matching-lines (frame)
    "Create a new buffer showing all the lines that match (or don't match) a given string."
  let window :: <basic-window> = frame-window(frame);
  let (string, operation) = hack-matching-lines-dialog(window);
  when (string)
    select (operation)
      #"show-matching" =>
        show-matching-lines(frame, string: string);
      #"show-non-matching" =>
        show-non-matching-lines(frame, string: string);
    end
  end
end command hack-matching-lines;

define function do-hack-matching-lines
    (frame :: <editor-state-mixin>, title :: <byte-string>,
     string :: <byte-string>, filter :: <function>) => ()
  let window :: <basic-window> = frame-window(frame);
  let buffer :: <basic-buffer> = frame-buffer(frame);
  let editor = frame-editor(frame);
  let name   = format-to-string(title, string);
  let result-buffer
    = find-buffer(editor, name)
      | make-empty-buffer(<non-file-buffer>,
                          name: name,
                          major-mode: find-mode(<text-mode>),
                          editor: editor);
  let node    = buffer-start-node(result-buffer);
  let section = node-section(node);
  let first-line :: false-or(<basic-line>) = #f;
  let last-line  :: false-or(<basic-line>) = #f;
  let interval
    = if (mark()) make-interval(point(), mark())
      else make-interval(point(), interval-end-bp(buffer)) end;
  clear-mark!();
  //--- Provide some way to get back to the original line...
  local method hack-line (line :: <basic-line>, si, ei, last?)
          ignore(last?);
          when (filter(string, line, si, ei))
            let line = copy-line(line, start: si, end: ei);
            line-section(line) := section;
            unless (first-line)
              first-line := line
            end;
            line-previous(line) := last-line;
            when (last-line)
              line-next(last-line) := line
            end;
            last-line := line
          end
        end method;
  do-lines(hack-line, interval);
  section-start-line(section) := first-line;
  section-end-line(section)   := last-line;
  move-bp!(interval-start-bp(node), first-line, 0);
  move-bp!(interval-end-bp(node), last-line, line-length(last-line));
  select-buffer-in-appropriate-window(window, result-buffer)
end function do-hack-matching-lines;

define command show-matching-lines
    (frame, #key string :: false-or(<byte-string>) = #f)
    "Create a new buffer showing all the lines that match a given string."
  let window :: <basic-window> = frame-window(frame);
  let string = string | choose-string-dialog(window,
                                             title: "Show Matching Lines");
  when (string)
    local method filter-line
              (string :: <byte-string>,
               line :: <basic-line>, si :: <integer>, ei :: <integer>)
           => (keep? :: <boolean>)
            string-search(string, line-contents(line), start: si, end: ei) ~== #f
          end method;
    do-hack-matching-lines(frame, "Lines matching \"%s\"", string, filter-line)
  end;
  frame-last-command-type(frame) := #"display"
end command show-matching-lines;

define command show-non-matching-lines
    (frame, #key string :: false-or(<byte-string>) = #f)
    "Create a new buffer showing all the lines that don't match a given string."
  let window :: <basic-window> = frame-window(frame);
  let string = string | choose-string-dialog(window,
                                             title: "Show Non-matching Lines");
  when (string)
    local method filter-line
              (string :: <byte-string>,
               line :: <basic-line>, si :: <integer>, ei :: <integer>)
           => (keep? :: <boolean>)
            string-search(string, line-contents(line), start: si, end: ei) == #f
          end method;
    do-hack-matching-lines(frame, "Lines not matching \"%s\"", string, filter-line)
  end;
  frame-last-command-type(frame) := #"display"
end command show-non-matching-lines;


/// Point and mark

define command set-mark (frame)
    "Set mark at the current position, or jump to a saved mark.\n"
    "With no numeric argument, push the old mark onto the mark ring and set the new mark.\n"
    "With c-U argument, pop the saved mark and set the point to it.\n"
    "With c-U c-U argument, pop the saved mark and discard it.\n"
  let window :: <basic-window> = frame-window(frame);
  let n :: <integer> = frame-numeric-arg(frame);
  let state  = frame-numeric-arg-state(frame);
  let degree = $display-point;
  case
    state == #f =>                        // c-Space
      push-point-pdl!(window, point());
      move-mark!(point());
    state == #"universal" & n = 4 =>        // c-U c-Space
      clear-mark!();
      let bp = pop-point-pdl!(window);
      if (bp)
        display-message(window, "Saved cursor position restored");
        move-point!(bp)
      else
        command-error("The point stack is empty")
      end;
    state == #"universal" & n = 16 =>        // c-U c-U c-Space
      clear-mark!();
      let bp = pop-point-pdl!(window);
      if (bp)
        display-message(window, "Saved cursor position discarded");
        degree := $display-region;
      else
        command-error("The point stack is empty")
      end;
    otherwise =>
      #f;
  end;
  queue-redisplay(window, degree);
  frame-last-command-type(frame) := #"motion"
end command set-mark;

define command exchange-point-pdl (frame)
    "Swap the point with the top of the point stack."
  let window :: <basic-window> = frame-window(frame);
  let bp = pop-point-pdl!(window);
  when (bp)
    push-point-pdl!(window, point(), display-message?: #f);
    move-point!(bp);
    queue-redisplay(window, $display-point)
  end;
  frame-last-command-type(frame) := #"motion"
end command exchange-point-pdl;

define command swap-point-and-mark (frame)
    "Swap the point and mark."
  let window :: <basic-window> = frame-window(frame);
  if (mark())
    swap-point-and-mark!(window);
    queue-redisplay(window, $display-point, centering: 0)
  else
    // If there's no current mark, but there is a "last mark",
    // swap the point and the "last mark"
    let bp1 = copy-bp(point());
    let bp2 = window-last-mark(window);
    when (bp2 & bp1 ~= bp2)
      move-point!(bp2);
      move-mark!(bp1);
      queue-redisplay(window, $display-point, centering: 0)
    end
  end;
  frame-last-command-type(frame) := #"motion"
end command swap-point-and-mark;


define command mark-buffer (frame)
    "Select the entire buffer."
  let window :: <basic-window> = frame-window(frame);
  let buffer :: <basic-buffer> = frame-buffer(frame);
  move-point!(interval-start-bp(buffer));
  move-mark!(interval-end-bp(buffer));
  queue-redisplay(window, $display-point, centering: -1);
  frame-last-command-type(frame) := #"mark"
end command mark-buffer;

define command mark-to-beginning (frame)
    "Select from the current position to the beginning of the buffer."
  let window :: <basic-window> = frame-window(frame);
  let buffer :: <basic-buffer> = frame-buffer(frame);
  move-mark!(interval-start-bp(buffer));
  queue-redisplay(window, $display-point);
  frame-last-command-type(frame) := #"mark"
end command mark-to-beginning;

define command mark-to-end (frame)
    "Select from the current position to the end of the buffer."
  let window :: <basic-window> = frame-window(frame);
  let buffer :: <basic-buffer> = frame-buffer(frame);
  move-mark!(interval-end-bp(buffer));
  queue-redisplay(window, $display-point);
  frame-last-command-type(frame) := #"mark"
end command mark-to-end;


define command mark-next-word (frame)
    "Select the next N words."
  let window :: <basic-window> = frame-window(frame);
  let n :: <integer> = frame-numeric-arg(frame);
  let sbp = point();
  let ebp = move-over-words(sbp, n);
  move-mark!(ebp);
  queue-redisplay(window, $display-point);
  frame-last-command-type(frame) := #"mark"
end command mark-next-word;

define command mark-word (frame)
    "Select the whole word around the point."
  let window :: <basic-window> = frame-window(frame);
  let bp   = point();
  let node = bp-node(bp) | bp-buffer(bp);
  let sbp = if (word-syntax(bp-character-before(bp)) == $word-delimiter)
              forward-over(bp, #[' ', '\t', '\f'], interval: node)
            else
              move-over-words(bp, -1, interval: node)
            end;
  let ebp = move-over-words(sbp, 1, interval: node);
  move-mark!(sbp);
  move-point!(ebp);
  queue-redisplay(window, $display-point);
  frame-last-command-type(frame) := #"mark"
end command mark-word;


define command mark-next-atom (frame)
    "Select the next N atoms."
  let window :: <basic-window> = frame-window(frame);
  let n :: <integer> = frame-numeric-arg(frame);
  let sbp = point();
  let ebp = move-over-atoms(sbp, n);
  move-mark!(ebp);
  queue-redisplay(window, $display-point);
  frame-last-command-type(frame) := #"mark"
end command mark-next-atom;

define command mark-atom (frame)
    "Select the whole atom around the point."
  let window :: <basic-window> = frame-window(frame);
  select-atom-under-bp(window, point());
  frame-last-command-type(frame) := #"mark"
end command mark-atom;


define command mark-next-expression (frame)
    "Select the next N language expressions."
  let window :: <basic-window> = frame-window(frame);
  let n :: <integer> = frame-numeric-arg(frame);
  let sbp = point();
  let ebp = move-over-expressions(sbp, n);
  move-mark!(ebp);
  queue-redisplay(window, $display-point);
  frame-last-command-type(frame) := #"mark"
end command mark-next-expression;


/// Registers

define constant $register-point-table :: <object-table> = make(<table>);

define command save-point-in-register (frame)
    "Store the current point in the given register."
  let window :: <basic-window> = frame-window(frame);
  let register = get-register-name(window, "Save point in register: ");
  let bp = point();
  let bp = make(<bp>,
                line: bp-line(bp), index: bp-index(bp),
                buffer: bp-buffer(bp),
                moving?: #t);
  gethash($register-point-table, register) := bp;
  frame-last-command-type(frame) := #"motion"
end command save-point-in-register;

define command restore-point-from-register (frame)
    "Restore the current point from the given register."
  let window :: <basic-window> = frame-window(frame);
  let buffer :: <basic-buffer> = frame-buffer(frame);
  let register = get-register-name(window, "Restore point from register: ");
  let bp = gethash($register-point-table, register);
  if (bp & member?(bp-buffer(bp), editor-buffers(frame-editor(frame))))
    unless (bp-buffer(bp) == buffer)
      select-buffer-in-appropriate-window(window, bp-buffer(bp),
                                          line: bp-line(bp), index: bp-index(bp));
      queue-redisplay(window, $display-all)
    end;
    move-point!(bp);
    queue-redisplay(window, $display-point);
    frame-last-command-type(frame) := #"motion"
  else
    command-error("The register '%c' does not point to a known location", register)
  end
end command restore-point-from-register;


define constant $register-string-table :: <object-table> = make(<table>);

define command save-string-in-register (frame)
    "Copy the current region into the given register.\n"
    "With a numeric argument, appends to the register."
  let window :: <basic-window> = frame-window(frame);
  let register = get-register-name(window, "Save region in register: ");
  let bp1 = point();
  let bp2 = mark();
  let old-string = gethash($register-string-table, register);
  let new-string = if (bp2) as(<string>, make-interval(bp1, bp2)) else "" end;
  gethash($register-string-table, register)
    := if (frame-numeric-arg-state(frame) & old-string)
         concatenate-as(<string>, old-string, new-string)
       else
         new-string
       end;
  frame-last-command-type(frame) := #"kill"
end command save-string-in-register;

define command insert-string-from-register (frame)
    "Insert the contents of the given register at the current point."
  let window :: <basic-window> = frame-window(frame);
  let register = get-register-name(window, "Insert string from register: ");
  let string = gethash($register-string-table, register);
  if (string)
    insert-yanked-element(frame, string, replace?: #f);
    frame-last-command-type(frame) := #"insert"
  else
    command-error("The register '%c' does not contain anything", register)
  end
end command insert-string-from-register;

//---*** This won't interact properly with keyboard macro recording!
define method get-register-name
    (window :: <basic-window>, prompt :: <string>) => (register)
  display-message(window, prompt);
  let register = read-character(window);
  if (graphic-char?(register))
    display-message(window, concatenate(prompt, "%c"), register);
    register
  else
    command-error("The register must be named by a printable character")
  end
end method get-register-name;


/// Undo and redo

define command undo-command (frame)
    "Undo the previously executed command.\n"
    "With a numeric argument, undoes that many previous commands."
  let window :: <basic-window> = frame-window(frame);
  let buffer :: <basic-buffer> = window-buffer(window);
  let section = line-section(bp-line(window-point(window)));
  let (history, home-buffer)
    = buffer & buffer-undo-history(buffer, section: section);
  when (history)
    let (n-undo, n-redo) = undo-history-state(history);
    ignore(n-redo);
    if (n-undo > 0)
      let n :: <integer> = min(frame-numeric-arg(frame), n-undo);
      for (i :: <integer> from 0 below n)
        undo!(window, home-buffer, history)
      end
    else
      command-error("Nothing to undo")
    end
  end;
  frame-last-command-type(frame) := #"undo"
end command undo-command;

define command undo-all-commands (frame)
    "Undo all of the previously executed commands."
  let window :: <basic-window> = frame-window(frame);
  let buffer :: <basic-buffer> = window-buffer(window);
  let section = line-section(bp-line(window-point(window)));
  let (history, home-buffer)
    = buffer & buffer-undo-history(buffer, section: section);
  when (history)
    undo-all!(window, home-buffer, history)
  end;
  frame-last-command-type(frame) := #"undo"
end command undo-all-commands;

define command redo-command (frame)
    "Redo the previously undone command.\n"
    "With a numeric argument, redoes that many previously undone commands."
  let window :: <basic-window> = frame-window(frame);
  let buffer :: <basic-buffer> = window-buffer(window);
  let section = line-section(bp-line(window-point(window)));
  let (history, home-buffer)
    = buffer & buffer-undo-history(buffer, section: section);
  when (history)
    let (n-undo, n-redo) = undo-history-state(history);
    ignore(n-undo);
    if (n-redo > 0)
      let n :: <integer> = min(frame-numeric-arg(frame), n-redo);
      for (i :: <integer> from 0 below n)
        redo!(window, home-buffer, history)
      end
    else
      command-error("Nothing to redo")
    end
  end;
  frame-last-command-type(frame) := #"redo"
end command redo-command;

define command redo-all-commands (frame)
    "Redo all of the previously undone commands."
  let window :: <basic-window> = frame-window(frame);
  let buffer :: <basic-buffer> = window-buffer(window);
  let section = line-section(bp-line(window-point(window)));
  let (history, home-buffer)
    = buffer & buffer-undo-history(buffer, section: section);
  when (history)
    redo-all!(window, home-buffer, history)
  end;
  frame-last-command-type(frame) := #"redo"
end command redo-all-commands;


/// Indentation

define command indent-line (frame)
    "Indent the current line."
  let window :: <basic-window> = frame-window(frame);
  let buffer :: <basic-buffer> = frame-buffer(frame);
  let bp   = point();
  let line = bp-line(bp);
  check-read-only(bp);
  queue-redisplay(window, $display-line,
                  line: line, index: 0, centering: #f);
  let bp1 = line-start(line);
  let bp2 = forward-over(bp1, #[' ', '\t']);
  let at-start? = (forward-over(bp, #[' ', '\t']) = bp2);
  with-change-recording (buffer, <replace-change-record>,
                         start-bp: bp1, end-bp: bp2, moving?: #t)
    let (ebp, nchars)
      = do-indent-line(buffer-major-mode(buffer), line);
    case
      ~ebp      =>
        command-error("Can't indent this line");
      at-start? =>
        move-point!(ebp);        // don't move the point if it was not at the start
      otherwise =>
        move-point!(line, index: bp-index(bp) + nchars);
    end
  end;
  frame-last-command-type(frame) := #"insert"
end command indent-line;

define command indent-expression (frame)
    "Indent the entire next language expression."
  let window :: <basic-window> = frame-window(frame);
  let buffer :: <basic-buffer> = frame-buffer(frame);
  let bp1 = point();
  let bp2 = move-over-expressions(bp1, 1);
  let interval = make-interval(bp1, bp2);
  check-read-only(interval);
  clear-mark!();
  queue-region-redisplay(window, bp1, bp2, centering: #f);
  with-change-recording (buffer, <indentation-change-record>, interval: interval)
    do-indent-region(buffer-major-mode(buffer), interval)
  end;
  frame-last-command-type(frame) := #"insert"
end command indent-expression;

define command indent-region (frame)
    "Indent all the lines in the current selection."
  let window :: <basic-window> = frame-window(frame);
  let buffer :: <basic-buffer> = frame-buffer(frame);
  let bp1 = point();
  let bp2 = mark();
  if (bp2)
    let interval = make-interval(bp1, bp2);
    check-read-only(interval);
    clear-mark!();
    queue-region-redisplay(window, bp1, bp2, centering: #f);
    with-change-recording (buffer, <indentation-change-record>, interval: interval)
      do-indent-region(buffer-major-mode(buffer), interval)
    end
  else
    indent-line(frame)                // no region, just indent the line
  end;
  frame-last-command-type(frame) := #"insert"
end command indent-region;


define command indent-rigidly (frame)
    "Indent all the lines in the current selection by the given amount.\n"
    "With a negative argument, \"outdents\" the lines in the selection."
  let window :: <basic-window> = frame-window(frame);
  let buffer :: <basic-buffer> = frame-buffer(frame);
  let n :: <integer> = frame-numeric-arg(frame);
  unless (n = 0)
    let bp1 = point();
    let bp2 = mark();
    if (bp2)
      let interval = make-interval(bp1, bp2);
      check-read-only(interval);
      clear-mark!();
      queue-region-redisplay(window, bp1, bp2, centering: #f);
      if (n > 0)
        let spaces = make(<byte-string>, size: n, fill: ' ');
        local method indent (line :: <basic-line>, si, ei, last?)
                ignore(last?);
                // Indent the line only if the start index is zero and
                // the end index is not zero
                when (si = 0 & ei ~= 0)
                  insert-into-line(line, 0, spaces)
                end
              end method indent;
        with-change-recording (buffer, <indentation-change-record>, interval: interval)
          do-lines(indent, interval, skip-test: diagram-line?)
        end
      else
        let n :: <integer> = -n;
        let interval = make-interval(bp1, bp2);
         local method unindent (line :: <basic-line>, si, ei, last?)
                ignore(last?);
                // Indent the line only if the start index is zero and
                // the end index is not zero
                when (si = 0 & ei ~= 0)
                ignore(si, ei);
                  let contents = line-contents(line);
                  for (i :: <integer> from 0 below min(line-length(line), n),
                       while: whitespace-char?(contents[i]))
                  finally
                    when (i > 0)
                      move-bp!(interval-start-bp(interval), line, 0);
                      move-bp!(interval-end-bp(interval),   line, i);
                      delete!(interval);
                    end
                  end
                end
              end method unindent;
        with-change-recording (buffer, <indentation-change-record>, interval: interval)
          do-lines(unindent, interval, skip-test: diagram-line?)
        end
      end
    else
      command-error("There is no selected region")
    end
  end;
  frame-last-command-type(frame) := #"insert"
end command indent-rigidly;

define command unindent-rigidly (frame)
    "Unindent all the lines in the current selection by the given amount."
  frame-numeric-arg(frame) := -frame-numeric-arg(frame);
  indent-rigidly(frame)
end command unindent-rigidly;


define variable *comment-start-column* :: <integer> = 40;

define command insert-comment (frame)
    "Insert a comment in the current line."
  let window :: <basic-window> = frame-window(frame);
  let buffer :: <basic-buffer> = frame-buffer(frame);
  let mode   = buffer-major-mode(buffer);
  let line   = bp-line(point());
  let column = if (line-empty?(line)) #f else *comment-start-column* end;
  let bp     = if (column) line-end(line) else line-start(line) end;
  with-change-recording (buffer, <paste-change-record>, start-bp: bp)
    clear-mark!();
    let bp = do-insert-comment(mode, line, column: column);
    when (bp)
      move-point!(bp);
      queue-redisplay(window, $display-line, line: line, index: 0)
    end
  end;
  frame-last-command-type(frame) := #"insert"
end command insert-comment;

define command comment-region (frame)
    "Comment out the current selection.\n"
    "With a numeric argument, \"uncomments\" the selection."
  let window :: <basic-window> = frame-window(frame);
  let buffer :: <basic-buffer> = frame-buffer(frame);
  let mode   = buffer-major-mode(buffer);
  let bp1 = point();
  let bp2 = mark();
  if (bp2)
    let interval = make-interval(bp1, bp2);
    check-read-only(interval);
    clear-mark!();
    queue-region-redisplay(window, bp1, bp2, centering: #f);
    with-change-recording (buffer, <replace-change-record>, interval: interval)
      do-comment-region(mode, interval, comment?: ~frame-numeric-arg-state(frame))
    end
  else
    command-error("There is no selected region")
  end;
  frame-last-command-type(frame) := #"insert"
end command comment-region;


define command delete-whitespace (frame)
    "Delete all whitespace around the point."
  let window :: <basic-window> = frame-window(frame);
  let buffer :: <basic-buffer> = frame-buffer(frame);
  let bp = point();
  let bp1 = backward-over(bp, #[' ', '\t']);
  let bp2 = forward-over(bp,  #[' ', '\t']);
  unless (bp1 = bp2)
    let interval = make-interval(bp1, bp2, in-order?: #t);
    check-read-only(interval);
    clear-mark!();
    queue-region-redisplay(window, bp1, bp2, centering: #f);
    with-change-recording (buffer, <kill-change-record>, interval: interval)
      move-point!(delete!(interval)
                  | command-error("Can't delete across hard sections"))
    end
  end;
  frame-last-command-type(frame) := #"delete"
end command delete-whitespace;


/// File and buffer commands

define command find-file (frame)
    "Create a buffer with this file in it.\n"
    "With a numeric argument, the buffer is put in \"fundamental\" mode."
  let window :: <basic-window> = frame-window(frame);
  let buffer = frame-buffer(frame);        // might get called before there's a buffer
  let home
    = if (composite-buffer?(buffer)) section-home-buffer(line-section(bp-line(point())))
      else buffer end;
  let default  = home & buffer-default-pathname(home);
  let type     = home & source-file-type(buffer-major-mode(home));
  let pathname = open-file-dialog(window, default: default, default-type: type);
  when (pathname)
    with-busy-cursor (window)
      let editor = frame-editor(frame);
      let buffer = find-buffer-from-pathname(editor, pathname);
      if (buffer)
        revert-buffer-if-necessary(buffer, window: window)
      else
        let mode = frame-numeric-arg-state(frame) & find-mode(<fundamental-mode>);
        buffer  := do-find-file(editor, pathname, direction: #"input", major-mode: mode)
      end;
      if (buffer)
        select-buffer-in-appropriate-window(window, buffer)
      else
        command-error("Couldn't find file %s", as(<string>, pathname))
      end
    end
  end;
  frame-last-command-type(frame) := #"file"
end command find-file;

define command new-file (frame)
    "Create an empty file buffer.\n"
    "With a numeric argument, the buffer is put in \"fundamental\" mode."
  let window :: <basic-window> = frame-window(frame);
  let buffer = frame-buffer(frame);        // might get called before there's a buffer
  let home
    = if (composite-buffer?(buffer)) section-home-buffer(line-section(bp-line(point())))
      else buffer end;
  let editor = frame-editor(frame);
  if (new-file-buffer?(editor-policy(editor)))
    let default  = home & buffer-default-pathname(home);
    let type     = home & source-file-type(buffer-major-mode(home));
    let pathname = new-file-dialog(window, default: default, default-type: type);
    when (pathname)
      with-busy-cursor (window)
        let mode   = frame-numeric-arg-state(frame) & find-mode(<fundamental-mode>);
        let buffer = find-buffer-from-pathname(editor, pathname)
                     | do-find-file(editor, pathname, direction: #"output", major-mode: mode);
        if (buffer)
          when (~mode & interval-start-bp(buffer) = interval-end-bp(buffer))
            // If the buffer is empty, at least enter the proper major mode
            let mode = find-mode-from-pathname(pathname);
            enter-mode(buffer, mode)
          end;
          select-buffer-in-appropriate-window(window, buffer)
        else
          command-error("Couldn't open file %s", as(<string>, pathname))
        end
      end
    end
  else
    let buffer = make-empty-buffer(<non-file-buffer>, editor: editor);
    select-buffer-in-appropriate-window(window, buffer)
  end;
  frame-last-command-type(frame) := #"file"
end command new-file;

define method do-find-file
    (editor :: <basic-editor>, pathname :: <pathname>,
     #key direction, major-mode)
 => (buffer :: false-or(<basic-buffer>))
  let container :: <source-container>
    = find-source-container(editor, source-container-class(pathname), pathname);
  let buffer :: false-or(<file-buffer>)                // so we can set it to #f below...
    = make-empty-buffer(<file-buffer>,
                        name:       pathname->buffer-name(pathname),
                        major-mode: major-mode | find-mode(<text-mode>),
                        container:  container,
                        editor:     editor);
  block ()
    // Always try to revert the buffer, even for output files
    revert-buffer(buffer, major-mode: major-mode)
  exception (<file-does-not-exist-error>)
    when (direction == #"input")
      remove!(editor-buffers(editor), buffer);
      buffer := #f
    end
  end;
  buffer
end method do-find-file;


define command insert-file (frame)
    "Insert the contents of a file into the current buffer."
  let window :: <basic-window> = frame-window(frame);
  let buffer :: <basic-buffer> = frame-buffer(frame);
  let home
    = if (composite-buffer?(buffer)) section-home-buffer(line-section(bp-line(point())))
      else buffer end;
  let default  = home & buffer-default-pathname(home);
  let type     = home & source-file-type(buffer-major-mode(home));
  let pathname = open-file-dialog(window, default: default, default-type: type);
  when (pathname)
    with-busy-cursor (window)
      // Read the contents of the file into a section
      let section = make(<section>,
                         container: #f,
                         start-line: #f, end-line: #f);
      let stream  = make(<file-stream>,
                         locator: pathname, direction: #"input");
      block ()
        read-section-contents-from-stream(section, stream)
      cleanup
        when (stream & stream-open?(stream))
          close(stream)
        end
      end;
      // Splice all the lines into the current buffer
      let bp = point();
      let interval = make-interval(line-start(section-start-line(section)),
                                   line-end(section-end-line(section)),
                                   in-order?: #t);
      with-change-recording (buffer, <paste-change-record>, start-bp: bp)
        clear-mark!();
        insert!(bp, interval)
      end;
      when (sectionize-buffer(buffer))
        queue-redisplay(window, $display-all)
      end
    end
  end;
  frame-last-command-type(frame) := #"file"
end command insert-file;


define command save-file (frame)
    "Save this buffer into the file it came from."
  let window :: <basic-window> = frame-window(frame);
  let buffer :: <basic-buffer> = frame-buffer(frame);
  if (saves-like-file-buffer?(buffer))
    if (buffer-modified?(buffer))
      with-busy-cursor (window)
        let (pathname, condition) = save-buffer(buffer, frame: frame);
        ignore(condition);
        if (pathname)
          display-message(window, "Saved to %s", as(<string>, pathname));
          note-buffer-changed-everywhere(buffer, #f);
          frame-last-command-type(frame) := #"file";
          when (resectionize-changed-sections(buffer))
            queue-redisplay(window, $display-all)        // might want to redraw sections...
          end
        else
          command-error("Couldn't save file %s",
                        as(<string>, buffer-default-pathname(buffer)));
        end
      end
    else
      display-message(window, "No changes need to be saved for %s",
                      as(<string>, buffer-default-pathname(buffer)))
    end
  else
    save-file-as(frame)
  end
end command save-file;

define command save-file-as (frame)
    "Save this buffer into a new file."
  let window :: <basic-window> = frame-window(frame);
  let buffer :: <basic-buffer> = frame-buffer(frame);
  do-save-file-as(frame, buffer);
  when (resectionize-changed-sections(buffer))
    queue-redisplay(window, $display-all)        // might want to redraw sections...
  end
end command save-file-as;

// This is split out so that frames can do "Save As" on buffers other
// than their own frame's buffer, for use in 'save-all-files'
define method do-save-file-as
    (frame :: <editor-state-mixin>, buffer :: <basic-buffer>)
 => (pathname :: false-or(<pathname>))
  let window :: <basic-window> = frame-window(frame);
  let home
    = if (composite-buffer?(buffer)) section-home-buffer(line-section(bp-line(point())))
      else buffer end;
  let default  = buffer-default-pathname(home);
  let type     = source-file-type(buffer-major-mode(home));
  let pathname = new-file-dialog(window, default: default, default-type: type);
  let result   = #f;
  when (pathname)
    with-busy-cursor (window)
      result := save-buffer-as(source-container-class(pathname), buffer, pathname,
                               frame: frame)
    end;
    if (result)
      when (~file-buffer?(buffer) & ~special-purpose-buffer?(buffer))
        // If we saved out a simple non-file buffer, "upgrade" it
        // to be a file buffer by creating a new (saved) file buffer
        // and killing the old buffer
        let new-buffer
          = as-file-buffer(<file-buffer>, buffer, result, frame-editor(frame));
        // Kill the old buffer gently and select the new one
        let editor = frame-editor(frame);
        remove!(editor-buffers(editor), buffer);
        for (window :: <basic-window> in editor-windows(editor))
          let buffers = window-selected-buffers(window);
          let entry
            = find-value(buffers, method (s) selection-buffer(s) == buffer end);
          when (entry)
            remove!(buffers, entry)
          end;
          when (window-buffer(window) == buffer)
            select-buffer(window, new-buffer)
          end
        end;
        queue-redisplay(window, $display-all);
        buffer := new-buffer
      end;
      note-buffer-changed-everywhere(buffer, #f);
      display-buffer-name-everywhere(buffer);
      display-message(window, "Saved to %s", as(<string>, result))
    else
      command-error("Couldn't save file %s", as(<string>, pathname))
    end
  end;
  frame-last-command-type(frame) := #"file";
  result
end method do-save-file-as;

define command save-all-files
  (frame, #key reason :: false-or(<string>), buffers :: false-or(<sequence>))
    "Save all buffers, even if they're not modified or not file-buffers."
  let window :: <basic-window> = frame-window(frame);
  let buffer :: <basic-buffer> = frame-buffer(frame);
  //--- It's not standard on Windows to prompt during Save All, but
  //--- until we are smarter about only saving new or modified buffers,
  //--- that's what we do to avoid saving unmodified buffers
  let (buffers, no-buffers?)
    = save-buffers-dialog(window, reason: reason, buffers: buffers);
  if (no-buffers?)
    display-message(window, "No documents need to be saved")
  else
    select (buffers)
      #f        => #f;
      #"cancel" => #f;
      otherwise =>
        do-save-all-files(frame, buffers, curry(display-message, window));
    end
  end;
  //--- This should 'display-buffer-name' for all for all editor windows
  //--- Fix D-environment-editor-backends-deuce!deuce-backend.dylan, too
  display-buffer-name(window, buffer);
  frame-last-command-type(frame) := #"file"
end command save-all-files;

define method do-save-all-files
    (frame :: <editor-state-mixin>, buffers :: <sequence>,
     display-message-function :: <function>) => ()
  // We dynamic-bind *editor-frame* for 'save-buffer', in case we're being
  // called from a thread where it's not bound (e.g., when DW is saving all
  // files as the last project window is closing).  We don't need to bind
  // *buffer*, since 'save-buffer' does that itself.
  dynamic-bind (*editor-frame* = frame)
    for (buffer :: <basic-buffer> in buffers)
      try-to-save-buffer(frame, buffer, display-message-function)
    end
  end
end method do-save-all-files;

define method try-to-save-buffer
    (frame :: <editor-state-mixin>, buffer :: <basic-buffer>,
     display-message-function :: <function>)
 => (pathname :: false-or(<pathname>))
  let window :: <basic-window> = frame-window(frame);
  let name = as(<string>, buffer-pathname(buffer) | buffer-name(buffer));
  let pathname
    = block ()
        if (file-buffer?(buffer))
          with-busy-cursor (window)
            let pathname = save-buffer(buffer, frame: frame);
            when (pathname)
              note-buffer-changed-everywhere(buffer, #f)
            end;
            pathname
          end
        else
          do-save-file-as(frame, buffer)
        end;
      exception(<command-error>)
        command-error("Couldn't save file %s", as(<string>, name));
        #f
      end;
  when (pathname)
    display-message-function("Saved %s", as(<string>, name))
  end;
  pathname
end method try-to-save-buffer;


// A bit of a misnomer -- it actually reverts the contents of the _buffer_
define command revert-file (frame)
    "Revert the contents of this buffer to its initial state."
  let window :: <basic-window> = frame-window(frame);
  let buffer :: <basic-buffer> = frame-buffer(frame);
  let container = buffer-source-container(buffer);
  let pathname  = container & container-pathname(container);
  if (file-buffer?(buffer) & pathname & ~file-exists?(pathname))
    // If the file is gone, don't revert
    warning-dialog(window, "%s no longer exists on disk; revert cancelled.",
                   as(<string>, pathname))
  else
    when (~buffer-modified?(buffer)
          | yes-or-no-dialog(window, "The document is modified; really revert it?"))
      let line = bp->line-index(point());
      with-busy-cursor (window)
        when (revert-buffer(buffer))
          restore-previous-position(buffer, window, line);
          queue-redisplay(window, $display-all)
        end
      end
    end
  end;
  frame-last-command-type(frame) := #"file"
end command revert-file;

// Try to move to where we were before the buffer was reverted
define method restore-previous-position
    (buffer :: <basic-buffer>, window :: <basic-window>, line :: false-or(<integer>)) => ()
  let (tbp :: <basic-bp>, centering)
    = if (line)
        let bp = line-index->bp(buffer, line);
        if (bp) values(bp, #"center")
        else values(interval-start-bp(buffer), #"top") end
      else
        values(interval-start-bp(buffer), #"top")
      end;
  let bp = make(<bp>, line: bp-line(tbp), index: bp-index(tbp), buffer: buffer);
  window-point(window) := as(<permanent-bp>, bp);
  window-mark(window)  := #f;
  recenter-window(window, bp-line(bp), centering);
  window-goal-x-position(window) := #f;
  window-total-lines(window) := #f;
  queue-redisplay(window, $display-all);
  note-buffer-changed-everywhere(buffer, #f)
end method restore-previous-position;

// Another misnomer -- it's really just the interface to 'kill-buffer'
define command close-file (frame)
    "Close the buffer, offering to save its underlying file if it is modified."
  let window :: <basic-window> = frame-window(frame);
  let buffer :: <basic-buffer> = frame-buffer(frame);
  // Only confirm when the command came from the keyboard and the
  // user has got the confirmation policy turned on
  let buffers
    = if (confirm-kill-buffer?(editor-policy(frame-editor(frame)))
          & frame-command-character(frame))        // kludge-o-rama
        choose-buffers-dialog(window,
                              title: "Documents to Close",
                              ok-label: "&Close", all-label: "Close &All",
                              buffer: buffer)
      else
        vector(buffer)
      end;
  when (buffers)
    let killed? = #f;
    block (break)
      for (b in buffers)
        unless (b == buffer)                // kill the current buffer last
          let result = maybe-save-buffer(window, b);
          select (result)
            #f =>
              // Note that this might exit in the one-frame-per-buffer policy...
              kill-buffer(b, frame: frame);
              killed? := #t;
            #t        => #f;
            #"cancel" => break();
          end
        end
      end;
      when (member?(buffer, buffers))
        let result = maybe-save-buffer(window, buffer);
        select (result)
          #f =>
            kill-buffer(buffer, frame: frame);
            killed? := #t;
          #t        => #f;
          #"cancel" => break();
        end
      end
    end block;
    when (killed?)
      queue-redisplay(window, $display-all);
      display-buffer-name(window, window-buffer(window))
    end
  end;
  frame-last-command-type(frame) := #"file"
end command close-file;

define command print-file (frame)
    "Print the contents of the buffer."
  let window :: <basic-window> = frame-window(frame);
  let buffer :: <basic-buffer> = frame-buffer(frame);
  unless (maybe-save-buffer(window, buffer))
    //---*** Print the file
    frame-last-command-type(frame) := #"file"
  end;
end command print-file;

// Returns #f if the "Save file" succeeded, #t if the save operation failed,
// or #"cancel" if the "Save file" query was cancelled by the user
define method maybe-save-buffer
    (window :: <basic-window>, buffer :: <basic-buffer>)
 => (failed? :: type-union(<boolean>, singleton(#"cancel")))
  // Obviously if the buffer's not modified, we don't need save it.
  // Less obviously, if it's a special-purpose buffer, the modification
  // state is irrelevant -- we never offer to save it
  if (~buffer-modified?(buffer)
      | special-purpose-buffer?(buffer))
    #f                                // succeeded, after a fashion
  else
    let result = yes-no-or-cancel-dialog(window, "Do you want to save changes to %s?",
                                         buffer-name(buffer));
    select (result)
      #t        =>                // "Yes"
        let pathname
          = try-to-save-buffer(window-frame(window), buffer, curry(display-message, window));
        ~pathname;                // pathname => succeeded, no pathname => failed
      #f        => #f;                // "No"     => succeeded, after a fashion
      otherwise => #"cancel";        // "Cancel" => failed
    end
  end
end method maybe-save-buffer;


// One more misnomer -- it sectionizes the contents of the _buffer_
define command sectionize-file (frame)
    "Sectionize the contents of this buffer."
  let window :: <basic-window> = frame-window(frame);
  let buffer :: <basic-buffer> = frame-buffer(frame);
  when (sectionize-buffer(buffer))
    queue-redisplay(window, $display-all)
  end;
  frame-last-command-type(frame) := #"file"
end command sectionize-file;


define command mark-unmodified (frame)
    "Mark the current buffer as being unmodified."
  let window :: <basic-window> = frame-window(frame);
  let buffer :: <basic-buffer> = frame-buffer(frame);
  buffer-modified?(buffer) := #f;
  display-message(window, "Buffer marked unmodified");
  frame-last-command-type(frame) := #"file"
end command mark-unmodified;

define command toggle-read-only (frame)
    "Toggle the read-only status of a region or the entire buffer."
  let window :: <basic-window> = frame-window(frame);
  let buffer :: <basic-buffer> = frame-buffer(frame);
  if (mark())
    let interval = make-interval(point(), mark());
    let read-only? = interval-read-only?(interval);
    interval-read-only?(interval) := ~read-only?;
    display-message(window,
                    if (read-only?) "Region now writable" else "Region now read-only" end)
  else
    let read-only? = buffer-read-only?(buffer);
    buffer-read-only?(buffer) := ~read-only?;
    display-message(window,
                    if (read-only?) "Buffer now writable" else "Buffer now read-only" end)
  end;
  frame-last-command-type(frame) := #"file"
end command toggle-read-only;


define command choose-buffer (frame)
    "Select a buffer to be shown in the current window.\n"
    "With a numeric argument, creates a new non-file buffer."
  if (frame-numeric-arg-state(frame))
    new-buffer(frame)
  else
    let window :: <basic-window> = frame-window(frame);
    let buffer :: false-or(<basic-buffer>)
      = choose-buffer-dialog(window,
                             title: "Select Document",
                             buffer: previously-selected-buffer(window, 1));
    when (buffer)
      select-buffer-in-appropriate-window(window, buffer)
    end;
    frame-last-command-type(frame) := #"motion";
    // Do the redisplay right here so that we can tell it not to move
    // the point.  Otherwise, Deuce will always recenter around the new
    // point because we haven't yet computed the dlines for the newly
    // selected buffer.  And that would break "poor man's source compare",
    // which I would find very depressing...
    redisplay-window(window, move-point?: #f, move-viewport?: #t)
  end
end command choose-buffer;

define command switch-buffers (frame)
    "Switch to the N'th buffer in the set of recently selected buffers."
  let window :: <basic-window> = frame-window(frame);
  // N gives the number of buffers through which to rotate
  let n :: <integer> = if (frame-numeric-arg-state(frame)) frame-numeric-arg(frame) else 2 end;
  case
    n = 0 =>
      let buffers = map(selection-buffer, window-selected-buffers(window));
      let buffer :: false-or(<basic-buffer>)
        = choose-buffer-dialog(window,
                               title: "Select Document",
                               buffers: buffers,
                               buffer:  previously-selected-buffer(window, 1));
      when (buffer)
        select-buffer-in-appropriate-window(window, buffer)
      end;
    n > 1 =>
      let buffer = previously-selected-buffer(window, n - 1);
      if (buffer)
        when (buffer ~= window-buffer(window))
          select-buffer-in-appropriate-window(window, buffer)
        end
      else
        command-error("This window hasn't shown that many documents")
      end;
    otherwise =>
      #f;
  end;
  frame-last-command-type(frame) := #"motion";
  // See comments in 'choose-buffer' above...
  redisplay-window(window, move-point?: #f, move-viewport?: #t)
end command switch-buffers;

define method previously-selected-buffer
    (window :: <basic-window>, n :: <integer>) => (buffer :: false-or(<basic-buffer>))
  let buffers = window-selected-buffers(window);
  n < size(buffers)
  & selection-buffer(buffers[n])
end method previously-selected-buffer;

define command new-buffer (frame)
    "Create a new non-file buffer to be shown in the current window."
  let window :: <basic-window> = frame-window(frame);
  let name = new-buffer-dialog(window);
  when (name)
    let editor = frame-editor(frame);
    let buffer = make-empty-buffer(<non-file-buffer>,
                                   name: ~empty?(name) & name,
                                   major-mode: find-mode(<text-mode>),
                                   editor: editor);
    select-buffer-in-appropriate-window(window, buffer)
  end;
  frame-last-command-type(frame) := #"motion"
end command new-buffer;


/// Configuration

define command choose-configuration (frame)
    "Set up various configuration parameters"
  let window :: <basic-window> = frame-window(frame);
  let editor = frame-editor(frame);
  let old-policy = editor-policy(editor);
  let new-policy = configuration-dialog(window);
  when (new-policy)
    editor-policy(editor) := new-policy;
    when (command-set-policy(new-policy) ~== command-set-policy(old-policy))
      install-command-set(editor, command-set-policy(new-policy))
    end;
    for (window :: <basic-window> in editor-windows(editor))
      window-note-policy-changed(window, new-policy, old-policy);
      redisplay-window(window);
    end
  end
end command choose-configuration;


/// Language (major mode) based commands

define command start-of-definition (frame)
    "Move to the beginning of the current language definition."
  let window :: <basic-window> = frame-window(frame);
  let bp = point();
  push-point-pdl!(window, bp);
  let line = section-defining-line(line-section(bp-line(bp)));
  when (bp-line(bp) == line)
    // Already at the beginning of this definition, move to the previous one
    let node = line-node(line);
    let prev = node & node-previous(node);
    when (prev)
      line := section-defining-line(node-section(prev))
     end
  end;
  move-point!(line, index: 0);
  queue-redisplay(window, $display-point, centering: -1);
  frame-last-command-type(frame) := #"motion"
end command start-of-definition;

define command end-of-definition (frame)
    "Move to the end of the current language definition."
  let window :: <basic-window> = frame-window(frame);
  let bp = point();
  push-point-pdl!(window, bp);
  let line = section-end-line(line-section(bp-line(bp)));
  when (bp-line(bp) == line)
    // Already at the end of this definition, move to the next one
    let node = line-node(line);
    let next = node & node-next(node);
    when (next)
      line := section-end-line(node-section(next))
     end
  end;
  move-point!(line, index: 0);
  queue-redisplay(window, $display-point, centering: 1);
  frame-last-command-type(frame) := #"motion"
end command end-of-definition;


define command edit-definition (frame)
    "Edit the named definition."
  let window :: <basic-window> = frame-window(frame);
  let buffer :: <basic-buffer> = frame-buffer(frame);
  let interval = selected-language-object();
  let name
    = unless (mark())
        let name = edit-definition-dialog(window, as(<string>, interval));
        name | error(make(<command-error>, window: window))
      end;
  unless (do-edit-definition(buffer-major-mode(buffer), interval, window, name: name))
    command-error("Couldn't find the definition for %s", as(<string>, interval))
  end;
  frame-last-command-type(frame) := #"motion"
end command edit-definition;


define command complete-name (frame)
    "Perform completion of the name at the current point."
  do-completion(frame, do-complete-name);
  frame-last-command-type(frame) := #"complete"
end command complete-name;

define command dynamic-complete-name (frame)
    "Expand the word at the current point \"dynamically\"."
  let state = reset-dynamic-completion-state(frame);
  do-completion(frame, do-complete-dynamically, completion-state: state);
  frame-last-command-type(frame) := #"dynamic-complete"
end command dynamic-complete-name;

define method do-completion
    (frame :: <editor-state-mixin>,
     completer :: <function>, #rest completer-args) => ()
  let window :: <basic-window> = frame-window(frame);
  let buffer :: <basic-buffer> = frame-buffer(frame);
  let (sbp, ebp) = atom-under-bp(point());
  let interval = make-interval(sbp, ebp, in-order?: #t);
  check-read-only(interval);
  let (completion, ambiguous?)
    = apply(completer, buffer-major-mode(buffer), interval, window,
            menu?: frame-numeric-arg-state(frame) ~== #f, completer-args);
  case
    ~completion =>
      command-error("No completion for \"%s\"", as(<string>, interval));
    completion == #t =>
      #f;
    string-equal?(completion, as(<string>, interval)) =>
      move-point!(ebp);
    otherwise =>
      queue-redisplay(window, $display-line,
                      line: bp-line(sbp), index: bp-index(sbp), centering: #f);
      with-change-recording (buffer, <replace-change-record>,
                             interval: interval, moving?: #t)
        delete!(interval);
        let ebp = insert-moving!(sbp, completion);
        move-point!(ebp)
      end;
  end;
  when (completion & ambiguous?)
    display-message(window, "The completion for \"%s\" was ambiguous",
                    as(<string>, interval))
  end
end method do-completion;


define command show-value (frame)
    "Show the value of the selected language object."
  let window :: <basic-window> = frame-window(frame);
  let buffer :: <basic-buffer> = frame-buffer(frame);
  let interval = selected-language-object();
  //---*** Do this via major mode
  frame-last-command-type(frame) := #"browse"
end command show-value;

define command describe-object (frame)
    "Describe the value of the selected language object."
  let window :: <basic-window> = frame-window(frame);
  let buffer :: <basic-buffer> = frame-buffer(frame);
  let interval = selected-language-object();
  let name
    = unless (mark())
        let name = edit-definition-dialog(window, as(<string>, interval),
                                          title: "Describe Object");
        name | error(make(<command-error>, window: window))
      end;
  unless (do-describe-object(buffer-major-mode(buffer), interval, window, name: name))
    command-error("Couldn't describe %s", as(<string>, interval))
  end;
  frame-last-command-type(frame) := #"browse"
end command describe-object;

define command browse-object (frame)
    "Browse the value of the selected language object."
  let window :: <basic-window> = frame-window(frame);
  let buffer :: <basic-buffer> = frame-buffer(frame);
  let interval = selected-language-object();
  let name
    = unless (mark())
        let name = edit-definition-dialog(window, as(<string>, interval),
                                          title: "Browse Object");
        name | error(make(<command-error>, window: window))
      end;
  unless (do-browse-object(buffer-major-mode(buffer), interval, window, name: name))
    command-error("Couldn't browse %s", as(<string>, interval))
  end;
  frame-last-command-type(frame) := #"browse"
end command browse-object;

define command browse-class (frame)
    "Browse the class of the selected language object."
  let window :: <basic-window> = frame-window(frame);
  let buffer :: <basic-buffer> = frame-buffer(frame);
  let interval = selected-language-object();
  let name
    = unless (mark())
        let name = edit-definition-dialog(window, as(<string>, interval),
                                          title: "Browse Class");
        name | error(make(<command-error>, window: window))
      end;
  unless (do-browse-class(buffer-major-mode(buffer), interval, window, name: name))
    command-error("Couldn't browse the class of %s", as(<string>, interval))
  end;
  frame-last-command-type(frame) := #"browse"
end command browse-class;

define command browse-function (frame)
    "Browse the generic function of the selected language object."
  let window :: <basic-window> = frame-window(frame);
  let buffer :: <basic-buffer> = frame-buffer(frame);
  let interval = selected-language-object();
  let name
    = unless (mark())
        let name = edit-definition-dialog(window, as(<string>, interval),
                                          title: "Browse Function");
        name | error(make(<command-error>, window: window))
      end;
  unless (do-browse-function(buffer-major-mode(buffer), interval, window, name: name))
    command-error("Couldn't browse the function %s", as(<string>, interval))
  end;
  frame-last-command-type(frame) := #"browse"
end command browse-function;

define function selected-language-object
    () => (interval :: <basic-interval>)
  let (sbp, ebp)
    = if (mark()) order-bps(point(), mark()) else atom-under-bp(point()) end;
  make-interval(sbp, ebp, in-order?: #t)
end function selected-language-object;


define command show-arglist (frame)
    "Show the parameter list of the selected language object."
  let window :: <basic-window> = frame-window(frame);
  let buffer :: <basic-buffer> = frame-buffer(frame);
  let interval
    = if (mark()) make-interval(point(), mark())
      else relevant-function-interval(point()) end;
  let name
    = unless (mark())
        let name = edit-definition-dialog(window, as(<string>, interval),
                                          title: "Show Parameters");
        name | error(make(<command-error>, window: window))
      end;
  unless (do-show-arglist(buffer-major-mode(buffer), interval, window, name: name))
    command-error("Couldn't show the parameters for %s", as(<string>, interval))
  end;
  frame-last-command-type(frame) := #"browse"
end command show-arglist;

define command show-documentation (frame)
    "Show the on-line documentation for the selected language object."
  let window :: <basic-window> = frame-window(frame);
  let buffer :: <basic-buffer> = frame-buffer(frame);
  let interval = selected-language-object();
  let name
    = unless (mark())
        let name = edit-definition-dialog(window, as(<string>, interval),
                                          title: "Show Documentation");
        name | error(make(<command-error>, window: window))
      end;
  unless (do-show-documentation(buffer-major-mode(buffer), interval, window, name: name))
    command-error("Couldn't show the documentation for %s", as(<string>, interval))
  end;
  frame-last-command-type(frame) := #"browse"
end command show-documentation;


define command evaluate-definition (frame)
    "Interactively compile the current definition."
  let interval = definition-interval(point());
  compile-to-core(frame, interval, "definition");
end command evaluate-definition;

define command evaluate-region (frame)
    "Interactively compile the selection, or the current definition if there's no selection.\n"
    "With a numeric argument, compiles the entire buffer."
  if (frame-numeric-arg-state(frame))
    evaluate-buffer(frame)
  else
    let (interval, what)
      = if (mark())
          values(make-interval(point(), mark()), "region")
        else
          values(definition-interval(point()), "definition")
        end;
    compile-to-core(frame, interval, what)
  end
end command evaluate-region;

define command evaluate-buffer (frame)
    "Interactively compile the entire buffer."
  let buffer = frame-buffer(frame);
  let interval = make-interval(interval-start-bp(buffer), interval-end-bp(buffer));
  compile-to-core(frame, interval, "buffer");
end command evaluate-buffer;

define method compile-to-core
    (frame :: <editor-state-mixin>, interval, what) => ()
  let window :: <basic-window> = frame-window(frame);
  let buffer :: <basic-buffer> = frame-buffer(frame);
  display-message(window, "Compiling %s... ", what);
  do-compile-to-core(buffer-major-mode(buffer), interval);
  display-message(window, "Compiling %s... compiled", what);
  frame-last-command-type(frame) := #"compile"
end method compile-to-core;


define command macroexpand-region (frame)
    "Macroexpand the selection, or the current definition if there's no selection.\n"
    "With a numeric argument, inserts the expansion into a \"results\" buffer."
  let window :: <basic-window> = frame-window(frame);
  let buffer :: <basic-buffer> = frame-buffer(frame);
  let interval = if (mark()) make-interval(point(), mark())
                 else definition-interval(point()) end;
  let stream   = make(<string-stream>, direction: #"output");
  do-macroexpand(buffer-major-mode(buffer), interval, stream);
  let expansion = stream-contents(stream);
  if (frame-numeric-arg-state(frame))
    //---*** Display the expansion somewhere
    #f
  else
    with-change-recording (buffer, <paste-change-record>, start-bp: interval-end-bp(interval))
      let bp1 = interval-end-bp(interval);
      let bp2 = insert!(bp1, expansion);
      move-point!(bp1);
      move-mark!(bp2)
    end;
    queue-redisplay(window, $display-all)
  end;
  frame-last-command-type(frame) := #"compile"
end command macroexpand-region;


define command compile-file (frame)
    "Compile the indicated file."
  let window :: <basic-window> = frame-window(frame);
  let buffer :: <basic-buffer> = frame-buffer(frame);
  let home
    = if (composite-buffer?(buffer)) section-home-buffer(line-section(bp-line(point())))
      else buffer end;
  let default  = home & buffer-default-pathname(home);
  let type     = home & source-file-type(buffer-major-mode(home));
  let pathname = open-file-dialog(window, default: default, default-type: type);
  when (pathname)
    let mode = find-mode-from-pathname(pathname);
    when (compilation-supported?(mode))
      display-message(window, "Compiling file... ");
      do-compile-file(mode, pathname);
      display-message(window, "Compiling file... compiled")
    end
  end;
  frame-last-command-type(frame) := #"compile"
end command compile-file;

define command load-file (frame)
    "Load the indicated file."
  let window :: <basic-window> = frame-window(frame);
  let buffer :: <basic-buffer> = frame-buffer(frame);
  let home
    = if (composite-buffer?(buffer)) section-home-buffer(line-section(bp-line(point())))
      else buffer end;
  let default  = home & buffer-default-pathname(home);
  let type     = home & binary-file-type(buffer-major-mode(home));
  let pathname = open-file-dialog(window, default: default, default-type: type);
  when (pathname)
    let mode = find-mode-from-pathname(pathname);
    when (compilation-supported?(mode))
      display-message(window, "Loading file... ");
      do-load-file(mode, pathname);
      display-message(window, "Loading file... loaded")
    end
  end;
  frame-last-command-type(frame) := #"compile"
end command load-file;


define command parse-project (frame)
    "Partially compile the project associated with this buffer."
  build-buffer-project(frame, #"project-parse", "Partially compiling", "compiled")
end command parse-project;

define command compile-project (frame)
    "Compile the project associated with this buffer."
  build-buffer-project(frame, #"project-compile", "Compiling", "compiled")
end command compile-project;

define command clean-compile-project (frame)
    "Cleanly recompile the project associated with this buffer."
  build-buffer-project(frame, #"project-clean-compile", "Cleanly compiling", "compiled")
end command clean-compile-project;

define command link-project (frame)
    "Link the project associated with this buffer."
  build-buffer-project(frame, #"project-link", "Linking", "linked")
end command link-project;

define command build-project (frame)
    "Build (compile then link) the project associated with this buffer."
  build-buffer-project(frame, #"project-build", "Building", "built")
end command build-project;

define command clean-build-project (frame)
    "Cleanly build (clean compile then link) the project associated with this buffer."
  build-buffer-project(frame, #"project-clean-build", "Cleanly building", "built")
end command clean-build-project;

define method build-buffer-project
    (frame :: <editor-state-mixin>, scope :: <symbol>, what, what-done) => ()
  let window :: <basic-window> = frame-window(frame);
  let buffer :: <basic-buffer> = frame-buffer(frame);
  let mode = buffer-major-mode(buffer);
  when (compilation-supported?(mode))
    // display-message(window, "%s project... ", what);
    do-build-project(buffer-major-mode(buffer), buffer, scope);
    // display-message(window, "%s project... %s", what, what-done)
  end;
  frame-last-command-type(frame) := #"compile"
end method build-buffer-project;


/// Browsing commands

define command edit-class-subclasses (frame)
    "Create a browsing buffer containing the subclasses of a class."
  make-definition-browser(frame, #"class-subclasses",
                          buffer-class: <subclasses-browsing-buffer>)
end command edit-class-subclasses;

define command edit-class-superclasses (frame)
    "Create a browsing buffer containing the superclasses of a class."
  make-definition-browser(frame, #"class-superclasses",
                          buffer-class: <superclasses-browsing-buffer>)
end command edit-class-superclasses;

define command edit-class-methods (frame)
    "Create a browsing buffer containing the methods of a class."
  make-definition-browser(frame, #"class-methods",
                          buffer-class: <class-methods-browsing-buffer>)
end command edit-class-methods;

define command edit-generic-function-methods (frame)
    "Create a browsing buffer containing the methods of a generic function."
  make-definition-browser(frame, #"generic-function-methods",
                          buffer-class: <generic-function-methods-browsing-buffer>)
end command edit-generic-function-methods;

define command edit-callers (frame)
    "Create a browsing buffer containing the callers of a function."
  make-definition-browser(frame, #"function-callers",
                          buffer-class: <callers-browsing-buffer>)
end command edit-callers;

define command edit-callees (frame)
    "Create a browsing buffer containing the callees of a function."
  make-definition-browser(frame, #"function-callees",
                          buffer-class: <callees-browsing-buffer>)
end command edit-callees;

define method make-definition-browser
    (frame :: <editor-state-mixin>, what :: <symbol>, #key buffer-class)
  let window :: <basic-window> = frame-window(frame);
  let buffer :: <basic-buffer> = frame-buffer(frame);
  let mode   :: <major-mode>   = buffer-major-mode(buffer);
  let editor   = frame-editor(frame);
  let interval = selected-language-object();
  let (definition, name-key, generator, major-mode, node-class)
    = definition-browser-parameters(mode, interval, what);
  when (definition)
    let buffer = make-empty-buffer(buffer-class,
                                   name:       as(<string>, what),
                                   definition: definition,
                                   name-key:   name-key,
                                   generator:  generator,
                                   major-mode: major-mode,
                                   node-class: node-class,
                                   editor:     editor);
    with-busy-cursor (window)
      revert-buffer(buffer)
    end;
    select-buffer-in-appropriate-window(window, buffer)
  end;
  frame-last-command-type(frame) := #"file"
end method make-definition-browser;


/// Debugging redisplay

define command redisplay-toggle-bitblt (frame)
    "Toggle the state of bitblt scrolling."
  let window :: <basic-window> = frame-window(frame);
  $scroll-with-bitblt? := ~$scroll-with-bitblt?;
  display-message(window, if ($scroll-with-bitblt?)
                            "Bitblt scrolling enabled"
                          else
                            "Bitblt scrolling disabled"
                          end)
end command redisplay-toggle-bitblt;

define command redisplay-toggle-debugging (frame)
    "Toggle the state of display debugging."
  let window :: <basic-window> = frame-window(frame);
  $debug-redisplay? := ~$debug-redisplay?;
  $debug-scrolling? :=  $debug-redisplay?;
  display-message(window, if ($debug-redisplay?)
                            "Redisplay debugging enabled"
                          else
                            "Redisplay debugging disabled"
                          end)
end command redisplay-toggle-debugging;
