Re: New minor mode: wrap.el

[Chong Yidong]

Fixed a couple of bugs.


;;; wrap.el --- Minor mode for simulating soft word wrap

;; Copyright (C) 2004 Chong Yidong

;; Author: Chong Yidong <cyd at stupidchicken com>
;; Version: 0.0.2
;; Keywords: convenience

;; This file is not part of GNU Emacs.

;; This file 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 2 of
;; the License, or (at your option) any later version.

;; This file 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 GNU Emacs; if not, write to the Free
;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston,
;; MA 02111-1307 USA


;;; Commentary:

;; This is wrap-mode, a minor mode for simulating soft word wrap. It
;; is intended to be used in conjunction with longlines-mode, written
;; by Kai Grossjohann and Alex Schroeder.
;; (http://www.emacswiki.org/elisp/longlines.el)

;; The idea for this minor mode was taken from refill-mode, written by
;; Dave Love. However, its behavior differs significantly from
;; refill-mode. Wrap-mode handles line wrapping by itself, rather than
;; calling fill-paragraph or related filling functions. This is
;; because filling leads to behavior that breaks the illusion of line
;; wrapping. For example, whitespace inserted by the user may be
;; instantly deleted.

;; In other words, "wrapping" is treated as a separate thing from
;; "filling". One of the consequences of this is that wrapping
;; intentionally ignores fill-prefix. There is, of course, nothing to
;; prevent the user from calling fill-paragraph manually; this is a
;; useful thing to do for, say, cleaning up extraneous whitespace.

;; We assume that newlines and whitespace characters are mutually
;; interchangeable, and that spaces are whitespace characters. This
;; mode will not work for, e.g., Emacs-Lisp mode, which defines "-" as
;; a whitespace character.

;;; Code:

(defvar wrap-beg nil "")
(defvar wrap-end nil "")

(make-variable-buffer-local 'wrap-beg)
(make-variable-buffer-local 'wrap-end)

(defun wrap-after-change-function (beg end len)
  "Function for `after-change-functions' which just sets `wrap-beg'."
  (unless undo-in-progress
    (setq wrap-beg (if wrap-beg (min wrap-beg beg) beg))
    (setq wrap-end (if wrap-end (max wrap-end end) end))))

(defun wrap-fill ()
  "Wrap each successive line, starting with the line before point.
Stop when we get to lines that don't need wrapping."
  (save-excursion
    (goto-char wrap-beg)
    (forward-line -1)
    ;; If there are two successful wrap-lines in a row, this means
    ;; that the following lines don't need to be wrapped. However, we
    ;; should only stop when we get past wrap-end.
    (while (null (and (wrap-line) (>= (point) wrap-end) (wrap-line))))))

(defun wrap-line ()
  "Wrap this line if necessary. If wrapping is performed, point
remains on the line. Otherwise, point advances to the next line.
Returns t if the current line did not require adjusting, and nil
otherwise."
  (end-of-line)
  (skip-syntax-backward "-" (line-beginning-position))
  (if (> (current-column) fill-column)
      (progn ;; This line is full, so split it.
        (move-to-column fill-column)
        (skip-syntax-forward "-" (line-end-position))
        (if (re-search-backward search-whitespace-regexp
                                (line-beginning-position) 1)
            (progn (goto-char (match-end 0))
                   (backward-delete-char 1)
                   (insert-char ?\n 1)
                   nil)
          ;; This word is too long!
          (forward-word 1)
          (skip-syntax-forward "-" (line-end-position))
          (if (eolp)
              (progn (forward-line 1) t)
            (backward-delete-char 1)
            (insert-char ?\n 1)
            nil)))
    (if (wrap-merge-lines-p)
        (progn (end-of-line)
               ;; wrap-merge-lines-p assures us that we are not
               ;; deleting a hard newline.
               (delete-char 1)
               (insert-char ?  1)
               nil)
      (forward-line 1)
      t)))

(defun wrap-merge-lines-p ()
  "If some of the text on the next line can be fitted onto the current
line, return t. Otherwise, return nil. Text cannot be moved across
hard newlines."
  (save-excursion
    (end-of-line)
    (and (null (eobp))
         (null (get-text-property (point) 'hard))
         (> (- fill-column (current-column))
            (progn (forward-line 1)
                   (forward-word 1)
                   (current-column))))))

(defun wrap-post-command-function ()
  "Post-command function to do wrapping."
  (when wrap-beg ; there was a change
    (cond
     ((or (eq this-command 'fill-paragraph)
          (eq this-command 'fill-region))
      nil)
     (t (wrap-fill)))
    (setq wrap-beg nil)
    (setq wrap-end nil)))

;;;###autoload
(define-minor-mode wrap-mode
  "Toggle Wrap minor mode.
With prefix arg, turn Wrap mode on iff arg is positive."
  nil " Wrap" nil
  (if wrap-mode
      (progn
        (if (functionp 'longlines-mode)
            (longlines-mode 1)
          (use-hard-newlines 1))
        (add-hook 'after-change-functions 'wrap-after-change-function nil t)
        (add-hook 'post-command-hook 'wrap-post-command-function nil t)
        (auto-fill-mode 0))
    (if (functionp 'longlines-mode)
        (longlines-mode 0))
    (remove-hook 'after-change-functions 'wrap-after-change-function t)
    (remove-hook 'post-command-hook 'wrap-post-command-function t)))

(provide 'wrap)

;;; wrap.el ends here