;;; tpu-extras.el --- scroll margins and free cursor mode for TPU-edt
;; Copyright (C) 1993, 1994, 1995, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007 Free Software Foundation, Inc.
+;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Author: Rob Riepel <riepel@networking.stanford.edu>
;; Maintainer: Rob Riepel <riepel@networking.stanford.edu>
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs 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.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;; Customization variables
(defcustom tpu-top-scroll-margin 0
- "*Scroll margin at the top of the screen.
+ "Scroll margin at the top of the screen.
Interpreted as a percent of the current window size."
:type 'integer
:group 'tpu)
(defcustom tpu-bottom-scroll-margin 0
- "*Scroll margin at the bottom of the screen.
+ "Scroll margin at the bottom of the screen.
Interpreted as a percent of the current window size."
:type 'integer
:group 'tpu)
(defcustom tpu-backward-char-like-tpu t
- "*If non-nil, in free cursor mode backward-char (left-arrow) works
+ "If non-nil, in free cursor mode backward-char (left-arrow) works
just like TPU/edt. Otherwise, backward-char will move to the end of
the previous line when starting from a line beginning."
:type 'boolean
;;; Global variables
-(defvar tpu-cursor-free nil
- "If non-nil, let the cursor roam free.")
+;;;###autoload
+(define-minor-mode tpu-cursor-free-mode
+ "Minor mode to allow the cursor to move freely about the screen."
+ :init-value nil
+ (if (not tpu-cursor-free-mode)
+ (tpu-trim-line-ends))
+ (if (not tpu-cursor-free-mode)
+ (message "The cursor is now bound to the flow of your text.")
+ (message "The cursor will now move freely about the screen.")))
;;; Hooks -- Set cursor free in picture mode.
(add-hook 'picture-mode-hook 'tpu-set-cursor-free)
-(defun tpu-write-file-hook nil
+(defun tpu-trim-line-ends-if-needed ()
"Eliminate whitespace at ends of lines, if the cursor is free."
- (if (and (buffer-modified-p) tpu-cursor-free) (tpu-trim-line-ends)))
-
-(or (memq 'tpu-write-file-hook write-file-functions)
- (setq write-file-functions
- (cons 'tpu-write-file-hook write-file-functions)))
+ (if (and (buffer-modified-p) tpu-cursor-free-mode) (tpu-trim-line-ends)))
+(add-hook 'before-save-hook 'tpu-trim-line-ends-if-needed)
;;; Utility routines for implementing scroll margins
(defun tpu-forward-char (num)
"Move right ARG characters (left if ARG is negative)."
(interactive "p")
- (if tpu-cursor-free (picture-forward-column num) (forward-char num)))
+ (if tpu-cursor-free-mode (picture-forward-column num) (forward-char num)))
(defun tpu-backward-char (num)
"Move left ARG characters (right if ARG is negative)."
(interactive "p")
- (cond ((not tpu-cursor-free)
+ (cond ((not tpu-cursor-free-mode)
(backward-char num))
(tpu-backward-char-like-tpu
(picture-backward-column num))
Prefix argument serves as a repeat count."
(interactive "p")
(let ((beg (tpu-current-line)))
- (if tpu-cursor-free (or (eobp) (picture-move-down num))
- (next-line-internal num))
+ (if tpu-cursor-free-mode (or (eobp) (picture-move-down num))
+ (line-move num))
(tpu-bottom-check beg num)
(setq this-command 'next-line)))
Prefix argument serves as a repeat count."
(interactive "p")
(let ((beg (tpu-current-line)))
- (if tpu-cursor-free (picture-move-up num) (next-line-internal (- num)))
+ (if tpu-cursor-free-mode (picture-move-up num) (line-move (- num)))
(tpu-top-check beg num)
(setq this-command 'previous-line)))
Accepts a prefix argument for the number of lines to move."
(interactive "p")
(let ((beg (tpu-current-line)))
- (cond (tpu-cursor-free
+ (cond (tpu-cursor-free-mode
(let ((beg (point)))
(if (< 1 num) (forward-line num))
(picture-end-of-line)
Accepts a prefix argument for the number of lines to move."
(interactive "p")
(let ((beg (tpu-current-line)))
- (cond (tpu-cursor-free
+ (cond (tpu-cursor-free-mode
(picture-end-of-line (- 1 num)))
(t
(end-of-line (- 1 num))))
(tpu-top-check beg num)))
-(defun tpu-current-end-of-line nil
+(defun tpu-current-end-of-line ()
"Move point to end of current line."
(interactive)
(let ((beg (point)))
- (if tpu-cursor-free (picture-end-of-line) (end-of-line))
+ (if tpu-cursor-free-mode (picture-end-of-line) (end-of-line))
(if (= beg (point)) (message "You are already at the end of a line."))))
(defun tpu-forward-line (num)
Prefix argument serves as a repeat count."
(interactive "p")
(let ((beg (tpu-current-line)))
- (next-line-internal num)
- (tpu-bottom-check beg num)
- (beginning-of-line)))
+ (forward-line num)
+ (tpu-bottom-check beg num)))
(defun tpu-backward-line (num)
"Move to beginning of previous line.
(interactive "p")
(let ((beg (tpu-current-line)))
(or (bolp) (>= 0 num) (setq num (- num 1)))
- (next-line-internal (- num))
- (tpu-top-check beg num)
- (beginning-of-line)))
+ (forward-line (- num))
+ (tpu-top-check beg num)))
;;; Movement by paragraph
(let* ((beg (tpu-current-line))
(height (1- (window-height)))
(lines (* num (/ (* height tpu-percent-scroll) 100))))
- (next-line-internal (- lines))
+ (line-move (- lines))
(tpu-top-check beg lines)))
(defun tpu-scroll-window-up (num)
(let* ((beg (tpu-current-line))
(height (1- (window-height)))
(lines (* num (/ (* height tpu-percent-scroll) 100))))
- (next-line-internal lines)
+ (line-move lines)
(tpu-bottom-check beg lines)))
-;;; 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)))
-
-(defun newline (&optional num)
- "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")
- (let ((beg (tpu-current-line)))
- (or num (setq num 1))
- (tpu-old-newline num)
+;; Advise the newline, newline-and-indent, and do-auto-fill functions.
+(defadvice newline (around tpu-respect-bottom-scroll-margin activate disable)
+ "Respect `tpu-bottom-scroll-margin'."
+ (let ((beg (tpu-current-line))
+ (num (prefix-numeric-value (ad-get-arg 0))))
+ ad-do-it
(tpu-bottom-check beg num)))
-(defun newline-and-indent nil
- "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 indents
-to the specified left-margin column. This is the TPU-edt
-version that respects the bottom scroll margin."
- (interactive)
+(defadvice newline-and-indent (around tpu-respect-bottom-scroll-margin)
+ "Respect `tpu-bottom-scroll-margin'."
(let ((beg (tpu-current-line)))
- (tpu-old-newline-and-indent)
+ ad-do-it
(tpu-bottom-check beg 1)))
-(defun do-auto-fill nil
- "TPU-edt version that respects the bottom scroll margin."
+(defadvice do-auto-fill (around tpu-respect-bottom-scroll-margin)
+ "Respect `tpu-bottom-scroll-margin'."
(let ((beg (tpu-current-line)))
- (tpu-old-do-auto-fill)
+ ad-do-it
(tpu-bottom-check beg 1)))
\nsEnter bottom scroll margin (N lines or N%% or RETURN for current value): ")
;; set top scroll margin
(or (string= top "")
- (if (string= "%" (substring top -1))
- (setq tpu-top-scroll-margin (string-to-number top))
- (setq tpu-top-scroll-margin
+ (setq tpu-top-scroll-margin
+ (if (string= "%" (substring top -1))
+ (string-to-number top)
(/ (1- (+ (* (string-to-number top) 100) (window-height)))
(window-height)))))
;; set bottom scroll margin
(or (string= bottom "")
- (if (string= "%" (substring bottom -1))
- (setq tpu-bottom-scroll-margin (string-to-number bottom))
- (setq tpu-bottom-scroll-margin
+ (setq tpu-bottom-scroll-margin
+ (if (string= "%" (substring bottom -1))
+ (string-to-number bottom)
(/ (1- (+ (* (string-to-number bottom) 100) (window-height)))
(window-height)))))
+ (dolist (f '(newline newline-and-indent do-auto-fill))
+ (ad-enable-advice f 'around 'tpu-respect-bottom-scroll-margin)
+ (ad-activate f))
;; report scroll margin settings if running interactively
- (and (interactive-p)
+ (and (called-interactively-p 'interactive)
(message "Scroll margins set. Top = %s%%, Bottom = %s%%"
tpu-top-scroll-margin tpu-bottom-scroll-margin)))
;;; Functions to set cursor bound or free
;;;###autoload
-(defun tpu-set-cursor-free nil
+(defun tpu-set-cursor-free ()
"Allow the cursor to move freely about the screen."
(interactive)
- (setq tpu-cursor-free t)
- (substitute-key-definition 'tpu-set-cursor-free
- 'tpu-set-cursor-bound
- GOLD-map)
- (message "The cursor will now move freely about the screen."))
+ (tpu-cursor-free-mode 1))
;;;###autoload
-(defun tpu-set-cursor-bound nil
+(defun tpu-set-cursor-bound ()
"Constrain the cursor to the flow of the text."
(interactive)
- (tpu-trim-line-ends)
- (setq tpu-cursor-free nil)
- (substitute-key-definition 'tpu-set-cursor-bound
- 'tpu-set-cursor-free
- GOLD-map)
- (message "The cursor is now bound to the flow of your text."))
-
-;;; arch-tag: 89676fa4-33ec-48cb-9135-6f3bf230ab1a
+ (tpu-cursor-free-mode -1))
+
+;; Local Variables:
+;; generated-autoload-file: "tpu-edt.el"
+;; End:
+
+;; arch-tag: 89676fa4-33ec-48cb-9135-6f3bf230ab1a
;;; tpu-extras.el ends here
HCoop / bpt / emacs.git / blobdiff