X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/c1473b4cfeb477ced05d457868c5e1eb97a58eb0..dacbc44ca3fc825c9e5ffa799f1a0937c1da0020:/lisp/emulation/tpu-extras.el diff --git a/lisp/emulation/tpu-extras.el b/lisp/emulation/tpu-extras.el index 1dcc20a3ec..30143a0fa9 100644 --- a/lisp/emulation/tpu-extras.el +++ b/lisp/emulation/tpu-extras.el @@ -1,11 +1,11 @@ ;;; 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 ;; Maintainer: Rob Riepel ;; Keywords: emulations +;; Package: tpu-edt ;; This file is part of GNU Emacs. @@ -26,7 +26,7 @@ ;; 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. @@ -132,10 +132,16 @@ the previous line when starting from a line beginning." ;;;###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. @@ -272,36 +278,41 @@ Prefix argument serves as repeat count." ;;; 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 @@ -309,32 +320,17 @@ A repeat count means move that many paragraphs." "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 @@ -363,31 +359,16 @@ A repeat count means scroll that many sections." (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) @@ -436,7 +417,7 @@ A repeat count means scroll that many sections." (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))) @@ -447,19 +428,16 @@ A repeat count means scroll that many sections." (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