1;;; tpu-extras.el --- Scroll margins and free cursor mode for TPU-edt 2 3;; Copyright (C) 1993 Free Software Foundation, Inc. 4 5;; Author: Rob Riepel <riepel@networking.stanford.edu> 6;; Maintainer: Rob Riepel <riepel@networking.stanford.edu> 7;; Keywords: emulations 8 9;; This file is part of GNU Emacs. 10 11;; GNU Emacs is free software; you can redistribute it and/or modify 12;; it under the terms of the GNU General Public License as published by 13;; the Free Software Foundation; either version 2, or (at your option) 14;; any later version. 15 16;; GNU Emacs is distributed in the hope that it will be useful, 17;; but WITHOUT ANY WARRANTY; without even the implied warranty of 18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19;; GNU General Public License for more details. 20 21;; You should have received a copy of the GNU General Public License 22;; along with GNU Emacs; see the file COPYING. If not, write to 23;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. 24 25;;; Commentary: 26 27;; The functions contained in this file implement scroll margins and free 28;; cursor mode. The following keys and commands are affected. 29 30;; key/command function scroll cursor 31 32;; Up-Arrow previous line x x 33;; Down-Arrow next line x x 34;; Right-Arrow next character x 35;; Left-Arrow previous character x 36;; KP0 next or previous line x 37;; KP7 next or previous page x 38;; KP8 next or previous screen x 39;; KP2 next or previous end-of-line x x 40;; Control-e current end-of-line x 41;; Control-h previous beginning-of-line x 42;; Next Scr next screen x 43;; Prev Scr previous screen x 44;; Search find a string x 45;; Replace find and replace a string x 46;; Newline insert a newline x 47;; Paragraph next or previous paragraph x 48;; Auto-Fill break lines on spaces x 49 50;; These functions are not part of the base TPU-edt for the following 51;; reasons: 52 53;; Free cursor mode is implemented with the emacs picture-mode functions. 54;; These functions support moving the cursor all over the screen, however, 55;; when the cursor is moved past the end of a line, spaces or tabs are 56;; appended to the line - even if no text is entered in that area. In 57;; order for a free cursor mode to work exactly like TPU/edt, this trailing 58;; whitespace needs to be dealt with in every function that might encounter 59;; it. Such global changes are impractical, however, free cursor mode is 60;; too valuable to abandon completely, so it has been implemented in those 61;; functions where it serves best. 62 63;; The implementation of scroll margins adds overhead to previously 64;; simple and often used commands. These commands are now responsible 65;; for their normal operation and part of the display function. There 66;; is a possibility that this display overhead could adversely affect the 67;; performance of TPU-edt on slower computers. In order to support the 68;; widest range of computers, scroll margin support is optional. 69 70;; I don't know for a fact that the overhead associated with scroll 71;; margin support is significant. If you find that it is, please send me 72;; a note describing the extent of the performance degradation. Be sure 73;; to include a description of the platform where you're running TPU-edt. 74;; Send your note to the address provided by Gold-V. 75 76;; Even with these differences and limitations, these functions implement 77;; important aspects of the real TPU/edt. Those who miss free cursor mode 78;; and/or scroll margins will appreciate these implementations. 79 80;;; Usage: 81 82;; To use this file, simply load it after loading TPU-edt. After that, 83;; customize TPU-edt to your tastes by setting scroll margins and/or 84;; turning on free cursor mode. Here's an example for your .emacs file. 85 86;; (load "tpu-edt") ; Load the base TPU-edt 87;; (load "tpu-extras") ; and the extras. 88;; (tpu-set-scroll-margins "10%" "15%") ; Set scroll margins. 89 90;; Once the extras are loaded, scroll margins and cursor binding can be 91;; changed with the following commands: 92 93;; tpu-set-scroll-margins or set scroll margins 94;; tpu-set-cursor-bound or set cursor bound 95;; tpu-set-cursor-free or set cursor free 96 97;; Additionally, Gold-F toggles between bound and free cursor modes. 98 99;; Note that switching out of free cursor mode or exiting TPU-edt while in 100;; free cursor mode strips trailing whitespace from every line in the file. 101 102;;; Code: 103 104 105;;; Revision Information 106 107(defconst tpu-extras-revision "$Revision: 1.6 $" 108 "Revision number of the TPU-edt extras.") 109 110 111;;; Customization variables 112 113(defconst tpu-top-scroll-margin 0 114 "*Scroll margin at the top of the screen. 115Interpreted as a percent of the current window size.") 116(defconst tpu-bottom-scroll-margin 0 117 "*Scroll margin at the bottom of the screen. 118Interpreted as a percent of the current window size.") 119 120(defvar tpu-backward-char-like-tpu t 121 "*If non-nil, in free cursor mode backward-char (left-arrow) works 122just like TPU/edt. Otherwise, backward-char will move to the end of 123the previous line when starting from a line beginning.") 124 125 126;;; Global variables 127 128(defvar tpu-cursor-free nil 129 "If non-nil, let the cursor roam free.") 130 131 132;;; Hooks -- Set cursor free in picture mode. 133;;; Clean up when writing a file from cursor free mode. 134 135(if tpu-gnu-emacs18-p 136 (or (memq 'tpu-set-cursor-free edit-picture-hook) 137 (setq edit-picture-hook 138 (cons 'tpu-set-cursor-free edit-picture-hook))) 139 (add-hook 'picture-mode-hook 'tpu-set-cursor-free)) 140 141(defun tpu-write-file-hook nil 142 "Eliminate whitespace at ends of lines, if the cursor is free." 143 (if (and (buffer-modified-p) tpu-cursor-free) (picture-clean))) 144 145(or (memq 'tpu-write-file-hook write-file-hooks) 146 (setq write-file-hooks 147 (cons 'tpu-write-file-hook write-file-hooks))) 148 149 150;;; Utility routines for implementing scroll margins 151 152(defun tpu-top-check (beg lines) 153 "Enforce scroll margin at the top of screen." 154 (let ((margin (/ (* (window-height) tpu-top-scroll-margin) 100))) 155 (cond ((< beg margin) (recenter beg)) 156 ((< (- beg lines) margin) (recenter margin))))) 157 158(defun tpu-bottom-check (beg lines) 159 "Enforce scroll margin at the bottom of screen." 160 (let* ((height (window-height)) 161 (margin (+ 1 (/ (* height tpu-bottom-scroll-margin) 100))) 162 ;; subtract 1 from height because it includes mode line 163 (difference (- height margin 1))) 164 (cond ((> beg difference) (recenter beg)) 165 ((> (+ beg lines) difference) (recenter (- margin)))))) 166 167 168;;; Movement by character 169 170(defun tpu-forward-char (num) 171 "Move right ARG characters (left if ARG is negative)." 172 (interactive "p") 173 (if tpu-cursor-free (picture-forward-column num) (forward-char num))) 174 175(defun tpu-backward-char (num) 176 "Move left ARG characters (right if ARG is negative)." 177 (interactive "p") 178 (cond ((not tpu-cursor-free) 179 (backward-char num)) 180 (tpu-backward-char-like-tpu 181 (picture-backward-column num)) 182 ((bolp) 183 (backward-char 1) 184 (picture-end-of-line) 185 (picture-backward-column (1- num))) 186 (t 187 (picture-backward-column num)))) 188 189 190;;; Movement by line 191 192(defun tpu-next-line (num) 193 "Move to next line. 194Prefix argument serves as a repeat count." 195 (interactive "p") 196 (let ((beg (tpu-current-line))) 197 (if tpu-cursor-free (or (eobp) (picture-move-down num)) 198 (next-line-internal num)) 199 (tpu-bottom-check beg num) 200 (setq this-command 'next-line))) 201 202(defun tpu-previous-line (num) 203 "Move to previous line. 204Prefix argument serves as a repeat count." 205 (interactive "p") 206 (let ((beg (tpu-current-line))) 207 (if tpu-cursor-free (picture-move-up num) (next-line-internal (- num))) 208 (tpu-top-check beg num) 209 (setq this-command 'previous-line))) 210 211(defun tpu-next-beginning-of-line (num) 212 "Move to beginning of line; if at beginning, move to beginning of next line. 213Accepts a prefix argument for the number of lines to move." 214 (interactive "p") 215 (let ((beg (tpu-current-line))) 216 (backward-char 1) 217 (forward-line (- 1 num)) 218 (tpu-top-check beg num))) 219 220(defun tpu-next-end-of-line (num) 221 "Move to end of line; if at end, move to end of next line. 222Accepts a prefix argument for the number of lines to move." 223 (interactive "p") 224 (let ((beg (tpu-current-line))) 225 (cond (tpu-cursor-free 226 (let ((beg (point))) 227 (if (< 1 num) (forward-line num)) 228 (picture-end-of-line) 229 (if (<= (point) beg) (progn (forward-line) (picture-end-of-line))))) 230 (t 231 (forward-char) 232 (end-of-line num))) 233 (tpu-bottom-check beg num))) 234 235(defun tpu-previous-end-of-line (num) 236 "Move EOL upward. 237Accepts a prefix argument for the number of lines to move." 238 (interactive "p") 239 (let ((beg (tpu-current-line))) 240 (cond (tpu-cursor-free 241 (picture-end-of-line (- 1 num))) 242 (t 243 (end-of-line (- 1 num)))) 244 (tpu-top-check beg num))) 245 246(defun tpu-current-end-of-line nil 247 "Move point to end of current line." 248 (interactive) 249 (let ((beg (point))) 250 (if tpu-cursor-free (picture-end-of-line) (end-of-line)) 251 (if (= beg (point)) (message "You are already at the end of a line.")))) 252 253(defun tpu-forward-line (num) 254 "Move to beginning of next line. 255Prefix argument serves as a repeat count." 256 (interactive "p") 257 (let ((beg (tpu-current-line))) 258 (next-line-internal num) 259 (tpu-bottom-check beg num) 260 (beginning-of-line))) 261 262(defun tpu-backward-line (num) 263 "Move to beginning of previous line. 264Prefix argument serves as repeat count." 265 (interactive "p") 266 (let ((beg (tpu-current-line))) 267 (next-line-internal (- num)) 268 (tpu-top-check beg num) 269 (beginning-of-line))) 270 271 272;;; Movement by paragraph 273 274(defun tpu-paragraph (num) 275 "Move to the next paragraph in the current direction. 276A repeat count means move that many paragraphs." 277 (interactive "p") 278 (let* ((left nil) 279 (beg (tpu-current-line)) 280 (height (window-height)) 281 (top-percent 282 (if (= 0 tpu-top-scroll-margin) 10 tpu-top-scroll-margin)) 283 (bottom-percent 284 (if (= 0 tpu-bottom-scroll-margin) 15 tpu-bottom-scroll-margin)) 285 (top-margin (/ (* height top-percent) 100)) 286 (bottom-up-margin (+ 1 (/ (* height bottom-percent) 100))) 287 (bottom-margin (max beg (- height bottom-up-margin 1))) 288 (top (save-excursion (move-to-window-line top-margin) (point))) 289 (bottom (save-excursion (move-to-window-line bottom-margin) (point))) 290 (far (save-excursion 291 (goto-char bottom) (forward-line (- height 2)) (point)))) 292 (cond (tpu-advance 293 (tpu-next-paragraph num) 294 (cond((> (point) far) 295 (setq left (save-excursion (forward-line height))) 296 (if (= 0 left) (recenter top-margin) 297 (recenter (- left bottom-up-margin)))) 298 (t 299 (and (> (point) bottom) (recenter bottom-margin))))) 300 (t 301 (tpu-previous-paragraph num) 302 (and (< (point) top) (recenter (min beg top-margin))))))) 303 304 305;;; Movement by page 306 307(defun tpu-page (num) 308 "Move to the next page in the current direction. 309A repeat count means move that many pages." 310 (interactive "p") 311 (let* ((left nil) 312 (beg (tpu-current-line)) 313 (height (window-height)) 314 (top-percent 315 (if (= 0 tpu-top-scroll-margin) 10 tpu-top-scroll-margin)) 316 (bottom-percent 317 (if (= 0 tpu-bottom-scroll-margin) 15 tpu-bottom-scroll-margin)) 318 (top-margin (/ (* height top-percent) 100)) 319 (bottom-up-margin (+ 1 (/ (* height bottom-percent) 100))) 320 (bottom-margin (max beg (- height bottom-up-margin 1))) 321 (top (save-excursion (move-to-window-line top-margin) (point))) 322 (bottom (save-excursion (move-to-window-line bottom-margin) (point))) 323 (far (save-excursion 324 (goto-char bottom) (forward-line (- height 2)) (point)))) 325 (cond (tpu-advance 326 (forward-page num) 327 (cond((> (point) far) 328 (setq left (save-excursion (forward-line height))) 329 (if (= 0 left) (recenter top-margin) 330 (recenter (- left bottom-up-margin)))) 331 (t 332 (and (> (point) bottom) (recenter bottom-margin))))) 333 (t 334 (backward-page num) 335 (and (< (point) top) (recenter (min beg top-margin))))))) 336 337 338;;; Scrolling 339 340(defun tpu-scroll-window-down (num) 341 "Scroll the display down to the next section. 342A repeat count means scroll that many sections." 343 (interactive "p") 344 (let* ((beg (tpu-current-line)) 345 (height (1- (window-height))) 346 (lines (* num (/ (* height tpu-percent-scroll) 100)))) 347 (next-line-internal (- lines)) 348 (tpu-top-check beg lines))) 349 350(defun tpu-scroll-window-up (num) 351 "Scroll the display up to the next section. 352A repeat count means scroll that many sections." 353 (interactive "p") 354 (let* ((beg (tpu-current-line)) 355 (height (1- (window-height))) 356 (lines (* num (/ (* height tpu-percent-scroll) 100)))) 357 (next-line-internal lines) 358 (tpu-bottom-check beg lines))) 359 360 361;;; Replace the TPU-edt internal search function 362 363(defun tpu-search-internal (pat &optional quiet) 364 "Search for a string or regular expression." 365 (let* ((left nil) 366 (beg (tpu-current-line)) 367 (height (window-height)) 368 (top-percent 369 (if (= 0 tpu-top-scroll-margin) 10 tpu-top-scroll-margin)) 370 (bottom-percent 371 (if (= 0 tpu-bottom-scroll-margin) 15 tpu-bottom-scroll-margin)) 372 (top-margin (/ (* height top-percent) 100)) 373 (bottom-up-margin (+ 1 (/ (* height bottom-percent) 100))) 374 (bottom-margin (max beg (- height bottom-up-margin 1))) 375 (top (save-excursion (move-to-window-line top-margin) (point))) 376 (bottom (save-excursion (move-to-window-line bottom-margin) (point))) 377 (far (save-excursion 378 (goto-char bottom) (forward-line (- height 2)) (point)))) 379 (tpu-search-internal-core pat quiet) 380 (if tpu-searching-forward 381 (cond((> (point) far) 382 (setq left (save-excursion (forward-line height))) 383 (if (= 0 left) (recenter top-margin) 384 (recenter (- left bottom-up-margin)))) 385 (t 386 (and (> (point) bottom) (recenter bottom-margin)))) 387 (and (< (point) top) (recenter (min beg top-margin)))))) 388 389 390 391;;; Replace the newline, newline-and-indent, and do-auto-fill functions 392 393(or (fboundp 'tpu-old-newline) 394 (fset 'tpu-old-newline (symbol-function 'newline))) 395(or (fboundp 'tpu-old-do-auto-fill) 396 (fset 'tpu-old-do-auto-fill (symbol-function 'do-auto-fill))) 397(or (fboundp 'tpu-old-newline-and-indent) 398 (fset 'tpu-old-newline-and-indent (symbol-function 'newline-and-indent))) 399 400(defun newline (&optional num) 401 "Insert a newline. With arg, insert that many newlines. 402In Auto Fill mode, can break the preceding line if no numeric arg. 403This is the TPU-edt version that respects the bottom scroll margin." 404 (interactive "p") 405 (let ((beg (tpu-current-line))) 406 (or num (setq num 1)) 407 (tpu-old-newline num) 408 (tpu-bottom-check beg num))) 409 410(defun newline-and-indent nil 411 "Insert a newline, then indent according to major mode. 412Indentation is done using the current indent-line-function. 413In programming language modes, this is the same as TAB. 414In some text modes, where TAB inserts a tab, this indents 415to the specified left-margin column. This is the TPU-edt 416version that respects the bottom scroll margin." 417 (interactive) 418 (let ((beg (tpu-current-line))) 419 (tpu-old-newline-and-indent) 420 (tpu-bottom-check beg 1))) 421 422(defun do-auto-fill nil 423 "TPU-edt version that respects the bottom scroll margin." 424 (let ((beg (tpu-current-line))) 425 (tpu-old-do-auto-fill) 426 (tpu-bottom-check beg 1))) 427 428 429;;; Function to set scroll margins 430 431;;;###autoload 432(defun tpu-set-scroll-margins (top bottom) 433 "Set scroll margins." 434 (interactive 435 "sEnter top scroll margin (N lines or N%% or RETURN for current value): \ 436\nsEnter bottom scroll margin (N lines or N%% or RETURN for current value): ") 437 ;; set top scroll margin 438 (or (string= top "") 439 (if (string= "%" (substring top -1)) 440 (setq tpu-top-scroll-margin (string-to-int top)) 441 (setq tpu-top-scroll-margin 442 (/ (1- (+ (* (string-to-int top) 100) (window-height))) 443 (window-height))))) 444 ;; set bottom scroll margin 445 (or (string= bottom "") 446 (if (string= "%" (substring bottom -1)) 447 (setq tpu-bottom-scroll-margin (string-to-int bottom)) 448 (setq tpu-bottom-scroll-margin 449 (/ (1- (+ (* (string-to-int bottom) 100) (window-height))) 450 (window-height))))) 451 ;; report scroll margin settings if running interactively 452 (and (interactive-p) 453 (message "Scroll margins set. Top = %s%%, Bottom = %s%%" 454 tpu-top-scroll-margin tpu-bottom-scroll-margin))) 455 456 457;;; Functions to set cursor bound or free 458 459;;;###autoload 460(defun tpu-set-cursor-free nil 461 "Allow the cursor to move freely about the screen." 462 (interactive) 463 (setq tpu-cursor-free t) 464 (substitute-key-definition 'tpu-set-cursor-free 465 'tpu-set-cursor-bound 466 GOLD-map) 467 (message "The cursor will now move freely about the screen.")) 468 469;;;###autoload 470(defun tpu-set-cursor-bound nil 471 "Constrain the cursor to the flow of the text." 472 (interactive) 473 (picture-clean) 474 (setq tpu-cursor-free nil) 475 (substitute-key-definition 'tpu-set-cursor-bound 476 'tpu-set-cursor-free 477 GOLD-map) 478 (message "The cursor is now bound to the flow of your text.")) 479 480;;; tpu-extras.el ends here 481