mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-12-01 08:17:38 +00:00
Code Issues Releases Activity

Minor edt.el simplification.

Browse Source 
* lisp/emulation/edt.el (edt-with-position): New macro.
(edt-find-forward, edt-find-backward, edt-find-next-forward)
(edt-find-next-backward, edt-sentence-forward, edt-sentence-backward)
(edt-paragraph-forward, edt-paragraph-backward): Use it.
This commit is contained in:
Glenn Morris 2010-11-09 21:24:48 -08:00
parent f8a09adb78
commit d4aca69c31
2 changed files with 96 additions and 187 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
lisp/ChangeLog
View File

@ -1,5 +1,10 @@
2010-11-10 Glenn Morris <rgm@gnu.org> 2010-11-10 Glenn Morris <rgm@gnu.org>
* emulation/edt.el (edt-with-position): New macro.
(edt-find-forward, edt-find-backward, edt-find-next-forward)
(edt-find-next-backward, edt-sentence-forward, edt-sentence-backward)
(edt-paragraph-forward, edt-paragraph-backward): Use it.
* emulation/tpu-extras.el (tpu-with-position): New macro. * emulation/tpu-extras.el (tpu-with-position): New macro.
(tpu-paragraph, tpu-page, tpu-search-internal): Use it. (tpu-paragraph, tpu-page, tpu-search-internal): Use it.

278
lisp/emulation/edt.el
View File

@ -1,4 +1,4 @@
;;; edt.el --- enhanced EDT keypad mode emulation for GNU Emacs 19 ;;; edt.el --- enhanced EDT keypad mode emulation for GNU Emacs
;; Copyright (C) 1986, 1992, 1993, 1994, 1995, 2000, 2001, 2002, 2003, ;; Copyright (C) 1986, 1992, 1993, 1994, 1995, 2000, 2001, 2002, 2003,
;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 ;; 2004, 2005, 2006, 2007, 2008, 2009, 2010
@ -28,7 +28,7 @@
;;; Commentary: ;;; Commentary:
;; ;;
;; This is Version 4.0 of the EDT Emulation for Emacs 19 and above. ;; This is Version 4.0 of the EDT Emulation for Emacs.
;; It comes with special functions which replicate nearly all of EDT's ;; It comes with special functions which replicate nearly all of EDT's
;; keypad mode behavior. It sets up default keypad and function key ;; keypad mode behavior. It sets up default keypad and function key
;; bindings which closely match those found in EDT. Support is ;; bindings which closely match those found in EDT. Support is
@ -89,8 +89,8 @@
;; settings for that session. ;; settings for that session.
;; ;;
;; NOTE: Another way to set the scroll margins is to use the ;; NOTE: Another way to set the scroll margins is to use the
;; Emacs customization feature (not available in Emacs 19) to set ;; Emacs customization feature to set the following two variables
;; the following two variables directly: ;; directly:
;; ;;
;; edt-top-scroll-margin and edt-bottom-scroll-margin ;; edt-top-scroll-margin and edt-bottom-scroll-margin
;; ;;
@ -667,6 +667,25 @@ Argument NUM is the number of lines to move."
(goto-char (point-max)) (goto-char (point-max))
(edt-line-to-bottom-of-window)) (edt-line-to-bottom-of-window))
(defmacro edt-with-position (&rest body)
"Execute BODY with some position-related variables bound."
`(let* ((left nil)
(beg (edt-current-line))
(height (window-height))
(top-percent
(if (zerop edt-top-scroll-margin) 10 edt-top-scroll-margin))
(bottom-percent
(if (zerop edt-bottom-scroll-margin) 15 edt-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))
;;; ;;;
;;; FIND ;;; FIND
;;; ;;;
@ -675,57 +694,29 @@ Argument NUM is the number of lines to move."
"Find first occurrence of a string in forward direction and save it. "Find first occurrence of a string in forward direction and save it.
Optional argument FIND is t is this function is called from `edt-find'." Optional argument FIND is t is this function is called from `edt-find'."
(interactive) (interactive)
(if (not find) (or find
(set 'edt-find-last-text (read-string "Search forward: "))) (setq edt-find-last-text (read-string "Search forward: ")))
(let* ((left nil) (edt-with-position
(beg (edt-current-line)) (when (search-forward edt-find-last-text) ; FIXME noerror?
(height (window-height)) (search-backward edt-find-last-text)
(top-percent (edt-set-match)
(if (= 0 edt-top-scroll-margin) 10 edt-top-scroll-margin)) (if (> (point) far)
(bottom-percent (if (zerop (setq left (save-excursion (forward-line height))))
(if (= 0 edt-bottom-scroll-margin) 15 edt-bottom-scroll-margin)) (recenter top-margin)
(top-margin (/ (* height top-percent) 100)) (recenter (- left bottom-up-margin)))
(bottom-up-margin (+ 1 (/ (* height bottom-percent) 100))) (and (> (point) bottom) (recenter bottom-margin)))))
(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))))
(if (search-forward edt-find-last-text)
(progn
(search-backward edt-find-last-text)
(edt-set-match)
(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)))))))
(if (featurep 'xemacs) (setq zmacs-region-stays t))) (if (featurep 'xemacs) (setq zmacs-region-stays t)))
(defun edt-find-backward (&optional find) (defun edt-find-backward (&optional find)
"Find first occurrence of a string in the backward direction and save it. "Find first occurrence of a string in the backward direction and save it.
Optional argument FIND is t if this function is called from `edt-find'." Optional argument FIND is t if this function is called from `edt-find'."
(interactive) (interactive)
(if (not find) (or find
(set 'edt-find-last-text (read-string "Search backward: "))) (setq edt-find-last-text (read-string "Search backward: ")))
(let* ((left nil) (edt-with-position
(beg (edt-current-line)) (if (search-backward edt-find-last-text)
(height (window-height)) (edt-set-match))
(top-percent (and (< (point) top) (recenter (min beg top-margin))))
(if (= 0 edt-top-scroll-margin) 10 edt-top-scroll-margin))
(bottom-percent
(if (= 0 edt-bottom-scroll-margin) 15 edt-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))))
(if (search-backward edt-find-last-text)
(edt-set-match))
(and (< (point) top) (recenter (min beg top-margin))))
(if (featurep 'xemacs) (setq zmacs-region-stays t))) (if (featurep 'xemacs) (setq zmacs-region-stays t)))
(defun edt-find () (defun edt-find ()
@ -744,58 +735,29 @@ Optional argument FIND is t if this function is called from `edt-find'."
(defun edt-find-next-forward () (defun edt-find-next-forward ()
"Find next occurrence of a string in forward direction." "Find next occurrence of a string in forward direction."
(interactive) (interactive)
(let* ((left nil) (edt-with-position
(beg (edt-current-line)) (forward-char 1)
(height (window-height)) (if (search-forward edt-find-last-text nil t)
(top-percent (progn
(if (= 0 edt-top-scroll-margin) 10 edt-top-scroll-margin)) (search-backward edt-find-last-text)
(bottom-percent (edt-set-match)
(if (= 0 edt-bottom-scroll-margin) 15 edt-bottom-scroll-margin)) (if (> (point) far)
(top-margin (/ (* height top-percent) 100)) (if (zerop (setq left (save-excursion (forward-line height))))
(bottom-up-margin (+ 1 (/ (* height bottom-percent) 100))) (recenter top-margin)
(bottom-margin (max beg (- height bottom-up-margin 1))) (recenter (- left bottom-up-margin)))
(top (save-excursion (move-to-window-line top-margin) (point))) (and (> (point) bottom) (recenter bottom-margin))))
(bottom (save-excursion (move-to-window-line bottom-margin) (point))) (backward-char 1)
(far (save-excursion (error "Search failed: \"%s\"" edt-find-last-text)))
(goto-char bottom) (forward-line (- height 2)) (point))))
(forward-char 1)
(if (search-forward edt-find-last-text nil t)
(progn
(search-backward edt-find-last-text)
(edt-set-match)
(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)))))
(progn
(backward-char 1)
(error "Search failed: \"%s\"" edt-find-last-text))))
(if (featurep 'xemacs) (setq zmacs-region-stays t))) (if (featurep 'xemacs) (setq zmacs-region-stays t)))
(defun edt-find-next-backward () (defun edt-find-next-backward ()
"Find next occurrence of a string in backward direction." "Find next occurrence of a string in backward direction."
(interactive) (interactive)
(let* ((left nil) (edt-with-position
(beg (edt-current-line)) (if (not (search-backward edt-find-last-text nil t))
(height (window-height)) (error "Search failed: \"%s\"" edt-find-last-text)
(top-percent (edt-set-match)
(if (= 0 edt-top-scroll-margin) 10 edt-top-scroll-margin)) (and (< (point) top) (recenter (min beg top-margin)))))
(bottom-percent
(if (= 0 edt-bottom-scroll-margin) 15 edt-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))))
(if (not (search-backward edt-find-last-text nil t))
(error "Search failed: \"%s\"" edt-find-last-text)
(progn
(edt-set-match)
(and (< (point) top) (recenter (min beg top-margin))))))
(if (featurep 'xemacs) (setq zmacs-region-stays t))) (if (featurep 'xemacs) (setq zmacs-region-stays t)))
(defun edt-find-next () (defun edt-find-next ()
@ -1318,33 +1280,17 @@ Argument BOTTOM is the bottom margin in number of lines or percent of window."
Argument NUM is the positive number of sentences to move." Argument NUM is the positive number of sentences to move."
(interactive "p") (interactive "p")
(edt-check-prefix num) (edt-check-prefix num)
(let* ((left nil) (edt-with-position
(beg (edt-current-line)) (if (eobp)
(height (window-height)) (error "End of buffer")
(top-percent (forward-sentence num)
(if (= 0 edt-top-scroll-margin) 10 edt-top-scroll-margin)) (forward-word 1)
(bottom-percent (backward-sentence))
(if (= 0 edt-bottom-scroll-margin) 15 edt-bottom-scroll-margin)) (if (> (point) far)
(top-margin (/ (* height top-percent) 100)) (if (zerop (setq left (save-excursion (forward-line height))))
(bottom-up-margin (+ 1 (/ (* height bottom-percent) 100))) (recenter top-margin)
(bottom-margin (max beg (- height bottom-up-margin 1))) (recenter (- left bottom-up-margin)))
(top (save-excursion (move-to-window-line top-margin) (point))) (and (> (point) bottom) (recenter bottom-margin))))
(bottom (save-excursion (move-to-window-line bottom-margin) (point)))
(far (save-excursion
(goto-char bottom) (forward-line (- height 2)) (point))))
(if (eobp)
(progn
(error "End of buffer"))
(progn
(forward-sentence num)
(forward-word 1)
(backward-sentence)))
(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)))))
(if (featurep 'xemacs) (setq zmacs-region-stays t))) (if (featurep 'xemacs) (setq zmacs-region-stays t)))
(defun edt-sentence-backward (num) (defun edt-sentence-backward (num)
@ -1352,25 +1298,11 @@ Argument NUM is the positive number of sentences to move."
Argument NUM is the positive number of sentences to move." Argument NUM is the positive number of sentences to move."
(interactive "p") (interactive "p")
(edt-check-prefix num) (edt-check-prefix num)
(let* ((left nil) (edt-with-position
(beg (edt-current-line)) (if (eobp)
(height (window-height)) (error "End of buffer")
(top-percent (backward-sentence num))
(if (= 0 edt-top-scroll-margin) 10 edt-top-scroll-margin)) (and (< (point) top) (recenter (min beg top-margin))))
(bottom-percent
(if (= 0 edt-bottom-scroll-margin) 15 edt-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))))
(if (eobp)
(progn
(error "End of buffer"))
(backward-sentence num))
(and (< (point) top) (recenter (min beg top-margin))))
(if (featurep 'xemacs) (setq zmacs-region-stays t))) (if (featurep 'xemacs) (setq zmacs-region-stays t)))
(defun edt-sentence (num) (defun edt-sentence (num)
@ -1390,32 +1322,18 @@ Argument NUM is the positive number of sentences to move."
Argument NUM is the positive number of paragraphs to move." Argument NUM is the positive number of paragraphs to move."
(interactive "p") (interactive "p")
(edt-check-prefix num) (edt-check-prefix num)
(let* ((left nil) (edt-with-position
(beg (edt-current-line)) (while (> num 0)
(height (window-height)) (forward-paragraph (+ num 1))
(top-percent (start-of-paragraph-text)
(if (= 0 edt-top-scroll-margin) 10 edt-top-scroll-margin)) (if (eolp)
(bottom-percent (forward-line 1))
(if (= 0 edt-bottom-scroll-margin) 15 edt-bottom-scroll-margin)) (setq num (1- num)))
(top-margin (/ (* height top-percent) 100)) (if (> (point) far)
(bottom-up-margin (+ 1 (/ (* height bottom-percent) 100))) (if (zerop (setq left (save-excursion (forward-line height))))
(bottom-margin (max beg (- height bottom-up-margin 1))) (recenter top-margin)
(top (save-excursion (move-to-window-line top-margin) (point))) (recenter (- left bottom-up-margin)))
(bottom (save-excursion (move-to-window-line bottom-margin) (point))) (and (> (point) bottom) (recenter bottom-margin))))
(far (save-excursion
(goto-char bottom) (forward-line (- height 2)) (point))))
(while (> num 0)
(forward-paragraph (+ num 1))
(start-of-paragraph-text)
(if (eolp)
(forward-line 1))
(setq num (1- 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)))))
(if (featurep 'xemacs) (setq zmacs-region-stays t))) (if (featurep 'xemacs) (setq zmacs-region-stays t)))
(defun edt-paragraph-backward (num) (defun edt-paragraph-backward (num)
@ -1423,24 +1341,11 @@ Argument NUM is the positive number of paragraphs to move."
Argument NUM is the positive number of paragraphs to move." Argument NUM is the positive number of paragraphs to move."
(interactive "p") (interactive "p")
(edt-check-prefix num) (edt-check-prefix num)
(let* ((left nil) (edt-with-position
(beg (edt-current-line)) (while (> num 0)
(height (window-height)) (start-of-paragraph-text)
(top-percent (setq num (1- num)))
(if (= 0 edt-top-scroll-margin) 10 edt-top-scroll-margin)) (and (< (point) top) (recenter (min beg top-margin))))
(bottom-percent
(if (= 0 edt-bottom-scroll-margin) 15 edt-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))))
(while (> num 0)
(start-of-paragraph-text)
(setq num (1- num)))
(and (< (point) top) (recenter (min beg top-margin))))
(if (featurep 'xemacs) (setq zmacs-region-stays t))) (if (featurep 'xemacs) (setq zmacs-region-stays t)))
(defun edt-paragraph (num) (defun edt-paragraph (num)
@ -2701,5 +2606,4 @@ G-C-\\: Split Window | FNDNXT | Yank | CUT |
(provide 'edt) (provide 'edt)
;; arch-tag: 18d1c54f-6900-4078-8bbc-7c2292f48941
;;; edt.el ends here ;;; edt.el ends here