X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/dc864d6e59c5bb76daccef16e56627e2823317b5..bf3323c57c0e5964c4ecb4e48a9a96cb055eeb0c:/lisp/textmodes/fill.el diff --git a/lisp/textmodes/fill.el b/lisp/textmodes/fill.el index f9b9003593..11ddfc0e96 100644 --- a/lisp/textmodes/fill.el +++ b/lisp/textmodes/fill.el @@ -1,7 +1,7 @@ -;;; fill.el --- fill commands for Emacs +;;; fill.el --- fill commands for Emacs -*- coding: iso-2022-7bit -*- -;; Copyright (C) 1985,86,92,94,95,96,97,1999,2001,2002 -;; Free Software Foundation, Inc. +;; Copyright (C) 1985, 1986, 1992, 1994, 1995, 1996, 1997, 1999, 2001, 2002, +;; 2003, 2004, 2005 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: wp @@ -20,8 +20,8 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. ;;; Commentary: @@ -30,6 +30,11 @@ ;;; Code: +(defgroup fill nil + "Indenting and filling text." + :link '(custom-manual "(emacs)Filling") + :group 'editing) + (defcustom fill-individual-varying-indent nil "*Controls criterion for a new paragraph in `fill-individual-paragraphs'. Non-nil means changing indent doesn't end a paragraph. @@ -48,11 +53,16 @@ A value of nil means that any change in indentation starts a new paragraph." "Mode-specific function to fill a paragraph, or nil if there is none. If the function returns nil, then `fill-paragraph' does its normal work.") -(defvar enable-kinsoku t - "*Non-nil means enable \"kinsoku\" processing on filling paragraph. +(defvar fill-paragraph-handle-comment t + "Non-nil means paragraph filling will try to pay attention to comments.") + +(defcustom enable-kinsoku t + "*Non-nil means enable \"kinsoku\" processing on filling paragraphs. Kinsoku processing is designed to prevent certain characters from being placed at the beginning or end of a line by filling. -See the documentation of `kinsoku' for more information.") +See the documentation of `kinsoku' for more information." + :type 'boolean + :group 'fill) (defun set-fill-prefix () "Set the fill prefix to the current line up to point. @@ -78,7 +88,7 @@ reinserts the fill prefix in each resulting line." (defcustom adaptive-fill-regexp ;; Added `!' for doxygen comments starting with `//!' or `/*!'. ;; Added `%' for TeX comments. - (purecopy "[ \t]*\\([-!|#%;>*]+[ \t]*\\|(?[0-9]+[.)][ \t]*\\)*") + (purecopy "[ \t]*\\([-!|#%;>*,A7$,1s"s#sC$,2"F(B]+[ \t]*\\|(?[0-9]+[.)][ \t]*\\)*") "*Regexp to match text at start of line that constitutes indentation. If Adaptive Fill mode is enabled, a prefix matching this pattern on the first and second lines of a paragraph is used as the @@ -105,7 +115,7 @@ if it would act as a paragraph-starter on the second line." (defcustom adaptive-fill-function nil "*Function to call to choose a fill prefix for a paragraph, or nil. -This function is used when `adaptive-fill-regexp' does not match." +nil means the function has not determined the fill prefix." :type '(choice (const nil) function) :group 'fill) @@ -146,14 +156,14 @@ Leave one space between words, two at end of sentences or after colons and `sentence-end-without-period'). Remove indentation from each line." (interactive "*r") - (let ((end-spc-re (concat "\\(" sentence-end "\\) *\\| +"))) + (let ((end-spc-re (concat "\\(" (sentence-end) "\\) *\\| +"))) (save-excursion (goto-char beg) ;; Nuke tabs; they get screwed up in a fill. ;; This is quick, but loses when a tab follows the end of a sentence. ;; Actually, it is difficult to tell that from "Mr.\tSmith". ;; Blame the typist. - (subst-char-in-region beg end ?\t ?\ ) + (subst-char-in-region beg end ?\t ?\s) (while (and (< (point) end) (re-search-forward end-spc-re end t)) (delete-region @@ -194,7 +204,17 @@ Remove indentation from each line." (setq cmp (1- (abs cmp))) (unless (zerop cmp) (substring s1 0 cmp))))) - + +(defun fill-match-adaptive-prefix () + (let ((str (or + (and adaptive-fill-function (funcall adaptive-fill-function)) + (and adaptive-fill-regexp (looking-at adaptive-fill-regexp) + (match-string-no-properties 0))))) + (if (>= (+ (current-left-margin) (length str)) (current-fill-column)) + ;; Death to insanely long prefixes. + nil + str))) + (defun fill-context-prefix (from to &optional first-line-regexp) "Compute a fill prefix from the text between FROM and TO. This uses the variables `adaptive-fill-regexp' and `adaptive-fill-function' @@ -208,55 +228,45 @@ act as a paragraph-separator." (if (eolp) (forward-line 1)) ;; Move to the second line unless there is just one. (move-to-left-margin) - (let ((firstline (point)) - first-line-prefix + (let (first-line-prefix ;; Non-nil if we are on the second line. - second-line-prefix - start) - (setq start (point)) + second-line-prefix) (setq first-line-prefix ;; We don't need to consider `paragraph-start' here since it ;; will be explicitly checked later on. ;; Also setting first-line-prefix to nil prevents ;; second-line-prefix from being used. - (cond ;; ((looking-at paragraph-start) nil) - ((and adaptive-fill-regexp (looking-at adaptive-fill-regexp)) - (match-string-no-properties 0)) - (adaptive-fill-function (funcall adaptive-fill-function)))) + ;; ((looking-at paragraph-start) nil) + (fill-match-adaptive-prefix)) (forward-line 1) (if (< (point) to) - (progn - (move-to-left-margin) - (setq start (point)) - (setq second-line-prefix - (cond ((looking-at paragraph-start) nil) ;Can it happen ? -stef - ((and adaptive-fill-regexp - (looking-at adaptive-fill-regexp)) - (buffer-substring-no-properties start (match-end 0))) - (adaptive-fill-function - (funcall adaptive-fill-function)))) - ;; If we get a fill prefix from the second line, - ;; make sure it or something compatible is on the first line too. - (when second-line-prefix - (unless first-line-prefix (setq first-line-prefix "")) - ;; If the non-whitespace chars match the first line, - ;; just use it (this subsumes the 2 checks used previously). - ;; Used when first line is `/* ...' and second-line is - ;; ` * ...'. - (let ((tmp second-line-prefix) - (re "\\`")) - (while (string-match "\\`[ \t]*\\([^ \t]+\\)" tmp) - (setq re (concat re ".*" (regexp-quote (match-string 1 tmp)))) - (setq tmp (substring tmp (match-end 0)))) - ;; (assert (string-match "\\`[ \t]*\\'" tmp)) - - (if (string-match re first-line-prefix) - second-line-prefix - - ;; Use the longest common substring of both prefixes, - ;; if there is one. - (fill-common-string-prefix first-line-prefix - second-line-prefix))))) + (progn + (move-to-left-margin) + (setq second-line-prefix + (cond ((looking-at paragraph-start) nil) ;Can it happen? -Stef + (t (fill-match-adaptive-prefix)))) + ;; If we get a fill prefix from the second line, + ;; make sure it or something compatible is on the first line too. + (when second-line-prefix + (unless first-line-prefix (setq first-line-prefix "")) + ;; If the non-whitespace chars match the first line, + ;; just use it (this subsumes the 2 checks used previously). + ;; Used when first line is `/* ...' and second-line is + ;; ` * ...'. + (let ((tmp second-line-prefix) + (re "\\`")) + (while (string-match "\\`[ \t]*\\([^ \t]+\\)" tmp) + (setq re (concat re ".*" (regexp-quote (match-string 1 tmp)))) + (setq tmp (substring tmp (match-end 0)))) + ;; (assert (string-match "\\`[ \t]*\\'" tmp)) + + (if (string-match re first-line-prefix) + second-line-prefix + + ;; Use the longest common substring of both prefixes, + ;; if there is one. + (fill-common-string-prefix first-line-prefix + second-line-prefix))))) ;; If we get a fill prefix from a one-line paragraph, ;; maybe change it to whitespace, ;; and check that it isn't a paragraph starter. @@ -272,7 +282,7 @@ act as a paragraph-separator." (string-match comment-start-skip first-line-prefix))) first-line-prefix - (make-string (string-width first-line-prefix) ?\ )))) + (make-string (string-width first-line-prefix) ?\s)))) ;; But either way, reject it if it indicates the start ;; of a paragraph when text follows it. (if (not (eq 0 (string-match paragraph-start @@ -295,14 +305,14 @@ after an opening paren or just before a closing paren or a punctuation mark such as `?' or `:'. It is common in French writing to put a space at such places, which would normally allow breaking the line at those places." - (or (looking-at "[ \t]*[])}»?!;:-]") + (or (looking-at "[ \t]*[])},A;,b;(B?!;:-]") (save-excursion (skip-chars-backward " \t") (unless (bolp) (backward-char 1) - (or (looking-at "[([{«]") + (or (looking-at "[([{,A+,b+(B]") ;; Don't cut right after a single-letter word. - (and (memq (preceding-char) '(?\t ?\ )) + (and (memq (preceding-char) '(?\t ?\s)) (eq (char-syntax (following-char)) ?w))))))) (defcustom fill-nobreak-predicate nil @@ -313,10 +323,18 @@ be tested. If it returns t, fill commands do not break the line there." :type 'hook :options '(fill-french-nobreak-p fill-single-word-nobreak-p)) +(defcustom fill-nobreak-invisible nil + "Non-nil means that fill commands do not break lines in invisible text." + :type 'boolean + :group 'fill) + (defun fill-nobreak-p () "Return nil if breaking the line at point is allowed. -Can be customized with the variable `fill-nobreak-predicate'." - (unless (bolp) +Can be customized with the variables `fill-nobreak-predicate' +and `fill-nobreak-invisible'." + (or + (and fill-nobreak-invisible (line-move-invisible-p (point))) + (unless (bolp) (or ;; Don't break after a period followed by just one space. ;; Move back to the previous place to break. @@ -332,12 +350,17 @@ Can be customized with the variable `fill-nobreak-predicate'." (save-excursion (skip-chars-backward ". ") (and (looking-at "\\.") - (not (looking-at sentence-end)))) + (not (looking-at (sentence-end))))) ;; Don't split a line if the rest would look like a new paragraph. (unless use-hard-newlines (save-excursion - (skip-chars-forward " \t") (looking-at paragraph-start))) - (run-hook-with-args-until-success 'fill-nobreak-predicate)))) + (skip-chars-forward " \t") + ;; If this break point is at the end of the line, + ;; which can occur for auto-fill, don't consider the newline + ;; which follows as a reason to return t. + (and (not (eolp)) + (looking-at paragraph-start)))) + (run-hook-with-args-until-success 'fill-nobreak-predicate))))) ;; Put `fill-find-break-point-function' property to charsets which ;; require special functions to find line breaking point. @@ -354,7 +377,7 @@ Can be customized with the variable `fill-nobreak-predicate'." Don't move back past the buffer position LIMIT. This function is called when we are going to break the current line -after or before a non-ascii character. If the charset of the +after or before a non-ASCII character. If the charset of the character has the property `fill-find-break-point-function', this function calls the property value as a function with one arg LINEBEG. If the charset has no such property, do nothing." @@ -395,21 +418,31 @@ Point is moved to just past the fill prefix on the first line." (goto-char (match-end 0))) (setq from (point)))) +;; The `fill-space' property carries the string with which a newline +;; should be replaced when unbreaking a line (in fill-delete-newlines). +;; It is added to newline characters by fill-newline when the default +;; behavior of fill-delete-newlines is not what we want. +(add-to-list 'text-property-default-nonsticky '(fill-space . t)) + (defun fill-delete-newlines (from to justify nosqueeze squeeze-after) (goto-char from) ;; Make sure sentences ending at end of line get an extra space. ;; loses on split abbrevs ("Mr.\nSmith") (let ((eol-double-space-re (cond - ((not colon-double-space) (concat sentence-end "$")) + ((not colon-double-space) (concat (sentence-end) "$")) ;; Try to add the : inside the `sentence-end' regexp. - ((string-match "\\[[^][]*\\(\\.\\)[^][]*\\]" sentence-end) - (concat (replace-match ".:" nil nil sentence-end 1) "$")) + ((string-match "\\[[^][]*\\(\\.\\)[^][]*\\]" (sentence-end)) + (concat (replace-match ".:" nil nil (sentence-end) 1) "$")) ;; Can't find the right spot to insert the colon. - (t "[.?!:][])}\"']*$")))) + (t "[.?!:][])}\"']*$"))) + (sentence-end-without-space-list + (string-to-list sentence-end-without-space))) (while (re-search-forward eol-double-space-re to t) - (or (>= (point) to) (memq (char-before) '(?\t ?\ )) - (insert-and-inherit ?\ )))) + (or (>= (point) to) (memq (char-before) '(?\t ?\s)) + (memq (char-after (match-beginning 0)) + sentence-end-without-space-list) + (insert-and-inherit ?\s)))) (goto-char from) (if enable-multibyte-characters @@ -423,26 +456,28 @@ Point is moved to just past the fill prefix on the first line." ;; character preceding a newline has text property ;; `nospace-between-words'. (while (search-forward "\n" to t) - (let ((prev (char-before (match-beginning 0))) - (next (following-char))) - (if (and (or (aref (char-category-set next) ?|) - (aref (char-category-set prev) ?|)) - (or (get-charset-property (char-charset prev) - 'nospace-between-words) - (get-text-property (1- (match-beginning 0)) - 'nospace-between-words))) - (delete-char -1))))) + (if (get-text-property (match-beginning 0) 'fill-space) + (replace-match (get-text-property (match-beginning 0) 'fill-space)) + (let ((prev (char-before (match-beginning 0))) + (next (following-char))) + (if (and (or (aref (char-category-set next) ?|) + (aref (char-category-set prev) ?|)) + (or (get-charset-property (char-charset prev) + 'nospace-between-words) + (get-text-property (1- (match-beginning 0)) + 'nospace-between-words))) + (delete-char -1)))))) (goto-char from) (skip-chars-forward " \t") ;; Then change all newlines to spaces. - (subst-char-in-region from to ?\n ?\ ) + (subst-char-in-region from to ?\n ?\s) (if (and nosqueeze (not (eq justify 'full))) nil (canonically-space-region (or squeeze-after (point)) to) - (goto-char to) - (delete-horizontal-space) - (insert-and-inherit " ")) + ;; Remove trailing whitespace. + ;; Maybe canonically-space-region should do that. + (goto-char to) (delete-char (- (skip-chars-backward " \t")))) (goto-char from)) (defun fill-move-to-break-point (linebeg) @@ -465,6 +500,10 @@ The break position will be always after LINEBEG and generally before point." ;; point is at the place where the break occurs. (forward-char 1) (when (fill-nobreak-p) (skip-chars-backward " \t" linebeg)))) + + ;; Move back over the single space between the words. + (skip-chars-backward " \t") + ;; If the left margin and fill prefix by themselves ;; pass the fill-column. or if they are zero ;; but we have no room for even one word, @@ -490,9 +529,6 @@ The break position will be always after LINEBEG and generally before point." (forward-char -1) (goto-char pos)))) (setq first nil))) - ;; Normally, move back over the single space between - ;; the words. - (skip-chars-backward " \t") (if enable-multibyte-characters ;; If we are going to break the line after or @@ -504,31 +540,52 @@ The break position will be always after LINEBEG and generally before point." ;; Make sure we take SOMETHING after the fill prefix if any. (fill-find-break-point linebeg))))) +;; Like text-properties-at but don't include `composition' property. +(defun fill-text-properties-at (pos) + (let ((l (text-properties-at pos)) + prop-list) + (while l + (unless (eq (car l) 'composition) + (setq prop-list + (cons (car l) (cons (cadr l) prop-list)))) + (setq l (cddr l))) + prop-list)) + (defun fill-newline () ;; Replace whitespace here with one newline, then ;; indent to left margin. (skip-chars-backward " \t") - (if (and (= (following-char) ?\ ) - (or (aref (char-category-set (preceding-char)) ?|) - (looking-at "[ \t]+\\c|"))) - ;; We need one space at end of line so that - ;; further filling won't delete it. NOTE: We - ;; intentionally leave this one space to - ;; distingush the case that user wants to put - ;; space between \c| characters. - (forward-char 1)) (insert ?\n) ;; Give newline the properties of the space(s) it replaces (set-text-properties (1- (point)) (point) - (text-properties-at (point))) + (fill-text-properties-at (point))) + (and (looking-at "\\( [ \t]*\\)\\(\\c|\\)?") + (or (aref (char-category-set (or (char-before (1- (point))) ?\000)) ?|) + (match-end 2)) + ;; When refilling later on, this newline would normally not be replaced + ;; by a space, so we need to mark it specially to re-install the space + ;; when we unfill. + (put-text-property (1- (point)) (point) 'fill-space (match-string 1))) + ;; If we don't want breaks in invisible text, don't insert + ;; an invisible newline. + (if fill-nobreak-invisible + (remove-text-properties (1- (point)) (point) + '(invisible t))) (if (or fill-prefix (not fill-indent-according-to-mode)) - (indent-to-left-margin) + (fill-indent-to-left-margin) (indent-according-to-mode)) ;; Insert the fill prefix after indentation. - ;; Set prefixcol so whitespace in the prefix won't get lost. (and fill-prefix (not (equal fill-prefix "")) - (insert-and-inherit fill-prefix))) + ;; Markers that were after the whitespace are now at point: insert + ;; before them so they don't get stuck before the prefix. + (insert-before-markers-and-inherit fill-prefix))) + +(defun fill-indent-to-left-margin () + "Indent current line to the column given by `current-left-margin'." + (let ((beg (point))) + (indent-line-to (current-left-margin)) + (put-text-property beg (point) 'face 'default))) (defun fill-region-as-paragraph (from to &optional justify nosqueeze squeeze-after) @@ -547,7 +604,7 @@ 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. -Return the fill-prefix used for filling. +Return the `fill-prefix' used for filling. 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." @@ -557,9 +614,6 @@ space does not end a sentence, so don't break a line there." (if current-prefix-arg 'full)))) (unless (memq justify '(t nil none full center left right)) (setq justify 'full)) - ;; Arrange for undoing the fill to restore point. - (if (and buffer-undo-list (not (eq buffer-undo-list t))) - (setq buffer-undo-list (cons (point) buffer-undo-list))) ;; Make sure "to" is the endpoint. (goto-char (min from to)) @@ -572,7 +626,7 @@ space does not end a sentence, so don't break a line there." (beginning-of-line) (setq from (point)) - + ;; Delete all but one soft newline at end of region. ;; And leave TO before that one. (goto-char to) @@ -607,63 +661,62 @@ space does not end a sentence, so don't break a line there." (string-match "\\`[ \t]*\\'" fill-prefix)) (setq fill-prefix nil))) - (save-restriction - (goto-char from) - (beginning-of-line) - (narrow-to-region (point) to) + (goto-char from) + (beginning-of-line) - (if (not justify) ; filling disabled: just check indentation - (progn - (goto-char from) - (while (< (point) to) - (if (and (not (eolp)) - (< (current-indentation) (current-left-margin))) - (indent-to-left-margin)) - (forward-line 1))) - - (if use-hard-newlines - (remove-text-properties from (point-max) '(hard nil))) - ;; Make sure first line is indented (at least) to left margin... - (if (or (memq justify '(right center)) - (< (current-indentation) (current-left-margin))) - (indent-to-left-margin)) - ;; Delete the fill-prefix from every line. - (fill-delete-prefix from to fill-prefix) - (setq from (point)) - - ;; FROM, and point, are now before the text to fill, - ;; but after any fill prefix on the first line. - - (fill-delete-newlines from to justify nosqueeze squeeze-after) - - ;; This is the actual filling loop. - (goto-char from) - (let (linebeg) + (if (not justify) ; filling disabled: just check indentation + (progn + (goto-char from) (while (< (point) to) - (setq linebeg (point)) - (move-to-column (1+ (current-fill-column))) - (if (>= (point) to) - (or nosqueeze (delete-horizontal-space)) - ;; Find the position where we'll break the line. - (fill-move-to-break-point linebeg) - - ;; Check again to see if we got to the end of the paragraph. - (if (save-excursion (skip-chars-forward " \t") (>= (point) to)) - (or nosqueeze (delete-horizontal-space)) - (fill-newline))) - ;; Justify the line just ended, if desired. - (if justify - (if (save-excursion (skip-chars-forward " \t") (>= (point) to)) - (progn - (delete-horizontal-space) - (justify-current-line justify t t)) + (if (and (not (eolp)) + (< (current-indentation) (current-left-margin))) + (fill-indent-to-left-margin)) + (forward-line 1))) + + (if use-hard-newlines + (remove-list-of-text-properties from to '(hard))) + ;; Make sure first line is indented (at least) to left margin... + (if (or (memq justify '(right center)) + (< (current-indentation) (current-left-margin))) + (fill-indent-to-left-margin)) + ;; Delete the fill-prefix from every line. + (fill-delete-prefix from to fill-prefix) + (setq from (point)) + + ;; FROM, and point, are now before the text to fill, + ;; but after any fill prefix on the first line. + + (fill-delete-newlines from to justify nosqueeze squeeze-after) + + ;; This is the actual filling loop. + (goto-char from) + (let (linebeg) + (while (< (point) to) + (setq linebeg (point)) + (move-to-column (current-fill-column)) + (if (when (< (point) to) + ;; Find the position where we'll break the line. + (forward-char 1) ;Use an immediately following space, if any. + (fill-move-to-break-point linebeg) + ;; Check again to see if we got to the end of + ;; the paragraph. + (skip-chars-forward " \t") + (< (point) to)) + ;; Found a place to cut. + (progn + (fill-newline) + (when justify + ;; Justify the line just ended, if desired. (save-excursion (forward-line -1) - (justify-current-line justify nil t))))))) - ;; Leave point after final newline. - (goto-char to)) - (unless (eobp) - (forward-char 1)) + (justify-current-line justify nil t)))) + + (goto-char to) + ;; Justify this last line, if desired. + (if justify (justify-current-line justify t t)))))) + ;; Leave point after final newline. + (goto-char to) + (unless (eobp) (forward-char 1)) ;; Return the fill-prefix we used fill-prefix))) @@ -689,31 +742,175 @@ If `fill-paragraph-function' is nil, return the `fill-prefix' used for filling." (interactive (progn (barf-if-buffer-read-only) (list (if current-prefix-arg 'full)))) + ;; First try fill-paragraph-function. (or (and fill-paragraph-function (let ((function fill-paragraph-function) + ;; If fill-paragraph-function is set, it probably takes care + ;; of comments and stuff. If not, it will have to set + ;; fill-paragraph-handle-comment back to t explicitly or + ;; return nil. + (fill-paragraph-handle-comment nil) fill-paragraph-function) (funcall function arg))) + ;; Then try our syntax-aware filling code. + (and fill-paragraph-handle-comment + ;; Our code only handles \n-terminated comments right now. + comment-start (equal comment-end "") + (let ((fill-paragraph-handle-comment nil)) + (fill-comment-paragraph arg))) + ;; If it all fails, default to the good ol' text paragraph filling. (let ((before (point)) + (paragraph-start paragraph-start) ;; Fill prefix used for filling the paragraph. fill-pfx) + ;; Try to prevent code sections and comment sections from being + ;; filled together. + (when (and fill-paragraph-handle-comment comment-start-skip) + (setq paragraph-start + (concat paragraph-start "\\|[ \t]*\\(?:" + comment-start-skip "\\)"))) (save-excursion - (forward-paragraph) - (or (bolp) (newline 1)) - (let ((end (point)) - (beg (progn (backward-paragraph) (point)))) - (goto-char before) - (setq fill-pfx - (if use-hard-newlines - ;; Can't use fill-region-as-paragraph, since this - ;; paragraph may still contain hard newlines. See - ;; fill-region. - (fill-region beg end arg) - (fill-region-as-paragraph beg end arg))))) - ;; See if point ended up inside the fill-prefix, and if so, move - ;; past it. - (skip-line-prefix fill-pfx) + ;; To make sure the return value of forward-paragraph is meaningful, + ;; we have to start from the beginning of line, otherwise skipping + ;; past the last few chars of a paragraph-separator would count as + ;; a paragraph (and not skipping any chars at EOB would not count + ;; as a paragraph even if it is). + (move-to-left-margin) + (if (not (zerop (forward-paragraph))) + ;; There's no paragraph at or after point: give up. + (setq fill-pfx "") + (let ((end (point)) + (beg (progn (backward-paragraph) (point)))) + (goto-char before) + (setq fill-pfx + (if use-hard-newlines + ;; Can't use fill-region-as-paragraph, since this + ;; paragraph may still contain hard newlines. See + ;; fill-region. + (fill-region beg end arg) + (fill-region-as-paragraph beg end arg)))))) fill-pfx))) +(defun fill-comment-paragraph (&optional justify) + "Fill current comment. +If we're not in a comment, just return nil so that the caller +can take care of filling. JUSTIFY is used as in `fill-paragraph'." + (comment-normalize-vars) + (let (has-code-and-comment ; Non-nil if it contains code and a comment. + comin comstart) + ;; Figure out what kind of comment we are looking at. + (save-excursion + (beginning-of-line) + (when (setq comstart (comment-search-forward (line-end-position) t)) + (setq comin (point)) + (goto-char comstart) (skip-chars-backward " \t") + (setq has-code-and-comment (not (bolp))))) + + (if (not comstart) + ;; Return nil, so the normal filling will take place. + nil + + ;; Narrow to include only the comment, and then fill the region. + (let* ((fill-prefix fill-prefix) + (commark + (comment-string-strip (buffer-substring comstart comin) nil t)) + (comment-re + (if (string-match comment-start-skip (concat commark "a")) + (concat "[ \t]*" (regexp-quote commark) + ;; Make sure we only match comments that use + ;; the exact same comment marker. + "[^" (substring commark -1) "]") + ;; If the commark needs to be followed by some special + ;; set of characters (like @c in TeXinfo), we can't + ;; rely just on `commark'. + (concat "[ \t]*\\(?:" comment-start-skip "\\)"))) + (comment-fill-prefix ; Compute a fill prefix. + (save-excursion + (goto-char comstart) + (if has-code-and-comment + (concat + (if (not indent-tabs-mode) + (make-string (current-column) ?\s) + (concat + (make-string (/ (current-column) tab-width) ?\t) + (make-string (% (current-column) tab-width) ?\s))) + (buffer-substring (point) comin)) + (buffer-substring (line-beginning-position) comin)))) + beg end) + (save-excursion + (save-restriction + (beginning-of-line) + (narrow-to-region + ;; Find the first line we should include in the region to fill. + (if has-code-and-comment + (line-beginning-position) + (save-excursion + (while (and (zerop (forward-line -1)) + (looking-at comment-re))) + ;; We may have gone too far. Go forward again. + (line-beginning-position + (if (progn + (goto-char + (or (comment-search-forward (line-end-position) t) + (point))) + (looking-at comment-re)) + 1 2)))) + ;; Find the beginning of the first line past the region to fill. + (save-excursion + (while (progn (forward-line 1) + (looking-at comment-re))) + (point))) + ;; Obey paragraph starters and boundaries within comments. + (let* ((paragraph-separate + ;; Use the default values since they correspond to + ;; the values to use for plain text. + (concat paragraph-separate "\\|[ \t]*\\(?:" + comment-start-skip "\\)\\(?:" + (default-value 'paragraph-separate) "\\)")) + (paragraph-start + (concat paragraph-start "\\|[ \t]*\\(?:" + comment-start-skip "\\)\\(?:" + (default-value 'paragraph-start) "\\)")) + ;; We used to reply on fill-prefix to break paragraph at + ;; comment-starter changes, but it did not work for the + ;; first line (mixed comment&code). + ;; We now use comment-re instead to "manually" make sure + ;; we treat comment-marker changes as paragraph boundaries. + ;; (paragraph-ignore-fill-prefix nil) + ;; (fill-prefix comment-fill-prefix) + (after-line (if has-code-and-comment + (line-beginning-position 2)))) + (setq end (progn (forward-paragraph) (point))) + ;; If this comment starts on a line with code, + ;; include that line in the filling. + (setq beg (progn (backward-paragraph) + (if (eq (point) after-line) + (forward-line -1)) + (point))))) + + ;; Find the fill-prefix to use. + (cond + (fill-prefix) ; Use the user-provided fill prefix. + ((and adaptive-fill-mode ; Try adaptive fill mode. + (setq fill-prefix (fill-context-prefix beg end)) + (string-match comment-start-skip fill-prefix))) + (t + (setq fill-prefix comment-fill-prefix))) + + ;; Don't fill with narrowing. + (or + (fill-region-as-paragraph + beg end justify nil + ;; Don't canonicalize spaces within the code just before + ;; the comment. + (save-excursion + (goto-char beg) + (if (looking-at fill-prefix) + nil + (re-search-forward comment-start-skip)))) + ;; Make sure we don't return nil. + t)))))) + (defun fill-region (from to &optional justify nosqueeze to-eop) "Fill each of the paragraphs in the region. A prefix arg means justify as well. @@ -727,7 +924,7 @@ as specified by its text properties. The 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). +hard newline, if variable `use-hard-newlines' is on). Return the fill-prefix used for filling the last paragraph. @@ -739,40 +936,38 @@ space does not end a sentence, so don't break a line there." (if current-prefix-arg 'full)))) (unless (memq justify '(t nil none full center left right)) (setq justify 'full)) - (let (end beg fill-pfx) - (save-restriction - (goto-char (max from to)) - (when to-eop - (skip-chars-backward "\n") - (forward-paragraph)) - (setq end (point)) - (goto-char (setq beg (min from to))) - (beginning-of-line) - (narrow-to-region (point) end) - (while (not (eobp)) - (let ((initial (point)) - end) - ;; If using hard newlines, break at every one for filling - ;; purposes rather than using paragraph breaks. - (if use-hard-newlines - (progn - (while (and (setq end (text-property-any (point) (point-max) - 'hard t)) - (not (= ?\n (char-after end))) - (not (= end (point-max)))) - (goto-char (1+ end))) - (setq end (if end (min (point-max) (1+ end)) (point-max))) - (goto-char initial)) - (forward-paragraph 1) - (setq end (point)) - (forward-paragraph -1)) - (if (< (point) beg) - (goto-char beg)) - (if (>= (point) initial) - (setq fill-pfx - (fill-region-as-paragraph (point) end justify nosqueeze)) - (goto-char end)))) - fill-pfx))) + (let (max beg fill-pfx) + (goto-char (max from to)) + (when to-eop + (skip-chars-backward "\n") + (forward-paragraph)) + (setq max (copy-marker (point) t)) + (goto-char (setq beg (min from to))) + (beginning-of-line) + (while (< (point) max) + (let ((initial (point)) + end) + ;; If using hard newlines, break at every one for filling + ;; purposes rather than using paragraph breaks. + (if use-hard-newlines + (progn + (while (and (setq end (text-property-any (point) max + 'hard t)) + (not (= ?\n (char-after end))) + (not (>= end max))) + (goto-char (1+ end))) + (setq end (if end (min max (1+ end)) max)) + (goto-char initial)) + (forward-paragraph 1) + (setq end (min max (point))) + (forward-paragraph -1)) + (if (< (point) beg) + (goto-char beg)) + (if (>= (point) initial) + (setq fill-pfx + (fill-region-as-paragraph (point) end justify nosqueeze)) + (goto-char end)))) + fill-pfx)) (defcustom default-justification 'left @@ -793,9 +988,9 @@ The `justification' text-property can locally override this variable." This returns the value of the text-property `justification', or the variable `default-justification' if there is no text-property. However, it returns nil rather than `none' to mean \"don't justify\"." - (let ((j (or (get-text-property + (let ((j (or (get-text-property ;; Make sure we're looking at paragraph body. - (save-excursion (skip-chars-forward " \t") + (save-excursion (skip-chars-forward " \t") (if (and (eobp) (not (bobp))) (1- (point)) (point))) 'justification) @@ -813,8 +1008,8 @@ beginning and end of the region are not at paragraph breaks, they are moved to the beginning and end \(respectively) of the paragraphs they are in. -If `use-hard-newlines' is true, all hard newlines are taken to be paragraph -breaks. +If variable `use-hard-newlines' is true, all hard newlines are +taken to be paragraph breaks. When calling from a program, operates just on region between BEGIN and END, unless optional fourth arg WHOLE-PAR is non-nil. In that case bounds are @@ -833,7 +1028,7 @@ extended to include entire paragraphs as in the interactive command." (save-restriction (if whole-par (let ((paragraph-start (if use-hard-newlines "." paragraph-start)) - (paragraph-ignore-fill-prefix (if use-hard-newlines t + (paragraph-ignore-fill-prefix (if use-hard-newlines t paragraph-ignore-fill-prefix))) (goto-char begin) (while (and (bolp) (not (eobp))) (forward-char 1)) @@ -890,7 +1085,7 @@ If the mark is not active, this applies to the current paragraph." ;; A line has up to six parts: ;; -;; >>> hello. +;; >>> hello. ;; [Indent-1][FP][ Indent-2 ][text][trailing whitespace][newline] ;; ;; "Indent-1" is the left-margin indentation; normally it ends at column @@ -902,7 +1097,7 @@ If the mark is not active, this applies to the current paragraph." ;; Trailing whitespace is not counted as part of the line length when ;; center- or right-justifying. ;; -;; All parts of the line are optional, although the final newline can +;; All parts of the line are optional, although the final newline can ;; only be missing on the last line of the buffer. (defun justify-current-line (&optional how eop nosqueeze) @@ -910,7 +1105,7 @@ If the mark is not active, this applies to the current paragraph." Normally does full justification: adds spaces to the line to make it end at the column given by `current-fill-column'. Optional first argument HOW specifies alternate type of justification: -it can be `left', `right', `full', `center', or `none'. +it can be `left', `right', `full', `center', or `none'. If HOW is t, will justify however the `current-justification' function says to. If HOW is nil or missing, full justification is done by default. Second arg EOP non-nil means that this is the last line of the paragraph, so @@ -933,13 +1128,11 @@ otherwise it is made canonical." ncols ; new indent point or offset (nspaces 0) ; number of spaces between words ; in line (not space characters) - fracspace ; fractional amount of space to be - ; added between each words (curr-fracspace 0) ; current fractional space amount count) (end-of-line) ;; Check if this is the last line of the paragraph. - (if (and use-hard-newlines (null eop) + (if (and use-hard-newlines (null eop) (get-text-property (point) 'hard)) (setq eop t)) (skip-chars-backward " \t") @@ -953,14 +1146,14 @@ otherwise it is made canonical." (beginning-of-line) (skip-chars-forward " \t") ;; Skip over fill-prefix. - (if (and fill-prefix + (if (and fill-prefix (not (string-equal fill-prefix "")) (equal fill-prefix - (buffer-substring + (buffer-substring (point) (min (point-max) (+ (length fill-prefix) (point)))))) (forward-char (length fill-prefix)) - (if (and adaptive-fill-mode + (if (and adaptive-fill-mode (looking-at adaptive-fill-regexp)) (goto-char (match-end 0)))) (setq fp-end (point)) @@ -972,11 +1165,11 @@ otherwise it is made canonical." (setq endcol (current-column)) ;; HOW can't be null or left--we would have exited already - (cond ((eq 'right how) + (cond ((eq 'right how) (setq ncols (- fc endcol)) (if (< ncols 0) ;; Need to remove some indentation - (delete-region + (delete-region (progn (goto-char fp-end) (if (< (current-column) (+ indent ncols)) (move-to-column (+ indent ncols) t)) @@ -986,7 +1179,7 @@ otherwise it is made canonical." (goto-char beg) (indent-to (+ indent ncols)) ;; If point was at beginning of text, keep it there. - (if (= beg pos) + (if (= beg pos) (move-marker pos (point))))) ((eq 'center how) @@ -1030,7 +1223,7 @@ otherwise it is made canonical." (while (> count 0) (skip-chars-forward " ") (insert-and-inherit - (make-string (/ curr-fracspace nspaces) ?\ )) + (make-string (/ curr-fracspace nspaces) ?\s)) (search-forward " " nil t) (setq count (1- count) curr-fracspace @@ -1055,10 +1248,10 @@ extra spaces between words. It does nothing in other justification modes." (save-excursion (move-to-left-margin nil t) ;; Position ourselves after any fill-prefix. - (if (and fill-prefix + (if (and fill-prefix (not (string-equal fill-prefix "")) (equal fill-prefix - (buffer-substring + (buffer-substring (point) (min (point-max) (+ (length fill-prefix) (point)))))) (forward-char (length fill-prefix))) @@ -1068,7 +1261,7 @@ extra spaces between words. It does nothing in other justification modes." (defun unjustify-region (&optional begin end) "Remove justification whitespace from region. For centered or right-justified regions, this function removes any indentation -past the left margin from each line. For full-justified lines, it removes +past the left margin from each line. For full-justified lines, it removes extra spaces between words. It does nothing in other justification modes. Arguments BEGIN and END are optional; default is the whole buffer." (save-excursion @@ -1089,12 +1282,12 @@ in the paragraph. When calling from a program, pass range to fill as first two arguments. -Optional third and fourth arguments JUSTIFY and MAIL-FLAG: -JUSTIFY to justify paragraphs (prefix arg), +Optional third and fourth arguments JUSTIFYP and CITATION-REGEXP: +JUSTIFYP to justify paragraphs (prefix arg). When filling a mail message, pass a regexp for CITATION-REGEXP which will match the prefix of a line which is a citation marker plus whitespace, but no other kind of prefix. -Also, if CITATION-REGEXP is non-nil, don't fill header lines." +Also, if CITATION-REGEXP is non-nil, don't fill header lines." (interactive (progn (barf-if-buffer-read-only) (list (region-beginning) (region-end) @@ -1104,7 +1297,7 @@ Also, if CITATION-REGEXP is non-nil, don't fill header lines." (defun fill-individual-paragraphs (min max &optional justify citation-regexp) "Fill paragraphs of uniform indentation within the region. -This command divides the region into \"paragraphs\", +This command divides the region into \"paragraphs\", treating every change in indentation level or prefix as a paragraph boundary, then fills each paragraph using its indentation level as the fill prefix. @@ -1124,7 +1317,7 @@ JUSTIFY to justify paragraphs (prefix arg), When filling a mail message, pass a regexp for CITATION-REGEXP which will match the prefix of a line which is a citation marker plus whitespace, but no other kind of prefix. -Also, if CITATION-REGEXP is non-nil, don't fill header lines." +Also, if CITATION-REGEXP is non-nil, don't fill header lines." (interactive (progn (barf-if-buffer-read-only) (list (region-beginning) (region-end) @@ -1143,7 +1336,7 @@ Also, if CITATION-REGEXP is non-nil, don't fill header lines." (forward-line 1)))) (narrow-to-region (point) max) ;; Loop over paragraphs. - (while (let ((here (point))) + (while (progn ;; Skip over all paragraph-separating lines ;; so as to not include them in any paragraph. (while (and (not (eobp)) @@ -1176,7 +1369,7 @@ Also, if CITATION-REGEXP is non-nil, don't fill header lines." (if fill-individual-varying-indent ;; If this line is a separator line, with or ;; without prefix, end the paragraph. - (and + (and (not (looking-at paragraph-separate)) (save-excursion (not (and (looking-at fill-prefix-regexp) @@ -1190,9 +1383,9 @@ Also, if CITATION-REGEXP is non-nil, don't fill header lines." ;; If fill prefix is shorter than a new ;; fill prefix computed here, end paragraph. (let ((this-line-fill-prefix - (fill-individual-paragraphs-prefix + (fill-individual-paragraphs-prefix citation-regexp))) - (>= (length fill-prefix) + (>= (length fill-prefix) (length this-line-fill-prefix))) (save-excursion (not (progn (forward-char @@ -1251,4 +1444,5 @@ Also, if CITATION-REGEXP is non-nil, don't fill header lines." "") string)) +;; arch-tag: 727ad455-1161-4fa9-8df5-0f74b179216d ;;; fill.el ends here