--- a/lisp/packages/filladapt.el	Mon Aug 13 09:17:27 2007 +0200
+++ b/lisp/packages/filladapt.el	Mon Aug 13 09:18:39 2007 +0200
@@ -1,8 +1,5 @@
-;;; filladapt.el --- adaptive fill; replacement for fill commands
-
-;; Keywords: wp
-
-;;; Copyright (C) 1989, 1995, 1996 Kyle E. Jones
+;;; Adaptive fill
+;;; Copyright (C) 1989, 1995, 1996, 1997 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
@@ -19,18 +16,16 @@
 ;;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA
 ;;; 02139, USA.
 ;;;
-;;; Send bug reports to kyle@wonderworks.com
-
-;;; Synched up with: Not in FSF.
+;;; Send bug reports to kyle_jones@wonderworks.com
 
 ;; LCD Archive Entry: 
 ;; filladapt|Kyle Jones|kyle_jones@wonderworks.com| 
 ;; Minor mode to adaptively set fill-prefix and overload filling functions|
-;; 10-June-1996|2.08|~/packages/filladapt.el| 
+;; 10-June-1996|2.09|~/packages/filladapt.el| 
 
 ;; These functions enhance the default behavior of Emacs' Auto Fill
-;; mode and the commands fill-paragraph, lisp-fill-paragraph and
-;; fill-region-as-paragraph.
+;; mode and the commands fill-paragraph, lisp-fill-paragraph,
+;; fill-region-as-paragraph and fill-region.
 ;;
 ;; The chief improvement is that the beginning of a line to be
 ;; filled is examined and, based on information gathered, an
@@ -72,9 +67,12 @@
 ;;     filladapt-token-match-table
 ;;     filladapt-token-conversion-table
 
+(and (featurep 'filladapt)
+     (error "filladapt cannot be loaded twice in the same Emacs session."))
+
 (provide 'filladapt)
 
-(defvar filladapt-version "2.08"
+(defvar filladapt-version "2.09"
   "Version string for filladapt.")
 
 (defvar filladapt-mode nil
@@ -86,6 +84,28 @@
   "*String to display in the modeline when Filladapt mode is active.
 Set this to nil if you don't want a modeline indicator for Filladapt.")
 
+(defvar filladapt-fill-column-tolerance nil
+  "*Tolerate filled paragraph lines ending this far from the fill column.
+If any lines other than the last paragraph line end at a column
+less than fill-column - filladapt-fill-column-tolerance, fill-column will
+be adjusted using the filladapt-fill-column-*-fuzz variables and
+the paragraph will be re-filled until the tolerance is achieved
+or filladapt runs out of fuzz values to try.
+
+A nil value means behave normally, that is, don't try refilling
+paragraphs to make filled line lengths fit within any particular
+range.")
+
+(defvar filladapt-fill-column-forward-fuzz 5
+  "*Try values from fill-column to fill-column plus this variable
+when trying to make filled paragraph lines fall with the tolerance
+range specified by filladapt-fill-column-tolerance.")
+
+(defvar filladapt-fill-column-backward-fuzz 5
+  "*Try values from fill-column to fill-column minus this variable
+when trying to make filled paragraph lines fall with the tolerance
+range specified by filladapt-fill-column-tolerance.")
+
 ;; install on minor-mode-alist
 (or (assq 'filladapt-mode minor-mode-alist)
     (setq minor-mode-alist (cons (list 'filladapt-mode
@@ -94,76 +114,82 @@
 
 (defvar filladapt-token-table
   '(
+    ;; this must be first
+    ("^" beginning-of-line)
     ;; Included text in news or mail replies
-    (">+" . citation->)
+    (">+" citation->)
     ;; Included text generated by SUPERCITE.  We can't hope to match all
     ;; the possible variations, your mileage may vary.
-    ("[A-Za-z0-9][^'`\"< \t\n]*>[ \t]*" . supercite-citation)
+    ("[A-Za-z0-9][^'`\"< \t\n]*>[ \t]*" supercite-citation)
     ;; Lisp comments
-    (";+" . lisp-comment)
+    (";+" lisp-comment)
     ;; UNIX shell comments
-    ("#+" . sh-comment)
+    ("#+" sh-comment)
     ;; Postscript comments
-    ("%+" . postscript-comment)
+    ("%+" postscript-comment)
     ;; C++ comments
-    ("///*" . c++-comment)
+    ("///*" c++-comment)
     ;; Texinfo comments
-    ("@c[ \t]" . texinfo-comment)
-    ("@comment[ \t]" . texinfo-comment)
+    ("@c[ \t]" texinfo-comment)
+    ("@comment[ \t]" texinfo-comment)
     ;; Bullet types.
     ;;
+    ;; LaTex \item
+    ;;
+    ("\\\\item[ \t]" bullet)
+    ;;
     ;; 1. xxxxx
     ;;    xxxxx
     ;;
-    ("[0-9]+\\.[ \t]" . bullet)
+    ("[0-9]+\\.[ \t]" bullet)
     ;;
     ;; 2.1.3  xxxxx xx x xx x
     ;;        xxx
     ;;
-    ("[0-9]+\\(\\.[0-9]+\\)+[ \t]" . bullet)
+    ("[0-9]+\\(\\.[0-9]+\\)+[ \t]" bullet)
     ;;
     ;; a. xxxxxx xx
     ;;    xxx xxx
     ;;
-    ("[A-Za-z]\\.[ \t]" . bullet)
+    ("[A-Za-z]\\.[ \t]" bullet)
     ;;
     ;; 1) xxxx x xx x xx   or   (1) xx xx x x xx xx
     ;;    xx xx xxxx                xxx xx x x xx x
     ;;
-    ("(?[0-9]+)[ \t]" . bullet)
+    ("(?[0-9]+)[ \t]" bullet)
     ;;
     ;; a) xxxx x xx x xx   or   (a) xx xx x x xx xx
     ;;    xx xx xxxx                xxx xx x x xx x
     ;;
-    ("(?[A-Za-z])[ \t]" . bullet)
+    ("(?[A-Za-z])[ \t]" bullet)
     ;;
     ;; 2a. xx x xxx x x xxx
     ;;     xxx xx x xx x
     ;;
-    ("[0-9]+[A-Za-z]\\.[ \t]" . bullet)
+    ("[0-9]+[A-Za-z]\\.[ \t]" bullet)
     ;;
     ;; 1a) xxxx x xx x xx   or   (1a) xx xx x x xx xx
     ;;     xx xx xxxx                 xxx xx x x xx x
     ;;
-    ("(?[0-9]+[A-Za-z])[ \t]" . bullet)
+    ("(?[0-9]+[A-Za-z])[ \t]" bullet)
     ;;
     ;; -  xx xxx xxxx   or   *  xx xx x xxx xxx
     ;;    xxx xx xx             x xxx x xx x x x
     ;;
-    ("[-~*+]+[ \t]" . bullet)
+    ("[-~*+]+[ \t]" bullet)
     ;;
     ;; o  xx xxx xxxx xx x xx xxx x xxx xx x xxx
     ;;    xxx xx xx 
     ;;
-    ("o[ \t]" . bullet)
+    ("o[ \t]" bullet)
     ;; don't touch
-    ("[ \t]+" . space)
-    ("$" . end-of-line)
+    ("[ \t]+" space)
+    ("$" end-of-line)
    )
   "Table of tokens filladapt knows about.
 Format is
 
-   ((REGEXP . SYM) ...)
+   ((REGEXP SYM) ...)
 
 filladapt uses this table to build a tokenized representation of
 the beginning of the current line.  Each REGEXP is matched
@@ -199,6 +225,7 @@
     (texinfo-comment texinfo-comment)
     (bullet)
     (space bullet space)
+    (beginning-of-line beginning-of-line)
    )
   "Table describing what tokens a certain token will match.
 
@@ -261,6 +288,7 @@
 (defvar filladapt-function-table
   (let ((assoc-list
 	 (list (cons 'fill-paragraph (symbol-function 'fill-paragraph))
+	       (cons 'fill-region (symbol-function 'fill-region))
 	       (cons 'fill-region-as-paragraph
 		     (symbol-function 'fill-region-as-paragraph))
 	       (cons 'do-auto-fill (symbol-function 'do-auto-fill)))))
@@ -349,23 +377,91 @@
 		fill-prefix retval)
 	    (if (filladapt-adapt t nil)
 		(progn
-		  (setq retval (filladapt-funcall function arg))
+		  (if filladapt-fill-column-tolerance
+		      (let* ((low (- fill-column
+				     filladapt-fill-column-backward-fuzz))
+			     (high (+ fill-column
+				      filladapt-fill-column-forward-fuzz))
+			     (old-fill-column fill-column)
+			     (fill-column fill-column)
+			     (lim (- high low))
+			     (done nil)
+			     (sign 1)
+			     (delta 0))
+			(while (not done)
+			  (setq retval (filladapt-funcall function arg))
+			  (if (filladapt-paragraph-within-fill-tolerance)
+			      (setq done 'success)
+			    (setq delta (1+ delta)
+				  sign (* sign -1)
+				  fill-column (+ fill-column (* delta sign)))
+			    (while (and (<= delta lim)
+					(or (< fill-column low)
+					    (> fill-column high)))
+			      (setq delta (1+ delta)
+				    sign (* sign -1)
+				    fill-column (+ fill-column
+						   (* delta sign))))
+			    (setq done (> delta lim))))
+			;; if the paragraph lines never fell
+			;; within the tolerances, refill using
+			;; the old fill-column.
+			(if (not (eq done 'success))
+			    (let ((fill-column old-fill-column))
+			      (setq retval (filladapt-funcall function arg)))))
+		    (setq retval (filladapt-funcall function arg)))
 		  (run-hooks 'filladapt-fill-paragraph-post-hook)
 		  (throw 'done retval))))))
     ;; filladapt-adapt failed, so do fill-paragraph normally.
     (filladapt-funcall function arg)))
 
 (defun fill-paragraph (arg)
+  "Fill paragraph at or after point.  Prefix arg means justify as well.
+
+(This function has been overloaded with the `filladapt' version.)
+
+If `sentence-end-double-space' is non-nil, then period followed by one
+space does not end a sentence, so don't break a line there.
+
+If `fill-paragraph-function' is non-nil, we call it (passing our
+argument to it), and if it returns non-nil, we simply return its value."
   (interactive "*P")
   (let ((filladapt-inside-filladapt t))
     (filladapt-fill-paragraph 'fill-paragraph arg)))
 
 (defun lisp-fill-paragraph (&optional arg)
+  "Like \\[fill-paragraph], but handle Emacs Lisp comments.
+
+(This function has been overloaded with the `filladapt' version.)
+
+If any of the current line is a comment, fill the comment or the
+paragraph of it that point is in, preserving the comment's indentation
+and initial semicolons."
   (interactive "*P")
   (let ((filladapt-inside-filladapt t))
     (filladapt-fill-paragraph 'lisp-fill-paragraph arg)))
 
-(defun fill-region-as-paragraph (beg end &optional justify nosqueeze squeeze-after)
+(defun fill-region-as-paragraph (beg end &optional justify
+				 nosqueeze squeeze-after)
+  "Fill the region as one paragraph.
+
+(This function has been overloaded with the `filladapt' version.)
+
+It removes any paragraph breaks in the region and extra newlines at the end,
+indents and fills lines between the margins given by the
+`current-left-margin' and `current-fill-column' functions.
+It leaves point at the beginning of the line following the paragraph.
+
+Normally performs justification according to the `current-justification'
+function, but with a prefix arg, does full justification instead.
+
+From a program, optional third arg JUSTIFY can specify any type of
+justification.  Fourth arg NOSQUEEZE non-nil means not to make spaces
+between words canonical before filling.  Fifth arg SQUEEZE-AFTER, if non-nil,
+means don't canonicalize spaces before that position.
+
+If `sentence-end-double-space' is non-nil, then period followed by one
+space does not end a sentence, so don't break a line there."
   (interactive "*r\nP")
   (if (and filladapt-mode (not filladapt-inside-filladapt))
       (save-restriction
@@ -373,6 +469,8 @@
 	(let ((filladapt-inside-filladapt t)
 	      line-start last-token)
 	  (goto-char beg)
+	  (while (equal (char-after (point)) ?\n)
+	    (delete-char 1))
 	  (end-of-line)
 	  (while (zerop (forward-line))
 	    (if (setq last-token
@@ -405,9 +503,59 @@
 	   ;; four args for Emacs 19.29
 	   (filladapt-funcall 'fill-region-as-paragraph beg end
 			      justify nosqueeze)
-      ;; three args for the rest of the world.
+	 ;; three args for the rest of the world.
+	 (wrong-number-of-arguments
+	  (filladapt-funcall 'fill-region-as-paragraph beg end justify)))))))
+
+(defun fill-region (beg end &optional justify nosqueeze to-eop)
+  "Fill each of the paragraphs in the region.
+
+(This function has been overloaded with the `filladapt' version.)
+
+Prefix arg (non-nil third arg, if called from program) means justify as well.
+
+Noninteractively, fourth arg NOSQUEEZE non-nil means to leave
+whitespace other than line breaks untouched, and fifth arg TO-EOP
+non-nil means to keep filling to the end of the paragraph (or next
+hard newline, if `use-hard-newlines' is on).
+
+If `sentence-end-double-space' is non-nil, then period followed by one
+space does not end a sentence, so don't break a line there."
+  (interactive "*r\nP")
+  (if (and filladapt-mode (not filladapt-inside-filladapt))
+      (save-restriction
+	(narrow-to-region beg end)
+	(let ((filladapt-inside-filladapt t)
+	      start)
+	  (goto-char beg)
+	  (while (not (eobp))
+	    (setq start (point))
+	    (while (and (not (eobp)) (not (filladapt-parse-prefixes)))
+	      (forward-line 1))
+	    (if (not (equal start (point)))
+		(progn
+		  (save-restriction
+		    (narrow-to-region start (point))
+		    (fill-region start (point) justify nosqueeze to-eop)
+		    (goto-char (point-max)))
+		  (if (and (not (bolp)) (not (eobp)))
+		      (forward-line 1))))
+	    (if (filladapt-parse-prefixes)
+		(progn
+		  (save-restriction
+		    ;; for the clipping region
+		    (filladapt-adapt t t)
+		    (fill-paragraph justify)
+		    (goto-char (point-max)))
+		  (if (and (not (bolp)) (not (eobp)))
+		      (forward-line 1)))))))
+    (condition-case nil
+	(filladapt-funcall 'fill-region beg end justify nosqueeze to-eop)
       (wrong-number-of-arguments
-	(filladapt-funcall 'fill-region-as-paragraph beg end justify)))))))
+       (condition-case nil
+	   (filladapt-funcall 'fill-region beg end justify nosqueeze)
+	 (wrong-number-of-arguments
+	  (filladapt-funcall 'fill-region beg end justify)))))))
 
 (defvar zmacs-region-stays) ; for XEmacs
 
@@ -463,7 +611,7 @@
 	  (done nil)
 	  (old-point (point))
 	  (case-fold-search nil)
-	  token-table not-token-table)
+	  token-table not-token-table moved)
       (catch 'done
 	(while (not done)
 	  (setq not-token-table filladapt-not-token-table)
@@ -477,14 +625,15 @@
 	    (if (null (looking-at (car (car token-table))))
 		(setq token-table (cdr token-table))
 	      (goto-char (match-end 0))
-	      (setq token-list (cons (list (cdr (car token-table))
+	      (setq token-list (cons (list (nth 1 (car token-table))
 					   (current-column)
 					   (buffer-substring
 					    (match-beginning 0)
 					    (match-end 0)))
 				     token-list)
-		    token-table nil
-		    done (eq (point) old-point)
+		    moved (not (eq (point) old-point))
+		    token-table (if moved nil (cdr token-table))
+		    done (not moved)
 		    old-point (point))))))
       (nreverse token-list))))
 
@@ -584,6 +733,20 @@
       (setq list (cdr list)))
     (apply (function concat) (nreverse prefix-list)) ))
 
+(defun filladapt-paragraph-within-fill-tolerance ()
+  (catch 'done
+    (save-excursion
+      (let ((low (- fill-column filladapt-fill-column-tolerance))
+	    (shortline nil))
+	(goto-char (point-min))
+	(while (not (eobp))
+	  (if shortline
+	      (throw 'done nil)
+	    (end-of-line)
+	    (setq shortline (< (current-column) low))
+	    (forward-line 1)))
+	t ))))
+
 (defun filladapt-convert-to-spaces (string)
   "Return a copy of STRING, with all non-tabs and non-space changed to spaces."
   (let ((i 0)
@@ -710,10 +873,6 @@
 ;;  (interactive)
   (make-local-variable 'filladapt-debug)
   (setq filladapt-debug (not filladapt-debug))
-  ;; make sure these faces exist at least
-  (make-face 'filladapt-debug-indentation-face-1)
-  (make-face 'filladapt-debug-indentation-face-2)
-  (make-face 'filladapt-debug-paragraph-face)
   (if (null filladapt-debug)
       (progn
 	(mapcar (function (lambda (e) (filladapt-set-extent-endpoints e 1 1)))