Source

edit-utils / page-ext.el

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
;;; page-ext.el --- extended page handling commands

;; Copyright (C) 1990, 1991, 1993, 1994 Free Software Foundation

;; Maintainer: Robert J. Chassell <bob@gnu.ai.mit.edu>

;; This file is part of XEmacs.

;; XEmacs is free software; you can redistribute it and/or modify it
;; under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; XEmacs is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;; General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with XEmacs; see the file COPYING.  If not, write to the Free
;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
;; 02111-1307, USA.

;;; Synched up with: FSF 19.34.

;;; Commentary:

;; You may use these commands to handle an address list or other
;; small data base.


;;; Summary

;; The current page commands are:

;;     forward-page         C-x ]
;;     backward-page        C-x [
;;     narrow-to-page       C-x p
;;     count-lines-page     C-x l
;;     mark-page            C-x C-p  (change this to C-x C-p C-m)
;;     sort-pages           not bound
;;     what-page            not bound

;; The new page handling commands all use `C-x C-p' as a prefix.  This
;; means that the key binding for `mark-page' must be changed.
;; Otherwise, no other changes are made to the current commands or
;; their bindings.

;; New page handling commands:

;;     next-page                        C-x C-p C-n
;;     previous-page                    C-x C-p C-p
;;     search-pages                     C-x C-p C-s
;;     add-new-page                     C-x C-p C-a
;;     sort-pages-buffer                C-x C-p s      
;;     set-page-delimiter               C-x C-p C-l
;;     pages-directory                  C-x C-p C-d   
;;     pages-directory-for-addresses    C-x C-p d
;;        pages-directory-goto          C-c C-c


;;; Using the page commands
 
;; The page commands are helpful in several different contexts.  For
;; example, programmers often divide source files into sections using the
;; `page-delimiter'; you can use the `pages-directory' command to list
;; the sections.

;; You may change the buffer local value of the `page-delimiter' with
;; the `set-page-delimiter' command.  This command is bound to `C-x C-p
;; C-l' The command prompts you for a new value for the page-delimiter.
;; Called with a prefix-arg, the command resets the value of the
;; page-delimiter to its original value.

;; You may set several user options:
;;
;;   The `pages-directory-buffer-narrowing-p' variable causes the
;;   `pages-directory-goto' command to narrow to the destination page.
;;
;;   The `pages-directory-for-adding-page-narrowing-p' variable, causes the
;;   `add-new-page' command to narrow to the new entry.
;;
;;   The `pages-directory-for-adding-new-page-before-current-page-p' variable
;;   causes the `add-new-page' command to insert a new page before current
;;   page.
;;
;; These variables are true by default.
;;
;; Additional, addresses-related user options are described in the next page
;; of this file.


;;; Handling an address list or small data base

;; You may use the page commands to handle an address list or other
;; small data base.  Put each address or entry on its own page.  The
;; first line of text in each page is a `header line' and is listed by
;; the `pages-directory' or `pages-directory-for-addresses' command.

;; Specifically:
;; 
;;   1. Begin each entry with a `page-delimiter' (which is, by default,
;;      `^L' at the beginning of the line).
;; 
;;   2. The first line of text in each entry is the `heading line'; it
;;      will appear in the pages-directory-buffer which is constructed
;;      using the `C-x C-p C-d' (pages-directory) command or the `C-x
;;      C-p d' (pages-directory-for-addresses) command.
;; 
;;      The heading line may be on the same line as the page-delimiter
;;      or it may follow after.  It is the first non-blank line on the
;;      page.  Conventionally, the heading line is placed on the line
;;      immediately following the line containing page-delimiter.
;;
;;   3. Follow the heading line with the body of the entry.  The body
;;      extends up to the next `page-delimiter'.  The body may be of any
;;      length.  It is conventional to place a blank line after the last
;;      line of the body.

;; For example, a file might look like this:
;; 
;;     FSF
;;     Free Software Foundation
;;     59 Temple Place - Suite 330
;;     Boston, MA 02111-1307  USA.
;;     (617) 542-5942
;;     gnu@prep.ai.mit.edu
;; 
;;     
;;     House Subcommittee on Intellectual Property,
;;     U.S. House of Representatives,
;;     Washington, DC  20515
;;     
;;     Congressional committee concerned with permitting or preventing
;;     monopolistic restrictions on the use of software technology.
;; 
;;     
;;     George Lakoff
;;     ``Women, Fire, and Dangerous Things:
;;     What Categories Reveal about the Mind''
;;     1987, Univ. of Chicago Press
;; 
;;     About philosophy, Whorfian effects, and linguistics.
;; 
;;      
;;     OBI   (On line text collection.)
;;     Open Book Initiative
;;     c/o Software Tool & Die
;;     1330 Beacon St, Brookline, MA 02146 USA
;;     (617) 739-0202 
;;     obi@world.std.com

;; In this example, the heading lines are:
;;
;;     FSF
;;     House Subcommittee on Intellectual Property
;;     George Lakoff
;;     OBI (On line text collection.)

;; The `C-x C-p s' (sort-pages-buffer) command sorts the entries in the
;; buffer alphabetically.

;; You may use any of the page commands, including the `next-page',
;; `previous-page', `add-new-page', `mark-page', and `search-pages'
;; commands.

;; You may use either the `C-x C-p d' (pages-directory-for-addresses)
;; or the `C-x C-p C-d' (pages-directory) command to construct and
;; display a directory of all the heading lines.

;; In the directory, you may position the cursor over a heading line
;; and type `C-c C-c' (pages-directory-goto) to go to the entry to
;; which it refers in the pages buffer.

;; You can type `C-c C-p C-a' (add-new-page) to add a new entry in the
;; pages buffer or address file.  This is the same command you use to
;; add a new entry when you are in the pages buffer or address file.

;; If you wish, you may create several different directories,
;; one for each different buffer.

;; `pages-directory-for-addresses' in detail

;; The `pages-directory-for-addresses' assumes a default addresses
;; file.  You do not need to specify the addresses file but merely type
;; `C-x C-p d' from any buffer.  The command finds the file, constructs
;; a directory for it, and switches you to the directory.  If you call
;; the command with a prefix arg, `C-u C-x C-p d', it prompts you for a
;; file name.

;; You may customize the addresses commands:

;;   The `pages-addresses-file-name' variable determines the name of
;;   the addresses file; by default it is "~/addresses".

;;   The `pages-directory-for-addresses-goto-narrowing-p' variable
;;   determines whether `pages-directory-goto' narrows the addresses
;;   buffer to the entry, which it does by default.

;;   The `pages-directory-for-addresses-buffer-keep-windows-p' variable
;;   determines whether `pages-directory-for-addresses' deletes other
;;   windows to show as many lines as possible on the screen or works
;;   in the usual Emacs manner and keeps other windows.  Default is to
;;   keep other windows.

;;   The `pages-directory-for-adding-addresses-narrowing-p' variable
;;   determines whether `pages-directory-for-addresses' narrows the
;;   addresses buffer to a new entry when you are adding that entry.
;;   Default is to narrow to new entry, which means you see a blank
;;   screen before you write the new entry.

;; `pages-directory' in detail

;; Call the `pages-directory' command from the buffer for which you
;; want a directory created; it creates a directory for the buffer and
;; pops you to the directory.

;; The `pages-directory' command has several options:

;;   Called with a prefix arg, `C-u C-x C-p C-d', the `pages-directory'
;;   prompts you for a regular expression and only lists only those
;;   header lines that are part of pages that contain matches to the
;;   regexp.  In the example above, `C-u C-x C-p C-d 617 RET' would
;;   match the telephone area code of the first and fourth entries, so
;;   only the header lines of those two entries would appear in the
;;   pages-directory-buffer.
;; 
;;   Called with a numeric argument, the `pages-directory' command
;;   lists the number of lines in each page.  This is helpful when you
;;   are printing hardcopy.  

;;   Called with a negative numeric argument, the `pages-directory'
;;   command lists the lengths of pages whose contents match a regexp.

;;; Code:


;;; Customarily customizable variable definitions

(defgroup pages nil
  "Extended page-handling commands."
  :group 'extensions)


(defcustom pages-directory-buffer-narrowing-p t
  "*If non-nil, `pages-directory-goto' narrows pages buffer to entry."
  :type 'boolean
  :group 'pages)

(defcustom pages-directory-for-adding-page-narrowing-p t
  "*If non-nil, `add-new-page' narrows page buffer to new entry."
  :type 'boolean
  :group 'pages)

(defcustom pages-directory-for-adding-new-page-before-current-page-p t
  "*If non-nil, `add-new-page' inserts new page before current page."
  :type 'boolean
  :group 'pages)


;;; Addresses related variables

(defcustom pages-addresses-file-name "~/addresses"
  "*Standard name for file of addresses. Entries separated by page-delimiter.
Used by `pages-directory-for-addresses' function."
  :type 'file
  :group 'pages)

(defcustom pages-directory-for-addresses-goto-narrowing-p t
  "*If non-nil, `pages-directory-goto' narrows addresses buffer to entry."
  :type 'boolean
  :group 'pages)

(defcustom pages-directory-for-addresses-buffer-keep-windows-p t
  "*If nil, `pages-directory-for-addresses' deletes other windows."
  :type 'boolean
  :group 'pages)

(defcustom pages-directory-for-adding-addresses-narrowing-p t
  "*If non-nil, `add-new-page' narrows addresses buffer to new entry."
  :type 'boolean
  :group 'pages)


;;; Key bindings for page handling functions

(global-unset-key "\C-x\C-p")

(defvar ctl-x-ctl-p-map (make-sparse-keymap)
  "Keymap for subcommands of C-x C-p, which are for page handling.")

(define-key ctl-x-map "\C-p" 'ctl-x-ctl-p-prefix)
(fset 'ctl-x-ctl-p-prefix ctl-x-ctl-p-map)

(define-key ctl-x-ctl-p-map "\C-n" 'next-page)
(define-key ctl-x-ctl-p-map "\C-p" 'previous-page)
(define-key ctl-x-ctl-p-map "\C-a" 'add-new-page)
(define-key ctl-x-ctl-p-map "\C-m" 'mark-page)
(define-key ctl-x-ctl-p-map "\C-s" 'search-pages)
(define-key ctl-x-ctl-p-map "s"    'sort-pages-buffer)
(define-key ctl-x-ctl-p-map "\C-l" 'set-page-delimiter)
(define-key ctl-x-ctl-p-map "\C-d" 'pages-directory)
(define-key ctl-x-ctl-p-map "d"    'pages-directory-for-addresses)


;;; Page movement function definitions

(defun next-page (&optional count)
  "Move to the next page bounded by the `page-delimiter' variable.
With arg (prefix if interactive), move that many pages."
  (interactive "p")
  (or count (setq count 1))
  (widen)
  ;; Cannot use forward-page because of problems at page boundaries.
  (while (and (> count 0) (not (eobp)))
    (if (re-search-forward page-delimiter nil t)
        nil
      (goto-char (point-max)))
    (setq count (1- count)))
  ;; If COUNT is negative, we want to go back -COUNT + 1 page boundaries.
  ;; The first page boundary we reach is the top of the current page,
  ;; which doesn't count.
  (while (and (< count 1) (not (bobp)))
    (if (re-search-backward page-delimiter nil t)
	(goto-char (match-beginning 0))
      (goto-char (point-min)))
    (setq count (1+ count)))
  (narrow-to-page)
  (goto-char (point-min))
  (recenter 0))

(defun previous-page (&optional count)
  "Move to the previous page bounded by the `page-delimiter' variable.
With arg (prefix if interactive), move that many pages."
  (interactive "p")
  (or count (setq count 1))
  (next-page (- count)))


;;; Adding and searching pages

(defun add-new-page (header-line)
  "Insert new page.  Prompt for header line.

If point is in the pages directory buffer, insert the new page in the
buffer associated with the directory.

Insert the new page just before current page if
  pages-directory-for-adding-new-page-before-current-page-p  variable
is non-nil.  Else insert at exact location of point.

Narrow to new page if
  pages-directory-for-adding-page-narrowing-p variable
is non-nil.

Page begins with a `^L' as the default page-delimiter.  
Use \\[set-page-delimiter] to change the page-delimiter.
Point is left in the body of page."
  (interactive "sHeader line: ")
  (widen)
  ;; If in pages directory buffer
  (if (eq major-mode 'pages-directory-mode) 
      (progn
        ;; Add new page before or after current page?
        (if pages-directory-for-adding-new-page-before-current-page-p
            (pages-directory-goto)
          (pages-directory-goto)
          (forward-page)
          (or (eobp) (forward-line -1)))))
  (widen)
  ;; Move point before current delimiter if desired.
  (and pages-directory-for-adding-new-page-before-current-page-p
       (if (re-search-backward page-delimiter nil t)
           (goto-char (match-beginning 0))
         ;; If going to beginning of file, insert a page-delimiter
         ;; before current first page.
         (goto-char (point-min))
         (insert
          (format "%s\n"
                  ;; Remove leading `^' from page-delimiter string
                  (if (eq '^ (car (read-from-string page-delimiter)))
                      (substring page-delimiter 1))))         
         (goto-char (point-min))))
  ;; Insert page delimiter at beginning of line.
  (if (not (looking-at "^."))   (forward-line 1))
  (insert (format "%s\n%s\n\n\n" 
                  (if (eq '^ (car (read-from-string page-delimiter)))
                      (substring page-delimiter 1))
                  header-line))
  (forward-line -1)
  (and pages-directory-for-adding-page-narrowing-p (narrow-to-page)))

(defvar pages-last-search nil
  "Value of last regexp searched for.  Initially, nil.")

(defun search-pages (regexp)
  "Search for REGEXP, starting from point, and narrow to page it is in."
  (interactive (list
                (read-string
                 (format "Search for `%s' (end with RET): "
                         (or pages-last-search "regexp")))))
  (if (equal regexp "")
      (setq regexp pages-last-search)
    (setq pages-last-search regexp))
  (widen)
  (re-search-forward regexp)
  (narrow-to-page))


;;; Sorting pages

(autoload 'sort-subr "sort" "Primary function for sorting." t nil)

(defun sort-pages-in-region (reverse beg end)
  "Sort pages in region alphabetically.  Prefix arg means reverse order.  

Called from a program, there are three arguments:
REVERSE (non-nil means reverse order), BEG and END (region to sort)."

;;; This sort function handles ends of pages differently than
;;; `sort-pages' and works better with lists of addresses and similar
;;; files.

  (interactive "P\nr")
  (save-restriction
    (narrow-to-region beg end)
    (goto-char (point-min))
    ;;; `sort-subr' takes three arguments
    (sort-subr reverse

               ;; NEXTRECFUN is called with point at the end of the
               ;; previous record. It moves point to the start of the
               ;; next record.
	       (function (lambda ()
                           (re-search-forward page-delimiter nil t)
                           (skip-chars-forward " \t\n")
                           ))

               ;; ENDRECFUN is called with point within the record.
               ;; It should move point to the end of the record.
	       (function (lambda ()
                           (if (re-search-forward
                                page-delimiter
                                nil
                                t)
                               (goto-char (match-beginning 0))
                             (goto-char (point-max))))))))

(defun sort-pages-buffer (&optional reverse)
  "Sort pages alphabetically in buffer.  Prefix arg means reverse order. 
\(Non-nil arg if not interactive.\)"

  (interactive "P")
  (or reverse (setq reverse nil))
  (widen)
  (let ((beginning (point-min))
        (end (point-max)))
    (sort-pages-in-region reverse beginning end)))


;;; Pages directory ancillary definitions

(defvar pages-directory-previous-regexp nil
  "Value of previous regexp used by `pages-directory'.
\(This regular expression may be used to select only those pages that
contain matches to the regexp.\)")

(defvar pages-buffer nil
  "The buffer for which the pages-directory function creates the directory.")

(defvar pages-directory-prefix "*Directory for:"
  "Prefix of name of temporary buffer for pages-directory.")

(defvar pages-pos-list nil
  "List containing the positions of the pages in the pages-buffer.")

(defvar pages-directory-map nil
  "Keymap for the pages-directory-buffer.")

(if pages-directory-map
    ()
  (setq pages-directory-map (make-sparse-keymap))
  (define-key pages-directory-map "\C-c\C-c"
    'pages-directory-goto)
  (define-key pages-directory-map "\C-c\C-p\C-a" 'add-new-page))

(defvar original-page-delimiter "^\f"
  "Default page delimiter.")

(defun set-page-delimiter (regexp reset-p)
  "Set buffer local value of page-delimiter to REGEXP.
Called interactively with a prefix argument, reset `page-delimiter' to
its original value.

In a program, non-nil second arg causes first arg to be ignored and
resets the page-delimiter to the original value."
  
  (interactive
   (if current-prefix-arg
       (list original-page-delimiter "^\f")
     (list (read-string "Set page-delimiter to regexp: " page-delimiter)
           nil)))
  (make-local-variable 'original-page-delimiter)
  (make-local-variable 'page-delimiter)
  (setq original-page-delimiter
        (or original-page-delimiter page-delimiter))
  (if (not reset-p)
      (setq page-delimiter regexp)
    (setq page-delimiter original-page-delimiter))
  (if (interactive-p)
      (message "The value of `page-delimiter' is now: %s" page-delimiter)))


;;; Pages directory main definitions

(defun pages-directory
  (pages-list-all-headers-p count-lines-p &optional regexp)
  "Display a directory of the page headers in a temporary buffer.
A header is the first non-blank line after the page-delimiter.
\\[pages-directory-mode]
You may move point to one of the lines in the temporary buffer,
then use \\<pages-directory-goto> to go to the same line in the pages buffer.

In interactive use:

    1. With no prefix arg, display all headers.

    2. With prefix arg, display the headers of only those pages that
       contain matches to a regular expression for which you are
       prompted.

    3. With numeric prefix arg, for every page, print the number of
       lines within each page.

    4. With negative numeric prefix arg, for only those pages that
       match a regular expression, print the number of lines within
       each page.

When called from a program, non-nil first arg means list all headers;
non-nil second arg means print numbers of lines in each page; if first
arg is nil, optional third arg is regular expression.

If the buffer is narrowed, the `pages-directory' command creates a
directory for only the accessible portion of the buffer."
  
  (interactive
   (cond ((not current-prefix-arg)
          (list t nil nil))
         ((listp current-prefix-arg) 
          (list nil
                nil
                (read-string
                 (format "Select according to `%s' (end with RET): "
                         (or pages-directory-previous-regexp "regexp")))))
         ((> (prefix-numeric-value current-prefix-arg) 0)
          (list t t nil))
         ((< (prefix-numeric-value current-prefix-arg) 0)          
          (list nil
                t
                (read-string
                 (format "Select according to `%s' (end with RET): "
                         (or pages-directory-previous-regexp "regexp")))))))
  
  (if (equal regexp "")
      (setq regexp pages-directory-previous-regexp)
    (setq pages-directory-previous-regexp regexp))
  
  (if (interactive-p)
      (message "Creating directory for: %s "
               (buffer-name)))
  
  (let ((target-buffer (current-buffer))
        (pages-directory-buffer
	 (concat pages-directory-prefix " " (buffer-name)))
        (linenum 1)
        (pages-buffer-original-position (point))
        (pages-buffer-original-page 0))
    
    ;; `with-output-to-temp-buffer' binds the value of the variable
    ;; `standard-output' to the buffer named as its first argument,
    ;; but does not switch to that buffer.
    (with-output-to-temp-buffer pages-directory-buffer
      (save-excursion
        (set-buffer standard-output)
        (pages-directory-mode)
        (insert
         "==== Pages Directory: use `C-c C-c' to go to page under cursor. ====" ?\n)
        (setq pages-buffer target-buffer)
        (setq pages-pos-list nil))
      
      (if pages-list-all-headers-p
          
          ;; 1. If no prefix argument, list all headers
          (save-excursion
            (goto-char (point-min))
            
            ;; (a) Point is at beginning of buffer; but the first
            ;;     page may not begin with a page-delimiter
            (save-restriction
              ;; If page delimiter is at beginning of buffer, skip it
              (if (and (save-excursion
                         (re-search-forward page-delimiter nil t))
                       (= 1 (match-beginning 0)))
                  (goto-char (match-end 0)))
              (narrow-to-page)
              (pages-copy-header-and-position count-lines-p))
            
            ;; (b) Search within pages buffer for next page-delimiter
            (while (re-search-forward page-delimiter nil t)
              (pages-copy-header-and-position count-lines-p)))
        
        ;; 2. Else list headers whose pages match regexp.
        (save-excursion
          ;; REMOVED  save-restriction  AND  widen  FROM HERE
          (goto-char (point-min))
          
          ;; (a) Handle first page
          (save-restriction
            (narrow-to-page)
            ;; search for selection regexp
            (if (save-excursion (re-search-forward regexp nil t))
                (pages-copy-header-and-position count-lines-p)))
          
          ;; (b) Search for next page-delimiter
          (while (re-search-forward page-delimiter nil t)
            (save-restriction
              (narrow-to-page)
              ;; search for selection regexp
              (if (save-excursion (re-search-forward regexp nil t))
                  (pages-copy-header-and-position count-lines-p)
                )))))
      
      (set-buffer standard-output)
      ;; Put positions in increasing order to go with buffer.
      (setq pages-pos-list (nreverse pages-pos-list))
      (if (interactive-p)
          (message "%d matching lines in: %s"
                   (length pages-pos-list) (buffer-name target-buffer))))
    (pop-to-buffer pages-directory-buffer)
    (sit-for 0)  ; otherwise forward-line fails if N > window height.
    (forward-line (if (= 0 pages-buffer-original-page)
                      1
                    pages-buffer-original-page))))

(defun pages-copy-header-and-position (count-lines-p)
  "Copy page header and its position to the Pages Directory.
Only arg non-nil, count lines in page and insert before header.
Used by `pages-directory' function."
  
  (let (position line-count)

    (if count-lines-p
        (save-excursion
          (save-restriction
            (narrow-to-page)
            (setq line-count (count-lines (point-min) (point-max))))))

    ;; Keep track of page for later cursor positioning
    (if (<= (point) pages-buffer-original-position)
        (setq pages-buffer-original-page
              (1+ pages-buffer-original-page)))
    
    (save-excursion
      ;; go to first non-blank char after the page-delimiter
      (skip-chars-forward " \t\n")     
      ;; set the marker here; this the place to which the
      ;; `pages-directory-goto' command will go 
      (setq position (make-marker))
      (set-marker position (point))
      (let ((start (point))
            (end (save-excursion (end-of-line) (point))))
        ;; change to directory buffer
        (set-buffer standard-output)
        ;; record page position 
        (setq pages-pos-list (cons position pages-pos-list))
        ;; insert page header
        (insert-buffer-substring target-buffer start end))
      
      (if count-lines-p
          (save-excursion
            (beginning-of-line)
            (insert (format "%3d: " line-count))))
      
      (terpri))
    (end-of-line 1)))

(defun pages-directory-mode ()
  "Mode for handling the pages-directory buffer.

Move point to one of the lines in this buffer, then use \\[pages-directory-goto] to go
to the same line in the pages buffer."

  (kill-all-local-variables)
  (use-local-map pages-directory-map)
  (setq major-mode 'pages-directory-mode)
  (setq mode-name "Pages-Directory")
  (make-local-variable 'pages-buffer)
  (make-local-variable 'pages-pos-list)
  (make-local-variable 'pages-directory-buffer-narrowing-p))

(defun pages-directory-goto ()
  "Go to the corresponding line in the pages buffer."

;;; This function is mostly a copy of `occur-mode-goto-occurrence'

  (interactive)
  (if (or (not pages-buffer)
	  (not (buffer-name pages-buffer)))
      (progn
	(setq pages-buffer nil
	      pages-pos-list nil)
	(error "Buffer in which pages were found is deleted.")))
  (beginning-of-line)
  (let* ((pages-number (1- (count-lines (point-min) (point))))
	 (pos (nth pages-number pages-pos-list))
         (end-of-directory-p (eobp))
         (narrowing-p  pages-directory-buffer-narrowing-p))
    (pop-to-buffer pages-buffer)  
    (widen)
    (if end-of-directory-p
        (goto-char (point-max))
      (goto-char (marker-position pos)))
    (if narrowing-p (narrow-to-page))))


;;; The `pages-directory-for-addresses' function and ancillary code

(defun pages-directory-for-addresses (&optional filename)
  "Find addresses file and display its directory.
By default, create and display directory of `pages-addresses-file-name'.
Optional argument is FILENAME.  In interactive use, with prefix
argument, prompt for file name and provide completion.

Move point to one of the lines in the displayed directory,
then use \\[pages-directory-goto] to go to the same line
in the addresses buffer.

If    pages-directory-for-addresses-goto-narrowing-p    is non-nil,
`pages-directory-goto' narrows addresses buffer to entry.

If    pages-directory-for-addresses-buffer-keep-windows-p     is nil,
this command deletes other windows when it displays the addresses 
directory."

  (interactive
   (list (if current-prefix-arg
             (read-file-name "Filename: " pages-addresses-file-name))))

  (if (interactive-p)
      (message "Creating directory for: %s "
               (or filename pages-addresses-file-name)))
  (if (file-exists-p (or filename pages-addresses-file-name))
      (progn
        (set-buffer
         (find-file-noselect
          (expand-file-name
           (or filename pages-addresses-file-name))))
        (widen)
        (pages-directory t nil nil)
        (pages-directory-address-mode)
        (setq pages-directory-buffer-narrowing-p
              pages-directory-for-addresses-goto-narrowing-p)
        (or pages-directory-for-addresses-buffer-keep-windows-p
            (delete-other-windows))
        (save-excursion
          (goto-char (point-min))
          (delete-region (point) (save-excursion (end-of-line) (point)))
          (insert
           "=== Address List Directory: use `C-c C-c' to go to page under cursor. ===")
          (set-buffer-modified-p nil)
          ))
    (error "No addresses file found!")))

(defun pages-directory-address-mode ()
  "Mode for handling the Addresses Directory buffer.

Move point to one of the lines in this buffer,
then use \\[pages-directory-goto] to go
to the same line in the pages buffer."

  (use-local-map pages-directory-map)
  (setq major-mode 'pages-directory-address-mode)
  (setq mode-name "Addresses Directory")
  (make-local-variable 'pages-buffer)
  (make-local-variable 'pages-pos-list)
  (make-local-variable 'pages-directory-buffer-narrowing-p))


;;; Place `provide' at end of file.
(provide 'page-ext)

;;;;;;;;;;;;;;;; end of page-ext.el ;;;;;;;;;;;;;;;;