diff options
| author | Eric S. Raymond | 1993-03-27 01:58:16 +0000 |
|---|---|---|
| committer | Eric S. Raymond | 1993-03-27 01:58:16 +0000 |
| commit | 008d65cfd98013abce58a7250131137a57e326e0 (patch) | |
| tree | a6ef888222ab4f84dab9a924693e72674b559af2 | |
| parent | c9dca4e0924e5469402b183e7f2c79e8ea577268 (diff) | |
| download | emacs-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.el | 64 |
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))) |