lib: add interface to delete directory documents

[notmuch] / emacs / notmuch-wash.el

diff --git a/emacs/notmuch-wash.el b/emacs/notmuch-wash.el
index 7d003a2d34b94974e63a7099f144508988a2b7f6..a76b4f5b589ab0d0f1ada7ced2bc024e31a5b91b 100644 (file)
--- a/emacs/notmuch-wash.el
+++ b/emacs/notmuch-wash.el
@@ -23,101 +23,145 @@
 
 (require 'coolj)
 
 
 (require 'coolj)
 

-(declare-function notmuch-show-insert-bodypart "notmuch-show" (msg part depth))
+(declare-function notmuch-show-insert-bodypart "notmuch-show" (msg part depth &optional hide))

 
 ;;
 
 
 ;;
 

-(defvar notmuch-wash-signature-regexp
-  "^\\(-- ?\\|_+\\)$"
-  "Pattern to match a line that separates content from signature.")
+(defgroup notmuch-wash nil
+  "Cleaning up messages for display."
+  :group 'notmuch)

 
 

-(defvar notmuch-wash-citation-regexp
-  "\\(^[[:space:]]*>.*\n\\)+"
-  "Pattern to match citation lines.")
+(defcustom notmuch-wash-signature-regexp "^\\(-- ?\\|_+\\)$"
+  "Pattern to match a line that separates content from signature."
+  :type 'regexp
+  :group 'notmuch-wash)

 
 

-(defvar notmuch-wash-original-regexp "^\\(--+\s?[oO]riginal [mM]essage\s?--+\\)$"
-  "Pattern to match a line that separates original message from reply in top-posted message.")
+(defcustom notmuch-wash-citation-regexp "\\(^[[:space:]]*>.*\n\\)+"
+  "Pattern to match citation lines."
+  :type 'regexp
+  :group 'notmuch-wash)

 
 

-(defvar notmuch-wash-button-signature-hidden-format
+(defcustom notmuch-wash-original-regexp "^\\(--+\s?[oO]riginal [mM]essage\s?--+\\)$"
+  "Pattern to match a line that separates original message from
+reply in top-posted message."
+  :type 'regexp
+  :group 'notmuch-wash)
+
+(defcustom notmuch-wash-button-signature-hidden-format

   "[ %d-line signature. Click/Enter to show. ]"
   "String used to construct button text for hidden signatures.
   "[ %d-line signature. Click/Enter to show. ]"
   "String used to construct button text for hidden signatures.

-Can use up to one integer format parameter, i.e. %d")
+Can use up to one integer format parameter, i.e. %d."
+  :type 'string
+  :group 'notmuch-wash)

 
 

-(defvar notmuch-wash-button-signature-visible-format
+(defcustom notmuch-wash-button-signature-visible-format

   "[ %d-line signature. Click/Enter to hide. ]"
   "String used to construct button text for visible signatures.
   "[ %d-line signature. Click/Enter to hide. ]"
   "String used to construct button text for visible signatures.

-Can use up to one integer format parameter, i.e. %d")
+Can use up to one integer format parameter, i.e. %d."
+  :type 'string
+  :group 'notmuch-wash)

 
 

-(defvar notmuch-wash-button-citation-hidden-format
+(defcustom notmuch-wash-button-citation-hidden-format

   "[ %d more citation lines. Click/Enter to show. ]"
   "String used to construct button text for hidden citations.
   "[ %d more citation lines. Click/Enter to show. ]"
   "String used to construct button text for hidden citations.

-Can use up to one integer format parameter, i.e. %d")
+Can use up to one integer format parameter, i.e. %d."
+  :type 'string
+  :group 'notmuch-wash)

 
 

-(defvar notmuch-wash-button-citation-visible-format
+(defcustom notmuch-wash-button-citation-visible-format

   "[ %d more citation lines. Click/Enter to hide. ]"
   "String used to construct button text for visible citations.
   "[ %d more citation lines. Click/Enter to hide. ]"
   "String used to construct button text for visible citations.

-Can use up to one integer format parameter, i.e. %d")
+Can use up to one integer format parameter, i.e. %d."
+  :type 'string
+  :group 'notmuch-wash)

 
 

-(defvar notmuch-wash-button-original-hidden-format
+(defcustom notmuch-wash-button-original-hidden-format

   "[ %d-line hidden original message. Click/Enter to show. ]"
   "String used to construct button text for hidden citations.
   "[ %d-line hidden original message. Click/Enter to show. ]"
   "String used to construct button text for hidden citations.

-Can use up to one integer format parameter, i.e. %d")
+Can use up to one integer format parameter, i.e. %d."
+  :type 'string
+  :group 'notmuch-wash)

 
 

-(defvar notmuch-wash-button-original-visible-format
+(defcustom notmuch-wash-button-original-visible-format

   "[ %d-line original message. Click/Enter to hide. ]"
   "String used to construct button text for visible citations.
   "[ %d-line original message. Click/Enter to hide. ]"
   "String used to construct button text for visible citations.

-Can use up to one integer format parameter, i.e. %d")
+Can use up to one integer format parameter, i.e. %d."
+  :type 'string
+  :group 'notmuch-wash)

 
 

-(defvar notmuch-wash-signature-lines-max 12
-  "Maximum length of signature that will be hidden by default.")
+(defcustom notmuch-wash-signature-lines-max 12
+  "Maximum length of signature that will be hidden by default."
+  :type 'integer
+  :group 'notmuch-wash)

 
 

-(defvar notmuch-wash-citation-lines-prefix 3
+(defcustom notmuch-wash-citation-lines-prefix 3

   "Always show at least this many lines from the start of a citation.
 
 If there is one more line than the sum of
 `notmuch-wash-citation-lines-prefix' and
 `notmuch-wash-citation-lines-suffix', show that, otherwise
   "Always show at least this many lines from the start of a citation.
 
 If there is one more line than the sum of
 `notmuch-wash-citation-lines-prefix' and
 `notmuch-wash-citation-lines-suffix', show that, otherwise

-collapse the remaining lines into a button.")
+collapse the remaining lines into a button."
+  :type 'integer
+  :group 'notmuch-wash)

 
 

-(defvar notmuch-wash-citation-lines-suffix 3
+(defcustom notmuch-wash-citation-lines-suffix 3

   "Always show at least this many lines from the end of a citation.
 
 If there is one more line than the sum of
 `notmuch-wash-citation-lines-prefix' and
 `notmuch-wash-citation-lines-suffix', show that, otherwise
   "Always show at least this many lines from the end of a citation.
 
 If there is one more line than the sum of
 `notmuch-wash-citation-lines-prefix' and
 `notmuch-wash-citation-lines-suffix', show that, otherwise

-collapse the remaining lines into a button.")
+collapse the remaining lines into a button."
+  :type 'integer
+  :group 'notmuch-wash)

 
 

-(defvar notmuch-wash-wrap-lines-length nil
+(defcustom 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
   "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).")
+lower)."
+  :type '(choice (const :tag "window width" nil)
+                (integer :tag "number of characters"))
+  :group 'notmuch-wash)
+
+(defface notmuch-wash-toggle-button
+  '((t (:inherit font-lock-comment-face)))
+  "Face used for buttons toggling the visibility of washed away
+message parts."
+  :group 'notmuch-wash
+  :group 'notmuch-faces)
+
+(defface notmuch-wash-cited-text
+  '((t (:inherit message-cited-text)))
+  "Face used for cited text."
+  :group 'notmuch-wash
+  :group 'notmuch-faces)

 
 (defun notmuch-wash-toggle-invisible-action (cite-button)
 
 (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))
         (old-point (point))
   (let* ((new-start (button-start cite-button))
         (overlay (button-get cite-button 'overlay))
         (button-label (notmuch-wash-button-label overlay))
         (old-point (point))

+        (properties (text-properties-at (point)))

         (inhibit-read-only t))
     (goto-char new-start)
     (insert button-label)
         (inhibit-read-only t))
     (goto-char new-start)
     (insert button-label)

+    (set-text-properties new-start (point) properties)

     (let ((old-end (button-end cite-button)))
       (move-overlay cite-button new-start (point))
       (delete-region (point) old-end))
     (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
 
 (define-button-type 'notmuch-wash-button-invisibility-toggle-type
   'action 'notmuch-wash-toggle-invisible-action
   'follow-link t

-  'face 'font-lock-comment-face)
+  'face 'notmuch-wash-toggle-button
+  :supertype 'notmuch-button-type)

 
 (define-button-type 'notmuch-wash-button-citation-toggle-type
   'help-echo "mouse-1, RET: Show citation"
 
 (define-button-type 'notmuch-wash-button-citation-toggle-type
   'help-echo "mouse-1, RET: Show citation"


@@ -132,8 +176,8 @@ lower).")
   :supertype 'notmuch-wash-button-invisibility-toggle-type)
 
 (defun notmuch-wash-region-isearch-show (overlay)
   :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))
 
 (defun notmuch-wash-button-label (overlay)
   (let* ((type (overlay-get overlay 'type))


@@ -158,14 +202,10 @@ that PREFIX should not include a newline."
   ;; since the newly created symbol has no plist.
 
   (let ((overlay (make-overlay beg end))
   ;; 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"))))
        (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 'isearch-open-invisible #'notmuch-wash-region-isearch-show)

-    (overlay-put overlay 'priority 10)

     (overlay-put overlay 'type type)
     (goto-char (1+ end))
     (save-excursion
     (overlay-put overlay 'type type)
     (goto-char (1+ end))
     (save-excursion


@@ -174,10 +214,10 @@ that PREFIX should not include a newline."
          (insert-before-markers prefix))
       (let ((button-beg (point)))
        (insert-before-markers (notmuch-wash-button-label overlay) "\n")
          (insert-before-markers prefix))
       (let ((button-beg (point)))
        (insert-before-markers (notmuch-wash-button-label overlay) "\n")

-       (make-button button-beg (1- (point))
-                    'invisibility-spec invis-spec
-                    'overlay overlay
-                    :type button-type)))))
+       (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."
 
 (defun notmuch-wash-excerpt-citations (msg depth)
   "Excerpt citations and up to one signature."


@@ -195,7 +235,7 @@ that PREFIX should not include a newline."
     (let* ((cite-start (match-beginning 0))
           (cite-end (match-end 0))
           (cite-lines (count-lines cite-start cite-end)))
     (let* ((cite-start (match-beginning 0))
           (cite-end (match-end 0))
           (cite-lines (count-lines cite-start cite-end)))

-      (overlay-put (make-overlay cite-start cite-end) 'face 'message-cited-text)
+      (overlay-put (make-overlay cite-start cite-end) 'face 'notmuch-wash-cited-text)

       (when (> cite-lines (+ notmuch-wash-citation-lines-prefix
                             notmuch-wash-citation-lines-suffix
                             1))
       (when (> cite-lines (+ notmuch-wash-citation-lines-prefix
                             notmuch-wash-citation-lines-suffix
                             1))


@@ -370,7 +410,7 @@ for error."
          (setq patch-end (match-beginning 0)))
       (save-restriction
        (narrow-to-region patch-start patch-end)
          (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-type "inline patch"))

        (setq part (plist-put part :content (buffer-string)))
        (setq part (plist-put part :id -1))
        (setq part (plist-put part :filename
        (setq part (plist-put part :content (buffer-string)))
        (setq part (plist-put part :id -1))
        (setq part (plist-put part :filename


@@ -382,71 +422,4 @@ for error."
 
 ;;
 
 
 ;;
 

-;; 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))
-
-;;
-

 (provide 'notmuch-wash)
 (provide 'notmuch-wash)