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