428
+ − 1 ;;; fill.el --- fill commands for XEmacs.
+ − 2
+ − 3 ;; Copyright (C) 1985, 86, 92, 94, 95, 1997 Free Software Foundation, Inc.
+ − 4
+ − 5 ;; Maintainer: XEmacs Development Team
+ − 6 ;; Keywords: wp, dumped
+ − 7
+ − 8 ;; This file is part of XEmacs.
+ − 9
+ − 10 ;; XEmacs is free software; you can redistribute it and/or modify it
+ − 11 ;; under the terms of the GNU General Public License as published by
+ − 12 ;; the Free Software Foundation; either version 2, or (at your option)
+ − 13 ;; any later version.
+ − 14
+ − 15 ;; XEmacs is distributed in the hope that it will be useful, but
+ − 16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
+ − 17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ − 18 ;; General Public License for more details.
+ − 19
+ − 20 ;; You should have received a copy of the GNU General Public License
+ − 21 ;; along with XEmacs; see the file COPYING. If not, write to the Free
+ − 22 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ − 23 ;; 02111-1307, USA.
+ − 24
+ − 25 ;;; Synched up with: FSF 19.34.
2510
+ − 26 ;;; NOTE: Merging past 19.34 is currently impossible. Later versions
+ − 27 ;;; contain FSF's own Kinsoku processing, conflicting with the current code
+ − 28 ;;; and depending on various features of their Mule implementation that
+ − 29 ;;; do not currently exist.
428
+ − 30
+ − 31 ;;; Commentary:
+ − 32
+ − 33 ;; This file is dumped with XEmacs.
+ − 34
+ − 35 ;; All the commands for filling text. These are documented in the XEmacs
+ − 36 ;; Reference Manual.
+ − 37
+ − 38 ;; 97/3/14 Jareth Hein (jhod@po.iijnet.or.jp) added functions for kinsoku (asian text
+ − 39 ;; line break processing)
+ − 40 ;; 97/06/11 Steve Baur (steve@xemacs.org) converted broken
+ − 41 ;; following-char/preceding-char calls to char-after/char-before.
+ − 42
+ − 43 ;;; Code:
+ − 44
+ − 45 (defgroup fill nil
+ − 46 "Indenting and filling text."
+ − 47 :group 'editing)
+ − 48
+ − 49 (defcustom fill-individual-varying-indent nil
+ − 50 "*Controls criterion for a new paragraph in `fill-individual-paragraphs'.
+ − 51 Non-nil means changing indent doesn't end a paragraph.
+ − 52 That mode can handle paragraphs with extra indentation on the first line,
+ − 53 but it requires separator lines between paragraphs.
+ − 54 A value of nil means that any change in indentation starts a new paragraph."
+ − 55 :type 'boolean
+ − 56 :group 'fill)
+ − 57
+ − 58 (defcustom sentence-end-double-space t
+ − 59 "*Non-nil means a single space does not end a sentence.
+ − 60 This variable applies only to filling, not motion commands. To
+ − 61 change the behavior of motion commands, see `sentence-end'."
+ − 62 :type 'boolean
+ − 63 :group 'fill)
+ − 64
+ − 65 (defcustom colon-double-space nil
+ − 66 "*Non-nil means put two spaces after a colon when filling."
+ − 67 :type 'boolean
+ − 68 :group 'fill)
+ − 69
+ − 70 (defvar fill-paragraph-function nil
+ − 71 "Mode-specific function to fill a paragraph, or nil if there is none.
+ − 72 If the function returns nil, then `fill-paragraph' does its normal work.")
+ − 73
+ − 74 (defun set-fill-prefix ()
+ − 75 "Set the fill prefix to the current line up to point.
+ − 76 Filling expects lines to start with the fill prefix and
+ − 77 reinserts the fill prefix in each resulting line."
+ − 78 (interactive)
+ − 79 (setq fill-prefix (buffer-substring
+ − 80 (save-excursion (move-to-left-margin) (point))
+ − 81 (point)))
+ − 82 (if (equal fill-prefix "")
+ − 83 (setq fill-prefix nil))
+ − 84 (if fill-prefix
+ − 85 (message "fill-prefix: \"%s\"" fill-prefix)
+ − 86 (message "fill-prefix cancelled")))
+ − 87
+ − 88 (defcustom adaptive-fill-mode t
+ − 89 "*Non-nil means determine a paragraph's fill prefix from its text."
+ − 90 :type 'boolean
+ − 91 :group 'fill)
+ − 92
+ − 93 ;; #### - this is still weak. Yeah, there's filladapt, but this should
+ − 94 ;; still be better... --Stig
444
+ − 95 (defcustom adaptive-fill-regexp "[ \t]*\\([#;>*]+ +\\)?"
428
+ − 96 "*Regexp to match text at start of line that constitutes indentation.
+ − 97 If Adaptive Fill mode is enabled, whatever text matches this pattern
+ − 98 on the second line of a paragraph is used as the standard indentation
+ − 99 for the paragraph. If the paragraph has just one line, the indentation
+ − 100 is taken from that line."
+ − 101 :type 'regexp
+ − 102 :group 'fill)
+ − 103
+ − 104 (defcustom adaptive-fill-function nil
+ − 105 "*Function to call to choose a fill prefix for a paragraph.
+ − 106 This function is used when `adaptive-fill-regexp' does not match."
+ − 107 :type 'function
+ − 108 :group 'fill)
+ − 109
444
+ − 110 ;; Added for kinsoku processing. Use this instead of
428
+ − 111 ;; (skip-chars-backward "^ \t\n")
+ − 112 ;; (skip-chars-backward "^ \n" linebeg)
+ − 113 (defun fill-move-backward-to-break-point (regexp &optional lim)
+ − 114 (let ((opoint (point)))
+ − 115 ;; 93.8.23 by kawamoto@ics.es.osaka-u.ac.jp
+ − 116 ;; case of first 'word' being longer than fill-column
+ − 117 (if (not (re-search-backward regexp lim 'move))
+ − 118 nil
+ − 119 ;; we have skipped backward SPC or WAN (word-across-newline). So move point forward again.
+ − 120 (forward-char)
+ − 121 (if (< opoint (point))
+ − 122 (forward-char -1)))))
+ − 123
+ − 124 ;; Added for kinsoku processing. Use instead of
+ − 125 ;; (re-search-forward "[ \t]" opoint t)
+ − 126 ;; (skip-chars-forward "^ \n")
+ − 127 ;; (skip-chars-forward "^ \n")
+ − 128 (defun fill-move-forward-to-break-point (regexp &optional lim)
+ − 129 (let ((opoint (point)))
+ − 130 (if (not (re-search-forward regexp lim 'move))
+ − 131 nil
+ − 132 (forward-char -1)
+ − 133 (if (< (point) opoint)
+ − 134 (forward-char))))
502
+ − 135 (if (featurep 'mule) (declare-fboundp (kinsoku-process-extend))))
428
+ − 136
+ − 137 (defun fill-end-of-sentence-p ()
+ − 138 (save-excursion
+ − 139 (skip-chars-backward " ]})\"'")
+ − 140 (memq (char-before (point)) '(?. ?? ?!))))
+ − 141
+ − 142 (defun current-fill-column ()
+ − 143 "Return the fill-column to use for this line.
+ − 144 The fill-column to use for a buffer is stored in the variable `fill-column',
+ − 145 but can be locally modified by the `right-margin' text property, which is
+ − 146 subtracted from `fill-column'.
+ − 147
+ − 148 The fill column to use for a line is the first column at which the column
+ − 149 number equals or exceeds the local fill-column - right-margin difference."
+ − 150 (save-excursion
+ − 151 (if fill-column
+ − 152 (let* ((here (progn (beginning-of-line) (point)))
+ − 153 (here-col 0)
+ − 154 (eol (progn (end-of-line) (point)))
+ − 155 margin fill-col change col)
+ − 156 ;; Look separately at each region of line with a different right-margin.
+ − 157 (while (and (setq margin (get-text-property here 'right-margin)
+ − 158 fill-col (- fill-column (or margin 0))
+ − 159 change (text-property-not-all
+ − 160 here eol 'right-margin margin))
+ − 161 (progn (goto-char (1- change))
+ − 162 (setq col (current-column))
+ − 163 (< col fill-col)))
+ − 164 (setq here change
+ − 165 here-col col))
+ − 166 (max here-col fill-col)))))
+ − 167
444
+ − 168 (defun canonically-space-region (start end)
428
+ − 169 "Remove extra spaces between words in region.
+ − 170 Leave one space between words, two at end of sentences or after colons
+ − 171 \(depending on values of `sentence-end-double-space' and `colon-double-space').
+ − 172 Remove indentation from each line."
+ − 173 (interactive "r")
+ − 174 ;;;### 97/3/14 jhod: Do I have to add anything here for kinsoku?
+ − 175 (save-excursion
444
+ − 176 (goto-char start)
428
+ − 177 ;; XEmacs - (ENE/stig from fa-extras.el): Skip the start of a comment.
+ − 178 (and comment-start-skip
+ − 179 (looking-at comment-start-skip)
+ − 180 (goto-char (match-end 0)))
+ − 181 ;; Nuke tabs; they get screwed up in a fill.
+ − 182 ;; This is quick, but loses when a tab follows the end of a sentence.
+ − 183 ;; Actually, it is difficult to tell that from "Mr.\tSmith".
+ − 184 ;; Blame the typist.
444
+ − 185 (subst-char-in-region start end ?\t ?\ )
428
+ − 186 (while (and (< (point) end)
+ − 187 (re-search-forward " *" end t))
+ − 188 (delete-region
+ − 189 (+ (match-beginning 0)
+ − 190 ;; Determine number of spaces to leave:
+ − 191 (save-excursion
+ − 192 (skip-chars-backward " ]})\"'")
+ − 193 (cond ((and sentence-end-double-space
+ − 194 (memq (char-before (point)) '(?. ?? ?!))) 2)
+ − 195 ((and colon-double-space
+ − 196 (eq (char-before (point)) ?:)) 2)
+ − 197 ((char-equal (char-before (point)) ?\n) 0)
+ − 198 (t 1))))
+ − 199 (match-end 0)))
+ − 200 ;; Make sure sentences ending at end of line get an extra space.
+ − 201 ;; loses on split abbrevs ("Mr.\nSmith")
444
+ − 202 (goto-char start)
428
+ − 203 (while (and (< (point) end)
+ − 204 (re-search-forward "[.?!][])}\"']*$" end t))
+ − 205 ;; We insert before markers in case a caller such as
+ − 206 ;; do-auto-fill has done a save-excursion with point at the end
+ − 207 ;; of the line and wants it to stay at the end of the line.
2510
+ − 208 (insert-before-markers-and-inherit ? ))))
428
+ − 209
+ − 210 ;; XEmacs -- added DONT-SKIP-FIRST. Port of older code changes by Stig.
+ − 211 ;; #### probably this junk is broken -- do-auto-fill doesn't actually use
+ − 212 ;; it. If so, it should be removed.
+ − 213
+ − 214 (defun fill-context-prefix (from to &optional first-line-regexp
+ − 215 dont-skip-first)
+ − 216 "Compute a fill prefix from the text between FROM and TO.
+ − 217 This uses the variables `adaptive-fill-prefix' and `adaptive-fill-function'.
+ − 218 If FIRST-LINE-REGEXP is non-nil, then when taking a prefix from the
+ − 219 first line, insist it must match FIRST-LINE-REGEXP."
+ − 220 (save-excursion
+ − 221 (goto-char from)
+ − 222 (if (eolp) (forward-line 1))
+ − 223 ;; Move to the second line unless there is just one.
+ − 224 (let ((firstline (point))
+ − 225 ;; Non-nil if we are on the second line.
+ − 226 at-second
+ − 227 result)
+ − 228 ;; XEmacs change
+ − 229 (if (not dont-skip-first)
+ − 230 (forward-line 1))
+ − 231 (cond ((>= (point) to)
+ − 232 (goto-char firstline))
+ − 233 ((/= (point) from)
+ − 234 (setq at-second t)))
+ − 235 (move-to-left-margin)
+ − 236 ;; XEmacs change
+ − 237 (let ((start (point))
+ − 238 ; jhod: no longer used?
+ − 239 ;(eol (save-excursion (end-of-line) (point)))
+ − 240 )
+ − 241 (setq result
+ − 242 (if (or dont-skip-first (not (looking-at paragraph-start)))
+ − 243 (cond ((and adaptive-fill-regexp (looking-at adaptive-fill-regexp))
+ − 244 (buffer-substring-no-properties start (match-end 0)))
+ − 245 (adaptive-fill-function (funcall adaptive-fill-function)))))
+ − 246 (and result
+ − 247 (or at-second
+ − 248 (null first-line-regexp)
+ − 249 (string-match first-line-regexp result))
+ − 250 result)))))
+ − 251
+ − 252 ;; XEmacs (stig) - this is pulled out of fill-region-as-paragraph so that it
+ − 253 ;; can also be called from do-auto-fill
+ − 254 ;; #### But it's not used there. Chuck pulled it out because it broke things.
+ − 255 (defun maybe-adapt-fill-prefix (&optional from to dont-skip-first)
+ − 256 (if (and adaptive-fill-mode
+ − 257 (or (null fill-prefix) (string= fill-prefix "")))
+ − 258 (setq fill-prefix (fill-context-prefix from to nil dont-skip-first))))
+ − 259
+ − 260 (defun fill-region-as-paragraph (from to &optional justify
+ − 261 nosqueeze squeeze-after)
+ − 262 "Fill the region as one paragraph.
+ − 263 It removes any paragraph breaks in the region and extra newlines at the end,
+ − 264 indents and fills lines between the margins given by the
+ − 265 `current-left-margin' and `current-fill-column' functions.
+ − 266 It leaves point at the beginning of the line following the paragraph.
+ − 267
+ − 268 Normally performs justification according to the `current-justification'
+ − 269 function, but with a prefix arg, does full justification instead.
+ − 270
+ − 271 From a program, optional third arg JUSTIFY can specify any type of
+ − 272 justification. Fourth arg NOSQUEEZE non-nil means not to make spaces
+ − 273 between words canonical before filling. Fifth arg SQUEEZE-AFTER, if non-nil,
+ − 274 means don't canonicalize spaces before that position.
+ − 275
+ − 276 If `sentence-end-double-space' is non-nil, then period followed by one
+ − 277 space does not end a sentence, so don't break a line there."
+ − 278 (interactive
+ − 279 (progn
+ − 280 ;; XEmacs addition:
+ − 281 (barf-if-buffer-read-only nil (region-beginning) (region-end))
+ − 282 (list (region-beginning) (region-end)
+ − 283 (if current-prefix-arg 'full))))
+ − 284 ;; Arrange for undoing the fill to restore point.
+ − 285 (if (and buffer-undo-list (not (eq buffer-undo-list t)))
+ − 286 (setq buffer-undo-list (cons (point) buffer-undo-list)))
+ − 287
+ − 288 ;; Make sure "to" is the endpoint.
+ − 289 (goto-char (min from to))
+ − 290 (setq to (max from to))
+ − 291 ;; Ignore blank lines at beginning of region.
+ − 292 (skip-chars-forward " \t\n")
+ − 293
+ − 294 (let ((from-plus-indent (point))
+ − 295 (oneleft nil))
+ − 296
+ − 297 (beginning-of-line)
+ − 298 (setq from (point))
444
+ − 299
428
+ − 300 ;; Delete all but one soft newline at end of region.
+ − 301 ;; And leave TO before that one.
+ − 302 (goto-char to)
+ − 303 (while (and (> (point) from) (eq ?\n (char-after (1- (point)))))
+ − 304 (if (and oneleft
+ − 305 (not (and use-hard-newlines
+ − 306 (get-text-property (1- (point)) 'hard))))
+ − 307 (delete-backward-char 1)
+ − 308 (backward-char 1)
+ − 309 (setq oneleft t)))
+ − 310 (setq to (point))
+ − 311
+ − 312 ;; If there was no newline, and there is text in the paragraph, then
+ − 313 ;; create a newline.
+ − 314 (if (and (not oneleft) (> to from-plus-indent))
+ − 315 (newline))
+ − 316 (goto-char from-plus-indent))
+ − 317
+ − 318 (if (not (> to (point)))
+ − 319 nil ; There is no paragraph, only whitespace: exit now.
+ − 320
+ − 321 (or justify (setq justify (current-justification)))
+ − 322
+ − 323 ;; Don't let Adaptive Fill mode alter the fill prefix permanently.
+ − 324 (let ((fill-prefix fill-prefix))
+ − 325 ;; Figure out how this paragraph is indented, if desired.
+ − 326 ;; XEmacs: move some code here to a separate function.
+ − 327 (maybe-adapt-fill-prefix from to t)
+ − 328
+ − 329 (save-restriction
+ − 330 (goto-char from)
+ − 331 (beginning-of-line)
+ − 332 (narrow-to-region (point) to)
+ − 333
+ − 334 (if (not justify) ; filling disabled: just check indentation
+ − 335 (progn
+ − 336 (goto-char from)
+ − 337 (while (not (eobp))
+ − 338 (if (and (not (eolp))
+ − 339 (< (current-indentation) (current-left-margin)))
+ − 340 (indent-to-left-margin))
+ − 341 (forward-line 1)))
+ − 342
+ − 343 (if use-hard-newlines
+ − 344 (remove-text-properties from (point-max) '(hard nil)))
+ − 345 ;; Make sure first line is indented (at least) to left margin...
+ − 346 (if (or (memq justify '(right center))
+ − 347 (< (current-indentation) (current-left-margin)))
+ − 348 (indent-to-left-margin))
+ − 349 ;; Delete the fill prefix from every line except the first.
+ − 350 ;; The first line may not even have a fill prefix.
+ − 351 (goto-char from)
+ − 352 (let ((fpre (and fill-prefix (not (equal fill-prefix ""))
+ − 353 (concat "[ \t]*"
+ − 354 (regexp-quote fill-prefix)
+ − 355 "[ \t]*"))))
+ − 356 (and fpre
+ − 357 (progn
+ − 358 (if (>= (+ (current-left-margin) (length fill-prefix))
+ − 359 (current-fill-column))
+ − 360 (error "fill-prefix too long for specified width"))
+ − 361 (goto-char from)
+ − 362 (forward-line 1)
+ − 363 (while (not (eobp))
+ − 364 (if (looking-at fpre)
+ − 365 (delete-region (point) (match-end 0)))
+ − 366 (forward-line 1))
+ − 367 (goto-char from)
+ − 368 (if (looking-at fpre)
+ − 369 (goto-char (match-end 0)))
+ − 370 (setq from (point)))))
+ − 371 ;; Remove indentation from lines other than the first.
+ − 372 (beginning-of-line 2)
+ − 373 (indent-region (point) (point-max) 0)
+ − 374 (goto-char from)
+ − 375
+ − 376 ;; FROM, and point, are now before the text to fill,
+ − 377 ;; but after any fill prefix on the first line.
+ − 378
+ − 379 ;; Make sure sentences ending at end of line get an extra space.
+ − 380 ;; loses on split abbrevs ("Mr.\nSmith")
+ − 381 (while (re-search-forward "[.?!][])}\"']*$" nil t)
2510
+ − 382 (or (eobp) (insert-and-inherit ?\ ?\ )))
428
+ − 383 (goto-char from)
+ − 384 (skip-chars-forward " \t")
+ − 385 ;; Then change all newlines to spaces.
+ − 386 ;;; 97/3/14 jhod: Kinsoku change
440
+ − 387 ;; Spacing is not necessary for characters of no word-separator.
428
+ − 388 ;; The regexp word-across-newline is used for this check.
+ − 389 (defvar word-across-newline)
+ − 390 (if (not (and (featurep 'mule)
+ − 391 (stringp word-across-newline)))
+ − 392 (subst-char-in-region from (point-max) ?\n ?\ )
+ − 393 ;;
+ − 394 ;; WAN +NL+WAN --> WAN + WAN
+ − 395 ;; not(WAN)+NL+WAN --> not(WAN) + WAN
+ − 396 ;; WAN +NL+not(WAN) --> WAN + not(WAN)
+ − 397 ;; SPC +NL+not(WAN) --> SPC + not(WAN)
+ − 398 ;; not(WAN)+NL+not(WAN) --> not(WAN) + SPC + not(WAN)
+ − 399 ;;
+ − 400 (goto-char from)
+ − 401 (end-of-line)
+ − 402 (while (not (eobp))
+ − 403 ;; Insert SPC only when point is between nonWAN. Insert
+ − 404 ;; before deleting to preserve marker if possible.
+ − 405 (if (or (prog2 ; check following char.
+ − 406 (forward-char) ; skip newline
+ − 407 (or (eobp)
+ − 408 (looking-at word-across-newline))
+ − 409 (forward-char -1))
+ − 410 (prog2 ; check previous char.
+ − 411 (forward-char -1)
+ − 412 (or (eq (char-after (point)) ?\ )
+ − 413 (looking-at word-across-newline))
+ − 414 (forward-char)))
+ − 415 nil
+ − 416 (insert ?\ ))
+ − 417 (delete-char 1) ; delete newline
+ − 418 (end-of-line)))
+ − 419 ;; end patch
+ − 420 (goto-char from)
+ − 421 (skip-chars-forward " \t")
+ − 422 (if (and nosqueeze (not (eq justify 'full)))
+ − 423 nil
+ − 424 (canonically-space-region (or squeeze-after (point)) (point-max))
+ − 425 (goto-char (point-max))
+ − 426 (delete-horizontal-space)
2510
+ − 427 (insert-and-inherit " "))
428
+ − 428 (goto-char (point-min))
+ − 429
+ − 430 ;; This is the actual filling loop.
+ − 431 (let ((prefixcol 0) linebeg
+ − 432 (re-break-point (if (featurep 'mule)
+ − 433 (concat "[ \n\t]\\|" word-across-newline
+ − 434 ".\\|." word-across-newline)
+ − 435 "[ \n\t]")))
+ − 436 (while (not (eobp))
+ − 437 (setq linebeg (point))
+ − 438 (move-to-column (1+ (current-fill-column)))
+ − 439 (if (eobp)
+ − 440 (or nosqueeze (delete-horizontal-space))
+ − 441 ;; Move back to start of word.
+ − 442 ;; 97/3/14 jhod: Kinsoku
+ − 443 ;(skip-chars-backward "^ \n" linebeg)
+ − 444 (fill-move-backward-to-break-point re-break-point linebeg)
+ − 445 ;; end patch
+ − 446 ;; Don't break after a period followed by just one space.
+ − 447 ;; Move back to the previous place to break.
+ − 448 ;; The reason is that if a period ends up at the end of a line,
+ − 449 ;; further fills will assume it ends a sentence.
+ − 450 ;; If we now know it does not end a sentence,
+ − 451 ;; avoid putting it at the end of the line.
+ − 452 (if sentence-end-double-space
+ − 453 (while (and (> (point) (+ linebeg 2))
+ − 454 (eq (char-before (point)) ?\ )
+ − 455 (not (eq (char-after (point)) ?\ ))
+ − 456 (eq (char-after (- (point) 2)) ?\.))
+ − 457 (forward-char -2)
+ − 458 ;; 97/3/14 jhod: Kinsoku
+ − 459 ;(skip-chars-backward "^ \n" linebeg)))
+ − 460 (fill-move-backward-to-break-point re-break-point linebeg)))
502
+ − 461 (if (featurep 'mule) (declare-fboundp (kinsoku-process)))
428
+ − 462 ;end patch
+ − 463
+ − 464 ;; If the left margin and fill prefix by themselves
+ − 465 ;; pass the fill-column. or if they are zero
+ − 466 ;; but we have no room for even one word,
+ − 467 ;; keep at least one word anyway.
+ − 468 ;; This handles ALL BUT the first line of the paragraph.
+ − 469 (if (if (zerop prefixcol)
+ − 470 (save-excursion
+ − 471 (skip-chars-backward " \t" linebeg)
+ − 472 (bolp))
+ − 473 (>= prefixcol (current-column)))
+ − 474 ;; Ok, skip at least one word.
+ − 475 ;; Meanwhile, don't stop at a period followed by one space.
+ − 476 (let ((first t))
+ − 477 (move-to-column prefixcol)
+ − 478 (while (and (not (eobp))
+ − 479 (or first
+ − 480 (and (not (bobp))
+ − 481 sentence-end-double-space
+ − 482 (save-excursion (forward-char -1)
+ − 483 (and (looking-at "\\. ")
+ − 484 (not (looking-at "\\. ")))))))
+ − 485 (skip-chars-forward " \t")
+ − 486 ;; 94/3/14 jhod: Kinsoku
+ − 487 ;(skip-chars-forward "^ \n\t")
+ − 488 (fill-move-forward-to-break-point re-break-point)
+ − 489 ;; end patch
+ − 490 (setq first nil)))
+ − 491 ;; Normally, move back over the single space between the words.
+ − 492 (if (eq (char-before (point)) ?\ )
+ − 493 (forward-char -1)))
+ − 494 ;; If the left margin and fill prefix by themselves
+ − 495 ;; pass the fill-column, keep at least one word.
+ − 496 ;; This handles the first line of the paragraph.
+ − 497 (if (and (zerop prefixcol)
+ − 498 (let ((fill-point (point)) nchars)
+ − 499 (save-excursion
+ − 500 (move-to-left-margin)
+ − 501 (setq nchars (- fill-point (point)))
+ − 502 (or (< nchars 0)
+ − 503 (and fill-prefix
+ − 504 (< nchars (length fill-prefix))
+ − 505 (string= (buffer-substring (point) fill-point)
+ − 506 (substring fill-prefix 0 nchars)))))))
+ − 507 ;; Ok, skip at least one word. But
+ − 508 ;; don't stop at a period followed by just one space.
+ − 509 (let ((first t))
+ − 510 (while (and (not (eobp))
+ − 511 (or first
+ − 512 (and (not (bobp))
+ − 513 sentence-end-double-space
+ − 514 (save-excursion (forward-char -1)
+ − 515 (and (looking-at "\\. ")
+ − 516 (not (looking-at "\\. ")))))))
+ − 517 (skip-chars-forward " \t")
+ − 518 ;; 97/3/14 jhod: Kinsoku
+ − 519 ;(skip-chars-forward "^ \t\n")
+ − 520 (fill-move-forward-to-break-point re-break-point)
+ − 521 ;; end patch
+ − 522 (setq first nil))))
+ − 523 ;; Check again to see if we got to the end of the paragraph.
+ − 524 (if (save-excursion (skip-chars-forward " \t") (eobp))
+ − 525 (or nosqueeze (delete-horizontal-space))
+ − 526 ;; Replace whitespace here with one newline, then indent to left
+ − 527 ;; margin.
+ − 528 (skip-chars-backward " \t")
+ − 529 ;; 97/3/14 jhod: More kinsoku stuff
+ − 530 (if (featurep 'mule)
+ − 531 ;; WAN means chars which match word-across-newline.
+ − 532 ;; (0) | SPC + SPC* <EOB> --> NL
+ − 533 ;; (1) WAN | SPC + SPC* --> WAN + SPC + NL
+ − 534 ;; (2) | SPC + SPC* + WAN --> SPC + NL + WAN
+ − 535 ;; (3) '.' | SPC + nonSPC --> '.' + SPC + NL + nonSPC
+ − 536 ;; (4) '.' | SPC + SPC --> '.' + NL
+ − 537 ;; (5) | SPC* --> NL
+ − 538 (let ((start (point)) ; 92.6.30 by K.Handa
+ − 539 (ch (char-after (point))))
+ − 540 (if (and (= ch ? )
+ − 541 (progn ; not case (0) -- 92.6.30 by K.Handa
+ − 542 (skip-chars-forward " \t")
+ − 543 (not (eobp)))
+ − 544 (or
+ − 545 (progn ; case (1)
+ − 546 (goto-char start)
+ − 547 (forward-char -1)
+ − 548 (looking-at word-across-newline))
+ − 549 (progn ; case (2)
+ − 550 (goto-char start)
+ − 551 (skip-chars-forward " \t")
+ − 552 (and (not (eobp))
+ − 553 (looking-at word-across-newline)
+ − 554 ;; never leave space after the end of sentence
+ − 555 (not (fill-end-of-sentence-p))))
+ − 556 (progn ; case (3)
+ − 557 (goto-char (1+ start))
+ − 558 (and (not (eobp))
+ − 559 (not (eq (char-after (point)) ? ))
+ − 560 (fill-end-of-sentence-p)))))
+ − 561 ;; We should keep one SPACE before NEWLINE. (1),(2),(3)
+ − 562 (goto-char (1+ start))
+ − 563 ;; We should delete all SPACES around break point. (4),(5)
+ − 564 (goto-char start))))
+ − 565 ;; end of patch
+ − 566 (insert ?\n)
+ − 567 ;; Give newline the properties of the space(s) it replaces
+ − 568 (set-text-properties (1- (point)) (point)
+ − 569 (text-properties-at (point)))
+ − 570 (indent-to-left-margin)
+ − 571 ;; Insert the fill prefix after indentation.
+ − 572 ;; Set prefixcol so whitespace in the prefix won't get lost.
+ − 573 (and fill-prefix (not (equal fill-prefix ""))
+ − 574 (progn
2510
+ − 575 (insert-and-inherit fill-prefix)
428
+ − 576 (setq prefixcol (current-column))))))
+ − 577 ;; Justify the line just ended, if desired.
+ − 578 (if justify
+ − 579 (if (save-excursion (skip-chars-forward " \t") (eobp))
+ − 580 (progn
+ − 581 (delete-horizontal-space)
+ − 582 (justify-current-line justify t t))
+ − 583 (forward-line -1)
+ − 584 (justify-current-line justify nil t)
+ − 585 (forward-line 1))))))
+ − 586 ;; Leave point after final newline.
+ − 587 (goto-char (point-max)))
+ − 588 (forward-char 1))))
+ − 589
+ − 590 (defun fill-paragraph (arg)
+ − 591 "Fill paragraph at or after point. Prefix arg means justify as well.
+ − 592 If `sentence-end-double-space' is non-nil, then period followed by one
+ − 593 space does not end a sentence, so don't break a line there.
+ − 594
+ − 595 If `fill-paragraph-function' is non-nil, we call it (passing our
+ − 596 argument to it), and if it returns non-nil, we simply return its value."
+ − 597 (interactive (list (if current-prefix-arg 'full)))
+ − 598 (or (and fill-paragraph-function
+ − 599 (let ((function fill-paragraph-function)
+ − 600 fill-paragraph-function)
+ − 601 (funcall function arg)))
+ − 602 (let ((before (point)))
+ − 603 (save-excursion
+ − 604 (forward-paragraph)
+ − 605 (or (bolp) (newline 1))
+ − 606 (let ((end (point))
444
+ − 607 (start (progn (backward-paragraph) (point))))
428
+ − 608 (goto-char before)
+ − 609 (if use-hard-newlines
+ − 610 ;; Can't use fill-region-as-paragraph, since this paragraph may
+ − 611 ;; still contain hard newlines. See fill-region.
444
+ − 612 (fill-region start end arg)
+ − 613 (fill-region-as-paragraph start end arg)))))))
428
+ − 614
+ − 615 (defun fill-region (from to &optional justify nosqueeze to-eop)
+ − 616 "Fill each of the paragraphs in the region.
+ − 617 Prefix arg (non-nil third arg, if called from program) means justify as well.
+ − 618
+ − 619 Noninteractively, fourth arg NOSQUEEZE non-nil means to leave
+ − 620 whitespace other than line breaks untouched, and fifth arg TO-EOP
+ − 621 non-nil means to keep filling to the end of the paragraph (or next
+ − 622 hard newline, if `use-hard-newlines' is on).
+ − 623
+ − 624 If `sentence-end-double-space' is non-nil, then period followed by one
+ − 625 space does not end a sentence, so don't break a line there."
+ − 626 (interactive
+ − 627 (progn
+ − 628 ;; XEmacs addition:
+ − 629 (barf-if-buffer-read-only nil (region-beginning) (region-end))
+ − 630 (list (region-beginning) (region-end)
+ − 631 (if current-prefix-arg 'full))))
444
+ − 632 (let (end start)
428
+ − 633 (save-restriction
+ − 634 (goto-char (max from to))
+ − 635 (if to-eop
+ − 636 (progn (skip-chars-backward "\n")
+ − 637 (forward-paragraph)))
+ − 638 (setq end (point))
444
+ − 639 (goto-char (setq start (min from to)))
428
+ − 640 (beginning-of-line)
+ − 641 (narrow-to-region (point) end)
+ − 642 (while (not (eobp))
+ − 643 (let ((initial (point))
+ − 644 end)
+ − 645 ;; If using hard newlines, break at every one for filling
444
+ − 646 ;; purposes rather than using paragraph breaks.
428
+ − 647 (if use-hard-newlines
444
+ − 648 (progn
428
+ − 649 (while (and (setq end (text-property-any (point) (point-max)
+ − 650 'hard t))
+ − 651 (not (eq ?\n (char-after end)))
+ − 652 (not (= end (point-max))))
+ − 653 (goto-char (1+ end)))
+ − 654 (setq end (if end (min (point-max) (1+ end)) (point-max)))
+ − 655 (goto-char initial))
+ − 656 (forward-paragraph 1)
+ − 657 (setq end (point))
+ − 658 (forward-paragraph -1))
444
+ − 659 (if (< (point) start)
+ − 660 (goto-char start))
428
+ − 661 (if (>= (point) initial)
+ − 662 (fill-region-as-paragraph (point) end justify nosqueeze)
+ − 663 (goto-char end)))))))
+ − 664
+ − 665 (defun fill-paragraph-or-region (arg)
+ − 666 "Fill the current region, if it's active; otherwise, fill the paragraph.
+ − 667 See `fill-paragraph' and `fill-region' for more information."
+ − 668 (interactive "*P")
+ − 669 (if (region-active-p)
502
+ − 670 (call-interactively 'fill-region)
+ − 671 (call-interactively 'fill-paragraph)))
428
+ − 672
444
+ − 673
428
+ − 674 (defconst default-justification 'left
+ − 675 "*Method of justifying text not otherwise specified.
+ − 676 Possible values are `left', `right', `full', `center', or `none'.
+ − 677 The requested kind of justification is done whenever lines are filled.
+ − 678 The `justification' text-property can locally override this variable.
+ − 679 This variable automatically becomes buffer-local when set in any fashion.")
+ − 680 (make-variable-buffer-local 'default-justification)
+ − 681
+ − 682 (defun current-justification ()
+ − 683 "How should we justify this line?
+ − 684 This returns the value of the text-property `justification',
+ − 685 or the variable `default-justification' if there is no text-property.
+ − 686 However, it returns nil rather than `none' to mean \"don't justify\"."
444
+ − 687 (let ((j (or (get-text-property
428
+ − 688 ;; Make sure we're looking at paragraph body.
444
+ − 689 (save-excursion (skip-chars-forward " \t")
428
+ − 690 (if (and (eobp) (not (bobp)))
+ − 691 (1- (point)) (point)))
+ − 692 'justification)
+ − 693 default-justification)))
+ − 694 (if (eq 'none j)
+ − 695 nil
+ − 696 j)))
+ − 697
+ − 698 (defun set-justification (begin end value &optional whole-par)
+ − 699 "Set the region's justification style.
+ − 700 The kind of justification to use is prompted for.
+ − 701 If the mark is not active, this command operates on the current paragraph.
+ − 702 If the mark is active, the region is used. However, if the beginning and end
+ − 703 of the region are not at paragraph breaks, they are moved to the beginning and
+ − 704 end of the paragraphs they are in.
+ − 705 If `use-hard-newlines' is true, all hard newlines are taken to be paragraph
+ − 706 breaks.
+ − 707
+ − 708 When calling from a program, operates just on region between BEGIN and END,
+ − 709 unless optional fourth arg WHOLE-PAR is non-nil. In that case bounds are
+ − 710 extended to include entire paragraphs as in the interactive command."
+ − 711 ;; XEmacs change (was mark-active)
+ − 712 (interactive (list (if (region-active-p) (region-beginning) (point))
+ − 713 (if (region-active-p) (region-end) (point))
+ − 714 (let ((s (completing-read
+ − 715 "Set justification to: "
+ − 716 '(("left") ("right") ("full")
+ − 717 ("center") ("none"))
+ − 718 nil t)))
+ − 719 (if (equal s "") (error ""))
+ − 720 (intern s))
+ − 721 t))
+ − 722 (save-excursion
+ − 723 (save-restriction
+ − 724 (if whole-par
+ − 725 (let ((paragraph-start (if use-hard-newlines "." paragraph-start))
444
+ − 726 (paragraph-ignore-fill-prefix (if use-hard-newlines t
428
+ − 727 paragraph-ignore-fill-prefix)))
+ − 728 (goto-char begin)
+ − 729 (while (and (bolp) (not (eobp))) (forward-char 1))
+ − 730 (backward-paragraph)
+ − 731 (setq begin (point))
+ − 732 (goto-char end)
+ − 733 (skip-chars-backward " \t\n" begin)
+ − 734 (forward-paragraph)
+ − 735 (setq end (point))))
+ − 736
+ − 737 (narrow-to-region (point-min) end)
+ − 738 (unjustify-region begin (point-max))
+ − 739 (put-text-property begin (point-max) 'justification value)
+ − 740 (fill-region begin (point-max) nil t))))
+ − 741
+ − 742 (defun set-justification-none (b e)
+ − 743 "Disable automatic filling for paragraphs in the region.
+ − 744 If the mark is not active, this applies to the current paragraph."
+ − 745 ;; XEmacs change (was mark-active)
+ − 746 (interactive (list (if (region-active-p) (region-beginning) (point))
+ − 747 (if (region-active-p) (region-end) (point))))
+ − 748 (set-justification b e 'none t))
+ − 749
+ − 750 (defun set-justification-left (b e)
+ − 751 "Make paragraphs in the region left-justified.
+ − 752 This is usually the default, but see the variable `default-justification'.
+ − 753 If the mark is not active, this applies to the current paragraph."
+ − 754 ;; XEmacs change (was mark-active)
+ − 755 (interactive (list (if (region-active-p) (region-beginning) (point))
+ − 756 (if (region-active-p) (region-end) (point))))
+ − 757 (set-justification b e 'left t))
+ − 758
+ − 759 (defun set-justification-right (b e)
+ − 760 "Make paragraphs in the region right-justified:
+ − 761 Flush at the right margin and ragged on the left.
+ − 762 If the mark is not active, this applies to the current paragraph."
+ − 763 ;; XEmacs change (was mark-active)
+ − 764 (interactive (list (if (region-active-p) (region-beginning) (point))
+ − 765 (if (region-active-p) (region-end) (point))))
+ − 766 (set-justification b e 'right t))
+ − 767
+ − 768 (defun set-justification-full (b e)
+ − 769 "Make paragraphs in the region fully justified:
+ − 770 This makes lines flush on both margins by inserting spaces between words.
+ − 771 If the mark is not active, this applies to the current paragraph."
+ − 772 ;; XEmacs change (was mark-active)
+ − 773 (interactive (list (if (region-active-p) (region-beginning) (point))
+ − 774 (if (region-active-p) (region-end) (point))))
+ − 775 (set-justification b e 'full t))
+ − 776
+ − 777 (defun set-justification-center (b e)
+ − 778 "Make paragraphs in the region centered.
+ − 779 If the mark is not active, this applies to the current paragraph."
+ − 780 ;; XEmacs change (was mark-active)
+ − 781 (interactive (list (if (region-active-p) (region-beginning) (point))
+ − 782 (if (region-active-p) (region-end) (point))))
+ − 783 (set-justification b e 'center t))
+ − 784
+ − 785 ;; 97/3/14 jhod: This functions are added for Kinsoku support
+ − 786 (defun find-space-insertable-point ()
444
+ − 787 "Search backward for a permissible point for inserting justification spaces."
776
+ − 788 (if-boundp 'space-insertable
+ − 789 (if (re-search-backward space-insertable nil t)
428
+ − 790 (progn (forward-char 1)
+ − 791 t)
+ − 792 nil)
+ − 793 (search-backward " " nil t)))
+ − 794
+ − 795 ;; A line has up to six parts:
+ − 796 ;;
444
+ − 797 ;; >>> hello.
428
+ − 798 ;; [Indent-1][FP][ Indent-2 ][text][trailing whitespace][newline]
+ − 799 ;;
+ − 800 ;; "Indent-1" is the left-margin indentation; normally it ends at column
+ − 801 ;; given by the `current-left-margin' function.
+ − 802 ;; "FP" is the fill-prefix. It can be any string, including whitespace.
+ − 803 ;; "Indent-2" is added to justify a line if the `current-justification' is
+ − 804 ;; `center' or `right'. In `left' and `full' justification regions, any
+ − 805 ;; whitespace there is part of the line's text, and should not be changed.
+ − 806 ;; Trailing whitespace is not counted as part of the line length when
+ − 807 ;; center- or right-justifying.
+ − 808 ;;
444
+ − 809 ;; All parts of the line are optional, although the final newline can
428
+ − 810 ;; only be missing on the last line of the buffer.
+ − 811
+ − 812 (defun justify-current-line (&optional how eop nosqueeze)
+ − 813 "Do some kind of justification on this line.
+ − 814 Normally does full justification: adds spaces to the line to make it end at
+ − 815 the column given by `current-fill-column'.
+ − 816 Optional first argument HOW specifies alternate type of justification:
444
+ − 817 it can be `left', `right', `full', `center', or `none'.
428
+ − 818 If HOW is t, will justify however the `current-justification' function says to.
+ − 819 If HOW is nil or missing, full justification is done by default.
+ − 820 Second arg EOP non-nil means that this is the last line of the paragraph, so
+ − 821 it will not be stretched by full justification.
+ − 822 Third arg NOSQUEEZE non-nil means to leave interior whitespace unchanged,
+ − 823 otherwise it is made canonical."
+ − 824 (interactive)
+ − 825 (if (eq t how) (setq how (or (current-justification) 'none))
+ − 826 (if (null how) (setq how 'full)
+ − 827 (or (memq how '(none left right center))
+ − 828 (setq how 'full))))
+ − 829 (or (memq how '(none left)) ; No action required for these.
+ − 830 (let ((fc (current-fill-column))
+ − 831 (pos (point-marker))
+ − 832 fp-end ; point at end of fill prefix
444
+ − 833 start ; point at beginning of line's text
428
+ − 834 end ; point at end of line's text
444
+ − 835 indent ; column of `start'
428
+ − 836 endcol ; column of `end'
+ − 837 ncols) ; new indent point or offset
+ − 838 (end-of-line)
+ − 839 ;; Check if this is the last line of the paragraph.
444
+ − 840 (if (and use-hard-newlines (null eop)
428
+ − 841 (get-text-property (point) 'hard))
+ − 842 (setq eop t))
+ − 843 (skip-chars-backward " \t")
+ − 844 ;; Quick exit if it appears to be properly justified already
+ − 845 ;; or there is no text.
+ − 846 (if (or (bolp)
+ − 847 (and (memq how '(full right))
+ − 848 (= (current-column) fc)))
+ − 849 nil
+ − 850 (setq end (point))
+ − 851 (beginning-of-line)
+ − 852 (skip-chars-forward " \t")
+ − 853 ;; Skip over fill-prefix.
444
+ − 854 (if (and fill-prefix
428
+ − 855 (not (string-equal fill-prefix ""))
+ − 856 (equal fill-prefix
444
+ − 857 (buffer-substring
428
+ − 858 (point) (min (point-max) (+ (length fill-prefix)
+ − 859 (point))))))
+ − 860 (forward-char (length fill-prefix))
444
+ − 861 (if (and adaptive-fill-mode
428
+ − 862 (looking-at adaptive-fill-regexp))
+ − 863 (goto-char (match-end 0))))
+ − 864 (setq fp-end (point))
+ − 865 (skip-chars-forward " \t")
+ − 866 ;; This is beginning of the line's text.
+ − 867 (setq indent (current-column))
444
+ − 868 (setq start (point))
428
+ − 869 (goto-char end)
+ − 870 (setq endcol (current-column))
+ − 871
+ − 872 ;; HOW can't be null or left--we would have exited already
444
+ − 873 (cond ((eq 'right how)
428
+ − 874 (setq ncols (- fc endcol))
+ − 875 (if (< ncols 0)
+ − 876 ;; Need to remove some indentation
444
+ − 877 (delete-region
428
+ − 878 (progn (goto-char fp-end)
+ − 879 (if (< (current-column) (+ indent ncols))
+ − 880 (move-to-column (+ indent ncols) t))
+ − 881 (point))
+ − 882 (progn (move-to-column indent) (point)))
+ − 883 ;; Need to add some
444
+ − 884 (goto-char start)
428
+ − 885 (indent-to (+ indent ncols))
+ − 886 ;; If point was at beginning of text, keep it there.
444
+ − 887 (if (= start pos)
428
+ − 888 (move-marker pos (point)))))
+ − 889
+ − 890 ((eq 'center how)
+ − 891 ;; Figure out how much indentation is needed
+ − 892 (setq ncols (+ (current-left-margin)
+ − 893 (/ (- fc (current-left-margin) ;avail. space
+ − 894 (- endcol indent)) ;text width
+ − 895 2)))
+ − 896 (if (< ncols indent)
+ − 897 ;; Have too much indentation - remove some
+ − 898 (delete-region
+ − 899 (progn (goto-char fp-end)
+ − 900 (if (< (current-column) ncols)
+ − 901 (move-to-column ncols t))
+ − 902 (point))
+ − 903 (progn (move-to-column indent) (point)))
+ − 904 ;; Have too little - add some
444
+ − 905 (goto-char start)
428
+ − 906 (indent-to ncols)
+ − 907 ;; If point was at beginning of text, keep it there.
444
+ − 908 (if (= start pos)
428
+ − 909 (move-marker pos (point)))))
+ − 910
+ − 911 ((eq 'full how)
+ − 912 ;; Insert extra spaces between words to justify line
+ − 913 (save-restriction
444
+ − 914 (narrow-to-region start end)
428
+ − 915 (or nosqueeze
444
+ − 916 (canonically-space-region start end))
428
+ − 917 (goto-char (point-max))
+ − 918 (setq ncols (- fc endcol))
+ − 919 ;; Ncols is number of additional spaces needed
+ − 920 (if (> ncols 0)
+ − 921 (if (and (not eop)
+ − 922 ;; 97/3/14 jhod: Kinsoku
+ − 923 (find-space-insertable-point)) ;(search-backward " " nil t))
+ − 924 (while (> ncols 0)
+ − 925 (let ((nmove (+ 3 (random 3))))
+ − 926 (while (> nmove 0)
+ − 927 (or (find-space-insertable-point) ;(search-backward " " nil t)
+ − 928 (progn
+ − 929 (goto-char (point-max))
+ − 930 (find-space-insertable-point))) ;(search-backward " ")))
+ − 931 (skip-chars-backward " ")
+ − 932 (setq nmove (1- nmove))))
2510
+ − 933 (insert-and-inherit " ")
428
+ − 934 (skip-chars-backward " ")
+ − 935 (setq ncols (1- ncols)))))))
+ − 936 (t (error "Unknown justification value"))))
+ − 937 (goto-char pos)
+ − 938 (move-marker pos nil)))
+ − 939 nil)
+ − 940
+ − 941 (defun unjustify-current-line ()
+ − 942 "Remove justification whitespace from current line.
+ − 943 If the line is centered or right-justified, this function removes any
+ − 944 indentation past the left margin. If the line is full-justified, it removes
+ − 945 extra spaces between words. It does nothing in other justification modes."
+ − 946 (let ((justify (current-justification)))
+ − 947 (cond ((eq 'left justify) nil)
+ − 948 ((eq nil justify) nil)
+ − 949 ((eq 'full justify) ; full justify: remove extra spaces
+ − 950 (beginning-of-line-text)
+ − 951 (canonically-space-region
+ − 952 (point) (save-excursion (end-of-line) (point))))
+ − 953 ((memq justify '(center right))
+ − 954 (save-excursion
+ − 955 (move-to-left-margin nil t)
+ − 956 ;; Position ourselves after any fill-prefix.
444
+ − 957 (if (and fill-prefix
428
+ − 958 (not (string-equal fill-prefix ""))
+ − 959 (equal fill-prefix
444
+ − 960 (buffer-substring
428
+ − 961 (point) (min (point-max) (+ (length fill-prefix)
+ − 962 (point))))))
+ − 963 (forward-char (length fill-prefix)))
+ − 964 (delete-region (point) (progn (skip-chars-forward " \t")
+ − 965 (point))))))))
+ − 966
+ − 967 (defun unjustify-region (&optional begin end)
+ − 968 "Remove justification whitespace from region.
+ − 969 For centered or right-justified regions, this function removes any indentation
444
+ − 970 past the left margin from each line. For full-justified lines, it removes
428
+ − 971 extra spaces between words. It does nothing in other justification modes.
+ − 972 Arguments BEGIN and END are optional; default is the whole buffer."
+ − 973 (save-excursion
+ − 974 (save-restriction
+ − 975 (if end (narrow-to-region (point-min) end))
+ − 976 (goto-char (or begin (point-min)))
+ − 977 (while (not (eobp))
+ − 978 (unjustify-current-line)
+ − 979 (forward-line 1)))))
+ − 980
+ − 981
+ − 982 (defun fill-nonuniform-paragraphs (min max &optional justifyp mailp)
+ − 983 "Fill paragraphs within the region, allowing varying indentation within each.
+ − 984 This command divides the region into \"paragraphs\",
+ − 985 only at paragraph-separator lines, then fills each paragraph
+ − 986 using as the fill prefix the smallest indentation of any line
+ − 987 in the paragraph.
+ − 988
+ − 989 When calling from a program, pass range to fill as first two arguments.
+ − 990
+ − 991 Optional third and fourth arguments JUSTIFY and MAIL-FLAG:
+ − 992 JUSTIFY to justify paragraphs (prefix arg),
+ − 993 MAIL-FLAG for a mail message, i. e. don't fill header lines."
+ − 994 (interactive (list (region-beginning) (region-end)
+ − 995 (if current-prefix-arg 'full)))
+ − 996 (let ((fill-individual-varying-indent t))
+ − 997 (fill-individual-paragraphs min max justifyp mailp)))
+ − 998
+ − 999 (defun fill-individual-paragraphs (min max &optional justify mailp)
+ − 1000 "Fill paragraphs of uniform indentation within the region.
+ − 1001 This command divides the region into \"paragraphs\",
+ − 1002 treating every change in indentation level as a paragraph boundary,
+ − 1003 then fills each paragraph using its indentation level as the fill prefix.
+ − 1004
+ − 1005 When calling from a program, pass range to fill as first two arguments.
+ − 1006
+ − 1007 Optional third and fourth arguments JUSTIFY and MAIL-FLAG:
+ − 1008 JUSTIFY to justify paragraphs (prefix arg),
+ − 1009 MAIL-FLAG for a mail message, i. e. don't fill header lines."
+ − 1010 (interactive (list (region-beginning) (region-end)
+ − 1011 (if current-prefix-arg 'full)))
+ − 1012 (save-restriction
+ − 1013 (save-excursion
+ − 1014 (goto-char min)
+ − 1015 (beginning-of-line)
+ − 1016 (narrow-to-region (point) max)
444
+ − 1017 (if mailp
428
+ − 1018 (while (and (not (eobp))
+ − 1019 (or (looking-at "[ \t]*[^ \t\n]+:")
+ − 1020 (looking-at "[ \t]*$")))
+ − 1021 (if (looking-at "[ \t]*[^ \t\n]+:")
+ − 1022 (search-forward "\n\n" nil 'move)
+ − 1023 (forward-line 1))))
+ − 1024 (narrow-to-region (point) max)
+ − 1025 ;; Loop over paragraphs.
+ − 1026 (while (progn (skip-chars-forward " \t\n") (not (eobp)))
+ − 1027 (move-to-left-margin)
+ − 1028 (let ((start (point))
+ − 1029 fill-prefix fill-prefix-regexp)
+ − 1030 ;; Find end of paragraph, and compute the smallest fill-prefix
+ − 1031 ;; that fits all the lines in this paragraph.
+ − 1032 (while (progn
+ − 1033 ;; Update the fill-prefix on the first line
+ − 1034 ;; and whenever the prefix good so far is too long.
+ − 1035 (if (not (and fill-prefix
+ − 1036 (looking-at fill-prefix-regexp)))
+ − 1037 (setq fill-prefix
+ − 1038 (if (and adaptive-fill-mode adaptive-fill-regexp
+ − 1039 (looking-at adaptive-fill-regexp))
+ − 1040 (match-string 0)
444
+ − 1041 (buffer-substring
428
+ − 1042 (point)
+ − 1043 (save-excursion (skip-chars-forward " \t")
+ − 1044 (point))))
+ − 1045 fill-prefix-regexp (regexp-quote fill-prefix)))
+ − 1046 (forward-line 1)
+ − 1047 (if (bolp)
2510
+ − 1048 ;; If forward-line went past a newline,
428
+ − 1049 ;; move further to the left margin.
+ − 1050 (move-to-left-margin))
+ − 1051 ;; Now stop the loop if end of paragraph.
+ − 1052 (and (not (eobp))
+ − 1053 (if fill-individual-varying-indent
+ − 1054 ;; If this line is a separator line, with or
+ − 1055 ;; without prefix, end the paragraph.
444
+ − 1056 (and
428
+ − 1057 (not (looking-at paragraph-separate))
+ − 1058 (save-excursion
+ − 1059 (not (and (looking-at fill-prefix-regexp)
+ − 1060 ;; XEmacs change
+ − 1061 (progn
+ − 1062 (forward-char (length fill-prefix))
+ − 1063 (looking-at paragraph-separate))))))
+ − 1064 ;; If this line has more or less indent
+ − 1065 ;; than the fill prefix wants, end the paragraph.
+ − 1066 (and (looking-at fill-prefix-regexp)
+ − 1067 (save-excursion
+ − 1068 (not
+ − 1069 (progn
+ − 1070 (forward-char (length fill-prefix))
+ − 1071 (or (looking-at paragraph-separate)
+ − 1072 (looking-at paragraph-start))))))))))
+ − 1073 ;; Fill this paragraph, but don't add a newline at the end.
+ − 1074 (let ((had-newline (bolp)))
+ − 1075 (fill-region-as-paragraph start (point) justify)
+ − 1076 (or had-newline (delete-char -1))))))))
+ − 1077
+ − 1078 ;;; fill.el ends here