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