[rfc] improved wrapping of long lines

[rfc] improved wrapping of long lines

[David Edmondson]

[-- Attachment #1: Type: text/plain, Size: 451 bytes --]

It's annoying that the wrapping of long lines doesn't respect the
indentation of the message. Here's an attempt to improve that.

The wrapping code is in a separate file and has a silly name[1], but all
of that is subject to change at the whim of Carl or his minions.

If anyone tries this then I'd be interested in your feedback,
particularly if it doesn't work or doesn't look the way that you expect.

Footnotes: 
[1]  It's a long-line wrapper...


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-notmuch.el-Improved-wrapping-of-long-lines-respect-t.patch --]
[-- Type: text/x-diff, Size: 3412 bytes --]

From d49ff05ef86b652ec4883d7075df4fb65c846342 Mon Sep 17 00:00:00 2001
From: David Edmondson <dme@dme.org>
Date: Tue, 16 Feb 2010 09:03:18 +0000
Subject: [PATCH] notmuch.el: Improved wrapping of long lines - respect the indentation
 level.

---
 Makefile.local   |    2 +-
 notmuch-coolj.el |   40 ++++++++++++++++++++++++++++++++++++++++
 notmuch.el       |    9 ++++++---
 3 files changed, 47 insertions(+), 4 deletions(-)
 create mode 100644 notmuch-coolj.el

diff --git a/Makefile.local b/Makefile.local
index 04bac83..44a786a 100644
--- a/Makefile.local
+++ b/Makefile.local
@@ -1,4 +1,4 @@
-emacs: notmuch.elc
+emacs: notmuch.elc notmuch-coolj.el
 
 notmuch_client_srcs =		\
 	$(notmuch_compat_srcs)	\
diff --git a/notmuch-coolj.el b/notmuch-coolj.el
new file mode 100644
index 0000000..6b4da6d
--- /dev/null
+++ b/notmuch-coolj.el
@@ -0,0 +1,40 @@
+(defgroup notmuch-coolj nil
+  "Automatic wrapping of long lines when displaying notmuch articles."
+  :group 'notmuch)
+
+(defcustom notmuch-coolj-prefix-regexp " *\\(>+ +\\)?"
+  "A regexp matching potential line prefixes.")
+
+(defun notmuch-coolj-wrap-region (beg end)
+  "Wrap lines in the region."
+  (goto-char beg)
+  (forward-line -1)
+  (while (not (>= (point) end))
+    (notmuch-coolj-wrap-line)
+    (forward-line)))
+
+(defun notmuch-coolj-wrap-line ()
+  "Wrap the current line, if necessary."
+  (let ((prefix (notmuch-coolj-determine-prefix))
+	(start (point))
+	(end (make-marker))
+	(width (window-width)))
+    (set-marker end (save-excursion (end-of-line) (point)))
+    (while (> end (+ (point) width))
+      (forward-char (window-width))
+      (if (re-search-backward "[^ ]\\( \\)" start t)
+	  (progn
+	    (goto-char (match-beginning 1))
+	    (insert-before-markers ?\n)
+	    (re-search-forward "\\( +\\)[^ ]" nil t)
+	    (delete-region (match-beginning 1) (match-end 1))
+	    (backward-char 1)
+	    (insert-before-markers prefix)))
+      (beginning-of-line))))
+
+(defun notmuch-coolj-determine-prefix ()
+  "Determine the prefix for the current line."
+  (if (looking-at notmuch-coolj-prefix-regexp)
+      (buffer-substring-no-properties (match-beginning 0) (match-end 0))))
+
+(provide 'notmuch-coolj)
diff --git a/notmuch.el b/notmuch.el
index ea74a72..d67b066 100644
--- a/notmuch.el
+++ b/notmuch.el
@@ -51,6 +51,8 @@
 (require 'mm-view)
 (require 'message)
 
+(require 'notmuch-coolj)
+
 (defvar notmuch-show-mode-map
   (let ((map (make-sparse-keymap)))
     (define-key map "?" 'notmuch-help)
@@ -777,7 +779,9 @@ is what to put on the button."
                           (mm-display-part mime-message))))
                 )
 	      (if (equal mime-type "text/plain")
-		  (notmuch-show-markup-citations-region beg end depth))
+		  (progn
+		    (notmuch-show-markup-citations-region beg end depth)
+		    (notmuch-coolj-wrap-region beg end)))
               ; Advance to the next part (if any) (so the outer loop can
               ; determine whether we've left the current message.
               (if (re-search-forward notmuch-show-buttonize-begin-regexp nil t)
@@ -1053,8 +1057,7 @@ All currently available key bindings:
 ; Make show mode a bit prettier, highlighting URLs and using word wrap
 
 (defun notmuch-show-pretty-hook ()
-  (goto-address-mode 1)
-  (visual-line-mode))
+  (goto-address-mode 1))
 
 (add-hook 'notmuch-show-hook 'notmuch-show-pretty-hook)
 (add-hook 'notmuch-search-hook
-- 
1.6.6.1


[-- Attachment #3: Type: text/plain, Size: 42 bytes --]


dme.
-- 
David Edmondson, http://dme.org

Re: [rfc] improved wrapping of long lines

[David Edmondson]

[-- Attachment #1: Type: text/plain, Size: 599 bytes --]

On Tue, 16 Feb 2010 09:10:23 +0000, David Edmondson <dme@dme.org> wrote:
> It's annoying that the wrapping of long lines doesn't respect the
> indentation of the message. Here's an attempt to improve that.
> 
> The wrapping code is in a separate file and has a silly name[1], but all
> of that is subject to change at the whim of Carl or his minions.
> 
> If anyone tries this then I'd be interested in your feedback,
> particularly if it doesn't work or doesn't look the way that you expect.
> 
> Footnotes: 
> [1]  It's a long-line wrapper...

Here's a better version, derived from longlines.el.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-notmuch.el-Improved-wrapping-of-long-lines-respect-t.patch --]
[-- Type: text/x-diff, Size: 7809 bytes --]

From 0fc142a4e8fd4b8648bfdf2246759af1fc31c997 Mon Sep 17 00:00:00 2001
From: David Edmondson <dme@dme.org>
Date: Tue, 16 Feb 2010 13:34:29 +0000
Subject: [PATCH] notmuch.el: Improved wrapping of long lines - respect the indentation
 level.

---
 Makefile.local |    8 ++-
 coolj.el       |  145 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 notmuch.el     |    8 ++-
 3 files changed, 156 insertions(+), 5 deletions(-)
 create mode 100644 coolj.el

diff --git a/Makefile.local b/Makefile.local
index 04bac83..0a1f203 100644
--- a/Makefile.local
+++ b/Makefile.local
@@ -1,4 +1,6 @@
-emacs: notmuch.elc
+# -*- mode:makefile -*-
+
+emacs: notmuch.elc coolj.elc
 
 notmuch_client_srcs =		\
 	$(notmuch_compat_srcs)	\
@@ -42,6 +44,8 @@ install-emacs: install emacs
 	done ;
 	install -m0644 notmuch.el $(DESTDIR)$(emacs_lispdir)
 	install -m0644 notmuch.elc $(DESTDIR)$(emacs_lispdir)
+	install -m0644 coolj.el $(DESTDIR)$(emacs_lispdir)
+	install -m0644 coolj.elc $(DESTDIR)$(emacs_lispdir)
 
 install-desktop:
 	install -d $(DESTDIR)$(desktop_dir)
@@ -58,4 +62,4 @@ install-zsh:
 		$(DESTDIR)$(zsh_completion_dir)/notmuch
 
 SRCS  := $(SRCS) $(notmuch_client_srcs)
-CLEAN := $(CLEAN) notmuch $(notmuch_client_modules) notmuch.elc notmuch.1.gz
+CLEAN := $(CLEAN) notmuch $(notmuch_client_modules) notmuch.elc coolj.elc notmuch.1.gz
diff --git a/coolj.el b/coolj.el
new file mode 100644
index 0000000..77187dc
--- /dev/null
+++ b/coolj.el
@@ -0,0 +1,145 @@
+;;; coolj.el --- automatically wrap long lines  -*- coding:utf-8 -*-
+
+;; Copyright (C) 2000, 2001, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
+
+;; Authors:    Kai Grossjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+;;             Alex Schroeder <alex@gnu.org>
+;;             Chong Yidong <cyd@stupidchicken.com>
+;; Maintainer: David Edmondson <dme@dme.org>
+;; Keywords: convenience, wp
+
+;; This file is not part of GNU Emacs.
+
+;; GNU Emacs 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 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs 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, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; This is a simple derivative of some functionality from
+;;; `longlines.el'. The key difference is that this version will
+;;; insert a prefix at the head of each wrapped line. The prefix is
+;;; calculated from the originating long line.
+
+;;; No minor-mode is provided, the caller is expected to call
+;;; `coolj-wrap-region' to wrap the region of interest.
+
+;;; Code:
+
+(defgroup coolj nil
+  "Wrapping of long lines with prefix."
+  :group 'fill)
+
+(defcustom coolj-wrap-follows-window-size t
+  "Non-nil means wrap text to the window size.
+Otherwise respect `fill-column'."
+  :group 'coolj
+  :type 'boolean)
+
+(defcustom coolj-line-prefix-regexp "^ *\\(>+ \\)*"
+  "Regular expression that matches line prefixes."
+  :group 'coolj
+  :type 'regexp)
+
+(defvar coolj-wrap-point nil)
+
+(make-variable-buffer-local 'coolj-wrap-point)
+
+(defun coolj-determine-prefix ()
+  "Determine the prefix for the current line."
+  (save-excursion
+    (beginning-of-line)
+    (if (re-search-forward coolj-line-prefix-regexp nil t)
+	(buffer-substring (match-beginning 0) (match-end 0))
+      "")))
+
+(defun coolj-wrap-buffer ()
+  "Wrap the current buffer."
+  (coolj-wrap-region (point-min) (point-max)))
+
+(defun coolj-wrap-region (beg end)
+  "Wrap each successive line, starting with the line before BEG.
+Stop when we reach lines after END that don't need wrapping, or the
+end of the buffer."
+  (setq fill-column (if coolj-wrap-follows-window-size
+			(window-width)
+		      fill-column))
+  (let ((mod (buffer-modified-p)))
+    (setq coolj-wrap-point (point))
+    (goto-char beg)
+    (forward-line -1)
+    ;; Two successful coolj-wrap-line's in a row mean successive
+    ;; lines don't need wrapping.
+    (while (null (and (coolj-wrap-line)
+		      (or (eobp)
+			  (and (>= (point) end)
+			       (coolj-wrap-line))))))
+    (goto-char coolj-wrap-point)
+    (set-buffer-modified-p mod)))
+
+(defun coolj-wrap-line ()
+  "If the current line needs to be wrapped, wrap it and return nil.
+If wrapping is performed, point remains on the line.  If the line does
+not need to be wrapped, move point to the next line and return t."
+  (let ((prefix (coolj-determine-prefix)))
+    (if (coolj-set-breakpoint prefix)
+	(progn
+	  (insert-before-markers ?\n)
+	  (backward-char 1)
+	  (delete-char -1)
+	  (forward-char 1)
+	  (insert-before-markers prefix)
+	  nil)
+      (forward-line 1)
+      t)))
+
+(defun coolj-set-breakpoint (prefix)
+  "Place point where we should break the current line, and return t.
+If the line should not be broken, return nil; point remains on the
+line."
+  (move-to-column fill-column)
+  (if (and (re-search-forward "[^ ]" (line-end-position) 1)
+           (> (current-column) fill-column))
+      ;; This line is too long.  Can we break it?
+      (or (coolj-find-break-backward prefix)
+          (progn (move-to-column fill-column)
+                 (coolj-find-break-forward)))))
+
+(defun coolj-find-break-backward (prefix)
+  "Move point backward to the first available breakpoint and return t.
+If no breakpoint is found, return nil."
+  (let ((end-of-prefix (+ (line-beginning-position) (length prefix))))
+    (and (search-backward " " end-of-prefix 1)
+	 (save-excursion
+	   (skip-chars-backward " " end-of-prefix)
+	   (null (bolp)))
+	 (progn (forward-char 1)
+		(if (and fill-nobreak-predicate
+			 (run-hook-with-args-until-success
+			  'fill-nobreak-predicate))
+		    (progn (skip-chars-backward " " end-of-prefix)
+			   (coolj-find-break-backward prefix))
+		  t)))))
+
+(defun coolj-find-break-forward ()
+  "Move point forward to the first available breakpoint and return t.
+If no break point is found, return nil."
+  (and (search-forward " " (line-end-position) 1)
+       (progn (skip-chars-forward " " (line-end-position))
+              (null (eolp)))
+       (if (and fill-nobreak-predicate
+                (run-hook-with-args-until-success
+                 'fill-nobreak-predicate))
+           (coolj-find-break-forward)
+         t)))
+
+(provide 'coolj)
diff --git a/notmuch.el b/notmuch.el
index ea74a72..8ff82ee 100644
--- a/notmuch.el
+++ b/notmuch.el
@@ -50,6 +50,7 @@
 (require 'cl)
 (require 'mm-view)
 (require 'message)
+(require 'coolj)
 
 (defvar notmuch-show-mode-map
   (let ((map (make-sparse-keymap)))
@@ -777,7 +778,9 @@ is what to put on the button."
                           (mm-display-part mime-message))))
                 )
 	      (if (equal mime-type "text/plain")
-		  (notmuch-show-markup-citations-region beg end depth))
+		  (progn
+		    (coolj-wrap-region beg end)
+		    (notmuch-show-markup-citations-region beg end depth)))
               ; Advance to the next part (if any) (so the outer loop can
               ; determine whether we've left the current message.
               (if (re-search-forward notmuch-show-buttonize-begin-regexp nil t)
@@ -1053,8 +1056,7 @@ All currently available key bindings:
 ; Make show mode a bit prettier, highlighting URLs and using word wrap
 
 (defun notmuch-show-pretty-hook ()
-  (goto-address-mode 1)
-  (visual-line-mode))
+  (goto-address-mode 1))
 
 (add-hook 'notmuch-show-hook 'notmuch-show-pretty-hook)
 (add-hook 'notmuch-search-hook
-- 
1.6.6.1


[-- Attachment #3: Type: text/plain, Size: 42 bytes --]


dme.
-- 
David Edmondson, http://dme.org