Mercurial > hg > xemacs-beta
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)))