/[emacs]/emacs/lisp/textmodes/page-ext.el
ViewVC logotype

Diff of /emacs/lisp/textmodes/page-ext.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.25 by rms, Mon Aug 12 17:23:16 2002 UTC revision 1.26 by lektu, Tue Feb 4 13:30:45 2003 UTC
# Line 51  Line 51 
51  ;;     previous-page                    C-x C-p C-p  ;;     previous-page                    C-x C-p C-p
52  ;;     search-pages                     C-x C-p C-s  ;;     search-pages                     C-x C-p C-s
53  ;;     add-new-page                     C-x C-p C-a  ;;     add-new-page                     C-x C-p C-a
54  ;;     sort-pages-buffer                C-x C-p s        ;;     sort-pages-buffer                C-x C-p s
55  ;;     set-page-delimiter               C-x C-p C-l  ;;     set-page-delimiter               C-x C-p C-l
56  ;;     pages-directory                  C-x C-p C-d    ;;     pages-directory                  C-x C-p C-d
57  ;;     pages-directory-for-addresses    C-x C-p d  ;;     pages-directory-for-addresses    C-x C-p d
58  ;;        pages-directory-goto          C-c C-c  ;;        pages-directory-goto          C-c C-c
59    
60    
61  ;;; Using the page commands  ;;; Using the page commands
62    
63  ;; The page commands are helpful in several different contexts.  For  ;; The page commands are helpful in several different contexts.  For
64  ;; example, programmers often divide source files into sections using the  ;; example, programmers often divide source files into sections using the
65  ;; `page-delimiter'; you can use the `pages-directory' command to list  ;; `page-delimiter'; you can use the `pages-directory' command to list
# Line 97  Line 97 
97  ;; the `pages-directory' or `pages-directory-for-addresses' command.  ;; the `pages-directory' or `pages-directory-for-addresses' command.
98    
99  ;; Specifically:  ;; Specifically:
100  ;;  ;;
101  ;;   1. Begin each entry with a `page-delimiter' (which is, by default,  ;;   1. Begin each entry with a `page-delimiter' (which is, by default,
102  ;;      `^L' at the beginning of the line).  ;;      `^L' at the beginning of the line).
103  ;;  ;;
104  ;;   2. The first line of text in each entry is the `heading line'; it  ;;   2. The first line of text in each entry is the `heading line'; it
105  ;;      will appear in the pages-directory-buffer which is constructed  ;;      will appear in the pages-directory-buffer which is constructed
106  ;;      using the `C-x C-p C-d' (pages-directory) command or the `C-x  ;;      using the `C-x C-p C-d' (pages-directory) command or the `C-x
107  ;;      C-p d' (pages-directory-for-addresses) command.  ;;      C-p d' (pages-directory-for-addresses) command.
108  ;;  ;;
109  ;;      The heading line may be on the same line as the page-delimiter  ;;      The heading line may be on the same line as the page-delimiter
110  ;;      or it may follow after.  It is the first non-blank line on the  ;;      or it may follow after.  It is the first non-blank line on the
111  ;;      page.  Conventionally, the heading line is placed on the line  ;;      page.  Conventionally, the heading line is placed on the line
# Line 117  Line 117 
117  ;;      line of the body.  ;;      line of the body.
118    
119  ;; For example, a file might look like this:  ;; For example, a file might look like this:
120  ;;  ;;
121  ;;     FSF  ;;     FSF
122  ;;     Free Software Foundation  ;;     Free Software Foundation
123  ;;     59 Temple Place - Suite 330  ;;     59 Temple Place - Suite 330
124  ;;     Boston, MA 02111-1307  USA.  ;;     Boston, MA 02111-1307  USA.
125  ;;     (617) 542-5942  ;;     (617) 542-5942
126  ;;     gnu@gnu.org  ;;     gnu@gnu.org
127  ;;  ;;
128  ;;      ;;    
129  ;;     House Subcommittee on Intellectual Property,  ;;     House Subcommittee on Intellectual Property,
130  ;;     U.S. House of Representatives,  ;;     U.S. House of Representatives,
131  ;;     Washington, DC  20515  ;;     Washington, DC  20515
132  ;;      ;;
133  ;;     Congressional committee concerned with permitting or preventing  ;;     Congressional committee concerned with permitting or preventing
134  ;;     monopolistic restrictions on the use of software technology.  ;;     monopolistic restrictions on the use of software technology.
135  ;;  ;;
136  ;;      ;;    
137  ;;     George Lakoff  ;;     George Lakoff
138  ;;     ``Women, Fire, and Dangerous Things:  ;;     ``Women, Fire, and Dangerous Things:
139  ;;     What Categories Reveal about the Mind''  ;;     What Categories Reveal about the Mind''
140  ;;     1987, Univ. of Chicago Press  ;;     1987, Univ. of Chicago Press
141  ;;  ;;
142  ;;     About philosophy, Whorfian effects, and linguistics.  ;;     About philosophy, Whorfian effects, and linguistics.
143  ;;  ;;
144  ;;      ;;    
145  ;;     OBI   (On line text collection.)  ;;     OBI   (On line text collection.)
146  ;;     Open Book Initiative  ;;     Open Book Initiative
147  ;;     c/o Software Tool & Die  ;;     c/o Software Tool & Die
148  ;;     1330 Beacon St, Brookline, MA 02146 USA  ;;     1330 Beacon St, Brookline, MA 02146 USA
149  ;;     (617) 739-0202  ;;     (617) 739-0202
150  ;;     obi@world.std.com  ;;     obi@world.std.com
151    
152  ;; In this example, the heading lines are:  ;; In this example, the heading lines are:
# Line 223  Line 223 
223  ;;   match the telephone area code of the first and fourth entries, so  ;;   match the telephone area code of the first and fourth entries, so
224  ;;   only the header lines of those two entries would appear in the  ;;   only the header lines of those two entries would appear in the
225  ;;   pages-directory-buffer.  ;;   pages-directory-buffer.
226  ;;  ;;
227  ;;   Called with a numeric argument, the `pages-directory' command  ;;   Called with a numeric argument, the `pages-directory' command
228  ;;   lists the number of lines in each page.  This is helpful when you  ;;   lists the number of lines in each page.  This is helpful when you
229  ;;   are printing hardcopy.    ;;   are printing hardcopy.
230    
231  ;;   Called with a negative numeric argument, the `pages-directory'  ;;   Called with a negative numeric argument, the `pages-directory'
232  ;;   command lists the lengths of pages whose contents match a regexp.  ;;   command lists the lengths of pages whose contents match a regexp.
# Line 352  Narrow to new page if Line 352  Narrow to new page if
352    pages-directory-for-adding-page-narrowing-p variable    pages-directory-for-adding-page-narrowing-p variable
353  is non-nil.  is non-nil.
354    
355  Page begins with a `^L' as the default page-delimiter.    Page begins with a `^L' as the default page-delimiter.
356  Use \\[set-page-delimiter] to change the page-delimiter.  Use \\[set-page-delimiter] to change the page-delimiter.
357  Point is left in the body of page."  Point is left in the body of page."
358    (interactive "sHeader line: ")    (interactive "sHeader line: ")
359    (widen)    (widen)
360    ;; If in pages directory buffer    ;; If in pages directory buffer
361    (if (eq major-mode 'pages-directory-mode)    (if (eq major-mode 'pages-directory-mode)
362        (progn        (progn
363          ;; Add new page before or after current page?          ;; Add new page before or after current page?
364          (if pages-directory-for-adding-new-page-before-current-page-p          (if pages-directory-for-adding-new-page-before-current-page-p
# Line 378  Point is left in the body of page." Line 378  Point is left in the body of page."
378            (format "%s\n"            (format "%s\n"
379                    ;; Remove leading `^' from page-delimiter string                    ;; Remove leading `^' from page-delimiter string
380                    (if (eq '^ (car (read-from-string page-delimiter)))                    (if (eq '^ (car (read-from-string page-delimiter)))
381                        (substring page-delimiter 1))))                                (substring page-delimiter 1))))
382           (goto-char (point-min))))           (goto-char (point-min))))
383    ;; Insert page delimiter at beginning of line.    ;; Insert page delimiter at beginning of line.
384    (if (not (looking-at "^."))   (forward-line 1))    (if (not (looking-at "^."))   (forward-line 1))
385    (insert (format "%s\n%s\n\n\n"    (insert (format "%s\n%s\n\n\n"
386                    (if (eq '^ (car (read-from-string page-delimiter)))                    (if (eq '^ (car (read-from-string page-delimiter)))
387                        (substring page-delimiter 1))                        (substring page-delimiter 1))
388                    header-line))                    header-line))
# Line 411  Point is left in the body of page." Line 411  Point is left in the body of page."
411  (autoload 'sort-subr "sort" "Primary function for sorting." t nil)  (autoload 'sort-subr "sort" "Primary function for sorting." t nil)
412    
413  (defun sort-pages-in-region (reverse beg end)  (defun sort-pages-in-region (reverse beg end)
414    "Sort pages in region alphabetically.  Prefix arg means reverse order.      "Sort pages in region alphabetically.  Prefix arg means reverse order.
415    
416  Called from a program, there are three arguments:  Called from a program, there are three arguments:
417  REVERSE (non-nil means reverse order), BEG and END (region to sort)."  REVERSE (non-nil means reverse order), BEG and END (region to sort)."
# Line 446  REVERSE (non-nil means reverse order), B Line 446  REVERSE (non-nil means reverse order), B
446                               (goto-char (point-max))))))))                               (goto-char (point-max))))))))
447    
448  (defun sort-pages-buffer (&optional reverse)  (defun sort-pages-buffer (&optional reverse)
449    "Sort pages alphabetically in buffer.  Prefix arg means reverse order.    "Sort pages alphabetically in buffer.  Prefix arg means reverse order.
450  \(Non-nil arg if not interactive.\)"  \(Non-nil arg if not interactive.\)"
451    
452    (interactive "P")    (interactive "P")
# Line 496  its original value. Line 496  its original value.
496    
497  In a program, non-nil second arg causes first arg to be ignored and  In a program, non-nil second arg causes first arg to be ignored and
498  resets the page-delimiter to the original value."  resets the page-delimiter to the original value."
499      
500    (interactive    (interactive
501     (if current-prefix-arg     (if current-prefix-arg
502         (list original-page-delimiter "^\f")         (list original-page-delimiter "^\f")
# Line 544  arg is nil, optional third arg is regula Line 544  arg is nil, optional third arg is regula
544    
545  If the buffer is narrowed, the `pages-directory' command creates a  If the buffer is narrowed, the `pages-directory' command creates a
546  directory for only the accessible portion of the buffer."  directory for only the accessible portion of the buffer."
547      
548    (interactive    (interactive
549     (cond ((not current-prefix-arg)     (cond ((not current-prefix-arg)
550            (list t nil nil))            (list t nil nil))
551           ((listp current-prefix-arg)           ((listp current-prefix-arg)
552            (list nil            (list nil
553                  nil                  nil
554                  (read-string                  (read-string
# Line 556  directory for only the accessible portio Line 556  directory for only the accessible portio
556                           (or pages-directory-previous-regexp "regexp")))))                           (or pages-directory-previous-regexp "regexp")))))
557           ((> (prefix-numeric-value current-prefix-arg) 0)           ((> (prefix-numeric-value current-prefix-arg) 0)
558            (list t t nil))            (list t t nil))
559           ((< (prefix-numeric-value current-prefix-arg) 0)                     ((< (prefix-numeric-value current-prefix-arg) 0)
560            (list nil            (list nil
561                  t                  t
562                  (read-string                  (read-string
563                   (format "Select according to `%s' (end with RET): "                   (format "Select according to `%s' (end with RET): "
564                           (or pages-directory-previous-regexp "regexp")))))))                           (or pages-directory-previous-regexp "regexp")))))))
565      
566    (if (equal regexp "")    (if (equal regexp "")
567        (setq regexp pages-directory-previous-regexp)        (setq regexp pages-directory-previous-regexp)
568      (setq pages-directory-previous-regexp regexp))      (setq pages-directory-previous-regexp regexp))
569      
570    (if (interactive-p)    (if (interactive-p)
571        (message "Creating directory for: %s "        (message "Creating directory for: %s "
572                 (buffer-name)))                 (buffer-name)))
573      
574    (let ((pages-target-buffer (current-buffer))    (let ((pages-target-buffer (current-buffer))
575          (pages-directory-buffer          (pages-directory-buffer
576           (concat pages-directory-prefix " " (buffer-name)))           (concat pages-directory-prefix " " (buffer-name)))
577          (linenum 1)          (linenum 1)
578          (pages-buffer-original-position (point))          (pages-buffer-original-position (point))
579          (pages-buffer-original-page 0))          (pages-buffer-original-page 0))
580        
581      ;; `with-output-to-temp-buffer' binds the value of the variable      ;; `with-output-to-temp-buffer' binds the value of the variable
582      ;; `standard-output' to the buffer named as its first argument,      ;; `standard-output' to the buffer named as its first argument,
583      ;; but does not switch to that buffer.      ;; but does not switch to that buffer.
# Line 589  directory for only the accessible portio Line 589  directory for only the accessible portio
589           "==== Pages Directory: use `C-c C-c' to go to page under cursor. ====" ?\n)           "==== Pages Directory: use `C-c C-c' to go to page under cursor. ====" ?\n)
590          (setq pages-buffer pages-target-buffer)          (setq pages-buffer pages-target-buffer)
591          (setq pages-pos-list nil))          (setq pages-pos-list nil))
592          
593        (if pages-list-all-headers-p        (if pages-list-all-headers-p
594              
595            ;; 1. If no prefix argument, list all headers            ;; 1. If no prefix argument, list all headers
596            (save-excursion            (save-excursion
597              (goto-char (point-min))              (goto-char (point-min))
598                
599              ;; (a) Point is at beginning of buffer; but the first              ;; (a) Point is at beginning of buffer; but the first
600              ;;     page may not begin with a page-delimiter              ;;     page may not begin with a page-delimiter
601              (save-restriction              (save-restriction
# Line 606  directory for only the accessible portio Line 606  directory for only the accessible portio
606                    (goto-char (match-end 0)))                    (goto-char (match-end 0)))
607                (narrow-to-page)                (narrow-to-page)
608                (pages-copy-header-and-position count-lines-p))                (pages-copy-header-and-position count-lines-p))
609                
610              ;; (b) Search within pages buffer for next page-delimiter              ;; (b) Search within pages buffer for next page-delimiter
611              (while (re-search-forward page-delimiter nil t)              (while (re-search-forward page-delimiter nil t)
612                (pages-copy-header-and-position count-lines-p)))                (pages-copy-header-and-position count-lines-p)))
613            
614          ;; 2. Else list headers whose pages match regexp.          ;; 2. Else list headers whose pages match regexp.
615          (save-excursion          (save-excursion
616            ;; REMOVED  save-restriction  AND  widen  FROM HERE            ;; REMOVED  save-restriction  AND  widen  FROM HERE
617            (goto-char (point-min))            (goto-char (point-min))
618              
619            ;; (a) Handle first page            ;; (a) Handle first page
620            (save-restriction            (save-restriction
621              (narrow-to-page)              (narrow-to-page)
622              ;; search for selection regexp              ;; search for selection regexp
623              (if (save-excursion (re-search-forward regexp nil t))              (if (save-excursion (re-search-forward regexp nil t))
624                  (pages-copy-header-and-position count-lines-p)))                  (pages-copy-header-and-position count-lines-p)))
625              
626            ;; (b) Search for next page-delimiter            ;; (b) Search for next page-delimiter
627            (while (re-search-forward page-delimiter nil t)            (while (re-search-forward page-delimiter nil t)
628              (save-restriction              (save-restriction
# Line 631  directory for only the accessible portio Line 631  directory for only the accessible portio
631                (if (save-excursion (re-search-forward regexp nil t))                (if (save-excursion (re-search-forward regexp nil t))
632                    (pages-copy-header-and-position count-lines-p)                    (pages-copy-header-and-position count-lines-p)
633                  )))))                  )))))
634          
635        (set-buffer standard-output)        (set-buffer standard-output)
636        ;; Put positions in increasing order to go with buffer.        ;; Put positions in increasing order to go with buffer.
637        (setq pages-pos-list (nreverse pages-pos-list))        (setq pages-pos-list (nreverse pages-pos-list))
# Line 652  directory for only the accessible portio Line 652  directory for only the accessible portio
652    "Copy page header and its position to the Pages Directory.    "Copy page header and its position to the Pages Directory.
653  Only arg non-nil, count lines in page and insert before header.  Only arg non-nil, count lines in page and insert before header.
654  Used by `pages-directory' function."  Used by `pages-directory' function."
655      
656    (let (position line-count)    (let (position line-count)
657    
658      (if count-lines-p      (if count-lines-p
# Line 665  Used by `pages-directory' function." Line 665  Used by `pages-directory' function."
665      (if (<= (point) pages-buffer-original-position)      (if (<= (point) pages-buffer-original-position)
666          (setq pages-buffer-original-page          (setq pages-buffer-original-page
667                (1+ pages-buffer-original-page)))                (1+ pages-buffer-original-page)))
668        
669      (save-excursion      (save-excursion
670        ;; go to first non-blank char after the page-delimiter        ;; go to first non-blank char after the page-delimiter
671        (skip-chars-forward " \t\n")            (skip-chars-forward " \t\n")
672        ;; set the marker here; this the place to which the        ;; set the marker here; this the place to which the
673        ;; `pages-directory-goto' command will go        ;; `pages-directory-goto' command will go
674        (setq position (make-marker))        (setq position (make-marker))
675        (set-marker position (point))        (set-marker position (point))
676        (let ((start (point))        (let ((start (point))
# Line 678  Used by `pages-directory' function." Line 678  Used by `pages-directory' function."
678              inserted-at)              inserted-at)
679          ;; change to directory buffer          ;; change to directory buffer
680          (set-buffer standard-output)          (set-buffer standard-output)
681          ;; record page position          ;; record page position
682          (setq pages-pos-list (cons position pages-pos-list))          (setq pages-pos-list (cons position pages-pos-list))
683          ;; insert page header          ;; insert page header
684          (setq inserted-at (point))          (setq inserted-at (point))
685          (insert-buffer-substring pages-target-buffer start end)          (insert-buffer-substring pages-target-buffer start end)
686          (add-text-properties inserted-at (point)          (add-text-properties inserted-at (point)
687                               '(mouse-face highlight                               '(mouse-face highlight
688                                 help-echo "mouse-2: go to this page"))                                 help-echo "mouse-2: go to this page"))
689          (put-text-property inserted-at (point) 'rear-nonsticky 'highlight))          (put-text-property inserted-at (point) 'rear-nonsticky 'highlight))
690          
691        (if count-lines-p        (if count-lines-p
692            (save-excursion            (save-excursion
693              (beginning-of-line)              (beginning-of-line)
694              (insert (format "%3d: " line-count))))              (insert (format "%3d: " line-count))))
695          
696        (terpri))        (terpri))
697      (end-of-line 1)))      (end-of-line 1)))
698    
# Line 727  to the same line in the pages buffer." Line 727  to the same line in the pages buffer."
727           (pos (nth pages-number pages-pos-list))           (pos (nth pages-number pages-pos-list))
728           (end-of-directory-p (eobp))           (end-of-directory-p (eobp))
729           (narrowing-p  pages-directory-buffer-narrowing-p))           (narrowing-p  pages-directory-buffer-narrowing-p))
730      (pop-to-buffer pages-buffer)        (pop-to-buffer pages-buffer)
731      (widen)      (widen)
732      (if end-of-directory-p      (if end-of-directory-p
733          (goto-char (point-max))          (goto-char (point-max))
# Line 759  If    pages-directory-for-addresses-goto Line 759  If    pages-directory-for-addresses-goto
759  `pages-directory-goto' narrows addresses buffer to entry.  `pages-directory-goto' narrows addresses buffer to entry.
760    
761  If    pages-directory-for-addresses-buffer-keep-windows-p     is nil,  If    pages-directory-for-addresses-buffer-keep-windows-p     is nil,
762  this command deletes other windows when it displays the addresses  this command deletes other windows when it displays the addresses
763  directory."  directory."
764    
765    (interactive    (interactive

Legend:
Removed from v.1.25  
changed lines
  Added in v.1.26

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26