Mercurial > emacs
comparison lisp/textmodes/fill.el @ 10811:7f9e55cdc349
(set-fill-prefix): start from left-margin.
(fill-region-as-paragraph): don't delete hard newlines. ignore whitespace
at beginning of region. Remove justification indentation.
(fill-region): Don't use paragraph-movement commands when use-hard-newlines
is true, just search for hard newlines.
(current-justification): take care at EOB.
(set-justification): new argWHOLE-PAR. Callers changed.
(justify-current-line): Error if JUSTIFY arg is not reasonable.
Better interaction if there is a fill-prefix.
"Line too long" warning removed.
(unjustify-current-line, unjustify-region): New functions.
author | Boris Goldowsky <boris@gnu.org> |
---|---|
date | Thu, 23 Feb 1995 18:22:04 +0000 |
parents | 6f9d0e697678 |
children | d8acd5b8cf63 |
comparison
equal
deleted
inserted
replaced
10810:9b418bde9fcf | 10811:7f9e55cdc349 |
---|---|
44 "Set the fill prefix to the current line up to point. | 44 "Set the fill prefix to the current line up to point. |
45 Filling expects lines to start with the fill prefix and | 45 Filling expects lines to start with the fill prefix and |
46 reinserts the fill prefix in each resulting line." | 46 reinserts the fill prefix in each resulting line." |
47 (interactive) | 47 (interactive) |
48 (setq fill-prefix (buffer-substring | 48 (setq fill-prefix (buffer-substring |
49 (save-excursion (beginning-of-line) (point)) | 49 (save-excursion (move-to-left-margin) (point)) |
50 (point))) | 50 (point))) |
51 (if (equal fill-prefix "") | 51 (if (equal fill-prefix "") |
52 (setq fill-prefix nil)) | 52 (setq fill-prefix nil)) |
53 (if fill-prefix | 53 (if fill-prefix |
54 (message "fill-prefix: \"%s\"" fill-prefix) | 54 (message "fill-prefix: \"%s\"" fill-prefix) |
118 (while (and (< (point) end) | 118 (while (and (< (point) end) |
119 (re-search-forward "[.?!][])}\"']*$" end t)) | 119 (re-search-forward "[.?!][])}\"']*$" end t)) |
120 (insert-and-inherit ? )))) | 120 (insert-and-inherit ? )))) |
121 | 121 |
122 (defun fill-region-as-paragraph (from to &optional justify nosqueeze) | 122 (defun fill-region-as-paragraph (from to &optional justify nosqueeze) |
123 "Fill region as one paragraph: break lines to fit `fill-column'. | 123 "Fill the region as one paragraph. |
124 This removes any paragraph breaks in the region. | 124 Removes any paragraph breaks in the region and extra newlines at the end, |
125 It performs justification according to the `justification' text-property, | 125 indents and fills lines between the margins given by the |
126 but a prefix arg can be used to override this and request full justification. | 126 `current-left-margin' and `current-fill-column' functions. |
127 | 127 |
128 Optional fourth arg NOSQUEEZE non-nil means to leave whitespace other than line | 128 Normally performs justification according to the `current-justification' |
129 breaks untouched. Normally it is made canonical before filling. | 129 function, but with a prefix arg, does full justification instead. |
130 | |
131 From a program, optional third arg JUSTIFY can specify any type of | |
132 justification, and fourth arg NOSQUEEZE non-nil means not to make spaces | |
133 between words canonical before filling. | |
130 | 134 |
131 If `sentence-end-double-space' is non-nil, then period followed by one | 135 If `sentence-end-double-space' is non-nil, then period followed by one |
132 space does not end a sentence, so don't break a line there." | 136 space does not end a sentence, so don't break a line there." |
133 (interactive "r\nP") | 137 (interactive "r\nP") |
134 ;; Arrange for undoing the fill to restore point. | 138 ;; Arrange for undoing the fill to restore point. |
135 (if (and buffer-undo-list (not (eq buffer-undo-list t))) | 139 (if (and buffer-undo-list (not (eq buffer-undo-list t))) |
136 (setq buffer-undo-list (cons (point) buffer-undo-list))) | 140 (setq buffer-undo-list (cons (point) buffer-undo-list))) |
137 (or justify (setq justify (current-justification))) | 141 |
138 | 142 ;; Make sure "to" is the endpoint. Make sure that we end up there. |
139 ;; Don't let Adaptive Fill mode alter the fill prefix permanently. | 143 (goto-char (min from to)) |
140 (let ((fill-prefix fill-prefix) | 144 (setq to (max from to)) |
141 (skip-after 0)) | 145 (setq from (point)) |
142 ;; Figure out how this paragraph is indented, if desired. | 146 |
143 (if (and adaptive-fill-mode | 147 ;; Delete all but one soft newline at end of region. |
144 (or (null fill-prefix) (string= fill-prefix ""))) | 148 (goto-char to) |
145 (save-excursion | 149 (let ((oneleft nil)) |
146 (goto-char (min from to)) | 150 (while (and (> (point) from) (eq ?\n (char-after (1- (point))))) |
147 (if (eolp) (forward-line 1)) | 151 (if (and oneleft |
148 (forward-line 1) | 152 (not (and use-hard-newlines |
149 (move-to-left-margin) | 153 (get-text-property (1- (point)) 'hard)))) |
150 (if (< (point) (max from to)) | 154 (delete-backward-char 1) |
151 (let ((start (point))) | 155 (backward-char 1) |
152 (re-search-forward adaptive-fill-regexp) | 156 (setq oneleft t))) |
153 (setq fill-prefix (buffer-substring start (point))) | 157 ;; If there was no newline, create one. |
154 (set-text-properties 0 (length fill-prefix) nil fill-prefix)) | 158 (if (and (not oneleft) (> (point) from)) |
155 (goto-char (min from to)) | 159 (save-excursion (newline)))) |
160 (setq to (point)) | |
161 | |
162 ;; Ignore blank lines at beginning of region. | |
163 (goto-char from) | |
164 (skip-chars-forward " \t\n") | |
165 (beginning-of-line) | |
166 (setq from (point)) | |
167 | |
168 (if (>= from to) | |
169 nil ; There is no paragraph at all. | |
170 | |
171 (or justify (setq justify (current-justification))) | |
172 | |
173 ;; Don't let Adaptive Fill mode alter the fill prefix permanently. | |
174 (let ((fill-prefix fill-prefix)) | |
175 ;; Figure out how this paragraph is indented, if desired. | |
176 (if (and adaptive-fill-mode | |
177 (or (null fill-prefix) (string= fill-prefix ""))) | |
178 (save-excursion | |
179 (goto-char from) | |
156 (if (eolp) (forward-line 1)) | 180 (if (eolp) (forward-line 1)) |
181 (forward-line 1) | |
182 (move-to-left-margin) | |
183 (if (< (point) to) | |
184 (let ((start (point))) | |
185 (re-search-forward adaptive-fill-regexp) | |
186 (setq fill-prefix (buffer-substring start (point))) | |
187 (set-text-properties 0 (length fill-prefix) nil | |
188 fill-prefix))) | |
157 ;; If paragraph has only one line, don't assume in general | 189 ;; If paragraph has only one line, don't assume in general |
158 ;; that additional lines would have the same starting | 190 ;; that additional lines would have the same starting |
159 ;; decoration. Assume no indentation. | 191 ;; decoration. Assume no indentation. |
160 ))) | 192 )) |
161 | |
162 (if (not justify) ; filling disabled: just check indentation | |
163 (progn | |
164 (goto-char (min from to)) | |
165 (setq to (max from to)) | |
166 (while (< (point) to) | |
167 (if (not (eolp)) | |
168 (if (< (current-indentation) (current-left-margin)) | |
169 (indent-to-left-margin))) | |
170 (forward-line 1))) | |
171 | 193 |
172 (save-restriction | 194 (save-restriction |
173 (let (beg) | 195 (goto-char from) |
174 (goto-char (min from to)) | 196 (beginning-of-line) |
175 (skip-chars-forward "\n") | 197 (narrow-to-region (point) to) |
176 (setq beg (point)) | 198 |
177 (goto-char (max from to)) | 199 (if (not justify) ; filling disabled: just check indentation |
178 (skip-chars-backward "\n") | 200 (progn |
179 (setq skip-after (- to (point))) | 201 (goto-char from) |
180 ;; If we omit some final newlines from the end of the narrowing, | 202 (while (not (eobp)) |
181 ;; arrange to advance past them at the end. | 203 (if (and (not (eolp)) |
182 (setq to (point) | 204 (< (current-indentation) (current-left-margin))) |
183 from beg) | 205 (indent-to-left-margin)) |
206 (forward-line 1))) | |
207 | |
208 (if use-hard-newlines | |
209 (remove-text-properties from (point-max) '(hard nil))) | |
210 ;; Make sure first line is indented (at least) to left margin... | |
211 (if (or (memq justify '(right center)) | |
212 (< (current-indentation) (current-left-margin))) | |
213 (indent-to-left-margin)) | |
214 ;; and remove indentation from other lines. | |
215 (beginning-of-line 2) | |
216 (indent-region (point) (point-max) 0) | |
217 ;; Delete the fill prefix from every line except the first. | |
218 ;; The first line may not even have a fill prefix. | |
184 (goto-char from) | 219 (goto-char from) |
185 (beginning-of-line) | 220 (let ((fpre (and fill-prefix (not (equal fill-prefix "")) |
186 (narrow-to-region (point) to)) | 221 (concat "[ \t]*" |
187 (if use-hard-newlines | 222 (regexp-quote fill-prefix) |
188 (remove-text-properties from to '(hard nil))) | 223 "[ \t]*")))) |
189 ;; Make sure first line is indented (at least) to left margin... | 224 (and fpre |
190 (if (or (memq justify '(right center)) | 225 (progn |
191 (< (current-indentation) (current-left-margin))) | 226 (if (>= (+ (current-left-margin) (length fill-prefix)) |
192 (indent-to-left-margin)) | 227 (current-fill-column)) |
193 ;; and remove indentation from other lines. | 228 (error "fill-prefix too long for specified width")) |
194 (beginning-of-line 2) | 229 (goto-char from) |
195 (indent-region (point) (point-max) 0) | 230 (forward-line 1) |
196 ;; Delete the fill prefix from every line except the first. | 231 (while (not (eobp)) |
197 ;; The first line may not even have a fill prefix. | 232 (if (looking-at fpre) |
198 (goto-char from) | 233 (delete-region (point) (match-end 0))) |
199 (let ((fpre (and fill-prefix (not (equal fill-prefix "")) | 234 (forward-line 1)) |
200 (concat "[ \t]*" | 235 (goto-char from) |
201 (regexp-quote fill-prefix))))) | 236 (and (looking-at fpre) (goto-char (match-end 0))) |
202 (and fpre | 237 (setq from (point))))) |
203 (progn | 238 ;; "from" is now before the text to fill, |
204 (if (>= (+ (current-left-margin) (length fill-prefix)) | 239 ;; but after any fill prefix on the first line. |
205 (current-fill-column)) | 240 |
206 (error "fill-prefix too long for specified width")) | 241 ;; Make sure sentences ending at end of line get an extra space. |
207 (goto-char from) | 242 ;; loses on split abbrevs ("Mr.\nSmith") |
208 (forward-line 1) | 243 (while (re-search-forward "[.?!][])}\"']*$" nil t) |
209 (while (not (eobp)) | 244 (insert-and-inherit ? )) |
210 (if (looking-at fpre) | 245 (goto-char from) |
211 (delete-region (point) (match-end 0))) | 246 (skip-chars-forward " \t") |
212 (forward-line 1)) | 247 ;; Then change all newlines to spaces. |
213 (goto-char from) | 248 (subst-char-in-region from (point-max) ?\n ?\ ) |
214 (and (looking-at fpre) (goto-char (match-end 0))) | 249 (if (and nosqueeze (not (eq justify 'full))) |
215 (setq from (point))))) | 250 nil |
216 ;; "from" is now before the text to fill, | 251 (canonically-space-region (point) (point-max)) |
217 ;; but after any fill prefix on the first line. | 252 (goto-char (point-max)) |
218 | 253 (delete-horizontal-space) |
219 ;; Make sure sentences ending at end of line get an extra space. | 254 (insert-and-inherit " ")) |
220 ;; loses on split abbrevs ("Mr.\nSmith") | 255 (goto-char (point-min)) |
221 (while (re-search-forward "[.?!][])}\"']*$" nil t) | 256 |
222 (insert-and-inherit ? )) | 257 ;; This is the actual filling loop. |
223 (goto-char from) | 258 (let ((prefixcol 0) linebeg) |
224 (skip-chars-forward " \t") | 259 (while (not (eobp)) |
225 ;; Then change all newlines to spaces. | 260 (setq linebeg (point)) |
226 (subst-char-in-region from (point-max) ?\n ?\ ) | 261 (move-to-column (1+ (current-fill-column))) |
227 (if (and nosqueeze (not (eq justify 'full))) | 262 (if (eobp) |
228 nil | 263 (or nosqueeze (delete-horizontal-space)) |
229 (canonically-space-region (point) (point-max)) | 264 ;; Move back to start of word. |
230 (goto-char (point-max)) | 265 (skip-chars-backward "^ \n" linebeg) |
231 (delete-horizontal-space) | 266 ;; Don't break after a period followed by just one space. |
232 (insert-and-inherit " ")) | 267 ;; Move back to the previous place to break. |
233 (goto-char (point-min)) | 268 ;; The reason is that if a period ends up at the end of a line, |
234 | 269 ;; further fills will assume it ends a sentence. |
235 ;; This is the actual filling loop. | 270 ;; If we now know it does not end a sentence, |
236 (let ((prefixcol 0) linebeg) | 271 ;; avoid putting it at the end of the line. |
237 (while (not (eobp)) | 272 (if sentence-end-double-space |
238 (setq linebeg (point)) | 273 (while (and (> (point) (+ linebeg 2)) |
239 (move-to-column (1+ (current-fill-column))) | 274 (eq (preceding-char) ?\ ) |
240 (if (eobp) | 275 (not (eq (following-char) ?\ )) |
241 (or nosqueeze (delete-horizontal-space)) | 276 (eq (char-after (- (point) 2)) ?\.)) |
242 ;; Move back to start of word. | 277 (forward-char -2) |
243 (skip-chars-backward "^ \n" linebeg) | 278 (skip-chars-backward "^ \n" linebeg))) |
244 ;; Don't break after a period followed by just one space. | 279 (if (if (zerop prefixcol) |
245 ;; Move back to the previous place to break. | 280 (save-excursion |
246 ;; The reason is that if a period ends up at the end of a line, | 281 (skip-chars-backward " " linebeg) |
247 ;; further fills will assume it ends a sentence. | 282 (bolp)) |
248 ;; If we now know it does not end a sentence, | 283 (>= prefixcol (current-column))) |
249 ;; avoid putting it at the end of the line. | 284 ;; Keep at least one word even if fill prefix exceeds margin. |
250 (if sentence-end-double-space | 285 ;; This handles all but the first line of the paragraph. |
251 (while (and (> (point) (+ linebeg 2)) | 286 ;; Meanwhile, don't stop at a period followed by one space. |
252 (eq (preceding-char) ?\ ) | 287 (let ((first t)) |
253 (not (eq (following-char) ?\ )) | 288 (move-to-column prefixcol) |
254 (eq (char-after (- (point) 2)) ?\.)) | 289 (while (and (not (eobp)) |
255 (forward-char -2) | 290 (or first |
256 (skip-chars-backward "^ \n" linebeg))) | 291 (and (not (bobp)) |
257 (if (if (zerop prefixcol) | 292 sentence-end-double-space |
258 (save-excursion | 293 (save-excursion (forward-char -1) |
259 (skip-chars-backward " " linebeg) | 294 (and (looking-at "\\. ") |
260 (bolp)) | 295 (not (looking-at "\\. "))))))) |
261 (>= prefixcol (current-column))) | 296 (skip-chars-forward " ") |
262 ;; Keep at least one word even if fill prefix exceeds margin. | 297 (skip-chars-forward "^ \n") |
263 ;; This handles all but the first line of the paragraph. | 298 (setq first nil))) |
264 ;; Meanwhile, don't stop at a period followed by one space. | 299 ;; Normally, move back over the single space between the words. |
265 (let ((first t)) | 300 (forward-char -1)) |
266 (move-to-column prefixcol) | 301 (if (and fill-prefix (zerop prefixcol) |
267 (while (and (not (eobp)) | 302 (< (- (point) (point-min)) (length fill-prefix)) |
268 (or first | 303 (string= (buffer-substring (point-min) (point)) |
269 (and (not (bobp)) | 304 (substring fill-prefix 0 (- (point) (point-min))))) |
270 sentence-end-double-space | 305 ;; Keep at least one word even if fill prefix exceeds margin. |
271 (save-excursion (forward-char -1) | 306 ;; This handles the first line of the paragraph. |
272 (and (looking-at "\\. ") | 307 ;; Don't stop at a period followed by just one space. |
273 (not (looking-at "\\. "))))))) | 308 (let ((first t)) |
274 (skip-chars-forward " ") | 309 (while (and (not (eobp)) |
275 (skip-chars-forward "^ \n") | 310 (or first |
276 (setq first nil))) | 311 (and (not (bobp)) |
277 ;; Normally, move back over the single space between the words. | 312 sentence-end-double-space |
278 (forward-char -1)) | 313 (save-excursion (forward-char -1) |
279 (if (and fill-prefix (zerop prefixcol) | 314 (and (looking-at "\\. ") |
280 (< (- (point) (point-min)) (length fill-prefix)) | 315 (not (looking-at "\\. "))))))) |
281 (string= (buffer-substring (point-min) (point)) | 316 (skip-chars-forward " ") |
282 (substring fill-prefix 0 (- (point) (point-min))))) | 317 (skip-chars-forward "^ \n") |
283 ;; Keep at least one word even if fill prefix exceeds margin. | 318 (setq first nil)))) |
284 ;; This handles the first line of the paragraph. | 319 ;; Replace whitespace here with one newline, then indent to left |
285 ;; Don't stop at a period followed by just one space. | 320 ;; margin. |
286 (let ((first t)) | 321 (skip-chars-backward " ") |
287 (while (and (not (eobp)) | 322 (insert ?\n) |
288 (or first | 323 ;; Give newline the properties of the space(s) it replaces |
289 (and (not (bobp)) | 324 (set-text-properties (1- (point)) (point) |
290 sentence-end-double-space | 325 (text-properties-at (point))) |
291 (save-excursion (forward-char -1) | 326 (indent-to-left-margin) |
292 (and (looking-at "\\. ") | 327 ;; Insert the fill prefix after indentation. |
293 (not (looking-at "\\. "))))))) | 328 ;; Set prefixcol so whitespace in the prefix won't get lost. |
294 (skip-chars-forward " ") | 329 (and fill-prefix (not (equal fill-prefix "")) |
295 (skip-chars-forward "^ \n") | 330 (progn |
296 (setq first nil)))) | 331 (insert-and-inherit fill-prefix) |
297 ;; Replace whitespace here with one newline, then indent to left | 332 (setq prefixcol (current-column))))) |
298 ;; margin. | 333 ;; Justify the line just ended, if desired. |
299 (skip-chars-backward " ") | 334 (if justify |
300 (insert ?\n) | 335 (if (eobp) |
301 ;; Give newline the properties of the space(s) it replaces | 336 (justify-current-line justify t t) |
302 (set-text-properties (1- (point)) (point) | 337 (forward-line -1) |
303 (text-properties-at (point))) | 338 (justify-current-line justify nil t) |
304 (indent-to-left-margin) | 339 (forward-line 1)))))) |
305 ;; Insert the fill prefix after indentation. | 340 ;; Leave point after final newline. |
306 ;; Set prefixcol so whitespace in the prefix won't get lost. | 341 (goto-char (point-max))) |
307 (and fill-prefix (not (equal fill-prefix "")) | 342 (forward-char 1)))) |
308 (progn | |
309 (insert-and-inherit fill-prefix) | |
310 (setq prefixcol (current-column))))) | |
311 ;; Justify the line just ended, if desired. | |
312 (if justify | |
313 (if (eobp) | |
314 (justify-current-line justify t t) | |
315 (forward-line -1) | |
316 (justify-current-line justify nil t) | |
317 (forward-line 1)))))) | |
318 (forward-char skip-after)))) | |
319 | 343 |
320 (defun fill-paragraph (arg) | 344 (defun fill-paragraph (arg) |
321 "Fill paragraph at or after point. Prefix arg means justify as well. | 345 "Fill paragraph at or after point. Prefix arg means justify as well. |
322 If `sentence-end-double-space' is non-nil, then period followed by one | 346 If `sentence-end-double-space' is non-nil, then period followed by one |
323 space does not end a sentence, so don't break a line there. | 347 space does not end a sentence, so don't break a line there. |
352 hard newline, if `use-hard-newlines' is on). | 376 hard newline, if `use-hard-newlines' is on). |
353 | 377 |
354 If `sentence-end-double-space' is non-nil, then period followed by one | 378 If `sentence-end-double-space' is non-nil, then period followed by one |
355 space does not end a sentence, so don't break a line there." | 379 space does not end a sentence, so don't break a line there." |
356 (interactive "r\nP") | 380 (interactive "r\nP") |
357 ;; If using hard newlines, break at every one for filling purposes rather | 381 (let (end beg) |
358 ;; than breaking at normal paragraph breaks. | |
359 (let ((paragraph-start (if use-hard-newlines "^" paragraph-start)) | |
360 end beg) | |
361 (save-restriction | 382 (save-restriction |
362 (goto-char (max from to)) | 383 (goto-char (max from to)) |
363 (if to-eop | 384 (if to-eop |
364 (progn (skip-chars-backward "\n") | 385 (progn (skip-chars-backward "\n") |
365 (forward-paragraph))) | 386 (forward-paragraph))) |
367 (goto-char (setq beg (min from to))) | 388 (goto-char (setq beg (min from to))) |
368 (beginning-of-line) | 389 (beginning-of-line) |
369 (narrow-to-region (point) end) | 390 (narrow-to-region (point) end) |
370 (while (not (eobp)) | 391 (while (not (eobp)) |
371 (let ((initial (point)) | 392 (let ((initial (point)) |
372 (end (progn | 393 end) |
373 (forward-paragraph 1) (point)))) | 394 ;; If using hard newlines, break at every one for filling |
374 (forward-paragraph -1) | 395 ;; purposes rather than using paragraph breaks. |
396 (if use-hard-newlines | |
397 (progn | |
398 (while (and (setq end (text-property-any (point) (point-max) | |
399 'hard t)) | |
400 (not (= ?\n (char-after end))) | |
401 (not (= end (point-max)))) | |
402 (goto-char (1+ end))) | |
403 (setq end (min (point-max) (1+ end))) | |
404 (goto-char initial)) | |
405 (forward-paragraph 1) | |
406 (setq end (point)) | |
407 (forward-paragraph -1)) | |
375 (if (< (point) beg) | 408 (if (< (point) beg) |
376 (goto-char beg)) | 409 (goto-char beg)) |
377 (if (>= (point) initial) | 410 (if (>= (point) initial) |
378 (fill-region-as-paragraph (point) end justify nosqueeze) | 411 (fill-region-as-paragraph (point) end justify nosqueeze) |
379 (goto-char end))))))) | 412 (goto-char end))))))) |
392 This returns the value of the text-property `justification', | 425 This returns the value of the text-property `justification', |
393 or the variable `default-justification' if there is no text-property. | 426 or the variable `default-justification' if there is no text-property. |
394 However, it returns nil rather than `none' to mean \"don't justify\"." | 427 However, it returns nil rather than `none' to mean \"don't justify\"." |
395 (let ((j (or (get-text-property | 428 (let ((j (or (get-text-property |
396 ;; Make sure we're looking at paragraph body. | 429 ;; Make sure we're looking at paragraph body. |
397 (save-excursion (skip-chars-forward " \t") (point)) | 430 (save-excursion (skip-chars-forward " \t") |
431 (if (and (eobp) (not (bobp))) | |
432 (1- (point)) (point))) | |
398 'justification) | 433 'justification) |
399 default-justification))) | 434 default-justification))) |
400 (if (eq 'none j) | 435 (if (eq 'none j) |
401 nil | 436 nil |
402 j))) | 437 j))) |
403 | 438 |
404 (defun set-justification (begin end value) | 439 (defun set-justification (begin end value &optional whole-par) |
405 "Set the region's justification style. | 440 "Set the region's justification style. |
406 If the mark is not active, this operates on the current line. | 441 The kind of justification to use is prompted for. |
407 In interactive use, if the BEGIN and END points are | 442 If the mark is not active, this command operates on the current paragraph. |
408 not at line breaks, they are moved outward to the next line break. | 443 If the mark is active, the region is used. However, if the beginning and end |
409 If `use-hard-newlines' is true, they are moved to the next hard line breaks. | 444 of the region are not at paragraph breaks, they are moved to the beginning and |
410 Noninteractively, the values of BEGIN, END and VALUE are not modified." | 445 end of the paragraphs they are in. |
446 If `use-hard-newlines' is true, all hard newlines are taken to be paragraph | |
447 breaks. | |
448 | |
449 When calling from a program, operates just on region between BEGIN and END, | |
450 unless optional fourth arg WHOLE-PAR is non-nil. In that case bounds are | |
451 extended to include entire paragraphs as in the interactive command." | |
411 (interactive (list (if mark-active (region-beginning) (point)) | 452 (interactive (list (if mark-active (region-beginning) (point)) |
412 (if mark-active (region-end) (point)) | 453 (if mark-active (region-end) (point)) |
413 (let ((s (completing-read | 454 (let ((s (completing-read |
414 "Set justification to: " | 455 "Set justification to: " |
415 '(("left") ("right") ("full") ("center") | 456 '(("left") ("right") ("full") |
416 ("none")) | 457 ("center") ("none")) |
417 nil t))) | 458 nil t))) |
418 (if (equal s "") | 459 (if (equal s "") (error "")) |
419 (error "") | 460 (intern s)) |
420 (intern s))))) | 461 t)) |
421 (let* ((paragraph-start (if use-hard-newlines "^" paragraph-start))) | 462 (save-excursion |
422 (save-excursion | 463 (save-restriction |
423 (goto-char begin) | 464 (if whole-par |
424 (while (bolp) (forward-char 1)) | 465 (let ((paragraph-start (if use-hard-newlines "." paragraph-start)) |
425 (backward-paragraph) | 466 (paragraph-ignore-fill-prefix (if use-hard-newlines t |
426 (setq begin (point)) | 467 paragraph-ignore-fill-prefix))) |
427 | 468 (goto-char begin) |
428 (goto-char end) | 469 (while (and (bolp) (not (eobp))) (forward-char 1)) |
429 (skip-chars-backward " \t\n" begin) | 470 (backward-paragraph) |
430 (forward-paragraph) | 471 (setq begin (point)) |
431 (setq end (point)) | 472 (goto-char end) |
432 (set-mark begin) | 473 (skip-chars-backward " \t\n" begin) |
433 (goto-char end) | 474 (forward-paragraph) |
434 (y-or-n-p "set-just"))) | 475 (setq end (point)))) |
435 (put-text-property begin end 'justification value) | 476 |
436 (fill-region begin end nil t)) | 477 (narrow-to-region (point-min) end) |
478 (unjustify-region begin (point-max)) | |
479 (put-text-property begin (point-max) 'justification value) | |
480 (fill-region begin (point-max) nil t)))) | |
437 | 481 |
438 (defun set-justification-none (b e) | 482 (defun set-justification-none (b e) |
439 "Disable automatic filling for paragraphs in the region. | 483 "Disable automatic filling for paragraphs in the region. |
440 If the mark is not active, this applies to the current paragraph." | 484 If the mark is not active, this applies to the current paragraph." |
441 (interactive "r") | 485 (interactive (list (if mark-active (region-beginning) (point)) |
442 (set-justification b e 'none)) | 486 (if mark-active (region-end) (point)))) |
487 (set-justification b e 'none t)) | |
443 | 488 |
444 (defun set-justification-left (b e) | 489 (defun set-justification-left (b e) |
445 "Make paragraphs in the region left-justified. | 490 "Make paragraphs in the region left-justified. |
446 This is usually the default, but see `enriched-default-justification'. | 491 This is usually the default, but see the variable `default-justification'. |
447 If the mark is not active, this applies to the current paragraph." | 492 If the mark is not active, this applies to the current paragraph." |
448 (interactive "r") | 493 (interactive (list (if mark-active (region-beginning) (point)) |
449 (set-justification b e 'left)) | 494 (if mark-active (region-end) (point)))) |
495 (set-justification b e 'left t)) | |
450 | 496 |
451 (defun set-justification-right (b e) | 497 (defun set-justification-right (b e) |
452 "Make paragraphs in the region right-justified: | 498 "Make paragraphs in the region right-justified: |
453 Flush at the right margin and ragged on the left. | 499 Flush at the right margin and ragged on the left. |
454 If the mark is not active, this applies to the current paragraph." | 500 If the mark is not active, this applies to the current paragraph." |
455 (interactive "r") | 501 (interactive (list (if mark-active (region-beginning) (point)) |
456 (set-justification b e 'right)) | 502 (if mark-active (region-end) (point)))) |
503 (set-justification b e 'right t)) | |
457 | 504 |
458 (defun set-justification-full (b e) | 505 (defun set-justification-full (b e) |
459 "Make paragraphs in the region fully justified: | 506 "Make paragraphs in the region fully justified: |
460 Flush on both margins. | 507 This makes lines flush on both margins by inserting spaces between words. |
461 If the mark is not active, this applies to the current paragraph." | 508 If the mark is not active, this applies to the current paragraph." |
462 (interactive "r") | 509 (interactive (list (if mark-active (region-beginning) (point)) |
463 (set-justification b e 'both)) | 510 (if mark-active (region-end) (point)))) |
511 (set-justification b e 'full t)) | |
464 | 512 |
465 (defun set-justification-center (b e) | 513 (defun set-justification-center (b e) |
466 "Make paragraphs in the region centered. | 514 "Make paragraphs in the region centered. |
467 If the mark is not active, this applies to the current paragraph." | 515 If the mark is not active, this applies to the current paragraph." |
468 (interactive "r") | 516 (interactive (list (if mark-active (region-beginning) (point)) |
469 (set-justification b e 'center)) | 517 (if mark-active (region-end) (point)))) |
518 (set-justification b e 'center t)) | |
519 | |
520 ;; A line has up to six parts: | |
521 ;; | |
522 ;; >>> hello. | |
523 ;; [Indent-1][FP][ Indent-2 ][text][trailing whitespace][newline] | |
524 ;; | |
525 ;; "Indent-1" is the left-margin indentation; normally it ends at column | |
526 ;; given by the `current-left-margin' function. | |
527 ;; "FP" is the fill-prefix. It can be any string, including whitespace. | |
528 ;; "Indent-2" is added to justify a line if the `current-justification' is | |
529 ;; `center' or `right'. In `left' and `full' justification regions, any | |
530 ;; whitespace there is part of the line's text, and should not be changed. | |
531 ;; Trailing whitespace is not counted as part of the line length when | |
532 ;; center- or right-justifying. | |
533 ;; | |
534 ;; All parts of the line are optional, although the final newline can | |
535 ;; only be missing on the last line of the buffer. | |
470 | 536 |
471 (defun justify-current-line (&optional how eop nosqueeze) | 537 (defun justify-current-line (&optional how eop nosqueeze) |
472 "Add spaces to line point is in, so it ends at `fill-column'. | 538 "Do some kind of justification on this line. |
539 Normally does full justification: adds spaces to the line to make it end at | |
540 the column given by `current-fill-column'. | |
473 Optional first argument HOW specifies alternate type of justification: | 541 Optional first argument HOW specifies alternate type of justification: |
474 it can be `left', `right', `full', `center', or `none'. | 542 it can be `left', `right', `full', `center', or `none'. |
475 If HOW is t, will justify however the `justification' function says. | 543 If HOW is t, will justify however the `current-justification' function says to. |
476 Any other value, including nil, is taken to mean `full'. | 544 If HOW is nil or missing, full justification is done by default. |
477 Second arg EOP non-nil means that this is the last line of the paragraph, so | 545 Second arg EOP non-nil means that this is the last line of the paragraph, so |
478 it will not be stretched by full justification. | 546 it will not be stretched by full justification. |
479 Third arg NOSQUEEZE non-nil means to leave interior whitespace unchanged, | 547 Third arg NOSQUEEZE non-nil means to leave interior whitespace unchanged, |
480 otherwise it is made canonical." | 548 otherwise it is made canonical." |
481 (interactive (list 'full nil nil)) | 549 (interactive) |
482 (if (eq t how) (setq how (or (current-justification) 'none))) | 550 (if (eq t how) (setq how (or (current-justification) 'none))) |
483 (or (memq how '(none left)) | 551 (if (null how) (setq how 'full)) |
484 (save-excursion | 552 (or (memq how '(none left)) ; No action required for these. |
485 (save-restriction | 553 (let ((fc (current-fill-column)) |
486 (let ((fc (current-fill-column)) | 554 (pos (point-marker)) |
487 ncols beg indent end) | 555 fp-end ; point at end of fill prefix |
488 (end-of-line) | 556 beg ; point at beginning of line's text |
489 (if (and use-hard-newlines (null eop) | 557 end ; point at end of line's text |
490 (get-text-property (point) 'hard)) | 558 indent ; column of `beg' |
491 (setq eop t)) | 559 endcol ; column of `end' |
492 (skip-chars-backward " \t") | 560 ncols) ; new indent point or offset |
493 (if (= (current-column) fc) | 561 (end-of-line) |
494 nil ;; Quick exit if it appears to be properly justified already. | 562 ;; Check if this is the last line of the paragraph. |
495 (setq end (point)) | 563 (if (and use-hard-newlines (null eop) |
496 (beginning-of-line) | 564 (get-text-property (point) 'hard)) |
497 (skip-chars-forward " \t") | 565 (setq eop t)) |
498 (if (and fill-prefix | 566 (skip-chars-backward " \t") |
499 (equal fill-prefix | 567 ;; Quick exit if it appears to be properly justified already |
500 (buffer-substring (point) | 568 ;; or there is no text. |
501 (min (point-max) | 569 (if (or (bolp) |
502 (+ (point) (length fill-prefix)))))) | 570 (and (memq how '(full right)) |
503 (forward-char (length fill-prefix))) | 571 (= (current-column) fc))) |
504 (setq indent (current-column)) | 572 nil |
505 (setq beg (point)) | 573 (setq end (point)) |
506 (goto-char end) | 574 (beginning-of-line) |
507 (cond ((or (eq 'none how) (eq 'left how)) | 575 (skip-chars-forward " \t") |
508 nil) | 576 ;; Skip over fill-prefix. |
509 ((eq 'right how) | 577 (if (and fill-prefix |
510 (setq ncols (- (+ indent (current-fill-column)) | 578 (not (string-equal fill-prefix "")) |
511 (current-column))) | 579 (equal fill-prefix |
512 (if (> ncols 0) | 580 (buffer-substring |
513 (indent-line-to ncols))) | 581 (point) (min (point-max) (+ (length fill-prefix) |
514 ((eq 'center how) | 582 (point)))))) |
515 (setq ncols | 583 (forward-char (length fill-prefix)) |
516 (/ (- (+ indent (current-fill-column)) (current-column)) | 584 (if (and adaptive-fill-mode |
517 2)) | 585 (looking-at adaptive-fill-regexp)) |
518 (if (>= ncols 0) | 586 (goto-char (match-end 0)))) |
519 (indent-line-to ncols) | 587 (setq fp-end (point)) |
520 (message "Line to long to center"))) | 588 (skip-chars-forward " \t") |
521 (t ;; full | 589 ;; This is beginning of the line's text. |
590 (setq indent (current-column)) | |
591 (setq beg (point)) | |
592 (goto-char end) | |
593 (setq endcol (current-column)) | |
594 | |
595 ;; HOW can't be null or left--we would have exited already | |
596 (cond ((eq 'right how) | |
597 (setq ncols (- fc endcol)) | |
598 (if (< ncols 0) | |
599 ;; Need to remove some indentation | |
600 (delete-region | |
601 (progn (goto-char fp-end) | |
602 (if (< (current-column) (+ indent ncols)) | |
603 (move-to-column (+ indent ncols) t)) | |
604 (point)) | |
605 (progn (move-to-column indent) (point))) | |
606 ;; Need to add some | |
607 (goto-char beg) | |
608 (indent-to (+ indent ncols)) | |
609 ;; If point was at beginning of text, keep it there. | |
610 (if (= beg pos) | |
611 (move-marker pos (point))))) | |
612 | |
613 ((eq 'center how) | |
614 ;; Figure out how much indentation is needed | |
615 (setq ncols (+ (current-left-margin) | |
616 (/ (- fc (current-left-margin) ;avail. space | |
617 (- endcol indent)) ;text width | |
618 2))) | |
619 (if (< ncols indent) | |
620 ;; Have too much indentation - remove some | |
621 (delete-region | |
622 (progn (goto-char fp-end) | |
623 (if (< (current-column) ncols) | |
624 (move-to-column ncols t)) | |
625 (point)) | |
626 (progn (move-to-column indent) (point))) | |
627 ;; Have too little - add some | |
628 (goto-char beg) | |
629 (indent-to ncols) | |
630 ;; If point was at beginning of text, keep it there. | |
631 (if (= beg pos) | |
632 (move-marker pos (point))))) | |
633 | |
634 ((eq 'full how) | |
635 ;; Insert extra spaces between words to justify line | |
636 (save-restriction | |
522 (narrow-to-region beg end) | 637 (narrow-to-region beg end) |
523 (or nosqueeze | 638 (or nosqueeze |
524 (canonically-space-region beg end)) | 639 (canonically-space-region beg end)) |
525 (goto-char (point-max)) | 640 (goto-char (point-max)) |
526 (setq ncols (- (current-fill-column) indent (current-column))) | 641 (setq ncols (- fc endcol)) |
527 (if (< ncols 0) | 642 ;; Ncols is number of additional spaces needed |
528 (message "Line to long to justify") | 643 (if (> ncols 0) |
529 (if (and (not eop) | 644 (if (and (not eop) |
530 (search-backward " " nil t)) | 645 (search-backward " " nil t)) |
531 (while (> ncols 0) | 646 (while (> ncols 0) |
532 (let ((nmove (+ 3 (random 3)))) | 647 (let ((nmove (+ 3 (random 3)))) |
533 (while (> nmove 0) | 648 (while (> nmove 0) |
534 (or (search-backward " " nil t) | 649 (or (search-backward " " nil t) |
535 (progn | 650 (progn |
536 (goto-char (point-max)) | 651 (goto-char (point-max)) |
537 (search-backward " "))) | 652 (search-backward " "))) |
538 (skip-chars-backward " ") | 653 (skip-chars-backward " ") |
539 (setq nmove (1- nmove)))) | 654 (setq nmove (1- nmove)))) |
540 (insert-and-inherit " ") | 655 (insert-and-inherit " ") |
541 (skip-chars-backward " ") | 656 (skip-chars-backward " ") |
542 (setq ncols (1- ncols)))))))))))) | 657 (setq ncols (1- ncols))))))) |
658 (t (error "Unknown justification value")))) | |
659 (goto-char pos) | |
660 (move-marker pos nil))) | |
543 nil) | 661 nil) |
662 | |
663 (defun unjustify-current-line () | |
664 "Remove justification whitespace from current line. | |
665 If the line is centered or right-justified, this function removes any | |
666 indentation past the left margin. If the line is full-jusitified, it removes | |
667 extra spaces between words. It does nothing in other justification modes." | |
668 (let ((justify (current-justification))) | |
669 (cond ((eq 'left justify) nil) | |
670 ((eq nil justify) nil) | |
671 ((eq 'full justify) ; full justify: remove extra spaces | |
672 (beginning-of-line-text) | |
673 (canonically-space-region | |
674 (point) (save-excursion (end-of-line) (point)))) | |
675 ((memq justify '(center right)) | |
676 (save-excursion | |
677 (move-to-left-margin nil t) | |
678 ;; Position ourselves after any fill-prefix. | |
679 (if (and fill-prefix | |
680 (not (string-equal fill-prefix "")) | |
681 (equal fill-prefix | |
682 (buffer-substring | |
683 (point) (min (point-max) (+ (length fill-prefix) | |
684 (point)))))) | |
685 (forward-char (length fill-prefix))) | |
686 (delete-region (point) (progn (skip-chars-forward " \t") | |
687 (point)))))))) | |
688 | |
689 (defun unjustify-region (&optional begin end) | |
690 "Remove justification whitespace from region. | |
691 For centered or right-justified regions, this function removes any indentation | |
692 past the left margin from each line. For full-jusitified lines, it removes | |
693 extra spaces between words. It does nothing in other justification modes. | |
694 Arguments BEGIN and END are optional; default is the whole buffer." | |
695 (save-excursion | |
696 (save-restriction | |
697 (if end (narrow-to-region (point-min) end)) | |
698 (goto-char (or begin (point-min))) | |
699 (while (not (eobp)) | |
700 (unjustify-current-line) | |
701 (forward-line 1))))) | |
544 | 702 |
545 | 703 |
546 (defun fill-nonuniform-paragraphs (min max &optional justifyp mailp) | 704 (defun fill-nonuniform-paragraphs (min max &optional justifyp mailp) |
547 "Fill paragraphs within the region, allowing varying indentation within each. | 705 "Fill paragraphs within the region, allowing varying indentation within each. |
548 This command divides the region into \"paragraphs\", | 706 This command divides the region into \"paragraphs\", |