kjones@UUNET.UU.NET (Kyle Jones) (09/08/89)
This package provides no muss, no fuss word wrapping and filling of
paragraphs with hanging indents, included text from news and mail
messages, and Lisp, C++, PostScript or shell comments. It is table
driven, so you can add your own favorites.
The functions do-auto-fill and fill-paragraph are replaced when the file
is loaded, so you don't need to rebind any keys. Installation
instructions are in the Lisp comments at the top of the file.
-------------------
;;; Adaptive fill
;;; Copyright (C) 1989 Kyle E. Jones
;;;
;;; This program is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 1, or (at your option)
;;; any later version.
;;;
;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; A copy of the GNU General Public License can be obtained from this
;;; program's author (send electronic mail to kyle@cs.odu.edu) or from
;;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA
;;; 02139, USA.
;;;
;;; Send bug reports to kyle@cs.odu.edu.
;; These functions enhance the default behavior of the Emacs'
;; auto-fill-mode and the command fill-paragraph. The chief improvement
;; is that the beginning of a line to be filled is examined and
;; appropriate values for fill-prefix, and the various paragraph-*
;; variables are constructed and used during fills. This occurs only if
;; the fill prefix is not already non-nil.
;;
;; The net result of this is that blurbs of text that are offset from
;; left margin by asterisks, dashes, and/or spaces, numbered examples,
;; included text from USENET news articles, etc. are generally filled
;; correctly with no fuss.
;;
;; Since this package replaces two existing Emacs functions, it cannot
;; be autoloaded. Save this in a file named filladapt.el in a Lisp
;; directory that Emacs knows about, byte-compile it and put
;; (require 'filladapt)
;; in your .emacs file.
(provide 'filladapt)
(defvar filladapt-prefix-table
'(
;; Included text in news or mail replies
("[ \t]*\\(>+ *\\)+" . filladapt-normal-included-text)
;; Included text generated by SUPERCITE. We can't hope to match all
;; the possible variations, your mileage may vary.
("[^'`\"< \t]*> *" . filladapt-supercite-included-text)
;; Lisp comments
("[ \t]*\\(;+[ \t]*\\)+" . filladapt-lisp-comment)
;; UNIX shell comments
("[ \t]*\\(#+[ \t]*\\)+" . filladapt-sh-comment)
;; Postscript comments
("[ \t]*\\(%+[ \t]*\\)+" . filladapt-postscript-comment)
;; C++ comments
("[ \t]*//[/ \t]*" . filladapt-c++-comment)
;; Lists with hanging indents, e.g.
;; 1. xxxxx or * xxxxx etc.
;; xxxxx xxx
(" *(?\\([0-9]+[a-z]?\\|[a-z]\\)) +" . filladapt-hanging-list)
(" *\\([0-9]+[a-z]?\\|[a-z]\\)\\. +" . filladapt-hanging-list)
("[?!~*+--- ]+ " . filladapt-hanging-list)
;; This keeps normal paragraphs from interacting unpleasantly with
;; the types given above.
("[^ \t/#%?!~*+---]" . filladapt-normal)
)
"Value is an alist of the form
((REGXP . FUNCTION) ...)
When fill-paragraph or do-auto-fill is called, the REGEXP of each alist
element is compared with the beginning of the current line. If a match
is found the crorrespoding FUNCTION is called. FUNCTION is called with
one argument, which is non-nil when invoked on the behalf of
fill-paragraph, nil for do-auto-fill. It is the job of FUNCTION to set
the values of the paragraph-* variables (or set a clipping region, if
paragraph-start and paragraph-separate cannot be made discerning enough)
so that fill-paragraph and do-auto-fill work correctly in various
contexts.")
(defvar filladapt-function-table
(list (cons 'fill-paragraph (symbol-function 'fill-paragraph))
(cons 'do-auto-fill (symbol-function 'do-auto-fill)))
"Table containing the old function definitions that filladapt usurps.")
(defun filladapt-funcall (function &rest args)
(apply (cdr (assoc function filladapt-function-table)) args))
(defun filladapt-adapt (paragraph)
(let ((table filladapt-prefix-table)
case-fold-search
success )
(save-excursion
(beginning-of-line)
(while table
(if (not (looking-at (car (car table))))
(setq table (cdr table))
(funcall (cdr (car table)) paragraph)
(setq success t table nil))))
success ))
(defun filladapt-negate-string (string)
(let ((len (length string))
(i 0) string-list)
(setq string-list (cons "\\(" nil))
(while (< i len)
(setq string-list
(cons (if (= i (1- len)) "" "\\|")
(cons "]"
(cons (let ((str (substring string i (1+ i))))
(cond ((equal str "-") "---")
(t str)))
(cons "[^"
(cons (regexp-quote (substring string 0 i))
string-list)))))
i (1+ i)))
(setq string-list (cons "\\)" string-list))
(apply 'concat (nreverse string-list))))
(defun filladapt-normal-included-text (paragraph)
(setq fill-prefix (buffer-substring (match-beginning 0) (match-end 0)))
(if paragraph
(setq paragraph-separate
(concat "^" fill-prefix " *>\\|^"
(filladapt-negate-string fill-prefix)))))
(defun filladapt-supercite-included-text (paragraph)
(setq fill-prefix (buffer-substring (match-beginning 0) (match-end 0)))
(if paragraph
(setq paragraph-separate
(concat "^" (filladapt-negate-string fill-prefix)))))
(defun filladapt-lisp-comment (paragraph)
(setq fill-prefix (buffer-substring (match-beginning 0) (match-end 0)))
(if paragraph
(setq paragraph-separate
(concat "^" fill-prefix " *;\\|^"
(filladapt-negate-string fill-prefix)))))
(defun filladapt-postscript-comment (paragraph)
(setq fill-prefix (buffer-substring (match-beginning 0) (match-end 0)))
(if paragraph
(setq paragraph-separate
(concat "^" fill-prefix " *%\\|^"
(filladapt-negate-string fill-prefix)))))
(defun filladapt-sh-comment (paragraph)
(setq fill-prefix (buffer-substring (match-beginning 0) (match-end 0)))
(if paragraph
(setq paragraph-separate
(concat "^" fill-prefix " *#\\|^"
(filladapt-negate-string fill-prefix)))))
(defun filladapt-c++-comment (paragraph)
(setq fill-prefix (buffer-substring (match-beginning 0) (match-end 0)))
(if paragraph
(setq paragraph-separate "^[^ \t/]")))
(defun filladapt-hanging-list (paragraph)
(let (prefix match beg end)
(setq prefix (make-string (- (match-end 0) (match-beginning 0)) ?\ ))
(if paragraph
(progn
(setq match (buffer-substring (match-beginning 0) (match-end 0)))
(if (string-match "^ +$" match)
(save-excursion
(while (and (not (bobp)) (looking-at prefix))
(forward-line -1))
(cond ((or (looking-at " *(?\\([0-9]+[a-z]?\\|[a-z]\\)) +")
(looking-at " *\\([0-9]+[a-z]?\\|[a-z]\\)\\. +")
(looking-at " *[?!~*+---]+ +"))
(setq beg (point)))
(t (setq beg (progn (forward-line 1) (point))))))
(setq beg (point)))
(save-excursion
(forward-line)
(while (and (looking-at prefix)
(not (equal (char-after (match-end 0)) ?\ )))
(forward-line))
(setq end (point)))
(narrow-to-region beg end)))
(setq fill-prefix prefix)))
(defun filladapt-normal (paragraph)
(if paragraph
(setq paragraph-separate
(concat paragraph-separate "\\|^[ \t/#%?!~*+---]"))))
(defun do-auto-fill ()
(save-restriction
(if (null fill-prefix)
(let (fill-prefix)
(filladapt-adapt nil)
(filladapt-funcall 'do-auto-fill))
(filladapt-funcall 'do-auto-fill))))
(defun fill-paragraph (arg)
(interactive "P")
(save-restriction
(catch 'done
(if (null fill-prefix)
(let (paragraph-ignore-fill-prefix
fill-prefix
(paragraph-start paragraph-start)
(paragraph-separate paragraph-separate))
(if (filladapt-adapt t)
(throw 'done (filladapt-funcall 'fill-paragraph arg)))))
;; filladapt-adapt failed, so do fill-paragraph normally.
(filladapt-funcall 'fill-paragraph arg))))