home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / packages / filladapt.el < prev    next >
Encoding:
Text File  |  1990-07-22  |  8.3 KB  |  228 lines
  1. ;From: talos!kjones@UUNET.UU.NET (Kyle Jones)
  2. ;Newsgroups: gnu.emacs
  3. ;Subject: adaptive fill commands
  4. ;Message-ID: <8909071813.AA16227@talos.uucp>
  5. ;Date: 7 Sep 89 18:13:47 GMT
  6. ;Reply-To: kjones%talos.uucp@uunet.uu.net
  7. ;Distribution: gnu
  8. ;Organization: GNUs Not Usenet
  9. ;Lines: 217
  10. ;
  11. ;This package provides no muss, no fuss word wrapping and filling of
  12. ;paragraphs with hanging indents, included text from news and mail
  13. ;messages, and Lisp, C++, PostScript or shell comments.  It is table
  14. ;driven, so you can add your own favorites.
  15. ;
  16. ;The functions do-auto-fill and fill-paragraph are replaced when the file
  17. ;is loaded, so you don't need to rebind any keys.  Installation
  18. ;instructions are in the Lisp comments at the top of the file.
  19. ;-------------------
  20. ;;; Adaptive fill
  21. ;;; Copyright (C) 1989 Kyle E. Jones
  22. ;;;
  23. ;;; This program is free software; you can redistribute it and/or modify
  24. ;;; it under the terms of the GNU General Public License as published by
  25. ;;; the Free Software Foundation; either version 1, or (at your option)
  26. ;;; any later version.
  27. ;;;
  28. ;;; This program is distributed in the hope that it will be useful,
  29. ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  30. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  31. ;;; GNU General Public License for more details.
  32. ;;;
  33. ;;; A copy of the GNU General Public License can be obtained from this
  34. ;;; program's author (send electronic mail to kyle@cs.odu.edu) or from
  35. ;;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA
  36. ;;; 02139, USA.
  37. ;;;
  38. ;;; Send bug reports to kyle@cs.odu.edu.
  39.  
  40. ;; These functions enhance the default behavior of the Emacs'
  41. ;; auto-fill-mode and the command fill-paragraph.  The chief improvement
  42. ;; is that the beginning of a line to be filled is examined and
  43. ;; appropriate values for fill-prefix, and the various paragraph-*
  44. ;; variables are constructed and used during fills.  This occurs only if
  45. ;; the fill prefix is not already non-nil.
  46. ;;
  47. ;; The net result of this is that blurbs of text that are offset from
  48. ;; left margin by asterisks, dashes, and/or spaces, numbered examples,
  49. ;; included text from USENET news articles, etc. are generally filled
  50. ;; correctly with no fuss.
  51. ;;
  52. ;; Since this package replaces two existing Emacs functions, it cannot
  53. ;; be autoloaded.  Save this in a file named filladapt.el in a Lisp
  54. ;; directory that Emacs knows about, byte-compile it and put
  55. ;;    (require 'filladapt)
  56. ;; in your .emacs file.
  57.  
  58. (provide 'filladapt)
  59.  
  60. (defvar filladapt-prefix-table
  61.   '(
  62.     ;; Included text in news or mail replies
  63.     ("[ \t]*\\(>+ *\\)+" . filladapt-normal-included-text)
  64.     ;; Included text generated by SUPERCITE.  We can't hope to match all
  65.     ;; the possible variations, your mileage may vary.
  66.     ("[^'`\"< \t]*> *" . filladapt-supercite-included-text)
  67.     ;; Lisp comments
  68.     ("[ \t]*\\(;+[ \t]*\\)+" . filladapt-lisp-comment)
  69.     ;; UNIX shell comments
  70.     ("[ \t]*\\(#+[ \t]*\\)+" . filladapt-sh-comment)
  71.     ;; Postscript comments
  72.     ("[ \t]*\\(%+[ \t]*\\)+" . filladapt-postscript-comment)
  73.     ;; C++ comments
  74.     ("[ \t]*//[/ \t]*" . filladapt-c++-comment)
  75.     ;; Lists with hanging indents, e.g.
  76.     ;; 1. xxxxx   or   *   xxxxx   etc.
  77.     ;;    xxxxx            xxx
  78.     (" *(?\\([0-9]+[a-z]?\\|[a-z]\\)) +" . filladapt-hanging-list)
  79.     (" *\\([0-9]+[a-z]?\\|[a-z]\\)\\. +" . filladapt-hanging-list)
  80.     ("[?!~*+--- ]+ " . filladapt-hanging-list)
  81.     ;; This keeps normal paragraphs from interacting unpleasantly with
  82.     ;; the types given above.
  83.     ("[^ \t/#%?!~*+---]" . filladapt-normal)
  84.     )
  85. "Value is an alist of the form
  86.  
  87.    ((REGXP . FUNCTION) ...)
  88.  
  89. When fill-paragraph or do-auto-fill is called, the REGEXP of each alist
  90. element is compared with the beginning of the current line.  If a match
  91. is found the crorrespoding FUNCTION is called.  FUNCTION is called with
  92. one argument, which is non-nil when invoked on the behalf of
  93. fill-paragraph, nil for do-auto-fill.  It is the job of FUNCTION to set
  94. the values of the paragraph-* variables (or set a clipping region, if
  95. paragraph-start and paragraph-separate cannot be made discerning enough)
  96. so that fill-paragraph and do-auto-fill work correctly in various
  97. contexts.")
  98.  
  99. (defvar filladapt-function-table
  100.   (list (cons 'fill-paragraph (symbol-function 'fill-paragraph))
  101.     (cons 'do-auto-fill (symbol-function 'do-auto-fill)))
  102.   "Table containing the old function definitions that filladapt usurps.")
  103.  
  104. (defun filladapt-funcall (function &rest args)
  105.   (apply (cdr (assoc function filladapt-function-table)) args))
  106.  
  107. (defun filladapt-adapt (paragraph)
  108.   (let ((table filladapt-prefix-table)
  109.     case-fold-search
  110.     success )
  111.     (save-excursion
  112.       (beginning-of-line)
  113.       (while table
  114.     (if (not (looking-at (car (car table))))
  115.         (setq table (cdr table))
  116.       (funcall (cdr (car table)) paragraph)
  117.       (setq success t table nil))))
  118.     success ))
  119.  
  120. (defun filladapt-negate-string (string)
  121.   (let ((len (length string))
  122.     (i 0) string-list)
  123.     (setq string-list (cons "\\(" nil))
  124.     (while (< i len)
  125.       (setq string-list
  126.         (cons (if (= i (1- len)) "" "\\|")
  127.           (cons "]"
  128.             (cons (let ((str (substring string i (1+ i))))
  129.                 (cond ((equal str "-") "---")
  130.                       (t str)))
  131.                   (cons "[^"
  132.                     (cons (regexp-quote (substring string 0 i))
  133.                       string-list)))))
  134.         i (1+ i)))
  135.     (setq string-list (cons "\\)" string-list))
  136.     (apply 'concat (nreverse string-list))))
  137.  
  138. (defun filladapt-normal-included-text (paragraph)
  139.   (setq fill-prefix (buffer-substring (match-beginning 0) (match-end 0)))
  140.   (if paragraph
  141.       (setq paragraph-separate
  142.         (concat "^" fill-prefix " *>\\|^"
  143.             (filladapt-negate-string fill-prefix)))))
  144.  
  145. (defun filladapt-supercite-included-text (paragraph)
  146.   (setq fill-prefix (buffer-substring (match-beginning 0) (match-end 0)))
  147.   (if paragraph
  148.       (setq paragraph-separate
  149.         (concat "^" (filladapt-negate-string fill-prefix)))))
  150.  
  151. (defun filladapt-lisp-comment (paragraph)
  152.   (setq fill-prefix (buffer-substring (match-beginning 0) (match-end 0)))
  153.   (if paragraph
  154.       (setq paragraph-separate
  155.         (concat "^" fill-prefix " *;\\|^"
  156.             (filladapt-negate-string fill-prefix)))))
  157.  
  158. (defun filladapt-postscript-comment (paragraph)
  159.   (setq fill-prefix (buffer-substring (match-beginning 0) (match-end 0)))
  160.   (if paragraph
  161.       (setq paragraph-separate
  162.         (concat "^" fill-prefix " *%\\|^"
  163.             (filladapt-negate-string fill-prefix)))))
  164.  
  165. (defun filladapt-sh-comment (paragraph)
  166.   (setq fill-prefix (buffer-substring (match-beginning 0) (match-end 0)))
  167.   (if paragraph
  168.       (setq paragraph-separate
  169.         (concat "^" fill-prefix " *#\\|^"
  170.             (filladapt-negate-string fill-prefix)))))
  171.  
  172. (defun filladapt-c++-comment (paragraph)
  173.   (setq fill-prefix (buffer-substring (match-beginning 0) (match-end 0)))
  174.   (if paragraph
  175.       (setq paragraph-separate "^[^ \t/]")))
  176.  
  177. (defun filladapt-hanging-list (paragraph)
  178.   (let (prefix match beg end)
  179.     (setq prefix (make-string (- (match-end 0) (match-beginning 0)) ?\ ))
  180.     (if paragraph
  181.     (progn
  182.       (setq match (buffer-substring (match-beginning 0) (match-end 0)))
  183.       (if (string-match "^ +$" match)
  184.           (save-excursion
  185.         (while (and (not (bobp)) (looking-at prefix))
  186.           (forward-line -1))
  187.         (cond ((or (looking-at " *(?\\([0-9]+[a-z]?\\|[a-z]\\)) +")
  188.                (looking-at " *\\([0-9]+[a-z]?\\|[a-z]\\)\\. +")
  189.                (looking-at " *[?!~*+---]+ +"))
  190.                (setq beg (point)))
  191.               (t (setq beg (progn (forward-line 1) (point))))))
  192.         (setq beg (point)))
  193.       (save-excursion
  194.         (forward-line)
  195.         (while (and (looking-at prefix)
  196.             (not (equal (char-after (match-end 0)) ?\ )))
  197.           (forward-line))
  198.         (setq end (point)))
  199.       (narrow-to-region beg end)))
  200.     (setq fill-prefix prefix)))
  201.  
  202. (defun filladapt-normal (paragraph)
  203.   (if paragraph
  204.       (setq paragraph-separate
  205.         (concat paragraph-separate "\\|^[ \t/#%?!~*+---]"))))
  206.  
  207. (defun do-auto-fill ()
  208.   (save-restriction
  209.     (if (null fill-prefix)
  210.     (let (fill-prefix)
  211.       (filladapt-adapt nil)
  212.       (filladapt-funcall 'do-auto-fill))
  213.       (filladapt-funcall 'do-auto-fill))))
  214.  
  215. (defun fill-paragraph (arg)
  216.   (interactive "P")
  217.   (save-restriction
  218.     (catch 'done
  219.       (if (null fill-prefix)
  220.       (let (paragraph-ignore-fill-prefix
  221.         fill-prefix
  222.         (paragraph-start paragraph-start)
  223.         (paragraph-separate paragraph-separate))
  224.         (if (filladapt-adapt t)
  225.         (throw 'done (filladapt-funcall 'fill-paragraph arg)))))
  226.       ;; filladapt-adapt failed, so do fill-paragraph normally.
  227.       (filladapt-funcall 'fill-paragraph arg))))
  228.