;;; 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.
+;; Copyright (C) 1993-1995, 2000-2013 Free Software Foundation, Inc.
;; Author: Rob Riepel <riepel@networking.stanford.edu>
;; Maintainer: Rob Riepel <riepel@networking.stanford.edu>
;; Keywords: emulations
+;; Package: tpu-edt
;; This file is part of GNU Emacs.
;; 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.
+;; example for your init file.
;; (tpu-set-cursor-free) ; Set cursor free.
;; (tpu-set-scroll-margins "10%" "15%") ; Set scroll margins.
;;;###autoload
(define-minor-mode tpu-cursor-free-mode
- "Minor mode to allow the cursor to move freely about the screen."
+ "Minor mode to allow the cursor to move freely about the screen.
+With a prefix argument ARG, enable the mode if ARG is positive,
+and disable it otherwise. If called from Lisp, enable the mode
+if ARG is omitted or nil."
:init-value nil
(if (not tpu-cursor-free-mode)
- (tpu-trim-line-ends)))
+ (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.
;;; Movement by paragraph
+;; Cf edt-with-position.
+(defmacro tpu-with-position (&rest body)
+ "Execute BODY with some position-related variables bound."
+ `(let* ((left nil)
+ (beg (tpu-current-line))
+ (height (window-height))
+ (top-percent
+ (if (zerop tpu-top-scroll-margin) 10 tpu-top-scroll-margin))
+ (bottom-percent
+ (if (zerop tpu-bottom-scroll-margin) 15 tpu-bottom-scroll-margin))
+ (top-margin (/ (* height top-percent) 100))
+ (bottom-up-margin (1+ (/ (* height bottom-percent) 100)))
+ (bottom-margin (max beg (- height bottom-up-margin 1)))
+ (top (save-excursion (move-to-window-line top-margin) (point)))
+ (bottom (save-excursion (move-to-window-line bottom-margin) (point)))
+ (far (save-excursion
+ (goto-char bottom)
+ (point-at-bol (1- height)))))
+ ,@body))
+
(defun tpu-paragraph (num)
"Move to the next paragraph in the current direction.
A repeat count means move that many paragraphs."
(interactive "p")
- (let* ((left nil)
- (beg (tpu-current-line))
- (height (window-height))
- (top-percent
- (if (= 0 tpu-top-scroll-margin) 10 tpu-top-scroll-margin))
- (bottom-percent
- (if (= 0 tpu-bottom-scroll-margin) 15 tpu-bottom-scroll-margin))
- (top-margin (/ (* height top-percent) 100))
- (bottom-up-margin (+ 1 (/ (* height bottom-percent) 100)))
- (bottom-margin (max beg (- height bottom-up-margin 1)))
- (top (save-excursion (move-to-window-line top-margin) (point)))
- (bottom (save-excursion (move-to-window-line bottom-margin) (point)))
- (far (save-excursion
- (goto-char bottom) (forward-line (- height 2)) (point))))
- (cond (tpu-advance
- (tpu-next-paragraph num)
- (cond((> (point) far)
- (setq left (save-excursion (forward-line height)))
- (if (= 0 left) (recenter top-margin)
- (recenter (- left bottom-up-margin))))
- (t
- (and (> (point) bottom) (recenter bottom-margin)))))
- (t
- (tpu-previous-paragraph num)
- (and (< (point) top) (recenter (min beg top-margin)))))))
-
+ (tpu-with-position
+ (if tpu-advance
+ (progn
+ (tpu-next-paragraph num)
+ (if (> (point) far)
+ (if (zerop (setq left (save-excursion (forward-line height))))
+ (recenter top-margin)
+ (recenter (- left bottom-up-margin)))
+ (and (> (point) bottom) (recenter bottom-margin))))
+ (tpu-previous-paragraph num)
+ (and (< (point) top) (recenter (min beg top-margin))))))
;;; Movement by page
"Move to the next page in the current direction.
A repeat count means move that many pages."
(interactive "p")
- (let* ((left nil)
- (beg (tpu-current-line))
- (height (window-height))
- (top-percent
- (if (= 0 tpu-top-scroll-margin) 10 tpu-top-scroll-margin))
- (bottom-percent
- (if (= 0 tpu-bottom-scroll-margin) 15 tpu-bottom-scroll-margin))
- (top-margin (/ (* height top-percent) 100))
- (bottom-up-margin (+ 1 (/ (* height bottom-percent) 100)))
- (bottom-margin (max beg (- height bottom-up-margin 1)))
- (top (save-excursion (move-to-window-line top-margin) (point)))
- (bottom (save-excursion (move-to-window-line bottom-margin) (point)))
- (far (save-excursion
- (goto-char bottom) (forward-line (- height 2)) (point))))
- (cond (tpu-advance
- (forward-page num)
- (cond((> (point) far)
- (setq left (save-excursion (forward-line height)))
- (if (= 0 left) (recenter top-margin)
- (recenter (- left bottom-up-margin))))
- (t
- (and (> (point) bottom) (recenter bottom-margin)))))
- (t
- (backward-page num)
- (and (< (point) top) (recenter (min beg top-margin)))))))
-
+ (tpu-with-position
+ (if tpu-advance
+ (progn
+ (forward-page num)
+ (if (> (point) far)
+ (if (zerop (setq left (save-excursion (forward-line height))))
+ (recenter top-margin)
+ (recenter (- left bottom-up-margin)))
+ (and (> (point) bottom) (recenter bottom-margin))))
+ (backward-page num)
+ (and (< (point) top) (recenter (min beg top-margin))))))
;;; Scrolling
(defun tpu-search-internal (pat &optional quiet)
"Search for a string or regular expression."
- (let* ((left nil)
- (beg (tpu-current-line))
- (height (window-height))
- (top-percent
- (if (= 0 tpu-top-scroll-margin) 10 tpu-top-scroll-margin))
- (bottom-percent
- (if (= 0 tpu-bottom-scroll-margin) 15 tpu-bottom-scroll-margin))
- (top-margin (/ (* height top-percent) 100))
- (bottom-up-margin (+ 1 (/ (* height bottom-percent) 100)))
- (bottom-margin (max beg (- height bottom-up-margin 1)))
- (top (save-excursion (move-to-window-line top-margin) (point)))
- (bottom (save-excursion (move-to-window-line bottom-margin) (point)))
- (far (save-excursion
- (goto-char bottom) (forward-line (- height 2)) (point))))
- (tpu-search-internal-core pat quiet)
- (if tpu-searching-forward
- (cond((> (point) far)
- (setq left (save-excursion (forward-line height)))
- (if (= 0 left) (recenter top-margin)
- (recenter (- left bottom-up-margin))))
- (t
- (and (> (point) bottom) (recenter bottom-margin))))
- (and (< (point) top) (recenter (min beg top-margin))))))
-
-
+ (tpu-with-position
+ (tpu-search-internal-core pat quiet)
+ (if tpu-searching-forward
+ (progn
+ (if (> (point) far)
+ (if (zerop (setq left (save-excursion (forward-line height))))
+ (recenter top-margin)
+ (recenter (- left bottom-up-margin)))
+ (and (> (point) bottom) (recenter bottom-margin))))
+ (and (< (point) top) (recenter (min beg top-margin))))))
;; Advise the newline, newline-and-indent, and do-auto-fill functions.
(defadvice newline (around tpu-respect-bottom-scroll-margin activate disable)
(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)
- (tpu-cursor-free-mode 1)
- (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-cursor-free-mode -1)
- (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