aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorRichard M. Stallman1993-08-02 19:11:20 +0000
committerRichard M. Stallman1993-08-02 19:11:20 +0000
commit522f921699daf6b03cbefdcd79597d54c1315ee6 (patch)
tree000369c8964f6bd2eae2bd63a2b4197c3fece543
parentef58099133e5591c06630d8064d215183eb95c8b (diff)
downloademacs-522f921699daf6b03cbefdcd79597d54c1315ee6.tar.gz
emacs-522f921699daf6b03cbefdcd79597d54c1315ee6.zip
Initial revision
Diffstat
-rw-r--r--lisp/emulation/tpu-edt.el2125
-rw-r--r--lisp/emulation/tpu-extras.el489
-rw-r--r--lisp/emulation/tpu-mapper.el369
-rw-r--r--lisp/tpu-doc.el472
-rw-r--r--lisp/vt-control.el114
5 files changed, 3569 insertions, 0 deletions
diff --git a/lisp/emulation/tpu-edt.el b/lisp/emulation/tpu-edt.el
new file mode 100644
index 00000000000..176517a1699
--- /dev/null
+++ b/lisp/emulation/tpu-edt.el
@@ -0,0 +1,2125 @@
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.
79CSI 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.
83SS3 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.
87GOLD 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.
260Otherwise 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.
297Return the appropriate value of the mark for the current
298version 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.
305Sets the mark at POS and activates the region acording to the
306current 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.
318Optional second argument NOT-YES changes default to negative.
319Like 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.
338Create 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.
348Top 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.
380Accepts 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.
408With 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
470its 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,
751kills 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.
816The 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.
823The 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.
831The 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.
839The 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
856direction. 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,
910and 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.
917Used 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
963corners 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.
985The 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.
1007The 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
1029argument, 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
1035argument, 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.
1056This includes the newline character at the end of each line.
1057They 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.
1069With argument, delete up to to Nth line-end past point.
1070They 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.
1081With argument, delete up to to Nth line-end past point.
1082They 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.
1092They 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.
1102They 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
1112character 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.
1129With 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.
1144With 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.
1154With 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.
1164With 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
1196repeat most recent search. A numeric argument serves as a repeat count.
1197A 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
1270currently in regular expression mode, the emacs regular expression
1271replace functions are used. If an argument is supplied, replacements
1272are 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,
1284or 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,
1302or 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.
1331A 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.
1353Additional 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.
1357A 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.
1363With 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.
1380With 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.
1434Prefix 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.
1441Prefix 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.
1448Accepts 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.
1455A 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.
1461Accepts 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.
1468Accepts 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.
1481A 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.
1487Prefix 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.
1493Prefix 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.
1503A 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.
1510Accepts 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.
1524Accepts 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.
1543A 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.
1554A 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.
1560A 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.
1570A 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).
1580Accepts 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).
1586Accepts 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.
2033If 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
diff --git a/lisp/emulation/tpu-extras.el b/lisp/emulation/tpu-extras.el
new file mode 100644
index 00000000000..b349fb63e16
--- /dev/null
+++ b/lisp/emulation/tpu-extras.el
@@ -0,0 +1,489 @@
1;;; tpu-extras.el --- Scroll margins and free cursor mode for TPU-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;; Keywords: tpu-edt
8
9;; GNU Emacs is distributed in the hope that it will be useful,
10;; but WITHOUT ANY WARRANTY. No author or distributor
11;; accepts responsibility to anyone for the consequences of using it
12;; or for whether it serves any particular purpose or works at all,
13;; unless he says so in writing. Refer to the GNU Emacs General Public
14;; License for full details.
15
16;; Everyone is granted permission to copy, modify and redistribute
17;; GNU Emacs, but only under the conditions described in the
18;; GNU Emacs General Public License. A copy of this license is
19;; supposed to have been given to you along with GNU Emacs so you
20;; can know your rights and responsibilities. It should be in a
21;; file named COPYING. Among other things, the copyright notice
22;; and this notice must be preserved on all copies.
23;;
24
25;;; Revision: $Id: tpu-extras.el,v 3.3 1993/08/01 21:38:06 riepel Exp $
26
27;;; Commentary:
28
29;; The functions contained in this file implement scroll margins and free
30;; cursor mode. The following keys and commands are affected.
31
32;; key/command function scroll cursor
33
34;; Up-Arrow previous line x x
35;; Down-Arrow next line x x
36;; Right-Arrow next character x
37;; Left-Arrow previous character x
38;; KP0 next or previous line x
39;; KP7 next or previous page x
40;; KP8 next or previous screen x
41;; KP2 next or previous end-of-line x x
42;; Control-e current end-of-line x
43;; Control-h previous beginning-of-line x
44;; Next Scr next screen x
45;; Prev Scr previous screen x
46;; Search find a string x
47;; Replace find and replace a string x
48;; Newline insert a newline x
49;; Paragraph next or previous paragraph x
50;; Auto-Fill break lines on spaces x
51
52;; These functions are not part of the base TPU-edt for the following
53;; reasons:
54
55;; Free cursor mode is implemented with the emacs picture-mode functions.
56;; These functions support moving the cursor all over the screen, however,
57;; when the cursor is moved past the end of a line, spaces or tabs are
58;; appended to the line - even if no text is entered in that area. In
59;; order for a free cursor mode to work exactly like TPU/edt, this trailing
60;; whitespace needs to be dealt with in every function that might encounter
61;; it. Such global changes are impractical, however, free cursor mode is
62;; too valuable to abandon completely, so it has been implemented in those
63;; functions where it serves best.
64
65;; The implementation of scroll margins adds overhead to previously
66;; simple and often used commands. These commands are now responsible
67;; for their normal operation and part of the display function. There
68;; is a possibility that this display overhead could adversely affect the
69;; performance of TPU-edt on slower computers. In order to support the
70;; widest range of computers, scroll margin support is optional.
71
72;; I don't know for a fact that the overhead associated with scroll
73;; margin support is significant. If you find that it is, please send me
74;; a note describing the extent of the performance degradation. Be sure
75;; to include a description of the platform where you're running TPU-edt.
76;; Send your note to the address provided by Gold-V.
77
78;; Even with these differences and limitations, these functions implement
79;; important aspects of the real TPU/edt. Those who miss free cursor mode
80;; and/or scroll margins will appreciate these implementations.
81
82;;; Usage:
83
84;; To use this file, simply load it after loading TPU-edt. After that,
85;; customize TPU-edt to your tastes by setting scroll margins and/or
86;; turning on free cursor mode. Here's an example for your .emacs file.
87
88;; (load "tpu-edt") ; Load the base TPU-edt
89;; (load "tpu-extras") ; and the extras.
90;; (tpu-set-scroll-margins "10%" "15%") ; Set scroll margins.
91
92;; Once the extras are loaded, scroll margins and cursor binding can be
93;; changed with the following commands:
94
95;; tpu-set-scroll-margins or set scroll margins
96;; tpu-set-cursor-bound or set cursor bound
97;; tpu-set-cursor-free or set cursor free
98
99;; Additionally, Gold-F toggles between bound and free cursor modes.
100
101;; Note that switching out of free cursor mode or exiting TPU-edt while in
102;; free cursor mode strips trailing whitespace from every line in the file.
103
104;;; Code:
105
106
107;;; Revision Information
108
109(defconst tpu-extras-revision "$Revision: 3.3 $"
110 "Revision number of the TPU-edt extras.")
111
112
113;;; Customization variables
114
115(defconst tpu-top-scroll-margin 0
116 "*Scroll margin at the top of the screen.
117Interpreted as a percent of the current window size.")
118(defconst tpu-bottom-scroll-margin 0
119 "*Scroll margin at the bottom of the screen.
120Interpreted as a percent of the current window size.")
121
122(defvar tpu-backward-char-like-tpu t
123 "*If non-nil, in free cursor mode backward-char (left-arrow) works
124just like TPU/edt. Otherwise, backward-char will move to the end of
125the previous line when starting from a line beginning.")
126
127
128;;; Global variables
129
130(defvar tpu-cursor-free nil
131 "If non-nil, let the cursor roam free.")
132
133
134;;; Hooks -- Set cursor free in picture mode.
135;;; Clean up when writing a file from cursor free mode.
136
137(setq edit-picture-hook 'tpu-set-cursor-free)
138
139(defun tpu-write-file-hook nil
140 "Eliminate whitespace at ends of lines, if the cursor is free."
141 (if (and (buffer-modified-p) tpu-cursor-free) (picture-clean)))
142
143(or (memq 'tpu-write-file-hook write-file-hooks)
144 (setq write-file-hooks
145 (cons 'tpu-write-file-hook write-file-hooks)))
146
147
148;;; Utility routines for implementing scroll margins
149
150(defun tpu-top-check (beg lines)
151 "Enforce scroll margin at the top of screen."
152 (let ((margin (/ (* (window-height) tpu-top-scroll-margin) 100)))
153 (cond ((< beg margin) (recenter beg))
154 ((< (- beg lines) margin) (recenter margin)))))
155
156(defun tpu-bottom-check (beg lines)
157 "Enforce scroll margin at the bottom of screen."
158 (let* ((height (window-height))
159 (margin (+ 1 (/ (* height tpu-bottom-scroll-margin) 100)))
160 ;; subtract 1 from height because it includes mode line
161 (difference (- height margin 1)))
162 (cond ((> beg difference) (recenter beg))
163 ((> (+ beg lines) difference) (recenter (- margin))))))
164
165
166;;; Movement by character
167
168(defun tpu-forward-char (num)
169 "Move right ARG characters (left if ARG is negative)."
170 (interactive "p")
171 (if tpu-cursor-free (picture-forward-column num) (forward-char num)))
172
173(defun tpu-backward-char (num)
174 "Move left ARG characters (right if ARG is negative)."
175 (interactive "p")
176 (cond ((not tpu-cursor-free)
177 (backward-char num))
178 (tpu-backward-char-like-tpu
179 (picture-backward-column num))
180 ((bolp)
181 (backward-char 1)
182 (picture-end-of-line)
183 (picture-backward-column (1- num)))
184 (t
185 (picture-backward-column num))))
186
187
188;;; Movement by line
189
190(defun tpu-next-line (num)
191 "Move to next line.
192Prefix argument serves as a repeat count."
193 (interactive "p")
194 (let ((beg (tpu-current-line)))
195 (if tpu-cursor-free (or (eobp) (picture-move-down num))
196 (next-line-internal num))
197 (tpu-bottom-check beg num)
198 (setq this-command 'next-line)))
199
200(defun tpu-previous-line (num)
201 "Move to previous line.
202Prefix argument serves as a repeat count."
203 (interactive "p")
204 (let ((beg (tpu-current-line)))
205 (if tpu-cursor-free (picture-move-up num) (next-line-internal (- num)))
206 (tpu-top-check beg num)
207 (setq this-command 'previous-line)))
208
209(defun tpu-next-beginning-of-line (num)
210 "Move to beginning of line; if at beginning, move to beginning of next line.
211Accepts a prefix argument for the number of lines to move."
212 (interactive "p")
213 (let ((beg (tpu-current-line)))
214 (backward-char 1)
215 (forward-line (- 1 num))
216 (tpu-top-check beg num)))
217
218(defun tpu-next-end-of-line (num)
219 "Move to end of line; if at end, move to end of next line.
220Accepts a prefix argument for the number of lines to move."
221 (interactive "p")
222 (let ((beg (tpu-current-line)))
223 (cond (tpu-cursor-free
224 (let ((beg (point)))
225 (if (< 1 num) (forward-line num))
226 (picture-end-of-line)
227 (if (<= (point) beg) (progn (forward-line) (picture-end-of-line)))))
228 (t
229 (forward-char)
230 (end-of-line num)))
231 (tpu-bottom-check beg num)))
232
233(defun tpu-previous-end-of-line (num)
234 "Move EOL upward.
235Accepts a prefix argument for the number of lines to move."
236 (interactive "p")
237 (let ((beg (tpu-current-line)))
238 (cond (tpu-cursor-free
239 (picture-end-of-line (- 1 num)))
240 (t
241 (end-of-line (- 1 num))))
242 (tpu-top-check beg num)))
243
244(defun tpu-current-end-of-line nil
245 "Move point to end of current line."
246 (interactive)
247 (let ((beg (point)))
248 (if tpu-cursor-free (picture-end-of-line) (end-of-line))
249 (if (= beg (point)) (message "You are already at the end of a line."))))
250
251(defun tpu-forward-line (num)
252 "Move to beginning of next line.
253Prefix argument serves as a repeat count."
254 (interactive "p")
255 (let ((beg (tpu-current-line)))
256 (next-line-internal num)
257 (tpu-bottom-check beg num)
258 (beginning-of-line)))
259
260(defun tpu-backward-line (num)
261 "Move to beginning of previous line.
262Prefix argument serves as repeat count."
263 (interactive "p")
264 (let ((beg (tpu-current-line)))
265 (next-line-internal (- num))
266 (tpu-top-check beg num)
267 (beginning-of-line)))
268
269
270;;; Movement by paragraph
271
272(defun tpu-paragraph (num)
273 "Move to the next paragraph in the current direction.
274A repeat count means move that many paragraphs."
275 (interactive "p")
276 (let* ((left nil)
277 (beg (tpu-current-line))
278 (height (window-height))
279 (top-percent
280 (if (= 0 tpu-top-scroll-margin) 10 tpu-top-scroll-margin))
281 (bottom-percent
282 (if (= 0 tpu-bottom-scroll-margin) 15 tpu-bottom-scroll-margin))
283 (top-margin (/ (* height top-percent) 100))
284 (bottom-up-margin (+ 1 (/ (* height bottom-percent) 100)))
285 (bottom-margin (max beg (- height bottom-up-margin 1)))
286 (top (save-excursion (move-to-window-line top-margin) (point)))
287 (bottom (save-excursion (move-to-window-line bottom-margin) (point)))
288 (far (save-excursion
289 (goto-char bottom) (forward-line (- height 2)) (point))))
290 (cond (tpu-advance
291 (tpu-next-paragraph num)
292 (cond((> (point) far)
293 (setq left (save-excursion (forward-line height)))
294 (if (= 0 left) (recenter top-margin)
295 (recenter (- left bottom-up-margin))))
296 (t
297 (and (> (point) bottom) (recenter bottom-margin)))))
298 (t
299 (tpu-previous-paragraph num)
300 (and (< (point) top) (recenter (min beg top-margin)))))))
301
302
303;;; Movement by page
304
305(defun tpu-page (num)
306 "Move to the next page in the current direction.
307A repeat count means move that many pages."
308 (interactive "p")
309 (let* ((left nil)
310 (beg (tpu-current-line))
311 (height (window-height))
312 (top-percent
313 (if (= 0 tpu-top-scroll-margin) 10 tpu-top-scroll-margin))
314 (bottom-percent
315 (if (= 0 tpu-bottom-scroll-margin) 15 tpu-bottom-scroll-margin))
316 (top-margin (/ (* height top-percent) 100))
317 (bottom-up-margin (+ 1 (/ (* height bottom-percent) 100)))
318 (bottom-margin (max beg (- height bottom-up-margin 1)))
319 (top (save-excursion (move-to-window-line top-margin) (point)))
320 (bottom (save-excursion (move-to-window-line bottom-margin) (point)))
321 (far (save-excursion
322 (goto-char bottom) (forward-line (- height 2)) (point))))
323 (cond (tpu-advance
324 (forward-page num)
325 (cond((> (point) far)
326 (setq left (save-excursion (forward-line height)))
327 (if (= 0 left) (recenter top-margin)
328 (recenter (- left bottom-up-margin))))
329 (t
330 (and (> (point) bottom) (recenter bottom-margin)))))
331 (t
332 (backward-page num)
333 (and (< (point) top) (recenter (min beg top-margin)))))))
334
335
336;;; Scrolling
337
338(defun tpu-scroll-window-down (num)
339 "Scroll the display down to the next section.
340A repeat count means scroll that many sections."
341 (interactive "p")
342 (let* ((beg (tpu-current-line))
343 (height (1- (window-height)))
344 (lines (* num (/ (* height tpu-percent-scroll) 100))))
345 (next-line-internal (- lines))
346 (tpu-top-check beg lines)))
347
348(defun tpu-scroll-window-up (num)
349 "Scroll the display up to the next section.
350A repeat count means scroll that many sections."
351 (interactive "p")
352 (let* ((beg (tpu-current-line))
353 (height (1- (window-height)))
354 (lines (* num (/ (* height tpu-percent-scroll) 100))))
355 (next-line-internal lines)
356 (tpu-bottom-check beg lines)))
357
358
359;;; Replace the TPU-edt internal search function
360
361(defun tpu-search-internal (pat &optional quiet)
362 "Search for a string or regular expression."
363 (let* ((left nil)
364 (beg (tpu-current-line))
365 (height (window-height))
366 (top-percent
367 (if (= 0 tpu-top-scroll-margin) 10 tpu-top-scroll-margin))
368 (bottom-percent
369 (if (= 0 tpu-bottom-scroll-margin) 15 tpu-bottom-scroll-margin))
370 (top-margin (/ (* height top-percent) 100))
371 (bottom-up-margin (+ 1 (/ (* height bottom-percent) 100)))
372 (bottom-margin (max beg (- height bottom-up-margin 1)))
373 (top (save-excursion (move-to-window-line top-margin) (point)))
374 (bottom (save-excursion (move-to-window-line bottom-margin) (point)))
375 (far (save-excursion
376 (goto-char bottom) (forward-line (- height 2)) (point))))
377 (tpu-search-internal-core pat quiet)
378 (if searching-forward
379 (cond((> (point) far)
380 (setq left (save-excursion (forward-line height)))
381 (if (= 0 left) (recenter top-margin)
382 (recenter (- left bottom-up-margin))))
383 (t
384 (and (> (point) bottom) (recenter bottom-margin))))
385 (and (< (point) top) (recenter (min beg top-margin))))))
386
387
388
389;;; Replace the newline, newline-and-indent, and do-auto-fill functions
390
391(or (fboundp 'tpu-old-newline)
392 (fset 'tpu-old-newline (symbol-function 'newline)))
393(or (fboundp 'tpu-old-do-auto-fill)
394 (fset 'tpu-old-do-auto-fill (symbol-function 'do-auto-fill)))
395(or (fboundp 'tpu-old-newline-and-indent)
396 (fset 'tpu-old-newline-and-indent (symbol-function 'newline-and-indent)))
397
398(defun newline (&optional num)
399 "Insert a newline. With arg, insert that many newlines.
400In Auto Fill mode, can break the preceding line if no numeric arg.
401This is the TPU-edt version that respects the bottom scroll margin."
402 (interactive "p")
403 (let ((beg (tpu-current-line)))
404 (or num (setq num 1))
405 (tpu-old-newline num)
406 (tpu-bottom-check beg num)))
407
408(defun newline-and-indent nil
409 "Insert a newline, then indent according to major mode.
410Indentation is done using the current indent-line-function.
411In programming language modes, this is the same as TAB.
412In some text modes, where TAB inserts a tab, this indents
413to the specified left-margin column. This is the TPU-edt
414version that respects the bottom scroll margin."
415 (interactive)
416 (let ((beg (tpu-current-line)))
417 (tpu-old-newline-and-indent)
418 (tpu-bottom-check beg 1)))
419
420(defun do-auto-fill nil
421 "TPU-edt version that respects the bottom scroll margin."
422 (let ((beg (tpu-current-line)))
423 (tpu-old-do-auto-fill)
424 (tpu-bottom-check beg 1)))
425
426
427;;; Function to set scroll margins
428
429(defun tpu-set-scroll-margins (top bottom)
430 "Set scroll margins."
431 (interactive
432 "sEnter top scroll margin (N lines or N%% or RETURN for current value): \
433\nsEnter bottom scroll margin (N lines or N%% or RETURN for current value): ")
434 ;; set top scroll margin
435 (or (string= top "")
436 (if (string= "%" (substring top -1))
437 (setq tpu-top-scroll-margin (string-to-int top))
438 (setq tpu-top-scroll-margin
439 (/ (1- (+ (* (string-to-int top) 100) (window-height)))
440 (window-height)))))
441 ;; set bottom scroll margin
442 (or (string= bottom "")
443 (if (string= "%" (substring bottom -1))
444 (setq tpu-bottom-scroll-margin (string-to-int bottom))
445 (setq tpu-bottom-scroll-margin
446 (/ (1- (+ (* (string-to-int bottom) 100) (window-height)))
447 (window-height)))))
448 ;; report scroll margin settings if running interactively
449 (and (interactive-p)
450 (message "Scroll margins set. Top = %s%%, Bottom = %s%%"
451 tpu-top-scroll-margin tpu-bottom-scroll-margin)))
452
453(fset 'set\ scroll\ margins 'tpu-set-scroll-margins)
454(fset 'SET\ SCROLL\ MARGINS 'tpu-set-scroll-margins)
455
456
457;;; Functions to set cursor bound or free
458
459(defun tpu-set-cursor-free nil
460 "Allow the cursor to move freely about the screen."
461 (interactive)
462 (setq tpu-cursor-free t)
463 (substitute-key-definition 'tpu-set-cursor-free
464 'tpu-set-cursor-bound
465 GOLD-map)
466 (message "The cursor will now move freely about the screen."))
467
468(defun tpu-set-cursor-bound nil
469 "Constrain the cursor to the flow of the text."
470 (interactive)
471 (picture-clean)
472 (setq tpu-cursor-free nil)
473 (substitute-key-definition 'tpu-set-cursor-bound
474 'tpu-set-cursor-free
475 GOLD-map)
476 (message "The cursor is now bound to the flow of your text."))
477
478(fset 'set\ cursor\ bound 'tpu-set-cursor-bound)
479(fset 'SET\ CURSOR\ BOUND 'tpu-set-cursor-bound)
480(fset 'set\ cursor\ free 'tpu-set-cursor-free)
481(fset 'SET\ CURSOR\ FREE 'tpu-set-cursor-free)
482
483
484;;; Keypad Mapping
485
486(define-key GOLD-map "F" 'tpu-set-cursor-free) ; F
487(define-key GOLD-map "f" 'tpu-set-cursor-free) ; f
488
489;;; tpu-extras.el ends here
diff --git a/lisp/emulation/tpu-mapper.el b/lisp/emulation/tpu-mapper.el
new file mode 100644
index 00000000000..e7e9158a67d
--- /dev/null
+++ b/lisp/emulation/tpu-mapper.el
@@ -0,0 +1,369 @@
1;;; tpu-mapper.el --- Create a TPU-edt keymap file for x-windows emacs.
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;; Keywords: tpu-edt
8
9;; GNU Emacs is distributed in the hope that it will be useful,
10;; but WITHOUT ANY WARRANTY. No author or distributor
11;; accepts responsibility to anyone for the consequences of using it
12;; or for whether it serves any particular purpose or works at all,
13;; unless he says so in writing. Refer to the GNU Emacs General Public
14;; License for full details.
15
16;; Everyone is granted permission to copy, modify and redistribute
17;; GNU Emacs, but only under the conditions described in the
18;; GNU Emacs General Public License. A copy of this license is
19;; supposed to have been given to you along with GNU Emacs so you
20;; can know your rights and responsibilities. It should be in a
21;; file named COPYING. Among other things, the copyright notice
22;; and this notice must be preserved on all copies.
23;;
24
25;;; Revision: $Id: tpu-mapper.el,v 1.1 1993/08/01 21:39:07 riepel Exp $
26
27;;; Commentary:
28
29;; This emacs lisp program can be used to create an emacs lisp file that
30;; defines the TPU-edt keypad for emacs running on x-windows. Please read
31;; the "Usage" AND "Known Problems" sections before attempting to run this
32;; program.
33
34;;; Usage:
35
36;; Simply load this file into the X-windows version of emacs (version 19)
37;; using the following command.
38
39;; emacs -q -l tpu-mapper.el
40
41;; The "-q" option prevents loading of your .emacs file (commands therein
42;; might confuse this program).
43
44;; An instruction screen showing the TPU-edt keypad will be displayed, and
45;; you will be prompted to press the TPU-edt editing keys. Tpu-mapper uses
46;; the keys you press to create an emacs lisp file that will define a
47;; TPU-edt keypad for your X server. You can even re-arrange the standard
48;; EDT keypad to suit your tastes (or to cope with those silly Sun and PC
49;; keypads).
50
51;; Finally, you will be prompted for the name of the file to store the key
52;; definitions. If you chose the default, TPU-edt will find it and load it
53;; automatically. If you specify a different file name, you will need to
54;; set the variable "tpu-xkeys-file" before loading TPU-edt. Here's how
55;; you might go about doing that in your .emacs file.
56
57;; (setq tpu-xkeys-file (expand-file-name "~/.my-emacs-x-keys"))
58;; (load "tpu-edt")
59
60;;; Known Problems:
61
62;; Sometimes, tpu-mapper will ignore a key you press, and just continue to
63;; prompt for the same key. This can happen when your window manager sucks
64;; up the key and doesn't pass it on to emacs, or it could be an emacs bug.
65;; Either way, there's nothing that tpu-mapper can do about it. You must
66;; press RETURN, to skip the current key and continue. Later, you and/or
67;; your local X guru can try to figure out why the key is being ignored.
68
69;;; Code:
70
71;;;
72;;; Revision Information
73;;;
74(defconst tpu-mapper-revision "$Revision: 1.1 $"
75 "Revision number of TPU-edt x-windows emacs key mapper.")
76
77
78;;;
79;;; Make sure we're running X-windows and Emacs version 19
80;;;
81(cond
82 ((not (and window-system (not (string-lessp emacs-version "19"))))
83 (insert "
84
85 Whoa! This isn't going to work...
86
87 You must run tpu-mapper.el under X-windows and Emacs version 19.
88
89 Press any key to exit. ")
90 (sit-for 600)
91 (kill-emacs t)))
92
93
94;;;
95;;; Decide whether we're running GNU or Lucid emacs.
96;;;
97(defconst tpu-lucid-emacs19-p (string-match "Lucid" emacs-version)
98 "Non-NIL if we are running Lucid Emacs version 19.")
99
100
101;;;
102;;; Key variables
103;;;
104(defvar tpu-key nil)
105(defvar tpu-enter nil)
106(defvar tpu-return nil)
107(defvar tpu-key-seq nil)
108(defvar tpu-enter-seq nil)
109(defvar tpu-return-seq nil)
110
111
112;;;
113;;; Make sure the window is big enough to display the instructions
114;;;
115(if tpu-lucid-emacs19-p (set-screen-size nil 80 36)
116 (set-frame-size (selected-frame) 80 36))
117
118
119;;;
120;;; Create buffers - Directions, Keys, Gold-Keys
121;;;
122(if (not (get-buffer "Directions")) (generate-new-buffer "Directions"))
123(if (not (get-buffer "Keys")) (generate-new-buffer "Keys"))
124(if (not (get-buffer "Gold-Keys")) (generate-new-buffer "Gold-Keys"))
125
126
127;;;
128;;; Put headers in the Keys buffer
129;;;
130(set-buffer "Keys")
131(insert "\
132;; Key definitions for TPU-edt
133;;
134")
135
136
137;;;
138;;; Display directions
139;;;
140(switch-to-buffer "Directions")
141(insert "
142 This program prompts you to press keys to create a custom keymap file
143 for use with the x-windows version of emacs and TPU-edt.
144
145 Start by pressing the RETURN key, and continue by pressing the keys
146 specified in the mini-buffer. You can re-arrange the TPU-edt keypad
147 by pressing any key you want at any prompt. If you want to entirely
148 omit a key, just press RETURN at the prompt.
149
150 Here's a picture of the standard TPU/edt keypad for reference:
151
152 _______________________ _______________________________
153 | HELP | Do | | | | | |
154 |KeyDefs| | | | | | |
155 |_______|_______________| |_______|_______|_______|_______|
156 _______________________ _______________________________
157 | Find |Insert |Remove | | Gold | HELP |FndNxt | Del L |
158 | | |Sto Tex| | key |E-Help | Find |Undel L|
159 |_______|_______|_______| |_______|_______|_______|_______|
160 |Select |Pre Scr|Nex Scr| | Page | Sect |Append | Del W |
161 | Reset |Pre Win|Nex Win| | Do | Fill |Replace|Undel W|
162 |_______|_______|_______| |_______|_______|_______|_______|
163 |Move up| |Forward|Reverse|Remove | Del C |
164 | Top | |Bottom | Top |Insert |Undel C|
165 _______|_______|_______ |_______|_______|_______|_______|
166 |Mov Lef|Mov Dow|Mov Rig| | Word | EOL | Char | |
167 |StaOfLi|Bottom |EndOfLi| |ChngCas|Del EOL|SpecIns| Enter |
168 |_______|_______|_______| |_______|_______|_______| |
169 | Line |Select | Subs |
170 | Open Line | Reset | |
171 |_______________|_______|_______|
172
173
174")
175(delete-other-windows)
176
177;;;
178;;; Save <CR> for future reference
179;;;
180(setq tpu-return-seq (read-key-sequence "Hit carriage-return <CR> to continue "))
181(cond
182 (tpu-lucid-emacs19-p
183 (setq tpu-return (concat "[" (format "%s" (event-key (aref tpu-return-seq 0))) "]")))
184 (t
185 (setq tpu-return (format "%s" tpu-return-seq))))
186
187
188;;;
189;;; Key mapping functions
190;;;
191(defun tpu-lucid-map-key (ident descrip func gold-func)
192 (interactive)
193 (setq tpu-key-seq (read-key-sequence (format "Press %s%s: " ident descrip)))
194 (setq tpu-key (concat "[" (format "%s" (event-key (aref tpu-key-seq 0))) "]"))
195 (cond ((not (equal tpu-key tpu-return))
196 (set-buffer "Keys")
197 (insert (format"(global-set-key %s %s)\n" tpu-key func))
198 (set-buffer "Gold-Keys")
199 (insert (format "(define-key GOLD-map %s %s)\n" tpu-key gold-func))
200 (set-buffer "Directions"))
201 ;; bogosity to get next prompt to come up, if the user hits <CR>!
202 ;; check periodically to see if this is still needed...
203 (t
204 (format "%s" tpu-key)))
205 tpu-key)
206
207(defun tpu-gnu-map-key (ident descrip func gold-func)
208 (interactive)
209 (setq tpu-key-seq (read-key-sequence (format "Press %s%s: " ident descrip)))
210 (setq tpu-key (format "%s" tpu-key-seq))
211 (cond ((not (equal tpu-key tpu-return))
212 (set-buffer "Keys")
213 (insert (format"(global-set-key %s %s)\n" tpu-key func))
214 (set-buffer "Gold-Keys")
215 (insert (format "(define-key GOLD-map %s %s)\n" tpu-key gold-func))
216 (set-buffer "Directions"))
217 ;; bogosity to get next prompt to come up, if the user hits <CR>!
218 ;; check periodically to see if this is still needed...
219 (t
220 (format "%s" tpu-key)))
221 tpu-key)
222
223(fset 'tpu-map-key (if tpu-lucid-emacs19-p 'tpu-lucid-map-key 'tpu-gnu-map-key))
224
225
226(set-buffer "Keys")
227(insert "
228;; Arrows
229;;
230")
231(set-buffer "Gold-Keys")
232(insert "
233;; GOLD Arrows
234;;
235")
236(set-buffer "Directions")
237
238(tpu-map-key "Up-Arrow" "" "'tpu-previous-line" "'tpu-move-to-beginning")
239(tpu-map-key "Down-arrow" "" "'tpu-next-line" "'tpu-move-to-end")
240(tpu-map-key "Right-arrow" "" "'tpu-forward-char" "'end-of-line")
241(tpu-map-key "Left-arrow" "" "'tpu-backward-char" "'beginning-of-line")
242
243
244(set-buffer "Keys")
245(insert "
246;; PF keys
247;;
248")
249(set-buffer "Gold-Keys")
250(insert "
251;; GOLD PF keys
252;;
253")
254(set-buffer "Directions")
255
256(tpu-map-key "PF1" " - The GOLD key" "GOLD-map" "'keyboard-quit")
257(tpu-map-key "PF2" " - The Keypad Help key" "'tpu-help" "'help-for-help")
258(tpu-map-key "PF3" " - The Find/Find-Next key" "'tpu-search-again" "'tpu-search")
259(tpu-map-key "PF4" " - The Del/Undelete Line key" "'tpu-delete-current-line" "'tpu-undelete-lines")
260
261(set-buffer "Keys")
262(insert "
263;; KP0-9 KP- KP, KP. and KPenter
264;;
265")
266(set-buffer "Gold-Keys")
267(insert "
268;; GOLD KP0-9 KP- KP, and KPenter
269;;
270")
271(set-buffer "Directions")
272
273(tpu-map-key "KP-0" " - The Line/Open-Line key" "'tpu-line" "'open-line")
274(tpu-map-key "KP-1" " - The Word/Change-Case key" "'tpu-word" "'tpu-change-case")
275(tpu-map-key "KP-2" " - The EOL/Delete-EOL key" "'tpu-end-of-line" "'tpu-delete-to-eol")
276(tpu-map-key "KP-3" " - The Character/Special-Insert key" "'tpu-char" "'tpu-special-insert")
277(tpu-map-key "KP-4" " - The Forward/Bottom key" "'tpu-advance-direction" "'tpu-move-to-end")
278(tpu-map-key "KP-5" " - The Reverse/Top key" "'tpu-backup-direction" "'tpu-move-to-beginning")
279(tpu-map-key "KP-6" " - The Remove/Insert key" "'tpu-cut" "'tpu-paste")
280(tpu-map-key "KP-7" " - The Page/Do key" "'tpu-page" "'execute-extended-command")
281(tpu-map-key "KP-8" " - The Section/Fill key" "'tpu-scroll-window" "'tpu-fill")
282(tpu-map-key "KP-9" " - The Append/Replace key" "'tpu-append-region" "'tpu-replace")
283(tpu-map-key "KP--" " - The Delete/Undelete Word key" "'tpu-delete-current-word" "'tpu-undelete-words")
284(tpu-map-key "KP-," " - The Delete/Undelete Character key" "'tpu-delete-current-char" "'tpu-undelete-char")
285(tpu-map-key "KP-." " - The Select/Reset key" "'tpu-select" "'tpu-unselect")
286(tpu-map-key "KP-Enter" " - The Enter key on the numeric keypad" "'newline" "'tpu-substitute")
287;; Save the enter key
288(setq tpu-enter tpu-key)
289(setq tpu-enter-seq tpu-key-seq)
290
291(set-buffer "Keys")
292(insert "
293;; Editing keypad (find, insert, remove)
294;; (select, prev, next)
295;;
296")
297(set-buffer "Gold-Keys")
298(insert "
299;; GOLD Editing keypad (find, insert, remove)
300;; (select, prev, next)
301;;
302")
303(set-buffer "Directions")
304
305(tpu-map-key "Find" " - The Find key on the editing keypad" "'tpu-search" "'nil")
306(tpu-map-key "Insert" " - The Insert key on the editing keypad" "'tpu-paste" "'nil")
307(tpu-map-key "Remove" " - The Remove key on the editing keypad" "'tpu-cut" "'tpu-store-text")
308(tpu-map-key "Select" " - The Select key on the editing keypad" "'tpu-select" "'tpu-unselect")
309(tpu-map-key "Prev Scr" " - The Prev Scr key on the editing keypad" "'tpu-scroll-window-down" "'tpu-previous-window")
310(tpu-map-key "Next Scr" " - The Next Scr key on the editing keypad" "'tpu-scroll-window-up" "'tpu-next-window")
311
312(set-buffer "Keys")
313(insert "
314;; F10-14 Help Do F17
315;;
316")
317(set-buffer "Gold-Keys")
318(insert "
319;; GOLD F10-14 Help Do F17
320;;
321")
322(set-buffer "Directions")
323
324(tpu-map-key "F10" " - Invokes the Exit function on VT200+ terminals" "'tpu-exit" "'nil")
325(tpu-map-key "F11" " - Inserts an Escape character into the text" "'tpu-insert-escape" "'nil")
326(tpu-map-key "Backspace" " - Not Delete nor ^H! Sometimes on the F12 key" "'tpu-next-beginning-of-line" "'nil")
327(tpu-map-key "F13" " - Invokes the delete previous word function" "'tpu-delete-previous-word" "'nil")
328(tpu-map-key "F14" " - Toggles insert/overstrike modes" "'tpu-toggle-overwrite-mode" "'nil")
329(tpu-map-key "Help" " - Brings up the help screen, same as PF2" "'tpu-help" "'describe-bindings")
330(tpu-map-key "Do" " - Invokes the COMMAND function" "'execute-extended-command" "'nil")
331(tpu-map-key "F17" "" "'tpu-goto-breadcrumb" "'tpu-drop-breadcrumb")
332
333(set-buffer "Gold-Keys")
334(cond
335 ((not (equal tpu-enter tpu-return))
336 (insert "
337;; Minibuffer map additions to make KP_enter = RET
338;;
339")
340
341 (insert (format "(define-key minibuffer-local-map %s 'exit-minibuffer)\n" tpu-enter))
342 (insert (format "(define-key minibuffer-local-ns-map %s 'exit-minibuffer)\n" tpu-enter))
343 (insert (format "(define-key minibuffer-local-completion-map %s 'exit-minibuffer)\n" tpu-enter))
344 (insert (format "(define-key minibuffer-local-must-match-map %s 'minibuffer-complete-and-exit)\n" tpu-enter))))
345
346(insert "
347;; Define the tpu-help-enter/return symbols
348;;
349")
350
351(insert (format "(setq tpu-help-enter \"%s\")\n" tpu-enter-seq))
352(insert (format "(setq tpu-help-return \"%s\")\n" tpu-return-seq))
353
354(append-to-buffer "Keys" 1 (point))
355(set-buffer "Keys")
356
357;;;
358;;; Save the key mapping program and blow this pop stand
359;;;
360(let ((file (if tpu-lucid-emacs19-p "~/.tpu-lucid-keys" "~/.tpu-gnu-keys")))
361 (set-visited-file-name
362 (read-file-name (format "Save key mapping to file (default %s): " file) nil file)))
363(save-buffer)
364
365(message "That's it! Press any key to exit")
366(sit-for 600)
367(kill-emacs t)
368
369;;; tpu-mapper.el ends here
diff --git a/lisp/tpu-doc.el b/lisp/tpu-doc.el
new file mode 100644
index 00000000000..dfdb6b8a4ff
--- /dev/null
+++ b/lisp/tpu-doc.el
@@ -0,0 +1,472 @@
1;;; tpu-doc.el --- Documentation for TPU-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;; Keywords: tpu-edt
8
9;; GNU Emacs is distributed in the hope that it will be useful,
10;; but WITHOUT ANY WARRANTY. No author or distributor
11;; accepts responsibility to anyone for the consequences of using it
12;; or for whether it serves any particular purpose or works at all,
13;; unless he says so in writing. Refer to the GNU Emacs General Public
14;; License for full details.
15
16;; Everyone is granted permission to copy, modify and redistribute
17;; GNU Emacs, but only under the conditions described in the
18;; GNU Emacs General Public License. A copy of this license is
19;; supposed to have been given to you along with GNU Emacs so you
20;; can know your rights and responsibilities. It should be in a
21;; file named COPYING. Among other things, the copyright notice
22;; and this notice must be preserved on all copies.
23;;
24
25;;; Revision: $Id: tpu-doc.el,v 3.2 1993/08/01 21:36:48 riepel Exp $
26(defconst tpu-doc-revision "$Revision: 3.2 $"
27 "TPU-edt documentation revision number.")
28
29
30;; This is documentation for the TPU-edt editor for GNU emacs. Major
31;; sections of this document are separated with lines that begin with
32;; ";; %% <topic>", where <topic> is what is discussed in that section.
33
34
35;; %% Contents
36
37;; % Introduction
38;; % Terminal Support
39;; % X-windows Support
40;; % Differences Between TPU-edt and the Real Thing
41;; % Starting TPU-edt
42;; % TPU-edt Default Editing Keypad, Control and Gold Key Bindings
43;; % Optional TPU-edt Extensions
44;; % Customizing TPU-edt using the Emacs Initialization File
45;; % Compiling TPU-edt
46;; % Regular expressions in TPU-edt
47;; % Etcetera
48
49
50;; %% Introduction
51
52;; TPU-edt is based on tpu.el by Jeff Kowalski. TPU-edt endeavors
53;; to be even more like TPU's EDT emulation than the original tpu.el.
54;; Considerable effort has been expended to that end. Still, emacs
55;; is emacs and there are differences between TPU-edt and the real
56;; thing. Please read the "Differences Between TPU-edt and the Real
57;; Thing" and "Starting TPU-edt" sections before running TPU-edt.
58
59
60;; %% Terminal Support
61
62;; TPU-edt, like it's VMS cousin, works on VT-series terminals with
63;; DEC style keyboards. VT terminal emulators, including xterm with
64;; the appropriate key translations, work just fine too.
65
66
67;; %% X-windows Support
68
69;; Starting with version 19 of emacs, TPU-edt works with X-windows.
70;; This is accomplished through a TPU-edt X keymap. The emacs lisp
71;; program tpu-mapper.el creates this map and stores it in a file.
72;; Tpu-mapper will be run automatically the first time you invoke
73;; the X-windows version of emacs, or you can run it by hand. See
74;; the commentary in tpu-mapper.el for details.
75
76
77;; %% Differences Between TPU-edt and the Real Thing (not Coke (r))
78
79;; Emacs (version 18.58) doesn't support text highlighting, so selected
80;; regions are not shown in inverse video. Emacs uses the concept of
81;; "the mark". The mark is set at one end of a selected region; the
82;; cursor is at the other. The letter "M" appears in the mode line
83;; when the mark is set. The native emacs command ^X^X (Control-X
84;; twice) exchanges the cursor with the mark; this provides a handy
85;; way to find the location of the mark.
86
87;; In TPU the cursor can be either bound or free. Bound means the
88;; cursor cannot wander outside the text of the file being edited.
89;; Free means the arrow keys can move the cursor past the ends of
90;; lines. Free is the default mode in TPU; bound is the only mode
91;; in EDT. Bound is the only mode in the base version of TPU-edt;
92;; optional extensions add an approximation of free mode.
93
94;; Like TPU, emacs uses multiple buffers. Some buffers are used to
95;; hold files you are editing; other "internal" buffers are used for
96;; emacs' own purposes (like showing you help). Here are some commands
97;; for dealing with buffers.
98
99;; Gold-B moves to next buffer, including internal buffers
100;; Gold-N moves to next buffer containing a file
101;; Gold-M brings up a buffer menu (like TPU "show buffers")
102
103;; Emacs is very fond of throwing up new windows. Dealing with all
104;; these windows can be a little confusing at first, so here are a few
105;; commands to that may help:
106
107;; Gold-Next_Scr moves to the next window on the screen
108;; Gold-Prev_Scr moves to the previous window on the screen
109;; Gold-TAB also moves to the next window on the screen
110
111;; Control-x 1 deletes all but the current window
112;; Control-x 0 deletes the current window
113
114;; Note that the buffers associated with deleted windows still exist!
115
116;; Like TPU, TPU-edt has a "command" function, invoked with Gold-KP7 or
117;; Do. Most of the commands available are emacs commands. Some TPU
118;; commands are available, they are: replace, exit, quit, include, and
119;; Get (unfortunately, "get" is an internal emacs function, so we are
120;; stuck with "Get" - to make life easier, Get is available as Gold-g).
121
122;; Support for recall of commands, file names, and search strings was
123;; added to emacs in version 19. For version 18 of emacs, optional
124;; extensions are available to add this recall capability (see "Optional
125;; TPU-edt Extensions" below). The history of strings recalled in both
126;; versions of emacs differs slightly from TPU/edt, but it is still very
127;; convenient.
128
129;; Help is available! The traditional help keys (Help and PF2) display
130;; a three page help file showing the default keypad layout, control key
131;; functions, and Gold key functions. Pressing any key inside of help
132;; splits the screen and prints a description of the function of the
133;; pressed key. Gold-PF2 invokes the native emacs help, with it's
134;; zillions of options. Gold-Help shows all the current key bindings.
135
136;; Thanks to emacs, TPU-edt has some extensions that may make your life
137;; easier, or at least more interesting. For example, Gold-r toggles
138;; TPU-edt rectangular mode. In rectangular mode, Remove and Insert work
139;; on rectangles. Likewise, Gold-* toggles TPU-edt regular expression
140;; mode. In regular expression mode Find, Find Next, and the line-mode
141;; replace command work with regular expressions. [A regular expression
142;; is a pattern that denotes a set of strings; like VMS wildcards.]
143
144;; Emacs also gives TPU-edt the undo and occur functions. Undo does
145;; what it says; it undoes the last change. Multiple undos in a row
146;; undo multiple changes. For your convenience, undo is available on
147;; Gold-u. Occur shows all the lines containing a specific string in
148;; another window. Moving to that window, and typing ^C^C (Control-C
149;; twice) on a particular line moves you back to the original window
150;; at that line. Occur is on Gold-o.
151
152;; Finally, as you edit, remember that all the power of emacs is at
153;; your disposal. It really is a fantastic tool. You may even want to
154;; take some time and read the emacs tutorial; perhaps not to learn the
155;; native emacs key bindings, but to get a feel for all the things
156;; emacs can do for you. The emacs tutorial is available from the
157;; emacs help function: "Gold-PF2 t"
158
159
160;; %% Starting TPU-edt
161
162;; In order to use TPU-edt, the TPU-edt editor definitions, contained
163;; in tpu-edt.el, need to be loaded when emacs is run. This can be
164;; done in a couple of ways. The first is by explicitly requesting
165;; loading of the TPU-edt emacs definition file on the command line:
166
167;; prompt> emacs -l /path/to/definitions/tpu-edt.el
168
169;; If TPU-edt is installed on your system, that is, if tpu-edt.el is in
170;; a directory like /usr/local/emacs/lisp, along with dozens of other
171;; .el files, you should be able to use the command:
172
173;; prompt> emacs -l tpu-edt
174
175;; If you like TPU-edt and want to use it all the time, you can load
176;; the TPU-edt definitions using the emacs initialization file, .emacs.
177;; Simply create a .emacs file in your home directory containing the
178;; line:
179
180;; (load "/path/to/definitions/tpu-edt")
181
182;; or, if (as above) TPU-edt is installed on your system:
183
184;; (load "tpu-edt")
185
186;; Once TPU-edt has been loaded, you will be using an editor with the
187;; interface shown in the next section (A section that is suitable for
188;; cutting out of this document and pasting next to your terminal!).
189
190
191;; %% TPU-edt Default Editing Keypad, Control and Gold Key Bindings
192;;
193;; _______________________ _______________________________
194;; | HELP | Do | | | | | |
195;; |KeyDefs| | | | | | |
196;; |_______|_______________| |_______|_______|_______|_______|
197;; _______________________ _______________________________
198;; | Find |Insert |Remove | | Gold | HELP |FndNxt | Del L |
199;; | | |Sto Tex| | key |E-Help | Find |Undel L|
200;; |_______|_______|_______| |_______|_______|_______|_______|
201;; |Select |Pre Scr|Nex Scr| | Page | Sect |Append | Del W |
202;; | Reset |Pre Win|Nex Win| | Do | Fill |Replace|Undel W|
203;; |_______|_______|_______| |_______|_______|_______|_______|
204;; |Move up| |Forward|Reverse|Remove | Del C |
205;; | Top | |Bottom | Top |Insert |Undel C|
206;; _______|_______|_______ |_______|_______|_______|_______|
207;; |Mov Lef|Mov Dow|Mov Rig| | Word | EOL | Char | |
208;; |StaOfLi|Bottom |EndOfLi| |ChngCas|Del EOL|SpecIns| Enter |
209;; |_______|_______|_______| |_______|_______|_______| |
210;; | Line |Select | Subs |
211;; | Open Line | Reset | |
212;; |_______________|_______|_______|
213;; Control Characters
214;;
215;; ^A toggle insert and overwrite ^L insert page break
216;; ^B recall ^R remember, re-center
217;; ^E end of line ^U delete to beginning of line
218;; ^G cancel current operation ^V quote
219;; ^H beginning of line ^W refresh
220;; ^J delete previous word ^Z exit
221;; ^K learn ^X^X exchange point and mark
222;;
223;;
224;; Gold-<key> Functions
225;; -----------------------------------------------------------------
226;; W Write - save current buffer
227;; K Kill buffer - abandon edits and delete buffer
228;;
229;; E Exit - save current buffer and ask about others
230;; X eXit - save all modified buffers and exit
231;; Q Quit - exit without saving anything
232;;
233;; G Get - load a file into a new edit buffer
234;; I Include - include a file in this buffer
235;;
236;; B next Buffer - display the next buffer (all buffers)
237;; N Next file buffer - display next buffer containing a file
238;; M buffer Menu - display a list of all buffers
239;;
240;; U Undo - undo the last edit
241;; C Recall - edit and possibly repeat previous commands
242;;
243;; O Occur - show following lines containing REGEXP
244;; S Search and substitute - line mode REPLACE command
245;;
246;; ? Spell check - check spelling in a region or entire buffer
247;;
248;; R Toggle Rectangular mode for remove and insert
249;; * Toggle regular expression mode for search and substitute
250;;
251;; V Show TPU-edt version
252;; -----------------------------------------------------------------
253
254
255;; %% Optional TPU-edt Extensions
256
257;; Several optional packages have been included in this distribution
258;; of TPU-edt. The following is a brief description of each package.
259;; See the {package}.el file for more detailed information and usage
260;; instructions.
261
262;; tpu-extras - TPU/edt scroll margins and free cursor mode.
263;; tpu-recall - String, file name, and command history.
264;; vt-control - VTxxx terminal width and keypad controls.
265
266;; Packages are normally loaded from the emacs initialization file
267;; (discussed below). If a package is not installed in the emacs
268;; lisp directory, it can be loaded by specifying the complete path
269;; to the package file. However, it is preferable to modify the
270;; emacs load-path variable to include the directory where packages
271;; are stored. This way, packages can be loaded by name, just as if
272;; they were installed. The first part of the sample .emacs file
273;; below shows how to make such a modification.
274
275
276;; %% Customizing TPU-edt using the Emacs Initialization File
277
278;; .emacs - a sample emacs initialization file
279
280;; This is a sample emacs initialization file. It shows how to invoke
281;; TPU-edt, and how to customize it.
282
283;; The load-path is where emacs looks for files to fulfill load requests.
284;; If TPU-edt is not installed in a standard emacs directory, the load-path
285;; should be updated to include the directory where the TPU-edt files are
286;; stored. Modify and un-comment the following section if TPU-ed is not
287;; installed on your system - be sure to leave the double quotes!
288
289;; (setq load-path
290;; (append (list (expand-file-name "/path/to/tpu-edt/files"))
291;; load-path))
292
293;; Load TPU-edt
294(load "tpu-edt")
295
296;; Load the optional goodies - scroll margins, free cursor mode, command
297;; and string recall. But don't complain if the file aren't available.
298(load "tpu-extras" t)
299(load "tpu-recall" t)
300
301;; Uncomment this line to set scroll margins 10% (top) and 15% (bottom).
302;(tpu-set-scroll-margins "10%" "15%")
303
304;; Load the vtxxx terminal control functions, but don't complain if
305;; if the file is not found.
306(load "vt-control" t)
307
308;; TPU-edt treats words like EDT; here's how to add word separators.
309;; Note that backslash (\) and double quote (") are quoted with '\'.
310(tpu-add-word-separators "]\\[-_,.\"=+()'/*#:!&;$")
311
312;; Emacs is happy to save files without a final newline; other Unix programs
313;; hate that! This line will make sure that files end with newlines.
314(setq require-final-newline t)
315
316;; Emacs has the ability to automatically run code embedded in files
317;; you edit. This line makes emacs ask if you want to run the code.
318(setq inhibit-local-variables t)
319
320;; Emacs uses Control-s and Control-q. Problems can occur when using emacs
321;; on terminals that use these codes for flow control (Xon/Xoff flow control).
322;; These lines disable emacs' use of these characters.
323(global-unset-key "\C-s")
324(global-unset-key "\C-q")
325
326;; top, bottom, bol, eol seem like a waste of Gold-arrow functions. The
327;; following section re-maps up and down arrow keys to top and bottom of
328;; screen, and left and right arrow keys to pan left and right (pan-left,
329;; right moves the screen 16 characters left or right - try it, you'll
330;; like it!).
331
332;; Re-map the Gold-arrow functions
333(define-key GOLD-CSI-map "A" 'tpu-beginning-of-window) ; up-arrow
334(define-key GOLD-CSI-map "B" 'tpu-end-of-window) ; down-arrow
335(define-key GOLD-CSI-map "C" 'tpu-pan-right) ; right-arrow
336(define-key GOLD-CSI-map "D" 'tpu-pan-left) ; left-arrow
337(define-key GOLD-SS3-map "A" 'tpu-beginning-of-window) ; up-arrow
338(define-key GOLD-SS3-map "B" 'tpu-end-of-window) ; down-arrow
339(define-key GOLD-SS3-map "C" 'tpu-pan-right) ; right-arrow
340(define-key GOLD-SS3-map "D" 'tpu-pan-left) ; left-arrow
341
342;; Re-map the Gold-arrow functions for X-windows TPU-edt (emacs version 19)
343(cond
344 ((and tpu-emacs19-p window-system)
345 (define-key GOLD-map [up] 'tpu-beginning-of-window) ; up-arrow
346 (define-key GOLD-map [down] 'tpu-end-of-window) ; down-arrow
347 (define-key GOLD-map [right] 'tpu-pan-right) ; right-arrow
348 (define-key GOLD-map [left] 'tpu-pan-left))) ; left-arrow
349
350;; The emacs universal-argument function is very useful for native emacs
351;; commands. This line maps universal-argument to Gold-PF1
352(define-key GOLD-SS3-map "P" 'universal-argument) ; Gold-PF1
353
354;; Make KP7 move by paragraphs, instead of pages.
355(define-key SS3-map "w" 'tpu-paragraph) ; KP7
356
357;; TPU-edt assumes you have the ispell spelling checker;
358;; Un-comment this line if you don't.
359;(setq tpu-have-spell nil)
360
361;; Display the TPU-edt version.
362(tpu-version)
363
364;; End of .emacs - a sample emacs initialization file
365
366;; After initialization with the .emacs file shown above, the editing
367;; keys have been re-mapped to look like this:
368
369;; _______________________ _______________________________
370;; | HELP | Do | | | | | |
371;; |KeyDefs| | | | | | |
372;; |_______|_______________| |_______|_______|_______|_______|
373;; _______________________ _______________________________
374;; | Find |Insert |Remove | | Gold | HELP |FndNxt | Del L |
375;; | | |Sto Tex| | U Arg |E-Help | Find |Undel L|
376;; |_______|_______|_______| |_______|_______|_______|_______|
377;; |Select |Pre Scr|Nex Scr| |Paragra| Sect |Append | Del W |
378;; | Reset |Pre Win|Nex Win| | Do | Fill |Replace|Undel W|
379;; |_______|_______|_______| |_______|_______|_______|_______|
380;; |Move up| |Forward|Reverse|Remove | Del C |
381;; |Tscreen| |Bottom | Top |Insert |Undel C|
382;; _______|_______|_______ |_______|_______|_______|_______|
383;; |Mov Lef|Mov Dow|Mov Rig| | Word | EOL | Char | |
384;; |PanLeft|Bscreen|PanRigh| |ChngCas|Del EOL|SpecIns| Enter |
385;; |_______|_______|_______| |_______|_______|_______| |
386;; | Line |Select | Subs |
387;; | Open Line | Reset | |
388;; |_______________|_______|_______|
389
390;; Astute emacs hackers will realize that on systems where TPU-edt is
391;; installed, this documentation file can be loaded to produce the above
392;; editing keypad layout. In fact, to get all the changes in the sample
393;; initialization file, you only need a one line initialization file:
394
395;; (load "tpu-doc")
396
397;; wow!
398
399
400;; %% Compiling TPU-edt
401
402;; It is not necessary to compile (byte-compile in emacs parlance)
403;; TPU-edt to use it. However, byte-compiled code loads and runs
404;; faster, and takes up less memory when loaded. To byte compile
405;; TPU-edt, use the following command.
406
407;; emacs -batch -f batch-byte-compile tpu-edt.el
408
409;; This will produce a file named tpu-edt.elc. This new file can be
410;; used in place of the original tpu-edt.el file. In commands where
411;; the file type is not specified, emacs always attempts to use the
412;; byte-compiled version before resorting to the source.
413
414
415;; %% Regular expressions in TPU-edt
416
417;; Gold-* toggles TPU-edt regular expression mode. In regular expression
418;; mode, find, find next, replace, and substitute accept emacs regular
419;; expressions. A complete list of emacs regular expressions can be
420;; found using the emacs "info" command (it's somewhat like the VMS help
421;; command). Try the following sequence of commands:
422
423;; DO info <enter info mode>
424;; m regex <select the "regular expression" topic>
425;; m directives <select the "directives" topic>
426
427;; Type "q" to quit out of info mode.
428
429;; There is a problem in regular expression mode when searching for
430;; empty strings, like beginning-of-line (^) and end-of-line ($).
431;; When searching for these strings, find-next may find the current
432;; string, instead of the next one. This can cause global replace and
433;; substitute commands to loop forever in the same location. For this
434;; reason, commands like
435
436;; replace "^" "> " <add "> " to beginning of line>
437;; replace "$" "00711" <add "00711" to end of line>
438
439;; may not work properly.
440
441;; Commands like those above are very useful for adding text to the
442;; beginning or end of lines. They might work on a line-by-line basis,
443;; but go into an infinite loop if the "all" response is specified. If
444;; the goal is to add a string to the beginning or end of a particular
445;; set of lines TPU-edt provides functions to do this.
446
447;; Gold-^ Add a string at BOL in region or buffer
448;; Gold-$ Add a string at EOL in region or buffer
449
450;; There is also a TPU-edt interface to the native emacs string
451;; replacement commands. Gold-/ invokes this command. It accepts
452;; regular expressions if TPU-edt is in regular expression mode. Given
453;; a repeat count, it will perform the replacement without prompting
454;; for confirmation.
455
456;; This command replaces empty strings correctly, however, it has its
457;; drawbacks. As a native emacs command, it has a different interface
458;; than the emulated TPU commands. Also, it works only in the forward
459;; direction, regardless of the current TPU-edt direction.
460
461
462;; %% Etcetera
463
464;; That's TPU-edt in a nutshell...
465
466;; Please send any bug reports, feature requests, or cookies to the
467;; author, Rob Riepel, at the address shown by the tpu-version command
468;; (Gold-V).
469
470;; Share and enjoy... Rob Riepel 7/93
471
472;;; tpu-doc.el ends here
diff --git a/lisp/vt-control.el b/lisp/vt-control.el
new file mode 100644
index 00000000000..02fe11b700d
--- /dev/null
+++ b/lisp/vt-control.el
@@ -0,0 +1,114 @@
1;;; vt-control.el --- Common VTxxx control functions
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;; Keywords: vt100
8
9;; GNU Emacs is distributed in the hope that it will be useful,
10;; but WITHOUT ANY WARRANTY. No author or distributor
11;; accepts responsibility to anyone for the consequences of using it
12;; or for whether it serves any particular purpose or works at all,
13;; unless he says so in writing. Refer to the GNU Emacs General Public
14;; License for full details.
15
16;; Everyone is granted permission to copy, modify and redistribute
17;; GNU Emacs, but only under the conditions described in the
18;; GNU Emacs General Public License. A copy of this license is
19;; supposed to have been given to you along with GNU Emacs so you
20;; can know your rights and responsibilities. It should be in a
21;; file named COPYING. Among other things, the copyright notice
22;; and this notice must be preserved on all copies.
23;;
24
25;;; Revision: $Id: vt-control.el,v 2.2 1993/08/01 21:47:43 riepel Exp $
26
27;;; Commentary:
28
29;; The functions contained in this file send various VT control codes
30;; to the terminal where emacs is running. The following functions are
31;; available.
32
33;; Function Action
34
35;; vt-wide set wide screen (132 characters)
36;; vt-narrow set narrow screen (80 characters)
37;; vt-toggle-screen toggle wide/narrow screen
38;; vt-keypad-on set applications keypad on
39;; vt-keypad-off set applications keypad off
40;; vt-numlock toggle applications keypad on/off
41
42;;; Usage:
43
44;; To use enable these functions, simply load this file.
45
46;; Note: vt-control makes no effort to determine how the terminal is
47;; initially set. It assumes the terminal starts with a width
48;; of 80 characters and the applications keypad enabled. Nor
49;; does vt-control try to restore the terminal when emacs is
50;; killed or suspended.
51
52;;; Code:
53
54
55;;; Revision Information
56
57(defconst vt-revision "$Revision: 2.2 $"
58 "Revision number of vt-control.")
59
60
61;;; Global variables
62
63(defvar vt-applications-keypad-p t
64 "If non-nil, keypad is in applications mode.")
65
66(defvar vt-wide-p nil
67 "If non-nil, the screen is 132 characters wide.")
68
69
70;;; Screen width functions.
71
72(defun vt-wide nil
73 "Set the screen 132 characters wide."
74 (interactive)
75 (send-string-to-terminal "\e[?3h")
76 (set-screen-width 132)
77 (setq vt-wide-p t))
78
79(defun vt-narrow nil
80 "Set the screen 80 characters wide."
81 (interactive)
82 (send-string-to-terminal "\e[?3l")
83 (set-screen-width 80)
84 (setq vt-wide-p nil))
85
86(defun vt-toggle-screen nil
87 "Toggle between 80 and 132 character screen width."
88 (interactive)
89 (if vt-wide-p (vt-narrow) (vt-wide)))
90
91
92;;; Applications keypad functions.
93
94(defun vt-keypad-on (&optional tell)
95 "Turn on the VT applications keypad."
96 (interactive)
97 (send-string-to-terminal "\e[\e=")
98 (setq vt-applications-keypad-p t)
99 (if (or tell (interactive-p)) (message "Applications keypad enabled.")))
100
101(defun vt-keypad-off (&optional tell)
102 "Turn off the VT applications keypad."
103 (interactive "p")
104 (send-string-to-terminal "\e[\e>")
105 (setq vt-applications-keypad-p nil)
106 (if (or tell (interactive-p)) (message "Applications keypad disabled.")))
107
108(defun vt-numlock nil
109 "Toggle VT application keypad on and off."
110 (interactive)
111 (if vt-applications-keypad-p (vt-keypad-off (interactive-p))
112 (vt-keypad-on (interactive-p))))
113
114;;; vt-control.el ends here
generated by cgit v1.2.1 (git 2.18.0) at 2026-01-27 00:12:07 +0000