Add arch taglines

[gnus] / lisp / mm-uu.el

diff --git a/lisp/mm-uu.el b/lisp/mm-uu.el
index f36a5fd..17fa593 100644 (file)
--- a/lisp/mm-uu.el
+++ b/lisp/mm-uu.el
@@ -1,5 +1,5 @@
 ;;; mm-uu.el --- Return uu stuff as mm handles
-;; Copyright (c) 1998, 1999, 2000, 2001 Free Software Foundation, Inc.
+;; Copyright (c) 1998, 1999, 2000, 2001, 2002, 2003 Free Software Foundation, Inc.
 
 ;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
 ;; Keywords: postscript uudecode binhex shar forward gnatsweb pgp
@@ -40,6 +40,9 @@
 (autoload 'binhex-decode-region-external "binhex")
 (autoload 'binhex-decode-region-internal "binhex")
 
+(autoload 'yenc-decode-region "yenc")
+(autoload 'yenc-extract-filename "yenc")
+
 (defcustom mm-uu-decode-function 'uudecode-decode-region
   "*Function to uudecode.
 Internal function is done in Lisp by default, therefore decoding may
@@ -61,6 +64,8 @@ decoder, such as hexbin."
                 (function-item :tag "External" binhex-decode-region-external))
   :group 'gnus-article-mime)
 
+(defvar mm-uu-yenc-decode-function 'yenc-decode-region)
+
 (defvar mm-uu-pgp-beginning-signature
      "^-----BEGIN PGP SIGNATURE-----")
 
@@ -71,7 +76,12 @@ decoder, such as hexbin."
 This can be either \"inline\" or \"attachment\".")
 
 (defvar mm-uu-emacs-sources-regexp "gnu\\.emacs\\.sources"
-  "The regexp of emacs sources groups.")
+  "The regexp of Emacs sources groups.")
+
+(defcustom mm-uu-diff-groups-regexp "gnus\\.commits"
+  "*Regexp matching diff groups."
+  :type 'regexp
+  :group 'gnus-article-mime)
 
 (defvar mm-uu-type-alist
   '((postscript
@@ -80,7 +90,7 @@ This can be either \"inline\" or \"attachment\".")
      mm-uu-postscript-extract
      nil)
     (uu
-     "^begin[ \t]+[0-7][0-7][0-7][ \t]+"
+     "^begin[ \t]+0?[0-7][0-7][0-7][ \t]+"
      "^end[ \t]*$"
      mm-uu-uu-extract
      mm-uu-uu-filename)
@@ -90,6 +100,11 @@ This can be either \"inline\" or \"attachment\".")
      mm-uu-binhex-extract
      nil
      mm-uu-binhex-filename)
+    (yenc
+     "^=ybegin.*size=[0-9]+.*name=.*$"
+     "^=yend.*size=[0-9]+"
+     mm-uu-yenc-extract
+     mm-uu-yenc-filename)
     (shar
      "^#! */bin/sh"
      "^exit 0$"
@@ -129,9 +144,15 @@ This can be either \"inline\" or \"attachment\".")
      "^;;;?[ \t]*\\([^ \t]+\\.el\\)[ \t]+ends here"
      mm-uu-emacs-sources-extract
      nil
-     mm-uu-emacs-sources-test)))
+     mm-uu-emacs-sources-test)
+    (diff
+     "^Index: "
+     nil
+     mm-uu-diff-extract
+     nil
+     mm-uu-diff-test)))
 
-(defcustom mm-uu-configure-list nil
+(defcustom mm-uu-configure-list '((shar . disabled))
   "A list of mm-uu configuration.
 To disable dissecting shar codes, for instance, add
 `(shar . disabled)' to this list."
@@ -165,8 +186,13 @@ To disable dissecting shar codes, for instance, add
   "Copy the contents of the current buffer to a fresh buffer.
 Return that buffer."
   (save-excursion
-    (let ((obuf (current-buffer)))
+    (let ((obuf (current-buffer))
+         (coding-system
+          ;; Might not exist in non-MULE XEmacs
+          (when (boundp 'buffer-file-coding-system)
+            buffer-file-coding-system)))
       (set-buffer (generate-new-buffer " *mm-uu*"))
+      (setq buffer-file-coding-system coding-system)
       (insert-buffer-substring obuf from to)
       (current-buffer))))
 
@@ -197,7 +223,7 @@ Return that buffer."
   (if (looking-at ".+")
       (setq file-name
            (let ((nnheader-file-name-translation-alist
-                  '((?/ . ?,) (? . ?_) (?* . ?_) (?$ . ?_))))
+                  '((?/ . ?,) (?\  . ?_) (?* . ?_) (?$ . ?_))))
              (nnheader-translate-file-chars (match-string 0))))))
 
 (defun mm-uu-binhex-filename ()
@@ -205,6 +231,12 @@ Return that buffer."
        (ignore-errors
          (binhex-decode-region start-point end-point t))))
 
+(defun mm-uu-yenc-filename ()
+  (goto-char start-point)
+  (setq file-name
+       (ignore-errors
+         (yenc-extract-filename))))
+
 (defun mm-uu-forward-test ()
   (save-excursion
     (goto-char start-point)
@@ -231,6 +263,15 @@ Return that buffer."
        mm-uu-emacs-sources-regexp
        (string-match mm-uu-emacs-sources-regexp gnus-newsgroup-name)))
 
+(defun mm-uu-diff-extract ()
+  (mm-make-handle (mm-uu-copy-to-buffer start-point end-point)
+                 '("text/x-patch")))
+
+(defun mm-uu-diff-test ()
+  (and gnus-newsgroup-name
+       mm-uu-diff-groups-regexp
+       (string-match mm-uu-diff-groups-regexp gnus-newsgroup-name)))
+
 (defun mm-uu-forward-extract ()
   (mm-make-handle (mm-uu-copy-to-buffer
                   (progn (goto-char start-point) (forward-line) (point))
@@ -262,6 +303,19 @@ Return that buffer."
                      (list mm-dissect-disposition
                            (cons 'filename file-name)))))
 
+(defun mm-uu-yenc-extract ()
+  (mm-make-handle (mm-uu-copy-to-buffer start-point end-point)
+                 (list (or (and file-name
+                                (string-match "\\.[^\\.]+$" file-name)
+                                (mailcap-extension-to-mime
+                                 (match-string 0 file-name)))
+                           "application/octet-stream"))
+                 'x-yenc nil
+                 (if (and file-name (not (equal file-name "")))
+                     (list mm-dissect-disposition
+                           (cons 'filename file-name)))))
+
+
 (defun mm-uu-shar-extract ()
   (mm-make-handle (mm-uu-copy-to-buffer start-point end-point)
                  '("application/x-shar")))
@@ -281,7 +335,7 @@ Return that buffer."
     ((eq mm-verify-option 'never) nil)
     ((eq mm-verify-option 'always) t)
     ((eq mm-verify-option 'known) t)
-    (t (y-or-n-p "Verify pgp signed part?")))))
+    (t (y-or-n-p "Verify pgp signed part? ")))))
 
 (eval-when-compile
   (defvar gnus-newsgroup-charset))
@@ -332,7 +386,7 @@ Return that buffer."
     ((eq mm-decrypt-option 'never) nil)
     ((eq mm-decrypt-option 'always) t)
     ((eq mm-decrypt-option 'known) t)
-    (t (y-or-n-p "Decrypt pgp encrypted part?")))))
+    (t (y-or-n-p "Decrypt pgp encrypted part? ")))))
 
 (defun mm-uu-pgp-encrypted-extract-1 (handles ctl)
   (let ((buf (mm-uu-copy-to-buffer (point-min) (point-max))))
@@ -441,4 +495,5 @@ Return that buffer."
 
 (provide 'mm-uu)
 
+;;; arch-tag: 7db076bf-53db-4320-aa19-ca76a1d2ab2c
 ;;; mm-uu.el ends here