lisp/emulation/tpu-edt.el

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