Commit | Line | Data |
---|---|---|
c0274f38 ER |
1 | ;;; fill.el --- fill commands for Emacs |
2 | ||
e065a56e | 3 | ;; Copyright (C) 1985, 1986, 1992 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 | |
20 | ;; along with GNU Emacs; see the file COPYING. If not, write to | |
21 | ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. | |
22 | ||
e41b2db1 ER |
23 | ;;; Commentary: |
24 | ||
25 | ;; All the commands for filling text. These are documented in the Emacs | |
26 | ;; manual. | |
27 | ||
e5167999 | 28 | ;;; Code: |
f53a262d | 29 | |
e065a56e JB |
30 | (defconst fill-individual-varying-indent nil |
31 | "*Controls criterion for a new paragraph in `fill-individual-paragraphs'. | |
32 | Non-nil means changing indent doesn't end a paragraph. | |
33 | That mode can handle paragraphs with extra indentation on the first line, | |
34 | but it requires separator lines between paragraphs. | |
35 | Nil means that any change in indentation starts a new paragraph.") | |
36 | ||
f53a262d | 37 | (defun set-fill-prefix () |
38 | "Set the fill-prefix to the current line up to point. | |
54d7f650 RS |
39 | Filling expects lines to start with the fill prefix and |
40 | reinserts the fill prefix in each resulting line." | |
f53a262d | 41 | (interactive) |
42 | (setq fill-prefix (buffer-substring | |
43 | (save-excursion (beginning-of-line) (point)) | |
44 | (point))) | |
45 | (if (equal fill-prefix "") | |
46 | (setq fill-prefix nil)) | |
47 | (if fill-prefix | |
48 | (message "fill-prefix: \"%s\"" fill-prefix) | |
49 | (message "fill-prefix cancelled"))) | |
50 | ||
54d7f650 RS |
51 | (defconst adaptive-fill-mode t |
52 | "*Non-nil means determine a paragraph's fill prefix from its text.") | |
53 | ||
54 | (defconst adaptive-fill-regexp "[ \t]*\\([>*] +\\)?" | |
55 | "*Regexp to match text at start of line that constitutes indentation. | |
56 | If Adaptive Fill mode is enabled, whatever text matches this pattern | |
57 | on the second line of a paragraph is used as the standard indentation | |
58 | for the paragraph.") | |
59 | ||
f53a262d | 60 | (defun fill-region-as-paragraph (from to &optional justify-flag) |
61 | "Fill region as one paragraph: break lines to fit fill-column. | |
62 | Prefix arg means justify too. | |
63 | From program, pass args FROM, TO and JUSTIFY-FLAG." | |
64 | (interactive "r\nP") | |
89cd98f3 RS |
65 | ;; Arrange for undoing the fill to restore point. |
66 | (if (and buffer-undo-list (not (eq buffer-undo-list t))) | |
67 | (setq buffer-undo-list (cons (point) buffer-undo-list))) | |
54d7f650 | 68 | ;; Don't let Adaptive Fill mode alter the fill prefix permanently. |
cc1344d5 | 69 | (let ((fill-prefix fill-prefix)) |
54d7f650 | 70 | ;; Figure out how this paragraph is indented, if desired. |
31c75fa7 RS |
71 | (if (and adaptive-fill-mode |
72 | (or (null fill-prefix) (string= fill-prefix ""))) | |
54d7f650 RS |
73 | (save-excursion |
74 | (goto-char (min from to)) | |
75 | (if (eolp) (forward-line 1)) | |
76 | (forward-line 1) | |
77 | (if (< (point) (max from to)) | |
78 | (let ((start (point))) | |
79 | (re-search-forward adaptive-fill-regexp) | |
80 | (setq fill-prefix (buffer-substring start (point)))) | |
81 | (goto-char (min from to)) | |
82 | (if (eolp) (forward-line 1)) | |
83 | ;; If paragraph has only one line, don't assume | |
84 | ;; that additional lines would have the same starting | |
d5a92c06 RS |
85 | ;; decoration. Assume no indentation. |
86 | ;; (re-search-forward adaptive-fill-regexp) | |
87 | ;; (setq fill-prefix (make-string (current-column) ?\ )) | |
88 | ))) | |
54d7f650 RS |
89 | |
90 | (save-restriction | |
91 | (narrow-to-region from to) | |
92 | (goto-char (point-min)) | |
93 | (skip-chars-forward "\n") | |
94 | (narrow-to-region (point) (point-max)) | |
95 | (setq from (point)) | |
96 | (goto-char (point-max)) | |
97 | (let ((fpre (and fill-prefix (not (equal fill-prefix "")) | |
98 | (regexp-quote fill-prefix)))) | |
99 | ;; Delete the fill prefix from every line except the first. | |
100 | ;; The first line may not even have a fill prefix. | |
101 | (and fpre | |
f53a262d | 102 | (progn |
54d7f650 RS |
103 | (if (>= (length fill-prefix) fill-column) |
104 | (error "fill-prefix too long for specified width")) | |
105 | (goto-char (point-min)) | |
106 | (forward-line 1) | |
107 | (while (not (eobp)) | |
108 | (if (looking-at fpre) | |
109 | (delete-region (point) (match-end 0))) | |
110 | (forward-line 1)) | |
111 | (goto-char (point-min)) | |
112 | (and (looking-at fpre) (forward-char (length fill-prefix))) | |
113 | (setq from (point))))) | |
114 | ;; from is now before the text to fill, | |
115 | ;; but after any fill prefix on the first line. | |
116 | ||
117 | ;; Make sure sentences ending at end of line get an extra space. | |
cc1344d5 | 118 | ;; loses on split abbrevs ("Mr.\nSmith") |
54d7f650 | 119 | (goto-char from) |
31c75fa7 | 120 | (while (re-search-forward "[.?!][])}\"']*$" nil t) |
cc1344d5 | 121 | (insert ? )) |
54d7f650 RS |
122 | |
123 | ;; Then change all newlines to spaces. | |
cc1344d5 | 124 | (subst-char-in-region from (point-max) ?\n ?\ ) |
54d7f650 | 125 | |
cc1344d5 | 126 | ;; Flush excess spaces, except in the paragraph indentation. |
54d7f650 | 127 | (goto-char from) |
cc1344d5 RS |
128 | (skip-chars-forward " \t") |
129 | ;; nuke tabs while we're at it; they get screwed up in a fill | |
130 | ;; this is quick, but loses when a sole tab follows the end of a sentence. | |
131 | ;; actually, it is difficult to tell that from "Mr.\tSmith". | |
132 | ;; blame the typist. | |
133 | (subst-char-in-region (point) (point-max) ?\t ?\ ) | |
134 | (while (re-search-forward " *" nil t) | |
54d7f650 RS |
135 | (delete-region |
136 | (+ (match-beginning 0) | |
137 | (if (save-excursion | |
cc1344d5 | 138 | (skip-chars-backward " ]})\"'") |
54d7f650 RS |
139 | (memq (preceding-char) '(?. ?? ?!))) |
140 | 2 1)) | |
141 | (match-end 0))) | |
142 | (goto-char (point-max)) | |
143 | (delete-horizontal-space) | |
cc1344d5 | 144 | (insert " ") |
54d7f650 RS |
145 | (goto-char (point-min)) |
146 | ||
406a57c1 RS |
147 | ;; This is the actual filling loop. |
148 | (let ((prefixcol 0) linebeg) | |
54d7f650 | 149 | (while (not (eobp)) |
406a57c1 | 150 | (setq linebeg (point)) |
54d7f650 RS |
151 | (move-to-column (1+ fill-column)) |
152 | (if (eobp) | |
153 | nil | |
406a57c1 | 154 | ;; Move back to start of word. |
cc1344d5 | 155 | (skip-chars-backward "^ \n" linebeg) |
406a57c1 RS |
156 | ;; Don't break after a period followed by just one space. |
157 | ;; Move back to the previous place to break. | |
158 | ;; The reason is that if a period ends up at the end of a line, | |
159 | ;; further fills will assume it ends a sentence. | |
160 | ;; If we now know it does not end a sentence, | |
161 | ;; avoid putting it at the end of the line. | |
162 | (while (and (> (point) (+ linebeg 2)) | |
cc1344d5 | 163 | (eq (preceding-char) ?\ ) |
406a57c1 RS |
164 | (eq (char-after (- (point) 2)) ?\.)) |
165 | (forward-char -2) | |
cc1344d5 | 166 | (skip-chars-backward "^ \n" linebeg)) |
54d7f650 | 167 | (if (if (zerop prefixcol) (bolp) (>= prefixcol (current-column))) |
406a57c1 RS |
168 | ;; Keep at least one word even if fill prefix exceeds margin. |
169 | ;; This handles all but the first line of the paragraph. | |
170 | (progn | |
cc1344d5 RS |
171 | (skip-chars-forward " ") |
172 | (skip-chars-forward "^ \n")) | |
406a57c1 | 173 | ;; Normally, move back over the single space between the words. |
54d7f650 | 174 | (forward-char -1))) |
406a57c1 RS |
175 | (if (and fill-prefix (zerop prefixcol) |
176 | (< (- (point) (point-min)) (length fill-prefix)) | |
177 | (string= (buffer-substring (point-min) (point)) | |
178 | (substring fill-prefix 0 (- (point) (point-min))))) | |
179 | ;; Keep at least one word even if fill prefix exceeds margin. | |
180 | ;; This handles the first line of the paragraph. | |
181 | (progn | |
cc1344d5 RS |
182 | (skip-chars-forward " ") |
183 | (skip-chars-forward "^ \n"))) | |
406a57c1 RS |
184 | ;; Replace all whitespace here with one newline. |
185 | ;; Insert before deleting, so we don't forget which side of | |
186 | ;; the whitespace point or markers used to be on. | |
cc1344d5 | 187 | (skip-chars-backward " ") |
54d7f650 RS |
188 | (insert ?\n) |
189 | (delete-horizontal-space) | |
406a57c1 RS |
190 | ;; Insert the fill prefix at start of each line. |
191 | ;; Set prefixcol so whitespace in the prefix won't get lost. | |
54d7f650 RS |
192 | (and (not (eobp)) fill-prefix (not (equal fill-prefix "")) |
193 | (progn | |
194 | (insert fill-prefix) | |
195 | (setq prefixcol (current-column)))) | |
406a57c1 | 196 | ;; Justify the line just ended, if desired. |
54d7f650 RS |
197 | (and justify-flag (not (eobp)) |
198 | (progn | |
199 | (forward-line -1) | |
200 | (justify-current-line) | |
201 | (forward-line 1)))))))) | |
f53a262d | 202 | |
203 | (defun fill-paragraph (arg) | |
54d7f650 | 204 | "Fill paragraph at or after point. Prefix arg means justify as well." |
f53a262d | 205 | (interactive "P") |
89cd98f3 RS |
206 | (let ((before (point))) |
207 | (save-excursion | |
208 | (forward-paragraph) | |
209 | (or (bolp) (newline 1)) | |
210 | (let ((end (point)) | |
211 | (beg (progn (backward-paragraph) (point)))) | |
212 | (goto-char before) | |
213 | (fill-region-as-paragraph beg end arg))))) | |
f53a262d | 214 | |
215 | (defun fill-region (from to &optional justify-flag) | |
216 | "Fill each of the paragraphs in the region. | |
54d7f650 | 217 | Prefix arg (non-nil third arg, if called from program) means justify as well." |
f53a262d | 218 | (interactive "r\nP") |
219 | (save-restriction | |
220 | (narrow-to-region from to) | |
221 | (goto-char (point-min)) | |
222 | (while (not (eobp)) | |
223 | (let ((initial (point)) | |
224 | (end (progn | |
225 | (forward-paragraph 1) (point)))) | |
226 | (forward-paragraph -1) | |
227 | (if (>= (point) initial) | |
228 | (fill-region-as-paragraph (point) end justify-flag) | |
229 | (goto-char end)))))) | |
230 | ||
231 | (defun justify-current-line () | |
54d7f650 | 232 | "Add spaces to line point is in, so it ends at `fill-column'." |
f53a262d | 233 | (interactive) |
234 | (save-excursion | |
235 | (save-restriction | |
54d7f650 | 236 | (let (ncols beg indent) |
f53a262d | 237 | (beginning-of-line) |
238 | (forward-char (length fill-prefix)) | |
cc1344d5 | 239 | (skip-chars-forward " \t") |
54d7f650 | 240 | (setq indent (current-column)) |
f53a262d | 241 | (setq beg (point)) |
242 | (end-of-line) | |
243 | (narrow-to-region beg (point)) | |
244 | (goto-char beg) | |
cc1344d5 | 245 | (while (re-search-forward " *" nil t) |
f53a262d | 246 | (delete-region |
247 | (+ (match-beginning 0) | |
248 | (if (save-excursion | |
cc1344d5 | 249 | (skip-chars-backward " ])\"'") |
f53a262d | 250 | (memq (preceding-char) '(?. ?? ?!))) |
251 | 2 1)) | |
252 | (match-end 0))) | |
253 | (goto-char beg) | |
c382a89a | 254 | (while (re-search-forward "[.?!][])\"']*\n" nil t) |
f53a262d | 255 | (forward-char -1) |
256 | (insert ? )) | |
257 | (goto-char (point-max)) | |
54d7f650 RS |
258 | ;; Note that the buffer bounds start after the indentation, |
259 | ;; so the columns counted by INDENT don't appear in (current-column). | |
260 | (setq ncols (- fill-column (current-column) indent)) | |
f53a262d | 261 | (if (search-backward " " nil t) |
262 | (while (> ncols 0) | |
263 | (let ((nmove (+ 3 (random 3)))) | |
264 | (while (> nmove 0) | |
265 | (or (search-backward " " nil t) | |
266 | (progn | |
267 | (goto-char (point-max)) | |
268 | (search-backward " "))) | |
269 | (skip-chars-backward " ") | |
270 | (setq nmove (1- nmove)))) | |
271 | (insert " ") | |
272 | (skip-chars-backward " ") | |
9dfcfbc9 JB |
273 | (setq ncols (1- ncols))))))) |
274 | nil) | |
f53a262d | 275 | \f |
e407986c RS |
276 | (defun fill-nonuniform-paragraphs (min max &optional justifyp mailp) |
277 | "Fill paragraphs within the region, allowing varying indentation within each. | |
278 | This command divides the region into \"paragraphs\", | |
279 | only at paragraph-separator lines, then fills each paragraph | |
280 | using as the fill prefix the smallest indentation of any line | |
281 | in the paragraph. | |
282 | ||
283 | When calling from a program, pass range to fill as first two arguments. | |
e065a56e | 284 | |
e407986c RS |
285 | Optional third and fourth arguments JUSTIFY-FLAG and MAIL-FLAG: |
286 | JUSTIFY-FLAG to justify paragraphs (prefix arg), | |
287 | MAIL-FLAG for a mail message, i. e. don't fill header lines." | |
288 | (interactive "r\nP") | |
289 | (let ((fill-individual-varying-indent t)) | |
290 | (fill-individual-paragraphs min max justifyp mailp))) | |
291 | ||
292 | (defun fill-individual-paragraphs (min max &optional justifyp mailp) | |
293 | "Fill paragraphs of uniform indentation within the region. | |
294 | This command divides the region into \"paragraphs\", | |
295 | treating every change in indentation level as a paragraph boundary, | |
296 | then fills each paragraph using its indentation level as the fill prefix. | |
e065a56e JB |
297 | |
298 | When calling from a program, pass range to fill as first two arguments. | |
299 | ||
f53a262d | 300 | Optional third and fourth arguments JUSTIFY-FLAG and MAIL-FLAG: |
301 | JUSTIFY-FLAG to justify paragraphs (prefix arg), | |
302 | MAIL-FLAG for a mail message, i. e. don't fill header lines." | |
303 | (interactive "r\nP") | |
aa228418 JB |
304 | (save-restriction |
305 | (save-excursion | |
306 | (goto-char min) | |
307 | (beginning-of-line) | |
308 | (if mailp | |
b9c7647e | 309 | (while (or (looking-at "[ \t]*[^ \t\n]*:") (looking-at "[ \t]*$")) |
55718e15 | 310 | (search-forward "\n\n" nil 'move))) |
aa228418 JB |
311 | (narrow-to-region (point) max) |
312 | ;; Loop over paragraphs. | |
313 | (while (progn (skip-chars-forward " \t\n") (not (eobp))) | |
314 | (beginning-of-line) | |
315 | (let ((start (point)) | |
316 | fill-prefix fill-prefix-regexp) | |
317 | ;; Find end of paragraph, and compute the smallest fill-prefix | |
318 | ;; that fits all the lines in this paragraph. | |
319 | (while (progn | |
320 | ;; Update the fill-prefix on the first line | |
321 | ;; and whenever the prefix good so far is too long. | |
322 | (if (not (and fill-prefix | |
323 | (looking-at fill-prefix-regexp))) | |
324 | (setq fill-prefix | |
325 | (buffer-substring (point) | |
326 | (save-excursion (skip-chars-forward " \t") (point))) | |
327 | fill-prefix-regexp | |
328 | (regexp-quote fill-prefix))) | |
329 | (forward-line 1) | |
330 | ;; Now stop the loop if end of paragraph. | |
331 | (and (not (eobp)) | |
e065a56e JB |
332 | (if fill-individual-varying-indent |
333 | ;; If this line is a separator line, with or | |
334 | ;; without prefix, end the paragraph. | |
335 | (and | |
aa228418 JB |
336 | (not (looking-at paragraph-separate)) |
337 | (save-excursion | |
338 | (not (and (looking-at fill-prefix-regexp) | |
339 | (progn (forward-char (length fill-prefix)) | |
e065a56e JB |
340 | (looking-at paragraph-separate)))))) |
341 | ;; If this line has more or less indent | |
342 | ;; than the fill prefix wants, end the paragraph. | |
343 | (and (looking-at fill-prefix-regexp) | |
344 | (save-excursion | |
345 | (not (progn (forward-char (length fill-prefix)) | |
346 | (or (looking-at paragraph-separate) | |
347 | (looking-at paragraph-start)))))))))) | |
aa228418 JB |
348 | ;; Fill this paragraph, but don't add a newline at the end. |
349 | (let ((had-newline (bolp))) | |
350 | (fill-region-as-paragraph start (point) justifyp) | |
e065a56e | 351 | (or had-newline (delete-char -1)))))))) |
c0274f38 | 352 | |
e5d77022 | 353 | ;;; fill.el ends here |