Commit | Line | Data |
---|---|---|
b0459dec | 1 | ;;; fill.el --- fill commands for Emacs -*- coding: utf-8 -*- |
c0274f38 | 2 | |
d95da8d3 | 3 | ;; Copyright (C) 1985, 1986, 1992, 1994, 1995, 1996, 1997, 1999, 2001, 2002, |
ae940284 | 4 | ;; 2003, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. |
f53a262d | 5 | |
6228c05b | 6 | ;; Maintainer: FSF |
3a801d0c ER |
7 | ;; Keywords: wp |
8 | ||
f53a262d | 9 | ;; This file is part of GNU Emacs. |
10 | ||
1fecc8fe | 11 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
f53a262d | 12 | ;; it under the terms of the GNU General Public License as published by |
1fecc8fe GM |
13 | ;; the Free Software Foundation, either version 3 of the License, or |
14 | ;; (at your option) any later version. | |
f53a262d | 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 | |
1fecc8fe | 22 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
f53a262d | 23 | |
e41b2db1 ER |
24 | ;;; Commentary: |
25 | ||
26 | ;; All the commands for filling text. These are documented in the Emacs | |
27 | ;; manual. | |
28 | ||
e5167999 | 29 | ;;; Code: |
f53a262d | 30 | |
e4b7444d SM |
31 | (defgroup fill nil |
32 | "Indenting and filling text." | |
4efbcf61 | 33 | :link '(custom-manual "(emacs)Filling") |
e4b7444d SM |
34 | :group 'editing) |
35 | ||
9d325ebf | 36 | (defcustom fill-individual-varying-indent nil |
92439579 | 37 | "Controls criterion for a new paragraph in `fill-individual-paragraphs'. |
e065a56e JB |
38 | Non-nil means changing indent doesn't end a paragraph. |
39 | That mode can handle paragraphs with extra indentation on the first line, | |
40 | but it requires separator lines between paragraphs. | |
9d325ebf RS |
41 | A value of nil means that any change in indentation starts a new paragraph." |
42 | :type 'boolean | |
43 | :group 'fill) | |
8f985fe2 | 44 | |
9d325ebf | 45 | (defcustom colon-double-space nil |
92439579 | 46 | "Non-nil means put two spaces after a colon when filling." |
9d325ebf RS |
47 | :type 'boolean |
48 | :group 'fill) | |
f31b1257 | 49 | (put 'colon-double-space 'safe-local-variable 'booleanp) |
68152e8f | 50 | |
86dfb30a | 51 | (defvar fill-paragraph-function nil |
3103b038 | 52 | "Mode-specific function to fill a paragraph, or nil if there is none. |
bbc02d00 | 53 | If the function returns nil, then `fill-paragraph' does its normal work. |
d87be1df SM |
54 | A value of t means explicitly \"do nothing special\". |
55 | Note: This only affects `fill-paragraph' and not `fill-region' | |
56 | nor `auto-fill-mode', so it is often better to use some other hook, | |
57 | such as `fill-forward-paragraph-function'.") | |
86dfb30a | 58 | |
3d9ce27e | 59 | (defvar fill-paragraph-handle-comment t |
e4b7444d | 60 | "Non-nil means paragraph filling will try to pay attention to comments.") |
3d9ce27e | 61 | |
e4b7444d | 62 | (defcustom enable-kinsoku t |
92439579 | 63 | "Non-nil means enable \"kinsoku\" processing on filling paragraphs. |
4dc0f0fc RS |
64 | Kinsoku processing is designed to prevent certain characters from being |
65 | placed at the beginning or end of a line by filling. | |
e4b7444d | 66 | See the documentation of `kinsoku' for more information." |
f5307782 JB |
67 | :type 'boolean |
68 | :group 'fill) | |
c9d611f4 | 69 | |
f53a262d | 70 | (defun set-fill-prefix () |
8f985fe2 | 71 | "Set the fill prefix to the current line up to point. |
54d7f650 RS |
72 | Filling expects lines to start with the fill prefix and |
73 | reinserts the fill prefix in each resulting line." | |
f53a262d | 74 | (interactive) |
2441692d GM |
75 | (let ((left-margin-pos (save-excursion (move-to-left-margin) (point)))) |
76 | (if (> (point) left-margin-pos) | |
77 | (progn | |
78 | (setq fill-prefix (buffer-substring left-margin-pos (point))) | |
79 | (if (equal fill-prefix "") | |
80 | (setq fill-prefix nil))) | |
81 | (setq fill-prefix nil))) | |
f53a262d | 82 | (if fill-prefix |
83 | (message "fill-prefix: \"%s\"" fill-prefix) | |
84 | (message "fill-prefix cancelled"))) | |
85 | ||
9d325ebf | 86 | (defcustom adaptive-fill-mode t |
92439579 | 87 | "Non-nil means determine a paragraph's fill prefix from its text." |
9d325ebf RS |
88 | :type 'boolean |
89 | :group 'fill) | |
54d7f650 | 90 | |
742c1822 | 91 | (defcustom adaptive-fill-regexp |
d47e9c06 SM |
92 | ;; Added `!' for doxygen comments starting with `//!' or `/*!'. |
93 | ;; Added `%' for TeX comments. | |
4e05bbf5 | 94 | ;; RMS: deleted the code to match `1.' and `(1)'. |
1e8780b1 | 95 | (purecopy "[ \t]*\\([-!|#%;>*·•‣⁃◦]+[ \t]*\\)*") |
92439579 | 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 | ||
1e8780b1 | 107 | (defcustom adaptive-fill-first-line-regexp (purecopy "\\`[ \t]*\\'") |
92439579 | 108 | "Regexp specifying whether to set fill prefix from a one-line paragraph. |
849f04e1 RS |
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 |
3e4dfbb6 JB |
121 | "Function to call to choose a fill prefix for a paragraph, or nil. |
122 | A nil value means the function has not determined the fill prefix." | |
ef4d4394 | 123 | :type '(choice (const nil) function) |
9d325ebf | 124 | :group 'fill) |
68152e8f | 125 | |
4bcb1be1 | 126 | (defvar fill-indent-according-to-mode nil ;Screws up CC-mode's filling tricks. |
178932de SM |
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") |
dff1336c SM |
163 | ;; Ideally, we'd want to scan the text from the end, so that changes to |
164 | ;; text don't affect the boundary, but the regexp we match against does | |
165 | ;; not match as eagerly when matching backward, so we instead use | |
166 | ;; a marker. | |
167 | (unless (markerp end) (setq end (copy-marker end t))) | |
20796cbc | 168 | (let ((end-spc-re (concat "\\(" (sentence-end) "\\) *\\| +"))) |
bb424945 SM |
169 | (save-excursion |
170 | (goto-char beg) | |
171 | ;; Nuke tabs; they get screwed up in a fill. | |
172 | ;; This is quick, but loses when a tab follows the end of a sentence. | |
173 | ;; Actually, it is difficult to tell that from "Mr.\tSmith". | |
174 | ;; Blame the typist. | |
8ad8316c | 175 | (subst-char-in-region beg end ?\t ?\s) |
ea9ae18a | 176 | (while (and (< (point) end) |
bb424945 SM |
177 | (re-search-forward end-spc-re end t)) |
178 | (delete-region | |
179 | (cond | |
180 | ;; `sentence-end' matched and did not match all spaces. | |
181 | ;; I.e. it only matched the number of spaces it needs: drop the rest. | |
182 | ((and (match-end 1) (> (match-end 0) (match-end 1))) (match-end 1)) | |
183 | ;; `sentence-end' matched but with nothing left. Either that means | |
184 | ;; nothing should be removed, or it means it's the "old-style" | |
185 | ;; sentence-end which matches all it can. Keep only 2 spaces. | |
186 | ;; We probably don't even need to check `sentence-end-double-space'. | |
187 | ((match-end 1) | |
188 | (min (match-end 0) | |
189 | (+ (if sentence-end-double-space 2 1) | |
190 | (save-excursion (goto-char (match-end 0)) | |
191 | (skip-chars-backward " ") | |
192 | (point))))) | |
193 | (t ;; It's not an end of sentence. | |
194 | (+ (match-beginning 0) | |
195 | ;; Determine number of spaces to leave: | |
196 | (save-excursion | |
197 | (skip-chars-backward " ]})\"'") | |
198 | (cond ((and sentence-end-double-space | |
199 | (or (memq (preceding-char) '(?. ?? ?!)) | |
200 | (and sentence-end-without-period | |
201 | (= (char-syntax (preceding-char)) ?w)))) 2) | |
202 | ((and colon-double-space | |
203 | (= (preceding-char) ?:)) 2) | |
204 | ((char-equal (preceding-char) ?\n) 0) | |
205 | (t 1)))))) | |
206 | (match-end 0)))))) | |
0cb08f98 | 207 | |
7190ab87 GM |
208 | (defun fill-common-string-prefix (s1 s2) |
209 | "Return the longest common prefix of strings S1 and S2, or nil if none." | |
210 | (let ((cmp (compare-strings s1 nil nil s2 nil nil))) | |
178932de | 211 | (if (eq cmp t) |
7190ab87 GM |
212 | s1 |
213 | (setq cmp (1- (abs cmp))) | |
214 | (unless (zerop cmp) | |
215 | (substring s1 0 cmp))))) | |
db95369b | 216 | |
d95da8d3 SM |
217 | (defun fill-match-adaptive-prefix () |
218 | (let ((str (or | |
219 | (and adaptive-fill-function (funcall adaptive-fill-function)) | |
220 | (and adaptive-fill-regexp (looking-at adaptive-fill-regexp) | |
221 | (match-string-no-properties 0))))) | |
222 | (if (>= (+ (current-left-margin) (length str)) (current-fill-column)) | |
223 | ;; Death to insanely long prefixes. | |
224 | nil | |
225 | str))) | |
226 | ||
0bcfa3ac | 227 | (defun fill-context-prefix (from to &optional first-line-regexp) |
d09d7ba9 | 228 | "Compute a fill prefix from the text between FROM and TO. |
39f5988d | 229 | This uses the variables `adaptive-fill-regexp' and `adaptive-fill-function' |
849f04e1 RS |
230 | and `adaptive-fill-first-line-regexp'. `paragraph-start' also plays a role; |
231 | we reject a prefix based on a one-line paragraph if that prefix would | |
232 | act as a paragraph-separator." | |
233 | (or first-line-regexp | |
234 | (setq first-line-regexp adaptive-fill-first-line-regexp)) | |
d09d7ba9 RS |
235 | (save-excursion |
236 | (goto-char from) | |
237 | (if (eolp) (forward-line 1)) | |
238 | ;; Move to the second line unless there is just one. | |
6d1f0a5e | 239 | (move-to-left-margin) |
d95da8d3 | 240 | (let (first-line-prefix |
0bcfa3ac | 241 | ;; Non-nil if we are on the second line. |
d95da8d3 | 242 | second-line-prefix) |
b5263b80 | 243 | (setq first-line-prefix |
3212cc84 SM |
244 | ;; We don't need to consider `paragraph-start' here since it |
245 | ;; will be explicitly checked later on. | |
246 | ;; Also setting first-line-prefix to nil prevents | |
247 | ;; second-line-prefix from being used. | |
d95da8d3 SM |
248 | ;; ((looking-at paragraph-start) nil) |
249 | (fill-match-adaptive-prefix)) | |
d09d7ba9 | 250 | (forward-line 1) |
03e3e2e9 | 251 | (if (< (point) to) |
d95da8d3 SM |
252 | (progn |
253 | (move-to-left-margin) | |
254 | (setq second-line-prefix | |
255 | (cond ((looking-at paragraph-start) nil) ;Can it happen? -Stef | |
256 | (t (fill-match-adaptive-prefix)))) | |
257 | ;; If we get a fill prefix from the second line, | |
258 | ;; make sure it or something compatible is on the first line too. | |
259 | (when second-line-prefix | |
260 | (unless first-line-prefix (setq first-line-prefix "")) | |
261 | ;; If the non-whitespace chars match the first line, | |
262 | ;; just use it (this subsumes the 2 checks used previously). | |
263 | ;; Used when first line is `/* ...' and second-line is | |
264 | ;; ` * ...'. | |
265 | (let ((tmp second-line-prefix) | |
266 | (re "\\`")) | |
267 | (while (string-match "\\`[ \t]*\\([^ \t]+\\)" tmp) | |
268 | (setq re (concat re ".*" (regexp-quote (match-string 1 tmp)))) | |
269 | (setq tmp (substring tmp (match-end 0)))) | |
270 | ;; (assert (string-match "\\`[ \t]*\\'" tmp)) | |
271 | ||
272 | (if (string-match re first-line-prefix) | |
273 | second-line-prefix | |
274 | ||
275 | ;; Use the longest common substring of both prefixes, | |
276 | ;; if there is one. | |
277 | (fill-common-string-prefix first-line-prefix | |
278 | second-line-prefix))))) | |
b5263b80 RS |
279 | ;; If we get a fill prefix from a one-line paragraph, |
280 | ;; maybe change it to whitespace, | |
281 | ;; and check that it isn't a paragraph starter. | |
282 | (if first-line-prefix | |
283 | (let ((result | |
284 | ;; If first-line-prefix comes from the first line, | |
285 | ;; see if it seems reasonable to use for all lines. | |
286 | ;; If not, replace it with whitespace. | |
287 | (if (or (and first-line-regexp | |
288 | (string-match first-line-regexp | |
289 | first-line-prefix)) | |
290 | (and comment-start-skip | |
291 | (string-match comment-start-skip | |
292 | first-line-prefix))) | |
293 | first-line-prefix | |
8ad8316c | 294 | (make-string (string-width first-line-prefix) ?\s)))) |
b5263b80 RS |
295 | ;; But either way, reject it if it indicates the start |
296 | ;; of a paragraph when text follows it. | |
297 | (if (not (eq 0 (string-match paragraph-start | |
298 | (concat result "a")))) | |
44a0dbd7 | 299 | result))))))) |
d09d7ba9 | 300 | |
03e3e2e9 SM |
301 | (defun fill-single-word-nobreak-p () |
302 | "Don't break a line after the first or before the last word of a sentence." | |
4a3608f5 SM |
303 | ;; Actually, allow breaking before the last word of a sentence, so long as |
304 | ;; it's not the last word of the paragraph. | |
305 | (or (looking-at (concat "[ \t]*\\sw+" "\\(?:" (sentence-end) "\\)[ \t]*$")) | |
03e3e2e9 SM |
306 | (save-excursion |
307 | (skip-chars-backward " \t") | |
308 | (and (/= (skip-syntax-backward "w") 0) | |
309 | (/= (skip-chars-backward " \t") 0) | |
74f36ff0 JL |
310 | (/= (skip-chars-backward ".?!:") 0) |
311 | (looking-at (sentence-end)))))) | |
03e3e2e9 SM |
312 | |
313 | (defun fill-french-nobreak-p () | |
314 | "Return nil if French style allows breaking the line at point. | |
315 | This is used in `fill-nobreak-predicate' to prevent breaking lines just | |
316 | after an opening paren or just before a closing paren or a punctuation | |
317 | mark such as `?' or `:'. It is common in French writing to put a space | |
318 | at such places, which would normally allow breaking the line at those | |
319 | places." | |
b0459dec | 320 | (or (looking-at "[ \t]*[])}»?!;:-]") |
03e3e2e9 SM |
321 | (save-excursion |
322 | (skip-chars-backward " \t") | |
323 | (unless (bolp) | |
324 | (backward-char 1) | |
b0459dec | 325 | (or (looking-at "[([{«]") |
03e3e2e9 | 326 | ;; Don't cut right after a single-letter word. |
8ad8316c | 327 | (and (memq (preceding-char) '(?\t ?\s)) |
03e3e2e9 SM |
328 | (eq (char-syntax (following-char)) ?w))))))) |
329 | ||
330 | (defcustom fill-nobreak-predicate nil | |
331 | "List of predicates for recognizing places not to break a line. | |
332 | The predicates are called with no arguments, with point at the place to | |
333 | be tested. If it returns t, fill commands do not break the line there." | |
334 | :group 'fill | |
335 | :type 'hook | |
336 | :options '(fill-french-nobreak-p fill-single-word-nobreak-p)) | |
337 | ||
1b457e18 | 338 | (defcustom fill-nobreak-invisible nil |
e4b7444d | 339 | "Non-nil means that fill commands do not break lines in invisible text." |
1b457e18 KS |
340 | :type 'boolean |
341 | :group 'fill) | |
342 | ||
03e3e2e9 SM |
343 | (defun fill-nobreak-p () |
344 | "Return nil if breaking the line at point is allowed. | |
1b457e18 KS |
345 | Can be customized with the variables `fill-nobreak-predicate' |
346 | and `fill-nobreak-invisible'." | |
347 | (or | |
72229917 | 348 | (and fill-nobreak-invisible (invisible-p (point))) |
1b457e18 | 349 | (unless (bolp) |
03e3e2e9 SM |
350 | (or |
351 | ;; Don't break after a period followed by just one space. | |
352 | ;; Move back to the previous place to break. | |
353 | ;; The reason is that if a period ends up at the end of a | |
354 | ;; line, further fills will assume it ends a sentence. | |
355 | ;; If we now know it does not end a sentence, avoid putting | |
d47e9c06 | 356 | ;; it at the end of the line. |
03e3e2e9 SM |
357 | (and sentence-end-double-space |
358 | (save-excursion | |
08150aa0 JL |
359 | (skip-chars-backward " ") |
360 | (and (eq (preceding-char) ?.) | |
361 | (looking-at " \\([^ ]\\|$\\)")))) | |
03e3e2e9 SM |
362 | ;; Another approach to the same problem. |
363 | (save-excursion | |
08150aa0 JL |
364 | (skip-chars-backward " ") |
365 | (and (eq (preceding-char) ?.) | |
366 | (not (progn (forward-char -1) (looking-at (sentence-end)))))) | |
03e3e2e9 SM |
367 | ;; Don't split a line if the rest would look like a new paragraph. |
368 | (unless use-hard-newlines | |
369 | (save-excursion | |
1637ed87 RS |
370 | (skip-chars-forward " \t") |
371 | ;; If this break point is at the end of the line, | |
372 | ;; which can occur for auto-fill, don't consider the newline | |
373 | ;; which follows as a reason to return t. | |
374 | (and (not (eolp)) | |
375 | (looking-at paragraph-start)))) | |
1b457e18 | 376 | (run-hook-with-args-until-success 'fill-nobreak-predicate))))) |
a0d8840a | 377 | |
11d356ce | 378 | (defvar fill-find-break-point-function-table (make-char-table nil) |
bc2ec97d | 379 | "Char-table of special functions to find line breaking point.") |
97323804 | 380 | |
11d356ce KH |
381 | (defvar fill-nospace-between-words-table (make-char-table nil) |
382 | "Char-table of characters that don't use space between words.") | |
383 | ||
384 | (progn | |
385 | ;; Register `kinsoku' for scripts HAN, KANA, BOPOMPFO, and CJK-MISS. | |
386 | ;; Also tell that they don't use space between words. | |
387 | (map-char-table | |
388 | #'(lambda (key val) | |
389 | (when (memq val '(han kana bopomofo cjk-misc)) | |
390 | (set-char-table-range fill-find-break-point-function-table | |
391 | key 'kinsoku) | |
392 | (set-char-table-range fill-nospace-between-words-table | |
393 | key t))) | |
394 | char-script-table) | |
395 | ;; Do the same thing also for full width characters and half | |
396 | ;; width kana variants. | |
397 | (set-char-table-range fill-find-break-point-function-table | |
398 | '(#xFF01 . #xFFE6) 'kinsoku) | |
399 | (set-char-table-range fill-nospace-between-words-table | |
400 | '(#xFF01 . #xFFE6) 'kinsoku)) | |
401 | ||
ce82deed KH |
402 | (defun fill-find-break-point (limit) |
403 | "Move point to a proper line breaking position of the current line. | |
97323804 KH |
404 | Don't move back past the buffer position LIMIT. |
405 | ||
ce82deed | 406 | This function is called when we are going to break the current line |
e4b7444d | 407 | after or before a non-ASCII character. If the charset of the |
ce82deed | 408 | character has the property `fill-find-break-point-function', this |
a5af675e | 409 | function calls the property value as a function with one arg LIMIT. |
ce82deed | 410 | If the charset has no such property, do nothing." |
bc2ec97d KH |
411 | (let ((func (or |
412 | (aref fill-find-break-point-function-table (following-char)) | |
413 | (aref fill-find-break-point-function-table (preceding-char))))) | |
34a500b3 KH |
414 | (if (and func (fboundp func)) |
415 | (funcall func limit)))) | |
97323804 | 416 | |
2f4fa275 SM |
417 | (defun fill-delete-prefix (from to prefix) |
418 | "Delete the fill prefix from every line except the first. | |
419 | The first line may not even have a fill prefix. | |
420 | Point is moved to just past the fill prefix on the first line." | |
d47e9c06 SM |
421 | (let ((fpre (if (and prefix (not (string-match "\\`[ \t]*\\'" prefix))) |
422 | (concat "[ \t]*\\(" | |
423 | (replace-regexp-in-string | |
424 | "[ \t]+" "[ \t]*" | |
425 | (regexp-quote prefix)) | |
426 | "\\)?[ \t]*") | |
427 | "[ \t]*"))) | |
428 | (goto-char from) | |
55f6a280 SM |
429 | ;; Why signal an error here? The problem needs to be caught elsewhere. |
430 | ;; (if (>= (+ (current-left-margin) (length prefix)) | |
431 | ;; (current-fill-column)) | |
432 | ;; (error "fill-prefix too long for specified width")) | |
d47e9c06 SM |
433 | (forward-line 1) |
434 | (while (< (point) to) | |
2f4fa275 | 435 | (if (looking-at fpre) |
55f6a280 | 436 | (delete-region (point) (match-end 0))) |
d47e9c06 SM |
437 | (forward-line 1)) |
438 | (goto-char from) | |
439 | (if (looking-at fpre) | |
440 | (goto-char (match-end 0))) | |
55f6a280 | 441 | (point))) |
2f4fa275 | 442 | |
e3d2084c SM |
443 | ;; The `fill-space' property carries the string with which a newline |
444 | ;; should be replaced when unbreaking a line (in fill-delete-newlines). | |
445 | ;; It is added to newline characters by fill-newline when the default | |
446 | ;; behavior of fill-delete-newlines is not what we want. | |
447 | (add-to-list 'text-property-default-nonsticky '(fill-space . t)) | |
448 | ||
2f4fa275 SM |
449 | (defun fill-delete-newlines (from to justify nosqueeze squeeze-after) |
450 | (goto-char from) | |
451 | ;; Make sure sentences ending at end of line get an extra space. | |
452 | ;; loses on split abbrevs ("Mr.\nSmith") | |
d47e9c06 SM |
453 | (let ((eol-double-space-re |
454 | (cond | |
20796cbc | 455 | ((not colon-double-space) (concat (sentence-end) "$")) |
d47e9c06 | 456 | ;; Try to add the : inside the `sentence-end' regexp. |
20796cbc JL |
457 | ((string-match "\\[[^][]*\\(\\.\\)[^][]*\\]" (sentence-end)) |
458 | (concat (replace-match ".:" nil nil (sentence-end) 1) "$")) | |
d47e9c06 | 459 | ;; Can't find the right spot to insert the colon. |
f43a0b98 KH |
460 | (t "[.?!:][])}\"']*$"))) |
461 | (sentence-end-without-space-list | |
462 | (string-to-list sentence-end-without-space))) | |
2f4fa275 | 463 | (while (re-search-forward eol-double-space-re to t) |
8ad8316c | 464 | (or (>= (point) to) (memq (char-before) '(?\t ?\s)) |
e4b7444d | 465 | (memq (char-after (match-beginning 0)) |
f43a0b98 | 466 | sentence-end-without-space-list) |
8ad8316c | 467 | (insert-and-inherit ?\s)))) |
2f4fa275 SM |
468 | |
469 | (goto-char from) | |
470 | (if enable-multibyte-characters | |
471 | ;; Delete unnecessay newlines surrounded by words. The | |
11d356ce KH |
472 | ;; character category `|' means that we can break a line at the |
473 | ;; character. And, char-table | |
474 | ;; `fill-nospace-between-words-table' tells how to concatenate | |
475 | ;; words. If a character has non-nil value in the table, never | |
476 | ;; put spaces between words, thus delete a newline between them. | |
477 | ;; Otherwise, delete a newline only when a character preceding a | |
478 | ;; newline has non-nil value in that table. | |
2f4fa275 | 479 | (while (search-forward "\n" to t) |
e3d2084c SM |
480 | (if (get-text-property (match-beginning 0) 'fill-space) |
481 | (replace-match (get-text-property (match-beginning 0) 'fill-space)) | |
482 | (let ((prev (char-before (match-beginning 0))) | |
483 | (next (following-char))) | |
484 | (if (and (or (aref (char-category-set next) ?|) | |
485 | (aref (char-category-set prev) ?|)) | |
11d356ce KH |
486 | (or (aref fill-nospace-between-words-table next) |
487 | (aref fill-nospace-between-words-table prev))) | |
e3d2084c | 488 | (delete-char -1)))))) |
2f4fa275 SM |
489 | |
490 | (goto-char from) | |
491 | (skip-chars-forward " \t") | |
492 | ;; Then change all newlines to spaces. | |
8ad8316c | 493 | (subst-char-in-region from to ?\n ?\s) |
2f4fa275 SM |
494 | (if (and nosqueeze (not (eq justify 'full))) |
495 | nil | |
51153542 SM |
496 | (canonically-space-region (or squeeze-after (point)) to) |
497 | ;; Remove trailing whitespace. | |
498 | ;; Maybe canonically-space-region should do that. | |
05670fa8 | 499 | (goto-char to) (delete-char (- (skip-chars-backward " \t")))) |
2f4fa275 SM |
500 | (goto-char from)) |
501 | ||
d47e9c06 SM |
502 | (defun fill-move-to-break-point (linebeg) |
503 | "Move to the position where the line should be broken. | |
bb424945 SM |
504 | The break position will be always after LINEBEG and generally before point." |
505 | ;; If the fill column is before linebeg, move to linebeg. | |
506 | (if (> linebeg (point)) (goto-char linebeg)) | |
d47e9c06 SM |
507 | ;; Move back to the point where we can break the line |
508 | ;; at. We break the line between word or after/before | |
509 | ;; the character which has character category `|'. We | |
510 | ;; search space, \c| followed by a character, or \c| | |
511 | ;; following a character. If not found, place | |
512 | ;; the point at linebeg. | |
513 | (while | |
514 | (when (re-search-backward "[ \t]\\|\\c|.\\|.\\c|" linebeg 0) | |
515 | ;; In case of space, we place the point at next to | |
516 | ;; the point where the break occurs actually, | |
517 | ;; because we don't want to change the following | |
518 | ;; logic of original Emacs. In case of \c|, the | |
519 | ;; point is at the place where the break occurs. | |
520 | (forward-char 1) | |
521 | (when (fill-nobreak-p) (skip-chars-backward " \t" linebeg)))) | |
ef11ff9b SM |
522 | |
523 | ;; Move back over the single space between the words. | |
524 | (skip-chars-backward " \t") | |
525 | ||
d47e9c06 SM |
526 | ;; If the left margin and fill prefix by themselves |
527 | ;; pass the fill-column. or if they are zero | |
528 | ;; but we have no room for even one word, | |
529 | ;; keep at least one word or a character which has | |
530 | ;; category `|' anyway. | |
531 | (if (>= linebeg (point)) | |
532 | ;; Ok, skip at least one word or one \c| character. | |
533 | ;; Meanwhile, don't stop at a period followed by one space. | |
534 | (let ((to (line-end-position)) | |
d47e9c06 SM |
535 | (first t)) |
536 | (goto-char linebeg) | |
537 | (while (and (< (point) to) (or first (fill-nobreak-p))) | |
538 | ;; Find a breakable point while ignoring the | |
539 | ;; following spaces. | |
540 | (skip-chars-forward " \t") | |
541 | (if (looking-at "\\c|") | |
542 | (forward-char 1) | |
543 | (let ((pos (save-excursion | |
544 | (skip-chars-forward "^ \n\t") | |
545 | (point)))) | |
546 | (if (re-search-forward "\\c|" pos t) | |
547 | (forward-char -1) | |
548 | (goto-char pos)))) | |
549 | (setq first nil))) | |
d47e9c06 SM |
550 | |
551 | (if enable-multibyte-characters | |
552 | ;; If we are going to break the line after or | |
553 | ;; before a non-ascii character, we may have to | |
554 | ;; run a special function for the charset of the | |
555 | ;; character to find the correct break point. | |
556 | (if (not (and (eq (charset-after (1- (point))) 'ascii) | |
557 | (eq (charset-after (point)) 'ascii))) | |
558 | ;; Make sure we take SOMETHING after the fill prefix if any. | |
559 | (fill-find-break-point linebeg))))) | |
560 | ||
7c315e1c KH |
561 | ;; Like text-properties-at but don't include `composition' property. |
562 | (defun fill-text-properties-at (pos) | |
563 | (let ((l (text-properties-at pos)) | |
564 | prop-list) | |
565 | (while l | |
566 | (unless (eq (car l) 'composition) | |
567 | (setq prop-list | |
568 | (cons (car l) (cons (cadr l) prop-list)))) | |
569 | (setq l (cddr l))) | |
570 | prop-list)) | |
571 | ||
d47e9c06 SM |
572 | (defun fill-newline () |
573 | ;; Replace whitespace here with one newline, then | |
574 | ;; indent to left margin. | |
575 | (skip-chars-backward " \t") | |
d47e9c06 SM |
576 | (insert ?\n) |
577 | ;; Give newline the properties of the space(s) it replaces | |
578 | (set-text-properties (1- (point)) (point) | |
7c315e1c | 579 | (fill-text-properties-at (point))) |
e3d2084c SM |
580 | (and (looking-at "\\( [ \t]*\\)\\(\\c|\\)?") |
581 | (or (aref (char-category-set (or (char-before (1- (point))) ?\000)) ?|) | |
582 | (match-end 2)) | |
583 | ;; When refilling later on, this newline would normally not be replaced | |
584 | ;; by a space, so we need to mark it specially to re-install the space | |
585 | ;; when we unfill. | |
586 | (put-text-property (1- (point)) (point) 'fill-space (match-string 1))) | |
1b457e18 KS |
587 | ;; If we don't want breaks in invisible text, don't insert |
588 | ;; an invisible newline. | |
589 | (if fill-nobreak-invisible | |
590 | (remove-text-properties (1- (point)) (point) | |
591 | '(invisible t))) | |
d47e9c06 SM |
592 | (if (or fill-prefix |
593 | (not fill-indent-according-to-mode)) | |
f601aaf8 | 594 | (fill-indent-to-left-margin) |
d47e9c06 SM |
595 | (indent-according-to-mode)) |
596 | ;; Insert the fill prefix after indentation. | |
d47e9c06 | 597 | (and fill-prefix (not (equal fill-prefix "")) |
29c1653c SM |
598 | ;; Markers that were after the whitespace are now at point: insert |
599 | ;; before them so they don't get stuck before the prefix. | |
600 | (insert-before-markers-and-inherit fill-prefix))) | |
d47e9c06 | 601 | |
f601aaf8 RS |
602 | (defun fill-indent-to-left-margin () |
603 | "Indent current line to the column given by `current-left-margin'." | |
604 | (let ((beg (point))) | |
605 | (indent-line-to (current-left-margin)) | |
606 | (put-text-property beg (point) 'face 'default))) | |
607 | ||
8c379895 KH |
608 | (defun fill-region-as-paragraph (from to &optional justify |
609 | nosqueeze squeeze-after) | |
1095bc3c | 610 | "Fill the region as one paragraph. |
2b6eb8c6 | 611 | It removes any paragraph breaks in the region and extra newlines at the end, |
1095bc3c BG |
612 | indents and fills lines between the margins given by the |
613 | `current-left-margin' and `current-fill-column' functions. | |
368d104a | 614 | \(In most cases, the variable `fill-column' controls the width.) |
2b6eb8c6 | 615 | It leaves point at the beginning of the line following the paragraph. |
0cb08f98 | 616 | |
1095bc3c BG |
617 | Normally performs justification according to the `current-justification' |
618 | function, but with a prefix arg, does full justification instead. | |
619 | ||
620 | From a program, optional third arg JUSTIFY can specify any type of | |
8c379895 | 621 | justification. Fourth arg NOSQUEEZE non-nil means not to make spaces |
f3253b8f | 622 | between words canonical before filling. Fifth arg SQUEEZE-AFTER, if non-nil, |
8c379895 | 623 | means don't canonicalize spaces before that position. |
0cb08f98 | 624 | |
ef11ff9b | 625 | Return the `fill-prefix' used for filling. |
27849a65 | 626 | |
8f985fe2 | 627 | If `sentence-end-double-space' is non-nil, then period followed by one |
0cb08f98 | 628 | space does not end a sentence, so don't break a line there." |
369aeb97 DL |
629 | (interactive (progn |
630 | (barf-if-buffer-read-only) | |
631 | (list (region-beginning) (region-end) | |
632 | (if current-prefix-arg 'full)))) | |
d09af6a5 | 633 | (unless (memq justify '(t nil none full center left right)) |
73b33545 | 634 | (setq justify 'full)) |
1095bc3c | 635 | |
2b6eb8c6 | 636 | ;; Make sure "to" is the endpoint. |
1095bc3c BG |
637 | (goto-char (min from to)) |
638 | (setq to (max from to)) | |
2b6eb8c6 RS |
639 | ;; Ignore blank lines at beginning of region. |
640 | (skip-chars-forward " \t\n") | |
1095bc3c | 641 | |
2b6eb8c6 RS |
642 | (let ((from-plus-indent (point)) |
643 | (oneleft nil)) | |
644 | ||
5fc5b7e8 | 645 | (beginning-of-line) |
55f6a280 | 646 | ;; We used to round up to whole line, but that prevents us from |
5fc5b7e8 SM |
647 | ;; correctly handling filling of mixed code-and-comment where we do want |
648 | ;; to fill the comment but not the code. So only use (point) if it's | |
649 | ;; further than `from', which means that `from' is followed by some | |
650 | ;; number of empty lines. | |
651 | (setq from (max (point) from)) | |
db95369b | 652 | |
2b6eb8c6 | 653 | ;; Delete all but one soft newline at end of region. |
dcfe5c05 | 654 | ;; And leave TO before that one. |
2b6eb8c6 | 655 | (goto-char to) |
1095bc3c BG |
656 | (while (and (> (point) from) (eq ?\n (char-after (1- (point))))) |
657 | (if (and oneleft | |
658 | (not (and use-hard-newlines | |
659 | (get-text-property (1- (point)) 'hard)))) | |
660 | (delete-backward-char 1) | |
661 | (backward-char 1) | |
662 | (setq oneleft t))) | |
2f4fa275 | 663 | (setq to (copy-marker (point) t)) |
178932de SM |
664 | ;; ;; If there was no newline, and there is text in the paragraph, then |
665 | ;; ;; create a newline. | |
666 | ;; (if (and (not oneleft) (> to from-plus-indent)) | |
667 | ;; (newline)) | |
2b6eb8c6 RS |
668 | (goto-char from-plus-indent)) |
669 | ||
670 | (if (not (> to (point))) | |
d47e9c06 | 671 | nil ;; There is no paragraph, only whitespace: exit now. |
1095bc3c BG |
672 | |
673 | (or justify (setq justify (current-justification))) | |
674 | ||
675 | ;; Don't let Adaptive Fill mode alter the fill prefix permanently. | |
676 | (let ((fill-prefix fill-prefix)) | |
677 | ;; Figure out how this paragraph is indented, if desired. | |
2f4fa275 SM |
678 | (when (and adaptive-fill-mode |
679 | (or (null fill-prefix) (string= fill-prefix ""))) | |
680 | (setq fill-prefix (fill-context-prefix from to)) | |
681 | ;; Ignore a white-space only fill-prefix | |
682 | ;; if we indent-according-to-mode. | |
683 | (when (and fill-prefix fill-indent-according-to-mode | |
684 | (string-match "\\`[ \t]*\\'" fill-prefix)) | |
685 | (setq fill-prefix nil))) | |
0cb08f98 | 686 | |
1eb29f50 SM |
687 | (goto-char from) |
688 | (beginning-of-line) | |
689 | ||
690 | (if (not justify) ; filling disabled: just check indentation | |
691 | (progn | |
692 | (goto-char from) | |
d47e9c06 | 693 | (while (< (point) to) |
1eb29f50 SM |
694 | (if (and (not (eolp)) |
695 | (< (current-indentation) (current-left-margin))) | |
696 | (fill-indent-to-left-margin)) | |
697 | (forward-line 1))) | |
698 | ||
699 | (if use-hard-newlines | |
700 | (remove-list-of-text-properties from to '(hard))) | |
701 | ;; Make sure first line is indented (at least) to left margin... | |
702 | (if (or (memq justify '(right center)) | |
703 | (< (current-indentation) (current-left-margin))) | |
704 | (fill-indent-to-left-margin)) | |
705 | ;; Delete the fill-prefix from every line. | |
706 | (fill-delete-prefix from to fill-prefix) | |
707 | (setq from (point)) | |
708 | ||
709 | ;; FROM, and point, are now before the text to fill, | |
710 | ;; but after any fill prefix on the first line. | |
711 | ||
712 | (fill-delete-newlines from to justify nosqueeze squeeze-after) | |
713 | ||
714 | ;; This is the actual filling loop. | |
715 | (goto-char from) | |
716 | (let (linebeg) | |
717 | (while (< (point) to) | |
718 | (setq linebeg (point)) | |
9bcdf9a8 | 719 | (move-to-column (current-fill-column)) |
1eb29f50 SM |
720 | (if (when (< (point) to) |
721 | ;; Find the position where we'll break the line. | |
9bcdf9a8 | 722 | (forward-char 1) ;Use an immediately following space, if any. |
1eb29f50 SM |
723 | (fill-move-to-break-point linebeg) |
724 | ;; Check again to see if we got to the end of | |
725 | ;; the paragraph. | |
726 | (skip-chars-forward " \t") | |
727 | (< (point) to)) | |
728 | ;; Found a place to cut. | |
729 | (progn | |
730 | (fill-newline) | |
731 | (when justify | |
732 | ;; Justify the line just ended, if desired. | |
733 | (save-excursion | |
734 | (forward-line -1) | |
735 | (justify-current-line justify nil t)))) | |
736 | ||
737 | (goto-char to) | |
738 | ;; Justify this last line, if desired. | |
739 | (if justify (justify-current-line justify t t)))))) | |
740 | ;; Leave point after final newline. | |
741 | (goto-char to) | |
742 | (unless (eobp) (forward-char 1)) | |
27849a65 MB |
743 | ;; Return the fill-prefix we used |
744 | fill-prefix))) | |
745 | ||
746 | (defsubst skip-line-prefix (prefix) | |
747 | "If point is inside the string PREFIX at the beginning of line, move past it." | |
748 | (when (and prefix | |
749 | (< (- (point) (line-beginning-position)) (length prefix)) | |
750 | (save-excursion | |
751 | (beginning-of-line) | |
752 | (looking-at (regexp-quote prefix)))) | |
753 | (goto-char (match-end 0)))) | |
f53a262d | 754 | |
708ca5aa RS |
755 | (defun fill-minibuffer-function (arg) |
756 | "Fill a paragraph in the minibuffer, ignoring the prompt." | |
743a6977 | 757 | (save-restriction |
708ca5aa RS |
758 | (narrow-to-region (minibuffer-prompt-end) (point-max)) |
759 | (fill-paragraph arg))) | |
760 | ||
d87be1df SM |
761 | (defvar fill-forward-paragraph-function 'forward-paragraph |
762 | "Function to move over paragraphs used by the filling code. | |
763 | It is called with a single argument specifying the number of paragraphs to move. | |
764 | Just like `forward-paragraph', it should return the number of paragraphs | |
765 | left to move.") | |
766 | ||
767 | (defun fill-forward-paragraph (arg) | |
768 | (funcall fill-forward-paragraph-function arg)) | |
769 | ||
b2d35abb | 770 | (defun fill-paragraph (&optional justify region) |
96bbf28b EZ |
771 | "Fill paragraph at or after point. |
772 | ||
b2d35abb | 773 | If JUSTIFY is non-nil (interactively, with prefix argument), justify as well. |
8f985fe2 | 774 | If `sentence-end-double-space' is non-nil, then period followed by one |
86dfb30a | 775 | space does not end a sentence, so don't break a line there. |
92439579 | 776 | The variable `fill-column' controls the width for filling. |
86dfb30a RS |
777 | |
778 | If `fill-paragraph-function' is non-nil, we call it (passing our | |
27849a65 MB |
779 | argument to it), and if it returns non-nil, we simply return its value. |
780 | ||
b2d35abb JL |
781 | If `fill-paragraph-function' is nil, return the `fill-prefix' used for filling. |
782 | ||
157bca46 CY |
783 | The REGION argument is non-nil if called interactively; in that |
784 | case, if Transient Mark mode is enabled and the mark is active, | |
785 | call `fill-region' to fill each of the paragraphs in the active | |
786 | region, instead of just filling the current paragraph." | |
369aeb97 DL |
787 | (interactive (progn |
788 | (barf-if-buffer-read-only) | |
b2d35abb JL |
789 | (list (if current-prefix-arg 'full) t))) |
790 | (or | |
791 | ;; 1. Fill the region if it is active when called interactively. | |
792 | (and region transient-mark-mode mark-active | |
793 | (not (eq (region-beginning) (region-end))) | |
64b53a1f | 794 | (or (fill-region (region-beginning) (region-end) justify) t)) |
b2d35abb JL |
795 | ;; 2. Try fill-paragraph-function. |
796 | (and (not (eq fill-paragraph-function t)) | |
d87be1df SM |
797 | (or fill-paragraph-function |
798 | (and (minibufferp (current-buffer)) | |
799 | (= 1 (point-min)))) | |
800 | (let ((function (or fill-paragraph-function | |
801 | ;; In the minibuffer, don't count the width | |
802 | ;; of the prompt. | |
803 | 'fill-minibuffer-function)) | |
804 | ;; If fill-paragraph-function is set, it probably takes care | |
805 | ;; of comments and stuff. If not, it will have to set | |
806 | ;; fill-paragraph-handle-comment back to t explicitly or | |
807 | ;; return nil. | |
808 | (fill-paragraph-handle-comment nil) | |
809 | (fill-paragraph-function t)) | |
810 | (funcall function justify))) | |
b2d35abb JL |
811 | ;; 3. Try our syntax-aware filling code. |
812 | (and fill-paragraph-handle-comment | |
d87be1df SM |
813 | ;; Our code only handles \n-terminated comments right now. |
814 | comment-start (equal comment-end "") | |
815 | (let ((fill-paragraph-handle-comment nil)) | |
816 | (fill-comment-paragraph justify))) | |
b2d35abb JL |
817 | ;; 4. If it all fails, default to the good ol' text paragraph filling. |
818 | (let ((before (point)) | |
d87be1df SM |
819 | (paragraph-start paragraph-start) |
820 | ;; Fill prefix used for filling the paragraph. | |
821 | fill-pfx) | |
b2d35abb JL |
822 | ;; Try to prevent code sections and comment sections from being |
823 | ;; filled together. | |
824 | (when (and fill-paragraph-handle-comment comment-start-skip) | |
825 | (setq paragraph-start | |
d87be1df SM |
826 | (concat paragraph-start "\\|[ \t]*\\(?:" |
827 | comment-start-skip "\\)"))) | |
b2d35abb JL |
828 | (save-excursion |
829 | ;; To make sure the return value of forward-paragraph is meaningful, | |
830 | ;; we have to start from the beginning of line, otherwise skipping | |
831 | ;; past the last few chars of a paragraph-separator would count as | |
832 | ;; a paragraph (and not skipping any chars at EOB would not count | |
833 | ;; as a paragraph even if it is). | |
834 | (move-to-left-margin) | |
d87be1df SM |
835 | (if (not (zerop (fill-forward-paragraph 1))) |
836 | ;; There's no paragraph at or after point: give up. | |
837 | (setq fill-pfx "") | |
838 | (let ((end (point)) | |
839 | (beg (progn (fill-forward-paragraph -1) (point)))) | |
840 | (goto-char before) | |
841 | (setq fill-pfx | |
842 | (if use-hard-newlines | |
843 | ;; Can't use fill-region-as-paragraph, since this | |
844 | ;; paragraph may still contain hard newlines. See | |
845 | ;; fill-region. | |
846 | (fill-region beg end justify) | |
847 | (fill-region-as-paragraph beg end justify)))))) | |
b2d35abb | 848 | fill-pfx))) |
f53a262d | 849 | |
5cec3056 GM |
850 | (declare-function comment-search-forward "newcomment" (limit &optional noerror)) |
851 | (declare-function comment-string-strip "newcomment" (str beforep afterp)) | |
153ef845 DN |
852 | |
853 | ||
3d9ce27e SM |
854 | (defun fill-comment-paragraph (&optional justify) |
855 | "Fill current comment. | |
856 | If we're not in a comment, just return nil so that the caller | |
1ddad36e SM |
857 | can take care of filling. JUSTIFY is used as in `fill-paragraph'." |
858 | (comment-normalize-vars) | |
55f6a280 | 859 | (let (has-code-and-comment ; Non-nil if it contains code and a comment. |
1ddad36e | 860 | comin comstart) |
3d9ce27e SM |
861 | ;; Figure out what kind of comment we are looking at. |
862 | (save-excursion | |
863 | (beginning-of-line) | |
1ddad36e SM |
864 | (when (setq comstart (comment-search-forward (line-end-position) t)) |
865 | (setq comin (point)) | |
866 | (goto-char comstart) (skip-chars-backward " \t") | |
867 | (setq has-code-and-comment (not (bolp))))) | |
db95369b | 868 | |
dacce831 SM |
869 | (if (not (and comstart |
870 | ;; Make sure the comment-start mark we found is accepted by | |
871 | ;; comment-start-skip. If not, all bets are off, and | |
872 | ;; we'd better not mess with it. | |
873 | (string-match comment-start-skip | |
874 | (buffer-substring comstart comin)))) | |
875 | ||
3d9ce27e SM |
876 | ;; Return nil, so the normal filling will take place. |
877 | nil | |
878 | ||
879 | ;; Narrow to include only the comment, and then fill the region. | |
1ddad36e | 880 | (let* ((fill-prefix fill-prefix) |
50ef8ff2 SM |
881 | (commark |
882 | (comment-string-strip (buffer-substring comstart comin) nil t)) | |
883 | (comment-re | |
af5debda SM |
884 | ;; A regexp more specialized than comment-start-skip, that only |
885 | ;; matches the current commark rather than any valid commark. | |
743a6977 | 886 | ;; |
af5debda SM |
887 | ;; The specialized regexp only works for "normal" comment |
888 | ;; syntax, not for Texinfo's "@c" (which can't be immediately | |
889 | ;; followed by word-chars) or Fortran's "C" (which needs to be | |
890 | ;; at bol), so check that comment-start-skip indeed allows the | |
891 | ;; commark to appear in the middle of the line and followed by | |
892 | ;; word chars. The choice of "\0" and "a" is mostly arbitrary. | |
893 | (if (string-match comment-start-skip (concat "\0" commark "a")) | |
894 | (concat "[ \t]*" (regexp-quote commark) | |
895 | ;; Make sure we only match comments that | |
896 | ;; use the exact same comment marker. | |
897 | "[^" (substring commark -1) "]") | |
898 | (concat "[ \t]*\\(?:" comment-start-skip "\\)"))) | |
899 | (comment-fill-prefix ; Compute a fill prefix. | |
1ddad36e SM |
900 | (save-excursion |
901 | (goto-char comstart) | |
902 | (if has-code-and-comment | |
8b44bc06 SM |
903 | (concat |
904 | (if (not indent-tabs-mode) | |
8ad8316c | 905 | (make-string (current-column) ?\s) |
8b44bc06 SM |
906 | (concat |
907 | (make-string (/ (current-column) tab-width) ?\t) | |
8ad8316c | 908 | (make-string (% (current-column) tab-width) ?\s))) |
8b44bc06 | 909 | (buffer-substring (point) comin)) |
1ddad36e SM |
910 | (buffer-substring (line-beginning-position) comin)))) |
911 | beg end) | |
912 | (save-excursion | |
913 | (save-restriction | |
914 | (beginning-of-line) | |
915 | (narrow-to-region | |
916 | ;; Find the first line we should include in the region to fill. | |
917 | (if has-code-and-comment | |
918 | (line-beginning-position) | |
919 | (save-excursion | |
920 | (while (and (zerop (forward-line -1)) | |
921 | (looking-at comment-re))) | |
922 | ;; We may have gone too far. Go forward again. | |
923 | (line-beginning-position | |
5a7139ee SM |
924 | (if (progn |
925 | (goto-char | |
926 | (or (comment-search-forward (line-end-position) t) | |
927 | (point))) | |
928 | (looking-at comment-re)) | |
55f6a280 SM |
929 | (progn (setq comstart (point)) 1) |
930 | (progn (setq comstart (point)) 2))))) | |
931 | ;; Find the beginning of the first line past the region to fill. | |
932 | (save-excursion | |
933 | (while (progn (forward-line 1) | |
934 | (looking-at comment-re))) | |
935 | (point))) | |
1ddad36e SM |
936 | ;; Obey paragraph starters and boundaries within comments. |
937 | (let* ((paragraph-separate | |
938 | ;; Use the default values since they correspond to | |
939 | ;; the values to use for plain text. | |
940 | (concat paragraph-separate "\\|[ \t]*\\(?:" | |
941 | comment-start-skip "\\)\\(?:" | |
942 | (default-value 'paragraph-separate) "\\)")) | |
943 | (paragraph-start | |
944 | (concat paragraph-start "\\|[ \t]*\\(?:" | |
945 | comment-start-skip "\\)\\(?:" | |
946 | (default-value 'paragraph-start) "\\)")) | |
55f6a280 | 947 | ;; We used to rely on fill-prefix to break paragraph at |
e4b7444d SM |
948 | ;; comment-starter changes, but it did not work for the |
949 | ;; first line (mixed comment&code). | |
950 | ;; We now use comment-re instead to "manually" make sure | |
951 | ;; we treat comment-marker changes as paragraph boundaries. | |
952 | ;; (paragraph-ignore-fill-prefix nil) | |
953 | ;; (fill-prefix comment-fill-prefix) | |
1ddad36e | 954 | (after-line (if has-code-and-comment |
1eb29f50 SM |
955 | (line-beginning-position 2)))) |
956 | (setq end (progn (forward-paragraph) (point))) | |
1ddad36e SM |
957 | ;; If this comment starts on a line with code, |
958 | ;; include that line in the filling. | |
959 | (setq beg (progn (backward-paragraph) | |
960 | (if (eq (point) after-line) | |
961 | (forward-line -1)) | |
1eb29f50 | 962 | (point))))) |
1ddad36e SM |
963 | |
964 | ;; Find the fill-prefix to use. | |
965 | (cond | |
55f6a280 | 966 | (fill-prefix) ; Use the user-provided fill prefix. |
1ddad36e SM |
967 | ((and adaptive-fill-mode ; Try adaptive fill mode. |
968 | (setq fill-prefix (fill-context-prefix beg end)) | |
969 | (string-match comment-start-skip fill-prefix))) | |
970 | (t | |
971 | (setq fill-prefix comment-fill-prefix))) | |
972 | ||
973 | ;; Don't fill with narrowing. | |
974 | (or | |
975 | (fill-region-as-paragraph | |
55f6a280 | 976 | (max comstart beg) end justify nil |
1ddad36e SM |
977 | ;; Don't canonicalize spaces within the code just before |
978 | ;; the comment. | |
979 | (save-excursion | |
980 | (goto-char beg) | |
981 | (if (looking-at fill-prefix) | |
982 | nil | |
983 | (re-search-forward comment-start-skip)))) | |
984 | ;; Make sure we don't return nil. | |
985 | t)))))) | |
3d9ce27e | 986 | |
0cb08f98 | 987 | (defun fill-region (from to &optional justify nosqueeze to-eop) |
f53a262d | 988 | "Fill each of the paragraphs in the region. |
73b33545 | 989 | A prefix arg means justify as well. |
368d104a | 990 | Ordinarily the variable `fill-column' controls the width. |
0cb08f98 | 991 | |
73b33545 RS |
992 | Noninteractively, the third argument JUSTIFY specifies which |
993 | kind of justification to do: `full', `left', `right', `center', | |
743a6977 JB |
994 | or `none' (equivalent to nil). A value of t means handle each |
995 | paragraph as specified by its text properties. | |
d09af6a5 | 996 | |
743a6977 JB |
997 | The fourth arg NOSQUEEZE non-nil means to leave whitespace other |
998 | than line breaks untouched, and fifth arg TO-EOP non-nil means | |
999 | to keep filling to the end of the paragraph (or next hard newline, | |
1000 | if variable `use-hard-newlines' is on). | |
0cb08f98 | 1001 | |
27849a65 MB |
1002 | Return the fill-prefix used for filling the last paragraph. |
1003 | ||
8f985fe2 RS |
1004 | If `sentence-end-double-space' is non-nil, then period followed by one |
1005 | space does not end a sentence, so don't break a line there." | |
369aeb97 DL |
1006 | (interactive (progn |
1007 | (barf-if-buffer-read-only) | |
1008 | (list (region-beginning) (region-end) | |
1009 | (if current-prefix-arg 'full)))) | |
d09af6a5 | 1010 | (unless (memq justify '(t nil none full center left right)) |
73b33545 | 1011 | (setq justify 'full)) |
ef11ff9b SM |
1012 | (let (max beg fill-pfx) |
1013 | (goto-char (max from to)) | |
1014 | (when to-eop | |
1015 | (skip-chars-backward "\n") | |
d87be1df | 1016 | (fill-forward-paragraph 1)) |
ef11ff9b SM |
1017 | (setq max (copy-marker (point) t)) |
1018 | (goto-char (setq beg (min from to))) | |
1019 | (beginning-of-line) | |
1020 | (while (< (point) max) | |
1021 | (let ((initial (point)) | |
1022 | end) | |
1023 | ;; If using hard newlines, break at every one for filling | |
1024 | ;; purposes rather than using paragraph breaks. | |
1025 | (if use-hard-newlines | |
1026 | (progn | |
1027 | (while (and (setq end (text-property-any (point) max | |
1028 | 'hard t)) | |
1029 | (not (= ?\n (char-after end))) | |
1030 | (not (>= end max))) | |
1031 | (goto-char (1+ end))) | |
1032 | (setq end (if end (min max (1+ end)) max)) | |
1033 | (goto-char initial)) | |
d87be1df | 1034 | (fill-forward-paragraph 1) |
ef11ff9b | 1035 | (setq end (min max (point))) |
d87be1df | 1036 | (fill-forward-paragraph -1)) |
ef11ff9b SM |
1037 | (if (< (point) beg) |
1038 | (goto-char beg)) | |
1039 | (if (>= (point) initial) | |
1040 | (setq fill-pfx | |
1041 | (fill-region-as-paragraph (point) end justify nosqueeze)) | |
1042 | (goto-char end)))) | |
1043 | fill-pfx)) | |
f53a262d | 1044 | |
0cb08f98 | 1045 | \f |
9d325ebf | 1046 | (defcustom default-justification 'left |
92439579 | 1047 | "Method of justifying text not otherwise specified. |
0cb08f98 RS |
1048 | Possible values are `left', `right', `full', `center', or `none'. |
1049 | The requested kind of justification is done whenever lines are filled. | |
03e3e2e9 | 1050 | The `justification' text-property can locally override this variable." |
9d325ebf RS |
1051 | :type '(choice (const left) |
1052 | (const right) | |
1053 | (const full) | |
1054 | (const center) | |
1055 | (const none)) | |
1056 | :group 'fill) | |
0cb08f98 RS |
1057 | (make-variable-buffer-local 'default-justification) |
1058 | ||
f43726fd | 1059 | (defun current-justification () |
0cb08f98 RS |
1060 | "How should we justify this line? |
1061 | This returns the value of the text-property `justification', | |
1062 | or the variable `default-justification' if there is no text-property. | |
1063 | However, it returns nil rather than `none' to mean \"don't justify\"." | |
db95369b | 1064 | (let ((j (or (get-text-property |
0cb08f98 | 1065 | ;; Make sure we're looking at paragraph body. |
db95369b | 1066 | (save-excursion (skip-chars-forward " \t") |
1095bc3c BG |
1067 | (if (and (eobp) (not (bobp))) |
1068 | (1- (point)) (point))) | |
0cb08f98 RS |
1069 | 'justification) |
1070 | default-justification))) | |
1071 | (if (eq 'none j) | |
1072 | nil | |
1073 | j))) | |
1074 | ||
c3f9a06a RS |
1075 | (defun set-justification (begin end style &optional whole-par) |
1076 | "Set the region's justification style to STYLE. | |
1077 | This commands prompts for the kind of justification to use. | |
1095bc3c | 1078 | If the mark is not active, this command operates on the current paragraph. |
c3f9a06a RS |
1079 | If the mark is active, it operates on the region. However, if the |
1080 | beginning and end of the region are not at paragraph breaks, they are | |
1081 | moved to the beginning and end \(respectively) of the paragraphs they | |
1082 | are in. | |
1083 | ||
e4b7444d SM |
1084 | If variable `use-hard-newlines' is true, all hard newlines are |
1085 | taken to be paragraph breaks. | |
1095bc3c BG |
1086 | |
1087 | When calling from a program, operates just on region between BEGIN and END, | |
1088 | unless optional fourth arg WHOLE-PAR is non-nil. In that case bounds are | |
1089 | extended to include entire paragraphs as in the interactive command." | |
0cb08f98 RS |
1090 | (interactive (list (if mark-active (region-beginning) (point)) |
1091 | (if mark-active (region-end) (point)) | |
1095bc3c | 1092 | (let ((s (completing-read |
0cb08f98 | 1093 | "Set justification to: " |
1095bc3c BG |
1094 | '(("left") ("right") ("full") |
1095 | ("center") ("none")) | |
0cb08f98 | 1096 | nil t))) |
1095bc3c BG |
1097 | (if (equal s "") (error "")) |
1098 | (intern s)) | |
1099 | t)) | |
1100 | (save-excursion | |
1101 | (save-restriction | |
1102 | (if whole-par | |
1103 | (let ((paragraph-start (if use-hard-newlines "." paragraph-start)) | |
db95369b | 1104 | (paragraph-ignore-fill-prefix (if use-hard-newlines t |
1095bc3c BG |
1105 | paragraph-ignore-fill-prefix))) |
1106 | (goto-char begin) | |
1107 | (while (and (bolp) (not (eobp))) (forward-char 1)) | |
1108 | (backward-paragraph) | |
1109 | (setq begin (point)) | |
1110 | (goto-char end) | |
1111 | (skip-chars-backward " \t\n" begin) | |
1112 | (forward-paragraph) | |
1113 | (setq end (point)))) | |
1114 | ||
1115 | (narrow-to-region (point-min) end) | |
1116 | (unjustify-region begin (point-max)) | |
c3f9a06a | 1117 | (put-text-property begin (point-max) 'justification style) |
1095bc3c | 1118 | (fill-region begin (point-max) nil t)))) |
0cb08f98 RS |
1119 | |
1120 | (defun set-justification-none (b e) | |
1121 | "Disable automatic filling for paragraphs in the region. | |
1122 | If the mark is not active, this applies to the current paragraph." | |
1095bc3c BG |
1123 | (interactive (list (if mark-active (region-beginning) (point)) |
1124 | (if mark-active (region-end) (point)))) | |
1125 | (set-justification b e 'none t)) | |
0cb08f98 RS |
1126 | |
1127 | (defun set-justification-left (b e) | |
1128 | "Make paragraphs in the region left-justified. | |
c3f9a06a | 1129 | This means they are flush at the left margin and ragged on the right. |
1095bc3c | 1130 | This is usually the default, but see the variable `default-justification'. |
0cb08f98 | 1131 | If the mark is not active, this applies to the current paragraph." |
1095bc3c BG |
1132 | (interactive (list (if mark-active (region-beginning) (point)) |
1133 | (if mark-active (region-end) (point)))) | |
1134 | (set-justification b e 'left t)) | |
0cb08f98 RS |
1135 | |
1136 | (defun set-justification-right (b e) | |
d9a49740 | 1137 | "Make paragraphs in the region right-justified. |
c3f9a06a | 1138 | This means they are flush at the right margin and ragged on the left. |
0cb08f98 | 1139 | If the mark is not active, this applies to the current paragraph." |
1095bc3c BG |
1140 | (interactive (list (if mark-active (region-beginning) (point)) |
1141 | (if mark-active (region-end) (point)))) | |
1142 | (set-justification b e 'right t)) | |
0cb08f98 RS |
1143 | |
1144 | (defun set-justification-full (b e) | |
d9a49740 | 1145 | "Make paragraphs in the region fully justified. |
1095bc3c | 1146 | This makes lines flush on both margins by inserting spaces between words. |
0cb08f98 | 1147 | If the mark is not active, this applies to the current paragraph." |
1095bc3c BG |
1148 | (interactive (list (if mark-active (region-beginning) (point)) |
1149 | (if mark-active (region-end) (point)))) | |
1150 | (set-justification b e 'full t)) | |
0cb08f98 RS |
1151 | |
1152 | (defun set-justification-center (b e) | |
1153 | "Make paragraphs in the region centered. | |
1154 | If the mark is not active, this applies to the current paragraph." | |
1095bc3c BG |
1155 | (interactive (list (if mark-active (region-beginning) (point)) |
1156 | (if mark-active (region-end) (point)))) | |
1157 | (set-justification b e 'center t)) | |
1158 | ||
1159 | ;; A line has up to six parts: | |
1160 | ;; | |
db95369b | 1161 | ;; >>> hello. |
1095bc3c BG |
1162 | ;; [Indent-1][FP][ Indent-2 ][text][trailing whitespace][newline] |
1163 | ;; | |
1164 | ;; "Indent-1" is the left-margin indentation; normally it ends at column | |
1165 | ;; given by the `current-left-margin' function. | |
1166 | ;; "FP" is the fill-prefix. It can be any string, including whitespace. | |
1167 | ;; "Indent-2" is added to justify a line if the `current-justification' is | |
1168 | ;; `center' or `right'. In `left' and `full' justification regions, any | |
1169 | ;; whitespace there is part of the line's text, and should not be changed. | |
1170 | ;; Trailing whitespace is not counted as part of the line length when | |
1171 | ;; center- or right-justifying. | |
1172 | ;; | |
db95369b | 1173 | ;; All parts of the line are optional, although the final newline can |
1095bc3c | 1174 | ;; only be missing on the last line of the buffer. |
0cb08f98 RS |
1175 | |
1176 | (defun justify-current-line (&optional how eop nosqueeze) | |
1095bc3c BG |
1177 | "Do some kind of justification on this line. |
1178 | Normally does full justification: adds spaces to the line to make it end at | |
1179 | the column given by `current-fill-column'. | |
0cb08f98 | 1180 | Optional first argument HOW specifies alternate type of justification: |
db95369b | 1181 | it can be `left', `right', `full', `center', or `none'. |
1095bc3c BG |
1182 | If HOW is t, will justify however the `current-justification' function says to. |
1183 | If HOW is nil or missing, full justification is done by default. | |
0cb08f98 RS |
1184 | Second arg EOP non-nil means that this is the last line of the paragraph, so |
1185 | it will not be stretched by full justification. | |
1186 | Third arg NOSQUEEZE non-nil means to leave interior whitespace unchanged, | |
1187 | otherwise it is made canonical." | |
369aeb97 | 1188 | (interactive "*") |
d09d7ba9 RS |
1189 | (if (eq t how) (setq how (or (current-justification) 'none)) |
1190 | (if (null how) (setq how 'full) | |
1191 | (or (memq how '(none left right center)) | |
1192 | (setq how 'full)))) | |
1095bc3c BG |
1193 | (or (memq how '(none left)) ; No action required for these. |
1194 | (let ((fc (current-fill-column)) | |
1195 | (pos (point-marker)) | |
1196 | fp-end ; point at end of fill prefix | |
1197 | beg ; point at beginning of line's text | |
1198 | end ; point at end of line's text | |
1199 | indent ; column of `beg' | |
1200 | endcol ; column of `end' | |
9fc0913c RS |
1201 | ncols ; new indent point or offset |
1202 | (nspaces 0) ; number of spaces between words | |
1203 | ; in line (not space characters) | |
9fc0913c RS |
1204 | (curr-fracspace 0) ; current fractional space amount |
1205 | count) | |
1095bc3c BG |
1206 | (end-of-line) |
1207 | ;; Check if this is the last line of the paragraph. | |
db95369b | 1208 | (if (and use-hard-newlines (null eop) |
1095bc3c BG |
1209 | (get-text-property (point) 'hard)) |
1210 | (setq eop t)) | |
1211 | (skip-chars-backward " \t") | |
1212 | ;; Quick exit if it appears to be properly justified already | |
1213 | ;; or there is no text. | |
1214 | (if (or (bolp) | |
1215 | (and (memq how '(full right)) | |
1216 | (= (current-column) fc))) | |
1217 | nil | |
1218 | (setq end (point)) | |
1219 | (beginning-of-line) | |
1220 | (skip-chars-forward " \t") | |
1221 | ;; Skip over fill-prefix. | |
db95369b | 1222 | (if (and fill-prefix |
1095bc3c BG |
1223 | (not (string-equal fill-prefix "")) |
1224 | (equal fill-prefix | |
db95369b | 1225 | (buffer-substring |
1095bc3c BG |
1226 | (point) (min (point-max) (+ (length fill-prefix) |
1227 | (point)))))) | |
1228 | (forward-char (length fill-prefix)) | |
db95369b | 1229 | (if (and adaptive-fill-mode |
1095bc3c BG |
1230 | (looking-at adaptive-fill-regexp)) |
1231 | (goto-char (match-end 0)))) | |
1232 | (setq fp-end (point)) | |
1233 | (skip-chars-forward " \t") | |
1234 | ;; This is beginning of the line's text. | |
1235 | (setq indent (current-column)) | |
1236 | (setq beg (point)) | |
1237 | (goto-char end) | |
1238 | (setq endcol (current-column)) | |
1239 | ||
1240 | ;; HOW can't be null or left--we would have exited already | |
db95369b | 1241 | (cond ((eq 'right how) |
1095bc3c BG |
1242 | (setq ncols (- fc endcol)) |
1243 | (if (< ncols 0) | |
1244 | ;; Need to remove some indentation | |
db95369b | 1245 | (delete-region |
1095bc3c BG |
1246 | (progn (goto-char fp-end) |
1247 | (if (< (current-column) (+ indent ncols)) | |
1248 | (move-to-column (+ indent ncols) t)) | |
1249 | (point)) | |
1250 | (progn (move-to-column indent) (point))) | |
1251 | ;; Need to add some | |
1252 | (goto-char beg) | |
1253 | (indent-to (+ indent ncols)) | |
1254 | ;; If point was at beginning of text, keep it there. | |
db95369b | 1255 | (if (= beg pos) |
1095bc3c BG |
1256 | (move-marker pos (point))))) |
1257 | ||
1258 | ((eq 'center how) | |
1259 | ;; Figure out how much indentation is needed | |
1260 | (setq ncols (+ (current-left-margin) | |
1261 | (/ (- fc (current-left-margin) ;avail. space | |
1262 | (- endcol indent)) ;text width | |
1263 | 2))) | |
1264 | (if (< ncols indent) | |
1265 | ;; Have too much indentation - remove some | |
1266 | (delete-region | |
1267 | (progn (goto-char fp-end) | |
1268 | (if (< (current-column) ncols) | |
1269 | (move-to-column ncols t)) | |
1270 | (point)) | |
1271 | (progn (move-to-column indent) (point))) | |
1272 | ;; Have too little - add some | |
1273 | (goto-char beg) | |
1274 | (indent-to ncols) | |
1275 | ;; If point was at beginning of text, keep it there. | |
1276 | (if (= beg pos) | |
1277 | (move-marker pos (point))))) | |
1278 | ||
1279 | ((eq 'full how) | |
1280 | ;; Insert extra spaces between words to justify line | |
1281 | (save-restriction | |
5f636376 RS |
1282 | (narrow-to-region beg end) |
1283 | (or nosqueeze | |
1284 | (canonically-space-region beg end)) | |
1285 | (goto-char (point-max)) | |
9fc0913c RS |
1286 | ;; count word spaces in line |
1287 | (while (search-backward " " nil t) | |
1288 | (setq nspaces (1+ nspaces)) | |
1289 | (skip-chars-backward " ")) | |
1095bc3c | 1290 | (setq ncols (- fc endcol)) |
9fc0913c RS |
1291 | ;; Ncols is number of additional space chars needed |
1292 | (if (and (> ncols 0) (> nspaces 0) (not eop)) | |
1293 | (progn | |
1294 | (setq curr-fracspace (+ ncols (/ (1+ nspaces) 2)) | |
1295 | count nspaces) | |
1296 | (while (> count 0) | |
1297 | (skip-chars-forward " ") | |
1298 | (insert-and-inherit | |
8ad8316c | 1299 | (make-string (/ curr-fracspace nspaces) ?\s)) |
9fc0913c RS |
1300 | (search-forward " " nil t) |
1301 | (setq count (1- count) | |
1302 | curr-fracspace | |
1303 | (+ (% curr-fracspace nspaces) ncols))))))) | |
1095bc3c BG |
1304 | (t (error "Unknown justification value")))) |
1305 | (goto-char pos) | |
1306 | (move-marker pos nil))) | |
9dfcfbc9 | 1307 | nil) |
30d653c4 | 1308 | |
1095bc3c BG |
1309 | (defun unjustify-current-line () |
1310 | "Remove justification whitespace from current line. | |
1311 | If the line is centered or right-justified, this function removes any | |
5512735e | 1312 | indentation past the left margin. If the line is full-justified, it removes |
1095bc3c BG |
1313 | extra spaces between words. It does nothing in other justification modes." |
1314 | (let ((justify (current-justification))) | |
1315 | (cond ((eq 'left justify) nil) | |
1316 | ((eq nil justify) nil) | |
1317 | ((eq 'full justify) ; full justify: remove extra spaces | |
1318 | (beginning-of-line-text) | |
742c1822 | 1319 | (canonically-space-region (point) (line-end-position))) |
1095bc3c BG |
1320 | ((memq justify '(center right)) |
1321 | (save-excursion | |
1322 | (move-to-left-margin nil t) | |
1323 | ;; Position ourselves after any fill-prefix. | |
db95369b | 1324 | (if (and fill-prefix |
1095bc3c BG |
1325 | (not (string-equal fill-prefix "")) |
1326 | (equal fill-prefix | |
db95369b | 1327 | (buffer-substring |
1095bc3c BG |
1328 | (point) (min (point-max) (+ (length fill-prefix) |
1329 | (point)))))) | |
1330 | (forward-char (length fill-prefix))) | |
1331 | (delete-region (point) (progn (skip-chars-forward " \t") | |
1332 | (point)))))))) | |
1333 | ||
1334 | (defun unjustify-region (&optional begin end) | |
1335 | "Remove justification whitespace from region. | |
1336 | For centered or right-justified regions, this function removes any indentation | |
db95369b | 1337 | past the left margin from each line. For full-justified lines, it removes |
1095bc3c BG |
1338 | extra spaces between words. It does nothing in other justification modes. |
1339 | Arguments BEGIN and END are optional; default is the whole buffer." | |
1340 | (save-excursion | |
1341 | (save-restriction | |
1342 | (if end (narrow-to-region (point-min) end)) | |
1343 | (goto-char (or begin (point-min))) | |
1344 | (while (not (eobp)) | |
1345 | (unjustify-current-line) | |
1346 | (forward-line 1))))) | |
1347 | ||
f53a262d | 1348 | \f |
b3a0387c | 1349 | (defun fill-nonuniform-paragraphs (min max &optional justifyp citation-regexp) |
e407986c RS |
1350 | "Fill paragraphs within the region, allowing varying indentation within each. |
1351 | This command divides the region into \"paragraphs\", | |
1352 | only at paragraph-separator lines, then fills each paragraph | |
1353 | using as the fill prefix the smallest indentation of any line | |
1354 | in the paragraph. | |
1355 | ||
1356 | When calling from a program, pass range to fill as first two arguments. | |
e065a56e | 1357 | |
8ad8316c JB |
1358 | Optional third and fourth arguments JUSTIFYP and CITATION-REGEXP: |
1359 | JUSTIFYP to justify paragraphs (prefix arg). | |
b3a0387c RS |
1360 | When filling a mail message, pass a regexp for CITATION-REGEXP |
1361 | which will match the prefix of a line which is a citation marker | |
1362 | plus whitespace, but no other kind of prefix. | |
f7a53cae | 1363 | Also, if CITATION-REGEXP is non-nil, don't fill header lines." |
369aeb97 DL |
1364 | (interactive (progn |
1365 | (barf-if-buffer-read-only) | |
1366 | (list (region-beginning) (region-end) | |
1367 | (if current-prefix-arg 'full)))) | |
e407986c | 1368 | (let ((fill-individual-varying-indent t)) |
b3a0387c | 1369 | (fill-individual-paragraphs min max justifyp citation-regexp))) |
e407986c | 1370 | |
b3a0387c | 1371 | (defun fill-individual-paragraphs (min max &optional justify citation-regexp) |
e407986c | 1372 | "Fill paragraphs of uniform indentation within the region. |
db95369b | 1373 | This command divides the region into \"paragraphs\", |
f37bbf08 | 1374 | treating every change in indentation level or prefix as a paragraph boundary, |
e407986c | 1375 | then fills each paragraph using its indentation level as the fill prefix. |
e065a56e | 1376 | |
f37bbf08 RS |
1377 | There is one special case where a change in indentation does not start |
1378 | a new paragraph. This is for text of this form: | |
1379 | ||
1380 | foo> This line with extra indentation starts | |
1381 | foo> a paragraph that continues on more lines. | |
1382 | ||
1383 | These lines are filled together. | |
1384 | ||
1385 | When calling from a program, pass the range to fill | |
1386 | as the first two arguments. | |
e065a56e | 1387 | |
3e4dfbb6 | 1388 | Optional third and fourth arguments JUSTIFY and CITATION-REGEXP: |
fdd2ae6d | 1389 | JUSTIFY to justify paragraphs (prefix arg). |
b3a0387c RS |
1390 | When filling a mail message, pass a regexp for CITATION-REGEXP |
1391 | which will match the prefix of a line which is a citation marker | |
1392 | plus whitespace, but no other kind of prefix. | |
f7a53cae | 1393 | Also, if CITATION-REGEXP is non-nil, don't fill header lines." |
369aeb97 DL |
1394 | (interactive (progn |
1395 | (barf-if-buffer-read-only) | |
1396 | (list (region-beginning) (region-end) | |
1397 | (if current-prefix-arg 'full)))) | |
aa228418 JB |
1398 | (save-restriction |
1399 | (save-excursion | |
1400 | (goto-char min) | |
1401 | (beginning-of-line) | |
a461b8e0 | 1402 | (narrow-to-region (point) max) |
b3a0387c | 1403 | (if citation-regexp |
a461b8e0 | 1404 | (while (and (not (eobp)) |
d09d7ba9 | 1405 | (or (looking-at "[ \t]*[^ \t\n]+:") |
a461b8e0 | 1406 | (looking-at "[ \t]*$"))) |
d09d7ba9 | 1407 | (if (looking-at "[ \t]*[^ \t\n]+:") |
30b786c3 RS |
1408 | (search-forward "\n\n" nil 'move) |
1409 | (forward-line 1)))) | |
aa228418 JB |
1410 | (narrow-to-region (point) max) |
1411 | ;; Loop over paragraphs. | |
d95da8d3 | 1412 | (while (progn |
4574ee6c RS |
1413 | ;; Skip over all paragraph-separating lines |
1414 | ;; so as to not include them in any paragraph. | |
183e4bd6 KH |
1415 | (while (and (not (eobp)) |
1416 | (progn (move-to-left-margin) | |
1417 | (and (not (eobp)) | |
1418 | (looking-at paragraph-separate)))) | |
4574ee6c RS |
1419 | (forward-line 1)) |
1420 | (skip-chars-forward " \t\n") (not (eobp))) | |
16cf6ab2 | 1421 | (move-to-left-margin) |
aa228418 JB |
1422 | (let ((start (point)) |
1423 | fill-prefix fill-prefix-regexp) | |
1424 | ;; Find end of paragraph, and compute the smallest fill-prefix | |
1425 | ;; that fits all the lines in this paragraph. | |
1426 | (while (progn | |
1427 | ;; Update the fill-prefix on the first line | |
1428 | ;; and whenever the prefix good so far is too long. | |
1429 | (if (not (and fill-prefix | |
1430 | (looking-at fill-prefix-regexp))) | |
1431 | (setq fill-prefix | |
742c1822 DL |
1432 | (fill-individual-paragraphs-prefix |
1433 | citation-regexp) | |
16cf6ab2 | 1434 | fill-prefix-regexp (regexp-quote fill-prefix))) |
c6286174 | 1435 | (forward-line 1) |
7b9f0657 RS |
1436 | (if (bolp) |
1437 | ;; If forward-line went past a newline, | |
1438 | ;; move further to the left margin. | |
1439 | (move-to-left-margin)) | |
aa228418 JB |
1440 | ;; Now stop the loop if end of paragraph. |
1441 | (and (not (eobp)) | |
e065a56e JB |
1442 | (if fill-individual-varying-indent |
1443 | ;; If this line is a separator line, with or | |
1444 | ;; without prefix, end the paragraph. | |
db95369b | 1445 | (and |
c6286174 RS |
1446 | (not (looking-at paragraph-separate)) |
1447 | (save-excursion | |
1448 | (not (and (looking-at fill-prefix-regexp) | |
742c1822 DL |
1449 | (progn (forward-char |
1450 | (length fill-prefix)) | |
1451 | (looking-at | |
1452 | paragraph-separate)))))) | |
e065a56e JB |
1453 | ;; If this line has more or less indent |
1454 | ;; than the fill prefix wants, end the paragraph. | |
1455 | (and (looking-at fill-prefix-regexp) | |
cc7e9720 KH |
1456 | ;; If fill prefix is shorter than a new |
1457 | ;; fill prefix computed here, end paragraph. | |
1458 | (let ((this-line-fill-prefix | |
db95369b | 1459 | (fill-individual-paragraphs-prefix |
cc7e9720 | 1460 | citation-regexp))) |
db95369b | 1461 | (>= (length fill-prefix) |
cc7e9720 | 1462 | (length this-line-fill-prefix))) |
e065a56e | 1463 | (save-excursion |
742c1822 DL |
1464 | (not (progn (forward-char |
1465 | (length fill-prefix)) | |
f37bbf08 RS |
1466 | (or (looking-at "[ \t]") |
1467 | (looking-at paragraph-separate) | |
3b99a4f8 GM |
1468 | (looking-at paragraph-start))))) |
1469 | (not (and (equal fill-prefix "") | |
1470 | citation-regexp | |
1471 | (looking-at citation-regexp)))))))) | |
aa228418 JB |
1472 | ;; Fill this paragraph, but don't add a newline at the end. |
1473 | (let ((had-newline (bolp))) | |
0cb08f98 | 1474 | (fill-region-as-paragraph start (point) justify) |
c97a5db4 KH |
1475 | (if (and (bolp) (not had-newline)) |
1476 | (delete-char -1)))))))) | |
3e4dfbb6 | 1477 | |
b3a0387c | 1478 | (defun fill-individual-paragraphs-prefix (citation-regexp) |
03e3e2e9 SM |
1479 | (let* ((adaptive-fill-first-line-regexp ".*") |
1480 | (just-one-line-prefix | |
1481 | ;; Accept any prefix rather than just the ones matched by | |
1482 | ;; adaptive-fill-first-line-regexp. | |
1483 | (fill-context-prefix (point) (line-beginning-position 2))) | |
1484 | (two-lines-prefix | |
1485 | (fill-context-prefix (point) (line-beginning-position 3)))) | |
1486 | (if (not just-one-line-prefix) | |
1487 | (buffer-substring | |
1488 | (point) (save-excursion (skip-chars-forward " \t") (point))) | |
b3a0387c RS |
1489 | ;; See if the citation part of JUST-ONE-LINE-PREFIX |
1490 | ;; is the same as that of TWO-LINES-PREFIX, | |
1491 | ;; except perhaps with longer whitespace. | |
03e3e2e9 SM |
1492 | (if (and just-one-line-prefix two-lines-prefix |
1493 | (let* ((one-line-citation-part | |
1494 | (fill-individual-paragraphs-citation | |
1495 | just-one-line-prefix citation-regexp)) | |
1496 | (two-lines-citation-part | |
1497 | (fill-individual-paragraphs-citation | |
1498 | two-lines-prefix citation-regexp)) | |
1499 | (adjusted-two-lines-citation-part | |
1500 | (substring two-lines-citation-part 0 | |
1501 | (string-match "[ \t]*\\'" | |
1502 | two-lines-citation-part)))) | |
1503 | (and | |
b3a0387c | 1504 | (string-match (concat "\\`" |
742c1822 DL |
1505 | (regexp-quote |
1506 | adjusted-two-lines-citation-part) | |
b3a0387c RS |
1507 | "[ \t]*\\'") |
1508 | one-line-citation-part) | |
1509 | (>= (string-width one-line-citation-part) | |
03e3e2e9 | 1510 | (string-width two-lines-citation-part))))) |
b3a0387c | 1511 | two-lines-prefix |
03e3e2e9 | 1512 | just-one-line-prefix)))) |
b3a0387c RS |
1513 | |
1514 | (defun fill-individual-paragraphs-citation (string citation-regexp) | |
03e3e2e9 SM |
1515 | (if citation-regexp |
1516 | (if (string-match citation-regexp string) | |
1517 | (match-string 0 string) | |
1518 | "") | |
1519 | string)) | |
b3a0387c | 1520 | |
d95da8d3 | 1521 | ;; arch-tag: 727ad455-1161-4fa9-8df5-0f74b179216d |
e5d77022 | 1522 | ;;; fill.el ends here |