Mercurial > hg > xemacs-beta

comparison lisp/emulators/edt.el @ 70:131b0175ea99 r20-0b30

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-0b30
author cvs
date Mon, 13 Aug 2007 09:02:59 +0200
parents b82b59fe008d
children b9518feda344
comparison
equal deleted inserted replaced
69:804d1389bcd6 70:131b0175ea99
1 ;;; edt.el --- Enhanced EDT Keypad Mode Emulation for GNU Emacs 19 1 ;;; edt.el --- EDT emulation in Emacs
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>
7 ;; Keywords: emulations 2 ;; 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.
8 7
9 ;; This file is part of XEmacs. 8 ;; This file is part of XEmacs.
10 9
11 ;; XEmacs is free software; you can redistribute it and/or modify it 10 ;; XEmacs is free software; you can redistribute it and/or modify it
12 ;; under the terms of the GNU General Public License as published by 11 ;; under the terms of the GNU General Public License as published by
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
19 ;; General Public License for more details. 18 ;; General Public License for more details.
20 19
21 ;; You should have received a copy of the GNU General Public License 20 ;; You should have received a copy of the GNU General Public License
22 ;; along with XEmacs; see the file COPYING. If not, write to the Free 21 ;; along with XEmacs; see the file COPYING. If not, write to the Free
23 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 22 ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
24 ;; 02111-1307, USA. 23
25 24
26 ;;; Synched up with: FSF 19.34 25 ;; From mike@yetti.UUCP Fri Aug 29 12:49:28 1986
27 26 ;; Path: mit-prep!mit-hermes!mit-eddie!genrad!panda!husc6!seismo!mnetor!yetti!mike
28 ;;; Usage: 27 ;; From: mike@yetti.UUCP (Mike Clarkson )
29 28 ;; Newsgroups: net.sources
30 ;; See edt-user.doc in the Emacs etc directory. 29 ;; Subject: Gnu Emacs EDT Emulation - Introduction - 1/3
31 30 ;; Date: 27 Aug 86 23:30:33 GMT
32 ;; Maintainer's note: There was a very old edt.el here that wouldn't even 31 ;; Reply-To: mike@yetti.UUCP (Mike Clarkson )
33 ;; load, so I replaced it completely with the newer one from 19.34. -sb 32 ;; Organization: York University Computer Science
34 ;; ==================================================================== 33 ;;
35 34 ;; Here's my EDT emulation for GNU Emacs that is based on the EDT emulation
36 ;;; Electric Help functions are used for keypad help displays. A few 35 ;; for Gosling's Emacs sent out on the net a couple of years ago by Lynn Olson
37 ;;; picture functions are used in rectangular cut and paste commands. 36 ;; at Tektronics. This emulation was widely distributed as the file edt.ml
38 (require 'ehelp) 37 ;; in the maclib directory of most Emacs distributions.
39 (require 'picture) 38 ;;
40 39 ;; My emulation consists of two files: edt.el and edtdoc.el. The edtdoc.el file
41 ;;;; 40 ;; is the documentation, that you can add to the beginning of edt.el if you
42 ;;;; VARIABLES and CONSTANTS 41 ;; want. I have split them because I have been loading the edt.el file a lot
43 ;;;; 42 ;; during debugging.
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)
44 134
45 (defvar edt-last-deleted-lines "" 135 (defvar edt-last-deleted-lines ""
46 "Last text deleted by an EDT emulation line delete command.") 136 "Last text deleted by an EDT emulation line-delete command.")
47
48 (defvar edt-last-deleted-words "" 137 (defvar edt-last-deleted-words ""
49 "Last text deleted by an EDT emulation word delete command.") 138 "Last text deleted by an EDT emulation word-delete command.")
50
51 (defvar edt-last-deleted-chars "" 139 (defvar edt-last-deleted-chars ""
52 "Last text deleted by an EDT emulation character delete command.") 140 "Last text deleted by an EDT emulation character-delete command.")
53 141
54 (defvar edt-last-replaced-key-definition "" 142 (defun delete-current-line (num)
55 "Key definition replaced with edt-define-key or edt-learn command.") 143 "Delete one or specified number of lines after point.
56 144 This includes the newline character at the end of each line.
57 (defvar edt-direction-string "" 145 They are saved for the EDT undelete-lines command."
58 "String indicating current direction of movement.") 146 (interactive "p")
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)
479 (let ((beg (point))) 147 (let ((beg (point)))
480 (forward-line num) 148 (forward-line num)
481 (if (not (eq (preceding-char) ?\n)) 149 (if (not (eq (preceding-char) ?\n))
482 (insert "\n")) 150 (insert "\n"))
483 (setq edt-last-deleted-lines 151 (setq edt-last-deleted-lines
484 (buffer-substring beg (point))) 152 (buffer-substring beg (point)))
485 (delete-region beg (point)))) 153 (delete-region beg (point))))
486 154
487 ;;; 155 (defun delete-to-eol (num)
488 ;;; DEL EOL 156 "Delete text up to end of line.
489 ;;; 157 With argument, delete up to to Nth line-end past point.
490 158 They are saved for the EDT undelete-lines command."
491 (defun edt-delete-to-end-of-line (num) 159 (interactive "p")
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)
496 (let ((beg (point))) 160 (let ((beg (point)))
497 (forward-char 1) 161 (forward-char 1)
498 (end-of-line num) 162 (end-of-line num)
499 (setq edt-last-deleted-lines 163 (setq edt-last-deleted-lines
500 (buffer-substring beg (point))) 164 (buffer-substring beg (point)))
501 (delete-region beg (point)))) 165 (delete-region beg (point))))
502 166
503 ;;; 167 (defun delete-current-word (num)
504 ;;; SELECT 168 "Delete one or specified number of words after point.
505 ;;; 169 They are saved for the EDT undelete-words command."
506 170 (interactive "p")
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)
549 (let ((beg (point))) 171 (let ((beg (point)))
550 (edt-beginning-of-line num) 172 (forward-word num)
551 (setq edt-last-deleted-lines 173 (setq edt-last-deleted-words
552 (buffer-substring (point) beg)) 174 (buffer-substring beg (point)))
553 (delete-region beg (point)))) 175 (delete-region beg (point))))
554 176
555 ;;; 177 (defun edt-delete-previous-word (num)
556 ;;; DEL W 178 "Delete one or specified number of words before point.
557 ;;; 179 They are saved for the EDT undelete-words command."
558 180 (interactive "p")
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)
564 (let ((beg (point))) 181 (let ((beg (point)))
565 (edt-word-forward num) 182 (forward-word (- num))
566 (setq edt-last-deleted-words (buffer-substring beg (point))) 183 (setq edt-last-deleted-words
184 (buffer-substring (point) beg))
567 (delete-region beg (point)))) 185 (delete-region beg (point))))
568 186
569 ;;; 187 (defun delete-current-char (num)
570 ;;; DELETE TO BEGINNING OF WORD 188 "Delete one or specified number of characters after point.
571 ;;; 189 They are saved for the EDT undelete-chars command."
572 190 (interactive "p")
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)
592 (setq edt-last-deleted-chars 191 (setq edt-last-deleted-chars
593 (buffer-substring (point) (min (point-max) (+ (point) num)))) 192 (buffer-substring (point) (min (point-max) (+ (point) num))))
594 (delete-region (point) (min (point-max) (+ (point) num)))) 193 (delete-region (point) (min (point-max) (+ (point) num))))
595 194
596 ;;; 195 (defun delete-previous-char (num)
597 ;;; DELETE CHAR 196 "Delete one or specified number of characters before point.
598 ;;; 197 They are saved for the EDT undelete-chars command."
599 198 (interactive "p")
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)
605 (setq edt-last-deleted-chars 199 (setq edt-last-deleted-chars
606 (buffer-substring (max (point-min) (- (point) num)) (point))) 200 (buffer-substring (max (point-min) (- (point) num)) (point)))
607 (delete-region (max (point-min) (- (point) num)) (point))) 201 (delete-region (max (point-min) (- (point) num)) (point)))
608 202
609 ;;; 203 (defun undelete-lines ()
610 ;;; UND L 204 "Yank lines deleted by last EDT line-deletion command."
611 ;;; 205 (interactive)
612 206 (insert edt-last-deleted-lines))
613 (defun edt-undelete-line () 207
614 "Undelete previous deleted line(s)." 208 (defun undelete-words ()
615 (interactive "*") 209 "Yank words deleted by last EDT word-deletion command."
616 (point-to-register 1) 210 (interactive)
617 (insert edt-last-deleted-lines) 211 (insert edt-last-deleted-words))
618 (register-to-point 1)) 212
619 213 (defun undelete-chars ()
620 ;;; 214 "Yank characters deleted by last EDT character-deletion command."
621 ;;; UND W 215 (interactive)
622 ;;; 216 (insert edt-last-deleted-chars))
623 217
624 (defun edt-undelete-word () 218 (defun next-end-of-line (num)
625 "Undelete previous deleted word(s)." 219 "Move to end of line; if at end, move to end of next line.
626 (interactive "*") 220 Accepts a prefix argument for the number of lines to move."
627 (point-to-register 1) 221 (interactive "p")
628 (insert edt-last-deleted-words) 222 (forward-char)
629 (register-to-point 1)) 223 (end-of-line num))
630 224
631 ;;; 225 (defun previous-end-of-line (num)
632 ;;; UND C 226 "Move EOL upward.
633 ;;; 227 Accepts a prefix argument for the number of lines to move."
634 228 (interactive "p")
635 (defun edt-undelete-character () 229 (end-of-line (- 1 num)))
636 "Undelete previous deleted character(s)." 230
637 (interactive "*") 231 (defun forward-to-word (num)
638 (point-to-register 1) 232 "Move to next word-beginning, or to Nth following word-beginning."
639 (insert edt-last-deleted-chars) 233 (interactive "p")
640 (register-to-point 1)) 234 (forward-word (1+ num))
641 235 (forward-word -1))
642 ;;; 236
643 ;;; REPLACE 237 (defun backward-to-word (num)
644 ;;; 238 "Move back to word-end, or to Nth word-end seen."
645 239 (interactive "p")
646 (defun edt-replace () 240 (forward-word (- (1+ num)))
647 "Replace marked section with last CUT (killed) text." 241 (forward-word 1))
648 (interactive "*") 242
649 (exchange-point-and-mark) 243 (defun backward-line (num)
650 (let ((beg (point))) 244 "Move point to start of previous line.
651 (exchange-point-and-mark) 245 Prefix argument serves as repeat-count."
652 (delete-region beg (point))) 246 (interactive "p")
653 (yank)) 247 (forward-line (- num)))
654 248
655 ;;; 249 (defun scroll-window-down (num)
656 ;;; ADVANCE 250 "Scroll the display down a window-full.
657 ;;; 251 Accepts a prefix argument for the number of window-fulls to scroll."
658 252 (interactive "p")
659 (defun edt-advance () 253 (scroll-down (- (* (window-height) num) 2)))
660 "Set movement direction forward. 254
661 Also, execute command specified if in Minibuffer." 255 (defun scroll-window-up (num)
662 (interactive) 256 "Scroll the display up a window-full.
663 (setq edt-direction-string edt-forward-string) 257 Accepts a prefix argument for the number of window-fulls to scroll."
664 (force-mode-line-update) 258 (interactive "p")
665 (if (string-equal " *Minibuf" 259 (scroll-up (- (* (window-height) num) 2)))
666 (substring (buffer-name) 0 (min (length (buffer-name)) 9))) 260
667 (exit-minibuffer))) 261 (defun next-paragraph (num)
668 262 "Move to beginning of the next indented paragraph.
669 ;;; 263 Accepts a prefix argument for the number of paragraphs."
670 ;;; BACKUP 264 (interactive "p")
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)
863 (while (> num 0) 265 (while (> num 0)
864 (next-line 1) 266 (next-line 1)
865 (forward-paragraph) 267 (forward-paragraph)
866 (previous-line 1) 268 (previous-line 1)
867 (if (eolp) 269 (if (eolp) (next-line 1))
868 (next-line 1))
869 (setq num (1- num)))) 270 (setq num (1- num))))
870 271
871 (defun edt-paragraph-backward (num) 272 (defun previous-paragraph (num)
872 "Move backward to beginning of paragraph. 273 "Move to beginning of previous indented paragraph.
873 Accepts a positive prefix argument for the number of paragraphs to move." 274 Accepts a prefix argument for the number of paragraphs."
874 (interactive "p") 275 (interactive "p")
875 (edt-check-prefix num)
876 (while (> num 0) 276 (while (> num 0)
877 (backward-paragraph) 277 (backward-paragraph)
878 (previous-line 1) 278 (previous-line 1)
879 (if (eolp) (next-line 1)) 279 (if (eolp) (next-line 1))
880 (setq num (1- num)))) 280 (setq num (1- num))))
881 281
882 (defun edt-paragraph (num) 282 (defun move-to-beginning ()
883 "Move in current direction to next paragraph. 283 "Move cursor to the beginning of buffer, but don't set the mark."
884 Accepts a positive prefix argument for the number of paragraph to move." 284 (interactive)
885 (interactive "p") 285 (goto-char (point-min)))
886 (if (equal edt-direction-string edt-forward-string) 286
887 (edt-paragraph-forward num) 287 (defun move-to-end ()
888 (edt-paragraph-backward num))) 288 "Move cursor to the end of buffer, but don't set the mark."
889 289 (interactive)
890 ;;; 290 (goto-char (point-max)))
891 ;;; RESTORE KEY 291
892 ;;; 292 (defun goto-percent (perc)
893 293 "Move point to ARG percentage of the buffer."
894 (defun edt-restore-key () 294 (interactive "NGoto-percentage: ")
895 "Restore last replaced key definition. 295 (if (or (> perc 100) (< perc 0))
896 Definition is stored in edt-last-replaced-key-definition." 296 (error "Percentage %d out of range 0 < percent < 100" perc)
897 (interactive) 297 (goto-char (/ (* (point-max) perc) 100))))
898 (if edt-last-replaced-key-definition 298
899 (progn 299 (defun update-mode-line ()
900 (let (edt-key-definition-string) 300 "Make sure mode-line in the current buffer reflects all changes."
901 (set 'edt-key-definition-string 301 (set-buffer-modified-p (buffer-modified-p))
902 (read-key-sequence "Press the key to be restored: ")) 302 (sit-for 0))
903 (if (string-equal "\C-m" edt-key-definition-string) 303
904 (message "Key not restored") 304 (defun advance-direction ()
905 (define-key (current-global-map) 305 "Set EDT Advance mode so keypad commands move forward."
906 edt-key-definition-string edt-last-replaced-key-definition)))) 306 (interactive)
907 (error "No replaced key definition to restore!"))) 307 (setq edt-direction-string " ADVANCE")
908 308 (define-key function-keymap "\C-c" 'isearch-forward) ; PF3
909 ;;; 309 (define-key function-keymap "8" 'scroll-window-up) ; "8"
910 ;;; WINDOW TOP 310 (define-key function-keymap "7" 'next-paragraph) ; "7"
911 ;;; 311 (define-key function-keymap "1" 'forward-to-word) ; "1"
912 312 (define-key function-keymap "2" 'next-end-of-line) ; "2"
913 (defun edt-window-top () 313 (define-key function-keymap "3" 'forward-char) ; "3"
914 "Move the cursor to the top of the window." 314 (define-key function-keymap "0" 'forward-line) ; "0"
915 (interactive) 315 (update-mode-line))
916 (let ((start-column (current-column))) 316
917 (move-to-window-line 0) 317 (defun backup-direction ()
918 (move-to-column start-column))) 318 "Set EDT Backup mode so keypad commands move backward."
919 319 (interactive)
920 ;;; 320 (setq edt-direction-string " BACKUP")
921 ;;; WINDOW BOTTOM 321 (define-key function-keymap "\C-c" 'isearch-backward) ; PF3
922 ;;; 322 (define-key function-keymap "8" 'scroll-window-down) ; "8"
923 323 (define-key function-keymap "7" 'previous-paragraph) ; "7"
924 (defun edt-window-bottom () 324 (define-key function-keymap "1" 'backward-to-word) ; "1"
925 "Move the cursor to the bottom of the window." 325 (define-key function-keymap "2" 'previous-end-of-line) ; "2"
926 (interactive) 326 (define-key function-keymap "3" 'backward-char) ; "3"
927 (let ((start-column (current-column))) 327 (define-key function-keymap "0" 'backward-line) ; "0"
928 (move-to-window-line (- (window-height) 2)) 328 (update-mode-line))
929 (move-to-column start-column))) 329
930 330 (defun edt-beginning-of-window ()
931 ;;; 331 "Home cursor to top of window."
932 ;;; SCROLL WINDOW LINE 332 (interactive)
933 ;;; 333 (move-to-window-line 0))
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 ;;;
985 334
986 (defun edt-line-to-bottom-of-window () 335 (defun edt-line-to-bottom-of-window ()
987 "Move the current line to the bottom of the window." 336 "Move the current line to the top of the window."
988 (interactive) 337 (interactive)
989 (recenter -1)) 338 (recenter -1))
990
991 ;;;
992 ;;; LINE TO TOP OF WINDOW
993 ;;;
994 339
995 (defun edt-line-to-top-of-window () 340 (defun edt-line-to-top-of-window ()
996 "Move the current line to the top of the window." 341 "Move the current line to the top of the window."
997 (interactive) 342 (interactive)
998 (recenter 0)) 343 (recenter 0))
999 344
1000 ;;; 345 (defun case-flip-character (num)
1001 ;;; LINE TO MIDDLE OF WINDOW 346 "Change the case of the character under the cursor.
1002 ;;; 347 Accepts a prefix argument of the number of characters to invert."
1003 348 (interactive "p")
1004 (defun edt-line-to-middle-of-window () 349 (while (> num 0)
1005 "Move window so line with cursor is in the middle of the window." 350 (funcall (if (<= ?a (following-char))
1006 (interactive) 351 'upcase-region 'downcase-region)
1007 (recenter '(4))) 352 (point) (1+ (point)))
1008 353 (forward-char 1)
1009 ;;; 354 (setq num (1- num))))
1010 ;;; GOTO PERCENTAGE 355
1011 ;;; 356 (defun indent-or-fill-region ()
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 ()
1035 "Fill region in text modes, indent region in programming language modes." 357 "Fill region in text modes, indent region in programming language modes."
1036 (interactive "*") 358 (interactive)
1037 (if (string= paragraph-start "$\\|\f") 359 (if (string= paragraph-start "^$\\|^ ")
1038 (indent-region (point) (mark) nil) 360 (indent-region (point) (mark) nil)
1039 (fill-region (point) (mark)))) 361 (fill-region (point) (mark))))
1040 362
1041 ;;; 363 (defun mark-section-wisely ()
1042 ;;; MARK SECTION WISELY
1043 ;;;
1044
1045 (defun edt-mark-section-wisely ()
1046 "Mark the section in a manner consistent with the major-mode. 364 "Mark the section in a manner consistent with the major-mode.
1047 Uses mark-defun for emacs-lisp and lisp, 365 Uses mark-defun for emacs-lisp, lisp,
1048 mark-c-function for C, 366 mark-c-function for C,
1049 mark-fortran-subsystem for fortran,
1050 and mark-paragraph for other modes." 367 and mark-paragraph for other modes."
1051 (interactive) 368 (interactive)
1052 (if edt-select-mode 369 (cond ((eq major-mode 'emacs-lisp-mode)
1053 (progn 370 (mark-defun))
1054 (edt-reset)) 371 ((eq major-mode 'lisp-mode)
1055 (progn 372 (mark-defun))
1056 (cond ((or (eq major-mode 'emacs-lisp-mode) 373 ((eq major-mode 'c-mode)
1057 (eq major-mode 'lisp-mode)) 374 (mark-c-function))
1058 (mark-defun) 375 (t (mark-paragraph))))
1059 (message "Lisp defun selected")) 376
1060 ((eq major-mode 'c-mode) 377 ;;; Key Bindings
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
1486 (defun edt-emulation-on () 378 (defun edt-emulation-on ()
1487 "Turn on EDT Emulation." 379 "Begin emulating DEC's EDT editor.
1488 (interactive) 380 Certain keys are rebound; including nearly all keypad keys.
1489 ;; If using MS-DOS, need to load edt-pc.el 381 Use \\[edt-emulation-off] to undo all rebindings except the keypad keys.
1490 (if (eq system-type 'ms-dos) 382 Note that this function does not work if called directly from the .emacs file.
1491 (setq edt-term "pc") 383 Instead, the .emacs file should do (setq term-setup-hook 'edt-emulation-on)
1492 (setq edt-term (getenv "TERM"))) 384 Then this function will be called at the time when it will work."
1493 ;; All DEC VT series terminals are supported by loading edt-vt100.el 385 (interactive)
1494 (if (string-equal "vt" (substring edt-term 0 (min (length edt-term) 2))) 386 (advance-direction)
1495 (setq edt-term "vt100")) 387 (edt-bind-gold-keypad) ;Must do this *after* $TERM.el is loaded
1496 ;; Load EDT terminal specific configuration file. 388 (setq edt-mode-old-c-\\ (lookup-key global-map "\C-\\"))
1497 (let ((term edt-term) 389 (global-set-key "\C-\\" 'quoted-insert)
1498 hyphend) 390 (setq edt-mode-old-delete (lookup-key global-map "\177"))
1499 (while (and term 391 (global-set-key "\177" 'delete-previous-char) ;"Delete"
1500 (not (load (concat "edt-" term) t t))) 392 (setq edt-mode-old-lisp-delete (lookup-key emacs-lisp-mode-map "\177"))
1501 ;; Strip off last hyphen and what follows, then try again 393 (define-key emacs-lisp-mode-map "\177" 'delete-previous-char) ;"Delete"
1502 (if (setq hyphend (string-match "[-_][^-_]+$" term)) 394 (define-key lisp-mode-map "\177" 'delete-previous-char) ;"Delete"
1503 (setq term (substring term 0 hyphend)) 395 (setq edt-mode-old-linefeed (lookup-key global-map "\C-j"))
1504 (setq term nil))) 396 (global-set-key "\C-j" 'edt-delete-previous-word) ;"LineFeed"
1505 ;; Override terminal-specific file if running X Windows. X Windows support 397 (define-key esc-map "?" 'apropos)) ;"<ESC>?"
1506 ;; is handled differently in edt-load-xkeys 398
1507 (if (eq window-system 'x) 399 (defun edt-emulation-off ()
1508 (edt-load-xkeys nil) 400 "Return from EDT emulation to normal Emacs key bindings.
1509 (if (null term) 401 The keys redefined by \\[edt-emulation-on] are given their old definitions."
1510 (error "Unable to load EDT terminal specific file for %s" edt-term))) 402 (interactive)
1511 (setq edt-term term)) 403 (setq edt-direction-string nil)
1512 (setq edt-orig-transient-mark-mode transient-mark-mode) 404 (global-set-key "\C-\\" edt-mode-old-c-\\)
1513 (add-hook 'activate-mark-hook 405 (global-set-key "\177" edt-mode-old-delete) ;"Delete"
1514 (function 406 (define-key emacs-lisp-mode-map "\177" edt-mode-old-lisp-delete) ;"Delete"
1515 (lambda () 407 (define-key lisp-mode-map "\177" edt-mode-old-lisp-delete) ;"Delete"
1516 (edt-select-mode t)))) 408 (global-set-key "\C-j" edt-mode-old-linefeed)) ;"LineFeed"
1517 (add-hook 'deactivate-mark-hook 409
1518 (function 410 (define-key function-keymap "u" 'previous-line) ;Up arrow
1519 (lambda () 411 (define-key function-keymap "d" 'next-line) ;down arrow
1520 (edt-select-mode nil)))) 412 (define-key function-keymap "l" 'backward-char) ;right arrow
1521 (if (load "edt-user" t t) 413 (define-key function-keymap "r" 'forward-char) ;left arrow
1522 (edt-user-emulation-setup) 414 (define-key function-keymap "h" 'edt-beginning-of-window) ;home
1523 (edt-default-emulation-setup))) 415 (define-key function-keymap "\C-b" 'describe-key) ;PF2
1524 416 (define-key function-keymap "\C-d" 'delete-current-line);PF4
1525 (defun edt-emulation-off() 417 (define-key function-keymap "9" 'append-to-buffer) ;9 keypad key, etc.
1526 "Select original global key bindings, disabling EDT Emulation." 418 (define-key function-keymap "-" 'delete-current-word)
1527 (interactive) 419 (define-key function-keymap "4" 'advance-direction)
1528 (use-global-map global-map) 420 (define-key function-keymap "5" 'backup-direction)
1529 (if (not edt-keep-current-page-delimiter) 421 (define-key function-keymap "6" 'kill-region)
1530 (setq page-delimiter edt-orig-page-delimiter)) 422 (define-key function-keymap "," 'delete-current-char)
1531 (setq edt-direction-string "") 423 (define-key function-keymap "." 'set-mark-command)
1532 (setq edt-select-mode-text nil) 424 (define-key function-keymap "e" 'other-window) ;enter key
1533 (edt-reset) 425 (define-key function-keymap "\C-a" 'GOLD-prefix) ;PF1 ("gold")
1534 (force-mode-line-update t) 426
1535 (setq transient-mark-mode edt-orig-transient-mark-mode) 427 (fset 'GOLD-prefix GOLD-map)
1536 (message "Original key bindings restored; EDT Emulation disabled")) 428
1537 429 (defvar GOLD-map (make-keymap)
1538 (defun edt-default-emulation-setup (&optional user-setup) 430 "GOLD-map maps the function keys on the VT100 keyboard preceeded
1539 "Setup emulation of DEC's EDT editor." 431 by the PF1 key. GOLD is the ASCII the 7-bit escape sequence <ESC>OP.")
1540 ;; Setup default EDT global map by copying global map bindings. 432
1541 ;; This preserves ESC and C-x prefix bindings and other bindings we 433 (defun define-keypad-key (keymap function-keymap-slot definition)
1542 ;; wish to retain in EDT emulation mode keymaps. It also permits 434 (let ((function-key-sequence (function-key-sequence function-keymap-slot)))
1543 ;; customization of these bindings in the EDT global maps without 435 (if function-key-sequence
1544 ;; disturbing the original bindings in global-map. 436 (define-key keymap function-key-sequence definition))))
1545 (fset 'edt-default-ESC-prefix (copy-keymap 'ESC-prefix)) 437
1546 (setq edt-default-global-map (copy-keymap (current-global-map))) 438 ;;Bind GOLD/Keyboard keys
1547 (define-key edt-default-global-map "\e" 'edt-default-ESC-prefix) 439
1548 (define-prefix-command 'edt-default-gold-map) 440 (define-key GOLD-map "\C-g" 'keyboard-quit) ; just for safety
1549 (edt-setup-default-bindings) 441 (define-key GOLD-map "\177" 'delete-window) ;"Delete"
1550 ;; If terminal has additional function keys, the terminal-specific 442 (define-key GOLD-map "\C-h" 'delete-other-windows) ;"BackSpace"
1551 ;; initialization file can assign bindings to them via the optional 443 (define-key GOLD-map "\C-m" 'newline-and-indent) ;"Return"
1552 ;; function edt-setup-extra-default-bindings. 444 (define-key GOLD-map " " 'undo) ;"Spacebar"
1553 (if (fboundp 'edt-setup-extra-default-bindings) 445 (define-key GOLD-map "%" 'goto-percent) ; "%"
1554 (edt-setup-extra-default-bindings)) 446 (define-key GOLD-map "=" 'goto-line) ; "="
1555 ;; Variable needed by edt-learn. 447 (define-key GOLD-map "`" 'what-line) ; "`"
1556 (setq edt-learn-macro-count 0) 448 (define-key GOLD-map "\C-\\" 'split-window-vertically) ; "Control-\"
1557 ;; Display EDT text selection active within the mode line 449
1558 (or (assq 'edt-select-mode minor-mode-alist) 450 ; GOLD letter combinations:
1559 (setq minor-mode-alist 451 (define-key GOLD-map "b" 'buffer-menu) ; "b"
1560 (cons '(edt-select-mode edt-select-mode) minor-mode-alist))) 452 (define-key GOLD-map "B" 'buffer-menu) ; "B"
1561 ;; Display EDT direction of motion within the mode line 453 (define-key GOLD-map "d" 'delete-window) ; "d"
1562 (or (assq 'edt-direction-string minor-mode-alist) 454 (define-key GOLD-map "D" 'delete-window) ; "D"
1563 (setq minor-mode-alist 455 (define-key GOLD-map "e" 'compile) ; "e"
1564 (cons 456 (define-key GOLD-map "E" 'compile) ; "E"
1565 '(edt-direction-string edt-direction-string) minor-mode-alist))) 457 (define-key GOLD-map "i" 'insert-file) ; "i"
1566 (if user-setup 458 (define-key GOLD-map "I" 'insert-file) ; "I"
1567 (progn 459 (define-key GOLD-map "l" 'goto-line) ; "l"
1568 (setq edt-user-map-configured t) 460 (define-key GOLD-map "L" 'goto-line) ; "L"
1569 (fset 'edt-emulation-on (symbol-function 'edt-select-user-global-map))) 461 (define-key GOLD-map "m" 'save-some-buffers) ; "m"
1570 (progn 462 (define-key GOLD-map "M" 'save-some-buffers) ; "m"
1571 (fset 'edt-emulation-on (symbol-function 'edt-select-default-global-map)) 463 (define-key GOLD-map "n" 'next-error) ; "n"
1572 (edt-select-default-global-map)))) 464 (define-key GOLD-map "N" 'next-error) ; "N"
1573 465 (define-key GOLD-map "o" 'switch-to-buffer-other-window) ; "o"
1574 (defun edt-user-emulation-setup () 466 (define-key GOLD-map "O" 'switch-to-buffer-other-window) ; "O"
1575 "Setup user custom emulation of DEC's EDT editor." 467 (define-key GOLD-map "r" 'revert-file) ; "r"
1576 ;; Initialize EDT default bindings. 468 (define-key GOLD-map "r" 'revert-file) ; "R"
1577 (edt-default-emulation-setup t) 469 (define-key GOLD-map "s" 'save-buffer) ; "s"
1578 ;; Setup user EDT global map by copying default EDT global map bindings. 470 (define-key GOLD-map "S" 'save-buffer) ; "S"
1579 (fset 'edt-user-ESC-prefix (copy-keymap 'edt-default-ESC-prefix)) 471 (define-key GOLD-map "v" 'find-file-other-window) ; "v"
1580 (setq edt-user-global-map (copy-keymap edt-default-global-map)) 472 (define-key GOLD-map "V" 'find-file-other-window) ; "V"
1581 (define-key edt-user-global-map "\e" 'edt-user-ESC-prefix) 473 (define-key GOLD-map "w" 'write-file) ; "w"
1582 ;; If terminal has additional function keys, the user's initialization 474 (define-key GOLD-map "w" 'write-file) ; "W"
1583 ;; file can assign bindings to them via the optional 475 ;(define-key GOLD-map "z" 'shrink-window) ; "z"
1584 ;; function edt-setup-extra-default-bindings. 476 ;(define-key GOLD-map "Z" 'shrink-window) ; "z"
1585 (define-prefix-command 'edt-user-gold-map) 477
1586 (fset 'edt-user-gold-map (copy-keymap 'edt-default-gold-map)) 478 ;Bind GOLD/Keypad keys
1587 (edt-setup-user-bindings) 479 (defun edt-bind-gold-keypad ()
1588 (edt-select-user-global-map)) 480 (define-keypad-key GOLD-map ?u 'edt-line-to-top-of-window) ;"up-arrow"
1589 481 (define-keypad-key GOLD-map ?d 'edt-line-to-bottom-of-window) ;"down-arrow"
1590 (defun edt-select-default-global-map() 482 (define-keypad-key GOLD-map ?l 'backward-sentence) ;"left-arrow"
1591 "Select default EDT emulation key bindings." 483 (define-keypad-key GOLD-map ?r 'forward-sentence) ;"right-arrow"
1592 (interactive) 484 (define-keypad-key GOLD-map ?\C-a 'mark-section-wisely) ;Gold "PF1"
1593 (transient-mark-mode 1) 485 (define-keypad-key GOLD-map ?\C-b 'describe-function) ;Help "PF2"
1594 (use-global-map edt-default-global-map) 486 (define-keypad-key GOLD-map ?\C-c 'occur) ;Find "PF3"
1595 (if (not edt-keep-current-page-delimiter) 487 (define-keypad-key GOLD-map ?\C-d 'undelete-lines) ;Und Line "PF4"
1596 (progn 488 (define-keypad-key GOLD-map ?0 'open-line) ;Open L "0"
1597 (setq edt-orig-page-delimiter page-delimiter) 489 (define-keypad-key GOLD-map ?1 'case-flip-character) ;Chgcase "1"
1598 (setq page-delimiter "\f"))) 490 (define-keypad-key GOLD-map ?2 'delete-to-eol) ;Del EOL "2"
1599 (setq edt-default-map-active t) 491 (define-keypad-key GOLD-map ?3 'copy-region-as-kill) ;Copy "3"
1600 (edt-advance) 492 (define-keypad-key GOLD-map ?4 'move-to-end) ;Bottom "4"
1601 (setq edt-select-mode-text 'edt-select-mode-string) 493 (define-keypad-key GOLD-map ?5 'move-to-beginning) ;Top "5"
1602 (edt-reset) 494 (define-keypad-key GOLD-map ?6 'yank) ;Paste "6"
1603 (message "Default EDT keymap active")) 495 (define-keypad-key GOLD-map ?7 'execute-extended-command) ;Command "7"
1604 496 (define-keypad-key GOLD-map ?8 'indent-or-fill-region) ;Fill "8"
1605 (defun edt-select-user-global-map() 497 (define-keypad-key GOLD-map ?9 'replace-regexp) ;Replace "9"
1606 "Select user EDT emulation custom key bindings." 498 (define-keypad-key GOLD-map ?- 'undelete-words) ;UND word "-"
1607 (interactive) 499 (define-keypad-key GOLD-map ?, 'undelete-chars) ;UND Char ","
1608 (if edt-user-map-configured 500 (define-keypad-key GOLD-map ?. 'redraw-display) ;Reset Window "."
1609 (progn 501 (define-keypad-key GOLD-map ?e 'shell-command)) ;"ENTER"
1610 (transient-mark-mode 1) 502
1611 (use-global-map edt-user-global-map) 503 ;; Make direction of motion show in mode line
1612 (if (not edt-keep-current-page-delimiter) 504 ;; while EDT emulation is turned on.
1613 (progn 505 ;; Note that the keypad is always turned on when in Emacs.
1614 (setq edt-orig-page-delimiter page-delimiter) 506
1615 (setq page-delimiter "\f"))) 507 (or (assq 'edt-direction-string minor-mode-alist)
1616 (setq edt-default-map-active nil) 508 (setq minor-mode-alist (cons '(edt-direction-string edt-direction-string)
1617 (edt-advance) 509 minor-mode-alist)))
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