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