Commit | Line | Data |
---|---|---|
c0274f38 ER |
1 | ;;; fill.el --- fill commands for Emacs |
2 | ||
369aeb97 | 3 | ;; Copyright (C) 1985, 86, 92, 94, 95, 96, 97, 1999 Free Software Foundation, Inc. |
f53a262d | 4 | |
6228c05b | 5 | ;; Maintainer: FSF |
3a801d0c ER |
6 | ;; Keywords: wp |
7 | ||
f53a262d | 8 | ;; This file is part of GNU Emacs. |
9 | ||
10 | ;; GNU Emacs is free software; you can redistribute it and/or modify | |
11 | ;; it under the terms of the GNU General Public License as published by | |
e5167999 | 12 | ;; the Free Software Foundation; either version 2, or (at your option) |
f53a262d | 13 | ;; any later version. |
14 | ||
15 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
18 | ;; GNU General Public License for more details. | |
19 | ||
20 | ;; You should have received a copy of the GNU General Public License | |
b578f267 EN |
21 | ;; along with GNU Emacs; see the file COPYING. If not, write to the |
22 | ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
23 | ;; Boston, MA 02111-1307, USA. | |
f53a262d | 24 | |
e41b2db1 ER |
25 | ;;; Commentary: |
26 | ||
27 | ;; All the commands for filling text. These are documented in the Emacs | |
28 | ;; manual. | |
29 | ||
e5167999 | 30 | ;;; Code: |
f53a262d | 31 | |
9d325ebf | 32 | (defcustom fill-individual-varying-indent nil |
e065a56e JB |
33 | "*Controls criterion for a new paragraph in `fill-individual-paragraphs'. |
34 | Non-nil means changing indent doesn't end a paragraph. | |
35 | That mode can handle paragraphs with extra indentation on the first line, | |
36 | but it requires separator lines between paragraphs. | |
9d325ebf RS |
37 | A value of nil means that any change in indentation starts a new paragraph." |
38 | :type 'boolean | |
39 | :group 'fill) | |
8f985fe2 | 40 | |
9d325ebf | 41 | (defcustom sentence-end-double-space t |
bdcb0e25 | 42 | "*Non-nil means a single space does not end a sentence. |
742c1822 DL |
43 | This is relevant for filling. See also `sentence-end-without-period' |
44 | and `colon-double-space'. | |
bdcb0e25 | 45 | |
742c1822 DL |
46 | If you change this, you should also change `sentence-end'. See Info |
47 | node `Sentences'." | |
9d325ebf RS |
48 | :type 'boolean |
49 | :group 'fill) | |
e065a56e | 50 | |
9d325ebf RS |
51 | (defcustom colon-double-space nil |
52 | "*Non-nil means put two spaces after a colon when filling." | |
53 | :type 'boolean | |
54 | :group 'fill) | |
68152e8f | 55 | |
ce82deed | 56 | (defcustom sentence-end-without-period nil |
742c1822 DL |
57 | "*Non-nil means a sentence will end without a period. |
58 | For example, a sentence in Thai text ends with double space but | |
59 | without a period." | |
ce82deed KH |
60 | :type 'boolean |
61 | :group 'fill) | |
62 | ||
86dfb30a | 63 | (defvar fill-paragraph-function nil |
3103b038 RS |
64 | "Mode-specific function to fill a paragraph, or nil if there is none. |
65 | If the function returns nil, then `fill-paragraph' does its normal work.") | |
86dfb30a | 66 | |
c4cd8760 | 67 | (defvar enable-kinsoku t |
4dc0f0fc RS |
68 | "*Non-nil means enable \"kinsoku\" processing on filling paragraph. |
69 | Kinsoku processing is designed to prevent certain characters from being | |
70 | placed at the beginning or end of a line by filling. | |
71 | See the documentation of `kinsoku' for more information.") | |
c9d611f4 | 72 | |
f53a262d | 73 | (defun set-fill-prefix () |
8f985fe2 | 74 | "Set the fill prefix to the current line up to point. |
54d7f650 RS |
75 | Filling expects lines to start with the fill prefix and |
76 | reinserts the fill prefix in each resulting line." | |
f53a262d | 77 | (interactive) |
2441692d GM |
78 | (let ((left-margin-pos (save-excursion (move-to-left-margin) (point)))) |
79 | (if (> (point) left-margin-pos) | |
80 | (progn | |
81 | (setq fill-prefix (buffer-substring left-margin-pos (point))) | |
82 | (if (equal fill-prefix "") | |
83 | (setq fill-prefix nil))) | |
84 | (setq fill-prefix nil))) | |
f53a262d | 85 | (if fill-prefix |
86 | (message "fill-prefix: \"%s\"" fill-prefix) | |
87 | (message "fill-prefix cancelled"))) | |
88 | ||
9d325ebf RS |
89 | (defcustom adaptive-fill-mode t |
90 | "*Non-nil means determine a paragraph's fill prefix from its text." | |
91 | :type 'boolean | |
92 | :group 'fill) | |
54d7f650 | 93 | |
742c1822 | 94 | (defcustom adaptive-fill-regexp |
9371f619 | 95 | (purecopy "[ \t]*\\([-|#;>*]+[ \t]*\\|(?[0-9]+[.)][ \t]*\\)*") |
54d7f650 | 96 | "*Regexp to match text at start of line that constitutes indentation. |
849f04e1 RS |
97 | If Adaptive Fill mode is enabled, a prefix matching this pattern |
98 | on the first and second lines of a paragraph is used as the | |
99 | standard indentation for the whole paragraph. | |
100 | ||
101 | If the paragraph has just one line, the indentation is taken from that | |
102 | line, but in that case `adaptive-fill-first-line-regexp' also plays | |
103 | a role." | |
104 | :type 'regexp | |
105 | :group 'fill) | |
106 | ||
21942e01 | 107 | (defcustom adaptive-fill-first-line-regexp "\\`[ \t]*\\'" |
849f04e1 RS |
108 | "*Regexp specifying whether to set fill prefix from a one-line paragraph. |
109 | When a paragraph has just one line, then after `adaptive-fill-regexp' | |
110 | finds the prefix at the beginning of the line, if it doesn't | |
111 | match this regexp, it is replaced with whitespace. | |
112 | ||
113 | By default, this regexp matches sequences of just spaces and tabs. | |
114 | ||
115 | However, we never use a prefix from a one-line paragraph | |
116 | if it would act as a paragraph-starter on the second line." | |
9d325ebf RS |
117 | :type 'regexp |
118 | :group 'fill) | |
54d7f650 | 119 | |
9d325ebf | 120 | (defcustom adaptive-fill-function nil |
ef4d4394 | 121 | "*Function to call to choose a fill prefix for a paragraph, or nil. |
9d325ebf | 122 | This function is used when `adaptive-fill-regexp' does not match." |
ef4d4394 | 123 | :type '(choice (const nil) function) |
9d325ebf | 124 | :group 'fill) |
68152e8f | 125 | |
178932de SM |
126 | (defvar fill-indent-according-to-mode nil |
127 | "Whether or not filling should try to use the major mode's indentation.") | |
128 | ||
0cb08f98 RS |
129 | (defun current-fill-column () |
130 | "Return the fill-column to use for this line. | |
131 | The fill-column to use for a buffer is stored in the variable `fill-column', | |
132 | but can be locally modified by the `right-margin' text property, which is | |
133 | subtracted from `fill-column'. | |
134 | ||
135 | The fill column to use for a line is the first column at which the column | |
136 | number equals or exceeds the local fill-column - right-margin difference." | |
137 | (save-excursion | |
1e87252c RS |
138 | (if fill-column |
139 | (let* ((here (progn (beginning-of-line) (point))) | |
140 | (here-col 0) | |
141 | (eol (progn (end-of-line) (point))) | |
142 | margin fill-col change col) | |
742c1822 DL |
143 | ;; Look separately at each region of line with a different |
144 | ;; right-margin. | |
1e87252c RS |
145 | (while (and (setq margin (get-text-property here 'right-margin) |
146 | fill-col (- fill-column (or margin 0)) | |
147 | change (text-property-not-all | |
148 | here eol 'right-margin margin)) | |
149 | (progn (goto-char (1- change)) | |
150 | (setq col (current-column)) | |
151 | (< col fill-col))) | |
152 | (setq here change | |
153 | here-col col)) | |
154 | (max here-col fill-col))))) | |
0cb08f98 RS |
155 | |
156 | (defun canonically-space-region (beg end) | |
157 | "Remove extra spaces between words in region. | |
8c379895 | 158 | Leave one space between words, two at end of sentences or after colons |
ce82deed KH |
159 | \(depending on values of `sentence-end-double-space', `colon-double-space', |
160 | and `sentence-end-without-period'). | |
34a5f45f | 161 | Remove indentation from each line." |
369aeb97 | 162 | (interactive "*r") |
0cb08f98 RS |
163 | (save-excursion |
164 | (goto-char beg) | |
165 | ;; Nuke tabs; they get screwed up in a fill. | |
166 | ;; This is quick, but loses when a tab follows the end of a sentence. | |
167 | ;; Actually, it is difficult to tell that from "Mr.\tSmith". | |
168 | ;; Blame the typist. | |
169 | (subst-char-in-region beg end ?\t ?\ ) | |
170 | (while (and (< (point) end) | |
171 | (re-search-forward " *" end t)) | |
172 | (delete-region | |
173 | (+ (match-beginning 0) | |
174 | ;; Determine number of spaces to leave: | |
175 | (save-excursion | |
176 | (skip-chars-backward " ]})\"'") | |
177 | (cond ((and sentence-end-double-space | |
ce82deed KH |
178 | (or (memq (preceding-char) '(?. ?? ?!)) |
179 | (and sentence-end-without-period | |
180 | (= (char-syntax (preceding-char)) ?w)))) 2) | |
68152e8f RS |
181 | ((and colon-double-space |
182 | (= (preceding-char) ?:)) 2) | |
0cb08f98 RS |
183 | ((char-equal (preceding-char) ?\n) 0) |
184 | (t 1)))) | |
185 | (match-end 0))) | |
186 | ;; Make sure sentences ending at end of line get an extra space. | |
187 | ;; loses on split abbrevs ("Mr.\nSmith") | |
188 | (goto-char beg) | |
ea9ae18a RS |
189 | (let ((eol-double-space-re (if colon-double-space |
190 | "[.?!:][])}\"']*$" | |
191 | "[.?!][])}\"']*$"))) | |
192 | (while (and (< (point) end) | |
193 | (re-search-forward eol-double-space-re end t)) | |
8c379895 KH |
194 | ;; We insert before markers in case a caller such as |
195 | ;; do-auto-fill has done a save-excursion with point at the end | |
196 | ;; of the line and wants it to stay at the end of the line. | |
ea9ae18a | 197 | (insert-before-markers-and-inherit ? ))))) |
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))))) | |
207 | ||
0bcfa3ac | 208 | (defun fill-context-prefix (from to &optional first-line-regexp) |
d09d7ba9 | 209 | "Compute a fill prefix from the text between FROM and TO. |
39f5988d | 210 | This uses the variables `adaptive-fill-regexp' and `adaptive-fill-function' |
849f04e1 RS |
211 | and `adaptive-fill-first-line-regexp'. `paragraph-start' also plays a role; |
212 | we reject a prefix based on a one-line paragraph if that prefix would | |
213 | act as a paragraph-separator." | |
214 | (or first-line-regexp | |
215 | (setq first-line-regexp adaptive-fill-first-line-regexp)) | |
d09d7ba9 RS |
216 | (save-excursion |
217 | (goto-char from) | |
218 | (if (eolp) (forward-line 1)) | |
219 | ;; Move to the second line unless there is just one. | |
0bcfa3ac | 220 | (let ((firstline (point)) |
b5263b80 | 221 | first-line-prefix |
0bcfa3ac RS |
222 | ;; Non-nil if we are on the second line. |
223 | at-second | |
b5263b80 RS |
224 | second-line-prefix |
225 | start) | |
226 | (move-to-left-margin) | |
227 | (setq start (point)) | |
228 | (setq first-line-prefix | |
3212cc84 SM |
229 | ;; We don't need to consider `paragraph-start' here since it |
230 | ;; will be explicitly checked later on. | |
231 | ;; Also setting first-line-prefix to nil prevents | |
232 | ;; second-line-prefix from being used. | |
233 | (cond ;; ((looking-at paragraph-start) nil) | |
b5263b80 RS |
234 | ((and adaptive-fill-regexp (looking-at adaptive-fill-regexp)) |
235 | (buffer-substring-no-properties start (match-end 0))) | |
236 | (adaptive-fill-function (funcall adaptive-fill-function)))) | |
d09d7ba9 RS |
237 | (forward-line 1) |
238 | (if (>= (point) to) | |
0bcfa3ac | 239 | (goto-char firstline) |
b5263b80 RS |
240 | (setq at-second t) |
241 | (move-to-left-margin) | |
242 | (setq start (point)) | |
243 | (setq second-line-prefix | |
244 | (cond ((looking-at paragraph-start) nil) | |
742c1822 DL |
245 | ((and adaptive-fill-regexp |
246 | (looking-at adaptive-fill-regexp)) | |
b5263b80 | 247 | (buffer-substring-no-properties start (match-end 0))) |
742c1822 DL |
248 | (adaptive-fill-function |
249 | (funcall adaptive-fill-function))))) | |
b5263b80 RS |
250 | (if at-second |
251 | ;; If we get a fill prefix from the second line, | |
252 | ;; make sure it or something compatible is on the first line too. | |
b03ddefc | 253 | (and second-line-prefix first-line-prefix |
82d5a637 | 254 | ;; If the first line has the second line prefix too, use it. |
c61005b9 RS |
255 | (if (or (string-match (concat "\\`" |
256 | (regexp-quote second-line-prefix) | |
257 | "\\(\\'\\|[ \t]\\)") | |
b5263b80 | 258 | first-line-prefix) |
82d5a637 RS |
259 | ;; If the second line prefix is whitespace, use it. |
260 | (string-match "\\`[ \t]+\\'" second-line-prefix)) | |
f37bbf08 | 261 | second-line-prefix |
7190ab87 GM |
262 | |
263 | ;; If using the common prefix of first-line-prefix | |
264 | ;; and second-line-prefix leads to problems, consider | |
265 | ;; to restore the code below that's commented out, | |
266 | ;; and document why a common prefix cannot be used. | |
267 | ||
268 | ; ;; If the second line has the first line prefix, | |
269 | ; ;; plus whitespace, use the part that the first line shares. | |
270 | ; (if (string-match (concat "\\`" | |
271 | ; (regexp-quote first-line-prefix) | |
272 | ; "[ \t]*\\'") | |
273 | ; second-line-prefix) | |
274 | ; first-line-prefix))) | |
275 | ||
276 | ;; Use the longest common substring of both prefixes, | |
277 | ;; if there is one. | |
278 | (fill-common-string-prefix first-line-prefix | |
279 | second-line-prefix))) | |
b5263b80 RS |
280 | ;; If we get a fill prefix from a one-line paragraph, |
281 | ;; maybe change it to whitespace, | |
282 | ;; and check that it isn't a paragraph starter. | |
283 | (if first-line-prefix | |
284 | (let ((result | |
285 | ;; If first-line-prefix comes from the first line, | |
286 | ;; see if it seems reasonable to use for all lines. | |
287 | ;; If not, replace it with whitespace. | |
288 | (if (or (and first-line-regexp | |
289 | (string-match first-line-regexp | |
290 | first-line-prefix)) | |
291 | (and comment-start-skip | |
292 | (string-match comment-start-skip | |
293 | first-line-prefix))) | |
294 | first-line-prefix | |
295 | (make-string (string-width first-line-prefix) ?\ )))) | |
296 | ;; But either way, reject it if it indicates the start | |
297 | ;; of a paragraph when text follows it. | |
298 | (if (not (eq 0 (string-match paragraph-start | |
299 | (concat result "a")))) | |
44a0dbd7 | 300 | result))))))) |
d09d7ba9 | 301 | |
a0d8840a RS |
302 | (defvar fill-nobreak-predicate nil |
303 | "If non-nil, a predicate for recognizing places not to break a line. | |
304 | The predicate is called with no arguments, with point at the place | |
305 | to be tested. If it returns t, fill commands do not break the line there.") | |
306 | ||
ce82deed KH |
307 | ;; Put `fill-find-break-point-function' property to charsets which |
308 | ;; require special functions to find line breaking point. | |
97323804 KH |
309 | (let ((alist '((katakana-jisx0201 . kinsoku) |
310 | (chinese-gb2312 . kinsoku) | |
311 | (japanese-jisx0208 . kinsoku) | |
312 | (japanese-jisx0212 . kinsoku) | |
313 | (chinese-big5-1 . kinsoku) | |
314 | (chinese-big5-2 . kinsoku)))) | |
315 | (while alist | |
316 | (put-charset-property (car (car alist)) 'fill-find-break-point-function | |
317 | (cdr (car alist))) | |
318 | (setq alist (cdr alist)))) | |
319 | ||
ce82deed KH |
320 | (defun fill-find-break-point (limit) |
321 | "Move point to a proper line breaking position of the current line. | |
97323804 KH |
322 | Don't move back past the buffer position LIMIT. |
323 | ||
ce82deed KH |
324 | This function is called when we are going to break the current line |
325 | after or before a non-ascii character. If the charset of the | |
326 | character has the property `fill-find-break-point-function', this | |
97323804 | 327 | function calls the property value as a function with one arg LINEBEG. |
ce82deed KH |
328 | If the charset has no such property, do nothing." |
329 | (let* ((ch (following-char)) | |
330 | (charset (char-charset ch)) | |
331 | func) | |
332 | (if (eq charset 'ascii) | |
333 | (setq ch (preceding-char) | |
334 | charset (char-charset ch))) | |
b1376368 KH |
335 | (if (charsetp charset) |
336 | (setq func | |
337 | (get-charset-property charset 'fill-find-break-point-function))) | |
34a500b3 KH |
338 | (if (and func (fboundp func)) |
339 | (funcall func limit)))) | |
97323804 | 340 | |
8c379895 KH |
341 | (defun fill-region-as-paragraph (from to &optional justify |
342 | nosqueeze squeeze-after) | |
1095bc3c | 343 | "Fill the region as one paragraph. |
2b6eb8c6 | 344 | It removes any paragraph breaks in the region and extra newlines at the end, |
1095bc3c BG |
345 | indents and fills lines between the margins given by the |
346 | `current-left-margin' and `current-fill-column' functions. | |
368d104a | 347 | \(In most cases, the variable `fill-column' controls the width.) |
2b6eb8c6 | 348 | It leaves point at the beginning of the line following the paragraph. |
0cb08f98 | 349 | |
1095bc3c BG |
350 | Normally performs justification according to the `current-justification' |
351 | function, but with a prefix arg, does full justification instead. | |
352 | ||
353 | From a program, optional third arg JUSTIFY can specify any type of | |
8c379895 | 354 | justification. Fourth arg NOSQUEEZE non-nil means not to make spaces |
f3253b8f | 355 | between words canonical before filling. Fifth arg SQUEEZE-AFTER, if non-nil, |
8c379895 | 356 | means don't canonicalize spaces before that position. |
0cb08f98 | 357 | |
27849a65 MB |
358 | Return the fill-prefix used for filling. |
359 | ||
8f985fe2 | 360 | If `sentence-end-double-space' is non-nil, then period followed by one |
0cb08f98 | 361 | space does not end a sentence, so don't break a line there." |
369aeb97 DL |
362 | (interactive (progn |
363 | (barf-if-buffer-read-only) | |
364 | (list (region-beginning) (region-end) | |
365 | (if current-prefix-arg 'full)))) | |
d09af6a5 | 366 | (unless (memq justify '(t nil none full center left right)) |
73b33545 | 367 | (setq justify 'full)) |
89cd98f3 RS |
368 | ;; Arrange for undoing the fill to restore point. |
369 | (if (and buffer-undo-list (not (eq buffer-undo-list t))) | |
370 | (setq buffer-undo-list (cons (point) buffer-undo-list))) | |
1095bc3c | 371 | |
2b6eb8c6 | 372 | ;; Make sure "to" is the endpoint. |
1095bc3c BG |
373 | (goto-char (min from to)) |
374 | (setq to (max from to)) | |
2b6eb8c6 RS |
375 | ;; Ignore blank lines at beginning of region. |
376 | (skip-chars-forward " \t\n") | |
1095bc3c | 377 | |
2b6eb8c6 RS |
378 | (let ((from-plus-indent (point)) |
379 | (oneleft nil)) | |
380 | ||
381 | (beginning-of-line) | |
382 | (setq from (point)) | |
383 | ||
384 | ;; Delete all but one soft newline at end of region. | |
dcfe5c05 | 385 | ;; And leave TO before that one. |
2b6eb8c6 | 386 | (goto-char to) |
1095bc3c BG |
387 | (while (and (> (point) from) (eq ?\n (char-after (1- (point))))) |
388 | (if (and oneleft | |
389 | (not (and use-hard-newlines | |
390 | (get-text-property (1- (point)) 'hard)))) | |
391 | (delete-backward-char 1) | |
392 | (backward-char 1) | |
393 | (setq oneleft t))) | |
2b6eb8c6 | 394 | (setq to (point)) |
178932de SM |
395 | ;; ;; If there was no newline, and there is text in the paragraph, then |
396 | ;; ;; create a newline. | |
397 | ;; (if (and (not oneleft) (> to from-plus-indent)) | |
398 | ;; (newline)) | |
2b6eb8c6 RS |
399 | (goto-char from-plus-indent)) |
400 | ||
401 | (if (not (> to (point))) | |
402 | nil ; There is no paragraph, only whitespace: exit now. | |
1095bc3c BG |
403 | |
404 | (or justify (setq justify (current-justification))) | |
405 | ||
406 | ;; Don't let Adaptive Fill mode alter the fill prefix permanently. | |
407 | (let ((fill-prefix fill-prefix)) | |
408 | ;; Figure out how this paragraph is indented, if desired. | |
409 | (if (and adaptive-fill-mode | |
410 | (or (null fill-prefix) (string= fill-prefix ""))) | |
d09d7ba9 | 411 | (setq fill-prefix (fill-context-prefix from to))) |
0cb08f98 RS |
412 | |
413 | (save-restriction | |
0cb08f98 | 414 | (goto-char from) |
1095bc3c BG |
415 | (beginning-of-line) |
416 | (narrow-to-region (point) to) | |
417 | ||
418 | (if (not justify) ; filling disabled: just check indentation | |
419 | (progn | |
420 | (goto-char from) | |
421 | (while (not (eobp)) | |
422 | (if (and (not (eolp)) | |
423 | (< (current-indentation) (current-left-margin))) | |
424 | (indent-to-left-margin)) | |
425 | (forward-line 1))) | |
426 | ||
427 | (if use-hard-newlines | |
428 | (remove-text-properties from (point-max) '(hard nil))) | |
429 | ;; Make sure first line is indented (at least) to left margin... | |
430 | (if (or (memq justify '(right center)) | |
431 | (< (current-indentation) (current-left-margin))) | |
432 | (indent-to-left-margin)) | |
1095bc3c BG |
433 | ;; Delete the fill prefix from every line except the first. |
434 | ;; The first line may not even have a fill prefix. | |
435 | (goto-char from) | |
436 | (let ((fpre (and fill-prefix (not (equal fill-prefix "")) | |
437 | (concat "[ \t]*" | |
438 | (regexp-quote fill-prefix) | |
439 | "[ \t]*")))) | |
440 | (and fpre | |
441 | (progn | |
442 | (if (>= (+ (current-left-margin) (length fill-prefix)) | |
443 | (current-fill-column)) | |
444 | (error "fill-prefix too long for specified width")) | |
445 | (goto-char from) | |
446 | (forward-line 1) | |
447 | (while (not (eobp)) | |
448 | (if (looking-at fpre) | |
449 | (delete-region (point) (match-end 0))) | |
450 | (forward-line 1)) | |
451 | (goto-char from) | |
8c379895 KH |
452 | (if (looking-at fpre) |
453 | (goto-char (match-end 0))) | |
1095bc3c | 454 | (setq from (point))))) |
24aac19d RS |
455 | ;; Remove indentation from lines other than the first. |
456 | (beginning-of-line 2) | |
457 | (indent-region (point) (point-max) 0) | |
458 | (goto-char from) | |
459 | ||
460 | ;; FROM, and point, are now before the text to fill, | |
1095bc3c BG |
461 | ;; but after any fill prefix on the first line. |
462 | ||
463 | ;; Make sure sentences ending at end of line get an extra space. | |
464 | ;; loses on split abbrevs ("Mr.\nSmith") | |
ea9ae18a RS |
465 | (let ((eol-double-space-re (if colon-double-space |
466 | "[.?!:][])}\"']*$" | |
467 | "[.?!][])}\"']*$"))) | |
468 | (while (re-search-forward eol-double-space-re nil t) | |
469 | (or (eobp) (insert-and-inherit ?\ )))) | |
ce82deed KH |
470 | |
471 | (goto-char from) | |
472 | (if enable-multibyte-characters | |
473 | ;; Delete unnecessay newlines surrounded by words. The | |
474 | ;; character category `|' means that we can break a line | |
475 | ;; at the character. And, charset property | |
476 | ;; `nospace-between-words' tells how to concatenate | |
477 | ;; words. If the value is non-nil, never put spaces | |
478 | ;; between words, thus delete a newline between them. | |
479 | ;; If the value is nil, delete a newline only when a | |
480 | ;; character preceding a newline has text property | |
481 | ;; `nospace-between-words'. | |
482 | (while (search-forward "\n" nil t) | |
483 | (let ((prev (char-before (match-beginning 0))) | |
484 | (next (following-char))) | |
485 | (if (and (or (aref (char-category-set next) ?|) | |
486 | (aref (char-category-set prev) ?|)) | |
487 | (or (get-charset-property (char-charset prev) | |
488 | 'nospace-between-words) | |
489 | (get-text-property (1- (match-beginning 0)) | |
490 | 'nospace-between-words))) | |
491 | (delete-char -1))))) | |
492 | ||
c9d611f4 | 493 | (goto-char from) |
1095bc3c BG |
494 | (skip-chars-forward " \t") |
495 | ;; Then change all newlines to spaces. | |
496 | (subst-char-in-region from (point-max) ?\n ?\ ) | |
497 | (if (and nosqueeze (not (eq justify 'full))) | |
498 | nil | |
8c379895 | 499 | (canonically-space-region (or squeeze-after (point)) (point-max)) |
1095bc3c BG |
500 | (goto-char (point-max)) |
501 | (delete-horizontal-space) | |
502 | (insert-and-inherit " ")) | |
503 | (goto-char (point-min)) | |
504 | ||
505 | ;; This is the actual filling loop. | |
506 | (let ((prefixcol 0) linebeg) | |
507 | (while (not (eobp)) | |
508 | (setq linebeg (point)) | |
509 | (move-to-column (1+ (current-fill-column))) | |
510 | (if (eobp) | |
511 | (or nosqueeze (delete-horizontal-space)) | |
c9d611f4 KH |
512 | ;; Move back to the point where we can break the line |
513 | ;; at. We break the line between word or after/before | |
514 | ;; the character which has character category `|'. We | |
515 | ;; search space, \c| followed by a character, or \c| | |
516 | ;; following a character. If not found, place | |
517 | ;; the point at linebeg. | |
518 | (if (re-search-backward " \\|\\c|.\\|.\\c|" linebeg 0) | |
519 | ;; In case of space, we place the point at next to | |
520 | ;; the point where the break occurs acutually, | |
521 | ;; because we don't want to change the following | |
522 | ;; logic of original Emacs. In case of \c|, the | |
523 | ;; point is at the place where the break occurs. | |
524 | (forward-char 1)) | |
1095bc3c BG |
525 | ;; Don't break after a period followed by just one space. |
526 | ;; Move back to the previous place to break. | |
527 | ;; The reason is that if a period ends up at the end of a line, | |
528 | ;; further fills will assume it ends a sentence. | |
529 | ;; If we now know it does not end a sentence, | |
530 | ;; avoid putting it at the end of the line. | |
da197e75 SM |
531 | (while (and (> (point) linebeg) |
532 | (or (and sentence-end-double-space | |
533 | (> (point) (+ linebeg 2)) | |
534 | (eq (preceding-char) ?\ ) | |
535 | (not (eq (following-char) ?\ )) | |
536 | (eq (char-after (- (point) 2)) ?\.) | |
537 | (progn (forward-char -2) t)) | |
538 | (and fill-nobreak-predicate | |
539 | (funcall fill-nobreak-predicate) | |
540 | (skip-chars-backward " \t")))) | |
a0d8840a RS |
541 | (if (re-search-backward " \\|\\c|.\\|.\\c|" linebeg 0) |
542 | (forward-char 1))) | |
86ddc17c | 543 | ;; If the left margin and fill prefix by themselves |
253996a8 RS |
544 | ;; pass the fill-column. or if they are zero |
545 | ;; but we have no room for even one word, | |
c9d611f4 KH |
546 | ;; keep at least one word or a character which has |
547 | ;; category `|'anyway . | |
86ddc17c | 548 | ;; This handles ALL BUT the first line of the paragraph. |
1095bc3c BG |
549 | (if (if (zerop prefixcol) |
550 | (save-excursion | |
2b6eb8c6 | 551 | (skip-chars-backward " \t" linebeg) |
1095bc3c BG |
552 | (bolp)) |
553 | (>= prefixcol (current-column))) | |
c9d611f4 | 554 | ;; Ok, skip at least one word or one \c| character. |
1095bc3c BG |
555 | ;; Meanwhile, don't stop at a period followed by one space. |
556 | (let ((first t)) | |
557 | (move-to-column prefixcol) | |
558 | (while (and (not (eobp)) | |
559 | (or first | |
560 | (and (not (bobp)) | |
561 | sentence-end-double-space | |
742c1822 DL |
562 | (save-excursion |
563 | (forward-char -1) | |
564 | (and (looking-at "\\. ") | |
565 | (not (looking-at "\\. "))))) | |
a0d8840a RS |
566 | (and fill-nobreak-predicate |
567 | (funcall fill-nobreak-predicate)))) | |
b847b1de KH |
568 | ;; Find a breakable point while ignoring the |
569 | ;; following spaces. | |
2b6eb8c6 | 570 | (skip-chars-forward " \t") |
b847b1de KH |
571 | (if (looking-at "\\c|") |
572 | (forward-char 1) | |
573 | (let ((pos (save-excursion | |
574 | (skip-chars-forward "^ \n\t") | |
575 | (point)))) | |
576 | (if (re-search-forward "\\c|" pos t) | |
577 | (forward-char -1) | |
578 | (goto-char pos)))) | |
1095bc3c | 579 | (setq first nil))) |
742c1822 DL |
580 | ;; Normally, move back over the single space between |
581 | ;; the words. | |
c9d611f4 | 582 | (if (= (preceding-char) ?\ ) (forward-char -1)) |
97323804 KH |
583 | |
584 | (if enable-multibyte-characters | |
585 | ;; If we are going to break the line after or | |
586 | ;; before a non-ascii character, we may have to | |
587 | ;; run a special function for the charset of the | |
588 | ;; character to find the correct break point. | |
ce82deed KH |
589 | (if (not (and (eq (charset-after (1- (point))) 'ascii) |
590 | (eq (charset-after (point)) 'ascii))) | |
e7029763 KH |
591 | ;; Make sure we take SOMETHING after the |
592 | ;; fill prefix if any. | |
593 | (fill-find-break-point | |
594 | (save-excursion | |
595 | (goto-char linebeg) | |
596 | (move-to-column prefixcol) | |
597 | (point)))))) | |
c9d611f4 | 598 | |
86ddc17c RS |
599 | ;; If the left margin and fill prefix by themselves |
600 | ;; pass the fill-column, keep at least one word. | |
601 | ;; This handles the first line of the paragraph. | |
602 | (if (and (zerop prefixcol) | |
603 | (let ((fill-point (point)) nchars) | |
604 | (save-excursion | |
605 | (move-to-left-margin) | |
606 | (setq nchars (- fill-point (point))) | |
607 | (or (< nchars 0) | |
608 | (and fill-prefix | |
609 | (< nchars (length fill-prefix)) | |
742c1822 DL |
610 | (string= (buffer-substring (point) |
611 | fill-point) | |
612 | (substring fill-prefix | |
613 | 0 nchars))))))) | |
86ddc17c RS |
614 | ;; Ok, skip at least one word. But |
615 | ;; don't stop at a period followed by just one space. | |
1095bc3c BG |
616 | (let ((first t)) |
617 | (while (and (not (eobp)) | |
618 | (or first | |
619 | (and (not (bobp)) | |
620 | sentence-end-double-space | |
742c1822 DL |
621 | (save-excursion |
622 | (forward-char -1) | |
623 | (and (looking-at "\\. ") | |
624 | (not (looking-at "\\. "))))) | |
a0d8840a RS |
625 | (and fill-nobreak-predicate |
626 | (funcall fill-nobreak-predicate)))) | |
b847b1de KH |
627 | ;; Find a breakable point while ignoring the |
628 | ;; following spaces. | |
2b6eb8c6 | 629 | (skip-chars-forward " \t") |
b847b1de KH |
630 | (if (looking-at "\\c|") |
631 | (forward-char 1) | |
632 | (let ((pos (save-excursion | |
633 | (skip-chars-forward "^ \n\t") | |
634 | (point)))) | |
635 | (if (re-search-forward "\\c|" pos t) | |
636 | (forward-char -1) | |
637 | (goto-char pos)))) | |
1095bc3c | 638 | (setq first nil)))) |
dcfe5c05 | 639 | ;; Check again to see if we got to the end of the paragraph. |
253996a8 | 640 | (if (save-excursion (skip-chars-forward " \t") (eobp)) |
dcfe5c05 | 641 | (or nosqueeze (delete-horizontal-space)) |
742c1822 DL |
642 | ;; Replace whitespace here with one newline, then |
643 | ;; indent to left margin. | |
dcfe5c05 | 644 | (skip-chars-backward " \t") |
c9d611f4 KH |
645 | (if (and (= (following-char) ?\ ) |
646 | (or (aref (char-category-set (preceding-char)) ?|) | |
647 | (looking-at "[ \t]+\\c|"))) | |
648 | ;; We need one space at end of line so that | |
649 | ;; further filling won't delete it. NOTE: We | |
650 | ;; intentionally leave this one space to | |
651 | ;; distingush the case that user wants to put | |
652 | ;; space between \c| characters. | |
653 | (forward-char 1)) | |
dcfe5c05 KH |
654 | (insert ?\n) |
655 | ;; Give newline the properties of the space(s) it replaces | |
656 | (set-text-properties (1- (point)) (point) | |
657 | (text-properties-at (point))) | |
178932de SM |
658 | (if (or fill-prefix |
659 | (not fill-indent-according-to-mode) | |
660 | (memq indent-line-function | |
661 | ;; Brain dead "indenting" functions. | |
662 | '(indent-relative-maybe indent-relative))) | |
663 | (indent-to-left-margin) | |
664 | (indent-according-to-mode)) | |
dcfe5c05 KH |
665 | ;; Insert the fill prefix after indentation. |
666 | ;; Set prefixcol so whitespace in the prefix won't get lost. | |
667 | (and fill-prefix (not (equal fill-prefix "")) | |
668 | (progn | |
669 | (insert-and-inherit fill-prefix) | |
670 | (setq prefixcol (current-column)))))) | |
1095bc3c BG |
671 | ;; Justify the line just ended, if desired. |
672 | (if justify | |
66d6ec94 RS |
673 | (if (save-excursion (skip-chars-forward " \t") (eobp)) |
674 | (progn | |
675 | (delete-horizontal-space) | |
676 | (justify-current-line justify t t)) | |
1095bc3c | 677 | (forward-line -1) |
4455f41c | 678 | (justify-current-line justify nil t) |
1095bc3c BG |
679 | (forward-line 1)))))) |
680 | ;; Leave point after final newline. | |
681 | (goto-char (point-max))) | |
78652ce8 | 682 | (unless (eobp) |
27849a65 MB |
683 | (forward-char 1)) |
684 | ;; Return the fill-prefix we used | |
685 | fill-prefix))) | |
686 | ||
687 | (defsubst skip-line-prefix (prefix) | |
688 | "If point is inside the string PREFIX at the beginning of line, move past it." | |
689 | (when (and prefix | |
690 | (< (- (point) (line-beginning-position)) (length prefix)) | |
691 | (save-excursion | |
692 | (beginning-of-line) | |
693 | (looking-at (regexp-quote prefix)))) | |
694 | (goto-char (match-end 0)))) | |
f53a262d | 695 | |
696 | (defun fill-paragraph (arg) | |
cb91b2c7 | 697 | "Fill paragraph at or after point. Prefix ARG means justify as well. |
8f985fe2 | 698 | If `sentence-end-double-space' is non-nil, then period followed by one |
86dfb30a | 699 | space does not end a sentence, so don't break a line there. |
368d104a | 700 | the variable `fill-column' controls the width for filling. |
86dfb30a RS |
701 | |
702 | If `fill-paragraph-function' is non-nil, we call it (passing our | |
27849a65 MB |
703 | argument to it), and if it returns non-nil, we simply return its value. |
704 | ||
cb91b2c7 | 705 | If `fill-paragraph-function' is nil, return the `fill-prefix' used for filling." |
369aeb97 DL |
706 | (interactive (progn |
707 | (barf-if-buffer-read-only) | |
708 | (list (if current-prefix-arg 'full)))) | |
86dfb30a | 709 | (or (and fill-paragraph-function |
e86fe0d7 RS |
710 | (let ((function fill-paragraph-function) |
711 | fill-paragraph-function) | |
712 | (funcall function arg))) | |
bb801a42 | 713 | (let ((before (point)) |
27849a65 MB |
714 | ;; Fill prefix used for filling the paragraph |
715 | fill-pfx | |
bb801a42 RS |
716 | ;; If fill-paragraph is called recursively, |
717 | ;; don't give fill-paragraph-function a second chance. | |
718 | fill-paragraph-function) | |
86dfb30a RS |
719 | (save-excursion |
720 | (forward-paragraph) | |
721 | (or (bolp) (newline 1)) | |
722 | (let ((end (point)) | |
723 | (beg (progn (backward-paragraph) (point)))) | |
724 | (goto-char before) | |
cb91b2c7 | 725 | (setq fill-pfx |
27849a65 MB |
726 | (if use-hard-newlines |
727 | ;; Can't use fill-region-as-paragraph, since this | |
728 | ;; paragraph may still contain hard newlines. See | |
729 | ;; fill-region. | |
730 | (fill-region beg end arg) | |
731 | (fill-region-as-paragraph beg end arg))))) | |
732 | ;; See if point ended up inside the fill-prefix, and if so, move | |
733 | ;; past it. | |
734 | (skip-line-prefix fill-pfx) | |
735 | fill-pfx))) | |
f53a262d | 736 | |
0cb08f98 | 737 | (defun fill-region (from to &optional justify nosqueeze to-eop) |
f53a262d | 738 | "Fill each of the paragraphs in the region. |
73b33545 | 739 | A prefix arg means justify as well. |
368d104a | 740 | Ordinarily the variable `fill-column' controls the width. |
0cb08f98 | 741 | |
73b33545 RS |
742 | Noninteractively, the third argument JUSTIFY specifies which |
743 | kind of justification to do: `full', `left', `right', `center', | |
d09af6a5 RS |
744 | or `none' (equivalent to nil). t means handle each paragraph |
745 | as specified by its text properties. | |
746 | ||
73b33545 | 747 | The fourth arg NOSQUEEZE non-nil means to leave |
0cb08f98 RS |
748 | whitespace other than line breaks untouched, and fifth arg TO-EOP |
749 | non-nil means to keep filling to the end of the paragraph (or next | |
750 | hard newline, if `use-hard-newlines' is on). | |
751 | ||
27849a65 MB |
752 | Return the fill-prefix used for filling the last paragraph. |
753 | ||
8f985fe2 RS |
754 | If `sentence-end-double-space' is non-nil, then period followed by one |
755 | space does not end a sentence, so don't break a line there." | |
369aeb97 DL |
756 | (interactive (progn |
757 | (barf-if-buffer-read-only) | |
758 | (list (region-beginning) (region-end) | |
759 | (if current-prefix-arg 'full)))) | |
d09af6a5 | 760 | (unless (memq justify '(t nil none full center left right)) |
73b33545 | 761 | (setq justify 'full)) |
27849a65 | 762 | (let (end beg fill-pfx) |
c4b55ff1 RS |
763 | (save-restriction |
764 | (goto-char (max from to)) | |
3212cc84 SM |
765 | (when to-eop |
766 | (skip-chars-backward "\n") | |
767 | (forward-paragraph)) | |
c4b55ff1 RS |
768 | (setq end (point)) |
769 | (goto-char (setq beg (min from to))) | |
770 | (beginning-of-line) | |
771 | (narrow-to-region (point) end) | |
772 | (while (not (eobp)) | |
773 | (let ((initial (point)) | |
1095bc3c BG |
774 | end) |
775 | ;; If using hard newlines, break at every one for filling | |
776 | ;; purposes rather than using paragraph breaks. | |
777 | (if use-hard-newlines | |
778 | (progn | |
779 | (while (and (setq end (text-property-any (point) (point-max) | |
780 | 'hard t)) | |
781 | (not (= ?\n (char-after end))) | |
782 | (not (= end (point-max)))) | |
783 | (goto-char (1+ end))) | |
42457d75 | 784 | (setq end (if end (min (point-max) (1+ end)) (point-max))) |
1095bc3c BG |
785 | (goto-char initial)) |
786 | (forward-paragraph 1) | |
787 | (setq end (point)) | |
788 | (forward-paragraph -1)) | |
c4b55ff1 RS |
789 | (if (< (point) beg) |
790 | (goto-char beg)) | |
791 | (if (>= (point) initial) | |
27849a65 MB |
792 | (setq fill-pfx |
793 | (fill-region-as-paragraph (point) end justify nosqueeze)) | |
794 | (goto-char end)))) | |
795 | fill-pfx))) | |
f53a262d | 796 | |
0cb08f98 | 797 | \f |
9d325ebf | 798 | (defcustom default-justification 'left |
0cb08f98 RS |
799 | "*Method of justifying text not otherwise specified. |
800 | Possible values are `left', `right', `full', `center', or `none'. | |
801 | The requested kind of justification is done whenever lines are filled. | |
802 | The `justification' text-property can locally override this variable. | |
9d325ebf RS |
803 | This variable automatically becomes buffer-local when set in any fashion." |
804 | :type '(choice (const left) | |
805 | (const right) | |
806 | (const full) | |
807 | (const center) | |
808 | (const none)) | |
809 | :group 'fill) | |
0cb08f98 RS |
810 | (make-variable-buffer-local 'default-justification) |
811 | ||
f43726fd | 812 | (defun current-justification () |
0cb08f98 RS |
813 | "How should we justify this line? |
814 | This returns the value of the text-property `justification', | |
815 | or the variable `default-justification' if there is no text-property. | |
816 | However, it returns nil rather than `none' to mean \"don't justify\"." | |
817 | (let ((j (or (get-text-property | |
818 | ;; Make sure we're looking at paragraph body. | |
1095bc3c BG |
819 | (save-excursion (skip-chars-forward " \t") |
820 | (if (and (eobp) (not (bobp))) | |
821 | (1- (point)) (point))) | |
0cb08f98 RS |
822 | 'justification) |
823 | default-justification))) | |
824 | (if (eq 'none j) | |
825 | nil | |
826 | j))) | |
827 | ||
1095bc3c | 828 | (defun set-justification (begin end value &optional whole-par) |
0cb08f98 | 829 | "Set the region's justification style. |
1095bc3c BG |
830 | The kind of justification to use is prompted for. |
831 | If the mark is not active, this command operates on the current paragraph. | |
832 | If the mark is active, the region is used. However, if the beginning and end | |
833 | of the region are not at paragraph breaks, they are moved to the beginning and | |
834 | end of the paragraphs they are in. | |
835 | If `use-hard-newlines' is true, all hard newlines are taken to be paragraph | |
836 | breaks. | |
837 | ||
838 | When calling from a program, operates just on region between BEGIN and END, | |
839 | unless optional fourth arg WHOLE-PAR is non-nil. In that case bounds are | |
840 | extended to include entire paragraphs as in the interactive command." | |
0cb08f98 RS |
841 | (interactive (list (if mark-active (region-beginning) (point)) |
842 | (if mark-active (region-end) (point)) | |
1095bc3c | 843 | (let ((s (completing-read |
0cb08f98 | 844 | "Set justification to: " |
1095bc3c BG |
845 | '(("left") ("right") ("full") |
846 | ("center") ("none")) | |
0cb08f98 | 847 | nil t))) |
1095bc3c BG |
848 | (if (equal s "") (error "")) |
849 | (intern s)) | |
850 | t)) | |
851 | (save-excursion | |
852 | (save-restriction | |
853 | (if whole-par | |
854 | (let ((paragraph-start (if use-hard-newlines "." paragraph-start)) | |
855 | (paragraph-ignore-fill-prefix (if use-hard-newlines t | |
856 | paragraph-ignore-fill-prefix))) | |
857 | (goto-char begin) | |
858 | (while (and (bolp) (not (eobp))) (forward-char 1)) | |
859 | (backward-paragraph) | |
860 | (setq begin (point)) | |
861 | (goto-char end) | |
862 | (skip-chars-backward " \t\n" begin) | |
863 | (forward-paragraph) | |
864 | (setq end (point)))) | |
865 | ||
866 | (narrow-to-region (point-min) end) | |
867 | (unjustify-region begin (point-max)) | |
868 | (put-text-property begin (point-max) 'justification value) | |
869 | (fill-region begin (point-max) nil t)))) | |
0cb08f98 RS |
870 | |
871 | (defun set-justification-none (b e) | |
872 | "Disable automatic filling for paragraphs in the region. | |
873 | If the mark is not active, this applies to the current paragraph." | |
1095bc3c BG |
874 | (interactive (list (if mark-active (region-beginning) (point)) |
875 | (if mark-active (region-end) (point)))) | |
876 | (set-justification b e 'none t)) | |
0cb08f98 RS |
877 | |
878 | (defun set-justification-left (b e) | |
879 | "Make paragraphs in the region left-justified. | |
1095bc3c | 880 | This is usually the default, but see the variable `default-justification'. |
0cb08f98 | 881 | If the mark is not active, this applies to the current paragraph." |
1095bc3c BG |
882 | (interactive (list (if mark-active (region-beginning) (point)) |
883 | (if mark-active (region-end) (point)))) | |
884 | (set-justification b e 'left t)) | |
0cb08f98 RS |
885 | |
886 | (defun set-justification-right (b e) | |
887 | "Make paragraphs in the region right-justified: | |
888 | Flush at the right margin and ragged on the left. | |
889 | If the mark is not active, this applies to the current paragraph." | |
1095bc3c BG |
890 | (interactive (list (if mark-active (region-beginning) (point)) |
891 | (if mark-active (region-end) (point)))) | |
892 | (set-justification b e 'right t)) | |
0cb08f98 RS |
893 | |
894 | (defun set-justification-full (b e) | |
895 | "Make paragraphs in the region fully justified: | |
1095bc3c | 896 | This makes lines flush on both margins by inserting spaces between words. |
0cb08f98 | 897 | If the mark is not active, this applies to the current paragraph." |
1095bc3c BG |
898 | (interactive (list (if mark-active (region-beginning) (point)) |
899 | (if mark-active (region-end) (point)))) | |
900 | (set-justification b e 'full t)) | |
0cb08f98 RS |
901 | |
902 | (defun set-justification-center (b e) | |
903 | "Make paragraphs in the region centered. | |
904 | If the mark is not active, this applies to the current paragraph." | |
1095bc3c BG |
905 | (interactive (list (if mark-active (region-beginning) (point)) |
906 | (if mark-active (region-end) (point)))) | |
907 | (set-justification b e 'center t)) | |
908 | ||
909 | ;; A line has up to six parts: | |
910 | ;; | |
911 | ;; >>> hello. | |
912 | ;; [Indent-1][FP][ Indent-2 ][text][trailing whitespace][newline] | |
913 | ;; | |
914 | ;; "Indent-1" is the left-margin indentation; normally it ends at column | |
915 | ;; given by the `current-left-margin' function. | |
916 | ;; "FP" is the fill-prefix. It can be any string, including whitespace. | |
917 | ;; "Indent-2" is added to justify a line if the `current-justification' is | |
918 | ;; `center' or `right'. In `left' and `full' justification regions, any | |
919 | ;; whitespace there is part of the line's text, and should not be changed. | |
920 | ;; Trailing whitespace is not counted as part of the line length when | |
921 | ;; center- or right-justifying. | |
922 | ;; | |
923 | ;; All parts of the line are optional, although the final newline can | |
924 | ;; only be missing on the last line of the buffer. | |
0cb08f98 RS |
925 | |
926 | (defun justify-current-line (&optional how eop nosqueeze) | |
1095bc3c BG |
927 | "Do some kind of justification on this line. |
928 | Normally does full justification: adds spaces to the line to make it end at | |
929 | the column given by `current-fill-column'. | |
0cb08f98 RS |
930 | Optional first argument HOW specifies alternate type of justification: |
931 | it can be `left', `right', `full', `center', or `none'. | |
1095bc3c BG |
932 | If HOW is t, will justify however the `current-justification' function says to. |
933 | If HOW is nil or missing, full justification is done by default. | |
0cb08f98 RS |
934 | Second arg EOP non-nil means that this is the last line of the paragraph, so |
935 | it will not be stretched by full justification. | |
936 | Third arg NOSQUEEZE non-nil means to leave interior whitespace unchanged, | |
937 | otherwise it is made canonical." | |
369aeb97 | 938 | (interactive "*") |
d09d7ba9 RS |
939 | (if (eq t how) (setq how (or (current-justification) 'none)) |
940 | (if (null how) (setq how 'full) | |
941 | (or (memq how '(none left right center)) | |
942 | (setq how 'full)))) | |
1095bc3c BG |
943 | (or (memq how '(none left)) ; No action required for these. |
944 | (let ((fc (current-fill-column)) | |
945 | (pos (point-marker)) | |
946 | fp-end ; point at end of fill prefix | |
947 | beg ; point at beginning of line's text | |
948 | end ; point at end of line's text | |
949 | indent ; column of `beg' | |
950 | endcol ; column of `end' | |
9fc0913c RS |
951 | ncols ; new indent point or offset |
952 | (nspaces 0) ; number of spaces between words | |
953 | ; in line (not space characters) | |
954 | fracspace ; fractional amount of space to be | |
955 | ; added between each words | |
956 | (curr-fracspace 0) ; current fractional space amount | |
957 | count) | |
1095bc3c BG |
958 | (end-of-line) |
959 | ;; Check if this is the last line of the paragraph. | |
960 | (if (and use-hard-newlines (null eop) | |
961 | (get-text-property (point) 'hard)) | |
962 | (setq eop t)) | |
963 | (skip-chars-backward " \t") | |
964 | ;; Quick exit if it appears to be properly justified already | |
965 | ;; or there is no text. | |
966 | (if (or (bolp) | |
967 | (and (memq how '(full right)) | |
968 | (= (current-column) fc))) | |
969 | nil | |
970 | (setq end (point)) | |
971 | (beginning-of-line) | |
972 | (skip-chars-forward " \t") | |
973 | ;; Skip over fill-prefix. | |
974 | (if (and fill-prefix | |
975 | (not (string-equal fill-prefix "")) | |
976 | (equal fill-prefix | |
977 | (buffer-substring | |
978 | (point) (min (point-max) (+ (length fill-prefix) | |
979 | (point)))))) | |
980 | (forward-char (length fill-prefix)) | |
981 | (if (and adaptive-fill-mode | |
982 | (looking-at adaptive-fill-regexp)) | |
983 | (goto-char (match-end 0)))) | |
984 | (setq fp-end (point)) | |
985 | (skip-chars-forward " \t") | |
986 | ;; This is beginning of the line's text. | |
987 | (setq indent (current-column)) | |
988 | (setq beg (point)) | |
989 | (goto-char end) | |
990 | (setq endcol (current-column)) | |
991 | ||
992 | ;; HOW can't be null or left--we would have exited already | |
993 | (cond ((eq 'right how) | |
994 | (setq ncols (- fc endcol)) | |
995 | (if (< ncols 0) | |
996 | ;; Need to remove some indentation | |
997 | (delete-region | |
998 | (progn (goto-char fp-end) | |
999 | (if (< (current-column) (+ indent ncols)) | |
1000 | (move-to-column (+ indent ncols) t)) | |
1001 | (point)) | |
1002 | (progn (move-to-column indent) (point))) | |
1003 | ;; Need to add some | |
1004 | (goto-char beg) | |
1005 | (indent-to (+ indent ncols)) | |
1006 | ;; If point was at beginning of text, keep it there. | |
1007 | (if (= beg pos) | |
1008 | (move-marker pos (point))))) | |
1009 | ||
1010 | ((eq 'center how) | |
1011 | ;; Figure out how much indentation is needed | |
1012 | (setq ncols (+ (current-left-margin) | |
1013 | (/ (- fc (current-left-margin) ;avail. space | |
1014 | (- endcol indent)) ;text width | |
1015 | 2))) | |
1016 | (if (< ncols indent) | |
1017 | ;; Have too much indentation - remove some | |
1018 | (delete-region | |
1019 | (progn (goto-char fp-end) | |
1020 | (if (< (current-column) ncols) | |
1021 | (move-to-column ncols t)) | |
1022 | (point)) | |
1023 | (progn (move-to-column indent) (point))) | |
1024 | ;; Have too little - add some | |
1025 | (goto-char beg) | |
1026 | (indent-to ncols) | |
1027 | ;; If point was at beginning of text, keep it there. | |
1028 | (if (= beg pos) | |
1029 | (move-marker pos (point))))) | |
1030 | ||
1031 | ((eq 'full how) | |
1032 | ;; Insert extra spaces between words to justify line | |
1033 | (save-restriction | |
5f636376 RS |
1034 | (narrow-to-region beg end) |
1035 | (or nosqueeze | |
1036 | (canonically-space-region beg end)) | |
1037 | (goto-char (point-max)) | |
9fc0913c RS |
1038 | ;; count word spaces in line |
1039 | (while (search-backward " " nil t) | |
1040 | (setq nspaces (1+ nspaces)) | |
1041 | (skip-chars-backward " ")) | |
1095bc3c | 1042 | (setq ncols (- fc endcol)) |
9fc0913c RS |
1043 | ;; Ncols is number of additional space chars needed |
1044 | (if (and (> ncols 0) (> nspaces 0) (not eop)) | |
1045 | (progn | |
1046 | (setq curr-fracspace (+ ncols (/ (1+ nspaces) 2)) | |
1047 | count nspaces) | |
1048 | (while (> count 0) | |
1049 | (skip-chars-forward " ") | |
1050 | (insert-and-inherit | |
1051 | (make-string (/ curr-fracspace nspaces) ?\ )) | |
1052 | (search-forward " " nil t) | |
1053 | (setq count (1- count) | |
1054 | curr-fracspace | |
1055 | (+ (% curr-fracspace nspaces) ncols))))))) | |
1095bc3c BG |
1056 | (t (error "Unknown justification value")))) |
1057 | (goto-char pos) | |
1058 | (move-marker pos nil))) | |
9dfcfbc9 | 1059 | nil) |
30d653c4 | 1060 | |
1095bc3c BG |
1061 | (defun unjustify-current-line () |
1062 | "Remove justification whitespace from current line. | |
1063 | If the line is centered or right-justified, this function removes any | |
5512735e | 1064 | indentation past the left margin. If the line is full-justified, it removes |
1095bc3c BG |
1065 | extra spaces between words. It does nothing in other justification modes." |
1066 | (let ((justify (current-justification))) | |
1067 | (cond ((eq 'left justify) nil) | |
1068 | ((eq nil justify) nil) | |
1069 | ((eq 'full justify) ; full justify: remove extra spaces | |
1070 | (beginning-of-line-text) | |
742c1822 | 1071 | (canonically-space-region (point) (line-end-position))) |
1095bc3c BG |
1072 | ((memq justify '(center right)) |
1073 | (save-excursion | |
1074 | (move-to-left-margin nil t) | |
1075 | ;; Position ourselves after any fill-prefix. | |
1076 | (if (and fill-prefix | |
1077 | (not (string-equal fill-prefix "")) | |
1078 | (equal fill-prefix | |
1079 | (buffer-substring | |
1080 | (point) (min (point-max) (+ (length fill-prefix) | |
1081 | (point)))))) | |
1082 | (forward-char (length fill-prefix))) | |
1083 | (delete-region (point) (progn (skip-chars-forward " \t") | |
1084 | (point)))))))) | |
1085 | ||
1086 | (defun unjustify-region (&optional begin end) | |
1087 | "Remove justification whitespace from region. | |
1088 | For centered or right-justified regions, this function removes any indentation | |
5512735e | 1089 | past the left margin from each line. For full-justified lines, it removes |
1095bc3c BG |
1090 | extra spaces between words. It does nothing in other justification modes. |
1091 | Arguments BEGIN and END are optional; default is the whole buffer." | |
1092 | (save-excursion | |
1093 | (save-restriction | |
1094 | (if end (narrow-to-region (point-min) end)) | |
1095 | (goto-char (or begin (point-min))) | |
1096 | (while (not (eobp)) | |
1097 | (unjustify-current-line) | |
1098 | (forward-line 1))))) | |
1099 | ||
f53a262d | 1100 | \f |
b3a0387c | 1101 | (defun fill-nonuniform-paragraphs (min max &optional justifyp citation-regexp) |
e407986c RS |
1102 | "Fill paragraphs within the region, allowing varying indentation within each. |
1103 | This command divides the region into \"paragraphs\", | |
1104 | only at paragraph-separator lines, then fills each paragraph | |
1105 | using as the fill prefix the smallest indentation of any line | |
1106 | in the paragraph. | |
1107 | ||
1108 | When calling from a program, pass range to fill as first two arguments. | |
e065a56e | 1109 | |
0cb08f98 RS |
1110 | Optional third and fourth arguments JUSTIFY and MAIL-FLAG: |
1111 | JUSTIFY to justify paragraphs (prefix arg), | |
b3a0387c RS |
1112 | When filling a mail message, pass a regexp for CITATION-REGEXP |
1113 | which will match the prefix of a line which is a citation marker | |
1114 | plus whitespace, but no other kind of prefix. | |
1115 | Also, if CITATION-REGEXP is non-nil, don't fill header lines." | |
369aeb97 DL |
1116 | (interactive (progn |
1117 | (barf-if-buffer-read-only) | |
1118 | (list (region-beginning) (region-end) | |
1119 | (if current-prefix-arg 'full)))) | |
e407986c | 1120 | (let ((fill-individual-varying-indent t)) |
b3a0387c | 1121 | (fill-individual-paragraphs min max justifyp citation-regexp))) |
e407986c | 1122 | |
b3a0387c | 1123 | (defun fill-individual-paragraphs (min max &optional justify citation-regexp) |
e407986c RS |
1124 | "Fill paragraphs of uniform indentation within the region. |
1125 | This command divides the region into \"paragraphs\", | |
f37bbf08 | 1126 | treating every change in indentation level or prefix as a paragraph boundary, |
e407986c | 1127 | then fills each paragraph using its indentation level as the fill prefix. |
e065a56e | 1128 | |
f37bbf08 RS |
1129 | There is one special case where a change in indentation does not start |
1130 | a new paragraph. This is for text of this form: | |
1131 | ||
1132 | foo> This line with extra indentation starts | |
1133 | foo> a paragraph that continues on more lines. | |
1134 | ||
1135 | These lines are filled together. | |
1136 | ||
1137 | When calling from a program, pass the range to fill | |
1138 | as the first two arguments. | |
e065a56e | 1139 | |
0cb08f98 RS |
1140 | Optional third and fourth arguments JUSTIFY and MAIL-FLAG: |
1141 | JUSTIFY to justify paragraphs (prefix arg), | |
b3a0387c RS |
1142 | When filling a mail message, pass a regexp for CITATION-REGEXP |
1143 | which will match the prefix of a line which is a citation marker | |
1144 | plus whitespace, but no other kind of prefix. | |
1145 | Also, if CITATION-REGEXP is non-nil, don't fill header lines." | |
369aeb97 DL |
1146 | (interactive (progn |
1147 | (barf-if-buffer-read-only) | |
1148 | (list (region-beginning) (region-end) | |
1149 | (if current-prefix-arg 'full)))) | |
aa228418 JB |
1150 | (save-restriction |
1151 | (save-excursion | |
1152 | (goto-char min) | |
1153 | (beginning-of-line) | |
a461b8e0 | 1154 | (narrow-to-region (point) max) |
b3a0387c | 1155 | (if citation-regexp |
a461b8e0 | 1156 | (while (and (not (eobp)) |
d09d7ba9 | 1157 | (or (looking-at "[ \t]*[^ \t\n]+:") |
a461b8e0 | 1158 | (looking-at "[ \t]*$"))) |
d09d7ba9 | 1159 | (if (looking-at "[ \t]*[^ \t\n]+:") |
30b786c3 RS |
1160 | (search-forward "\n\n" nil 'move) |
1161 | (forward-line 1)))) | |
aa228418 JB |
1162 | (narrow-to-region (point) max) |
1163 | ;; Loop over paragraphs. | |
183e4bd6 | 1164 | (while (let ((here (point))) |
4574ee6c RS |
1165 | ;; Skip over all paragraph-separating lines |
1166 | ;; so as to not include them in any paragraph. | |
183e4bd6 KH |
1167 | (while (and (not (eobp)) |
1168 | (progn (move-to-left-margin) | |
1169 | (and (not (eobp)) | |
1170 | (looking-at paragraph-separate)))) | |
4574ee6c RS |
1171 | (forward-line 1)) |
1172 | (skip-chars-forward " \t\n") (not (eobp))) | |
16cf6ab2 | 1173 | (move-to-left-margin) |
aa228418 JB |
1174 | (let ((start (point)) |
1175 | fill-prefix fill-prefix-regexp) | |
1176 | ;; Find end of paragraph, and compute the smallest fill-prefix | |
1177 | ;; that fits all the lines in this paragraph. | |
1178 | (while (progn | |
1179 | ;; Update the fill-prefix on the first line | |
1180 | ;; and whenever the prefix good so far is too long. | |
1181 | (if (not (and fill-prefix | |
1182 | (looking-at fill-prefix-regexp))) | |
1183 | (setq fill-prefix | |
742c1822 DL |
1184 | (fill-individual-paragraphs-prefix |
1185 | citation-regexp) | |
16cf6ab2 | 1186 | fill-prefix-regexp (regexp-quote fill-prefix))) |
c6286174 | 1187 | (forward-line 1) |
7b9f0657 RS |
1188 | (if (bolp) |
1189 | ;; If forward-line went past a newline, | |
1190 | ;; move further to the left margin. | |
1191 | (move-to-left-margin)) | |
aa228418 JB |
1192 | ;; Now stop the loop if end of paragraph. |
1193 | (and (not (eobp)) | |
e065a56e JB |
1194 | (if fill-individual-varying-indent |
1195 | ;; If this line is a separator line, with or | |
1196 | ;; without prefix, end the paragraph. | |
1197 | (and | |
c6286174 RS |
1198 | (not (looking-at paragraph-separate)) |
1199 | (save-excursion | |
1200 | (not (and (looking-at fill-prefix-regexp) | |
742c1822 DL |
1201 | (progn (forward-char |
1202 | (length fill-prefix)) | |
1203 | (looking-at | |
1204 | paragraph-separate)))))) | |
e065a56e JB |
1205 | ;; If this line has more or less indent |
1206 | ;; than the fill prefix wants, end the paragraph. | |
1207 | (and (looking-at fill-prefix-regexp) | |
cc7e9720 KH |
1208 | ;; If fill prefix is shorter than a new |
1209 | ;; fill prefix computed here, end paragraph. | |
1210 | (let ((this-line-fill-prefix | |
1211 | (fill-individual-paragraphs-prefix | |
1212 | citation-regexp))) | |
1213 | (>= (length fill-prefix) | |
1214 | (length this-line-fill-prefix))) | |
e065a56e | 1215 | (save-excursion |
742c1822 DL |
1216 | (not (progn (forward-char |
1217 | (length fill-prefix)) | |
f37bbf08 RS |
1218 | (or (looking-at "[ \t]") |
1219 | (looking-at paragraph-separate) | |
3b99a4f8 GM |
1220 | (looking-at paragraph-start))))) |
1221 | (not (and (equal fill-prefix "") | |
1222 | citation-regexp | |
1223 | (looking-at citation-regexp)))))))) | |
aa228418 JB |
1224 | ;; Fill this paragraph, but don't add a newline at the end. |
1225 | (let ((had-newline (bolp))) | |
0cb08f98 | 1226 | (fill-region-as-paragraph start (point) justify) |
c97a5db4 KH |
1227 | (if (and (bolp) (not had-newline)) |
1228 | (delete-char -1)))))))) | |
c0274f38 | 1229 | |
b3a0387c RS |
1230 | (defun fill-individual-paragraphs-prefix (citation-regexp) |
1231 | (or (let ((adaptive-fill-first-line-regexp "") | |
1232 | just-one-line-prefix | |
1233 | two-lines-prefix | |
1234 | one-line-citation-part | |
1235 | two-lines-citation-part | |
1236 | adjusted-two-lines-citation-part) | |
1237 | (setq just-one-line-prefix | |
1238 | (fill-context-prefix | |
1239 | (point) | |
742c1822 | 1240 | (line-beginning-position 2))) |
b3a0387c RS |
1241 | (setq two-lines-prefix |
1242 | (fill-context-prefix | |
1243 | (point) | |
1cc218de | 1244 | (line-beginning-position 3))) |
b3a0387c RS |
1245 | (when just-one-line-prefix |
1246 | (setq one-line-citation-part | |
1247 | (if citation-regexp | |
1248 | (fill-individual-paragraphs-citation just-one-line-prefix | |
1249 | citation-regexp) | |
1250 | just-one-line-prefix))) | |
1251 | (when two-lines-prefix | |
1252 | (setq two-lines-citation-part | |
1253 | (if citation-regexp | |
1254 | (fill-individual-paragraphs-citation two-lines-prefix | |
1255 | citation-regexp) | |
1256 | just-one-line-prefix)) | |
11da2896 | 1257 | (or two-lines-citation-part (setq two-lines-citation-part "")) |
b3a0387c RS |
1258 | (setq adjusted-two-lines-citation-part |
1259 | (substring two-lines-citation-part 0 | |
1260 | (string-match "[ \t]*\\'" | |
1261 | two-lines-citation-part)))) | |
1262 | ;; See if the citation part of JUST-ONE-LINE-PREFIX | |
1263 | ;; is the same as that of TWO-LINES-PREFIX, | |
1264 | ;; except perhaps with longer whitespace. | |
1265 | (if (and just-one-line-prefix | |
1266 | two-lines-prefix | |
1267 | (string-match (concat "\\`" | |
742c1822 DL |
1268 | (regexp-quote |
1269 | adjusted-two-lines-citation-part) | |
b3a0387c RS |
1270 | "[ \t]*\\'") |
1271 | one-line-citation-part) | |
1272 | (>= (string-width one-line-citation-part) | |
1273 | (string-width two-lines-citation-part))) | |
1274 | two-lines-prefix | |
1275 | just-one-line-prefix)) | |
1276 | (buffer-substring | |
1277 | (point) | |
1278 | (save-excursion (skip-chars-forward " \t") | |
1279 | (point))))) | |
1280 | ||
1281 | (defun fill-individual-paragraphs-citation (string citation-regexp) | |
1282 | (string-match citation-regexp | |
1283 | string) | |
1284 | (match-string 0 string)) | |
1285 | ||
e5d77022 | 1286 | ;;; fill.el ends here |