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