Mercurial > emacs

comparison lisp/emulation/tpu-edt.el @ 4421:95bb7e28d761

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