|
|
1.1 ! root 1: ;; Page motion commands for emacs. ! 2: ;; Copyright (C) 1985 Free Software Foundation, Inc. ! 3: ! 4: ;; This file is part of GNU Emacs. ! 5: ! 6: ;; GNU Emacs is distributed in the hope that it will be useful, ! 7: ;; but WITHOUT ANY WARRANTY. No author or distributor ! 8: ;; accepts responsibility to anyone for the consequences of using it ! 9: ;; or for whether it serves any particular purpose or works at all, ! 10: ;; unless he says so in writing. Refer to the GNU Emacs General Public ! 11: ;; License for full details. ! 12: ! 13: ;; Everyone is granted permission to copy, modify and redistribute ! 14: ;; GNU Emacs, but only under the conditions described in the ! 15: ;; GNU Emacs General Public License. A copy of this license is ! 16: ;; supposed to have been given to you along with GNU Emacs so you ! 17: ;; can know your rights and responsibilities. It should be in a ! 18: ;; file named COPYING. Among other things, the copyright notice ! 19: ;; and this notice must be preserved on all copies. ! 20: ! 21: ! 22: (defun forward-page (&optional count) ! 23: "Move forward to page boundary. With arg, repeat, or go back if negative. ! 24: A page boundary is any line whose beginning matches the regexp page-delimiter." ! 25: (interactive "p") ! 26: (or count (setq count 1)) ! 27: (while (and (> count 0) (not (eobp))) ! 28: (if (re-search-forward page-delimiter nil t) ! 29: nil ! 30: (goto-char (point-max))) ! 31: (setq count (1- count))) ! 32: (while (and (< count 0) (not (bobp))) ! 33: (forward-char -1) ! 34: (if (re-search-backward page-delimiter nil t) ! 35: (goto-char (match-end 0)) ! 36: (goto-char (point-min))) ! 37: (setq count (1+ count)))) ! 38: ! 39: (defun backward-page (&optional count) ! 40: "Move backward to page boundary. With arg, repeat, or go fwd if negative. ! 41: A page boundary is any line whose beginning matches the regexp page-delimiter." ! 42: (interactive "p") ! 43: (or count (setq count 1)) ! 44: (forward-page (- count))) ! 45: ! 46: (defun mark-page (&optional arg) ! 47: "Put mark at end of page, point at beginning. ! 48: A numeric arg specifies to move forward or backward by that many pages, ! 49: thus marking a page other than the one point was originally in." ! 50: (interactive "P") ! 51: (setq arg (if arg (prefix-numeric-value arg) 0)) ! 52: (if (> arg 0) ! 53: (forward-page arg) ! 54: (if (< arg 0) ! 55: (forward-page (1- arg)))) ! 56: (forward-page) ! 57: (push-mark nil t) ! 58: (forward-page -1)) ! 59: ! 60: (defun narrow-to-page (&optional arg) ! 61: "Make text outside current page invisible. ! 62: A numeric arg specifies to move forward or backward by that many pages, ! 63: thus showing a page other than the one point was originally in." ! 64: (interactive "P") ! 65: (setq arg (if arg (prefix-numeric-value arg) 0)) ! 66: (save-excursion ! 67: (widen) ! 68: (if (> arg 0) ! 69: (forward-page arg) ! 70: (if (< arg 0) ! 71: (forward-page (1- arg)))) ! 72: ;; Find the end of the page. ! 73: (forward-page) ! 74: ;; If we stopped due to end of buffer, stay there. ! 75: ;; If we stopped after a page delimiter, put end of restriction ! 76: ;; at the beginning of that line. ! 77: (if (save-excursion (beginning-of-line) ! 78: (looking-at page-delimiter)) ! 79: (beginning-of-line)) ! 80: (narrow-to-region (point) ! 81: (progn ! 82: ;; Find the top of the page. ! 83: (forward-page -1) ! 84: ;; If we found beginning of buffer, stay there. ! 85: ;; If extra text follows page delimiter on same line, ! 86: ;; include it. ! 87: ;; Otherwise, show text starting with following line. ! 88: (if (and (eolp) (not (bobp))) ! 89: (forward-line 1)) ! 90: (point))))) ! 91: ! 92: (defun count-lines-page () ! 93: "Report number of lines on current page, and how many are before or after point." ! 94: (interactive) ! 95: (save-excursion ! 96: (let ((opoint (point)) beg end ! 97: total before after) ! 98: (forward-page) ! 99: (beginning-of-line) ! 100: (or (looking-at page-delimiter) ! 101: (end-of-line)) ! 102: (setq end (point)) ! 103: (backward-page) ! 104: (setq beg (point)) ! 105: (setq total (count-lines beg end) ! 106: before (count-lines beg opoint) ! 107: after (count-lines opoint end)) ! 108: (message "Page has %d lines (%d + %d)" total before after)))) ! 109: ! 110: (defun what-page () ! 111: "Print page and line number of point." ! 112: (interactive) ! 113: (save-restriction ! 114: (widen) ! 115: (save-excursion ! 116: (let ((count 1) ! 117: (opoint (point))) ! 118: (goto-char 1) ! 119: (while (re-search-forward page-delimiter opoint t) ! 120: (setq count (1+ count))) ! 121: (message "Page %d, line %d" ! 122: count ! 123: (1+ (count-lines (point) opoint)))))))
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.