1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16 (%include e-macros)
17
18 (declare (special MCS-editing-characters)
19 (*expr self-insert))
20
21 (defun rubout-character macro (form) '(ItoC (cadr MCS-editing-characters)))
22
23 (defun overwrite-mode ()
24 (assert-minor-mode 'overwrite)
25 (set-key 'esc-D 'overwrite-mode-delete-word)
26 (set-key 'esc-# 'overwrite-mode-rubout-word)
27 (set-key 'esc-\177 'overwrite-mode-rubout-word)
28 (set-key (rubout-character) 'overwrite-mode-rubout-char)
29 (set-key '\177 'overwrite-mode-rubout-char)
30 (set-key '^D 'overwrite-mode-delete-char)
31 (map-over-emacs-commands
32 '(lambda (sym fun arg)
33 (and (eq fun 'self-insert)
34 (set-key sym 'overwrite-mode-self-insert))
35 arg)
36 nil))
37
38 (defprop overwrite-off overwrite-mode-off expr)
39 (defprop overwriteoff overwrite-mode-off expr)
40
41 (defun overwrite-mode-off ()
42 (negate-minor-mode 'overwrite)
43 (set-key 'esc-D 'delete-word)
44 (set-key 'esc-# 'rubout-word)
45 (set-key 'esc-\177 'rubout-word)
46 (set-key (rubout-character) 'rubout-char)
47 (set-key '\177 'rubout-char)
48 (set-key '^D 'delete-char)
49 (map-over-emacs-commands
50 '(lambda (sym fun arg)
51 (and (eq fun 'overwrite-mode-self-insert)
52 (set-key sym 'self-insert))
53 arg)
54 nil))
55
56 (defun overwrite-mode-self-insert ()
57 (or (eolp)(delete-char))
58 (self-insert))
59
60 (defun overwrite-mode-delete-char ()
61 (if (not (eolp))
62 (delete-char)
63 (insert-char " ")))
64
65
66
67
68
69
70
71
72
73
74 (defun overwrite-mode-rubout-char ()
75 (or (bolp)(progn (backward-char)
76 (delete-char)
77 (insert-char " ")
78 (backward-char))))
79
80 (defprop overwrite-mode-delete-word forward kills)
81 (defun overwrite-mode-delete-word ()
82 (with-mark m
83 (forward-word)
84 (let ((hp (cur-hpos)))
85 (kill-backwards-to-mark m)
86 (spaces-to-hpos hp)))
87 (merge-kills-forward))
88
89 (defprop overwrite-mode-rubout-word reverse kills)
90 (defun overwrite-mode-rubout-word ()
91 (with-mark m
92 (let ((hpos (cur-hpos)))
93 (backward-word)
94 (kill-forward-to-mark m)
95 (merge-kills-reverse)
96 (save-excursion
97 (spaces-to-hpos hpos)))))
98
99 (defun spaces-to-hpos (x)
100 (do ((hpdiff (- x (cur-hpos)) (1- hpdiff)))
101 ((< hpdiff 1))
102 (insert-char " ")))
103
104 (defun overwrite-mode-insert-string (string)
105 (with-mark start
106 (let ((start-pos curpointpos))
107 (go-to-end-of-line)
108 (if (< (- curpointpos start-pos) (stringlength string))
109 (kill-backwards-to-mark start)
110 else
111 (go-to-mark start)
112 (do-times (stringlength string) (delete-char)))))
113 (insert-string string))