Mercurial > emacs
annotate lisp/textmodes/fill.el @ 10468:d0854b6f3216
(set-justification): New function.
(set-justification-{none,left,right,full,center}): New functions.
(fill-region-as-paragraph, fill-region, justify-current-line): New
arg NOSQUEEZE defeats normal removal of extra whitespace.
(fill-region-as-paragraph, fill-region)
(fill-nonuniform-paragraphs, fill-individual-paragraphs):
Arg JUSTIFY-FLAG (JUSTIFYP) renamed to JUSTIFY.
(fill-region-as-paragraph): Obey left-margin; fill-prefix starts
after left-margin. Disable filling if JUSTIFY == none, but indent to
margin anyway.
Adaptive-fill removes text-props from fill-prefixes it finds.
Adaptive-fill no longer has to notice left-margin: std fill does that.
Use fill-column and canonically-space-region functions.
(canonically-space-region): New fn split from fill-region-as-paragraph.
(fill-region): New args NOSQUEEZE (as above) and TO-EOP.
(default-justification): New variable.
(current-left-margin, fill-column, justification): New functions.
(fill-paragraph): Use fill-region-as-paragraph when possible.
(justify-current-line): New arguments; different kinds of
justification handled. Uses left-margin and fill-column functions.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Thu, 19 Jan 1995 04:20:52 +0000 |
parents | 166aed4ba78b |
children | 82ff279a4cea |
rev | line source |
---|---|
662
8a533acedb77
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
638
diff
changeset
|
1 ;;; fill.el --- fill commands for Emacs |
8a533acedb77
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
638
diff
changeset
|
2 |
7300 | 3 ;; Copyright (C) 1985, 1986, 1992, 1994 Free Software Foundation, Inc. |
846
20674ae6bf52
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
821
diff
changeset
|
4 |
811
e694e0879463
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
807
diff
changeset
|
5 ;; Keywords: wp |
807
4f28bd14272c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
732
diff
changeset
|
6 |
75 | 7 ;; This file is part of GNU Emacs. |
8 | |
9 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
10 ;; it under the terms of the GNU General Public License as published by | |
807
4f28bd14272c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
732
diff
changeset
|
11 ;; the Free Software Foundation; either version 2, or (at your option) |
75 | 12 ;; any later version. |
13 | |
14 ;; GNU Emacs is distributed in the hope that it will be useful, | |
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
17 ;; GNU General Public License for more details. | |
18 | |
19 ;; You should have received a copy of the GNU General Public License | |
20 ;; along with GNU Emacs; see the file COPYING. If not, write to | |
21 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. | |
22 | |
2307
10e417efb12a
Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2109
diff
changeset
|
23 ;;; Commentary: |
10e417efb12a
Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2109
diff
changeset
|
24 |
10e417efb12a
Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2109
diff
changeset
|
25 ;; All the commands for filling text. These are documented in the Emacs |
10e417efb12a
Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2109
diff
changeset
|
26 ;; manual. |
10e417efb12a
Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2109
diff
changeset
|
27 |
807
4f28bd14272c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
732
diff
changeset
|
28 ;;; Code: |
75 | 29 |
638 | 30 (defconst fill-individual-varying-indent nil |
31 "*Controls criterion for a new paragraph in `fill-individual-paragraphs'. | |
32 Non-nil means changing indent doesn't end a paragraph. | |
33 That mode can handle paragraphs with extra indentation on the first line, | |
34 but it requires separator lines between paragraphs. | |
5770
92dd602768d2
(sentence-end-double-space): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
5291
diff
changeset
|
35 A value of nil means that any change in indentation starts a new paragraph.") |
92dd602768d2
(sentence-end-double-space): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
5291
diff
changeset
|
36 |
92dd602768d2
(sentence-end-double-space): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
5291
diff
changeset
|
37 (defconst sentence-end-double-space t |
92dd602768d2
(sentence-end-double-space): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
5291
diff
changeset
|
38 "*Non-nil means a single space does not end a sentence.") |
638 | 39 |
75 | 40 (defun set-fill-prefix () |
5770
92dd602768d2
(sentence-end-double-space): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
5291
diff
changeset
|
41 "Set the fill prefix to the current line up to point. |
218 | 42 Filling expects lines to start with the fill prefix and |
43 reinserts the fill prefix in each resulting line." | |
75 | 44 (interactive) |
45 (setq fill-prefix (buffer-substring | |
46 (save-excursion (beginning-of-line) (point)) | |
47 (point))) | |
48 (if (equal fill-prefix "") | |
49 (setq fill-prefix nil)) | |
50 (if fill-prefix | |
51 (message "fill-prefix: \"%s\"" fill-prefix) | |
52 (message "fill-prefix cancelled"))) | |
53 | |
218 | 54 (defconst adaptive-fill-mode t |
55 "*Non-nil means determine a paragraph's fill prefix from its text.") | |
56 | |
57 (defconst adaptive-fill-regexp "[ \t]*\\([>*] +\\)?" | |
58 "*Regexp to match text at start of line that constitutes indentation. | |
59 If Adaptive Fill mode is enabled, whatever text matches this pattern | |
60 on the second line of a paragraph is used as the standard indentation | |
61 for the paragraph.") | |
62 | |
10468
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
63 (defun current-fill-column () |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
64 "Return the fill-column to use for this line. |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
65 The fill-column to use for a buffer is stored in the variable `fill-column', |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
66 but can be locally modified by the `right-margin' text property, which is |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
67 subtracted from `fill-column'. |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
68 |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
69 The fill column to use for a line is the first column at which the column |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
70 number equals or exceeds the local fill-column - right-margin difference." |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
71 (save-excursion |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
72 (let* ((here (progn (beginning-of-line) (point))) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
73 (here-col 0) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
74 (eol (progn (end-of-line) (point))) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
75 margin fill-col change col) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
76 ;; Look separately at each region of line with a different right-margin |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
77 (while (and (setq margin (get-text-property here 'right-margin) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
78 fill-col (- fill-column (or margin 0)) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
79 change (text-property-not-all here eol |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
80 'right-margin margin)) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
81 (progn (goto-char (1- change)) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
82 (setq col (current-column)) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
83 (< col fill-col))) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
84 (setq here change |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
85 here-col col)) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
86 (max here-col fill-col)))) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
87 |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
88 (defun canonically-space-region (beg end) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
89 "Remove extra spaces between words in region. |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
90 Puts one space between words in region; two between sentences. |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
91 Remove indenation from each line." |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
92 (interactive "r") |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
93 (save-excursion |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
94 (goto-char beg) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
95 ;; Nuke tabs; they get screwed up in a fill. |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
96 ;; This is quick, but loses when a tab follows the end of a sentence. |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
97 ;; Actually, it is difficult to tell that from "Mr.\tSmith". |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
98 ;; Blame the typist. |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
99 (subst-char-in-region beg end ?\t ?\ ) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
100 (while (and (< (point) end) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
101 (re-search-forward " *" end t)) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
102 (delete-region |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
103 (+ (match-beginning 0) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
104 ;; Determine number of spaces to leave: |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
105 (save-excursion |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
106 (skip-chars-backward " ]})\"'") |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
107 (cond ((and sentence-end-double-space |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
108 (memq (preceding-char) '(?. ?? ?!))) 2) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
109 ((char-equal (preceding-char) ?\n) 0) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
110 (t 1)))) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
111 (match-end 0))) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
112 ;; Make sure sentences ending at end of line get an extra space. |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
113 ;; loses on split abbrevs ("Mr.\nSmith") |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
114 (goto-char beg) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
115 (while (and (< (point) end) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
116 (re-search-forward "[.?!][])}\"']*$" end t)) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
117 (insert-and-inherit ? )))) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
118 |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
119 (defun fill-region-as-paragraph (from to &optional justify nosqueeze) |
5770
92dd602768d2
(sentence-end-double-space): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
5291
diff
changeset
|
120 "Fill region as one paragraph: break lines to fit `fill-column'. |
10468
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
121 This removes any paragraph breaks in the region. |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
122 It performs justification according to the `justification' text-property, |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
123 but a prefix arg can be used to override this and request full justification. |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
124 |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
125 Optional fourth arg NOSQUEEZE non-nil means to leave whitespace other than line |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
126 breaks untouched. Normally it is made canonical before filling. |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
127 |
5770
92dd602768d2
(sentence-end-double-space): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
5291
diff
changeset
|
128 If `sentence-end-double-space' is non-nil, then period followed by one |
10468
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
129 space does not end a sentence, so don't break a line there." |
75 | 130 (interactive "r\nP") |
1332
955ebdb98095
(fill-paragraph): Don't actually change point before
Richard M. Stallman <rms@gnu.org>
parents:
1067
diff
changeset
|
131 ;; Arrange for undoing the fill to restore point. |
955ebdb98095
(fill-paragraph): Don't actually change point before
Richard M. Stallman <rms@gnu.org>
parents:
1067
diff
changeset
|
132 (if (and buffer-undo-list (not (eq buffer-undo-list t))) |
955ebdb98095
(fill-paragraph): Don't actually change point before
Richard M. Stallman <rms@gnu.org>
parents:
1067
diff
changeset
|
133 (setq buffer-undo-list (cons (point) buffer-undo-list))) |
10468
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
134 (or justify (setq justify (justification))) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
135 |
218 | 136 ;; Don't let Adaptive Fill mode alter the fill prefix permanently. |
2409
d03c7b8ac284
Cancel previous change; this version should be identical to version 1.17.
Richard M. Stallman <rms@gnu.org>
parents:
2376
diff
changeset
|
137 (let ((fill-prefix fill-prefix)) |
218 | 138 ;; Figure out how this paragraph is indented, if desired. |
670
bff41708644e
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
662
diff
changeset
|
139 (if (and adaptive-fill-mode |
bff41708644e
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
662
diff
changeset
|
140 (or (null fill-prefix) (string= fill-prefix ""))) |
218 | 141 (save-excursion |
142 (goto-char (min from to)) | |
143 (if (eolp) (forward-line 1)) | |
144 (forward-line 1) | |
10468
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
145 (move-to-left-margin) |
218 | 146 (if (< (point) (max from to)) |
147 (let ((start (point))) | |
148 (re-search-forward adaptive-fill-regexp) | |
10468
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
149 (setq fill-prefix (buffer-substring start (point))) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
150 (set-text-properties 0 (length fill-prefix) nil fill-prefix)) |
218 | 151 (goto-char (min from to)) |
152 (if (eolp) (forward-line 1)) | |
7721
b04897534717
(fill-region-as-paragraph): if left-margin is nonzero,
Richard M. Stallman <rms@gnu.org>
parents:
7300
diff
changeset
|
153 ;; If paragraph has only one line, don't assume in general |
218 | 154 ;; that additional lines would have the same starting |
729
5d684b81ac6b
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
719
diff
changeset
|
155 ;; decoration. Assume no indentation. |
5d684b81ac6b
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
719
diff
changeset
|
156 ))) |
75 | 157 |
10468
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
158 (if (not justify) ; filling disabled: just check indentation |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
159 (progn |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
160 (goto-char (min from to)) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
161 (setq to (max from to)) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
162 (while (< (point) to) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
163 (if (not (eolp)) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
164 (if (< (current-indentation) (left-margin)) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
165 (indent-to-left-margin))) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
166 (forward-line 1))) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
167 |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
168 (save-restriction |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
169 (let (beg) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
170 (goto-char (min from to)) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
171 (skip-chars-forward "\n") |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
172 (setq beg (point)) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
173 (goto-char (max from to)) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
174 (skip-chars-backward "\n") |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
175 (setq to (point) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
176 from beg) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
177 (goto-char from) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
178 (beginning-of-line) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
179 (narrow-to-region (point) to)) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
180 (if use-hard-newlines |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
181 (remove-text-properties from to '(hard nil))) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
182 ;; Make sure first line is indented (at least) to left margin... |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
183 (if (or (memq justify '(right center)) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
184 (< (current-indentation) (left-margin))) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
185 (indent-to-left-margin)) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
186 ;; and remove indentation from other lines. |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
187 (beginning-of-line 2) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
188 (indent-region (point) (point-max) 0) |
218 | 189 ;; Delete the fill prefix from every line except the first. |
190 ;; The first line may not even have a fill prefix. | |
10468
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
191 (goto-char from) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
192 (let ((fpre (and fill-prefix (not (equal fill-prefix "")) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
193 (concat "[ \t]*" |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
194 (regexp-quote fill-prefix))))) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
195 (and fpre |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
196 (progn |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
197 (if (>= (+ (left-margin) (length fill-prefix)) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
198 (current-fill-column)) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
199 (error "fill-prefix too long for specified width")) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
200 (goto-char from) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
201 (forward-line 1) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
202 (while (not (eobp)) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
203 (if (looking-at fpre) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
204 (delete-region (point) (match-end 0))) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
205 (forward-line 1)) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
206 (goto-char from) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
207 (and (looking-at fpre) (goto-char (match-end 0))) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
208 (setq from (point))))) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
209 ;; "from" is now before the text to fill, |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
210 ;; but after any fill prefix on the first line. |
218 | 211 |
10468
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
212 ;; Make sure sentences ending at end of line get an extra space. |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
213 ;; loses on split abbrevs ("Mr.\nSmith") |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
214 (while (re-search-forward "[.?!][])}\"']*$" nil t) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
215 (insert-and-inherit ? )) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
216 (goto-char from) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
217 (skip-chars-forward " \t") |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
218 ;; Then change all newlines to spaces. |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
219 (subst-char-in-region from (point-max) ?\n ?\ ) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
220 (if (and nosqueeze (not (eq justify 'full))) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
221 nil |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
222 (canonically-space-region (point) (point-max)) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
223 (goto-char (point-max)) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
224 (delete-horizontal-space) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
225 (insert-and-inherit " ")) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
226 (goto-char (point-min)) |
218 | 227 |
10468
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
228 ;; This is the actual filling loop. |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
229 (let ((prefixcol 0) linebeg) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
230 (while (not (eobp)) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
231 (setq linebeg (point)) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
232 (move-to-column (1+ (current-fill-column))) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
233 (if (eobp) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
234 (or nosqueeze (delete-horizontal-space)) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
235 ;; Move back to start of word. |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
236 (skip-chars-backward "^ \n" linebeg) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
237 ;; Don't break after a period followed by just one space. |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
238 ;; Move back to the previous place to break. |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
239 ;; The reason is that if a period ends up at the end of a line, |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
240 ;; further fills will assume it ends a sentence. |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
241 ;; If we now know it does not end a sentence, |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
242 ;; avoid putting it at the end of the line. |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
243 (if sentence-end-double-space |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
244 (while (and (> (point) (+ linebeg 2)) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
245 (eq (preceding-char) ?\ ) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
246 (not (eq (following-char) ?\ )) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
247 (eq (char-after (- (point) 2)) ?\.)) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
248 (forward-char -2) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
249 (skip-chars-backward "^ \n" linebeg))) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
250 (if (if (zerop prefixcol) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
251 (save-excursion |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
252 (skip-chars-backward " " linebeg) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
253 (bolp)) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
254 (>= prefixcol (current-column))) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
255 ;; Keep at least one word even if fill prefix exceeds margin. |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
256 ;; This handles all but the first line of the paragraph. |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
257 ;; Meanwhile, don't stop at a period followed by one space. |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
258 (let ((first t)) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
259 (move-to-column prefixcol) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
260 (while (and (not (eobp)) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
261 (or first |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
262 (and (not (bobp)) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
263 sentence-end-double-space |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
264 (save-excursion (forward-char -1) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
265 (and (looking-at "\\. ") |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
266 (not (looking-at "\\. "))))))) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
267 (skip-chars-forward " ") |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
268 (skip-chars-forward "^ \n") |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
269 (setq first nil))) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
270 ;; Normally, move back over the single space between the words. |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
271 (forward-char -1)) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
272 (if (and fill-prefix (zerop prefixcol) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
273 (< (- (point) (point-min)) (length fill-prefix)) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
274 (string= (buffer-substring (point-min) (point)) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
275 (substring fill-prefix 0 (- (point) (point-min))))) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
276 ;; Keep at least one word even if fill prefix exceeds margin. |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
277 ;; This handles the first line of the paragraph. |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
278 ;; Don't stop at a period followed by just one space. |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
279 (let ((first t)) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
280 (while (and (not (eobp)) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
281 (or first |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
282 (and (not (bobp)) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
283 sentence-end-double-space |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
284 (save-excursion (forward-char -1) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
285 (and (looking-at "\\. ") |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
286 (not (looking-at "\\. "))))))) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
287 (skip-chars-forward " ") |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
288 (skip-chars-forward "^ \n") |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
289 (setq first nil)))) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
290 ;; Replace whitespace here with one newline, then indent to left |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
291 ;; margin. |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
292 (skip-chars-backward " ") |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
293 (insert ?\n) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
294 ;; Give newline the properties of the space(s) it replaces |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
295 (set-text-properties (1- (point)) (point) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
296 (text-properties-at (point))) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
297 (indent-to-left-margin) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
298 ;; Insert the fill prefix after indentation. |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
299 ;; Set prefixcol so whitespace in the prefix won't get lost. |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
300 (and fill-prefix (not (equal fill-prefix "")) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
301 (progn |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
302 (insert-and-inherit fill-prefix) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
303 (setq prefixcol (current-column))))) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
304 ;; Justify the line just ended, if desired. |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
305 (if justify |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
306 (if (eobp) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
307 (justify-current-line justify t t) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
308 (forward-line -1) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
309 (justify-current-line justify nil t) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
310 (forward-line 1))))))))) |
75 | 311 |
312 (defun fill-paragraph (arg) | |
5770
92dd602768d2
(sentence-end-double-space): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
5291
diff
changeset
|
313 "Fill paragraph at or after point. Prefix arg means justify as well. |
92dd602768d2
(sentence-end-double-space): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
5291
diff
changeset
|
314 If `sentence-end-double-space' is non-nil, then period followed by one |
92dd602768d2
(sentence-end-double-space): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
5291
diff
changeset
|
315 space does not end a sentence, so don't break a line there." |
75 | 316 (interactive "P") |
1332
955ebdb98095
(fill-paragraph): Don't actually change point before
Richard M. Stallman <rms@gnu.org>
parents:
1067
diff
changeset
|
317 (let ((before (point))) |
955ebdb98095
(fill-paragraph): Don't actually change point before
Richard M. Stallman <rms@gnu.org>
parents:
1067
diff
changeset
|
318 (save-excursion |
955ebdb98095
(fill-paragraph): Don't actually change point before
Richard M. Stallman <rms@gnu.org>
parents:
1067
diff
changeset
|
319 (forward-paragraph) |
955ebdb98095
(fill-paragraph): Don't actually change point before
Richard M. Stallman <rms@gnu.org>
parents:
1067
diff
changeset
|
320 (or (bolp) (newline 1)) |
955ebdb98095
(fill-paragraph): Don't actually change point before
Richard M. Stallman <rms@gnu.org>
parents:
1067
diff
changeset
|
321 (let ((end (point)) |
955ebdb98095
(fill-paragraph): Don't actually change point before
Richard M. Stallman <rms@gnu.org>
parents:
1067
diff
changeset
|
322 (beg (progn (backward-paragraph) (point)))) |
955ebdb98095
(fill-paragraph): Don't actually change point before
Richard M. Stallman <rms@gnu.org>
parents:
1067
diff
changeset
|
323 (goto-char before) |
10423
166aed4ba78b
(fill-region-as-paragraph): Don't modify newline
Richard M. Stallman <rms@gnu.org>
parents:
10110
diff
changeset
|
324 (if use-hard-newlines |
166aed4ba78b
(fill-region-as-paragraph): Don't modify newline
Richard M. Stallman <rms@gnu.org>
parents:
10110
diff
changeset
|
325 ;; Can't use fill-region-as-paragraph, since this paragraph may |
166aed4ba78b
(fill-region-as-paragraph): Don't modify newline
Richard M. Stallman <rms@gnu.org>
parents:
10110
diff
changeset
|
326 ;; still contain hard newlines. See fill-region. |
166aed4ba78b
(fill-region-as-paragraph): Don't modify newline
Richard M. Stallman <rms@gnu.org>
parents:
10110
diff
changeset
|
327 (fill-region beg end arg) |
166aed4ba78b
(fill-region-as-paragraph): Don't modify newline
Richard M. Stallman <rms@gnu.org>
parents:
10110
diff
changeset
|
328 (fill-region-as-paragraph beg end arg)))))) |
75 | 329 |
10468
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
330 (defun fill-region (from to &optional justify nosqueeze to-eop) |
75 | 331 "Fill each of the paragraphs in the region. |
5770
92dd602768d2
(sentence-end-double-space): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
5291
diff
changeset
|
332 Prefix arg (non-nil third arg, if called from program) means justify as well. |
10468
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
333 |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
334 Noninteractively, fourth arg NOSQUEEZE non-nil means to leave |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
335 whitespace other than line breaks untouched, and fifth arg TO-EOP |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
336 non-nil means to keep filling to the end of the paragraph (or next |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
337 hard newline, if `use-hard-newlines' is on). |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
338 |
5770
92dd602768d2
(sentence-end-double-space): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
5291
diff
changeset
|
339 If `sentence-end-double-space' is non-nil, then period followed by one |
92dd602768d2
(sentence-end-double-space): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
5291
diff
changeset
|
340 space does not end a sentence, so don't break a line there." |
75 | 341 (interactive "r\nP") |
10423
166aed4ba78b
(fill-region-as-paragraph): Don't modify newline
Richard M. Stallman <rms@gnu.org>
parents:
10110
diff
changeset
|
342 ;; If using hard newlines, break at every one for filling purposes rather |
166aed4ba78b
(fill-region-as-paragraph): Don't modify newline
Richard M. Stallman <rms@gnu.org>
parents:
10110
diff
changeset
|
343 ;; than breaking at normal paragraph breaks. |
166aed4ba78b
(fill-region-as-paragraph): Don't modify newline
Richard M. Stallman <rms@gnu.org>
parents:
10110
diff
changeset
|
344 (let ((paragraph-start (if use-hard-newlines "^" paragraph-start)) |
166aed4ba78b
(fill-region-as-paragraph): Don't modify newline
Richard M. Stallman <rms@gnu.org>
parents:
10110
diff
changeset
|
345 end beg) |
10110
18d52489f138
(fill-region-as-paragraph): If region starts in mid-line,
Richard M. Stallman <rms@gnu.org>
parents:
9706
diff
changeset
|
346 (save-restriction |
18d52489f138
(fill-region-as-paragraph): If region starts in mid-line,
Richard M. Stallman <rms@gnu.org>
parents:
9706
diff
changeset
|
347 (goto-char (max from to)) |
10468
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
348 (if to-eop |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
349 (progn (skip-chars-backward "\n") |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
350 (forward-paragraph))) |
10110
18d52489f138
(fill-region-as-paragraph): If region starts in mid-line,
Richard M. Stallman <rms@gnu.org>
parents:
9706
diff
changeset
|
351 (setq end (point)) |
18d52489f138
(fill-region-as-paragraph): If region starts in mid-line,
Richard M. Stallman <rms@gnu.org>
parents:
9706
diff
changeset
|
352 (goto-char (setq beg (min from to))) |
18d52489f138
(fill-region-as-paragraph): If region starts in mid-line,
Richard M. Stallman <rms@gnu.org>
parents:
9706
diff
changeset
|
353 (beginning-of-line) |
18d52489f138
(fill-region-as-paragraph): If region starts in mid-line,
Richard M. Stallman <rms@gnu.org>
parents:
9706
diff
changeset
|
354 (narrow-to-region (point) end) |
18d52489f138
(fill-region-as-paragraph): If region starts in mid-line,
Richard M. Stallman <rms@gnu.org>
parents:
9706
diff
changeset
|
355 (while (not (eobp)) |
18d52489f138
(fill-region-as-paragraph): If region starts in mid-line,
Richard M. Stallman <rms@gnu.org>
parents:
9706
diff
changeset
|
356 (let ((initial (point)) |
18d52489f138
(fill-region-as-paragraph): If region starts in mid-line,
Richard M. Stallman <rms@gnu.org>
parents:
9706
diff
changeset
|
357 (end (progn |
18d52489f138
(fill-region-as-paragraph): If region starts in mid-line,
Richard M. Stallman <rms@gnu.org>
parents:
9706
diff
changeset
|
358 (forward-paragraph 1) (point)))) |
18d52489f138
(fill-region-as-paragraph): If region starts in mid-line,
Richard M. Stallman <rms@gnu.org>
parents:
9706
diff
changeset
|
359 (forward-paragraph -1) |
18d52489f138
(fill-region-as-paragraph): If region starts in mid-line,
Richard M. Stallman <rms@gnu.org>
parents:
9706
diff
changeset
|
360 (if (< (point) beg) |
18d52489f138
(fill-region-as-paragraph): If region starts in mid-line,
Richard M. Stallman <rms@gnu.org>
parents:
9706
diff
changeset
|
361 (goto-char beg)) |
18d52489f138
(fill-region-as-paragraph): If region starts in mid-line,
Richard M. Stallman <rms@gnu.org>
parents:
9706
diff
changeset
|
362 (if (>= (point) initial) |
10468
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
363 (fill-region-as-paragraph (point) end justify nosqueeze) |
10110
18d52489f138
(fill-region-as-paragraph): If region starts in mid-line,
Richard M. Stallman <rms@gnu.org>
parents:
9706
diff
changeset
|
364 (goto-char end))))))) |
75 | 365 |
10468
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
366 |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
367 (defconst default-justification 'left |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
368 "*Method of justifying text not otherwise specified. |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
369 Possible values are `left', `right', `full', `center', or `none'. |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
370 The requested kind of justification is done whenever lines are filled. |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
371 The `justification' text-property can locally override this variable. |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
372 This variable automatically becomes buffer-local when set in any fashion.") |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
373 (make-variable-buffer-local 'default-justification) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
374 |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
375 (defun justification () |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
376 "How should we justify this line? |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
377 This returns the value of the text-property `justification', |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
378 or the variable `default-justification' if there is no text-property. |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
379 However, it returns nil rather than `none' to mean \"don't justify\"." |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
380 (let ((j (or (get-text-property |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
381 ;; Make sure we're looking at paragraph body. |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
382 (save-excursion (skip-chars-forward " \t") (point)) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
383 'justification) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
384 default-justification))) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
385 (if (eq 'none j) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
386 nil |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
387 j))) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
388 |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
389 (defun set-justification (begin end value) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
390 "Set the region's justification style. |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
391 If the mark is not active, this operates on the current line. |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
392 In interactive use, if the BEGIN and END points are |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
393 not at line breaks, they are moved outward to the next line break. |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
394 If `use-hard-newlines' is true, they are moved to the next hard line breaks. |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
395 Noninteractively, the values of BEGIN, END and VALUE are not modified." |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
396 (interactive (list (if mark-active (region-beginning) (point)) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
397 (if mark-active (region-end) (point)) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
398 (let ((s (completing-read |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
399 "Set justification to: " |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
400 '(("left") ("right") ("full") ("center") |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
401 ("none")) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
402 nil t))) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
403 (if (equal s "") |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
404 (error "") |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
405 (intern s))))) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
406 (let* ((paragraph-start (if use-hard-newlines "^" paragraph-start))) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
407 (save-excursion |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
408 (goto-char begin) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
409 (while (bolp) (forward-char 1)) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
410 (backward-paragraph) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
411 (setq begin (point)) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
412 |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
413 (goto-char end) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
414 (skip-chars-backward " \t\n" begin) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
415 (forward-paragraph) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
416 (setq end (point)) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
417 (set-mark begin) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
418 (goto-char end) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
419 (y-or-n-p "set-just"))) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
420 (put-text-property begin end 'justification value) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
421 (fill-region begin end nil t)) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
422 |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
423 (defun set-justification-none (b e) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
424 "Disable automatic filling for paragraphs in the region. |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
425 If the mark is not active, this applies to the current paragraph." |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
426 (interactive "r") |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
427 (set-justification b e 'none)) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
428 |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
429 (defun set-justification-left (b e) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
430 "Make paragraphs in the region left-justified. |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
431 This is usually the default, but see `enriched-default-justification'. |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
432 If the mark is not active, this applies to the current paragraph." |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
433 (interactive "r") |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
434 (set-justification b e 'left)) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
435 |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
436 (defun set-justification-right (b e) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
437 "Make paragraphs in the region right-justified: |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
438 Flush at the right margin and ragged on the left. |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
439 If the mark is not active, this applies to the current paragraph." |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
440 (interactive "r") |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
441 (set-justification b e 'right)) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
442 |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
443 (defun set-justification-full (b e) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
444 "Make paragraphs in the region fully justified: |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
445 Flush on both margins. |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
446 If the mark is not active, this applies to the current paragraph." |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
447 (interactive "r") |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
448 (set-justification b e 'both)) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
449 |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
450 (defun set-justification-center (b e) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
451 "Make paragraphs in the region centered. |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
452 If the mark is not active, this applies to the current paragraph." |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
453 (interactive "r") |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
454 (set-justification b e 'center)) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
455 |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
456 (defun justify-current-line (&optional how eop nosqueeze) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
457 "Add spaces to line point is in, so it ends at `fill-column'. |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
458 Optional first argument HOW specifies alternate type of justification: |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
459 it can be `left', `right', `full', `center', or `none'. |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
460 If HOW is t, will justify however the `justification' function says. |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
461 Any other value, including nil, is taken to mean `full'. |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
462 Second arg EOP non-nil means that this is the last line of the paragraph, so |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
463 it will not be stretched by full justification. |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
464 Third arg NOSQUEEZE non-nil means to leave interior whitespace unchanged, |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
465 otherwise it is made canonical." |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
466 (interactive (list 'full nil nil)) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
467 (if (eq t how) (setq how (or (justification) 'none))) |
75 | 468 (save-excursion |
469 (save-restriction | |
10468
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
470 (let ((fc (current-fill-column)) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
471 ncols beg indent end) |
75 | 472 (end-of-line) |
10468
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
473 (if (and use-hard-newlines (null eop) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
474 (get-text-property (point) 'hard)) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
475 (setq eop t)) |
8363
bf559544bd48
(justify-current-line): Delete space at end of line.
Richard M. Stallman <rms@gnu.org>
parents:
7721
diff
changeset
|
476 (skip-chars-backward " \t") |
10468
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
477 (if (= (current-column) fc) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
478 nil ;; Quick exit if it appears to be properly justified already. |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
479 (setq end (point)) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
480 (beginning-of-line) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
481 (skip-chars-forward " \t") |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
482 (if (and fill-prefix |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
483 (equal fill-prefix |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
484 (buffer-substring (point) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
485 (+ (point) (length fill-prefix))))) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
486 (forward-char (length fill-prefix))) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
487 (setq indent (current-column)) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
488 (setq beg (point)) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
489 (goto-char end) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
490 (cond ((or (eq 'none how) (eq 'left how)) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
491 nil) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
492 ((eq 'right how) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
493 (setq ncols (- (+ indent (current-fill-column)) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
494 (current-column))) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
495 (if (> ncols 0) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
496 (indent-line-to ncols))) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
497 ((eq 'center how) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
498 (setq ncols |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
499 (/ (- (+ indent (current-fill-column)) (current-column)) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
500 2)) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
501 (if (>= ncols 0) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
502 (indent-line-to ncols) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
503 (message "Line to long to center"))) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
504 (t ;; full |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
505 (narrow-to-region beg end) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
506 (or nosqueeze |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
507 (canonically-space-region beg end)) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
508 (goto-char (point-max)) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
509 (setq ncols (- (current-fill-column) indent (current-column))) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
510 (if (< ncols 0) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
511 (message "Line to long to justify") |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
512 (if (and (not eop) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
513 (search-backward " " nil t)) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
514 (while (> ncols 0) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
515 (let ((nmove (+ 3 (random 3)))) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
516 (while (> nmove 0) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
517 (or (search-backward " " nil t) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
518 (progn |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
519 (goto-char (point-max)) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
520 (search-backward " "))) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
521 (skip-chars-backward " ") |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
522 (setq nmove (1- nmove)))) |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
523 (insert-and-inherit " ") |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
524 (skip-chars-backward " ") |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
525 (setq ncols (1- ncols))))))))))) |
2109
73485780a8f9
* simple.el (yank, yank-pop): Always return nil; don't rely on
Jim Blandy <jimb@redhat.com>
parents:
1332
diff
changeset
|
526 nil) |
9026
74fd93bc3568
(justify-current-line): Inherit props when inserting spaces.
Richard M. Stallman <rms@gnu.org>
parents:
8363
diff
changeset
|
527 |
75 | 528 |
2520
ef643dbb7d40
(fill-nonuniform-paragraphs): New command.
Richard M. Stallman <rms@gnu.org>
parents:
2412
diff
changeset
|
529 (defun fill-nonuniform-paragraphs (min max &optional justifyp mailp) |
ef643dbb7d40
(fill-nonuniform-paragraphs): New command.
Richard M. Stallman <rms@gnu.org>
parents:
2412
diff
changeset
|
530 "Fill paragraphs within the region, allowing varying indentation within each. |
ef643dbb7d40
(fill-nonuniform-paragraphs): New command.
Richard M. Stallman <rms@gnu.org>
parents:
2412
diff
changeset
|
531 This command divides the region into \"paragraphs\", |
ef643dbb7d40
(fill-nonuniform-paragraphs): New command.
Richard M. Stallman <rms@gnu.org>
parents:
2412
diff
changeset
|
532 only at paragraph-separator lines, then fills each paragraph |
ef643dbb7d40
(fill-nonuniform-paragraphs): New command.
Richard M. Stallman <rms@gnu.org>
parents:
2412
diff
changeset
|
533 using as the fill prefix the smallest indentation of any line |
ef643dbb7d40
(fill-nonuniform-paragraphs): New command.
Richard M. Stallman <rms@gnu.org>
parents:
2412
diff
changeset
|
534 in the paragraph. |
ef643dbb7d40
(fill-nonuniform-paragraphs): New command.
Richard M. Stallman <rms@gnu.org>
parents:
2412
diff
changeset
|
535 |
ef643dbb7d40
(fill-nonuniform-paragraphs): New command.
Richard M. Stallman <rms@gnu.org>
parents:
2412
diff
changeset
|
536 When calling from a program, pass range to fill as first two arguments. |
638 | 537 |
10468
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
538 Optional third and fourth arguments JUSTIFY and MAIL-FLAG: |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
539 JUSTIFY to justify paragraphs (prefix arg), |
2520
ef643dbb7d40
(fill-nonuniform-paragraphs): New command.
Richard M. Stallman <rms@gnu.org>
parents:
2412
diff
changeset
|
540 MAIL-FLAG for a mail message, i. e. don't fill header lines." |
ef643dbb7d40
(fill-nonuniform-paragraphs): New command.
Richard M. Stallman <rms@gnu.org>
parents:
2412
diff
changeset
|
541 (interactive "r\nP") |
ef643dbb7d40
(fill-nonuniform-paragraphs): New command.
Richard M. Stallman <rms@gnu.org>
parents:
2412
diff
changeset
|
542 (let ((fill-individual-varying-indent t)) |
ef643dbb7d40
(fill-nonuniform-paragraphs): New command.
Richard M. Stallman <rms@gnu.org>
parents:
2412
diff
changeset
|
543 (fill-individual-paragraphs min max justifyp mailp))) |
ef643dbb7d40
(fill-nonuniform-paragraphs): New command.
Richard M. Stallman <rms@gnu.org>
parents:
2412
diff
changeset
|
544 |
10468
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
545 (defun fill-individual-paragraphs (min max &optional justify mailp) |
2520
ef643dbb7d40
(fill-nonuniform-paragraphs): New command.
Richard M. Stallman <rms@gnu.org>
parents:
2412
diff
changeset
|
546 "Fill paragraphs of uniform indentation within the region. |
ef643dbb7d40
(fill-nonuniform-paragraphs): New command.
Richard M. Stallman <rms@gnu.org>
parents:
2412
diff
changeset
|
547 This command divides the region into \"paragraphs\", |
ef643dbb7d40
(fill-nonuniform-paragraphs): New command.
Richard M. Stallman <rms@gnu.org>
parents:
2412
diff
changeset
|
548 treating every change in indentation level as a paragraph boundary, |
ef643dbb7d40
(fill-nonuniform-paragraphs): New command.
Richard M. Stallman <rms@gnu.org>
parents:
2412
diff
changeset
|
549 then fills each paragraph using its indentation level as the fill prefix. |
638 | 550 |
551 When calling from a program, pass range to fill as first two arguments. | |
552 | |
10468
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
553 Optional third and fourth arguments JUSTIFY and MAIL-FLAG: |
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
554 JUSTIFY to justify paragraphs (prefix arg), |
75 | 555 MAIL-FLAG for a mail message, i. e. don't fill header lines." |
556 (interactive "r\nP") | |
474 | 557 (save-restriction |
558 (save-excursion | |
559 (goto-char min) | |
560 (beginning-of-line) | |
9706
f5f7d07eece8
(fill-individual-paragraphs): Avoid infinite loop
Richard M. Stallman <rms@gnu.org>
parents:
9217
diff
changeset
|
561 (narrow-to-region (point) max) |
474 | 562 (if mailp |
9706
f5f7d07eece8
(fill-individual-paragraphs): Avoid infinite loop
Richard M. Stallman <rms@gnu.org>
parents:
9217
diff
changeset
|
563 (while (and (not (eobp)) |
f5f7d07eece8
(fill-individual-paragraphs): Avoid infinite loop
Richard M. Stallman <rms@gnu.org>
parents:
9217
diff
changeset
|
564 (or (looking-at "[ \t]*[^ \t\n]*:") |
f5f7d07eece8
(fill-individual-paragraphs): Avoid infinite loop
Richard M. Stallman <rms@gnu.org>
parents:
9217
diff
changeset
|
565 (looking-at "[ \t]*$"))) |
4992
8a3293abe1ba
(fill-individual-paragraphs): Fix skipping headers of yanked message.
Richard M. Stallman <rms@gnu.org>
parents:
4413
diff
changeset
|
566 (if (looking-at "[ \t]*[^ \t\n]*:") |
8a3293abe1ba
(fill-individual-paragraphs): Fix skipping headers of yanked message.
Richard M. Stallman <rms@gnu.org>
parents:
4413
diff
changeset
|
567 (search-forward "\n\n" nil 'move) |
8a3293abe1ba
(fill-individual-paragraphs): Fix skipping headers of yanked message.
Richard M. Stallman <rms@gnu.org>
parents:
4413
diff
changeset
|
568 (forward-line 1)))) |
474 | 569 (narrow-to-region (point) max) |
570 ;; Loop over paragraphs. | |
571 (while (progn (skip-chars-forward " \t\n") (not (eobp))) | |
572 (beginning-of-line) | |
573 (let ((start (point)) | |
574 fill-prefix fill-prefix-regexp) | |
575 ;; Find end of paragraph, and compute the smallest fill-prefix | |
576 ;; that fits all the lines in this paragraph. | |
577 (while (progn | |
578 ;; Update the fill-prefix on the first line | |
579 ;; and whenever the prefix good so far is too long. | |
580 (if (not (and fill-prefix | |
581 (looking-at fill-prefix-regexp))) | |
582 (setq fill-prefix | |
583 (buffer-substring (point) | |
584 (save-excursion (skip-chars-forward " \t") (point))) | |
585 fill-prefix-regexp | |
586 (regexp-quote fill-prefix))) | |
587 (forward-line 1) | |
588 ;; Now stop the loop if end of paragraph. | |
589 (and (not (eobp)) | |
638 | 590 (if fill-individual-varying-indent |
591 ;; If this line is a separator line, with or | |
592 ;; without prefix, end the paragraph. | |
593 (and | |
474 | 594 (not (looking-at paragraph-separate)) |
595 (save-excursion | |
596 (not (and (looking-at fill-prefix-regexp) | |
597 (progn (forward-char (length fill-prefix)) | |
638 | 598 (looking-at paragraph-separate)))))) |
599 ;; If this line has more or less indent | |
600 ;; than the fill prefix wants, end the paragraph. | |
601 (and (looking-at fill-prefix-regexp) | |
602 (save-excursion | |
603 (not (progn (forward-char (length fill-prefix)) | |
604 (or (looking-at paragraph-separate) | |
605 (looking-at paragraph-start)))))))))) | |
474 | 606 ;; Fill this paragraph, but don't add a newline at the end. |
607 (let ((had-newline (bolp))) | |
10468
d0854b6f3216
(set-justification): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10423
diff
changeset
|
608 (fill-region-as-paragraph start (point) justify) |
638 | 609 (or had-newline (delete-char -1)))))))) |
662
8a533acedb77
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
638
diff
changeset
|
610 |
732 | 611 ;;; fill.el ends here |