* Re: [rfc] improved wrapping of long lines
2010-02-16 9:10 [rfc] improved wrapping of long lines David Edmondson
@ 2010-02-16 13:36 ` David Edmondson
0 siblings, 0 replies; 2+ messages in thread
From: David Edmondson @ 2010-02-16 13:36 UTC (permalink / raw)
To: notmuch
[-- 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
^ permalink raw reply related [flat|nested] 2+ messages in thread