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