Mercurial > emacs
comparison lisp/textmodes/fill.el @ 75:a13ef7914930
Initial revision
author | root <root> |
---|---|
date | Fri, 27 Jul 1990 04:20:16 +0000 |
parents | |
children | d492f16a8743 |
comparison
equal
deleted
inserted
replaced
74:2c14d4cb1256 | 75:a13ef7914930 |
---|---|
1 ;; Fill commands for Emacs | |
2 ;; Copyright (C) 1985, 1986 Free Software Foundation, Inc. | |
3 | |
4 ;; This file is part of GNU Emacs. | |
5 | |
6 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
7 ;; it under the terms of the GNU General Public License as published by | |
8 ;; the Free Software Foundation; either version 1, or (at your option) | |
9 ;; any later version. | |
10 | |
11 ;; GNU Emacs is distributed in the hope that it will be useful, | |
12 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
13 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
14 ;; GNU General Public License for more details. | |
15 | |
16 ;; You should have received a copy of the GNU General Public License | |
17 ;; along with GNU Emacs; see the file COPYING. If not, write to | |
18 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. | |
19 | |
20 | |
21 (defun set-fill-prefix () | |
22 "Set the fill-prefix to the current line up to point. | |
23 Filling expects lines to start with the fill prefix | |
24 and reinserts the fill prefix in each resulting line." | |
25 (interactive) | |
26 (setq fill-prefix (buffer-substring | |
27 (save-excursion (beginning-of-line) (point)) | |
28 (point))) | |
29 (if (equal fill-prefix "") | |
30 (setq fill-prefix nil)) | |
31 (if fill-prefix | |
32 (message "fill-prefix: \"%s\"" fill-prefix) | |
33 (message "fill-prefix cancelled"))) | |
34 | |
35 (defun fill-region-as-paragraph (from to &optional justify-flag) | |
36 "Fill region as one paragraph: break lines to fit fill-column. | |
37 Prefix arg means justify too. | |
38 From program, pass args FROM, TO and JUSTIFY-FLAG." | |
39 (interactive "r\nP") | |
40 (save-restriction | |
41 (narrow-to-region from to) | |
42 (goto-char (point-min)) | |
43 (skip-chars-forward "\n") | |
44 (narrow-to-region (point) (point-max)) | |
45 (setq from (point)) | |
46 (goto-char (point-max)) | |
47 (let ((fpre (and fill-prefix (not (equal fill-prefix "")) | |
48 (regexp-quote fill-prefix)))) | |
49 ;; Delete the fill prefix from every line except the first. | |
50 ;; The first line may not even have a fill prefix. | |
51 (and fpre | |
52 (progn | |
53 (if (>= (length fill-prefix) fill-column) | |
54 (error "fill-prefix too long for specified width")) | |
55 (goto-char (point-min)) | |
56 (forward-line 1) | |
57 (while (not (eobp)) | |
58 (if (looking-at fpre) | |
59 (delete-region (point) (match-end 0))) | |
60 (forward-line 1)) | |
61 (goto-char (point-min)) | |
62 (and (looking-at fpre) (forward-char (length fill-prefix))) | |
63 (setq from (point))))) | |
64 ;; from is now before the text to fill, | |
65 ;; but after any fill prefix on the first line. | |
66 | |
67 ;; Make sure sentences ending at end of line get an extra space. | |
68 ;; loses on split abbrevs ("Mr.\nSmith") | |
69 (goto-char from) | |
70 (while (re-search-forward "[.?!][])\"']*$" nil t) | |
71 (insert ? )) | |
72 | |
73 ;; Then change all newlines to spaces. | |
74 (subst-char-in-region from (point-max) ?\n ?\ ) | |
75 | |
76 ;; Flush excess spaces, except in the paragraph indentation. | |
77 (goto-char from) | |
78 (skip-chars-forward " \t") | |
79 ;; nuke tabs while we're at it; they get screwed up in a fill | |
80 ;; this is quick, but loses when a sole tab follows the end of a sentence. | |
81 ;; actually, it is difficult to tell that from "Mr.\tSmith". | |
82 ;; blame the typist. | |
83 (subst-char-in-region (point) (point-max) ?\t ?\ ) | |
84 (while (re-search-forward " *" nil t) | |
85 (delete-region | |
86 (+ (match-beginning 0) | |
87 (if (save-excursion | |
88 (skip-chars-backward " ])\"'") | |
89 (memq (preceding-char) '(?. ?? ?!))) | |
90 2 1)) | |
91 (match-end 0))) | |
92 (goto-char (point-max)) | |
93 (delete-horizontal-space) | |
94 (insert " ") | |
95 (goto-char (point-min)) | |
96 | |
97 (let ((prefixcol 0)) | |
98 (while (not (eobp)) | |
99 (move-to-column (1+ fill-column)) | |
100 (if (eobp) | |
101 nil | |
102 (skip-chars-backward "^ \n") | |
103 (if (if (zerop prefixcol) (bolp) (>= prefixcol (current-column))) | |
104 (skip-chars-forward "^ \n") | |
105 (forward-char -1))) | |
106 ;; Inserting the newline first prevents losing track of point. | |
107 (skip-chars-backward " ") | |
108 (insert ?\n) | |
109 (delete-horizontal-space) | |
110 (and (not (eobp)) fill-prefix (not (equal fill-prefix "")) | |
111 (progn | |
112 (insert fill-prefix) | |
113 (setq prefixcol (current-column)))) | |
114 (and justify-flag (not (eobp)) | |
115 (progn | |
116 (forward-line -1) | |
117 (justify-current-line) | |
118 (forward-line 1))))))) | |
119 | |
120 (defun fill-paragraph (arg) | |
121 "Fill paragraph at or after point. | |
122 Prefix arg means justify as well." | |
123 (interactive "P") | |
124 (save-excursion | |
125 (forward-paragraph) | |
126 (or (bolp) (newline 1)) | |
127 (let ((end (point))) | |
128 (backward-paragraph) | |
129 (fill-region-as-paragraph (point) end arg)))) | |
130 | |
131 (defun fill-region (from to &optional justify-flag) | |
132 "Fill each of the paragraphs in the region. | |
133 Prefix arg (non-nil third arg, if called from program) | |
134 means justify as well." | |
135 (interactive "r\nP") | |
136 (save-restriction | |
137 (narrow-to-region from to) | |
138 (goto-char (point-min)) | |
139 (while (not (eobp)) | |
140 (let ((initial (point)) | |
141 (end (progn | |
142 (forward-paragraph 1) (point)))) | |
143 (forward-paragraph -1) | |
144 (if (>= (point) initial) | |
145 (fill-region-as-paragraph (point) end justify-flag) | |
146 (goto-char end)))))) | |
147 | |
148 (defun justify-current-line () | |
149 "Add spaces to line point is in, so it ends at fill-column." | |
150 (interactive) | |
151 (save-excursion | |
152 (save-restriction | |
153 (let (ncols beg) | |
154 (beginning-of-line) | |
155 (forward-char (length fill-prefix)) | |
156 (skip-chars-forward " \t") | |
157 (setq beg (point)) | |
158 (end-of-line) | |
159 (narrow-to-region beg (point)) | |
160 (goto-char beg) | |
161 (while (re-search-forward " *" nil t) | |
162 (delete-region | |
163 (+ (match-beginning 0) | |
164 (if (save-excursion | |
165 (skip-chars-backward " ])\"'") | |
166 (memq (preceding-char) '(?. ?? ?!))) | |
167 2 1)) | |
168 (match-end 0))) | |
169 (goto-char beg) | |
170 (while (re-search-forward "[.?!][])""']*\n" nil t) | |
171 (forward-char -1) | |
172 (insert ? )) | |
173 (goto-char (point-max)) | |
174 (setq ncols (- fill-column (current-column))) | |
175 (if (search-backward " " nil t) | |
176 (while (> ncols 0) | |
177 (let ((nmove (+ 3 (random 3)))) | |
178 (while (> nmove 0) | |
179 (or (search-backward " " nil t) | |
180 (progn | |
181 (goto-char (point-max)) | |
182 (search-backward " "))) | |
183 (skip-chars-backward " ") | |
184 (setq nmove (1- nmove)))) | |
185 (insert " ") | |
186 (skip-chars-backward " ") | |
187 (setq ncols (1- ncols)))))))) | |
188 | |
189 (defun fill-individual-paragraphs (min max &optional justifyp mailp) | |
190 "Fill each paragraph in region according to its individual fill prefix. | |
191 Calling from a program, pass range to fill as first two arguments. | |
192 Optional third and fourth arguments JUSTIFY-FLAG and MAIL-FLAG: | |
193 JUSTIFY-FLAG to justify paragraphs (prefix arg), | |
194 MAIL-FLAG for a mail message, i. e. don't fill header lines." | |
195 (interactive "r\nP") | |
196 (let (fill-prefix) | |
197 (save-restriction | |
198 (save-excursion | |
199 (narrow-to-region min max) | |
200 (goto-char (point-min)) | |
201 (while (progn | |
202 (skip-chars-forward " \t\n") | |
203 (not (eobp))) | |
204 (setq fill-prefix (buffer-substring (point) (progn (beginning-of-line) (point)))) | |
205 (let ((fin (save-excursion (forward-paragraph) (point))) | |
206 (start (point))) | |
207 (if mailp | |
208 (while (re-search-forward "^[ \t]*[^ \t\n]*:" fin t) | |
209 (forward-line 1))) | |
210 (cond ((= start (point)) | |
211 (fill-region-as-paragraph (point) fin justifyp) | |
212 (goto-char fin))))))))) | |
213 |