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