;;; tpu-extras.el --- Scroll margins and free cursor mode for TPU-edt;; Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc.;; Author: Rob Riepel <riepel@networking.stanford.edu>;; Maintainer: Rob Riepel <riepel@networking.stanford.edu>;; 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;; the Free Software Foundation; either version 2, or (at your option);; any later version.;; 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.;; 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.;;; Synced up with FSF 19.34 and XEmacs 21.0;;; Commentary:;; Use the functions defined here to customize TPU-edt to your tastes by;; setting scroll margins and/or turning on free cursor mode. Here's an;; example for your .emacs file.;; (tpu-set-cursor-free) ; Set cursor free.;; (tpu-set-scroll-margins "10%" "15%") ; Set scroll margins.;; Scroll margins and cursor binding can be changed from within emacs using;; the following commands:;; tpu-set-scroll-margins or set scroll margins;; tpu-set-cursor-bound or set cursor bound;; tpu-set-cursor-free or set cursor free;; Additionally, Gold-F toggles between bound and free cursor modes.;; Note that switching out of free cursor mode or exiting TPU-edt while in;; free cursor mode strips trailing whitespace from every line in the file.;;; Details:;; The functions contained in this file implement scroll margins and free;; cursor mode. The following keys and commands are affected.;; key/command function scroll cursor;; Up-Arrow previous line x x;; Down-Arrow next line x x;; Right-Arrow next character x;; Left-Arrow previous character x;; KP0 next or previous line x;; KP7 next or previous page x;; KP8 next or previous screen x;; KP2 next or previous end-of-line x x;; Control-e current end-of-line x;; Control-h previous beginning-of-line x;; Next Scr next screen x;; Prev Scr previous screen x;; Search find a string x;; Replace find and replace a string x;; Newline insert a newline x;; Paragraph next or previous paragraph x;; Auto-Fill break lines on spaces x;; These functions are not part of the base TPU-edt for the following;; reasons:;; Free cursor mode is implemented with the emacs picture-mode functions.;; These functions support moving the cursor all over the screen, however,;; when the cursor is moved past the end of a line, spaces or tabs are;; appended to the line - even if no text is entered in that area. In;; order for a free cursor mode to work exactly like TPU/edt, this trailing;; whitespace needs to be dealt with in every function that might encounter;; it. Such global changes are impractical, however, free cursor mode is;; too valuable to abandon completely, so it has been implemented in those;; functions where it serves best.;; The implementation of scroll margins adds overhead to previously;; simple and often used commands. These commands are now responsible;; for their normal operation and part of the display function. There;; is a possibility that this display overhead could adversely affect the;; performance of TPU-edt on slower computers. In order to support the;; widest range of computers, scroll margin support is optional.;; It's actually not known whether the overhead associated with scroll;; margin support is significant. If you find that it is, please send;; a note describing the extent of the performance degradation. Be sure;; to include a description of the platform where you're running TPU-edt.;; Send your note to the address provided by Gold-V.;; Even with these differences and limitations, these functions implement;; important aspects of the real TPU/edt. Those who miss free cursor mode;; and/or scroll margins will appreciate these implementations.;;; Code:;;; Gotta have tpu-edt(require'tpu-edt);;; Customization variables(defcustomtpu-top-scroll-margin0"*Scroll margin at the top of the screen.Interpreted as a percent of the current window size.":type'integer:group'tpu)(defcustomtpu-bottom-scroll-margin0"*Scroll margin at the bottom of the screen.Interpreted as a percent of the current window size.":type'integer:group'tpu)(defcustomtpu-backward-char-like-tput"*If non-nil, in free cursor mode backward-char (left-arrow) worksjust like TPU/edt. Otherwise, backward-char will move to the end ofthe previous line when starting from a line beginning.":type'boolean:group'tpu);;; Global variables(defvartpu-cursor-freenil"If non-nil, let the cursor roam free.");;; Hooks -- Set cursor free in picture mode.;;; Clean up when writing a file from cursor free mode.(add-hook'picture-mode-hook'tpu-set-cursor-free)(defuntpu-write-file-hooknil"Eliminate whitespace at ends of lines, if the cursor is free."(if(and(buffer-modified-p)tpu-cursor-free)(picture-clean)))(or(memq'tpu-write-file-hookwrite-file-hooks)(setqwrite-file-hooks(cons'tpu-write-file-hookwrite-file-hooks)));;; Utility routines for implementing scroll margins(defuntpu-top-check(beglines)"Enforce scroll margin at the top of screen."(let((margin(/(*(window-height)tpu-top-scroll-margin)100)))(cond((<begmargin)(recenterbeg))((<(-beglines)margin)(recentermargin)))))(defuntpu-bottom-check(beglines)"Enforce scroll margin at the bottom of screen."(let*((height(window-height))(margin(+1(/(*heighttpu-bottom-scroll-margin)100)));; subtract 1 from height because it includes mode line(difference(-heightmargin1)))(cond((>begdifference)(recenterbeg))((>(+beglines)difference)(recenter(-margin))))));;; Movement by character(defuntpu-forward-char(num)"Move right ARG characters (left if ARG is negative)."(interactive"p")(setqzmacs-region-stayst)(iftpu-cursor-free(picture-forward-columnnum)(forward-charnum)))(defuntpu-backward-char(num)"Move left ARG characters (right if ARG is negative)."(interactive"p")(setqzmacs-region-stayst)(cond((nottpu-cursor-free)(backward-charnum))(tpu-backward-char-like-tpu(picture-backward-columnnum))((bolp)(backward-char1)(picture-end-of-line)(picture-backward-column(1-num)))(t(picture-backward-columnnum))));;; Movement by line(defuntpu-next-line(num)"Move to next line.Prefix argument serves as a repeat count."(interactive"p")(setqzmacs-region-stayst)(let((beg(tpu-current-line)))(iftpu-cursor-free(or(eobp)(picture-move-downnum))(next-line-internalnum))(tpu-bottom-checkbegnum)(setqthis-command'next-line)))(defuntpu-previous-line(num)"Move to previous line.Prefix argument serves as a repeat count."(interactive"p")(setqzmacs-region-stayst)(let((beg(tpu-current-line)))(iftpu-cursor-free(picture-move-upnum)(next-line-internal(-num)))(tpu-top-checkbegnum)(setqthis-command'previous-line)))(defuntpu-next-beginning-of-line(num)"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")(setqzmacs-region-stayst)(let((beg(tpu-current-line)))(backward-char1)(forward-line(-1num))(tpu-top-checkbegnum)))(defuntpu-next-end-of-line(num)"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")(setqzmacs-region-stayst)(let((beg(tpu-current-line)))(cond(tpu-cursor-free(let((beg(point)))(if(<1num)(forward-linenum))(picture-end-of-line)(if(<=(point)beg)(progn(forward-line)(picture-end-of-line)))))(t(forward-char)(end-of-linenum)))(tpu-bottom-checkbegnum)))(defuntpu-previous-end-of-line(num)"Move EOL upward.Accepts a prefix argument for the number of lines to move."(interactive"p")(setqzmacs-region-stayst)(let((beg(tpu-current-line)))(cond(tpu-cursor-free(picture-end-of-line(-1num)))(t(end-of-line(-1num))))(tpu-top-checkbegnum)))(defuntpu-current-end-of-linenil"Move point to end of current line."(interactive)(setqzmacs-region-stayst)(let((beg(point)))(iftpu-cursor-free(picture-end-of-line)(end-of-line))(if(=beg(point))(message"You are already at the end of a line."))))(defuntpu-forward-line(num)"Move to beginning of next line.Prefix argument serves as a repeat count."(interactive"p")(let((beg(tpu-current-line)))(next-line-internalnum)(tpu-bottom-checkbegnum)(beginning-of-line)))(defuntpu-backward-line(num)"Move to beginning of previous line.Prefix argument serves as repeat count."(interactive"p")(setqzmacs-region-stayst)(let((beg(tpu-current-line)))(or(bolp)(>=0num)(setqnum(-num1)))(next-line-internal(-num))(tpu-top-checkbegnum)(beginning-of-line)));;; Movement by paragraph(defuntpu-paragraph(num)"Move to the next paragraph in the current direction.A repeat count means move that many paragraphs."(interactive"p")(setqzmacs-region-stayst)(let*((leftnil)(beg(tpu-current-line))(height(window-height))(top-percent(if(=0tpu-top-scroll-margin)10tpu-top-scroll-margin))(bottom-percent(if(=0tpu-bottom-scroll-margin)15tpu-bottom-scroll-margin))(top-margin(/(*heighttop-percent)100))(bottom-up-margin(+1(/(*heightbottom-percent)100)))(bottom-margin(maxbeg(-heightbottom-up-margin1)))(top(save-excursion(move-to-window-linetop-margin)(point)))(bottom(save-excursion(move-to-window-linebottom-margin)(point)))(far(save-excursion(goto-charbottom)(forward-line(-height2))(point))))(cond(tpu-advance(tpu-next-paragraphnum)(cond((>(point)far)(setqleft(save-excursion(forward-lineheight)))(if(=0left)(recentertop-margin)(recenter(-leftbottom-up-margin))))(t(and(>(point)bottom)(recenterbottom-margin)))))(t(tpu-previous-paragraphnum)(and(<(point)top)(recenter(minbegtop-margin)))))));;; Movement by page(defuntpu-page(num)"Move to the next page in the current direction.A repeat count means move that many pages."(interactive"p")(setqzmacs-region-stayst)(let*((leftnil)(beg(tpu-current-line))(height(window-height))(top-percent(if(=0tpu-top-scroll-margin)10tpu-top-scroll-margin))(bottom-percent(if(=0tpu-bottom-scroll-margin)15tpu-bottom-scroll-margin))(top-margin(/(*heighttop-percent)100))(bottom-up-margin(+1(/(*heightbottom-percent)100)))(bottom-margin(maxbeg(-heightbottom-up-margin1)))(top(save-excursion(move-to-window-linetop-margin)(point)))(bottom(save-excursion(move-to-window-linebottom-margin)(point)))(far(save-excursion(goto-charbottom)(forward-line(-height2))(point))))(cond(tpu-advance(forward-pagenum)(cond((>(point)far)(setqleft(save-excursion(forward-lineheight)))(if(=0left)(recentertop-margin)(recenter(-leftbottom-up-margin))))(t(and(>(point)bottom)(recenterbottom-margin)))))(t(backward-pagenum)(and(<(point)top)(recenter(minbegtop-margin)))))));;; Scrolling(defuntpu-scroll-window-down(num)"Scroll the display down to the next section.A repeat count means scroll that many sections."(interactive"p")(setqzmacs-region-stayst)(let*((beg(tpu-current-line))(height(1-(window-height)))(lines(*num(/(*heighttpu-percent-scroll)100))))(next-line-internal(-lines))(tpu-top-checkbeglines)))(defuntpu-scroll-window-up(num)"Scroll the display up to the next section.A repeat count means scroll that many sections."(interactive"p")(setqzmacs-region-stayst)(let*((beg(tpu-current-line))(height(1-(window-height)))(lines(*num(/(*heighttpu-percent-scroll)100))))(next-line-internallines)(tpu-bottom-checkbeglines)));;; Replace the TPU-edt internal search function(defuntpu-search-internal(pat&optionalquiet)"Search for a string or regular expression."(let*((leftnil)(beg(tpu-current-line))(height(window-height))(top-percent(if(=0tpu-top-scroll-margin)10tpu-top-scroll-margin))(bottom-percent(if(=0tpu-bottom-scroll-margin)15tpu-bottom-scroll-margin))(top-margin(/(*heighttop-percent)100))(bottom-up-margin(+1(/(*heightbottom-percent)100)))(bottom-margin(maxbeg(-heightbottom-up-margin1)))(top(save-excursion(move-to-window-linetop-margin)(point)))(bottom(save-excursion(move-to-window-linebottom-margin)(point)))(far(save-excursion(goto-charbottom)(forward-line(-height2))(point))))(tpu-search-internal-corepatquiet)(iftpu-searching-forward(cond((>(point)far)(setqleft(save-excursion(forward-lineheight)))(if(=0left)(recentertop-margin)(recenter(-leftbottom-up-margin))))(t(and(>(point)bottom)(recenterbottom-margin))))(and(<(point)top)(recenter(minbegtop-margin))))));;; Replace the newline, newline-and-indent, and do-auto-fill functions(or(fboundp'tpu-old-newline)(fset'tpu-old-newline(symbol-function'newline)))(or(fboundp'tpu-old-do-auto-fill)(fset'tpu-old-do-auto-fill(symbol-function'do-auto-fill)))(or(fboundp'tpu-old-newline-and-indent)(fset'tpu-old-newline-and-indent(symbol-function'newline-and-indent)))(defunnewline(&optionalnum)"Insert a newline. With arg, insert that many newlines.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")(setqzmacs-region-stayst)(let((beg(tpu-current-line)))(ornum(setqnum1))(tpu-old-newlinenum)(tpu-bottom-checkbegnum)))(defunnewline-and-indentnil"Insert a newline, then indent according to major mode.Indentation is done using the current indent-line-function.In programming language modes, this is the same as TAB.In some text modes, where TAB inserts a tab, this indentsto the specified left-margin column. This is the TPU-edtversion that respects the bottom scroll margin."(interactive)(setqzmacs-region-stayst)(let((beg(tpu-current-line)))(tpu-old-newline-and-indent)(tpu-bottom-checkbeg1)))(defundo-auto-fillnil"TPU-edt version that respects the bottom scroll margin."(let((beg(tpu-current-line)))(tpu-old-do-auto-fill)(tpu-bottom-checkbeg1)));;; Function to set scroll margins;;;###autoload(defuntpu-set-scroll-margins(topbottom)"Set scroll margins."(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): ")(setqzmacs-region-stayst);; set top scroll margin(or(string=top"")(if(string="%"(substringtop-1))(setqtpu-top-scroll-margin(string-to-inttop))(setqtpu-top-scroll-margin(/(1-(+(*(string-to-inttop)100)(window-height)))(window-height)))));; set bottom scroll margin(or(string=bottom"")(if(string="%"(substringbottom-1))(setqtpu-bottom-scroll-margin(string-to-intbottom))(setqtpu-bottom-scroll-margin(/(1-(+(*(string-to-intbottom)100)(window-height)))(window-height)))));; report scroll margin settings if running interactively(and(interactive-p)(message"Scroll margins set. Top = %s%%, Bottom = %s%%"tpu-top-scroll-margintpu-bottom-scroll-margin)));;; Functions to set cursor bound or free;;;###autoload(defuntpu-set-cursor-freenil"Allow the cursor to move freely about the screen."(interactive)(setqzmacs-region-stayst)(setqtpu-cursor-freet)(substitute-key-definition'tpu-set-cursor-free'tpu-set-cursor-boundGOLD-map)(message"The cursor will now move freely about the screen."));;;###autoload(defuntpu-set-cursor-boundnil"Constrain the cursor to the flow of the text."(interactive)(setqzmacs-region-stayst)(picture-clean)(setqtpu-cursor-freenil)(substitute-key-definition'tpu-set-cursor-bound'tpu-set-cursor-freeGOLD-map)(message"The cursor is now bound to the flow of your text."));;; tpu-extras.el ends here