comparison lisp/packages/page-ext.el @ 0:376386a54a3c r19-14

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