diff lisp/packages/filladapt.el @ 70:131b0175ea99 r20-0b30

Import from CVS: tag r20-0b30
author cvs
date Mon, 13 Aug 2007 09:02:59 +0200
parents ec9a17fef872
children 360340f9fd5f
line wrap: on
line diff
--- a/lisp/packages/filladapt.el	Mon Aug 13 09:00:04 2007 +0200
+++ b/lisp/packages/filladapt.el	Mon Aug 13 09:02:59 2007 +0200
@@ -1,5 +1,8 @@
-;;; Adaptive fill
-;;; Copyright (C) 1989, 1995, 1996, 1997 Kyle E. Jones
+;;; filladapt.el --- adaptive fill; replacement for fill commands
+
+;; Keywords: wp
+
+;;; Copyright (C) 1989, 1995, 1996 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
@@ -16,16 +19,18 @@
 ;;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA
 ;;; 02139, USA.
 ;;;
-;;; Send bug reports to kyle_jones@wonderworks.com
+;;; Send bug reports to kyle@wonderworks.com
+
+;;; Synched up with: Not in FSF.
 
 ;; 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.09|~/packages/filladapt.el| 
+;; 10-June-1996|2.08|~/packages/filladapt.el| 
 
 ;; These functions enhance the default behavior of Emacs' Auto Fill
-;; mode and the commands fill-paragraph, lisp-fill-paragraph,
-;; fill-region-as-paragraph and fill-region.
+;; mode and the commands fill-paragraph, lisp-fill-paragraph and
+;; fill-region-as-paragraph.
 ;;
 ;; The chief improvement is that the beginning of a line to be
 ;; filled is examined and, based on information gathered, an
@@ -67,12 +72,9 @@
 ;;     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.09"
+(defvar filladapt-version "2.08"
   "Version string for filladapt.")
 
 (defvar filladapt-mode nil
@@ -84,28 +86,6 @@
   "*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
@@ -114,82 +94,76 @@
 
 (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
@@ -225,7 +199,6 @@
     (texinfo-comment texinfo-comment)
     (bullet)
     (space bullet space)
-    (beginning-of-line beginning-of-line)
    )
   "Table describing what tokens a certain token will match.
 
@@ -288,7 +261,6 @@
 (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)))))
@@ -377,91 +349,23 @@
 		fill-prefix retval)
 	    (if (filladapt-adapt t nil)
 		(progn
-		  (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)))
+		  (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)
-  "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."
+(defun fill-region-as-paragraph (beg end &optional justify nosqueeze squeeze-after)
   (interactive "*r\nP")
   (if (and filladapt-mode (not filladapt-inside-filladapt))
       (save-restriction
@@ -469,8 +373,6 @@
 	(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
@@ -503,59 +405,9 @@
 	   ;; four args for Emacs 19.29
 	   (filladapt-funcall 'fill-region-as-paragraph beg end
 			      justify nosqueeze)
-	 ;; 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)
+      ;; three args for the rest of the world.
       (wrong-number-of-arguments
-       (condition-case nil
-	   (filladapt-funcall 'fill-region beg end justify nosqueeze)
-	 (wrong-number-of-arguments
-	  (filladapt-funcall 'fill-region beg end justify)))))))
+	(filladapt-funcall 'fill-region-as-paragraph beg end justify)))))))
 
 (defvar zmacs-region-stays) ; for XEmacs
 
@@ -611,7 +463,7 @@
 	  (done nil)
 	  (old-point (point))
 	  (case-fold-search nil)
-	  token-table not-token-table moved)
+	  token-table not-token-table)
       (catch 'done
 	(while (not done)
 	  (setq not-token-table filladapt-not-token-table)
@@ -625,15 +477,14 @@
 	    (if (null (looking-at (car (car token-table))))
 		(setq token-table (cdr token-table))
 	      (goto-char (match-end 0))
-	      (setq token-list (cons (list (nth 1 (car token-table))
+	      (setq token-list (cons (list (cdr (car token-table))
 					   (current-column)
 					   (buffer-substring
 					    (match-beginning 0)
 					    (match-end 0)))
 				     token-list)
-		    moved (not (eq (point) old-point))
-		    token-table (if moved nil (cdr token-table))
-		    done (not moved)
+		    token-table nil
+		    done (eq (point) old-point)
 		    old-point (point))))))
       (nreverse token-list))))
 
@@ -733,20 +584,6 @@
       (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)
@@ -873,6 +710,10 @@
 ;;  (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)))