scratch/edwin/modefs.scm

#| -*-Scheme-*-

Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
    1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
    2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016,
    2017, 2018, 2019, 2020 Massachusetts Institute of Technology

This file is part of MIT/GNU Scheme.

MIT/GNU Scheme is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or (at
your option) any later version.

MIT/GNU Scheme is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
General Public License for more details.

You should have received a copy of the GNU General Public License
along with MIT/GNU Scheme; if not, write to the Free Software
Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301,
USA.

|#

;;;; Fundamental Mode

(declare (usual-integrations))

(define-command fundamental-mode
  "Make the current mode be Fundamental Mode.
All normal editing modes are defined relative to this mode."
  ()
  (lambda ()
    (set-current-major-mode! (ref-mode-object fundamental))))

(define-major-mode fundamental #f "Fundamental"
  "Major mode not specialized for anything in particular.
Most other major modes are defined by comparison to this one.")

(define-variable editor-default-mode
  "The default major mode for new buffers."
  (ref-mode-object fundamental))

(define initial-buffer-name
  "*scheme*")

;; The extra range allows international keyboards to insert 8-bit characters
(define char-set:self-insert-keys
  (char-set-union (ucs-range->char-set #x20 #x7F)
		  (ucs-range->char-set #x80 #xFF)))

(define-key 'fundamental char-set:self-insert-keys 'self-insert-command)
(define-key 'fundamental char-set:numeric 'auto-digit-argument)
(define-key 'fundamental #\- 'auto-negative-argument)
(define-key 'fundamental #\rubout 'delete-backward-char)

(define-major-mode read-only fundamental "Read-only"
  "Major mode for read-only buffers.
Like Fundamental mode, but no self-inserting characters.
Digits and - are bound to prefix argument commands.")

(define-key 'read-only char-set:self-insert-keys 'undefined)
(define-key 'read-only char-set:numeric 'digit-argument)
(define-key 'read-only #\- 'negative-argument)
(define-key 'read-only '(#\c-x #\c-q) 'no-toggle-read-only)

(define-major-mode read-only-noarg fundamental "Read-only-noarg"
  "Major mode for read-only buffers.
Like Fundamental mode, but no self-inserting characters.")

(define-key 'read-only-noarg char-set:self-insert-keys 'undefined)
(define-key 'read-only-noarg '(#\c-x #\c-q) 'no-toggle-read-only)

(define global-modes
  (list (ref-mode-object fundamental)
	(ref-mode-object read-only)
	(ref-mode-object read-only-noarg)))

(define-key 'fundamental #\c-space 'set-mark-command)
(define-key 'fundamental #\c-% 'replace-string)
(define-key 'fundamental #\c-- 'negative-argument)
(define-key 'fundamental #\c-0 'digit-argument)
(define-key 'fundamental #\c-1 'digit-argument)
(define-key 'fundamental #\c-2 'digit-argument)
(define-key 'fundamental #\c-3 'digit-argument)
(define-key 'fundamental #\c-4 'digit-argument)
(define-key 'fundamental #\c-5 'digit-argument)
(define-key 'fundamental #\c-6 'digit-argument)
(define-key 'fundamental #\c-7 'digit-argument)
(define-key 'fundamental #\c-8 'digit-argument)
(define-key 'fundamental #\c-9 'digit-argument)
(define-key 'fundamental #\c-\; 'indent-for-comment)
(define-key 'fundamental #\c-< 'mark-beginning-of-buffer)
(define-key 'fundamental #\c-= 'what-cursor-position)
(define-key 'fundamental #\c-> 'mark-end-of-buffer)
(define-key 'fundamental #\c-@ 'set-mark-command)
(define-key 'fundamental #\c-a 'beginning-of-line)
(define-key 'fundamental #\c-b 'backward-char)
(define-prefix-key 'fundamental #\c-c)
(define-key 'fundamental #\c-d 'delete-char)
(define-key 'fundamental #\c-e 'end-of-line)
(define-key 'fundamental #\c-f 'forward-char)
(define-key 'fundamental #\c-g 'keyboard-quit)
(define-prefix-key 'fundamental #\c-h 'help-prefix)
(define-key 'fundamental #\c-i 'indent-for-tab-command)
(define-key 'fundamental #\c-j 'newline-and-indent)
(define-key 'fundamental #\c-k 'kill-line)
(define-key 'fundamental #\c-l 'recenter)
(define-key 'fundamental #\c-m 'newline)
(define-key 'fundamental #\c-n 'next-line)
(define-key 'fundamental #\c-o 'open-line)
(define-key 'fundamental #\c-p 'previous-line)
(define-key 'fundamental #\c-q 'quoted-insert)
(define-key 'fundamental #\c-r 'isearch-backward)
(define-key 'fundamental #\c-s 'isearch-forward)
(define-key 'fundamental #\c-t 'transpose-chars)
(define-key 'fundamental #\c-u 'universal-argument)
(define-key 'fundamental #\c-v 'scroll-up)
(define-key 'fundamental #\c-w 'kill-region)
(define-prefix-key 'fundamental #\c-x)
(define-key 'fundamental #\c-y 'yank)
(define-key 'fundamental #\c-z 'control-meta-prefix)
(define-key 'fundamental #\c-\[ 'meta-prefix)
(define-key 'fundamental #\c-\] 'abort-recursive-edit)
(define-key 'fundamental #\c-^ 'control-prefix)
(define-key 'fundamental #\c-_ 'undo)
(define-key 'fundamental #\c-rubout 'backward-delete-char-untabify)

(define-key 'fundamental #\m-space 'just-one-space)
(define-key 'fundamental #\m-! 'shell-command)
(define-key 'fundamental #\m-% 'query-replace)
(define-key 'fundamental #\m-\' 'abbrev-prefix-mark)
(define-key 'fundamental #\m-\, 'tags-loop-continue)
(define-key 'fundamental #\m-- 'auto-argument)
(define-key 'fundamental #\m-. 'find-tag)
(define-key 'fundamental #\m-/ 'dabbrev-expand)
(define-key 'fundamental #\m-0 'auto-argument)
(define-key 'fundamental #\m-1 'auto-argument)
(define-key 'fundamental #\m-2 'auto-argument)
(define-key 'fundamental #\m-3 'auto-argument)
(define-key 'fundamental #\m-4 'auto-argument)
(define-key 'fundamental #\m-5 'auto-argument)
(define-key 'fundamental #\m-6 'auto-argument)
(define-key 'fundamental #\m-7 'auto-argument)
(define-key 'fundamental #\m-8 'auto-argument)
(define-key 'fundamental #\m-9 'auto-argument)
(define-key 'fundamental #\m-: 'eval-expression)
(define-key 'fundamental #\m-\; 'indent-for-comment)
(define-key 'fundamental #\m-< 'beginning-of-buffer)
(define-key 'fundamental #\m-= 'count-lines-region)
(define-key 'fundamental #\m-> 'end-of-buffer)
(define-key 'fundamental #\m-@ 'mark-word)
(define-key 'fundamental #\m-\\ 'delete-horizontal-space)
(define-key 'fundamental #\m-\( 'insert-parentheses)
(define-key 'fundamental #\m-\) 'move-past-close-and-reindent)
(define-key 'fundamental #\m-^ 'delete-indentation)
(define-key 'fundamental #\m-a 'backward-sentence)
(define-key 'fundamental #\m-b 'backward-word)
(define-key 'fundamental #\m-c 'capitalize-word)
(define-key 'fundamental #\m-d 'kill-word)
(define-key 'fundamental #\m-e 'forward-sentence)
(define-key 'fundamental #\m-f 'forward-word)
(define-key 'fundamental #\m-g 'fill-region)
(define-key 'fundamental #\m-h 'mark-paragraph)
(define-key 'fundamental #\m-i 'tab-to-tab-stop)
(define-key 'fundamental #\m-j 'indent-new-comment-line)
(define-key 'fundamental #\m-k 'kill-sentence)
(define-key 'fundamental #\m-l 'downcase-word)
(define-key 'fundamental #\m-m 'back-to-indentation)
(define-key 'fundamental #\m-q 'fill-paragraph)
(define-key 'fundamental #\m-r 'move-to-window-line)
(define-key 'fundamental #\m-t 'transpose-words)
(define-key 'fundamental #\m-u 'upcase-word)
(define-key 'fundamental #\m-v 'scroll-down)
(define-key 'fundamental #\m-w 'copy-region-as-kill)
(define-key 'fundamental #\m-x 'execute-extended-command)
(define-key 'fundamental #\m-y 'yank-pop)
(define-key 'fundamental #\m-z 'zap-to-char)
(define-key 'fundamental #\m-\{ 'backward-paragraph)
(define-key 'fundamental #\m-\| 'shell-command-on-region)
(define-key 'fundamental #\m-\} 'forward-paragraph)
(define-key 'fundamental #\m-~ 'not-modified)
(define-key 'fundamental #\m-rubout 'backward-kill-word)

(define-key 'fundamental #\c-m-space 'mark-sexp)
(define-key 'fundamental #\c-m-0 'digit-argument)
(define-key 'fundamental #\c-m-1 'digit-argument)
(define-key 'fundamental #\c-m-2 'digit-argument)
(define-key 'fundamental #\c-m-3 'digit-argument)
(define-key 'fundamental #\c-m-4 'digit-argument)
(define-key 'fundamental #\c-m-5 'digit-argument)
(define-key 'fundamental #\c-m-6 'digit-argument)
(define-key 'fundamental #\c-m-7 'digit-argument)
(define-key 'fundamental #\c-m-8 'digit-argument)
(define-key 'fundamental #\c-m-9 'digit-argument)
(define-key 'fundamental #\c-m-- 'negative-argument)
(define-key 'fundamental #\c-m-\\ 'indent-region)
(define-key 'fundamental #\c-m-^ 'delete-indentation)
(define-key 'fundamental #\c-m-\( 'backward-up-list)
(define-key 'fundamental #\c-m-\) 'up-list)
(define-key 'fundamental #\c-m-@ 'mark-sexp)
(define-key 'fundamental #\c-m-\; 'kill-comment)
(define-key 'fundamental #\c-m-\[ 'eval-expression)
(define-key 'fundamental #\c-m-a 'beginning-of-defun)
(define-key 'fundamental #\c-m-b 'backward-sexp)
(define-key 'fundamental #\c-m-c 'exit-recursive-edit)
(define-key 'fundamental #\c-m-d 'down-list)
(define-key 'fundamental #\c-m-e 'end-of-defun)
(define-key 'fundamental #\c-m-f 'forward-sexp)
(define-key 'fundamental #\c-m-h 'mark-defun)
(define-key 'fundamental #\c-m-j 'indent-new-comment-line)
(define-key 'fundamental #\c-m-k 'kill-sexp)
(define-key 'fundamental #\c-m-l 'twiddle-buffers)
(define-key 'fundamental #\c-m-n 'forward-list)
(define-key 'fundamental #\c-m-o 'split-line)
(define-key 'fundamental #\c-m-p 'backward-list)
(define-key 'fundamental #\c-m-r 'isearch-backward-regexp)
(define-key 'fundamental #\c-m-s 'isearch-forward-regexp)
(define-key 'fundamental #\c-m-t 'transpose-sexps)
(define-key 'fundamental #\c-m-u 'backward-up-list)
(define-key 'fundamental #\c-m-v 'scroll-other-window)
(define-key 'fundamental #\c-m-w 'append-next-kill)
(define-key 'fundamental #\c-m-rubout 'backward-kill-sexp)

(define-key 'fundamental '(#\c-c #\c-i) 'insert-filename)
(define-key 'fundamental '(#\c-c #\c-s) 'repl)

(define-key 'fundamental '(#\c-h #\a) 'command-apropos)
(define-key 'fundamental '(#\c-h #\b) 'describe-bindings)
(define-key 'fundamental '(#\c-h #\c) 'describe-key-briefly)
(define-key 'fundamental '(#\c-h #\f) 'describe-function)
(define-key 'fundamental '(#\c-h #\i) 'info)
(define-key 'fundamental '(#\c-h #\k) 'describe-key)
(define-key 'fundamental '(#\c-h #\l) 'view-lossage)
(define-key 'fundamental '(#\c-h #\m) 'describe-mode)
(define-key 'fundamental '(#\c-h #\s) 'describe-syntax)
(define-key 'fundamental '(#\c-h #\t) 'help-with-tutorial)
(define-key 'fundamental '(#\c-h #\v) 'describe-variable)
(define-key 'fundamental '(#\c-h #\w) 'where-is)

(define-key 'fundamental '(#\c-x #\') 'expand-abbrev)
(define-key 'fundamental '(#\c-x #\c-\[) 'repeat-complex-command)
(define-key 'fundamental '(#\c-x #\c-b) 'list-buffers)
(define-key 'fundamental '(#\c-x #\c-c) 'save-buffers-kill-scheme)
(define-key 'fundamental '(#\c-x #\c-d) 'list-directory)
(define-key 'fundamental '(#\c-x #\c-e) 'eval-last-sexp)
(define-key 'fundamental '(#\c-x #\c-f) 'find-file)
(define-key 'fundamental '(#\c-x #\c-i) 'indent-rigidly)
(define-key 'fundamental '(#\c-x #\c-l) 'downcase-region)
(define-key 'fundamental '(#\c-x #\c-n) 'set-goal-column)
(define-key 'fundamental '(#\c-x #\c-o) 'delete-blank-lines)
(define-key 'fundamental '(#\c-x #\c-p) 'mark-page)
(define-key 'fundamental '(#\c-x #\c-q) 'toggle-read-only)
(define-key 'fundamental '(#\c-x #\c-s) 'save-buffer)
(define-key 'fundamental '(#\c-x #\c-t) 'transpose-lines)
(define-key 'fundamental '(#\c-x #\c-u) 'upcase-region)
(define-key 'fundamental '(#\c-x #\c-v) 'find-alternate-file)
(define-key 'fundamental '(#\c-x #\c-w) 'write-file)
(define-key 'fundamental '(#\c-x #\c-x) 'exchange-point-and-mark)
(define-key 'fundamental '(#\c-x #\c-z) 'suspend-scheme)
(define-key 'fundamental '(#\c-x #\() 'start-kbd-macro)
(define-key 'fundamental '(#\c-x #\)) 'end-kbd-macro)
(define-key 'fundamental '(#\c-x #\-) 'shrink-window-if-larger-than-buffer)
(define-key 'fundamental '(#\c-x #\.) 'set-fill-prefix)
(define-key 'fundamental '(#\c-x #\/) 'point-to-register)
(define-key 'fundamental '(#\c-x #\0) 'delete-window)
(define-key 'fundamental '(#\c-x #\1) 'delete-other-windows)
(define-key 'fundamental '(#\c-x #\2) 'split-window-vertically)
(define-key 'fundamental '(#\c-x #\3) 'split-window-horizontally)
(define-prefix-key 'fundamental '(#\c-x #\4))
(define-key 'fundamental '(#\C-x #\4 #\0) 'kill-buffer-and-window)
(define-key 'fundamental '(#\c-x #\4 #\c-f) 'find-file-other-window)
(define-key 'fundamental '(#\c-x #\4 #\.) 'find-tag-other-window)
(define-key 'fundamental '(#\c-x #\4 #\b) 'switch-to-buffer-other-window)
(define-key 'fundamental '(#\c-x #\4 #\d) 'dired-other-window)
(define-key 'fundamental '(#\c-x #\4 #\f) 'find-file-other-window)
(define-key 'fundamental '(#\c-x #\4 #\m) 'mail-other-window)
(define-prefix-key 'fundamental '(#\c-x #\5))
(define-key 'fundamental '(#\c-x #\5 #\c-f) 'find-file-other-frame)
(define-key 'fundamental '(#\c-x #\5 #\.) 'find-tag-other-frame)
(define-key 'fundamental '(#\c-x #\5 #\0) 'delete-frame)
(define-key 'fundamental '(#\c-x #\5 #\2) 'make-frame)
(define-key 'fundamental '(#\c-x #\5 #\b) 'switch-to-buffer-other-frame)
(define-key 'fundamental '(#\c-x #\5 #\d) 'dired-other-frame)
(define-key 'fundamental '(#\c-x #\5 #\f) 'find-file-other-frame)
(define-key 'fundamental '(#\c-x #\5 #\m) 'mail-other-frame)
(define-key 'fundamental '(#\c-x #\5 #\o) 'other-frame)

(define-key 'fundamental '(#\c-x #\;) 'set-comment-column)
(define-key 'fundamental '(#\c-x #\=) 'what-cursor-position)
(define-key 'fundamental '(#\c-x #\[) 'backward-page)
(define-key 'fundamental '(#\c-x #\]) 'forward-page)
(define-key 'fundamental '(#\c-x #\^) 'enlarge-window)
(define-prefix-key 'fundamental '(#\c-x #\a))
(define-key 'fundamental '(#\c-x #\a #\') 'expand-abbrev)
(define-key 'fundamental '(#\c-x #\a #\+) 'add-mode-abbrev)
(define-key 'fundamental '(#\c-x #\a #\-) 'inverse-add-global-abbrev)
(define-key 'fundamental '(#\c-x #\a #\c-a) 'add-mode-abbrev)
(define-key 'fundamental '(#\c-x #\a #\e) 'expand-abbrev)
(define-key 'fundamental '(#\c-x #\a #\g) 'add-global-abbrev)
(define-prefix-key 'fundamental '(#\c-x #\a #\i))
(define-key 'fundamental '(#\c-x #\a #\i #\g) 'inverse-add-global-abbrev)
(define-key 'fundamental '(#\c-x #\a #\i #\l) 'inverse-add-mode-abbrev)
(define-key 'fundamental '(#\c-x #\a #\l) 'add-mode-abbrev)
(define-key 'fundamental '(#\c-x #\b) 'switch-to-buffer)
(define-key 'fundamental '(#\c-x #\c) 'save-buffers-kill-edwin)
(define-key 'fundamental '(#\c-x #\d) 'dired)
(define-key 'fundamental '(#\c-x #\e) 'call-last-kbd-macro)
(define-key 'fundamental '(#\c-x #\f) 'set-fill-column)
(define-key 'fundamental '(#\c-x #\g) 'insert-register)
(define-key 'fundamental '(#\c-x #\h) 'mark-whole-buffer)
(define-key 'fundamental '(#\c-x #\i) 'insert-file)
(define-key 'fundamental '(#\c-x #\j) 'register-to-point)
(define-key 'fundamental '(#\c-x #\k) 'kill-buffer)
(define-key 'fundamental '(#\c-x #\l) 'count-lines-page)
(define-key 'fundamental '(#\c-x #\m) 'mail)
(define-key 'fundamental '(#\c-x #\n) 'narrow-to-region)
(define-key 'fundamental '(#\c-x #\o) 'other-window)
(define-key 'fundamental '(#\c-x #\p) 'narrow-to-page)
(define-key 'fundamental '(#\c-x #\q) 'kbd-macro-query)
(define-key 'fundamental '(#\c-x #\r) 'copy-rectangle-to-register)
(define-key 'fundamental '(#\c-x #\s) 'save-some-buffers)
(define-key 'fundamental '(#\c-x #\u) 'undo)
(define-key 'fundamental '(#\c-x #\w) 'widen)
(define-key 'fundamental '(#\c-x #\x) 'copy-to-register)
(define-key 'fundamental '(#\c-x #\z) 'suspend-edwin)
(define-key 'fundamental '(#\c-x #\{) 'shrink-window-horizontally)
(define-key 'fundamental '(#\c-x #\}) 'enlarge-window-horizontally)
(define-key 'fundamental '(#\c-x #\rubout) 'backward-kill-sentence)

;;; Additional bindings to `standard' special keys:

(define-key 'fundamental (make-special-key 'down 0) 'next-line)
(define-key 'fundamental (make-special-key 'up 0) 'previous-line)
(define-key 'fundamental (make-special-key 'left 0) 'backward-char)
(define-key 'fundamental (make-special-key 'right 0) 'forward-char)
(define-key 'fundamental (make-special-key 'left 1) 'backward-word)
(define-key 'fundamental (make-special-key 'right 1) 'forward-word)

;; PC bindings:
(define-key 'fundamental (make-special-key 'home 0) 'beginning-of-line)
(define-key 'fundamental (make-special-key 'end 0) 'end-of-line)
(define-key 'fundamental (make-special-key 'delete 0) 'delete-char)
(define-key 'fundamental (make-special-key 'page-up 0) 'scroll-down)
(define-key 'fundamental (make-special-key 'page-down 0) 'scroll-up)
(define-key 'fundamental (make-special-key 'page-up 1) 'scroll-other-window)
(define-key 'fundamental (make-special-key 'page-down 1)
  'scroll-other-window-down)

;; HP bindings:
(define-key 'fundamental (make-special-key 'deletechar 0) 'delete-char)
(define-key 'fundamental (make-special-key 'deleteline 0) 'kill-line)
(define-key 'fundamental (make-special-key 'insertline 0) 'open-line)
(define-key 'fundamental (make-special-key 'next 0) 'scroll-up)
(define-key 'fundamental (make-special-key 'prior 0) 'scroll-down)
(define-key 'fundamental (make-special-key 'next 1) 'scroll-other-window)
(define-key 'fundamental (make-special-key 'prior 1) 'scroll-other-window-down)

;;; Jokes:

(define-key 'fundamental #\h-space 'hyper-space)
(define-key 'fundamental (make-special-key 'malesymbol 4) 'super-man)
(define-key 'fundamental (make-special-key 'menu 4) 'super-menu)

;;; Mouse buttons:

(define-key 'fundamental button1-down 'mouse-set-point)
;; Next two are for wheel mouse under X.
(define-key 'fundamental button4-down 'mouse-scroll-down)
(define-key 'fundamental button5-down 'mouse-scroll-up)
(define-key 'fundamental button1-up 'mouse-ignore)
(define-key 'fundamental button2-up 'mouse-ignore)
(define-key 'fundamental button3-up 'mouse-ignore)
(define-key 'fundamental button4-up 'mouse-ignore)
(define-key 'fundamental button5-up 'mouse-ignore)

;; Bind VC keys only if VC is loaded.
(if (name->command 'vc-toggle-read-only #f)
    (begin
      (define-key 'fundamental '(#\c-x #\c-q) 'vc-toggle-read-only)
      (define-prefix-key 'fundamental '(#\c-x #\v))
      ;;(define-key 'fundamental '(#\c-x #\v #\a) 'vc-update-change-log)
      ;;(define-key 'fundamental '(#\c-x #\v #\c) 'vc-cancel-version)
      (define-key 'fundamental '(#\c-x #\v #\d) 'vc-directory)
      ;;(define-key 'fundamental '(#\c-x #\v #\g) 'vc-annotate)
      (define-key 'fundamental '(#\c-x #\v #\h) 'vc-insert-headers)
      (define-key 'fundamental '(#\c-x #\v #\i) 'vc-register)
      (define-key 'fundamental '(#\c-x #\v #\l) 'vc-print-log)
      ;;(define-key 'fundamental '(#\c-x #\v #\m) 'vc-merge)
      ;;(define-key 'fundamental '(#\c-x #\v #\r) 'vc-retrieve-snapshot)
      ;;(define-key 'fundamental '(#\c-x #\v #\s) 'vc-create-snapshot)
      (define-key 'fundamental '(#\c-x #\v #\u) 'vc-revert-buffer)
      (define-key 'fundamental '(#\c-x #\v #\v) 'vc-next-action)
      (define-key 'fundamental '(#\c-x #\v #\=) 'vc-diff)
      (define-key 'fundamental '(#\c-x #\v #\~) 'vc-version-other-window)
      ))