Update FSF's address.
[bpt/emacs.git] / lisp / emulation / tpu-edt.el
1 ;;; tpu-edt.el --- Emacs emulating TPU emulating EDT
2
3 ;; Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc.
4
5 ;; Author: Rob Riepel <riepel@networking.stanford.edu>
6 ;; Maintainer: Rob Riepel <riepel@networking.stanford.edu>
7 ;; Version: 4.2
8 ;; Keywords: emulations
9
10 ;; This file is part of GNU Emacs.
11
12 ;; GNU Emacs is free software; you can redistribute it and/or modify
13 ;; it under the terms of the GNU General Public License as published by
14 ;; the Free Software Foundation; either version 2, or (at your option)
15 ;; any later version.
16
17 ;; GNU Emacs is distributed in the hope that it will be useful,
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;; GNU General Public License for more details.
21
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with GNU Emacs; see the file COPYING. If not, write to the
24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
25 ;; Boston, MA 02111-1307, USA.
26
27 ;; TPU-edt is based on tpu.el by Jeff Kowalski and Bob Covey.
28
29 ;;; Commentary:
30
31 ;; %% TPU-edt -- Emacs emulating TPU emulating EDT
32
33 ;; %% Contents
34
35 ;; % Introduction
36 ;; % Differences Between TPU-edt and DEC TPU/edt
37 ;; % Starting TPU-edt
38 ;; % Customizing TPU-edt using the Emacs Initialization File
39 ;; % Regular Expressions in TPU-edt
40
41
42 ;; %% Introduction
43
44 ;; TPU-edt emulates the popular DEC VMS editor EDT (actually, it emulates
45 ;; DEC TPU's EDT emulation, hence the name TPU-edt). TPU-edt features the
46 ;; following TPU/edt functionality:
47
48 ;; . EDT keypad
49 ;; . On-line help
50 ;; . Repeat counts
51 ;; . Scroll margins
52 ;; . Learn sequences
53 ;; . Free cursor mode
54 ;; . Rectangular cut and paste
55 ;; . Multiple windows and buffers
56 ;; . TPU line-mode REPLACE command
57 ;; . Wild card search and substitution
58 ;; . Configurable through an initialization file
59 ;; . History recall of search strings, file names, and commands
60
61 ;; Please note that TPU-edt does NOT emulate TPU. It emulates TPU's EDT
62 ;; emulation. Very few TPU line-mode commands are supported.
63
64 ;; TPU-edt, like it's VMS cousin, works on VT-series terminals with DEC
65 ;; style keyboards. VT terminal emulators, including xterm with the
66 ;; appropriate key translations, work just fine too.
67
68 ;; TPU-edt works with X-windows. This is accomplished through a TPU-edt X
69 ;; key map. The TPU-edt module tpu-mapper creates this map and stores it
70 ;; in a file. Tpu-mapper will be run automatically the first time you
71 ;; invoke the X-windows version of emacs, or you can run it by hand. See
72 ;; the commentary in tpu-mapper.el for details.
73
74
75 ;; %% Differences Between TPU-edt and DEC TPU/edt
76
77 ;; In some cases, Emacs doesn't support text highlighting, so selected
78 ;; regions are not shown in inverse video. Emacs uses the concept of "the
79 ;; mark". The mark is set at one end of a selected region; the cursor is
80 ;; at the other. The letter "M" appears in the mode line when the mark is
81 ;; set. The native emacs command ^X^X (Control-X twice) exchanges the
82 ;; cursor with the mark; this provides a handy way to find the location of
83 ;; the mark.
84
85 ;; In TPU the cursor can be either bound or free. Bound means the cursor
86 ;; cannot wander outside the text of the file being edited. Free means
87 ;; the arrow keys can move the cursor past the ends of lines. Free is the
88 ;; default mode in TPU; bound is the only mode in EDT. Bound is the only
89 ;; mode in the base version of TPU-edt; optional extensions add an
90 ;; approximation of free mode, see the commentary in tpu-extras.el for
91 ;; details.
92
93 ;; Like TPU, emacs uses multiple buffers. Some buffers are used to hold
94 ;; files you are editing; other "internal" buffers are used for emacs' own
95 ;; purposes (like showing you help). Here are some commands for dealing
96 ;; with buffers.
97
98 ;; Gold-B moves to next buffer, including internal buffers
99 ;; Gold-N moves to next buffer containing a file
100 ;; Gold-M brings up a buffer menu (like TPU "show buffers")
101
102 ;; Emacs is very fond of throwing up new windows. Dealing with all these
103 ;; windows can be a little confusing at first, so here are a few commands
104 ;; to that may help:
105
106 ;; Gold-Next_Scr moves to the next window on the screen
107 ;; Gold-Prev_Scr moves to the previous window on the screen
108 ;; Gold-TAB also moves to the next window on the screen
109
110 ;; Control-x 1 deletes all but the current window
111 ;; Control-x 0 deletes the current window
112
113 ;; Note that the buffers associated with deleted windows still exist!
114
115 ;; Like TPU, TPU-edt has a "command" function, invoked with Gold-KP7 or
116 ;; Do. Most of the commands available are emacs commands. Some TPU
117 ;; commands are available, they are: replace, exit, quit, include, and
118 ;; Get (unfortunately, "get" is an internal emacs function, so we are
119 ;; stuck with "Get" - to make life easier, Get is available as Gold-g).
120
121 ;; TPU-edt supports the recall of commands, file names, and search
122 ;; strings. The history of strings recalled differs slightly from
123 ;; TPU/edt, but it is still very convenient.
124
125 ;; Help is available! The traditional help keys (Help and PF2) display
126 ;; a small help file showing the default keypad layout, control key
127 ;; functions, and Gold key functions. Pressing any key inside of help
128 ;; splits the screen and prints a description of the function of the
129 ;; pressed key. Gold-PF2 invokes the native emacs help, with it's
130 ;; zillions of options.
131
132 ;; Thanks to emacs, TPU-edt has some extensions that may make your life
133 ;; easier, or at least more interesting. For example, Gold-r toggles
134 ;; TPU-edt rectangular mode. In rectangular mode, Remove and Insert work
135 ;; on rectangles. Likewise, Gold-* toggles TPU-edt regular expression
136 ;; mode. In regular expression mode Find, Find Next, and the line-mode
137 ;; replace command work with regular expressions. [A regular expression
138 ;; is a pattern that denotes a set of strings; like VMS wildcards.]
139
140 ;; Emacs also gives TPU-edt the undo and occur functions. Undo does
141 ;; what it says; it undoes the last change. Multiple undos in a row
142 ;; undo multiple changes. For your convenience, undo is available on
143 ;; Gold-u. Occur shows all the lines containing a specific string in
144 ;; another window. Moving to that window, and typing ^C^C (Control-C
145 ;; twice) on a particular line moves you back to the original window
146 ;; at that line. Occur is on Gold-o.
147
148 ;; Finally, as you edit, remember that all the power of emacs is at
149 ;; your disposal. It really is a fantastic tool. You may even want to
150 ;; take some time and read the emacs tutorial; perhaps not to learn the
151 ;; native emacs key bindings, but to get a feel for all the things
152 ;; emacs can do for you. The emacs tutorial is available from the
153 ;; emacs help function: "Gold-PF2 t"
154
155
156 ;; %% Starting TPU-edt
157
158 ;; All you have to do to start TPU-edt, is turn it on. This can be
159 ;; done from the command line when running emacs.
160
161 ;; prompt> emacs -f tpu-edt
162
163 ;; If you've already started emacs, turn on TPU-edt using the tpu-edt
164 ;; command. First press `M-x' (that's usually `ESC' followed by `x')
165 ;; and type `tpu-edt' followed by a carriage return.
166
167 ;; If you like TPU-edt and want to use it all the time, you can start
168 ;; TPU-edt using the emacs initialization file, .emacs. Simply create
169 ;; a .emacs file in your home directory containing the line:
170
171 ;; (tpu-edt)
172
173 ;; That's all you need to do to start TPU-edt.
174
175
176 ;; %% Customizing TPU-edt using the Emacs Initialization File
177
178 ;; The following is a sample emacs initialization file. It shows how to
179 ;; invoke TPU-edt, and how to customize it.
180
181 ;; ; .emacs - a sample emacs initialization file
182
183 ;; ; Turn on TPU-edt
184 ;; (tpu-edt)
185
186 ;; ; Set scroll margins 10% (top) and 15% (bottom).
187 ;; (tpu-set-scroll-margins "10%" "15%")
188
189 ;; ; Load the vtxxx terminal control functions.
190 ;; (load "vt-control" t)
191
192 ;; ; TPU-edt treats words like EDT; here's how to add word separators.
193 ;; ; Note that backslash (\) and double quote (") are quoted with '\'.
194 ;; (tpu-add-word-separators "]\\[-_,.\"=+()'/*#:!&;$")
195
196 ;; ; Emacs is happy to save files without a final newline; other Unix
197 ;; ; programs hate that! Here we make sure that files end with newlines.
198 ;; (setq require-final-newline t)
199
200 ;; ; Emacs uses Control-s and Control-q. Problems can occur when using
201 ;; ; emacs on terminals that use these codes for flow control (Xon/Xoff
202 ;; ; flow control). These lines disable emacs' use of these characters.
203 ;; (global-unset-key "\C-s")
204 ;; (global-unset-key "\C-q")
205
206 ;; ; The emacs universal-argument function is very useful.
207 ;; ; This line maps universal-argument to Gold-PF1.
208 ;; (define-key GOLD-SS3-map "P" 'universal-argument) ; Gold-PF1
209
210 ;; ; Make KP7 move by paragraphs, instead of pages.
211 ;; (define-key SS3-map "w" 'tpu-paragraph) ; KP7
212
213 ;; ; Repeat the preceding mappings for X-windows.
214 ;; (cond
215 ;; (window-system
216 ;; (global-set-key [kp_7] 'tpu-paragraph) ; KP7
217 ;; (define-key GOLD-map [kp_f1] 'universal-argument))) ; GOLD-PF1
218
219 ;; ; Display the TPU-edt version.
220 ;; (tpu-version)
221
222
223 ;; %% Regular Expressions in TPU-edt
224
225 ;; Gold-* toggles TPU-edt regular expression mode. In regular expression
226 ;; mode, find, find next, replace, and substitute accept emacs regular
227 ;; expressions. A complete list of emacs regular expressions can be found
228 ;; using the emacs "info" command (it's somewhat like the VMS help
229 ;; command). Try the following sequence of commands:
230
231 ;; DO info <enter info mode>
232 ;; m emacs <select the "emacs" topic>
233 ;; m regexs <select the "regular expression" topic>
234
235 ;; Type "q" to quit out of info mode.
236
237 ;; There is a problem in regular expression mode when searching for empty
238 ;; strings, like beginning-of-line (^) and end-of-line ($). When searching
239 ;; for these strings, find-next may find the current string, instead of the
240 ;; next one. This can cause global replace and substitute commands to loop
241 ;; forever in the same location. For this reason, commands like
242
243 ;; replace "^" "> " <add "> " to beginning of line>
244 ;; replace "$" "00711" <add "00711" to end of line>
245
246 ;; may not work properly.
247
248 ;; Commands like those above are very useful for adding text to the
249 ;; beginning or end of lines. They might work on a line-by-line basis, but
250 ;; go into an infinite loop if the "all" response is specified. If the
251 ;; goal is to add a string to the beginning or end of a particular set of
252 ;; lines TPU-edt provides functions to do this.
253
254 ;; Gold-^ Add a string at BOL in region or buffer
255 ;; Gold-$ Add a string at EOL in region or buffer
256
257 ;; There is also a TPU-edt interface to the native emacs string replacement
258 ;; commands. Gold-/ invokes this command. It accepts regular expressions
259 ;; if TPU-edt is in regular expression mode. Given a repeat count, it will
260 ;; perform the replacement without prompting for confirmation.
261
262 ;; This command replaces empty strings correctly, however, it has its
263 ;; drawbacks. As a native emacs command, it has a different interface
264 ;; than the emulated TPU commands. Also, it works only in the forward
265 ;; direction, regardless of the current TPU-edt direction.
266
267 ;;; Code:
268
269
270 ;;;
271 ;;; Version Information
272 ;;;
273 (defconst tpu-version "4.2" "TPU-edt version number.")
274
275
276 ;;;
277 ;;; User Configurable Variables
278 ;;;
279 (defconst tpu-have-ispell t
280 "*If non-nil (default), TPU-edt uses ispell for spell checking.")
281
282 (defconst tpu-kill-buffers-silently nil
283 "*If non-nil, TPU-edt kills modified buffers without asking.")
284
285 (defvar tpu-percent-scroll 75
286 "*Percentage of the screen to scroll for next/previous screen commands.")
287
288 (defvar tpu-pan-columns 16
289 "*Number of columns the tpu-pan functions scroll left or right.")
290
291
292 ;;;
293 ;;; Emacs version identifiers - currently referenced by
294 ;;;
295 ;;; o tpu-mark o tpu-set-mark
296 ;;; o tpu-string-prompt o tpu-regexp-prompt
297 ;;; o tpu-edt-on o tpu-load-xkeys
298 ;;; o tpu-update-mode-line o mode line section
299 ;;;
300 (defconst tpu-emacs19-p (not (string-lessp emacs-version "19"))
301 "Non-nil if we are running Lucid Emacs or version 19.")
302
303 (defconst tpu-lucid-emacs19-p
304 (and tpu-emacs19-p (string-match "Lucid" emacs-version))
305 "Non-nil if we are running Lucid Emacs version 19.")
306
307
308 ;;;
309 ;;; Global Keymaps
310 ;;;
311 (defvar CSI-map (make-sparse-keymap)
312 "Maps the CSI function keys on the VT100 keyboard.
313 CSI is DEC's name for the sequence <ESC>[.")
314
315 (defvar SS3-map (make-sparse-keymap)
316 "Maps the SS3 function keys on the VT100 keyboard.
317 SS3 is DEC's name for the sequence <ESC>O.")
318
319 (defvar GOLD-map (make-keymap)
320 "Maps the function keys on the VT100 keyboard preceded by PF1.
321 GOLD is the ASCII 7-bit escape sequence <ESC>OP.")
322
323 (defvar GOLD-CSI-map (make-sparse-keymap)
324 "Maps the function keys on the VT100 keyboard preceded by GOLD-CSI.")
325
326 (defvar GOLD-SS3-map (make-sparse-keymap)
327 "Maps the function keys on the VT100 keyboard preceded by GOLD-SS3.")
328
329 (defvar tpu-global-map nil "TPU-edt global keymap.")
330 (defvar tpu-original-global-map (copy-keymap global-map)
331 "Original global keymap.")
332
333 (and tpu-lucid-emacs19-p
334 (defvar minibuffer-local-ns-map (make-sparse-keymap)
335 "Hack to give Lucid Emacs the same maps as ordinary Emacs."))
336
337
338 ;;;
339 ;;; Global Variables
340 ;;;
341 (defvar tpu-edt-mode nil
342 "If non-nil, TPU-edt mode is active.")
343
344 (defvar tpu-last-replaced-text ""
345 "Last text deleted by a TPU-edt replace command.")
346 (defvar tpu-last-deleted-region ""
347 "Last text deleted by a TPU-edt remove command.")
348 (defvar tpu-last-deleted-lines ""
349 "Last text deleted by a TPU-edt line-delete command.")
350 (defvar tpu-last-deleted-words ""
351 "Last text deleted by a TPU-edt word-delete command.")
352 (defvar tpu-last-deleted-char ""
353 "Last character deleted by a TPU-edt character-delete command.")
354
355 (defvar tpu-searching-forward t
356 "If non-nil, TPU-edt is searching in the forward direction.")
357 (defvar tpu-search-last-string ""
358 "Last text searched for by the TPU-edt search commands.")
359
360 (defvar tpu-regexp-p nil
361 "If non-nil, TPU-edt uses regexp search and replace routines.")
362 (defvar tpu-rectangular-p nil
363 "If non-nil, TPU-edt removes and inserts rectangles.")
364 (defvar tpu-advance t
365 "True when TPU-edt is operating in the forward direction.")
366 (defvar tpu-reverse nil
367 "True when TPU-edt is operating in the backward direction.")
368 (defvar tpu-control-keys nil
369 "If non-nil, control keys are set to perform TPU functions.")
370 (defvar tpu-xkeys-file nil
371 "File containing TPU-edt X key map.")
372
373 (defvar tpu-rectangle-string nil
374 "Mode line string to identify rectangular mode.")
375 (defvar tpu-direction-string nil
376 "Mode line string to identify current direction.")
377
378 (defvar tpu-add-at-bol-hist nil
379 "History variable for tpu-edt-add-at-bol function.")
380 (defvar tpu-add-at-eol-hist nil
381 "History variable for tpu-edt-add-at-eol function.")
382 (defvar tpu-regexp-prompt-hist nil
383 "History variable for search and replace functions.")
384
385
386 ;;;
387 ;;; Buffer Local Variables
388 ;;;
389 (defvar tpu-newline-and-indent-p nil
390 "If non-nil, Return produces a newline and indents.")
391 (make-variable-buffer-local 'tpu-newline-and-indent-p)
392
393 (defvar tpu-newline-and-indent-string nil
394 "Mode line string to identify AutoIndent mode.")
395 (make-variable-buffer-local 'tpu-newline-and-indent-string)
396
397 (defvar tpu-saved-delete-func nil
398 "Saved value of the delete key.")
399 (make-variable-buffer-local 'tpu-saved-delete-func)
400
401 (defvar tpu-buffer-local-map nil
402 "TPU-edt buffer local key map.")
403 (make-variable-buffer-local 'tpu-buffer-local-map)
404
405
406 ;;;
407 ;;; Mode Line - Modify the mode line to show the following
408 ;;;
409 ;;; o If the mark is set.
410 ;;; o Direction of motion.
411 ;;; o Active rectangle mode.
412 ;;;
413 (defvar tpu-original-mode-line mode-line-format)
414 (defvar tpu-original-mm-alist minor-mode-alist)
415
416 (defvar tpu-mark-flag " ")
417 (make-variable-buffer-local 'tpu-mark-flag)
418
419 (defun tpu-set-mode-line (for-tpu)
420 "Set the mode for TPU-edt, or reset it to default Emacs."
421 (cond ((not for-tpu)
422 (setq mode-line-format tpu-original-mode-line)
423 (setq minor-mode-alist tpu-original-mm-alist))
424 (t
425 (setq-default mode-line-format
426 (list (purecopy "")
427 'mode-line-modified
428 'mode-line-buffer-identification
429 (purecopy " ")
430 'global-mode-string
431 (purecopy " ")
432 'tpu-mark-flag
433 (purecopy " %[(")
434 'mode-name 'mode-line-process 'minor-mode-alist
435 (purecopy "%n")
436 (purecopy ")%]--")
437 (purecopy '(line-number-mode "L%l--"))
438 (purecopy '(column-number-mode "C%c--"))
439 (purecopy '(-3 . "%p"))
440 (purecopy "-%-")))
441 (or (assq 'tpu-newline-and-indent-p minor-mode-alist)
442 (setq minor-mode-alist
443 (cons '(tpu-newline-and-indent-p
444 tpu-newline-and-indent-string)
445 minor-mode-alist)))
446 (or (assq 'tpu-rectangular-p minor-mode-alist)
447 (setq minor-mode-alist
448 (cons '(tpu-rectangular-p tpu-rectangle-string)
449 minor-mode-alist)))
450 (or (assq 'tpu-direction-string minor-mode-alist)
451 (setq minor-mode-alist
452 (cons '(tpu-direction-string tpu-direction-string)
453 minor-mode-alist))))))
454
455 (defun tpu-update-mode-line nil
456 "Make sure mode-line in the current buffer reflects all changes."
457 (setq tpu-mark-flag (if (tpu-mark) "M" " "))
458 (cond (tpu-emacs19-p (force-mode-line-update))
459 (t (set-buffer-modified-p (buffer-modified-p)) (sit-for 0))))
460
461 (cond (tpu-lucid-emacs19-p
462 (add-hook 'zmacs-deactivate-region-hook 'tpu-update-mode-line)
463 (add-hook 'zmacs-activate-region-hook 'tpu-update-mode-line))
464 (tpu-emacs19-p
465 (add-hook 'activate-mark-hook 'tpu-update-mode-line)
466 (add-hook 'deactivate-mark-hook 'tpu-update-mode-line)))
467
468
469 ;;;
470 ;;; Match Markers -
471 ;;;
472 ;;; Set in: Search
473 ;;;
474 ;;; Used in: Replace, Substitute, Store-Text, Cut/Remove,
475 ;;; Append, and Change-Case
476 ;;;
477 (defvar tpu-match-beginning-mark (make-marker))
478 (defvar tpu-match-end-mark (make-marker))
479
480 (defun tpu-set-match nil
481 "Set markers at match beginning and end."
482 ;; Add one to beginning mark so it stays with the first character of
483 ;; the string even if characters are added just before the string.
484 (setq tpu-match-beginning-mark (copy-marker (1+ (match-beginning 0))))
485 (setq tpu-match-end-mark (copy-marker (match-end 0))))
486
487 (defun tpu-unset-match nil
488 "Unset match beginning and end markers."
489 (set-marker tpu-match-beginning-mark nil)
490 (set-marker tpu-match-end-mark nil))
491
492 (defun tpu-match-beginning nil
493 "Returns the location of the last match beginning."
494 (1- (marker-position tpu-match-beginning-mark)))
495
496 (defun tpu-match-end nil
497 "Returns the location of the last match end."
498 (marker-position tpu-match-end-mark))
499
500 (defun tpu-check-match nil
501 "Returns t if point is between tpu-match markers.
502 Otherwise sets the tpu-match markers to nil and returns nil."
503 ;; make sure 1- marker is in this buffer
504 ;; 2- point is at or after beginning marker
505 ;; 3- point is before ending marker, or in the case of
506 ;; zero length regions (like bol, or eol) that the
507 ;; beginning, end, and point are equal.
508 (cond ((and
509 (equal (marker-buffer tpu-match-beginning-mark) (current-buffer))
510 (>= (point) (1- (marker-position tpu-match-beginning-mark)))
511 (or
512 (< (point) (marker-position tpu-match-end-mark))
513 (and (= (1- (marker-position tpu-match-beginning-mark))
514 (marker-position tpu-match-end-mark))
515 (= (marker-position tpu-match-end-mark) (point))))) t)
516 (t
517 (tpu-unset-match) nil)))
518
519 (defun tpu-show-match-markers nil
520 "Show the values of the match markers."
521 (interactive)
522 (if (markerp tpu-match-beginning-mark)
523 (let ((beg (marker-position tpu-match-beginning-mark)))
524 (message "(%s, %s) in %s -- current %s in %s"
525 (if beg (1- beg) nil)
526 (marker-position tpu-match-end-mark)
527 (marker-buffer tpu-match-end-mark)
528 (point) (current-buffer)))))
529
530
531 ;;;
532 ;;; Utilities
533 ;;;
534 (defun tpu-caar (thingy) (car (car thingy)))
535 (defun tpu-cadr (thingy) (car (cdr thingy)))
536
537 (defun tpu-mark nil
538 "TPU-edt version of the mark function.
539 Return the appropriate value of the mark for the current
540 version of Emacs."
541 (cond (tpu-lucid-emacs19-p (mark (not zmacs-regions)))
542 (tpu-emacs19-p (and mark-active (mark (not transient-mark-mode))))
543 (t (mark))))
544
545 (defun tpu-set-mark (pos)
546 "TPU-edt verion of the `set-mark' function.
547 Sets the mark at POS and activates the region according to the
548 current version of Emacs."
549 (set-mark pos)
550 (and tpu-lucid-emacs19-p pos (zmacs-activate-region)))
551
552 (defun tpu-string-prompt (prompt history-symbol)
553 "Read a string with PROMPT."
554 (if tpu-emacs19-p
555 (read-from-minibuffer prompt nil nil nil history-symbol)
556 (read-string prompt)))
557
558 (defvar tpu-last-answer nil "Most recent response to tpu-y-or-n-p.")
559
560 (defun tpu-y-or-n-p (prompt &optional not-yes)
561 "Prompt for a y or n answer with positive default.
562 Optional second argument NOT-YES changes default to negative.
563 Like Emacs `y-or-n-p', but also accepts space as y and DEL as n."
564 (message (format "%s[%s]" prompt (if not-yes "n" "y")))
565 (let ((doit t))
566 (while doit
567 (setq doit nil)
568 (let ((ans (read-char)))
569 (cond ((or (= ans ?y) (= ans ?Y) (= ans ?\ ))
570 (setq tpu-last-answer t))
571 ((or (= ans ?n) (= ans ?N) (= ans ?\C-?))
572 (setq tpu-last-answer nil))
573 ((= ans ?\r) (setq tpu-last-answer (not not-yes)))
574 (t
575 (setq doit t) (beep)
576 (message (format "Please answer y or n. %s[%s]"
577 prompt (if not-yes "n" "y"))))))))
578 tpu-last-answer)
579
580 (defun tpu-local-set-key (key func)
581 "Replace a key in the TPU-edt local key map.
582 Create the key map if necessary."
583 (cond ((not (keymapp tpu-buffer-local-map))
584 (setq tpu-buffer-local-map (if (current-local-map)
585 (copy-keymap (current-local-map))
586 (make-sparse-keymap)))
587 (use-local-map tpu-buffer-local-map)))
588 (local-set-key key func))
589
590 (defun tpu-current-line nil
591 "Return the vertical position of point in the selected window.
592 Top line is 0. Counts each text line only once, even if it wraps."
593 (+ (count-lines (window-start) (point)) (if (= (current-column) 0) 1 0) -1))
594
595
596 ;;;
597 ;;; Breadcrumbs
598 ;;;
599 (defvar tpu-breadcrumb-plist nil
600 "The set of user-defined markers (breadcrumbs), as a plist.")
601
602 (defun tpu-drop-breadcrumb (num)
603 "Drops a breadcrumb that can be returned to later with goto-breadcrumb."
604 (interactive "p")
605 (put tpu-breadcrumb-plist num (list (current-buffer) (point)))
606 (message "Mark %d set." num))
607
608 (defun tpu-goto-breadcrumb (num)
609 "Returns to a breadcrumb set with drop-breadcrumb."
610 (interactive "p")
611 (cond ((get tpu-breadcrumb-plist num)
612 (switch-to-buffer (car (get tpu-breadcrumb-plist num)))
613 (goto-char (tpu-cadr (get tpu-breadcrumb-plist num)))
614 (message "mark %d found." num))
615 (t
616 (message "mark %d not found." num))))
617
618
619 ;;;
620 ;;; Miscellaneous
621 ;;;
622 (defun tpu-change-case (num)
623 "Change the case of the character under the cursor or region.
624 Accepts a prefix argument of the number of characters to invert."
625 (interactive "p")
626 (cond ((tpu-mark)
627 (let ((beg (region-beginning)) (end (region-end)))
628 (while (> end beg)
629 (funcall (if (= (downcase (char-after beg)) (char-after beg))
630 'upcase-region 'downcase-region)
631 beg (1+ beg))
632 (setq beg (1+ beg)))
633 (tpu-unselect t)))
634 ((tpu-check-match)
635 (let ((beg (tpu-match-beginning)) (end (tpu-match-end)))
636 (while (> end beg)
637 (funcall (if (= (downcase (char-after beg)) (char-after beg))
638 'upcase-region 'downcase-region)
639 beg (1+ beg))
640 (setq beg (1+ beg)))
641 (tpu-unset-match)))
642 (t
643 (while (> num 0)
644 (funcall (if (= (downcase (following-char)) (following-char))
645 'upcase-region 'downcase-region)
646 (point) (1+ (point)))
647 (forward-char (if tpu-reverse -1 1))
648 (setq num (1- num))))))
649
650 (defun tpu-fill (num)
651 "Fill paragraph or marked region.
652 With argument, fill and justify."
653 (interactive "P")
654 (cond ((tpu-mark)
655 (fill-region (point) (tpu-mark) num)
656 (tpu-unselect t))
657 (t
658 (fill-paragraph num))))
659
660 (defun tpu-version nil
661 "Print the TPU-edt version number."
662 (interactive)
663 (message
664 "TPU-edt version %s by Rob Riepel (riepel@networking.stanford.edu)"
665 tpu-version))
666
667 (defun tpu-reset-screen-size (height width)
668 "Sets the screen size."
669 (interactive "nnew screen height: \nnnew screen width: ")
670 (set-screen-height height)
671 (set-screen-width width))
672
673 (defun tpu-toggle-newline-and-indent nil
674 "Toggle between 'newline and indent' and 'simple newline'."
675 (interactive)
676 (cond (tpu-newline-and-indent-p
677 (setq tpu-newline-and-indent-string "")
678 (setq tpu-newline-and-indent-p nil)
679 (tpu-local-set-key "\C-m" 'newline))
680 (t
681 (setq tpu-newline-and-indent-string " AutoIndent")
682 (setq tpu-newline-and-indent-p t)
683 (tpu-local-set-key "\C-m" 'newline-and-indent)))
684 (tpu-update-mode-line)
685 (and (interactive-p)
686 (message "Carriage return inserts a newline%s"
687 (if tpu-newline-and-indent-p " and indents." "."))))
688
689 (defun tpu-spell-check nil
690 "Checks the spelling of the region, or of the entire buffer if no
691 region is selected."
692 (interactive)
693 (cond (tpu-have-ispell
694 (if (tpu-mark) (ispell-region (tpu-mark) (point)) (ispell-buffer)))
695 (t
696 (if (tpu-mark) (spell-region (tpu-mark) (point)) (spell-buffer))))
697 (if (tpu-mark) (tpu-unselect t)))
698
699 (defun tpu-toggle-overwrite-mode nil
700 "Switches in and out of overwrite mode"
701 (interactive)
702 (cond (overwrite-mode
703 (tpu-local-set-key "\177" tpu-saved-delete-func)
704 (overwrite-mode 0))
705 (t
706 (setq tpu-saved-delete-func (local-key-binding "\177"))
707 (tpu-local-set-key "\177" 'picture-backward-clear-column)
708 (overwrite-mode 1))))
709
710 (defun tpu-special-insert (num)
711 "Insert a character or control code according to
712 its ASCII decimal value."
713 (interactive "P")
714 (if overwrite-mode (delete-char 1))
715 (insert (if num num 0)))
716
717 (defun tpu-quoted-insert (num)
718 "Read next input character and insert it.
719 This is useful for inserting control characters."
720 (interactive "*p")
721 (let ((char (read-char)) )
722 (if overwrite-mode (delete-char num))
723 (insert-char char num)))
724
725
726 ;;;
727 ;;; TPU line-mode commands
728 ;;;
729 (defun tpu-include (file)
730 "TPU-like include file"
731 (interactive "fInclude file: ")
732 (save-excursion
733 (insert-file file)
734 (message "")))
735
736 (defun tpu-get (file)
737 "TPU-like get file"
738 (interactive "FFile to get: ")
739 (find-file file))
740
741 (defun tpu-what-line nil
742 "Tells what line the point is on,
743 and the total number of lines in the buffer."
744 (interactive)
745 (if (eobp)
746 (message "You are at the End of Buffer. The last line is %d."
747 (count-lines 1 (point-max)))
748 (message "Line %d of %d"
749 (count-lines 1 (1+ (point)))
750 (count-lines 1 (point-max)))))
751
752 (defun tpu-exit nil
753 "Exit the way TPU does, save current buffer and ask about others."
754 (interactive)
755 (if (not (eq (recursion-depth) 0))
756 (exit-recursive-edit)
757 (progn (save-buffer) (save-buffers-kill-emacs))))
758
759 (defun tpu-quit nil
760 "Quit the way TPU does, ask to make sure changes should be abandoned."
761 (interactive)
762 (let ((list (buffer-list))
763 (working t))
764 (while (and list working)
765 (let ((buffer (car list)))
766 (if (and (buffer-file-name buffer) (buffer-modified-p buffer))
767 (if (tpu-y-or-n-p
768 "Modifications will not be saved, continue quitting? ")
769 (kill-emacs t) (setq working nil)))
770 (setq list (cdr list))))
771 (if working (kill-emacs t))))
772
773
774 ;;;
775 ;;; Command and Function Aliases
776 ;;;
777 ;;;###autoload
778 (fset 'tpu-edt-mode 'tpu-edt-on)
779 (fset 'TPU-EDT-MODE 'tpu-edt-on)
780
781 ;;;###autoload
782 (fset 'tpu-edt 'tpu-edt-on)
783 (fset 'TPU-EDT 'tpu-edt-on)
784
785 (fset 'exit 'tpu-exit)
786 (fset 'EXIT 'tpu-exit)
787
788 (fset 'Get 'tpu-get)
789 (fset 'GET 'tpu-get)
790
791 (fset 'include 'tpu-include)
792 (fset 'INCLUDE 'tpu-include)
793
794 (fset 'quit 'tpu-quit)
795 (fset 'QUIT 'tpu-quit)
796
797 (fset 'spell 'tpu-spell-check)
798 (fset 'SPELL 'tpu-spell-check)
799
800 (fset 'what\ line 'tpu-what-line)
801 (fset 'WHAT\ LINE 'tpu-what-line)
802
803 (fset 'replace 'tpu-lm-replace)
804 (fset 'REPLACE 'tpu-lm-replace)
805
806 (fset 'help 'tpu-help)
807 (fset 'HELP 'tpu-help)
808
809 (fset 'set\ cursor\ free 'tpu-set-cursor-free)
810 (fset 'SET\ CURSOR\ FREE 'tpu-set-cursor-free)
811
812 (fset 'set\ cursor\ bound 'tpu-set-cursor-bound)
813 (fset 'SET\ CURSOR\ BOUND 'tpu-set-cursor-bound)
814
815 (fset 'set\ scroll\ margins 'tpu-set-scroll-margins)
816 (fset 'SET\ SCROLL\ MARGINS 'tpu-set-scroll-margins)
817
818
819 ;; Around emacs version 18.57, function line-move was renamed to
820 ;; next-line-internal. If we're running under an older emacs,
821 ;; make next-line-internal equivalent to line-move.
822
823 (if (not (fboundp 'next-line-internal)) (fset 'next-line-internal 'line-move))
824
825
826 ;;;
827 ;;; Help
828 ;;;
829 (defconst tpu-help-keypad-map "\f
830 _______________________ _______________________________
831 | HELP | Do | | | | | |
832 |KeyDefs| | | | | | |
833 |_______|_______________| |_______|_______|_______|_______|
834 _______________________ _______________________________
835 | Find |Insert |Remove | | Gold | HELP |FndNxt | Del L |
836 | | |Sto Tex| | key |E-Help | Find |Undel L|
837 |_______|_______|_______| |_______|_______|_______|_______|
838 |Select |Pre Scr|Nex Scr| | Page | Sect |Append | Del W |
839 | Reset |Pre Win|Nex Win| | Do | Fill |Replace|Undel W|
840 |_______|_______|_______| |_______|_______|_______|_______|
841 |Move up| |Forward|Reverse|Remove | Del C |
842 | Top | |Bottom | Top |Insert |Undel C|
843 _______|_______|_______ |_______|_______|_______|_______|
844 |Mov Lef|Mov Dow|Mov Rig| | Word | EOL | Char | |
845 |StaOfLi|Bottom |EndOfLi| |ChngCas|Del EOL|SpecIns| Enter |
846 |_______|_______|_______| |_______|_______|_______| |
847 | Line |Select | Subs |
848 | Open Line | Reset | |
849 |_______________|_______|_______|
850 ")
851
852 (defconst tpu-help-text "
853 \n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\f
854
855 Control Characters
856
857 ^A toggle insert and overwrite
858 ^B recall
859 ^E end of line
860
861 ^G Cancel current operation
862 ^H beginning of line
863 ^J delete previous word
864
865 ^K learn
866 ^L insert page break
867 ^R remember (during learn), re-center
868
869 ^U delete to beginning of line
870 ^V quote
871 ^W refresh
872
873 ^Z exit
874 ^X^X exchange point and mark - useful for checking region boundaries
875
876 \n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\f
877 Gold-<key> Functions
878
879 B Next Buffer - display the next buffer (all buffers)
880 C Recall - edit and possibly repeat previous commands
881 E Exit - save current buffer and ask about others
882 G Get - load a file into a new edit buffer
883
884 I Include - include a file in this buffer
885 K Kill Buffer - abandon edits and delete buffer
886 M Buffer Menu - display a list of all buffers
887 N Next File Buffer - display next buffer containing a file
888
889 O Occur - show following lines containing REGEXP
890 Q Quit - exit without saving anything
891 R Toggle rectangular mode for remove and insert
892 S Search and substitute - line mode REPLACE command
893
894 ^T Toggle control key bindings between TPU and emacs
895 U Undo - undo the last edit
896 W Write - save current buffer
897 X Exit - save all modified buffers and exit
898
899 \n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\f
900
901 More extensive documentation on TPU-edt can be found in the `Commentary'
902 section of tpu-edt.el. This section can be accessed through the standard
903 Emacs help facility using the `p' option. Once you exit TPU-edt Help, one
904 of the following key sequences is sure to get you there.
905
906 ^h p if you're not yet using TPU-edt
907 Gold-PF2 p if you're using TPU-edt
908
909 Alternatively, fire up Emacs help from the command prompt, with
910
911 M-x help-for-help <CR> p <CR>
912
913 Where `M-x' might be any of `Gold-KP7', 'Do', or 'ESC-x'.
914
915 When you successfully invoke this part of the Emacs help facility, you
916 will see a buffer named `*Finder*' listing a number of topics. Look for
917 tpu-edt under `emulations'.
918
919 \n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\f
920
921 *** No more help, use P to view previous screen")
922
923 (defvar tpu-help-enter (format "%s" "\eOM")) ; tpu-help enter key symbol
924 (defvar tpu-help-return (format "%s" "\r")) ; tpu-help enter key symbol
925 (defvar tpu-help-N "N") ; tpu-help "N" symbol
926 (defvar tpu-help-n "n") ; tpu-help "n" symbol
927 (defvar tpu-help-P "P") ; tpu-help "P" symbol
928 (defvar tpu-help-p "p") ; tpu-help "p" symbol
929
930 (defun tpu-help nil
931 "Display TPU-edt help."
932 (interactive)
933 ;; Save current window configuration
934 (save-window-excursion
935 ;; Create and fill help buffer if necessary
936 (if (not (get-buffer "*TPU-edt Help*"))
937 (progn (generate-new-buffer "*TPU-edt Help*")
938 (switch-to-buffer "*TPU-edt Help*")
939 (insert tpu-help-keypad-map)
940 (insert tpu-help-text)
941 (setq buffer-read-only t)))
942
943 ;; Display the help buffer
944 (switch-to-buffer "*TPU-edt Help*")
945 (delete-other-windows)
946 (tpu-move-to-beginning)
947 (forward-line 1)
948 (tpu-line-to-top-of-window)
949
950 ;; Prompt for keys to describe, based on screen state (split/not split)
951 (let ((key nil) (fkey nil) (split nil))
952 (while (not (equal tpu-help-return fkey))
953 (if split
954 (setq key
955 (read-key-sequence
956 "Press the key you want help on (RET=exit, ENTER=redisplay, N=next, P=prev): "))
957 (setq key
958 (read-key-sequence
959 "Press the key you want help on (RET to exit, N next screen, P prev screen): ")))
960
961 ;; Process the read key
962 ;;
963 ;; ENTER - Display just the help window
964 ;; N or n - Next help or describe-key screen
965 ;; P or p - Previous help or describe-key screen
966 ;; RETURN - Exit from TPU-help
967 ;; default - describe the key
968 ;;
969 (setq fkey (format "%s" key))
970 (cond ((equal tpu-help-enter fkey)
971 (setq split nil)
972 (delete-other-windows))
973 ((or (equal tpu-help-N fkey) (equal tpu-help-n fkey))
974 (cond (split
975 (condition-case nil
976 (scroll-other-window 8)
977 (error nil)))
978 (t
979 (forward-page)
980 (forward-line 1)
981 (tpu-line-to-top-of-window))))
982 ((or (equal tpu-help-P fkey) (equal tpu-help-p fkey))
983 (cond (split
984 (condition-case nil
985 (scroll-other-window -8)
986 (error nil)))
987 (t
988 (backward-page)
989 (forward-line 1)
990 (tpu-line-to-top-of-window))))
991 ((not (equal tpu-help-return fkey))
992 (setq split t)
993 (describe-key key)
994 ;; If the key is undefined, leave the
995 ;; message in the mini-buffer for 3 seconds
996 (if (not (key-binding key)) (sit-for 3))))))))
997
998
999 ;;;
1000 ;;; Auto-insert
1001 ;;;
1002 (defun tpu-insert-escape nil
1003 "Inserts an escape character, and so becomes the escape-key alias."
1004 (interactive)
1005 (insert "\e"))
1006
1007 (defun tpu-insert-formfeed nil
1008 "Inserts a formfeed character."
1009 (interactive)
1010 (insert "\C-L"))
1011
1012
1013 ;;;
1014 ;;; Define key
1015 ;;;
1016 (defvar tpu-saved-control-r nil "Saved value of Control-r.")
1017
1018 (defun tpu-end-define-macro-key (key)
1019 "Ends the current macro definition"
1020 (interactive "kPress the key you want to use to do what was just learned: ")
1021 (end-kbd-macro nil)
1022 (global-set-key key last-kbd-macro)
1023 (global-set-key "\C-r" tpu-saved-control-r))
1024
1025 (defun tpu-define-macro-key nil
1026 "Bind a set of keystrokes to a single key, or key combination."
1027 (interactive)
1028 (setq tpu-saved-control-r (global-key-binding "\C-r"))
1029 (global-set-key "\C-r" 'tpu-end-define-macro-key)
1030 (start-kbd-macro nil))
1031
1032
1033 ;;;
1034 ;;; Buffers and Windows
1035 ;;;
1036 (defun tpu-kill-buffer nil
1037 "Kills the current buffer. If tpu-kill-buffers-silently is non-nil,
1038 kills modified buffers without asking."
1039 (interactive)
1040 (if tpu-kill-buffers-silently (set-buffer-modified-p nil))
1041 (kill-buffer (current-buffer)))
1042
1043 (defun tpu-save-all-buffers-kill-emacs nil
1044 "Save all buffers and exit emacs."
1045 (interactive)
1046 (let ((delete-old-versions t))
1047 (save-buffers-kill-emacs t)))
1048
1049 (defun tpu-write-current-buffers nil
1050 "Save all modified buffers without exiting."
1051 (interactive)
1052 (save-some-buffers t))
1053
1054 (defun tpu-next-buffer nil
1055 "Go to next buffer in ring."
1056 (interactive)
1057 (switch-to-buffer (car (reverse (buffer-list)))))
1058
1059 (defun tpu-next-file-buffer nil
1060 "Go to next buffer in ring that is visiting a file or directory."
1061 (interactive)
1062 (let ((list (tpu-make-file-buffer-list (buffer-list))))
1063 (setq list (delq (current-buffer) list))
1064 (if (not list) (error "No other buffers."))
1065 (switch-to-buffer (car (reverse list)))))
1066
1067 (defun tpu-make-file-buffer-list (buffer-list)
1068 "Returns names from BUFFER-LIST excluding those beginning with a space or star."
1069 (delq nil (mapcar '(lambda (b)
1070 (if (or (= (aref (buffer-name b) 0) ? )
1071 (= (aref (buffer-name b) 0) ?*)) nil b))
1072 buffer-list)))
1073
1074 (defun tpu-next-window nil
1075 "Move to the next window."
1076 (interactive)
1077 (if (one-window-p) (message "There is only one window on screen.")
1078 (other-window 1)))
1079
1080 (defun tpu-previous-window nil
1081 "Move to the previous window."
1082 (interactive)
1083 (if (one-window-p) (message "There is only one window on screen.")
1084 (select-window (previous-window))))
1085
1086
1087 ;;;
1088 ;;; Search
1089 ;;;
1090 (defun tpu-toggle-regexp nil
1091 "Switches in and out of regular expression search and replace mode."
1092 (interactive)
1093 (setq tpu-regexp-p (not tpu-regexp-p))
1094 (tpu-set-search)
1095 (and (interactive-p)
1096 (message "Regular expression search and substitute %sabled."
1097 (if tpu-regexp-p "en" "dis"))))
1098
1099 (defun tpu-regexp-prompt (prompt)
1100 "Read a string, adding 'RE' to the prompt if tpu-regexp-p is set."
1101 (let ((re-prompt (concat (if tpu-regexp-p "RE ") prompt)))
1102 (if tpu-emacs19-p
1103 (read-from-minibuffer re-prompt nil nil nil 'tpu-regexp-prompt-hist)
1104 (read-string re-prompt))))
1105
1106 (defun tpu-search nil
1107 "Search for a string or regular expression.
1108 The search is performed in the current direction."
1109 (interactive)
1110 (tpu-set-search)
1111 (tpu-search-internal ""))
1112
1113 (defun tpu-search-forward nil
1114 "Search for a string or regular expression.
1115 The search is begins in the forward direction."
1116 (interactive)
1117 (setq tpu-searching-forward t)
1118 (tpu-set-search t)
1119 (tpu-search-internal ""))
1120
1121 (defun tpu-search-reverse nil
1122 "Search for a string or regular expression.
1123 The search is begins in the reverse direction."
1124 (interactive)
1125 (setq tpu-searching-forward nil)
1126 (tpu-set-search t)
1127 (tpu-search-internal ""))
1128
1129 (defun tpu-search-again nil
1130 "Search for the same string or regular expression as last time.
1131 The search is performed in the current direction."
1132 (interactive)
1133 (tpu-search-internal tpu-search-last-string))
1134
1135 ;; tpu-set-search defines the search functions used by the TPU-edt internal
1136 ;; search function. It should be called whenever the direction changes, or
1137 ;; the regular expression mode is turned on or off. It can also be called
1138 ;; to ensure that the next search will be in the current direction. It is
1139 ;; called from:
1140
1141 ;; tpu-advance tpu-backup
1142 ;; tpu-toggle-regexp tpu-toggle-search-direction (t)
1143 ;; tpu-search tpu-lm-replace
1144 ;; tpu-search-forward (t) tpu-search-reverse (t)
1145 ;; tpu-search-forward-exit (t) tpu-search-backward-exit (t)
1146
1147 (defun tpu-set-search (&optional arg)
1148 "Set the search functions and set the search direction to the current
1149 direction. If an argument is specified, don't set the search direction."
1150 (if (not arg) (setq tpu-searching-forward (if tpu-advance t nil)))
1151 (cond (tpu-searching-forward
1152 (cond (tpu-regexp-p
1153 (fset 'tpu-emacs-search 're-search-forward)
1154 (fset 'tpu-emacs-rev-search 're-search-backward))
1155 (t
1156 (fset 'tpu-emacs-search 'search-forward)
1157 (fset 'tpu-emacs-rev-search 'search-backward))))
1158 (t
1159 (cond (tpu-regexp-p
1160 (fset 'tpu-emacs-search 're-search-backward)
1161 (fset 'tpu-emacs-rev-search 're-search-forward))
1162 (t
1163 (fset 'tpu-emacs-search 'search-backward)
1164 (fset 'tpu-emacs-rev-search 'search-forward))))))
1165
1166 (defun tpu-search-internal (pat &optional quiet)
1167 "Search for a string or regular expression."
1168 (setq tpu-search-last-string
1169 (if (not (string= "" pat)) pat (tpu-regexp-prompt "Search: ")))
1170
1171 (tpu-unset-match)
1172 (tpu-adjust-search)
1173
1174 (let ((case-fold-search
1175 (and case-fold-search (tpu-check-search-case tpu-search-last-string))))
1176
1177 (cond ((tpu-emacs-search tpu-search-last-string nil t)
1178 (tpu-set-match) (goto-char (tpu-match-beginning)))
1179
1180 (t
1181 (tpu-adjust-search t)
1182 (let ((found nil) (pos nil))
1183 (save-excursion
1184 (let ((tpu-searching-forward (not tpu-searching-forward)))
1185 (tpu-adjust-search)
1186 (setq found (tpu-emacs-rev-search tpu-search-last-string nil t))
1187 (setq pos (match-beginning 0))))
1188
1189 (cond
1190 (found
1191 (cond ((tpu-y-or-n-p
1192 (format "Found in %s direction. Go there? "
1193 (if tpu-searching-forward "reverse" "forward")))
1194 (goto-char pos) (tpu-set-match)
1195 (tpu-toggle-search-direction))))
1196
1197 (t
1198 (if (not quiet)
1199 (message
1200 "%sSearch failed: \"%s\""
1201 (if tpu-regexp-p "RE " "") tpu-search-last-string)))))))))
1202
1203 (fset 'tpu-search-internal-core (symbol-function 'tpu-search-internal))
1204
1205 (defun tpu-check-search-case (string)
1206 "Returns t if string contains upper case."
1207 ;; if using regexp, eliminate upper case forms (\B \W \S.)
1208 (if tpu-regexp-p
1209 (let ((pat (copy-sequence string)) (case-fold-search nil) (pos 0))
1210 (while (setq pos (string-match "\\\\\\\\" pat)) (aset pat (+ 1 pos) ?.))
1211 (while (setq pos (string-match "\\\\B" pat)) (aset pat (+ 1 pos) ?.))
1212 (while (setq pos (string-match "\\\\W" pat)) (aset pat (+ 1 pos) ?.))
1213 (while (setq pos (string-match "\\\\S." pat))
1214 (aset pat (+ 1 pos) ?.) (aset pat (+ 2 pos) ?.))
1215 (string-equal pat (downcase pat)))
1216 (string-equal string (downcase string))))
1217
1218 (defun tpu-adjust-search (&optional arg)
1219 "For forward searches, move forward a character before searching,
1220 and backward a character after a failed search. Arg means end of search."
1221 (if tpu-searching-forward
1222 (cond (arg (if (not (bobp)) (forward-char -1)))
1223 (t (if (not (eobp)) (forward-char 1))))))
1224
1225 (defun tpu-toggle-search-direction nil
1226 "Toggle the TPU-edt search direction.
1227 Used for reversing a search in progress."
1228 (interactive)
1229 (setq tpu-searching-forward (not tpu-searching-forward))
1230 (tpu-set-search t)
1231 (and (interactive-p)
1232 (message "Searching %sward."
1233 (if tpu-searching-forward "for" "back"))))
1234
1235 (defun tpu-search-forward-exit nil
1236 "Set search direction forward and exit minibuffer."
1237 (interactive)
1238 (setq tpu-searching-forward t)
1239 (tpu-set-search t)
1240 (exit-minibuffer))
1241
1242 (defun tpu-search-backward-exit nil
1243 "Set search direction backward and exit minibuffer."
1244 (interactive)
1245 (setq tpu-searching-forward nil)
1246 (tpu-set-search t)
1247 (exit-minibuffer))
1248
1249
1250 ;;;
1251 ;;; Select / Unselect
1252 ;;;
1253 (defun tpu-select (&optional quiet)
1254 "Sets the mark to define one end of a region."
1255 (interactive "P")
1256 (cond ((tpu-mark)
1257 (tpu-unselect quiet))
1258 (t
1259 (tpu-set-mark (point))
1260 (tpu-update-mode-line)
1261 (if (not quiet) (message "Move the text cursor to select text.")))))
1262
1263 (defun tpu-unselect (&optional quiet)
1264 "Removes the mark to unselect the current region."
1265 (interactive "P")
1266 (setq mark-ring nil)
1267 (tpu-set-mark nil)
1268 (tpu-update-mode-line)
1269 (if (not quiet) (message "Selection canceled.")))
1270
1271
1272 ;;;
1273 ;;; Delete / Cut
1274 ;;;
1275 (defun tpu-toggle-rectangle nil
1276 "Toggle rectangular mode for remove and insert."
1277 (interactive)
1278 (setq tpu-rectangular-p (not tpu-rectangular-p))
1279 (setq tpu-rectangle-string (if tpu-rectangular-p " Rect" ""))
1280 (tpu-update-mode-line)
1281 (and (interactive-p)
1282 (message "Rectangular cut and paste %sabled."
1283 (if tpu-rectangular-p "en" "dis"))))
1284
1285 (defun tpu-arrange-rectangle nil
1286 "Adjust point and mark to mark upper left and lower right
1287 corners of a rectangle."
1288 (let ((mc (current-column))
1289 (pc (progn (exchange-point-and-mark) (current-column))))
1290
1291 (cond ((> (point) (tpu-mark)) ; point on lower line
1292 (cond ((> pc mc) ; point @ lower-right
1293 (exchange-point-and-mark)) ; point -> upper-left
1294
1295 (t ; point @ lower-left
1296 (move-to-column-force mc) ; point -> lower-right
1297 (exchange-point-and-mark) ; point -> upper-right
1298 (move-to-column-force pc)))) ; point -> upper-left
1299
1300 (t ; point on upper line
1301 (cond ((> pc mc) ; point @ upper-right
1302 (move-to-column-force mc) ; point -> upper-left
1303 (exchange-point-and-mark) ; point -> lower-left
1304 (move-to-column-force pc) ; point -> lower-right
1305 (exchange-point-and-mark))))))) ; point -> upper-left
1306
1307 (defun tpu-cut-text nil
1308 "Delete the selected region.
1309 The text is saved for the tpu-paste command."
1310 (interactive)
1311 (cond ((tpu-mark)
1312 (cond (tpu-rectangular-p
1313 (tpu-arrange-rectangle)
1314 (picture-clear-rectangle (point) (tpu-mark) (not overwrite-mode))
1315 (tpu-unselect t))
1316 (t
1317 (setq tpu-last-deleted-region
1318 (buffer-substring (tpu-mark) (point)))
1319 (delete-region (tpu-mark) (point))
1320 (tpu-unselect t))))
1321 ((tpu-check-match)
1322 (let ((beg (tpu-match-beginning)) (end (tpu-match-end)))
1323 (setq tpu-last-deleted-region (buffer-substring beg end))
1324 (delete-region beg end)
1325 (tpu-unset-match)))
1326 (t
1327 (error "No selection active."))))
1328
1329 (defun tpu-store-text nil
1330 "Copy the selected region to the cut buffer without deleting it.
1331 The text is saved for the tpu-paste command."
1332 (interactive)
1333 (cond ((tpu-mark)
1334 (cond (tpu-rectangular-p
1335 (save-excursion
1336 (tpu-arrange-rectangle)
1337 (setq picture-killed-rectangle
1338 (extract-rectangle (point) (tpu-mark))))
1339 (tpu-unselect t))
1340 (t
1341 (setq tpu-last-deleted-region
1342 (buffer-substring (tpu-mark) (point)))
1343 (tpu-unselect t))))
1344 ((tpu-check-match)
1345 (setq tpu-last-deleted-region
1346 (buffer-substring (tpu-match-beginning) (tpu-match-end)))
1347 (tpu-unset-match))
1348 (t
1349 (error "No selection active."))))
1350
1351 (defun tpu-cut (arg)
1352 "Copy selected region to the cut buffer. In the absence of an
1353 argument, delete the selected region too."
1354 (interactive "P")
1355 (if arg (tpu-store-text) (tpu-cut-text)))
1356
1357 (defun tpu-append-region (arg)
1358 "Append selected region to the tpu-cut buffer. In the absence of an
1359 argument, delete the selected region too."
1360 (interactive "P")
1361 (cond ((tpu-mark)
1362 (let ((beg (region-beginning)) (end (region-end)))
1363 (setq tpu-last-deleted-region
1364 (concat tpu-last-deleted-region
1365 (buffer-substring beg end)))
1366 (if (not arg) (delete-region beg end))
1367 (tpu-unselect t)))
1368 ((tpu-check-match)
1369 (let ((beg (tpu-match-beginning)) (end (tpu-match-end)))
1370 (setq tpu-last-deleted-region
1371 (concat tpu-last-deleted-region
1372 (buffer-substring beg end)))
1373 (if (not arg) (delete-region beg end))
1374 (tpu-unset-match)))
1375 (t
1376 (error "No selection active."))))
1377
1378 (defun tpu-delete-current-line (num)
1379 "Delete one or specified number of lines after point.
1380 This includes the newline character at the end of each line.
1381 They are saved for the TPU-edt undelete-lines command."
1382 (interactive "p")
1383 (let ((beg (point)))
1384 (forward-line num)
1385 (if (not (eq (preceding-char) ?\n))
1386 (insert "\n"))
1387 (setq tpu-last-deleted-lines
1388 (buffer-substring beg (point)))
1389 (delete-region beg (point))))
1390
1391 (defun tpu-delete-to-eol (num)
1392 "Delete text up to end of line.
1393 With argument, delete up to to Nth line-end past point.
1394 They are saved for the TPU-edt undelete-lines command."
1395 (interactive "p")
1396 (let ((beg (point)))
1397 (forward-char 1)
1398 (end-of-line num)
1399 (setq tpu-last-deleted-lines
1400 (buffer-substring beg (point)))
1401 (delete-region beg (point))))
1402
1403 (defun tpu-delete-to-bol (num)
1404 "Delete text back to beginning of line.
1405 With argument, delete up to to Nth line-end past point.
1406 They are saved for the TPU-edt undelete-lines command."
1407 (interactive "p")
1408 (let ((beg (point)))
1409 (tpu-next-beginning-of-line num)
1410 (setq tpu-last-deleted-lines
1411 (buffer-substring (point) beg))
1412 (delete-region (point) beg)))
1413
1414 (defun tpu-delete-current-word (num)
1415 "Delete one or specified number of words after point.
1416 They are saved for the TPU-edt undelete-words command."
1417 (interactive "p")
1418 (let ((beg (point)))
1419 (tpu-forward-to-word num)
1420 (setq tpu-last-deleted-words
1421 (buffer-substring beg (point)))
1422 (delete-region beg (point))))
1423
1424 (defun tpu-delete-previous-word (num)
1425 "Delete one or specified number of words before point.
1426 They are saved for the TPU-edt undelete-words command."
1427 (interactive "p")
1428 (let ((beg (point)))
1429 (tpu-backward-to-word num)
1430 (setq tpu-last-deleted-words
1431 (buffer-substring (point) beg))
1432 (delete-region beg (point))))
1433
1434 (defun tpu-delete-current-char (num)
1435 "Delete one or specified number of characters after point. The last
1436 character deleted is saved for the TPU-edt undelete-char command."
1437 (interactive "p")
1438 (while (and (> num 0) (not (eobp)))
1439 (setq tpu-last-deleted-char (char-after (point)))
1440 (cond (overwrite-mode
1441 (picture-clear-column 1)
1442 (forward-char 1))
1443 (t
1444 (delete-char 1)))
1445 (setq num (1- num))))
1446
1447
1448 ;;;
1449 ;;; Undelete / Paste
1450 ;;;
1451 (defun tpu-paste (num)
1452 "Insert the last region or rectangle of killed text.
1453 With argument reinserts the text that many times."
1454 (interactive "p")
1455 (while (> num 0)
1456 (cond (tpu-rectangular-p
1457 (let ((beg (point)))
1458 (save-excursion
1459 (picture-yank-rectangle (not overwrite-mode))
1460 (message ""))
1461 (goto-char beg)))
1462 (t
1463 (insert tpu-last-deleted-region)))
1464 (setq num (1- num))))
1465
1466 (defun tpu-undelete-lines (num)
1467 "Insert lines deleted by last TPU-edt line-deletion command.
1468 With argument reinserts lines that many times."
1469 (interactive "p")
1470 (let ((beg (point)))
1471 (while (> num 0)
1472 (insert tpu-last-deleted-lines)
1473 (setq num (1- num)))
1474 (goto-char beg)))
1475
1476 (defun tpu-undelete-words (num)
1477 "Insert words deleted by last TPU-edt word-deletion command.
1478 With argument reinserts words that many times."
1479 (interactive "p")
1480 (let ((beg (point)))
1481 (while (> num 0)
1482 (insert tpu-last-deleted-words)
1483 (setq num (1- num)))
1484 (goto-char beg)))
1485
1486 (defun tpu-undelete-char (num)
1487 "Insert character deleted by last TPU-edt character-deletion command.
1488 With argument reinserts the character that many times."
1489 (interactive "p")
1490 (while (> num 0)
1491 (if overwrite-mode (prog1 (forward-char -1) (delete-char 1)))
1492 (insert tpu-last-deleted-char)
1493 (forward-char -1)
1494 (setq num (1- num))))
1495
1496
1497 ;;;
1498 ;;; Replace and Substitute
1499 ;;;
1500 (defun tpu-replace nil
1501 "Replace the selected region with the contents of the cut buffer."
1502 (interactive)
1503 (cond ((tpu-mark)
1504 (let ((beg (region-beginning)) (end (region-end)))
1505 (setq tpu-last-replaced-text (buffer-substring beg end))
1506 (delete-region beg end)
1507 (insert tpu-last-deleted-region)
1508 (tpu-unselect t)))
1509 ((tpu-check-match)
1510 (let ((beg (tpu-match-beginning)) (end (tpu-match-end)))
1511 (setq tpu-last-replaced-text (buffer-substring beg end))
1512 (replace-match tpu-last-deleted-region
1513 (not case-replace) (not tpu-regexp-p))
1514 (tpu-unset-match)))
1515 (t
1516 (error "No selection active."))))
1517
1518 (defun tpu-substitute (num)
1519 "Replace the selected region with the contents of the cut buffer, and
1520 repeat most recent search. A numeric argument serves as a repeat count.
1521 A negative argument means replace all occurrences of the search string."
1522 (interactive "p")
1523 (cond ((or (tpu-mark) (tpu-check-match))
1524 (while (and (not (= num 0)) (or (tpu-mark) (tpu-check-match)))
1525 (let ((beg (point)))
1526 (tpu-replace)
1527 (if tpu-searching-forward (forward-char -1) (goto-char beg))
1528 (if (= num 1) (tpu-search-internal tpu-search-last-string)
1529 (tpu-search-internal-core tpu-search-last-string)))
1530 (setq num (1- num))))
1531 (t
1532 (error "No selection active."))))
1533
1534 (defun tpu-lm-replace (from to)
1535 "Interactively search for OLD-string and substitute NEW-string."
1536 (interactive (list (tpu-regexp-prompt "Old String: ")
1537 (tpu-regexp-prompt "New String: ")))
1538
1539 (let ((doit t) (strings 0))
1540
1541 ;; Can't replace null strings
1542 (if (string= "" from) (error "No string to replace."))
1543
1544 ;; Find the first occurrence
1545 (tpu-set-search)
1546 (tpu-search-internal from t)
1547
1548 ;; Loop on replace question - yes, no, all, last, or quit.
1549 (while doit
1550 (if (not (tpu-check-match)) (setq doit nil)
1551 (progn (message "Replace? Type Yes, No, All, Last, or Quit: ")
1552 (let ((ans (read-char)))
1553
1554 (cond ((or (= ans ?y) (= ans ?Y) (= ans ?\r) (= ans ?\ ))
1555 (let ((beg (point)))
1556 (replace-match to (not case-replace) (not tpu-regexp-p))
1557 (setq strings (1+ strings))
1558 (if tpu-searching-forward (forward-char -1) (goto-char beg)))
1559 (tpu-search-internal from t))
1560
1561 ((or (= ans ?n) (= ans ?N) (= ans ?\C-?))
1562 (tpu-search-internal from t))
1563
1564 ((or (= ans ?a) (= ans ?A))
1565 (save-excursion
1566 (let ((beg (point)))
1567 (replace-match to (not case-replace) (not tpu-regexp-p))
1568 (setq strings (1+ strings))
1569 (if tpu-searching-forward (forward-char -1) (goto-char beg)))
1570 (tpu-search-internal-core from t)
1571 (while (tpu-check-match)
1572 (let ((beg (point)))
1573 (replace-match to (not case-replace) (not tpu-regexp-p))
1574 (setq strings (1+ strings))
1575 (if tpu-searching-forward (forward-char -1) (goto-char beg)))
1576 (tpu-search-internal-core from t)))
1577 (setq doit nil))
1578
1579 ((or (= ans ?l) (= ans ?L))
1580 (let ((beg (point)))
1581 (replace-match to (not case-replace) (not tpu-regexp-p))
1582 (setq strings (1+ strings))
1583 (if tpu-searching-forward (forward-char -1) (goto-char beg)))
1584 (setq doit nil))
1585
1586 ((or (= ans ?q) (= ans ?Q))
1587 (setq doit nil)))))))
1588
1589 (message "Replaced %s occurrence%s." strings
1590 (if (not (= 1 strings)) "s" ""))))
1591
1592 (defun tpu-emacs-replace (&optional dont-ask)
1593 "A TPU-edt interface to the emacs replace functions. If TPU-edt is
1594 currently in regular expression mode, the emacs regular expression
1595 replace functions are used. If an argument is supplied, replacements
1596 are performed without asking. Only works in forward direction."
1597 (interactive "P")
1598 (cond (dont-ask
1599 (setq current-prefix-arg nil)
1600 (call-interactively
1601 (if tpu-regexp-p 'replace-regexp 'replace-string)))
1602 (t
1603 (call-interactively
1604 (if tpu-regexp-p 'query-replace-regexp 'query-replace)))))
1605
1606 (defun tpu-add-at-bol (text)
1607 "Add text to the beginning of each line in a region,
1608 or each line in the entire buffer if no region is selected."
1609 (interactive
1610 (list (tpu-string-prompt "String to add: " 'tpu-add-at-bol-hist)))
1611 (if (string= "" text) (error "No string specified."))
1612 (cond ((tpu-mark)
1613 (save-excursion
1614 (if (> (point) (tpu-mark)) (exchange-point-and-mark))
1615 (while (and (< (point) (tpu-mark)) (re-search-forward "^" (tpu-mark) t))
1616 (if (< (point) (tpu-mark)) (replace-match text))))
1617 (tpu-unselect t))
1618 (t
1619 (save-excursion
1620 (goto-char (point-min))
1621 (while (and (re-search-forward "^" nil t) (not (eobp)))
1622 (replace-match text))))))
1623
1624 (defun tpu-add-at-eol (text)
1625 "Add text to the end of each line in a region,
1626 or each line of the entire buffer if no region is selected."
1627 (interactive
1628 (list (tpu-string-prompt "String to add: " 'tpu-add-at-eol-hist)))
1629 (if (string= "" text) (error "No string specified."))
1630 (cond ((tpu-mark)
1631 (save-excursion
1632 (if (> (point) (tpu-mark)) (exchange-point-and-mark))
1633 (while (< (point) (tpu-mark))
1634 (end-of-line)
1635 (if (<= (point) (tpu-mark)) (insert text))
1636 (forward-line)))
1637 (tpu-unselect t))
1638 (t
1639 (save-excursion
1640 (goto-char (point-min))
1641 (while (not (eobp))
1642 (end-of-line) (insert text) (forward-line))))))
1643
1644 (defun tpu-trim-line-ends nil
1645 "Removes trailing whitespace from every line in the buffer."
1646 (interactive)
1647 (picture-clean))
1648
1649
1650 ;;;
1651 ;;; Movement by character
1652 ;;;
1653 (defun tpu-char (num)
1654 "Move to the next character in the current direction.
1655 A repeat count means move that many characters."
1656 (interactive "p")
1657 (if tpu-advance (tpu-forward-char num) (tpu-backward-char num)))
1658
1659 (defun tpu-forward-char (num)
1660 "Move right ARG characters (left if ARG is negative)."
1661 (interactive "p")
1662 (forward-char num))
1663
1664 (defun tpu-backward-char (num)
1665 "Move left ARG characters (right if ARG is negative)."
1666 (interactive "p")
1667 (backward-char num))
1668
1669
1670 ;;;
1671 ;;; Movement by word
1672 ;;;
1673 (defconst tpu-word-separator-list '()
1674 "List of additional word separators.")
1675 (defconst tpu-skip-chars "^ \t"
1676 "Characters to skip when moving by word.
1677 Additional word separators are added to this string.")
1678
1679 (defun tpu-word (num)
1680 "Move to the beginning of the next word in the current direction.
1681 A repeat count means move that many words."
1682 (interactive "p")
1683 (if tpu-advance (tpu-forward-to-word num) (tpu-backward-to-word num)))
1684
1685 (defun tpu-forward-to-word (num)
1686 "Move forward until encountering the beginning of a word.
1687 With argument, do this that many times."
1688 (interactive "p")
1689 (while (and (> num 0) (not (eobp)))
1690 (let* ((beg (point))
1691 (end (prog2 (end-of-line) (point) (goto-char beg))))
1692 (cond ((eolp)
1693 (forward-char 1))
1694 ((memq (char-after (point)) tpu-word-separator-list)
1695 (forward-char 1)
1696 (skip-chars-forward " \t" end))
1697 (t
1698 (skip-chars-forward tpu-skip-chars end)
1699 (skip-chars-forward " \t" end))))
1700 (setq num (1- num))))
1701
1702 (defun tpu-backward-to-word (num)
1703 "Move backward until encountering the beginning of a word.
1704 With argument, do this that many times."
1705 (interactive "p")
1706 (while (and (> num 0) (not (bobp)))
1707 (let* ((beg (point))
1708 (end (prog2 (beginning-of-line) (point) (goto-char beg))))
1709 (cond ((bolp)
1710 ( forward-char -1))
1711 ((memq (char-after (1- (point))) tpu-word-separator-list)
1712 (forward-char -1))
1713 (t
1714 (skip-chars-backward " \t" end)
1715 (skip-chars-backward tpu-skip-chars end)
1716 (if (and (not (bolp)) (= ? (char-syntax (char-after (point)))))
1717 (forward-char -1)))))
1718 (setq num (1- num))))
1719
1720 (defun tpu-add-word-separators (separators)
1721 "Add new word separators for TPU-edt word commands."
1722 (interactive "sSeparators: ")
1723 (let* ((n 0) (length (length separators)))
1724 (while (< n length)
1725 (let ((char (aref separators n))
1726 (ss (substring separators n (1+ n))))
1727 (cond ((not (memq char tpu-word-separator-list))
1728 (setq tpu-word-separator-list
1729 (append ss tpu-word-separator-list))
1730 (cond ((= char ?-)
1731 (setq tpu-skip-chars (concat tpu-skip-chars "\\-")))
1732 ((= char ?\\)
1733 (setq tpu-skip-chars (concat tpu-skip-chars "\\\\")))
1734 ((= char ?^)
1735 (setq tpu-skip-chars (concat tpu-skip-chars "\\^")))
1736 (t
1737 (setq tpu-skip-chars (concat tpu-skip-chars ss))))))
1738 (setq n (1+ n))))))
1739
1740 (defun tpu-reset-word-separators nil
1741 "Reset word separators to default value."
1742 (interactive)
1743 (setq tpu-word-separator-list nil)
1744 (setq tpu-skip-chars "^ \t"))
1745
1746 (defun tpu-set-word-separators (separators)
1747 "Set new word separators for TPU-edt word commands."
1748 (interactive "sSeparators: ")
1749 (tpu-reset-word-separators)
1750 (tpu-add-word-separators separators))
1751
1752
1753 ;;;
1754 ;;; Movement by line
1755 ;;;
1756 (defun tpu-next-line (num)
1757 "Move to next line.
1758 Prefix argument serves as a repeat count."
1759 (interactive "p")
1760 (next-line-internal num)
1761 (setq this-command 'next-line))
1762
1763 (defun tpu-previous-line (num)
1764 "Move to previous line.
1765 Prefix argument serves as a repeat count."
1766 (interactive "p")
1767 (next-line-internal (- num))
1768 (setq this-command 'previous-line))
1769
1770 (defun tpu-next-beginning-of-line (num)
1771 "Move to beginning of line; if at beginning, move to beginning of next line.
1772 Accepts a prefix argument for the number of lines to move."
1773 (interactive "p")
1774 (backward-char 1)
1775 (forward-line (- 1 num)))
1776
1777 (defun tpu-end-of-line (num)
1778 "Move to the next end of line in the current direction.
1779 A repeat count means move that many lines."
1780 (interactive "p")
1781 (if tpu-advance (tpu-next-end-of-line num) (tpu-previous-end-of-line num)))
1782
1783 (defun tpu-next-end-of-line (num)
1784 "Move to end of line; if at end, move to end of next line.
1785 Accepts a prefix argument for the number of lines to move."
1786 (interactive "p")
1787 (forward-char 1)
1788 (end-of-line num))
1789
1790 (defun tpu-previous-end-of-line (num)
1791 "Move EOL upward.
1792 Accepts a prefix argument for the number of lines to move."
1793 (interactive "p")
1794 (end-of-line (- 1 num)))
1795
1796 (defun tpu-current-end-of-line nil
1797 "Move point to end of current line."
1798 (interactive)
1799 (let ((beg (point)))
1800 (end-of-line)
1801 (if (= beg (point)) (message "You are already at the end of a line."))))
1802
1803 (defun tpu-line (num)
1804 "Move to the beginning of the next line in the current direction.
1805 A repeat count means move that many lines."
1806 (interactive "p")
1807 (if tpu-advance (tpu-forward-line num) (tpu-backward-line num)))
1808
1809 (defun tpu-forward-line (num)
1810 "Move to beginning of next line.
1811 Prefix argument serves as a repeat count."
1812 (interactive "p")
1813 (forward-line num))
1814
1815 (defun tpu-backward-line (num)
1816 "Move to beginning of previous line.
1817 Prefix argument serves as repeat count."
1818 (interactive "p")
1819 (or (bolp) (>= 0 num) (setq num (- num 1)))
1820 (forward-line (- num)))
1821
1822
1823 ;;;
1824 ;;; Movement by paragraph
1825 ;;;
1826 (defun tpu-paragraph (num)
1827 "Move to the next paragraph in the current direction.
1828 A repeat count means move that many paragraphs."
1829 (interactive "p")
1830 (if tpu-advance
1831 (tpu-next-paragraph num) (tpu-previous-paragraph num)))
1832
1833 (defun tpu-next-paragraph (num)
1834 "Move to beginning of the next paragraph.
1835 Accepts a prefix argument for the number of paragraphs."
1836 (interactive "p")
1837 (beginning-of-line)
1838 (while (and (not (eobp)) (> num 0))
1839 (if (re-search-forward "^[ \t]*$" nil t)
1840 (if (re-search-forward "[^ \t\n]" nil t)
1841 (goto-char (match-beginning 0))
1842 (goto-char (point-max))))
1843 (setq num (1- num)))
1844 (beginning-of-line))
1845
1846
1847 (defun tpu-previous-paragraph (num)
1848 "Move to beginning of previous paragraph.
1849 Accepts a prefix argument for the number of paragraphs."
1850 (interactive "p")
1851 (end-of-line)
1852 (while (and (not (bobp)) (> num 0))
1853 (if (not (and (re-search-backward "^[ \t]*$" nil t)
1854 (re-search-backward "[^ \t\n]" nil t)
1855 (re-search-backward "^[ \t]*$" nil t)
1856 (progn (re-search-forward "[^ \t\n]" nil t)
1857 (goto-char (match-beginning 0)))))
1858 (goto-char (point-min)))
1859 (setq num (1- num)))
1860 (beginning-of-line))
1861
1862
1863 ;;;
1864 ;;; Movement by page
1865 ;;;
1866 (defun tpu-page (num)
1867 "Move to the next page in the current direction.
1868 A repeat count means move that many pages."
1869 (interactive "p")
1870 (if tpu-advance (forward-page num) (backward-page num))
1871 (if (eobp) (recenter -1)))
1872
1873
1874 ;;;
1875 ;;; Scrolling and movement within the buffer
1876 ;;;
1877 (defun tpu-scroll-window (num)
1878 "Scroll the display to the next section in the current direction.
1879 A repeat count means scroll that many sections."
1880 (interactive "p")
1881 (if tpu-advance (tpu-scroll-window-up num) (tpu-scroll-window-down num)))
1882
1883 (defun tpu-scroll-window-down (num)
1884 "Scroll the display down to the next section.
1885 A repeat count means scroll that many sections."
1886 (interactive "p")
1887 (let* ((beg (tpu-current-line))
1888 (height (1- (window-height)))
1889 (lines (* num (/ (* height tpu-percent-scroll) 100))))
1890 (next-line-internal (- lines))
1891 (if (> lines beg) (recenter 0))))
1892
1893 (defun tpu-scroll-window-up (num)
1894 "Scroll the display up to the next section.
1895 A repeat count means scroll that many sections."
1896 (interactive "p")
1897 (let* ((beg (tpu-current-line))
1898 (height (1- (window-height)))
1899 (lines (* num (/ (* height tpu-percent-scroll) 100))))
1900 (next-line-internal lines)
1901 (if (>= (+ lines beg) height) (recenter -1))))
1902
1903 (defun tpu-pan-right (num)
1904 "Pan right tpu-pan-columns (16 by default).
1905 Accepts a prefix argument for the number of tpu-pan-columns to scroll."
1906 (interactive "p")
1907 (scroll-left (* tpu-pan-columns num)))
1908
1909 (defun tpu-pan-left (num)
1910 "Pan left tpu-pan-columns (16 by default).
1911 Accepts a prefix argument for the number of tpu-pan-columns to scroll."
1912 (interactive "p")
1913 (scroll-right (* tpu-pan-columns num)))
1914
1915 (defun tpu-move-to-beginning nil
1916 "Move cursor to the beginning of buffer, but don't set the mark."
1917 (interactive)
1918 (goto-char (point-min)))
1919
1920 (defun tpu-move-to-end nil
1921 "Move cursor to the end of buffer, but don't set the mark."
1922 (interactive)
1923 (goto-char (point-max))
1924 (recenter -1))
1925
1926 (defun tpu-goto-percent (perc)
1927 "Move point to ARG percentage of the buffer."
1928 (interactive "NGoto-percentage: ")
1929 (if (or (> perc 100) (< perc 0))
1930 (error "Percentage %d out of range 0 < percent < 100" perc)
1931 (goto-char (/ (* (point-max) perc) 100))))
1932
1933 (defun tpu-beginning-of-window nil
1934 "Move cursor to top of window."
1935 (interactive)
1936 (move-to-window-line 0))
1937
1938 (defun tpu-end-of-window nil
1939 "Move cursor to bottom of window."
1940 (interactive)
1941 (move-to-window-line -1))
1942
1943 (defun tpu-line-to-bottom-of-window nil
1944 "Move the current line to the bottom of the window."
1945 (interactive)
1946 (recenter -1))
1947
1948 (defun tpu-line-to-top-of-window nil
1949 "Move the current line to the top of the window."
1950 (interactive)
1951 (recenter 0))
1952
1953
1954 ;;;
1955 ;;; Direction
1956 ;;;
1957 (defun tpu-advance-direction nil
1958 "Set TPU Advance mode so keypad commands move forward."
1959 (interactive)
1960 (setq tpu-direction-string " Advance")
1961 (setq tpu-advance t)
1962 (setq tpu-reverse nil)
1963 (tpu-set-search)
1964 (tpu-update-mode-line))
1965
1966 (defun tpu-backup-direction nil
1967 "Set TPU Backup mode so keypad commands move backward."
1968 (interactive)
1969 (setq tpu-direction-string " Reverse")
1970 (setq tpu-advance nil)
1971 (setq tpu-reverse t)
1972 (tpu-set-search)
1973 (tpu-update-mode-line))
1974
1975
1976 ;;;
1977 ;;; Define keymaps
1978 ;;;
1979 (define-key global-map "\e[" CSI-map) ; CSI map
1980 (define-key global-map "\eO" SS3-map) ; SS3 map
1981 (define-key SS3-map "P" GOLD-map) ; GOLD map
1982 (define-key GOLD-map "\e[" GOLD-CSI-map) ; GOLD-CSI map
1983 (define-key GOLD-map "\eO" GOLD-SS3-map) ; GOLD-SS3 map
1984
1985
1986 ;;;
1987 ;;; CSI-map key definitions
1988 ;;;
1989 (define-key CSI-map "A" 'tpu-previous-line) ; up
1990 (define-key CSI-map "B" 'tpu-next-line) ; down
1991 (define-key CSI-map "D" 'tpu-backward-char) ; left
1992 (define-key CSI-map "C" 'tpu-forward-char) ; right
1993
1994 (define-key CSI-map "1~" 'tpu-search) ; Find
1995 (define-key CSI-map "2~" 'tpu-paste) ; Insert Here
1996 (define-key CSI-map "3~" 'tpu-cut) ; Remove
1997 (define-key CSI-map "4~" 'tpu-select) ; Select
1998 (define-key CSI-map "5~" 'tpu-scroll-window-down) ; Prev Screen
1999 (define-key CSI-map "6~" 'tpu-scroll-window-up) ; Next Screen
2000
2001 (define-key CSI-map "11~" 'nil) ; F1
2002 (define-key CSI-map "12~" 'nil) ; F2
2003 (define-key CSI-map "13~" 'nil) ; F3
2004 (define-key CSI-map "14~" 'nil) ; F4
2005 (define-key CSI-map "15~" 'nil) ; F5
2006 (define-key CSI-map "17~" 'nil) ; F6
2007 (define-key CSI-map "18~" 'nil) ; F7
2008 (define-key CSI-map "19~" 'nil) ; F8
2009 (define-key CSI-map "20~" 'nil) ; F9
2010 (define-key CSI-map "21~" 'tpu-exit) ; F10
2011 (define-key CSI-map "23~" 'tpu-insert-escape) ; F11 (ESC)
2012 (define-key CSI-map "24~" 'tpu-next-beginning-of-line) ; F12 (BS)
2013 (define-key CSI-map "25~" 'tpu-delete-previous-word) ; F13 (LF)
2014 (define-key CSI-map "26~" 'tpu-toggle-overwrite-mode) ; F14
2015 (define-key CSI-map "28~" 'tpu-help) ; HELP
2016 (define-key CSI-map "29~" 'execute-extended-command) ; DO
2017 (define-key CSI-map "31~" 'tpu-goto-breadcrumb) ; F17
2018 (define-key CSI-map "32~" 'nil) ; F18
2019 (define-key CSI-map "33~" 'nil) ; F19
2020 (define-key CSI-map "34~" 'nil) ; F20
2021
2022
2023 ;;;
2024 ;;; SS3-map key definitions
2025 ;;;
2026 (define-key SS3-map "A" 'tpu-previous-line) ; up
2027 (define-key SS3-map "B" 'tpu-next-line) ; down
2028 (define-key SS3-map "C" 'tpu-forward-char) ; right
2029 (define-key SS3-map "D" 'tpu-backward-char) ; left
2030
2031 (define-key SS3-map "Q" 'tpu-help) ; PF2
2032 (define-key SS3-map "R" 'tpu-search-again) ; PF3
2033 (define-key SS3-map "S" 'tpu-delete-current-line) ; PF4
2034 (define-key SS3-map "p" 'tpu-line) ; KP0
2035 (define-key SS3-map "q" 'tpu-word) ; KP1
2036 (define-key SS3-map "r" 'tpu-end-of-line) ; KP2
2037 (define-key SS3-map "s" 'tpu-char) ; KP3
2038 (define-key SS3-map "t" 'tpu-advance-direction) ; KP4
2039 (define-key SS3-map "u" 'tpu-backup-direction) ; KP5
2040 (define-key SS3-map "v" 'tpu-cut) ; KP6
2041 (define-key SS3-map "w" 'tpu-page) ; KP7
2042 (define-key SS3-map "x" 'tpu-scroll-window) ; KP8
2043 (define-key SS3-map "y" 'tpu-append-region) ; KP9
2044 (define-key SS3-map "m" 'tpu-delete-current-word) ; KP-
2045 (define-key SS3-map "l" 'tpu-delete-current-char) ; KP,
2046 (define-key SS3-map "n" 'tpu-select) ; KP.
2047 (define-key SS3-map "M" 'newline) ; KPenter
2048
2049
2050 ;;;
2051 ;;; GOLD-map key definitions
2052 ;;;
2053 (define-key GOLD-map "\C-A" 'tpu-toggle-overwrite-mode) ; ^A
2054 (define-key GOLD-map "\C-B" 'nil) ; ^B
2055 (define-key GOLD-map "\C-C" 'nil) ; ^C
2056 (define-key GOLD-map "\C-D" 'nil) ; ^D
2057 (define-key GOLD-map "\C-E" 'nil) ; ^E
2058 (define-key GOLD-map "\C-F" 'set-visited-file-name) ; ^F
2059 (define-key GOLD-map "\C-g" 'keyboard-quit) ; safety first
2060 (define-key GOLD-map "\C-h" 'delete-other-windows) ; BS
2061 (define-key GOLD-map "\C-i" 'other-window) ; TAB
2062 (define-key GOLD-map "\C-J" 'nil) ; ^J
2063 (define-key GOLD-map "\C-K" 'tpu-define-macro-key) ; ^K
2064 (define-key GOLD-map "\C-l" 'downcase-region) ; ^L
2065 (define-key GOLD-map "\C-M" 'nil) ; ^M
2066 (define-key GOLD-map "\C-N" 'nil) ; ^N
2067 (define-key GOLD-map "\C-O" 'nil) ; ^O
2068 (define-key GOLD-map "\C-P" 'nil) ; ^P
2069 (define-key GOLD-map "\C-Q" 'nil) ; ^Q
2070 (define-key GOLD-map "\C-R" 'nil) ; ^R
2071 (define-key GOLD-map "\C-S" 'nil) ; ^S
2072 (define-key GOLD-map "\C-T" 'tpu-toggle-control-keys) ; ^T
2073 (define-key GOLD-map "\C-u" 'upcase-region) ; ^U
2074 (define-key GOLD-map "\C-V" 'nil) ; ^V
2075 (define-key GOLD-map "\C-w" 'tpu-write-current-buffers) ; ^W
2076 (define-key GOLD-map "\C-X" 'nil) ; ^X
2077 (define-key GOLD-map "\C-Y" 'nil) ; ^Y
2078 (define-key GOLD-map "\C-Z" 'nil) ; ^Z
2079 (define-key GOLD-map " " 'undo) ; SPC
2080 (define-key GOLD-map "!" 'nil) ; !
2081 (define-key GOLD-map "#" 'nil) ; #
2082 (define-key GOLD-map "$" 'tpu-add-at-eol) ; $
2083 (define-key GOLD-map "%" 'tpu-goto-percent) ; %
2084 (define-key GOLD-map "&" 'nil) ; &
2085 (define-key GOLD-map "(" 'nil) ; (
2086 (define-key GOLD-map ")" 'nil) ; )
2087 (define-key GOLD-map "*" 'tpu-toggle-regexp) ; *
2088 (define-key GOLD-map "+" 'nil) ; +
2089 (define-key GOLD-map "," 'tpu-goto-breadcrumb) ; ,
2090 (define-key GOLD-map "-" 'negative-argument) ; -
2091 (define-key GOLD-map "." 'tpu-drop-breadcrumb) ; .
2092 (define-key GOLD-map "/" 'tpu-emacs-replace) ; /
2093 (define-key GOLD-map "0" 'digit-argument) ; 0
2094 (define-key GOLD-map "1" 'digit-argument) ; 1
2095 (define-key GOLD-map "2" 'digit-argument) ; 2
2096 (define-key GOLD-map "3" 'digit-argument) ; 3
2097 (define-key GOLD-map "4" 'digit-argument) ; 4
2098 (define-key GOLD-map "5" 'digit-argument) ; 5
2099 (define-key GOLD-map "6" 'digit-argument) ; 6
2100 (define-key GOLD-map "7" 'digit-argument) ; 7
2101 (define-key GOLD-map "8" 'digit-argument) ; 8
2102 (define-key GOLD-map "9" 'digit-argument) ; 9
2103 (define-key GOLD-map ":" 'nil) ; :
2104 (define-key GOLD-map ";" 'tpu-trim-line-ends) ; ;
2105 (define-key GOLD-map "<" 'nil) ; <
2106 (define-key GOLD-map "=" 'nil) ; =
2107 (define-key GOLD-map ">" 'nil) ; >
2108 (define-key GOLD-map "?" 'tpu-spell-check) ; ?
2109 (define-key GOLD-map "A" 'tpu-toggle-newline-and-indent) ; A
2110 (define-key GOLD-map "B" 'tpu-next-buffer) ; B
2111 (define-key GOLD-map "C" 'repeat-complex-command) ; C
2112 (define-key GOLD-map "D" 'shell-command) ; D
2113 (define-key GOLD-map "E" 'tpu-exit) ; E
2114 (define-key GOLD-map "F" 'tpu-set-cursor-free) ; F
2115 (define-key GOLD-map "G" 'tpu-get) ; G
2116 (define-key GOLD-map "H" 'nil) ; H
2117 (define-key GOLD-map "I" 'tpu-include) ; I
2118 (define-key GOLD-map "K" 'tpu-kill-buffer) ; K
2119 (define-key GOLD-map "L" 'tpu-what-line) ; L
2120 (define-key GOLD-map "M" 'buffer-menu) ; M
2121 (define-key GOLD-map "N" 'tpu-next-file-buffer) ; N
2122 (define-key GOLD-map "O" 'occur) ; O
2123 (define-key GOLD-map "P" 'lpr-buffer) ; P
2124 (define-key GOLD-map "Q" 'tpu-quit) ; Q
2125 (define-key GOLD-map "R" 'tpu-toggle-rectangle) ; R
2126 (define-key GOLD-map "S" 'replace) ; S
2127 (define-key GOLD-map "T" 'tpu-line-to-top-of-window) ; T
2128 (define-key GOLD-map "U" 'undo) ; U
2129 (define-key GOLD-map "V" 'tpu-version) ; V
2130 (define-key GOLD-map "W" 'save-buffer) ; W
2131 (define-key GOLD-map "X" 'tpu-save-all-buffers-kill-emacs) ; X
2132 (define-key GOLD-map "Y" 'copy-region-as-kill) ; Y
2133 (define-key GOLD-map "Z" 'suspend-emacs) ; Z
2134 (define-key GOLD-map "[" 'blink-matching-open) ; [
2135 (define-key GOLD-map "\\" 'nil) ; \
2136 (define-key GOLD-map "]" 'blink-matching-open) ; ]
2137 (define-key GOLD-map "^" 'tpu-add-at-bol) ; ^
2138 (define-key GOLD-map "_" 'split-window-vertically) ; -
2139 (define-key GOLD-map "`" 'what-line) ; `
2140 (define-key GOLD-map "a" 'tpu-toggle-newline-and-indent) ; a
2141 (define-key GOLD-map "b" 'tpu-next-buffer) ; b
2142 (define-key GOLD-map "c" 'repeat-complex-command) ; c
2143 (define-key GOLD-map "d" 'shell-command) ; d
2144 (define-key GOLD-map "e" 'tpu-exit) ; e
2145 (define-key GOLD-map "f" 'tpu-set-cursor-free) ; f
2146 (define-key GOLD-map "g" 'tpu-get) ; g
2147 (define-key GOLD-map "h" 'nil) ; h
2148 (define-key GOLD-map "i" 'tpu-include) ; i
2149 (define-key GOLD-map "k" 'tpu-kill-buffer) ; k
2150 (define-key GOLD-map "l" 'goto-line) ; l
2151 (define-key GOLD-map "m" 'buffer-menu) ; m
2152 (define-key GOLD-map "n" 'tpu-next-file-buffer) ; n
2153 (define-key GOLD-map "o" 'occur) ; o
2154 (define-key GOLD-map "p" 'lpr-region) ; p
2155 (define-key GOLD-map "q" 'tpu-quit) ; q
2156 (define-key GOLD-map "r" 'tpu-toggle-rectangle) ; r
2157 (define-key GOLD-map "s" 'replace) ; s
2158 (define-key GOLD-map "t" 'tpu-line-to-top-of-window) ; t
2159 (define-key GOLD-map "u" 'undo) ; u
2160 (define-key GOLD-map "v" 'tpu-version) ; v
2161 (define-key GOLD-map "w" 'save-buffer) ; w
2162 (define-key GOLD-map "x" 'tpu-save-all-buffers-kill-emacs) ; x
2163 (define-key GOLD-map "y" 'copy-region-as-kill) ; y
2164 (define-key GOLD-map "z" 'suspend-emacs) ; z
2165 (define-key GOLD-map "{" 'nil) ; {
2166 (define-key GOLD-map "|" 'split-window-horizontally) ; |
2167 (define-key GOLD-map "}" 'nil) ; }
2168 (define-key GOLD-map "~" 'exchange-point-and-mark) ; ~
2169 (define-key GOLD-map "\177" 'delete-window) ; <X]
2170
2171
2172 ;;;
2173 ;;; GOLD-CSI-map key definitions
2174 ;;;
2175 (define-key GOLD-CSI-map "A" 'tpu-move-to-beginning) ; up-arrow
2176 (define-key GOLD-CSI-map "B" 'tpu-move-to-end) ; down-arrow
2177 (define-key GOLD-CSI-map "C" 'end-of-line) ; right-arrow
2178 (define-key GOLD-CSI-map "D" 'beginning-of-line) ; left-arrow
2179
2180 (define-key GOLD-CSI-map "1~" 'nil) ; Find
2181 (define-key GOLD-CSI-map "2~" 'nil) ; Insert Here
2182 (define-key GOLD-CSI-map "3~" 'tpu-store-text) ; Remove
2183 (define-key GOLD-CSI-map "4~" 'tpu-unselect) ; Select
2184 (define-key GOLD-CSI-map "5~" 'tpu-previous-window) ; Prev Screen
2185 (define-key GOLD-CSI-map "6~" 'tpu-next-window) ; Next Screen
2186
2187 (define-key GOLD-CSI-map "11~" 'nil) ; F1
2188 (define-key GOLD-CSI-map "12~" 'nil) ; F2
2189 (define-key GOLD-CSI-map "13~" 'nil) ; F3
2190 (define-key GOLD-CSI-map "14~" 'nil) ; F4
2191 (define-key GOLD-CSI-map "16~" 'nil) ; F5
2192 (define-key GOLD-CSI-map "17~" 'nil) ; F6
2193 (define-key GOLD-CSI-map "18~" 'nil) ; F7
2194 (define-key GOLD-CSI-map "19~" 'nil) ; F8
2195 (define-key GOLD-CSI-map "20~" 'nil) ; F9
2196 (define-key GOLD-CSI-map "21~" 'nil) ; F10
2197 (define-key GOLD-CSI-map "23~" 'nil) ; F11
2198 (define-key GOLD-CSI-map "24~" 'nil) ; F12
2199 (define-key GOLD-CSI-map "25~" 'nil) ; F13
2200 (define-key GOLD-CSI-map "26~" 'nil) ; F14
2201 (define-key GOLD-CSI-map "28~" 'describe-bindings) ; HELP
2202 (define-key GOLD-CSI-map "29~" 'nil) ; DO
2203 (define-key GOLD-CSI-map "31~" 'tpu-drop-breadcrumb) ; F17
2204 (define-key GOLD-CSI-map "32~" 'nil) ; F18
2205 (define-key GOLD-CSI-map "33~" 'nil) ; F19
2206 (define-key GOLD-CSI-map "34~" 'nil) ; F20
2207
2208
2209 ;;;
2210 ;;; GOLD-SS3-map key definitions
2211 ;;;
2212 (define-key GOLD-SS3-map "A" 'tpu-move-to-beginning) ; up-arrow
2213 (define-key GOLD-SS3-map "B" 'tpu-move-to-end) ; down-arrow
2214 (define-key GOLD-SS3-map "C" 'end-of-line) ; right-arrow
2215 (define-key GOLD-SS3-map "D" 'beginning-of-line) ; left-arrow
2216
2217 (define-key GOLD-SS3-map "P" 'keyboard-quit) ; PF1
2218 (define-key GOLD-SS3-map "Q" 'help-for-help) ; PF2
2219 (define-key GOLD-SS3-map "R" 'tpu-search) ; PF3
2220 (define-key GOLD-SS3-map "S" 'tpu-undelete-lines) ; PF4
2221 (define-key GOLD-SS3-map "p" 'open-line) ; KP0
2222 (define-key GOLD-SS3-map "q" 'tpu-change-case) ; KP1
2223 (define-key GOLD-SS3-map "r" 'tpu-delete-to-eol) ; KP2
2224 (define-key GOLD-SS3-map "s" 'tpu-special-insert) ; KP3
2225 (define-key GOLD-SS3-map "t" 'tpu-move-to-end) ; KP4
2226 (define-key GOLD-SS3-map "u" 'tpu-move-to-beginning) ; KP5
2227 (define-key GOLD-SS3-map "v" 'tpu-paste) ; KP6
2228 (define-key GOLD-SS3-map "w" 'execute-extended-command) ; KP7
2229 (define-key GOLD-SS3-map "x" 'tpu-fill) ; KP8
2230 (define-key GOLD-SS3-map "y" 'tpu-replace) ; KP9
2231 (define-key GOLD-SS3-map "m" 'tpu-undelete-words) ; KP-
2232 (define-key GOLD-SS3-map "l" 'tpu-undelete-char) ; KP,
2233 (define-key GOLD-SS3-map "n" 'tpu-unselect) ; KP.
2234 (define-key GOLD-SS3-map "M" 'tpu-substitute) ; KPenter
2235
2236
2237 ;;;
2238 ;;; Repeat complex command map additions to make arrows work
2239 ;;;
2240 (cond ((boundp 'repeat-complex-command-map)
2241 (define-key repeat-complex-command-map "\e[A" 'previous-complex-command)
2242 (define-key repeat-complex-command-map "\e[B" 'next-complex-command)
2243 (define-key repeat-complex-command-map "\eOA" 'previous-complex-command)
2244 (define-key repeat-complex-command-map "\eOB" 'next-complex-command)))
2245
2246
2247 ;;;
2248 ;;; Minibuffer map additions to make KP_enter = RET
2249 ;;;
2250 (define-key minibuffer-local-map "\eOM" 'exit-minibuffer)
2251 (define-key minibuffer-local-ns-map "\eOM" 'exit-minibuffer)
2252 (define-key minibuffer-local-completion-map "\eOM" 'exit-minibuffer)
2253 (define-key minibuffer-local-must-match-map "\eOM" 'minibuffer-complete-and-exit)
2254 (and (boundp 'repeat-complex-command-map)
2255 (define-key repeat-complex-command-map "\eOM" 'exit-minibuffer))
2256
2257
2258 ;;;
2259 ;;; Minibuffer map additions to set search direction
2260 ;;;
2261 (define-key minibuffer-local-map "\eOt" 'tpu-search-forward-exit)
2262 (define-key minibuffer-local-map "\eOu" 'tpu-search-backward-exit)
2263
2264
2265 ;;;
2266 ;;; Functions to set, reset, and toggle the control key bindings
2267 ;;;
2268 (defun tpu-set-control-keys nil
2269 "Set control keys to TPU style functions."
2270 (define-key global-map "\C-\\" 'quoted-insert) ; ^\
2271 (define-key global-map "\C-a" 'tpu-toggle-overwrite-mode) ; ^A
2272 (define-key global-map "\C-b" 'repeat-complex-command) ; ^B
2273 (define-key global-map "\C-e" 'tpu-current-end-of-line) ; ^E
2274 (define-key global-map "\C-h" 'tpu-next-beginning-of-line) ; ^H (BS)
2275 (define-key global-map "\C-j" 'tpu-delete-previous-word) ; ^J (LF)
2276 (define-key global-map "\C-k" 'tpu-define-macro-key) ; ^K
2277 (define-key global-map "\C-l" 'tpu-insert-formfeed) ; ^L (FF)
2278 (define-key global-map "\C-r" 'recenter) ; ^R
2279 (define-key global-map "\C-u" 'tpu-delete-to-bol) ; ^U
2280 (define-key global-map "\C-v" 'tpu-quoted-insert) ; ^V
2281 (define-key global-map "\C-w" 'redraw-display) ; ^W
2282 (define-key global-map "\C-z" 'tpu-exit) ; ^Z
2283 (setq tpu-control-keys t))
2284
2285 (defun tpu-reset-control-keys (tpu-style)
2286 "Set control keys to TPU or emacs style functions."
2287 (let* ((tpu (and tpu-style (not tpu-control-keys)))
2288 (emacs (and (not tpu-style) tpu-control-keys))
2289 (doit (or tpu emacs)))
2290 (cond (doit
2291 (if emacs (setq tpu-global-map (copy-keymap global-map)))
2292 (let ((map (if tpu
2293 (copy-keymap tpu-global-map)
2294 (copy-keymap tpu-original-global-map))))
2295
2296 (define-key global-map "\C-\\" (lookup-key map "\C-\\")) ; ^\
2297 (define-key global-map "\C-a" (lookup-key map "\C-a")) ; ^A
2298 (define-key global-map "\C-b" (lookup-key map "\C-b")) ; ^B
2299 (define-key global-map "\C-e" (lookup-key map "\C-e")) ; ^E
2300 (define-key global-map "\C-h" (lookup-key map "\C-h")) ; ^H (BS)
2301 (define-key global-map "\C-j" (lookup-key map "\C-j")) ; ^J (LF)
2302 (define-key global-map "\C-k" (lookup-key map "\C-k")) ; ^K
2303 (define-key global-map "\C-l" (lookup-key map "\C-l")) ; ^L (FF)
2304 (define-key global-map "\C-r" (lookup-key map "\C-r")) ; ^R
2305 (define-key global-map "\C-u" (lookup-key map "\C-u")) ; ^U
2306 (define-key global-map "\C-v" (lookup-key map "\C-v")) ; ^V
2307 (define-key global-map "\C-w" (lookup-key map "\C-w")) ; ^W
2308 (define-key global-map "\C-z" (lookup-key map "\C-z")) ; ^Z
2309 (setq tpu-control-keys tpu-style))))))
2310
2311 (defun tpu-toggle-control-keys nil
2312 "Toggles control key bindings between TPU-edt and Emacs."
2313 (interactive)
2314 (tpu-reset-control-keys (not tpu-control-keys))
2315 (and (interactive-p)
2316 (message "Control keys function with %s bindings."
2317 (if tpu-control-keys "TPU-edt" "Emacs"))))
2318
2319
2320 ;;;
2321 ;;; Emacs version 19 minibuffer history support
2322 ;;;
2323 (defun tpu-next-history-element (n)
2324 "Insert the next element of the minibuffer history into the minibuffer."
2325 (interactive "p")
2326 (next-history-element n)
2327 (goto-char (point-max)))
2328
2329 (defun tpu-previous-history-element (n)
2330 "Insert the previous element of the minibuffer history into the minibuffer."
2331 (interactive "p")
2332 (previous-history-element n)
2333 (goto-char (point-max)))
2334
2335 (defun tpu-arrow-history nil
2336 "Modify minibuffer maps to use arrows for history recall."
2337 (interactive)
2338 (let ((loc (where-is-internal 'tpu-previous-line)) (cur nil))
2339 (while (setq cur (car loc))
2340 (define-key read-expression-map cur 'tpu-previous-history-element)
2341 (define-key minibuffer-local-map cur 'tpu-previous-history-element)
2342 (define-key minibuffer-local-ns-map cur 'tpu-previous-history-element)
2343 (define-key minibuffer-local-completion-map cur 'tpu-previous-history-element)
2344 (define-key minibuffer-local-must-match-map cur 'tpu-previous-history-element)
2345 (setq loc (cdr loc)))
2346
2347 (setq loc (where-is-internal 'tpu-next-line))
2348 (while (setq cur (car loc))
2349 (define-key read-expression-map cur 'tpu-next-history-element)
2350 (define-key minibuffer-local-map cur 'tpu-next-history-element)
2351 (define-key minibuffer-local-ns-map cur 'tpu-next-history-element)
2352 (define-key minibuffer-local-completion-map cur 'tpu-next-history-element)
2353 (define-key minibuffer-local-must-match-map cur 'tpu-next-history-element)
2354 (setq loc (cdr loc)))))
2355
2356
2357 ;;;
2358 ;;; Emacs version 19 X-windows key definition support
2359 ;;;
2360 (defun tpu-load-xkeys (file)
2361 "Load the TPU-edt X-windows key definitions FILE.
2362 If FILE is nil, try to load a default file. The default file names are
2363 `~/.tpu-lucid-keys' for Lucid emacs, and `~/.tpu-keys' for Emacs."
2364 (interactive "fX key definition file: ")
2365 (cond (file
2366 (setq file (expand-file-name file)))
2367 (tpu-xkeys-file
2368 (setq file (expand-file-name tpu-xkeys-file)))
2369 (tpu-lucid-emacs19-p
2370 (setq file (expand-file-name "~/.tpu-lucid-keys")))
2371 (tpu-emacs19-p
2372 (setq file (expand-file-name "~/.tpu-keys"))
2373 (and (not (file-exists-p file))
2374 (file-exists-p (expand-file-name "~/.tpu-gnu-keys"))
2375 (tpu-copy-keyfile (expand-file-name "~/.tpu-gnu-keys") file))))
2376 (cond ((file-readable-p file)
2377 (load-file file))
2378 (t
2379 (switch-to-buffer "*scratch*")
2380 (erase-buffer)
2381 (insert "
2382
2383 Ack!! You're running TPU-edt under X-windows without loading an
2384 X key definition file. To create a TPU-edt X key definition
2385 file, run the tpu-mapper.el program. It came with TPU-edt. It
2386 even includes directions on how to use it! Perhaps it's laying
2387 around here someplace. ")
2388 (let ((file "tpu-mapper.el")
2389 (found nil)
2390 (path nil)
2391 (search-list (append (list (expand-file-name ".")) load-path)))
2392 (while (and (not found) search-list)
2393 (setq path (concat (car search-list)
2394 (if (string-match "/$" (car search-list)) "" "/")
2395 file))
2396 (if (and (file-exists-p path) (not (file-directory-p path)))
2397 (setq found t))
2398 (setq search-list (cdr search-list)))
2399 (cond (found
2400 (insert (format
2401 "Ah yes, there it is, in \n\n %s \n\n" path))
2402 (if (tpu-y-or-n-p "Do you want to run it now? ")
2403 (load-file path)))
2404 (t
2405 (insert "Nope, I can't seem to find it. :-(\n\n")
2406 (sit-for 120)))))))
2407
2408 (defun tpu-copy-keyfile (oldname newname)
2409 "Copy the TPU-edt X key definitions file to the new default name."
2410 (interactive "fOld name: \nFNew name: ")
2411 (if (not (get-buffer "*TPU-Notice*")) (generate-new-buffer "*TPU-Notice*"))
2412 (set-buffer "*TPU-Notice*")
2413 (erase-buffer)
2414 (insert "
2415 NOTICE --
2416
2417 The default name of the TPU-edt key definition file has changed
2418 from `~/.tpu-gnu-keys' to `~/.tpu-keys'. With your permission,
2419 your key definitions will be copied to the new file. If you'll
2420 never use older versions of Emacs, you can remove the old file.
2421 If the copy fails, you'll be asked if you want to create a new
2422 key definitions file. Do you want to copy your key definition
2423 file now?
2424 ")
2425 (save-window-excursion
2426 (switch-to-buffer-other-window "*TPU-Notice*")
2427 (shrink-window-if-larger-than-buffer)
2428 (goto-char (point-min))
2429 (beep)
2430 (and (tpu-y-or-n-p "Copy key definitions to the new file now? ")
2431 (condition-case conditions
2432 (copy-file oldname newname)
2433 (error (message "Sorry, couldn't copy - %s" (cdr conditions)))))
2434 (kill-buffer "*TPU-Notice*")))
2435
2436
2437 ;;;
2438 ;;; Start and Stop TPU-edt
2439 ;;;
2440 ;;;###autoload
2441 (defun tpu-edt-on nil
2442 "Turn on TPU/edt emulation."
2443 (interactive)
2444 (cond
2445 ((not tpu-edt-mode)
2446 ;; we use picture-mode functions
2447 (require 'picture)
2448 (tpu-set-control-keys)
2449 (cond (tpu-emacs19-p
2450 (and window-system (tpu-load-xkeys nil))
2451 (tpu-arrow-history))
2452 (t
2453 ;; define ispell functions
2454 (autoload 'ispell-word "ispell" "Check spelling of word at or before point" t)
2455 (autoload 'ispell-complete-word "ispell" "Complete word at or before point" t)
2456 (autoload 'ispell-buffer "ispell" "Check spelling of entire buffer" t)
2457 (autoload 'ispell-region "ispell" "Check spelling of region" t)))
2458 (tpu-set-mode-line t)
2459 (tpu-advance-direction)
2460 ;; set page delimiter, display line truncation, and scrolling like TPU
2461 (setq-default page-delimiter "\f")
2462 (setq-default truncate-lines t)
2463 (setq scroll-step 1)
2464 (setq tpu-edt-mode t))))
2465
2466 (defun tpu-edt-off nil
2467 "Turn off TPU/edt emulation. Note that the keypad is left on."
2468 (interactive)
2469 (cond
2470 (tpu-edt-mode
2471 (tpu-reset-control-keys nil)
2472 (tpu-set-mode-line nil)
2473 (setq-default page-delimiter "^\f")
2474 (setq-default truncate-lines nil)
2475 (setq scroll-step 0)
2476 (setq global-map (copy-keymap tpu-original-global-map))
2477 (use-global-map global-map)
2478 (setq tpu-edt-mode nil))))
2479
2480 (provide 'tpu-edt)
2481
2482 ;;; tpu-edt.el ends here