Use gnus-article-before-search.
[gnus] / lisp / gnus-art.el
index ccb0db1..4ae78ad 100644 (file)
@@ -136,7 +136,7 @@ If `gnus-visible-headers' is non-nil, this variable will be ignored."
   :group 'gnus-article-hiding)
 
 (defcustom gnus-visible-headers
-  "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^[BGF]?Cc:\\|^Posted-To:\\|^Mail-Copies-To:\\|^Apparently-To:\\|^Gnus-Warning:\\|^Resent-From:\\|^X-Sent:"
+  "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^[BGF]?Cc:\\|^Posted-To:\\|^Mail-Copies-To:\\|^Mail-Followup-To:\\|^Apparently-To:\\|^Gnus-Warning:\\|^Resent-From:\\|^X-Sent:"
   "*All headers that do not match this regexp will be hidden.
 This variable can also be a list of regexp of headers to remain visible.
 If this variable is non-nil, `gnus-ignored-headers' will be ignored."
@@ -659,6 +659,7 @@ used."
 
 (defcustom gnus-mime-action-alist
   '(("save to file" . gnus-mime-save-part)
+    ("save and strip" . gnus-mime-save-part-and-strip)
     ("display as text" . gnus-mime-inline-part)
     ("view the part" . gnus-mime-view-part)
     ("pipe to command" . gnus-mime-pipe-part)
@@ -2923,6 +2924,7 @@ If ALL-HEADERS is non-nil, no headers are hidden."
     (gnus-mime-view-part "v" "View Interactively...")
     (gnus-mime-view-part-as-type "t" "View As Type...")
     (gnus-mime-save-part "o" "Save...")
+    (gnus-mime-save-part-and-strip "\C-o" "Save and Strip")
     (gnus-mime-copy-part "c" "View As Text, In Other Buffer")
     (gnus-mime-inline-part "i" "View As Text, In This Buffer")
     (gnus-mime-internalize-part "E" "View Internally")
@@ -2974,6 +2976,77 @@ If ALL-HEADERS is non-nil, no headers are hidden."
          (gnus-mime-view-all-parts (cdr handles))
        (mapcar 'mm-display-part handles)))))
 
+(defun gnus-mime-save-part-and-strip ()
+  "Save the MIME part under point then replace it with an external body."
+  (interactive)
+  (gnus-article-check-buffer)
+  (let* ((data (get-text-property (point) 'gnus-data)) 
+        (file (mm-save-part data))
+        param)
+    (when file
+      (with-current-buffer (mm-handle-buffer data)
+       (erase-buffer)
+       (insert "Content-Type: " (mm-handle-media-type data))
+       (mml-insert-parameter-string (cdr (mm-handle-type data))
+                                    '(charset))
+       (insert "\n")
+       (insert "Content-ID: " (message-make-message-id) "\n")
+       (insert "Content-Transfer-Encoding: binary\n")
+       (insert "\n"))
+      (setcdr data
+             (cdr (mm-make-handle nil 
+                                  `("message/external-body"
+                                    (access-type . "LOCAL-FILE")
+                                    (name . ,file)))))
+      (set-buffer gnus-summary-buffer)
+      (gnus-article-edit-article
+       `(lambda () 
+          (erase-buffer)
+          (let ((mail-parse-charset (or gnus-article-charset 
+                                        ',gnus-newsgroup-charset))
+                (mail-parse-ignored-charsets 
+                 (or gnus-article-ignored-charsets
+                     ',gnus-newsgroup-ignored-charsets))
+                (mbl mml-buffer-list))
+            (insert-buffer gnus-original-article-buffer)
+            (save-restriction
+              (message-narrow-to-head)
+              (message-remove-header "Content-Type")
+              (message-remove-header "MIME-Version")
+              (message-remove-header "Content-Transfer-Encoding")
+              (mail-decode-encoded-word-region (point-min) (point-max))
+              (goto-char (point-max)))
+            (forward-char 1)
+            (delete-region (point) (point-max))
+            (setq mml-buffer-list nil)
+            (if (stringp (car gnus-article-mime-handles))
+                (mml-insert-mime gnus-article-mime-handles)
+              (mml-insert-mime gnus-article-mime-handles t))
+            (mm-destroy-parts gnus-article-mime-handles)
+            (setq gnus-article-mime-handles nil)
+            (make-local-hook 'kill-buffer-hook)
+            (let ((mbl1 mml-buffer-list))
+              (setq mml-buffer-list mbl)
+              (set (make-local-variable 'mml-buffer-list) mbl1))
+            (add-hook 'kill-buffer-hook 'mml-destroy-buffers t t)))
+       `(lambda (no-highlight)
+         (let ((mail-parse-charset (or gnus-article-charset
+                                       ',gnus-newsgroup-charset))
+               (message-options message-options)
+               (message-options-set-recipient)
+               (mail-parse-ignored-charsets  
+                (or gnus-article-ignored-charsets
+                    ',gnus-newsgroup-ignored-charsets)))
+          (mml-to-mime)
+          (mml-destroy-buffers)
+          (remove-hook 'kill-buffer-hook 
+                       'mml-destroy-buffers t)
+          (kill-local-variable 'mml-buffer-list))
+         (gnus-summary-edit-article-done
+          ,(or (mail-header-references gnus-current-headers) "")
+          ,(gnus-group-read-only-p) 
+          ,gnus-summary-buffer no-highlight))))))
+
 (defun gnus-mime-save-part ()
   "Save the MIME part under point."
   (interactive)
@@ -3252,6 +3325,8 @@ In no internal viewer is available, use an external viewer."
                                    'name)
             (mail-content-type-get (mm-handle-disposition handle)
                                    'filename)
+            (mail-content-type-get (mm-handle-type handle)
+                                   'url)
             ""))
        (gnus-tmp-type (mm-handle-media-type handle))
        (gnus-tmp-description
@@ -3385,6 +3460,14 @@ In no internal viewer is available, use an external viewer."
     ;;;!!!to the first part.
     (gnus-mime-display-part (cadr handle)))
    ;; Other multiparts are handled like multipart/mixed.
+   ((equal (car handle) "multipart/signed")
+    (or (memq 'signed gnus-article-wash-types)
+       (push 'signed gnus-article-wash-types))
+    (gnus-mime-display-mixed (cdr handle)))
+   ((equal (car handle) "multipart/encrypted")
+    (or (memq 'encrypted gnus-article-wash-types)
+       (push 'encrypted gnus-article-wash-types))
+    (gnus-mime-display-mixed (cdr handle)))
    (t
     (gnus-mime-display-mixed (cdr handle)))))
 
@@ -3576,13 +3659,15 @@ In no internal viewer is available, use an external viewer."
          (boring (memq 'boring-headers gnus-article-wash-types))
          (pgp (memq 'pgp gnus-article-wash-types))
          (pem (memq 'pem gnus-article-wash-types))
+         (signed (memq 'signed gnus-article-wash-types))
+         (encrypted (memq 'encrypted gnus-article-wash-types))
          (signature (memq 'signature gnus-article-wash-types))
          (overstrike (memq 'overstrike gnus-article-wash-types))
          (emphasis (memq 'emphasis gnus-article-wash-types)))
       (format "%c%c%c%c%c%c"
              (if cite ?c ? )
              (if (or headers boring) ?h ? )
-             (if (or pgp pem) ?p ? )
+             (if (or pgp pem signed encrypted) ?p ? )
              (if signature ?s ? )
              (if overstrike ?o ? )
              (if emphasis ?e ? )))))
@@ -4106,27 +4191,6 @@ groups."
 (defun gnus-article-edit-done (&optional arg)
   "Update the article edits and exit."
   (interactive "P")
-  (save-excursion
-    (save-restriction
-      (widen)
-      (when (article-goto-body)
-       (let ((lines (count-lines (point) (point-max)))
-             (length (- (point-max) (point)))
-             (case-fold-search t)
-             (body (copy-marker (point))))
-         (goto-char (point-min))
-         (when (re-search-forward "^content-length:[ \t]\\([0-9]+\\)" body t)
-           (delete-region (match-beginning 1) (match-end 1))
-           (insert (number-to-string length)))
-         (goto-char (point-min))
-         (when (re-search-forward
-                "^x-content-length:[ \t]\\([0-9]+\\)" body t)
-           (delete-region (match-beginning 1) (match-end 1))
-           (insert (number-to-string length)))
-         (goto-char (point-min))
-         (when (re-search-forward "^lines:[ \t]\\([0-9]+\\)" body t)
-           (delete-region (match-beginning 1) (match-end 1))
-           (insert (number-to-string lines)))))))
   (let ((func gnus-article-edit-done-function)
        (buf (current-buffer))
        (start (window-start)))