]> git.notmuchmail.org Git - notmuch/blobdiff - emacs/notmuch-wash.el
Merge branch 'release'
[notmuch] / emacs / notmuch-wash.el
index 5c1e83009eec56a4d5073806be2d9ea93c2d4a94..826b6f43c77ba6853a32f65ad82b67af0a52271c 100644 (file)
@@ -87,11 +87,19 @@ If there is one more line than the sum of
 `notmuch-wash-citation-lines-suffix', show that, otherwise
 collapse the remaining lines into a button.")
 
+(defvar notmuch-wash-wrap-lines-length nil
+  "Wrap line after at most this many characters.
+
+If this is nil, lines in messages will be wrapped to fit in the
+current window. If this is a number, lines will be wrapped after
+this many characters or at the window width (whichever one is
+lower).")
+
 (defun notmuch-wash-toggle-invisible-action (cite-button)
-  (let ((invis-spec (button-get cite-button 'invisibility-spec)))
-    (if (invisible-p invis-spec)
-       (remove-from-invisibility-spec invis-spec)
-      (add-to-invisibility-spec invis-spec)))
+  ;; Toggle overlay visibility
+  (let ((overlay (button-get cite-button 'overlay)))
+    (overlay-put overlay 'invisible (not (overlay-get overlay 'invisible))))
+  ;; Update button text
   (let* ((new-start (button-start cite-button))
         (overlay (button-get cite-button 'overlay))
         (button-label (notmuch-wash-button-label overlay))
@@ -102,14 +110,13 @@ collapse the remaining lines into a button.")
     (let ((old-end (button-end cite-button)))
       (move-overlay cite-button new-start (point))
       (delete-region (point) old-end))
-    (goto-char (min old-point (1- (button-end cite-button)))))
-  (force-window-update)
-  (redisplay t))
+    (goto-char (min old-point (1- (button-end cite-button))))))
 
 (define-button-type 'notmuch-wash-button-invisibility-toggle-type
   'action 'notmuch-wash-toggle-invisible-action
   'follow-link t
-  'face 'font-lock-comment-face)
+  'face 'font-lock-comment-face
+  :supertype 'notmuch-button-type)
 
 (define-button-type 'notmuch-wash-button-citation-toggle-type
   'help-echo "mouse-1, RET: Show citation"
@@ -124,8 +131,8 @@ collapse the remaining lines into a button.")
   :supertype 'notmuch-wash-button-invisibility-toggle-type)
 
 (defun notmuch-wash-region-isearch-show (overlay)
-  (dolist (invis-spec (overlay-get overlay 'invisible))
-    (remove-from-invisibility-spec invis-spec)))
+  (notmuch-wash-toggle-invisible-action
+   (overlay-get overlay 'notmuch-wash-button)))
 
 (defun notmuch-wash-button-label (overlay)
   (let* ((type (overlay-get overlay 'type))
@@ -136,12 +143,13 @@ collapse the remaining lines into a button.")
         (lines-count (count-lines (overlay-start overlay) (overlay-end overlay))))
     (format label-format lines-count)))
 
-(defun notmuch-wash-region-to-button (msg beg end type prefix)
+(defun notmuch-wash-region-to-button (msg beg end type &optional prefix)
   "Auxiliary function to do the actual making of overlays and buttons
 
 BEG and END are buffer locations. TYPE should a string, either
-\"citation\" or \"signature\". PREFIX is some arbitrary text to
-insert before the button, probably for indentation."
+\"citation\" or \"signature\". Optional PREFIX is some arbitrary
+text to insert before the button, probably for indentation.  Note
+that PREFIX should not include a newline."
 
   ;; This uses some slightly tricky conversions between strings and
   ;; symbols because of the way the button code works. Note that
@@ -149,23 +157,22 @@ insert before the button, probably for indentation."
   ;; since the newly created symbol has no plist.
 
   (let ((overlay (make-overlay beg end))
-       (message-invis-spec (plist-get msg :message-invis-spec))
-       (invis-spec (make-symbol (concat "notmuch-" type "-region")))
        (button-type (intern-soft (concat "notmuch-wash-button-"
                                          type "-toggle-type"))))
-    (add-to-invisibility-spec invis-spec)
-    (overlay-put overlay 'invisible (list invis-spec message-invis-spec))
+    (overlay-put overlay 'invisible t)
     (overlay-put overlay 'isearch-open-invisible #'notmuch-wash-region-isearch-show)
-    (overlay-put overlay 'priority 10)
     (overlay-put overlay 'type type)
     (goto-char (1+ end))
     (save-excursion
-      (goto-char (1- beg))
-      (insert prefix)
-      (insert-button (notmuch-wash-button-label overlay)
-                    'invisibility-spec invis-spec
-                    'overlay overlay
-                    :type button-type))))
+      (goto-char beg)
+      (if prefix
+         (insert-before-markers prefix))
+      (let ((button-beg (point)))
+       (insert-before-markers (notmuch-wash-button-label overlay) "\n")
+       (let ((button (make-button button-beg (1- (point))
+                                  'overlay overlay
+                                  :type button-type)))
+         (overlay-put overlay 'notmuch-wash-button button))))))
 
 (defun notmuch-wash-excerpt-citations (msg depth)
   "Excerpt citations and up to one signature."
@@ -177,7 +184,7 @@ insert before the button, probably for indentation."
             (msg-end (point-max))
             (msg-lines (count-lines msg-start msg-end)))
        (notmuch-wash-region-to-button
-        msg msg-start msg-end "original" "\n")))
+        msg msg-start msg-end "original")))
   (while (and (< (point) (point-max))
              (re-search-forward notmuch-wash-citation-regexp nil t))
     (let* ((cite-start (match-beginning 0))
@@ -194,7 +201,7 @@ insert before the button, probably for indentation."
          (forward-line (- notmuch-wash-citation-lines-suffix))
          (notmuch-wash-region-to-button
           msg hidden-start (point-marker)
-          "citation" "\n")))))
+          "citation")))))
   (if (and (not (eobp))
           (re-search-forward notmuch-wash-signature-regexp nil t))
       (let* ((sig-start (match-beginning 0))
@@ -208,7 +215,7 @@ insert before the button, probably for indentation."
              (overlay-put (make-overlay sig-start-marker sig-end-marker) 'face 'message-cited-text)
              (notmuch-wash-region-to-button
               msg sig-start-marker sig-end-marker
-              "signature" "\n"))))))
+              "signature"))))))
 
 ;;
 
@@ -272,16 +279,24 @@ Perform several transformations on the message body:
 ;;
 
 (defun notmuch-wash-wrap-long-lines (msg depth)
-  "Wrap any long lines in the message to the width of the window.
-
-When doing so, maintaining citation leaders in the wrapped text."
-
-  (let ((coolj-wrap-follows-window-size nil)
-       (fill-column (- (window-width)
-                       depth
-                       ;; 2 to avoid poor interaction with
-                       ;; `word-wrap'.
-                       2)))
+  "Wrap long lines in the message.
+
+If `notmuch-wash-wrap-lines-length' is a number, this will wrap
+the message lines to the minimum of the width of the window or
+its value. Otherwise, this function will wrap long lines in the
+message at the window width. When doing so, citation leaders in
+the wrapped text are maintained."
+
+  (let* ((coolj-wrap-follows-window-size nil)
+        (limit (if (numberp notmuch-wash-wrap-lines-length)
+                   (min notmuch-wash-wrap-lines-length
+                        (window-width))
+                 (window-width)))
+        (fill-column (- limit
+                        depth
+                        ;; 2 to avoid poor interaction with
+                        ;; `word-wrap'.
+                        2)))
     (coolj-wrap-region (point-min) (point-max))))
 
 ;;
@@ -336,97 +351,29 @@ patch and then guesses the extent of the patch, there is scope
 for error."
 
   (goto-char (point-min))
-  (if (re-search-forward diff-file-header-re nil t)
-      (progn
-       (beginning-of-line -1)
-       (let ((patch-start (point))
-             (patch-end (point-max))
-             part)
-         (goto-char patch-start)
-         (if (or
-              ;; Patch ends with signature.
-              (re-search-forward notmuch-wash-signature-regexp nil t)
-              ;; Patch ends with bugtraq comment.
-              (re-search-forward "^\\*\\*\\* " nil t))
-             (setq patch-end (match-beginning 0)))
-         (save-restriction
-           (narrow-to-region patch-start patch-end)
-           (setq part (plist-put part :content-type "inline-patch-fake-part"))
-           (setq part (plist-put part :content (buffer-string)))
-           (setq part (plist-put part :id -1))
-           (setq part (plist-put part :filename
-                                 (notmuch-wash-subject-to-patch-filename
-                                  (plist-get
-                                   (plist-get msg :headers) :Subject))))
-           (delete-region (point-min) (point-max))
-           (notmuch-show-insert-bodypart nil part depth))))))
-
-;;
-
-;; Temporary workaround for Emacs bug #8721
-;; http://debbugs.gnu.org/cgi/bugreport.cgi?bug=8721
-
-(defun notmuch-isearch-range-invisible (beg end)
-  "Same as `isearch-range-invisible' but with fixed Emacs bug #8721."
-  (when (/= beg end)
-    ;; Check that invisibility runs up to END.
-    (save-excursion
-      (goto-char beg)
-      (let (;; can-be-opened keeps track if we can open some overlays.
-           (can-be-opened (eq search-invisible 'open))
-           ;; the list of overlays that could be opened
-           (crt-overlays nil))
-       (when (and can-be-opened isearch-hide-immediately)
-         (isearch-close-unnecessary-overlays beg end))
-       ;; If the following character is currently invisible,
-       ;; skip all characters with that same `invisible' property value.
-       ;; Do that over and over.
-       (while (and (< (point) end) (invisible-p (point)))
-         (if (invisible-p (get-text-property (point) 'invisible))
-             (progn
-               (goto-char (next-single-property-change (point) 'invisible
-                                                       nil end))
-               ;; if text is hidden by an `invisible' text property
-               ;; we cannot open it at all.
-               (setq can-be-opened nil))
-           (when can-be-opened
-             (let ((overlays (overlays-at (point)))
-                   ov-list
-                   o
-                   invis-prop)
-               (while overlays
-                 (setq o (car overlays)
-                       invis-prop (overlay-get o 'invisible))
-                 (if (invisible-p invis-prop)
-                     (if (overlay-get o 'isearch-open-invisible)
-                         (setq ov-list (cons o ov-list))
-                       ;; We found one overlay that cannot be
-                       ;; opened, that means the whole chunk
-                       ;; cannot be opened.
-                       (setq can-be-opened nil)))
-                 (setq overlays (cdr overlays)))
-               (if can-be-opened
-                   ;; It makes sense to append to the open
-                   ;; overlays list only if we know that this is
-                   ;; t.
-                   (setq crt-overlays (append ov-list crt-overlays)))))
-           (goto-char (next-overlay-change (point)))))
-       ;; See if invisibility reaches up thru END.
-       (if (>= (point) end)
-           (if (and can-be-opened (consp crt-overlays))
-               (progn
-                 (setq isearch-opened-overlays
-                       (append isearch-opened-overlays crt-overlays))
-                 (mapc 'isearch-open-overlay-temporary crt-overlays)
-                 nil)
-             (setq isearch-hidden t)))))))
-
-(defadvice isearch-range-invisible (around notmuch-isearch-range-invisible-advice activate)
-  "Call `notmuch-isearch-range-invisible' instead of the original
-`isearch-range-invisible' when in `notmuch-show-mode' mode."
-  (if (eq major-mode 'notmuch-show-mode)
-      (setq ad-return-value (notmuch-isearch-range-invisible beg end))
-    ad-do-it))
+  (when (re-search-forward diff-file-header-re nil t)
+    (beginning-of-line -1)
+    (let ((patch-start (point))
+         (patch-end (point-max))
+         part)
+      (goto-char patch-start)
+      (if (or
+          ;; Patch ends with signature.
+          (re-search-forward notmuch-wash-signature-regexp nil t)
+          ;; Patch ends with bugtraq comment.
+          (re-search-forward "^\\*\\*\\* " nil t))
+         (setq patch-end (match-beginning 0)))
+      (save-restriction
+       (narrow-to-region patch-start patch-end)
+       (setq part (plist-put part :content-type "inline-patch-fake-part"))
+       (setq part (plist-put part :content (buffer-string)))
+       (setq part (plist-put part :id -1))
+       (setq part (plist-put part :filename
+                             (notmuch-wash-subject-to-patch-filename
+                              (plist-get
+                               (plist-get msg :headers) :Subject))))
+       (delete-region (point-min) (point-max))
+       (notmuch-show-insert-bodypart nil part depth)))))
 
 ;;