1 ;;; tpu-edt.el --- Emacs emulating TPU emulating EDT
3 ;; Copyright (C) 1993 Free Software Foundation, Inc.
5 ;; Author: Rob Riepel <riepel@networking.stanford.edu>
6 ;; Maintainer: Rob Riepel <riepel@networking.stanford.edu>
8 ;; Keywords: emulations
10 ;; This file is part of GNU Emacs.
12 ;; GNU Emacs is free software; you can redistribute it and/or modify
13 ;; it under the terms of the GNU General Public License as published by
14 ;; the Free Software Foundation; either version 2, or (at your option)
17 ;; GNU Emacs is distributed in the hope that it will be useful,
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;; GNU General Public License for more details.
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with GNU Emacs; see the file COPYING. If not, write to
24 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
30 ;;; Revision and Version Information
32 (defconst tpu-version "3.2" "TPU-edt version number.")
36 ;;; User Configurable Variables
38 (defconst tpu-have-ispell t
39 "*If non-nil (default), TPU-edt uses ispell for spell checking.")
41 (defconst tpu-kill-buffers-silently nil
42 "*If non-nil, TPU-edt kills modified buffers without asking.")
44 (defvar tpu-percent-scroll 75
45 "*Percentage of the screen to scroll for next/previous screen commands.")
47 (defvar tpu-pan-columns 16
48 "*Number of columns the tpu-pan functions scroll left or right.")
52 ;;; Emacs version identifiers - currently referenced by
54 ;;; o tpu-mark o tpu-set-mark
55 ;;; o tpu-string-prompt o tpu-regexp-prompt
56 ;;; o tpu-edt-on o tpu-load-xkeys
57 ;;; o tpu-update-mode-line o mode line section
59 (defconst tpu-emacs19-p (not (string-lessp emacs-version "19"))
60 "Non-NIL if we are running Lucid or GNU Emacs version 19.")
62 (defconst tpu-gnu-emacs18-p (not tpu-emacs19-p)
63 "Non-NIL if we are running GNU Emacs version 18.")
65 (defconst tpu-lucid-emacs19-p
66 (and tpu-emacs19-p (string-match "Lucid" emacs-version))
67 "Non-NIL if we are running Lucid Emacs version 19.")
69 (defconst tpu-gnu-emacs19-p (and tpu-emacs19-p (not tpu-lucid-emacs19-p))
70 "Non-NIL if we are running GNU Emacs version 19.")
76 (defvar CSI-map (make-sparse-keymap)
77 "Maps the CSI function keys on the VT100 keyboard.
78 CSI is DEC's name for the sequence <ESC>[.")
80 (defvar SS3-map (make-sparse-keymap)
81 "Maps the SS3 function keys on the VT100 keyboard.
82 SS3 is DEC's name for the sequence <ESC>O.")
84 (defvar GOLD-map (make-keymap)
85 "Maps the function keys on the VT100 keyboard preceeded by PF1.
86 GOLD is the ASCII 7-bit escape sequence <ESC>OP.")
88 (defvar GOLD-CSI-map (make-sparse-keymap)
89 "Maps the function keys on the VT100 keyboard preceeded by GOLD-CSI.")
91 (defvar GOLD-SS3-map (make-sparse-keymap)
92 "Maps the function keys on the VT100 keyboard preceeded by GOLD-SS3.")
94 (defvar tpu-global-map nil "TPU-edt global keymap.")
95 (defvar tpu-original-global-map (copy-keymap global-map)
96 "Original global keymap.")
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."))
106 (defvar tpu-edt-mode nil
107 "If non-nil, TPU-edt mode is active.")
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.")
120 (defvar tpu-searching-forward t
121 "If non-nil, TPU-edt is searching in the forward direction.")
122 (defvar tpu-search-last-string ""
123 "Last text searched for by the TPU-edt search commands.")
125 (defvar tpu-regexp-p nil
126 "If non-nil, TPU-edt uses regexp search and replace routines.")
127 (defvar tpu-rectangular-p nil
128 "If non-nil, TPU-edt removes and inserts rectangles.")
129 (defvar tpu-advance t
130 "True when TPU-edt is operating in the forward direction.")
131 (defvar tpu-reverse nil
132 "True when TPU-edt is operating in the backward direction.")
133 (defvar tpu-control-keys t
134 "If non-nil, control keys are set to perform TPU functions.")
135 (defvar tpu-xkeys-file nil
136 "File containing TPU-edt X key map.")
138 (defvar tpu-rectangle-string nil
139 "Mode line string to identify rectangular mode.")
140 (defvar tpu-direction-string nil
141 "Mode line string to identify current direction.")
143 (defvar tpu-add-at-bol-hist nil
144 "History variable for tpu-edt-add-at-bol function.")
145 (defvar tpu-add-at-eol-hist nil
146 "History variable for tpu-edt-add-at-eol function.")
147 (defvar tpu-regexp-prompt-hist nil
148 "History variable for search and replace functions.")
152 ;;; Buffer Local Variables
154 (defvar tpu-newline-and-indent-p nil
155 "If non-nil, Return produces a newline and indents.")
156 (make-variable-buffer-local 'tpu-newline-and-indent-p)
158 (defvar tpu-newline-and-indent-string nil
159 "Mode line string to identify AutoIndent mode.")
160 (make-variable-buffer-local 'tpu-newline-and-indent-string)
162 (defvar tpu-saved-delete-func nil
163 "Saved value of the delete key.")
164 (make-variable-buffer-local 'tpu-saved-delete-func)
166 (defvar tpu-buffer-local-map nil
167 "TPU-edt buffer local key map.")
168 (make-variable-buffer-local 'tpu-buffer-local-map)
172 ;;; Mode Line - Modify the mode line to show the following
174 ;;; o If the mark is set.
175 ;;; o Direction of motion.
176 ;;; o Active rectangle mode.
178 (defvar tpu-original-mode-line mode-line-format)
179 (defvar tpu-original-mm-alist minor-mode-alist)
181 (defvar tpu-mark-flag " ")
182 (make-variable-buffer-local 'tpu-mark-flag)
184 (defun tpu-set-mode-line (for-tpu)
185 "Set the mode for TPU-edt, or reset it to default Emacs."
187 (setq mode-line-format tpu-original-mode-line)
188 (setq minor-mode-alist tpu-original-mm-alist))
190 (setq-default mode-line-format
193 'mode-line-buffer-identification
199 'mode-name 'mode-line-process 'minor-mode-alist "%n"
201 (purecopy '(-3 . "%p"))
203 (or (assq 'tpu-newline-and-indent-p minor-mode-alist)
204 (setq minor-mode-alist
205 (cons '(tpu-newline-and-indent-p
206 tpu-newline-and-indent-string)
208 (or (assq 'tpu-rectangular-p minor-mode-alist)
209 (setq minor-mode-alist
210 (cons '(tpu-rectangular-p tpu-rectangle-string)
212 (or (assq 'tpu-direction-string minor-mode-alist)
213 (setq minor-mode-alist
214 (cons '(tpu-direction-string tpu-direction-string)
215 minor-mode-alist))))))
217 (defun tpu-update-mode-line nil
218 "Make sure mode-line in the current buffer reflects all changes."
219 (setq tpu-mark-flag (if (tpu-mark) "M" " "))
220 (cond (tpu-emacs19-p (force-mode-line-update))
221 (t (set-buffer-modified-p (buffer-modified-p)) (sit-for 0))))
223 (cond (tpu-gnu-emacs19-p
224 (add-hook 'activate-mark-hook 'tpu-update-mode-line)
225 (add-hook 'deactivate-mark-hook 'tpu-update-mode-line))
227 (add-hook 'zmacs-deactivate-region-hook 'tpu-update-mode-line)
228 (add-hook 'zmacs-activate-region-hook 'tpu-update-mode-line)))
236 ;;; Used in: Replace, Substitute, Store-Text, Cut/Remove,
237 ;;; Append, and Change-Case
239 (defvar tpu-match-beginning-mark (make-marker))
240 (defvar tpu-match-end-mark (make-marker))
242 (defun tpu-set-match nil
243 "Set markers at match beginning and end."
244 ;; Add one to beginning mark so it stays with the first character of
245 ;; the string even if characters are added just before the string.
246 (setq tpu-match-beginning-mark (copy-marker (1+ (match-beginning 0))))
247 (setq tpu-match-end-mark (copy-marker (match-end 0))))
249 (defun tpu-unset-match nil
250 "Unset match beginning and end markers."
251 (set-marker tpu-match-beginning-mark nil)
252 (set-marker tpu-match-end-mark nil))
254 (defun tpu-match-beginning nil
255 "Returns the location of the last match beginning."
256 (1- (marker-position tpu-match-beginning-mark)))
258 (defun tpu-match-end nil
259 "Returns the location of the last match end."
260 (marker-position tpu-match-end-mark))
262 (defun tpu-check-match nil
263 "Returns t if point is between tpu-match markers.
264 Otherwise sets the tpu-match markers to nil and returns nil."
265 ;; make sure 1- marker is in this buffer
266 ;; 2- point is at or after beginning marker
267 ;; 3- point is before ending marker, or in the case of
268 ;; zero length regions (like bol, or eol) that the
269 ;; beginning, end, and point are equal.
271 (equal (marker-buffer tpu-match-beginning-mark) (current-buffer))
272 (>= (point) (1- (marker-position tpu-match-beginning-mark)))
274 (< (point) (marker-position tpu-match-end-mark))
275 (and (= (1- (marker-position tpu-match-beginning-mark))
276 (marker-position tpu-match-end-mark))
277 (= (marker-position tpu-match-end-mark) (point))))) t)
279 (tpu-unset-match) nil)))
281 (defun tpu-show-match-markers nil
282 "Show the values of the match markers."
284 (if (markerp tpu-match-beginning-mark)
285 (let ((beg (marker-position tpu-match-beginning-mark)))
286 (message "(%s, %s) in %s -- current %s in %s"
287 (if beg (1- beg) nil)
288 (marker-position tpu-match-end-mark)
289 (marker-buffer tpu-match-end-mark)
290 (point) (current-buffer)))))
296 (defun tpu-caar (thingy) (car (car thingy)))
297 (defun tpu-cadr (thingy) (car (cdr thingy)))
300 "TPU-edt version of the mark function.
301 Return the appropriate value of the mark for the current
303 (cond (tpu-lucid-emacs19-p (mark (not zmacs-regions)))
304 (tpu-gnu-emacs19-p (and mark-active (mark (not transient-mark-mode))))
307 (defun tpu-set-mark (pos)
308 "TPU-edt verion of the set-mark function.
309 Sets the mark at POS and activates the region acording to the
310 current version of emacs."
312 (and tpu-lucid-emacs19-p pos (zmacs-activate-region)))
314 (defun tpu-string-prompt (prompt history-symbol)
315 "Read a string with PROMPT."
317 (read-from-minibuffer prompt nil nil nil history-symbol)
318 (read-string prompt)))
320 (defvar tpu-last-answer nil "Most recent response to tpu-y-or-n-p.")
322 (defun tpu-y-or-n-p (prompt &optional not-yes)
323 "Prompt for a y or n answer with positive default.
324 Optional second argument NOT-YES changes default to negative.
325 Like emacs y-or-n-p, also accepts space as y and DEL as n."
326 (message (format "%s[%s]" prompt (if not-yes "n" "y")))
330 (let ((ans (read-char)))
331 (cond ((or (= ans ?y) (= ans ?Y) (= ans ?\ ))
332 (setq tpu-last-answer t))
333 ((or (= ans ?n) (= ans ?N) (= ans ?\C-?))
334 (setq tpu-last-answer nil))
335 ((= ans ?\r) (setq tpu-last-answer (not not-yes)))
338 (message (format "Please answer y or n. %s[%s]"
339 prompt (if not-yes "n" "y"))))))))
342 (defun tpu-local-set-key (key func)
343 "Replace a key in the TPU-edt local key map.
344 Create the key map if necessary."
345 (cond ((not (keymapp tpu-buffer-local-map))
346 (setq tpu-buffer-local-map (if (current-local-map)
347 (copy-keymap (current-local-map))
348 (make-sparse-keymap)))
349 (use-local-map tpu-buffer-local-map)))
350 (local-set-key key func))
352 (defun tpu-current-line nil
353 "Return the vertical position of point in the selected window.
354 Top line is 0. Counts each text line only once, even if it wraps."
355 (+ (count-lines (window-start) (point)) (if (= (current-column) 0) 1 0) -1))
361 (defvar tpu-breadcrumb-plist nil
362 "The set of user-defined markers (breadcrumbs), as a plist.")
364 (defun tpu-drop-breadcrumb (num)
365 "Drops a breadcrumb that can be returned to later with goto-breadcrumb."
367 (put tpu-breadcrumb-plist num (list (current-buffer) (point)))
368 (message "Mark %d set." num))
370 (defun tpu-goto-breadcrumb (num)
371 "Returns to a breadcrumb set with drop-breadcrumb."
373 (cond ((get tpu-breadcrumb-plist num)
374 (switch-to-buffer (car (get tpu-breadcrumb-plist num)))
375 (goto-char (tpu-cadr (get tpu-breadcrumb-plist num)))
376 (message "mark %d found." num))
378 (message "mark %d not found." num))))
384 (defun tpu-change-case (num)
385 "Change the case of the character under the cursor or region.
386 Accepts a prefix argument of the number of characters to invert."
389 (let ((beg (region-beginning)) (end (region-end)))
391 (funcall (if (= (downcase (char-after beg)) (char-after beg))
392 'upcase-region 'downcase-region)
397 (let ((beg (tpu-match-beginning)) (end (tpu-match-end)))
399 (funcall (if (= (downcase (char-after beg)) (char-after beg))
400 'upcase-region 'downcase-region)
406 (funcall (if (= (downcase (following-char)) (following-char))
407 'upcase-region 'downcase-region)
408 (point) (1+ (point)))
409 (forward-char (if tpu-reverse -1 1))
410 (setq num (1- num))))))
412 (defun tpu-fill (num)
413 "Fill paragraph or marked region.
414 With argument, fill and justify."
417 (fill-region (point) (tpu-mark) num)
420 (fill-paragraph num))))
422 (defun tpu-version nil
423 "Print the TPU-edt version number."
426 "TPU-edt version %s by Rob Riepel (riepel@networking.stanford.edu)"
429 (defun tpu-reset-screen-size (height width)
430 "Sets the screen size."
431 (interactive "nnew screen height: \nnnew screen width: ")
432 (set-screen-height height)
433 (set-screen-width width))
435 (defun tpu-toggle-newline-and-indent nil
436 "Toggle between 'newline and indent' and 'simple newline'."
438 (cond (tpu-newline-and-indent-p
439 (setq tpu-newline-and-indent-string "")
440 (setq tpu-newline-and-indent-p nil)
441 (tpu-local-set-key "\C-m" 'newline))
443 (setq tpu-newline-and-indent-string " AutoIndent")
444 (setq tpu-newline-and-indent-p t)
445 (tpu-local-set-key "\C-m" 'newline-and-indent)))
446 (tpu-update-mode-line)
448 (message "Carriage return inserts a newline%s"
449 (if tpu-newline-and-indent-p " and indents." "."))))
451 (defun tpu-spell-check nil
452 "Checks the spelling of the region, or of the entire buffer if no
455 (cond (tpu-have-ispell
456 (if (tpu-mark) (ispell-region (tpu-mark) (point)) (ispell-buffer)))
458 (if (tpu-mark) (spell-region (tpu-mark) (point)) (spell-buffer))))
459 (if (tpu-mark) (tpu-unselect t)))
461 (defun tpu-toggle-overwrite-mode nil
462 "Switches in and out of overwrite mode"
464 (cond (overwrite-mode
465 (tpu-local-set-key "\177" tpu-saved-delete-func)
468 (setq tpu-saved-delete-func (local-key-binding "\177"))
469 (tpu-local-set-key "\177" 'picture-backward-clear-column)
470 (overwrite-mode 1))))
472 (defun tpu-special-insert (num)
473 "Insert a character or control code according to
474 its ASCII decimal value."
476 (if overwrite-mode (delete-char 1))
477 (insert (if num num 0)))
479 (defun tpu-quoted-insert (num)
480 "Read next input character and insert it.
481 This is useful for inserting control characters."
483 (let ((char (read-char)) )
484 (if overwrite-mode (delete-char num))
485 (insert-char char num)))
489 ;;; TPU line-mode commands
491 (defun tpu-include (file)
492 "TPU-like include file"
493 (interactive "fInclude file: ")
498 (defun tpu-get (file)
500 (interactive "FFile to get: ")
503 (defun tpu-what-line nil
504 "Tells what line the point is on,
505 and the total number of lines in the buffer."
508 (message "You are at the End of Buffer. The last line is %d."
509 (count-lines 1 (point-max)))
510 (message "Line %d of %d"
511 (count-lines 1 (1+ (point)))
512 (count-lines 1 (point-max)))))
515 "Exit the way TPU does, save current buffer and ask about others."
517 (if (not (eq (recursion-depth) 0))
518 (exit-recursive-edit)
519 (progn (save-buffer) (save-buffers-kill-emacs))))
522 "Quit the way TPU does, ask to make sure changes should be abandoned."
524 (let ((list (buffer-list))
526 (while (and list working)
527 (let ((buffer (car list)))
528 (if (and (buffer-file-name buffer) (buffer-modified-p buffer))
530 "Modifications will not be saved, continue quitting? ")
531 (kill-emacs t) (setq working nil)))
532 (setq list (cdr list))))
533 (if working (kill-emacs t))))
537 ;;; Command and Function Aliases
540 (fset 'tpu-edt-mode 'tpu-edt-on)
541 (fset 'TPU-EDT-MODE 'tpu-edt-on)
544 (fset 'tpu-edt 'tpu-edt-on)
545 (fset 'TPU-EDT 'tpu-edt-on)
547 (fset 'exit 'tpu-exit)
548 (fset 'EXIT 'tpu-exit)
553 (fset 'include 'tpu-include)
554 (fset 'INCLUDE 'tpu-include)
556 (fset 'quit 'tpu-quit)
557 (fset 'QUIT 'tpu-quit)
559 (fset 'spell 'tpu-spell-check)
560 (fset 'SPELL 'tpu-spell-check)
562 (fset 'what\ line 'tpu-what-line)
563 (fset 'WHAT\ LINE 'tpu-what-line)
565 (fset 'replace 'tpu-lm-replace)
566 (fset 'REPLACE 'tpu-lm-replace)
568 (fset 'help 'tpu-help)
569 (fset 'HELP 'tpu-help)
571 (fset 'set\ cursor\ free 'tpu-set-cursor-free)
572 (fset 'SET\ CURSOR\ FREE 'tpu-set-cursor-free)
574 (fset 'set\ cursor\ bound 'tpu-set-cursor-bound)
575 (fset 'SET\ CURSOR\ BOUND 'tpu-set-cursor-bound)
577 (fset 'set\ scroll\ margins 'tpu-set-scroll-margins)
578 (fset 'SET\ SCROLL\ MARGINS 'tpu-set-scroll-margins)
581 ;; Around emacs version 18.57, function line-move was renamed to
582 ;; next-line-internal. If we're running under an older emacs,
583 ;; make next-line-internal equivalent to line-move.
585 (if (not (fboundp 'next-line-internal)) (fset 'next-line-internal 'line-move))
591 (defconst tpu-help-keypad-map "\f
592 _______________________ _______________________________
593 | HELP | Do | | | | | |
594 |KeyDefs| | | | | | |
595 |_______|_______________| |_______|_______|_______|_______|
596 _______________________ _______________________________
597 | Find |Insert |Remove | | Gold | HELP |FndNxt | Del L |
598 | | |Sto Tex| | key |E-Help | Find |Undel L|
599 |_______|_______|_______| |_______|_______|_______|_______|
600 |Select |Pre Scr|Nex Scr| | Page | Sect |Append | Del W |
601 | Reset |Pre Win|Nex Win| | Do | Fill |Replace|Undel W|
602 |_______|_______|_______| |_______|_______|_______|_______|
603 |Move up| |Forward|Reverse|Remove | Del C |
604 | Top | |Bottom | Top |Insert |Undel C|
605 _______|_______|_______ |_______|_______|_______|_______|
606 |Mov Lef|Mov Dow|Mov Rig| | Word | EOL | Char | |
607 |StaOfLi|Bottom |EndOfLi| |ChngCas|Del EOL|SpecIns| Enter |
608 |_______|_______|_______| |_______|_______|_______| |
609 | Line |Select | Subs |
610 | Open Line | Reset | |
611 |_______________|_______|_______|
614 (defconst tpu-help-text "
615 \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
619 ^A toggle insert and overwrite
623 ^G Cancel current operation
625 ^J delete previous word
629 ^R remember (during learn), re-center
631 ^U delete to beginning of line
636 ^X^X exchange point and mark - useful for checking region boundaries
638 \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
641 B Next Buffer - display the next buffer (all buffers)
642 C Recall - edit and possibly repeat previous commands
643 E Exit - save current buffer and ask about others
645 G Get - load a file into a new edit buffer
646 I Include - include a file in this buffer
647 K Kill Buffer - abandon edits and delete buffer
649 M Buffer Menu - display a list of all buffers
650 N Next File Buffer - display next buffer containing a file
651 O Occur - show following lines containing REGEXP
653 Q Quit - exit without saving anything
654 R Toggle rectangular mode for remove and insert
655 S Search and substitute - line mode REPLACE command
657 U Undo - undo the last edit
658 W Write - save current buffer
659 X Exit - save all modified buffers and exit
661 \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
663 *** No more help, use P to view previous screen")
665 (defvar tpu-help-enter (format "%s" "\eOM")) ; tpu-help enter key symbol
666 (defvar tpu-help-return (format "%s" "\r")) ; tpu-help enter key symbol
667 (defvar tpu-help-N "N") ; tpu-help "N" symbol
668 (defvar tpu-help-n "n") ; tpu-help "n" symbol
669 (defvar tpu-help-P "P") ; tpu-help "P" symbol
670 (defvar tpu-help-p "p") ; tpu-help "p" symbol
673 "Display TPU-edt help."
675 ;; Save current window configuration
676 (save-window-excursion
677 ;; Create and fill help buffer if necessary
678 (if (not (get-buffer "*TPU-edt Help*"))
679 (progn (generate-new-buffer "*TPU-edt Help*")
680 (switch-to-buffer "*TPU-edt Help*")
681 (insert tpu-help-keypad-map)
682 (insert tpu-help-text)
683 (setq buffer-read-only t)))
685 ;; Display the help buffer
686 (switch-to-buffer "*TPU-edt Help*")
687 (delete-other-windows)
688 (tpu-move-to-beginning)
690 (tpu-line-to-top-of-window)
692 ;; Prompt for keys to describe, based on screen state (split/not split)
693 (let ((key nil) (fkey nil) (split nil))
694 (while (not (equal tpu-help-return fkey))
698 "Press the key you want help on (RET=exit, ENTER=redisplay, N=next, P=prev): "))
701 "Press the key you want help on (RET to exit, N next screen, P prev screen): ")))
703 ;; Process the read key
705 ;; ENTER - Display just the help window
706 ;; N or n - Next help or describe-key screen
707 ;; P or p - Previous help or describe-key screen
708 ;; RETURN - Exit from TPU-help
709 ;; default - describe the key
711 (setq fkey (format "%s" key))
712 (cond ((equal tpu-help-enter fkey)
714 (delete-other-windows))
715 ((or (equal tpu-help-N fkey) (equal tpu-help-n fkey))
718 (scroll-other-window 8)
723 (tpu-line-to-top-of-window))))
724 ((or (equal tpu-help-P fkey) (equal tpu-help-p fkey))
727 (scroll-other-window -8)
732 (tpu-line-to-top-of-window))))
733 ((not (equal tpu-help-return fkey))
736 ;; If the key is undefined, leave the
737 ;; message in the mini-buffer for 3 seconds
738 (if (not (key-binding key)) (sit-for 3))))))))
744 (defun tpu-insert-escape nil
745 "Inserts an escape character, and so becomes the escape-key alias."
749 (defun tpu-insert-formfeed nil
750 "Inserts a formfeed character."
758 (defvar tpu-saved-control-r nil "Saved value of Control-r.")
760 (defun tpu-end-define-macro-key (key)
761 "Ends the current macro definition"
762 (interactive "kPress the key you want to use to do what was just learned: ")
764 (global-set-key key last-kbd-macro)
765 (global-set-key "\C-r" tpu-saved-control-r))
767 (defun tpu-define-macro-key nil
768 "Bind a set of keystrokes to a single key, or key combination."
770 (setq tpu-saved-control-r (global-key-binding "\C-r"))
771 (global-set-key "\C-r" 'tpu-end-define-macro-key)
772 (start-kbd-macro nil))
776 ;;; Buffers and Windows
778 (defun tpu-kill-buffer nil
779 "Kills the current buffer. If tpu-kill-buffers-silently is non-nil,
780 kills modified buffers without asking."
782 (if tpu-kill-buffers-silently (set-buffer-modified-p nil))
783 (kill-buffer (current-buffer)))
785 (defun tpu-save-all-buffers-kill-emacs nil
786 "Save all buffers and exit emacs."
788 (setq trim-versions-without-asking t)
789 (save-buffers-kill-emacs t))
791 (defun tpu-write-current-buffers nil
792 "Save all modified buffers without exiting."
794 (save-some-buffers t))
796 (defun tpu-next-buffer nil
797 "Go to next buffer in ring."
799 (switch-to-buffer (car (reverse (buffer-list)))))
801 (defun tpu-next-file-buffer nil
802 "Go to next buffer in ring that is visiting a file."
804 (let ((starting-buffer (buffer-name)))
805 (switch-to-buffer (car (reverse (buffer-list))))
806 (while (and (not (equal (buffer-name) starting-buffer))
807 (not (buffer-file-name)))
808 (switch-to-buffer (car (reverse (buffer-list)))))
809 (if (equal (buffer-name) starting-buffer) (error "No other buffers."))))
811 (defun tpu-next-window nil
812 "Move to the next window."
814 (if (one-window-p) (message "There is only one window on screen.")
817 (defun tpu-previous-window nil
818 "Move to the previous window."
820 (if (one-window-p) (message "There is only one window on screen.")
821 (select-window (previous-window))))
827 (defun tpu-toggle-regexp nil
828 "Switches in and out of regular expression search and replace mode."
830 (setq tpu-regexp-p (not tpu-regexp-p))
833 (message "Regular expression search and substitute %sabled."
834 (if tpu-regexp-p "en" "dis"))))
836 (defun tpu-regexp-prompt (prompt)
837 "Read a string, adding 'RE' to the prompt if tpu-regexp-p is set."
838 (let ((re-prompt (concat (if tpu-regexp-p "RE ") prompt)))
840 (read-from-minibuffer re-prompt nil nil nil 'tpu-regexp-prompt-hist)
841 (read-string re-prompt))))
843 (defun tpu-search nil
844 "Search for a string or regular expression.
845 The search is performed in the current direction."
848 (tpu-search-internal ""))
850 (defun tpu-search-forward nil
851 "Search for a string or regular expression.
852 The search is begins in the forward direction."
854 (setq tpu-searching-forward t)
856 (tpu-search-internal ""))
858 (defun tpu-search-reverse nil
859 "Search for a string or regular expression.
860 The search is begins in the reverse direction."
862 (setq tpu-searching-forward nil)
864 (tpu-search-internal ""))
866 (defun tpu-search-again nil
867 "Search for the same string or regular expression as last time.
868 The search is performed in the current direction."
870 (tpu-search-internal tpu-search-last-string))
872 ;; tpu-set-search defines the search functions used by the TPU-edt internal
873 ;; search function. It should be called whenever the direction changes, or
874 ;; the regular expression mode is turned on or off. It can also be called
875 ;; to ensure that the next search will be in the current direction. It is
878 ;; tpu-advance tpu-backup
879 ;; tpu-toggle-regexp tpu-toggle-search-direction (t)
880 ;; tpu-search tpu-lm-replace
881 ;; tpu-search-forward (t) tpu-search-reverse (t)
883 (defun tpu-set-search (&optional arg)
884 "Set the search functions and set the search direction to the current
885 direction. If an argument is specified, don't set the search direction."
886 (if (not arg) (setq tpu-searching-forward (if tpu-advance t nil)))
887 (cond (tpu-searching-forward
889 (fset 'tpu-emacs-search 're-search-forward)
890 (fset 'tpu-emacs-rev-search 're-search-backward))
892 (fset 'tpu-emacs-search 'search-forward)
893 (fset 'tpu-emacs-rev-search 'search-backward))))
896 (fset 'tpu-emacs-search 're-search-backward)
897 (fset 'tpu-emacs-rev-search 're-search-forward))
899 (fset 'tpu-emacs-search 'search-backward)
900 (fset 'tpu-emacs-rev-search 'search-forward))))))
902 (defun tpu-search-internal (pat &optional quiet)
903 "Search for a string or regular expression."
904 (setq tpu-search-last-string
905 (if (not (string= "" pat)) pat (tpu-regexp-prompt "Search: ")))
910 (cond ((tpu-emacs-search tpu-search-last-string nil t)
911 (tpu-set-match) (goto-char (tpu-match-beginning)))
914 (tpu-adjust-search t)
915 (let ((found nil) (pos nil))
917 (let ((tpu-searching-forward (not tpu-searching-forward)))
919 (setq found (tpu-emacs-rev-search tpu-search-last-string nil t))
920 (setq pos (match-beginning 0))))
924 (format "Found in %s direction. Go there? "
925 (if tpu-searching-forward "reverse" "forward")))
926 (goto-char pos) (tpu-set-match)
927 (tpu-toggle-search-direction))))
932 "%sSearch failed: \"%s\""
933 (if tpu-regexp-p "RE " "") tpu-search-last-string))))))))
935 (fset 'tpu-search-internal-core (symbol-function 'tpu-search-internal))
937 (defun tpu-adjust-search (&optional arg)
938 "For forward searches, move forward a character before searching,
939 and backward a character after a failed search. Arg means end of search."
940 (if tpu-searching-forward
941 (cond (arg (if (not (bobp)) (forward-char -1)))
942 (t (if (not (eobp)) (forward-char 1))))))
944 (defun tpu-toggle-search-direction nil
945 "Toggle the TPU-edt search direction.
946 Used for reversing a search in progress."
948 (setq tpu-searching-forward (not tpu-searching-forward))
951 (message "Searching %sward."
952 (if tpu-searching-forward "for" "back"))))
956 ;;; Select / Unselect
958 (defun tpu-select (&optional quiet)
959 "Sets the mark to define one end of a region."
962 (tpu-unselect quiet))
964 (tpu-set-mark (point))
965 (tpu-update-mode-line)
966 (if (not quiet) (message "Move the text cursor to select text.")))))
968 (defun tpu-unselect (&optional quiet)
969 "Removes the mark to unselect the current region."
973 (tpu-update-mode-line)
974 (if (not quiet) (message "Selection canceled.")))
980 (defun tpu-toggle-rectangle nil
981 "Toggle rectangular mode for remove and insert."
983 (setq tpu-rectangular-p (not tpu-rectangular-p))
984 (setq tpu-rectangle-string (if tpu-rectangular-p " Rect" ""))
985 (tpu-update-mode-line)
987 (message "Rectangular cut and paste %sabled."
988 (if tpu-rectangular-p "en" "dis"))))
990 (defun tpu-arrange-rectangle nil
991 "Adjust point and mark to mark upper left and lower right
992 corners of a rectangle."
993 (let ((mc (current-column))
994 (pc (progn (exchange-point-and-mark) (current-column))))
996 (cond ((> (point) (tpu-mark)) ; point on lower line
997 (cond ((> pc mc) ; point @ lower-right
998 (exchange-point-and-mark)) ; point -> upper-left
1000 (t ; point @ lower-left
1001 (move-to-column-force mc) ; point -> lower-right
1002 (exchange-point-and-mark) ; point -> upper-right
1003 (move-to-column-force pc)))) ; point -> upper-left
1005 (t ; point on upper line
1006 (cond ((> pc mc) ; point @ upper-right
1007 (move-to-column-force mc) ; point -> upper-left
1008 (exchange-point-and-mark) ; point -> lower-left
1009 (move-to-column-force pc) ; point -> lower-right
1010 (exchange-point-and-mark))))))) ; point -> upper-left
1012 (defun tpu-cut-text nil
1013 "Delete the selected region.
1014 The text is saved for the tpu-paste command."
1017 (cond (tpu-rectangular-p
1018 (tpu-arrange-rectangle)
1019 (picture-clear-rectangle (point) (tpu-mark) (not overwrite-mode))
1022 (setq tpu-last-deleted-region
1023 (buffer-substring (tpu-mark) (point)))
1024 (delete-region (tpu-mark) (point))
1027 (let ((beg (tpu-match-beginning)) (end (tpu-match-end)))
1028 (setq tpu-last-deleted-region (buffer-substring beg end))
1029 (delete-region beg end)
1032 (error "No selection active."))))
1034 (defun tpu-store-text nil
1035 "Copy the selected region to the cut buffer without deleting it.
1036 The text is saved for the tpu-paste command."
1039 (cond (tpu-rectangular-p
1041 (tpu-arrange-rectangle)
1042 (setq picture-killed-rectangle
1043 (extract-rectangle (point) (tpu-mark))))
1046 (setq tpu-last-deleted-region
1047 (buffer-substring (tpu-mark) (point)))
1050 (setq tpu-last-deleted-region
1051 (buffer-substring (tpu-match-beginning) (tpu-match-end)))
1054 (error "No selection active."))))
1056 (defun tpu-cut (arg)
1057 "Copy selected region to the cut buffer. In the absence of an
1058 argument, delete the selected region too."
1060 (if arg (tpu-store-text) (tpu-cut-text)))
1062 (defun tpu-append-region (arg)
1063 "Append selected region to the tpu-cut buffer. In the absence of an
1064 argument, delete the selected region too."
1067 (let ((beg (region-beginning)) (end (region-end)))
1068 (setq tpu-last-deleted-region
1069 (concat tpu-last-deleted-region
1070 (buffer-substring beg end)))
1071 (if (not arg) (delete-region beg end))
1074 (let ((beg (tpu-match-beginning)) (end (tpu-match-end)))
1075 (setq tpu-last-deleted-region
1076 (concat tpu-last-deleted-region
1077 (buffer-substring beg end)))
1078 (if (not arg) (delete-region beg end))
1081 (error "No selection active."))))
1083 (defun tpu-delete-current-line (num)
1084 "Delete one or specified number of lines after point.
1085 This includes the newline character at the end of each line.
1086 They are saved for the TPU-edt undelete-lines command."
1088 (let ((beg (point)))
1090 (if (not (eq (preceding-char) ?\n))
1092 (setq tpu-last-deleted-lines
1093 (buffer-substring beg (point)))
1094 (delete-region beg (point))))
1096 (defun tpu-delete-to-eol (num)
1097 "Delete text up to end of line.
1098 With argument, delete up to to Nth line-end past point.
1099 They are saved for the TPU-edt undelete-lines command."
1101 (let ((beg (point)))
1104 (setq tpu-last-deleted-lines
1105 (buffer-substring beg (point)))
1106 (delete-region beg (point))))
1108 (defun tpu-delete-to-bol (num)
1109 "Delete text back to beginning of line.
1110 With argument, delete up to to Nth line-end past point.
1111 They are saved for the TPU-edt undelete-lines command."
1113 (let ((beg (point)))
1114 (tpu-next-beginning-of-line num)
1115 (setq tpu-last-deleted-lines
1116 (buffer-substring (point) beg))
1117 (delete-region (point) beg)))
1119 (defun tpu-delete-current-word (num)
1120 "Delete one or specified number of words after point.
1121 They are saved for the TPU-edt undelete-words command."
1123 (let ((beg (point)))
1124 (tpu-forward-to-word num)
1125 (setq tpu-last-deleted-words
1126 (buffer-substring beg (point)))
1127 (delete-region beg (point))))
1129 (defun tpu-delete-previous-word (num)
1130 "Delete one or specified number of words before point.
1131 They are saved for the TPU-edt undelete-words command."
1133 (let ((beg (point)))
1134 (tpu-backward-to-word num)
1135 (setq tpu-last-deleted-words
1136 (buffer-substring (point) beg))
1137 (delete-region beg (point))))
1139 (defun tpu-delete-current-char (num)
1140 "Delete one or specified number of characters after point. The last
1141 character deleted is saved for the TPU-edt undelete-char command."
1143 (while (and (> num 0) (not (eobp)))
1144 (setq tpu-last-deleted-char (char-after (point)))
1145 (cond (overwrite-mode
1146 (picture-clear-column 1)
1150 (setq num (1- num))))
1154 ;;; Undelete / Paste
1156 (defun tpu-paste (num)
1157 "Insert the last region or rectangle of killed text.
1158 With argument reinserts the text that many times."
1161 (cond (tpu-rectangular-p
1162 (let ((beg (point)))
1164 (picture-yank-rectangle (not overwrite-mode))
1168 (insert tpu-last-deleted-region)))
1169 (setq num (1- num))))
1171 (defun tpu-undelete-lines (num)
1172 "Insert lines deleted by last TPU-edt line-deletion command.
1173 With argument reinserts lines that many times."
1175 (let ((beg (point)))
1177 (insert tpu-last-deleted-lines)
1178 (setq num (1- num)))
1181 (defun tpu-undelete-words (num)
1182 "Insert words deleted by last TPU-edt word-deletion command.
1183 With argument reinserts words that many times."
1185 (let ((beg (point)))
1187 (insert tpu-last-deleted-words)
1188 (setq num (1- num)))
1191 (defun tpu-undelete-char (num)
1192 "Insert character deleted by last TPU-edt character-deletion command.
1193 With argument reinserts the character that many times."
1196 (if overwrite-mode (prog1 (forward-char -1) (delete-char 1)))
1197 (insert tpu-last-deleted-char)
1199 (setq num (1- num))))
1203 ;;; Replace and Substitute
1205 (defun tpu-replace nil
1206 "Replace the selected region with the contents of the cut buffer."
1209 (let ((beg (region-beginning)) (end (region-end)))
1210 (setq tpu-last-replaced-text (buffer-substring beg end))
1211 (delete-region beg end)
1212 (insert tpu-last-deleted-region)
1215 (let ((beg (tpu-match-beginning)) (end (tpu-match-end)))
1216 (setq tpu-last-replaced-text (buffer-substring beg end))
1217 (replace-match tpu-last-deleted-region
1218 (not case-replace) (not tpu-regexp-p))
1221 (error "No selection active."))))
1223 (defun tpu-substitute (num)
1224 "Replace the selected region with the contents of the cut buffer, and
1225 repeat most recent search. A numeric argument serves as a repeat count.
1226 A negative argument means replace all occurrences of the search string."
1228 (cond ((or (tpu-mark) (tpu-check-match))
1229 (while (and (not (= num 0)) (or (tpu-mark) (tpu-check-match)))
1230 (let ((beg (point)))
1232 (if tpu-searching-forward (forward-char -1) (goto-char beg))
1233 (if (= num 1) (tpu-search-internal tpu-search-last-string)
1234 (tpu-search-internal-core tpu-search-last-string)))
1235 (setq num (1- num))))
1237 (error "No selection active."))))
1239 (defun tpu-lm-replace (from to)
1240 "Interactively search for OLD-string and substitute NEW-string."
1241 (interactive (list (tpu-regexp-prompt "Old String: ")
1242 (tpu-regexp-prompt "New String: ")))
1244 (let ((doit t) (strings 0))
1246 ;; Can't replace null strings
1247 (if (string= "" from) (error "No string to replace."))
1249 ;; Find the first occurrence
1251 (tpu-search-internal from t)
1253 ;; Loop on replace question - yes, no, all, last, or quit.
1255 (if (not (tpu-check-match)) (setq doit nil)
1256 (progn (message "Replace? Type Yes, No, All, Last, or Quit: ")
1257 (let ((ans (read-char)))
1259 (cond ((or (= ans ?y) (= ans ?Y) (= ans ?\r) (= ans ?\ ))
1260 (let ((beg (point)))
1261 (replace-match to (not case-replace) (not tpu-regexp-p))
1262 (setq strings (1+ strings))
1263 (if tpu-searching-forward (forward-char -1) (goto-char beg)))
1264 (tpu-search-internal from t))
1266 ((or (= ans ?n) (= ans ?N) (= ans ?\C-?))
1267 (tpu-search-internal from t))
1269 ((or (= ans ?a) (= ans ?A))
1271 (let ((beg (point)))
1272 (replace-match to (not case-replace) (not tpu-regexp-p))
1273 (setq strings (1+ strings))
1274 (if tpu-searching-forward (forward-char -1) (goto-char beg)))
1275 (tpu-search-internal-core from t)
1276 (while (tpu-check-match)
1277 (let ((beg (point)))
1278 (replace-match to (not case-replace) (not tpu-regexp-p))
1279 (setq strings (1+ strings))
1280 (if tpu-searching-forward (forward-char -1) (goto-char beg)))
1281 (tpu-search-internal-core from t)))
1284 ((or (= ans ?l) (= ans ?L))
1285 (let ((beg (point)))
1286 (replace-match to (not case-replace) (not tpu-regexp-p))
1287 (setq strings (1+ strings))
1288 (if tpu-searching-forward (forward-char -1) (goto-char beg)))
1291 ((or (= ans ?q) (= ans ?Q))
1292 (setq doit nil)))))))
1294 (message "Replaced %s occurrence%s." strings
1295 (if (not (= 1 strings)) "s" ""))))
1297 (defun tpu-emacs-replace (&optional dont-ask)
1298 "A TPU-edt interface to the emacs replace functions. If TPU-edt is
1299 currently in regular expression mode, the emacs regular expression
1300 replace functions are used. If an argument is supplied, replacements
1301 are performed without asking. Only works in forward direction."
1304 (setq current-prefix-arg nil)
1306 (if tpu-regexp-p 'replace-regexp 'replace-string)))
1309 (if tpu-regexp-p 'query-replace-regexp 'query-replace)))))
1311 (defun tpu-add-at-bol (text)
1312 "Add text to the beginning of each line in a region,
1313 or each line in the entire buffer if no region is selected."
1315 (list (tpu-string-prompt "String to add: " 'tpu-add-at-bol-hist)))
1316 (if (string= "" text) (error "No string specified."))
1319 (if (> (point) (tpu-mark)) (exchange-point-and-mark))
1320 (while (and (< (point) (tpu-mark)) (re-search-forward "^" (tpu-mark) t))
1321 (if (< (point) (tpu-mark)) (replace-match text))))
1325 (goto-char (point-min))
1326 (while (and (re-search-forward "^" nil t) (not (eobp)))
1327 (replace-match text))))))
1329 (defun tpu-add-at-eol (text)
1330 "Add text to the end of each line in a region,
1331 or each line of the entire buffer if no region is selected."
1333 (list (tpu-string-prompt "String to add: " 'tpu-add-at-eol-hist)))
1334 (if (string= "" text) (error "No string specified."))
1337 (if (> (point) (tpu-mark)) (exchange-point-and-mark))
1338 (while (< (point) (tpu-mark))
1340 (if (<= (point) (tpu-mark)) (insert text))
1345 (goto-char (point-min))
1347 (end-of-line) (insert text) (forward-line))))))
1349 (defun tpu-trim-line-ends nil
1350 "Removes trailing whitespace from every line in the buffer."
1356 ;;; Movement by character
1358 (defun tpu-char (num)
1359 "Move to the next character in the current direction.
1360 A repeat count means move that many characters."
1362 (if tpu-advance (tpu-forward-char num) (tpu-backward-char num)))
1364 (defun tpu-forward-char (num)
1365 "Move right ARG characters (left if ARG is negative)."
1369 (defun tpu-backward-char (num)
1370 "Move left ARG characters (right if ARG is negative)."
1372 (backward-char num))
1376 ;;; Movement by word
1378 (defconst tpu-word-separator-list '()
1379 "List of additional word separators.")
1380 (defconst tpu-skip-chars "^ \t"
1381 "Characters to skip when moving by word.
1382 Additional word separators are added to this string.")
1384 (defun tpu-word (num)
1385 "Move to the beginning of the next word in the current direction.
1386 A repeat count means move that many words."
1388 (if tpu-advance (tpu-forward-to-word num) (tpu-backward-to-word num)))
1390 (defun tpu-forward-to-word (num)
1391 "Move forward until encountering the beginning of a word.
1392 With argument, do this that many times."
1394 (while (and (> num 0) (not (eobp)))
1395 (let* ((beg (point))
1396 (end (prog2 (end-of-line) (point) (goto-char beg))))
1399 ((memq (char-after (point)) tpu-word-separator-list)
1401 (skip-chars-forward " \t" end))
1403 (skip-chars-forward tpu-skip-chars end)
1404 (skip-chars-forward " \t" end))))
1405 (setq num (1- num))))
1407 (defun tpu-backward-to-word (num)
1408 "Move backward until encountering the beginning of a word.
1409 With argument, do this that many times."
1411 (while (and (> num 0) (not (bobp)))
1412 (let* ((beg (point))
1413 (end (prog2 (beginning-of-line) (point) (goto-char beg))))
1416 ((memq (char-after (1- (point))) tpu-word-separator-list)
1419 (skip-chars-backward " \t" end)
1420 (skip-chars-backward tpu-skip-chars end)
1421 (if (and (not (bolp)) (= ? (char-syntax (char-after (point)))))
1422 (forward-char -1)))))
1423 (setq num (1- num))))
1425 (defun tpu-add-word-separators (separators)
1426 "Add new word separators for TPU-edt word commands."
1427 (interactive "sSeparators: ")
1428 (let* ((n 0) (length (length separators)))
1430 (let ((char (aref separators n))
1431 (ss (substring separators n (1+ n))))
1432 (cond ((not (memq char tpu-word-separator-list))
1433 (setq tpu-word-separator-list
1434 (append ss tpu-word-separator-list))
1436 (setq tpu-skip-chars (concat tpu-skip-chars "\\-")))
1438 (setq tpu-skip-chars (concat tpu-skip-chars "\\\\")))
1440 (setq tpu-skip-chars (concat tpu-skip-chars "\\^")))
1442 (setq tpu-skip-chars (concat tpu-skip-chars ss))))))
1445 (defun tpu-reset-word-separators nil
1446 "Reset word separators to default value."
1448 (setq tpu-word-separator-list nil)
1449 (setq tpu-skip-chars "^ \t"))
1451 (defun tpu-set-word-separators (separators)
1452 "Set new word separators for TPU-edt word commands."
1453 (interactive "sSeparators: ")
1454 (tpu-reset-word-separators)
1455 (tpu-add-word-separators separators))
1459 ;;; Movement by line
1461 (defun tpu-next-line (num)
1463 Prefix argument serves as a repeat count."
1465 (next-line-internal num)
1466 (setq this-command 'next-line))
1468 (defun tpu-previous-line (num)
1469 "Move to previous line.
1470 Prefix argument serves as a repeat count."
1472 (next-line-internal (- num))
1473 (setq this-command 'previous-line))
1475 (defun tpu-next-beginning-of-line (num)
1476 "Move to beginning of line; if at beginning, move to beginning of next line.
1477 Accepts a prefix argument for the number of lines to move."
1480 (forward-line (- 1 num)))
1482 (defun tpu-end-of-line (num)
1483 "Move to the next end of line in the current direction.
1484 A repeat count means move that many lines."
1486 (if tpu-advance (tpu-next-end-of-line num) (tpu-previous-end-of-line num)))
1488 (defun tpu-next-end-of-line (num)
1489 "Move to end of line; if at end, move to end of next line.
1490 Accepts a prefix argument for the number of lines to move."
1495 (defun tpu-previous-end-of-line (num)
1497 Accepts a prefix argument for the number of lines to move."
1499 (end-of-line (- 1 num)))
1501 (defun tpu-current-end-of-line nil
1502 "Move point to end of current line."
1504 (let ((beg (point)))
1506 (if (= beg (point)) (message "You are already at the end of a line."))))
1508 (defun tpu-line (num)
1509 "Move to the beginning of the next line in the current direction.
1510 A repeat count means move that many lines."
1512 (if tpu-advance (tpu-forward-line num) (tpu-backward-line num)))
1514 (defun tpu-forward-line (num)
1515 "Move to beginning of next line.
1516 Prefix argument serves as a repeat count."
1520 (defun tpu-backward-line (num)
1521 "Move to beginning of previous line.
1522 Prefix argument serves as repeat count."
1524 (forward-line (- num)))
1528 ;;; Movement by paragraph
1530 (defun tpu-paragraph (num)
1531 "Move to the next paragraph in the current direction.
1532 A repeat count means move that many paragraphs."
1535 (tpu-next-paragraph num) (tpu-previous-paragraph num)))
1537 (defun tpu-next-paragraph (num)
1538 "Move to beginning of the next paragraph.
1539 Accepts a prefix argument for the number of paragraphs."
1542 (while (and (not (eobp)) (> num 0))
1543 (if (re-search-forward "^[ \t]*$" nil t)
1544 (if (re-search-forward "[^ \t\n]" nil t)
1545 (goto-char (match-beginning 0))
1546 (goto-char (point-max))))
1547 (setq num (1- num)))
1548 (beginning-of-line))
1551 (defun tpu-previous-paragraph (num)
1552 "Move to beginning of previous paragraph.
1553 Accepts a prefix argument for the number of paragraphs."
1556 (while (and (not (bobp)) (> num 0))
1557 (if (not (and (re-search-backward "^[ \t]*$" nil t)
1558 (re-search-backward "[^ \t\n]" nil t)
1559 (re-search-backward "^[ \t]*$" nil t)
1560 (progn (re-search-forward "[^ \t\n]" nil t)
1561 (goto-char (match-beginning 0)))))
1562 (goto-char (point-min)))
1563 (setq num (1- num)))
1564 (beginning-of-line))
1568 ;;; Movement by page
1570 (defun tpu-page (num)
1571 "Move to the next page in the current direction.
1572 A repeat count means move that many pages."
1574 (if tpu-advance (forward-page num) (backward-page num))
1575 (if (eobp) (recenter -1)))
1579 ;;; Scrolling and movement within the buffer
1581 (defun tpu-scroll-window (num)
1582 "Scroll the display to the next section in the current direction.
1583 A repeat count means scroll that many sections."
1585 (if tpu-advance (tpu-scroll-window-up num) (tpu-scroll-window-down num)))
1587 (defun tpu-scroll-window-down (num)
1588 "Scroll the display down to the next section.
1589 A repeat count means scroll that many sections."
1591 (let* ((beg (tpu-current-line))
1592 (height (1- (window-height)))
1593 (lines (* num (/ (* height tpu-percent-scroll) 100))))
1594 (next-line-internal (- lines))
1595 (if (> lines beg) (recenter 0))))
1597 (defun tpu-scroll-window-up (num)
1598 "Scroll the display up to the next section.
1599 A repeat count means scroll that many sections."
1601 (let* ((beg (tpu-current-line))
1602 (height (1- (window-height)))
1603 (lines (* num (/ (* height tpu-percent-scroll) 100))))
1604 (next-line-internal lines)
1605 (if (>= (+ lines beg) height) (recenter -1))))
1607 (defun tpu-pan-right (num)
1608 "Pan right tpu-pan-columns (16 by default).
1609 Accepts a prefix argument for the number of tpu-pan-columns to scroll."
1611 (scroll-left (* tpu-pan-columns num)))
1613 (defun tpu-pan-left (num)
1614 "Pan left tpu-pan-columns (16 by default).
1615 Accepts a prefix argument for the number of tpu-pan-columns to scroll."
1617 (scroll-right (* tpu-pan-columns num)))
1619 (defun tpu-move-to-beginning nil
1620 "Move cursor to the beginning of buffer, but don't set the mark."
1622 (goto-char (point-min)))
1624 (defun tpu-move-to-end nil
1625 "Move cursor to the end of buffer, but don't set the mark."
1627 (goto-char (point-max))
1630 (defun tpu-goto-percent (perc)
1631 "Move point to ARG percentage of the buffer."
1632 (interactive "NGoto-percentage: ")
1633 (if (or (> perc 100) (< perc 0))
1634 (error "Percentage %d out of range 0 < percent < 100" perc)
1635 (goto-char (/ (* (point-max) perc) 100))))
1637 (defun tpu-beginning-of-window nil
1638 "Move cursor to top of window."
1640 (move-to-window-line 0))
1642 (defun tpu-end-of-window nil
1643 "Move cursor to bottom of window."
1645 (move-to-window-line -1))
1647 (defun tpu-line-to-bottom-of-window nil
1648 "Move the current line to the bottom of the window."
1652 (defun tpu-line-to-top-of-window nil
1653 "Move the current line to the top of the window."
1661 (defun tpu-advance-direction nil
1662 "Set TPU Advance mode so keypad commands move forward."
1664 (setq tpu-direction-string " Advance")
1665 (setq tpu-advance t)
1666 (setq tpu-reverse nil)
1668 (tpu-update-mode-line))
1670 (defun tpu-backup-direction nil
1671 "Set TPU Backup mode so keypad commands move backward."
1673 (setq tpu-direction-string " Reverse")
1674 (setq tpu-advance nil)
1675 (setq tpu-reverse t)
1677 (tpu-update-mode-line))
1683 (define-key global-map "\e[" CSI-map) ; CSI map
1684 (define-key global-map "\eO" SS3-map) ; SS3 map
1685 (define-key SS3-map "P" GOLD-map) ; GOLD map
1686 (define-key GOLD-map "\e[" GOLD-CSI-map) ; GOLD-CSI map
1687 (define-key GOLD-map "\eO" GOLD-SS3-map) ; GOLD-SS3 map
1691 ;;; CSI-map key definitions
1693 (define-key CSI-map "A" 'tpu-previous-line) ; up
1694 (define-key CSI-map "B" 'tpu-next-line) ; down
1695 (define-key CSI-map "D" 'tpu-backward-char) ; left
1696 (define-key CSI-map "C" 'tpu-forward-char) ; right
1698 (define-key CSI-map "1~" 'tpu-search) ; Find
1699 (define-key CSI-map "2~" 'tpu-paste) ; Insert Here
1700 (define-key CSI-map "3~" 'tpu-cut) ; Remove
1701 (define-key CSI-map "4~" 'tpu-select) ; Select
1702 (define-key CSI-map "5~" 'tpu-scroll-window-down) ; Prev Screen
1703 (define-key CSI-map "6~" 'tpu-scroll-window-up) ; Next Screen
1705 (define-key CSI-map "11~" 'nil) ; F1
1706 (define-key CSI-map "12~" 'nil) ; F2
1707 (define-key CSI-map "13~" 'nil) ; F3
1708 (define-key CSI-map "14~" 'nil) ; F4
1709 (define-key CSI-map "15~" 'nil) ; F5
1710 (define-key CSI-map "17~" 'nil) ; F6
1711 (define-key CSI-map "18~" 'nil) ; F7
1712 (define-key CSI-map "19~" 'nil) ; F8
1713 (define-key CSI-map "20~" 'nil) ; F9
1714 (define-key CSI-map "21~" 'tpu-exit) ; F10
1715 (define-key CSI-map "23~" 'tpu-insert-escape) ; F11 (ESC)
1716 (define-key CSI-map "24~" 'tpu-next-beginning-of-line) ; F12 (BS)
1717 (define-key CSI-map "25~" 'tpu-delete-previous-word) ; F13 (LF)
1718 (define-key CSI-map "26~" 'tpu-toggle-overwrite-mode) ; F14
1719 (define-key CSI-map "28~" 'tpu-help) ; HELP
1720 (define-key CSI-map "29~" 'execute-extended-command) ; DO
1721 (define-key CSI-map "31~" 'tpu-goto-breadcrumb) ; F17
1722 (define-key CSI-map "32~" 'nil) ; F18
1723 (define-key CSI-map "33~" 'nil) ; F19
1724 (define-key CSI-map "34~" 'nil) ; F20
1728 ;;; SS3-map key definitions
1730 (define-key SS3-map "A" 'tpu-previous-line) ; up
1731 (define-key SS3-map "B" 'tpu-next-line) ; down
1732 (define-key SS3-map "C" 'tpu-forward-char) ; right
1733 (define-key SS3-map "D" 'tpu-backward-char) ; left
1735 (define-key SS3-map "Q" 'tpu-help) ; PF2
1736 (define-key SS3-map "R" 'tpu-search-again) ; PF3
1737 (define-key SS3-map "S" 'tpu-delete-current-line) ; PF4
1738 (define-key SS3-map "p" 'tpu-line) ; KP0
1739 (define-key SS3-map "q" 'tpu-word) ; KP1
1740 (define-key SS3-map "r" 'tpu-end-of-line) ; KP2
1741 (define-key SS3-map "s" 'tpu-char) ; KP3
1742 (define-key SS3-map "t" 'tpu-advance-direction) ; KP4
1743 (define-key SS3-map "u" 'tpu-backup-direction) ; KP5
1744 (define-key SS3-map "v" 'tpu-cut) ; KP6
1745 (define-key SS3-map "w" 'tpu-page) ; KP7
1746 (define-key SS3-map "x" 'tpu-scroll-window) ; KP8
1747 (define-key SS3-map "y" 'tpu-append-region) ; KP9
1748 (define-key SS3-map "m" 'tpu-delete-current-word) ; KP-
1749 (define-key SS3-map "l" 'tpu-delete-current-char) ; KP,
1750 (define-key SS3-map "n" 'tpu-select) ; KP.
1751 (define-key SS3-map "M" 'newline) ; KPenter
1755 ;;; GOLD-map key definitions
1757 (define-key GOLD-map "\C-A" 'tpu-toggle-overwrite-mode) ; ^A
1758 (define-key GOLD-map "\C-B" 'nil) ; ^B
1759 (define-key GOLD-map "\C-C" 'nil) ; ^C
1760 (define-key GOLD-map "\C-D" 'nil) ; ^D
1761 (define-key GOLD-map "\C-E" 'nil) ; ^E
1762 (define-key GOLD-map "\C-F" 'set-visited-file-name) ; ^F
1763 (define-key GOLD-map "\C-g" 'keyboard-quit) ; safety first
1764 (define-key GOLD-map "\C-h" 'delete-other-windows) ; BS
1765 (define-key GOLD-map "\C-i" 'other-window) ; TAB
1766 (define-key GOLD-map "\C-J" 'nil) ; ^J
1767 (define-key GOLD-map "\C-K" 'tpu-define-macro-key) ; ^K
1768 (define-key GOLD-map "\C-l" 'downcase-region) ; ^L
1769 (define-key GOLD-map "\C-M" 'nil) ; ^M
1770 (define-key GOLD-map "\C-N" 'nil) ; ^N
1771 (define-key GOLD-map "\C-O" 'nil) ; ^O
1772 (define-key GOLD-map "\C-P" 'nil) ; ^P
1773 (define-key GOLD-map "\C-Q" 'nil) ; ^Q
1774 (define-key GOLD-map "\C-R" 'nil) ; ^R
1775 (define-key GOLD-map "\C-S" 'nil) ; ^S
1776 (define-key GOLD-map "\C-T" 'tpu-toggle-control-keys) ; ^T
1777 (define-key GOLD-map "\C-u" 'upcase-region) ; ^U
1778 (define-key GOLD-map "\C-V" 'nil) ; ^V
1779 (define-key GOLD-map "\C-w" 'tpu-write-current-buffers) ; ^W
1780 (define-key GOLD-map "\C-X" 'nil) ; ^X
1781 (define-key GOLD-map "\C-Y" 'nil) ; ^Y
1782 (define-key GOLD-map "\C-Z" 'nil) ; ^Z
1783 (define-key GOLD-map " " 'undo) ; SPC
1784 (define-key GOLD-map "!" 'nil) ; !
1785 (define-key GOLD-map "#" 'nil) ; #
1786 (define-key GOLD-map "$" 'tpu-add-at-eol) ; $
1787 (define-key GOLD-map "%" 'tpu-goto-percent) ; %
1788 (define-key GOLD-map "&" 'nil) ; &
1789 (define-key GOLD-map "(" 'nil) ; (
1790 (define-key GOLD-map ")" 'nil) ; )
1791 (define-key GOLD-map "*" 'tpu-toggle-regexp) ; *
1792 (define-key GOLD-map "+" 'nil) ; +
1793 (define-key GOLD-map "," 'tpu-goto-breadcrumb) ; ,
1794 (define-key GOLD-map "-" 'negative-argument) ; -
1795 (define-key GOLD-map "." 'tpu-drop-breadcrumb) ; .
1796 (define-key GOLD-map "/" 'tpu-emacs-replace) ; /
1797 (define-key GOLD-map "0" 'digit-argument) ; 0
1798 (define-key GOLD-map "1" 'digit-argument) ; 1
1799 (define-key GOLD-map "2" 'digit-argument) ; 2
1800 (define-key GOLD-map "3" 'digit-argument) ; 3
1801 (define-key GOLD-map "4" 'digit-argument) ; 4
1802 (define-key GOLD-map "5" 'digit-argument) ; 5
1803 (define-key GOLD-map "6" 'digit-argument) ; 6
1804 (define-key GOLD-map "7" 'digit-argument) ; 7
1805 (define-key GOLD-map "8" 'digit-argument) ; 8
1806 (define-key GOLD-map "9" 'digit-argument) ; 9
1807 (define-key GOLD-map ":" 'nil) ; :
1808 (define-key GOLD-map ";" 'tpu-trim-line-ends) ; ;
1809 (define-key GOLD-map "<" 'nil) ; <
1810 (define-key GOLD-map "=" 'nil) ; =
1811 (define-key GOLD-map ">" 'nil) ; >
1812 (define-key GOLD-map "?" 'tpu-spell-check) ; ?
1813 (define-key GOLD-map "A" 'tpu-toggle-newline-and-indent) ; A
1814 (define-key GOLD-map "B" 'tpu-next-buffer) ; B
1815 (define-key GOLD-map "C" 'repeat-complex-command) ; C
1816 (define-key GOLD-map "D" 'shell-command) ; D
1817 (define-key GOLD-map "E" 'tpu-exit) ; E
1818 (define-key GOLD-map "F" 'tpu-set-cursor-free) ; F
1819 (define-key GOLD-map "G" 'tpu-get) ; G
1820 (define-key GOLD-map "H" 'nil) ; H
1821 (define-key GOLD-map "I" 'tpu-include) ; I
1822 (define-key GOLD-map "K" 'tpu-kill-buffer) ; K
1823 (define-key GOLD-map "L" 'tpu-what-line) ; L
1824 (define-key GOLD-map "M" 'buffer-menu) ; M
1825 (define-key GOLD-map "N" 'tpu-next-file-buffer) ; N
1826 (define-key GOLD-map "O" 'occur) ; O
1827 (define-key GOLD-map "P" 'lpr-buffer) ; P
1828 (define-key GOLD-map "Q" 'tpu-quit) ; Q
1829 (define-key GOLD-map "R" 'tpu-toggle-rectangle) ; R
1830 (define-key GOLD-map "S" 'replace) ; S
1831 (define-key GOLD-map "T" 'tpu-line-to-top-of-window) ; T
1832 (define-key GOLD-map "U" 'undo) ; U
1833 (define-key GOLD-map "V" 'tpu-version) ; V
1834 (define-key GOLD-map "W" 'save-buffer) ; W
1835 (define-key GOLD-map "X" 'tpu-save-all-buffers-kill-emacs) ; X
1836 (define-key GOLD-map "Y" 'copy-region-as-kill) ; Y
1837 (define-key GOLD-map "Z" 'suspend-emacs) ; Z
1838 (define-key GOLD-map "[" 'blink-matching-open) ; [
1839 (define-key GOLD-map "\\" 'nil) ; \
1840 (define-key GOLD-map "]" 'blink-matching-open) ; ]
1841 (define-key GOLD-map "^" 'tpu-add-at-bol) ; ^
1842 (define-key GOLD-map "_" 'split-window-vertically) ; -
1843 (define-key GOLD-map "`" 'what-line) ; `
1844 (define-key GOLD-map "a" 'tpu-toggle-newline-and-indent) ; a
1845 (define-key GOLD-map "b" 'tpu-next-buffer) ; b
1846 (define-key GOLD-map "c" 'repeat-complex-command) ; c
1847 (define-key GOLD-map "d" 'shell-command) ; d
1848 (define-key GOLD-map "e" 'tpu-exit) ; e
1849 (define-key GOLD-map "f" 'tpu-set-cursor-free) ; f
1850 (define-key GOLD-map "g" 'tpu-get) ; g
1851 (define-key GOLD-map "h" 'nil) ; h
1852 (define-key GOLD-map "i" 'tpu-include) ; i
1853 (define-key GOLD-map "k" 'tpu-kill-buffer) ; k
1854 (define-key GOLD-map "l" 'goto-line) ; l
1855 (define-key GOLD-map "m" 'buffer-menu) ; m
1856 (define-key GOLD-map "n" 'tpu-next-file-buffer) ; n
1857 (define-key GOLD-map "o" 'occur) ; o
1858 (define-key GOLD-map "p" 'lpr-region) ; p
1859 (define-key GOLD-map "q" 'tpu-quit) ; q
1860 (define-key GOLD-map "r" 'tpu-toggle-rectangle) ; r
1861 (define-key GOLD-map "s" 'replace) ; s
1862 (define-key GOLD-map "t" 'tpu-line-to-top-of-window) ; t
1863 (define-key GOLD-map "u" 'undo) ; u
1864 (define-key GOLD-map "v" 'tpu-version) ; v
1865 (define-key GOLD-map "w" 'save-buffer) ; w
1866 (define-key GOLD-map "x" 'tpu-save-all-buffers-kill-emacs) ; x
1867 (define-key GOLD-map "y" 'copy-region-as-kill) ; y
1868 (define-key GOLD-map "z" 'suspend-emacs) ; z
1869 (define-key GOLD-map "{" 'nil) ; {
1870 (define-key GOLD-map "|" 'split-window-horizontally) ; |
1871 (define-key GOLD-map "}" 'nil) ; }
1872 (define-key GOLD-map "~" 'exchange-point-and-mark) ; ~
1873 (define-key GOLD-map "\177" 'delete-window) ; <X]
1877 ;;; GOLD-CSI-map key definitions
1879 (define-key GOLD-CSI-map "A" 'tpu-move-to-beginning) ; up-arrow
1880 (define-key GOLD-CSI-map "B" 'tpu-move-to-end) ; down-arrow
1881 (define-key GOLD-CSI-map "C" 'end-of-line) ; right-arrow
1882 (define-key GOLD-CSI-map "D" 'beginning-of-line) ; left-arrow
1884 (define-key GOLD-CSI-map "1~" 'nil) ; Find
1885 (define-key GOLD-CSI-map "2~" 'nil) ; Insert Here
1886 (define-key GOLD-CSI-map "3~" 'tpu-store-text) ; Remove
1887 (define-key GOLD-CSI-map "4~" 'tpu-unselect) ; Select
1888 (define-key GOLD-CSI-map "5~" 'tpu-previous-window) ; Prev Screen
1889 (define-key GOLD-CSI-map "6~" 'tpu-next-window) ; Next Screen
1891 (define-key GOLD-CSI-map "11~" 'nil) ; F1
1892 (define-key GOLD-CSI-map "12~" 'nil) ; F2
1893 (define-key GOLD-CSI-map "13~" 'nil) ; F3
1894 (define-key GOLD-CSI-map "14~" 'nil) ; F4
1895 (define-key GOLD-CSI-map "16~" 'nil) ; F5
1896 (define-key GOLD-CSI-map "17~" 'nil) ; F6
1897 (define-key GOLD-CSI-map "18~" 'nil) ; F7
1898 (define-key GOLD-CSI-map "19~" 'nil) ; F8
1899 (define-key GOLD-CSI-map "20~" 'nil) ; F9
1900 (define-key GOLD-CSI-map "21~" 'nil) ; F10
1901 (define-key GOLD-CSI-map "23~" 'nil) ; F11
1902 (define-key GOLD-CSI-map "24~" 'nil) ; F12
1903 (define-key GOLD-CSI-map "25~" 'nil) ; F13
1904 (define-key GOLD-CSI-map "26~" 'nil) ; F14
1905 (define-key GOLD-CSI-map "28~" 'describe-bindings) ; HELP
1906 (define-key GOLD-CSI-map "29~" 'nil) ; DO
1907 (define-key GOLD-CSI-map "31~" 'tpu-drop-breadcrumb) ; F17
1908 (define-key GOLD-CSI-map "32~" 'nil) ; F18
1909 (define-key GOLD-CSI-map "33~" 'nil) ; F19
1910 (define-key GOLD-CSI-map "34~" 'nil) ; F20
1914 ;;; GOLD-SS3-map key definitions
1916 (define-key GOLD-SS3-map "A" 'tpu-move-to-beginning) ; up-arrow
1917 (define-key GOLD-SS3-map "B" 'tpu-move-to-end) ; down-arrow
1918 (define-key GOLD-SS3-map "C" 'end-of-line) ; right-arrow
1919 (define-key GOLD-SS3-map "D" 'beginning-of-line) ; left-arrow
1921 (define-key GOLD-SS3-map "P" 'keyboard-quit) ; PF1
1922 (define-key GOLD-SS3-map "Q" 'help-for-help) ; PF2
1923 (define-key GOLD-SS3-map "R" 'tpu-search) ; PF3
1924 (define-key GOLD-SS3-map "S" 'tpu-undelete-lines) ; PF4
1925 (define-key GOLD-SS3-map "p" 'open-line) ; KP0
1926 (define-key GOLD-SS3-map "q" 'tpu-change-case) ; KP1
1927 (define-key GOLD-SS3-map "r" 'tpu-delete-to-eol) ; KP2
1928 (define-key GOLD-SS3-map "s" 'tpu-special-insert) ; KP3
1929 (define-key GOLD-SS3-map "t" 'tpu-move-to-end) ; KP4
1930 (define-key GOLD-SS3-map "u" 'tpu-move-to-beginning) ; KP5
1931 (define-key GOLD-SS3-map "v" 'tpu-paste) ; KP6
1932 (define-key GOLD-SS3-map "w" 'execute-extended-command) ; KP7
1933 (define-key GOLD-SS3-map "x" 'tpu-fill) ; KP8
1934 (define-key GOLD-SS3-map "y" 'tpu-replace) ; KP9
1935 (define-key GOLD-SS3-map "m" 'tpu-undelete-words) ; KP-
1936 (define-key GOLD-SS3-map "l" 'tpu-undelete-char) ; KP,
1937 (define-key GOLD-SS3-map "n" 'tpu-unselect) ; KP.
1938 (define-key GOLD-SS3-map "M" 'tpu-substitute) ; KPenter
1942 ;;; Repeat complex command map additions to make arrows work
1944 (cond ((boundp 'repeat-complex-command-map)
1945 (define-key repeat-complex-command-map "\e[A" 'previous-complex-command)
1946 (define-key repeat-complex-command-map "\e[B" 'next-complex-command)
1947 (define-key repeat-complex-command-map "\eOA" 'previous-complex-command)
1948 (define-key repeat-complex-command-map "\eOB" 'next-complex-command)))
1952 ;;; Minibuffer map additions to make KP_enter = RET
1954 (define-key minibuffer-local-map "\eOM" 'exit-minibuffer)
1955 (define-key minibuffer-local-ns-map "\eOM" 'exit-minibuffer)
1956 (define-key minibuffer-local-completion-map "\eOM" 'exit-minibuffer)
1957 (define-key minibuffer-local-must-match-map "\eOM" 'minibuffer-complete-and-exit)
1958 (and (boundp 'repeat-complex-command-map)
1959 (define-key repeat-complex-command-map "\eOM" 'exit-minibuffer))
1963 ;;; Map control keys
1965 (define-key global-map "\C-\\" 'quoted-insert) ; ^\
1966 (define-key global-map "\C-a" 'tpu-toggle-overwrite-mode) ; ^A
1967 (define-key global-map "\C-b" 'repeat-complex-command) ; ^B
1968 (define-key global-map "\C-e" 'tpu-current-end-of-line) ; ^E
1969 (define-key global-map "\C-h" 'tpu-next-beginning-of-line) ; ^H (BS)
1970 (define-key global-map "\C-j" 'tpu-delete-previous-word) ; ^J (LF)
1971 (define-key global-map "\C-k" 'tpu-define-macro-key) ; ^K
1972 (define-key global-map "\C-l" 'tpu-insert-formfeed) ; ^L (FF)
1973 (define-key global-map "\C-r" 'recenter) ; ^R
1974 (define-key global-map "\C-u" 'tpu-delete-to-bol) ; ^U
1975 (define-key global-map "\C-v" 'tpu-quoted-insert) ; ^V
1976 (define-key global-map "\C-w" 'redraw-display) ; ^W
1977 (define-key global-map "\C-z" 'tpu-exit) ; ^Z
1981 ;;; Functions to reset and toggle the control key bindings
1983 (defun tpu-reset-control-keys (tpu-style)
1984 "Set control keys to TPU or emacs style functions."
1985 (let* ((tpu (and tpu-style (not tpu-control-keys)))
1986 (emacs (and (not tpu-style) tpu-control-keys))
1987 (doit (or tpu emacs)))
1989 (if emacs (setq tpu-global-map (copy-keymap global-map)))
1991 (copy-keymap tpu-global-map)
1992 (copy-keymap tpu-original-global-map))))
1994 (define-key global-map "\C-\\" (lookup-key map "\C-\\")) ; ^\
1995 (define-key global-map "\C-a" (lookup-key map "\C-a")) ; ^A
1996 (define-key global-map "\C-b" (lookup-key map "\C-b")) ; ^B
1997 (define-key global-map "\C-e" (lookup-key map "\C-e")) ; ^E
1998 (define-key global-map "\C-h" (lookup-key map "\C-h")) ; ^H (BS)
1999 (define-key global-map "\C-j" (lookup-key map "\C-j")) ; ^J (LF)
2000 (define-key global-map "\C-k" (lookup-key map "\C-k")) ; ^K
2001 (define-key global-map "\C-l" (lookup-key map "\C-l")) ; ^L (FF)
2002 (define-key global-map "\C-r" (lookup-key map "\C-r")) ; ^R
2003 (define-key global-map "\C-u" (lookup-key map "\C-u")) ; ^U
2004 (define-key global-map "\C-v" (lookup-key map "\C-v")) ; ^V
2005 (define-key global-map "\C-w" (lookup-key map "\C-w")) ; ^W
2006 (define-key global-map "\C-z" (lookup-key map "\C-z")) ; ^Z
2007 (setq tpu-control-keys tpu-style))))))
2009 (defun tpu-toggle-control-keys nil
2010 "Toggles control key bindings between TPU-edt and Emacs."
2012 (tpu-reset-control-keys (not tpu-control-keys))
2013 (and (interactive-p)
2014 (message "Control keys function with %s bindings."
2015 (if tpu-control-keys "TPU-edt" "Emacs"))))
2019 ;;; Emacs version 19 minibuffer history support
2021 (defun tpu-next-history-element (n)
2022 "Insert the next element of the minibuffer history into the minibuffer."
2024 (next-history-element n)
2025 (goto-char (point-max)))
2027 (defun tpu-previous-history-element (n)
2028 "Insert the previous element of the minibuffer history into the minibuffer."
2030 (previous-history-element n)
2031 (goto-char (point-max)))
2033 (defun tpu-arrow-history nil
2034 "Modify minibuffer maps to use arrows for history recall."
2036 (let ((loc (where-is-internal 'tpu-previous-line)) (cur nil))
2037 (while (setq cur (car loc))
2038 (define-key read-expression-map cur 'tpu-previous-history-element)
2039 (define-key minibuffer-local-map cur 'tpu-previous-history-element)
2040 (define-key minibuffer-local-ns-map cur 'tpu-previous-history-element)
2041 (define-key minibuffer-local-completion-map cur 'tpu-previous-history-element)
2042 (define-key minibuffer-local-must-match-map cur 'tpu-previous-history-element)
2043 (setq loc (cdr loc)))
2045 (setq loc (where-is-internal 'tpu-next-line))
2046 (while (setq cur (car loc))
2047 (define-key read-expression-map cur 'tpu-next-history-element)
2048 (define-key minibuffer-local-map cur 'tpu-next-history-element)
2049 (define-key minibuffer-local-ns-map cur 'tpu-next-history-element)
2050 (define-key minibuffer-local-completion-map cur 'tpu-next-history-element)
2051 (define-key minibuffer-local-must-match-map cur 'tpu-next-history-element)
2052 (setq loc (cdr loc)))))
2056 ;;; Emacs version 19 X-windows key definition support
2058 (defun tpu-load-xkeys (file)
2059 "Load the TPU-edt X-windows key definitions FILE.
2060 If FILE is nil, try to load a default file. The default file names are
2061 ~/.tpu-lucid-keys for Lucid emacs, and ~/.tpu-gnu-keys for GNU emacs."
2062 (interactive "fX key definition file: ")
2064 (setq file (expand-file-name file)))
2066 (setq file (expand-file-name tpu-xkeys-file)))
2068 (setq file (expand-file-name "~/.tpu-gnu-keys")))
2069 (tpu-lucid-emacs19-p
2070 (setq file (expand-file-name "~/.tpu-lucid-keys"))))
2071 (cond ((file-readable-p file)
2074 (switch-to-buffer "*scratch*")
2078 Ack!! You're running TPU-edt under X-windows without loading an
2079 X key definition file. To create a TPU-edt X key definition
2080 file, run the tpu-mapper.el program. It came with TPU-edt. It
2081 even includes directions on how to use it! Perhaps it's laying
2082 around here someplace. ")
2083 (let ((file "tpu-mapper.el")
2086 (search-list (append (list (expand-file-name ".")) load-path)))
2087 (while (and (not found) search-list)
2088 (setq path (concat (car search-list)
2089 (if (string-match "/$" (car search-list)) "" "/")
2091 (if (and (file-exists-p path) (not (file-directory-p path)))
2093 (setq search-list (cdr search-list)))
2096 "Ah yes, there it is, in \n\n %s \n\n" path))
2097 (if (tpu-y-or-n-p "Do you want to run it now? ")
2100 (insert "Nope, I can't seem to find it. :-(\n\n")
2105 ;;; Start and Stop TPU-edt
2108 (defun tpu-edt-on nil
2109 "Turn on TPU/edt emulation."
2113 ;; we use picture-mode functions
2115 (tpu-reset-control-keys t)
2116 (cond (tpu-emacs19-p
2117 (and window-system (tpu-load-xkeys nil))
2118 (tpu-arrow-history))
2120 ;; define ispell functions
2121 (autoload 'ispell-word "ispell" "Check spelling of word at or before point" t)
2122 (autoload 'ispell-complete-word "ispell" "Complete word at or before point" t)
2123 (autoload 'ispell-buffer "ispell" "Check spelling of entire buffer" t)
2124 (autoload 'ispell-region "ispell" "Check spelling of region" t)))
2125 (tpu-set-mode-line t)
2126 (tpu-advance-direction)
2127 ;; set page delimiter, display line truncation, and scrolling like TPU
2128 (setq-default page-delimiter "\f")
2129 (setq-default truncate-lines t)
2130 (setq scroll-step 1)
2131 (setq tpu-edt-mode t))))
2133 (defun tpu-edt-off nil
2134 "Turn off TPU/edt emulation. Note that the keypad is left on."
2138 (tpu-reset-control-keys nil)
2139 (tpu-set-mode-line nil)
2140 (setq-default page-delimiter "^\f")
2141 (setq-default truncate-lines nil)
2142 (setq scroll-step 0)
2143 (use-global-map global-map)
2144 (setq tpu-edt-mode nil))))
2148 ;;; Turn on TPU-edt and announce it as a feature
2154 ;;; tpu-edt.el ends here