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