|
|
1.1 root 1: ;; Copyright (C) 1986 Free Software Foundation, Inc.
2: ;; It started from public domain code by Mike Clarkson
3: ;; but has been greatly altered.
4:
5: ;; This file is part of GNU Emacs.
6:
7: ;; GNU Emacs is distributed in the hope that it will be useful,
8: ;; but WITHOUT ANY WARRANTY. No author or distributor
9: ;; accepts responsibility to anyone for the consequences of using it
10: ;; or for whether it serves any particular purpose or works at all,
11: ;; unless he says so in writing. Refer to the GNU Emacs General Public
12: ;; License for full details.
13:
14: ;; Everyone is granted permission to copy, modify and redistribute
15: ;; GNU Emacs, but only under the conditions described in the
16: ;; GNU Emacs General Public License. A copy of this license is
17: ;; supposed to have been given to you along with GNU Emacs so you
18: ;; can know your rights and responsibilities. It should be in a
19: ;; file named COPYING. Among other things, the copyright notice
20: ;; and this notice must be preserved on all copies.
21:
22: (require 'keypad)
23:
24: (defvar edt-last-deleted-lines ""
25: "Last text deleted by an EDT emulation line-delete command.")
26: (defvar edt-last-deleted-words ""
27: "Last text deleted by an EDT emulation word-delete command.")
28: (defvar edt-last-deleted-chars ""
29: "Last text deleted by an EDT emulation character-delete command.")
30:
31: (defun delete-current-line (num)
32: "Delete one or specified number of lines after point.
33: This includes the newline character at the end of each line.
34: They are saved for the EDT undelete-lines command."
35: (interactive "p")
36: (let ((beg (point)))
37: (forward-line num)
38: (if (not (eq (preceding-char) ?\n))
39: (insert "\n"))
40: (setq edt-last-deleted-lines
41: (buffer-substring beg (point)))
42: (delete-region beg (point))))
43:
44: (defun delete-to-eol (num)
45: "Delete text up to end of line.
46: With argument, delete up to to Nth line-end past point.
47: They are saved for the EDT undelete-lines command."
48: (interactive "p")
49: (let ((beg (point)))
50: (forward-char 1)
51: (end-of-line num)
52: (setq edt-last-deleted-lines
53: (buffer-substring beg (point)))
54: (delete-region beg (point))))
55:
56: (defun delete-current-word (num)
57: "Delete one or specified number of words after point.
58: They are saved for the EDT undelete-words command."
59: (interactive "p")
60: (let ((beg (point)))
61: (forward-word num)
62: (setq edt-last-deleted-words
63: (buffer-substring beg (point)))
64: (delete-region beg (point))))
65:
66: (defun delete-previous-word (num)
67: "Delete one or specified number of words before point.
68: They are saved for the EDT undelete-words command."
69: (interactive "p")
70: (let ((beg (point)))
71: (forward-word (- num))
72: (setq edt-last-deleted-words
73: (buffer-substring (point) beg))
74: (delete-region beg (point))))
75:
76: (defun delete-current-char (num)
77: "Delete one or specified number of characters after point.
78: They are saved for the EDT undelete-chars command."
79: (interactive "p")
80: (setq edt-last-deleted-chars
81: (buffer-substring (point) (min (point-max) (+ (point) num))))
82: (delete-region (point) (min (point-max) (+ (point) num))))
83:
84: (defun delete-previous-char (num)
85: "Delete one or specified number of characters before point.
86: They are saved for the EDT undelete-chars command."
87: (interactive "p")
88: (setq edt-last-deleted-chars
89: (buffer-substring (max (point-min) (- (point) num)) (point)))
90: (delete-region (max (point-min) (- (point) num)) (point)))
91:
92: (defun undelete-lines ()
93: "Yank lines deleted by last EDT line-deletion command."
94: (interactive)
95: (insert edt-last-deleted-lines))
96:
97: (defun undelete-words ()
98: "Yank words deleted by last EDT word-deletion command."
99: (interactive)
100: (insert edt-last-deleted-words))
101:
102: (defun undelete-chars ()
103: "Yank characters deleted by last EDT character-deletion command."
104: (interactive)
105: (insert edt-last-deleted-chars))
106:
107: (defun next-end-of-line (num)
108: "Move to end of line; if at end, move to end of next line.
109: Accepts a prefix argument for the number of lines to move."
110: (interactive "p")
111: (forward-char)
112: (end-of-line num))
113:
114: (defun previous-end-of-line (num)
115: "Move EOL upward.
116: Accepts a prefix argument for the number of lines to move."
117: (interactive "p")
118: (end-of-line (- 1 num)))
119:
120: (defun forward-to-word (num)
121: "Move to next word-beginning, or to Nth following word-beginning."
122: (interactive "p")
123: (forward-word (1+ num))
124: (forward-word -1))
125:
126: (defun backward-to-word (num)
127: "Move back to word-end, or to Nth word-end seen."
128: (interactive "p")
129: (forward-word (- (1+ num)))
130: (forward-word 1))
131:
132: (defun backward-line (num)
133: "Move point to start of previous line.
134: Prefix argument serves as repeat-count."
135: (interactive "p")
136: (forward-line (- num)))
137:
138: (defun scroll-window-down (num)
139: "Scroll the display down a window-full.
140: Accepts a prefix argument for the number of window-fulls to scroll."
141: (interactive "p")
142: (scroll-down (- (* (window-height) num) 2)))
143:
144: (defun scroll-window-up (num)
145: "Scroll the display up a window-full.
146: Accepts a prefix argument for the number of window-fulls to scroll."
147: (interactive "p")
148: (scroll-up (- (* (window-height) num) 2)))
149:
150: (defun next-paragraph (num)
151: "Move to beginning of the next indented paragraph.
152: Accepts a prefix argument for the number of paragraphs."
153: (interactive "p")
154: (while (> num 0)
155: (next-line 1)
156: (forward-paragraph)
157: (previous-line 1)
158: (if (eolp) (next-line 1))
159: (setq num (1- num))))
160:
161: (defun previous-paragraph (num)
162: "Move to beginning of previous indented paragraph.
163: Accepts a prefix argument for the number of paragraphs."
164: (interactive "p")
165: (while (> num 0)
166: (backward-paragraph)
167: (previous-line 1)
168: (if (eolp) (next-line 1))
169: (setq num (1- num))))
170:
171: (defun move-to-beginning ()
172: "Move cursor to the beginning of buffer, but don't set the mark."
173: (interactive)
174: (goto-char (point-min)))
175:
176: (defun move-to-end ()
177: "Move cursor to the end of buffer, but don't set the mark."
178: (interactive)
179: (goto-char (point-max)))
180:
181: (defun goto-percent (perc)
182: "Move point to ARG percentage of the buffer."
183: (interactive "NGoto-percentage: ")
184: (if (or (> perc 100) (< perc 0))
185: (error "Percentage %d out of range 0 < percent < 100" perc)
186: (goto-char (/ (* (point-max) perc) 100))))
187:
188: (defun update-mode-line ()
189: "Make sure mode-line in the current buffer reflects all changes."
190: (set-buffer-modified-p (buffer-modified-p))
191: (sit-for 0))
192:
193: (defun advance-direction ()
194: "Set EDT Advance mode so keypad commands move forward."
195: (interactive)
196: (setq edt-direction-string " ADVANCE")
197: (define-key function-keymap "\C-c" 'isearch-forward) ; PF3
198: (define-key function-keymap "8" 'scroll-window-up) ; "8"
199: (define-key function-keymap "7" 'next-paragraph) ; "7"
200: (define-key function-keymap "1" 'forward-to-word) ; "1"
201: (define-key function-keymap "2" 'next-end-of-line) ; "2"
202: (define-key function-keymap "3" 'forward-char) ; "3"
203: (define-key function-keymap "0" 'forward-line) ; "0"
204: (update-mode-line))
205:
206: (defun backup-direction ()
207: "Set EDT Backup mode so keypad commands move backward."
208: (interactive)
209: (setq edt-direction-string " BACKUP")
210: (define-key function-keymap "\C-c" 'isearch-backward) ; PF3
211: (define-key function-keymap "8" 'scroll-window-down) ; "8"
212: (define-key function-keymap "7" 'previous-paragraph) ; "7"
213: (define-key function-keymap "1" 'backward-to-word) ; "1"
214: (define-key function-keymap "2" 'previous-end-of-line) ; "2"
215: (define-key function-keymap "3" 'backward-char) ; "3"
216: (define-key function-keymap "0" 'backward-line) ; "0"
217: (update-mode-line))
218:
219: (defun beginning-of-window ()
220: "Home cursor to top of window."
221: (interactive)
222: (move-to-window-line 0))
223:
224: (defun line-to-bottom-of-window ()
225: "Move the current line to the top of the window."
226: (interactive)
227: (recenter -1))
228:
229: (defun line-to-top-of-window ()
230: "Move the current line to the top of the window."
231: (interactive)
232: (recenter 0))
233:
234: (defun case-flip-character (num)
235: "Change the case of the character under the cursor.
236: Accepts a prefix argument of the number of characters to invert."
237: (interactive "p")
238: (while (> num 0)
239: (funcall (if (<= ?a (following-char))
240: 'upcase-region 'downcase-region)
241: (point) (1+ (point)))
242: (forward-char 1)
243: (setq num (1- num))))
244:
245: (defun indent-or-fill-region ()
246: "Fill region in text modes, indent region in programming language modes."
247: (interactive)
248: (if (string= paragraph-start "^$\\|^")
249: (indent-region (point) (mark) nil)
250: (fill-region (point) (mark))))
251:
252: (defun mark-section-wisely ()
253: "Mark the section in a manner consistent with the major-mode.
254: Uses mark-defun for emacs-lisp, lisp,
255: mark-c-function for C,
256: and mark-paragraph for other modes."
257: (interactive)
258: (cond ((eq major-mode 'emacs-lisp-mode)
259: (mark-defun))
260: ((eq major-mode 'lisp-mode)
261: (mark-defun))
262: ((eq major-mode 'c-mode)
263: (mark-c-function))
264: (t (mark-paragraph))))
265:
266: ;;; Key Bindings
267: (defun edt-emulation-on ()
268: "Begin emulating DEC's EDT editor.
269: Certain keys are rebound; including nearly all keypad keys.
270: Use \\[edt-emulation-off] to undo all rebindings except the keypad keys.
271: Note that this function does not work if called directly from the .emacs file.
272: Instead, the .emacs file should do (setq term-setup-hook 'edt-emulation-on)
273: Then this function will be called at the time when it will work."
274: (interactive)
275: (advance-direction)
276: (edt-bind-gold-keypad) ;Must do this *after* $TERM.el is loaded
277: (setq edt-mode-old-c-\\ (lookup-key global-map "\C-\\"))
278: (global-set-key "\C-\\" 'quoted-insert)
279: (setq edt-mode-old-delete (lookup-key global-map "\177"))
280: (global-set-key "\177" 'delete-previous-char) ;"Delete"
281: (setq edt-mode-old-lisp-delete (lookup-key emacs-lisp-mode-map "\177"))
282: (define-key emacs-lisp-mode-map "\177" 'delete-previous-char) ;"Delete"
283: (define-key lisp-mode-map "\177" 'delete-previous-char) ;"Delete"
284: (setq edt-mode-old-linefeed (lookup-key global-map "\C-j"))
285: (global-set-key "\C-j" 'delete-previous-word) ;"LineFeed"
286: (define-key esc-map "?" 'apropos)) ;"<ESC>?"
287:
288: (defun edt-emulation-off ()
289: "Return from EDT emulation to normal Emacs key bindings.
290: The keys redefined by \\[edt-emulation-on] are given their old definitions."
291: (interactive)
292: (setq edt-direction-string nil)
293: (global-set-key "\C-\\" edt-mode-old-c-\\)
294: (global-set-key "\177" edt-mode-old-delete) ;"Delete"
295: (define-key emacs-lisp-mode-map "\177" edt-mode-old-lisp-delete) ;"Delete"
296: (define-key lisp-mode-map "\177" edt-mode-old-lisp-delete) ;"Delete"
297: (global-set-key "\C-j" edt-mode-old-linefeed)) ;"LineFeed"
298:
299: (define-key function-keymap "u" 'previous-line) ;Up arrow
300: (define-key function-keymap "d" 'next-line) ;down arrow
301: (define-key function-keymap "l" 'backward-char) ;right arrow
302: (define-key function-keymap "r" 'forward-char) ;left arrow
303: (define-key function-keymap "h" 'beginning-of-window) ;home
304: (define-key function-keymap "\C-b" 'describe-key) ;PF2
305: (define-key function-keymap "\C-d" 'delete-current-line);PF4
306: (define-key function-keymap "9" 'append-to-buffer) ;9 keypad key, etc.
307: (define-key function-keymap "-" 'delete-current-word)
308: (define-key function-keymap "4" 'advance-direction)
309: (define-key function-keymap "5" 'backup-direction)
310: (define-key function-keymap "6" 'kill-region)
311: (define-key function-keymap "," 'delete-current-char)
312: (define-key function-keymap "." 'set-mark-command)
313: (define-key function-keymap "e" 'other-window) ;enter key
314: (define-key function-keymap "\C-a" 'GOLD-prefix) ;PF1 ("gold")
315:
316: (setq GOLD-map (make-keymap))
317: (fset 'GOLD-prefix GOLD-map)
318:
319: (defvar GOLD-map nil
320: "GOLD-map maps the function keys on the VT100 keyboard preceeded
321: by the PF1 key. GOLD is the ASCII the 7-bit escape sequence <ESC>OP.")
322:
323: (defun define-keypad-key (keymap function-keymap-slot definition)
324: (let ((function-key-sequence (function-key-sequence function-keymap-slot)))
325: (if function-key-sequence
326: (define-key keymap function-key-sequence definition))))
327:
328: ;;Bind GOLD/Keyboard keys
329:
330: (define-key GOLD-map "\C-g" 'keyboard-quit) ; just for safety
331: (define-key GOLD-map "\177" 'delete-window) ;"Delete"
332: (define-key GOLD-map "\C-h" 'delete-other-windows) ;"BackSpace"
333: (define-key GOLD-map "\C-m" 'newline-and-indent) ;"Return"
334: (define-key GOLD-map " " 'undo) ;"Spacebar"
335: (define-key GOLD-map "%" 'goto-percent) ; "%"
336: (define-key GOLD-map "=" 'goto-line) ; "="
337: (define-key GOLD-map "`" 'what-line) ; "`"
338: (define-key GOLD-map "\C-\\" 'split-window-vertically) ; "Control-\"
339:
340: ; GOLD letter combinations:
341: (define-key GOLD-map "b" 'buffer-menu) ; "b"
342: (define-key GOLD-map "B" 'buffer-menu) ; "B"
343: (define-key GOLD-map "d" 'delete-window) ; "d"
344: (define-key GOLD-map "D" 'delete-window) ; "D"
345: (define-key GOLD-map "e" 'compile) ; "e"
346: (define-key GOLD-map "E" 'compile) ; "E"
347: (define-key GOLD-map "i" 'insert-file) ; "i"
348: (define-key GOLD-map "I" 'insert-file) ; "I"
349: (define-key GOLD-map "l" 'goto-line) ; "l"
350: (define-key GOLD-map "L" 'goto-line) ; "L"
351: (define-key GOLD-map "m" 'save-some-buffers) ; "m"
352: (define-key GOLD-map "M" 'save-some-buffers) ; "m"
353: (define-key GOLD-map "n" 'next-error) ; "n"
354: (define-key GOLD-map "N" 'next-error) ; "N"
355: (define-key GOLD-map "o" 'switch-to-buffer-other-window) ; "o"
356: (define-key GOLD-map "O" 'switch-to-buffer-other-window) ; "O"
357: (define-key GOLD-map "r" 'revert-file) ; "r"
358: (define-key GOLD-map "r" 'revert-file) ; "R"
359: (define-key GOLD-map "s" 'save-buffer) ; "s"
360: (define-key GOLD-map "S" 'save-buffer) ; "S"
361: (define-key GOLD-map "v" 'find-file-other-window) ; "v"
362: (define-key GOLD-map "V" 'find-file-other-window) ; "V"
363: (define-key GOLD-map "w" 'write-file) ; "w"
364: (define-key GOLD-map "w" 'write-file) ; "W"
365: ;(define-key GOLD-map "z" 'shrink-window) ; "z"
366: ;(define-key GOLD-map "Z" 'shrink-window) ; "z"
367:
368: ;Bind GOLD/Keypad keys
369: (defun edt-bind-gold-keypad ()
370: (define-keypad-key GOLD-map ?u 'line-to-top-of-window) ;"up-arrow"
371: (define-keypad-key GOLD-map ?d 'line-to-bottom-of-window) ;"down-arrow"
372: (define-keypad-key GOLD-map ?l 'backward-sentence) ;"left-arrow"
373: (define-keypad-key GOLD-map ?r 'forward-sentence) ;"right-arrow"
374: (define-keypad-key GOLD-map ?\C-a 'mark-section-wisely) ;Gold "PF1"
375: (define-keypad-key GOLD-map ?\C-b 'describe-function) ;Help "PF2"
376: (define-keypad-key GOLD-map ?\C-c 'occur) ;Find "PF3"
377: (define-keypad-key GOLD-map ?\C-d 'undelete-lines) ;Und Line "PF4"
378: (define-keypad-key GOLD-map ?0 'open-line) ;Open L "0"
379: (define-keypad-key GOLD-map ?1 'case-flip-character) ;Chgcase "1"
380: (define-keypad-key GOLD-map ?2 'delete-to-eol) ;Del EOL "2"
381: (define-keypad-key GOLD-map ?3 'copy-region-as-kill) ;Copy "3"
382: (define-keypad-key GOLD-map ?4 'move-to-end) ;Bottom "4"
383: (define-keypad-key GOLD-map ?5 'move-to-beginning) ;Top "5"
384: (define-keypad-key GOLD-map ?6 'yank) ;Paste "6"
385: (define-keypad-key GOLD-map ?7 'execute-extended-command) ;Command "7"
386: (define-keypad-key GOLD-map ?8 'indent-or-fill-region) ;Fill "8"
387: (define-keypad-key GOLD-map ?9 'replace-regexp) ;Replace "9"
388: (define-keypad-key GOLD-map ?- 'undelete-words) ;UND word "-"
389: (define-keypad-key GOLD-map ?, 'undelete-chars) ;UND Char ","
390: (define-keypad-key GOLD-map ?. 'redraw-display) ;Reset Window "."
391: (define-keypad-key GOLD-map ?e 'shell-command)) ;"ENTER"
392:
393: ;; Make direction of motion show in mode line
394: ;; while EDT emulation is turned on.
395: ;; Note that the keypad is always turned on when in Emacs.
396:
397: (or (assq 'edt-direction-string minor-mode-alist)
398: (setq minor-mode-alist (cons '(edt-direction-string edt-direction-string)
399: minor-mode-alist)))
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.