home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / gnu / lucid / lemacs-19.6 / lisp / packages / page-ext.el < prev    next >
Encoding:
Text File  |  1992-06-29  |  27.1 KB  |  748 lines
  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.  
  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.  
  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.  
  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. ;     
  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. ;     
  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. ;       
  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.  
  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.  
  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.  
  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 \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.  
  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.  
  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.  
  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.  
  481. You may move point to one of the lines in the temporary buffer,
  482. then use C-c C-c 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,
  651. then use \\[pages-directory-goto] to go
  652. to the same line in the pages buffer."
  653.  
  654.   (kill-all-local-variables)
  655.   (use-local-map pages-directory-map)
  656.   (setq major-mode 'pages-directory-mode)
  657.   (setq mode-name "Pages-Directory")
  658.   (make-local-variable 'pages-buffer)
  659.   (make-local-variable 'pages-pos-list)
  660.   (make-local-variable 'pages-directory-buffer-narrowing-p))
  661.  
  662. (defun pages-directory-goto ()
  663.   "Go to the corresponding line in the pages buffer."
  664.  
  665. ;;; This function is mostly a copy of `occur-mode-goto-occurrence'
  666.  
  667.   (interactive)
  668.   (if (or (not pages-buffer)
  669.       (not (buffer-name pages-buffer)))
  670.       (progn
  671.     (setq pages-buffer nil
  672.           pages-pos-list nil)
  673.     (error "Buffer in which pages were found is deleted.")))
  674.   (beginning-of-line)
  675.   (let* ((pages-number (1- (count-lines (point-min) (point))))
  676.      (pos (nth pages-number pages-pos-list))
  677.          (end-of-directory-p (eobp))
  678.          (narrowing-p  pages-directory-buffer-narrowing-p))
  679.     (pop-to-buffer pages-buffer)
  680.     (widen)
  681.     (if end-of-directory-p
  682.         (goto-char (point-max))
  683.       (goto-char (marker-position pos)))
  684.     (if narrowing-p (narrow-to-page))))
  685.  
  686.  
  687. ;;;; The `pages-directory-for-addresses' function and ancillary code
  688.  
  689. (defvar pages-addresses-file-name "~/addresses"
  690.   "*Standard name for file of addresses. Entries separated by page-delimiter.
  691. Used by `pages-directory-for-addresses' function.")
  692.  
  693. (defvar pages-directory-for-addresses-narrowing-p t
  694.   "*If non-nil, `pages-directory-goto' narrows addresses buffer to entry.")
  695.  
  696. (defun pages-directory-for-addresses (&optional filename)
  697.   "Find addresses file and display its directory.
  698. By default, create and display directory of   pages-addresses-file-name.
  699. Optional argument is FILENAME.  In interactive use, with prefix
  700. argument, prompt for filename and provide completion.
  701.  
  702. Move point to one of the lines in the displayed directory,
  703. then use C-c C-c to go to the same line in the addresses buffer."
  704.  
  705.   (interactive
  706.    (list (if current-prefix-arg
  707.              (read-file-name "Filename: " pages-addresses-file-name))))
  708.  
  709.   (if (interactive-p)
  710.       (message "Creating directory for: %s "
  711.                (or filename pages-addresses-file-name)))
  712.   (if (file-exists-p (or filename pages-addresses-file-name))
  713.       (progn
  714.         (set-buffer
  715.          (find-file-noselect
  716.           (expand-file-name
  717.            (or filename pages-addresses-file-name))))
  718.         (widen)
  719.         (pages-directory t nil nil)
  720.         (pages-directory-address-mode)
  721.         (setq pages-directory-buffer-narrowing-p 
  722.               pages-directory-for-addresses-narrowing-p)
  723.         (delete-other-windows)
  724.         (save-excursion
  725.           (goto-char (point-min))
  726.           (delete-region (point) (save-excursion (end-of-line) (point)))
  727.           (insert
  728.            "=== Address List Directory: use `C-c C-c' to go to page under cursor. ===")
  729.           (set-buffer-modified-p nil)
  730.           ))
  731.     (error "No addresses file found!")))
  732.  
  733. (defun pages-directory-address-mode ()
  734.   "Mode for handling the Addresses Directory buffer.
  735.  
  736. Move point to one of the lines in this buffer,
  737. then use \\[pages-directory-goto] to go
  738. to the same line in the pages buffer."
  739.  
  740.   (use-local-map pages-directory-map)
  741.   (setq major-mode 'pages-directory-address-mode)
  742.   (setq mode-name "Addresses Directory")
  743.   (make-local-variable 'pages-buffer)
  744.   (make-local-variable 'pages-pos-list)
  745.   (make-local-variable 'pages-directory-buffer-narrowing-p))
  746.  
  747. ;;;;;;;;;;;;;;;; end of page-ext.el ;;;;;;;;;;;;;;;;
  748.