racket-ansi/rmacs/mode/fundamental.rkt

138 lines
5.1 KiB
Racket
Raw Normal View History

2014-12-23 06:43:01 +00:00
#lang racket/base
(provide fundamental-mode)
2014-12-23 16:09:22 +00:00
(require racket/set)
(require racket/match)
(require "../api.rkt")
2014-12-23 06:43:01 +00:00
(define fundamental-mode (make-mode "fundamental"))
(define-command fundamental-mode (self-insert-command buf #:window win #:keyseq keyseq)
2014-12-23 16:09:22 +00:00
(match keyseq
[(list (key (? char? ch) modifiers)) #:when (set-empty? (set-remove modifiers 'shift))
(buffer-insert! buf (window-point win) (string->rope (string ch)))]
2014-12-23 16:09:22 +00:00
[_ #f]))
2014-12-23 06:43:01 +00:00
(define-command fundamental-mode (unbound-key-sequence buf #:command cmd #:keyseq keyseq)
(invoke (replace-selector cmd 'self-insert-command)))
2014-12-23 06:43:01 +00:00
(define-key fundamental-mode (list "C-q" '#:default) self-insert-command)
(define-command fundamental-mode (newline buf #:window win)
2014-12-23 06:43:01 +00:00
#:bind-key "C-m"
#:bind-key "C-j"
(buffer-insert! buf (window-point win) (string->rope "\n")))
2014-12-23 06:43:01 +00:00
(define (move-forward-n-lines win count)
(define buf (window-buffer win))
2014-12-23 06:43:01 +00:00
(for ((i count))
(buffer-move-mark-to-end-of-line! buf (window-point win))
(buffer-move-mark! buf (window-point win) 1)))
2014-12-23 06:43:01 +00:00
(define (move-backward-n-lines win count)
(define buf (window-buffer win))
2014-12-23 06:43:01 +00:00
(for ((i count))
(buffer-move-mark-to-start-of-line! buf (window-point win))
(buffer-move-mark! buf (window-point win) -1)))
2014-12-23 06:43:01 +00:00
(define (move-to-column win col)
(define buf (window-buffer win))
(define eol-pos (buffer-end-of-line buf (window-point win)))
(define sol-pos (buffer-start-of-line buf (window-point win)))
(buffer-mark! buf (window-point win) (+ sol-pos (min col (- eol-pos sol-pos)))))
2014-12-23 06:43:01 +00:00
(define-command fundamental-mode (forward-char buf #:window win #:prefix-arg [count 1])
2014-12-23 06:43:01 +00:00
#:bind-key "C-f"
#:bind-key "<right>"
(buffer-move-mark! buf (window-point win) count))
2014-12-23 06:43:01 +00:00
(define-command fundamental-mode (backward-char buf #:window win #:prefix-arg [count 1])
2014-12-23 06:43:01 +00:00
#:bind-key "C-b"
#:bind-key "<left>"
(buffer-move-mark! buf (window-point win) (- count)))
2014-12-23 06:43:01 +00:00
(define-command fundamental-mode (next-line buf #:window win #:prefix-arg [count 1])
2014-12-23 06:43:01 +00:00
#:bind-key "C-n"
#:bind-key "<down>"
(define col (buffer-column buf (window-point win)))
(move-forward-n-lines win count)
(move-to-column win col))
2014-12-23 06:43:01 +00:00
(define-command fundamental-mode (prev-line buf #:window win #:prefix-arg [count 1])
2014-12-23 06:43:01 +00:00
#:bind-key "C-p"
#:bind-key "<up>"
(define col (buffer-column buf (window-point win)))
(move-backward-n-lines win count)
(move-to-column win col))
2014-12-23 06:43:01 +00:00
(define-command fundamental-mode (move-end-of-line buf #:window win #:prefix-arg [count 1])
2014-12-23 06:43:01 +00:00
#:bind-key "C-e"
#:bind-key "<end>"
(when (positive? count) (move-forward-n-lines win (- count 1)))
(buffer-move-mark-to-end-of-line! buf (window-point win)))
2014-12-23 06:43:01 +00:00
(define-command fundamental-mode (move-beginning-of-line buf #:window win #:prefix-arg [count 1])
2014-12-23 06:43:01 +00:00
#:bind-key "C-a"
#:bind-key "<home>"
(when (positive? count) (move-forward-n-lines win (- count 1)))
(buffer-move-mark-to-start-of-line! buf (window-point win)))
2014-12-23 06:43:01 +00:00
(define-command fundamental-mode (delete-backward-char buf #:window win #:prefix-arg [count 1])
2014-12-23 06:43:01 +00:00
#:bind-key "<backspace>"
#:bind-key "C-h" ;; differs from GNU emacs
(define pos (buffer-mark-pos buf (window-point win)))
(buffer-region-update! buf (- pos 1) pos (lambda (_deleted) (empty-rope))))
2014-12-23 06:43:01 +00:00
(define-command fundamental-mode (delete-forward-char buf #:window win #:prefix-arg [count 1])
2014-12-23 06:43:01 +00:00
#:bind-key "<delete>"
#:bind-key "C-d"
(define pos (buffer-mark-pos buf (window-point win)))
(buffer-region-update! buf pos (+ pos 1) (lambda (_deleted) (empty-rope))))
2014-12-23 06:43:01 +00:00
(define-command fundamental-mode (beginning-of-buffer buf #:window win #:prefix-arg [tenths 0])
2014-12-23 06:43:01 +00:00
#:bind-key "M-<"
#:bind-key "C-<home>"
#:bind-key "<begin>"
(if (eq? tenths '#:prefix) (set! tenths 0) (window-mark! win))
(window-move-to! win (* (buffer-size buf) (max 0 (min 10 tenths)) 1/10)))
2014-12-23 06:43:01 +00:00
(define-command fundamental-mode (end-of-buffer buf #:window win #:prefix-arg [tenths 0])
2014-12-23 06:43:01 +00:00
#:bind-key "M->"
#:bind-key "C-<end>"
(if (eq? tenths '#:prefix) (set! tenths 0) (window-mark! win))
(window-move-to! win (* (buffer-size buf) (- 10 (max 0 (min 10 tenths))) 1/10)))
2014-12-23 06:43:01 +00:00
(define-command fundamental-mode (exchange-point-and-mark buf #:window win)
2014-12-23 06:43:01 +00:00
#:bind-key "C-x C-x"
(define m (buffer-mark-pos* buf (window-mark win)))
2014-12-23 06:43:01 +00:00
(when m
(define p (buffer-mark-pos buf (window-point win)))
(window-mark! win p)
(window-move-to! win m)))
2014-12-23 06:43:01 +00:00
(define-command fundamental-mode (set-mark-command buf #:window win #:prefix-arg arg)
2014-12-23 06:43:01 +00:00
#:bind-key "C-@"
#:bind-key "C-space"
(if (eq? arg '#:prefix)
(let ((m (buffer-mark-pos* buf (window-mark win))))
(and m (window-move-to! win m)))
(window-mark! win (window-point win))))
(define-command fundamental-mode (split-window-below buf #:window win #:editor ed)
#:bind-key "C-x 2"
(open-window ed buf #:after-window win))
(define-command fundamental-mode (delete-other-windows buf #:window win #:editor ed)
#:bind-key "C-x 1"
(close-other-windows ed win))
(define-command fundamental-mode (delete-window buf #:window win #:editor ed)
#:bind-key "C-x 0"
(close-window ed win))
(define-command fundamental-mode (other-window buf #:window win #:editor ed)
#:bind-key "C-tab"
#:bind-key "C-x o"
(select-window ed (editor-next-window ed win)))