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