Mercurial > emacs
comparison lisp/textmodes/refill.el @ 88155:d7ddb3e565de
sync with trunk
author | Henrik Enberg <henrik.enberg@telia.com> |
---|---|
date | Mon, 16 Jan 2006 00:03:54 +0000 |
parents | 5ade352e8d1c |
children |
comparison
equal
deleted
inserted
replaced
88154:8ce476d3ba36 | 88155:d7ddb3e565de |
---|---|
1 ;;; refill.el --- `auto-fill' by refilling paragraphs on changes | 1 ;;; refill.el --- `auto-fill' by refilling paragraphs on changes |
2 | 2 |
3 ;; Copyright (C) 2000 Free Software Foundation, Inc. | 3 ;; Copyright (C) 2000, 2002, 2003, 2004, 2005 Free Software Foundation, Inc. |
4 | 4 |
5 ;; Author: Dave Love <fx@gnu.org> | 5 ;; Author: Dave Love <fx@gnu.org> |
6 ;; Maintainer: Miles Bader <miles@gnu.org> | |
6 ;; Keywords: wp | 7 ;; Keywords: wp |
7 | 8 |
8 ;; This file is part of GNU Emacs. | 9 ;; This file is part of GNU Emacs. |
9 | 10 |
10 ;; GNU Emacs is free software; you can redistribute it and/or modify | 11 ;; GNU Emacs is free software; you can redistribute it and/or modify |
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | 18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
18 ;; GNU General Public License for more details. | 19 ;; GNU General Public License for more details. |
19 | 20 |
20 ;; You should have received a copy of the GNU General Public License | 21 ;; You should have received a copy of the GNU General Public License |
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the | 22 ;; along with GNU Emacs; see the file COPYING. If not, write to the |
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | 23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
23 ;; Boston, MA 02111-1307, USA. | 24 ;; Boston, MA 02110-1301, USA. |
24 | 25 |
25 ;;; Commentary: | 26 ;;; Commentary: |
26 | 27 |
27 ;; Provides a mode where paragraphs are refilled after changes in them | 28 ;; Provides a mode where paragraphs are refilled after changes in them |
28 ;; (using `after-change-functions'). This gives something akin to typical | 29 ;; (using `after-change-functions'). This gives something akin to typical |
81 ;; Foo bar blablabla asdgf | 82 ;; Foo bar blablabla asdgf |
82 ;; ><asdfas dfasdfasd asd | 83 ;; ><asdfas dfasdfasd asd |
83 ;; asdfa sdfasd sdf | 84 ;; asdfa sdfasd sdf |
84 | 85 |
85 ;;; Code: | 86 ;;; Code: |
87 | |
88 (eval-when-compile (require 'cl)) | |
86 | 89 |
87 (defgroup refill nil | 90 (defgroup refill nil |
88 "Refilling paragraphs on changes." | 91 "Refilling paragraphs on changes." |
89 :group 'fill) | 92 :group 'fill) |
90 | 93 |
99 (save-excursion | 102 (save-excursion |
100 (goto-char beg) | 103 (goto-char beg) |
101 (forward-line -1) | 104 (forward-line -1) |
102 (if (<= (point) (overlay-start overlay)) | 105 (if (<= (point) (overlay-start overlay)) |
103 ;; Just get OVERLAY out of the way | 106 ;; Just get OVERLAY out of the way |
104 (move-overlay overlay 1 1) | 107 (move-overlay overlay (point-min) (point-min)) |
105 ;; Make overlay contain only the region | 108 ;; Make overlay contain only the region |
106 (move-overlay overlay (overlay-start overlay) (point)))))) | 109 (move-overlay overlay (overlay-start overlay) (point)))))) |
107 | 110 |
108 (defun refill-fill-paragraph-at (pos &optional arg) | 111 (defun refill-fill-paragraph-at (pos &optional arg) |
109 "Like `fill-paragraph' at POS, but don't delete whitespace at paragraph end." | 112 "Like `fill-paragraph' at POS, but don't delete whitespace at paragraph end." |
110 (let (fill-pfx) | 113 (save-excursion |
111 (save-excursion | 114 (goto-char pos) |
112 (goto-char pos) | 115 ;; FIXME: forward-paragraph seems to disregard `use-hard-newlines', |
113 ;; FIXME: forward-paragraph seems to disregard `use-hard-newlines', | 116 ;; leading to excessive refilling and wrong choice of fill-prefix. |
114 ;; leading to excessive refilling and wrong choice of fill-prefix. | 117 ;; might be a bug in my paragraphs.el. |
115 ;; might be a bug in my paragraphs.el. | 118 (forward-paragraph) |
116 (forward-paragraph) | 119 (skip-syntax-backward "-") |
117 (skip-syntax-backward "-") | 120 (let ((end (point)) |
118 (let ((end (point)) | 121 (beg (progn (backward-paragraph) (point))) |
119 (beg (progn (backward-paragraph) (point))) | 122 (obeg (overlay-start refill-ignorable-overlay)) |
120 (obeg (overlay-start refill-ignorable-overlay)) | 123 (oend (overlay-end refill-ignorable-overlay))) |
121 (oend (overlay-end refill-ignorable-overlay))) | 124 (unless (> beg pos) ;Don't fill if point is outside the paragraph. |
122 (goto-char pos) | 125 (goto-char pos) |
123 (if (and (>= beg obeg) (< beg oend)) | 126 (if (and (>= beg obeg) (< beg oend)) |
124 ;; Limit filling to the modified tail of the paragraph. | 127 ;; Limit filling to the modified tail of the paragraph. |
125 (let (;; When adaptive-fill-mode is enabled, the filling | 128 (let ( ;; When adaptive-fill-mode is enabled, the filling |
126 ;; functions will attempt to set the fill prefix from | 129 ;; functions will attempt to set the fill prefix from |
127 ;; the fake paragraph bounds we pass in, so set it | 130 ;; the fake paragraph bounds we pass in, so set it |
128 ;; ourselves first, using the real paragraph bounds. | 131 ;; ourselves first, using the real paragraph bounds. |
129 (fill-prefix | 132 (fill-prefix |
130 (if (and adaptive-fill-mode | 133 (if (and adaptive-fill-mode |
135 (adaptive-fill-mode nil)) | 138 (adaptive-fill-mode nil)) |
136 (save-restriction | 139 (save-restriction |
137 (if use-hard-newlines | 140 (if use-hard-newlines |
138 (fill-region oend end arg) | 141 (fill-region oend end arg) |
139 (fill-region-as-paragraph oend end arg))) | 142 (fill-region-as-paragraph oend end arg))) |
140 (setq fill-pfx fill-prefix) | |
141 (move-overlay refill-ignorable-overlay obeg (point))) | 143 (move-overlay refill-ignorable-overlay obeg (point))) |
142 ;; Fill the whole paragraph | 144 ;; Fill the whole paragraph |
143 (setq fill-pfx | 145 (save-restriction |
144 (save-restriction | 146 (if use-hard-newlines |
145 (if use-hard-newlines | 147 (fill-region beg end arg) |
146 (fill-region beg end arg) | 148 (fill-region-as-paragraph beg end arg))) |
147 (fill-region-as-paragraph beg end arg)))) | 149 (move-overlay refill-ignorable-overlay beg (point))))))) |
148 (move-overlay refill-ignorable-overlay beg (point))))) | |
149 (skip-line-prefix fill-pfx))) | |
150 | 150 |
151 (defun refill-fill-paragraph (arg) | 151 (defun refill-fill-paragraph (arg) |
152 "Like `fill-paragraph' but don't delete whitespace at paragraph end." | 152 "Like `fill-paragraph' but don't delete whitespace at paragraph end." |
153 (refill-fill-paragraph-at (point) arg)) | 153 (refill-fill-paragraph-at (point) arg)) |
154 | 154 |
155 (defvar refill-doit nil | 155 (defvar refill-doit nil |
156 "Non-nil means that `refill-post-command-function' does its processing. | 156 "Non-nil tells `refill-post-command-function' to do its processing. |
157 Set by `refill-after-change-function' in `after-change-functions' and | 157 Set by `refill-after-change-function' in `after-change-functions' and |
158 unset by `refill-post-command-function' in `post-command-hook', and | 158 unset by `refill-post-command-function' in `post-command-hook', and |
159 sometimes `refill-pre-command-function' in `pre-command-hook'. This | 159 sometimes `refill-pre-command-function' in `pre-command-hook'. This |
160 ensures refilling is only done once per command that causes a change, | 160 ensures refilling is only done once per command that causes a change, |
161 regardless of the number of after-change calls from commands doing | 161 regardless of the number of after-change calls from commands doing |
169 | 169 |
170 (defun refill-post-command-function () | 170 (defun refill-post-command-function () |
171 "Post-command function to do refilling (conditionally)." | 171 "Post-command function to do refilling (conditionally)." |
172 (when refill-doit ; there was a change | 172 (when refill-doit ; there was a change |
173 ;; There's probably scope for more special cases here... | 173 ;; There's probably scope for more special cases here... |
174 (if (eq this-command 'self-insert-command) | 174 (case this-command |
175 ;; Treat self-insertion commands specially, since they don't | 175 (self-insert-command |
176 ;; always reset `refill-doit' -- for self-insertion commands that | 176 ;; Treat self-insertion commands specially, since they don't |
177 ;; *don't* cause a refill, we want to leave it turned on so that | 177 ;; always reset `refill-doit' -- for self-insertion commands that |
178 ;; any subsequent non-modification command will cause a refill. | 178 ;; *don't* cause a refill, we want to leave it turned on so that |
179 (when (aref auto-fill-chars (char-before)) | 179 ;; any subsequent non-modification command will cause a refill. |
180 ;; Respond to the same characters as auto-fill (other than | 180 (when (aref auto-fill-chars (char-before)) |
181 ;; newline, covered below). | 181 ;; Respond to the same characters as auto-fill (other than |
182 (refill-fill-paragraph-at refill-doit) | 182 ;; newline, covered below). |
183 (setq refill-doit nil)) | 183 (refill-fill-paragraph-at refill-doit) |
184 (cond | 184 (setq refill-doit nil))) |
185 ((or (eq this-command 'quoted-insert) | 185 ((quoted-insert fill-paragraph fill-region) nil) |
186 (eq this-command 'fill-paragraph) | 186 ((newline newline-and-indent open-line indent-new-comment-line |
187 (eq this-command 'fill-region)) | 187 reindent-then-newline-and-indent) |
188 nil) | 188 ;; Don't zap what was just inserted. |
189 ((or (eq this-command 'newline) | 189 (save-excursion |
190 (eq this-command 'newline-and-indent) | 190 (beginning-of-line) ; for newline-and-indent |
191 (eq this-command 'open-line)) | 191 (skip-chars-backward "\n") |
192 ;; Don't zap what was just inserted. | 192 (save-restriction |
193 (save-excursion | 193 (narrow-to-region (point-min) (point)) |
194 (beginning-of-line) ; for newline-and-indent | 194 (refill-fill-paragraph-at refill-doit))) |
195 (skip-chars-backward "\n") | 195 (widen) |
196 (save-restriction | 196 (save-excursion |
197 (narrow-to-region (point-min) (point)) | 197 (skip-chars-forward "\n") |
198 (refill-fill-paragraph-at refill-doit))) | 198 (save-restriction |
199 (widen) | 199 (narrow-to-region (line-beginning-position) (point-max)) |
200 (save-excursion | 200 (refill-fill-paragraph-at refill-doit)))) |
201 (skip-chars-forward "\n") | 201 (t |
202 (save-restriction | 202 (refill-fill-paragraph-at refill-doit))) |
203 (narrow-to-region (line-beginning-position) (point-max)) | 203 (setq refill-doit nil))) |
204 (refill-fill-paragraph-at refill-doit)))) | |
205 (t | |
206 (refill-fill-paragraph-at refill-doit))) | |
207 (setq refill-doit nil)))) | |
208 | 204 |
209 (defun refill-pre-command-function () | 205 (defun refill-pre-command-function () |
210 "Pre-command function to do refilling (conditionally)." | 206 "Pre-command function to do refilling (conditionally)." |
211 (when (and refill-doit (not (eq this-command 'self-insert-command))) | 207 (when (and refill-doit (not (eq this-command 'self-insert-command))) |
212 ;; A previous setting of `refill-doit' didn't result in a refill, | 208 ;; A previous setting of `refill-doit' didn't result in a refill, |
213 ;; because it was a self-insert-command. Since the next command is | 209 ;; because it was a self-insert-command. Since the next command is |
214 ;; something else, do the refill now. | 210 ;; something else, do the refill now. |
215 (refill-fill-paragraph-at refill-doit) | 211 (refill-fill-paragraph-at refill-doit) |
216 (setq refill-doit nil))) | 212 (setq refill-doit nil))) |
217 | 213 |
218 (defvar refill-late-fill-paragraph-function nil) | 214 (defvar refill-saved-state nil) |
219 | 215 |
220 ;;;###autoload | 216 ;;;###autoload |
221 (define-minor-mode refill-mode | 217 (define-minor-mode refill-mode |
222 "Toggle Refill minor mode. | 218 "Toggle Refill minor mode. |
223 With prefix arg, turn Refill mode on iff arg is positive. | 219 With prefix arg, turn Refill mode on iff arg is positive. |
224 | 220 |
225 When Refill mode is on, the current paragraph will be formatted when | 221 When Refill mode is on, the current paragraph will be formatted when |
226 changes are made within it. Self-inserting characters only cause | 222 changes are made within it. Self-inserting characters only cause |
227 refilling if they would cause auto-filling." | 223 refilling if they would cause auto-filling." |
228 nil " Refill" '(("\177" . backward-delete-char-untabify)) | 224 :group 'refill |
225 :lighter " Refill" | |
226 :keymap '(("\177" . backward-delete-char-untabify)) | |
229 ;; Remove old state if necessary | 227 ;; Remove old state if necessary |
230 (when refill-ignorable-overlay | 228 (when refill-ignorable-overlay |
231 (delete-overlay refill-ignorable-overlay) | 229 (delete-overlay refill-ignorable-overlay) |
232 (kill-local-variable 'refill-ignorable-overlay)) | 230 (kill-local-variable 'refill-ignorable-overlay)) |
233 (when refill-late-fill-paragraph-function | 231 (when (local-variable-p 'refill-saved-state) |
234 (setq fill-paragraph-function refill-late-fill-paragraph-function) | 232 (dolist (x refill-saved-state) |
235 (kill-local-variable 'refill-late-fill-paragraph-function)) | 233 (set (make-local-variable (car x)) (cdr x))) |
234 (kill-local-variable 'refill-saved-state)) | |
236 (if refill-mode | 235 (if refill-mode |
237 (progn | 236 (progn |
238 (add-hook 'after-change-functions 'refill-after-change-function nil t) | 237 (add-hook 'after-change-functions 'refill-after-change-function nil t) |
239 (add-hook 'post-command-hook 'refill-post-command-function nil t) | 238 (add-hook 'post-command-hook 'refill-post-command-function nil t) |
240 (add-hook 'pre-command-hook 'refill-pre-command-function nil t) | 239 (add-hook 'pre-command-hook 'refill-pre-command-function nil t) |
241 (set (make-local-variable 'refill-late-fill-paragraph-function) | 240 (set (make-local-variable 'refill-saved-state) |
242 fill-paragraph-function) | 241 (mapcar (lambda (s) (cons s (symbol-value s))) |
242 '(fill-paragraph-function auto-fill-function))) | |
243 ;; This provides the test for recursive paragraph filling. | 243 ;; This provides the test for recursive paragraph filling. |
244 (set (make-local-variable 'fill-paragraph-function) | 244 (set (make-local-variable 'fill-paragraph-function) |
245 'refill-fill-paragraph) | 245 'refill-fill-paragraph) |
246 ;; When using justification, doing DEL on 2 spaces should remove | 246 ;; When using justification, doing DEL on 2 spaces should remove |
247 ;; both, otherwise, the subsequent refill will undo the DEL. | 247 ;; both, otherwise, the subsequent refill will undo the DEL. |
257 (remove-hook 'post-command-hook 'refill-post-command-function t) | 257 (remove-hook 'post-command-hook 'refill-post-command-function t) |
258 (kill-local-variable 'backward-delete-char-untabify-method))) | 258 (kill-local-variable 'backward-delete-char-untabify-method))) |
259 | 259 |
260 (provide 'refill) | 260 (provide 'refill) |
261 | 261 |
262 ;; arch-tag: 2c4ce9e8-1daa-4a3b-b6f8-fd6ac5bf6138 | |
262 ;;; refill.el ends here | 263 ;;; refill.el ends here |