lisp/textmodes/fill.el

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