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