lisp/longlines.el

   1 ;;; longlines.el --- automatically wrap long lines
   2
   3 ;; Copyright (C) 2000, 2001, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
   4
   5 ;; Authors:    Kai Grossjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
   6 ;;             Alex Schroeder <alex@gnu.org>
   7 ;;             Chong Yidong <cyd@stupidchicken.com>
   8 ;; Maintainer: Chong Yidong <cyd@stupidchicken.com>
   9 ;; Keywords: convenience, wp
  10
  11 ;; This file is part of GNU Emacs.
  12
  13 ;; GNU Emacs is free software: you can redistribute it and/or modify
  14 ;; it under the terms of the GNU General Public License as published by
  15 ;; the Free Software Foundation, either version 3 of the License, or
  16 ;; (at your option) any later version.
  17
  18 ;; GNU Emacs is distributed in the hope that it will be useful,
  19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21 ;; GNU General Public License for more details.
  22
  23 ;; You should have received a copy of the GNU General Public License
  24 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  25
  26 ;;; Commentary:
  27
  28 ;; Some text editors save text files with long lines, and they
  29 ;; automatically break these lines at whitespace, without actually
  30 ;; inserting any newline characters.  When doing `M-q' in Emacs, you
  31 ;; are inserting newline characters.  Longlines mode provides a file
  32 ;; format which wraps the long lines when reading a file and unwraps
  33 ;; the lines when saving the file.  It can also wrap and unwrap
  34 ;; automatically as editing takes place.
  35
  36 ;; Special thanks to Rod Smith for many useful bug reports.
  37
  38 ;;; Code:
  39
  40 (defgroup longlines nil
  41   "Automatic wrapping of long lines when loading files."
  42   :group 'fill)
  43
  44 (defcustom longlines-auto-wrap t
  45   "Non-nil means long lines are automatically wrapped after each command.
  46 Otherwise, you can perform filling using `fill-paragraph' or
  47 `auto-fill-mode'.  In any case, the soft newlines will be removed
  48 when the file is saved to disk."
  49   :group 'longlines
  50   :type 'boolean)
  51
  52 (defcustom longlines-wrap-follows-window-size nil
  53   "Non-nil means wrapping and filling happen at the edge of the window.
  54 Otherwise, `fill-column' is used, regardless of the window size.  This
  55 does not work well when the buffer is displayed in multiple windows
  56 with differing widths.
  57
  58 If the value is an integer, that specifies the distance from the
  59 right edge of the window at which wrapping occurs.  For any other
  60 non-nil value, wrapping occurs 2 characters from the right edge."
  61   :group 'longlines
  62   :type 'boolean)
  63
  64 (defcustom longlines-show-hard-newlines nil
  65   "Non-nil means each hard newline is marked on the screen.
  66 \(The variable `longlines-show-effect' controls what they look like.)
  67 You can also enable the display temporarily, using the command
  68 `longlines-show-hard-newlines'."
  69   :group 'longlines
  70   :type 'boolean)
  71
  72 (defcustom longlines-show-effect (propertize "|\n" 'face 'escape-glyph)
  73   "A string to display when showing hard newlines.
  74 This is used when `longlines-show-hard-newlines' is on."
  75   :group 'longlines
  76   :type 'string)
  77
  78 ;; Internal variables
  79
  80 (defvar longlines-wrap-beg nil)
  81 (defvar longlines-wrap-end nil)
  82 (defvar longlines-wrap-point nil)
  83 (defvar longlines-showing nil)
  84 (defvar longlines-decoded nil)
  85
  86 (make-variable-buffer-local 'longlines-wrap-beg)
  87 (make-variable-buffer-local 'longlines-wrap-end)
  88 (make-variable-buffer-local 'longlines-wrap-point)
  89 (make-variable-buffer-local 'longlines-showing)
  90 (make-variable-buffer-local 'longlines-decoded)
  91
  92 ;; Mode
  93
  94 (defvar message-indent-citation-function)
  95
  96 ;;;###autoload
  97 (define-minor-mode longlines-mode
  98   "Toggle Long Lines mode.
  99 In Long Lines mode, long lines are wrapped if they extend beyond
 100 `fill-column'.  The soft newlines used for line wrapping will not
 101 show up when the text is yanked or saved to disk.
 102
 103 If the variable `longlines-auto-wrap' is non-nil, lines are automatically
 104 wrapped whenever the buffer is changed.  You can always call
 105 `fill-paragraph' to fill individual paragraphs.
 106
 107 If the variable `longlines-show-hard-newlines' is non-nil, hard newlines
 108 are indicated with a symbol."
 109   :group 'longlines :lighter " ll"
 110   (if longlines-mode
 111       ;; Turn on longlines mode
 112       (progn
 113         (use-hard-newlines 1 'never)
 114         (set (make-local-variable 'require-final-newline) nil)
 115         (add-to-list 'buffer-file-format 'longlines)
 116         (add-hook 'change-major-mode-hook 'longlines-mode-off nil t)
 117         (add-hook 'before-revert-hook 'longlines-before-revert-hook nil t)
 118         (make-local-variable 'buffer-substring-filters)
 119         (make-local-variable 'longlines-auto-wrap)
 120         (set (make-local-variable 'isearch-search-fun-function)
 121              'longlines-search-function)
 122         (add-to-list 'buffer-substring-filters 'longlines-encode-string)
 123         (when longlines-wrap-follows-window-size
 124           (let ((dw (if (and (integerp longlines-wrap-follows-window-size)
 125                              (>= longlines-wrap-follows-window-size 0)
 126                              (< longlines-wrap-follows-window-size
 127                                 (window-width)))
 128                         longlines-wrap-follows-window-size
 129                       2)))
 130             (set (make-local-variable 'fill-column)
 131                  (- (window-width) dw)))
 132           (add-hook 'window-configuration-change-hook
 133                     'longlines-window-change-function nil t))
 134         (let ((buffer-undo-list t)
 135               (inhibit-read-only t)
 136               (after-change-functions nil)
 137               (mod (buffer-modified-p))
 138               buffer-file-name buffer-file-truename)
 139           ;; Turning off undo is OK since (spaces + newlines) is
 140           ;; conserved, except for a corner case in
 141           ;; longlines-wrap-lines that we'll never encounter from here
 142           (save-restriction
 143             (widen)
 144             (unless longlines-decoded
 145               (longlines-decode-buffer)
 146               (setq longlines-decoded t))
 147             (longlines-wrap-region (point-min) (point-max)))
 148           (set-buffer-modified-p mod))
 149         (when (and longlines-show-hard-newlines
 150                    (not longlines-showing))
 151           (longlines-show-hard-newlines))
 152
 153         ;; Hacks to make longlines play nice with various modes.
 154         (cond ((eq major-mode 'mail-mode)
 155                (add-hook 'mail-setup-hook 'longlines-decode-buffer nil t)
 156                (or mail-citation-hook
 157                    (add-hook 'mail-citation-hook 'mail-indent-citation nil t))
 158                (add-hook 'mail-citation-hook 'longlines-decode-region nil t))
 159               ((eq major-mode 'message-mode)
 160                (add-hook 'message-setup-hook 'longlines-decode-buffer nil t)
 161                (make-local-variable 'message-indent-citation-function)
 162                (if (not (listp message-indent-citation-function))
 163                    (setq message-indent-citation-function
 164                          (list message-indent-citation-function)))
 165                (add-to-list 'message-indent-citation-function
 166                             'longlines-decode-region t)))
 167
 168         (add-hook 'after-change-functions 'longlines-after-change-function nil t)
 169         (add-hook 'post-command-hook 'longlines-post-command-function nil t)
 170         (when longlines-auto-wrap
 171           (auto-fill-mode 0)))
 172     ;; Turn off longlines mode
 173     (setq buffer-file-format (delete 'longlines buffer-file-format))
 174     (if longlines-showing
 175         (longlines-unshow-hard-newlines))
 176     (let ((buffer-undo-list t)
 177           (after-change-functions nil)
 178           (inhibit-read-only t)
 179           buffer-file-name buffer-file-truename)
 180       (if longlines-decoded
 181           (save-restriction
 182             (widen)
 183             (longlines-encode-region (point-min) (point-max))
 184             (setq longlines-decoded nil))))
 185     (remove-hook 'change-major-mode-hook 'longlines-mode-off t)
 186     (remove-hook 'after-change-functions 'longlines-after-change-function t)
 187     (remove-hook 'post-command-hook 'longlines-post-command-function t)
 188     (remove-hook 'before-revert-hook 'longlines-before-revert-hook t)
 189     (remove-hook 'window-configuration-change-hook
 190                  'longlines-window-change-function t)
 191     (when longlines-wrap-follows-window-size
 192       (kill-local-variable 'fill-column))
 193     (kill-local-variable 'isearch-search-fun-function)
 194     (kill-local-variable 'require-final-newline)
 195     (kill-local-variable 'buffer-substring-filters)
 196     (kill-local-variable 'use-hard-newlines)))
 197
 198 (defun longlines-mode-off ()
 199   "Turn off longlines mode.
 200 This function exists to be called by `change-major-mode-hook' when the
 201 major mode changes."
 202   (longlines-mode 0))
 203
 204 ;; Showing the effect of hard newlines in the buffer
 205
 206 (defun longlines-show-hard-newlines (&optional arg)
 207   "Make hard newlines visible by adding a face.
 208 With optional argument ARG, make the hard newlines invisible again."
 209   (interactive "P")
 210     (if arg
 211         (longlines-unshow-hard-newlines)
 212       (setq longlines-showing t)
 213       (longlines-show-region (point-min) (point-max))))
 214
 215 (defun longlines-show-region (beg end)
 216   "Make hard newlines between BEG and END visible."
 217   (let* ((pmin (min beg end))
 218          (pmax (max beg end))
 219          (pos (text-property-not-all pmin pmax 'hard nil))
 220          (mod (buffer-modified-p))
 221          (buffer-undo-list t)
 222          (inhibit-read-only t)
 223          (inhibit-modification-hooks t)
 224          buffer-file-name buffer-file-truename)
 225     (while pos
 226       (put-text-property pos (1+ pos) 'display
 227                          (copy-sequence longlines-show-effect))
 228       (setq pos (text-property-not-all (1+ pos) pmax 'hard nil)))
 229     (restore-buffer-modified-p mod)))
 230
 231 (defun longlines-unshow-hard-newlines ()
 232   "Make hard newlines invisible again."
 233   (interactive)
 234   (setq longlines-showing nil)
 235   (let ((pos (text-property-not-all (point-min) (point-max) 'hard nil))
 236         (mod (buffer-modified-p))
 237         (buffer-undo-list t)
 238         (inhibit-read-only t)
 239         (inhibit-modification-hooks t)
 240         buffer-file-name buffer-file-truename)
 241     (while pos
 242       (remove-text-properties pos (1+ pos) '(display))
 243       (setq pos (text-property-not-all (1+ pos) (point-max) 'hard nil)))
 244     (restore-buffer-modified-p mod)))
 245
 246 ;; Wrapping the paragraphs.
 247
 248 (defun longlines-wrap-region (beg end)
 249   "Wrap each successive line, starting with the line before BEG.
 250 Stop when we reach lines after END that don't need wrapping, or the
 251 end of the buffer."
 252   (let ((mod (buffer-modified-p)))
 253     (setq longlines-wrap-point (point))
 254     (goto-char beg)
 255     (forward-line -1)
 256     ;; Two successful longlines-wrap-line's in a row mean successive
 257     ;; lines don't need wrapping.
 258     (while (null (and (longlines-wrap-line)
 259                       (or (eobp)
 260                           (and (>= (point) end)
 261                                (longlines-wrap-line))))))
 262     (goto-char longlines-wrap-point)
 263     (set-buffer-modified-p mod)))
 264
 265 (defun longlines-wrap-line ()
 266   "If the current line needs to be wrapped, wrap it and return nil.
 267 If wrapping is performed, point remains on the line.  If the line does
 268 not need to be wrapped, move point to the next line and return t."
 269   (if (longlines-set-breakpoint)
 270       (progn (insert-before-markers ?\n)
 271              (backward-char 1)
 272              (delete-char -1)
 273              (forward-char 1)
 274              nil)
 275     (if (longlines-merge-lines-p)
 276         (progn (end-of-line)
 277      ;; After certain commands (e.g. kill-line), there may be two
 278      ;; successive soft newlines in the buffer.  In this case, we
 279      ;; replace these two newlines by a single space.  Unfortunately,
 280      ;; this breaks the conservation of (spaces + newlines), so we
 281      ;; have to fiddle with longlines-wrap-point.
 282                (if (or (prog1 (bolp) (forward-char 1)) (eolp))
 283                    (progn
 284                      (delete-char -1)
 285                      (if (> longlines-wrap-point (point))
 286                          (setq longlines-wrap-point
 287                                (1- longlines-wrap-point))))
 288                  (insert-before-markers-and-inherit ?\s)
 289                  (backward-char 1)
 290                  (delete-char -1)
 291                  (forward-char 1))
 292                nil)
 293       (forward-line 1)
 294       t)))
 295
 296 (defun longlines-set-breakpoint ()
 297   "Place point where we should break the current line, and return t.
 298 If the line should not be broken, return nil; point remains on the
 299 line."
 300   (move-to-column fill-column)
 301   (if (and (re-search-forward "[^ ]" (line-end-position) 1)
 302            (> (current-column) fill-column))
 303       ;; This line is too long.  Can we break it?
 304       (or (longlines-find-break-backward)
 305           (progn (move-to-column fill-column)
 306                  (longlines-find-break-forward)))))
 307
 308 (defun longlines-find-break-backward ()
 309   "Move point backward to the first available breakpoint and return t.
 310 If no breakpoint is found, return nil."
 311   (and (search-backward " " (line-beginning-position) 1)
 312        (save-excursion
 313          (skip-chars-backward " " (line-beginning-position))
 314          (null (bolp)))
 315        (progn (forward-char 1)
 316               (if (and fill-nobreak-predicate
 317                        (run-hook-with-args-until-success
 318                         'fill-nobreak-predicate))
 319                   (progn (skip-chars-backward " " (line-beginning-position))
 320                          (longlines-find-break-backward))
 321                 t))))
 322
 323 (defun longlines-find-break-forward ()
 324   "Move point forward to the first available breakpoint and return t.
 325 If no break point is found, return nil."
 326   (and (search-forward " " (line-end-position) 1)
 327        (progn (skip-chars-forward " " (line-end-position))
 328               (null (eolp)))
 329        (if (and fill-nobreak-predicate
 330                 (run-hook-with-args-until-success
 331                  'fill-nobreak-predicate))
 332            (longlines-find-break-forward)
 333          t)))
 334
 335 (defun longlines-merge-lines-p ()
 336   "Return t if part of the next line can fit onto the current line.
 337 Otherwise, return nil.  Text cannot be moved across hard newlines."
 338   (save-excursion
 339     (end-of-line)
 340     (and (null (eobp))
 341          (null (get-text-property (point) 'hard))
 342          (let ((space (- fill-column (current-column))))
 343            (forward-line 1)
 344            (if (eq (char-after) ? )
 345                t ; We can always merge some spaces
 346              (<= (if (search-forward " " (line-end-position) 1)
 347                      (current-column)
 348                    (1+ (current-column)))
 349                  space))))))
 350
 351 (defun longlines-decode-region (&optional beg end)
 352   "Turn all newlines between BEG and END into hard newlines.
 353 If BEG and END are nil, the point and mark are used."
 354   (if (null beg) (setq beg (point)))
 355   (if (null end) (setq end (mark t)))
 356   (save-excursion
 357     (let ((reg-max (max beg end)))
 358       (goto-char (min beg end))
 359       (while (search-forward "\n" reg-max t)
 360         (set-hard-newline-properties
 361          (match-beginning 0) (match-end 0))))))
 362
 363 (defun longlines-decode-buffer ()
 364   "Turn all newlines in the buffer into hard newlines."
 365   (longlines-decode-region (point-min) (point-max)))
 366
 367 (defun longlines-encode-region (beg end &optional buffer)
 368   "Replace each soft newline between BEG and END with exactly one space.
 369 Hard newlines are left intact.  The optional argument BUFFER exists for
 370 compatibility with `format-alist', and is ignored."
 371   (save-excursion
 372     (let ((reg-max (max beg end))
 373           (mod (buffer-modified-p)))
 374       (goto-char (min beg end))
 375       (while (search-forward "\n" reg-max t)
 376         (unless (get-text-property (match-beginning 0) 'hard)
 377           (replace-match " ")))
 378       (set-buffer-modified-p mod)
 379       end)))
 380
 381 (defun longlines-encode-string (string)
 382   "Return a copy of STRING with each soft newline replaced by a space.
 383 Hard newlines are left intact."
 384   (let* ((str (copy-sequence string))
 385          (pos (string-match "\n" str)))
 386     (while pos
 387       (if (null (get-text-property pos 'hard str))
 388           (aset str pos ? ))
 389       (setq pos (string-match "\n" str (1+ pos))))
 390     str))
 391
 392 ;; Auto wrap
 393
 394 (defun longlines-auto-wrap (&optional arg)
 395   "Toggle automatic line wrapping.
 396 With optional argument ARG, turn on line wrapping if and only if ARG is positive.
 397 If automatic line wrapping is turned on, wrap the entire buffer."
 398   (interactive "P")
 399   (setq arg (if arg
 400                 (> (prefix-numeric-value arg) 0)
 401               (not longlines-auto-wrap)))
 402   (if arg
 403       (progn
 404         (setq longlines-auto-wrap t)
 405         (longlines-wrap-region (point-min) (point-max))
 406         (message "Auto wrap enabled."))
 407     (setq longlines-auto-wrap nil)
 408     (message "Auto wrap disabled.")))
 409
 410 (defun longlines-after-change-function (beg end len)
 411   "Update `longlines-wrap-beg' and `longlines-wrap-end'.
 412 This is called by `after-change-functions' to keep track of the region
 413 that has changed."
 414   (when (and longlines-auto-wrap (not undo-in-progress))
 415     (setq longlines-wrap-beg
 416           (if longlines-wrap-beg (min longlines-wrap-beg beg) beg))
 417     (setq longlines-wrap-end
 418           (if longlines-wrap-end (max longlines-wrap-end end) end))))
 419
 420 (defun longlines-post-command-function ()
 421   "Perform line wrapping on the parts of the buffer that have changed.
 422 This is called by `post-command-hook' after each command."
 423   (when (and longlines-auto-wrap longlines-wrap-beg)
 424     (if (or (eq this-command 'yank)
 425             (eq this-command 'yank-pop))
 426         (longlines-decode-region (point) (mark t)))
 427     (if longlines-showing
 428         (longlines-show-region longlines-wrap-beg longlines-wrap-end))
 429     (unless (or (eq this-command 'fill-paragraph)
 430                 (eq this-command 'fill-region))
 431       (longlines-wrap-region longlines-wrap-beg longlines-wrap-end))
 432     (setq longlines-wrap-beg nil)
 433     (setq longlines-wrap-end nil)))
 434
 435 (defun longlines-window-change-function ()
 436   "Re-wrap the buffer if the window width has changed.
 437 This is called by `window-configuration-change-hook'."
 438   (let ((dw (if (and (integerp longlines-wrap-follows-window-size)
 439                      (>= longlines-wrap-follows-window-size 0)
 440                      (< longlines-wrap-follows-window-size (window-width)))
 441                 longlines-wrap-follows-window-size
 442               2)))
 443     (when (/= fill-column (- (window-width) dw))
 444       (setq fill-column (- (window-width) dw))
 445       (longlines-wrap-region (point-min) (point-max)))))
 446
 447 ;; Isearch
 448
 449 (defun longlines-search-function ()
 450   (cond
 451    (isearch-word
 452     (if isearch-forward 'word-search-forward 'word-search-backward))
 453    (isearch-regexp
 454     (if isearch-forward 're-search-forward 're-search-backward))
 455    (t
 456     (if isearch-forward
 457         'longlines-search-forward
 458       'longlines-search-backward))))
 459
 460 (defun longlines-search-forward (string &optional bound noerror count)
 461   (let ((search-spaces-regexp "[ \n]+"))
 462     (re-search-forward (regexp-quote string) bound noerror count)))
 463
 464 (defun longlines-search-backward (string &optional bound noerror count)
 465   (let ((search-spaces-regexp "[ \n]+"))
 466     (re-search-backward (regexp-quote string) bound noerror count)))
 467
 468 ;; Loading and saving
 469
 470 (defun longlines-before-revert-hook ()
 471   (add-hook 'after-revert-hook 'longlines-after-revert-hook nil t)
 472   (longlines-mode 0))
 473
 474 (defun longlines-after-revert-hook ()
 475   (remove-hook 'after-revert-hook 'longlines-after-revert-hook t)
 476   (longlines-mode 1))
 477
 478 (add-to-list
 479  'format-alist
 480  (list 'longlines "Automatically wrap long lines." nil nil
 481        'longlines-encode-region t nil))
 482
 483 ;; Unloading
 484
 485 (defun longlines-unload-function ()
 486   "Unload the longlines library."
 487   (save-current-buffer
 488     (dolist (buffer (buffer-list))
 489       (set-buffer buffer)
 490       (longlines-mode-off)))
 491   ;; continue standard unloading
 492   nil)
 493
 494 (provide 'longlines)
 495
 496 ;; arch-tag: 3489d225-5506-47b9-8659-d8807b77c624
 497 ;;; longlines.el ends here