Commit | Line | Data |
---|---|---|
ac249c4c | 1 | ;;; fill.el --- fill commands for Emacs -*- coding: iso-2022-7bit -*- |
c0274f38 | 2 | |
d95da8d3 | 3 | ;; Copyright (C) 1985, 1986, 1992, 1994, 1995, 1996, 1997, 1999, 2001, 2002, |
12dc447f | 4 | ;; 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. |
f53a262d | 5 | |
6228c05b | 6 | ;; Maintainer: FSF |
3a801d0c ER |
7 | ;; Keywords: wp |
8 | ||
f53a262d | 9 | ;; This file is part of GNU Emacs. |
10 | ||
11 | ;; GNU Emacs is free software; you can redistribute it and/or modify | |
12 | ;; it under the terms of the GNU General Public License as published by | |
5a9dffec | 13 | ;; the Free Software Foundation; either version 3, or (at your option) |
f53a262d | 14 | ;; any later version. |
15 | ||
16 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
19 | ;; GNU General Public License for more details. | |
20 | ||
21 | ;; You should have received a copy of the GNU General Public License | |
b578f267 | 22 | ;; along with GNU Emacs; see the file COPYING. If not, write to the |
4fc5845f LK |
23 | ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
24 | ;; Boston, MA 02110-1301, USA. | |
f53a262d | 25 | |
e41b2db1 ER |
26 | ;;; Commentary: |
27 | ||
28 | ;; All the commands for filling text. These are documented in the Emacs | |
29 | ;; manual. | |
30 | ||
e5167999 | 31 | ;;; Code: |
f53a262d | 32 | |
e4b7444d SM |
33 | (defgroup fill nil |
34 | "Indenting and filling text." | |
4efbcf61 | 35 | :link '(custom-manual "(emacs)Filling") |
e4b7444d SM |
36 | :group 'editing) |
37 | ||
9d325ebf | 38 | (defcustom fill-individual-varying-indent nil |
e065a56e JB |
39 | "*Controls criterion for a new paragraph in `fill-individual-paragraphs'. |
40 | Non-nil means changing indent doesn't end a paragraph. | |
41 | That mode can handle paragraphs with extra indentation on the first line, | |
42 | but it requires separator lines between paragraphs. | |
9d325ebf RS |
43 | A value of nil means that any change in indentation starts a new paragraph." |
44 | :type 'boolean | |
45 | :group 'fill) | |
8f985fe2 | 46 | |
9d325ebf RS |
47 | (defcustom colon-double-space nil |
48 | "*Non-nil means put two spaces after a colon when filling." | |
49 | :type 'boolean | |
50 | :group 'fill) | |
119d72b6 | 51 | ;;;###autoload(put 'colon-double-space 'safe-local-variable 'booleanp) |
68152e8f | 52 | |
86dfb30a | 53 | (defvar fill-paragraph-function nil |
3103b038 | 54 | "Mode-specific function to fill a paragraph, or nil if there is none. |
bbc02d00 RS |
55 | If the function returns nil, then `fill-paragraph' does its normal work. |
56 | A value of t means explicitly \"do nothing special\".") | |
86dfb30a | 57 | |
3d9ce27e | 58 | (defvar fill-paragraph-handle-comment t |
e4b7444d | 59 | "Non-nil means paragraph filling will try to pay attention to comments.") |
3d9ce27e | 60 | |
e4b7444d SM |
61 | (defcustom enable-kinsoku t |
62 | "*Non-nil means enable \"kinsoku\" processing on filling paragraphs. | |
4dc0f0fc RS |
63 | Kinsoku processing is designed to prevent certain characters from being |
64 | placed at the beginning or end of a line by filling. | |
e4b7444d | 65 | See the documentation of `kinsoku' for more information." |
f5307782 JB |
66 | :type 'boolean |
67 | :group 'fill) | |
c9d611f4 | 68 | |
f53a262d | 69 | (defun set-fill-prefix () |
8f985fe2 | 70 | "Set the fill prefix to the current line up to point. |
54d7f650 RS |
71 | Filling expects lines to start with the fill prefix and |
72 | reinserts the fill prefix in each resulting line." | |
f53a262d | 73 | (interactive) |
2441692d GM |
74 | (let ((left-margin-pos (save-excursion (move-to-left-margin) (point)))) |
75 | (if (> (point) left-margin-pos) | |
76 | (progn | |
77 | (setq fill-prefix (buffer-substring left-margin-pos (point))) | |
78 | (if (equal fill-prefix "") | |
79 | (setq fill-prefix nil))) | |
80 | (setq fill-prefix nil))) | |
f53a262d | 81 | (if fill-prefix |
82 | (message "fill-prefix: \"%s\"" fill-prefix) | |
83 | (message "fill-prefix cancelled"))) | |
84 | ||
9d325ebf RS |
85 | (defcustom adaptive-fill-mode t |
86 | "*Non-nil means determine a paragraph's fill prefix from its text." | |
87 | :type 'boolean | |
88 | :group 'fill) | |
54d7f650 | 89 | |
742c1822 | 90 | (defcustom adaptive-fill-regexp |
d47e9c06 SM |
91 | ;; Added `!' for doxygen comments starting with `//!' or `/*!'. |
92 | ;; Added `%' for TeX comments. | |
4e05bbf5 RS |
93 | ;; RMS: deleted the code to match `1.' and `(1)'. |
94 | "[ \t]*\\([-!|#%;>*\e,A7\e$,1s"s#sC\e$,2"F\e(B]+[ \t]*\\)*" | |
54d7f650 | 95 | "*Regexp to match text at start of line that constitutes indentation. |
849f04e1 RS |
96 | If Adaptive Fill mode is enabled, a prefix matching this pattern |
97 | on the first and second lines of a paragraph is used as the | |
98 | standard indentation for the whole paragraph. | |
99 | ||
100 | If the paragraph has just one line, the indentation is taken from that | |
101 | line, but in that case `adaptive-fill-first-line-regexp' also plays | |
102 | a role." | |
103 | :type 'regexp | |
104 | :group 'fill) | |
105 | ||
21942e01 | 106 | (defcustom adaptive-fill-first-line-regexp "\\`[ \t]*\\'" |
849f04e1 RS |
107 | "*Regexp specifying whether to set fill prefix from a one-line paragraph. |
108 | When a paragraph has just one line, then after `adaptive-fill-regexp' | |
109 | finds the prefix at the beginning of the line, if it doesn't | |
110 | match this regexp, it is replaced with whitespace. | |
111 | ||
112 | By default, this regexp matches sequences of just spaces and tabs. | |
113 | ||
114 | However, we never use a prefix from a one-line paragraph | |
115 | if it would act as a paragraph-starter on the second line." | |
9d325ebf RS |
116 | :type 'regexp |
117 | :group 'fill) | |
54d7f650 | 118 | |
9d325ebf | 119 | (defcustom adaptive-fill-function nil |
efffe5a3 JB |
120 | "Function to call to choose a fill prefix for a paragraph, or nil. |
121 | A nil value means the function has not determined the fill prefix." | |
ef4d4394 | 122 | :type '(choice (const nil) function) |
9d325ebf | 123 | :group 'fill) |
68152e8f | 124 | |
4bcb1be1 | 125 | (defvar fill-indent-according-to-mode nil ;Screws up CC-mode's filling tricks. |
178932de SM |
126 | "Whether or not filling should try to use the major mode's indentation.") |
127 | ||
0cb08f98 RS |
128 | (defun current-fill-column () |
129 | "Return the fill-column to use for this line. | |
130 | The fill-column to use for a buffer is stored in the variable `fill-column', | |
131 | but can be locally modified by the `right-margin' text property, which is | |
132 | subtracted from `fill-column'. | |
133 | ||
134 | The fill column to use for a line is the first column at which the column | |
135 | number equals or exceeds the local fill-column - right-margin difference." | |
136 | (save-excursion | |
1e87252c RS |
137 | (if fill-column |
138 | (let* ((here (progn (beginning-of-line) (point))) | |
139 | (here-col 0) | |
140 | (eol (progn (end-of-line) (point))) | |
141 | margin fill-col change col) | |
742c1822 DL |
142 | ;; Look separately at each region of line with a different |
143 | ;; right-margin. | |
1e87252c RS |
144 | (while (and (setq margin (get-text-property here 'right-margin) |
145 | fill-col (- fill-column (or margin 0)) | |
146 | change (text-property-not-all | |
147 | here eol 'right-margin margin)) | |
148 | (progn (goto-char (1- change)) | |
149 | (setq col (current-column)) | |
150 | (< col fill-col))) | |
151 | (setq here change | |
152 | here-col col)) | |
153 | (max here-col fill-col))))) | |
0cb08f98 RS |
154 | |
155 | (defun canonically-space-region (beg end) | |
156 | "Remove extra spaces between words in region. | |
8c379895 | 157 | Leave one space between words, two at end of sentences or after colons |
ce82deed KH |
158 | \(depending on values of `sentence-end-double-space', `colon-double-space', |
159 | and `sentence-end-without-period'). | |
34a5f45f | 160 | Remove indentation from each line." |
369aeb97 | 161 | (interactive "*r") |
4b880ac1 SM |
162 | ;; Ideally, we'd want to scan the text from the end, so that changes to |
163 | ;; text don't affect the boundary, but the regexp we match against does | |
164 | ;; not match as eagerly when matching backward, so we instead use | |
165 | ;; a marker. | |
166 | (unless (markerp end) (setq end (copy-marker end t))) | |
20796cbc | 167 | (let ((end-spc-re (concat "\\(" (sentence-end) "\\) *\\| +"))) |
bb424945 SM |
168 | (save-excursion |
169 | (goto-char beg) | |
170 | ;; Nuke tabs; they get screwed up in a fill. | |
171 | ;; This is quick, but loses when a tab follows the end of a sentence. | |
172 | ;; Actually, it is difficult to tell that from "Mr.\tSmith". | |
173 | ;; Blame the typist. | |
8ad8316c | 174 | (subst-char-in-region beg end ?\t ?\s) |
ea9ae18a | 175 | (while (and (< (point) end) |
bb424945 SM |
176 | (re-search-forward end-spc-re end t)) |
177 | (delete-region | |
178 | (cond | |
179 | ;; `sentence-end' matched and did not match all spaces. | |
180 | ;; I.e. it only matched the number of spaces it needs: drop the rest. | |
181 | ((and (match-end 1) (> (match-end 0) (match-end 1))) (match-end 1)) | |
182 | ;; `sentence-end' matched but with nothing left. Either that means | |
183 | ;; nothing should be removed, or it means it's the "old-style" | |
184 | ;; sentence-end which matches all it can. Keep only 2 spaces. | |
185 | ;; We probably don't even need to check `sentence-end-double-space'. | |
186 | ((match-end 1) | |
187 | (min (match-end 0) | |
188 | (+ (if sentence-end-double-space 2 1) | |
189 | (save-excursion (goto-char (match-end 0)) | |
190 | (skip-chars-backward " ") | |
191 | (point))))) | |
192 | (t ;; It's not an end of sentence. | |
193 | (+ (match-beginning 0) | |
194 | ;; Determine number of spaces to leave: | |
195 | (save-excursion | |
196 | (skip-chars-backward " ]})\"'") | |
197 | (cond ((and sentence-end-double-space | |
198 | (or (memq (preceding-char) '(?. ?? ?!)) | |
199 | (and sentence-end-without-period | |
200 | (= (char-syntax (preceding-char)) ?w)))) 2) | |
201 | ((and colon-double-space | |
202 | (= (preceding-char) ?:)) 2) | |
203 | ((char-equal (preceding-char) ?\n) 0) | |
204 | (t 1)))))) | |
205 | (match-end 0)))))) | |
0cb08f98 | 206 | |
7190ab87 GM |
207 | (defun fill-common-string-prefix (s1 s2) |
208 | "Return the longest common prefix of strings S1 and S2, or nil if none." | |
209 | (let ((cmp (compare-strings s1 nil nil s2 nil nil))) | |
178932de | 210 | (if (eq cmp t) |
7190ab87 GM |
211 | s1 |
212 | (setq cmp (1- (abs cmp))) | |
213 | (unless (zerop cmp) | |
214 | (substring s1 0 cmp))))) | |
db95369b | 215 | |
d95da8d3 SM |
216 | (defun fill-match-adaptive-prefix () |
217 | (let ((str (or | |
218 | (and adaptive-fill-function (funcall adaptive-fill-function)) | |
219 | (and adaptive-fill-regexp (looking-at adaptive-fill-regexp) | |
220 | (match-string-no-properties 0))))) | |
221 | (if (>= (+ (current-left-margin) (length str)) (current-fill-column)) | |
222 | ;; Death to insanely long prefixes. | |
223 | nil | |
224 | str))) | |
225 | ||
0bcfa3ac | 226 | (defun fill-context-prefix (from to &optional first-line-regexp) |
d09d7ba9 | 227 | "Compute a fill prefix from the text between FROM and TO. |
39f5988d | 228 | This uses the variables `adaptive-fill-regexp' and `adaptive-fill-function' |
849f04e1 RS |
229 | and `adaptive-fill-first-line-regexp'. `paragraph-start' also plays a role; |
230 | we reject a prefix based on a one-line paragraph if that prefix would | |
231 | act as a paragraph-separator." | |
232 | (or first-line-regexp | |
233 | (setq first-line-regexp adaptive-fill-first-line-regexp)) | |
d09d7ba9 RS |
234 | (save-excursion |
235 | (goto-char from) | |
236 | (if (eolp) (forward-line 1)) | |
237 | ;; Move to the second line unless there is just one. | |
6d1f0a5e | 238 | (move-to-left-margin) |
d95da8d3 | 239 | (let (first-line-prefix |
0bcfa3ac | 240 | ;; Non-nil if we are on the second line. |
d95da8d3 | 241 | second-line-prefix) |
b5263b80 | 242 | (setq first-line-prefix |
3212cc84 SM |
243 | ;; We don't need to consider `paragraph-start' here since it |
244 | ;; will be explicitly checked later on. | |
245 | ;; Also setting first-line-prefix to nil prevents | |
246 | ;; second-line-prefix from being used. | |
d95da8d3 SM |
247 | ;; ((looking-at paragraph-start) nil) |
248 | (fill-match-adaptive-prefix)) | |
d09d7ba9 | 249 | (forward-line 1) |
03e3e2e9 | 250 | (if (< (point) to) |
d95da8d3 SM |
251 | (progn |
252 | (move-to-left-margin) | |
253 | (setq second-line-prefix | |
254 | (cond ((looking-at paragraph-start) nil) ;Can it happen? -Stef | |
255 | (t (fill-match-adaptive-prefix)))) | |
256 | ;; If we get a fill prefix from the second line, | |
257 | ;; make sure it or something compatible is on the first line too. | |
258 | (when second-line-prefix | |
259 | (unless first-line-prefix (setq first-line-prefix "")) | |
260 | ;; If the non-whitespace chars match the first line, | |
261 | ;; just use it (this subsumes the 2 checks used previously). | |
262 | ;; Used when first line is `/* ...' and second-line is | |
263 | ;; ` * ...'. | |
264 | (let ((tmp second-line-prefix) | |
265 | (re "\\`")) | |
266 | (while (string-match "\\`[ \t]*\\([^ \t]+\\)" tmp) | |
267 | (setq re (concat re ".*" (regexp-quote (match-string 1 tmp)))) | |
268 | (setq tmp (substring tmp (match-end 0)))) | |
269 | ;; (assert (string-match "\\`[ \t]*\\'" tmp)) | |
270 | ||
271 | (if (string-match re first-line-prefix) | |
272 | second-line-prefix | |
273 | ||
274 | ;; Use the longest common substring of both prefixes, | |
275 | ;; if there is one. | |
276 | (fill-common-string-prefix first-line-prefix | |
277 | second-line-prefix))))) | |
b5263b80 RS |
278 | ;; If we get a fill prefix from a one-line paragraph, |
279 | ;; maybe change it to whitespace, | |
280 | ;; and check that it isn't a paragraph starter. | |
281 | (if first-line-prefix | |
282 | (let ((result | |
283 | ;; If first-line-prefix comes from the first line, | |
284 | ;; see if it seems reasonable to use for all lines. | |
285 | ;; If not, replace it with whitespace. | |
286 | (if (or (and first-line-regexp | |
287 | (string-match first-line-regexp | |
288 | first-line-prefix)) | |
289 | (and comment-start-skip | |
290 | (string-match comment-start-skip | |
291 | first-line-prefix))) | |
292 | first-line-prefix | |
8ad8316c | 293 | (make-string (string-width first-line-prefix) ?\s)))) |
b5263b80 RS |
294 | ;; But either way, reject it if it indicates the start |
295 | ;; of a paragraph when text follows it. | |
296 | (if (not (eq 0 (string-match paragraph-start | |
297 | (concat result "a")))) | |
44a0dbd7 | 298 | result))))))) |
d09d7ba9 | 299 | |
03e3e2e9 SM |
300 | (defun fill-single-word-nobreak-p () |
301 | "Don't break a line after the first or before the last word of a sentence." | |
4a3608f5 SM |
302 | ;; Actually, allow breaking before the last word of a sentence, so long as |
303 | ;; it's not the last word of the paragraph. | |
304 | (or (looking-at (concat "[ \t]*\\sw+" "\\(?:" (sentence-end) "\\)[ \t]*$")) | |
03e3e2e9 SM |
305 | (save-excursion |
306 | (skip-chars-backward " \t") | |
307 | (and (/= (skip-syntax-backward "w") 0) | |
308 | (/= (skip-chars-backward " \t") 0) | |
74f36ff0 JL |
309 | (/= (skip-chars-backward ".?!:") 0) |
310 | (looking-at (sentence-end)))))) | |
03e3e2e9 SM |
311 | |
312 | (defun fill-french-nobreak-p () | |
313 | "Return nil if French style allows breaking the line at point. | |
314 | This is used in `fill-nobreak-predicate' to prevent breaking lines just | |
315 | after an opening paren or just before a closing paren or a punctuation | |
316 | mark such as `?' or `:'. It is common in French writing to put a space | |
317 | at such places, which would normally allow breaking the line at those | |
318 | places." | |
eaa872bb | 319 | (or (looking-at "[ \t]*[])}\e,A;\e,b;\e(B?!;:-]") |
03e3e2e9 SM |
320 | (save-excursion |
321 | (skip-chars-backward " \t") | |
322 | (unless (bolp) | |
323 | (backward-char 1) | |
eaa872bb | 324 | (or (looking-at "[([{\e,A+\e,b+\e(B]") |
03e3e2e9 | 325 | ;; Don't cut right after a single-letter word. |
8ad8316c | 326 | (and (memq (preceding-char) '(?\t ?\s)) |
03e3e2e9 SM |
327 | (eq (char-syntax (following-char)) ?w))))))) |
328 | ||
329 | (defcustom fill-nobreak-predicate nil | |
330 | "List of predicates for recognizing places not to break a line. | |
331 | The predicates are called with no arguments, with point at the place to | |
332 | be tested. If it returns t, fill commands do not break the line there." | |
333 | :group 'fill | |
334 | :type 'hook | |
335 | :options '(fill-french-nobreak-p fill-single-word-nobreak-p)) | |
336 | ||
1b457e18 | 337 | (defcustom fill-nobreak-invisible nil |
e4b7444d | 338 | "Non-nil means that fill commands do not break lines in invisible text." |
1b457e18 KS |
339 | :type 'boolean |
340 | :group 'fill) | |
341 | ||
03e3e2e9 SM |
342 | (defun fill-nobreak-p () |
343 | "Return nil if breaking the line at point is allowed. | |
1b457e18 KS |
344 | Can be customized with the variables `fill-nobreak-predicate' |
345 | and `fill-nobreak-invisible'." | |
346 | (or | |
d95da8d3 | 347 | (and fill-nobreak-invisible (line-move-invisible-p (point))) |
1b457e18 | 348 | (unless (bolp) |
03e3e2e9 SM |
349 | (or |
350 | ;; Don't break after a period followed by just one space. | |
351 | ;; Move back to the previous place to break. | |
352 | ;; The reason is that if a period ends up at the end of a | |
353 | ;; line, further fills will assume it ends a sentence. | |
354 | ;; If we now know it does not end a sentence, avoid putting | |
d47e9c06 | 355 | ;; it at the end of the line. |
03e3e2e9 SM |
356 | (and sentence-end-double-space |
357 | (save-excursion | |
08150aa0 JL |
358 | (skip-chars-backward " ") |
359 | (and (eq (preceding-char) ?.) | |
360 | (looking-at " \\([^ ]\\|$\\)")))) | |
03e3e2e9 SM |
361 | ;; Another approach to the same problem. |
362 | (save-excursion | |
08150aa0 JL |
363 | (skip-chars-backward " ") |
364 | (and (eq (preceding-char) ?.) | |
365 | (not (progn (forward-char -1) (looking-at (sentence-end)))))) | |
03e3e2e9 SM |
366 | ;; Don't split a line if the rest would look like a new paragraph. |
367 | (unless use-hard-newlines | |
368 | (save-excursion | |
1637ed87 RS |
369 | (skip-chars-forward " \t") |
370 | ;; If this break point is at the end of the line, | |
371 | ;; which can occur for auto-fill, don't consider the newline | |
372 | ;; which follows as a reason to return t. | |
373 | (and (not (eolp)) | |
374 | (looking-at paragraph-start)))) | |
1b457e18 | 375 | (run-hook-with-args-until-success 'fill-nobreak-predicate))))) |
a0d8840a | 376 | |
ce82deed KH |
377 | ;; Put `fill-find-break-point-function' property to charsets which |
378 | ;; require special functions to find line breaking point. | |
03e3e2e9 | 379 | (dolist (pair '((katakana-jisx0201 . kinsoku) |
2f4fa275 SM |
380 | (chinese-gb2312 . kinsoku) |
381 | (japanese-jisx0208 . kinsoku) | |
382 | (japanese-jisx0212 . kinsoku) | |
383 | (chinese-big5-1 . kinsoku) | |
03e3e2e9 SM |
384 | (chinese-big5-2 . kinsoku))) |
385 | (put-charset-property (car pair) 'fill-find-break-point-function (cdr pair))) | |
97323804 | 386 | |
ce82deed KH |
387 | (defun fill-find-break-point (limit) |
388 | "Move point to a proper line breaking position of the current line. | |
97323804 KH |
389 | Don't move back past the buffer position LIMIT. |
390 | ||
ce82deed | 391 | This function is called when we are going to break the current line |
e4b7444d | 392 | after or before a non-ASCII character. If the charset of the |
ce82deed | 393 | character has the property `fill-find-break-point-function', this |
a5af675e | 394 | function calls the property value as a function with one arg LIMIT. |
ce82deed KH |
395 | If the charset has no such property, do nothing." |
396 | (let* ((ch (following-char)) | |
397 | (charset (char-charset ch)) | |
398 | func) | |
399 | (if (eq charset 'ascii) | |
400 | (setq ch (preceding-char) | |
401 | charset (char-charset ch))) | |
b1376368 KH |
402 | (if (charsetp charset) |
403 | (setq func | |
404 | (get-charset-property charset 'fill-find-break-point-function))) | |
34a500b3 KH |
405 | (if (and func (fboundp func)) |
406 | (funcall func limit)))) | |
97323804 | 407 | |
2f4fa275 SM |
408 | (defun fill-delete-prefix (from to prefix) |
409 | "Delete the fill prefix from every line except the first. | |
410 | The first line may not even have a fill prefix. | |
411 | Point is moved to just past the fill prefix on the first line." | |
d47e9c06 SM |
412 | (let ((fpre (if (and prefix (not (string-match "\\`[ \t]*\\'" prefix))) |
413 | (concat "[ \t]*\\(" | |
414 | (replace-regexp-in-string | |
415 | "[ \t]+" "[ \t]*" | |
416 | (regexp-quote prefix)) | |
417 | "\\)?[ \t]*") | |
418 | "[ \t]*"))) | |
419 | (goto-char from) | |
55f6a280 SM |
420 | ;; Why signal an error here? The problem needs to be caught elsewhere. |
421 | ;; (if (>= (+ (current-left-margin) (length prefix)) | |
422 | ;; (current-fill-column)) | |
423 | ;; (error "fill-prefix too long for specified width")) | |
d47e9c06 SM |
424 | (forward-line 1) |
425 | (while (< (point) to) | |
2f4fa275 | 426 | (if (looking-at fpre) |
55f6a280 | 427 | (delete-region (point) (match-end 0))) |
d47e9c06 SM |
428 | (forward-line 1)) |
429 | (goto-char from) | |
430 | (if (looking-at fpre) | |
431 | (goto-char (match-end 0))) | |
55f6a280 | 432 | (point))) |
2f4fa275 | 433 | |
e3d2084c SM |
434 | ;; The `fill-space' property carries the string with which a newline |
435 | ;; should be replaced when unbreaking a line (in fill-delete-newlines). | |
436 | ;; It is added to newline characters by fill-newline when the default | |
437 | ;; behavior of fill-delete-newlines is not what we want. | |
438 | (add-to-list 'text-property-default-nonsticky '(fill-space . t)) | |
439 | ||
2f4fa275 SM |
440 | (defun fill-delete-newlines (from to justify nosqueeze squeeze-after) |
441 | (goto-char from) | |
442 | ;; Make sure sentences ending at end of line get an extra space. | |
443 | ;; loses on split abbrevs ("Mr.\nSmith") | |
d47e9c06 SM |
444 | (let ((eol-double-space-re |
445 | (cond | |
20796cbc | 446 | ((not colon-double-space) (concat (sentence-end) "$")) |
d47e9c06 | 447 | ;; Try to add the : inside the `sentence-end' regexp. |
20796cbc JL |
448 | ((string-match "\\[[^][]*\\(\\.\\)[^][]*\\]" (sentence-end)) |
449 | (concat (replace-match ".:" nil nil (sentence-end) 1) "$")) | |
d47e9c06 | 450 | ;; Can't find the right spot to insert the colon. |
f43a0b98 KH |
451 | (t "[.?!:][])}\"']*$"))) |
452 | (sentence-end-without-space-list | |
453 | (string-to-list sentence-end-without-space))) | |
2f4fa275 | 454 | (while (re-search-forward eol-double-space-re to t) |
8ad8316c | 455 | (or (>= (point) to) (memq (char-before) '(?\t ?\s)) |
e4b7444d | 456 | (memq (char-after (match-beginning 0)) |
f43a0b98 | 457 | sentence-end-without-space-list) |
8ad8316c | 458 | (insert-and-inherit ?\s)))) |
2f4fa275 SM |
459 | |
460 | (goto-char from) | |
461 | (if enable-multibyte-characters | |
462 | ;; Delete unnecessay newlines surrounded by words. The | |
463 | ;; character category `|' means that we can break a line | |
464 | ;; at the character. And, charset property | |
465 | ;; `nospace-between-words' tells how to concatenate | |
466 | ;; words. If the value is non-nil, never put spaces | |
467 | ;; between words, thus delete a newline between them. | |
468 | ;; If the value is nil, delete a newline only when a | |
469 | ;; character preceding a newline has text property | |
470 | ;; `nospace-between-words'. | |
471 | (while (search-forward "\n" to t) | |
e3d2084c SM |
472 | (if (get-text-property (match-beginning 0) 'fill-space) |
473 | (replace-match (get-text-property (match-beginning 0) 'fill-space)) | |
474 | (let ((prev (char-before (match-beginning 0))) | |
475 | (next (following-char))) | |
476 | (if (and (or (aref (char-category-set next) ?|) | |
477 | (aref (char-category-set prev) ?|)) | |
478 | (or (get-charset-property (char-charset prev) | |
479 | 'nospace-between-words) | |
480 | (get-text-property (1- (match-beginning 0)) | |
481 | 'nospace-between-words))) | |
482 | (delete-char -1)))))) | |
2f4fa275 SM |
483 | |
484 | (goto-char from) | |
485 | (skip-chars-forward " \t") | |
486 | ;; Then change all newlines to spaces. | |
8ad8316c | 487 | (subst-char-in-region from to ?\n ?\s) |
2f4fa275 SM |
488 | (if (and nosqueeze (not (eq justify 'full))) |
489 | nil | |
51153542 SM |
490 | (canonically-space-region (or squeeze-after (point)) to) |
491 | ;; Remove trailing whitespace. | |
492 | ;; Maybe canonically-space-region should do that. | |
05670fa8 | 493 | (goto-char to) (delete-char (- (skip-chars-backward " \t")))) |
2f4fa275 SM |
494 | (goto-char from)) |
495 | ||
d47e9c06 SM |
496 | (defun fill-move-to-break-point (linebeg) |
497 | "Move to the position where the line should be broken. | |
bb424945 SM |
498 | The break position will be always after LINEBEG and generally before point." |
499 | ;; If the fill column is before linebeg, move to linebeg. | |
500 | (if (> linebeg (point)) (goto-char linebeg)) | |
d47e9c06 SM |
501 | ;; Move back to the point where we can break the line |
502 | ;; at. We break the line between word or after/before | |
503 | ;; the character which has character category `|'. We | |
504 | ;; search space, \c| followed by a character, or \c| | |
505 | ;; following a character. If not found, place | |
506 | ;; the point at linebeg. | |
507 | (while | |
508 | (when (re-search-backward "[ \t]\\|\\c|.\\|.\\c|" linebeg 0) | |
509 | ;; In case of space, we place the point at next to | |
510 | ;; the point where the break occurs actually, | |
511 | ;; because we don't want to change the following | |
512 | ;; logic of original Emacs. In case of \c|, the | |
513 | ;; point is at the place where the break occurs. | |
514 | (forward-char 1) | |
515 | (when (fill-nobreak-p) (skip-chars-backward " \t" linebeg)))) | |
ef11ff9b SM |
516 | |
517 | ;; Move back over the single space between the words. | |
518 | (skip-chars-backward " \t") | |
519 | ||
d47e9c06 SM |
520 | ;; If the left margin and fill prefix by themselves |
521 | ;; pass the fill-column. or if they are zero | |
522 | ;; but we have no room for even one word, | |
523 | ;; keep at least one word or a character which has | |
524 | ;; category `|' anyway. | |
525 | (if (>= linebeg (point)) | |
526 | ;; Ok, skip at least one word or one \c| character. | |
527 | ;; Meanwhile, don't stop at a period followed by one space. | |
528 | (let ((to (line-end-position)) | |
d47e9c06 SM |
529 | (first t)) |
530 | (goto-char linebeg) | |
531 | (while (and (< (point) to) (or first (fill-nobreak-p))) | |
532 | ;; Find a breakable point while ignoring the | |
533 | ;; following spaces. | |
534 | (skip-chars-forward " \t") | |
535 | (if (looking-at "\\c|") | |
536 | (forward-char 1) | |
537 | (let ((pos (save-excursion | |
538 | (skip-chars-forward "^ \n\t") | |
539 | (point)))) | |
540 | (if (re-search-forward "\\c|" pos t) | |
541 | (forward-char -1) | |
542 | (goto-char pos)))) | |
543 | (setq first nil))) | |
d47e9c06 SM |
544 | |
545 | (if enable-multibyte-characters | |
546 | ;; If we are going to break the line after or | |
547 | ;; before a non-ascii character, we may have to | |
548 | ;; run a special function for the charset of the | |
549 | ;; character to find the correct break point. | |
550 | (if (not (and (eq (charset-after (1- (point))) 'ascii) | |
551 | (eq (charset-after (point)) 'ascii))) | |
552 | ;; Make sure we take SOMETHING after the fill prefix if any. | |
553 | (fill-find-break-point linebeg))))) | |
554 | ||
7c315e1c KH |
555 | ;; Like text-properties-at but don't include `composition' property. |
556 | (defun fill-text-properties-at (pos) | |
557 | (let ((l (text-properties-at pos)) | |
558 | prop-list) | |
559 | (while l | |
560 | (unless (eq (car l) 'composition) | |
561 | (setq prop-list | |
562 | (cons (car l) (cons (cadr l) prop-list)))) | |
563 | (setq l (cddr l))) | |
564 | prop-list)) | |
565 | ||
d47e9c06 SM |
566 | (defun fill-newline () |
567 | ;; Replace whitespace here with one newline, then | |
568 | ;; indent to left margin. | |
569 | (skip-chars-backward " \t") | |
d47e9c06 SM |
570 | (insert ?\n) |
571 | ;; Give newline the properties of the space(s) it replaces | |
572 | (set-text-properties (1- (point)) (point) | |
7c315e1c | 573 | (fill-text-properties-at (point))) |
e3d2084c SM |
574 | (and (looking-at "\\( [ \t]*\\)\\(\\c|\\)?") |
575 | (or (aref (char-category-set (or (char-before (1- (point))) ?\000)) ?|) | |
576 | (match-end 2)) | |
577 | ;; When refilling later on, this newline would normally not be replaced | |
578 | ;; by a space, so we need to mark it specially to re-install the space | |
579 | ;; when we unfill. | |
580 | (put-text-property (1- (point)) (point) 'fill-space (match-string 1))) | |
1b457e18 KS |
581 | ;; If we don't want breaks in invisible text, don't insert |
582 | ;; an invisible newline. | |
583 | (if fill-nobreak-invisible | |
584 | (remove-text-properties (1- (point)) (point) | |
585 | '(invisible t))) | |
d47e9c06 SM |
586 | (if (or fill-prefix |
587 | (not fill-indent-according-to-mode)) | |
f601aaf8 | 588 | (fill-indent-to-left-margin) |
d47e9c06 SM |
589 | (indent-according-to-mode)) |
590 | ;; Insert the fill prefix after indentation. | |
d47e9c06 | 591 | (and fill-prefix (not (equal fill-prefix "")) |
29c1653c SM |
592 | ;; Markers that were after the whitespace are now at point: insert |
593 | ;; before them so they don't get stuck before the prefix. | |
594 | (insert-before-markers-and-inherit fill-prefix))) | |
d47e9c06 | 595 | |
f601aaf8 RS |
596 | (defun fill-indent-to-left-margin () |
597 | "Indent current line to the column given by `current-left-margin'." | |
598 | (let ((beg (point))) | |
599 | (indent-line-to (current-left-margin)) | |
600 | (put-text-property beg (point) 'face 'default))) | |
601 | ||
8c379895 KH |
602 | (defun fill-region-as-paragraph (from to &optional justify |
603 | nosqueeze squeeze-after) | |
1095bc3c | 604 | "Fill the region as one paragraph. |
2b6eb8c6 | 605 | It removes any paragraph breaks in the region and extra newlines at the end, |
1095bc3c BG |
606 | indents and fills lines between the margins given by the |
607 | `current-left-margin' and `current-fill-column' functions. | |
368d104a | 608 | \(In most cases, the variable `fill-column' controls the width.) |
2b6eb8c6 | 609 | It leaves point at the beginning of the line following the paragraph. |
0cb08f98 | 610 | |
1095bc3c BG |
611 | Normally performs justification according to the `current-justification' |
612 | function, but with a prefix arg, does full justification instead. | |
613 | ||
614 | From a program, optional third arg JUSTIFY can specify any type of | |
8c379895 | 615 | justification. Fourth arg NOSQUEEZE non-nil means not to make spaces |
f3253b8f | 616 | between words canonical before filling. Fifth arg SQUEEZE-AFTER, if non-nil, |
8c379895 | 617 | means don't canonicalize spaces before that position. |
0cb08f98 | 618 | |
ef11ff9b | 619 | Return the `fill-prefix' used for filling. |
27849a65 | 620 | |
8f985fe2 | 621 | If `sentence-end-double-space' is non-nil, then period followed by one |
0cb08f98 | 622 | space does not end a sentence, so don't break a line there." |
369aeb97 DL |
623 | (interactive (progn |
624 | (barf-if-buffer-read-only) | |
625 | (list (region-beginning) (region-end) | |
626 | (if current-prefix-arg 'full)))) | |
d09af6a5 | 627 | (unless (memq justify '(t nil none full center left right)) |
73b33545 | 628 | (setq justify 'full)) |
1095bc3c | 629 | |
2b6eb8c6 | 630 | ;; Make sure "to" is the endpoint. |
1095bc3c BG |
631 | (goto-char (min from to)) |
632 | (setq to (max from to)) | |
2b6eb8c6 RS |
633 | ;; Ignore blank lines at beginning of region. |
634 | (skip-chars-forward " \t\n") | |
1095bc3c | 635 | |
2b6eb8c6 RS |
636 | (let ((from-plus-indent (point)) |
637 | (oneleft nil)) | |
638 | ||
5fc5b7e8 | 639 | (beginning-of-line) |
55f6a280 | 640 | ;; We used to round up to whole line, but that prevents us from |
5fc5b7e8 SM |
641 | ;; correctly handling filling of mixed code-and-comment where we do want |
642 | ;; to fill the comment but not the code. So only use (point) if it's | |
643 | ;; further than `from', which means that `from' is followed by some | |
644 | ;; number of empty lines. | |
645 | (setq from (max (point) from)) | |
db95369b | 646 | |
2b6eb8c6 | 647 | ;; Delete all but one soft newline at end of region. |
dcfe5c05 | 648 | ;; And leave TO before that one. |
2b6eb8c6 | 649 | (goto-char to) |
1095bc3c BG |
650 | (while (and (> (point) from) (eq ?\n (char-after (1- (point))))) |
651 | (if (and oneleft | |
652 | (not (and use-hard-newlines | |
653 | (get-text-property (1- (point)) 'hard)))) | |
654 | (delete-backward-char 1) | |
655 | (backward-char 1) | |
656 | (setq oneleft t))) | |
2f4fa275 | 657 | (setq to (copy-marker (point) t)) |
178932de SM |
658 | ;; ;; If there was no newline, and there is text in the paragraph, then |
659 | ;; ;; create a newline. | |
660 | ;; (if (and (not oneleft) (> to from-plus-indent)) | |
661 | ;; (newline)) | |
2b6eb8c6 RS |
662 | (goto-char from-plus-indent)) |
663 | ||
664 | (if (not (> to (point))) | |
d47e9c06 | 665 | nil ;; There is no paragraph, only whitespace: exit now. |
1095bc3c BG |
666 | |
667 | (or justify (setq justify (current-justification))) | |
668 | ||
669 | ;; Don't let Adaptive Fill mode alter the fill prefix permanently. | |
670 | (let ((fill-prefix fill-prefix)) | |
671 | ;; Figure out how this paragraph is indented, if desired. | |
2f4fa275 SM |
672 | (when (and adaptive-fill-mode |
673 | (or (null fill-prefix) (string= fill-prefix ""))) | |
674 | (setq fill-prefix (fill-context-prefix from to)) | |
675 | ;; Ignore a white-space only fill-prefix | |
676 | ;; if we indent-according-to-mode. | |
677 | (when (and fill-prefix fill-indent-according-to-mode | |
678 | (string-match "\\`[ \t]*\\'" fill-prefix)) | |
679 | (setq fill-prefix nil))) | |
0cb08f98 | 680 | |
1eb29f50 SM |
681 | (goto-char from) |
682 | (beginning-of-line) | |
683 | ||
684 | (if (not justify) ; filling disabled: just check indentation | |
685 | (progn | |
686 | (goto-char from) | |
d47e9c06 | 687 | (while (< (point) to) |
1eb29f50 SM |
688 | (if (and (not (eolp)) |
689 | (< (current-indentation) (current-left-margin))) | |
690 | (fill-indent-to-left-margin)) | |
691 | (forward-line 1))) | |
692 | ||
693 | (if use-hard-newlines | |
694 | (remove-list-of-text-properties from to '(hard))) | |
695 | ;; Make sure first line is indented (at least) to left margin... | |
696 | (if (or (memq justify '(right center)) | |
697 | (< (current-indentation) (current-left-margin))) | |
698 | (fill-indent-to-left-margin)) | |
699 | ;; Delete the fill-prefix from every line. | |
700 | (fill-delete-prefix from to fill-prefix) | |
701 | (setq from (point)) | |
702 | ||
703 | ;; FROM, and point, are now before the text to fill, | |
704 | ;; but after any fill prefix on the first line. | |
705 | ||
706 | (fill-delete-newlines from to justify nosqueeze squeeze-after) | |
707 | ||
708 | ;; This is the actual filling loop. | |
709 | (goto-char from) | |
710 | (let (linebeg) | |
711 | (while (< (point) to) | |
712 | (setq linebeg (point)) | |
9bcdf9a8 | 713 | (move-to-column (current-fill-column)) |
1eb29f50 SM |
714 | (if (when (< (point) to) |
715 | ;; Find the position where we'll break the line. | |
9bcdf9a8 | 716 | (forward-char 1) ;Use an immediately following space, if any. |
1eb29f50 SM |
717 | (fill-move-to-break-point linebeg) |
718 | ;; Check again to see if we got to the end of | |
719 | ;; the paragraph. | |
720 | (skip-chars-forward " \t") | |
721 | (< (point) to)) | |
722 | ;; Found a place to cut. | |
723 | (progn | |
724 | (fill-newline) | |
725 | (when justify | |
726 | ;; Justify the line just ended, if desired. | |
727 | (save-excursion | |
728 | (forward-line -1) | |
729 | (justify-current-line justify nil t)))) | |
730 | ||
731 | (goto-char to) | |
732 | ;; Justify this last line, if desired. | |
733 | (if justify (justify-current-line justify t t)))))) | |
734 | ;; Leave point after final newline. | |
735 | (goto-char to) | |
736 | (unless (eobp) (forward-char 1)) | |
27849a65 MB |
737 | ;; Return the fill-prefix we used |
738 | fill-prefix))) | |
739 | ||
740 | (defsubst skip-line-prefix (prefix) | |
741 | "If point is inside the string PREFIX at the beginning of line, move past it." | |
742 | (when (and prefix | |
743 | (< (- (point) (line-beginning-position)) (length prefix)) | |
744 | (save-excursion | |
745 | (beginning-of-line) | |
746 | (looking-at (regexp-quote prefix)))) | |
747 | (goto-char (match-end 0)))) | |
f53a262d | 748 | |
708ca5aa RS |
749 | (defun fill-minibuffer-function (arg) |
750 | "Fill a paragraph in the minibuffer, ignoring the prompt." | |
743a6977 | 751 | (save-restriction |
708ca5aa RS |
752 | (narrow-to-region (minibuffer-prompt-end) (point-max)) |
753 | (fill-paragraph arg))) | |
754 | ||
f53a262d | 755 | (defun fill-paragraph (arg) |
a9bdfaa4 EZ |
756 | "Fill paragraph at or after point. |
757 | ||
758 | If ARG is non-nil (interactively, with prefix argument), justify as well. | |
8f985fe2 | 759 | If `sentence-end-double-space' is non-nil, then period followed by one |
86dfb30a | 760 | space does not end a sentence, so don't break a line there. |
368d104a | 761 | the variable `fill-column' controls the width for filling. |
86dfb30a RS |
762 | |
763 | If `fill-paragraph-function' is non-nil, we call it (passing our | |
27849a65 MB |
764 | argument to it), and if it returns non-nil, we simply return its value. |
765 | ||
cb91b2c7 | 766 | If `fill-paragraph-function' is nil, return the `fill-prefix' used for filling." |
369aeb97 DL |
767 | (interactive (progn |
768 | (barf-if-buffer-read-only) | |
769 | (list (if current-prefix-arg 'full)))) | |
3d9ce27e | 770 | ;; First try fill-paragraph-function. |
bbc02d00 RS |
771 | (or (and (not (eq fill-paragraph-function t)) |
772 | (or fill-paragraph-function | |
c98f7365 | 773 | (and (minibufferp (current-buffer)) |
708ca5aa RS |
774 | (= 1 (point-min)))) |
775 | (let ((function (or fill-paragraph-function | |
776 | ;; In the minibuffer, don't count the width | |
777 | ;; of the prompt. | |
778 | 'fill-minibuffer-function)) | |
3d9ce27e SM |
779 | ;; If fill-paragraph-function is set, it probably takes care |
780 | ;; of comments and stuff. If not, it will have to set | |
781 | ;; fill-paragraph-handle-comment back to t explicitly or | |
782 | ;; return nil. | |
783 | (fill-paragraph-handle-comment nil) | |
bbc02d00 | 784 | (fill-paragraph-function t)) |
e86fe0d7 | 785 | (funcall function arg))) |
3d9ce27e SM |
786 | ;; Then try our syntax-aware filling code. |
787 | (and fill-paragraph-handle-comment | |
1ddad36e | 788 | ;; Our code only handles \n-terminated comments right now. |
f5e85051 | 789 | comment-start (equal comment-end "") |
3d9ce27e SM |
790 | (let ((fill-paragraph-handle-comment nil)) |
791 | (fill-comment-paragraph arg))) | |
792 | ;; If it all fails, default to the good ol' text paragraph filling. | |
bb801a42 | 793 | (let ((before (point)) |
1ddad36e | 794 | (paragraph-start paragraph-start) |
bb424945 SM |
795 | ;; Fill prefix used for filling the paragraph. |
796 | fill-pfx) | |
1ddad36e SM |
797 | ;; Try to prevent code sections and comment sections from being |
798 | ;; filled together. | |
799 | (when (and fill-paragraph-handle-comment comment-start-skip) | |
800 | (setq paragraph-start | |
801 | (concat paragraph-start "\\|[ \t]*\\(?:" | |
802 | comment-start-skip "\\)"))) | |
86dfb30a | 803 | (save-excursion |
87485959 SM |
804 | ;; To make sure the return value of forward-paragraph is meaningful, |
805 | ;; we have to start from the beginning of line, otherwise skipping | |
806 | ;; past the last few chars of a paragraph-separator would count as | |
807 | ;; a paragraph (and not skipping any chars at EOB would not count | |
808 | ;; as a paragraph even if it is). | |
809 | (move-to-left-margin) | |
3078db32 SM |
810 | (if (not (zerop (forward-paragraph))) |
811 | ;; There's no paragraph at or after point: give up. | |
812 | (setq fill-pfx "") | |
3078db32 SM |
813 | (let ((end (point)) |
814 | (beg (progn (backward-paragraph) (point)))) | |
815 | (goto-char before) | |
816 | (setq fill-pfx | |
817 | (if use-hard-newlines | |
818 | ;; Can't use fill-region-as-paragraph, since this | |
819 | ;; paragraph may still contain hard newlines. See | |
820 | ;; fill-region. | |
821 | (fill-region beg end arg) | |
822 | (fill-region-as-paragraph beg end arg)))))) | |
27849a65 | 823 | fill-pfx))) |
f53a262d | 824 | |
3d9ce27e SM |
825 | (defun fill-comment-paragraph (&optional justify) |
826 | "Fill current comment. | |
827 | If we're not in a comment, just return nil so that the caller | |
1ddad36e SM |
828 | can take care of filling. JUSTIFY is used as in `fill-paragraph'." |
829 | (comment-normalize-vars) | |
55f6a280 | 830 | (let (has-code-and-comment ; Non-nil if it contains code and a comment. |
1ddad36e | 831 | comin comstart) |
3d9ce27e SM |
832 | ;; Figure out what kind of comment we are looking at. |
833 | (save-excursion | |
834 | (beginning-of-line) | |
1ddad36e SM |
835 | (when (setq comstart (comment-search-forward (line-end-position) t)) |
836 | (setq comin (point)) | |
837 | (goto-char comstart) (skip-chars-backward " \t") | |
838 | (setq has-code-and-comment (not (bolp))))) | |
db95369b | 839 | |
1ddad36e | 840 | (if (not comstart) |
3d9ce27e SM |
841 | ;; Return nil, so the normal filling will take place. |
842 | nil | |
843 | ||
844 | ;; Narrow to include only the comment, and then fill the region. | |
1ddad36e | 845 | (let* ((fill-prefix fill-prefix) |
50ef8ff2 SM |
846 | (commark |
847 | (comment-string-strip (buffer-substring comstart comin) nil t)) | |
848 | (comment-re | |
af5debda SM |
849 | ;; A regexp more specialized than comment-start-skip, that only |
850 | ;; matches the current commark rather than any valid commark. | |
743a6977 | 851 | ;; |
af5debda SM |
852 | ;; The specialized regexp only works for "normal" comment |
853 | ;; syntax, not for Texinfo's "@c" (which can't be immediately | |
854 | ;; followed by word-chars) or Fortran's "C" (which needs to be | |
855 | ;; at bol), so check that comment-start-skip indeed allows the | |
856 | ;; commark to appear in the middle of the line and followed by | |
857 | ;; word chars. The choice of "\0" and "a" is mostly arbitrary. | |
858 | (if (string-match comment-start-skip (concat "\0" commark "a")) | |
859 | (concat "[ \t]*" (regexp-quote commark) | |
860 | ;; Make sure we only match comments that | |
861 | ;; use the exact same comment marker. | |
862 | "[^" (substring commark -1) "]") | |
863 | (concat "[ \t]*\\(?:" comment-start-skip "\\)"))) | |
864 | (comment-fill-prefix ; Compute a fill prefix. | |
1ddad36e SM |
865 | (save-excursion |
866 | (goto-char comstart) | |
867 | (if has-code-and-comment | |
8b44bc06 SM |
868 | (concat |
869 | (if (not indent-tabs-mode) | |
8ad8316c | 870 | (make-string (current-column) ?\s) |
8b44bc06 SM |
871 | (concat |
872 | (make-string (/ (current-column) tab-width) ?\t) | |
8ad8316c | 873 | (make-string (% (current-column) tab-width) ?\s))) |
8b44bc06 | 874 | (buffer-substring (point) comin)) |
1ddad36e SM |
875 | (buffer-substring (line-beginning-position) comin)))) |
876 | beg end) | |
877 | (save-excursion | |
878 | (save-restriction | |
879 | (beginning-of-line) | |
880 | (narrow-to-region | |
881 | ;; Find the first line we should include in the region to fill. | |
882 | (if has-code-and-comment | |
883 | (line-beginning-position) | |
884 | (save-excursion | |
885 | (while (and (zerop (forward-line -1)) | |
886 | (looking-at comment-re))) | |
887 | ;; We may have gone too far. Go forward again. | |
888 | (line-beginning-position | |
5a7139ee SM |
889 | (if (progn |
890 | (goto-char | |
891 | (or (comment-search-forward (line-end-position) t) | |
892 | (point))) | |
893 | (looking-at comment-re)) | |
55f6a280 SM |
894 | (progn (setq comstart (point)) 1) |
895 | (progn (setq comstart (point)) 2))))) | |
896 | ;; Find the beginning of the first line past the region to fill. | |
897 | (save-excursion | |
898 | (while (progn (forward-line 1) | |
899 | (looking-at comment-re))) | |
900 | (point))) | |
1ddad36e SM |
901 | ;; Obey paragraph starters and boundaries within comments. |
902 | (let* ((paragraph-separate | |
903 | ;; Use the default values since they correspond to | |
904 | ;; the values to use for plain text. | |
905 | (concat paragraph-separate "\\|[ \t]*\\(?:" | |
906 | comment-start-skip "\\)\\(?:" | |
907 | (default-value 'paragraph-separate) "\\)")) | |
908 | (paragraph-start | |
909 | (concat paragraph-start "\\|[ \t]*\\(?:" | |
910 | comment-start-skip "\\)\\(?:" | |
911 | (default-value 'paragraph-start) "\\)")) | |
55f6a280 | 912 | ;; We used to rely on fill-prefix to break paragraph at |
e4b7444d SM |
913 | ;; comment-starter changes, but it did not work for the |
914 | ;; first line (mixed comment&code). | |
915 | ;; We now use comment-re instead to "manually" make sure | |
916 | ;; we treat comment-marker changes as paragraph boundaries. | |
917 | ;; (paragraph-ignore-fill-prefix nil) | |
918 | ;; (fill-prefix comment-fill-prefix) | |
1ddad36e | 919 | (after-line (if has-code-and-comment |
1eb29f50 SM |
920 | (line-beginning-position 2)))) |
921 | (setq end (progn (forward-paragraph) (point))) | |
1ddad36e SM |
922 | ;; If this comment starts on a line with code, |
923 | ;; include that line in the filling. | |
924 | (setq beg (progn (backward-paragraph) | |
925 | (if (eq (point) after-line) | |
926 | (forward-line -1)) | |
1eb29f50 | 927 | (point))))) |
1ddad36e SM |
928 | |
929 | ;; Find the fill-prefix to use. | |
930 | (cond | |
55f6a280 | 931 | (fill-prefix) ; Use the user-provided fill prefix. |
1ddad36e SM |
932 | ((and adaptive-fill-mode ; Try adaptive fill mode. |
933 | (setq fill-prefix (fill-context-prefix beg end)) | |
934 | (string-match comment-start-skip fill-prefix))) | |
935 | (t | |
936 | (setq fill-prefix comment-fill-prefix))) | |
937 | ||
938 | ;; Don't fill with narrowing. | |
939 | (or | |
940 | (fill-region-as-paragraph | |
55f6a280 | 941 | (max comstart beg) end justify nil |
1ddad36e SM |
942 | ;; Don't canonicalize spaces within the code just before |
943 | ;; the comment. | |
944 | (save-excursion | |
945 | (goto-char beg) | |
946 | (if (looking-at fill-prefix) | |
947 | nil | |
948 | (re-search-forward comment-start-skip)))) | |
949 | ;; Make sure we don't return nil. | |
950 | t)))))) | |
3d9ce27e | 951 | |
0cb08f98 | 952 | (defun fill-region (from to &optional justify nosqueeze to-eop) |
f53a262d | 953 | "Fill each of the paragraphs in the region. |
73b33545 | 954 | A prefix arg means justify as well. |
368d104a | 955 | Ordinarily the variable `fill-column' controls the width. |
0cb08f98 | 956 | |
73b33545 RS |
957 | Noninteractively, the third argument JUSTIFY specifies which |
958 | kind of justification to do: `full', `left', `right', `center', | |
743a6977 JB |
959 | or `none' (equivalent to nil). A value of t means handle each |
960 | paragraph as specified by its text properties. | |
d09af6a5 | 961 | |
743a6977 JB |
962 | The fourth arg NOSQUEEZE non-nil means to leave whitespace other |
963 | than line breaks untouched, and fifth arg TO-EOP non-nil means | |
964 | to keep filling to the end of the paragraph (or next hard newline, | |
965 | if variable `use-hard-newlines' is on). | |
0cb08f98 | 966 | |
27849a65 MB |
967 | Return the fill-prefix used for filling the last paragraph. |
968 | ||
8f985fe2 RS |
969 | If `sentence-end-double-space' is non-nil, then period followed by one |
970 | space does not end a sentence, so don't break a line there." | |
369aeb97 DL |
971 | (interactive (progn |
972 | (barf-if-buffer-read-only) | |
973 | (list (region-beginning) (region-end) | |
974 | (if current-prefix-arg 'full)))) | |
d09af6a5 | 975 | (unless (memq justify '(t nil none full center left right)) |
73b33545 | 976 | (setq justify 'full)) |
ef11ff9b SM |
977 | (let (max beg fill-pfx) |
978 | (goto-char (max from to)) | |
979 | (when to-eop | |
980 | (skip-chars-backward "\n") | |
981 | (forward-paragraph)) | |
982 | (setq max (copy-marker (point) t)) | |
983 | (goto-char (setq beg (min from to))) | |
984 | (beginning-of-line) | |
985 | (while (< (point) max) | |
986 | (let ((initial (point)) | |
987 | end) | |
988 | ;; If using hard newlines, break at every one for filling | |
989 | ;; purposes rather than using paragraph breaks. | |
990 | (if use-hard-newlines | |
991 | (progn | |
992 | (while (and (setq end (text-property-any (point) max | |
993 | 'hard t)) | |
994 | (not (= ?\n (char-after end))) | |
995 | (not (>= end max))) | |
996 | (goto-char (1+ end))) | |
997 | (setq end (if end (min max (1+ end)) max)) | |
998 | (goto-char initial)) | |
999 | (forward-paragraph 1) | |
1000 | (setq end (min max (point))) | |
1001 | (forward-paragraph -1)) | |
1002 | (if (< (point) beg) | |
1003 | (goto-char beg)) | |
1004 | (if (>= (point) initial) | |
1005 | (setq fill-pfx | |
1006 | (fill-region-as-paragraph (point) end justify nosqueeze)) | |
1007 | (goto-char end)))) | |
1008 | fill-pfx)) | |
f53a262d | 1009 | |
0cb08f98 | 1010 | \f |
9d325ebf | 1011 | (defcustom default-justification 'left |
0cb08f98 RS |
1012 | "*Method of justifying text not otherwise specified. |
1013 | Possible values are `left', `right', `full', `center', or `none'. | |
1014 | The requested kind of justification is done whenever lines are filled. | |
03e3e2e9 | 1015 | The `justification' text-property can locally override this variable." |
9d325ebf RS |
1016 | :type '(choice (const left) |
1017 | (const right) | |
1018 | (const full) | |
1019 | (const center) | |
1020 | (const none)) | |
1021 | :group 'fill) | |
0cb08f98 RS |
1022 | (make-variable-buffer-local 'default-justification) |
1023 | ||
f43726fd | 1024 | (defun current-justification () |
0cb08f98 RS |
1025 | "How should we justify this line? |
1026 | This returns the value of the text-property `justification', | |
1027 | or the variable `default-justification' if there is no text-property. | |
1028 | However, it returns nil rather than `none' to mean \"don't justify\"." | |
db95369b | 1029 | (let ((j (or (get-text-property |
0cb08f98 | 1030 | ;; Make sure we're looking at paragraph body. |
db95369b | 1031 | (save-excursion (skip-chars-forward " \t") |
1095bc3c BG |
1032 | (if (and (eobp) (not (bobp))) |
1033 | (1- (point)) (point))) | |
0cb08f98 RS |
1034 | 'justification) |
1035 | default-justification))) | |
1036 | (if (eq 'none j) | |
1037 | nil | |
1038 | j))) | |
1039 | ||
c3f9a06a RS |
1040 | (defun set-justification (begin end style &optional whole-par) |
1041 | "Set the region's justification style to STYLE. | |
1042 | This commands prompts for the kind of justification to use. | |
1095bc3c | 1043 | If the mark is not active, this command operates on the current paragraph. |
c3f9a06a RS |
1044 | If the mark is active, it operates on the region. However, if the |
1045 | beginning and end of the region are not at paragraph breaks, they are | |
1046 | moved to the beginning and end \(respectively) of the paragraphs they | |
1047 | are in. | |
1048 | ||
e4b7444d SM |
1049 | If variable `use-hard-newlines' is true, all hard newlines are |
1050 | taken to be paragraph breaks. | |
1095bc3c BG |
1051 | |
1052 | When calling from a program, operates just on region between BEGIN and END, | |
1053 | unless optional fourth arg WHOLE-PAR is non-nil. In that case bounds are | |
1054 | extended to include entire paragraphs as in the interactive command." | |
0cb08f98 RS |
1055 | (interactive (list (if mark-active (region-beginning) (point)) |
1056 | (if mark-active (region-end) (point)) | |
1095bc3c | 1057 | (let ((s (completing-read |
0cb08f98 | 1058 | "Set justification to: " |
1095bc3c BG |
1059 | '(("left") ("right") ("full") |
1060 | ("center") ("none")) | |
0cb08f98 | 1061 | nil t))) |
1095bc3c BG |
1062 | (if (equal s "") (error "")) |
1063 | (intern s)) | |
1064 | t)) | |
1065 | (save-excursion | |
1066 | (save-restriction | |
1067 | (if whole-par | |
1068 | (let ((paragraph-start (if use-hard-newlines "." paragraph-start)) | |
db95369b | 1069 | (paragraph-ignore-fill-prefix (if use-hard-newlines t |
1095bc3c BG |
1070 | paragraph-ignore-fill-prefix))) |
1071 | (goto-char begin) | |
1072 | (while (and (bolp) (not (eobp))) (forward-char 1)) | |
1073 | (backward-paragraph) | |
1074 | (setq begin (point)) | |
1075 | (goto-char end) | |
1076 | (skip-chars-backward " \t\n" begin) | |
1077 | (forward-paragraph) | |
1078 | (setq end (point)))) | |
1079 | ||
1080 | (narrow-to-region (point-min) end) | |
1081 | (unjustify-region begin (point-max)) | |
c3f9a06a | 1082 | (put-text-property begin (point-max) 'justification style) |
1095bc3c | 1083 | (fill-region begin (point-max) nil t)))) |
0cb08f98 RS |
1084 | |
1085 | (defun set-justification-none (b e) | |
1086 | "Disable automatic filling for paragraphs in the region. | |
1087 | If the mark is not active, this applies to the current paragraph." | |
1095bc3c BG |
1088 | (interactive (list (if mark-active (region-beginning) (point)) |
1089 | (if mark-active (region-end) (point)))) | |
1090 | (set-justification b e 'none t)) | |
0cb08f98 RS |
1091 | |
1092 | (defun set-justification-left (b e) | |
1093 | "Make paragraphs in the region left-justified. | |
c3f9a06a | 1094 | This means they are flush at the left margin and ragged on the right. |
1095bc3c | 1095 | This is usually the default, but see the variable `default-justification'. |
0cb08f98 | 1096 | If the mark is not active, this applies to the current paragraph." |
1095bc3c BG |
1097 | (interactive (list (if mark-active (region-beginning) (point)) |
1098 | (if mark-active (region-end) (point)))) | |
1099 | (set-justification b e 'left t)) | |
0cb08f98 RS |
1100 | |
1101 | (defun set-justification-right (b e) | |
d9a49740 | 1102 | "Make paragraphs in the region right-justified. |
c3f9a06a | 1103 | This means they are flush at the right margin and ragged on the left. |
0cb08f98 | 1104 | If the mark is not active, this applies to the current paragraph." |
1095bc3c BG |
1105 | (interactive (list (if mark-active (region-beginning) (point)) |
1106 | (if mark-active (region-end) (point)))) | |
1107 | (set-justification b e 'right t)) | |
0cb08f98 RS |
1108 | |
1109 | (defun set-justification-full (b e) | |
d9a49740 | 1110 | "Make paragraphs in the region fully justified. |
1095bc3c | 1111 | This makes lines flush on both margins by inserting spaces between words. |
0cb08f98 | 1112 | If the mark is not active, this applies to the current paragraph." |
1095bc3c BG |
1113 | (interactive (list (if mark-active (region-beginning) (point)) |
1114 | (if mark-active (region-end) (point)))) | |
1115 | (set-justification b e 'full t)) | |
0cb08f98 RS |
1116 | |
1117 | (defun set-justification-center (b e) | |
1118 | "Make paragraphs in the region centered. | |
1119 | If the mark is not active, this applies to the current paragraph." | |
1095bc3c BG |
1120 | (interactive (list (if mark-active (region-beginning) (point)) |
1121 | (if mark-active (region-end) (point)))) | |
1122 | (set-justification b e 'center t)) | |
1123 | ||
1124 | ;; A line has up to six parts: | |
1125 | ;; | |
db95369b | 1126 | ;; >>> hello. |
1095bc3c BG |
1127 | ;; [Indent-1][FP][ Indent-2 ][text][trailing whitespace][newline] |
1128 | ;; | |
1129 | ;; "Indent-1" is the left-margin indentation; normally it ends at column | |
1130 | ;; given by the `current-left-margin' function. | |
1131 | ;; "FP" is the fill-prefix. It can be any string, including whitespace. | |
1132 | ;; "Indent-2" is added to justify a line if the `current-justification' is | |
1133 | ;; `center' or `right'. In `left' and `full' justification regions, any | |
1134 | ;; whitespace there is part of the line's text, and should not be changed. | |
1135 | ;; Trailing whitespace is not counted as part of the line length when | |
1136 | ;; center- or right-justifying. | |
1137 | ;; | |
db95369b | 1138 | ;; All parts of the line are optional, although the final newline can |
1095bc3c | 1139 | ;; only be missing on the last line of the buffer. |
0cb08f98 RS |
1140 | |
1141 | (defun justify-current-line (&optional how eop nosqueeze) | |
1095bc3c BG |
1142 | "Do some kind of justification on this line. |
1143 | Normally does full justification: adds spaces to the line to make it end at | |
1144 | the column given by `current-fill-column'. | |
0cb08f98 | 1145 | Optional first argument HOW specifies alternate type of justification: |
db95369b | 1146 | it can be `left', `right', `full', `center', or `none'. |
1095bc3c BG |
1147 | If HOW is t, will justify however the `current-justification' function says to. |
1148 | If HOW is nil or missing, full justification is done by default. | |
0cb08f98 RS |
1149 | Second arg EOP non-nil means that this is the last line of the paragraph, so |
1150 | it will not be stretched by full justification. | |
1151 | Third arg NOSQUEEZE non-nil means to leave interior whitespace unchanged, | |
1152 | otherwise it is made canonical." | |
369aeb97 | 1153 | (interactive "*") |
d09d7ba9 RS |
1154 | (if (eq t how) (setq how (or (current-justification) 'none)) |
1155 | (if (null how) (setq how 'full) | |
1156 | (or (memq how '(none left right center)) | |
1157 | (setq how 'full)))) | |
1095bc3c BG |
1158 | (or (memq how '(none left)) ; No action required for these. |
1159 | (let ((fc (current-fill-column)) | |
1160 | (pos (point-marker)) | |
1161 | fp-end ; point at end of fill prefix | |
1162 | beg ; point at beginning of line's text | |
1163 | end ; point at end of line's text | |
1164 | indent ; column of `beg' | |
1165 | endcol ; column of `end' | |
9fc0913c RS |
1166 | ncols ; new indent point or offset |
1167 | (nspaces 0) ; number of spaces between words | |
1168 | ; in line (not space characters) | |
9fc0913c RS |
1169 | (curr-fracspace 0) ; current fractional space amount |
1170 | count) | |
1095bc3c BG |
1171 | (end-of-line) |
1172 | ;; Check if this is the last line of the paragraph. | |
db95369b | 1173 | (if (and use-hard-newlines (null eop) |
1095bc3c BG |
1174 | (get-text-property (point) 'hard)) |
1175 | (setq eop t)) | |
1176 | (skip-chars-backward " \t") | |
1177 | ;; Quick exit if it appears to be properly justified already | |
1178 | ;; or there is no text. | |
1179 | (if (or (bolp) | |
1180 | (and (memq how '(full right)) | |
1181 | (= (current-column) fc))) | |
1182 | nil | |
1183 | (setq end (point)) | |
1184 | (beginning-of-line) | |
1185 | (skip-chars-forward " \t") | |
1186 | ;; Skip over fill-prefix. | |
db95369b | 1187 | (if (and fill-prefix |
1095bc3c BG |
1188 | (not (string-equal fill-prefix "")) |
1189 | (equal fill-prefix | |
db95369b | 1190 | (buffer-substring |
1095bc3c BG |
1191 | (point) (min (point-max) (+ (length fill-prefix) |
1192 | (point)))))) | |
1193 | (forward-char (length fill-prefix)) | |
db95369b | 1194 | (if (and adaptive-fill-mode |
1095bc3c BG |
1195 | (looking-at adaptive-fill-regexp)) |
1196 | (goto-char (match-end 0)))) | |
1197 | (setq fp-end (point)) | |
1198 | (skip-chars-forward " \t") | |
1199 | ;; This is beginning of the line's text. | |
1200 | (setq indent (current-column)) | |
1201 | (setq beg (point)) | |
1202 | (goto-char end) | |
1203 | (setq endcol (current-column)) | |
1204 | ||
1205 | ;; HOW can't be null or left--we would have exited already | |
db95369b | 1206 | (cond ((eq 'right how) |
1095bc3c BG |
1207 | (setq ncols (- fc endcol)) |
1208 | (if (< ncols 0) | |
1209 | ;; Need to remove some indentation | |
db95369b | 1210 | (delete-region |
1095bc3c BG |
1211 | (progn (goto-char fp-end) |
1212 | (if (< (current-column) (+ indent ncols)) | |
1213 | (move-to-column (+ indent ncols) t)) | |
1214 | (point)) | |
1215 | (progn (move-to-column indent) (point))) | |
1216 | ;; Need to add some | |
1217 | (goto-char beg) | |
1218 | (indent-to (+ indent ncols)) | |
1219 | ;; If point was at beginning of text, keep it there. | |
db95369b | 1220 | (if (= beg pos) |
1095bc3c BG |
1221 | (move-marker pos (point))))) |
1222 | ||
1223 | ((eq 'center how) | |
1224 | ;; Figure out how much indentation is needed | |
1225 | (setq ncols (+ (current-left-margin) | |
1226 | (/ (- fc (current-left-margin) ;avail. space | |
1227 | (- endcol indent)) ;text width | |
1228 | 2))) | |
1229 | (if (< ncols indent) | |
1230 | ;; Have too much indentation - remove some | |
1231 | (delete-region | |
1232 | (progn (goto-char fp-end) | |
1233 | (if (< (current-column) ncols) | |
1234 | (move-to-column ncols t)) | |
1235 | (point)) | |
1236 | (progn (move-to-column indent) (point))) | |
1237 | ;; Have too little - add some | |
1238 | (goto-char beg) | |
1239 | (indent-to ncols) | |
1240 | ;; If point was at beginning of text, keep it there. | |
1241 | (if (= beg pos) | |
1242 | (move-marker pos (point))))) | |
1243 | ||
1244 | ((eq 'full how) | |
1245 | ;; Insert extra spaces between words to justify line | |
1246 | (save-restriction | |
5f636376 RS |
1247 | (narrow-to-region beg end) |
1248 | (or nosqueeze | |
1249 | (canonically-space-region beg end)) | |
1250 | (goto-char (point-max)) | |
9fc0913c RS |
1251 | ;; count word spaces in line |
1252 | (while (search-backward " " nil t) | |
1253 | (setq nspaces (1+ nspaces)) | |
1254 | (skip-chars-backward " ")) | |
1095bc3c | 1255 | (setq ncols (- fc endcol)) |
9fc0913c RS |
1256 | ;; Ncols is number of additional space chars needed |
1257 | (if (and (> ncols 0) (> nspaces 0) (not eop)) | |
1258 | (progn | |
1259 | (setq curr-fracspace (+ ncols (/ (1+ nspaces) 2)) | |
1260 | count nspaces) | |
1261 | (while (> count 0) | |
1262 | (skip-chars-forward " ") | |
1263 | (insert-and-inherit | |
8ad8316c | 1264 | (make-string (/ curr-fracspace nspaces) ?\s)) |
9fc0913c RS |
1265 | (search-forward " " nil t) |
1266 | (setq count (1- count) | |
1267 | curr-fracspace | |
1268 | (+ (% curr-fracspace nspaces) ncols))))))) | |
1095bc3c BG |
1269 | (t (error "Unknown justification value")))) |
1270 | (goto-char pos) | |
1271 | (move-marker pos nil))) | |
9dfcfbc9 | 1272 | nil) |
30d653c4 | 1273 | |
1095bc3c BG |
1274 | (defun unjustify-current-line () |
1275 | "Remove justification whitespace from current line. | |
1276 | If the line is centered or right-justified, this function removes any | |
5512735e | 1277 | indentation past the left margin. If the line is full-justified, it removes |
1095bc3c BG |
1278 | extra spaces between words. It does nothing in other justification modes." |
1279 | (let ((justify (current-justification))) | |
1280 | (cond ((eq 'left justify) nil) | |
1281 | ((eq nil justify) nil) | |
1282 | ((eq 'full justify) ; full justify: remove extra spaces | |
1283 | (beginning-of-line-text) | |
742c1822 | 1284 | (canonically-space-region (point) (line-end-position))) |
1095bc3c BG |
1285 | ((memq justify '(center right)) |
1286 | (save-excursion | |
1287 | (move-to-left-margin nil t) | |
1288 | ;; Position ourselves after any fill-prefix. | |
db95369b | 1289 | (if (and fill-prefix |
1095bc3c BG |
1290 | (not (string-equal fill-prefix "")) |
1291 | (equal fill-prefix | |
db95369b | 1292 | (buffer-substring |
1095bc3c BG |
1293 | (point) (min (point-max) (+ (length fill-prefix) |
1294 | (point)))))) | |
1295 | (forward-char (length fill-prefix))) | |
1296 | (delete-region (point) (progn (skip-chars-forward " \t") | |
1297 | (point)))))))) | |
1298 | ||
1299 | (defun unjustify-region (&optional begin end) | |
1300 | "Remove justification whitespace from region. | |
1301 | For centered or right-justified regions, this function removes any indentation | |
db95369b | 1302 | past the left margin from each line. For full-justified lines, it removes |
1095bc3c BG |
1303 | extra spaces between words. It does nothing in other justification modes. |
1304 | Arguments BEGIN and END are optional; default is the whole buffer." | |
1305 | (save-excursion | |
1306 | (save-restriction | |
1307 | (if end (narrow-to-region (point-min) end)) | |
1308 | (goto-char (or begin (point-min))) | |
1309 | (while (not (eobp)) | |
1310 | (unjustify-current-line) | |
1311 | (forward-line 1))))) | |
1312 | ||
f53a262d | 1313 | \f |
b3a0387c | 1314 | (defun fill-nonuniform-paragraphs (min max &optional justifyp citation-regexp) |
e407986c RS |
1315 | "Fill paragraphs within the region, allowing varying indentation within each. |
1316 | This command divides the region into \"paragraphs\", | |
1317 | only at paragraph-separator lines, then fills each paragraph | |
1318 | using as the fill prefix the smallest indentation of any line | |
1319 | in the paragraph. | |
1320 | ||
1321 | When calling from a program, pass range to fill as first two arguments. | |
e065a56e | 1322 | |
8ad8316c JB |
1323 | Optional third and fourth arguments JUSTIFYP and CITATION-REGEXP: |
1324 | JUSTIFYP to justify paragraphs (prefix arg). | |
b3a0387c RS |
1325 | When filling a mail message, pass a regexp for CITATION-REGEXP |
1326 | which will match the prefix of a line which is a citation marker | |
1327 | plus whitespace, but no other kind of prefix. | |
f7a53cae | 1328 | Also, if CITATION-REGEXP is non-nil, don't fill header lines." |
369aeb97 DL |
1329 | (interactive (progn |
1330 | (barf-if-buffer-read-only) | |
1331 | (list (region-beginning) (region-end) | |
1332 | (if current-prefix-arg 'full)))) | |
e407986c | 1333 | (let ((fill-individual-varying-indent t)) |
b3a0387c | 1334 | (fill-individual-paragraphs min max justifyp citation-regexp))) |
e407986c | 1335 | |
b3a0387c | 1336 | (defun fill-individual-paragraphs (min max &optional justify citation-regexp) |
e407986c | 1337 | "Fill paragraphs of uniform indentation within the region. |
db95369b | 1338 | This command divides the region into \"paragraphs\", |
f37bbf08 | 1339 | treating every change in indentation level or prefix as a paragraph boundary, |
e407986c | 1340 | then fills each paragraph using its indentation level as the fill prefix. |
e065a56e | 1341 | |
f37bbf08 RS |
1342 | There is one special case where a change in indentation does not start |
1343 | a new paragraph. This is for text of this form: | |
1344 | ||
1345 | foo> This line with extra indentation starts | |
1346 | foo> a paragraph that continues on more lines. | |
1347 | ||
1348 | These lines are filled together. | |
1349 | ||
1350 | When calling from a program, pass the range to fill | |
1351 | as the first two arguments. | |
e065a56e | 1352 | |
efffe5a3 JB |
1353 | Optional third and fourth arguments JUSTIFY and CITATION-REGEXP: |
1354 | JUSTIFY to justify paragraphs (prefix arg). | |
b3a0387c RS |
1355 | When filling a mail message, pass a regexp for CITATION-REGEXP |
1356 | which will match the prefix of a line which is a citation marker | |
1357 | plus whitespace, but no other kind of prefix. | |
f7a53cae | 1358 | Also, if CITATION-REGEXP is non-nil, don't fill header lines." |
369aeb97 DL |
1359 | (interactive (progn |
1360 | (barf-if-buffer-read-only) | |
1361 | (list (region-beginning) (region-end) | |
1362 | (if current-prefix-arg 'full)))) | |
aa228418 JB |
1363 | (save-restriction |
1364 | (save-excursion | |
1365 | (goto-char min) | |
1366 | (beginning-of-line) | |
a461b8e0 | 1367 | (narrow-to-region (point) max) |
b3a0387c | 1368 | (if citation-regexp |
a461b8e0 | 1369 | (while (and (not (eobp)) |
d09d7ba9 | 1370 | (or (looking-at "[ \t]*[^ \t\n]+:") |
a461b8e0 | 1371 | (looking-at "[ \t]*$"))) |
d09d7ba9 | 1372 | (if (looking-at "[ \t]*[^ \t\n]+:") |
30b786c3 RS |
1373 | (search-forward "\n\n" nil 'move) |
1374 | (forward-line 1)))) | |
aa228418 JB |
1375 | (narrow-to-region (point) max) |
1376 | ;; Loop over paragraphs. | |
d95da8d3 | 1377 | (while (progn |
4574ee6c RS |
1378 | ;; Skip over all paragraph-separating lines |
1379 | ;; so as to not include them in any paragraph. | |
183e4bd6 KH |
1380 | (while (and (not (eobp)) |
1381 | (progn (move-to-left-margin) | |
1382 | (and (not (eobp)) | |
1383 | (looking-at paragraph-separate)))) | |
4574ee6c RS |
1384 | (forward-line 1)) |
1385 | (skip-chars-forward " \t\n") (not (eobp))) | |
16cf6ab2 | 1386 | (move-to-left-margin) |
aa228418 JB |
1387 | (let ((start (point)) |
1388 | fill-prefix fill-prefix-regexp) | |
1389 | ;; Find end of paragraph, and compute the smallest fill-prefix | |
1390 | ;; that fits all the lines in this paragraph. | |
1391 | (while (progn | |
1392 | ;; Update the fill-prefix on the first line | |
1393 | ;; and whenever the prefix good so far is too long. | |
1394 | (if (not (and fill-prefix | |
1395 | (looking-at fill-prefix-regexp))) | |
1396 | (setq fill-prefix | |
742c1822 DL |
1397 | (fill-individual-paragraphs-prefix |
1398 | citation-regexp) | |
16cf6ab2 | 1399 | fill-prefix-regexp (regexp-quote fill-prefix))) |
c6286174 | 1400 | (forward-line 1) |
7b9f0657 RS |
1401 | (if (bolp) |
1402 | ;; If forward-line went past a newline, | |
1403 | ;; move further to the left margin. | |
1404 | (move-to-left-margin)) | |
aa228418 JB |
1405 | ;; Now stop the loop if end of paragraph. |
1406 | (and (not (eobp)) | |
e065a56e JB |
1407 | (if fill-individual-varying-indent |
1408 | ;; If this line is a separator line, with or | |
1409 | ;; without prefix, end the paragraph. | |
db95369b | 1410 | (and |
c6286174 RS |
1411 | (not (looking-at paragraph-separate)) |
1412 | (save-excursion | |
1413 | (not (and (looking-at fill-prefix-regexp) | |
742c1822 DL |
1414 | (progn (forward-char |
1415 | (length fill-prefix)) | |
1416 | (looking-at | |
1417 | paragraph-separate)))))) | |
e065a56e JB |
1418 | ;; If this line has more or less indent |
1419 | ;; than the fill prefix wants, end the paragraph. | |
1420 | (and (looking-at fill-prefix-regexp) | |
cc7e9720 KH |
1421 | ;; If fill prefix is shorter than a new |
1422 | ;; fill prefix computed here, end paragraph. | |
1423 | (let ((this-line-fill-prefix | |
db95369b | 1424 | (fill-individual-paragraphs-prefix |
cc7e9720 | 1425 | citation-regexp))) |
db95369b | 1426 | (>= (length fill-prefix) |
cc7e9720 | 1427 | (length this-line-fill-prefix))) |
e065a56e | 1428 | (save-excursion |
742c1822 DL |
1429 | (not (progn (forward-char |
1430 | (length fill-prefix)) | |
f37bbf08 RS |
1431 | (or (looking-at "[ \t]") |
1432 | (looking-at paragraph-separate) | |
3b99a4f8 GM |
1433 | (looking-at paragraph-start))))) |
1434 | (not (and (equal fill-prefix "") | |
1435 | citation-regexp | |
1436 | (looking-at citation-regexp)))))))) | |
aa228418 JB |
1437 | ;; Fill this paragraph, but don't add a newline at the end. |
1438 | (let ((had-newline (bolp))) | |
0cb08f98 | 1439 | (fill-region-as-paragraph start (point) justify) |
c97a5db4 KH |
1440 | (if (and (bolp) (not had-newline)) |
1441 | (delete-char -1)))))))) | |
b3a0387c | 1442 | (defun fill-individual-paragraphs-prefix (citation-regexp) |
03e3e2e9 SM |
1443 | (let* ((adaptive-fill-first-line-regexp ".*") |
1444 | (just-one-line-prefix | |
1445 | ;; Accept any prefix rather than just the ones matched by | |
1446 | ;; adaptive-fill-first-line-regexp. | |
1447 | (fill-context-prefix (point) (line-beginning-position 2))) | |
1448 | (two-lines-prefix | |
1449 | (fill-context-prefix (point) (line-beginning-position 3)))) | |
1450 | (if (not just-one-line-prefix) | |
1451 | (buffer-substring | |
1452 | (point) (save-excursion (skip-chars-forward " \t") (point))) | |
b3a0387c RS |
1453 | ;; See if the citation part of JUST-ONE-LINE-PREFIX |
1454 | ;; is the same as that of TWO-LINES-PREFIX, | |
1455 | ;; except perhaps with longer whitespace. | |
03e3e2e9 SM |
1456 | (if (and just-one-line-prefix two-lines-prefix |
1457 | (let* ((one-line-citation-part | |
1458 | (fill-individual-paragraphs-citation | |
1459 | just-one-line-prefix citation-regexp)) | |
1460 | (two-lines-citation-part | |
1461 | (fill-individual-paragraphs-citation | |
1462 | two-lines-prefix citation-regexp)) | |
1463 | (adjusted-two-lines-citation-part | |
1464 | (substring two-lines-citation-part 0 | |
1465 | (string-match "[ \t]*\\'" | |
1466 | two-lines-citation-part)))) | |
1467 | (and | |
b3a0387c | 1468 | (string-match (concat "\\`" |
742c1822 DL |
1469 | (regexp-quote |
1470 | adjusted-two-lines-citation-part) | |
b3a0387c RS |
1471 | "[ \t]*\\'") |
1472 | one-line-citation-part) | |
1473 | (>= (string-width one-line-citation-part) | |
03e3e2e9 | 1474 | (string-width two-lines-citation-part))))) |
b3a0387c | 1475 | two-lines-prefix |
03e3e2e9 | 1476 | just-one-line-prefix)))) |
b3a0387c RS |
1477 | |
1478 | (defun fill-individual-paragraphs-citation (string citation-regexp) | |
03e3e2e9 SM |
1479 | (if citation-regexp |
1480 | (if (string-match citation-regexp string) | |
1481 | (match-string 0 string) | |
1482 | "") | |
1483 | string)) | |
b3a0387c | 1484 | |
d95da8d3 | 1485 | ;; arch-tag: 727ad455-1161-4fa9-8df5-0f74b179216d |
e5d77022 | 1486 | ;;; fill.el ends here |