aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorEric S. Raymond1993-03-27 01:58:16 +0000
committerEric S. Raymond1993-03-27 01:58:16 +0000
commit008d65cfd98013abce58a7250131137a57e326e0 (patch)
treea6ef888222ab4f84dab9a924693e72674b559af2
parentc9dca4e0924e5469402b183e7f2c79e8ea577268 (diff)
downloademacs-008d65cfd98013abce58a7250131137a57e326e0.tar.gz
emacs-008d65cfd98013abce58a7250131137a57e326e0.zip
(fill-paragraph, justify-current-line) Now uses the skip-syntax-
forward and backward characters and char-syntax to be smart about filling syntaxes other than text. This change was inspired by Richard Caley's fill-para package from LCD, but the implementation is original.
-rw-r--r--lisp/textmodes/fill.el64
1 files changed, 39 insertions, 25 deletions
diff --git a/lisp/textmodes/fill.el b/lisp/textmodes/fill.el
index a905bef78d1..f1669d7b049 100644
--- a/lisp/textmodes/fill.el
+++ b/lisp/textmodes/fill.el
@@ -66,7 +66,7 @@ From program, pass args FROM, TO and JUSTIFY-FLAG."
66 (if (and buffer-undo-list (not (eq buffer-undo-list t))) 66 (if (and buffer-undo-list (not (eq buffer-undo-list t)))
67 (setq buffer-undo-list (cons (point) buffer-undo-list))) 67 (setq buffer-undo-list (cons (point) buffer-undo-list)))
68 ;; Don't let Adaptive Fill mode alter the fill prefix permanently. 68 ;; Don't let Adaptive Fill mode alter the fill prefix permanently.
69 (let ((fill-prefix fill-prefix)) 69 (let ((fill-prefix fill-prefix) spc)
70 ;; Figure out how this paragraph is indented, if desired. 70 ;; Figure out how this paragraph is indented, if desired.
71 (if (and adaptive-fill-mode 71 (if (and adaptive-fill-mode
72 (or (null fill-prefix) (string= fill-prefix ""))) 72 (or (null fill-prefix) (string= fill-prefix "")))
@@ -114,34 +114,48 @@ From program, pass args FROM, TO and JUSTIFY-FLAG."
114 ;; from is now before the text to fill, 114 ;; from is now before the text to fill,
115 ;; but after any fill prefix on the first line. 115 ;; but after any fill prefix on the first line.
116 116
117 ;; spc (our filler character) is normally SPC;
118 ;; if SPC does not have syntax class whitespace, find a filler that does.
119 (if (= (char-syntax ?\ ) ?\ )
120 (setq spc ?\ )
121 (setq spc 0)
122 (while (not (= (char-syntax spc) ?\ ))
123 (setq spc (1+ spc))))
124
117 ;; Make sure sentences ending at end of line get an extra space. 125 ;; Make sure sentences ending at end of line get an extra space.
118 ;; loses on split abbrevs ("Mr.\nSmith") 126 ;; loses on split abbrevs ("Mr.\nSmith"). This is fairly specific
127 ;; to text mode.
119 (goto-char from) 128 (goto-char from)
120 (while (re-search-forward "[.?!][])}\"']*$" nil t) 129 (while (re-search-forward "[.?!][])}\"']*$" nil t)
121 (insert ? )) 130 (insert spc))
122 131
123 ;; Then change all newlines to spaces. 132 ;; Then change all newlines to spaces.
124 (subst-char-in-region from (point-max) ?\n ?\ ) 133 (subst-char-in-region from to ?\n spc)
125 134
126 ;; Flush excess spaces, except in the paragraph indentation. 135 ;; Go to beginning of paragraph (after indent)
127 (goto-char from) 136 (goto-char from)
128 (skip-chars-forward " \t") 137 (skip-syntax-forward " ")
129 ;; nuke tabs while we're at it; they get screwed up in a fill 138
130 ;; this is quick, but loses when a sole tab follows the end of a sentence. 139 ;; If tabs have whitespace class, nuke them; they get screwed up
131 ;; actually, it is difficult to tell that from "Mr.\tSmith". 140 ;; in a fill. This is quick, but loses when a sole tab follows
132 ;; blame the typist. 141 ;; the end of a sentence. actually, it is difficult to tell
133 (subst-char-in-region (point) (point-max) ?\t ?\ ) 142 ;; that from "Mr.\tSmith". Blame the typist.
134 (while (re-search-forward " *" nil t) 143 (if (= (char-syntax ?\t) ?\ )
144 (subst-char-in-region (point) to ?\t spc))
145
146 ;; Flush excess whitespace, except in the paragraph indentation.
147 (while (re-search-forward "\\s-\\s-\\s-*" nil t)
135 (delete-region 148 (delete-region
136 (+ (match-beginning 0) 149 (+ (match-beginning 0)
137 (if (save-excursion 150 (if (save-excursion
138 (skip-chars-backward " ]})\"'") 151 (skip-syntax-backward " ).")
139 (memq (preceding-char) '(?. ?? ?!))) 152 (memq (preceding-char) '(?. ?? ?!)))
140 2 1)) 153 2 1))
141 (match-end 0))) 154 (match-end 0)))
142 (goto-char (point-max)) 155 (goto-char (point-max))
143 (delete-horizontal-space) 156 (delete-horizontal-space)
144 (insert " ") 157 (insert spc)
158 (insert spc)
145 (goto-char (point-min)) 159 (goto-char (point-min))
146 160
147 ;; This is the actual filling loop. 161 ;; This is the actual filling loop.
@@ -152,7 +166,7 @@ From program, pass args FROM, TO and JUSTIFY-FLAG."
152 (if (eobp) 166 (if (eobp)
153 nil 167 nil
154 ;; Move back to start of word. 168 ;; Move back to start of word.
155 (skip-chars-backward "^ \n" linebeg) 169 (skip-syntax-backward "^ " linebeg)
156 ;; Don't break after a period followed by just one space. 170 ;; Don't break after a period followed by just one space.
157 ;; Move back to the previous place to break. 171 ;; Move back to the previous place to break.
158 ;; The reason is that if a period ends up at the end of a line, 172 ;; The reason is that if a period ends up at the end of a line,
@@ -160,16 +174,16 @@ From program, pass args FROM, TO and JUSTIFY-FLAG."
160 ;; If we now know it does not end a sentence, 174 ;; If we now know it does not end a sentence,
161 ;; avoid putting it at the end of the line. 175 ;; avoid putting it at the end of the line.
162 (while (and (> (point) (+ linebeg 2)) 176 (while (and (> (point) (+ linebeg 2))
163 (eq (preceding-char) ?\ ) 177 (eq (char-syntax (preceding-char)) ?\ )
164 (eq (char-after (- (point) 2)) ?\.)) 178 (eq (char-after (- (point) 2)) ?\.))
165 (forward-char -2) 179 (forward-char -2)
166 (skip-chars-backward "^ \n" linebeg)) 180 (skip-syntax-backward "^ " linebeg))
167 (if (if (zerop prefixcol) (bolp) (>= prefixcol (current-column))) 181 (if (if (zerop prefixcol) (bolp) (>= prefixcol (current-column)))
168 ;; Keep at least one word even if fill prefix exceeds margin. 182 ;; Keep at least one word even if fill prefix exceeds margin.
169 ;; This handles all but the first line of the paragraph. 183 ;; This handles all but the first line of the paragraph.
170 (progn 184 (progn
171 (skip-chars-forward " ") 185 (skip-syntax-forward " ")
172 (skip-chars-forward "^ \n")) 186 (skip-syntax-forward "^ "))
173 ;; Normally, move back over the single space between the words. 187 ;; Normally, move back over the single space between the words.
174 (forward-char -1))) 188 (forward-char -1)))
175 (if (and fill-prefix (zerop prefixcol) 189 (if (and fill-prefix (zerop prefixcol)
@@ -179,12 +193,12 @@ From program, pass args FROM, TO and JUSTIFY-FLAG."
179 ;; Keep at least one word even if fill prefix exceeds margin. 193 ;; Keep at least one word even if fill prefix exceeds margin.
180 ;; This handles the first line of the paragraph. 194 ;; This handles the first line of the paragraph.
181 (progn 195 (progn
182 (skip-chars-forward " ") 196 (skip-syntax-forward " ")
183 (skip-chars-forward "^ \n"))) 197 (skip-syntax-forward "^ ")))
184 ;; Replace all whitespace here with one newline. 198 ;; Replace all whitespace here with one newline.
185 ;; Insert before deleting, so we don't forget which side of 199 ;; Insert before deleting, so we don't forget which side of
186 ;; the whitespace point or markers used to be on. 200 ;; the whitespace point or markers used to be on.
187 (skip-chars-backward " ") 201 (skip-syntax-backward " ")
188 (insert ?\n) 202 (insert ?\n)
189 (delete-horizontal-space) 203 (delete-horizontal-space)
190 ;; Insert the fill prefix at start of each line. 204 ;; Insert the fill prefix at start of each line.
@@ -236,17 +250,17 @@ Prefix arg (non-nil third arg, if called from program) means justify as well."
236 (let (ncols beg indent) 250 (let (ncols beg indent)
237 (beginning-of-line) 251 (beginning-of-line)
238 (forward-char (length fill-prefix)) 252 (forward-char (length fill-prefix))
239 (skip-chars-forward " \t") 253 (skip-syntax-forward " " (save-excursion (end-of-line) (point)))
240 (setq indent (current-column)) 254 (setq indent (current-column))
241 (setq beg (point)) 255 (setq beg (point))
242 (end-of-line) 256 (end-of-line)
243 (narrow-to-region beg (point)) 257 (narrow-to-region beg (point))
244 (goto-char beg) 258 (goto-char beg)
245 (while (re-search-forward " *" nil t) 259 (while (re-search-forward "\\s-\\s-\\s-*" nil t)
246 (delete-region 260 (delete-region
247 (+ (match-beginning 0) 261 (+ (match-beginning 0)
248 (if (save-excursion 262 (if (save-excursion
249 (skip-chars-backward " ])\"'") 263 (skip-syntax-backward " ).")
250 (memq (preceding-char) '(?. ?? ?!))) 264 (memq (preceding-char) '(?. ?? ?!)))
251 2 1)) 265 2 1))
252 (match-end 0))) 266 (match-end 0)))