cgit.sxemacs.org Git - sxemacs/blob - lisp/page.el

   1 ;;; page.el --- page motion commands for SXEmacs.
   2
   3 ;; Copyright (C) 1985, 1997 Free Software Foundation, Inc.
   4
   5 ;; Maintainer: FSF
   6 ;; Keywords: extensions, dumped
   7
   8 ;; This file is part of SXEmacs.
   9
  10 ;; SXEmacs is free software: you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation, either version 3 of the License, or
  13 ;; (at your option) any later version.
  14
  15 ;; SXEmacs is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  22
  23 ;;; Synched up with: FSF 19.34.
  24
  25 ;;; Commentary:
  26
  27 ;; This file is dumped with SXEmacs.
  28
  29 ;; This code provides the page-oriented movement and selection commands
  30 ;; documented in the XEmacs Reference Manual.
  31
  32 ;;; Code:
  33
  34 (defun forward-page (&optional count)
  35   "Move forward to page boundary.  With arg, repeat, or go back if negative.
  36 A page boundary is any line whose beginning matches the regexp
  37 `page-delimiter'."
  38   (interactive "_p") ; XEmacs
  39   (or count (setq count 1))
  40   (while (and (> count 0) (not (eobp)))
  41     ;; In case the page-delimiter matches the null string,
  42     ;; don't find a match without moving.
  43     (if (bolp) (forward-char 1))
  44     (if (re-search-forward page-delimiter nil t)
  45         nil
  46       (goto-char (point-max)))
  47     (setq count (1- count)))
  48   (while (and (< count 0) (not (bobp)))
  49     ;; In case the page-delimiter matches the null string,
  50     ;; don't find a match without moving.
  51     (and (save-excursion (re-search-backward page-delimiter nil t))
  52          (= (match-end 0) (point))
  53          (goto-char (match-beginning 0)))
  54     (backward-char 1)
  55     (if (re-search-backward page-delimiter nil t)
  56         ;; We found one--move to the end of it.
  57         (goto-char (match-end 0))
  58       ;; We found nothing--go to beg of buffer.
  59       (goto-char (point-min)))
  60     (setq count (1+ count))))
  61
  62 (defun backward-page (&optional count)
  63   "Move backward to page boundary.  With arg, repeat, or go fwd if negative.
  64 A page boundary is any line whose beginning matches the regexp
  65 `page-delimiter'."
  66   (interactive "_p") ; XEmacs
  67   (or count (setq count 1))
  68   (forward-page (- count)))
  69
  70 (defun mark-page (&optional arg)
  71   "Put mark at end of page, point at beginning.
  72 A numeric arg specifies to move forward or backward by that many pages,
  73 thus marking a page other than the one point was originally in."
  74   (interactive "P")
  75   (setq arg (if arg (prefix-numeric-value arg) 0))
  76   (if (> arg 0)
  77       (forward-page arg)
  78     (if (< arg 0)
  79         (forward-page (1- arg))))
  80   (forward-page)
  81   (push-mark nil t t)
  82   (forward-page -1))
  83
  84 (defun narrow-to-page (&optional arg)
  85   "Make text outside current page invisible.
  86 A numeric arg specifies to move forward or backward by that many pages,
  87 thus showing a page other than the one point was originally in."
  88   (interactive "P")
  89   (setq arg (if arg (prefix-numeric-value arg) 0))
  90   (save-excursion
  91     (widen)
  92     (if (> arg 0)
  93         (forward-page arg)
  94       (if (< arg 0)
  95           (forward-page (1- arg))))
  96     ;; Find the end of the page.
  97     (forward-page)
  98     ;; If we stopped due to end of buffer, stay there.
  99     ;; If we stopped after a page delimiter, put end of restriction
 100     ;; at the beginning of that line.
 101     (if (save-excursion
 102           (goto-char (match-beginning 0)) ; was (beginning-of-line)
 103           (looking-at page-delimiter))
 104         (beginning-of-line))
 105     (narrow-to-region (point)
 106                       (progn
 107                         ;; Find the top of the page.
 108                         (forward-page -1)
 109                         ;; If we found beginning of buffer, stay there.
 110                         ;; If extra text follows page delimiter on same line,
 111                         ;; include it.
 112                         ;; Otherwise, show text starting with following line.
 113                         (if (and (eolp) (not (bobp)))
 114                             (forward-line 1))
 115                         (point)))))
 116 (put 'narrow-to-page 'disabled t)
 117
 118 (defun count-lines-page ()
 119   "Report number of lines on current page, and how many are before or after point."
 120   (interactive "_") ; XEmacs
 121   (save-excursion
 122     (let ((opoint (point)) beg end
 123           total before after)
 124       (forward-page)
 125       (beginning-of-line)
 126       (or (looking-at page-delimiter)
 127           (end-of-line))
 128       (setq end (point))
 129       (backward-page)
 130       (setq beg (point))
 131       (setq total (count-lines beg end)
 132             before (count-lines beg opoint)
 133             after (count-lines opoint end))
 134       (message "Page has %d lines (%d + %d)" total before after))))
 135
 136 (defun what-page ()
 137   "Print page and line number of point."
 138   (interactive "_") ; XEmacs
 139   (save-restriction
 140     (widen)
 141     (save-excursion
 142       (beginning-of-line)
 143       (let ((count 1)
 144             (opoint (point)))
 145         (goto-char 1)
 146         (while (re-search-forward page-delimiter opoint t)
 147           (setq count (1+ count)))
 148         (message "Page %d, line %d"
 149                  count
 150                  (1+ (count-lines (point) opoint)))))))
 151 \f
 152 ;;; Place `provide' at end of file.
 153 (provide 'page)
 154
 155 ;;; page.el ends here