Import Oort Gnus v0.09.

[elisp/gnus.git-] / lisp / deuglify.el

diff --git a/lisp/deuglify.el b/lisp/deuglify.el
index e3a9bf3..81ba9e9 100644 (file)
--- a/lisp/deuglify.el
+++ b/lisp/deuglify.el
@@ -230,8 +230,7 @@
 ;;; User Customizable Variables:
 
 (defgroup gnus-outlook-deuglify nil
-  "Deuglify articles generated by broken user agents like MS 
-Outlook (Express).")
+  "Deuglify articles generated by broken user agents like MS Outlook (Express).")
 
 ;;;###autoload
 (defcustom gnus-outlook-deuglify-unwrap-min 45
@@ -251,21 +250,18 @@ Outlook (Express).")
   :group 'gnus-outlook-deuglify)
 
 (defcustom gnus-outlook-deuglify-unwrap-stop-chars nil ;; ".?!" or nil
-  "Characters that inhibit unwrapping if they are the last one on the
-cited line above the possible wrapped line."
+  "Characters that inhibit unwrapping if they are the last one on the cited line above the possible wrapped line."
   :type 'string
   :group 'gnus-outlook-deuglify)
 
 (defcustom gnus-outlook-deuglify-no-wrap-chars "`"
-  "Characters that inhibit unwrapping if they are the first one in the
-possibly wrapped line."
+  "Characters that inhibit unwrapping if they are the first one in the possibly wrapped line."
   :type 'string
   :group 'gnus-outlook-deuglify)
 
 (defcustom  gnus-outlook-deuglify-attrib-cut-regexp
   "\\(On \\|Am \\)?\\(Mon\\|Tue\\|Wed\\|Thu\\|Fri\\|Sat\\|Sun\\),[^,]+, "
-  "Regular expression matching the beginning of an attribution line
-that should be cut off."
+  "Regular expression matching the beginning of an attribution line that should be cut off."
   :type 'string
   :group 'gnus-outlook-deuglify)
 
@@ -284,11 +280,10 @@ that should be cut off."
 
 ;; Functions
 
-;; TODO: don't kill MIME parts
 ;;;###autoload
 (defun gnus-outlook-unwrap-lines ()
-  "Unwrap lines that appear to be wrapped citation lines.  You can
-control what lines will be unwrapped by frobbing
+  "Unwrap lines that appear to be wrapped citation lines.
+You can control what lines will be unwrapped by frobbing
 `gnus-outlook-deuglify-unwrap-min' and
 `gnus-outlook-deuglify-unwrap-max', indicating the miminum and maximum
 length of an unwrapped citation line."
@@ -315,20 +310,26 @@ length of an unwrapped citation line."
                  (replace-match "\\1\\2 \\3")
                  (goto-char (match-beginning 0))))))))))
 
-;; TODO: respect signatures, don't kill MIME parts
-(defun gnus-outlook-rearrange-article (from-where)
-  "Put the text from `from-where' to the end of buffer at the top of
-the article buffer."
+(defun gnus-outlook-rearrange-article (attr-start)
+  "Put the text from `attr-start' to the end of buffer at the top of the article buffer."
   (save-excursion
     (let ((inhibit-read-only t)
          (cite-marks gnus-outlook-deuglify-cite-marks))
       (gnus-with-article-buffer
-       (unless (search-forward-regexp
-                  (concat "^[ \t]*[^" cite-marks "\n]") nil t)
-         (kill-region from-where (point-max))
-         (article-goto-body)
-         (yank)
-         (insert "\n"))))))
+       (article-goto-body)
+       ;; article does not start with attribution
+       (unless (= (point) attr-start)
+         (gnus-kill-all-overlays)
+         (let ((cur (point))
+               ;; before signature or end of buffer
+               (to (if (gnus-article-search-signature)
+                       (point)
+                     (point-max))))
+           ;; handle the case where the full quote is below the
+           ;; signature
+           (if (< to attr-start)
+               (setq to (point-max)))
+           (transpose-regions cur attr-start attr-start to)))))))
 
 ;; John Doe <john.doe@some.domain> wrote in message
 ;; news:a87usw8$dklsssa$2@some.news.server...
@@ -348,6 +349,7 @@ the article buffer."
                     "\\(" gnus-outlook-deuglify-attrib-end-regexp "\\)$")
             nil t)
            (progn
+             (gnus-kill-all-overlays)
              (replace-match "\\1\\2\\4")
              (match-beginning 0)))))))
 
@@ -367,14 +369,13 @@ the article buffer."
       (gnus-with-article-buffer
        (article-goto-body)
        (if (re-search-forward
-            (concat "^----* ?[^-]+ ?----*\n"
-                    "[^\n]+: \\([^\n]+\\)\n"
-                    "[^\n]+: [^\n]+\n"
-                    "[^\n]+: [^\n]+\n"
-                    "[^\n]+: [^\n]+$")
+            (concat "^[" cite-marks " \t]*----* ?[^-]+ [^-]+ ?----*\n"
+                    "[^\n:]+:[ \t]*\\([^\n]+\\)\n"
+                    "\\([^\n:]+:[ \t]*[^\n]+\n\\)+")
             nil t)
            (progn
-             (replace-match "\\1 wrote:")
+             (gnus-kill-all-overlays)
+             (replace-match "\\1 wrote:\n")
              (match-beginning 0)))))))
 
 ;; On Wed, 16 Jan 2002 23:23:30 +0100, John Doe <john.doe@some.domain> wrote:
@@ -394,6 +395,7 @@ the article buffer."
                     "\\(" gnus-outlook-deuglify-attrib-end-regexp "\\)$")
             nil t)
            (progn
+             (gnus-kill-all-overlays)
              (replace-match "\\4 \\5\\6\\7")
              (match-beginning 0)))))))
 
@@ -430,7 +432,13 @@ the article buffer."
   (interactive)
   (gnus-outlook-deuglify-article)
   (with-current-buffer (or gnus-article-buffer (current-buffer))
-    (gnus-article-prepare-display)))
+    ;; "Emulate" `gnus-article-prepare-display' without calling
+    ;; it. Calling `gnus-article-prepare-display' on an already
+    ;; prepared article removes all MIME parts.  I'm unsure whether
+    ;; this is a bug or not.
+    (gnus-article-highlight t)
+    (gnus-treat-article nil)
+    (gnus-run-hooks 'gnus-article-prepare-hook)))
 
 (provide 'deuglify)