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