comparison lisp/textmodes/page-ext.el @ 49599:5ade352e8d1c

Trailing whitespace deleted.

49598:0d8b17d428b5

;;     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


;;; 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.

;; 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.
;;

;;      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
;;     59 Temple Place - Suite 330
;;     Boston, MA 02111-1307  USA.
;;     [phone]
;;     [e-mail]
;; 
;;     
;;     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.
;; 
;;     
;;     George Lakoff
;;     ``Women, Fire, and Dangerous Things:
;;     What Categories Reveal about the Mind''
;;     1987, Univ. of Chicago Press
;; 
;;     About philosophy, Whorfian effects, and linguistics.
;; 
;;      
;;     OBI   (On line text collection.)
;;     Open Book Initiative
;;     c/o Software Tool & Die
;;     1330 Beacon St, Brookline, MA 02146 USA
;;     [phone] 
;;     [e-mail]

;; In this example, the heading lines are:
;;
;;     FSF

;;   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.

;;; Code:

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 in pages directory buffer
  (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
            (pages-directory-goto)
          (pages-directory-goto)

         (goto-char (point-min))
         (insert
          (format "%s\n"
                  ;; Remove leading `^' from page-delimiter string
                  (if (eq '^ (car (read-from-string page-delimiter)))
                      (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" 
                  (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)))

;;; Sorting pages

(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)."

;;; This sort function handles ends of pages differently than

                                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)

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)))

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' 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

        (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
          
          ;; 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
              ;; If page delimiter is at beginning of buffer, skip it
              (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))
            
            ;; (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
              (narrow-to-page)
              ;; search for selection regexp
              (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)
          (message "%d matching lines in: %s"

(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

    ;; Keep track of page for later cursor positioning
    (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")     
      ;; set the marker here; this the place to which the
      ;; `pages-directory-goto' command will go 
      (setq position (make-marker))
      (set-marker position (point))
      (let ((start (point))
            (end (save-excursion (end-of-line) (point)))
	    inserted-at)
        ;; change to directory buffer
        (set-buffer standard-output)
        ;; record page position 
        (setq pages-pos-list (cons position pages-pos-list))
        ;; insert page header
	(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.

  (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))))

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))))

49599:5ade352e8d1c

;;     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


;;; 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.

;; 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.
;;

;;      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
;;     59 Temple Place - Suite 330
;;     Boston, MA 02111-1307  USA.
;;     [phone]
;;     [e-mail]
;;
;;     
;;     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.
;;
;;     
;;     George Lakoff
;;     ``Women, Fire, and Dangerous Things:
;;     What Categories Reveal about the Mind''
;;     1987, Univ. of Chicago Press
;;
;;     About philosophy, Whorfian effects, and linguistics.
;;
;;     
;;     OBI   (On line text collection.)
;;     Open Book Initiative
;;     c/o Software Tool & Die
;;     1330 Beacon St, Brookline, MA 02146 USA
;;     [phone]
;;     [e-mail]

;; In this example, the heading lines are:
;;
;;     FSF

;;   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.

;;; Code:

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 in pages directory buffer
  (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
            (pages-directory-goto)
          (pages-directory-goto)

         (goto-char (point-min))
         (insert
          (format "%s\n"
                  ;; Remove leading `^' from page-delimiter string
                  (if (eq '^ (car (read-from-string page-delimiter)))
                      (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"
                  (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)))

;;; Sorting pages

(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)."

;;; This sort function handles ends of pages differently than

                                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)

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)))

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' 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

        (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

          ;; 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
              ;; If page delimiter is at beginning of buffer, skip it
              (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))

            ;; (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
              (narrow-to-page)
              ;; search for selection regexp
              (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)
          (message "%d matching lines in: %s"

(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

    ;; Keep track of page for later cursor positioning
    (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")
      ;; set the marker here; this the place to which the
      ;; `pages-directory-goto' command will go
      (setq position (make-marker))
      (set-marker position (point))
      (let ((start (point))
            (end (save-excursion (end-of-line) (point)))
	    inserted-at)
        ;; change to directory buffer
        (set-buffer standard-output)
        ;; record page position
        (setq pages-pos-list (cons position pages-pos-list))
        ;; insert page header
	(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.

  (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))))

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))))