Commit | Line | Data |
---|---|---|
c0274f38 ER |
1 | ;;; fill.el --- fill commands for Emacs |
2 | ||
9596811a | 3 | ;; Copyright (C) 1985, 86, 92, 94, 95, 1996 Free Software Foundation, Inc. |
f53a262d | 4 | |
3a801d0c ER |
5 | ;; Keywords: wp |
6 | ||
f53a262d | 7 | ;; This file is part of GNU Emacs. |
8 | ||
9 | ;; GNU Emacs is free software; you can redistribute it and/or modify | |
10 | ;; it under the terms of the GNU General Public License as published by | |
e5167999 | 11 | ;; the Free Software Foundation; either version 2, or (at your option) |
f53a262d | 12 | ;; any later version. |
13 | ||
14 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
15 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
16 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
17 | ;; GNU General Public License for more details. | |
18 | ||
19 | ;; You should have received a copy of the GNU General Public License | |
b578f267 EN |
20 | ;; along with GNU Emacs; see the file COPYING. If not, write to the |
21 | ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
22 | ;; Boston, MA 02111-1307, USA. | |
f53a262d | 23 | |
e41b2db1 ER |
24 | ;;; Commentary: |
25 | ||
26 | ;; All the commands for filling text. These are documented in the Emacs | |
27 | ;; manual. | |
28 | ||
e5167999 | 29 | ;;; Code: |
f53a262d | 30 | |
9d325ebf | 31 | (defcustom fill-individual-varying-indent nil |
e065a56e JB |
32 | "*Controls criterion for a new paragraph in `fill-individual-paragraphs'. |
33 | Non-nil means changing indent doesn't end a paragraph. | |
34 | That mode can handle paragraphs with extra indentation on the first line, | |
35 | but it requires separator lines between paragraphs. | |
9d325ebf RS |
36 | A value of nil means that any change in indentation starts a new paragraph." |
37 | :type 'boolean | |
38 | :group 'fill) | |
8f985fe2 | 39 | |
9d325ebf RS |
40 | (defcustom sentence-end-double-space t |
41 | "*Non-nil means a single space does not end a sentence." | |
42 | :type 'boolean | |
43 | :group 'fill) | |
e065a56e | 44 | |
9d325ebf RS |
45 | (defcustom colon-double-space nil |
46 | "*Non-nil means put two spaces after a colon when filling." | |
47 | :type 'boolean | |
48 | :group 'fill) | |
68152e8f | 49 | |
86dfb30a | 50 | (defvar fill-paragraph-function nil |
3103b038 RS |
51 | "Mode-specific function to fill a paragraph, or nil if there is none. |
52 | If the function returns nil, then `fill-paragraph' does its normal work.") | |
86dfb30a | 53 | |
c9d611f4 KH |
54 | (defvar do-kinsoku t |
55 | "*Non-nil means do `kinsoku' processing. | |
56 | See the document of `kinsoku' for more detail.") | |
57 | ||
f53a262d | 58 | (defun set-fill-prefix () |
8f985fe2 | 59 | "Set the fill prefix to the current line up to point. |
54d7f650 RS |
60 | Filling expects lines to start with the fill prefix and |
61 | reinserts the fill prefix in each resulting line." | |
f53a262d | 62 | (interactive) |
63 | (setq fill-prefix (buffer-substring | |
1095bc3c | 64 | (save-excursion (move-to-left-margin) (point)) |
f53a262d | 65 | (point))) |
66 | (if (equal fill-prefix "") | |
67 | (setq fill-prefix nil)) | |
68 | (if fill-prefix | |
69 | (message "fill-prefix: \"%s\"" fill-prefix) | |
70 | (message "fill-prefix cancelled"))) | |
71 | ||
9d325ebf RS |
72 | (defcustom adaptive-fill-mode t |
73 | "*Non-nil means determine a paragraph's fill prefix from its text." | |
74 | :type 'boolean | |
75 | :group 'fill) | |
54d7f650 | 76 | |
9d325ebf | 77 | (defcustom adaptive-fill-regexp "[ \t]*\\([#;>*]+ +\\)?" |
54d7f650 RS |
78 | "*Regexp to match text at start of line that constitutes indentation. |
79 | If Adaptive Fill mode is enabled, whatever text matches this pattern | |
80 | on the second line of a paragraph is used as the standard indentation | |
34a5f45f | 81 | for the paragraph. If the paragraph has just one line, the indentation |
9d325ebf RS |
82 | is taken from that line." |
83 | :type 'regexp | |
84 | :group 'fill) | |
54d7f650 | 85 | |
9d325ebf | 86 | (defcustom adaptive-fill-function nil |
68152e8f | 87 | "*Function to call to choose a fill prefix for a paragraph. |
9d325ebf RS |
88 | This function is used when `adaptive-fill-regexp' does not match." |
89 | :type 'function | |
90 | :group 'fill) | |
68152e8f | 91 | |
0cb08f98 RS |
92 | (defun current-fill-column () |
93 | "Return the fill-column to use for this line. | |
94 | The fill-column to use for a buffer is stored in the variable `fill-column', | |
95 | but can be locally modified by the `right-margin' text property, which is | |
96 | subtracted from `fill-column'. | |
97 | ||
98 | The fill column to use for a line is the first column at which the column | |
99 | number equals or exceeds the local fill-column - right-margin difference." | |
100 | (save-excursion | |
1e87252c RS |
101 | (if fill-column |
102 | (let* ((here (progn (beginning-of-line) (point))) | |
103 | (here-col 0) | |
104 | (eol (progn (end-of-line) (point))) | |
105 | margin fill-col change col) | |
106 | ;; Look separately at each region of line with a different right-margin. | |
107 | (while (and (setq margin (get-text-property here 'right-margin) | |
108 | fill-col (- fill-column (or margin 0)) | |
109 | change (text-property-not-all | |
110 | here eol 'right-margin margin)) | |
111 | (progn (goto-char (1- change)) | |
112 | (setq col (current-column)) | |
113 | (< col fill-col))) | |
114 | (setq here change | |
115 | here-col col)) | |
116 | (max here-col fill-col))))) | |
0cb08f98 RS |
117 | |
118 | (defun canonically-space-region (beg end) | |
119 | "Remove extra spaces between words in region. | |
8c379895 KH |
120 | Leave one space between words, two at end of sentences or after colons |
121 | (depending on values of `sentence-end-double-space' and `colon-double-space'). | |
34a5f45f | 122 | Remove indentation from each line." |
0cb08f98 RS |
123 | (interactive "r") |
124 | (save-excursion | |
125 | (goto-char beg) | |
126 | ;; Nuke tabs; they get screwed up in a fill. | |
127 | ;; This is quick, but loses when a tab follows the end of a sentence. | |
128 | ;; Actually, it is difficult to tell that from "Mr.\tSmith". | |
129 | ;; Blame the typist. | |
130 | (subst-char-in-region beg end ?\t ?\ ) | |
131 | (while (and (< (point) end) | |
132 | (re-search-forward " *" end t)) | |
133 | (delete-region | |
134 | (+ (match-beginning 0) | |
135 | ;; Determine number of spaces to leave: | |
136 | (save-excursion | |
137 | (skip-chars-backward " ]})\"'") | |
138 | (cond ((and sentence-end-double-space | |
139 | (memq (preceding-char) '(?. ?? ?!))) 2) | |
68152e8f RS |
140 | ((and colon-double-space |
141 | (= (preceding-char) ?:)) 2) | |
0cb08f98 RS |
142 | ((char-equal (preceding-char) ?\n) 0) |
143 | (t 1)))) | |
144 | (match-end 0))) | |
145 | ;; Make sure sentences ending at end of line get an extra space. | |
146 | ;; loses on split abbrevs ("Mr.\nSmith") | |
147 | (goto-char beg) | |
148 | (while (and (< (point) end) | |
149 | (re-search-forward "[.?!][])}\"']*$" end t)) | |
8c379895 KH |
150 | ;; We insert before markers in case a caller such as |
151 | ;; do-auto-fill has done a save-excursion with point at the end | |
152 | ;; of the line and wants it to stay at the end of the line. | |
153 | (insert-before-markers-and-inherit ? )))) | |
0cb08f98 | 154 | |
0bcfa3ac | 155 | (defun fill-context-prefix (from to &optional first-line-regexp) |
d09d7ba9 | 156 | "Compute a fill prefix from the text between FROM and TO. |
dea10df4 | 157 | This uses the variables `adaptive-fill-prefix' and `adaptive-fill-function'. |
0bcfa3ac RS |
158 | If FIRST-LINE-REGEXP is non-nil, then when taking a prefix from the |
159 | first line, insist it must match FIRST-LINE-REGEXP." | |
d09d7ba9 RS |
160 | (save-excursion |
161 | (goto-char from) | |
162 | (if (eolp) (forward-line 1)) | |
163 | ;; Move to the second line unless there is just one. | |
0bcfa3ac RS |
164 | (let ((firstline (point)) |
165 | ;; Non-nil if we are on the second line. | |
166 | at-second | |
167 | result) | |
d09d7ba9 RS |
168 | (forward-line 1) |
169 | (if (>= (point) to) | |
0bcfa3ac RS |
170 | (goto-char firstline) |
171 | (setq at-second t)) | |
172 | (move-to-left-margin) | |
a58fcb99 | 173 | (let ((start (point))) |
0bcfa3ac RS |
174 | (setq result |
175 | (if (not (looking-at paragraph-start)) | |
176 | (cond ((and adaptive-fill-regexp (looking-at adaptive-fill-regexp)) | |
177 | (buffer-substring-no-properties start (match-end 0))) | |
178 | (adaptive-fill-function (funcall adaptive-fill-function))))) | |
179 | (and result | |
180 | (or at-second | |
181 | (null first-line-regexp) | |
182 | (string-match first-line-regexp result)) | |
183 | result))))) | |
d09d7ba9 | 184 | |
8c379895 KH |
185 | (defun fill-region-as-paragraph (from to &optional justify |
186 | nosqueeze squeeze-after) | |
1095bc3c | 187 | "Fill the region as one paragraph. |
2b6eb8c6 | 188 | It removes any paragraph breaks in the region and extra newlines at the end, |
1095bc3c BG |
189 | indents and fills lines between the margins given by the |
190 | `current-left-margin' and `current-fill-column' functions. | |
2b6eb8c6 | 191 | It leaves point at the beginning of the line following the paragraph. |
0cb08f98 | 192 | |
1095bc3c BG |
193 | Normally performs justification according to the `current-justification' |
194 | function, but with a prefix arg, does full justification instead. | |
195 | ||
196 | From a program, optional third arg JUSTIFY can specify any type of | |
8c379895 | 197 | justification. Fourth arg NOSQUEEZE non-nil means not to make spaces |
f3253b8f | 198 | between words canonical before filling. Fifth arg SQUEEZE-AFTER, if non-nil, |
8c379895 | 199 | means don't canonicalize spaces before that position. |
0cb08f98 | 200 | |
8f985fe2 | 201 | If `sentence-end-double-space' is non-nil, then period followed by one |
0cb08f98 | 202 | space does not end a sentence, so don't break a line there." |
4455f41c RS |
203 | (interactive (list (region-beginning) (region-end) |
204 | (if current-prefix-arg 'full))) | |
89cd98f3 RS |
205 | ;; Arrange for undoing the fill to restore point. |
206 | (if (and buffer-undo-list (not (eq buffer-undo-list t))) | |
207 | (setq buffer-undo-list (cons (point) buffer-undo-list))) | |
1095bc3c | 208 | |
2b6eb8c6 | 209 | ;; Make sure "to" is the endpoint. |
1095bc3c BG |
210 | (goto-char (min from to)) |
211 | (setq to (max from to)) | |
2b6eb8c6 RS |
212 | ;; Ignore blank lines at beginning of region. |
213 | (skip-chars-forward " \t\n") | |
1095bc3c | 214 | |
2b6eb8c6 RS |
215 | (let ((from-plus-indent (point)) |
216 | (oneleft nil)) | |
217 | ||
218 | (beginning-of-line) | |
219 | (setq from (point)) | |
220 | ||
221 | ;; Delete all but one soft newline at end of region. | |
dcfe5c05 | 222 | ;; And leave TO before that one. |
2b6eb8c6 | 223 | (goto-char to) |
1095bc3c BG |
224 | (while (and (> (point) from) (eq ?\n (char-after (1- (point))))) |
225 | (if (and oneleft | |
226 | (not (and use-hard-newlines | |
227 | (get-text-property (1- (point)) 'hard)))) | |
228 | (delete-backward-char 1) | |
229 | (backward-char 1) | |
230 | (setq oneleft t))) | |
2b6eb8c6 | 231 | (setq to (point)) |
1095bc3c | 232 | |
2b6eb8c6 RS |
233 | ;; If there was no newline, and there is text in the paragraph, then |
234 | ;; create a newline. | |
235 | (if (and (not oneleft) (> to from-plus-indent)) | |
236 | (newline)) | |
237 | (goto-char from-plus-indent)) | |
238 | ||
239 | (if (not (> to (point))) | |
240 | nil ; There is no paragraph, only whitespace: exit now. | |
1095bc3c BG |
241 | |
242 | (or justify (setq justify (current-justification))) | |
243 | ||
244 | ;; Don't let Adaptive Fill mode alter the fill prefix permanently. | |
245 | (let ((fill-prefix fill-prefix)) | |
246 | ;; Figure out how this paragraph is indented, if desired. | |
247 | (if (and adaptive-fill-mode | |
248 | (or (null fill-prefix) (string= fill-prefix ""))) | |
d09d7ba9 | 249 | (setq fill-prefix (fill-context-prefix from to))) |
0cb08f98 RS |
250 | |
251 | (save-restriction | |
0cb08f98 | 252 | (goto-char from) |
1095bc3c BG |
253 | (beginning-of-line) |
254 | (narrow-to-region (point) to) | |
255 | ||
256 | (if (not justify) ; filling disabled: just check indentation | |
257 | (progn | |
258 | (goto-char from) | |
259 | (while (not (eobp)) | |
260 | (if (and (not (eolp)) | |
261 | (< (current-indentation) (current-left-margin))) | |
262 | (indent-to-left-margin)) | |
263 | (forward-line 1))) | |
264 | ||
265 | (if use-hard-newlines | |
266 | (remove-text-properties from (point-max) '(hard nil))) | |
267 | ;; Make sure first line is indented (at least) to left margin... | |
268 | (if (or (memq justify '(right center)) | |
269 | (< (current-indentation) (current-left-margin))) | |
270 | (indent-to-left-margin)) | |
1095bc3c BG |
271 | ;; Delete the fill prefix from every line except the first. |
272 | ;; The first line may not even have a fill prefix. | |
273 | (goto-char from) | |
274 | (let ((fpre (and fill-prefix (not (equal fill-prefix "")) | |
275 | (concat "[ \t]*" | |
276 | (regexp-quote fill-prefix) | |
277 | "[ \t]*")))) | |
278 | (and fpre | |
279 | (progn | |
280 | (if (>= (+ (current-left-margin) (length fill-prefix)) | |
281 | (current-fill-column)) | |
282 | (error "fill-prefix too long for specified width")) | |
283 | (goto-char from) | |
284 | (forward-line 1) | |
285 | (while (not (eobp)) | |
286 | (if (looking-at fpre) | |
287 | (delete-region (point) (match-end 0))) | |
288 | (forward-line 1)) | |
289 | (goto-char from) | |
8c379895 KH |
290 | (if (looking-at fpre) |
291 | (goto-char (match-end 0))) | |
1095bc3c | 292 | (setq from (point))))) |
24aac19d RS |
293 | ;; Remove indentation from lines other than the first. |
294 | (beginning-of-line 2) | |
295 | (indent-region (point) (point-max) 0) | |
296 | (goto-char from) | |
297 | ||
298 | ;; FROM, and point, are now before the text to fill, | |
1095bc3c BG |
299 | ;; but after any fill prefix on the first line. |
300 | ||
301 | ;; Make sure sentences ending at end of line get an extra space. | |
302 | ;; loses on split abbrevs ("Mr.\nSmith") | |
303 | (while (re-search-forward "[.?!][])}\"']*$" nil t) | |
d09d7ba9 | 304 | (or (eobp) (insert-and-inherit ?\ ))) |
1095bc3c | 305 | (goto-char from) |
c9d611f4 KH |
306 | ;; The character category `|' means that we can break a line |
307 | ;; at the character. Since we don't need a space between | |
308 | ;; them, delete all newlines between them ... | |
309 | (while (re-search-forward "\\c|\n\\|\n\\c|" nil t) | |
310 | (if (bolp) | |
311 | (delete-char -1) | |
312 | (if (= (char-before (match-beginning 0)) ?\ ) | |
313 | ;; ... except when there is end of sentence. The | |
314 | ;; variable `sentence-end-double-space' is handled | |
315 | ;; properly later. | |
316 | nil | |
317 | (delete-region (match-beginning 0) (1+ (match-beginning 0)))))) | |
318 | (goto-char from) | |
1095bc3c BG |
319 | (skip-chars-forward " \t") |
320 | ;; Then change all newlines to spaces. | |
321 | (subst-char-in-region from (point-max) ?\n ?\ ) | |
322 | (if (and nosqueeze (not (eq justify 'full))) | |
323 | nil | |
8c379895 | 324 | (canonically-space-region (or squeeze-after (point)) (point-max)) |
1095bc3c BG |
325 | (goto-char (point-max)) |
326 | (delete-horizontal-space) | |
327 | (insert-and-inherit " ")) | |
328 | (goto-char (point-min)) | |
329 | ||
330 | ;; This is the actual filling loop. | |
331 | (let ((prefixcol 0) linebeg) | |
332 | (while (not (eobp)) | |
333 | (setq linebeg (point)) | |
334 | (move-to-column (1+ (current-fill-column))) | |
335 | (if (eobp) | |
336 | (or nosqueeze (delete-horizontal-space)) | |
c9d611f4 KH |
337 | ;; Move back to the point where we can break the line |
338 | ;; at. We break the line between word or after/before | |
339 | ;; the character which has character category `|'. We | |
340 | ;; search space, \c| followed by a character, or \c| | |
341 | ;; following a character. If not found, place | |
342 | ;; the point at linebeg. | |
343 | (if (re-search-backward " \\|\\c|.\\|.\\c|" linebeg 0) | |
344 | ;; In case of space, we place the point at next to | |
345 | ;; the point where the break occurs acutually, | |
346 | ;; because we don't want to change the following | |
347 | ;; logic of original Emacs. In case of \c|, the | |
348 | ;; point is at the place where the break occurs. | |
349 | (forward-char 1)) | |
1095bc3c BG |
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 line, | |
353 | ;; further fills will assume it ends a sentence. | |
354 | ;; If we now know it does not end a sentence, | |
355 | ;; avoid putting it at the end of the line. | |
356 | (if sentence-end-double-space | |
357 | (while (and (> (point) (+ linebeg 2)) | |
358 | (eq (preceding-char) ?\ ) | |
359 | (not (eq (following-char) ?\ )) | |
360 | (eq (char-after (- (point) 2)) ?\.)) | |
361 | (forward-char -2) | |
c9d611f4 KH |
362 | (if (re-search-backward " \\|\\c|.\\|.\\c|" linebeg 0) |
363 | (forward-char 1)))) | |
86ddc17c | 364 | ;; If the left margin and fill prefix by themselves |
253996a8 RS |
365 | ;; pass the fill-column. or if they are zero |
366 | ;; but we have no room for even one word, | |
c9d611f4 KH |
367 | ;; keep at least one word or a character which has |
368 | ;; category `|'anyway . | |
86ddc17c | 369 | ;; This handles ALL BUT the first line of the paragraph. |
1095bc3c BG |
370 | (if (if (zerop prefixcol) |
371 | (save-excursion | |
2b6eb8c6 | 372 | (skip-chars-backward " \t" linebeg) |
1095bc3c BG |
373 | (bolp)) |
374 | (>= prefixcol (current-column))) | |
c9d611f4 | 375 | ;; Ok, skip at least one word or one \c| character. |
1095bc3c BG |
376 | ;; Meanwhile, don't stop at a period followed by one space. |
377 | (let ((first t)) | |
378 | (move-to-column prefixcol) | |
379 | (while (and (not (eobp)) | |
380 | (or first | |
381 | (and (not (bobp)) | |
382 | sentence-end-double-space | |
383 | (save-excursion (forward-char -1) | |
384 | (and (looking-at "\\. ") | |
385 | (not (looking-at "\\. "))))))) | |
2b6eb8c6 | 386 | (skip-chars-forward " \t") |
c9d611f4 KH |
387 | ;; Skip one \c| character or one word. |
388 | (if (looking-at "$\\|\\c|\\|[^ \t\n]+") | |
389 | (goto-char (match-end 0))) | |
1095bc3c BG |
390 | (setq first nil))) |
391 | ;; Normally, move back over the single space between the words. | |
c9d611f4 KH |
392 | (if (= (preceding-char) ?\ ) (forward-char -1)) |
393 | ;; Do KINSOKU processing. | |
394 | (if do-kinsoku (kinsoku linebeg))) | |
395 | ||
86ddc17c RS |
396 | ;; If the left margin and fill prefix by themselves |
397 | ;; pass the fill-column, keep at least one word. | |
398 | ;; This handles the first line of the paragraph. | |
399 | (if (and (zerop prefixcol) | |
400 | (let ((fill-point (point)) nchars) | |
401 | (save-excursion | |
402 | (move-to-left-margin) | |
403 | (setq nchars (- fill-point (point))) | |
404 | (or (< nchars 0) | |
405 | (and fill-prefix | |
406 | (< nchars (length fill-prefix)) | |
407 | (string= (buffer-substring (point) fill-point) | |
408 | (substring fill-prefix 0 nchars))))))) | |
409 | ;; Ok, skip at least one word. But | |
410 | ;; don't stop at a period followed by just one space. | |
1095bc3c BG |
411 | (let ((first t)) |
412 | (while (and (not (eobp)) | |
413 | (or first | |
414 | (and (not (bobp)) | |
415 | sentence-end-double-space | |
416 | (save-excursion (forward-char -1) | |
417 | (and (looking-at "\\. ") | |
418 | (not (looking-at "\\. "))))))) | |
2b6eb8c6 | 419 | (skip-chars-forward " \t") |
c9d611f4 KH |
420 | ;; Skip one \c| character or one word. |
421 | (if (looking-at "$\\|\\c|\\|[^ \t\n]+") | |
422 | (goto-char (match-end 0))) | |
1095bc3c | 423 | (setq first nil)))) |
dcfe5c05 | 424 | ;; Check again to see if we got to the end of the paragraph. |
253996a8 | 425 | (if (save-excursion (skip-chars-forward " \t") (eobp)) |
dcfe5c05 KH |
426 | (or nosqueeze (delete-horizontal-space)) |
427 | ;; Replace whitespace here with one newline, then indent to left | |
428 | ;; margin. | |
429 | (skip-chars-backward " \t") | |
c9d611f4 KH |
430 | (if (and (= (following-char) ?\ ) |
431 | (or (aref (char-category-set (preceding-char)) ?|) | |
432 | (looking-at "[ \t]+\\c|"))) | |
433 | ;; We need one space at end of line so that | |
434 | ;; further filling won't delete it. NOTE: We | |
435 | ;; intentionally leave this one space to | |
436 | ;; distingush the case that user wants to put | |
437 | ;; space between \c| characters. | |
438 | (forward-char 1)) | |
dcfe5c05 KH |
439 | (insert ?\n) |
440 | ;; Give newline the properties of the space(s) it replaces | |
441 | (set-text-properties (1- (point)) (point) | |
442 | (text-properties-at (point))) | |
443 | (indent-to-left-margin) | |
444 | ;; Insert the fill prefix after indentation. | |
445 | ;; Set prefixcol so whitespace in the prefix won't get lost. | |
446 | (and fill-prefix (not (equal fill-prefix "")) | |
447 | (progn | |
448 | (insert-and-inherit fill-prefix) | |
449 | (setq prefixcol (current-column)))))) | |
1095bc3c BG |
450 | ;; Justify the line just ended, if desired. |
451 | (if justify | |
452 | (if (eobp) | |
4455f41c | 453 | (justify-current-line justify t t) |
1095bc3c | 454 | (forward-line -1) |
4455f41c | 455 | (justify-current-line justify nil t) |
1095bc3c BG |
456 | (forward-line 1)))))) |
457 | ;; Leave point after final newline. | |
458 | (goto-char (point-max))) | |
459 | (forward-char 1)))) | |
f53a262d | 460 | |
461 | (defun fill-paragraph (arg) | |
8f985fe2 RS |
462 | "Fill paragraph at or after point. Prefix arg means justify as well. |
463 | If `sentence-end-double-space' is non-nil, then period followed by one | |
86dfb30a RS |
464 | space does not end a sentence, so don't break a line there. |
465 | ||
466 | If `fill-paragraph-function' is non-nil, we call it (passing our | |
467 | argument to it), and if it returns non-nil, we simply return its value." | |
f3440589 | 468 | (interactive (list (if current-prefix-arg 'full))) |
86dfb30a | 469 | (or (and fill-paragraph-function |
e86fe0d7 RS |
470 | (let ((function fill-paragraph-function) |
471 | fill-paragraph-function) | |
472 | (funcall function arg))) | |
86dfb30a RS |
473 | (let ((before (point))) |
474 | (save-excursion | |
475 | (forward-paragraph) | |
476 | (or (bolp) (newline 1)) | |
477 | (let ((end (point)) | |
478 | (beg (progn (backward-paragraph) (point)))) | |
479 | (goto-char before) | |
480 | (if use-hard-newlines | |
481 | ;; Can't use fill-region-as-paragraph, since this paragraph may | |
482 | ;; still contain hard newlines. See fill-region. | |
483 | (fill-region beg end arg) | |
484 | (fill-region-as-paragraph beg end arg))))))) | |
f53a262d | 485 | |
0cb08f98 | 486 | (defun fill-region (from to &optional justify nosqueeze to-eop) |
f53a262d | 487 | "Fill each of the paragraphs in the region. |
8f985fe2 | 488 | Prefix arg (non-nil third arg, if called from program) means justify as well. |
0cb08f98 RS |
489 | |
490 | Noninteractively, fourth arg NOSQUEEZE non-nil means to leave | |
491 | whitespace other than line breaks untouched, and fifth arg TO-EOP | |
492 | non-nil means to keep filling to the end of the paragraph (or next | |
493 | hard newline, if `use-hard-newlines' is on). | |
494 | ||
8f985fe2 RS |
495 | If `sentence-end-double-space' is non-nil, then period followed by one |
496 | space does not end a sentence, so don't break a line there." | |
f3440589 RS |
497 | (interactive (list (region-beginning) (region-end) |
498 | (if current-prefix-arg 'full))) | |
1095bc3c | 499 | (let (end beg) |
c4b55ff1 RS |
500 | (save-restriction |
501 | (goto-char (max from to)) | |
0cb08f98 RS |
502 | (if to-eop |
503 | (progn (skip-chars-backward "\n") | |
504 | (forward-paragraph))) | |
c4b55ff1 RS |
505 | (setq end (point)) |
506 | (goto-char (setq beg (min from to))) | |
507 | (beginning-of-line) | |
508 | (narrow-to-region (point) end) | |
509 | (while (not (eobp)) | |
510 | (let ((initial (point)) | |
1095bc3c BG |
511 | end) |
512 | ;; If using hard newlines, break at every one for filling | |
513 | ;; purposes rather than using paragraph breaks. | |
514 | (if use-hard-newlines | |
515 | (progn | |
516 | (while (and (setq end (text-property-any (point) (point-max) | |
517 | 'hard t)) | |
518 | (not (= ?\n (char-after end))) | |
519 | (not (= end (point-max)))) | |
520 | (goto-char (1+ end))) | |
42457d75 | 521 | (setq end (if end (min (point-max) (1+ end)) (point-max))) |
1095bc3c BG |
522 | (goto-char initial)) |
523 | (forward-paragraph 1) | |
524 | (setq end (point)) | |
525 | (forward-paragraph -1)) | |
c4b55ff1 RS |
526 | (if (< (point) beg) |
527 | (goto-char beg)) | |
528 | (if (>= (point) initial) | |
0cb08f98 | 529 | (fill-region-as-paragraph (point) end justify nosqueeze) |
c4b55ff1 | 530 | (goto-char end))))))) |
f53a262d | 531 | |
0cb08f98 | 532 | \f |
9d325ebf | 533 | (defcustom default-justification 'left |
0cb08f98 RS |
534 | "*Method of justifying text not otherwise specified. |
535 | Possible values are `left', `right', `full', `center', or `none'. | |
536 | The requested kind of justification is done whenever lines are filled. | |
537 | The `justification' text-property can locally override this variable. | |
9d325ebf RS |
538 | This variable automatically becomes buffer-local when set in any fashion." |
539 | :type '(choice (const left) | |
540 | (const right) | |
541 | (const full) | |
542 | (const center) | |
543 | (const none)) | |
544 | :group 'fill) | |
0cb08f98 RS |
545 | (make-variable-buffer-local 'default-justification) |
546 | ||
f43726fd | 547 | (defun current-justification () |
0cb08f98 RS |
548 | "How should we justify this line? |
549 | This returns the value of the text-property `justification', | |
550 | or the variable `default-justification' if there is no text-property. | |
551 | However, it returns nil rather than `none' to mean \"don't justify\"." | |
552 | (let ((j (or (get-text-property | |
553 | ;; Make sure we're looking at paragraph body. | |
1095bc3c BG |
554 | (save-excursion (skip-chars-forward " \t") |
555 | (if (and (eobp) (not (bobp))) | |
556 | (1- (point)) (point))) | |
0cb08f98 RS |
557 | 'justification) |
558 | default-justification))) | |
559 | (if (eq 'none j) | |
560 | nil | |
561 | j))) | |
562 | ||
1095bc3c | 563 | (defun set-justification (begin end value &optional whole-par) |
0cb08f98 | 564 | "Set the region's justification style. |
1095bc3c BG |
565 | The kind of justification to use is prompted for. |
566 | If the mark is not active, this command operates on the current paragraph. | |
567 | If the mark is active, the region is used. However, if the beginning and end | |
568 | of the region are not at paragraph breaks, they are moved to the beginning and | |
569 | end of the paragraphs they are in. | |
570 | If `use-hard-newlines' is true, all hard newlines are taken to be paragraph | |
571 | breaks. | |
572 | ||
573 | When calling from a program, operates just on region between BEGIN and END, | |
574 | unless optional fourth arg WHOLE-PAR is non-nil. In that case bounds are | |
575 | extended to include entire paragraphs as in the interactive command." | |
0cb08f98 RS |
576 | (interactive (list (if mark-active (region-beginning) (point)) |
577 | (if mark-active (region-end) (point)) | |
1095bc3c | 578 | (let ((s (completing-read |
0cb08f98 | 579 | "Set justification to: " |
1095bc3c BG |
580 | '(("left") ("right") ("full") |
581 | ("center") ("none")) | |
0cb08f98 | 582 | nil t))) |
1095bc3c BG |
583 | (if (equal s "") (error "")) |
584 | (intern s)) | |
585 | t)) | |
586 | (save-excursion | |
587 | (save-restriction | |
588 | (if whole-par | |
589 | (let ((paragraph-start (if use-hard-newlines "." paragraph-start)) | |
590 | (paragraph-ignore-fill-prefix (if use-hard-newlines t | |
591 | paragraph-ignore-fill-prefix))) | |
592 | (goto-char begin) | |
593 | (while (and (bolp) (not (eobp))) (forward-char 1)) | |
594 | (backward-paragraph) | |
595 | (setq begin (point)) | |
596 | (goto-char end) | |
597 | (skip-chars-backward " \t\n" begin) | |
598 | (forward-paragraph) | |
599 | (setq end (point)))) | |
600 | ||
601 | (narrow-to-region (point-min) end) | |
602 | (unjustify-region begin (point-max)) | |
603 | (put-text-property begin (point-max) 'justification value) | |
604 | (fill-region begin (point-max) nil t)))) | |
0cb08f98 RS |
605 | |
606 | (defun set-justification-none (b e) | |
607 | "Disable automatic filling for paragraphs in the region. | |
608 | If the mark is not active, this applies to the current paragraph." | |
1095bc3c BG |
609 | (interactive (list (if mark-active (region-beginning) (point)) |
610 | (if mark-active (region-end) (point)))) | |
611 | (set-justification b e 'none t)) | |
0cb08f98 RS |
612 | |
613 | (defun set-justification-left (b e) | |
614 | "Make paragraphs in the region left-justified. | |
1095bc3c | 615 | This is usually the default, but see the variable `default-justification'. |
0cb08f98 | 616 | If the mark is not active, this applies to the current paragraph." |
1095bc3c BG |
617 | (interactive (list (if mark-active (region-beginning) (point)) |
618 | (if mark-active (region-end) (point)))) | |
619 | (set-justification b e 'left t)) | |
0cb08f98 RS |
620 | |
621 | (defun set-justification-right (b e) | |
622 | "Make paragraphs in the region right-justified: | |
623 | Flush at the right margin and ragged on the left. | |
624 | If the mark is not active, this applies to the current paragraph." | |
1095bc3c BG |
625 | (interactive (list (if mark-active (region-beginning) (point)) |
626 | (if mark-active (region-end) (point)))) | |
627 | (set-justification b e 'right t)) | |
0cb08f98 RS |
628 | |
629 | (defun set-justification-full (b e) | |
630 | "Make paragraphs in the region fully justified: | |
1095bc3c | 631 | This makes lines flush on both margins by inserting spaces between words. |
0cb08f98 | 632 | If the mark is not active, this applies to the current paragraph." |
1095bc3c BG |
633 | (interactive (list (if mark-active (region-beginning) (point)) |
634 | (if mark-active (region-end) (point)))) | |
635 | (set-justification b e 'full t)) | |
0cb08f98 RS |
636 | |
637 | (defun set-justification-center (b e) | |
638 | "Make paragraphs in the region centered. | |
639 | If the mark is not active, this applies to the current paragraph." | |
1095bc3c BG |
640 | (interactive (list (if mark-active (region-beginning) (point)) |
641 | (if mark-active (region-end) (point)))) | |
642 | (set-justification b e 'center t)) | |
643 | ||
644 | ;; A line has up to six parts: | |
645 | ;; | |
646 | ;; >>> hello. | |
647 | ;; [Indent-1][FP][ Indent-2 ][text][trailing whitespace][newline] | |
648 | ;; | |
649 | ;; "Indent-1" is the left-margin indentation; normally it ends at column | |
650 | ;; given by the `current-left-margin' function. | |
651 | ;; "FP" is the fill-prefix. It can be any string, including whitespace. | |
652 | ;; "Indent-2" is added to justify a line if the `current-justification' is | |
653 | ;; `center' or `right'. In `left' and `full' justification regions, any | |
654 | ;; whitespace there is part of the line's text, and should not be changed. | |
655 | ;; Trailing whitespace is not counted as part of the line length when | |
656 | ;; center- or right-justifying. | |
657 | ;; | |
658 | ;; All parts of the line are optional, although the final newline can | |
659 | ;; only be missing on the last line of the buffer. | |
0cb08f98 RS |
660 | |
661 | (defun justify-current-line (&optional how eop nosqueeze) | |
1095bc3c BG |
662 | "Do some kind of justification on this line. |
663 | Normally does full justification: adds spaces to the line to make it end at | |
664 | the column given by `current-fill-column'. | |
0cb08f98 RS |
665 | Optional first argument HOW specifies alternate type of justification: |
666 | it can be `left', `right', `full', `center', or `none'. | |
1095bc3c BG |
667 | If HOW is t, will justify however the `current-justification' function says to. |
668 | If HOW is nil or missing, full justification is done by default. | |
0cb08f98 RS |
669 | Second arg EOP non-nil means that this is the last line of the paragraph, so |
670 | it will not be stretched by full justification. | |
671 | Third arg NOSQUEEZE non-nil means to leave interior whitespace unchanged, | |
672 | otherwise it is made canonical." | |
1095bc3c | 673 | (interactive) |
d09d7ba9 RS |
674 | (if (eq t how) (setq how (or (current-justification) 'none)) |
675 | (if (null how) (setq how 'full) | |
676 | (or (memq how '(none left right center)) | |
677 | (setq how 'full)))) | |
1095bc3c BG |
678 | (or (memq how '(none left)) ; No action required for these. |
679 | (let ((fc (current-fill-column)) | |
680 | (pos (point-marker)) | |
681 | fp-end ; point at end of fill prefix | |
682 | beg ; point at beginning of line's text | |
683 | end ; point at end of line's text | |
684 | indent ; column of `beg' | |
685 | endcol ; column of `end' | |
686 | ncols) ; new indent point or offset | |
687 | (end-of-line) | |
688 | ;; Check if this is the last line of the paragraph. | |
689 | (if (and use-hard-newlines (null eop) | |
690 | (get-text-property (point) 'hard)) | |
691 | (setq eop t)) | |
692 | (skip-chars-backward " \t") | |
693 | ;; Quick exit if it appears to be properly justified already | |
694 | ;; or there is no text. | |
695 | (if (or (bolp) | |
696 | (and (memq how '(full right)) | |
697 | (= (current-column) fc))) | |
698 | nil | |
699 | (setq end (point)) | |
700 | (beginning-of-line) | |
701 | (skip-chars-forward " \t") | |
702 | ;; Skip over fill-prefix. | |
703 | (if (and fill-prefix | |
704 | (not (string-equal fill-prefix "")) | |
705 | (equal fill-prefix | |
706 | (buffer-substring | |
707 | (point) (min (point-max) (+ (length fill-prefix) | |
708 | (point)))))) | |
709 | (forward-char (length fill-prefix)) | |
710 | (if (and adaptive-fill-mode | |
711 | (looking-at adaptive-fill-regexp)) | |
712 | (goto-char (match-end 0)))) | |
713 | (setq fp-end (point)) | |
714 | (skip-chars-forward " \t") | |
715 | ;; This is beginning of the line's text. | |
716 | (setq indent (current-column)) | |
717 | (setq beg (point)) | |
718 | (goto-char end) | |
719 | (setq endcol (current-column)) | |
720 | ||
721 | ;; HOW can't be null or left--we would have exited already | |
722 | (cond ((eq 'right how) | |
723 | (setq ncols (- fc endcol)) | |
724 | (if (< ncols 0) | |
725 | ;; Need to remove some indentation | |
726 | (delete-region | |
727 | (progn (goto-char fp-end) | |
728 | (if (< (current-column) (+ indent ncols)) | |
729 | (move-to-column (+ indent ncols) t)) | |
730 | (point)) | |
731 | (progn (move-to-column indent) (point))) | |
732 | ;; Need to add some | |
733 | (goto-char beg) | |
734 | (indent-to (+ indent ncols)) | |
735 | ;; If point was at beginning of text, keep it there. | |
736 | (if (= beg pos) | |
737 | (move-marker pos (point))))) | |
738 | ||
739 | ((eq 'center how) | |
740 | ;; Figure out how much indentation is needed | |
741 | (setq ncols (+ (current-left-margin) | |
742 | (/ (- fc (current-left-margin) ;avail. space | |
743 | (- endcol indent)) ;text width | |
744 | 2))) | |
745 | (if (< ncols indent) | |
746 | ;; Have too much indentation - remove some | |
747 | (delete-region | |
748 | (progn (goto-char fp-end) | |
749 | (if (< (current-column) ncols) | |
750 | (move-to-column ncols t)) | |
751 | (point)) | |
752 | (progn (move-to-column indent) (point))) | |
753 | ;; Have too little - add some | |
754 | (goto-char beg) | |
755 | (indent-to ncols) | |
756 | ;; If point was at beginning of text, keep it there. | |
757 | (if (= beg pos) | |
758 | (move-marker pos (point))))) | |
759 | ||
760 | ((eq 'full how) | |
761 | ;; Insert extra spaces between words to justify line | |
762 | (save-restriction | |
5f636376 RS |
763 | (narrow-to-region beg end) |
764 | (or nosqueeze | |
765 | (canonically-space-region beg end)) | |
766 | (goto-char (point-max)) | |
1095bc3c BG |
767 | (setq ncols (- fc endcol)) |
768 | ;; Ncols is number of additional spaces needed | |
769 | (if (> ncols 0) | |
770 | (if (and (not eop) | |
771 | (search-backward " " nil t)) | |
772 | (while (> ncols 0) | |
773 | (let ((nmove (+ 3 (random 3)))) | |
774 | (while (> nmove 0) | |
775 | (or (search-backward " " nil t) | |
776 | (progn | |
777 | (goto-char (point-max)) | |
778 | (search-backward " "))) | |
779 | (skip-chars-backward " ") | |
780 | (setq nmove (1- nmove)))) | |
781 | (insert-and-inherit " ") | |
782 | (skip-chars-backward " ") | |
783 | (setq ncols (1- ncols))))))) | |
784 | (t (error "Unknown justification value")))) | |
785 | (goto-char pos) | |
786 | (move-marker pos nil))) | |
9dfcfbc9 | 787 | nil) |
30d653c4 | 788 | |
1095bc3c BG |
789 | (defun unjustify-current-line () |
790 | "Remove justification whitespace from current line. | |
791 | If the line is centered or right-justified, this function removes any | |
5512735e | 792 | indentation past the left margin. If the line is full-justified, it removes |
1095bc3c BG |
793 | extra spaces between words. It does nothing in other justification modes." |
794 | (let ((justify (current-justification))) | |
795 | (cond ((eq 'left justify) nil) | |
796 | ((eq nil justify) nil) | |
797 | ((eq 'full justify) ; full justify: remove extra spaces | |
798 | (beginning-of-line-text) | |
799 | (canonically-space-region | |
800 | (point) (save-excursion (end-of-line) (point)))) | |
801 | ((memq justify '(center right)) | |
802 | (save-excursion | |
803 | (move-to-left-margin nil t) | |
804 | ;; Position ourselves after any fill-prefix. | |
805 | (if (and fill-prefix | |
806 | (not (string-equal fill-prefix "")) | |
807 | (equal fill-prefix | |
808 | (buffer-substring | |
809 | (point) (min (point-max) (+ (length fill-prefix) | |
810 | (point)))))) | |
811 | (forward-char (length fill-prefix))) | |
812 | (delete-region (point) (progn (skip-chars-forward " \t") | |
813 | (point)))))))) | |
814 | ||
815 | (defun unjustify-region (&optional begin end) | |
816 | "Remove justification whitespace from region. | |
817 | For centered or right-justified regions, this function removes any indentation | |
5512735e | 818 | past the left margin from each line. For full-justified lines, it removes |
1095bc3c BG |
819 | extra spaces between words. It does nothing in other justification modes. |
820 | Arguments BEGIN and END are optional; default is the whole buffer." | |
821 | (save-excursion | |
822 | (save-restriction | |
823 | (if end (narrow-to-region (point-min) end)) | |
824 | (goto-char (or begin (point-min))) | |
825 | (while (not (eobp)) | |
826 | (unjustify-current-line) | |
827 | (forward-line 1))))) | |
828 | ||
f53a262d | 829 | \f |
e407986c RS |
830 | (defun fill-nonuniform-paragraphs (min max &optional justifyp mailp) |
831 | "Fill paragraphs within the region, allowing varying indentation within each. | |
832 | This command divides the region into \"paragraphs\", | |
833 | only at paragraph-separator lines, then fills each paragraph | |
834 | using as the fill prefix the smallest indentation of any line | |
835 | in the paragraph. | |
836 | ||
837 | When calling from a program, pass range to fill as first two arguments. | |
e065a56e | 838 | |
0cb08f98 RS |
839 | Optional third and fourth arguments JUSTIFY and MAIL-FLAG: |
840 | JUSTIFY to justify paragraphs (prefix arg), | |
e407986c | 841 | MAIL-FLAG for a mail message, i. e. don't fill header lines." |
f3440589 RS |
842 | (interactive (list (region-beginning) (region-end) |
843 | (if current-prefix-arg 'full))) | |
e407986c RS |
844 | (let ((fill-individual-varying-indent t)) |
845 | (fill-individual-paragraphs min max justifyp mailp))) | |
846 | ||
0cb08f98 | 847 | (defun fill-individual-paragraphs (min max &optional justify mailp) |
e407986c RS |
848 | "Fill paragraphs of uniform indentation within the region. |
849 | This command divides the region into \"paragraphs\", | |
850 | treating every change in indentation level as a paragraph boundary, | |
851 | then fills each paragraph using its indentation level as the fill prefix. | |
e065a56e JB |
852 | |
853 | When calling from a program, pass range to fill as first two arguments. | |
854 | ||
0cb08f98 RS |
855 | Optional third and fourth arguments JUSTIFY and MAIL-FLAG: |
856 | JUSTIFY to justify paragraphs (prefix arg), | |
f53a262d | 857 | MAIL-FLAG for a mail message, i. e. don't fill header lines." |
f3440589 RS |
858 | (interactive (list (region-beginning) (region-end) |
859 | (if current-prefix-arg 'full))) | |
aa228418 JB |
860 | (save-restriction |
861 | (save-excursion | |
862 | (goto-char min) | |
863 | (beginning-of-line) | |
a461b8e0 | 864 | (narrow-to-region (point) max) |
aa228418 | 865 | (if mailp |
a461b8e0 | 866 | (while (and (not (eobp)) |
d09d7ba9 | 867 | (or (looking-at "[ \t]*[^ \t\n]+:") |
a461b8e0 | 868 | (looking-at "[ \t]*$"))) |
d09d7ba9 | 869 | (if (looking-at "[ \t]*[^ \t\n]+:") |
30b786c3 RS |
870 | (search-forward "\n\n" nil 'move) |
871 | (forward-line 1)))) | |
aa228418 JB |
872 | (narrow-to-region (point) max) |
873 | ;; Loop over paragraphs. | |
874 | (while (progn (skip-chars-forward " \t\n") (not (eobp))) | |
16cf6ab2 | 875 | (move-to-left-margin) |
aa228418 JB |
876 | (let ((start (point)) |
877 | fill-prefix fill-prefix-regexp) | |
878 | ;; Find end of paragraph, and compute the smallest fill-prefix | |
879 | ;; that fits all the lines in this paragraph. | |
880 | (while (progn | |
881 | ;; Update the fill-prefix on the first line | |
882 | ;; and whenever the prefix good so far is too long. | |
883 | (if (not (and fill-prefix | |
884 | (looking-at fill-prefix-regexp))) | |
885 | (setq fill-prefix | |
34a5f45f | 886 | (if (and adaptive-fill-mode adaptive-fill-regexp |
16cf6ab2 RS |
887 | (looking-at adaptive-fill-regexp)) |
888 | (match-string 0) | |
889 | (buffer-substring | |
890 | (point) | |
891 | (save-excursion (skip-chars-forward " \t") | |
892 | (point)))) | |
893 | fill-prefix-regexp (regexp-quote fill-prefix))) | |
c6286174 | 894 | (forward-line 1) |
7b9f0657 RS |
895 | (if (bolp) |
896 | ;; If forward-line went past a newline, | |
897 | ;; move further to the left margin. | |
898 | (move-to-left-margin)) | |
aa228418 JB |
899 | ;; Now stop the loop if end of paragraph. |
900 | (and (not (eobp)) | |
e065a56e JB |
901 | (if fill-individual-varying-indent |
902 | ;; If this line is a separator line, with or | |
903 | ;; without prefix, end the paragraph. | |
904 | (and | |
c6286174 RS |
905 | (not (looking-at paragraph-separate)) |
906 | (save-excursion | |
907 | (not (and (looking-at fill-prefix-regexp) | |
908 | (progn (forward-char (length fill-prefix)) | |
e065a56e JB |
909 | (looking-at paragraph-separate)))))) |
910 | ;; If this line has more or less indent | |
911 | ;; than the fill prefix wants, end the paragraph. | |
912 | (and (looking-at fill-prefix-regexp) | |
913 | (save-excursion | |
914 | (not (progn (forward-char (length fill-prefix)) | |
915 | (or (looking-at paragraph-separate) | |
916 | (looking-at paragraph-start)))))))))) | |
aa228418 JB |
917 | ;; Fill this paragraph, but don't add a newline at the end. |
918 | (let ((had-newline (bolp))) | |
0cb08f98 | 919 | (fill-region-as-paragraph start (point) justify) |
e065a56e | 920 | (or had-newline (delete-char -1)))))))) |
c0274f38 | 921 | |
e5d77022 | 922 | ;;; fill.el ends here |