diff options
Diffstat (limited to 'emacs.d/nxhtml/util/wrap-to-fill.el')
| -rw-r--r-- | emacs.d/nxhtml/util/wrap-to-fill.el | 364 |
1 files changed, 364 insertions, 0 deletions
diff --git a/emacs.d/nxhtml/util/wrap-to-fill.el b/emacs.d/nxhtml/util/wrap-to-fill.el new file mode 100644 index 0000000..223ce1b --- /dev/null +++ b/emacs.d/nxhtml/util/wrap-to-fill.el @@ -0,0 +1,364 @@ +;;; 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 |