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