(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)
(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)
(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)
(defcustom pages-addresses-file-name "~/addresses"
"*Standard name for file of addresses. Entries separated by page-delimiter.
Used by `pages-directory-for-addresses' function."
:type 'file
:group 'pages)
(defcustom pages-directory-for-addresses-goto-narrowing-p t
"*If non-nil, `pages-directory-goto' narrows addresses buffer to entry."
:type 'boolean
:group 'pages)
(defcustom pages-directory-for-addresses-buffer-keep-windows-p t
"*If nil, `pages-directory-for-addresses' deletes other windows."
:type 'boolean
:group 'pages)
(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)
(global-unset-key "\C-x\C-p")
(defvar ctl-x-ctl-p-map (make-sparse-keymap)
"Keymap for subcommands of C-x C-p, which are for page handling.")
(define-key ctl-x-map "\C-p" 'ctl-x-ctl-p-prefix)
(fset 'ctl-x-ctl-p-prefix ctl-x-ctl-p-map)
(define-key ctl-x-ctl-p-map "\C-n" 'next-page)
(define-key ctl-x-ctl-p-map "\C-p" 'previous-page)
(define-key ctl-x-ctl-p-map "\C-a" 'add-new-page)
(define-key ctl-x-ctl-p-map "\C-m" 'mark-page)
(define-key ctl-x-ctl-p-map "\C-s" 'search-pages)
(define-key ctl-x-ctl-p-map "s" 'sort-pages-buffer)
(define-key ctl-x-ctl-p-map "\C-l" 'set-page-delimiter)
(define-key ctl-x-ctl-p-map "\C-d" 'pages-directory)
(define-key ctl-x-ctl-p-map "d" 'pages-directory-for-addresses)
(defun next-page (&optional count)
"Move to the next page bounded by the `page-delimiter' variable.
With arg (prefix if interactive), move that many pages."
(interactive "p")
(or count (setq count 1))
(widen)
(while (and (> count 0) (not (eobp)))
(if (re-search-forward page-delimiter nil t)
nil
(goto-char (point-max)))
(setq count (1- count)))
(while (and (< count 1) (not (bobp)))
(if (re-search-backward page-delimiter nil t)
(goto-char (match-beginning 0))
(goto-char (point-min)))
(setq count (1+ count)))
(narrow-to-page)
(goto-char (point-min))
(recenter 0))
(defun previous-page (&optional count)
"Move to the previous page bounded by the `page-delimiter' variable.
With arg (prefix if interactive), move that many pages."
(interactive "p")
(or count (setq count 1))
(next-page (- count)))
(defun add-new-page (header-line)
"Insert new page. Prompt for header line.
If point is in the pages directory buffer, insert the new page in the
buffer associated with the directory.
Insert the new page just before current page if
pages-directory-for-adding-new-page-before-current-page-p variable
is non-nil. Else insert at exact location of point.
Narrow to new page if
pages-directory-for-adding-page-narrowing-p variable
is non-nil.
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 (eq major-mode 'pages-directory-mode)
(progn
(if pages-directory-for-adding-new-page-before-current-page-p
(pages-directory-goto)
(pages-directory-goto)
(forward-page)
(or (eobp) (forward-line -1)))))
(widen)
(and pages-directory-for-adding-new-page-before-current-page-p
(if (re-search-backward page-delimiter nil t)
(goto-char (match-beginning 0))
(goto-char (point-min))
(insert
(format "%s\n"
(if (eq '^ (car (read-from-string page-delimiter)))
(substring page-delimiter 1))))
(goto-char (point-min))))
(if (not (looking-at "^.")) (forward-line 1))
(insert (format "%s\n%s\n\n\n"
(if (eq '^ (car (read-from-string page-delimiter)))
(substring page-delimiter 1))
header-line))
(forward-line -1)
(and pages-directory-for-adding-page-narrowing-p (narrow-to-page)))
(defvar pages-last-search nil
"Value of last regexp searched for. Initially, nil.")
(defun search-pages (regexp)
"Search for REGEXP, starting from point, and narrow to page it is in."
(interactive (list
(read-string
(format "Search for `%s' (end with RET): "
(or pages-last-search "regexp")))))
(if (equal regexp "")
(setq regexp pages-last-search)
(setq pages-last-search regexp))
(widen)
(re-search-forward regexp)
(narrow-to-page))
(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.
Called from a program, there are three arguments:
REVERSE (non-nil means reverse order), BEG and END (region to sort)."
(interactive "P\nr")
(save-restriction
(narrow-to-region beg end)
(goto-char (point-min))
(sort-subr reverse
(function (lambda ()
(re-search-forward page-delimiter nil t)
(skip-chars-forward " \t\n")
))
(function (lambda ()
(if (re-search-forward
page-delimiter
nil
t)
(goto-char (match-beginning 0))
(goto-char (point-max))))))))
(defun sort-pages-buffer (&optional reverse)
"Sort pages alphabetically in buffer. Prefix arg means reverse order.
\(Non-nil arg if not interactive.\)"
(interactive "P")
(or reverse (setq reverse nil))
(widen)
(let ((beginning (point-min))
(end (point-max)))
(sort-pages-in-region reverse beginning end)))
(defvar pages-directory-previous-regexp nil
"Value of previous regexp used by `pages-directory'.
\(This regular expression may be used to select only those pages that
contain matches to the regexp.\)")
(defvar pages-buffer nil
"The buffer for which the pages-directory function creates the directory.")
(defvar pages-directory-prefix "*Directory for:"
"Prefix of name of temporary buffer for pages-directory.")
(defvar pages-pos-list nil
"List containing the positions of the pages in the pages-buffer.")
(defvar pages-target-buffer)
(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"
"Default page delimiter.")
(defun set-page-delimiter (regexp reset-p)
"Set buffer local value of page-delimiter to REGEXP.
Called interactively with a prefix argument, reset `page-delimiter' to
its original value.
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 (read-string "Set page-delimiter to regexp: " page-delimiter)
nil)))
(make-local-variable 'original-page-delimiter)
(make-local-variable 'page-delimiter)
(setq original-page-delimiter
(or original-page-delimiter page-delimiter))
(if (not reset-p)
(setq page-delimiter regexp)
(setq page-delimiter original-page-delimiter))
(if (interactive-p)
(message "The value of `page-delimiter' is now: %s" page-delimiter)))
(defun pages-directory
(pages-list-all-headers-p count-lines-p &optional regexp)
"Display a directory of the page headers in a temporary buffer.
A header is the first non-blank line after the page-delimiter.
\\[pages-directory-mode]
You may move point to one of the lines in the temporary buffer,
then use \\<pages-directory-goto> to go to the same line in the pages buffer.
In interactive use:
1. With no prefix arg, display all headers.
2. With prefix arg, display the headers of only those pages that
contain matches to a regular expression for which you are
prompted.
3. With numeric prefix arg, for every page, print the number of
lines within each page.
4. With negative numeric prefix arg, for only those pages that
match a regular expression, print the number of lines within
each page.
When called from a program, non-nil first arg means list all headers;
non-nil second arg means print numbers of lines in each page; if first
arg is nil, optional third arg is regular expression.
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)
(list nil
nil
(read-string
(format "Select according to `%s' (end with RET): "
(or pages-directory-previous-regexp "regexp")))))
((> (prefix-numeric-value current-prefix-arg) 0)
(list t t nil))
((< (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)
(message "Creating directory for: %s "
(buffer-name)))
(let ((pages-target-buffer (current-buffer))
(pages-directory-buffer
(concat pages-directory-prefix " " (buffer-name)))
(linenum 1)
(pages-buffer-original-position (point))
(pages-buffer-original-page 0))
(with-output-to-temp-buffer pages-directory-buffer
(save-excursion
(set-buffer standard-output)
(pages-directory-mode)
(insert
"==== Pages Directory: use `C-c C-c' to go to page under cursor. ====" ?\n)
(setq pages-buffer pages-target-buffer)
(setq pages-pos-list nil))
(if pages-list-all-headers-p
(save-excursion
(goto-char (point-min))
(save-restriction
(if (and (save-excursion
(re-search-forward page-delimiter nil t))
(= 1 (match-beginning 0)))
(goto-char (match-end 0)))
(narrow-to-page)
(pages-copy-header-and-position count-lines-p))
(while (re-search-forward page-delimiter nil t)
(pages-copy-header-and-position count-lines-p)))
(save-excursion
(goto-char (point-min))
(save-restriction
(narrow-to-page)
(if (save-excursion (re-search-forward regexp nil t))
(pages-copy-header-and-position count-lines-p)))
(while (re-search-forward page-delimiter nil t)
(save-restriction
(narrow-to-page)
(if (save-excursion (re-search-forward regexp nil t))
(pages-copy-header-and-position count-lines-p)
)))))
(set-buffer standard-output)
(setq pages-pos-list (nreverse pages-pos-list))
(if (interactive-p)
(message "%d matching lines in: %s"
(length pages-pos-list) (buffer-name pages-target-buffer))))
(pop-to-buffer pages-directory-buffer)
(sit-for 0) (forward-line (if (= 0 pages-buffer-original-page)
1
pages-buffer-original-page))))
(eval-when-compile
(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
(save-excursion
(save-restriction
(narrow-to-page)
(setq line-count (count-lines (point-min) (point-max))))))
(if (<= (point) pages-buffer-original-position)
(setq pages-buffer-original-page
(1+ pages-buffer-original-page)))
(save-excursion
(skip-chars-forward " \t\n")
(setq position (make-marker))
(set-marker position (point))
(let ((start (point))
(end (save-excursion (end-of-line) (point)))
inserted-at)
(set-buffer standard-output)
(setq pages-pos-list (cons position pages-pos-list))
(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))
(end-of-line 1)))
(defun pages-directory-mode ()
"Mode for handling the pages-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."
(kill-all-local-variables)
(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)
(run-mode-hooks 'pages-directory-mode-hook))
(defun pages-directory-goto ()
"Go to the corresponding line in the pages buffer."
(interactive)
(if (or (not pages-buffer)
(not (buffer-name pages-buffer)))
(progn
(setq pages-buffer nil
pages-pos-list nil)
(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)
(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")
(save-excursion
(set-buffer (window-buffer (posn-window (event-end event))))
(save-excursion
(goto-char (posn-point (event-end event)))
(pages-directory-goto))))
(defun pages-directory-for-addresses (&optional filename)
"Find addresses file and display its directory.
By default, create and display directory of `pages-addresses-file-name'.
Optional argument is FILENAME. In interactive use, with prefix
argument, prompt for file name and provide completion.
Move point to one of the lines in the displayed directory,
then use \\[pages-directory-goto] to go to the same line
in the addresses buffer.
If pages-directory-for-addresses-goto-narrowing-p is non-nil,
`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
directory."
(interactive
(list (if current-prefix-arg
(read-file-name "Filename: " pages-addresses-file-name))))
(if (interactive-p)
(message "Creating directory for: %s "
(or filename pages-addresses-file-name)))
(if (file-exists-p (or filename pages-addresses-file-name))
(progn
(set-buffer
(find-file-noselect
(expand-file-name
(or filename pages-addresses-file-name))))
(widen)
(pages-directory t nil nil)
(setq pages-directory-buffer-narrowing-p
pages-directory-for-addresses-goto-narrowing-p)
(or pages-directory-for-addresses-buffer-keep-windows-p
(delete-other-windows))
(save-excursion
(goto-char (point-min))
(delete-region (point) (save-excursion (end-of-line) (point)))
(insert
"=== Address List Directory: use `C-c C-c' to go to page under cursor. ===")
(set-buffer-modified-p nil)
))
(error "No addresses file found!")))
(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)
(provide 'page-ext)