Mercurial > emacs

changeset 111465:b0fdf722b533

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
tpu-extras.el simplifiation. * lisp/emulation/tpu-extras.el (tpu-with-position): New macro. (tpu-paragraph, tpu-page, tpu-search-internal): Use it.
author Glenn Morris <rgm@gnu.org>
date Tue, 09 Nov 2010 21:16:34 -0800
parents 9ab5ff757483
children c208e8e46177
files lisp/ChangeLog lisp/emulation/tpu-extras.el
diffstat 2 files changed, 55 insertions(+), 78 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/ChangeLog	Tue Nov 09 20:35:18 2010 -0800
+++ b/lisp/ChangeLog	Tue Nov 09 21:16:34 2010 -0800
@@ -1,5 +1,8 @@
 2010-11-10  Glenn Morris  <rgm@gnu.org>
 
+	* emulation/tpu-extras.el (tpu-with-position): New macro.
+	(tpu-paragraph, tpu-page, tpu-search-internal): Use it.
+
 	* textmodes/texnfo-upd.el (texinfo-all-menus-update)
 	(texinfo-menu-copy-old-description, texinfo-start-menu-description)
 	(texinfo-master-menu, texinfo-insert-node-lines)
--- a/lisp/emulation/tpu-extras.el	Tue Nov 09 20:35:18 2010 -0800
+++ b/lisp/emulation/tpu-extras.el	Tue Nov 09 21:16:34 2010 -0800
@@ -276,36 +276,41 @@
 
 ;;;  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
 
@@ -313,32 +318,17 @@
   "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
 
@@ -367,31 +357,16 @@
 
 (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)
@@ -463,5 +438,4 @@
 ;; generated-autoload-file: "tpu-edt.el"
 ;; End:
 
-;; arch-tag: 89676fa4-33ec-48cb-9135-6f3bf230ab1a
 ;;; tpu-extras.el ends here