Mercurial > hg > xemacs-beta
diff lisp/emulators/tpu-extras.el @ 185:3d6bfa290dbd r20-3b19
Import from CVS: tag r20-3b19
author | cvs |
---|---|
date | Mon, 13 Aug 2007 09:55:28 +0200 |
parents | b9518feda344 |
children |
line wrap: on
line diff
--- a/lisp/emulators/tpu-extras.el Mon Aug 13 09:54:24 2007 +0200 +++ b/lisp/emulators/tpu-extras.el Mon Aug 13 09:55:28 2007 +0200 @@ -7,6 +7,7 @@ ;; Keywords: emulations ;; This file is part of XEmacs. +;; XEmacs modifications by Kevin Oberman <oberman@es.net> ;; XEmacs is free software; you can redistribute it and/or modify it ;; under the terms of the GNU General Public License as published by @@ -15,15 +16,15 @@ ;; XEmacs is distributed in the hope that it will be useful, but ;; WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;; General Public License for more details. +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. -;;; Synched up with: FSF 19.34 +;;; Synced up with FSF 19.34 and XEmacs 19.16 ;;; Commentary: @@ -102,9 +103,6 @@ ;; important aspects of the real TPU/edt. Those who miss free cursor mode ;; and/or scroll margins will appreciate these implementations. -;; NOTE: There was a very old tpu-edt in XEmacs 19.14 so I deleted it and -;; replaced it with the one in Emacs 19.34. -sb - ;;; Code: @@ -171,11 +169,13 @@ (defun tpu-forward-char (num) "Move right ARG characters (left if ARG is negative)." (interactive "p") + (setq zmacs-region-stays t) (if tpu-cursor-free (picture-forward-column num) (forward-char num))) (defun tpu-backward-char (num) "Move left ARG characters (right if ARG is negative)." (interactive "p") + (setq zmacs-region-stays t) (cond ((not tpu-cursor-free) (backward-char num)) (tpu-backward-char-like-tpu @@ -194,6 +194,7 @@ "Move to next line. Prefix argument serves as a repeat count." (interactive "p") + (setq zmacs-region-stays t) (let ((beg (tpu-current-line))) (if tpu-cursor-free (or (eobp) (picture-move-down num)) (next-line-internal num)) @@ -204,6 +205,7 @@ "Move to previous line. Prefix argument serves as a repeat count." (interactive "p") + (setq zmacs-region-stays t) (let ((beg (tpu-current-line))) (if tpu-cursor-free (picture-move-up num) (next-line-internal (- num))) (tpu-top-check beg num) @@ -213,6 +215,7 @@ "Move to beginning of line; if at beginning, move to beginning of next line. Accepts a prefix argument for the number of lines to move." (interactive "p") + (setq zmacs-region-stays t) (let ((beg (tpu-current-line))) (backward-char 1) (forward-line (- 1 num)) @@ -222,6 +225,7 @@ "Move to end of line; if at end, move to end of next line. Accepts a prefix argument for the number of lines to move." (interactive "p") + (setq zmacs-region-stays t) (let ((beg (tpu-current-line))) (cond (tpu-cursor-free (let ((beg (point))) @@ -237,6 +241,7 @@ "Move EOL upward. Accepts a prefix argument for the number of lines to move." (interactive "p") + (setq zmacs-region-stays t) (let ((beg (tpu-current-line))) (cond (tpu-cursor-free (picture-end-of-line (- 1 num))) @@ -247,6 +252,7 @@ (defun tpu-current-end-of-line nil "Move point to end of current line." (interactive) + (setq zmacs-region-stays t) (let ((beg (point))) (if tpu-cursor-free (picture-end-of-line) (end-of-line)) (if (= beg (point)) (message "You are already at the end of a line.")))) @@ -264,6 +270,7 @@ "Move to beginning of previous line. Prefix argument serves as repeat count." (interactive "p") + (setq zmacs-region-stays t) (let ((beg (tpu-current-line))) (or (bolp) (>= 0 num) (setq num (- num 1))) (next-line-internal (- num)) @@ -277,6 +284,7 @@ "Move to the next paragraph in the current direction. A repeat count means move that many paragraphs." (interactive "p") + (setq zmacs-region-stays t) (let* ((left nil) (beg (tpu-current-line)) (height (window-height)) @@ -310,6 +318,7 @@ "Move to the next page in the current direction. A repeat count means move that many pages." (interactive "p") + (setq zmacs-region-stays t) (let* ((left nil) (beg (tpu-current-line)) (height (window-height)) @@ -343,6 +352,7 @@ "Scroll the display down to the next section. A repeat count means scroll that many sections." (interactive "p") + (setq zmacs-region-stays t) (let* ((beg (tpu-current-line)) (height (1- (window-height))) (lines (* num (/ (* height tpu-percent-scroll) 100)))) @@ -353,6 +363,7 @@ "Scroll the display up to the next section. A repeat count means scroll that many sections." (interactive "p") + (setq zmacs-region-stays t) (let* ((beg (tpu-current-line)) (height (1- (window-height))) (lines (* num (/ (* height tpu-percent-scroll) 100)))) @@ -404,6 +415,7 @@ In Auto Fill mode, can break the preceding line if no numeric arg. This is the TPU-edt version that respects the bottom scroll margin." (interactive "p") + (setq zmacs-region-stays t) (let ((beg (tpu-current-line))) (or num (setq num 1)) (tpu-old-newline num) @@ -417,6 +429,7 @@ to the specified left-margin column. This is the TPU-edt version that respects the bottom scroll margin." (interactive) + (setq zmacs-region-stays t) (let ((beg (tpu-current-line))) (tpu-old-newline-and-indent) (tpu-bottom-check beg 1))) @@ -436,6 +449,7 @@ (interactive "sEnter top scroll margin (N lines or N%% or RETURN for current value): \ \nsEnter bottom scroll margin (N lines or N%% or RETURN for current value): ") + (setq zmacs-region-stays t) ;; set top scroll margin (or (string= top "") (if (string= "%" (substring top -1)) @@ -462,6 +476,7 @@ (defun tpu-set-cursor-free nil "Allow the cursor to move freely about the screen." (interactive) + (setq zmacs-region-stays t) (setq tpu-cursor-free t) (substitute-key-definition 'tpu-set-cursor-free 'tpu-set-cursor-bound @@ -472,6 +487,7 @@ (defun tpu-set-cursor-bound nil "Constrain the cursor to the flow of the text." (interactive) + (setq zmacs-region-stays t) (picture-clean) (setq tpu-cursor-free nil) (substitute-key-definition 'tpu-set-cursor-bound