lisp/textmodes/page-ext.el

   1 ;;; page-ext.el --- extended page handling commands
   2
   3 ;; Copyright (C) 1990, 1991, 1993, 1994, 2001, 2002, 2003, 2004,
   4 ;;   2005, 2006, 2007, 2008 Free Software Foundation, Inc.
   5
   6 ;; Maintainer: Robert J. Chassell <bob@gnu.org>
   7 ;; Keywords: wp data
   8
   9 ;; This file is part of GNU Emacs.
  10
  11 ;; GNU Emacs is free software; you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation; either version 3, or (at your option)
  14 ;; any later version.
  15
  16 ;; GNU Emacs is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  24 ;; Boston, MA 02110-1301, USA.
  25
  26 ;;; Commentary:
  27
  28 ;; You may use these commands to handle an address list or other
  29 ;; small data base.
  30
  31 \f
  32 ;;; Summary
  33
  34 ;; The current page commands are:
  35
  36 ;;     forward-page         C-x ]
  37 ;;     backward-page        C-x [
  38 ;;     narrow-to-page       C-x p
  39 ;;     count-lines-page     C-x l
  40 ;;     mark-page            C-x C-p  (change this to C-x C-p C-m)
  41 ;;     sort-pages           not bound
  42 ;;     what-page            not bound
  43
  44 ;; The new page handling commands all use `C-x C-p' as a prefix.  This
  45 ;; means that the key binding for `mark-page' must be changed.
  46 ;; Otherwise, no other changes are made to the current commands or
  47 ;; their bindings.
  48
  49 ;; New page handling commands:
  50
  51 ;;     next-page                        C-x C-p C-n
  52 ;;     previous-page                    C-x C-p C-p
  53 ;;     search-pages                     C-x C-p C-s
  54 ;;     add-new-page                     C-x C-p C-a
  55 ;;     sort-pages-buffer                C-x C-p s
  56 ;;     set-page-delimiter               C-x C-p C-l
  57 ;;     pages-directory                  C-x C-p C-d
  58 ;;     pages-directory-for-addresses    C-x C-p d
  59 ;;        pages-directory-goto          C-c C-c
  60
  61 \f
  62 ;;; Using the page commands
  63
  64 ;; The page commands are helpful in several different contexts.  For
  65 ;; example, programmers often divide source files into sections using the
  66 ;; `page-delimiter'; you can use the `pages-directory' command to list
  67 ;; the sections.
  68
  69 ;; You may change the buffer local value of the `page-delimiter' with
  70 ;; the `set-page-delimiter' command.  This command is bound to `C-x C-p
  71 ;; C-l' The command prompts you for a new value for the page-delimiter.
  72 ;; Called with a prefix-arg, the command resets the value of the
  73 ;; page-delimiter to its original value.
  74
  75 ;; You may set several user options:
  76 ;;
  77 ;;   The `pages-directory-buffer-narrowing-p' variable causes the
  78 ;;   `pages-directory-goto' command to narrow to the destination page.
  79 ;;
  80 ;;   The `pages-directory-for-adding-page-narrowing-p' variable, causes the
  81 ;;   `add-new-page' command to narrow to the new entry.
  82 ;;
  83 ;;   The `pages-directory-for-adding-new-page-before-current-page-p' variable
  84 ;;   causes the `add-new-page' command to insert a new page before current
  85 ;;   page.
  86 ;;
  87 ;; These variables are true by default.
  88 ;;
  89 ;; Additional, addresses-related user options are described in the next page
  90 ;; of this file.
  91
  92 \f
  93 ;;; Handling an address list or small data base
  94
  95 ;; You may use the page commands to handle an address list or other
  96 ;; small data base.  Put each address or entry on its own page.  The
  97 ;; first line of text in each page is a `header line' and is listed by
  98 ;; the `pages-directory' or `pages-directory-for-addresses' command.
  99
 100 ;; Specifically:
 101 ;;
 102 ;;   1. Begin each entry with a `page-delimiter' (which is, by default,
 103 ;;      `^L' at the beginning of the line).
 104 ;;
 105 ;;   2. The first line of text in each entry is the `heading line'; it
 106 ;;      will appear in the pages-directory-buffer which is constructed
 107 ;;      using the `C-x C-p C-d' (pages-directory) command or the `C-x
 108 ;;      C-p d' (pages-directory-for-addresses) command.
 109 ;;
 110 ;;      The heading line may be on the same line as the page-delimiter
 111 ;;      or it may follow after.  It is the first non-blank line on the
 112 ;;      page.  Conventionally, the heading line is placed on the line
 113 ;;      immediately following the line containing page-delimiter.
 114 ;;
 115 ;;   3. Follow the heading line with the body of the entry.  The body
 116 ;;      extends up to the next `page-delimiter'.  The body may be of any
 117 ;;      length.  It is conventional to place a blank line after the last
 118 ;;      line of the body.
 119
 120 ;; For example, a file might look like this:
 121 ;;
 122 ;;     FSF
 123 ;;     Free Software Foundation
 124 ;;     51 Franklin Street, Fifth Floor
 125 ;;     Boston, MA 02110-1301  USA.
 126 ;;     (617) 542-5942
 127 ;;     gnu@gnu.org
 128 ;;
 129 ;;     \f
 130 ;;     House Subcommittee on Intellectual Property,
 131 ;;     U.S. House of Representatives,
 132 ;;     Washington, DC  20515
 133 ;;
 134 ;;     Congressional committee concerned with permitting or preventing
 135 ;;     monopolistic restrictions on the use of software technology.
 136 ;;
 137 ;;     \f
 138 ;;     George Lakoff
 139 ;;     ``Women, Fire, and Dangerous Things:
 140 ;;     What Categories Reveal about the Mind''
 141 ;;     1987, Univ. of Chicago Press
 142 ;;
 143 ;;     About philosophy, Whorfian effects, and linguistics.
 144 ;;
 145 ;;     \f
 146 ;;     OBI   (On line text collection.)
 147 ;;     Open Book Initiative
 148 ;;     c/o Software Tool & Die
 149 ;;     1330 Beacon St, Brookline, MA 02146 USA
 150 ;;     (617) 739-0202
 151 ;;     obi@world.std.com
 152
 153 ;; In this example, the heading lines are:
 154 ;;
 155 ;;     FSF
 156 ;;     House Subcommittee on Intellectual Property
 157 ;;     George Lakoff
 158 ;;     OBI (On line text collection.)
 159
 160 ;; The `C-x C-p s' (sort-pages-buffer) command sorts the entries in the
 161 ;; buffer alphabetically.
 162
 163 ;; You may use any of the page commands, including the `next-page',
 164 ;; `previous-page', `add-new-page', `mark-page', and `search-pages'
 165 ;; commands.
 166
 167 ;; You may use either the `C-x C-p d' (pages-directory-for-addresses)
 168 ;; or the `C-x C-p C-d' (pages-directory) command to construct and
 169 ;; display a directory of all the heading lines.
 170
 171 ;; In the directory, you may position the cursor over a heading line
 172 ;; and type `C-c C-c' (pages-directory-goto) to go to the entry to
 173 ;; which it refers in the pages buffer.
 174
 175 ;; You can type `C-c C-p C-a' (add-new-page) to add a new entry in the
 176 ;; pages buffer or address file.  This is the same command you use to
 177 ;; add a new entry when you are in the pages buffer or address file.
 178
 179 ;; If you wish, you may create several different directories,
 180 ;; one for each different buffer.
 181
 182 ;; `pages-directory-for-addresses' in detail
 183
 184 ;; The `pages-directory-for-addresses' assumes a default addresses
 185 ;; file.  You do not need to specify the addresses file but merely type
 186 ;; `C-x C-p d' from any buffer.  The command finds the file, constructs
 187 ;; a directory for it, and switches you to the directory.  If you call
 188 ;; the command with a prefix arg, `C-u C-x C-p d', it prompts you for a
 189 ;; file name.
 190
 191 ;; You may customize the addresses commands:
 192
 193 ;;   The `pages-addresses-file-name' variable determines the name of
 194 ;;   the addresses file; by default it is "~/addresses".
 195
 196 ;;   The `pages-directory-for-addresses-goto-narrowing-p' variable
 197 ;;   determines whether `pages-directory-goto' narrows the addresses
 198 ;;   buffer to the entry, which it does by default.
 199
 200 ;;   The `pages-directory-for-addresses-buffer-keep-windows-p' variable
 201 ;;   determines whether `pages-directory-for-addresses' deletes other
 202 ;;   windows to show as many lines as possible on the screen or works
 203 ;;   in the usual Emacs manner and keeps other windows.  Default is to
 204 ;;   keep other windows.
 205
 206 ;;   The `pages-directory-for-adding-addresses-narrowing-p' variable
 207 ;;   determines whether `pages-directory-for-addresses' narrows the
 208 ;;   addresses buffer to a new entry when you are adding that entry.
 209 ;;   Default is to narrow to new entry, which means you see a blank
 210 ;;   screen before you write the new entry.
 211
 212 ;; `pages-directory' in detail
 213
 214 ;; Call the `pages-directory' command from the buffer for which you
 215 ;; want a directory created; it creates a directory for the buffer and
 216 ;; pops you to the directory.
 217
 218 ;; The `pages-directory' command has several options:
 219
 220 ;;   Called with a prefix arg, `C-u C-x C-p C-d', the `pages-directory'
 221 ;;   prompts you for a regular expression and only lists only those
 222 ;;   header lines that are part of pages that contain matches to the
 223 ;;   regexp.  In the example above, `C-u C-x C-p C-d 617 RET' would
 224 ;;   match the telephone area code of the first and fourth entries, so
 225 ;;   only the header lines of those two entries would appear in the
 226 ;;   pages-directory-buffer.
 227 ;;
 228 ;;   Called with a numeric argument, the `pages-directory' command
 229 ;;   lists the number of lines in each page.  This is helpful when you
 230 ;;   are printing hardcopy.
 231
 232 ;;   Called with a negative numeric argument, the `pages-directory'
 233 ;;   command lists the lengths of pages whose contents match a regexp.
 234
 235 ;;; Code:
 236
 237 \f
 238 ;;; Customarily customizable variable definitions
 239
 240 (defgroup pages nil
 241   "Extended page-handling commands."
 242   :group 'extensions)
 243
 244
 245 (defcustom pages-directory-buffer-narrowing-p t
 246   "*If non-nil, `pages-directory-goto' narrows pages buffer to entry."
 247   :type 'boolean
 248   :group 'pages)
 249
 250 (defcustom pages-directory-for-adding-page-narrowing-p t
 251   "*If non-nil, `add-new-page' narrows page buffer to new entry."
 252   :type 'boolean
 253   :group 'pages)
 254
 255 (defcustom pages-directory-for-adding-new-page-before-current-page-p t
 256   "*If non-nil, `add-new-page' inserts new page before current page."
 257   :type 'boolean
 258   :group 'pages)
 259
 260 \f
 261 ;;; Addresses related variables
 262
 263 (defcustom pages-addresses-file-name "~/addresses"
 264   "*Standard name for file of addresses. Entries separated by page-delimiter.
 265 Used by `pages-directory-for-addresses' function."
 266   :type 'file
 267   :group 'pages)
 268
 269 (defcustom pages-directory-for-addresses-goto-narrowing-p t
 270   "*If non-nil, `pages-directory-goto' narrows addresses buffer to entry."
 271   :type 'boolean
 272   :group 'pages)
 273
 274 (defcustom pages-directory-for-addresses-buffer-keep-windows-p t
 275   "*If nil, `pages-directory-for-addresses' deletes other windows."
 276   :type 'boolean
 277   :group 'pages)
 278
 279 (defcustom pages-directory-for-adding-addresses-narrowing-p t
 280   "*If non-nil, `add-new-page' narrows addresses buffer to new entry."
 281   :type 'boolean
 282   :group 'pages)
 283
 284 \f
 285 ;;; Key bindings for page handling functions
 286
 287 (global-unset-key "\C-x\C-p")
 288
 289 (defvar ctl-x-ctl-p-map (make-sparse-keymap)
 290   "Keymap for subcommands of C-x C-p, which are for page handling.")
 291
 292 (define-key ctl-x-map "\C-p" 'ctl-x-ctl-p-prefix)
 293 (fset 'ctl-x-ctl-p-prefix ctl-x-ctl-p-map)
 294
 295 (define-key ctl-x-ctl-p-map "\C-n" 'next-page)
 296 (define-key ctl-x-ctl-p-map "\C-p" 'previous-page)
 297 (define-key ctl-x-ctl-p-map "\C-a" 'add-new-page)
 298 (define-key ctl-x-ctl-p-map "\C-m" 'mark-page)
 299 (define-key ctl-x-ctl-p-map "\C-s" 'search-pages)
 300 (define-key ctl-x-ctl-p-map "s"    'sort-pages-buffer)
 301 (define-key ctl-x-ctl-p-map "\C-l" 'set-page-delimiter)
 302 (define-key ctl-x-ctl-p-map "\C-d" 'pages-directory)
 303 (define-key ctl-x-ctl-p-map "d"    'pages-directory-for-addresses)
 304
 305 \f
 306 ;;; Page movement function definitions
 307
 308 (defun next-page (&optional count)
 309   "Move to the next page bounded by the `page-delimiter' variable.
 310 With arg (prefix if interactive), move that many pages."
 311   (interactive "p")
 312   (or count (setq count 1))
 313   (widen)
 314   ;; Cannot use forward-page because of problems at page boundaries.
 315   (while (and (> count 0) (not (eobp)))
 316     (if (re-search-forward page-delimiter nil t)
 317         nil
 318       (goto-char (point-max)))
 319     (setq count (1- count)))
 320   ;; If COUNT is negative, we want to go back -COUNT + 1 page boundaries.
 321   ;; The first page boundary we reach is the top of the current page,
 322   ;; which doesn't count.
 323   (while (and (< count 1) (not (bobp)))
 324     (if (re-search-backward page-delimiter nil t)
 325         (goto-char (match-beginning 0))
 326       (goto-char (point-min)))
 327     (setq count (1+ count)))
 328   (narrow-to-page)
 329   (goto-char (point-min))
 330   (recenter 0))
 331
 332 (defun previous-page (&optional count)
 333   "Move to the previous page bounded by the `page-delimiter' variable.
 334 With arg (prefix if interactive), move that many pages."
 335   (interactive "p")
 336   (or count (setq count 1))
 337   (next-page (- count)))
 338
 339 \f
 340 ;;; Adding and searching pages
 341
 342 (defun add-new-page (header-line)
 343   "Insert new page.  Prompt for header line.
 344
 345 If point is in the pages directory buffer, insert the new page in the
 346 buffer associated with the directory.
 347
 348 Insert the new page just before current page if
 349   pages-directory-for-adding-new-page-before-current-page-p  variable
 350 is non-nil.  Else insert at exact location of point.
 351
 352 Narrow to new page if
 353   pages-directory-for-adding-page-narrowing-p variable
 354 is non-nil.
 355
 356 Page begins with a `^L' as the default page-delimiter.
 357 Use \\[set-page-delimiter] to change the page-delimiter.
 358 Point is left in the body of page."
 359   (interactive "sHeader line: ")
 360   (widen)
 361   ;; If in pages directory buffer
 362   (if (eq major-mode 'pages-directory-mode)
 363       (progn
 364         ;; Add new page before or after current page?
 365         (if pages-directory-for-adding-new-page-before-current-page-p
 366             (pages-directory-goto)
 367           (pages-directory-goto)
 368           (forward-page)
 369           (or (eobp) (forward-line -1)))))
 370   (widen)
 371   ;; Move point before current delimiter if desired.
 372   (and pages-directory-for-adding-new-page-before-current-page-p
 373        (if (re-search-backward page-delimiter nil t)
 374            (goto-char (match-beginning 0))
 375          ;; If going to beginning of file, insert a page-delimiter
 376          ;; before current first page.
 377          (goto-char (point-min))
 378          (insert
 379           (format "%s\n"
 380                   ;; Remove leading `^' from page-delimiter string
 381                   (if (eq '^ (car (read-from-string page-delimiter)))
 382                       (substring page-delimiter 1))))
 383          (goto-char (point-min))))
 384   ;; Insert page delimiter at beginning of line.
 385   (if (not (looking-at "^."))   (forward-line 1))
 386   (insert (format "%s\n%s\n\n\n"
 387                   (if (eq '^ (car (read-from-string page-delimiter)))
 388                       (substring page-delimiter 1))
 389                   header-line))
 390   (forward-line -1)
 391   (and pages-directory-for-adding-page-narrowing-p (narrow-to-page)))
 392
 393 (defvar pages-last-search nil
 394   "Value of last regexp searched for.  Initially, nil.")
 395
 396 (defun search-pages (regexp)
 397   "Search for REGEXP, starting from point, and narrow to page it is in."
 398   (interactive (list
 399                 (read-string
 400                  (format "Search for `%s' (end with RET): "
 401                          (or pages-last-search "regexp")))))
 402   (if (equal regexp "")
 403       (setq regexp pages-last-search)
 404     (setq pages-last-search regexp))
 405   (widen)
 406   (re-search-forward regexp)
 407   (narrow-to-page))
 408
 409 \f
 410 ;;; Sorting pages
 411
 412 (autoload 'sort-subr "sort" "Primary function for sorting." t nil)
 413
 414 (defun sort-pages-in-region (reverse beg end)
 415   "Sort pages in region alphabetically.  Prefix arg means reverse order.
 416
 417 Called from a program, there are three arguments:
 418 REVERSE (non-nil means reverse order), BEG and END (region to sort)."
 419
 420 ;;; This sort function handles ends of pages differently than
 421 ;;; `sort-pages' and works better with lists of addresses and similar
 422 ;;; files.
 423
 424   (interactive "P\nr")
 425   (save-restriction
 426     (narrow-to-region beg end)
 427     (goto-char (point-min))
 428     ;;; `sort-subr' takes three arguments
 429     (sort-subr reverse
 430
 431                ;; NEXTRECFUN is called with point at the end of the
 432                ;; previous record. It moves point to the start of the
 433                ;; next record.
 434                (function (lambda ()
 435                            (re-search-forward page-delimiter nil t)
 436                            (skip-chars-forward " \t\n")
 437                            ))
 438
 439                ;; ENDRECFUN is is called with point within the record.
 440                ;; It should move point to the end of the record.
 441                (function (lambda ()
 442                            (if (re-search-forward
 443                                 page-delimiter
 444                                 nil
 445                                 t)
 446                                (goto-char (match-beginning 0))
 447                              (goto-char (point-max))))))))
 448
 449 (defun sort-pages-buffer (&optional reverse)
 450   "Sort pages alphabetically in buffer.  Prefix arg means reverse order.
 451 \(Non-nil arg if not interactive.\)"
 452
 453   (interactive "P")
 454   (or reverse (setq reverse nil))
 455   (widen)
 456   (let ((beginning (point-min))
 457         (end (point-max)))
 458     (sort-pages-in-region reverse beginning end)))
 459
 460 \f
 461 ;;; Pages directory ancillary definitions
 462
 463 (defvar pages-directory-previous-regexp nil
 464   "Value of previous regexp used by `pages-directory'.
 465 \(This regular expression may be used to select only those pages that
 466 contain matches to the regexp.\)")
 467
 468 (defvar pages-buffer nil
 469   "The buffer for which the pages-directory function creates the directory.")
 470
 471 (defvar pages-directory-prefix "*Directory for:"
 472   "Prefix of name of temporary buffer for pages-directory.")
 473
 474 (defvar pages-pos-list nil
 475   "List containing the positions of the pages in the pages-buffer.")
 476
 477 (defvar pages-target-buffer)
 478
 479 (defvar pages-directory-mode-map
 480   (let ((map (make-sparse-keymap)))
 481     (define-key map "\C-c\C-c" 'pages-directory-goto)
 482     (define-key map "\C-c\C-p\C-a" 'add-new-page)
 483     (define-key map [mouse-2] 'pages-directory-goto-with-mouse)
 484     map)
 485   "Keymap for the pages-directory-buffer.")
 486 (defvaralias 'pages-directory-map 'pages-directory-mode-map)
 487
 488 (defvar original-page-delimiter "^\f"
 489   "Default page delimiter.")
 490
 491 (defun set-page-delimiter (regexp reset-p)
 492   "Set buffer local value of page-delimiter to REGEXP.
 493 Called interactively with a prefix argument, reset `page-delimiter' to
 494 its original value.
 495
 496 In a program, non-nil second arg causes first arg to be ignored and
 497 resets the page-delimiter to the original value."
 498
 499   (interactive
 500    (if current-prefix-arg
 501        (list original-page-delimiter "^\f")
 502      (list (read-string "Set page-delimiter to regexp: " page-delimiter)
 503            nil)))
 504   (make-local-variable 'original-page-delimiter)
 505   (make-local-variable 'page-delimiter)
 506   (setq original-page-delimiter
 507         (or original-page-delimiter page-delimiter))
 508   (if (not reset-p)
 509       (setq page-delimiter regexp)
 510     (setq page-delimiter original-page-delimiter))
 511   (if (interactive-p)
 512       (message "The value of `page-delimiter' is now: %s" page-delimiter)))
 513
 514 \f
 515 ;;; Pages directory main definitions
 516
 517 (defun pages-directory
 518   (pages-list-all-headers-p count-lines-p &optional regexp)
 519   "Display a directory of the page headers in a temporary buffer.
 520 A header is the first non-blank line after the page-delimiter.
 521 \\[pages-directory-mode]
 522 You may move point to one of the lines in the temporary buffer,
 523 then use \\<pages-directory-goto> to go to the same line in the pages buffer.
 524
 525 In interactive use:
 526
 527     1. With no prefix arg, display all headers.
 528
 529     2. With prefix arg, display the headers of only those pages that
 530        contain matches to a regular expression for which you are
 531        prompted.
 532
 533     3. With numeric prefix arg, for every page, print the number of
 534        lines within each page.
 535
 536     4. With negative numeric prefix arg, for only those pages that
 537        match a regular expression, print the number of lines within
 538        each page.
 539
 540 When called from a program, non-nil first arg means list all headers;
 541 non-nil second arg means print numbers of lines in each page; if first
 542 arg is nil, optional third arg is regular expression.
 543
 544 If the buffer is narrowed, the `pages-directory' command creates a
 545 directory for only the accessible portion of the buffer."
 546
 547   (interactive
 548    (cond ((not current-prefix-arg)
 549           (list t nil nil))
 550          ((listp current-prefix-arg)
 551           (list nil
 552                 nil
 553                 (read-string
 554                  (format "Select according to `%s' (end with RET): "
 555                          (or pages-directory-previous-regexp "regexp")))))
 556          ((> (prefix-numeric-value current-prefix-arg) 0)
 557           (list t t nil))
 558          ((< (prefix-numeric-value current-prefix-arg) 0)
 559           (list nil
 560                 t
 561                 (read-string
 562                  (format "Select according to `%s' (end with RET): "
 563                          (or pages-directory-previous-regexp "regexp")))))))
 564
 565   (if (equal regexp "")
 566       (setq regexp pages-directory-previous-regexp)
 567     (setq pages-directory-previous-regexp regexp))
 568
 569   (if (interactive-p)
 570       (message "Creating directory for: %s "
 571                (buffer-name)))
 572
 573   (let ((pages-target-buffer (current-buffer))
 574         (pages-directory-buffer
 575          (concat pages-directory-prefix " " (buffer-name)))
 576         (linenum 1)
 577         (pages-buffer-original-position (point))
 578         (pages-buffer-original-page 0))
 579
 580     ;; `with-output-to-temp-buffer' binds the value of the variable
 581     ;; `standard-output' to the buffer named as its first argument,
 582     ;; but does not switch to that buffer.
 583     (with-output-to-temp-buffer pages-directory-buffer
 584       (save-excursion
 585         (set-buffer standard-output)
 586         (pages-directory-mode)
 587         (insert
 588          "==== Pages Directory: use `C-c C-c' to go to page under cursor. ====" ?\n)
 589         (setq pages-buffer pages-target-buffer)
 590         (setq pages-pos-list nil))
 591
 592       (if pages-list-all-headers-p
 593
 594           ;; 1. If no prefix argument, list all headers
 595           (save-excursion
 596             (goto-char (point-min))
 597
 598             ;; (a) Point is at beginning of buffer; but the first
 599             ;;     page may not begin with a page-delimiter
 600             (save-restriction
 601               ;; If page delimiter is at beginning of buffer, skip it
 602               (if (and (save-excursion
 603                          (re-search-forward page-delimiter nil t))
 604                        (= 1 (match-beginning 0)))
 605                   (goto-char (match-end 0)))
 606               (narrow-to-page)
 607               (pages-copy-header-and-position count-lines-p))
 608
 609             ;; (b) Search within pages buffer for next page-delimiter
 610             (while (re-search-forward page-delimiter nil t)
 611               (pages-copy-header-and-position count-lines-p)))
 612
 613         ;; 2. Else list headers whose pages match regexp.
 614         (save-excursion
 615           ;; REMOVED  save-restriction  AND  widen  FROM HERE
 616           (goto-char (point-min))
 617
 618           ;; (a) Handle first page
 619           (save-restriction
 620             (narrow-to-page)
 621             ;; search for selection regexp
 622             (if (save-excursion (re-search-forward regexp nil t))
 623                 (pages-copy-header-and-position count-lines-p)))
 624
 625           ;; (b) Search for next page-delimiter
 626           (while (re-search-forward page-delimiter nil t)
 627             (save-restriction
 628               (narrow-to-page)
 629               ;; search for selection regexp
 630               (if (save-excursion (re-search-forward regexp nil t))
 631                   (pages-copy-header-and-position count-lines-p)
 632                 )))))
 633
 634       (set-buffer standard-output)
 635       ;; Put positions in increasing order to go with buffer.
 636       (setq pages-pos-list (nreverse pages-pos-list))
 637       (if (interactive-p)
 638           (message "%d matching lines in: %s"
 639                    (length pages-pos-list) (buffer-name pages-target-buffer))))
 640     (pop-to-buffer pages-directory-buffer)
 641     (sit-for 0)  ; otherwise forward-line fails if N > window height.
 642     (forward-line (if (= 0 pages-buffer-original-page)
 643                       1
 644                     pages-buffer-original-page))))
 645 (eval-when-compile
 646   (defvar pages-buffer-original-position)
 647   (defvar pages-buffer-original-page)
 648   (defvar pages-buffer-original-page))
 649
 650 (defun pages-copy-header-and-position (count-lines-p)
 651   "Copy page header and its position to the Pages Directory.
 652 Only arg non-nil, count lines in page and insert before header.
 653 Used by `pages-directory' function."
 654
 655   (let (position line-count)
 656
 657     (if count-lines-p
 658         (save-excursion
 659           (save-restriction
 660             (narrow-to-page)
 661             (setq line-count (count-lines (point-min) (point-max))))))
 662
 663     ;; Keep track of page for later cursor positioning
 664     (if (<= (point) pages-buffer-original-position)
 665         (setq pages-buffer-original-page
 666               (1+ pages-buffer-original-page)))
 667
 668     (save-excursion
 669       ;; go to first non-blank char after the page-delimiter
 670       (skip-chars-forward " \t\n")
 671       ;; set the marker here; this the place to which the
 672       ;; `pages-directory-goto' command will go
 673       (setq position (make-marker))
 674       (set-marker position (point))
 675       (let ((start (point))
 676             (end (save-excursion (end-of-line) (point)))
 677             inserted-at)
 678         ;; change to directory buffer
 679         (set-buffer standard-output)
 680         ;; record page position
 681         (setq pages-pos-list (cons position pages-pos-list))
 682         ;; insert page header
 683         (setq inserted-at (point))
 684         (insert-buffer-substring pages-target-buffer start end)
 685         (add-text-properties inserted-at (point)
 686                              '(mouse-face highlight
 687                                help-echo "mouse-2: go to this page"))
 688         (put-text-property inserted-at (point) 'rear-nonsticky 'highlight))
 689
 690       (if count-lines-p
 691           (save-excursion
 692             (beginning-of-line)
 693             (insert (format "%3d: " line-count))))
 694
 695       (terpri))
 696     (end-of-line 1)))
 697
 698 (defun pages-directory-mode ()
 699   "Mode for handling the pages-directory buffer.
 700
 701 Move point to one of the lines in this buffer, then use \\[pages-directory-goto] to go
 702 to the same line in the pages buffer."
 703
 704   (kill-all-local-variables)
 705   (use-local-map pages-directory-mode-map)
 706   (setq major-mode 'pages-directory-mode)
 707   (setq mode-name "Pages-Directory")
 708   (make-local-variable 'pages-buffer)
 709   (make-local-variable 'pages-pos-list)
 710   (make-local-variable 'pages-directory-buffer-narrowing-p)
 711   (run-mode-hooks 'pages-directory-mode-hook))
 712
 713 (defun pages-directory-goto ()
 714   "Go to the corresponding line in the pages buffer."
 715
 716 ;;; This function is mostly a copy of `occur-mode-goto-occurrence'
 717
 718   (interactive)
 719   (if (or (not pages-buffer)
 720           (not (buffer-name pages-buffer)))
 721       (progn
 722         (setq pages-buffer nil
 723               pages-pos-list nil)
 724         (error "Buffer in which pages were found is deleted")))
 725   (beginning-of-line)
 726   (let* ((pages-number (1- (count-lines (point-min) (point))))
 727          (pos (nth pages-number pages-pos-list))
 728          (end-of-directory-p (eobp))
 729          (narrowing-p  pages-directory-buffer-narrowing-p))
 730     (pop-to-buffer pages-buffer)
 731     (widen)
 732     (if end-of-directory-p
 733         (goto-char (point-max))
 734       (goto-char (marker-position pos)))
 735     (if narrowing-p (narrow-to-page))))
 736
 737 (defun pages-directory-goto-with-mouse  (event)
 738   "Go to the corresponding line under the mouse pointer in the pages buffer."
 739   (interactive "e")
 740   (save-excursion
 741     (set-buffer (window-buffer (posn-window (event-end event))))
 742     (save-excursion
 743       (goto-char (posn-point (event-end event)))
 744       (pages-directory-goto))))
 745 \f
 746 ;;; The `pages-directory-for-addresses' function and ancillary code
 747
 748 (defun pages-directory-for-addresses (&optional filename)
 749   "Find addresses file and display its directory.
 750 By default, create and display directory of `pages-addresses-file-name'.
 751 Optional argument is FILENAME.  In interactive use, with prefix
 752 argument, prompt for file name and provide completion.
 753
 754 Move point to one of the lines in the displayed directory,
 755 then use \\[pages-directory-goto] to go to the same line
 756 in the addresses buffer.
 757
 758 If    pages-directory-for-addresses-goto-narrowing-p    is non-nil,
 759 `pages-directory-goto' narrows addresses buffer to entry.
 760
 761 If    pages-directory-for-addresses-buffer-keep-windows-p     is nil,
 762 this command deletes other windows when it displays the addresses
 763 directory."
 764
 765   (interactive
 766    (list (if current-prefix-arg
 767              (read-file-name "Filename: " pages-addresses-file-name))))
 768
 769   (if (interactive-p)
 770       (message "Creating directory for: %s "
 771                (or filename pages-addresses-file-name)))
 772   (if (file-exists-p (or filename pages-addresses-file-name))
 773       (progn
 774         (set-buffer
 775          (find-file-noselect
 776           (expand-file-name
 777            (or filename pages-addresses-file-name))))
 778         (widen)
 779         (pages-directory t nil nil)
 780         ;; by RJC, 2006 Jun 11: including this causes failure; it results in
 781         ;;  the message "Buffer in which pages were found is deleted"
 782         ;;        (pages-directory-address-mode)
 783         (setq pages-directory-buffer-narrowing-p
 784               pages-directory-for-addresses-goto-narrowing-p)
 785         (or pages-directory-for-addresses-buffer-keep-windows-p
 786             (delete-other-windows))
 787         (save-excursion
 788           (goto-char (point-min))
 789           (delete-region (point) (save-excursion (end-of-line) (point)))
 790           (insert
 791            "=== Address List Directory: use `C-c C-c' to go to page under cursor. ===")
 792           (set-buffer-modified-p nil)
 793           ))
 794     (error "No addresses file found!")))
 795
 796 (define-derived-mode pages-directory-address-mode pages-directory-mode
 797   "Addresses Directory"
 798   "Mode for handling the Addresses Directory buffer.
 799
 800 Move point to one of the lines in this buffer,
 801 then use \\[pages-directory-goto] to go
 802 to the same line in the pages buffer."
 803   :syntax-table nil)
 804
 805 (provide 'page-ext)
 806
 807 ;; arch-tag: 2f311550-c6e0-4458-9c12-7f039c058bdb
 808 ;;; page-ext.el ends here