Remove init_stack static declaration.
[bpt/emacs.git] / lisp / textmodes / page-ext.el
CommitLineData
98d87352 1;;; page-ext.el --- extended page handling commands
0d2d639a 2
8f1204db 3;; Copyright (C) 1990, 1991, 1993, 1994 Free Software Foundation
98d87352 4
5762abec 5;; Maintainer: Robert J. Chassell <bob@gnu.org>
9750e079 6
3bab998b
ER
7;; This file is part of GNU Emacs.
8
9;; GNU Emacs is free software; you can redistribute it and/or modify
10;; it under the terms of the GNU General Public License as published by
e5167999 11;; the Free Software Foundation; either version 2, or (at your option)
3bab998b
ER
12;; any later version.
13
14;; GNU Emacs is distributed in the hope that it will be useful,
15;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17;; GNU General Public License for more details.
18
19;; You should have received a copy of the GNU General Public License
b578f267
EN
20;; along with GNU Emacs; see the file COPYING. If not, write to the
21;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
22;; Boston, MA 02111-1307, USA.
23
24;;; Commentary:
25
26;; You may use these commands to handle an address list or other
27;; small data base.
3bab998b 28
0d2d639a 29\f
98d87352 30;;; Summary
0d2d639a 31
b578f267
EN
32;; The current page commands are:
33
34;; forward-page C-x ]
35;; backward-page C-x [
36;; narrow-to-page C-x p
37;; count-lines-page C-x l
38;; mark-page C-x C-p (change this to C-x C-p C-m)
39;; sort-pages not bound
40;; what-page not bound
41
42;; The new page handling commands all use `C-x C-p' as a prefix. This
43;; means that the key binding for `mark-page' must be changed.
44;; Otherwise, no other changes are made to the current commands or
45;; their bindings.
46
47;; New page handling commands:
48
49;; next-page C-x C-p C-n
50;; previous-page C-x C-p C-p
51;; search-pages C-x C-p C-s
52;; add-new-page C-x C-p C-a
53;; sort-pages-buffer C-x C-p s
54;; set-page-delimiter C-x C-p C-l
55;; pages-directory C-x C-p C-d
56;; pages-directory-for-addresses C-x C-p d
57;; pages-directory-goto C-c C-c
0d2d639a
JB
58
59\f
98d87352
RS
60;;; Using the page commands
61
b578f267
EN
62;; The page commands are helpful in several different contexts. For
63;; example, programmers often divide source files into sections using the
64;; `page-delimiter'; you can use the `pages-directory' command to list
65;; the sections.
66
67;; You may change the buffer local value of the `page-delimiter' with
68;; the `set-page-delimiter' command. This command is bound to `C-x C-p
69;; C-l' The command prompts you for a new value for the page-delimiter.
70;; Called with a prefix-arg, the command resets the value of the
71;; page-delimiter to its original value.
72
73;; You may set several user options:
74;;
75;; The `pages-directory-buffer-narrowing-p' variable causes the
76;; `pages-directory-goto' command to narrow to the destination page.
77;;
78;; The `pages-directory-for-adding-page-narrowing-p' variable, causes the
79;; `add-new-page' command to narrow to the new entry.
80;;
81;; The `pages-directory-for-adding-new-page-before-current-page-p' variable
82;; causes the `add-new-page' command to insert a new page before current
83;; page.
84;;
85;; These variables are true by default.
86;;
87;; Additional, addresses-related user options are described in the next page
88;; of this file.
98d87352 89
0d2d639a 90\f
98d87352 91;;; Handling an address list or small data base
0d2d639a 92
b578f267
EN
93;; You may use the page commands to handle an address list or other
94;; small data base. Put each address or entry on its own page. The
95;; first line of text in each page is a `header line' and is listed by
96;; the `pages-directory' or `pages-directory-for-addresses' command.
97
98;; Specifically:
99;;
100;; 1. Begin each entry with a `page-delimiter' (which is, by default,
101;; `^L' at the beginning of the line).
102;;
103;; 2. The first line of text in each entry is the `heading line'; it
104;; will appear in the pages-directory-buffer which is constructed
105;; using the `C-x C-p C-d' (pages-directory) command or the `C-x
106;; C-p d' (pages-directory-for-addresses) command.
107;;
108;; The heading line may be on the same line as the page-delimiter
109;; or it may follow after. It is the first non-blank line on the
110;; page. Conventionally, the heading line is placed on the line
111;; immediately following the line containing page-delimiter.
112;;
113;; 3. Follow the heading line with the body of the entry. The body
114;; extends up to the next `page-delimiter'. The body may be of any
115;; length. It is conventional to place a blank line after the last
116;; line of the body.
117
118;; For example, a file might look like this:
119;;
120;; FSF
121;; Free Software Foundation
29bd7a8f
KH
122;; 59 Temple Place - Suite 330
123;; Boston, MA 02111-1307 USA.
124;; (617) 542-5942
5762abec 125;; gnu@gnu.org
b578f267
EN
126;;
127;; \f
128;; House Subcommittee on Intellectual Property,
129;; U.S. House of Representatives,
130;; Washington, DC 20515
131;;
132;; Congressional committee concerned with permitting or preventing
133;; monopolistic restrictions on the use of software technology.
134;;
135;; \f
136;; George Lakoff
137;; ``Women, Fire, and Dangerous Things:
138;; What Categories Reveal about the Mind''
139;; 1987, Univ. of Chicago Press
140;;
141;; About philosophy, Whorfian effects, and linguistics.
142;;
143;; \f
144;; OBI (On line text collection.)
145;; Open Book Initiative
146;; c/o Software Tool & Die
147;; 1330 Beacon St, Brookline, MA 02146 USA
148;; (617) 739-0202
149;; obi@world.std.com
150
151;; In this example, the heading lines are:
152;;
153;; FSF
154;; House Subcommittee on Intellectual Property
155;; George Lakoff
156;; OBI (On line text collection.)
157
158;; The `C-x C-p s' (sort-pages-buffer) command sorts the entries in the
159;; buffer alphabetically.
160
161;; You may use any of the page commands, including the `next-page',
162;; `previous-page', `add-new-page', `mark-page', and `search-pages'
163;; commands.
164
165;; You may use either the `C-x C-p d' (pages-directory-for-addresses)
166;; or the `C-x C-p C-d' (pages-directory) command to construct and
167;; display a directory of all the heading lines.
168
169;; In the directory, you may position the cursor over a heading line
170;; and type `C-c C-c' (pages-directory-goto) to go to the entry to
171;; which it refers in the pages buffer.
172
173;; You can type `C-c C-p C-a' (add-new-page) to add a new entry in the
174;; pages buffer or address file. This is the same command you use to
175;; add a new entry when you are in the pages buffer or address file.
176
177;; If you wish, you may create several different directories,
178;; one for each different buffer.
0d2d639a
JB
179
180;; `pages-directory-for-addresses' in detail
181
b578f267
EN
182;; The `pages-directory-for-addresses' assumes a default addresses
183;; file. You do not need to specify the addresses file but merely type
184;; `C-x C-p d' from any buffer. The command finds the file, constructs
185;; a directory for it, and switches you to the directory. If you call
186;; the command with a prefix arg, `C-u C-x C-p d', it prompts you for a
187;; file name.
0d2d639a 188
b578f267 189;; You may customize the addresses commands:
98d87352 190
b578f267
EN
191;; The `pages-addresses-file-name' variable determines the name of
192;; the addresses file; by default it is "~/addresses".
98d87352 193
b578f267
EN
194;; The `pages-directory-for-addresses-goto-narrowing-p' variable
195;; determines whether `pages-directory-goto' narrows the addresses
196;; buffer to the entry, which it does by default.
98d87352 197
b578f267
EN
198;; The `pages-directory-for-addresses-buffer-keep-windows-p' variable
199;; determines whether `pages-directory-for-addresses' deletes other
200;; windows to show as many lines as possible on the screen or works
201;; in the usual Emacs manner and keeps other windows. Default is to
202;; keep other windows.
98d87352 203
b578f267
EN
204;; The `pages-directory-for-adding-addresses-narrowing-p' variable
205;; determines whether `pages-directory-for-addresses' narrows the
206;; addresses buffer to a new entry when you are adding that entry.
207;; Default is to narrow to new entry, which means you see a blank
208;; screen before you write the new entry.
98d87352 209
0d2d639a
JB
210;; `pages-directory' in detail
211
b578f267
EN
212;; Call the `pages-directory' command from the buffer for which you
213;; want a directory created; it creates a directory for the buffer and
214;; pops you to the directory.
215
216;; The `pages-directory' command has several options:
217
218;; Called with a prefix arg, `C-u C-x C-p C-d', the `pages-directory'
219;; prompts you for a regular expression and only lists only those
220;; header lines that are part of pages that contain matches to the
221;; regexp. In the example above, `C-u C-x C-p C-d 617 RET' would
222;; match the telephone area code of the first and fourth entries, so
223;; only the header lines of those two entries would appear in the
224;; pages-directory-buffer.
225;;
226;; Called with a numeric argument, the `pages-directory' command
227;; lists the number of lines in each page. This is helpful when you
228;; are printing hardcopy.
229
230;; Called with a negative numeric argument, the `pages-directory'
231;; command lists the lengths of pages whose contents match a regexp.
0d2d639a 232
98d87352
RS
233;;; Code:
234
235\f
236;;; Customarily customizable variable definitions
237
00ed33e7
RS
238(defgroup pages nil
239 "Extended page-handling commands."
240 :group 'extensions)
98d87352 241
98d87352 242
00ed33e7
RS
243(defcustom pages-directory-buffer-narrowing-p t
244 "*If non-nil, `pages-directory-goto' narrows pages buffer to entry."
245 :type 'boolean
246 :group 'pages)
247
248(defcustom pages-directory-for-adding-page-narrowing-p t
249 "*If non-nil, `add-new-page' narrows page buffer to new entry."
250 :type 'boolean
251 :group 'pages)
252
253(defcustom pages-directory-for-adding-new-page-before-current-page-p t
254 "*If non-nil, `add-new-page' inserts new page before current page."
255 :type 'boolean
256 :group 'pages)
98d87352
RS
257
258\f
259;;; Addresses related variables
260
00ed33e7 261(defcustom pages-addresses-file-name "~/addresses"
98d87352 262 "*Standard name for file of addresses. Entries separated by page-delimiter.
00ed33e7
RS
263Used by `pages-directory-for-addresses' function."
264 :type 'file
265 :group 'pages)
266
267(defcustom pages-directory-for-addresses-goto-narrowing-p t
268 "*If non-nil, `pages-directory-goto' narrows addresses buffer to entry."
269 :type 'boolean
270 :group 'pages)
271
272(defcustom pages-directory-for-addresses-buffer-keep-windows-p t
273 "*If nil, `pages-directory-for-addresses' deletes other windows."
274 :type 'boolean
275 :group 'pages)
276
277(defcustom pages-directory-for-adding-addresses-narrowing-p t
278 "*If non-nil, `add-new-page' narrows addresses buffer to new entry."
279 :type 'boolean
280 :group 'pages)
98d87352 281
0d2d639a 282\f
98d87352 283;;; Key bindings for page handling functions
0d2d639a
JB
284
285(global-unset-key "\C-x\C-p")
286
287(defvar ctl-x-ctl-p-map (make-sparse-keymap)
288 "Keymap for subcommands of C-x C-p, which are for page handling.")
289
290(define-key ctl-x-map "\C-p" 'ctl-x-ctl-p-prefix)
291(fset 'ctl-x-ctl-p-prefix ctl-x-ctl-p-map)
292
293(define-key ctl-x-ctl-p-map "\C-n" 'next-page)
294(define-key ctl-x-ctl-p-map "\C-p" 'previous-page)
295(define-key ctl-x-ctl-p-map "\C-a" 'add-new-page)
296(define-key ctl-x-ctl-p-map "\C-m" 'mark-page)
297(define-key ctl-x-ctl-p-map "\C-s" 'search-pages)
298(define-key ctl-x-ctl-p-map "s" 'sort-pages-buffer)
299(define-key ctl-x-ctl-p-map "\C-l" 'set-page-delimiter)
300(define-key ctl-x-ctl-p-map "\C-d" 'pages-directory)
301(define-key ctl-x-ctl-p-map "d" 'pages-directory-for-addresses)
302
303\f
98d87352 304;;; Page movement function definitions
0d2d639a
JB
305
306(defun next-page (&optional count)
307 "Move to the next page bounded by the `page-delimiter' variable.
308With arg (prefix if interactive), move that many pages."
309 (interactive "p")
310 (or count (setq count 1))
311 (widen)
312 ;; Cannot use forward-page because of problems at page boundaries.
313 (while (and (> count 0) (not (eobp)))
314 (if (re-search-forward page-delimiter nil t)
315 nil
316 (goto-char (point-max)))
317 (setq count (1- count)))
817d6535
JB
318 ;; If COUNT is negative, we want to go back -COUNT + 1 page boundaries.
319 ;; The first page boundary we reach is the top of the current page,
320 ;; which doesn't count.
321 (while (and (< count 1) (not (bobp)))
0d2d639a
JB
322 (if (re-search-backward page-delimiter nil t)
323 (goto-char (match-beginning 0))
324 (goto-char (point-min)))
325 (setq count (1+ count)))
326 (narrow-to-page)
327 (goto-char (point-min))
328 (recenter 0))
329
330(defun previous-page (&optional count)
331 "Move to the previous page bounded by the `page-delimiter' variable.
332With arg (prefix if interactive), move that many pages."
333 (interactive "p")
334 (or count (setq count 1))
335 (next-page (- count)))
336
337\f
98d87352 338;;; Adding and searching pages
0d2d639a
JB
339
340(defun add-new-page (header-line)
98d87352
RS
341 "Insert new page. Prompt for header line.
342
343If point is in the pages directory buffer, insert the new page in the
344buffer associated with the directory.
345
346Insert the new page just before current page if
347 pages-directory-for-adding-new-page-before-current-page-p variable
348is non-nil. Else insert at exact location of point.
349
350Narrow to new page if
351 pages-directory-for-adding-page-narrowing-p variable
352is non-nil.
353
354Page begins with a `^L' as the default page-delimiter.
355Use \\[set-page-delimiter] to change the page-delimiter.
0d2d639a
JB
356Point is left in the body of page."
357 (interactive "sHeader line: ")
358 (widen)
98d87352
RS
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)))
0d2d639a
JB
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 "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
98d87352 408;;; Sorting pages
0d2d639a
JB
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
415Called from a program, there are three arguments:
416REVERSE (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 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
98d87352 459;;; Pages directory ancillary definitions
0d2d639a
JB
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
464contain 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-directory-map nil
476 "Keymap for the pages-directory-buffer.")
477
478(if pages-directory-map
479 ()
480 (setq pages-directory-map (make-sparse-keymap))
481 (define-key pages-directory-map "\C-c\C-c"
98d87352 482 'pages-directory-goto)
a2b327b6
RS
483 (define-key pages-directory-map "\C-c\C-p\C-a" 'add-new-page)
484 (define-key pages-directory-map [mouse-2] 'pages-directory-goto-with-mouse))
98d87352 485
98526426 486(defvar original-page-delimiter "^\f"
98d87352 487 "Default page delimiter.")
0d2d639a
JB
488
489(defun set-page-delimiter (regexp reset-p)
490 "Set buffer local value of page-delimiter to REGEXP.
491Called interactively with a prefix argument, reset `page-delimiter' to
492its original value.
493
494In a program, non-nil second arg causes first arg to be ignored and
495resets the page-delimiter to the original value."
496
497 (interactive
498 (if current-prefix-arg
98526426 499 (list original-page-delimiter "^\f")
0d2d639a
JB
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 (interactive-p)
510 (message "The value of `page-delimiter' is now: %s" page-delimiter)))
511
512\f
98d87352 513;;; Pages directory main definitions
0d2d639a
JB
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.
518A header is the first non-blank line after the page-delimiter.
519\\[pages-directory-mode]
520You may move point to one of the lines in the temporary buffer,
521then use \\<pages-directory-goto> to go to the same line in the pages buffer.
522
523In 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
538When called from a program, non-nil first arg means list all headers;
539non-nil second arg means print numbers of lines in each page; if first
540arg is nil, optional third arg is regular expression.
541
542If the buffer is narrowed, the `pages-directory' command creates a
543directory 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 "Select according to `%s' (end with RET): "
553 (or pages-directory-previous-regexp "regexp")))))
554 ((> (prefix-numeric-value current-prefix-arg) 0)
555 (list t t nil))
556 ((< (prefix-numeric-value current-prefix-arg) 0)
557 (list nil
558 t
559 (read-string
560 (format "Select according to `%s' (end with RET): "
561 (or pages-directory-previous-regexp "regexp")))))))
562
563 (if (equal regexp "")
564 (setq regexp pages-directory-previous-regexp)
565 (setq pages-directory-previous-regexp regexp))
566
567 (if (interactive-p)
568 (message "Creating directory for: %s "
569 (buffer-name)))
570
98d87352 571 (let ((target-buffer (current-buffer))
0d2d639a 572 (pages-directory-buffer
e6945ec7 573 (concat pages-directory-prefix " " (buffer-name)))
0d2d639a
JB
574 (linenum 1)
575 (pages-buffer-original-position (point))
576 (pages-buffer-original-page 0))
577
578 ;; `with-output-to-temp-buffer' binds the value of the variable
579 ;; `standard-output' to the buffer named as its first argument,
580 ;; but does not switch to that buffer.
581 (with-output-to-temp-buffer pages-directory-buffer
582 (save-excursion
583 (set-buffer standard-output)
584 (pages-directory-mode)
585 (insert
586 "==== Pages Directory: use `C-c C-c' to go to page under cursor. ====" ?\n)
98d87352 587 (setq pages-buffer target-buffer)
0d2d639a
JB
588 (setq pages-pos-list nil))
589
590 (if pages-list-all-headers-p
591
592 ;; 1. If no prefix argument, list all headers
593 (save-excursion
594 (goto-char (point-min))
595
596 ;; (a) Point is at beginning of buffer; but the first
597 ;; page may not begin with a page-delimiter
598 (save-restriction
599 ;; If page delimiter is at beginning of buffer, skip it
600 (if (and (save-excursion
601 (re-search-forward page-delimiter nil t))
602 (= 1 (match-beginning 0)))
603 (goto-char (match-end 0)))
604 (narrow-to-page)
605 (pages-copy-header-and-position count-lines-p))
606
607 ;; (b) Search within pages buffer for next page-delimiter
608 (while (re-search-forward page-delimiter nil t)
609 (pages-copy-header-and-position count-lines-p)))
610
611 ;; 2. Else list headers whose pages match regexp.
612 (save-excursion
613 ;; REMOVED save-restriction AND widen FROM HERE
614 (goto-char (point-min))
615
616 ;; (a) Handle first page
617 (save-restriction
618 (narrow-to-page)
619 ;; search for selection regexp
620 (if (save-excursion (re-search-forward regexp nil t))
621 (pages-copy-header-and-position count-lines-p)))
622
623 ;; (b) Search for next page-delimiter
624 (while (re-search-forward page-delimiter nil t)
625 (save-restriction
626 (narrow-to-page)
627 ;; search for selection regexp
628 (if (save-excursion (re-search-forward regexp nil t))
629 (pages-copy-header-and-position count-lines-p)
630 )))))
631
632 (set-buffer standard-output)
633 ;; Put positions in increasing order to go with buffer.
634 (setq pages-pos-list (nreverse pages-pos-list))
635 (if (interactive-p)
636 (message "%d matching lines in: %s"
98d87352 637 (length pages-pos-list) (buffer-name target-buffer))))
0d2d639a
JB
638 (pop-to-buffer pages-directory-buffer)
639 (sit-for 0) ; otherwise forward-line fails if N > window height.
640 (forward-line (if (= 0 pages-buffer-original-page)
641 1
642 pages-buffer-original-page))))
55df774a
DL
643(eval-when-compile
644 (defvar pages-buffer-original-position)
645 (defvar pages-buffer-original-page)
646 (defvar pages-buffer-original-page))
0d2d639a
JB
647
648(defun pages-copy-header-and-position (count-lines-p)
649 "Copy page header and its position to the Pages Directory.
650Only arg non-nil, count lines in page and insert before header.
651Used by `pages-directory' function."
652
653 (let (position line-count)
654
655 (if count-lines-p
656 (save-excursion
657 (save-restriction
658 (narrow-to-page)
659 (setq line-count (count-lines (point-min) (point-max))))))
660
661 ;; Keep track of page for later cursor positioning
662 (if (<= (point) pages-buffer-original-position)
663 (setq pages-buffer-original-page
664 (1+ pages-buffer-original-page)))
665
666 (save-excursion
667 ;; go to first non-blank char after the page-delimiter
668 (skip-chars-forward " \t\n")
669 ;; set the marker here; this the place to which the
670 ;; `pages-directory-goto' command will go
671 (setq position (make-marker))
672 (set-marker position (point))
673 (let ((start (point))
a2b327b6
RS
674 (end (save-excursion (end-of-line) (point)))
675 inserted-at)
0d2d639a
JB
676 ;; change to directory buffer
677 (set-buffer standard-output)
678 ;; record page position
679 (setq pages-pos-list (cons position pages-pos-list))
680 ;; insert page header
a2b327b6
RS
681 (setq inserted-at (point))
682 (insert-buffer-substring target-buffer start end)
dc44c48c
EZ
683 (add-text-properties inserted-at (point)
684 '(mouse-face highlight
685 help-echo "mouse-2: go to this page"))
cac7e5a8 686 (put-text-property inserted-at (point) 'rear-nonsticky 'highlight))
0d2d639a
JB
687
688 (if count-lines-p
689 (save-excursion
690 (beginning-of-line)
691 (insert (format "%3d: " line-count))))
692
693 (terpri))
e6945ec7 694 (end-of-line 1)))
0d2d639a
JB
695
696(defun pages-directory-mode ()
697 "Mode for handling the pages-directory buffer.
698
699Move point to one of the lines in this buffer, then use \\[pages-directory-goto] to go
700to the same line in the pages buffer."
701
702 (kill-all-local-variables)
703 (use-local-map pages-directory-map)
704 (setq major-mode 'pages-directory-mode)
705 (setq mode-name "Pages-Directory")
706 (make-local-variable 'pages-buffer)
707 (make-local-variable 'pages-pos-list)
708 (make-local-variable 'pages-directory-buffer-narrowing-p))
709
710(defun pages-directory-goto ()
711 "Go to the corresponding line in the pages buffer."
712
713;;; This function is mostly a copy of `occur-mode-goto-occurrence'
714
715 (interactive)
716 (if (or (not pages-buffer)
717 (not (buffer-name pages-buffer)))
718 (progn
719 (setq pages-buffer nil
720 pages-pos-list nil)
e8af40ee 721 (error "Buffer in which pages were found is deleted")))
0d2d639a
JB
722 (beginning-of-line)
723 (let* ((pages-number (1- (count-lines (point-min) (point))))
724 (pos (nth pages-number pages-pos-list))
725 (end-of-directory-p (eobp))
726 (narrowing-p pages-directory-buffer-narrowing-p))
98d87352 727 (pop-to-buffer pages-buffer)
0d2d639a
JB
728 (widen)
729 (if end-of-directory-p
730 (goto-char (point-max))
731 (goto-char (marker-position pos)))
732 (if narrowing-p (narrow-to-page))))
733
a2b327b6
RS
734(defun pages-directory-goto-with-mouse (event)
735 "Go to the corresponding line under the mouse pointer in the pages buffer."
736 (interactive "e")
737 (save-excursion
738 (set-buffer (window-buffer (posn-window (event-end event))))
739 (save-excursion
740 (goto-char (posn-point (event-end event)))
741 (pages-directory-goto))))
0d2d639a 742\f
98d87352 743;;; The `pages-directory-for-addresses' function and ancillary code
0d2d639a
JB
744
745(defun pages-directory-for-addresses (&optional filename)
746 "Find addresses file and display its directory.
747By default, create and display directory of `pages-addresses-file-name'.
748Optional argument is FILENAME. In interactive use, with prefix
749argument, prompt for file name and provide completion.
750
751Move point to one of the lines in the displayed directory,
98d87352
RS
752then use \\[pages-directory-goto] to go to the same line
753in the addresses buffer.
754
755If pages-directory-for-addresses-goto-narrowing-p is non-nil,
756`pages-directory-goto' narrows addresses buffer to entry.
757
758If pages-directory-for-addresses-buffer-keep-windows-p is nil,
759this command deletes other windows when it displays the addresses
760directory."
0d2d639a
JB
761
762 (interactive
763 (list (if current-prefix-arg
764 (read-file-name "Filename: " pages-addresses-file-name))))
765
766 (if (interactive-p)
767 (message "Creating directory for: %s "
768 (or filename pages-addresses-file-name)))
769 (if (file-exists-p (or filename pages-addresses-file-name))
770 (progn
771 (set-buffer
772 (find-file-noselect
773 (expand-file-name
774 (or filename pages-addresses-file-name))))
775 (widen)
776 (pages-directory t nil nil)
777 (pages-directory-address-mode)
98d87352
RS
778 (setq pages-directory-buffer-narrowing-p
779 pages-directory-for-addresses-goto-narrowing-p)
780 (or pages-directory-for-addresses-buffer-keep-windows-p
781 (delete-other-windows))
0d2d639a
JB
782 (save-excursion
783 (goto-char (point-min))
784 (delete-region (point) (save-excursion (end-of-line) (point)))
785 (insert
786 "=== Address List Directory: use `C-c C-c' to go to page under cursor. ===")
787 (set-buffer-modified-p nil)
788 ))
789 (error "No addresses file found!")))
790
791(defun pages-directory-address-mode ()
792 "Mode for handling the Addresses Directory buffer.
793
98d87352
RS
794Move point to one of the lines in this buffer,
795then use \\[pages-directory-goto] to go
0d2d639a
JB
796to the same line in the pages buffer."
797
798 (use-local-map pages-directory-map)
799 (setq major-mode 'pages-directory-address-mode)
800 (setq mode-name "Addresses Directory")
801 (make-local-variable 'pages-buffer)
802 (make-local-variable 'pages-pos-list)
803 (make-local-variable 'pages-directory-buffer-narrowing-p))
804
98d87352
RS
805\f
806;;; Place `provide' at end of file.
807(provide 'page-ext)
808
e8af40ee 809;;; page-ext.el ends here