Mercurial > emacs
comparison lisp/emulation/tpu-edt.el @ 85688:b210bba3f477
Merge from emacs--rel--22
Patches applied:
* emacs--rel--22 (patch 131-137)
- Update from CVS
- Merge from gnus--rel--5.10
* gnus--rel--5.10 (patch 261-262)
- Update from CVS
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-908
author | Miles Bader <miles@gnu.org> |
---|---|
date | Sat, 27 Oct 2007 09:07:17 +0000 |
parents | 0203f02d33db c6da63ecc892 |
children | da67dc2c4510 4bc33ffdda1a |
comparison
equal
deleted
inserted
replaced
85687:666ace46440f | 85688:b210bba3f477 |
---|---|
271 ;; We shouldn't use vt100 ESC sequences since it is uselessly fighting | 271 ;; We shouldn't use vt100 ESC sequences since it is uselessly fighting |
272 ;; against function-key-map. Better use real key names. | 272 ;; against function-key-map. Better use real key names. |
273 | 273 |
274 ;;; Code: | 274 ;;; Code: |
275 | 275 |
276 (eval-when-compile (require 'cl)) | |
276 ;; we use picture-mode functions | 277 ;; we use picture-mode functions |
277 (require 'picture) | 278 (require 'picture) |
278 | 279 |
279 (defgroup tpu nil | 280 (defgroup tpu nil |
280 "Emacs emulating TPU emulating EDT." | 281 "Emacs emulating TPU emulating EDT." |
2376 (condition-case conditions | 2377 (condition-case conditions |
2377 (copy-file oldname newname) | 2378 (copy-file oldname newname) |
2378 (tpu-error (message "Sorry, couldn't copy - %s." (cdr conditions))))) | 2379 (tpu-error (message "Sorry, couldn't copy - %s." (cdr conditions))))) |
2379 (kill-buffer "*TPU-Notice*"))) | 2380 (kill-buffer "*TPU-Notice*"))) |
2380 | 2381 |
2382 (defvar tpu-edt-old-global-values nil) | |
2381 | 2383 |
2382 ;;; | 2384 ;;; |
2383 ;;; Start and Stop TPU-edt | 2385 ;;; Start and Stop TPU-edt |
2384 ;;; | 2386 ;;; |
2385 ;;;###autoload | 2387 ;;;###autoload |
2386 (defun tpu-edt-on () | 2388 (defun tpu-edt-on () |
2387 "Turn on TPU/edt emulation." | 2389 "Turn on TPU/edt emulation." |
2388 (interactive) | 2390 (interactive) |
2391 ;; To clean things up (and avoid cycles in the global map). | |
2392 (tpu-edt-off) | |
2389 ;; First, activate tpu-global-map, while protecting the original keymap. | 2393 ;; First, activate tpu-global-map, while protecting the original keymap. |
2390 (set-keymap-parent tpu-global-map global-map) | 2394 (set-keymap-parent tpu-global-map global-map) |
2391 (setq global-map tpu-global-map) | 2395 (setq global-map tpu-global-map) |
2392 (use-global-map global-map) | 2396 (use-global-map global-map) |
2393 ;; Then do the normal TPU setup. | 2397 ;; Then do the normal TPU setup. |
2394 (transient-mark-mode t) | 2398 (transient-mark-mode t) |
2395 (add-hook 'post-command-hook 'tpu-search-highlight) | 2399 (add-hook 'post-command-hook 'tpu-search-highlight) |
2396 (tpu-set-mode-line t) | 2400 (tpu-set-mode-line t) |
2397 (tpu-advance-direction) | 2401 (tpu-advance-direction) |
2398 ;; set page delimiter, display line truncation, and scrolling like TPU | 2402 ;; set page delimiter, display line truncation, and scrolling like TPU |
2399 (setq-default page-delimiter "\f") | 2403 (dolist (varval '((page-delimiter . "\f") |
2400 (setq-default truncate-lines t) | 2404 (truncate-lines . t) |
2401 (setq scroll-step 1) | 2405 (scroll-step . 1))) |
2406 (push (cons (car varval) (default-value (car varval))) | |
2407 tpu-edt-old-global-values) | |
2408 (set-default (car varval) (cdr varval))) | |
2402 (tpu-set-control-keys) | 2409 (tpu-set-control-keys) |
2403 (and window-system (tpu-load-xkeys nil)) | 2410 (and window-system (tpu-load-xkeys nil)) |
2404 (tpu-arrow-history) | 2411 (tpu-arrow-history) |
2405 ;; Then protect tpu-global-map from user modifications. | 2412 ;; Then protect tpu-global-map from user modifications. |
2406 (let ((map (make-sparse-keymap))) | 2413 (let ((map (make-sparse-keymap))) |
2413 "Turn off TPU/edt emulation. Note that the keypad is left on." | 2420 "Turn off TPU/edt emulation. Note that the keypad is left on." |
2414 (interactive) | 2421 (interactive) |
2415 (tpu-reset-control-keys nil) | 2422 (tpu-reset-control-keys nil) |
2416 (remove-hook 'post-command-hook 'tpu-search-highlight) | 2423 (remove-hook 'post-command-hook 'tpu-search-highlight) |
2417 (tpu-set-mode-line nil) | 2424 (tpu-set-mode-line nil) |
2418 (setq-default page-delimiter "^\f") | 2425 (while tpu-edt-old-global-values |
2419 (setq-default truncate-lines nil) | 2426 (let ((varval (pop tpu-edt-old-global-values))) |
2420 (setq scroll-step 0) | 2427 (set-default (car varval) (cdr varval)))) |
2421 ;; Remove tpu-global-map from the global map. | 2428 ;; Remove tpu-global-map from the global map. |
2422 (let ((map global-map)) | 2429 (let ((map global-map)) |
2423 (while map | 2430 (while map |
2424 (let ((parent (keymap-parent map))) | 2431 (let ((parent (keymap-parent map))) |
2425 (if (eq tpu-global-map parent) | 2432 (if (eq tpu-global-map parent) |
2426 (set-keymap-parent map (keymap-parent parent)) | 2433 (set-keymap-parent map (keymap-parent parent)) |
2427 (setq map parent))))) | 2434 (setq map parent))))) |
2428 (ad-disable-regexp "\\`tpu-") | 2435 (ignore-errors (ad-disable-regexp "\\`tpu-")) |
2429 (setq tpu-edt-mode nil)) | 2436 (setq tpu-edt-mode nil)) |
2430 | 2437 |
2431 | 2438 |
2432 ;;;### (autoloads (tpu-set-cursor-bound tpu-set-cursor-free tpu-set-scroll-margins | 2439 ;;;### (autoloads (tpu-set-cursor-bound tpu-set-cursor-free tpu-set-scroll-margins |
2433 ;;;;;; tpu-cursor-free-mode) "tpu-extras" "tpu-extras.el" "e0629234f1abe076917a303456b48329") | 2440 ;;;;;; tpu-cursor-free-mode) "tpu-extras" "tpu-extras.el" "e0629234f1abe076917a303456b48329") |