LCOV - code coverage report
Current view: top level - lisp/textmodes - fill.el (source / functions) Hit Total Coverage
Test: tramp-tests-after.info Lines: 0 744 0.0 %
Date: 2017-08-30 10:12:24 Functions: 0 38 0.0 %

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

Generated by: LCOV version 1.12