/[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.23 by monnier, Sat Oct 13 19:19:01 2001 UTC revision 1.23.4.1 by miles, Fri Apr 4 06:20:37 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 473  contain matches to the regexp.\)") Line 473  contain matches to the regexp.\)")
473  (defvar pages-pos-list nil  (defvar pages-pos-list nil
474    "List containing the positions of the pages in the pages-buffer.")    "List containing the positions of the pages in the pages-buffer.")
475    
476  (defvar pages-directory-map nil  (defvar pages-target-buffer)
   "Keymap for the pages-directory-buffer.")  
477    
478  (if pages-directory-map  (defvar pages-directory-mode-map
479      ()    (let ((map (make-sparse-keymap)))
480    (setq pages-directory-map (make-sparse-keymap))      (define-key map "\C-c\C-c" 'pages-directory-goto)
481    (define-key pages-directory-map "\C-c\C-c"      (define-key map "\C-c\C-p\C-a" 'add-new-page)
482      'pages-directory-goto)      (define-key map [mouse-2] 'pages-directory-goto-with-mouse)
483    (define-key pages-directory-map "\C-c\C-p\C-a" 'add-new-page)      map)
484    (define-key pages-directory-map [mouse-2] 'pages-directory-goto-with-mouse))    "Keymap for the pages-directory-buffer.")
485    (defvaralias 'pages-directory-map 'pages-directory-mode-map)
486    
487  (defvar original-page-delimiter "^\f"  (defvar original-page-delimiter "^\f"
488    "Default page delimiter.")    "Default page delimiter.")
# Line 494  its original value. Line 494  its original value.
494    
495  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
496  resets the page-delimiter to the original value."  resets the page-delimiter to the original value."
497      
498    (interactive    (interactive
499     (if current-prefix-arg     (if current-prefix-arg
500         (list original-page-delimiter "^\f")         (list original-page-delimiter "^\f")
# Line 542  arg is nil, optional third arg is regula Line 542  arg is nil, optional third arg is regula
542    
543  If the buffer is narrowed, the `pages-directory' command creates a  If the buffer is narrowed, the `pages-directory' command creates a
544  directory for only the accessible portion of the buffer."  directory for only the accessible portion of the buffer."
545      
546    (interactive    (interactive
547     (cond ((not current-prefix-arg)     (cond ((not current-prefix-arg)
548            (list t nil nil))            (list t nil nil))
549           ((listp current-prefix-arg)           ((listp current-prefix-arg)
550            (list nil            (list nil
551                  nil                  nil
552                  (read-string                  (read-string
# Line 554  directory for only the accessible portio Line 554  directory for only the accessible portio
554                           (or pages-directory-previous-regexp "regexp")))))                           (or pages-directory-previous-regexp "regexp")))))
555           ((> (prefix-numeric-value current-prefix-arg) 0)           ((> (prefix-numeric-value current-prefix-arg) 0)
556            (list t t nil))            (list t t nil))
557           ((< (prefix-numeric-value current-prefix-arg) 0)                     ((< (prefix-numeric-value current-prefix-arg) 0)
558            (list nil            (list nil
559                  t                  t
560                  (read-string                  (read-string
561                   (format "Select according to `%s' (end with RET): "                   (format "Select according to `%s' (end with RET): "
562                           (or pages-directory-previous-regexp "regexp")))))))                           (or pages-directory-previous-regexp "regexp")))))))
563      
564    (if (equal regexp "")    (if (equal regexp "")
565        (setq regexp pages-directory-previous-regexp)        (setq regexp pages-directory-previous-regexp)
566      (setq pages-directory-previous-regexp regexp))      (setq pages-directory-previous-regexp regexp))
567      
568    (if (interactive-p)    (if (interactive-p)
569        (message "Creating directory for: %s "        (message "Creating directory for: %s "
570                 (buffer-name)))                 (buffer-name)))
571      
572    (let ((target-buffer (current-buffer))    (let ((pages-target-buffer (current-buffer))
573          (pages-directory-buffer          (pages-directory-buffer
574           (concat pages-directory-prefix " " (buffer-name)))           (concat pages-directory-prefix " " (buffer-name)))
575          (linenum 1)          (linenum 1)
576          (pages-buffer-original-position (point))          (pages-buffer-original-position (point))
577          (pages-buffer-original-page 0))          (pages-buffer-original-page 0))
578        
579      ;; `with-output-to-temp-buffer' binds the value of the variable      ;; `with-output-to-temp-buffer' binds the value of the variable
580      ;; `standard-output' to the buffer named as its first argument,      ;; `standard-output' to the buffer named as its first argument,
581      ;; but does not switch to that buffer.      ;; but does not switch to that buffer.
# Line 585  directory for only the accessible portio Line 585  directory for only the accessible portio
585          (pages-directory-mode)          (pages-directory-mode)
586          (insert          (insert
587           "==== 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)
588          (setq pages-buffer target-buffer)          (setq pages-buffer pages-target-buffer)
589          (setq pages-pos-list nil))          (setq pages-pos-list nil))
590          
591        (if pages-list-all-headers-p        (if pages-list-all-headers-p
592              
593            ;; 1. If no prefix argument, list all headers            ;; 1. If no prefix argument, list all headers
594            (save-excursion            (save-excursion
595              (goto-char (point-min))              (goto-char (point-min))
596                
597              ;; (a) Point is at beginning of buffer; but the first              ;; (a) Point is at beginning of buffer; but the first
598              ;;     page may not begin with a page-delimiter              ;;     page may not begin with a page-delimiter
599              (save-restriction              (save-restriction
# Line 604  directory for only the accessible portio Line 604  directory for only the accessible portio
604                    (goto-char (match-end 0)))                    (goto-char (match-end 0)))
605                (narrow-to-page)                (narrow-to-page)
606                (pages-copy-header-and-position count-lines-p))                (pages-copy-header-and-position count-lines-p))
607                
608              ;; (b) Search within pages buffer for next page-delimiter              ;; (b) Search within pages buffer for next page-delimiter
609              (while (re-search-forward page-delimiter nil t)              (while (re-search-forward page-delimiter nil t)
610                (pages-copy-header-and-position count-lines-p)))                (pages-copy-header-and-position count-lines-p)))
611            
612          ;; 2. Else list headers whose pages match regexp.          ;; 2. Else list headers whose pages match regexp.
613          (save-excursion          (save-excursion
614            ;; REMOVED  save-restriction  AND  widen  FROM HERE            ;; REMOVED  save-restriction  AND  widen  FROM HERE
615            (goto-char (point-min))            (goto-char (point-min))
616              
617            ;; (a) Handle first page            ;; (a) Handle first page
618            (save-restriction            (save-restriction
619              (narrow-to-page)              (narrow-to-page)
620              ;; search for selection regexp              ;; search for selection regexp
621              (if (save-excursion (re-search-forward regexp nil t))              (if (save-excursion (re-search-forward regexp nil t))
622                  (pages-copy-header-and-position count-lines-p)))                  (pages-copy-header-and-position count-lines-p)))
623              
624            ;; (b) Search for next page-delimiter            ;; (b) Search for next page-delimiter
625            (while (re-search-forward page-delimiter nil t)            (while (re-search-forward page-delimiter nil t)
626              (save-restriction              (save-restriction
# Line 629  directory for only the accessible portio Line 629  directory for only the accessible portio
629                (if (save-excursion (re-search-forward regexp nil t))                (if (save-excursion (re-search-forward regexp nil t))
630                    (pages-copy-header-and-position count-lines-p)                    (pages-copy-header-and-position count-lines-p)
631                  )))))                  )))))
632          
633        (set-buffer standard-output)        (set-buffer standard-output)
634        ;; Put positions in increasing order to go with buffer.        ;; Put positions in increasing order to go with buffer.
635        (setq pages-pos-list (nreverse pages-pos-list))        (setq pages-pos-list (nreverse pages-pos-list))
636        (if (interactive-p)        (if (interactive-p)
637            (message "%d matching lines in: %s"            (message "%d matching lines in: %s"
638                     (length pages-pos-list) (buffer-name target-buffer))))                     (length pages-pos-list) (buffer-name pages-target-buffer))))
639      (pop-to-buffer pages-directory-buffer)      (pop-to-buffer pages-directory-buffer)
640      (sit-for 0)  ; otherwise forward-line fails if N > window height.      (sit-for 0)  ; otherwise forward-line fails if N > window height.
641      (forward-line (if (= 0 pages-buffer-original-page)      (forward-line (if (= 0 pages-buffer-original-page)
# Line 650  directory for only the accessible portio Line 650  directory for only the accessible portio
650    "Copy page header and its position to the Pages Directory.    "Copy page header and its position to the Pages Directory.
651  Only arg non-nil, count lines in page and insert before header.  Only arg non-nil, count lines in page and insert before header.
652  Used by `pages-directory' function."  Used by `pages-directory' function."
653      
654    (let (position line-count)    (let (position line-count)
655    
656      (if count-lines-p      (if count-lines-p
# Line 663  Used by `pages-directory' function." Line 663  Used by `pages-directory' function."
663      (if (<= (point) pages-buffer-original-position)      (if (<= (point) pages-buffer-original-position)
664          (setq pages-buffer-original-page          (setq pages-buffer-original-page
665                (1+ pages-buffer-original-page)))                (1+ pages-buffer-original-page)))
666        
667      (save-excursion      (save-excursion
668        ;; go to first non-blank char after the page-delimiter        ;; go to first non-blank char after the page-delimiter
669        (skip-chars-forward " \t\n")            (skip-chars-forward " \t\n")
670        ;; set the marker here; this the place to which the        ;; set the marker here; this the place to which the
671        ;; `pages-directory-goto' command will go        ;; `pages-directory-goto' command will go
672        (setq position (make-marker))        (setq position (make-marker))
673        (set-marker position (point))        (set-marker position (point))
674        (let ((start (point))        (let ((start (point))
# Line 676  Used by `pages-directory' function." Line 676  Used by `pages-directory' function."
676              inserted-at)              inserted-at)
677          ;; change to directory buffer          ;; change to directory buffer
678          (set-buffer standard-output)          (set-buffer standard-output)
679          ;; record page position          ;; record page position
680          (setq pages-pos-list (cons position pages-pos-list))          (setq pages-pos-list (cons position pages-pos-list))
681          ;; insert page header          ;; insert page header
682          (setq inserted-at (point))          (setq inserted-at (point))
683          (insert-buffer-substring target-buffer start end)          (insert-buffer-substring pages-target-buffer start end)
684          (add-text-properties inserted-at (point)          (add-text-properties inserted-at (point)
685                               '(mouse-face highlight                               '(mouse-face highlight
686                                 help-echo "mouse-2: go to this page"))                                 help-echo "mouse-2: go to this page"))
687          (put-text-property inserted-at (point) 'rear-nonsticky 'highlight))          (put-text-property inserted-at (point) 'rear-nonsticky 'highlight))
688          
689        (if count-lines-p        (if count-lines-p
690            (save-excursion            (save-excursion
691              (beginning-of-line)              (beginning-of-line)
692              (insert (format "%3d: " line-count))))              (insert (format "%3d: " line-count))))
693          
694        (terpri))        (terpri))
695      (end-of-line 1)))      (end-of-line 1)))
696    
697  (define-derived-mode pages-directory-mode nil "Pages-Directory"  (defun pages-directory-mode ()
698    "Mode for handling the pages-directory buffer.    "Mode for handling the pages-directory buffer.
699    
700  Move point to one of the lines in this buffer, then use \\[pages-directory-goto] to go  Move point to one of the lines in this buffer, then use \\[pages-directory-goto] to go
701  to the same line in the pages buffer."  to the same line in the pages buffer."
702    
703      (kill-all-local-variables)
704      (use-local-map pages-directory-mode-map)
705      (setq major-mode 'pages-directory-mode)
706      (setq mode-name "Pages-Directory")
707    (make-local-variable 'pages-buffer)    (make-local-variable 'pages-buffer)
708    (make-local-variable 'pages-pos-list)    (make-local-variable 'pages-pos-list)
709    (make-local-variable 'pages-directory-buffer-narrowing-p))    (make-local-variable 'pages-directory-buffer-narrowing-p)
710      (run-mode-hooks 'pages-directory-mode-hook))
711    
712  (defun pages-directory-goto ()  (defun pages-directory-goto ()
713    "Go to the corresponding line in the pages buffer."    "Go to the corresponding line in the pages buffer."
# Line 720  to the same line in the pages buffer." Line 726  to the same line in the pages buffer."
726           (pos (nth pages-number pages-pos-list))           (pos (nth pages-number pages-pos-list))
727           (end-of-directory-p (eobp))           (end-of-directory-p (eobp))
728           (narrowing-p  pages-directory-buffer-narrowing-p))           (narrowing-p  pages-directory-buffer-narrowing-p))
729      (pop-to-buffer pages-buffer)        (pop-to-buffer pages-buffer)
730      (widen)      (widen)
731      (if end-of-directory-p      (if end-of-directory-p
732          (goto-char (point-max))          (goto-char (point-max))
# Line 752  If    pages-directory-for-addresses-goto Line 758  If    pages-directory-for-addresses-goto
758  `pages-directory-goto' narrows addresses buffer to entry.  `pages-directory-goto' narrows addresses buffer to entry.
759    
760  If    pages-directory-for-addresses-buffer-keep-windows-p     is nil,  If    pages-directory-for-addresses-buffer-keep-windows-p     is nil,
761  this command deletes other windows when it displays the addresses  this command deletes other windows when it displays the addresses
762  directory."  directory."
763    
764    (interactive    (interactive
# Line 784  directory." Line 790  directory."
790            ))            ))
791      (error "No addresses file found!")))      (error "No addresses file found!")))
792    
793  (defun pages-directory-address-mode ()  (define-derived-mode pages-directory-address-mode pages-directory-mode
794      "Addresses Directory"
795    "Mode for handling the Addresses Directory buffer.    "Mode for handling the Addresses Directory buffer.
796    
797  Move point to one of the lines in this buffer,  Move point to one of the lines in this buffer,
798  then use \\[pages-directory-goto] to go  then use \\[pages-directory-goto] to go
799  to the same line in the pages buffer."  to the same line in the pages buffer."
800      :syntax-table nil)
801    
   (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))  
   
   
 ;;; Place `provide' at end of file.  
802  (provide 'page-ext)  (provide 'page-ext)
   
803  ;;; page-ext.el ends here  ;;; page-ext.el ends here

Legend:
Removed from v.1.23  
changed lines
  Added in v.1.23.4.1

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