xemacs-beta: lisp/packages/filladapt.el comparison

comparison lisp/packages/filladapt.el @ 108:360340f9fd5f r20-1b6

Import from CVS: tag r20-1b6

author	cvs
date	Mon, 13 Aug 2007 09:18:39 +0200
parents	131b0175ea99
children	cca96a509cfe

comparison

equal deleted inserted replaced

-:523141596bda
+:360340f9fd5f
-;;; filladapt.el --- adaptive fill; replacement for fill commands
+;;; Adaptive fill
+;;; Copyright (C) 1989, 1995, 1996, 1997 Kyle E. Jones
-;; 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
 ;;; the Free Software Foundation; either version 2, or (at your option)
 ;;; any later version.
 ;;; A copy of the GNU General Public License can be obtained from this
 ;;; program's author (send electronic mail to kyle@uunet.uu.net) or from
 ;;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA
 ;;; 02139, USA.
 ;;;
-;;; Send bug reports to kyle@wonderworks.com
+;;; Send bug reports to kyle_jones@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.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
+;; mode and the commands fill-paragraph, lisp-fill-paragraph,
-;; fill-region-as-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
 ;; appropriate value for fill-prefix is constructed.  Also the
 ;; boundaries of the current paragraph are located.  This occurs
 ;;
 ;;     filladapt-token-table
 ;;     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
 "*Non-nil means that Filladapt minor mode is enabled.
 Use the filladapt-mode command to toggle the mode on/off.")
 (make-variable-buffer-local 'filladapt-mode)
 (defvar filladapt-mode-line-string " Filladapt"
 "*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
 				       'filladapt-mode-line-string)
 				 minor-mode-alist)))
 (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)
+("@c[ \t]" texinfo-comment)
-("@comment[ \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)
+("[ \t]+" space)
-("$" . end-of-line)
+("$" 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
 against the beginning of the line until a match is found.
 Matching is done case-sensitively.  The corresponding SYM is
 (postscript-comment postscript-comment)
 (c++-comment c++-comment)
 (texinfo-comment texinfo-comment)
 (bullet)
 (space bullet space)
+(beginning-of-line beginning-of-line)
 )
 "Table describing what tokens a certain token will match.
 To decide whether a line belongs in the current paragraph,
 filladapt creates a token list for the fill prefix of both lines.
 the fill prefix.")
 (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)))))
 ;; v18 Emacs doesn't have lisp-fill-paragraph
 (if (fboundp 'lisp-fill-paragraph)
 		;; inside a comment.
 		(comment-multi-line t)
 		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
 	(narrow-to-region beg end)
 	(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
 		      (car (filladapt-tail (filladapt-parse-prefixes))))
 		(progn
 (wrong-number-of-arguments
 (condition-case nil
 	   ;; 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
 (defun filladapt-mode (&optional arg)
 "Toggle Filladapt minor mode.
 (save-excursion
 (let ((token-list nil)
 	  (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)
 	  (while not-token-table
 	    (if (looking-at (car not-token-table))
 		done t)
 	  (while token-table
 	    (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
+		    moved (not (eq (point) old-point))
-		    done (eq (point) old-point)
+		    token-table (if moved nil (cdr token-table))
+		    done (not moved)
 		    old-point (point))))))
 (nreverse token-list))))
 (defun filladapt-tokens-match-p (list1 list2)
 "Compare two token lists and return non-nil if they match, nil otherwise.
 		   (cons
 		    (nth 2 (car list))
 		    prefix-list))))
 (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)
 	(space-list '(?\  ?\t))
 (defun filladapt-debug ()
 "Toggle filladapt debugging on/off in the current buffer."
 ;;  (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)))
 		filladapt-debug-indentation-extents)
 	(if filladapt-debug-paragraph-extent

Mercurial > hg > xemacs-beta

comparison lisp/packages/filladapt.el @ 108:360340f9fd5f r20-1b6