;;; page-ext.el --- extended page handling commands
-;; You may use these commands to handle an address list or other
-;; small data base.
-
-;; Copyright (C) 1990, 1991, 1993 Free Software Foundation
+;; Copyright (C) 1990, 1991, 1993, 1994, 2001, 2002, 2003, 2004, 2005, 2006,
+;; 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
-;; Maintainer: Robert J. Chassell <bob@gnu.ai.mit.edu>
+;; Author: Robert J. Chassell <bob@gnu.org>
+;; (according to ack.texi)
+;; Keywords: wp data
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to
-;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; You may use these commands to handle an address list or other
+;; small data base.
\f
;;; Summary
-; The current page commands are:
-
-; forward-page C-x ]
-; backward-page C-x [
-; narrow-to-page C-x p
-; count-lines-page C-x l
-; mark-page C-x C-p (change this to C-x C-p C-m)
-; sort-pages not bound
-; what-page not bound
-
-; The new page handling commands all use `C-x C-p' as a prefix. This
-; means that the key binding for `mark-page' must be changed.
-; Otherwise, no other changes are made to the current commands or
-; their bindings.
-
-; New page handling commands:
-
-; next-page C-x C-p C-n
-; previous-page C-x C-p C-p
-; search-pages C-x C-p C-s
-; add-new-page C-x C-p C-a
-; sort-pages-buffer C-x C-p s
-; set-page-delimiter C-x C-p C-l
-; pages-directory C-x C-p C-d
-; pages-directory-for-addresses C-x C-p d
-; pages-directory-goto C-c C-c
+;; The current page commands are:
+
+;; forward-page C-x ]
+;; backward-page C-x [
+;; narrow-to-page C-x p
+;; count-lines-page C-x l
+;; mark-page C-x C-p (change this to C-x C-p C-m)
+;; sort-pages not bound
+;; what-page not bound
+
+;; The new page handling commands all use `C-x C-p' as a prefix. This
+;; means that the key binding for `mark-page' must be changed.
+;; Otherwise, no other changes are made to the current commands or
+;; their bindings.
+
+;; New page handling commands:
+
+;; next-page C-x C-p C-n
+;; previous-page C-x C-p C-p
+;; search-pages C-x C-p C-s
+;; add-new-page C-x C-p C-a
+;; sort-pages-buffer C-x C-p s
+;; set-page-delimiter C-x C-p C-l
+;; pages-directory C-x C-p C-d
+;; pages-directory-for-addresses C-x C-p d
+;; pages-directory-goto C-c C-c
\f
;;; Using the page commands
-
-; The page commands are helpful in several different contexts. For
-; example, programmers often divide source files into sections using the
-; `page-delimiter'; you can use the `pages-directory' command to list
-; the sections.
-
-; You may change the buffer local value of the `page-delimiter' with
-; the `set-page-delimiter' command. This command is bound to `C-x C-p
-; C-l' The command prompts you for a new value for the page-delimiter.
-; Called with a prefix-arg, the command resets the value of the
-; page-delimiter to its original value.
-
-; You may set several user options:
-;
-; The `pages-directory-buffer-narrowing-p' variable causes the
-; `pages-directory-goto' command to narrow to the destination page.
-;
-; The `pages-directory-for-adding-page-narrowing-p' variable, causes the
-; `add-new-page' command to narrow to the new entry.
-;
-; The `pages-directory-for-adding-new-page-before-current-page-p' variable
-; causes the `add-new-page' command to insert a new page before current
-; page.
-;
-; These variables are true by default.
-;
-; Additional, addresses-related user options are described in the next page
-; of this file.
+
+;; The page commands are helpful in several different contexts. For
+;; example, programmers often divide source files into sections using the
+;; `page-delimiter'; you can use the `pages-directory' command to list
+;; the sections.
+
+;; You may change the buffer local value of the `page-delimiter' with
+;; the `set-page-delimiter' command. This command is bound to `C-x C-p
+;; C-l' The command prompts you for a new value for the page-delimiter.
+;; Called with a prefix-arg, the command resets the value of the
+;; page-delimiter to its original value.
+
+;; You may set several user options:
+;;
+;; The `pages-directory-buffer-narrowing-p' variable causes the
+;; `pages-directory-goto' command to narrow to the destination page.
+;;
+;; The `pages-directory-for-adding-page-narrowing-p' variable, causes the
+;; `add-new-page' command to narrow to the new entry.
+;;
+;; The `pages-directory-for-adding-new-page-before-current-page-p' variable
+;; causes the `add-new-page' command to insert a new page before current
+;; page.
+;;
+;; These variables are true by default.
+;;
+;; Additional, addresses-related user options are described in the next page
+;; of this file.
\f
;;; Handling an address list or small data base
-; You may use the page commands to handle an address list or other
-; small data base. Put each address or entry on its own page. The
-; first line of text in each page is a `header line' and is listed by
-; the `pages-directory' or `pages-directory-for-addresses' command.
-
-; Specifically:
-;
-; 1. Begin each entry with a `page-delimiter' (which is, by default,
-; `^L' at the beginning of the line).
-;
-; 2. The first line of text in each entry is the `heading line'; it
-; will appear in the pages-directory-buffer which is constructed
-; using the `C-x C-p C-d' (pages-directory) command or the `C-x
-; C-p d' (pages-directory-for-addresses) command.
-;
-; The heading line may be on the same line as the page-delimiter
-; or it may follow after. It is the first non-blank line on the
-; page. Conventionally, the heading line is placed on the line
-; immediately following the line containing page-delimiter.
-;
-; 3. Follow the heading line with the body of the entry. The body
-; extends up to the next `page-delimiter'. The body may be of any
-; length. It is conventional to place a blank line after the last
-; line of the body.
-
-; For example, a file might look like this:
-;
-; FSF
-; Free Software Foundation
-; 675 Massachusetts Avenue
-; Cambridge, MA 02139 USA
-; (617) 876-3296
-; gnu@prep.ai.mit.edu
-;
-; \f
-; House Subcommittee on Intellectual Property,
-; U.S. House of Representatives,
-; Washington, DC 20515
-;
-; Congressional committee concerned with permitting or preventing
-; monopolistic restrictions on the use of software technology.
-;
-; \f
-; George Lakoff
-; ``Women, Fire, and Dangerous Things:
-; What Categories Reveal about the Mind''
-; 1987, Univ. of Chicago Press
-;
-; About philosophy, Whorfian effects, and linguistics.
-;
-; \f
-; OBI (On line text collection.)
-; Open Book Initiative
-; c/o Software Tool & Die
-; 1330 Beacon St, Brookline, MA 02146 USA
-; (617) 739-0202
-; obi@world.std.com
-
-; In this example, the heading lines are:
-;
-; FSF
-; House Subcommittee on Intellectual Property
-; George Lakoff
-; OBI (On line text collection.)
-
-; The `C-x C-p s' (sort-pages-buffer) command sorts the entries in the
-; buffer alphabetically.
-
-; You may use any of the page commands, including the `next-page',
-; `previous-page', `add-new-page', `mark-page', and `search-pages'
-; commands.
-
-; You may use either the `C-x C-p d' (pages-directory-for-addresses)
-; or the `C-x C-p C-d' (pages-directory) command to construct and
-; dislay a directory of all the heading lines.
-
-; In the directory, you may position the cursor over a heading line
-; and type `C-c C-c' (pages-directory-goto) to go to the entry to
-; which it refers in the pages buffer.
-
-; You can type `C-c C-p C-a' (add-new-page) to add a new entry in the
-; pages buffer or address file. This is the same command you use to
-; add a new entry when you are in the pages buffer or address file.
-
-; If you wish, you may create several different directories,
-; one for each different buffer.
+;; You may use the page commands to handle an address list or other
+;; small data base. Put each address or entry on its own page. The
+;; first line of text in each page is a `header line' and is listed by
+;; the `pages-directory' or `pages-directory-for-addresses' command.
+
+;; Specifically:
+;;
+;; 1. Begin each entry with a `page-delimiter' (which is, by default,
+;; `^L' at the beginning of the line).
+;;
+;; 2. The first line of text in each entry is the `heading line'; it
+;; will appear in the pages-directory-buffer which is constructed
+;; using the `C-x C-p C-d' (pages-directory) command or the `C-x
+;; C-p d' (pages-directory-for-addresses) command.
+;;
+;; The heading line may be on the same line as the page-delimiter
+;; or it may follow after. It is the first non-blank line on the
+;; page. Conventionally, the heading line is placed on the line
+;; immediately following the line containing page-delimiter.
+;;
+;; 3. Follow the heading line with the body of the entry. The body
+;; extends up to the next `page-delimiter'. The body may be of any
+;; length. It is conventional to place a blank line after the last
+;; line of the body.
+
+;; For example, a file might look like this:
+;;
+;; FSF
+;; Free Software Foundation
+;; 51 Franklin Street, Fifth Floor
+;; Boston, MA 02110-1301 USA.
+;; (617) 542-5942
+;; gnu@gnu.org
+;;
+;; \f
+;; House Subcommittee on Intellectual Property,
+;; U.S. House of Representatives,
+;; Washington, DC 20515
+;;
+;; Congressional committee concerned with permitting or preventing
+;; monopolistic restrictions on the use of software technology.
+;;
+;; \f
+;; George Lakoff
+;; ``Women, Fire, and Dangerous Things:
+;; What Categories Reveal about the Mind''
+;; 1987, Univ. of Chicago Press
+;;
+;; About philosophy, Whorfian effects, and linguistics.
+;;
+;; \f
+;; OBI (On line text collection.)
+;; Open Book Initiative
+;; c/o Software Tool & Die
+;; 1330 Beacon St, Brookline, MA 02146 USA
+;; (617) 739-0202
+;; obi@world.std.com
+
+;; In this example, the heading lines are:
+;;
+;; FSF
+;; House Subcommittee on Intellectual Property
+;; George Lakoff
+;; OBI (On line text collection.)
+
+;; The `C-x C-p s' (sort-pages-buffer) command sorts the entries in the
+;; buffer alphabetically.
+
+;; You may use any of the page commands, including the `next-page',
+;; `previous-page', `add-new-page', `mark-page', and `search-pages'
+;; commands.
+
+;; You may use either the `C-x C-p d' (pages-directory-for-addresses)
+;; or the `C-x C-p C-d' (pages-directory) command to construct and
+;; display a directory of all the heading lines.
+
+;; In the directory, you may position the cursor over a heading line
+;; and type `C-c C-c' (pages-directory-goto) to go to the entry to
+;; which it refers in the pages buffer.
+
+;; You can type `C-c C-p C-a' (add-new-page) to add a new entry in the
+;; pages buffer or address file. This is the same command you use to
+;; add a new entry when you are in the pages buffer or address file.
+
+;; If you wish, you may create several different directories,
+;; one for each different buffer.
;; `pages-directory-for-addresses' in detail
-; The `pages-directory-for-addresses' assumes a default addresses
-; file. You do not need to specify the addresses file but merely type
-; `C-x C-p d' from any buffer. The command finds the file, constructs
-; a directory for it, and switches you to the directory. If you call
-; the command with a prefix arg, `C-u C-x C-p d', it prompts you for a
-; file name.
+;; The `pages-directory-for-addresses' assumes a default addresses
+;; file. You do not need to specify the addresses file but merely type
+;; `C-x C-p d' from any buffer. The command finds the file, constructs
+;; a directory for it, and switches you to the directory. If you call
+;; the command with a prefix arg, `C-u C-x C-p d', it prompts you for a
+;; file name.
-; You may customize the addresses commands:
+;; You may customize the addresses commands:
-; The `pages-addresses-file-name' variable determines the name of
-; the addresses file; by default it is "~/addresses".
+;; The `pages-addresses-file-name' variable determines the name of
+;; the addresses file; by default it is "~/addresses".
-; The `pages-directory-for-addresses-goto-narrowing-p' variable
-; determines whether `pages-directory-goto' narrows the addresses
-; buffer to the entry, which it does by default.
+;; The `pages-directory-for-addresses-goto-narrowing-p' variable
+;; determines whether `pages-directory-goto' narrows the addresses
+;; buffer to the entry, which it does by default.
-; The `pages-directory-for-addresses-buffer-keep-windows-p' variable
-; determines whether `pages-directory-for-addresses' deletes other
-; windows to show as many lines as possible on the screen or works
-; in the usual Emacs manner and keeps other windows. Default is to
-; keep other windows.
+;; The `pages-directory-for-addresses-buffer-keep-windows-p' variable
+;; determines whether `pages-directory-for-addresses' deletes other
+;; windows to show as many lines as possible on the screen or works
+;; in the usual Emacs manner and keeps other windows. Default is to
+;; keep other windows.
-; The `pages-directory-for-adding-addresses-narrowing-p' variable
-; determines whether `pages-directory-for-addresses' narrows the
-; addresses buffer to a new entry when you are adding that entry.
-; Default is to narrow to new entry, which means you see a blank
-; screen before you write the new entry.
+;; The `pages-directory-for-adding-addresses-narrowing-p' variable
+;; determines whether `pages-directory-for-addresses' narrows the
+;; addresses buffer to a new entry when you are adding that entry.
+;; Default is to narrow to new entry, which means you see a blank
+;; screen before you write the new entry.
;; `pages-directory' in detail
-; Call the `pages-directory' command from the buffer for which you
-; want a directory created; it creates a directory for the buffer and
-; pops you to the directory.
+;; Call the `pages-directory' command from the buffer for which you
+;; want a directory created; it creates a directory for the buffer and
+;; pops you to the directory.
-; The `pages-directory' command has several options:
+;; The `pages-directory' command has several options:
-; Called with a prefix arg, `C-u C-x C-p C-d', the `pages-directory'
-; prompts you for a regular expression and only lists only those
-; header lines that are part of pages that contain matches to the
-; regexp. In the example above, `C-u C-x C-p C-d 617 RET' would
-; match the telephone area code of the first and fourth entries, so
-; only the header lines of those two entries would appear in the
-; pages-directory-buffer.
-;
-; Called with a numeric argument, the `pages-directory' command
-; lists the number of lines in each page. This is helpful when you
-; are printing hardcopy.
+;; Called with a prefix arg, `C-u C-x C-p C-d', the `pages-directory'
+;; prompts you for a regular expression and only lists only those
+;; header lines that are part of pages that contain matches to the
+;; regexp. In the example above, `C-u C-x C-p C-d 617 RET' would
+;; match the telephone area code of the first and fourth entries, so
+;; only the header lines of those two entries would appear in the
+;; pages-directory-buffer.
+;;
+;; Called with a numeric argument, the `pages-directory' command
+;; lists the number of lines in each page. This is helpful when you
+;; are printing hardcopy.
-; Called with a negative numeric argument, the `pages-directory'
-; command lists the lengths of pages whose contents match a regexp.
+;; Called with a negative numeric argument, the `pages-directory'
+;; command lists the lengths of pages whose contents match a regexp.
;;; Code:
\f
;;; Customarily customizable variable definitions
-(defvar pages-directory-buffer-narrowing-p t
- "*If non-nil, `pages-directory-goto' narrows pages buffer to entry.")
+(defgroup pages nil
+ "Extended page-handling commands."
+ :group 'extensions)
+
+
+(defcustom pages-directory-buffer-narrowing-p t
+ "*If non-nil, `pages-directory-goto' narrows pages buffer to entry."
+ :type 'boolean
+ :group 'pages)
-(defvar pages-directory-for-adding-page-narrowing-p t
- "*If non-nil, `add-new-page' narrows page buffer to new entry.")
+(defcustom pages-directory-for-adding-page-narrowing-p t
+ "*If non-nil, `add-new-page' narrows page buffer to new entry."
+ :type 'boolean
+ :group 'pages)
-(defvar pages-directory-for-adding-new-page-before-current-page-p t
- "*If non-nil, `add-new-page' inserts new page before current page.")
+(defcustom pages-directory-for-adding-new-page-before-current-page-p t
+ "*If non-nil, `add-new-page' inserts new page before current page."
+ :type 'boolean
+ :group 'pages)
\f
;;; Addresses related variables
-(defvar pages-addresses-file-name "~/addresses"
+(defcustom pages-addresses-file-name "~/addresses"
"*Standard name for file of addresses. Entries separated by page-delimiter.
-Used by `pages-directory-for-addresses' function.")
+Used by `pages-directory-for-addresses' function."
+ :type 'file
+ :group 'pages)
-(defvar pages-directory-for-addresses-goto-narrowing-p t
- "*If non-nil, `pages-directory-goto' narrows addresses buffer to entry.")
+(defcustom pages-directory-for-addresses-goto-narrowing-p t
+ "*If non-nil, `pages-directory-goto' narrows addresses buffer to entry."
+ :type 'boolean
+ :group 'pages)
-(defvar pages-directory-for-addresses-buffer-keep-windows-p t
- "*If nil, `pages-directory-for-addresses' deletes other windows.")
+(defcustom pages-directory-for-addresses-buffer-keep-windows-p t
+ "*If nil, `pages-directory-for-addresses' deletes other windows."
+ :type 'boolean
+ :group 'pages)
-(defvar pages-directory-for-adding-addresses-narrowing-p t
- "*If non-nil, `add-new-page' narrows addresses buffer to new entry.")
+(defcustom pages-directory-for-adding-addresses-narrowing-p t
+ "*If non-nil, `add-new-page' narrows addresses buffer to new entry."
+ :type 'boolean
+ :group 'pages)
\f
;;; Key bindings for page handling functions
pages-directory-for-adding-page-narrowing-p variable
is non-nil.
-Page begins with a `^L' as the default page-delimiter.
+Page begins with a `^L' as the default page-delimiter.
Use \\[set-page-delimiter] to change the page-delimiter.
Point is left in the body of page."
(interactive "sHeader line: ")
(widen)
;; If in pages directory buffer
- (if (eq major-mode 'pages-directory-mode)
+ (if (eq major-mode 'pages-directory-mode)
(progn
;; Add new page before or after current page?
(if pages-directory-for-adding-new-page-before-current-page-p
(format "%s\n"
;; Remove leading `^' from page-delimiter string
(if (eq '^ (car (read-from-string page-delimiter)))
- (substring page-delimiter 1))))
+ (substring page-delimiter 1))))
(goto-char (point-min))))
;; Insert page delimiter at beginning of line.
(if (not (looking-at "^.")) (forward-line 1))
- (insert (format "%s\n%s\n\n\n"
+ (insert (format "%s\n%s\n\n\n"
(if (eq '^ (car (read-from-string page-delimiter)))
(substring page-delimiter 1))
header-line))
(autoload 'sort-subr "sort" "Primary function for sorting." t nil)
(defun sort-pages-in-region (reverse beg end)
- "Sort pages in region alphabetically. Prefix arg means reverse order.
+ "Sort pages in region alphabetically. Prefix arg means reverse order.
Called from a program, there are three arguments:
REVERSE (non-nil means reverse order), BEG and END (region to sort)."
(goto-char (point-max))))))))
(defun sort-pages-buffer (&optional reverse)
- "Sort pages alphabetically in buffer. Prefix arg means reverse order.
+ "Sort pages alphabetically in buffer. Prefix arg means reverse order.
\(Non-nil arg if not interactive.\)"
(interactive "P")
(defvar pages-pos-list nil
"List containing the positions of the pages in the pages-buffer.")
-(defvar pages-directory-map nil
- "Keymap for the pages-directory-buffer.")
+(defvar pages-target-buffer)
-(if pages-directory-map
- ()
- (setq pages-directory-map (make-sparse-keymap))
- (define-key pages-directory-map "\C-c\C-c"
- 'pages-directory-goto)
- (define-key pages-directory-map "\C-c\C-p\C-a" 'add-new-page))
+(defvar pages-directory-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map "\C-c\C-c" 'pages-directory-goto)
+ (define-key map "\C-c\C-p\C-a" 'add-new-page)
+ (define-key map [mouse-2] 'pages-directory-goto-with-mouse)
+ map)
+ "Keymap for the pages-directory-buffer.")
+(defvaralias 'pages-directory-map 'pages-directory-mode-map)
-(defvar original-page-delimiter "^\f"
+(defvar original-page-delimiter "^\f"
"Default page delimiter.")
(defun set-page-delimiter (regexp reset-p)
In a program, non-nil second arg causes first arg to be ignored and
resets the page-delimiter to the original value."
-
+
(interactive
(if current-prefix-arg
- (list original-page-delimiter "^\f")
+ (list original-page-delimiter "^\f")
(list (read-string "Set page-delimiter to regexp: " page-delimiter)
nil)))
(make-local-variable 'original-page-delimiter)
(if (not reset-p)
(setq page-delimiter regexp)
(setq page-delimiter original-page-delimiter))
- (if (interactive-p)
+ (if (called-interactively-p 'interactive)
(message "The value of `page-delimiter' is now: %s" page-delimiter)))
\f
If the buffer is narrowed, the `pages-directory' command creates a
directory for only the accessible portion of the buffer."
-
+
(interactive
(cond ((not current-prefix-arg)
(list t nil nil))
- ((listp current-prefix-arg)
+ ((listp current-prefix-arg)
(list nil
nil
(read-string
(or pages-directory-previous-regexp "regexp")))))
((> (prefix-numeric-value current-prefix-arg) 0)
(list t t nil))
- ((< (prefix-numeric-value current-prefix-arg) 0)
+ ((< (prefix-numeric-value current-prefix-arg) 0)
(list nil
t
(read-string
(format "Select according to `%s' (end with RET): "
(or pages-directory-previous-regexp "regexp")))))))
-
+
(if (equal regexp "")
(setq regexp pages-directory-previous-regexp)
(setq pages-directory-previous-regexp regexp))
-
- (if (interactive-p)
+
+ (if (called-interactively-p 'interactive)
(message "Creating directory for: %s "
(buffer-name)))
-
- (let ((target-buffer (current-buffer))
+
+ (let ((pages-target-buffer (current-buffer))
(pages-directory-buffer
- (concat pages-directory-prefix " " (buffer-name) " "))
+ (concat pages-directory-prefix " " (buffer-name)))
(linenum 1)
(pages-buffer-original-position (point))
(pages-buffer-original-page 0))
-
+
;; `with-output-to-temp-buffer' binds the value of the variable
;; `standard-output' to the buffer named as its first argument,
;; but does not switch to that buffer.
(with-output-to-temp-buffer pages-directory-buffer
- (save-excursion
- (set-buffer standard-output)
+ (with-current-buffer standard-output
(pages-directory-mode)
(insert
"==== Pages Directory: use `C-c C-c' to go to page under cursor. ====" ?\n)
- (setq pages-buffer target-buffer)
+ (setq pages-buffer pages-target-buffer)
(setq pages-pos-list nil))
-
+
(if pages-list-all-headers-p
-
+
;; 1. If no prefix argument, list all headers
(save-excursion
(goto-char (point-min))
-
+
;; (a) Point is at beginning of buffer; but the first
;; page may not begin with a page-delimiter
(save-restriction
(goto-char (match-end 0)))
(narrow-to-page)
(pages-copy-header-and-position count-lines-p))
-
+
;; (b) Search within pages buffer for next page-delimiter
(while (re-search-forward page-delimiter nil t)
(pages-copy-header-and-position count-lines-p)))
-
+
;; 2. Else list headers whose pages match regexp.
(save-excursion
;; REMOVED save-restriction AND widen FROM HERE
(goto-char (point-min))
-
+
;; (a) Handle first page
(save-restriction
(narrow-to-page)
;; search for selection regexp
(if (save-excursion (re-search-forward regexp nil t))
(pages-copy-header-and-position count-lines-p)))
-
+
;; (b) Search for next page-delimiter
(while (re-search-forward page-delimiter nil t)
(save-restriction
(if (save-excursion (re-search-forward regexp nil t))
(pages-copy-header-and-position count-lines-p)
)))))
-
+
(set-buffer standard-output)
;; Put positions in increasing order to go with buffer.
(setq pages-pos-list (nreverse pages-pos-list))
- (if (interactive-p)
+ (if (called-interactively-p 'interactive)
(message "%d matching lines in: %s"
- (length pages-pos-list) (buffer-name target-buffer))))
+ (length pages-pos-list) (buffer-name pages-target-buffer))))
(pop-to-buffer pages-directory-buffer)
(sit-for 0) ; otherwise forward-line fails if N > window height.
(forward-line (if (= 0 pages-buffer-original-page)
1
pages-buffer-original-page))))
+(defvar pages-buffer-original-position)
+(defvar pages-buffer-original-page)
+(defvar pages-buffer-original-page)
+
(defun pages-copy-header-and-position (count-lines-p)
"Copy page header and its position to the Pages Directory.
Only arg non-nil, count lines in page and insert before header.
Used by `pages-directory' function."
-
+
(let (position line-count)
(if count-lines-p
(if (<= (point) pages-buffer-original-position)
(setq pages-buffer-original-page
(1+ pages-buffer-original-page)))
-
+
(save-excursion
;; go to first non-blank char after the page-delimiter
- (skip-chars-forward " \t\n")
+ (skip-chars-forward " \t\n")
;; set the marker here; this the place to which the
- ;; `pages-directory-goto' command will go
+ ;; `pages-directory-goto' command will go
(setq position (make-marker))
(set-marker position (point))
(let ((start (point))
- (end (save-excursion (end-of-line) (point))))
+ (end (save-excursion (end-of-line) (point)))
+ inserted-at)
;; change to directory buffer
(set-buffer standard-output)
- ;; record page position
+ ;; record page position
(setq pages-pos-list (cons position pages-pos-list))
;; insert page header
- (insert-buffer-substring target-buffer start end))
-
+ (setq inserted-at (point))
+ (insert-buffer-substring pages-target-buffer start end)
+ (add-text-properties inserted-at (point)
+ '(mouse-face highlight
+ help-echo "mouse-2: go to this page"))
+ (put-text-property inserted-at (point) 'rear-nonsticky 'highlight))
+
(if count-lines-p
(save-excursion
(beginning-of-line)
(insert (format "%3d: " line-count))))
-
+
(terpri))
- (forward-line 1)))
+ (end-of-line 1)))
(defun pages-directory-mode ()
"Mode for handling the pages-directory buffer.
to the same line in the pages buffer."
(kill-all-local-variables)
- (use-local-map pages-directory-map)
+ (use-local-map pages-directory-mode-map)
(setq major-mode 'pages-directory-mode)
(setq mode-name "Pages-Directory")
(make-local-variable 'pages-buffer)
(make-local-variable 'pages-pos-list)
- (make-local-variable 'pages-directory-buffer-narrowing-p))
+ (make-local-variable 'pages-directory-buffer-narrowing-p)
+ (run-mode-hooks 'pages-directory-mode-hook))
(defun pages-directory-goto ()
"Go to the corresponding line in the pages buffer."
(progn
(setq pages-buffer nil
pages-pos-list nil)
- (error "Buffer in which pages were found is deleted.")))
+ (error "Buffer in which pages were found is deleted")))
(beginning-of-line)
(let* ((pages-number (1- (count-lines (point-min) (point))))
(pos (nth pages-number pages-pos-list))
(end-of-directory-p (eobp))
(narrowing-p pages-directory-buffer-narrowing-p))
- (pop-to-buffer pages-buffer)
+ (pop-to-buffer pages-buffer)
(widen)
(if end-of-directory-p
(goto-char (point-max))
(goto-char (marker-position pos)))
(if narrowing-p (narrow-to-page))))
+(defun pages-directory-goto-with-mouse (event)
+ "Go to the corresponding line under the mouse pointer in the pages buffer."
+ (interactive "e")
+ (with-current-buffer (window-buffer (posn-window (event-end event)))
+ (save-excursion
+ (goto-char (posn-point (event-end event)))
+ (pages-directory-goto))))
\f
;;; The `pages-directory-for-addresses' function and ancillary code
`pages-directory-goto' narrows addresses buffer to entry.
If pages-directory-for-addresses-buffer-keep-windows-p is nil,
-this command deletes other windows when it displays the addresses
+this command deletes other windows when it displays the addresses
directory."
(interactive
(list (if current-prefix-arg
(read-file-name "Filename: " pages-addresses-file-name))))
- (if (interactive-p)
+ (if (called-interactively-p 'interactive)
(message "Creating directory for: %s "
(or filename pages-addresses-file-name)))
(if (file-exists-p (or filename pages-addresses-file-name))
(or filename pages-addresses-file-name))))
(widen)
(pages-directory t nil nil)
- (pages-directory-address-mode)
+ ;; by RJC, 2006 Jun 11: including this causes failure; it results in
+ ;; the message "Buffer in which pages were found is deleted"
+ ;; (pages-directory-address-mode)
(setq pages-directory-buffer-narrowing-p
pages-directory-for-addresses-goto-narrowing-p)
(or pages-directory-for-addresses-buffer-keep-windows-p
))
(error "No addresses file found!")))
-(defun pages-directory-address-mode ()
+(define-derived-mode pages-directory-address-mode pages-directory-mode
+ "Addresses Directory"
"Mode for handling the Addresses Directory buffer.
Move point to one of the lines in this buffer,
then use \\[pages-directory-goto] to go
to the same line in the pages buffer."
+ :syntax-table nil)
- (use-local-map pages-directory-map)
- (setq major-mode 'pages-directory-address-mode)
- (setq mode-name "Addresses Directory")
- (make-local-variable 'pages-buffer)
- (make-local-variable 'pages-pos-list)
- (make-local-variable 'pages-directory-buffer-narrowing-p))
-
-\f
-;;; Place `provide' at end of file.
(provide 'page-ext)
-;;;;;;;;;;;;;;;; end of page-ext.el ;;;;;;;;;;;;;;;;
-
+;; arch-tag: 2f311550-c6e0-4458-9c12-7f039c058bdb
+;;; page-ext.el ends here