Mercurial > emacs
annotate lisp/textmodes/fill.el @ 1241:de92360b091b
(timer-process-sentinel): Don't set timer-scratch.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Mon, 28 Sep 1992 12:41:39 +0000 |
parents | eb89a883529c |
children | 955ebdb98095 |
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 |
846
20674ae6bf52
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
821
diff
changeset
|
3 ;; Copyright (C) 1985, 1986, 1992 Free Software Foundation, Inc. |
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 | |
807
4f28bd14272c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
732
diff
changeset
|
23 ;;; Code: |
75 | 24 |
638 | 25 (defconst fill-individual-varying-indent nil |
26 "*Controls criterion for a new paragraph in `fill-individual-paragraphs'. | |
27 Non-nil means changing indent doesn't end a paragraph. | |
28 That mode can handle paragraphs with extra indentation on the first line, | |
29 but it requires separator lines between paragraphs. | |
30 Nil means that any change in indentation starts a new paragraph.") | |
31 | |
75 | 32 (defun set-fill-prefix () |
33 "Set the fill-prefix to the current line up to point. | |
218 | 34 Filling expects lines to start with the fill prefix and |
35 reinserts the fill prefix in each resulting line." | |
75 | 36 (interactive) |
37 (setq fill-prefix (buffer-substring | |
38 (save-excursion (beginning-of-line) (point)) | |
39 (point))) | |
40 (if (equal fill-prefix "") | |
41 (setq fill-prefix nil)) | |
42 (if fill-prefix | |
43 (message "fill-prefix: \"%s\"" fill-prefix) | |
44 (message "fill-prefix cancelled"))) | |
45 | |
218 | 46 (defconst adaptive-fill-mode t |
47 "*Non-nil means determine a paragraph's fill prefix from its text.") | |
48 | |
49 (defconst adaptive-fill-regexp "[ \t]*\\([>*] +\\)?" | |
50 "*Regexp to match text at start of line that constitutes indentation. | |
51 If Adaptive Fill mode is enabled, whatever text matches this pattern | |
52 on the second line of a paragraph is used as the standard indentation | |
53 for the paragraph.") | |
54 | |
75 | 55 (defun fill-region-as-paragraph (from to &optional justify-flag) |
56 "Fill region as one paragraph: break lines to fit fill-column. | |
57 Prefix arg means justify too. | |
58 From program, pass args FROM, TO and JUSTIFY-FLAG." | |
59 (interactive "r\nP") | |
218 | 60 ;; Don't let Adaptive Fill mode alter the fill prefix permanently. |
61 (let ((fill-prefix fill-prefix)) | |
62 ;; Figure out how this paragraph is indented, if desired. | |
670
bff41708644e
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
662
diff
changeset
|
63 (if (and adaptive-fill-mode |
bff41708644e
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
662
diff
changeset
|
64 (or (null fill-prefix) (string= fill-prefix ""))) |
218 | 65 (save-excursion |
66 (goto-char (min from to)) | |
67 (if (eolp) (forward-line 1)) | |
68 (forward-line 1) | |
69 (if (< (point) (max from to)) | |
70 (let ((start (point))) | |
71 (re-search-forward adaptive-fill-regexp) | |
72 (setq fill-prefix (buffer-substring start (point)))) | |
73 (goto-char (min from to)) | |
74 (if (eolp) (forward-line 1)) | |
75 ;; If paragraph has only one line, don't assume | |
76 ;; that additional lines would have the same starting | |
729
5d684b81ac6b
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
719
diff
changeset
|
77 ;; decoration. Assume no indentation. |
5d684b81ac6b
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
719
diff
changeset
|
78 ;; (re-search-forward adaptive-fill-regexp) |
5d684b81ac6b
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
719
diff
changeset
|
79 ;; (setq fill-prefix (make-string (current-column) ?\ )) |
5d684b81ac6b
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
719
diff
changeset
|
80 ))) |
75 | 81 |
218 | 82 (save-restriction |
83 (narrow-to-region from to) | |
84 (goto-char (point-min)) | |
85 (skip-chars-forward "\n") | |
86 (narrow-to-region (point) (point-max)) | |
87 (setq from (point)) | |
88 (goto-char (point-max)) | |
89 (let ((fpre (and fill-prefix (not (equal fill-prefix "")) | |
90 (regexp-quote fill-prefix)))) | |
91 ;; Delete the fill prefix from every line except the first. | |
92 ;; The first line may not even have a fill prefix. | |
93 (and fpre | |
94 (progn | |
95 (if (>= (length fill-prefix) fill-column) | |
96 (error "fill-prefix too long for specified width")) | |
97 (goto-char (point-min)) | |
98 (forward-line 1) | |
99 (while (not (eobp)) | |
100 (if (looking-at fpre) | |
101 (delete-region (point) (match-end 0))) | |
102 (forward-line 1)) | |
103 (goto-char (point-min)) | |
104 (and (looking-at fpre) (forward-char (length fill-prefix))) | |
105 (setq from (point))))) | |
106 ;; from is now before the text to fill, | |
107 ;; but after any fill prefix on the first line. | |
75 | 108 |
218 | 109 ;; Make sure sentences ending at end of line get an extra space. |
110 ;; loses on split abbrevs ("Mr.\nSmith") | |
111 (goto-char from) | |
670
bff41708644e
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
662
diff
changeset
|
112 (while (re-search-forward "[.?!][])}\"']*$" nil t) |
218 | 113 (insert ? )) |
114 | |
115 ;; Then change all newlines to spaces. | |
116 (subst-char-in-region from (point-max) ?\n ?\ ) | |
75 | 117 |
218 | 118 ;; Flush excess spaces, except in the paragraph indentation. |
119 (goto-char from) | |
120 (skip-chars-forward " \t") | |
121 ;; nuke tabs while we're at it; they get screwed up in a fill | |
122 ;; this is quick, but loses when a sole tab follows the end of a sentence. | |
123 ;; actually, it is difficult to tell that from "Mr.\tSmith". | |
124 ;; blame the typist. | |
125 (subst-char-in-region (point) (point-max) ?\t ?\ ) | |
126 (while (re-search-forward " *" nil t) | |
127 (delete-region | |
128 (+ (match-beginning 0) | |
129 (if (save-excursion | |
670
bff41708644e
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
662
diff
changeset
|
130 (skip-chars-backward " ]})\"'") |
218 | 131 (memq (preceding-char) '(?. ?? ?!))) |
132 2 1)) | |
133 (match-end 0))) | |
134 (goto-char (point-max)) | |
135 (delete-horizontal-space) | |
136 (insert " ") | |
137 (goto-char (point-min)) | |
138 | |
719
3007551721dc
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
670
diff
changeset
|
139 ;; This is the actual filling loop. |
3007551721dc
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
670
diff
changeset
|
140 (let ((prefixcol 0) linebeg) |
218 | 141 (while (not (eobp)) |
719
3007551721dc
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
670
diff
changeset
|
142 (setq linebeg (point)) |
218 | 143 (move-to-column (1+ fill-column)) |
144 (if (eobp) | |
145 nil | |
719
3007551721dc
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
670
diff
changeset
|
146 ;; Move back to start of word. |
3007551721dc
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
670
diff
changeset
|
147 (skip-chars-backward "^ \n" linebeg) |
3007551721dc
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
670
diff
changeset
|
148 ;; Don't break after a period followed by just one space. |
3007551721dc
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
670
diff
changeset
|
149 ;; Move back to the previous place to break. |
3007551721dc
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
670
diff
changeset
|
150 ;; The reason is that if a period ends up at the end of a line, |
3007551721dc
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
670
diff
changeset
|
151 ;; further fills will assume it ends a sentence. |
3007551721dc
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
670
diff
changeset
|
152 ;; If we now know it does not end a sentence, |
3007551721dc
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
670
diff
changeset
|
153 ;; avoid putting it at the end of the line. |
3007551721dc
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
670
diff
changeset
|
154 (while (and (> (point) (+ linebeg 2)) |
3007551721dc
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
670
diff
changeset
|
155 (eq (preceding-char) ?\ ) |
3007551721dc
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
670
diff
changeset
|
156 (eq (char-after (- (point) 2)) ?\.)) |
3007551721dc
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
670
diff
changeset
|
157 (forward-char -2) |
3007551721dc
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
670
diff
changeset
|
158 (skip-chars-backward "^ \n" linebeg)) |
218 | 159 (if (if (zerop prefixcol) (bolp) (>= prefixcol (current-column))) |
719
3007551721dc
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
670
diff
changeset
|
160 ;; Keep at least one word even if fill prefix exceeds margin. |
3007551721dc
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
670
diff
changeset
|
161 ;; This handles all but the first line of the paragraph. |
3007551721dc
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
670
diff
changeset
|
162 (progn |
3007551721dc
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
670
diff
changeset
|
163 (skip-chars-forward " ") |
3007551721dc
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
670
diff
changeset
|
164 (skip-chars-forward "^ \n")) |
3007551721dc
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
670
diff
changeset
|
165 ;; Normally, move back over the single space between the words. |
218 | 166 (forward-char -1))) |
719
3007551721dc
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
670
diff
changeset
|
167 (if (and fill-prefix (zerop prefixcol) |
3007551721dc
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
670
diff
changeset
|
168 (< (- (point) (point-min)) (length fill-prefix)) |
3007551721dc
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
670
diff
changeset
|
169 (string= (buffer-substring (point-min) (point)) |
3007551721dc
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
670
diff
changeset
|
170 (substring fill-prefix 0 (- (point) (point-min))))) |
3007551721dc
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
670
diff
changeset
|
171 ;; Keep at least one word even if fill prefix exceeds margin. |
3007551721dc
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
670
diff
changeset
|
172 ;; This handles the first line of the paragraph. |
3007551721dc
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
670
diff
changeset
|
173 (progn |
3007551721dc
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
670
diff
changeset
|
174 (skip-chars-forward " ") |
3007551721dc
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
670
diff
changeset
|
175 (skip-chars-forward "^ \n"))) |
3007551721dc
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
670
diff
changeset
|
176 ;; Replace all whitespace here with one newline. |
3007551721dc
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
670
diff
changeset
|
177 ;; Insert before deleting, so we don't forget which side of |
3007551721dc
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
670
diff
changeset
|
178 ;; the whitespace point or markers used to be on. |
218 | 179 (skip-chars-backward " ") |
180 (insert ?\n) | |
181 (delete-horizontal-space) | |
719
3007551721dc
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
670
diff
changeset
|
182 ;; Insert the fill prefix at start of each line. |
3007551721dc
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
670
diff
changeset
|
183 ;; Set prefixcol so whitespace in the prefix won't get lost. |
218 | 184 (and (not (eobp)) fill-prefix (not (equal fill-prefix "")) |
185 (progn | |
186 (insert fill-prefix) | |
187 (setq prefixcol (current-column)))) | |
719
3007551721dc
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
670
diff
changeset
|
188 ;; Justify the line just ended, if desired. |
218 | 189 (and justify-flag (not (eobp)) |
190 (progn | |
191 (forward-line -1) | |
192 (justify-current-line) | |
193 (forward-line 1)))))))) | |
75 | 194 |
195 (defun fill-paragraph (arg) | |
218 | 196 "Fill paragraph at or after point. Prefix arg means justify as well." |
75 | 197 (interactive "P") |
198 (save-excursion | |
199 (forward-paragraph) | |
200 (or (bolp) (newline 1)) | |
201 (let ((end (point))) | |
202 (backward-paragraph) | |
203 (fill-region-as-paragraph (point) end arg)))) | |
204 | |
205 (defun fill-region (from to &optional justify-flag) | |
206 "Fill each of the paragraphs in the region. | |
218 | 207 Prefix arg (non-nil third arg, if called from program) means justify as well." |
75 | 208 (interactive "r\nP") |
209 (save-restriction | |
210 (narrow-to-region from to) | |
211 (goto-char (point-min)) | |
212 (while (not (eobp)) | |
213 (let ((initial (point)) | |
214 (end (progn | |
215 (forward-paragraph 1) (point)))) | |
216 (forward-paragraph -1) | |
217 (if (>= (point) initial) | |
218 (fill-region-as-paragraph (point) end justify-flag) | |
219 (goto-char end)))))) | |
220 | |
221 (defun justify-current-line () | |
218 | 222 "Add spaces to line point is in, so it ends at `fill-column'." |
75 | 223 (interactive) |
224 (save-excursion | |
225 (save-restriction | |
218 | 226 (let (ncols beg indent) |
75 | 227 (beginning-of-line) |
228 (forward-char (length fill-prefix)) | |
229 (skip-chars-forward " \t") | |
218 | 230 (setq indent (current-column)) |
75 | 231 (setq beg (point)) |
232 (end-of-line) | |
233 (narrow-to-region beg (point)) | |
234 (goto-char beg) | |
235 (while (re-search-forward " *" nil t) | |
236 (delete-region | |
237 (+ (match-beginning 0) | |
238 (if (save-excursion | |
239 (skip-chars-backward " ])\"'") | |
240 (memq (preceding-char) '(?. ?? ?!))) | |
241 2 1)) | |
242 (match-end 0))) | |
243 (goto-char beg) | |
1067 | 244 (while (re-search-forward "[.?!][])\"']*\n" nil t) |
75 | 245 (forward-char -1) |
246 (insert ? )) | |
247 (goto-char (point-max)) | |
218 | 248 ;; Note that the buffer bounds start after the indentation, |
249 ;; so the columns counted by INDENT don't appear in (current-column). | |
250 (setq ncols (- fill-column (current-column) indent)) | |
75 | 251 (if (search-backward " " nil t) |
252 (while (> ncols 0) | |
253 (let ((nmove (+ 3 (random 3)))) | |
254 (while (> nmove 0) | |
255 (or (search-backward " " nil t) | |
256 (progn | |
257 (goto-char (point-max)) | |
258 (search-backward " "))) | |
259 (skip-chars-backward " ") | |
260 (setq nmove (1- nmove)))) | |
261 (insert " ") | |
262 (skip-chars-backward " ") | |
263 (setq ncols (1- ncols)))))))) | |
264 | |
265 (defun fill-individual-paragraphs (min max &optional justifyp mailp) | |
266 "Fill each paragraph in region according to its individual fill prefix. | |
638 | 267 |
268 If `fill-individual-varying-indent' is non-nil, | |
269 then a mere change in indentation does not end a paragraph. In this mode, | |
270 the indentation for a paragraph is the minimum indentation of any line in it. | |
271 | |
272 When calling from a program, pass range to fill as first two arguments. | |
273 | |
75 | 274 Optional third and fourth arguments JUSTIFY-FLAG and MAIL-FLAG: |
275 JUSTIFY-FLAG to justify paragraphs (prefix arg), | |
276 MAIL-FLAG for a mail message, i. e. don't fill header lines." | |
277 (interactive "r\nP") | |
474 | 278 (save-restriction |
279 (save-excursion | |
280 (goto-char min) | |
281 (beginning-of-line) | |
282 (if mailp | |
821
cee415e2dae8
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
811
diff
changeset
|
283 (while (or (looking-at "[ \t]*[^ \t\n]*:") (looking-at "[ \t]*$")) |
474 | 284 (forward-line 1))) |
285 (narrow-to-region (point) max) | |
286 ;; Loop over paragraphs. | |
287 (while (progn (skip-chars-forward " \t\n") (not (eobp))) | |
288 (beginning-of-line) | |
289 (let ((start (point)) | |
290 fill-prefix fill-prefix-regexp) | |
291 ;; Find end of paragraph, and compute the smallest fill-prefix | |
292 ;; that fits all the lines in this paragraph. | |
293 (while (progn | |
294 ;; Update the fill-prefix on the first line | |
295 ;; and whenever the prefix good so far is too long. | |
296 (if (not (and fill-prefix | |
297 (looking-at fill-prefix-regexp))) | |
298 (setq fill-prefix | |
299 (buffer-substring (point) | |
300 (save-excursion (skip-chars-forward " \t") (point))) | |
301 fill-prefix-regexp | |
302 (regexp-quote fill-prefix))) | |
303 (forward-line 1) | |
304 ;; Now stop the loop if end of paragraph. | |
305 (and (not (eobp)) | |
638 | 306 (if fill-individual-varying-indent |
307 ;; If this line is a separator line, with or | |
308 ;; without prefix, end the paragraph. | |
309 (and | |
474 | 310 (not (looking-at paragraph-separate)) |
311 (save-excursion | |
312 (not (and (looking-at fill-prefix-regexp) | |
313 (progn (forward-char (length fill-prefix)) | |
638 | 314 (looking-at paragraph-separate)))))) |
315 ;; If this line has more or less indent | |
316 ;; than the fill prefix wants, end the paragraph. | |
317 (and (looking-at fill-prefix-regexp) | |
318 (save-excursion | |
319 (not (progn (forward-char (length fill-prefix)) | |
320 (or (looking-at paragraph-separate) | |
321 (looking-at paragraph-start)))))))))) | |
474 | 322 ;; Fill this paragraph, but don't add a newline at the end. |
323 (let ((had-newline (bolp))) | |
324 (fill-region-as-paragraph start (point) justifyp) | |
638 | 325 (or had-newline (delete-char -1)))))))) |
662
8a533acedb77
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
638
diff
changeset
|
326 |
732 | 327 ;;; fill.el ends here |