;;; 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, 2008 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 3, 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-before-save-hook ()
+(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)))
-
-(add-hook 'before-save-hook 'tpu-before-save-hook)
+ (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))
+ (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) (line-move (- 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))))
"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)))
- (line-move 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)))
- (line-move (- num))
- (tpu-top-check beg num)
- (beginning-of-line)))
+ (forward-line (- num))
+ (tpu-top-check beg num)))
;;; Movement by paragraph
(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)))
(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 ()
"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."))
+ (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