*** empty log message ***
[bpt/emacs.git] / lisp / textmodes / page-ext.el
CommitLineData
6594deb0 1;;; page-ext.el --- page handling commands
0d2d639a 2
0d2d639a
JB
3;;; by Robert J. Chassell
4
5;;; You may use these commands to handle an address list or other
6;;; small data base.
7
8;;; Copyright (C) 1990 Free Software Foundation
9;;; Please send bug reports to bob@ai.mit.edu
10
11;;; Change Log ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12;;;
13;;; Version 0.043
14;;; 24 May 1990 - When the cursor is at the end of the pages directory
15;;; buffer (which is empty), a `C-c C-c' (pages-directory-goto)
16;;; command now takes you to the end of the buffer.
17;;;
18;;; Version 0.042
19;;; 16 May 1990 - Since people often handle address and other files
20;;; differently, variable `pages-directory-for-addresses-narrowing-p'
21;;; now specifies whether `pages-directory-goto' should narrow
22;;; addresses buffer to entry to which it goes.
23;;; `pages-directory-buffer-narrowing-p' continues to control
24;;; narrowing of pages buffer.
25;;;
26;;; `add-new-page' documentation string now explains
27;;; that the value of the inserted page-delimiter is a `^L'.
28;;;
29;;; `pages-directory-previous-regexp' definition reworded.
30;;;
31;;; Removed unneeded defvar for `pages-directory-buffer'.
32;;;
33;;; Version 0.041
34;;; 14 May 1990 - `pages-last-search' bound to nil initially.
35;;; Remove unnecessary lines from `search-pages' definition.
36;;;
37;;; Version 0.04
38;;; 18 Mar 1990 - `pages-directory' creates a directory for only the
39;;; accessible portion of the buffer; it does not automatically widen
40;;; the buffer.
41;;;
42;;; However, `pages-directory-for-addresses' does widen the addresses'
43;;; buffer before constructing the addresses' directory.
44;;;
45;;; Version 0.032
46;;; 20 Feb 1990 - `pages-directory-for-addresses' no longer copies
47;;; first line of addresses directory to kill-ring
48;;;
49;;; Remove `(kill-all-local-variables)' line from
50;;; `pages-directory-address-mode' so Emacs will not be told to forget
51;;; the name of the file containing the addresses!
52;;;
53;;; Version 0.031
54;;; 15 Feb 1990 - `pages-directory-goto' no longer erroneously selects
55;;; the entry on the following line when the cursor is at the end of
56;;; the line, but selects the entry on which the cursor rests.
57;;;
58;;; `pages-directory-address-mode' now sets local variables and enables
59;;; `describe-mode' to describe Addresses Directory mode.
60;;;
61;;; `pages-directory-for-addresses' now sets the buffer-modifed flag
62;;; for the Addresses Directory to nil.
63;;;
64;;; The documentation string for both `pages-directory-mode' and
65;;; `pages-directory-address-mode' now provide a lookup for the
66;;; `pages-directory-goto' keybinding.
67;;;
68;;; Version 0.03
69;;; 10 Feb 1990 - Incorporated a specialized extension of the
70;;; `pages-directory' command called `pages-directory-for-addresses'
71;;; and bound it to ctl-x-ctl-p-map "d" for integration with other
72;;; page functions. This function finds a file, creates a directory
73;;; for it using the `pages-directory' command, and displays the
74;;; directory. It is primarily for lists of addresses and the like.
75;;;
76;;; The difference between this and the `pages-directory' command is
77;;; that the `pages-directory-for-addresses' command presumes a
78;;; default addresses file (although you may optionally specify a file
79;;; name) and it switches you to the directory for the file, but the
80;;; `pages-directory' command creates a directory for the current
81;;; buffer, and pops to the directory in another window.
82;;;
83;;; `pages-directory' now places the cursor over the header line of
84;;; the page in which point was located in the pages buffer.
85;;;
86;;; New `set-page-delimiter' command sets the buffer local value of
87;;; the page-delimiter variable. With prefix arg, resets function to
88;;; original value. (Quicker to use than `edit-options'.)
89;;;
90;;; Version 0.02
91;;; 9 Feb 1990 - `pages-directory' now displays the
92;;; first line that contains a non-blank character that follows the
93;;; `page-delimiter'; this may be the rest of the line that contains
94;;; the `page-delimiter' or a line following. (In most instances, the
95;;; line containing a non-blank character is a line of text.)
96;;; Modification includes changes to `pages-copy-header-and-position'.
97;;;
98;;; Each directory created by `pages-directory' now possesses a name
99;;; derived on the name of the pages buffer. Consequently, you may
100;;; create several different directories, one for each pages buffer.
101;;;
102;;; `sort-pages-in-region' no longers requires the text to start on
103;;; the line immediately following the line containing the
104;;; page-delimiter.
105;;;
106;;; `pages-directory-goto' no longer narrows to the page
107;;; automatically. Instead, if you wish it to narrow to the page, set
108;;; variable pages-directory-buffer-narrowing-p to a non-nil value.
109;;; Default is nil; this is an experiment to see whether it is useful
110;;; to see the surrounding context.
111;;;
112;;; Version 0.011
113;;; 2 Feb 1990 - `add-new-page': removed extraneous space.
114;;;
115;;; Version 0.01
116;;; 28 Jan 1990 - Initial definitions.
117;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
118
119\f
120;;;; Summary
121
122; The current page commands are:
123
124; forward-page C-x ]
125; backward-page C-x [
126; narrow-to-page C-x p
127; count-lines-page C-x l
128; mark-page C-x C-p (change this to C-x C-p C-m)
129; sort-pages not bound
130; what-page not bound
131
132; The new page handling commands all use `C-x C-p' as a prefix. This
133; means that the key binding for `mark-page' must be changed.
134; Otherwise, no other changes are made to the current commands or
135; their bindings.
136
137; New page handling commands:
138
139; next-page C-x C-p C-n
140; previous-page C-x C-p C-p
141; search-pages C-x C-p C-s
142; add-new-page C-x C-p C-a
143; sort-pages-buffer C-x C-p s
144; set-page-delimiter C-x C-p C-l
145; pages-directory C-x C-p C-d
146; pages-directory-for-addresses C-x C-p d
147; goto-page C-c C-c
148
149\f
150;;;; Using the page commands
151;
152; The page commands are helpful in several different contexts. For
153; example, programmers often divide source files into sections using the
154; `page-delimiter'; you can use the `pages-directory' command to list
155; the sections.
156
157; You may change the buffer local value of the `page-delimiter' with
158; the `set-page-delimiter' command. This command is bound to `C-x C-p
159; C-l' The command prompts you for a new value for the page-delimiter.
160; Called with a prefix-arg, the command resets the value of the
161; page-delimiter to its original value.
162
163\f
164;;;; Handling an address list or small data base
165
166; You may use the page commands to handle an address list or other
167; small data base. Put each address or entry on its own page. The
168; first line of text in each page is a `header line' and is listed by
169; the `pages-directory' or `pages-directory-for-addresses' command.
170
171; Specifically:
172;
173; 1. Begin each entry with a `page-delimiter' (which is, by default,
174; `^L' at the beginning of the line).
175;
176; 2. The first line of text in each entry is the `heading line'; it
177; will appear in the pages-directory-buffer which is constructed
178; using the `C-x C-p C-d' (pages-directory) command or the `C-x
179; C-p d' (pages-directory-for-addresses) command.
180;
181; The heading line may be on the same line as the page-delimiter
182; or it may follow after. It is the first non-blank line on the
183; page. Conventionally, the heading line is placed on the line
184; immediately following the line containing page-delimiter.
185;
186; 3. Follow the heading line with the body of the entry. The body
187; extends up to the next `page-delimiter'. The body may be of any
188; length. It is conventional to place a blank line after the last
189; line of the body.
190
191; For example, a file might look like this:
192;
193; FSF
194; Free Software Foundation
195; 675 Massachusetts Avenue
196; Cambridge, MA 02139 USA
197; (617) 876-3296
198; gnu@prep.ai.mit.edu
199;
200; \f
201; House Subcommittee on Intellectual Property,
202; U.S. House of Representatives,
203; Washington, DC 20515
204;
205; Congressional committee concerned with permitting or preventing
206; monopolistic restictions on the use of software technology
207;
208; \f
209; George Lakoff
210; ``Women, Fire, and Dangerous Things:
211; What Categories Reveal about the Mind''
212; 1987, Univ. of Chicago Press
213;
214; About philosophy, Whorfian effects, and linguistics.
215;
216; \f
217; OBI (On line text collection.)
218; Open Book Initiative
219; c/o Software Tool & Die
220; 1330 Beacon St, Brookline, MA 02146 USA
221; (617) 739-0202
222; obi@world.std.com
223
224; In this example, the heading lines are:
225;
226; FSF
227; House Subcommittee on Intellectual Property
228; George Lakoff
229; OBI (On line text collection.)
230
231; The `C-x C-p s' (sort-pages-buffer) command sorts the entries in the
232; buffer alphabetically.
233
234; You may use any of the page commands, including the `next-page',
235; `previous-page', `add-new-page', `mark-page', and `search-pages'
236; commands.
237
238; You may use either the `C-x C-p d' (pages-directory-for-addresses)
239; or the `C-x C-p C-d' (pages-directory) command to construct and
240; dislay a directory of all the heading lines.
241
242; In the directory, you may position the cursor over a heading line
243; and type `C-c C-c' to go to the entry to which it refers in the
244; pages buffer.
245
246; When used in conjunction with the `pages-directory-for-addresses'
247; command, the `C-c C-c' (pages-directory-goto) command narrows to the
248; entry to which it goes. But, when used in conjunction with the
249; `pages-directory' command, the `C-c C-c' (pages-directory-goto)
250; command does not narrow to the entry, but widens the buffer so you
251; can see the context surrounding the entry.
252
253; If you wish, you may create several different directories,
254; one for each different buffer.
255
256;; `pages-directory-for-addresses' in detail
257
258; The `pages-directory-for-addresses' assumes a default addresses
259; file. You do not need to specify the addresses file but merely type
260; `C-x C-p d' from any buffer. The command finds the file, constructs
261; a directory for it, and switches you to the directory. If you call
262; the command with a prefix arg, `C-u C-x C-p d', it prompts you for a
263; file name.
264
265;; `pages-directory' in detail
266
267; Call the `pages-directory' from the buffer for which you want a
268; directory created; it creates a directory for the buffer and pops
269; you to the directory.
270
271; The `pages-directory' command has several options:
272
273; Called with a prefix arg, `C-u C-x C-p C-d', the `pages-directory'
274; prompts you for a regular expression and only lists only those
275; header lines that are part of pages that contain matches to the
276; regexp. In the example above, `C-u C-x C-p C-d 617 RET' would
277; match the telephone area code of the first and fourth entries, so
278; only the header lines of those two entries would appear in the
279; pages-directory-buffer.
280;
281; Called with a numeric argument, the `pages-directory' command
282; lists the number of lines in each page. This is helpful when you
283; are printing hardcopy.
284
285; Called with a negative numeric argument, the `pages-directory'
286; command lists the lengths of pages whose contents match a regexp.
287
288\f
289;;;; Key bindings for page handling functions
290
291(global-unset-key "\C-x\C-p")
292
293(defvar ctl-x-ctl-p-map (make-sparse-keymap)
294 "Keymap for subcommands of C-x C-p, which are for page handling.")
295
296(define-key ctl-x-map "\C-p" 'ctl-x-ctl-p-prefix)
297(fset 'ctl-x-ctl-p-prefix ctl-x-ctl-p-map)
298
299(define-key ctl-x-ctl-p-map "\C-n" 'next-page)
300(define-key ctl-x-ctl-p-map "\C-p" 'previous-page)
301(define-key ctl-x-ctl-p-map "\C-a" 'add-new-page)
302(define-key ctl-x-ctl-p-map "\C-m" 'mark-page)
303(define-key ctl-x-ctl-p-map "\C-s" 'search-pages)
304(define-key ctl-x-ctl-p-map "s" 'sort-pages-buffer)
305(define-key ctl-x-ctl-p-map "\C-l" 'set-page-delimiter)
306(define-key ctl-x-ctl-p-map "\C-d" 'pages-directory)
307(define-key ctl-x-ctl-p-map "d" 'pages-directory-for-addresses)
308
309\f
310;;;; Page movement function definitions
311
312(defun next-page (&optional count)
313 "Move to the next page bounded by the `page-delimiter' variable.
314With arg (prefix if interactive), move that many pages."
315 (interactive "p")
316 (or count (setq count 1))
317 (widen)
318 ;; Cannot use forward-page because of problems at page boundaries.
319 (while (and (> count 0) (not (eobp)))
320 (if (re-search-forward page-delimiter nil t)
321 nil
322 (goto-char (point-max)))
323 (setq count (1- count)))
324 (while (and (< count 0) (not (bobp)))
325 (if (re-search-backward page-delimiter nil t)
326 (goto-char (match-beginning 0))
327 (goto-char (point-min)))
328 (setq count (1+ count)))
329 (narrow-to-page)
330 (goto-char (point-min))
331 (recenter 0))
332
333(defun previous-page (&optional count)
334 "Move to the previous page bounded by the `page-delimiter' variable.
335With arg (prefix if interactive), move that many pages."
336 (interactive "p")
337 (or count (setq count 1))
338 (next-page (- count)))
339
340\f
341;;;; Adding and searching pages
342
343(defun add-new-page (header-line)
344 "Insert new page at point; prompt for header line.
345Page begins with a `^L' as the page-delimiter.
346Point is left in the body of page."
347 (interactive "sHeader line: ")
348 (widen)
349 (insert (format "\n\f\n%s\n\n" header-line))
350 ;; don't renarrow; stay unnarrowed to see context
351 (forward-line -1))
352
353(defvar pages-last-search nil
354 "Value of last regexp searched for. Initially, nil.")
355
356(defun search-pages (regexp)
357 "Search for REGEXP, starting from point, and narrow to page it is in."
358 (interactive (list
359 (read-string
360 (format "Search for `%s' (end with RET): "
361 (or pages-last-search "regexp")))))
362 (if (equal regexp "")
363 (setq regexp pages-last-search)
364 (setq pages-last-search regexp))
365 (widen)
366 (re-search-forward regexp)
367 (narrow-to-page))
368
369\f
370;;;; Sorting pages
371
372(autoload 'sort-subr "sort" "Primary function for sorting." t nil)
373
374(defun sort-pages-in-region (reverse beg end)
375 "Sort pages in region alphabetically. Prefix arg means reverse order.
376
377Called from a program, there are three arguments:
378REVERSE (non-nil means reverse order), BEG and END (region to sort)."
379
380;;; This sort function handles ends of pages differently than
381;;; `sort-pages' and works better with lists of addresses and similar
382;;; files.
383
384 (interactive "P\nr")
385 (save-restriction
386 (narrow-to-region beg end)
387 (goto-char (point-min))
388 ;;; `sort-subr' takes three arguments
389 (sort-subr reverse
390
391 ;; NEXTRECFUN is called with point at the end of the
392 ;; previous record. It moves point to the start of the
393 ;; next record.
394 (function (lambda ()
395 (re-search-forward page-delimiter nil t)
396 (skip-chars-forward " \t\n")
397 ))
398
399 ;; ENDRECFUN is is called with point within the record.
400 ;; It should move point to the end of the record.
401 (function (lambda ()
402 (if (re-search-forward
403 page-delimiter
404 nil
405 t)
406 (goto-char (match-beginning 0))
407 (goto-char (point-max))))))))
408
409(defun sort-pages-buffer (&optional reverse)
410 "Sort pages alphabetically in buffer. Prefix arg means reverse order.
411\(Non-nil arg if not interactive.\)"
412
413 (interactive "P")
414 (or reverse (setq reverse nil))
415 (widen)
416 (let ((beginning (point-min))
417 (end (point-max)))
418 (sort-pages-in-region reverse beginning end)))
419
420\f
421;;;; Pages directory ancillary definitions
422
423(defvar pages-directory-buffer-narrowing-p nil
424 "*If non-nil, `pages-directory-goto' narrows pages buffer to entry.")
425
426(defvar pages-directory-previous-regexp nil
427 "Value of previous regexp used by `pages-directory'.
428\(This regular expression may be used to select only those pages that
429contain matches to the regexp.\)")
430
431(defvar pages-buffer nil
432 "The buffer for which the pages-directory function creates the directory.")
433
434(defvar pages-directory-prefix "*Directory for:"
435 "Prefix of name of temporary buffer for pages-directory.")
436
437(defvar pages-pos-list nil
438 "List containing the positions of the pages in the pages-buffer.")
439
440(defvar pages-directory-map nil
441 "Keymap for the pages-directory-buffer.")
442
443(if pages-directory-map
444 ()
445 (setq pages-directory-map (make-sparse-keymap))
446 (define-key pages-directory-map "\C-c\C-c"
447 'pages-directory-goto))
448
449(defun set-page-delimiter (regexp reset-p)
450 "Set buffer local value of page-delimiter to REGEXP.
451Called interactively with a prefix argument, reset `page-delimiter' to
452its original value.
453
454In a program, non-nil second arg causes first arg to be ignored and
455resets the page-delimiter to the original value."
456
457 (interactive
458 (if current-prefix-arg
459 (list original-page-delimiter nil)
460 (list (read-string "Set page-delimiter to regexp: " page-delimiter)
461 nil)))
462 (make-local-variable 'original-page-delimiter)
463 (make-local-variable 'page-delimiter)
464 (setq original-page-delimiter
465 (or original-page-delimiter page-delimiter))
466 (if (not reset-p)
467 (setq page-delimiter regexp)
468 (setq page-delimiter original-page-delimiter))
469 (if (interactive-p)
470 (message "The value of `page-delimiter' is now: %s" page-delimiter)))
471
472\f
473;;;; Pages directory main definitions
474
475(defun pages-directory
476 (pages-list-all-headers-p count-lines-p &optional regexp)
477 "Display a directory of the page headers in a temporary buffer.
478A header is the first non-blank line after the page-delimiter.
479\\[pages-directory-mode]
480You may move point to one of the lines in the temporary buffer,
481then use \\<pages-directory-goto> to go to the same line in the pages buffer.
482
483In interactive use:
484
485 1. With no prefix arg, display all headers.
486
487 2. With prefix arg, display the headers of only those pages that
488 contain matches to a regular expression for which you are
489 prompted.
490
491 3. With numeric prefix arg, for every page, print the number of
492 lines within each page.
493
494 4. With negative numeric prefix arg, for only those pages that
495 match a regular expression, print the number of lines within
496 each page.
497
498When called from a program, non-nil first arg means list all headers;
499non-nil second arg means print numbers of lines in each page; if first
500arg is nil, optional third arg is regular expression.
501
502If the buffer is narrowed, the `pages-directory' command creates a
503directory for only the accessible portion of the buffer."
504
505 (interactive
506 (cond ((not current-prefix-arg)
507 (list t nil nil))
508 ((listp current-prefix-arg)
509 (list nil
510 nil
511 (read-string
512 (format "Select according to `%s' (end with RET): "
513 (or pages-directory-previous-regexp "regexp")))))
514 ((> (prefix-numeric-value current-prefix-arg) 0)
515 (list t t nil))
516 ((< (prefix-numeric-value current-prefix-arg) 0)
517 (list nil
518 t
519 (read-string
520 (format "Select according to `%s' (end with RET): "
521 (or pages-directory-previous-regexp "regexp")))))))
522
523 (if (equal regexp "")
524 (setq regexp pages-directory-previous-regexp)
525 (setq pages-directory-previous-regexp regexp))
526
527 (if (interactive-p)
528 (message "Creating directory for: %s "
529 (buffer-name)))
530
531 (let ((buffer (current-buffer))
532 (pages-directory-buffer
533 (concat pages-directory-prefix " " (buffer-name) " "))
534 (linenum 1)
535 (pages-buffer-original-position (point))
536 (pages-buffer-original-page 0))
537
538 ;; `with-output-to-temp-buffer' binds the value of the variable
539 ;; `standard-output' to the buffer named as its first argument,
540 ;; but does not switch to that buffer.
541 (with-output-to-temp-buffer pages-directory-buffer
542 (save-excursion
543 (set-buffer standard-output)
544 (pages-directory-mode)
545 (insert
546 "==== Pages Directory: use `C-c C-c' to go to page under cursor. ====" ?\n)
547 (setq pages-buffer buffer)
548 (setq pages-pos-list nil))
549
550 (if pages-list-all-headers-p
551
552 ;; 1. If no prefix argument, list all headers
553 (save-excursion
554 (goto-char (point-min))
555
556 ;; (a) Point is at beginning of buffer; but the first
557 ;; page may not begin with a page-delimiter
558 (save-restriction
559 ;; If page delimiter is at beginning of buffer, skip it
560 (if (and (save-excursion
561 (re-search-forward page-delimiter nil t))
562 (= 1 (match-beginning 0)))
563 (goto-char (match-end 0)))
564 (narrow-to-page)
565 (pages-copy-header-and-position count-lines-p))
566
567 ;; (b) Search within pages buffer for next page-delimiter
568 (while (re-search-forward page-delimiter nil t)
569 (pages-copy-header-and-position count-lines-p)))
570
571 ;; 2. Else list headers whose pages match regexp.
572 (save-excursion
573 ;; REMOVED save-restriction AND widen FROM HERE
574 (goto-char (point-min))
575
576 ;; (a) Handle first page
577 (save-restriction
578 (narrow-to-page)
579 ;; search for selection regexp
580 (if (save-excursion (re-search-forward regexp nil t))
581 (pages-copy-header-and-position count-lines-p)))
582
583 ;; (b) Search for next page-delimiter
584 (while (re-search-forward page-delimiter nil t)
585 (save-restriction
586 (narrow-to-page)
587 ;; search for selection regexp
588 (if (save-excursion (re-search-forward regexp nil t))
589 (pages-copy-header-and-position count-lines-p)
590 )))))
591
592 (set-buffer standard-output)
593 ;; Put positions in increasing order to go with buffer.
594 (setq pages-pos-list (nreverse pages-pos-list))
595 (if (interactive-p)
596 (message "%d matching lines in: %s"
597 (length pages-pos-list) (buffer-name buffer))))
598 (pop-to-buffer pages-directory-buffer)
599 (sit-for 0) ; otherwise forward-line fails if N > window height.
600 (forward-line (if (= 0 pages-buffer-original-page)
601 1
602 pages-buffer-original-page))))
603
604(defun pages-copy-header-and-position (count-lines-p)
605 "Copy page header and its position to the Pages Directory.
606Only arg non-nil, count lines in page and insert before header.
607Used by `pages-directory' function."
608
609 (let (position line-count)
610
611 (if count-lines-p
612 (save-excursion
613 (save-restriction
614 (narrow-to-page)
615 (setq line-count (count-lines (point-min) (point-max))))))
616
617 ;; Keep track of page for later cursor positioning
618 (if (<= (point) pages-buffer-original-position)
619 (setq pages-buffer-original-page
620 (1+ pages-buffer-original-page)))
621
622 (save-excursion
623 ;; go to first non-blank char after the page-delimiter
624 (skip-chars-forward " \t\n")
625 ;; set the marker here; this the place to which the
626 ;; `pages-directory-goto' command will go
627 (setq position (make-marker))
628 (set-marker position (point))
629 (let ((start (point))
630 (end (save-excursion (end-of-line) (point))))
631 ;; change to directory buffer
632 (set-buffer standard-output)
633 ;; record page position
634 (setq pages-pos-list (cons position pages-pos-list))
635 ;; insert page header
636 (insert-buffer-substring buffer start end))
637
638 (if count-lines-p
639 (save-excursion
640 (beginning-of-line)
641 (insert (format "%3d: " line-count))))
642
643 (terpri))
644 (forward-line 1)))
645
646(defun pages-directory-mode ()
647 "Mode for handling the pages-directory buffer.
648
649Move point to one of the lines in this buffer, then use \\[pages-directory-goto] to go
650to the same line in the pages buffer."
651
652 (kill-all-local-variables)
653 (use-local-map pages-directory-map)
654 (setq major-mode 'pages-directory-mode)
655 (setq mode-name "Pages-Directory")
656 (make-local-variable 'pages-buffer)
657 (make-local-variable 'pages-pos-list)
658 (make-local-variable 'pages-directory-buffer-narrowing-p))
659
660(defun pages-directory-goto ()
661 "Go to the corresponding line in the pages buffer."
662
663;;; This function is mostly a copy of `occur-mode-goto-occurrence'
664
665 (interactive)
666 (if (or (not pages-buffer)
667 (not (buffer-name pages-buffer)))
668 (progn
669 (setq pages-buffer nil
670 pages-pos-list nil)
671 (error "Buffer in which pages were found is deleted.")))
672 (beginning-of-line)
673 (let* ((pages-number (1- (count-lines (point-min) (point))))
674 (pos (nth pages-number pages-pos-list))
675 (end-of-directory-p (eobp))
676 (narrowing-p pages-directory-buffer-narrowing-p))
677 (pop-to-buffer pages-buffer)
678 (widen)
679 (if end-of-directory-p
680 (goto-char (point-max))
681 (goto-char (marker-position pos)))
682 (if narrowing-p (narrow-to-page))))
683
684\f
685;;;; The `pages-directory-for-addresses' function and ancillary code
686
687(defvar pages-addresses-file-name "~/addresses"
688 "*Standard name for file of addresses. Entries separated by `page-delimiter'.
689Used by `pages-directory-for-addresses' function.")
690
691(defvar pages-directory-for-addresses-narrowing-p t
692 "*If non-nil, `pages-directory-goto' narrows addresses buffer to entry.")
693
694(defun pages-directory-for-addresses (&optional filename)
695 "Find addresses file and display its directory.
696By default, create and display directory of `pages-addresses-file-name'.
697Optional argument is FILENAME. In interactive use, with prefix
698argument, prompt for file name and provide completion.
699
700Move point to one of the lines in the displayed directory,
701then use C-c C-c to go to the same line in the addresses buffer."
702
703 (interactive
704 (list (if current-prefix-arg
705 (read-file-name "Filename: " pages-addresses-file-name))))
706
707 (if (interactive-p)
708 (message "Creating directory for: %s "
709 (or filename pages-addresses-file-name)))
710 (if (file-exists-p (or filename pages-addresses-file-name))
711 (progn
712 (set-buffer
713 (find-file-noselect
714 (expand-file-name
715 (or filename pages-addresses-file-name))))
716 (widen)
717 (pages-directory t nil nil)
718 (pages-directory-address-mode)
719 (setq pages-directory-buffer-narrowing-p
720 pages-directory-for-addresses-narrowing-p)
721 (delete-other-windows)
722 (save-excursion
723 (goto-char (point-min))
724 (delete-region (point) (save-excursion (end-of-line) (point)))
725 (insert
726 "=== Address List Directory: use `C-c C-c' to go to page under cursor. ===")
727 (set-buffer-modified-p nil)
728 ))
729 (error "No addresses file found!")))
730
731(defun pages-directory-address-mode ()
732 "Mode for handling the Addresses Directory buffer.
733
734Move point to one of the lines in this buffer, then use C-c C-c to go
735to the same line in the pages buffer."
736
737 (use-local-map pages-directory-map)
738 (setq major-mode 'pages-directory-address-mode)
739 (setq mode-name "Addresses Directory")
740 (make-local-variable 'pages-buffer)
741 (make-local-variable 'pages-pos-list)
742 (make-local-variable 'pages-directory-buffer-narrowing-p))
743
6594deb0
ER
744;;; page-ext.el ends here
745