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