Mercurial > hg > xemacs-beta

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

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