Mercurial > hg > xemacs-beta

comparison lisp/emulators/edt.el @ 72:b9518feda344 r20-0b31

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-0b31
author cvs
date Mon, 13 Aug 2007 09:03:46 +0200
parents 131b0175ea99
children 6608ceec7cf8
comparison
equal deleted inserted replaced
71:bae944334fa4 72:b9518feda344
1 ;;; edt.el --- EDT emulation in Emacs 1 ;;; edt.el --- Enhanced EDT Keypad Mode Emulation for GNU Emacs 19
2
3 ;; Copyright (C) 1986, 1992, 1993, 1994, 1995 Free Software Foundation, Inc.
4
5 ;; Author: Kevin Gallagher <kgallagh@spd.dsccc.com>
6 ;; Maintainer: Kevin Gallagher <kgallagh@spd.dsccc.com>
2 ;; Keywords: emulations 7 ;; Keywords: emulations
3
4 ;; Copyright (C) 1986 Free Software Foundation, Inc.
5 ;; It started from public domain code by Mike Clarkson
6 ;; but has been greatly altered.
7 8
8 ;; This file is part of XEmacs. 9 ;; This file is part of XEmacs.
9 10
10 ;; XEmacs is free software; you can redistribute it and/or modify it 11 ;; XEmacs is free software; you can redistribute it and/or modify it
11 ;; under the terms of the GNU General Public License as published by 12 ;; under the terms of the GNU General Public License as published by
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
18 ;; General Public License for more details. 19 ;; General Public License for more details.
19 20
20 ;; You should have received a copy of the GNU General Public License 21 ;; You should have received a copy of the GNU General Public License
21 ;; along with XEmacs; see the file COPYING. If not, write to the Free 22 ;; along with XEmacs; see the file COPYING. If not, write to the Free
22 ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. 23 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
23 24 ;; 02111-1307, USA.
24 25
25 ;; From mike@yetti.UUCP Fri Aug 29 12:49:28 1986 26 ;;; Synched up with: FSF 19.34
26 ;; Path: mit-prep!mit-hermes!mit-eddie!genrad!panda!husc6!seismo!mnetor!yetti!mike 27
27 ;; From: mike@yetti.UUCP (Mike Clarkson ) 28 ;;; Usage:
28 ;; Newsgroups: net.sources 29
29 ;; Subject: Gnu Emacs EDT Emulation - Introduction - 1/3 30 ;; See edt-user.doc in the Emacs etc directory.
30 ;; Date: 27 Aug 86 23:30:33 GMT 31
31 ;; Reply-To: mike@yetti.UUCP (Mike Clarkson ) 32 ;; Maintainer's note: There was a very old edt.el here that wouldn't even
32 ;; Organization: York University Computer Science 33 ;; load, so I replaced it completely with the newer one from 19.34. -sb
33 ;; 34 ;; ====================================================================
34 ;; Here's my EDT emulation for GNU Emacs that is based on the EDT emulation 35
35 ;; for Gosling's Emacs sent out on the net a couple of years ago by Lynn Olson 36 ;;; Electric Help functions are used for keypad help displays. A few
36 ;; at Tektronics. This emulation was widely distributed as the file edt.ml 37 ;;; picture functions are used in rectangular cut and paste commands.
37 ;; in the maclib directory of most Emacs distributions. 38 (require 'ehelp)
38 ;; 39 (require 'picture)
39 ;; My emulation consists of two files: edt.el and edtdoc.el. The edtdoc.el file 40
40 ;; is the documentation, that you can add to the beginning of edt.el if you 41 ;;;;
41 ;; want. I have split them because I have been loading the edt.el file a lot 42 ;;;; VARIABLES and CONSTANTS
42 ;; during debugging. 43 ;;;;
43 ;;
44 ;; I will gladly take all criticisms and complaints to heart, and will fix
45 ;; what bugs I can find. As this is my first elisp hack, you may have to
46 ;; root out a few nasties hidden in the code. Please let me know if you
47 ;; find any (sorry,
48 ;; no rewards :-). I would also be interested if there are better,
49 ;; cleaner, faster ways of doing some of the things that I have done.
50 ;;
51 ;; You must understand some design considerations that I had in mind.
52 ;; The intention was not really to "emulate" EDT, but rather to take advantage
53 ;; of the years of EDT experience that had accumulated in my right hand,
54 ;; while at the same time taking advantage of EMACS.
55 ;;
56 ;; Some major differences are:
57 ;;
58 ;; HELP is describe-key;
59 ;; GOLD/HELP is describe-function;
60 ;; FIND is isearch-forward/backward;
61 ;; GOLD/HELP is occur-menu, which finds all occurrences of a search string;
62 ;; ENTER is other-window;
63 ;; SUBS is subprocess-command. Note that you will have to change this
64 ;; yourself to shell if you are running Un*x;
65 ;; PAGE is next-paragraph, because that's more useful than page.
66 ;; SPECINS is copy-to-killring;
67 ;; GOLD/GOLD is mark-section-wisely, which is my command to mark the
68 ;; section in a manner consistent with the major-mode. It
69 ;; uses mark-defun for emacs-lisp, lisp, mark-c-function for C,
70 ;; and mark-paragraph for other modes.
71 ;;
72 ;;
73 ;; Some subtle differences are:
74 ;;
75 ;; APPEND is append-to-buffer. One doesn't append to the kill ring much
76 ;; and SPECINS is now copy-to-killring;
77 ;; REPLACE is replace-regexp;
78 ;; FILL is fill-region-wisely, which uses indent-region for C, lisp
79 ;; emacs-lisp, and fill-region for others. It asks if you really
80 ;; want to fill-region in TeX-mode, because I find this to be
81 ;; very dangerous.
82 ;; CHNGCASE is case-flip for the character under the cursor only.
83 ;; I felt that case-flip region is unlikely, as usually you
84 ;; upcase-region or downcase region. Also, unlike EDT it
85 ;; is independent of the direction you are going, as that
86 ;; drives me nuts.
87 ;;
88 ;; I use Emacs definition of what a word is. This is considerably different from
89 ;; what EDT thinks a word is. This is not good for dyed-in-the-wool EDT fans,
90 ;; but is probably preferable for experienced Emacs users. My assumption is that
91 ;; the former are a dying breed now that GNU Emacs has made it to VMS, but let me
92 ;; know how you feel. Also, when you undelete a word it leave the point at the
93 ;; end of the undeleted text, rather than the beginning. I might change this
94 ;; as I'm not sure if I like this or not. I'm also not sure if I want it to
95 ;; set the mark each time you delete a character or word.
96 ;;
97 ;; Backspace does not invoke beginning-of-line, because ^H is the help prefix,
98 ;; and I felt it should be left as such. You can change this if you like.
99 ;;
100 ;; The ADVANCE and BACKUP keys do not work as terminators for forward or
101 ;; backward searches. In Emacs, all search strings are terminated by return.
102 ;; The searches will however go forward or backward depending on your current
103 ;; direction. Also, when you change directions, the mode line will not be
104 ;; updated immediately, but only when you next execute an emacs function.
105 ;; Personally, I consider this to be a bug, not a feature.
106 ;;
107 ;; This should also work with VT-2xx's, though I haven't tested it extensively
108 ;; on those terminals. It assumes that the CSI-map of vt_200.el has been defined.
109 ;;
110 ;; There are also a whole bunch of GOLD letter, and GOLD character bindings:
111 ;; look at edtdoc.el for them, or better still, look at the edt.el lisp code,
112 ;; because after all, in the true Lisp tradition, the source code is *assumed*
113 ;; to be self-documenting :-)
114 ;;
115 ;; Mike Clarkson, ...!allegra \ BITNET: mike@YUYETTI or
116 ;; CRESS, York University, ...!decvax \ SYMALG@YUSOL
117 ;; 4700 Keele Street, ...!ihnp4 > !utzoo!yetti!mike
118 ;; North York, Ontario, ...!linus /
119 ;; CANADA M3J 1P3. ...!watmath / Phone: +1 (416) 736-2100 x 7767
120 ;;
121 ;; Note that I am not on ARPA, and must gateway any ARPA mail through BITNET or
122 ;; UUCP. If you have a UUCP or BITNET address please use it for communication
123 ;; so that I can reach you directly. If you have both, the BITNET address
124 ;; is preferred.
125 ;; --
126 ;; Mike Clarkson, ...!allegra \ BITNET: mike@YUYETTI or
127 ;; CRESS, York University, ...!decvax \ SYMALG@YUSOL
128 ;; 4700 Keele Street, ...!ihnp4 > !utzoo!yetti!mike
129 ;; North York, Ontario, ...!linus /
130 ;; CANADA M3J 1P3. ...!watmath / Phone: +1 (416) 737-2100 x 7767
131
132
133 (require 'keypad)
134 44
135 (defvar edt-last-deleted-lines "" 45 (defvar edt-last-deleted-lines ""
136 "Last text deleted by an EDT emulation line-delete command.") 46 "Last text deleted by an EDT emulation line delete command.")
47
137 (defvar edt-last-deleted-words "" 48 (defvar edt-last-deleted-words ""
138 "Last text deleted by an EDT emulation word-delete command.") 49 "Last text deleted by an EDT emulation word delete command.")
50
139 (defvar edt-last-deleted-chars "" 51 (defvar edt-last-deleted-chars ""
140 "Last text deleted by an EDT emulation character-delete command.") 52 "Last text deleted by an EDT emulation character delete command.")
141 53
142 (defun delete-current-line (num) 54 (defvar edt-last-replaced-key-definition ""
143 "Delete one or specified number of lines after point. 55 "Key definition replaced with edt-define-key or edt-learn command.")
144 This includes the newline character at the end of each line. 56
145 They are saved for the EDT undelete-lines command." 57 (defvar edt-direction-string ""
146 (interactive "p") 58 "String indicating current direction of movement.")
59
60 (defvar edt-select-mode nil
61 "Non-nil means select mode is active.")
62
63 (defvar edt-select-mode-text ""
64 "Text displayed in mode line when select mode is active.")
65
66 (defconst edt-select-mode-string " Select"
67 "String to indicate select mode is active.")
68
69 (defconst edt-forward-string " ADVANCE"
70 "Direction string in mode line to indicate forward movement.")
71
72 (defconst edt-backward-string " BACKUP"
73 "Direction string in mode line to indicate backward movement.")
74
75 (defvar edt-default-map-active nil
76 "Non-nil indicates that default EDT emulation key bindings are active.
77 Nil means user-defined custom bindings are active.")
78
79 (defvar edt-user-map-configured nil
80 "Non-nil indicates that user custom EDT key bindings are configured.
81 This means that an edt-user.el file was found in the user's load-path.")
82
83 (defvar edt-keep-current-page-delimiter nil
84 "Non-nil leaves current value of page-delimiter unchanged.
85 Nil causes the page-delimiter variable to be set to to \"\\f\"
86 when edt-emulation-on is first invoked. Original value is restored
87 when edt-emulation-off is called.")
88
89 (defvar edt-use-EDT-control-key-bindings nil
90 "Non-nil causes the control key bindings to be replaced with EDT bindings.
91 Nil (the default) means EDT control key bindings are not used and the current
92 control key bindings are retained for use in the EDT emulation.")
93
94 (defvar edt-word-entities '(?\t)
95 "*Specifies the list of EDT word entity characters.")
96
97 ;;;
98 ;;; Emacs version identifiers - currently referenced by
99 ;;;
100 ;;; o edt-emulation-on o edt-load-xkeys
101 ;;;
102 (defconst edt-emacs19-p (not (string-lessp emacs-version "19"))
103 "Non-nil if we are running Lucid or GNU Emacs version 19.")
104
105 (defconst edt-lucid-emacs19-p
106 (and edt-emacs19-p (string-match "Lucid" emacs-version))
107 "Non-nil if we are running Lucid Emacs version 19.")
108
109 (defconst edt-gnu-emacs19-p (and edt-emacs19-p (not edt-lucid-emacs19-p))
110 "Non-nil if we are running GNU Emacs version 19.")
111
112 (defvar edt-xkeys-file nil
113 "File mapping X function keys to LK-201 keyboard function and keypad keys.")
114
115 ;;;;
116 ;;;; EDT Emulation Commands
117 ;;;;
118
119 ;;; Almost all of EDT's keypad mode commands have equivalent
120 ;;; counterparts in Emacs. Some behave the same way in Emacs as they
121 ;;; do in EDT, but most do not.
122 ;;;
123 ;;; The following Emacs functions emulate, where practical, the exact
124 ;;; behavior of the corresponding EDT keypad mode commands. In a few
125 ;;; cases, the emulation is not exact, but it is close enough for most
126 ;;; EDT die-hards.
127 ;;;
128 ;;; In a very few cases, we chose to use the superior Emacs way of
129 ;;; handling things. For example, we do not emulate the EDT SUBS
130 ;;; command. Instead, we chose to use the superior Emacs
131 ;;; query-replace function.
132 ;;;
133
134 ;;;
135 ;;; PAGE
136 ;;;
137 ;;; Emacs uses the regexp assigned to page-delimiter to determine what
138 ;;; marks a page break. This is normally "^\f", which causes the
139 ;;; edt-page command to ignore form feeds not located at the beginning
140 ;;; of a line. To emulate the EDT PAGE command exactly,
141 ;;; page-delimiter is set to "\f" when EDT emulation is turned on, and
142 ;;; restored to its original value when EDT emulation is turned off.
143 ;;; But this can be overridden if the EDT definition is not desired by
144 ;;; placing
145 ;;;
146 ;;; (setq edt-keep-current-page-delimiter t)
147 ;;;
148 ;;; in your .emacs file.
149
150 (defun edt-page-forward (num)
151 "Move forward to just after next page delimiter.
152 Accepts a positive prefix argument for the number of page delimiters to move."
153 (interactive "p")
154 (edt-check-prefix num)
155 (if (eobp)
156 (error "End of buffer")
157 (progn
158 (forward-page num)
159 (if (eobp)
160 (edt-line-to-bottom-of-window)
161 (edt-line-to-top-of-window)))))
162
163 (defun edt-page-backward (num)
164 "Move backward to just after previous page delimiter.
165 Accepts a positive prefix argument for the number of page delimiters to move."
166 (interactive "p")
167 (edt-check-prefix num)
168 (if (bobp)
169 (error "Beginning of buffer")
170 (progn
171 (backward-page num)
172 (edt-line-to-top-of-window))))
173
174 (defun edt-page (num)
175 "Move in current direction to next page delimiter.
176 Accepts a positive prefix argument for the number of page delimiters to move."
177 (interactive "p")
178 (if (equal edt-direction-string edt-forward-string)
179 (edt-page-forward num)
180 (edt-page-backward num)))
181
182 ;;;
183 ;;; SECT
184 ;;;
185 ;;; EDT defaults a section size to be 16 lines of its one and only
186 ;;; 24-line window. That's two-thirds of the window at a time. The
187 ;;; EDT SECT commands moves the cursor, not the window.
188 ;;;
189 ;;; This emulation of EDT's SECT moves the cursor approximately two-thirds
190 ;;; of the current window at a time.
191
192 (defun edt-sect-forward (num)
193 "Move cursor forward two-thirds of a window.
194 Accepts a positive prefix argument for the number of sections to move."
195 (interactive "p")
196 (edt-check-prefix num)
197 (edt-line-forward (* (* (/ (- (window-height) 1) 3) 2) num)))
198
199 (defun edt-sect-backward (num)
200 "Move cursor backward two-thirds of a window.
201 Accepts a positive prefix argument for the number of sections to move."
202 (interactive "p")
203 (edt-check-prefix num)
204 (edt-line-backward (* (* (/ (- (window-height) 1) 3) 2) num)))
205
206 (defun edt-sect (num)
207 "Move in current direction a full window.
208 Accepts a positive prefix argument for the number windows to move."
209 (interactive "p")
210 (if (equal edt-direction-string edt-forward-string)
211 (edt-sect-forward num)
212 (edt-sect-backward num)))
213
214 ;;;
215 ;;; BEGINNING OF LINE
216 ;;;
217 ;;; EDT's beginning-of-line command is not affected by current
218 ;;; direction, for some unknown reason.
219
220 (defun edt-beginning-of-line (num)
221 "Move backward to next beginning of line mark.
222 Accepts a positive prefix argument for the number of BOL marks to move."
223 (interactive "p")
224 (edt-check-prefix num)
225 (if (bolp)
226 (forward-line (* -1 num))
227 (progn
228 (setq num (1- num))
229 (forward-line (* -1 num)))))
230
231 ;;;
232 ;;; EOL (End of Line)
233 ;;;
234
235 (defun edt-end-of-line-forward (num)
236 "Move forward to next end of line mark.
237 Accepts a positive prefix argument for the number of EOL marks to move."
238 (interactive "p")
239 (edt-check-prefix num)
240 (forward-char)
241 (end-of-line num))
242
243 (defun edt-end-of-line-backward (num)
244 "Move backward to next end of line mark.
245 Accepts a positive prefix argument for the number of EOL marks to move."
246 (interactive "p")
247 (edt-check-prefix num)
248 (end-of-line (1- num)))
249
250 (defun edt-end-of-line (num)
251 "Move in current direction to next end of line mark.
252 Accepts a positive prefix argument for the number of EOL marks to move."
253 (interactive "p")
254 (if (equal edt-direction-string edt-forward-string)
255 (edt-end-of-line-forward num)
256 (edt-end-of-line-backward num)))
257
258 ;;;
259 ;;; WORD
260 ;;;
261 ;;; This one is a tad messy. To emulate EDT's behavior everywhere in
262 ;;; the file (beginning of file, end of file, beginning of line, end
263 ;;; of line, etc.) it takes a bit of special handling.
264 ;;;
265 ;;; The variable edt-word-entities contains a list of characters which
266 ;;; are to be viewed as distinct words where ever they appear in the
267 ;;; buffer. This emulates the EDT line mode command SET ENTITY WORD.
268
269
270 (defun edt-one-word-forward ()
271 "Move forward to first character of next word."
272 (interactive)
273 (if (eobp)
274 (error "End of buffer"))
275 (if (eolp)
276 (forward-char)
277 (progn
278 (if (memq (following-char) edt-word-entities)
279 (forward-char)
280 (while (and
281 (not (eolp))
282 (not (eobp))
283 (not (eq ?\ (char-syntax (following-char))))
284 (not (memq (following-char) edt-word-entities)))
285 (forward-char)))
286 (while (and
287 (not (eolp))
288 (not (eobp))
289 (eq ?\ (char-syntax (following-char)))
290 (not (memq (following-char) edt-word-entities)))
291 (forward-char)))))
292
293 (defun edt-one-word-backward ()
294 "Move backward to first character of previous word."
295 (interactive)
296 (if (bobp)
297 (error "Beginning of buffer"))
298 (if (bolp)
299 (backward-char)
300 (progn
301 (backward-char)
302 (while (and
303 (not (bolp))
304 (not (bobp))
305 (eq ?\ (char-syntax (following-char)))
306 (not (memq (following-char) edt-word-entities)))
307 (backward-char))
308 (if (not (memq (following-char) edt-word-entities))
309 (while (and
310 (not (bolp))
311 (not (bobp))
312 (not (eq ?\ (char-syntax (preceding-char))))
313 (not (memq (preceding-char) edt-word-entities)))
314 (backward-char))))))
315
316 (defun edt-word-forward (num)
317 "Move forward to first character of next word.
318 Accepts a positive prefix argument for the number of words to move."
319 (interactive "p")
320 (edt-check-prefix num)
321 (while (> num 0)
322 (edt-one-word-forward)
323 (setq num (1- num))))
324
325 (defun edt-word-backward (num)
326 "Move backward to first character of previous word.
327 Accepts a positive prefix argument for the number of words to move."
328 (interactive "p")
329 (edt-check-prefix num)
330 (while (> num 0)
331 (edt-one-word-backward)
332 (setq num (1- num))))
333
334 (defun edt-word (num)
335 "Move in current direction to first character of next word.
336 Accepts a positive prefix argument for the number of words to move."
337 (interactive "p")
338 (if (equal edt-direction-string edt-forward-string)
339 (edt-word-forward num)
340 (edt-word-backward num)))
341
342 ;;;
343 ;;; CHAR
344 ;;;
345
346 (defun edt-character (num)
347 "Move in current direction to next character.
348 Accepts a positive prefix argument for the number of characters to move."
349 (interactive "p")
350 (edt-check-prefix num)
351 (if (equal edt-direction-string edt-forward-string)
352 (forward-char num)
353 (backward-char num)))
354
355 ;;;
356 ;;; LINE
357 ;;;
358 ;;; When direction is set to BACKUP, LINE behaves just like BEGINNING
359 ;;; OF LINE in EDT. So edt-line-backward is not really needed as a
360 ;;; separate function.
361
362 (defun edt-line-backward (num)
363 "Move backward to next beginning of line mark.
364 Accepts a positive prefix argument for the number of BOL marks to move."
365 (interactive "p")
366 (edt-beginning-of-line num))
367
368 (defun edt-line-forward (num)
369 "Move forward to next beginning of line mark.
370 Accepts a positive prefix argument for the number of BOL marks to move."
371 (interactive "p")
372 (edt-check-prefix num)
373 (forward-line num))
374
375 (defun edt-line (num)
376 "Move in current direction to next beginning of line mark.
377 Accepts a positive prefix argument for the number of BOL marks to move."
378 (interactive "p")
379 (if (equal edt-direction-string edt-forward-string)
380 (edt-line-forward num)
381 (edt-line-backward num)))
382
383 ;;;
384 ;;; TOP
385 ;;;
386
387 (defun edt-top ()
388 "Move cursor to the beginning of buffer."
389 (interactive)
390 (goto-char (point-min)))
391
392 ;;;
393 ;;; BOTTOM
394 ;;;
395
396 (defun edt-bottom ()
397 "Move cursor to the end of buffer."
398 (interactive)
399 (goto-char (point-max))
400 (edt-line-to-bottom-of-window))
401
402 ;;;
403 ;;; FIND
404 ;;;
405
406 (defun edt-find-forward (&optional find)
407 "Find first occurrence of a string in forward direction and save it."
408 (interactive)
409 (if (not find)
410 (set 'search-last-string (read-string "Search forward: ")))
411 (if (search-forward search-last-string)
412 (search-backward search-last-string)))
413
414 (defun edt-find-backward (&optional find)
415 "Find first occurrence of a string in the backward direction and save it."
416 (interactive)
417 (if (not find)
418 (set 'search-last-string (read-string "Search backward: ")))
419 (search-backward search-last-string))
420
421 (defun edt-find ()
422 "Find first occurrence of string in current direction and save it."
423 (interactive)
424 (set 'search-last-string (read-string "Search: "))
425 (if (equal edt-direction-string edt-forward-string)
426 (edt-find-forward t)
427 (edt-find-backward t)))
428
429
430 ;;;
431 ;;; FNDNXT
432 ;;;
433
434 (defun edt-find-next-forward ()
435 "Find next occurrence of a string in forward direction."
436 (interactive)
437 (forward-char 1)
438 (if (search-forward search-last-string nil t)
439 (search-backward search-last-string)
440 (progn
441 (backward-char 1)
442 (error "Search failed: \"%s\"." search-last-string))))
443
444 (defun edt-find-next-backward ()
445 "Find next occurrence of a string in backward direction."
446 (interactive)
447 (if (eq (search-backward search-last-string nil t) nil)
448 (progn
449 (error "Search failed: \"%s\"." search-last-string))))
450
451 (defun edt-find-next ()
452 "Find next occurrence of a string in current direction."
453 (interactive)
454 (if (equal edt-direction-string edt-forward-string)
455 (edt-find-next-forward)
456 (edt-find-next-backward)))
457
458 ;;;
459 ;;; APPEND
460 ;;;
461
462 (defun edt-append ()
463 "Append this kill region to last killed region."
464 (interactive "*")
465 (edt-check-selection)
466 (append-next-kill)
467 (kill-region (mark) (point))
468 (message "Selected text APPENDED to kill ring"))
469
470 ;;;
471 ;;; DEL L
472 ;;;
473
474 (defun edt-delete-line (num)
475 "Delete from cursor up to and including the end of line mark.
476 Accepts a positive prefix argument for the number of lines to delete."
477 (interactive "*p")
478 (edt-check-prefix num)
147 (let ((beg (point))) 479 (let ((beg (point)))
148 (forward-line num) 480 (forward-line num)
149 (if (not (eq (preceding-char) ?\n)) 481 (if (not (eq (preceding-char) ?\n))
150 (insert "\n")) 482 (insert "\n"))
151 (setq edt-last-deleted-lines 483 (setq edt-last-deleted-lines
152 (buffer-substring beg (point))) 484 (buffer-substring beg (point)))
153 (delete-region beg (point)))) 485 (delete-region beg (point))))
154 486
155 (defun delete-to-eol (num) 487 ;;;
156 "Delete text up to end of line. 488 ;;; DEL EOL
157 With argument, delete up to to Nth line-end past point. 489 ;;;
158 They are saved for the EDT undelete-lines command." 490
159 (interactive "p") 491 (defun edt-delete-to-end-of-line (num)
492 "Delete from cursor up to but excluding the end of line mark.
493 Accepts a positive prefix argument for the number of lines to delete."
494 (interactive "*p")
495 (edt-check-prefix num)
160 (let ((beg (point))) 496 (let ((beg (point)))
161 (forward-char 1) 497 (forward-char 1)
162 (end-of-line num) 498 (end-of-line num)
163 (setq edt-last-deleted-lines 499 (setq edt-last-deleted-lines
164 (buffer-substring beg (point))) 500 (buffer-substring beg (point)))
165 (delete-region beg (point)))) 501 (delete-region beg (point))))
166 502
167 (defun delete-current-word (num) 503 ;;;
168 "Delete one or specified number of words after point. 504 ;;; SELECT
169 They are saved for the EDT undelete-words command." 505 ;;;
170 (interactive "p") 506
507 (defun edt-select-mode (arg)
508 "Turn EDT select mode off if ARG is nil; otherwise, turn EDT select mode on.
509 In select mode, selected text is highlighted."
510 (if arg
511 (progn
512 (make-local-variable 'edt-select-mode)
513 (setq edt-select-mode 'edt-select-mode-text)
514 (setq rect-start-point (window-point)))
515 (progn
516 (kill-local-variable 'edt-select-mode)))
517 (force-mode-line-update))
518
519 (defun edt-select ()
520 "Set mark at cursor and start text selection."
521 (interactive)
522 (set-mark-command nil))
523
524 (defun edt-reset ()
525 "Cancel text selection."
526 (interactive)
527 (deactivate-mark))
528
529 ;;;
530 ;;; CUT
531 ;;;
532
533 (defun edt-cut ()
534 "Deletes selected text but copies to kill ring."
535 (interactive "*")
536 (edt-check-selection)
537 (kill-region (mark) (point))
538 (message "Selected text CUT to kill ring"))
539
540 ;;;
541 ;;; DELETE TO BEGINNING OF LINE
542 ;;;
543
544 (defun edt-delete-to-beginning-of-line (num)
545 "Delete from cursor to beginning of line.
546 Accepts a positive prefix argument for the number of lines to delete."
547 (interactive "*p")
548 (edt-check-prefix num)
171 (let ((beg (point))) 549 (let ((beg (point)))
172 (forward-word num) 550 (edt-beginning-of-line num)
173 (setq edt-last-deleted-words 551 (setq edt-last-deleted-lines
174 (buffer-substring beg (point))) 552 (buffer-substring (point) beg))
175 (delete-region beg (point)))) 553 (delete-region beg (point))))
176 554
177 (defun edt-delete-previous-word (num) 555 ;;;
178 "Delete one or specified number of words before point. 556 ;;; DEL W
179 They are saved for the EDT undelete-words command." 557 ;;;
180 (interactive "p") 558
559 (defun edt-delete-word (num)
560 "Delete from cursor up to but excluding first character of next word.
561 Accepts a positive prefix argument for the number of words to delete."
562 (interactive "*p")
563 (edt-check-prefix num)
181 (let ((beg (point))) 564 (let ((beg (point)))
182 (forward-word (- num)) 565 (edt-word-forward num)
183 (setq edt-last-deleted-words 566 (setq edt-last-deleted-words (buffer-substring beg (point)))
184 (buffer-substring (point) beg))
185 (delete-region beg (point)))) 567 (delete-region beg (point))))
186 568
187 (defun delete-current-char (num) 569 ;;;
188 "Delete one or specified number of characters after point. 570 ;;; DELETE TO BEGINNING OF WORD
189 They are saved for the EDT undelete-chars command." 571 ;;;
190 (interactive "p") 572
573 (defun edt-delete-to-beginning-of-word (num)
574 "Delete from cursor to beginning of word.
575 Accepts a positive prefix argument for the number of words to delete."
576 (interactive "*p")
577 (edt-check-prefix num)
578 (let ((beg (point)))
579 (edt-word-backward num)
580 (setq edt-last-deleted-words (buffer-substring (point) beg))
581 (delete-region beg (point))))
582
583 ;;;
584 ;;; DEL C
585 ;;;
586
587 (defun edt-delete-character (num)
588 "Delete character under cursor.
589 Accepts a positive prefix argument for the number of characters to delete."
590 (interactive "*p")
591 (edt-check-prefix num)
191 (setq edt-last-deleted-chars 592 (setq edt-last-deleted-chars
192 (buffer-substring (point) (min (point-max) (+ (point) num)))) 593 (buffer-substring (point) (min (point-max) (+ (point) num))))
193 (delete-region (point) (min (point-max) (+ (point) num)))) 594 (delete-region (point) (min (point-max) (+ (point) num))))
194 595
195 (defun delete-previous-char (num) 596 ;;;
196 "Delete one or specified number of characters before point. 597 ;;; DELETE CHAR
197 They are saved for the EDT undelete-chars command." 598 ;;;
198 (interactive "p") 599
600 (defun edt-delete-previous-character (num)
601 "Delete character in front of cursor.
602 Accepts a positive prefix argument for the number of characters to delete."
603 (interactive "*p")
604 (edt-check-prefix num)
199 (setq edt-last-deleted-chars 605 (setq edt-last-deleted-chars
200 (buffer-substring (max (point-min) (- (point) num)) (point))) 606 (buffer-substring (max (point-min) (- (point) num)) (point)))
201 (delete-region (max (point-min) (- (point) num)) (point))) 607 (delete-region (max (point-min) (- (point) num)) (point)))
202 608
203 (defun undelete-lines () 609 ;;;
204 "Yank lines deleted by last EDT line-deletion command." 610 ;;; UND L
205 (interactive) 611 ;;;
206 (insert edt-last-deleted-lines)) 612
207 613 (defun edt-undelete-line ()
208 (defun undelete-words () 614 "Undelete previous deleted line(s)."
209 "Yank words deleted by last EDT word-deletion command." 615 (interactive "*")
210 (interactive) 616 (point-to-register 1)
211 (insert edt-last-deleted-words)) 617 (insert edt-last-deleted-lines)
212 618 (register-to-point 1))
213 (defun undelete-chars () 619
214 "Yank characters deleted by last EDT character-deletion command." 620 ;;;
215 (interactive) 621 ;;; UND W
216 (insert edt-last-deleted-chars)) 622 ;;;
217 623
218 (defun next-end-of-line (num) 624 (defun edt-undelete-word ()
219 "Move to end of line; if at end, move to end of next line. 625 "Undelete previous deleted word(s)."
220 Accepts a prefix argument for the number of lines to move." 626 (interactive "*")
221 (interactive "p") 627 (point-to-register 1)
222 (forward-char) 628 (insert edt-last-deleted-words)
223 (end-of-line num)) 629 (register-to-point 1))
224 630
225 (defun previous-end-of-line (num) 631 ;;;
226 "Move EOL upward. 632 ;;; UND C
227 Accepts a prefix argument for the number of lines to move." 633 ;;;
228 (interactive "p") 634
229 (end-of-line (- 1 num))) 635 (defun edt-undelete-character ()
230 636 "Undelete previous deleted character(s)."
231 (defun forward-to-word (num) 637 (interactive "*")
232 "Move to next word-beginning, or to Nth following word-beginning." 638 (point-to-register 1)
233 (interactive "p") 639 (insert edt-last-deleted-chars)
234 (forward-word (1+ num)) 640 (register-to-point 1))
235 (forward-word -1)) 641
236 642 ;;;
237 (defun backward-to-word (num) 643 ;;; REPLACE
238 "Move back to word-end, or to Nth word-end seen." 644 ;;;
239 (interactive "p") 645
240 (forward-word (- (1+ num))) 646 (defun edt-replace ()
241 (forward-word 1)) 647 "Replace marked section with last CUT (killed) text."
242 648 (interactive "*")
243 (defun backward-line (num) 649 (exchange-point-and-mark)
244 "Move point to start of previous line. 650 (let ((beg (point)))
245 Prefix argument serves as repeat-count." 651 (exchange-point-and-mark)
246 (interactive "p") 652 (delete-region beg (point)))
247 (forward-line (- num))) 653 (yank))
248 654
249 (defun scroll-window-down (num) 655 ;;;
250 "Scroll the display down a window-full. 656 ;;; ADVANCE
251 Accepts a prefix argument for the number of window-fulls to scroll." 657 ;;;
252 (interactive "p") 658
253 (scroll-down (- (* (window-height) num) 2))) 659 (defun edt-advance ()
254 660 "Set movement direction forward.
255 (defun scroll-window-up (num) 661 Also, execute command specified if in Minibuffer."
256 "Scroll the display up a window-full. 662 (interactive)
257 Accepts a prefix argument for the number of window-fulls to scroll." 663 (setq edt-direction-string edt-forward-string)
258 (interactive "p") 664 (force-mode-line-update)
259 (scroll-up (- (* (window-height) num) 2))) 665 (if (string-equal " *Minibuf"
260 666 (substring (buffer-name) 0 (min (length (buffer-name)) 9)))
261 (defun next-paragraph (num) 667 (exit-minibuffer)))
262 "Move to beginning of the next indented paragraph. 668
263 Accepts a prefix argument for the number of paragraphs." 669 ;;;
264 (interactive "p") 670 ;;; BACKUP
671 ;;;
672
673 (defun edt-backup ()
674 "Set movement direction backward.
675 Also, execute command specified if in Minibuffer."
676 (interactive)
677 (setq edt-direction-string edt-backward-string)
678 (force-mode-line-update)
679 (if (string-equal " *Minibuf"
680 (substring (buffer-name) 0 (min (length (buffer-name)) 9)))
681 (exit-minibuffer)))
682
683 ;;;
684 ;;; CHNGCASE
685 ;;;
686 ;; This function is based upon Jeff Kowalski's case-flip function in his
687 ;; tpu.el.
688
689 (defun edt-change-case (num)
690 "Change the case of specified characters.
691 If text selection IS active, then characters between the cursor and mark are
692 changed. If text selection is NOT active, there are two cases. First, if the
693 current direction is ADVANCE, then the prefix number of character(s) under and
694 following cursor are changed. Second, if the current direction is BACKUP, then
695 the prefix number of character(s) before the cursor are changed. Accepts a
696 positive prefix for the number of characters to change, but the prefix is
697 ignored if text selection is active."
698 (interactive "*p")
699 (edt-check-prefix num)
700 (if edt-select-mode
701 (let ((end (max (mark) (point)))
702 (point-save (point)))
703 (goto-char (min (point) (mark)))
704 (while (not (eq (point) end))
705 (funcall (if (<= ?a (following-char))
706 'upcase-region 'downcase-region)
707 (point) (1+ (point)))
708 (forward-char 1))
709 (goto-char point-save))
710 (progn
711 (if (string= edt-direction-string edt-backward-string)
712 (backward-char num))
713 (while (> num 0)
714 (funcall (if (<= ?a (following-char))
715 'upcase-region 'downcase-region)
716 (point) (1+ (point)))
717 (forward-char 1)
718 (setq num (1- num))))))
719
720 ;;;
721 ;;; DEFINE KEY
722 ;;;
723
724 (defun edt-define-key ()
725 "Assign an interactively-callable function to a specified key sequence.
726 The current key definition is saved in edt-last-replaced-key-definition.
727 Use edt-restore-key to restore last replaced key definition."
728 (interactive)
729 (let (edt-function
730 edt-key-definition-string)
731 (setq edt-key-definition-string
732 (read-key-sequence "Press the key to be defined: "))
733 (if (string-equal "\C-m" edt-key-definition-string)
734 (message "Key not defined")
735 (progn
736 (setq edt-function (read-command "Enter command name: "))
737 (if (string-equal "" edt-function)
738 (message "Key not defined")
739 (progn
740 (setq edt-last-replaced-key-definition
741 (lookup-key (current-global-map) edt-key-definition-string))
742 (define-key (current-global-map)
743 edt-key-definition-string edt-function)))))))
744
745 ;;;
746 ;;; FORM FEED INSERT
747 ;;;
748
749 (defun edt-form-feed-insert (num)
750 "Insert form feed character at cursor position.
751 Accepts a positive prefix argument for the number of form feeds to insert."
752 (interactive "*p")
753 (edt-check-prefix num)
754 (while (> num 0)
755 (insert ?\f)
756 (setq num (1- num))))
757
758 ;;;
759 ;;; TAB INSERT
760 ;;;
761
762 (defun edt-tab-insert (num)
763 "Insert tab character at cursor position.
764 Accepts a positive prefix argument for the number of tabs to insert."
765 (interactive "*p")
766 (edt-check-prefix num)
767 (while (> num 0)
768 (insert ?\t)
769 (setq num (1- num))))
770
771 ;;;
772 ;;; Check Prefix
773 ;;;
774
775 (defun edt-check-prefix (num)
776 "Indicate error if prefix is not positive."
777 (if (<= num 0)
778 (error "Prefix must be positive")))
779
780 ;;;
781 ;;; Check Selection
782 ;;;
783
784 (defun edt-check-selection ()
785 "Indicate error if EDT selection is not active."
786 (if (not edt-select-mode)
787 (error "Selection NOT active")))
788
789 ;;;;
790 ;;;; ENHANCEMENTS AND ADDITIONS FOR EDT KEYPAD MODE
791 ;;;;
792
793 ;;;
794 ;;; Several enhancements and additions to EDT keypad mode commands are
795 ;;; provided here. Some of these have been motivated by similar
796 ;;; TPU/EVE and EVE-Plus commands. Others are new.
797
798 ;;;
799 ;;; CHANGE DIRECTION
800 ;;;
801
802 (defun edt-change-direction ()
803 "Toggle movement direction."
804 (interactive)
805 (if (equal edt-direction-string edt-forward-string)
806 (edt-backup)
807 (edt-advance)))
808
809 ;;;
810 ;;; TOGGLE SELECT
811 ;;;
812
813 (defun edt-toggle-select ()
814 "Toggle to start (or cancel) text selection."
815 (interactive)
816 (if edt-select-mode
817 (edt-reset)
818 (edt-select)))
819
820 ;;;
821 ;;; SENTENCE
822 ;;;
823
824 (defun edt-sentence-forward (num)
825 "Move forward to start of next sentence.
826 Accepts a positive prefix argument for the number of sentences to move."
827 (interactive "p")
828 (edt-check-prefix num)
829 (if (eobp)
830 (progn
831 (error "End of buffer"))
832 (progn
833 (forward-sentence num)
834 (edt-one-word-forward))))
835
836 (defun edt-sentence-backward (num)
837 "Move backward to next sentence beginning.
838 Accepts a positive prefix argument for the number of sentences to move."
839 (interactive "p")
840 (edt-check-prefix num)
841 (if (eobp)
842 (progn
843 (error "End of buffer"))
844 (backward-sentence num)))
845
846 (defun edt-sentence (num)
847 "Move in current direction to next sentence.
848 Accepts a positive prefix argument for the number of sentences to move."
849 (interactive "p")
850 (if (equal edt-direction-string edt-forward-string)
851 (edt-sentence-forward num)
852 (edt-sentence-backward num)))
853
854 ;;;
855 ;;; PARAGRAPH
856 ;;;
857
858 (defun edt-paragraph-forward (num)
859 "Move forward to beginning of paragraph.
860 Accepts a positive prefix argument for the number of paragraphs to move."
861 (interactive "p")
862 (edt-check-prefix num)
265 (while (> num 0) 863 (while (> num 0)
266 (next-line 1) 864 (next-line 1)
267 (forward-paragraph) 865 (forward-paragraph)
268 (previous-line 1) 866 (previous-line 1)
269 (if (eolp) (next-line 1)) 867 (if (eolp)
868 (next-line 1))
270 (setq num (1- num)))) 869 (setq num (1- num))))
271 870
272 (defun previous-paragraph (num) 871 (defun edt-paragraph-backward (num)
273 "Move to beginning of previous indented paragraph. 872 "Move backward to beginning of paragraph.
274 Accepts a prefix argument for the number of paragraphs." 873 Accepts a positive prefix argument for the number of paragraphs to move."
275 (interactive "p") 874 (interactive "p")
875 (edt-check-prefix num)
276 (while (> num 0) 876 (while (> num 0)
277 (backward-paragraph) 877 (backward-paragraph)
278 (previous-line 1) 878 (previous-line 1)
279 (if (eolp) (next-line 1)) 879 (if (eolp) (next-line 1))
280 (setq num (1- num)))) 880 (setq num (1- num))))
281 881
282 (defun move-to-beginning () 882 (defun edt-paragraph (num)
283 "Move cursor to the beginning of buffer, but don't set the mark." 883 "Move in current direction to next paragraph.
284 (interactive) 884 Accepts a positive prefix argument for the number of paragraph to move."
285 (goto-char (point-min))) 885 (interactive "p")
286 886 (if (equal edt-direction-string edt-forward-string)
287 (defun move-to-end () 887 (edt-paragraph-forward num)
288 "Move cursor to the end of buffer, but don't set the mark." 888 (edt-paragraph-backward num)))
289 (interactive) 889
290 (goto-char (point-max))) 890 ;;;
291 891 ;;; RESTORE KEY
292 (defun goto-percent (perc) 892 ;;;
293 "Move point to ARG percentage of the buffer." 893
294 (interactive "NGoto-percentage: ") 894 (defun edt-restore-key ()
295 (if (or (> perc 100) (< perc 0)) 895 "Restore last replaced key definition.
296 (error "Percentage %d out of range 0 < percent < 100" perc) 896 Definition is stored in edt-last-replaced-key-definition."
297 (goto-char (/ (* (point-max) perc) 100)))) 897 (interactive)
298 898 (if edt-last-replaced-key-definition
299 (defun update-mode-line () 899 (progn
300 "Make sure mode-line in the current buffer reflects all changes." 900 (let (edt-key-definition-string)
301 (set-buffer-modified-p (buffer-modified-p)) 901 (set 'edt-key-definition-string
302 (sit-for 0)) 902 (read-key-sequence "Press the key to be restored: "))
303 903 (if (string-equal "\C-m" edt-key-definition-string)
304 (defun advance-direction () 904 (message "Key not restored")
305 "Set EDT Advance mode so keypad commands move forward." 905 (define-key (current-global-map)
306 (interactive) 906 edt-key-definition-string edt-last-replaced-key-definition))))
307 (setq edt-direction-string " ADVANCE") 907 (error "No replaced key definition to restore!")))
308 (define-key function-keymap "\C-c" 'isearch-forward) ; PF3 908
309 (define-key function-keymap "8" 'scroll-window-up) ; "8" 909 ;;;
310 (define-key function-keymap "7" 'next-paragraph) ; "7" 910 ;;; WINDOW TOP
311 (define-key function-keymap "1" 'forward-to-word) ; "1" 911 ;;;
312 (define-key function-keymap "2" 'next-end-of-line) ; "2" 912
313 (define-key function-keymap "3" 'forward-char) ; "3" 913 (defun edt-window-top ()
314 (define-key function-keymap "0" 'forward-line) ; "0" 914 "Move the cursor to the top of the window."
315 (update-mode-line)) 915 (interactive)
316 916 (let ((start-column (current-column)))
317 (defun backup-direction () 917 (move-to-window-line 0)
318 "Set EDT Backup mode so keypad commands move backward." 918 (move-to-column start-column)))
319 (interactive) 919
320 (setq edt-direction-string " BACKUP") 920 ;;;
321 (define-key function-keymap "\C-c" 'isearch-backward) ; PF3 921 ;;; WINDOW BOTTOM
322 (define-key function-keymap "8" 'scroll-window-down) ; "8" 922 ;;;
323 (define-key function-keymap "7" 'previous-paragraph) ; "7" 923
324 (define-key function-keymap "1" 'backward-to-word) ; "1" 924 (defun edt-window-bottom ()
325 (define-key function-keymap "2" 'previous-end-of-line) ; "2" 925 "Move the cursor to the bottom of the window."
326 (define-key function-keymap "3" 'backward-char) ; "3" 926 (interactive)
327 (define-key function-keymap "0" 'backward-line) ; "0" 927 (let ((start-column (current-column)))
328 (update-mode-line)) 928 (move-to-window-line (- (window-height) 2))
329 929 (move-to-column start-column)))
330 (defun edt-beginning-of-window () 930
331 "Home cursor to top of window." 931 ;;;
332 (interactive) 932 ;;; SCROLL WINDOW LINE
333 (move-to-window-line 0)) 933 ;;;
934
935 (defun edt-scroll-window-forward-line ()
936 "Move window forward one line leaving cursor at position in window."
937 (interactive)
938 (scroll-up 1))
939
940 (defun edt-scroll-window-backward-line ()
941 "Move window backward one line leaving cursor at position in window."
942 (interactive)
943 (scroll-down 1))
944
945 (defun edt-scroll-line ()
946 "Move window one line in current direction."
947 (interactive)
948 (if (equal edt-direction-string edt-forward-string)
949 (edt-scroll-window-forward-line)
950 (edt-scroll-window-backward-line)))
951
952 ;;;
953 ;;; SCROLL WINDOW
954 ;;;
955 ;;; Scroll a window (less one line) at a time. Leave cursor in center of
956 ;;; window.
957
958 (defun edt-scroll-window-forward (num)
959 "Scroll forward one window in buffer, less one line.
960 Accepts a positive prefix argument for the number of windows to move."
961 (interactive "p")
962 (edt-check-prefix num)
963 (scroll-up (- (* (window-height) num) 2))
964 (edt-line-forward (/ (- (window-height) 1) 2)))
965
966 (defun edt-scroll-window-backward (num)
967 "Scroll backward one window in buffer, less one line.
968 Accepts a positive prefix argument for the number of windows to move."
969 (interactive "p")
970 (edt-check-prefix num)
971 (scroll-down (- (* (window-height) num) 2))
972 (edt-line-backward (/ (- (window-height) 1) 2)))
973
974 (defun edt-scroll-window (num)
975 "Scroll one window in buffer, less one line, in current direction.
976 Accepts a positive prefix argument for the number windows to move."
977 (interactive "p")
978 (if (equal edt-direction-string edt-forward-string)
979 (edt-scroll-window-forward num)
980 (edt-scroll-window-backward num)))
981
982 ;;;
983 ;;; LINE TO BOTTOM OF WINDOW
984 ;;;
334 985
335 (defun edt-line-to-bottom-of-window () 986 (defun edt-line-to-bottom-of-window ()
336 "Move the current line to the top of the window." 987 "Move the current line to the bottom of the window."
337 (interactive) 988 (interactive)
338 (recenter -1)) 989 (recenter -1))
990
991 ;;;
992 ;;; LINE TO TOP OF WINDOW
993 ;;;
339 994
340 (defun edt-line-to-top-of-window () 995 (defun edt-line-to-top-of-window ()
341 "Move the current line to the top of the window." 996 "Move the current line to the top of the window."
342 (interactive) 997 (interactive)
343 (recenter 0)) 998 (recenter 0))
344 999
345 (defun case-flip-character (num) 1000 ;;;
346 "Change the case of the character under the cursor. 1001 ;;; LINE TO MIDDLE OF WINDOW
347 Accepts a prefix argument of the number of characters to invert." 1002 ;;;
348 (interactive "p") 1003
349 (while (> num 0) 1004 (defun edt-line-to-middle-of-window ()
350 (funcall (if (<= ?a (following-char)) 1005 "Move window so line with cursor is in the middle of the window."
351 'upcase-region 'downcase-region) 1006 (interactive)
352 (point) (1+ (point))) 1007 (recenter '(4)))
353 (forward-char 1) 1008
354 (setq num (1- num)))) 1009 ;;;
355 1010 ;;; GOTO PERCENTAGE
356 (defun indent-or-fill-region () 1011 ;;;
1012
1013 (defun edt-goto-percentage (num)
1014 "Move to specified percentage in buffer from top of buffer."
1015 (interactive "NGoto-percentage: ")
1016 (if (or (> num 100) (< num 0))
1017 (error "Percentage %d out of range 0 < percent < 100" num)
1018 (goto-char (/ (* (point-max) num) 100))))
1019
1020 ;;;
1021 ;;; FILL REGION
1022 ;;;
1023
1024 (defun edt-fill-region ()
1025 "Fill selected text."
1026 (interactive "*")
1027 (edt-check-selection)
1028 (fill-region (point) (mark)))
1029
1030 ;;;
1031 ;;; INDENT OR FILL REGION
1032 ;;;
1033
1034 (defun edt-indent-or-fill-region ()
357 "Fill region in text modes, indent region in programming language modes." 1035 "Fill region in text modes, indent region in programming language modes."
358 (interactive) 1036 (interactive "*")
359 (if (string= paragraph-start "^$\\|^ ") 1037 (if (string= paragraph-start "$\\|\f")
360 (indent-region (point) (mark) nil) 1038 (indent-region (point) (mark) nil)
361 (fill-region (point) (mark)))) 1039 (fill-region (point) (mark))))
362 1040
363 (defun mark-section-wisely () 1041 ;;;
1042 ;;; MARK SECTION WISELY
1043 ;;;
1044
1045 (defun edt-mark-section-wisely ()
364 "Mark the section in a manner consistent with the major-mode. 1046 "Mark the section in a manner consistent with the major-mode.
365 Uses mark-defun for emacs-lisp, lisp, 1047 Uses mark-defun for emacs-lisp and lisp,
366 mark-c-function for C, 1048 mark-c-function for C,
1049 mark-fortran-subsystem for fortran,
367 and mark-paragraph for other modes." 1050 and mark-paragraph for other modes."
368 (interactive) 1051 (interactive)
369 (cond ((eq major-mode 'emacs-lisp-mode) 1052 (if edt-select-mode
370 (mark-defun)) 1053 (progn
371 ((eq major-mode 'lisp-mode) 1054 (edt-reset))
372 (mark-defun)) 1055 (progn
373 ((eq major-mode 'c-mode) 1056 (cond ((or (eq major-mode 'emacs-lisp-mode)
374 (mark-c-function)) 1057 (eq major-mode 'lisp-mode))
375 (t (mark-paragraph)))) 1058 (mark-defun)
376 1059 (message "Lisp defun selected"))
377 ;;; Key Bindings 1060 ((eq major-mode 'c-mode)
1061 (mark-c-function)
1062 (message "C function selected"))
1063 ((eq major-mode 'fortran-mode)
1064 (mark-fortran-subprogram)
1065 (message "Fortran subprogram selected"))
1066 (t (mark-paragraph)
1067 (message "Paragraph selected"))))))
1068
1069 ;;;
1070 ;;; COPY
1071 ;;;
1072
1073 (defun edt-copy ()
1074 "Copy selected region to kill ring, but don't delete it!"
1075 (interactive)
1076 (edt-check-selection)
1077 (copy-region-as-kill (mark) (point))
1078 (edt-reset)
1079 (message "Selected text COPIED to kill ring"))
1080
1081 ;;;
1082 ;;; CUT or COPY
1083 ;;;
1084
1085 (defun edt-cut-or-copy ()
1086 "Cuts (or copies) selected text to kill ring.
1087 Cuts selected text if buffer-read-only is nil.
1088 Copies selected text if buffer-read-only is t."
1089 (interactive)
1090 (if buffer-read-only
1091 (edt-copy)
1092 (edt-cut)))
1093
1094 ;;;
1095 ;;; DELETE ENTIRE LINE
1096 ;;;
1097
1098 (defun edt-delete-entire-line ()
1099 "Delete entire line regardless of cursor position in the line."
1100 (interactive "*")
1101 (beginning-of-line)
1102 (edt-delete-line 1))
1103
1104 ;;;
1105 ;;; DUPLICATE LINE
1106 ;;;
1107
1108 (defun edt-duplicate-line (num)
1109 "Duplicate a line of text.
1110 Accepts a positive prefix argument for the number times to duplicate the line."
1111 (interactive "*p")
1112 (edt-check-prefix num)
1113 (let ((old-column (current-column))
1114 (count num))
1115 (edt-delete-entire-line)
1116 (edt-undelete-line)
1117 (while (> count 0)
1118 (edt-undelete-line)
1119 (setq count (1- count)))
1120 (edt-line-forward num)
1121 (move-to-column old-column)))
1122
1123 ;;;
1124 ;;; DUPLICATE WORD
1125 ;;;
1126
1127 (defun edt-duplicate-word()
1128 "Duplicate word (or rest of word) found directly above cursor, if any."
1129 (interactive "*")
1130 (let ((start (point))
1131 (start-column (current-column)))
1132 (forward-line -1)
1133 (move-to-column start-column)
1134 (if (and (not (equal start (point)))
1135 (not (eolp)))
1136 (progn
1137 (if (and (equal ?\t (preceding-char))
1138 (< start-column (current-column)))
1139 (backward-char))
1140 (let ((beg (point)))
1141 (edt-one-word-forward)
1142 (setq edt-last-copied-word (buffer-substring beg (point))))
1143 (forward-line)
1144 (move-to-column start-column)
1145 (insert edt-last-copied-word))
1146 (progn
1147 (if (not (equal start (point)))
1148 (forward-line))
1149 (move-to-column start-column)
1150 (error "Nothing to duplicate!")))))
1151
1152 ;;;
1153 ;;; KEY NOT ASSIGNED
1154 ;;;
1155
1156 (defun edt-key-not-assigned ()
1157 "Displays message that key has not been assigned to a function."
1158 (interactive)
1159 (error "Key not assigned"))
1160
1161 ;;;
1162 ;;; TOGGLE CAPITALIZATION OF WORD
1163 ;;;
1164
1165 (defun edt-toggle-capitalization-of-word ()
1166 "Toggle the capitalization of the current word and move forward to next."
1167 (interactive "*")
1168 (edt-one-word-forward)
1169 (edt-one-word-backward)
1170 (edt-change-case 1)
1171 (edt-one-word-backward)
1172 (edt-one-word-forward))
1173
1174 ;;;
1175 ;;; ELIMINATE ALL TABS
1176 ;;;
1177
1178 (defun edt-eliminate-all-tabs ()
1179 "Convert all tabs to spaces in the entire buffer."
1180 (interactive "*")
1181 (untabify (point-min) (point-max))
1182 (message "TABS converted to SPACES"))
1183
1184 ;;;
1185 ;;; DISPLAY THE TIME
1186 ;;;
1187
1188 (defun edt-display-the-time ()
1189 "Display the current time."
1190 (interactive)
1191 (set 'time-string (current-time-string))
1192 (message "%s" time-string))
1193
1194 ;;;
1195 ;;; LEARN
1196 ;;;
1197
1198 (defun edt-learn ()
1199 "Learn a sequence of key strokes to bind to a key."
1200 (interactive)
1201 (if (eq defining-kbd-macro t)
1202 (edt-remember)
1203 (start-kbd-macro nil)))
1204
1205 ;;;
1206 ;;; REMEMBER
1207 ;;;
1208
1209 (defun edt-remember ()
1210 "Store the sequence of key strokes started by edt-learn to a key."
1211 (interactive)
1212 (if (eq defining-kbd-macro nil)
1213 (error "Nothing to remember!")
1214 (progn
1215 (end-kbd-macro nil)
1216 (let (edt-key-definition-string)
1217 (set 'edt-key-definition-string
1218 (read-key-sequence "Enter key for binding: "))
1219 (if (string-equal "\C-m" edt-key-definition-string)
1220 (message "Key sequence not remembered")
1221 (progn
1222 (set 'edt-learn-macro-count (+ edt-learn-macro-count 1))
1223 (setq edt-last-replaced-key-definition
1224 (lookup-key (current-global-map)
1225 edt-key-definition-string))
1226 (define-key (current-global-map) edt-key-definition-string
1227 (name-last-kbd-macro
1228 (intern (concat "last-learned-sequence-"
1229 (int-to-string edt-learn-macro-count)))))))))))
1230
1231 ;;;
1232 ;;; EXIT
1233 ;;;
1234
1235 (defun edt-exit ()
1236 "Save current buffer, ask to save other buffers, and then exit Emacs."
1237 (interactive)
1238 (save-buffer)
1239 (save-buffers-kill-emacs))
1240
1241 ;;;
1242 ;;; QUIT
1243 ;;;
1244
1245 (defun edt-quit ()
1246 "Quit Emacs without saving changes."
1247 (interactive)
1248 (kill-emacs))
1249
1250 ;;;
1251 ;;; SPLIT WINDOW
1252 ;;;
1253
1254 (defun edt-split-window ()
1255 "Split current window and place cursor in the new window."
1256 (interactive)
1257 (split-window)
1258 (other-window 1))
1259
1260 ;;;
1261 ;;; COPY RECTANGLE
1262 ;;;
1263
1264 (defun edt-copy-rectangle ()
1265 "Copy a rectangle of text between mark and cursor to register."
1266 (interactive)
1267 (edt-check-selection)
1268 (copy-rectangle-to-register 3 (region-beginning) (region-end) nil)
1269 (edt-reset)
1270 (message "Selected rectangle COPIED to register"))
1271
1272 ;;;
1273 ;;; CUT RECTANGLE
1274 ;;;
1275
1276 (defun edt-cut-rectangle-overstrike-mode ()
1277 "Cut a rectangle of text between mark and cursor to register.
1278 Replace cut characters with spaces and moving cursor back to
1279 upper left corner."
1280 (interactive "*")
1281 (edt-check-selection)
1282 (setq edt-rect-start-point (region-beginning))
1283 (picture-clear-rectangle-to-register (region-beginning) (region-end) 3)
1284 (set-window-point (get-buffer-window (window-buffer)) edt-rect-start-point)
1285 (message "Selected rectangle CUT to register"))
1286
1287 (defun edt-cut-rectangle-insert-mode ()
1288 "Cut a rectangle of text between mark and cursor to register.
1289 Move cursor back to upper left corner."
1290 (interactive "*")
1291 (edt-check-selection)
1292 (setq edt-rect-start-point (region-beginning))
1293 (picture-clear-rectangle-to-register (region-beginning) (region-end) 3 t)
1294 (fixup-whitespace)
1295 (set-window-point (get-buffer-window (window-buffer)) edt-rect-start-point)
1296 (message "Selected rectangle CUT to register"))
1297
1298 (defun edt-cut-rectangle ()
1299 "Cut a rectangular region of text to register.
1300 If overwrite mode is active, cut text is replaced with whitespace."
1301 (interactive "*")
1302 (if overwrite-mode
1303 (edt-cut-rectangle-overstrike-mode)
1304 (edt-cut-rectangle-insert-mode)))
1305
1306 ;;;
1307 ;;; PASTE RECTANGLE
1308 ;;;
1309
1310 (defun edt-paste-rectangle-overstrike-mode ()
1311 "Paste a rectangular region of text from register, replacing text at cursor."
1312 (interactive "*")
1313 (picture-yank-rectangle-from-register 3))
1314
1315 (defun edt-paste-rectangle-insert-mode ()
1316 "Paste previously deleted rectangular region, inserting text at cursor."
1317 (interactive "*")
1318 (picture-yank-rectangle-from-register 3 t))
1319
1320 (defun edt-paste-rectangle ()
1321 "Paste a rectangular region of text.
1322 If overwrite mode is active, existing text is replace with text from register."
1323 (interactive)
1324 (if overwrite-mode
1325 (edt-paste-rectangle-overstrike-mode)
1326 (edt-paste-rectangle-insert-mode)))
1327
1328 ;;;
1329 ;;; DOWNCASE REGION
1330 ;;;
1331
1332 (defun edt-lowercase ()
1333 "Change specified characters to lower case.
1334 If text selection IS active, then characters between the cursor and
1335 mark are changed. If text selection is NOT active, there are two
1336 situations. If the current direction is ADVANCE, then the word under
1337 the cursor is changed to lower case and the cursor is moved to rest at
1338 the beginning of the next word. If the current direction is BACKUP,
1339 the word prior to the word under the cursor is changed to lower case
1340 and the cursor is left to rest at the beginning of that word."
1341 (interactive "*")
1342 (if edt-select-mode
1343 (progn
1344 (downcase-region (mark) (point)))
1345 (progn
1346 ;; Move to beginning of current word.
1347 (if (and
1348 (not (bobp))
1349 (not (eobp))
1350 (not (bolp))
1351 (not (eolp))
1352 (not (eq ?\ (char-syntax (preceding-char))))
1353 (not (memq (preceding-char) edt-word-entities))
1354 (not (memq (following-char) edt-word-entities)))
1355 (edt-one-word-backward))
1356 (if (equal edt-direction-string edt-backward-string)
1357 (edt-one-word-backward))
1358 (let ((beg (point)))
1359 (edt-one-word-forward)
1360 (downcase-region beg (point)))
1361 (if (equal edt-direction-string edt-backward-string)
1362 (edt-one-word-backward)))))
1363
1364 ;;;
1365 ;;; UPCASE REGION
1366 ;;;
1367
1368 (defun edt-uppercase ()
1369 "Change specified characters to upper case.
1370 If text selection IS active, then characters between the cursor and
1371 mark are changed. If text selection is NOT active, there are two
1372 situations. If the current direction is ADVANCE, then the word under
1373 the cursor is changed to upper case and the cursor is moved to rest at
1374 the beginning of the next word. If the current direction is BACKUP,
1375 the word prior to the word under the cursor is changed to upper case
1376 and the cursor is left to rest at the beginning of that word."
1377 (interactive "*")
1378 (if edt-select-mode
1379 (progn
1380 (upcase-region (mark) (point)))
1381 (progn
1382 ;; Move to beginning of current word.
1383 (if (and
1384 (not (bobp))
1385 (not (eobp))
1386 (not (bolp))
1387 (not (eolp))
1388 (not (eq ?\ (char-syntax (preceding-char))))
1389 (not (memq (preceding-char) edt-word-entities))
1390 (not (memq (following-char) edt-word-entities)))
1391 (edt-one-word-backward))
1392 (if (equal edt-direction-string edt-backward-string)
1393 (edt-one-word-backward))
1394 (let ((beg (point)))
1395 (edt-one-word-forward)
1396 (upcase-region beg (point)))
1397 (if (equal edt-direction-string edt-backward-string)
1398 (edt-one-word-backward)))))
1399
1400
1401 ;;;
1402 ;;; INITIALIZATION COMMANDS.
1403 ;;;
1404
1405 ;;;
1406 ;;; Emacs version 19 X-windows key definition support
1407 ;;;
1408 (defvar edt-last-answer nil
1409 "Most recent response to edt-y-or-n-p.")
1410
1411 (defun edt-y-or-n-p (prompt &optional not-yes)
1412 "Prompt for a y or n answer with positive default.
1413 Optional second argument NOT-YES changes default to negative.
1414 Like emacs y-or-n-p, also accepts space as y and DEL as n."
1415 (message "%s[%s]" prompt (if not-yes "n" "y"))
1416 (let ((doit t))
1417 (while doit
1418 (setq doit nil)
1419 (let ((ans (read-char)))
1420 (cond ((or (= ans ?y) (= ans ?Y) (= ans ?\ ))
1421 (setq edt-last-answer t))
1422 ((or (= ans ?n) (= ans ?N) (= ans ?\C-?))
1423 (setq edt-last-answer nil))
1424 ((= ans ?\r) (setq edt-last-answer (not not-yes)))
1425 (t
1426 (setq doit t) (beep)
1427 (message "Please answer y or n. %s[%s]"
1428 prompt (if not-yes "n" "y")))))))
1429 edt-last-answer)
1430
1431 (defun edt-load-xkeys (file)
1432 "Load the EDT X-windows key definitions FILE.
1433 If FILE is nil, try to load a default file. The default file names are
1434 ~/.edt-xemacs-keys for XEmacs, and ~/.edt-gnu-keys for GNU emacs."
1435 (interactive "fX key definition file: ")
1436 (cond (file
1437 (setq file (expand-file-name file)))
1438 (edt-xkeys-file
1439 (setq file (expand-file-name edt-xkeys-file)))
1440 (edt-gnu-emacs19-p
1441 (setq file (expand-file-name "~/.edt-gnu-keys")))
1442 (edt-lucid-emacs19-p
1443 (setq file (expand-file-name "~/.edt-xemacs-keys"))))
1444 (cond ((file-readable-p file)
1445 (load-file file))
1446 (t
1447 (switch-to-buffer "*scratch*")
1448 (erase-buffer)
1449 (insert "
1450
1451 Ack!! You're running the Enhanced EDT Emulation under X-windows
1452 without loading an EDT X key definition file. To create an EDT X
1453 key definition file, run the edt-mapper.el program. But ONLY run
1454 it from an XEmacs loaded without any of your own customizations
1455 found in your .emacs file, etc. Some user customization confuse
1456 the edt-mapper function. To do this, you need to invoke XEmacs
1457 as follows:
1458
1459 xemacs -q -l edt-mapper.el
1460
1461 The file edt-mapper.el includes these same directions on how to
1462 use it! Perhaps it's laying around here someplace. \n ")
1463 (let ((file "edt-mapper.el")
1464 (found nil)
1465 (path nil)
1466 (search-list (append (list (expand-file-name ".")) load-path)))
1467 (while (and (not found) search-list)
1468 (setq path (concat (car search-list)
1469 (if (string-match "/$" (car search-list)) "" "/")
1470 file))
1471 (if (and (file-exists-p path) (not (file-directory-p path)))
1472 (setq found t))
1473 (setq search-list (cdr search-list)))
1474 (cond (found
1475 (insert (format
1476 "Ah yes, there it is, in \n\n %s \n\n" path))
1477 (if (edt-y-or-n-p "Do you want to run it now? ")
1478 (load-file path)
1479 (error "EDT Emulation not configured.")))
1480 (t
1481 (insert "Nope, I can't seem to find it. :-(\n\n")
1482 (sit-for 20)
1483 (error "EDT Emulation not configured.")))))))
1484
1485 ;;;###autoload
378 (defun edt-emulation-on () 1486 (defun edt-emulation-on ()
379 "Begin emulating DEC's EDT editor. 1487 "Turn on EDT Emulation."
380 Certain keys are rebound; including nearly all keypad keys. 1488 (interactive)
381 Use \\[edt-emulation-off] to undo all rebindings except the keypad keys. 1489 ;; If using MS-DOS, need to load edt-pc.el
382 Note that this function does not work if called directly from the .emacs file. 1490 (if (eq system-type 'ms-dos)
383 Instead, the .emacs file should do (setq term-setup-hook 'edt-emulation-on) 1491 (setq edt-term "pc")
384 Then this function will be called at the time when it will work." 1492 (setq edt-term (getenv "TERM")))
385 (interactive) 1493 ;; All DEC VT series terminals are supported by loading edt-vt100.el
386 (advance-direction) 1494 (if (string-equal "vt" (substring edt-term 0 (min (length edt-term) 2)))
387 (edt-bind-gold-keypad) ;Must do this *after* $TERM.el is loaded 1495 (setq edt-term "vt100"))
388 (setq edt-mode-old-c-\\ (lookup-key global-map "\C-\\")) 1496 ;; Load EDT terminal specific configuration file.
389 (global-set-key "\C-\\" 'quoted-insert) 1497 (let ((term edt-term)
390 (setq edt-mode-old-delete (lookup-key global-map "\177")) 1498 hyphend)
391 (global-set-key "\177" 'delete-previous-char) ;"Delete" 1499 (while (and term
392 (setq edt-mode-old-lisp-delete (lookup-key emacs-lisp-mode-map "\177")) 1500 (not (load (concat "edt-" term) t t)))
393 (define-key emacs-lisp-mode-map "\177" 'delete-previous-char) ;"Delete" 1501 ;; Strip off last hyphen and what follows, then try again
394 (define-key lisp-mode-map "\177" 'delete-previous-char) ;"Delete" 1502 (if (setq hyphend (string-match "[-_][^-_]+$" term))
395 (setq edt-mode-old-linefeed (lookup-key global-map "\C-j")) 1503 (setq term (substring term 0 hyphend))
396 (global-set-key "\C-j" 'edt-delete-previous-word) ;"LineFeed" 1504 (setq term nil)))
397 (define-key esc-map "?" 'apropos)) ;"<ESC>?" 1505 ;; Override terminal-specific file if running X Windows. X Windows support
398 1506 ;; is handled differently in edt-load-xkeys
399 (defun edt-emulation-off () 1507 (if (eq window-system 'x)
400 "Return from EDT emulation to normal Emacs key bindings. 1508 (edt-load-xkeys nil)
401 The keys redefined by \\[edt-emulation-on] are given their old definitions." 1509 (if (null term)
402 (interactive) 1510 (error "Unable to load EDT terminal specific file for %s" edt-term)))
403 (setq edt-direction-string nil) 1511 (setq edt-term term))
404 (global-set-key "\C-\\" edt-mode-old-c-\\) 1512 (setq edt-orig-transient-mark-mode transient-mark-mode)
405 (global-set-key "\177" edt-mode-old-delete) ;"Delete" 1513 (add-hook 'activate-mark-hook
406 (define-key emacs-lisp-mode-map "\177" edt-mode-old-lisp-delete) ;"Delete" 1514 (function
407 (define-key lisp-mode-map "\177" edt-mode-old-lisp-delete) ;"Delete" 1515 (lambda ()
408 (global-set-key "\C-j" edt-mode-old-linefeed)) ;"LineFeed" 1516 (edt-select-mode t))))
409 1517 (add-hook 'deactivate-mark-hook
410 (define-key function-keymap "u" 'previous-line) ;Up arrow 1518 (function
411 (define-key function-keymap "d" 'next-line) ;down arrow 1519 (lambda ()
412 (define-key function-keymap "l" 'backward-char) ;right arrow 1520 (edt-select-mode nil))))
413 (define-key function-keymap "r" 'forward-char) ;left arrow 1521 (if (load "edt-user" t t)
414 (define-key function-keymap "h" 'edt-beginning-of-window) ;home 1522 (edt-user-emulation-setup)
415 (define-key function-keymap "\C-b" 'describe-key) ;PF2 1523 (edt-default-emulation-setup)))
416 (define-key function-keymap "\C-d" 'delete-current-line);PF4 1524
417 (define-key function-keymap "9" 'append-to-buffer) ;9 keypad key, etc. 1525 (defun edt-emulation-off()
418 (define-key function-keymap "-" 'delete-current-word) 1526 "Select original global key bindings, disabling EDT Emulation."
419 (define-key function-keymap "4" 'advance-direction) 1527 (interactive)
420 (define-key function-keymap "5" 'backup-direction) 1528 (use-global-map global-map)
421 (define-key function-keymap "6" 'kill-region) 1529 (if (not edt-keep-current-page-delimiter)
422 (define-key function-keymap "," 'delete-current-char) 1530 (setq page-delimiter edt-orig-page-delimiter))
423 (define-key function-keymap "." 'set-mark-command) 1531 (setq edt-direction-string "")
424 (define-key function-keymap "e" 'other-window) ;enter key 1532 (setq edt-select-mode-text nil)
425 (define-key function-keymap "\C-a" 'GOLD-prefix) ;PF1 ("gold") 1533 (edt-reset)
426 1534 (force-mode-line-update t)
427 (fset 'GOLD-prefix GOLD-map) 1535 (setq transient-mark-mode edt-orig-transient-mark-mode)
428 1536 (message "Original key bindings restored; EDT Emulation disabled"))
429 (defvar GOLD-map (make-keymap) 1537
430 "GOLD-map maps the function keys on the VT100 keyboard preceeded 1538 (defun edt-default-emulation-setup (&optional user-setup)
431 by the PF1 key. GOLD is the ASCII the 7-bit escape sequence <ESC>OP.") 1539 "Setup emulation of DEC's EDT editor."
432 1540 ;; Setup default EDT global map by copying global map bindings.
433 (defun define-keypad-key (keymap function-keymap-slot definition) 1541 ;; This preserves ESC and C-x prefix bindings and other bindings we
434 (let ((function-key-sequence (function-key-sequence function-keymap-slot))) 1542 ;; wish to retain in EDT emulation mode keymaps. It also permits
435 (if function-key-sequence 1543 ;; customization of these bindings in the EDT global maps without
436 (define-key keymap function-key-sequence definition)))) 1544 ;; disturbing the original bindings in global-map.
437 1545 (fset 'edt-default-ESC-prefix (copy-keymap 'ESC-prefix))
438 ;;Bind GOLD/Keyboard keys 1546 (setq edt-default-global-map (copy-keymap (current-global-map)))
439 1547 (define-key edt-default-global-map "\e" 'edt-default-ESC-prefix)
440 (define-key GOLD-map "\C-g" 'keyboard-quit) ; just for safety 1548 (define-prefix-command 'edt-default-gold-map)
441 (define-key GOLD-map "\177" 'delete-window) ;"Delete" 1549 (edt-setup-default-bindings)
442 (define-key GOLD-map "\C-h" 'delete-other-windows) ;"BackSpace" 1550 ;; If terminal has additional function keys, the terminal-specific
443 (define-key GOLD-map "\C-m" 'newline-and-indent) ;"Return" 1551 ;; initialization file can assign bindings to them via the optional
444 (define-key GOLD-map " " 'undo) ;"Spacebar" 1552 ;; function edt-setup-extra-default-bindings.
445 (define-key GOLD-map "%" 'goto-percent) ; "%" 1553 (if (fboundp 'edt-setup-extra-default-bindings)
446 (define-key GOLD-map "=" 'goto-line) ; "=" 1554 (edt-setup-extra-default-bindings))
447 (define-key GOLD-map "`" 'what-line) ; "`" 1555 ;; Variable needed by edt-learn.
448 (define-key GOLD-map "\C-\\" 'split-window-vertically) ; "Control-\" 1556 (setq edt-learn-macro-count 0)
449 1557 ;; Display EDT text selection active within the mode line
450 ; GOLD letter combinations: 1558 (or (assq 'edt-select-mode minor-mode-alist)
451 (define-key GOLD-map "b" 'buffer-menu) ; "b" 1559 (setq minor-mode-alist
452 (define-key GOLD-map "B" 'buffer-menu) ; "B" 1560 (cons '(edt-select-mode edt-select-mode) minor-mode-alist)))
453 (define-key GOLD-map "d" 'delete-window) ; "d" 1561 ;; Display EDT direction of motion within the mode line
454 (define-key GOLD-map "D" 'delete-window) ; "D" 1562 (or (assq 'edt-direction-string minor-mode-alist)
455 (define-key GOLD-map "e" 'compile) ; "e" 1563 (setq minor-mode-alist
456 (define-key GOLD-map "E" 'compile) ; "E" 1564 (cons
457 (define-key GOLD-map "i" 'insert-file) ; "i" 1565 '(edt-direction-string edt-direction-string) minor-mode-alist)))
458 (define-key GOLD-map "I" 'insert-file) ; "I" 1566 (if user-setup
459 (define-key GOLD-map "l" 'goto-line) ; "l" 1567 (progn
460 (define-key GOLD-map "L" 'goto-line) ; "L" 1568 (setq edt-user-map-configured t)
461 (define-key GOLD-map "m" 'save-some-buffers) ; "m" 1569 (fset 'edt-emulation-on (symbol-function 'edt-select-user-global-map)))
462 (define-key GOLD-map "M" 'save-some-buffers) ; "m" 1570 (progn
463 (define-key GOLD-map "n" 'next-error) ; "n" 1571 (fset 'edt-emulation-on (symbol-function 'edt-select-default-global-map))
464 (define-key GOLD-map "N" 'next-error) ; "N" 1572 (edt-select-default-global-map))))
465 (define-key GOLD-map "o" 'switch-to-buffer-other-window) ; "o" 1573
466 (define-key GOLD-map "O" 'switch-to-buffer-other-window) ; "O" 1574 (defun edt-user-emulation-setup ()
467 (define-key GOLD-map "r" 'revert-file) ; "r" 1575 "Setup user custom emulation of DEC's EDT editor."
468 (define-key GOLD-map "r" 'revert-file) ; "R" 1576 ;; Initialize EDT default bindings.
469 (define-key GOLD-map "s" 'save-buffer) ; "s" 1577 (edt-default-emulation-setup t)
470 (define-key GOLD-map "S" 'save-buffer) ; "S" 1578 ;; Setup user EDT global map by copying default EDT global map bindings.
471 (define-key GOLD-map "v" 'find-file-other-window) ; "v" 1579 (fset 'edt-user-ESC-prefix (copy-keymap 'edt-default-ESC-prefix))
472 (define-key GOLD-map "V" 'find-file-other-window) ; "V" 1580 (setq edt-user-global-map (copy-keymap edt-default-global-map))
473 (define-key GOLD-map "w" 'write-file) ; "w" 1581 (define-key edt-user-global-map "\e" 'edt-user-ESC-prefix)
474 (define-key GOLD-map "w" 'write-file) ; "W" 1582 ;; If terminal has additional function keys, the user's initialization
475 ;(define-key GOLD-map "z" 'shrink-window) ; "z" 1583 ;; file can assign bindings to them via the optional
476 ;(define-key GOLD-map "Z" 'shrink-window) ; "z" 1584 ;; function edt-setup-extra-default-bindings.
477 1585 (define-prefix-command 'edt-user-gold-map)
478 ;Bind GOLD/Keypad keys 1586 (fset 'edt-user-gold-map (copy-keymap 'edt-default-gold-map))
479 (defun edt-bind-gold-keypad () 1587 (edt-setup-user-bindings)
480 (define-keypad-key GOLD-map ?u 'edt-line-to-top-of-window) ;"up-arrow" 1588 (edt-select-user-global-map))
481 (define-keypad-key GOLD-map ?d 'edt-line-to-bottom-of-window) ;"down-arrow" 1589
482 (define-keypad-key GOLD-map ?l 'backward-sentence) ;"left-arrow" 1590 (defun edt-select-default-global-map()
483 (define-keypad-key GOLD-map ?r 'forward-sentence) ;"right-arrow" 1591 "Select default EDT emulation key bindings."
484 (define-keypad-key GOLD-map ?\C-a 'mark-section-wisely) ;Gold "PF1" 1592 (interactive)
485 (define-keypad-key GOLD-map ?\C-b 'describe-function) ;Help "PF2" 1593 (transient-mark-mode 1)
486 (define-keypad-key GOLD-map ?\C-c 'occur) ;Find "PF3" 1594 (use-global-map edt-default-global-map)
487 (define-keypad-key GOLD-map ?\C-d 'undelete-lines) ;Und Line "PF4" 1595 (if (not edt-keep-current-page-delimiter)
488 (define-keypad-key GOLD-map ?0 'open-line) ;Open L "0" 1596 (progn
489 (define-keypad-key GOLD-map ?1 'case-flip-character) ;Chgcase "1" 1597 (setq edt-orig-page-delimiter page-delimiter)
490 (define-keypad-key GOLD-map ?2 'delete-to-eol) ;Del EOL "2" 1598 (setq page-delimiter "\f")))
491 (define-keypad-key GOLD-map ?3 'copy-region-as-kill) ;Copy "3" 1599 (setq edt-default-map-active t)
492 (define-keypad-key GOLD-map ?4 'move-to-end) ;Bottom "4" 1600 (edt-advance)
493 (define-keypad-key GOLD-map ?5 'move-to-beginning) ;Top "5" 1601 (setq edt-select-mode-text 'edt-select-mode-string)
494 (define-keypad-key GOLD-map ?6 'yank) ;Paste "6" 1602 (edt-reset)
495 (define-keypad-key GOLD-map ?7 'execute-extended-command) ;Command "7" 1603 (message "Default EDT keymap active"))
496 (define-keypad-key GOLD-map ?8 'indent-or-fill-region) ;Fill "8" 1604
497 (define-keypad-key GOLD-map ?9 'replace-regexp) ;Replace "9" 1605 (defun edt-select-user-global-map()
498 (define-keypad-key GOLD-map ?- 'undelete-words) ;UND word "-" 1606 "Select user EDT emulation custom key bindings."
499 (define-keypad-key GOLD-map ?, 'undelete-chars) ;UND Char "," 1607 (interactive)
500 (define-keypad-key GOLD-map ?. 'redraw-display) ;Reset Window "." 1608 (if edt-user-map-configured
501 (define-keypad-key GOLD-map ?e 'shell-command)) ;"ENTER" 1609 (progn
502 1610 (transient-mark-mode 1)
503 ;; Make direction of motion show in mode line 1611 (use-global-map edt-user-global-map)
504 ;; while EDT emulation is turned on. 1612 (if (not edt-keep-current-page-delimiter)
505 ;; Note that the keypad is always turned on when in Emacs. 1613 (progn
506 1614 (setq edt-orig-page-delimiter page-delimiter)
507 (or (assq 'edt-direction-string minor-mode-alist) 1615 (setq page-delimiter "\f")))
508 (setq minor-mode-alist (cons '(edt-direction-string edt-direction-string) 1616 (setq edt-default-map-active nil)
509 minor-mode-alist))) 1617 (edt-advance)
1618 (setq edt-select-mode-text 'edt-select-mode-string)
1619 (edt-reset)
1620 (message "User EDT custom keymap active"))
1621 (error "User EDT custom keymap NOT configured!")))
1622
1623 (defun edt-switch-global-maps ()
1624 "Toggle between default EDT keymap and user EDT keymap."
1625 (interactive)
1626 (if edt-default-map-active
1627 (edt-select-user-global-map)
1628 (edt-select-default-global-map)))
1629
1630 ;; There are three key binding functions needed: one for standard keys
1631 ;; (used to bind control keys, primarily), one for Gold sequences of
1632 ;; standard keys, and one for function keys.
1633
1634 (defun edt-bind-gold-key (key gold-binding &optional default)
1635 "Binds commands to a gold key sequence in the EDT Emulator."
1636 (if default
1637 (define-key 'edt-default-gold-map key gold-binding)
1638 (define-key 'edt-user-gold-map key gold-binding)))
1639
1640 (defun edt-bind-standard-key (key gold-binding &optional default)
1641 "Bind commands to a gold key sequence in the default EDT keymap."
1642 (if default
1643 (define-key edt-default-global-map key gold-binding)
1644 (define-key edt-user-global-map key gold-binding)))
1645
1646 (defun edt-bind-function-key
1647 (function-key binding gold-binding &optional default)
1648 "Binds function keys in the EDT Emulator."
1649 (catch 'edt-key-not-supported
1650 (let ((key-vector (cdr (assoc function-key *EDT-keys*))))
1651 (if (stringp key-vector)
1652 (throw 'edt-key-not-supported t))
1653 (if (not (null key-vector))
1654 (progn
1655 (if default
1656 (progn
1657 (define-key edt-default-global-map key-vector binding)
1658 (define-key 'edt-default-gold-map key-vector gold-binding))
1659 (progn
1660 (define-key edt-user-global-map key-vector binding)
1661 (define-key 'edt-user-gold-map key-vector gold-binding))))
1662 (error "%s is not a legal function key name" function-key)))))
1663
1664 (defun edt-setup-default-bindings ()
1665 "Assigns default EDT Emulation keyboard bindings."
1666
1667 ;; Function Key Bindings: Regular and GOLD.
1668
1669 ;; VT100/VT200/VT300 PF1 (GOLD), PF2, PF3, PF4 Keys
1670 (edt-bind-function-key "PF1" 'edt-default-gold-map 'edt-mark-section-wisely t)
1671 (edt-bind-function-key "PF2" 'edt-electric-keypad-help 'describe-function t)
1672 (edt-bind-function-key "PF3" 'edt-find-next 'edt-find t)
1673 (edt-bind-function-key "PF4" 'edt-delete-line 'edt-undelete-line t)
1674
1675 ;; VT100/VT200/VT300 Arrow Keys
1676 (edt-bind-function-key "UP" 'previous-line 'edt-window-top t)
1677 (edt-bind-function-key "DOWN" 'next-line 'edt-window-bottom t)
1678 (edt-bind-function-key "LEFT" 'backward-char 'edt-sentence-backward t)
1679 (edt-bind-function-key "RIGHT" 'forward-char 'edt-sentence-forward t)
1680
1681 ;; VT100/VT200/VT300 Keypad Keys
1682 (edt-bind-function-key "KP0" 'edt-line 'open-line t)
1683 (edt-bind-function-key "KP1" 'edt-word 'edt-change-case t)
1684 (edt-bind-function-key "KP2" 'edt-end-of-line 'edt-delete-to-end-of-line t)
1685 (edt-bind-function-key "KP3" 'edt-character 'quoted-insert t)
1686 (edt-bind-function-key "KP4" 'edt-advance 'edt-bottom t)
1687 (edt-bind-function-key "KP5" 'edt-backup 'edt-top t)
1688 (edt-bind-function-key "KP6" 'edt-cut 'yank t)
1689 (edt-bind-function-key "KP7" 'edt-page 'execute-extended-command t)
1690 (edt-bind-function-key "KP8" 'edt-sect 'edt-fill-region t)
1691 (edt-bind-function-key "KP9" 'edt-append 'edt-replace t)
1692 (edt-bind-function-key "KP-" 'edt-delete-word 'edt-undelete-word t)
1693 (edt-bind-function-key "KP," 'edt-delete-character 'edt-undelete-character t)
1694 (edt-bind-function-key "KPP" 'edt-select 'edt-reset t)
1695 (edt-bind-function-key "KPE" 'other-window 'query-replace t)
1696
1697 ;; VT200/VT300 Function Keys
1698 ;; (F1 through F5, on the VT220, are not programmable, so we skip
1699 ;; making default bindings to those keys.
1700 (edt-bind-function-key "FIND" 'edt-find-next 'edt-find t)
1701 (edt-bind-function-key "INSERT" 'yank 'edt-key-not-assigned t)
1702 (edt-bind-function-key "REMOVE" 'edt-cut 'edt-copy t)
1703 (edt-bind-function-key "SELECT" 'edt-toggle-select 'edt-key-not-assigned t)
1704 (edt-bind-function-key "NEXT" 'edt-sect-forward 'edt-key-not-assigned t)
1705 (edt-bind-function-key "PREVIOUS" 'edt-sect-backward 'edt-key-not-assigned t)
1706 (edt-bind-function-key "F6" 'edt-key-not-assigned 'edt-key-not-assigned t)
1707 (edt-bind-function-key "F7" 'edt-copy-rectangle 'edt-key-not-assigned t)
1708 (edt-bind-function-key "F8"
1709 'edt-cut-rectangle-overstrike-mode 'edt-paste-rectangle-overstrike-mode t)
1710 (edt-bind-function-key "F9"
1711 'edt-cut-rectangle-insert-mode 'edt-paste-rectangle-insert-mode t)
1712 (edt-bind-function-key "F10" 'edt-cut-rectangle 'edt-paste-rectangle t)
1713 ;; Under X, the F11 key can be bound. If using a VT-200 or higher terminal,
1714 ;; the default emacs terminal support causes the VT F11 key to seem as if it
1715 ;; is an ESC key when in emacs.
1716 (edt-bind-function-key "F11"
1717 'edt-key-not-assigned 'edt-key-not-assigned t)
1718 (edt-bind-function-key "F12"
1719 'edt-beginning-of-line 'delete-other-windows t) ;BS
1720 (edt-bind-function-key "F13"
1721 'edt-delete-to-beginning-of-word 'edt-key-not-assigned t) ;LF
1722 (edt-bind-function-key "F14" 'edt-key-not-assigned 'edt-key-not-assigned t)
1723 (edt-bind-function-key "HELP" 'edt-electric-keypad-help 'edt-key-not-assigned t)
1724 (edt-bind-function-key "DO" 'execute-extended-command 'edt-key-not-assigned t)
1725 (edt-bind-function-key "F17" 'edt-key-not-assigned 'edt-key-not-assigned t)
1726 (edt-bind-function-key "F18" 'edt-key-not-assigned 'edt-key-not-assigned t)
1727 (edt-bind-function-key "F19" 'edt-key-not-assigned 'edt-key-not-assigned t)
1728 (edt-bind-function-key "F20" 'edt-key-not-assigned 'edt-key-not-assigned t)
1729
1730 ;; Control key bindings: Regular and GOLD
1731 ;;
1732 ;; Standard EDT control key bindings conflict with standard Emacs
1733 ;; control key bindings. Normally, the standard Emacs control key
1734 ;; bindings are left unchanged in the default EDT mode. However, if
1735 ;; the variable edt-use-EDT-control-key-bindings is set to true
1736 ;; before invoking edt-emulation-on for the first time, then the
1737 ;; standard EDT bindings (with some enhancements) as defined here are
1738 ;; used, instead.
1739 (if edt-use-EDT-control-key-bindings
1740 (progn
1741 (edt-bind-standard-key "\C-a" 'edt-key-not-assigned t)
1742 (edt-bind-standard-key "\C-b" 'edt-key-not-assigned t)
1743 ;; Leave binding of C-c as original prefix key.
1744 (edt-bind-standard-key "\C-d" 'edt-key-not-assigned t)
1745 (edt-bind-standard-key "\C-e" 'edt-key-not-assigned t)
1746 (edt-bind-standard-key "\C-f" 'edt-key-not-assigned t)
1747 ;; Leave binding of C-g to keyboard-quit
1748 ; (edt-bind-standard-key "\C-g" 'keyboard-quit t)
1749 ;; Standard EDT binding of C-h. To invoke Emacs help, use
1750 ;; GOLD-C-h instead.
1751 (edt-bind-standard-key "\C-h" 'edt-beginning-of-line t)
1752 (edt-bind-standard-key "\C-i" 'edt-tab-insert t)
1753 (edt-bind-standard-key "\C-j" 'edt-delete-to-beginning-of-word t)
1754 (edt-bind-standard-key "\C-k" 'edt-define-key t)
1755 (edt-bind-gold-key "\C-k" 'edt-restore-key t)
1756 (edt-bind-standard-key "\C-l" 'edt-form-feed-insert t)
1757 ;; Leave binding of C-m to newline.
1758 (edt-bind-standard-key "\C-n" 'edt-set-screen-width-80 t)
1759 (edt-bind-standard-key "\C-o" 'edt-key-not-assigned t)
1760 (edt-bind-standard-key "\C-p" 'edt-key-not-assigned t)
1761 (edt-bind-standard-key "\C-q" 'edt-key-not-assigned t)
1762 ;; Leave binding of C-r to isearch-backward.
1763 ;; Leave binding of C-s to isearch-forward.
1764 (edt-bind-standard-key "\C-t" 'edt-display-the-time t)
1765 (edt-bind-standard-key "\C-u" 'edt-delete-to-beginning-of-line t)
1766 (edt-bind-standard-key "\C-v" 'redraw-display t)
1767 (edt-bind-standard-key "\C-w" 'edt-set-screen-width-132 t)
1768 ;; Leave binding of C-x as original prefix key.
1769 (edt-bind-standard-key "\C-y" 'edt-key-not-assigned t)
1770 ; (edt-bind-standard-key "\C-z" 'suspend-emacs t)
1771 )
1772 )
1773
1774 ;; GOLD bindings for a few Control keys.
1775 (edt-bind-gold-key "\C-g" 'keyboard-quit t); Just in case.
1776 (edt-bind-gold-key "\C-h" 'help-for-help t)
1777 (edt-bind-gold-key [f1] 'help-for-help t)
1778 (edt-bind-gold-key [help] 'help-for-help t)
1779 (edt-bind-gold-key "\C-\\" 'split-window-vertically t)
1780
1781 ;; GOLD bindings for regular keys.
1782 (edt-bind-gold-key "a" 'edt-key-not-assigned t)
1783 (edt-bind-gold-key "A" 'edt-key-not-assigned t)
1784 (edt-bind-gold-key "b" 'buffer-menu t)
1785 (edt-bind-gold-key "B" 'buffer-menu t)
1786 (edt-bind-gold-key "c" 'compile t)
1787 (edt-bind-gold-key "C" 'compile t)
1788 (edt-bind-gold-key "d" 'delete-window t)
1789 (edt-bind-gold-key "D" 'delete-window t)
1790 (edt-bind-gold-key "e" 'edt-exit t)
1791 (edt-bind-gold-key "E" 'edt-exit t)
1792 (edt-bind-gold-key "f" 'find-file t)
1793 (edt-bind-gold-key "F" 'find-file t)
1794 (edt-bind-gold-key "g" 'find-file-other-window t)
1795 (edt-bind-gold-key "G" 'find-file-other-window t)
1796 (edt-bind-gold-key "h" 'edt-electric-keypad-help t)
1797 (edt-bind-gold-key "H" 'edt-electric-keypad-help t)
1798 (edt-bind-gold-key "i" 'insert-file t)
1799 (edt-bind-gold-key "I" 'insert-file t)
1800 (edt-bind-gold-key "j" 'edt-key-not-assigned t)
1801 (edt-bind-gold-key "J" 'edt-key-not-assigned t)
1802 (edt-bind-gold-key "k" 'edt-toggle-capitalization-of-word t)
1803 (edt-bind-gold-key "K" 'edt-toggle-capitalization-of-word t)
1804 (edt-bind-gold-key "l" 'edt-lowercase t)
1805 (edt-bind-gold-key "L" 'edt-lowercase t)
1806 (edt-bind-gold-key "m" 'save-some-buffers t)
1807 (edt-bind-gold-key "M" 'save-some-buffers t)
1808 (edt-bind-gold-key "n" 'next-error t)
1809 (edt-bind-gold-key "N" 'next-error t)
1810 (edt-bind-gold-key "o" 'switch-to-buffer-other-window t)
1811 (edt-bind-gold-key "O" 'switch-to-buffer-other-window t)
1812 (edt-bind-gold-key "p" 'edt-key-not-assigned t)
1813 (edt-bind-gold-key "P" 'edt-key-not-assigned t)
1814 (edt-bind-gold-key "q" 'edt-quit t)
1815 (edt-bind-gold-key "Q" 'edt-quit t)
1816 (edt-bind-gold-key "r" 'revert-buffer t)
1817 (edt-bind-gold-key "R" 'revert-buffer t)
1818 (edt-bind-gold-key "s" 'save-buffer t)
1819 (edt-bind-gold-key "S" 'save-buffer t)
1820 (edt-bind-gold-key "t" 'edt-key-not-assigned t)
1821 (edt-bind-gold-key "T" 'edt-key-not-assigned t)
1822 (edt-bind-gold-key "u" 'edt-uppercase t)
1823 (edt-bind-gold-key "U" 'edt-uppercase t)
1824 (edt-bind-gold-key "v" 'find-file-other-window t)
1825 (edt-bind-gold-key "V" 'find-file-other-window t)
1826 (edt-bind-gold-key "w" 'write-file t)
1827 (edt-bind-gold-key "W" 'write-file t)
1828 (edt-bind-gold-key "x" 'edt-key-not-assigned t)
1829 (edt-bind-gold-key "X" 'edt-key-not-assigned t)
1830 (edt-bind-gold-key "y" 'edt-emulation-off t)
1831 (edt-bind-gold-key "Y" 'edt-emulation-off t)
1832 (edt-bind-gold-key "z" 'edt-switch-global-maps t)
1833 (edt-bind-gold-key "Z" 'edt-switch-global-maps t)
1834 (edt-bind-gold-key "1" 'delete-other-windows t)
1835 (edt-bind-gold-key "!" 'edt-key-not-assigned t)
1836 (edt-bind-gold-key "2" 'edt-split-window t)
1837 (edt-bind-gold-key "@" 'edt-key-not-assigned t)
1838 (edt-bind-gold-key "3" 'edt-key-not-assigned t)
1839 (edt-bind-gold-key "#" 'edt-key-not-assigned t)
1840 (edt-bind-gold-key "4" 'edt-key-not-assigned t)
1841 (edt-bind-gold-key "$" 'edt-key-not-assigned t)
1842 (edt-bind-gold-key "5" 'edt-key-not-assigned t)
1843 (edt-bind-gold-key "%" 'edt-goto-percentage t)
1844 (edt-bind-gold-key "6" 'edt-key-not-assigned t)
1845 (edt-bind-gold-key "^" 'edt-key-not-assigned t)
1846 (edt-bind-gold-key "7" 'edt-key-not-assigned t)
1847 (edt-bind-gold-key "&" 'edt-key-not-assigned t)
1848 (edt-bind-gold-key "8" 'edt-key-not-assigned t)
1849 (edt-bind-gold-key "*" 'edt-key-not-assigned t)
1850 (edt-bind-gold-key "9" 'edt-key-not-assigned t)
1851 (edt-bind-gold-key "(" 'edt-key-not-assigned t)
1852 (edt-bind-gold-key "0" 'edt-key-not-assigned t)
1853 (edt-bind-gold-key ")" 'edt-key-not-assigned t)
1854 (edt-bind-gold-key " " 'undo t)
1855 (edt-bind-gold-key "," 'edt-key-not-assigned t)
1856 (edt-bind-gold-key "<" 'edt-key-not-assigned t)
1857 (edt-bind-gold-key "." 'edt-key-not-assigned t)
1858 (edt-bind-gold-key ">" 'edt-key-not-assigned t)
1859 (edt-bind-gold-key "/" 'edt-key-not-assigned t)
1860 (edt-bind-gold-key "?" 'edt-key-not-assigned t)
1861 (edt-bind-gold-key "\\" 'edt-key-not-assigned t)
1862 (edt-bind-gold-key "|" 'edt-key-not-assigned t)
1863 (edt-bind-gold-key ";" 'edt-key-not-assigned t)
1864 (edt-bind-gold-key ":" 'edt-key-not-assigned t)
1865 (edt-bind-gold-key "'" 'edt-key-not-assigned t)
1866 (edt-bind-gold-key "\"" 'edt-key-not-assigned t)
1867 (edt-bind-gold-key "-" 'edt-key-not-assigned t)
1868 (edt-bind-gold-key "_" 'edt-key-not-assigned t)
1869 (edt-bind-gold-key "=" 'goto-line t)
1870 (edt-bind-gold-key "+" 'edt-key-not-assigned t)
1871 (edt-bind-gold-key "[" 'edt-key-not-assigned t)
1872 (edt-bind-gold-key "{" 'edt-key-not-assigned t)
1873 (edt-bind-gold-key "]" 'edt-key-not-assigned t)
1874 (edt-bind-gold-key "}" 'edt-key-not-assigned t)
1875 (edt-bind-gold-key "`" 'what-line t)
1876 (edt-bind-gold-key "~" 'edt-key-not-assigned t)
1877 )
1878
1879 ;;;
1880 ;;; DEFAULT EDT KEYPAD HELP
1881 ;;;
1882
1883 ;;;
1884 ;;; Upper case commands in the keypad diagram below indicate that the
1885 ;;; emulation should look and feel very much like EDT. Lower case
1886 ;;; commands are enhancements and/or additions to the EDT keypad
1887 ;;; commands or are native Emacs commands.
1888 ;;;
1889
1890 (defun edt-keypad-help ()
1891 "
1892 DEFAULT EDT Keypad Active
1893
1894 F7: Copy Rectangle +----------+----------+----------+----------+
1895 F8: Cut Rect Overstrike |Prev Line |Next Line |Bkwd Char |Frwd Char |
1896 G-F8: Paste Rect Overstrike | (UP) | (DOWN) | (LEFT) | (RIGHT) |
1897 F9: Cut Rect Insert |Window Top|Window Bot|Bkwd Sent |Frwd Sent |
1898 G-F9: Paste Rect Insert +----------+----------+----------+----------+
1899 F10: Cut Rectangle
1900 G-F10: Paste Rectangle
1901 F11: ESC
1902 F12: Begining of Line +----------+----------+----------+----------+
1903 G-F12: Delete Other Windows | GOLD | HELP | FNDNXT | DEL L |
1904 F13: Delete to Begin of Word | (PF1) | (PF2) | (PF3) | (PF4) |
1905 HELP: Keypad Help |Mark Wisel|Desc Funct| FIND | UND L |
1906 DO: Execute extended command +----------+----------+----------+----------+
1907 | PAGE | SECT | APPEND | DEL W |
1908 C-g: Keyboard Quit | (7) | (8) | (9) | (-) |
1909 G-C-g: Keyboard Quit |Ex Ext Cmd|Fill Regio| REPLACE | UND W |
1910 C-h: Beginning of Line +----------+----------+----------+----------+
1911 G-C-h: Emacs Help | ADVANCE | BACKUP | CUT | DEL C |
1912 C-i: Tab Insert | (4) | (5) | (6) | (,) |
1913 C-j: Delete to Begin of Word | BOTTOM | TOP | Yank | UND C |
1914 C-k: Define Key +----------+----------+----------+----------+
1915 G-C-k: Restore Key | WORD | EOL | CHAR | Next |
1916 C-l: Form Feed Insert | (1) | (2) | (3) | Window |
1917 C-n: Set Screen Width 80 | CHNGCASE | DEL EOL |Quoted Ins| !
1918 C-r: Isearch Backward +---------------------+----------+ (ENTER) |
1919 C-s: Isearch Forward | LINE | SELECT | !
1920 C-t: Display the Time | (0) | (.) | Query |
1921 C-u: Delete to Begin of Line | Open Line | RESET | Replace |
1922 C-v: Redraw Display +---------------------+----------+----------+
1923 C-w: Set Screen Width 132
1924 C-z: Suspend Emacs +----------+----------+----------+
1925 G-C-\\: Split Window | FNDNXT | Yank | CUT |
1926 | (FIND) | (INSERT) | (REMOVE) |
1927 G-b: Buffer Menu | FIND | | COPY |
1928 G-c: Compile +----------+----------+----------+
1929 G-d: Delete Window |SELECT/RES|SECT BACKW|SECT FORWA|
1930 G-e: Exit | (SELECT) |(PREVIOUS)| (NEXT) |
1931 G-f: Find File | | | |
1932 G-g: Find File Other Window +----------+----------+----------+
1933 G-h: Keypad Help
1934 G-i: Insert File
1935 G-k: Toggle Capitalization Word
1936 G-l: Downcase Region
1937 G-m: Save Some Buffers
1938 G-n: Next Error
1939 G-o: Switch to Next Window
1940 G-q: Quit
1941 G-r: Revert File
1942 G-s: Save Buffer
1943 G-u: Upcase Region
1944 G-v: Find File Other Window
1945 G-w: Write file
1946 G-y: EDT Emulation OFF
1947 G-z: Switch to User EDT Key Bindings
1948 G-1: Delete Other Windows
1949 G-2: Split Window
1950 G-%: Go to Percentage
1951 G- : Undo (GOLD Spacebar)
1952 G-=: Go to Line
1953 G-`: What line"
1954
1955 (interactive)
1956 (describe-function 'edt-keypad-help))
1957
1958 (defun edt-electric-helpify (fun)
1959 (let ((name "*Help*"))
1960 (if (save-window-excursion
1961 (let* ((p (symbol-function 'print-help-return-message))
1962 (b (get-buffer name))
1963 (m (buffer-modified-p b)))
1964 (and b (not (get-buffer-window b))
1965 (setq b nil))
1966 (unwind-protect
1967 (progn
1968 (message "%s..." (capitalize (symbol-name fun)))
1969 (and b
1970 (save-excursion
1971 (set-buffer b)
1972 (set-buffer-modified-p t)))
1973 (fset 'print-help-return-message 'ignore)
1974 (call-interactively fun)
1975 (and (get-buffer name)
1976 (get-buffer-window (get-buffer name))
1977 (or (not b)
1978 (not (eq b (get-buffer name)))
1979 (not (buffer-modified-p b)))))
1980 (fset 'print-help-return-message p)
1981 (and b (buffer-name b)
1982 (save-excursion
1983 (set-buffer b)
1984 (set-buffer-modified-p m))))))
1985 (with-electric-help 'delete-other-windows name t))))
1986
1987 (defun edt-electric-keypad-help ()
1988 "Display default EDT bindings."
1989 (interactive)
1990 (edt-electric-helpify 'edt-keypad-help))
1991
1992 (defun edt-electric-user-keypad-help ()
1993 "Display user custom EDT bindings."
1994 (interactive)
1995 (edt-electric-helpify 'edt-user-keypad-help))
1996
1997 ;;;
1998 ;;; EDT emulation screen width commands.
1999 ;;;
2000 ;; Some terminals require modification of terminal attributes when changing the
2001 ;; number of columns displayed, hence the fboundp tests below. These functions
2002 ;; are defined in the corresponding terminal specific file, if needed.
2003
2004 (defun edt-set-screen-width-80 ()
2005 "Set screen width to 80 columns."
2006 (interactive)
2007 (if (fboundp 'edt-set-term-width-80)
2008 (edt-set-term-width-80))
2009 (set-screen-width 80)
2010 (message "Screen width 80"))
2011
2012 (defun edt-set-screen-width-132 ()
2013 "Set screen width to 132 columns."
2014 (interactive)
2015 (if (fboundp 'edt-set-term-width-132)
2016 (edt-set-term-width-132))
2017 (set-screen-width 132)
2018 (message "Screen width 132"))
2019
2020 (provide 'edt)
2021
2022 ;;; edt.el ends here