365 lines
14 KiB
EmacsLisp
365 lines
14 KiB
EmacsLisp
|
;;; wrap-to-fill.el --- Make a fill-column wide space for editing
|
|||
|
|
;;
|
|||
|
|
;; Author: Lennart Borgman (lennart O borgman A gmail O com)
|
|||
|
|
;; Created: 2009-08-12 Wed
|
|||
|
|
;; Version:
|
|||
|
|
;; Last-Updated: x
|
|||
|
|
;; URL:
|
|||
|
|
;; Keywords:
|
|||
|
|
;; Compatibility:
|
|||
|
|
;;
|
|||
|
|
;; Features that might be required by this library:
|
|||
|
|
;;
|
|||
|
|
;; None
|
|||
|
|
;;
|
|||
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|||
|
|
;;
|
|||
|
|
;;; Commentary:
|
|||
|
|
;;
|
|||
|
|
;;
|
|||
|
|
;;
|
|||
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|||
|
|
;;
|
|||
|
|
;;; Change log:
|
|||
|
|
;;
|
|||
|
|
;;
|
|||
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|||
|
|
;;
|
|||
|
|
;; This program is free software; you can redistribute it and/or
|
|||
|
|
;; modify it under the terms of the GNU General Public License as
|
|||
|
|
;; published by the Free Software Foundation; either version 3, or
|
|||
|
|
;; (at your option) any later version.
|
|||
|
|
;;
|
|||
|
|
;; This program is distributed in the hope that it will be useful,
|
|||
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|||
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|||
|
|
;; General Public License for more details.
|
|||
|
|
;;
|
|||
|
|
;; You should have received a copy of the GNU General Public License
|
|||
|
|
;; along with this program; see the file COPYING. If not, write to
|
|||
|
|
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
|
|||
|
|
;; Floor, Boston, MA 02110-1301, USA.
|
|||
|
|
;;
|
|||
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|||
|
|
;;
|
|||
|
|
;;; Code:
|
|||
|
|
|
|||
|
|
(eval-when-compile (require 'mumamo))
|
|||
|
|
|
|||
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|||
|
|
;;;; Wrapping
|
|||
|
|
|
|||
|
|
;;;###autoload
|
|||
|
|
(defgroup wrap-to-fill nil
|
|||
|
|
"Customizing of `wrap-to-fill-column-mode'."
|
|||
|
|
:group 'convenience)
|
|||
|
|
|
|||
|
|
;;;###autoload
|
|||
|
|
(defcustom wrap-to-fill-left-marg nil
|
|||
|
|
"Left margin handling for `wrap-to-fill-column-mode'.
|
|||
|
|
Used by `wrap-to-fill-column-mode'. If nil then center the
|
|||
|
|
display columns. Otherwise it should be a number which will be
|
|||
|
|
the left margin."
|
|||
|
|
:type '(choice (const :tag "Center" nil)
|
|||
|
|
(integer :tag "Left margin"))
|
|||
|
|
:group 'wrap-to-fill)
|
|||
|
|
(make-variable-buffer-local 'wrap-to-fill-left-marg)
|
|||
|
|
|
|||
|
|
(defvar wrap-to-fill--saved-state nil)
|
|||
|
|
;;(make-variable-buffer-local 'wrap-to-fill--saved-state)
|
|||
|
|
(put 'wrap-to-fill--saved-state 'permanent-local t)
|
|||
|
|
|
|||
|
|
;;;###autoload
|
|||
|
|
(defcustom wrap-to-fill-left-marg-modes
|
|||
|
|
'(text-mode
|
|||
|
|
fundamental-mode)
|
|||
|
|
"Major modes where `wrap-to-fill-left-margin' may be nil."
|
|||
|
|
:type '(repeat command)
|
|||
|
|
:group 'wrap-to-fill)
|
|||
|
|
|
|||
|
|
|
|||
|
|
;;ThisisaVeryVeryVeryVeryVeryVeryVeryVeryVeryVeryVeryVeryVeryVeryVeryVeryVeryVeryVeryVeryLongWord ThisisaVeryVeryVeryVeryVeryVeryVeryVeryVeryVeryVeryVeryVeryVeryVeryVeryVeryVeryVeryVeryLongWord
|
|||
|
|
|
|||
|
|
(defun wrap-to-fill-wider ()
|
|||
|
|
"Increase `fill-column' with 10."
|
|||
|
|
(interactive)
|
|||
|
|
(setq fill-column (+ fill-column 10))
|
|||
|
|
(wrap-to-fill-set-values-in-buffer-windows))
|
|||
|
|
|
|||
|
|
(defun wrap-to-fill-narrower ()
|
|||
|
|
"Decrease `fill-column' with 10."
|
|||
|
|
(interactive)
|
|||
|
|
(setq fill-column (- fill-column 10))
|
|||
|
|
(wrap-to-fill-set-values-in-buffer-windows))
|
|||
|
|
|
|||
|
|
(defun wrap-to-fill-normal ()
|
|||
|
|
"Reset `fill-column' to global value."
|
|||
|
|
(interactive)
|
|||
|
|
;;(setq fill-column (default-value 'fill-column))
|
|||
|
|
(kill-local-variable 'fill-column)
|
|||
|
|
(wrap-to-fill-set-values-in-buffer-windows))
|
|||
|
|
|
|||
|
|
(defvar wrap-to-fill-column-mode-map
|
|||
|
|
(let ((map (make-sparse-keymap)))
|
|||
|
|
(define-key map [(control ?c) ?+] 'wrap-to-fill-wider)
|
|||
|
|
(define-key map [(control ?c) ?-] 'wrap-to-fill-narrower)
|
|||
|
|
(define-key map [(control ?c) ?0] 'wrap-to-fill-normal)
|
|||
|
|
map))
|
|||
|
|
|
|||
|
|
;; Fix-me: Maybe make the `wrap-prefix' behavior an option or separate
|
|||
|
|
;; minor mode.
|
|||
|
|
|
|||
|
|
;; Fix-me: better handling of left-column in mumamo buffers (and other
|
|||
|
|
;; if possible).
|
|||
|
|
|
|||
|
|
;;;###autoload
|
|||
|
|
(define-minor-mode wrap-to-fill-column-mode
|
|||
|
|
"Use `fill-column' display columns in buffer windows.
|
|||
|
|
By default the display columns are centered, but see the option
|
|||
|
|
`wrap-to-fill-left-marg'.
|
|||
|
|
|
|||
|
|
Fix-me:
|
|||
|
|
Note 1: When turning this on `visual-line-mode' is also turned on. This
|
|||
|
|
is not reset when turning off this mode.
|
|||
|
|
|
|||
|
|
Note 2: The text properties 'wrap-prefix and 'wrap-to-fill-prefix
|
|||
|
|
is set by this mode to indent continuation lines.
|
|||
|
|
|
|||
|
|
Key bindings added by this minor mode:
|
|||
|
|
|
|||
|
|
\\{wrap-to-fill-column-mode-map}"
|
|||
|
|
:lighter " WrapFill"
|
|||
|
|
:group 'wrap-to-fill
|
|||
|
|
;; (message "wrap-to-fill-column-mode %s, cb=%s, major=%s, multi=%s" wrap-to-fill-column-mode (current-buffer)
|
|||
|
|
;; major-mode mumamo-multi-major-mode)
|
|||
|
|
(if wrap-to-fill-column-mode
|
|||
|
|
(progn
|
|||
|
|
;; Old values (idea from visual-line-mode)
|
|||
|
|
(set (make-local-variable 'wrap-to-fill--saved-state) nil)
|
|||
|
|
(dolist (var '(visual-line-mode
|
|||
|
|
;;left-margin-width
|
|||
|
|
;;right-margin-width
|
|||
|
|
))
|
|||
|
|
(push (list var (symbol-value var) (local-variable-p var))
|
|||
|
|
wrap-to-fill--saved-state))
|
|||
|
|
;; Hooks
|
|||
|
|
(add-hook 'window-configuration-change-hook 'wrap-to-fill-set-values nil t)
|
|||
|
|
;; Wrapping
|
|||
|
|
(visual-line-mode 1)
|
|||
|
|
(wrap-to-fill-set-values-in-buffer-windows))
|
|||
|
|
;; Hooks
|
|||
|
|
(remove-hook 'window-configuration-change-hook 'wrap-to-fill-set-values t)
|
|||
|
|
;; Old values
|
|||
|
|
(dolist (saved wrap-to-fill--saved-state)
|
|||
|
|
(let ((var (nth 0 saved))
|
|||
|
|
(val (nth 1 saved))
|
|||
|
|
(loc (nth 2 saved)))
|
|||
|
|
(cond
|
|||
|
|
((eq var 'visual-line-mode)
|
|||
|
|
(unless val (visual-line-mode -1)))
|
|||
|
|
(t
|
|||
|
|
(if loc
|
|||
|
|
(set (make-local-variable var) val)
|
|||
|
|
(kill-local-variable var))))))
|
|||
|
|
(kill-local-variable 'wrap-to-fill--saved-state)
|
|||
|
|
;; Margins
|
|||
|
|
(dolist (win (get-buffer-window-list (current-buffer)))
|
|||
|
|
(set-window-margins win left-margin-width right-margin-width))
|
|||
|
|
;; Indentation
|
|||
|
|
(let ((here (point))
|
|||
|
|
(inhibit-field-text-motion t)
|
|||
|
|
beg-pos
|
|||
|
|
end-pos)
|
|||
|
|
(mumamo-with-buffer-prepared-for-jit-lock
|
|||
|
|
(save-restriction
|
|||
|
|
(widen)
|
|||
|
|
(goto-char (point-min))
|
|||
|
|
(while (< (point) (point-max))
|
|||
|
|
(setq beg-pos (point))
|
|||
|
|
(setq end-pos (line-end-position))
|
|||
|
|
(when (equal (get-text-property beg-pos 'wrap-prefix)
|
|||
|
|
(get-text-property beg-pos 'wrap-to-fill-prefix))
|
|||
|
|
(remove-list-of-text-properties
|
|||
|
|
beg-pos end-pos
|
|||
|
|
'(wrap-prefix)))
|
|||
|
|
(forward-line))
|
|||
|
|
(remove-list-of-text-properties
|
|||
|
|
(point-min) (point-max)
|
|||
|
|
'(wrap-to-fill-prefix)))
|
|||
|
|
(goto-char here))))
|
|||
|
|
(wrap-to-fill-font-lock wrap-to-fill-column-mode))
|
|||
|
|
(put 'wrap-to-fill-column-mode 'permanent-local t)
|
|||
|
|
|
|||
|
|
(defcustom wrap-to-fill-major-modes '(org-mode
|
|||
|
|
html-mode
|
|||
|
|
nxhtml-mode)
|
|||
|
|
"Major modes where to turn on `wrap-to-fill-column-mode'"
|
|||
|
|
;;:type '(repeat major-mode)
|
|||
|
|
:type '(repeat command)
|
|||
|
|
:group 'wrap-to-fill)
|
|||
|
|
|
|||
|
|
(defun wrap-to-fill-turn-on-in-buffer ()
|
|||
|
|
"Turn on fun for globalization."
|
|||
|
|
(when (catch 'turn-on
|
|||
|
|
(dolist (m wrap-to-fill-major-modes)
|
|||
|
|
(when (derived-mode-p m)
|
|||
|
|
(throw 'turn-on t))))
|
|||
|
|
(wrap-to-fill-column-mode 1)))
|
|||
|
|
|
|||
|
|
(define-globalized-minor-mode wrap-to-fill-column-global-mode wrap-to-fill-column-mode
|
|||
|
|
wrap-to-fill-turn-on-in-buffer
|
|||
|
|
:group 'wrap-to-fill)
|
|||
|
|
|
|||
|
|
;; Fix-me: There is a confusion between buffer and window margins
|
|||
|
|
;; here. Also the doc says that left-margin-width and dito right may
|
|||
|
|
;; be nil. However they seem to be 0 by default, but when displaying a
|
|||
|
|
;; buffer in a window then window-margins returns (nil).
|
|||
|
|
|
|||
|
|
(defvar wrap-to-fill-timer nil)
|
|||
|
|
(make-variable-buffer-local 'wrap-to-fill-timer)
|
|||
|
|
|
|||
|
|
(defun wrap-to-fill-set-values ()
|
|||
|
|
(when (timerp wrap-to-fill-timer)
|
|||
|
|
(cancel-timer wrap-to-fill-timer))
|
|||
|
|
(setq wrap-to-fill-timer
|
|||
|
|
(run-with-idle-timer 0 nil 'wrap-to-fill-set-values-in-timer
|
|||
|
|
(selected-window) (current-buffer))))
|
|||
|
|
(put 'wrap-to-fill-set-values 'permanent-local-hook t)
|
|||
|
|
|
|||
|
|
(defun wrap-to-fill-set-values-in-timer (win buf)
|
|||
|
|
(condition-case err
|
|||
|
|
(when (buffer-live-p buf)
|
|||
|
|
(wrap-to-fill-set-values-in-buffer-windows buf))
|
|||
|
|
(error (message "ERROR wrap-to-fill-set-values-in-timer: %s"
|
|||
|
|
(error-message-string err)))))
|
|||
|
|
|
|||
|
|
(defun wrap-to-fill-set-values-in-timer-old (win buf)
|
|||
|
|
(when (and (window-live-p win) (buffer-live-p buf)
|
|||
|
|
(eq buf (window-buffer win)))
|
|||
|
|
(condition-case err
|
|||
|
|
(with-current-buffer buf
|
|||
|
|
(when wrap-to-fill-column-mode
|
|||
|
|
(wrap-to-fill-set-values-in-window win)))
|
|||
|
|
(error (message "ERROR wrap-to-fill-set-values: %s"
|
|||
|
|
(error-message-string err))))))
|
|||
|
|
|
|||
|
|
(defun wrap-to-fill-set-values-in-buffer-windows (&optional buffer)
|
|||
|
|
"Use `fill-column' display columns in buffer windows."
|
|||
|
|
(let ((buf-windows (get-buffer-window-list (or buffer
|
|||
|
|
(current-buffer))
|
|||
|
|
nil
|
|||
|
|
t)))
|
|||
|
|
(dolist (win buf-windows)
|
|||
|
|
(if wrap-to-fill-column-mode
|
|||
|
|
(wrap-to-fill-set-values-in-window win)
|
|||
|
|
(set-window-buffer nil (current-buffer))))))
|
|||
|
|
|
|||
|
|
(defvar wrap-old-win-width nil)
|
|||
|
|
(make-variable-buffer-local 'wrap-old-win-width)
|
|||
|
|
;; Fix-me: compensate for left-margin-width etc
|
|||
|
|
(defun wrap-to-fill-set-values-in-window (win)
|
|||
|
|
(with-current-buffer (window-buffer win)
|
|||
|
|
(when wrap-to-fill-column-mode
|
|||
|
|
(let* ((win-width (window-width win))
|
|||
|
|
(win-margs (window-margins win))
|
|||
|
|
(win-full (+ win-width
|
|||
|
|
(or (car win-margs) 0)
|
|||
|
|
(or (cdr win-margs) 0)))
|
|||
|
|
(extra-width (- win-full fill-column))
|
|||
|
|
(fill-left-marg (unless (memq major-mode wrap-to-fill-left-marg-modes)
|
|||
|
|
(or (when (> left-margin-width 0) left-margin-width)
|
|||
|
|
wrap-to-fill-left-marg)))
|
|||
|
|
(left-marg (if fill-left-marg
|
|||
|
|
fill-left-marg
|
|||
|
|
(- (/ extra-width 2) 1)))
|
|||
|
|
;; Fix-me: Why do I have to subtract 1 here...???
|
|||
|
|
(right-marg (- win-full fill-column left-marg 1))
|
|||
|
|
(need-update nil)
|
|||
|
|
)
|
|||
|
|
;; (when wrap-old-win-width
|
|||
|
|
;; (unless (= wrap-old-win-width win-width)
|
|||
|
|
;; (message "-")
|
|||
|
|
;; (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))
|
|||
|
|
;; ))
|
|||
|
|
(setq wrap-old-win-width win-width)
|
|||
|
|
(unless (> left-marg 0) (setq left-marg 0))
|
|||
|
|
(unless (> right-marg 0) (setq right-marg 0))
|
|||
|
|
(unless nil;(= left-marg (or left-margin-width 0))
|
|||
|
|
;;(setq left-margin-width left-marg)
|
|||
|
|
(setq need-update t))
|
|||
|
|
(unless nil;(= right-marg (or right-margin-width 0))
|
|||
|
|
;;(setq right-margin-width right-marg)
|
|||
|
|
(setq need-update t))
|
|||
|
|
;;(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))
|
|||
|
|
(when need-update
|
|||
|
|
;;(set-window-buffer win (window-buffer win))
|
|||
|
|
;;(run-with-idle-timer 0 nil 'set-window-buffer win (window-buffer win))
|
|||
|
|
;;(dolist (win (get-buffer-window-list (current-buffer)))
|
|||
|
|
;; Fix-me: check window width...
|
|||
|
|
(set-window-margins win left-marg right-marg)
|
|||
|
|
;;)
|
|||
|
|
;;(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))
|
|||
|
|
)
|
|||
|
|
))))
|
|||
|
|
|
|||
|
|
;; (add-hook 'post-command-hook 'my-win-post-command nil t)
|
|||
|
|
;; (remove-hook 'post-command-hook 'my-win-post-command t)
|
|||
|
|
(defun my-win-post-command ()
|
|||
|
|
(message "win-post-command: l/r=%s/%s %S %S %S" left-margin-width right-margin-width (window-edges) (window-inside-edges) (window-margins))
|
|||
|
|
)
|
|||
|
|
|
|||
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|||
|
|
;;; Font lock
|
|||
|
|
|
|||
|
|
(defun wrap-to-fill-fontify (bound)
|
|||
|
|
(save-restriction
|
|||
|
|
(widen)
|
|||
|
|
(while (< (point) bound)
|
|||
|
|
(let ((this-bol (if (bolp) (point)
|
|||
|
|
(1+ (line-end-position)))))
|
|||
|
|
(unless (< this-bol bound) (setq this-bol nil))
|
|||
|
|
(when this-bol
|
|||
|
|
(goto-char (+ this-bol 0))
|
|||
|
|
(let (ind-str
|
|||
|
|
ind-str-fill
|
|||
|
|
(beg-pos this-bol)
|
|||
|
|
(end-pos (line-end-position)))
|
|||
|
|
(when (equal (get-text-property beg-pos 'wrap-prefix)
|
|||
|
|
(get-text-property beg-pos 'wrap-to-fill-prefix))
|
|||
|
|
;; Find indentation
|
|||
|
|
(skip-chars-forward "[:blank:]")
|
|||
|
|
(setq ind-str (buffer-substring-no-properties beg-pos (point)))
|
|||
|
|
;; Any special markers like -, * etc
|
|||
|
|
(if (and (< (1+ (point)) (point-max))
|
|||
|
|
(memq (char-after) '(?- ;; 45
|
|||
|
|
?– ;; 8211
|
|||
|
|
?*
|
|||
|
|
))
|
|||
|
|
(eq (char-after (1+ (point))) ?\ ))
|
|||
|
|
(setq ind-str-fill (concat " " ind-str))
|
|||
|
|
(setq ind-str-fill ind-str))
|
|||
|
|
;;(setq ind-str-fill (concat " " ind-str))
|
|||
|
|
(mumamo-with-buffer-prepared-for-jit-lock
|
|||
|
|
(put-text-property beg-pos end-pos 'wrap-prefix ind-str-fill)
|
|||
|
|
(put-text-property beg-pos end-pos 'wrap-to-fill-prefix ind-str-fill))))))
|
|||
|
|
(forward-line 1))
|
|||
|
|
;; Note: doing it line by line and returning t gave problem in mumamo.
|
|||
|
|
(when nil ;this-bol
|
|||
|
|
(set-match-data (list (point) (point)))
|
|||
|
|
t)))
|
|||
|
|
|
|||
|
|
(defun wrap-to-fill-font-lock (on)
|
|||
|
|
;; See mlinks.el
|
|||
|
|
(let* ((add-or-remove (if on 'font-lock-add-keywords 'font-lock-remove-keywords))
|
|||
|
|
(fontify-fun 'wrap-to-fill-fontify)
|
|||
|
|
(args (list nil `(( ,fontify-fun ( 0 'font-lock-warning-face t ))))))
|
|||
|
|
(when fontify-fun
|
|||
|
|
(when on (setq args (append args (list t))))
|
|||
|
|
(apply add-or-remove args)
|
|||
|
|
(font-lock-mode -1)
|
|||
|
|
(font-lock-mode 1))))
|
|||
|
|
|
|||
|
|
(provide 'wrap-to-fill)
|
|||
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|||
|
|
;;; wrap-to-fill.el ends here
|