1 ;;; wrap-to-fill.el --- Make a fill-column wide space for editing
3 ;; Author: Lennart Borgman (lennart O borgman A gmail O com)
4 ;; Created: 2009-08-12 Wed
11 ;; Features that might be required by this library:
15 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
21 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
26 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
28 ;; This program is free software; you can redistribute it and/or
29 ;; modify it under the terms of the GNU General Public License as
30 ;; published by the Free Software Foundation; either version 3, or
31 ;; (at your option) any later version.
33 ;; This program is distributed in the hope that it will be useful,
34 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
35 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
36 ;; General Public License for more details.
38 ;; You should have received a copy of the GNU General Public License
39 ;; along with this program; see the file COPYING. If not, write to
40 ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
41 ;; Floor, Boston, MA 02110-1301, USA.
43 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
47 (eval-when-compile (require 'mumamo))
49 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
53 (defgroup wrap-to-fill nil
54 "Customizing of `wrap-to-fill-column-mode'."
58 (defcustom wrap-to-fill-left-marg nil
59 "Left margin handling for `wrap-to-fill-column-mode'.
60 Used by `wrap-to-fill-column-mode'. If nil then center the
61 display columns. Otherwise it should be a number which will be
63 :type '(choice (const :tag "Center" nil)
64 (integer :tag "Left margin"))
66 (make-variable-buffer-local 'wrap-to-fill-left-marg)
68 (defvar wrap-to-fill--saved-state nil)
69 ;;(make-variable-buffer-local 'wrap-to-fill--saved-state)
70 (put 'wrap-to-fill--saved-state 'permanent-local t)
73 (defcustom wrap-to-fill-left-marg-modes
76 "Major modes where `wrap-to-fill-left-margin' may be nil."
77 :type '(repeat command)
81 ;;ThisisaVeryVeryVeryVeryVeryVeryVeryVeryVeryVeryVeryVeryVeryVeryVeryVeryVeryVeryVeryVeryLongWord ThisisaVeryVeryVeryVeryVeryVeryVeryVeryVeryVeryVeryVeryVeryVeryVeryVeryVeryVeryVeryVeryLongWord
83 (defun wrap-to-fill-wider ()
84 "Increase `fill-column' with 10."
86 (setq fill-column (+ fill-column 10))
87 (wrap-to-fill-set-values-in-buffer-windows))
89 (defun wrap-to-fill-narrower ()
90 "Decrease `fill-column' with 10."
92 (setq fill-column (- fill-column 10))
93 (wrap-to-fill-set-values-in-buffer-windows))
95 (defun wrap-to-fill-normal ()
96 "Reset `fill-column' to global value."
98 ;;(setq fill-column (default-value 'fill-column))
99 (kill-local-variable 'fill-column)
100 (wrap-to-fill-set-values-in-buffer-windows))
102 (defvar wrap-to-fill-column-mode-map
103 (let ((map (make-sparse-keymap)))
104 (define-key map [(control ?c) ?+] 'wrap-to-fill-wider)
105 (define-key map [(control ?c) ?-] 'wrap-to-fill-narrower)
106 (define-key map [(control ?c) ?0] 'wrap-to-fill-normal)
109 ;; Fix-me: Maybe make the `wrap-prefix' behavior an option or separate
112 ;; Fix-me: better handling of left-column in mumamo buffers (and other
116 (define-minor-mode wrap-to-fill-column-mode
117 "Use `fill-column' display columns in buffer windows.
118 By default the display columns are centered, but see the option
119 `wrap-to-fill-left-marg'.
122 Note 1: When turning this on `visual-line-mode' is also turned on. This
123 is not reset when turning off this mode.
125 Note 2: The text properties 'wrap-prefix and 'wrap-to-fill-prefix
126 is set by this mode to indent continuation lines.
128 Key bindings added by this minor mode:
130 \\{wrap-to-fill-column-mode-map}"
133 ;; (message "wrap-to-fill-column-mode %s, cb=%s, major=%s, multi=%s" wrap-to-fill-column-mode (current-buffer)
134 ;; major-mode mumamo-multi-major-mode)
135 (if wrap-to-fill-column-mode
137 ;; Old values (idea from visual-line-mode)
138 (set (make-local-variable 'wrap-to-fill--saved-state) nil)
139 (dolist (var '(visual-line-mode
143 (push (list var (symbol-value var) (local-variable-p var))
144 wrap-to-fill--saved-state))
146 (add-hook 'window-configuration-change-hook 'wrap-to-fill-set-values nil t)
149 (wrap-to-fill-set-values-in-buffer-windows))
151 (remove-hook 'window-configuration-change-hook 'wrap-to-fill-set-values t)
153 (dolist (saved wrap-to-fill--saved-state)
154 (let ((var (nth 0 saved))
158 ((eq var 'visual-line-mode)
159 (unless val (visual-line-mode -1)))
162 (set (make-local-variable var) val)
163 (kill-local-variable var))))))
164 (kill-local-variable 'wrap-to-fill--saved-state)
166 (dolist (win (get-buffer-window-list (current-buffer)))
167 (set-window-margins win left-margin-width right-margin-width))
170 (inhibit-field-text-motion t)
173 (mumamo-with-buffer-prepared-for-jit-lock
176 (goto-char (point-min))
177 (while (< (point) (point-max))
178 (setq beg-pos (point))
179 (setq end-pos (line-end-position))
180 (when (equal (get-text-property beg-pos 'wrap-prefix)
181 (get-text-property beg-pos 'wrap-to-fill-prefix))
182 (remove-list-of-text-properties
186 (remove-list-of-text-properties
187 (point-min) (point-max)
188 '(wrap-to-fill-prefix)))
190 (wrap-to-fill-font-lock wrap-to-fill-column-mode))
191 (put 'wrap-to-fill-column-mode 'permanent-local t)
193 (defcustom wrap-to-fill-major-modes '(org-mode
196 "Major modes where to turn on `wrap-to-fill-column-mode'"
197 ;;:type '(repeat major-mode)
198 :type '(repeat command)
199 :group 'wrap-to-fill)
201 (defun wrap-to-fill-turn-on-in-buffer ()
202 "Turn on fun for globalization."
203 (when (catch 'turn-on
204 (dolist (m wrap-to-fill-major-modes)
205 (when (derived-mode-p m)
206 (throw 'turn-on t))))
207 (wrap-to-fill-column-mode 1)))
209 (define-globalized-minor-mode wrap-to-fill-column-global-mode wrap-to-fill-column-mode
210 wrap-to-fill-turn-on-in-buffer
211 :group 'wrap-to-fill)
213 ;; Fix-me: There is a confusion between buffer and window margins
214 ;; here. Also the doc says that left-margin-width and dito right may
215 ;; be nil. However they seem to be 0 by default, but when displaying a
216 ;; buffer in a window then window-margins returns (nil).
218 (defvar wrap-to-fill-timer nil)
219 (make-variable-buffer-local 'wrap-to-fill-timer)
221 (defun wrap-to-fill-set-values ()
222 (when (timerp wrap-to-fill-timer)
223 (cancel-timer wrap-to-fill-timer))
224 (setq wrap-to-fill-timer
225 (run-with-idle-timer 0 nil 'wrap-to-fill-set-values-in-timer
226 (selected-window) (current-buffer))))
227 (put 'wrap-to-fill-set-values 'permanent-local-hook t)
229 (defun wrap-to-fill-set-values-in-timer (win buf)
231 (when (buffer-live-p buf)
232 (wrap-to-fill-set-values-in-buffer-windows buf))
233 (error (message "ERROR wrap-to-fill-set-values-in-timer: %s"
234 (error-message-string err)))))
236 (defun wrap-to-fill-set-values-in-timer-old (win buf)
237 (when (and (window-live-p win) (buffer-live-p buf)
238 (eq buf (window-buffer win)))
240 (with-current-buffer buf
241 (when wrap-to-fill-column-mode
242 (wrap-to-fill-set-values-in-window win)))
243 (error (message "ERROR wrap-to-fill-set-values: %s"
244 (error-message-string err))))))
246 (defun wrap-to-fill-set-values-in-buffer-windows (&optional buffer)
247 "Use `fill-column' display columns in buffer windows."
248 (let ((buf-windows (get-buffer-window-list (or buffer
252 (dolist (win buf-windows)
253 (if wrap-to-fill-column-mode
254 (wrap-to-fill-set-values-in-window win)
255 (set-window-buffer nil (current-buffer))))))
257 (defvar wrap-old-win-width nil)
258 (make-variable-buffer-local 'wrap-old-win-width)
259 ;; Fix-me: compensate for left-margin-width etc
260 (defun wrap-to-fill-set-values-in-window (win)
261 (with-current-buffer (window-buffer win)
262 (when wrap-to-fill-column-mode
263 (let* ((win-width (window-width win))
264 (win-margs (window-margins win))
265 (win-full (+ win-width
266 (or (car win-margs) 0)
267 (or (cdr win-margs) 0)))
268 (extra-width (- win-full fill-column))
269 (fill-left-marg (unless (memq major-mode wrap-to-fill-left-marg-modes)
270 (or (when (> left-margin-width 0) left-margin-width)
271 wrap-to-fill-left-marg)))
272 (left-marg (if fill-left-marg
274 (- (/ extra-width 2) 1)))
275 ;; Fix-me: Why do I have to subtract 1 here...???
276 (right-marg (- win-full fill-column left-marg 1))
279 ;; (when wrap-old-win-width
280 ;; (unless (= wrap-old-win-width win-width)
282 ;; (message "win-width 0: %s => %s, win-full=%s, e=%s l/r=%s/%s %S %S %S" wrap-old-win-width win-width win-full extra-width left-marg right-marg (window-edges) (window-inside-edges) (window-margins))
284 (setq wrap-old-win-width win-width)
285 (unless (> left-marg 0) (setq left-marg 0))
286 (unless (> right-marg 0) (setq right-marg 0))
287 (unless nil;(= left-marg (or left-margin-width 0))
288 ;;(setq left-margin-width left-marg)
289 (setq need-update t))
290 (unless nil;(= right-marg (or right-margin-width 0))
291 ;;(setq right-margin-width right-marg)
292 (setq need-update t))
293 ;;(message "win-width a: %s => %s, win-full=%s, e=%s l/r=%s/%s %S %S %S" wrap-old-win-width win-width win-full extra-width left-margin-width right-margin-width (window-edges) (window-inside-edges) (window-margins))
295 ;;(set-window-buffer win (window-buffer win))
296 ;;(run-with-idle-timer 0 nil 'set-window-buffer win (window-buffer win))
297 ;;(dolist (win (get-buffer-window-list (current-buffer)))
298 ;; Fix-me: check window width...
299 (set-window-margins win left-marg right-marg)
301 ;;(message "win-width b: %s => %s, win-full=%s, e=%s l/r=%s/%s %S %S %S" wrap-old-win-width win-width win-full extra-width left-marg right-marg (window-edges) (window-inside-edges) (window-margins))
305 ;; (add-hook 'post-command-hook 'my-win-post-command nil t)
306 ;; (remove-hook 'post-command-hook 'my-win-post-command t)
307 (defun my-win-post-command ()
308 (message "win-post-command: l/r=%s/%s %S %S %S" left-margin-width right-margin-width (window-edges) (window-inside-edges) (window-margins))
311 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
314 (defun wrap-to-fill-fontify (bound)
317 (while (< (point) bound)
318 (let ((this-bol (if (bolp) (point)
319 (1+ (line-end-position)))))
320 (unless (< this-bol bound) (setq this-bol nil))
322 (goto-char (+ this-bol 0))
326 (end-pos (line-end-position)))
327 (when (equal (get-text-property beg-pos 'wrap-prefix)
328 (get-text-property beg-pos 'wrap-to-fill-prefix))
330 (skip-chars-forward "[:blank:]")
331 (setq ind-str (buffer-substring-no-properties beg-pos (point)))
332 ;; Any special markers like -, * etc
333 (if (and (< (1+ (point)) (point-max))
334 (memq (char-after) '(?- ;; 45
338 (eq (char-after (1+ (point))) ?\ ))
339 (setq ind-str-fill (concat " " ind-str))
340 (setq ind-str-fill ind-str))
341 ;;(setq ind-str-fill (concat " " ind-str))
342 (mumamo-with-buffer-prepared-for-jit-lock
343 (put-text-property beg-pos end-pos 'wrap-prefix ind-str-fill)
344 (put-text-property beg-pos end-pos 'wrap-to-fill-prefix ind-str-fill))))))
346 ;; Note: doing it line by line and returning t gave problem in mumamo.
348 (set-match-data (list (point) (point)))
351 (defun wrap-to-fill-font-lock (on)
353 (let* ((add-or-remove (if on 'font-lock-add-keywords 'font-lock-remove-keywords))
354 (fontify-fun 'wrap-to-fill-fontify)
355 (args (list nil `(( ,fontify-fun ( 0 'font-lock-warning-face t ))))))
357 (when on (setq args (append args (list t))))
358 (apply add-or-remove args)
360 (font-lock-mode 1))))
362 (provide 'wrap-to-fill)
363 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
364 ;;; wrap-to-fill.el ends here