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