emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Emacs-diffs] Changes to emacs/lisp/gnus/mm-uu.el


From: Miles Bader
Subject: [Emacs-diffs] Changes to emacs/lisp/gnus/mm-uu.el
Date: Sat, 04 Sep 2004 09:44:13 -0400

Index: emacs/lisp/gnus/mm-uu.el
diff -c emacs/lisp/gnus/mm-uu.el:1.11 emacs/lisp/gnus/mm-uu.el:1.12
*** emacs/lisp/gnus/mm-uu.el:1.11       Mon Sep  1 15:45:24 2003
--- emacs/lisp/gnus/mm-uu.el    Sat Sep  4 13:13:43 2004
***************
*** 1,8 ****
! ;;; mm-uu.el --- return uu stuff as mm handles
! ;; Copyright (c) 1998, 1999, 2000, 2001 Free Software Foundation, Inc.
  
  ;; Author: Shenghuo Zhu <address@hidden>
! ;; Keywords: postscript uudecode binhex shar forward news
  
  ;; This file is part of GNU Emacs.
  
--- 1,8 ----
! ;;; mm-uu.el --- Return uu stuff as mm handles
! ;; Copyright (c) 1998, 1999, 2000, 2001, 2002, 2003 Free Software Foundation, 
Inc.
  
  ;; Author: Shenghuo Zhu <address@hidden>
! ;; Keywords: postscript uudecode binhex shar forward gnatsweb pgp
  
  ;; This file is part of GNU Emacs.
  
***************
*** 30,223 ****
  (require 'nnheader)
  (require 'mm-decode)
  (require 'mailcap)
! (require 'uudecode)
! (require 'binhex)
  
! (defun mm-uu-copy-to-buffer (from to)
!   "Copy the contents of the current buffer to a fresh buffer.
! Return that buffer."
!   (save-excursion
!     (let ((obuf (current-buffer)))
!       (set-buffer (generate-new-buffer " *mm-uu*"))
!       (insert-buffer-substring obuf from to)
!       (current-buffer))))
! 
! ;;; postscript
  
! (defconst mm-uu-postscript-begin-line "^%!PS-")
! (defconst mm-uu-postscript-end-line "^%%EOF$")
  
- (defconst mm-uu-uu-begin-line "^begin[ \t]+[0-7][0-7][0-7][ \t]+")
- (defconst mm-uu-uu-end-line "^end[ \t]*$")
- 
- ;; This is not the right place for this.  uudecode.el should decide
- ;; whether or not to use a program with a single interface, but I
- ;; guess it's too late now.  Also the default should depend on a test
- ;; for the program.  -- fx
  (defcustom mm-uu-decode-function 'uudecode-decode-region
    "*Function to uudecode.
  Internal function is done in Lisp by default, therefore decoding may
  appear to be horribly slow.  You can make Gnus use an external
  decoder, such as uudecode."
    :type '(choice
!         (function-item :tag "Internal" uudecode-decode-region)
          (function-item :tag "External" uudecode-decode-region-external))
    :group 'gnus-article-mime)
  
- (defconst mm-uu-binhex-begin-line
-   "^:...............................................................$")
- (defconst mm-uu-binhex-end-line ":$")
- 
  (defcustom mm-uu-binhex-decode-function 'binhex-decode-region
    "*Function to binhex decode.
! Internal function is done in Lisp by default, therefore decoding may
! appear to be horribly slow.  You can make Gnus use an external
  decoder, such as hexbin."
!   :type '(choice
!         (function-item :tag "Internal" binhex-decode-region)
!         (function-item :tag "External" binhex-decode-region-external))
    :group 'gnus-article-mime)
  
! (defconst mm-uu-shar-begin-line "^#! */bin/sh")
! (defconst mm-uu-shar-end-line "^exit 0\\|^$")
  
! ;;; Thanks to Edward J. Sabol <address@hidden> and
! ;;; Peter von der Ah\'e <address@hidden>
! (defconst mm-uu-forward-begin-line "^-+ \\(Start of \\)?Forwarded message")
! (defconst mm-uu-forward-end-line "^-+ End \\(of \\)?forwarded message")
! 
! (defvar mm-uu-begin-line nil)
  
! (defconst mm-uu-identifier-alist
!   '((?% . postscript) (?b . uu) (?: . binhex) (?# . shar)
!     (?- . forward)))
  
  (defvar mm-dissect-disposition "inline"
    "The default disposition of uu parts.
  This can be either \"inline\" or \"attachment\".")
  
  (defun mm-uu-configure-p  (key val)
    (member (cons key val) mm-uu-configure-list))
  
  (defun mm-uu-configure (&optional symbol value)
    (if symbol (set-default symbol value))
!   (setq mm-uu-begin-line nil)
!   (mapcar (lambda (type)
!           (if (mm-uu-configure-p type 'disabled)
!               nil
!             (setq mm-uu-begin-line
!                   (concat mm-uu-begin-line
!                           (if mm-uu-begin-line "\\|")
!                           (symbol-value
!                            (intern (concat "mm-uu-" (symbol-name type)
!                                            "-begin-line")))))))
!         '(uu postscript binhex shar forward)))
! 
! ;; Needs to come after mm-uu-configure.
! (defcustom mm-uu-configure-list nil
!   "Alist of mm-uu configurations to disable.
! To disable dissecting shar codes, for instance, add
! `(shar . disabled)' to this list."
!   :type '(repeat (choice (const :tag "postscript" (postscript . disabled))
!                        (const :tag "uu" (uu . disabled))
!                        (const :tag "binhex" (binhex . disabled))
!                        (const :tag "shar" (shar . disabled))
!                        (const :tag "forward" (forward . disabled))))
!   :group 'gnus-article-mime
!   :set 'mm-uu-configure)
  
  (mm-uu-configure)
  
  ;;;###autoload
  (defun mm-uu-dissect ()
    "Dissect the current buffer and return a list of uu handles."
!   (let (text-start start-char end-char
!                  type file-name end-line result text-plain-type
!                  start-char-1 end-char-1
!                  (case-fold-search t))
      (save-excursion
!       (save-restriction
!       (mail-narrow-to-head)
!       (goto-char (point-max)))
!       (forward-line)
        ;;; gnus-decoded is a fake charset, which means no further
        ;;; decoding.
        (setq text-start (point)
            text-plain-type '("text/plain"  (charset . gnus-decoded)))
!       (while (re-search-forward mm-uu-begin-line nil t)
!       (setq start-char (match-beginning 0))
!       (setq type (cdr (assq (aref (match-string 0) 0)
!                             mm-uu-identifier-alist)))
!       (setq file-name
!             (if (and (eq type 'uu)
!                      (looking-at "\\(.+\\)$"))
!                 (and (match-string 1)
!                      (let ((nnheader-file-name-translation-alist
!                             '((?/ . ?,) (?\  . ?_) (?* . ?_) (?$ . ?_))))
!                        (nnheader-translate-file-chars (match-string 1))))))
        (forward-line);; in case of failure
!       (setq start-char-1 (point))
!       (setq end-line (symbol-value
!                       (intern (concat "mm-uu-" (symbol-name type)
!                                       "-end-line"))))
!       (when (and (re-search-forward end-line nil t)
!                  (not (eq (match-beginning 0) (match-end 0))))
!         (setq end-char-1 (match-beginning 0))
!         (forward-line)
!         (setq end-char (point))
!         (when (cond
!                ((eq type 'binhex)
!                 (setq file-name
!                       (ignore-errors
!                         (binhex-decode-region start-char end-char t))))
!                ((eq type 'forward)
!                 (save-excursion
!                   (goto-char start-char-1)
!                   (looking-at "[\r\n]*[a-zA-Z][a-zA-Z0-9-]*:")))
!                (t t))
!           (if (> start-char text-start)
!               (push
!                (mm-make-handle (mm-uu-copy-to-buffer text-start start-char)
!                                text-plain-type)
!                result))
!           (push
!            (cond
!             ((eq type 'postscript)
!              (mm-make-handle (mm-uu-copy-to-buffer start-char end-char)
!                              '("application/postscript")))
!             ((eq type 'forward)
!              (mm-make-handle (mm-uu-copy-to-buffer start-char-1 end-char-1)
!                              '("message/rfc822" (charset . gnus-decoded))))
!             ((eq type 'uu)
!              (mm-make-handle (mm-uu-copy-to-buffer start-char end-char)
!                              (list (or (and file-name
!                                             (string-match "\\.[^\\.]+$"
!                                                           file-name)
!                                             (mailcap-extension-to-mime
!                                              (match-string 0 file-name)))
!                                        "application/octet-stream"))
!                              'x-uuencode nil
!                              (if (and file-name (not (equal file-name "")))
!                                  (list mm-dissect-disposition
!                                        (cons 'filename file-name)))))
!             ((eq type 'binhex)
!              (mm-make-handle (mm-uu-copy-to-buffer start-char end-char)
!                              (list (or (and file-name
!                                             (string-match "\\.[^\\.]+$" 
file-name)
!                                             (mailcap-extension-to-mime
!                                              (match-string 0 file-name)))
!                                        "application/octet-stream"))
!                              'x-binhex nil
!                              (if (and file-name (not (equal file-name "")))
!                                  (list mm-dissect-disposition
!                                        (cons 'filename file-name)))))
!             ((eq type 'shar)
!              (mm-make-handle (mm-uu-copy-to-buffer start-char end-char)
!                              '("application/x-shar"))))
!            result)
!           (setq text-start end-char))))
        (when result
!       (if (> (point-max) (1+ text-start))
            (push
             (mm-make-handle (mm-uu-copy-to-buffer text-start (point-max))
                             text-plain-type)
--- 30,491 ----
  (require 'nnheader)
  (require 'mm-decode)
  (require 'mailcap)
! (require 'mml2015)
  
! (autoload 'uudecode-decode-region "uudecode")
! (autoload 'uudecode-decode-region-external "uudecode")
! (autoload 'uudecode-decode-region-internal "uudecode")
! 
! (autoload 'binhex-decode-region "binhex")
! (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
  appear to be horribly slow.  You can make Gnus use an external
  decoder, such as uudecode."
    :type '(choice
!         (function-item :tag "Auto detect" uudecode-decode-region)
!         (function-item :tag "Internal" uudecode-decode-region-internal)
          (function-item :tag "External" uudecode-decode-region-external))
    :group 'gnus-article-mime)
  
  (defcustom mm-uu-binhex-decode-function 'binhex-decode-region
    "*Function to binhex decode.
! Internal function is done in elisp by default, therefore decoding may
! appear to be horribly slow . You can make Gnus use the external Unix
  decoder, such as hexbin."
!   :type '(choice (function-item :tag "Auto detect" binhex-decode-region)
!                (function-item :tag "Internal" binhex-decode-region-internal)
!                (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-----")
  
! (defvar mm-uu-beginning-regexp nil)
  
  (defvar mm-dissect-disposition "inline"
    "The default disposition of uu parts.
  This can be either \"inline\" or \"attachment\".")
  
+ (defvar mm-uu-emacs-sources-regexp "gnu\\.emacs\\.sources"
+   "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
+      "^%!PS-"
+      "^%%EOF$"
+      mm-uu-postscript-extract
+      nil)
+     (uu
+      "^begin[ \t]+0?[0-7][0-7][0-7][ \t]+"
+      "^end[ \t]*$"
+      mm-uu-uu-extract
+      mm-uu-uu-filename)
+     (binhex
+      "^:...............................................................$"
+      ":$"
+      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$"
+      mm-uu-shar-extract)
+     (forward
+ ;;; Thanks to Edward J. Sabol <address@hidden> and
+ ;;; Peter von der Ah\'e <address@hidden>
+      "^-+ \\(Start of \\)?Forwarded message"
+      "^-+ End \\(of \\)?forwarded message"
+      mm-uu-forward-extract
+      nil
+      mm-uu-forward-test)
+     (gnatsweb
+      "^----gnatsweb-attachment----"
+      nil
+      mm-uu-gnatsweb-extract)
+     (pgp-signed
+      "^-----BEGIN PGP SIGNED MESSAGE-----"
+      "^-----END PGP SIGNATURE-----"
+      mm-uu-pgp-signed-extract
+      nil
+      nil)
+     (pgp-encrypted
+      "^-----BEGIN PGP MESSAGE-----"
+      "^-----END PGP MESSAGE-----"
+      mm-uu-pgp-encrypted-extract
+      nil
+      nil)
+     (pgp-key
+      "^-----BEGIN PGP PUBLIC KEY BLOCK-----"
+      "^-----END PGP PUBLIC KEY BLOCK-----"
+      mm-uu-pgp-key-extract
+      mm-uu-gpg-key-skip-to-last
+      nil)
+     (emacs-sources
+      "^;;;?[ \t]*[^ \t]+\\.el[ \t]*--"
+      "^;;;?[ \t]*\\([^ \t]+\\.el\\)[ \t]+ends here"
+      mm-uu-emacs-sources-extract
+      nil
+      mm-uu-emacs-sources-test)
+     (diff
+      "^Index: "
+      nil
+      mm-uu-diff-extract
+      nil
+      mm-uu-diff-test)))
+ 
+ (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."
+   :type 'alist
+   :options (mapcar (lambda (entry)
+                    (list (car entry) '(const disabled)))
+                  mm-uu-type-alist)
+   :group 'gnus-article-mime)
+ 
+ ;; functions
+ 
+ (defsubst mm-uu-type (entry)
+   (car entry))
+ 
+ (defsubst mm-uu-beginning-regexp (entry)
+   (nth 1 entry))
+ 
+ (defsubst mm-uu-end-regexp (entry)
+   (nth 2 entry))
+ 
+ (defsubst mm-uu-function-extract (entry)
+   (nth 3 entry))
+ 
+ (defsubst mm-uu-function-1 (entry)
+   (nth 4 entry))
+ 
+ (defsubst mm-uu-function-2 (entry)
+   (nth 5 entry))
+ 
+ (defun mm-uu-copy-to-buffer (&optional from to)
+   "Copy the contents of the current buffer to a fresh buffer.
+ Return that buffer."
+   (save-excursion
+     (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))))
+ 
  (defun mm-uu-configure-p  (key val)
    (member (cons key val) mm-uu-configure-list))
  
  (defun mm-uu-configure (&optional symbol value)
    (if symbol (set-default symbol value))
!   (setq mm-uu-beginning-regexp nil)
!   (mapcar (lambda (entry)
!            (if (mm-uu-configure-p (mm-uu-type entry) 'disabled)
!                nil
!              (setq mm-uu-beginning-regexp
!                    (concat mm-uu-beginning-regexp
!                            (if mm-uu-beginning-regexp "\\|")
!                            (mm-uu-beginning-regexp entry)))))
!         mm-uu-type-alist))
  
  (mm-uu-configure)
  
+ (eval-when-compile
+   (defvar file-name)
+   (defvar start-point)
+   (defvar end-point)
+   (defvar entry))
+ 
+ (defun mm-uu-uu-filename ()
+   (if (looking-at ".+")
+       (setq file-name
+           (let ((nnheader-file-name-translation-alist
+                  '((?/ . ?,) (?\  . ?_) (?* . ?_) (?$ . ?_))))
+             (nnheader-translate-file-chars (match-string 0))))))
+ 
+ (defun mm-uu-binhex-filename ()
+   (setq file-name
+       (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)
+     (forward-line)
+     (looking-at "[\r\n]*[a-zA-Z][a-zA-Z0-9-]*:")))
+ 
+ (defun mm-uu-postscript-extract ()
+   (mm-make-handle (mm-uu-copy-to-buffer start-point end-point)
+                 '("application/postscript")))
+ 
+ (defun mm-uu-emacs-sources-extract ()
+   (mm-make-handle (mm-uu-copy-to-buffer start-point end-point)
+                 '("application/emacs-lisp")
+                 nil nil
+                 (list mm-dissect-disposition
+                       (cons 'filename file-name))))
+ 
+ (eval-when-compile
+   (defvar gnus-newsgroup-name))
+ 
+ (defun mm-uu-emacs-sources-test ()
+   (setq file-name (match-string 1))
+   (and gnus-newsgroup-name
+        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))
+                  (progn (goto-char end-point) (forward-line -1) (point)))
+                 '("message/rfc822" (charset . gnus-decoded))))
+ 
+ (defun mm-uu-uu-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-uuencode nil
+                 (if (and file-name (not (equal file-name "")))
+                     (list mm-dissect-disposition
+                           (cons 'filename file-name)))))
+ 
+ (defun mm-uu-binhex-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-binhex nil
+                 (if (and file-name (not (equal file-name "")))
+                     (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")))
+ 
+ (defun mm-uu-gnatsweb-extract ()
+   (save-restriction
+     (goto-char start-point)
+     (forward-line)
+     (narrow-to-region (point) end-point)
+     (mm-dissect-buffer t)))
+ 
+ (defun mm-uu-pgp-signed-test (&rest rest)
+   (and
+    mml2015-use
+    (mml2015-clear-verify-function)
+    (cond
+     ((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? ")))))
+ 
+ (eval-when-compile
+   (defvar gnus-newsgroup-charset))
+ 
+ (defun mm-uu-pgp-signed-extract-1 (handles ctl)
+   (let ((buf (mm-uu-copy-to-buffer (point-min) (point-max))))
+     (with-current-buffer buf
+       (if (mm-uu-pgp-signed-test)
+         (progn
+           (mml2015-clean-buffer)
+           (let ((coding-system-for-write (or gnus-newsgroup-charset
+                                              'iso-8859-1)))
+             (funcall (mml2015-clear-verify-function))))
+       (when (and mml2015-use (null (mml2015-clear-verify-function)))
+         (mm-set-handle-multipart-parameter
+          mm-security-handle 'gnus-details
+          (format "Clear verification not supported by `%s'.\n" mml2015-use))))
+       (goto-char (point-min))
+       (if (search-forward "\n\n" nil t)
+         (delete-region (point-min) (point)))
+       (if (re-search-forward mm-uu-pgp-beginning-signature nil t)
+         (delete-region (match-beginning 0) (point-max)))
+       (goto-char (point-min))
+       (while (re-search-forward "^- " nil t)
+       (replace-match "" t t)
+       (forward-line 1)))
+     (list (mm-make-handle buf '("text/plain" (charset . gnus-decoded))))))
+ 
+ (defun mm-uu-pgp-signed-extract ()
+   (let ((mm-security-handle (list (format "multipart/signed"))))
+     (mm-set-handle-multipart-parameter
+      mm-security-handle 'protocol "application/x-gnus-pgp-signature")
+     (save-restriction
+       (narrow-to-region start-point end-point)
+       (add-text-properties 0 (length (car mm-security-handle))
+                          (list 'buffer (mm-uu-copy-to-buffer))
+                          (car mm-security-handle))
+       (setcdr mm-security-handle
+             (mm-uu-pgp-signed-extract-1 nil
+                                         mm-security-handle)))
+     mm-security-handle))
+ 
+ (defun mm-uu-pgp-encrypted-test (&rest rest)
+   (and
+    mml2015-use
+    (mml2015-clear-decrypt-function)
+    (cond
+     ((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? ")))))
+ 
+ (defun mm-uu-pgp-encrypted-extract-1 (handles ctl)
+   (let ((buf (mm-uu-copy-to-buffer (point-min) (point-max))))
+     (if (mm-uu-pgp-encrypted-test)
+       (with-current-buffer buf
+         (mml2015-clean-buffer)
+         (funcall (mml2015-clear-decrypt-function))))
+     (list
+      (mm-make-handle buf
+                    '("text/plain"  (charset . gnus-decoded))))))
+ 
+ (defun mm-uu-pgp-encrypted-extract ()
+   (let ((mm-security-handle (list (format "multipart/encrypted"))))
+     (mm-set-handle-multipart-parameter
+      mm-security-handle 'protocol "application/x-gnus-pgp-encrypted")
+     (save-restriction
+       (narrow-to-region start-point end-point)
+       (add-text-properties 0 (length (car mm-security-handle))
+                          (list 'buffer (mm-uu-copy-to-buffer))
+                          (car mm-security-handle))
+       (setcdr mm-security-handle
+             (mm-uu-pgp-encrypted-extract-1 nil
+                                            mm-security-handle)))
+     mm-security-handle))
+ 
+ (defun mm-uu-gpg-key-skip-to-last ()
+   (let ((point (point))
+       (end-regexp (mm-uu-end-regexp entry))
+       (beginning-regexp (mm-uu-beginning-regexp entry)))
+     (when (and end-regexp
+              (not (mm-uu-configure-p (mm-uu-type entry) 'disabled)))
+       (while (re-search-forward end-regexp nil t)
+       (skip-chars-forward " \t\n\r")
+       (if (looking-at beginning-regexp)
+           (setq point (match-end 0)))))
+     (goto-char point)))
+ 
+ (defun mm-uu-pgp-key-extract ()
+   (let ((buf (mm-uu-copy-to-buffer start-point end-point)))
+     (mm-make-handle buf
+                   '("application/pgp-keys"))))
+ 
  ;;;###autoload
  (defun mm-uu-dissect ()
    "Dissect the current buffer and return a list of uu handles."
!   (let ((case-fold-search t)
!       text-start start-point end-point file-name result
!       text-plain-type entry func)
      (save-excursion
!       (goto-char (point-min))
!       (cond
!        ((looking-at "\n")
!       (forward-line))
!        ((search-forward "\n\n" nil t)
!       t)
!        (t (goto-char (point-max))))
        ;;; gnus-decoded is a fake charset, which means no further
        ;;; decoding.
        (setq text-start (point)
            text-plain-type '("text/plain"  (charset . gnus-decoded)))
!       (while (re-search-forward mm-uu-beginning-regexp nil t)
!       (setq start-point (match-beginning 0))
!       (let ((alist mm-uu-type-alist)
!             (beginning-regexp (match-string 0)))
!         (while (not entry)
!           (if (string-match (mm-uu-beginning-regexp (car alist))
!                             beginning-regexp)
!               (setq entry (car alist))
!             (pop alist))))
!       (if (setq func (mm-uu-function-1 entry))
!           (funcall func))
        (forward-line);; in case of failure
!       (when (and (not (mm-uu-configure-p (mm-uu-type entry) 'disabled))
!                  (let ((end-regexp (mm-uu-end-regexp entry)))
!                    (if (not end-regexp)
!                        (or (setq end-point (point-max)) t)
!                      (prog1
!                          (re-search-forward end-regexp nil t)
!                        (forward-line)
!                        (setq end-point (point)))))
!                  (or (not (setq func (mm-uu-function-2 entry)))
!                      (funcall func)))
!         (if (and (> start-point text-start)
!                  (progn
!                    (goto-char text-start)
!                    (re-search-forward "." start-point t)))
!             (push
!              (mm-make-handle (mm-uu-copy-to-buffer text-start start-point)
!                              text-plain-type)
!              result))
!         (push
!          (funcall (mm-uu-function-extract entry))
!          result)
!         (goto-char (setq text-start end-point))))
        (when result
!       (if (and (> (point-max) (1+ text-start))
!                (save-excursion
!                  (goto-char text-start)
!                  (re-search-forward "." nil t)))
            (push
             (mm-make-handle (mm-uu-copy-to-buffer text-start (point-max))
                             text-plain-type)
***************
*** 225,250 ****
        (setq result (cons "multipart/mixed" (nreverse result))))
        result)))
  
- ;;;###autoload
- (defun mm-uu-test ()
-   "Check whether the current buffer contains uu stuff."
-   (save-excursion
-     (goto-char (point-min))
-     (let (type end-line result
-              (case-fold-search t))
-       (while (and mm-uu-begin-line
-                 (not result) (re-search-forward mm-uu-begin-line nil t))
-       (forward-line)
-       (setq type (cdr (assq (aref (match-string 0) 0)
-                             mm-uu-identifier-alist)))
-       (setq end-line (symbol-value
-                       (intern (concat "mm-uu-" (symbol-name type)
-                                       "-end-line"))))
-       (if (and (re-search-forward end-line nil t)
-                (not (eq (match-beginning 0) (match-end 0))))
-           (setq result t)))
-       result)))
- 
  (provide 'mm-uu)
  
  ;;; arch-tag: 7db076bf-53db-4320-aa19-ca76a1d2ab2c
--- 493,498 ----




reply via email to

[Prev in Thread] Current Thread [Next in Thread]