Mercurial > hg > xemacs-beta
comparison lisp/emulators/tpu-edt.el @ 185:3d6bfa290dbd r20-3b19
Import from CVS: tag r20-3b19
author | cvs |
---|---|
date | Mon, 13 Aug 2007 09:55:28 +0200 |
parents | 34a5b81f86ba |
children |
comparison
equal
deleted
inserted
replaced
184:bcd2674570bf | 185:3d6bfa290dbd |
---|---|
5 ;; Author: Rob Riepel <riepel@networking.stanford.edu> | 5 ;; Author: Rob Riepel <riepel@networking.stanford.edu> |
6 ;; Maintainer: Rob Riepel <riepel@networking.stanford.edu> | 6 ;; Maintainer: Rob Riepel <riepel@networking.stanford.edu> |
7 ;; Version: 4.2 | 7 ;; Version: 4.2 |
8 ;; Keywords: emulations | 8 ;; Keywords: emulations |
9 | 9 |
10 ;; Modified for XEmacs by R. Kevin Oberman <oberman@es.net> | |
11 | |
12 ;; This file is part of XEmacs. | 10 ;; This file is part of XEmacs. |
11 ;; Modified for XEmacs by Kevin Oberman <oberman@es.net> | |
13 | 12 |
14 ;; XEmacs is free software; you can redistribute it and/or modify it | 13 ;; XEmacs is free software; you can redistribute it and/or modify it |
15 ;; under the terms of the GNU General Public License as published by | 14 ;; under the terms of the GNU General Public License as published by |
16 ;; the Free Software Foundation; either version 2, or (at your option) | 15 ;; the Free Software Foundation; either version 2, or (at your option) |
17 ;; any later version. | 16 ;; any later version. |
18 | 17 |
19 ;; XEmacs is distributed in the hope that it will be useful, but | 18 ;; XEmacs is distributed in the hope that it will be useful, but |
20 ;; WITHOUT ANY WARRANTY; without even the implied warranty of | 19 ;; WITHOUT ANY WARRANTY; without even the implied warranty of |
21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | 20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
22 ;; General Public License for more details. | 21 ;; GNU General Public License for more details. |
23 | 22 |
24 ;; You should have received a copy of the GNU General Public License | 23 ;; You should have received a copy of the GNU General Public License |
25 ;; along with XEmacs; see the file COPYING. If not, write to the Free | 24 ;; along with XEmacs; see the file COPYING. If not, write to the |
26 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA | 25 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, |
27 ;; 02111-1307, USA. | 26 ;; Boston, MA 02111-1307, USA. |
28 | 27 |
29 ;;; Synched up with: FSF 19.34 | 28 ;;; Synced up with FSF 19.34 and XEmacs 19.16 |
30 | 29 |
31 ;; TPU-edt is based on tpu.el by Jeff Kowalski and Bob Covey. | 30 ;; TPU-edt is based on tpu.el by Jeff Kowalski and Bob Covey. |
32 | 31 |
33 ;;; Commentary: | 32 ;;; Commentary: |
34 | 33 |
63 ;; . History recall of search strings, file names, and commands | 62 ;; . History recall of search strings, file names, and commands |
64 | 63 |
65 ;; Please note that TPU-edt does NOT emulate TPU. It emulates TPU's EDT | 64 ;; Please note that TPU-edt does NOT emulate TPU. It emulates TPU's EDT |
66 ;; emulation. Very few TPU line-mode commands are supported. | 65 ;; emulation. Very few TPU line-mode commands are supported. |
67 | 66 |
68 ;; TPU-edt, like it's VMS cousin, works on VT-series terminals with DEC | 67 ;; TPU-edt, like its VMS cousin, works on VT-series terminals with DEC |
69 ;; style keyboards. VT terminal emulators, including xterm with the | 68 ;; style keyboards. VT terminal emulators, including xterm with the |
70 ;; appropriate key translations, work just fine too. | 69 ;; appropriate key translations, work just fine too. |
71 | 70 |
72 ;; TPU-edt works with X-windows. This is accomplished through a TPU-edt X | 71 ;; TPU-edt works with X-windows. This is accomplished through a TPU-edt X |
73 ;; key map. The TPU-edt module tpu-mapper creates this map and stores it | 72 ;; key map. The TPU-edt module tpu-mapper creates this map and stores it |
128 | 127 |
129 ;; Help is available! The traditional help keys (Help and PF2) display | 128 ;; Help is available! The traditional help keys (Help and PF2) display |
130 ;; a small help file showing the default keypad layout, control key | 129 ;; a small help file showing the default keypad layout, control key |
131 ;; functions, and Gold key functions. Pressing any key inside of help | 130 ;; functions, and Gold key functions. Pressing any key inside of help |
132 ;; splits the screen and prints a description of the function of the | 131 ;; splits the screen and prints a description of the function of the |
133 ;; pressed key. Gold-PF2 invokes the native emacs help, with it's | 132 ;; pressed key. Gold-PF2 invokes the native emacs help, with its |
134 ;; zillions of options. | 133 ;; zillions of options. |
135 | 134 |
136 ;; Thanks to emacs, TPU-edt has some extensions that may make your life | 135 ;; Thanks to emacs, TPU-edt has some extensions that may make your life |
137 ;; easier, or at least more interesting. For example, Gold-r toggles | 136 ;; easier, or at least more interesting. For example, Gold-r toggles |
138 ;; TPU-edt rectangular mode. In rectangular mode, Remove and Insert work | 137 ;; TPU-edt rectangular mode. In rectangular mode, Remove and Insert work |
266 ;; This command replaces empty strings correctly, however, it has its | 265 ;; This command replaces empty strings correctly, however, it has its |
267 ;; drawbacks. As a native emacs command, it has a different interface | 266 ;; drawbacks. As a native emacs command, it has a different interface |
268 ;; than the emulated TPU commands. Also, it works only in the forward | 267 ;; than the emulated TPU commands. Also, it works only in the forward |
269 ;; direction, regardless of the current TPU-edt direction. | 268 ;; direction, regardless of the current TPU-edt direction. |
270 | 269 |
271 ;; NOTE: There was a very old tpu-edt in XEmacs 19.14 so I deleted it and | |
272 ;; replaced it with the one in Emacs 19.34. -sb | |
273 | |
274 ;;; Code: | 270 ;;; Code: |
275 | 271 |
276 | 272 |
277 ;;; | 273 ;;; |
278 ;;; Version Information | 274 ;;; Version Information |
279 ;;; | 275 ;;; |
280 (defconst tpu-version "4.2" "TPU-edt version number.") | 276 (defconst tpu-version "4.2X" "TPU-edt version number.") |
281 | 277 |
282 | 278 |
283 ;;; | 279 ;;; |
284 ;;; User Configurable Variables | 280 ;;; User Configurable Variables |
285 ;;; | 281 ;;; |
428 (cond ((not for-tpu) | 424 (cond ((not for-tpu) |
429 (setq mode-line-format tpu-original-mode-line) | 425 (setq mode-line-format tpu-original-mode-line) |
430 (setq minor-mode-alist tpu-original-mm-alist)) | 426 (setq minor-mode-alist tpu-original-mm-alist)) |
431 (t | 427 (t |
432 (setq-default mode-line-format | 428 (setq-default mode-line-format |
433 (list (purecopy "") | 429 (list (purecopy "-") |
434 'mode-line-modified | 430 'mode-line-modified |
431 'mode-line-frame-identification | |
435 'mode-line-buffer-identification | 432 'mode-line-buffer-identification |
436 (purecopy " ") | 433 (purecopy " ") |
437 'global-mode-string | 434 'global-mode-string |
438 (purecopy " ") | 435 (purecopy " ") |
439 'tpu-mark-flag | 436 'tpu-mark-flag |
677 | 674 |
678 (defun tpu-reset-screen-size (height width) | 675 (defun tpu-reset-screen-size (height width) |
679 "Sets the screen size." | 676 "Sets the screen size." |
680 (interactive "nnew screen height: \nnnew screen width: ") | 677 (interactive "nnew screen height: \nnnew screen width: ") |
681 (setq zmacs-region-stays t) | 678 (setq zmacs-region-stays t) |
682 (set-screen-height height) | 679 (set-frame-height height) |
683 (set-screen-width width)) | 680 (set-frame-width width)) |
684 | 681 |
685 (defun tpu-toggle-newline-and-indent nil | 682 (defun tpu-toggle-newline-and-indent nil |
686 "Toggle between 'newline and indent' and 'simple newline'." | 683 "Toggle between 'newline and indent' and 'simple newline'." |
687 (interactive) | 684 (interactive) |
688 (setq zmacs-region-stays t) | 685 (setq zmacs-region-stays t) |
820 (fset 'WHAT\ LINE 'tpu-what-line) | 817 (fset 'WHAT\ LINE 'tpu-what-line) |
821 | 818 |
822 (fset 'replace 'tpu-lm-replace) | 819 (fset 'replace 'tpu-lm-replace) |
823 (fset 'REPLACE 'tpu-lm-replace) | 820 (fset 'REPLACE 'tpu-lm-replace) |
824 | 821 |
822 ;; Apparently TPU users really expect to do M-x help RET to get help. | |
823 ;; So it is really necessary to redefine this. | |
825 (fset 'help 'tpu-help) | 824 (fset 'help 'tpu-help) |
826 (fset 'HELP 'tpu-help) | 825 (fset 'HELP 'tpu-help) |
827 | 826 |
828 (fset 'set\ cursor\ free 'tpu-set-cursor-free) | 827 (fset 'set\ cursor\ free 'tpu-set-cursor-free) |
829 (fset 'SET\ CURSOR\ FREE 'tpu-set-cursor-free) | 828 (fset 'SET\ CURSOR\ FREE 'tpu-set-cursor-free) |
971 (let ((key nil) (fkey nil) (split nil)) | 970 (let ((key nil) (fkey nil) (split nil)) |
972 (while (not (equal tpu-help-return fkey)) | 971 (while (not (equal tpu-help-return fkey)) |
973 (if split | 972 (if split |
974 (setq key | 973 (setq key |
975 (read-key-sequence | 974 (read-key-sequence |
976 "Press the key you want help on (RET=exit, ENTER=redisplay, N=next, P=prev): ")) | 975 "Press the key you want help on (RET=exit, ENTER=redisplay, N=next, |
976 P=prev): ")) | |
977 (setq key | 977 (setq key |
978 (read-key-sequence | 978 (read-key-sequence |
979 "Press the key you want help on (RET to exit, N next screen, P prev screen): "))) | 979 "Press the key you want help on (RET to exit, N next screen, P prev |
980 screen): "))) | |
980 | 981 |
981 ;; Process the read key | 982 ;; Process the read key |
982 ;; | 983 ;; |
983 ;; ENTER - Display just the help window | 984 ;; ENTER - Display just the help window |
984 ;; N or n - Next help or describe-key screen | 985 ;; N or n - Next help or describe-key screen |
1088 (setq list (delq (current-buffer) list)) | 1089 (setq list (delq (current-buffer) list)) |
1089 (if (not list) (error "No other buffers.")) | 1090 (if (not list) (error "No other buffers.")) |
1090 (switch-to-buffer (car (reverse list))))) | 1091 (switch-to-buffer (car (reverse list))))) |
1091 | 1092 |
1092 (defun tpu-make-file-buffer-list (buffer-list) | 1093 (defun tpu-make-file-buffer-list (buffer-list) |
1093 "Returns names from BUFFER-LIST excluding those beginning with a space or star." | 1094 "Returns names from BUFFER-LIST excluding those beginning with a space or |
1095 star." | |
1094 (delq nil (mapcar '(lambda (b) | 1096 (delq nil (mapcar '(lambda (b) |
1095 (if (or (= (aref (buffer-name b) 0) ? ) | 1097 (if (or (= (aref (buffer-name b) 0) ? ) |
1096 (= (aref (buffer-name b) 0) ?*)) nil b)) | 1098 (= (aref (buffer-name b) 0) ?*)) nil b)) |
1097 buffer-list))) | 1099 buffer-list))) |
1098 | 1100 |
1672 (defun tpu-add-at-eol (text) | 1674 (defun tpu-add-at-eol (text) |
1673 "Add text to the end of each line in a region, | 1675 "Add text to the end of each line in a region, |
1674 or each line of the entire buffer if no region is selected." | 1676 or each line of the entire buffer if no region is selected." |
1675 (interactive | 1677 (interactive |
1676 (list (tpu-string-prompt "String to add: " 'tpu-add-at-eol-hist))) | 1678 (list (tpu-string-prompt "String to add: " 'tpu-add-at-eol-hist))) |
1677 (set zmacs-region-stays t) | 1679 (setq zmacs-region-stays t) |
1678 (if (string= "" text) (error "No string specified.")) | 1680 (if (string= "" text) (error "No string specified.")) |
1679 (cond ((tpu-mark) | 1681 (cond ((tpu-mark) |
1680 (save-excursion | 1682 (save-excursion |
1681 (if (> (point) (tpu-mark)) (exchange-point-and-mark)) | 1683 (if (> (point) (tpu-mark)) (exchange-point-and-mark)) |
1682 (while (< (point) (tpu-mark)) | 1684 (while (< (point) (tpu-mark)) |
1815 (defun tpu-next-line (num) | 1817 (defun tpu-next-line (num) |
1816 "Move to next line. | 1818 "Move to next line. |
1817 Prefix argument serves as a repeat count." | 1819 Prefix argument serves as a repeat count." |
1818 (interactive "p") | 1820 (interactive "p") |
1819 (setq zmacs-region-stays t) | 1821 (setq zmacs-region-stays t) |
1820 (next-line-internal num) | 1822 (line-move num) |
1821 (setq this-command 'next-line)) | 1823 (setq this-command 'next-line)) |
1822 | 1824 |
1823 (defun tpu-previous-line (num) | 1825 (defun tpu-previous-line (num) |
1824 "Move to previous line. | 1826 "Move to previous line. |
1825 Prefix argument serves as a repeat count." | 1827 Prefix argument serves as a repeat count." |
1826 (interactive "p") | 1828 (interactive "p") |
1827 (setq zmacs-region-stays t) | 1829 (setq zmacs-region-stays t) |
1828 (next-line-internal (- num)) | 1830 (line-move (- num)) |
1829 (setq this-command 'previous-line)) | 1831 (setq this-command 'previous-line)) |
1830 | 1832 |
1831 (defun tpu-next-beginning-of-line (num) | 1833 (defun tpu-next-beginning-of-line (num) |
1832 "Move to beginning of line; if at beginning, move to beginning of next line. | 1834 "Move to beginning of line; if at beginning, move to beginning of next line. |
1833 Accepts a prefix argument for the number of lines to move." | 1835 Accepts a prefix argument for the number of lines to move." |
1957 (defun tpu-scroll-window-down (num) | 1959 (defun tpu-scroll-window-down (num) |
1958 "Scroll the display down to the next section. | 1960 "Scroll the display down to the next section. |
1959 A repeat count means scroll that many sections." | 1961 A repeat count means scroll that many sections." |
1960 (interactive "p") | 1962 (interactive "p") |
1961 (setq zmacs-region-stays t) | 1963 (setq zmacs-region-stays t) |
1962 (let* ((beg (tpu-current-line)) | 1964 (let* ( |
1965 (beg (tpu-current-line)) | |
1963 (height (1- (window-height))) | 1966 (height (1- (window-height))) |
1964 (lines (* num (/ (* height tpu-percent-scroll) 100)))) | 1967 (lines (* num (/ (* height tpu-percent-scroll) 100)))) |
1965 (next-line-internal (- lines)) | 1968 (setq zmacs-region-stays t) |
1969 (line-move (- lines)) | |
1966 (if (> lines beg) (recenter 0)))) | 1970 (if (> lines beg) (recenter 0)))) |
1967 | 1971 |
1968 (defun tpu-scroll-window-up (num) | 1972 (defun tpu-scroll-window-up (num) |
1969 "Scroll the display up to the next section. | 1973 "Scroll the display up to the next section. |
1970 A repeat count means scroll that many sections." | 1974 A repeat count means scroll that many sections." |
1971 (interactive "p") | 1975 (interactive "p") |
1972 (setq zmacs-region-stays t) | 1976 (setq zmacs-region-stays t) |
1973 (let* ((beg (tpu-current-line)) | 1977 (let* ( |
1978 (beg (tpu-current-line)) | |
1974 (height (1- (window-height))) | 1979 (height (1- (window-height))) |
1975 (lines (* num (/ (* height tpu-percent-scroll) 100)))) | 1980 (lines (* num (/ (* height tpu-percent-scroll) 100)))) |
1976 (next-line-internal lines) | 1981 (setq zmacs-region-stays t) |
1982 (line-move lines) | |
1977 (if (>= (+ lines beg) height) (recenter -1)))) | 1983 (if (>= (+ lines beg) height) (recenter -1)))) |
1978 | 1984 |
1979 (defun tpu-pan-right (num) | 1985 (defun tpu-pan-right (num) |
1980 "Pan right tpu-pan-columns (16 by default). | 1986 "Pan right tpu-pan-columns (16 by default). |
1981 Accepts a prefix argument for the number of tpu-pan-columns to scroll." | 1987 Accepts a prefix argument for the number of tpu-pan-columns to scroll." |
2335 ;;; Minibuffer map additions to make KP_enter = RET | 2341 ;;; Minibuffer map additions to make KP_enter = RET |
2336 ;;; | 2342 ;;; |
2337 (define-key minibuffer-local-map "\eOM" 'exit-minibuffer) | 2343 (define-key minibuffer-local-map "\eOM" 'exit-minibuffer) |
2338 (define-key minibuffer-local-ns-map "\eOM" 'exit-minibuffer) | 2344 (define-key minibuffer-local-ns-map "\eOM" 'exit-minibuffer) |
2339 (define-key minibuffer-local-completion-map "\eOM" 'exit-minibuffer) | 2345 (define-key minibuffer-local-completion-map "\eOM" 'exit-minibuffer) |
2340 (define-key minibuffer-local-must-match-map "\eOM" 'minibuffer-complete-and-exit) | 2346 (define-key minibuffer-local-must-match-map "\eOM" |
2347 'minibuffer-complete-and-exit) | |
2341 (and (boundp 'repeat-complex-command-map) | 2348 (and (boundp 'repeat-complex-command-map) |
2342 (define-key repeat-complex-command-map "\eOM" 'exit-minibuffer)) | 2349 (define-key repeat-complex-command-map "\eOM" 'exit-minibuffer)) |
2343 | 2350 |
2344 | 2351 |
2345 ;;; | 2352 ;;; |
2429 (let ((loc (where-is-internal 'tpu-previous-line)) (cur nil)) | 2436 (let ((loc (where-is-internal 'tpu-previous-line)) (cur nil)) |
2430 (while (setq cur (car loc)) | 2437 (while (setq cur (car loc)) |
2431 (define-key read-expression-map cur 'tpu-previous-history-element) | 2438 (define-key read-expression-map cur 'tpu-previous-history-element) |
2432 (define-key minibuffer-local-map cur 'tpu-previous-history-element) | 2439 (define-key minibuffer-local-map cur 'tpu-previous-history-element) |
2433 (define-key minibuffer-local-ns-map cur 'tpu-previous-history-element) | 2440 (define-key minibuffer-local-ns-map cur 'tpu-previous-history-element) |
2434 (define-key minibuffer-local-completion-map cur 'tpu-previous-history-element) | 2441 (define-key minibuffer-local-completion-map cur |
2435 (define-key minibuffer-local-must-match-map cur 'tpu-previous-history-element) | 2442 'tpu-previous-history-element) |
2443 (define-key minibuffer-local-must-match-map cur | |
2444 'tpu-previous-history-element) | |
2436 (setq loc (cdr loc))) | 2445 (setq loc (cdr loc))) |
2437 | 2446 |
2438 (setq loc (where-is-internal 'tpu-next-line)) | 2447 (setq loc (where-is-internal 'tpu-next-line)) |
2439 (while (setq cur (car loc)) | 2448 (while (setq cur (car loc)) |
2440 (define-key read-expression-map cur 'tpu-next-history-element) | 2449 (define-key read-expression-map cur 'tpu-next-history-element) |
2441 (define-key minibuffer-local-map cur 'tpu-next-history-element) | 2450 (define-key minibuffer-local-map cur 'tpu-next-history-element) |
2442 (define-key minibuffer-local-ns-map cur 'tpu-next-history-element) | 2451 (define-key minibuffer-local-ns-map cur 'tpu-next-history-element) |
2443 (define-key minibuffer-local-completion-map cur 'tpu-next-history-element) | 2452 (define-key minibuffer-local-completion-map cur |
2444 (define-key minibuffer-local-must-match-map cur 'tpu-next-history-element) | 2453 'tpu-next-history-element) |
2454 (define-key minibuffer-local-must-match-map cur | |
2455 'tpu-next-history-element) | |
2445 (setq loc (cdr loc))))) | 2456 (setq loc (cdr loc))))) |
2446 | 2457 |
2447 | 2458 |
2448 ;;; | 2459 ;;; |
2449 ;;; Emacs version 19 X-windows key definition support | 2460 ;;; Emacs version 19 X-windows key definition support |
2479 (insert " | 2490 (insert " |
2480 | 2491 |
2481 Ack!! You're running TPU-edt under X-windows without loading an | 2492 Ack!! You're running TPU-edt under X-windows without loading an |
2482 X key definition file. To create a TPU-edt X key definition | 2493 X key definition file. To create a TPU-edt X key definition |
2483 file, run the tpu-mapper.el program. It came with TPU-edt. It | 2494 file, run the tpu-mapper.el program. It came with TPU-edt. It |
2484 even includes directions on how to use it! Perhaps it's laying | 2495 even includes directions on how to use it! Perhaps it's lying |
2485 around here someplace. ") | 2496 around here someplace. ") |
2486 (let ((file "tpu-mapper.el") | 2497 (let ((file "tpu-mapper.el") |
2487 (found nil) | 2498 (found nil) |
2488 (path nil) | 2499 (path nil) |
2489 (search-list (append (list (expand-file-name ".")) load-path))) | 2500 (search-list (append (list (expand-file-name ".")) load-path))) |
2548 (cond (tpu-emacs19-p | 2559 (cond (tpu-emacs19-p |
2549 (and window-system (tpu-load-xkeys nil)) | 2560 (and window-system (tpu-load-xkeys nil)) |
2550 (tpu-arrow-history)) | 2561 (tpu-arrow-history)) |
2551 (t | 2562 (t |
2552 ;; define ispell functions | 2563 ;; define ispell functions |
2553 (autoload 'ispell-word "ispell" "Check spelling of word at or before point" t) | 2564 (autoload 'ispell-word "ispell" "Check spelling of word at or before |
2554 (autoload 'ispell-complete-word "ispell" "Complete word at or before point" t) | 2565 point" t) |
2566 (autoload 'ispell-complete-word "ispell" "Complete word at or before | |
2567 point" t) | |
2555 (autoload 'ispell-buffer "ispell" "Check spelling of entire buffer" t) | 2568 (autoload 'ispell-buffer "ispell" "Check spelling of entire buffer" t) |
2556 (autoload 'ispell-region "ispell" "Check spelling of region" t))) | 2569 (autoload 'ispell-region "ispell" "Check spelling of region" t))) |
2557 (tpu-set-mode-line t) | 2570 (tpu-set-mode-line t) |
2558 (tpu-advance-direction) | 2571 (tpu-advance-direction) |
2559 ;; set page delimiter, display line truncation, and scrolling like TPU | 2572 ;; set page delimiter, display line truncation, and scrolling like TPU |