git.notmuchmail.org Git - notmuch/blob - emacs/coolj.el

   1 ;;; coolj.el --- automatically wrap long lines  -*- coding:utf-8 -*-
   2
   3 ;; Copyright (C) 2000, 2001, 2004, 2005, 2006, 2007, 2008, 2009 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: David Edmondson <dme@dme.org>
   9 ;; Keywords: convenience, wp
  10
  11 ;; This file is not 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 ;;; This is a simple derivative of some functionality from
  29 ;;; `longlines.el'. The key difference is that this version will
  30 ;;; insert a prefix at the head of each wrapped line. The prefix is
  31 ;;; calculated from the originating long line.
  32
  33 ;;; No minor-mode is provided, the caller is expected to call
  34 ;;; `coolj-wrap-region' to wrap the region of interest.
  35
  36 ;;; Code:
  37
  38 (defgroup coolj nil
  39   "Wrapping of long lines with prefix."
  40   :group 'fill)
  41
  42 (defcustom coolj-wrap-follows-window-size t
  43   "Non-nil means wrap text to the window size.
  44 Otherwise respect `fill-column'."
  45   :group 'coolj
  46   :type 'boolean)
  47
  48 (defcustom coolj-line-prefix-regexp "^\\(>+ \\)*"
  49   "Regular expression that matches line prefixes."
  50   :group 'coolj
  51   :type 'regexp)
  52
  53 (defvar coolj-wrap-point nil)
  54
  55 (make-variable-buffer-local 'coolj-wrap-point)
  56
  57 (defun coolj-determine-prefix ()
  58   "Determine the prefix for the current line."
  59   (save-excursion
  60     (beginning-of-line)
  61     (if (re-search-forward coolj-line-prefix-regexp nil t)
  62         (buffer-substring (match-beginning 0) (match-end 0))
  63       "")))
  64
  65 (defun coolj-wrap-buffer ()
  66   "Wrap the current buffer."
  67   (coolj-wrap-region (point-min) (point-max)))
  68
  69 (defun coolj-wrap-region (beg end)
  70   "Wrap each successive line, starting with the line before BEG.
  71 Stop when we reach lines after END that don't need wrapping, or the
  72 end of the buffer."
  73   (setq fill-column (if coolj-wrap-follows-window-size
  74                         (window-width)
  75                       fill-column))
  76   (let ((mod (buffer-modified-p)))
  77     (setq coolj-wrap-point (point))
  78     (goto-char beg)
  79     (forward-line -1)
  80     ;; Two successful coolj-wrap-line's in a row mean successive
  81     ;; lines don't need wrapping.
  82     (while (null (and (coolj-wrap-line)
  83                       (or (eobp)
  84                           (and (>= (point) end)
  85                                (coolj-wrap-line))))))
  86     (goto-char coolj-wrap-point)
  87     (set-buffer-modified-p mod)))
  88
  89 (defun coolj-wrap-line ()
  90   "If the current line needs to be wrapped, wrap it and return nil.
  91 If wrapping is performed, point remains on the line.  If the line does
  92 not need to be wrapped, move point to the next line and return t."
  93   (let ((prefix (coolj-determine-prefix)))
  94     (if (coolj-set-breakpoint prefix)
  95         (progn
  96           (insert-before-markers ?\n)
  97           (backward-char 1)
  98           (delete-char -1)
  99           (forward-char 1)
 100           (insert-before-markers prefix)
 101           nil)
 102       (forward-line 1)
 103       t)))
 104
 105 (defun coolj-set-breakpoint (prefix)
 106   "Place point where we should break the current line, and return t.
 107 If the line should not be broken, return nil; point remains on the
 108 line."
 109   (move-to-column fill-column)
 110   (if (and (re-search-forward "[^ ]" (line-end-position) 1)
 111            (> (current-column) fill-column))
 112       ;; This line is too long.  Can we break it?
 113       (or (coolj-find-break-backward prefix)
 114           (progn (move-to-column fill-column)
 115                  (coolj-find-break-forward)))))
 116
 117 (defun coolj-find-break-backward (prefix)
 118   "Move point backward to the first available breakpoint and return t.
 119 If no breakpoint is found, return nil."
 120   (let ((end-of-prefix (+ (line-beginning-position) (length prefix))))
 121     (and (search-backward " " end-of-prefix 1)
 122          (save-excursion
 123            (skip-chars-backward " " end-of-prefix)
 124            (null (bolp)))
 125          (progn (forward-char 1)
 126                 (if (and fill-nobreak-predicate
 127                          (run-hook-with-args-until-success
 128                           'fill-nobreak-predicate))
 129                     (progn (skip-chars-backward " " end-of-prefix)
 130                            (coolj-find-break-backward prefix))
 131                   t)))))
 132
 133 (defun coolj-find-break-forward ()
 134   "Move point forward to the first available breakpoint and return t.
 135 If no break point is found, return nil."
 136   (and (search-forward " " (line-end-position) 1)
 137        (progn (skip-chars-forward " " (line-end-position))
 138               (null (eolp)))
 139        (if (and fill-nobreak-predicate
 140                 (run-hook-with-args-until-success
 141                  'fill-nobreak-predicate))
 142            (coolj-find-break-forward)
 143          t)))
 144
 145 (provide 'coolj)