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, 0 insertions, 364 deletions
diff --git a/emacs.d/nxhtml/util/wrap-to-fill.el b/emacs.d/nxhtml/util/wrap-to-fill.el deleted file mode 100644 index 223ce1b..0000000 --- a/emacs.d/nxhtml/util/wrap-to-fill.el +++ /dev/null @@ -1,364 +0,0 @@ -;;; 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 |