Move low-level library files from the lisp/gnus directory

The files moved from lisp/gnus are:

auth-source.el -> /
compface.el -> /image
ecomplete.el -> /
flow-fill.el -> /mail
gravatar.el -> /image
gssapi.el -> /net
html2text.el -> /net
ietf-drums.el -> /mail
mail-parse.el -> /mail
mail-prsvr.el -> /mail
mailcap.el -> /net
plstore.el -> /
pop3.el -> /net
qp.el -> /mail
registry.el -> /
rfc1843.el -> /international
rfc2045.el -> /mail
rfc2047.el -> /mail
rfc2231.el -> /mail
rtree.el -> /
sieve-manage.el -> /net
sieve-mode.el -> /net
sieve.el -> /net
starttls.el -> /net
utf7.el -> /international
yenc.el -> /mail

7 files changed, 3901 insertions, 0 deletions

diff --git a/lisp/net/html2text.el b/lisp/net/html2text.el
new file mode 100644
index 00000000000..2b1c2057bb4
--- /dev/null
+++ b/lisp/net/html2text.el
@@ -0,0 +1,461 @@
+;;; html2text.el --- a simple html to plain text converter -*- coding: utf-8 -*-
+
+;; Copyright (C) 2002-2016 Free Software Foundation, Inc.
+
+;; Author: Joakim Hove <hove@phys.ntnu.no>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; These functions provide a simple way to wash/clean html infected
+;; mails.  Definitely do not work in all cases, but some improvement
+;; in readability is generally obtained.  Formatting is only done in
+;; the buffer, so the next time you enter the article it will be
+;; "re-htmlized".
+;;
+;; The main function is `html2text'.
+
+;;; Code:
+
+;;
+;; <Global variables>
+;;
+
+(eval-when-compile
+  (require 'cl))
+
+(defvar html2text-format-single-element-list '(("hr" . html2text-clean-hr)))
+
+(defvar html2text-replace-list
+  '(("&acute;" . "`")
+    ("&amp;" . "&")
+    ("&apos;" . "'")
+    ("&brvbar;" . "|")
+    ("&cent;" . "c")
+    ("&circ;" . "^")
+    ("&copy;" . "(C)")
+    ("&curren;" . "(#)")
+    ("&deg;" . "degree")
+    ("&divide;" . "/")
+    ("&euro;" . "e")
+    ("&frac12;" . "1/2")
+    ("&gt;" . ">")
+    ("&iquest;" . "?")
+    ("&laquo;" . "<<")
+    ("&ldquo" . "\"")
+    ("&lsaquo;" . "(")
+    ("&lsquo;" . "`")
+    ("&lt;" . "<")
+    ("&mdash;" . "--")
+    ("&nbsp;" . " ")
+    ("&ndash;" . "-")
+    ("&permil;" . "%%")
+    ("&plusmn;" . "+-")
+    ("&pound;" . "£")
+    ("&quot;" . "\"")
+    ("&raquo;" . ">>")
+    ("&rdquo" . "\"")
+    ("&reg;" . "(R)")
+    ("&rsaquo;" . ")")
+    ("&rsquo;" . "'")
+    ("&sect;" . "§")
+    ("&sup1;" . "^1")
+    ("&sup2;" . "^2")
+    ("&sup3;" . "^3")
+    ("&tilde;" . "~"))
+  "The map of entity to text.
+
+This is an alist were each element is a dotted pair consisting of an
+old string, and a replacement string.  This replacement is done by the
+function `html2text-substitute' which basically performs a
+`replace-string' operation for every element in the list.  This is
+completely verbatim - without any use of REGEXP.")
+
+(defvar html2text-remove-tag-list
+  '("html" "body" "p" "img" "dir" "head" "div" "br" "font" "title" "meta")
+  "A list of removable tags.
+
+This is a list of tags which should be removed, without any
+formatting.  Note that tags in the list are presented *without*
+any \"<\" or \">\".  All occurrences of a tag appearing in this
+list are removed, irrespective of whether it is a closing or
+opening tag, or if the tag has additional attributes.  The
+deletion is done by the function `html2text-remove-tags'.
+
+For instance the text:
+
+\"Here comes something <font size\"+3\" face=\"Helvetica\"> big </font>.\"
+
+will be reduced to:
+
+\"Here comes something big.\"
+
+If this list contains the element \"font\".")
+
+(defvar html2text-format-tag-list
+  '(("b"          . html2text-clean-bold)
+    ("strong"     . html2text-clean-bold)
+    ("u"          . html2text-clean-underline)
+    ("i"          . html2text-clean-italic)
+    ("em"         . html2text-clean-italic)
+    ("blockquote" . html2text-clean-blockquote)
+    ("a"          . html2text-clean-anchor)
+    ("ul"         . html2text-clean-ul)
+    ("ol"         . html2text-clean-ol)
+    ("dl"         . html2text-clean-dl)
+    ("center"     . html2text-clean-center))
+  "An alist of tags and processing functions.
+
+This is an alist where each dotted pair consists of a tag, and then
+the name of a function to be called when this tag is found.  The
+function is called with the arguments p1, p2, p3 and p4. These are
+demonstrated below:
+
+\"<b> This is bold text </b>\"
+ ^   ^                 ^    ^
+ |   |                 |    |
+p1  p2                p3   p4
+
+Then the called function will typically format the text somewhat and
+remove the tags.")
+
+(defvar html2text-remove-tag-list2  '("li" "dt" "dd" "meta")
+  "Another list of removable tags.
+
+This is a list of tags which are removed similarly to the list
+`html2text-remove-tag-list' - but these tags are retained for the
+formatting, and then moved afterward.")
+
+;;
+;; </Global variables>
+;;
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;
+;; <Utility functions>
+;;
+
+
+(defun html2text-replace-string (from-string to-string min max)
+  "Replace FROM-STRING with TO-STRING in region from MIN to MAX."
+  (goto-char min)
+  (let ((delta (- (string-width to-string) (string-width from-string)))
+        (change 0))
+    (while (search-forward from-string max t)
+      (replace-match to-string)
+      (setq change (+ change delta)))
+    change))
+
+;;
+;; </Utility functions>
+;;
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;
+;; <Functions related to attributes> i.e. <font size=+3>
+;;
+
+(defun html2text-attr-value (list attribute)
+  "Get value of ATTRIBUTE from LIST."
+  (nth 1 (assoc attribute list)))
+
+(defun html2text-get-attr (p1 p2)
+  (goto-char p1)
+  (re-search-forward "\\s-+" p2 t)
+  (let (attr-list)
+    (while (re-search-forward "[-a-z0-9._]+" p2 t)
+      (setq attr-list
+            (cons
+             (list (match-string 0)
+                   (when (looking-at "\\s-*=")
+                     (goto-char (match-end 0))
+                     (skip-chars-forward "[:space:]")
+                     (when (or (looking-at "\"[^\"]*\"\\|'[^']*'")
+                               (looking-at "[-a-z0-9._:]+"))
+                       (goto-char (match-end 0))
+                       (match-string 0))))
+             attr-list)))
+    attr-list))
+
+;;
+;; </Functions related to attributes>
+;;
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;
+;; <Functions to be called to format a tag-pair>
+;;
+(defun html2text-clean-list-items (p1 p2 list-type)
+  (goto-char p1)
+  (let ((item-nr 0)
+        (items   0))
+    (while (search-forward "<li>" p2 t)
+      (setq items (1+ items)))
+    (goto-char p1)
+    (while (< item-nr items)
+      (setq item-nr (1+ item-nr))
+      (search-forward "<li>" (point-max) t)
+      (cond
+       ((string= list-type "ul") (insert " o "))
+       ((string= list-type "ol") (insert (format " %s: " item-nr)))
+       (t (insert " x "))))))
+
+(defun html2text-clean-dtdd (p1 p2)
+  (goto-char p1)
+  (let ((items   0)
+        (item-nr 0))
+    (while (search-forward "<dt>" p2 t)
+      (setq items (1+ items)))
+    (goto-char p1)
+    (while (< item-nr items)
+      (setq item-nr (1+ item-nr))
+      (re-search-forward "<dt>\\([ ]*\\)" (point-max) t)
+      (when (match-string 1)
+        (delete-region (point) (- (point) (string-width (match-string 1)))))
+      (let ((def-p1 (point))
+            (def-p2 0))
+        (re-search-forward "\\([ ]*\\)\\(</dt>\\|<dd>\\)" (point-max) t)
+        (if (match-string 1)
+            (progn
+              (let* ((mw1 (string-width (match-string 1)))
+                     (mw2 (string-width (match-string 2)))
+                     (mw  (+ mw1 mw2)))
+                (goto-char (- (point) mw))
+                (delete-region (point) (+ (point) mw1))
+                (setq def-p2 (point))))
+          (setq def-p2 (- (point) (string-width (match-string 2)))))
+        (put-text-property def-p1 def-p2 'face 'bold)))))
+
+(defun html2text-delete-tags (p1 p2 p3 p4)
+  (delete-region p1 p2)
+  (delete-region (- p3 (- p2 p1)) (- p4 (- p2 p1))))
+
+(defun html2text-delete-single-tag (p1 p2)
+  (delete-region p1 p2))
+
+(defun html2text-clean-hr (p1 p2)
+  (html2text-delete-single-tag p1 p2)
+  (goto-char p1)
+  (newline 1)
+  (insert (make-string fill-column ?-)))
+
+(defun html2text-clean-ul (p1 p2 p3 p4)
+  (html2text-delete-tags p1 p2 p3 p4)
+  (html2text-clean-list-items p1 (- p3 (- p1 p2)) "ul"))
+
+(defun html2text-clean-ol (p1 p2 p3 p4)
+  (html2text-delete-tags p1 p2 p3 p4)
+  (html2text-clean-list-items p1 (- p3 (- p1 p2)) "ol"))
+
+(defun html2text-clean-dl (p1 p2 p3 p4)
+  (html2text-delete-tags p1 p2 p3 p4)
+  (html2text-clean-dtdd p1 (- p3 (- p1 p2))))
+
+(defun html2text-clean-center (p1 p2 p3 p4)
+  (html2text-delete-tags p1 p2 p3 p4)
+  (center-region p1 (- p3 (- p2 p1))))
+
+(defun html2text-clean-bold (p1 p2 p3 p4)
+  (put-text-property p2 p3 'face 'bold)
+  (html2text-delete-tags p1 p2 p3 p4))
+
+(defun html2text-clean-title (p1 p2 p3 p4)
+  (put-text-property p2 p3 'face 'bold)
+  (html2text-delete-tags p1 p2 p3 p4))
+
+(defun html2text-clean-underline (p1 p2 p3 p4)
+  (put-text-property p2 p3 'face 'underline)
+  (html2text-delete-tags p1 p2 p3 p4))
+
+(defun html2text-clean-italic (p1 p2 p3 p4)
+  (put-text-property p2 p3 'face 'italic)
+  (html2text-delete-tags p1 p2 p3 p4))
+
+(defun html2text-clean-font (p1 p2 p3 p4)
+  (html2text-delete-tags p1 p2 p3 p4))
+
+(defun html2text-clean-blockquote (p1 p2 p3 p4)
+  (html2text-delete-tags p1 p2 p3 p4))
+
+(defun html2text-clean-anchor (p1 p2 p3 p4)
+  ;; If someone can explain how to make the URL clickable I will surely
+  ;; improve upon this.
+  ;; Maybe `goto-addr.el' can be used here.
+  (let* ((attr-list (html2text-get-attr p1 p2))
+         (href (html2text-attr-value attr-list "href")))
+    (delete-region p1 p4)
+    (when href
+      (goto-char p1)
+      (insert (if (string-match "\\`['\"].*['\"]\\'" href)
+                  (substring href 1 -1) href))
+      (put-text-property p1 (point) 'face 'bold))))
+
+;;
+;; </Functions to be called to format a tag-pair>
+;;
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;
+;; <Functions to be called to fix up paragraphs>
+;;
+
+(defun html2text-fix-paragraph (p1 p2)
+  (goto-char p1)
+  (let ((refill-start)
+        (refill-stop))
+    (when (re-search-forward "<br>$" p2 t)
+      (goto-char p1)
+      (when (re-search-forward ".+[^<][^b][^r][^>]$" p2 t)
+        (beginning-of-line)
+        (setq refill-start (point))
+        (goto-char p2)
+        (re-search-backward ".+[^<][^b][^r][^>]$" refill-start t)
+        (forward-line 1)
+        (end-of-line)
+        ;; refill-stop should ideally be adjusted to
+        ;; accommodate the "<br>" strings which are removed
+        ;; between refill-start and refill-stop.  Can simply
+        ;; be returned from my-replace-string
+        (setq refill-stop (+ (point)
+                             (html2text-replace-string
+                              "<br>" ""
+                              refill-start (point))))
+        ;; (message "Point = %s  refill-stop = %s" (point) refill-stop)
+        ;; (sleep-for 4)
+        (fill-region refill-start refill-stop))))
+  (html2text-replace-string "<br>" "" p1 p2))
+
+;;
+;; This one is interactive ...
+;;
+(defun html2text-fix-paragraphs ()
+  "This _tries_ to fix up the paragraphs - this is done in quite a ad-hook
+fashion, quite close to pure guess-work. It does work in some cases though."
+  (interactive)
+  (goto-char (point-min))
+  (while (re-search-forward "^<br>$" nil t)
+    (delete-region (match-beginning 0) (match-end 0)))
+  ;; Removing lonely <br> on a single line, if they are left intact we
+  ;; don't have any paragraphs at all.
+  (goto-char (point-min))
+  (while (not (eobp))
+    (let ((p1 (point)))
+      (forward-paragraph 1)
+      ;;(message "Kaller fix med p1=%s  p2=%s " p1 (1- (point))) (sleep-for 5)
+      (html2text-fix-paragraph p1 (1- (point)))
+      (goto-char p1)
+      (when (not (eobp))
+        (forward-paragraph 1)))))
+
+;;
+;; </Functions to be called to fix up paragraphs>
+;;
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;
+;; <Interactive functions>
+;;
+
+(defun html2text-remove-tags (tag-list)
+  "Removes the tags listed in the list `html2text-remove-tag-list'.
+See the documentation for that variable."
+  (interactive)
+  (dolist (tag tag-list)
+    (goto-char (point-min))
+    (while (re-search-forward (format "\\(</?%s[^>]*>\\)" tag) (point-max) t)
+      (delete-region (match-beginning 0) (match-end 0)))))
+
+(defun html2text-format-tags ()
+  "See the variable `html2text-format-tag-list' for documentation."
+  (interactive)
+  (dolist (tag-and-function html2text-format-tag-list)
+    (let ((tag      (car tag-and-function))
+          (function (cdr tag-and-function)))
+      (goto-char (point-min))
+      (while (re-search-forward (format "\\(<%s\\( [^>]*\\)?>\\)" tag)
+                                (point-max) t)
+        (let ((p1)
+              (p2 (point))
+              (p3) (p4))
+          (search-backward "<" (point-min) t)
+          (setq p1 (point))
+          (unless (search-forward (format "</%s>" tag) (point-max) t)
+            (goto-char p2)
+            (insert (format "</%s>" tag)))
+          (setq p4 (point))
+          (search-backward "</" (point-min) t)
+          (setq p3 (point))
+          (funcall function p1 p2 p3 p4)
+          (goto-char p1))))))
+
+(defun html2text-substitute ()
+  "See the variable `html2text-replace-list' for documentation."
+  (interactive)
+  (dolist (e html2text-replace-list)
+    (goto-char (point-min))
+    (let ((old-string (car e))
+          (new-string (cdr e)))
+      (html2text-replace-string old-string new-string (point-min) (point-max)))))
+
+(defun html2text-format-single-elements ()
+  (interactive)
+  (dolist (tag-and-function html2text-format-single-element-list)
+    (let ((tag      (car tag-and-function))
+          (function (cdr tag-and-function)))
+      (goto-char (point-min))
+      (while (re-search-forward (format "\\(<%s\\( [^>]*\\)?>\\)" tag)
+                                (point-max) t)
+        (let ((p1)
+              (p2 (point)))
+          (search-backward "<" (point-min) t)
+          (setq p1 (point))
+          (funcall function p1 p2))))))
+
+;;
+;; Main function
+;;
+
+;;;###autoload
+(defun html2text ()
+  "Convert HTML to plain text in the current buffer."
+  (interactive)
+  (save-excursion
+    (let ((case-fold-search t)
+          (buffer-read-only))
+      (html2text-remove-tags html2text-remove-tag-list)
+      (html2text-format-tags)
+      (html2text-remove-tags html2text-remove-tag-list2)
+      (html2text-substitute)
+      (html2text-format-single-elements)
+      (html2text-fix-paragraphs))))
+
+;;
+;; </Interactive functions>
+;;
+(provide 'html2text)
+
+;;; html2text.el ends here
diff --git a/lisp/net/mailcap.el b/lisp/net/mailcap.el
new file mode 100644
index 00000000000..609a8f4d64b
--- /dev/null
+++ b/lisp/net/mailcap.el
@@ -0,0 +1,1054 @@
+;;; mailcap.el --- MIME media types configuration
+
+;; Copyright (C) 1998-2016 Free Software Foundation, Inc.
+
+;; Author: William M. Perry <wmperry@aventail.com>
+;;      Lars Magne Ingebrigtsen <larsi@gnus.org>
+;; Keywords: news, mail, multimedia
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Provides configuration of MIME media types from directly from Lisp
+;; and via the usual mailcap mechanism (RFC 1524).  Deals with
+;; mime.types similarly.
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+(autoload 'mail-header-parse-content-type "mail-parse")
+
+(defgroup mailcap nil
+  "Definition of viewers for MIME types."
+  :version "21.1"
+  :group 'mime)
+
+(defvar mailcap-parse-args-syntax-table
+  (let ((table (copy-syntax-table emacs-lisp-mode-syntax-table)))
+    (modify-syntax-entry ?' "\"" table)
+    (modify-syntax-entry ?` "\"" table)
+    (modify-syntax-entry ?{ "(" table)
+    (modify-syntax-entry ?} ")" table)
+    table)
+  "A syntax table for parsing SGML attributes.")
+
+(defvar mailcap-print-command
+  (mapconcat 'identity
+             (cons (if (boundp 'lpr-command)
+                       lpr-command
+                     "lpr")
+                   (when (boundp 'lpr-switches)
+                     (if (stringp lpr-switches)
+                         (list lpr-switches)
+                       lpr-switches)))
+             " ")
+  "Shell command (including switches) used to print PostScript files.")
+
+;; Postpone using defcustom for this as it's so big and we essentially
+;; have to have two copies of the data around then.  Perhaps just
+;; customize the Lisp viewers and rely on the normal configuration
+;; files for the rest?  -- fx
+(defvar mailcap-mime-data
+  `(("application"
+     ("vnd\\.ms-excel"
+      (viewer . "gnumeric %s")
+      (test   . (getenv "DISPLAY"))
+      (type . "application/vnd.ms-excel"))
+     ("x-x509-ca-cert"
+      (viewer . ssl-view-site-cert)
+      (type . "application/x-x509-ca-cert"))
+     ("x-x509-user-cert"
+      (viewer . ssl-view-user-cert)
+      (type . "application/x-x509-user-cert"))
+     ("octet-stream"
+      (viewer . mailcap-save-binary-file)
+      (non-viewer . t)
+      (type . "application/octet-stream"))
+     ("dvi"
+      (viewer . "xdvi -safer %s")
+      (test   . (eq window-system 'x))
+      ("needsx11")
+      (type   . "application/dvi")
+      ("print" . "dvips -qRP %s"))
+     ("dvi"
+      (viewer . "dvitty %s")
+      (test   . (not (getenv "DISPLAY")))
+      (type   . "application/dvi")
+      ("print" . "dvips -qRP %s"))
+     ("emacs-lisp"
+      (viewer . mailcap-maybe-eval)
+      (type   . "application/emacs-lisp"))
+     ("x-emacs-lisp"
+      (viewer . mailcap-maybe-eval)
+      (type   . "application/x-emacs-lisp"))
+     ("x-tar"
+      (viewer . mailcap-save-binary-file)
+      (non-viewer . t)
+      (type   . "application/x-tar"))
+     ("x-latex"
+      (viewer . tex-mode)
+      (type   . "application/x-latex"))
+     ("x-tex"
+      (viewer . tex-mode)
+      (type   . "application/x-tex"))
+     ("latex"
+      (viewer . tex-mode)
+      (type   . "application/latex"))
+     ("tex"
+      (viewer . tex-mode)
+      (type   . "application/tex"))
+     ("texinfo"
+      (viewer . texinfo-mode)
+      (type   . "application/tex"))
+     ("zip"
+      (viewer . mailcap-save-binary-file)
+      (non-viewer . t)
+      (type   . "application/zip")
+      ("copiousoutput"))
+     ("pdf"
+      (viewer . pdf-view-mode)
+      (type . "application/pdf")
+      (test . (eq window-system 'x)))
+     ("pdf"
+      (viewer . doc-view-mode)
+      (type . "application/pdf")
+      (test . (eq window-system 'x)))
+     ("pdf"
+      (viewer . "gv -safer %s")
+      (type . "application/pdf")
+      (test . window-system)
+      ("print" . ,(concat "pdf2ps %s - | " mailcap-print-command)))
+     ("pdf"
+      (viewer . "gpdf %s")
+      (type . "application/pdf")
+      ("print" . ,(concat "pdftops %s - | " mailcap-print-command))
+      (test . (eq window-system 'x)))
+     ("pdf"
+      (viewer . "xpdf %s")
+      (type . "application/pdf")
+      ("print" . ,(concat "pdftops %s - | " mailcap-print-command))
+      (test . (eq window-system 'x)))
+     ("pdf"
+      (viewer . ,(concat "pdftotext %s -"))
+      (type   . "application/pdf")
+      ("print" . ,(concat "pdftops %s - | " mailcap-print-command))
+      ("copiousoutput"))
+     ("postscript"
+      (viewer . "gv -safer %s")
+      (type . "application/postscript")
+      (test   . window-system)
+      ("print" . ,(concat mailcap-print-command " %s"))
+      ("needsx11"))
+     ("postscript"
+      (viewer . "ghostview -dSAFER %s")
+      (type . "application/postscript")
+      (test   . (eq window-system 'x))
+      ("print" . ,(concat mailcap-print-command " %s"))
+      ("needsx11"))
+     ("postscript"
+      (viewer . "ps2ascii %s")
+      (type . "application/postscript")
+      (test . (not (getenv "DISPLAY")))
+      ("print" . ,(concat mailcap-print-command " %s"))
+      ("copiousoutput"))
+     ("sieve"
+      (viewer . sieve-mode)
+      (type   . "application/sieve"))
+     ("pgp-keys"
+      (viewer . "gpg --import --interactive --verbose")
+      (type   . "application/pgp-keys")
+      ("needsterminal")))
+    ("audio"
+     ("x-mpeg"
+      (viewer . "maplay %s")
+      (type   . "audio/x-mpeg"))
+     (".*"
+      (viewer . "showaudio")
+      (type   . "audio/*")))
+    ("message"
+     ("rfc-*822"
+      (viewer . mm-view-message)
+      (test   . (and (featurep 'gnus)
+                     (gnus-alive-p)))
+      (type   . "message/rfc822"))
+     ("rfc-*822"
+      (viewer . vm-mode)
+      (type   . "message/rfc822"))
+     ("rfc-*822"
+      (viewer . view-mode)
+      (type   . "message/rfc822")))
+    ("image"
+     ("x-xwd"
+      (viewer  . "xwud -in %s")
+      (type    . "image/x-xwd")
+      ("compose" . "xwd -frame > %s")
+      (test    . (eq window-system 'x))
+      ("needsx11"))
+     ("x11-dump"
+      (viewer . "xwud -in %s")
+      (type . "image/x-xwd")
+      ("compose" . "xwd -frame > %s")
+      (test   . (eq window-system 'x))
+      ("needsx11"))
+     ("windowdump"
+      (viewer . "xwud -in %s")
+      (type . "image/x-xwd")
+      ("compose" . "xwd -frame > %s")
+      (test   . (eq window-system 'x))
+      ("needsx11"))
+     (".*"
+      (viewer . "display %s")
+      (type . "image/*")
+      (test   . (eq window-system 'x))
+      ("needsx11"))
+     (".*"
+      (viewer . "ee %s")
+      (type . "image/*")
+      (test   . (eq window-system 'x))
+      ("needsx11")))
+    ("text"
+     ("plain"
+      (viewer  . view-mode)
+      (type    . "text/plain"))
+     ("plain"
+      (viewer  . fundamental-mode)
+      (type    . "text/plain"))
+     ("enriched"
+      (viewer . enriched-decode)
+      (type   . "text/enriched"))
+     ("dns"
+      (viewer . dns-mode)
+      (type   . "text/dns")))
+    ("video"
+     ("mpeg"
+      (viewer . "mpeg_play %s")
+      (type   . "video/mpeg")
+      (test   . (eq window-system 'x))
+      ("needsx11")))
+    ("x-world"
+     ("x-vrml"
+      (viewer  . "webspace -remote %s -URL %u")
+      (type    . "x-world/x-vrml")
+      ("description"
+       "VRML document")))
+    ("archive"
+     ("tar"
+      (viewer . tar-mode)
+      (type . "archive/tar"))))
+  "The mailcap structure is an assoc list of assoc lists.
+1st assoc list is keyed on the major content-type
+2nd assoc list is keyed on the minor content-type (which can be a regexp)
+
+Which looks like:
+-----------------
+ ((\"application\"
+   (\"postscript\" . <info>))
+  (\"text\"
+   (\"plain\" . <info>)))
+
+Where <info> is another assoc list of the various information
+related to the mailcap RFC 1524.  This is keyed on the lowercase
+attribute name (viewer, test, etc).  This looks like:
+ ((viewer . VIEWERINFO)
+  (test   . TESTINFO)
+  (xxxx   . \"STRING\")
+  FLAG)
+
+Where VIEWERINFO specifies how the content-type is viewed.  Can be
+a string, in which case it is run through a shell, with appropriate
+parameters, or a symbol, in which case the symbol is `funcall'ed if
+and only if it exists as a function, with the buffer as an argument.
+
+TESTINFO is a test for the viewer's applicability, or nil.  If nil, it
+means the viewer is always valid.  If it is a Lisp function, it is
+called with a list of items from any extra fields from the
+Content-Type header as argument to return a boolean value for the
+validity.  Otherwise, if it is a non-function Lisp symbol or list
+whose car is a symbol, it is `eval'led to yield the validity.  If it
+is a string or list of strings, it represents a shell command to run
+to return a true or false shell value for the validity.")
+(put 'mailcap-mime-data 'risky-local-variable t)
+
+(defcustom mailcap-download-directory nil
+  "*Directory to which `mailcap-save-binary-file' downloads files by default.
+nil means your home directory."
+  :type '(choice (const :tag "Home directory" nil)
+                 directory)
+  :group 'mailcap)
+
+(defvar mailcap-poor-system-types
+  '(ms-dos windows-nt)
+  "Systems that don't have a Unix-like directory hierarchy.")
+
+;;;
+;;; Utility functions
+;;;
+
+(defun mailcap-save-binary-file ()
+  (goto-char (point-min))
+  (unwind-protect
+      (let ((file (read-file-name
+                   "Filename to save as: "
+                   (or mailcap-download-directory "~/")))
+            (require-final-newline nil))
+        (write-region (point-min) (point-max) file))
+    (kill-buffer (current-buffer))))
+
+(defvar mailcap-maybe-eval-warning
+  "*** WARNING ***
+
+This MIME part contains untrusted and possibly harmful content.
+If you evaluate the Emacs Lisp code contained in it, a lot of nasty
+things can happen.  Please examine the code very carefully before you
+instruct Emacs to evaluate it.  You can browse the buffer containing
+the code using \\[scroll-other-window].
+
+If you are unsure what to do, please answer \"no\"."
+  "Text of warning message displayed by `mailcap-maybe-eval'.
+Make sure that this text consists only of few text lines.  Otherwise,
+Gnus might fail to display all of it.")
+
+(defun mailcap-maybe-eval ()
+  "Maybe evaluate a buffer of Emacs Lisp code."
+  (let ((lisp-buffer (current-buffer)))
+    (goto-char (point-min))
+    (when
+        (save-window-excursion
+          (delete-other-windows)
+          (let ((buffer (get-buffer-create (generate-new-buffer-name
+                                            "*Warning*"))))
+            (unwind-protect
+                (with-current-buffer buffer
+                  (insert (substitute-command-keys
+                           mailcap-maybe-eval-warning))
+                  (goto-char (point-min))
+                  (display-buffer buffer)
+                  (yes-or-no-p "This is potentially dangerous emacs-lisp code, evaluate it? "))
+              (kill-buffer buffer))))
+      (eval-buffer (current-buffer)))
+    (when (buffer-live-p lisp-buffer)
+      (with-current-buffer lisp-buffer
+        (emacs-lisp-mode)))))
+
+
+;;;
+;;; The mailcap parser
+;;;
+
+(defun mailcap-replace-regexp (regexp to-string)
+  ;; Quiet replace-regexp.
+  (goto-char (point-min))
+  (while (re-search-forward regexp nil t)
+    (replace-match to-string t nil)))
+
+(defvar mailcap-parsed-p nil)
+
+(defun mailcap-parse-mailcaps (&optional path force)
+  "Parse out all the mailcaps specified in a path string PATH.
+Components of PATH are separated by the `path-separator' character
+appropriate for this system.  If FORCE, re-parse even if already
+parsed.  If PATH is omitted, use the value of environment variable
+MAILCAPS if set; otherwise (on Unix) use the path from RFC 1524, plus
+/usr/local/etc/mailcap."
+  (interactive (list nil t))
+  (when (or (not mailcap-parsed-p)
+            force)
+    (cond
+     (path nil)
+     ((getenv "MAILCAPS") (setq path (getenv "MAILCAPS")))
+     ((memq system-type mailcap-poor-system-types)
+      (setq path '("~/.mailcap" "~/mail.cap" "~/etc/mail.cap")))
+     (t (setq path
+              ;; This is per RFC 1524, specifically
+              ;; with /usr before /usr/local.
+              '("~/.mailcap" "/etc/mailcap" "/usr/etc/mailcap"
+                "/usr/local/etc/mailcap"))))
+    (let ((fnames (reverse
+                   (if (stringp path)
+                       (split-string path path-separator t)
+                     path)))
+          fname)
+      (while fnames
+        (setq fname (car fnames))
+        (if (and (file-readable-p fname)
+                 (file-regular-p fname))
+            (mailcap-parse-mailcap fname))
+        (setq fnames (cdr fnames))))
+      (setq mailcap-parsed-p t)))
+
+(defun mailcap-parse-mailcap (fname)
+  "Parse out the mailcap file specified by FNAME."
+  (let (major                           ; The major mime type (image/audio/etc)
+        minor                           ; The minor mime type (gif, basic, etc)
+        save-pos                        ; Misc saved positions used in parsing
+        viewer                          ; How to view this mime type
+        info                            ; Misc info about this mime type
+        )
+    (with-temp-buffer
+      (insert-file-contents fname)
+      (set-syntax-table mailcap-parse-args-syntax-table)
+      (mailcap-replace-regexp "#.*" "") ; Remove all comments
+      (mailcap-replace-regexp "\\\\[ \t]*\n" " ") ; And collapse spaces
+      (mailcap-replace-regexp "\n+" "\n") ; And blank lines
+      (goto-char (point-max))
+      (skip-chars-backward " \t\n")
+      (delete-region (point) (point-max))
+      (while (not (bobp))
+        (skip-chars-backward " \t\n")
+        (beginning-of-line)
+        (setq save-pos (point)
+              info nil)
+        (skip-chars-forward "^/; \t\n")
+        (downcase-region save-pos (point))
+        (setq major (buffer-substring save-pos (point)))
+        (skip-chars-forward " \t")
+        (setq minor "")
+        (when (eq (char-after) ?/)
+          (forward-char)
+          (skip-chars-forward " \t")
+          (setq save-pos (point))
+          (skip-chars-forward "^; \t\n")
+          (downcase-region save-pos (point))
+          (setq minor
+                (cond
+                 ((eq ?* (or (char-after save-pos) 0)) ".*")
+                 ((= (point) save-pos) ".*")
+                 (t (regexp-quote (buffer-substring save-pos (point)))))))
+        (skip-chars-forward " \t")
+        ;;; Got the major/minor chunks, now for the viewers/etc
+        ;;; The first item _must_ be a viewer, according to the
+        ;;; RFC for mailcap files (#1524)
+        (setq viewer "")
+        (when (eq (char-after) ?\;)
+          (forward-char)
+          (skip-chars-forward " \t")
+          (setq save-pos (point))
+          (skip-chars-forward "^;\n")
+          ;; skip \;
+          (while (eq (char-before) ?\\)
+            (backward-delete-char 1)
+            (forward-char)
+            (skip-chars-forward "^;\n"))
+          (if (eq (or (char-after save-pos) 0) ?')
+              (setq viewer (progn
+                             (narrow-to-region (1+ save-pos) (point))
+                             (goto-char (point-min))
+                             (prog1
+                                 (read (current-buffer))
+                               (goto-char (point-max))
+                               (widen))))
+            (setq viewer (buffer-substring save-pos (point)))))
+        (setq save-pos (point))
+        (end-of-line)
+        (unless (equal viewer "")
+          (setq info (nconc (list (cons 'viewer viewer)
+                                  (cons 'type (concat major "/"
+                                                      (if (string= minor ".*")
+                                                          "*" minor))))
+                            (mailcap-parse-mailcap-extras save-pos (point))))
+          (mailcap-mailcap-entry-passes-test info)
+          (mailcap-add-mailcap-entry major minor info))
+        (beginning-of-line)))))
+
+(defun mailcap-parse-mailcap-extras (st nd)
+  "Grab all the extra stuff from a mailcap entry."
+  (let (
+        name                            ; From name=
+        value                           ; its value
+        results                         ; Assoc list of results
+        name-pos                        ; Start of XXXX= position
+        val-pos                         ; Start of value position
+        done                            ; Found end of \'d ;s?
+        )
+    (save-restriction
+      (narrow-to-region st nd)
+      (goto-char (point-min))
+      (skip-chars-forward " \n\t;")
+      (while (not (eobp))
+        (setq done nil)
+        (setq name-pos (point))
+        (skip-chars-forward "^ \n\t=;")
+        (downcase-region name-pos (point))
+        (setq name (buffer-substring name-pos (point)))
+        (skip-chars-forward " \t\n")
+        (if (not (eq (char-after (point)) ?=)) ; There is no value
+            (setq value t)
+          (skip-chars-forward " \t\n=")
+          (setq val-pos (point))
+          (if (memq (char-after val-pos) '(?\" ?'))
+              (progn
+                (setq val-pos (1+ val-pos))
+                (condition-case nil
+                    (progn
+                      (forward-sexp 1)
+                      (backward-char 1))
+                  (error (goto-char (point-max)))))
+            (while (not done)
+              (skip-chars-forward "^;")
+              (if (eq (char-after (1- (point))) ?\\ )
+                  (progn
+                    (subst-char-in-region (1- (point)) (point) ?\\ ? )
+                    (skip-chars-forward ";"))
+                (setq done t))))
+          (setq value (buffer-substring val-pos (point))))
+        ;; `test' as symbol, others like "copiousoutput" and "needsx11" as
+        ;; strings
+        (setq results (cons (cons (if (string-equal name "test")
+                                      'test
+                                    name)
+                                  value) results))
+        (skip-chars-forward " \";\n\t"))
+      results)))
+
+(defun mailcap-mailcap-entry-passes-test (info)
+  "Replace the test clause of INFO itself with a boolean for some cases.
+This function supports only `test -n $DISPLAY' and `test -z $DISPLAY',
+replaces them with t or nil.  As for others or if INFO has a interactive
+spec (needsterm, needsterminal, or needsx11) but DISPLAY is not set,
+the test clause will be unchanged."
+  (let ((test (assq 'test info))        ; The test clause
+        status)
+    (setq status (and test (split-string (cdr test) " ")))
+    (if (and (or (assoc "needsterm" info)
+                 (assoc "needsterminal" info)
+                 (assoc "needsx11" info))
+             (not (getenv "DISPLAY")))
+        (setq status nil)
+      (cond
+       ((and (equal (nth 0 status) "test")
+             (equal (nth 1 status) "-n")
+             (or (equal (nth 2 status) "$DISPLAY")
+                 (equal (nth 2 status) "\"$DISPLAY\"")))
+        (setq status (if (getenv "DISPLAY") t nil)))
+       ((and (equal (nth 0 status) "test")
+             (equal (nth 1 status) "-z")
+             (or (equal (nth 2 status) "$DISPLAY")
+                 (equal (nth 2 status) "\"$DISPLAY\"")))
+        (setq status (if (getenv "DISPLAY") nil t)))
+       (test nil)
+       (t nil)))
+    (and test (listp test) (setcdr test status))))
+
+;;;
+;;; The action routines.
+;;;
+
+(defun mailcap-possible-viewers (major minor)
+  "Return a list of possible viewers from MAJOR for minor type MINOR."
+  (let ((exact '())
+        (wildcard '()))
+    (while major
+      (cond
+       ((equal (car (car major)) minor)
+        (setq exact (cons (cdr (car major)) exact)))
+       ((and minor (string-match (concat "^" (car (car major)) "$") minor))
+        (setq wildcard (cons (cdr (car major)) wildcard))))
+      (setq major (cdr major)))
+    (nconc exact wildcard)))
+
+(defun mailcap-unescape-mime-test (test type-info)
+  (let (save-pos save-chr subst)
+    (cond
+     ((symbolp test) test)
+     ((and (listp test) (symbolp (car test))) test)
+     ((or (stringp test)
+          (and (listp test) (stringp (car test))
+               (setq test (mapconcat 'identity test " "))))
+      (with-temp-buffer
+        (insert test)
+        (goto-char (point-min))
+        (while (not (eobp))
+          (skip-chars-forward "^%")
+          (if (/= (- (point)
+                     (progn (skip-chars-backward "\\\\")
+                            (point)))
+                  0)                    ; It is an escaped %
+              (progn
+                (delete-char 1)
+                (skip-chars-forward "%."))
+            (setq save-pos (point))
+            (skip-chars-forward "%")
+            (setq save-chr (char-after (point)))
+            ;; Escapes:
+            ;; %s: name of a file for the body data
+            ;; %t: content-type
+            ;; %{<parameter name}: value of parameter in mailcap entry
+            ;; %n: number of sub-parts for multipart content-type
+            ;; %F: a set of content-type/filename pairs for multiparts
+            (cond
+             ((null save-chr) nil)
+             ((= save-chr ?t)
+              (delete-region save-pos (progn (forward-char 1) (point)))
+              (insert (or (cdr (assq 'type type-info)) "\"\"")))
+             ((memq save-chr '(?M ?n ?F))
+              (delete-region save-pos (progn (forward-char 1) (point)))
+              (insert "\"\""))
+             ((= save-chr ?{)
+              (forward-char 1)
+              (skip-chars-forward "^}")
+              (downcase-region (+ 2 save-pos) (point))
+              (setq subst (buffer-substring (+ 2 save-pos) (point)))
+              (delete-region save-pos (1+ (point)))
+              (insert (or (cdr (assoc subst type-info)) "\"\"")))
+             (t nil))))
+        (buffer-string)))
+     (t (error "Bad value to mailcap-unescape-mime-test: %s" test)))))
+
+(defvar mailcap-viewer-test-cache nil)
+
+(defun mailcap-viewer-passes-test (viewer-info type-info)
+  "Return non-nil if viewer specified by VIEWER-INFO passes its test clause.
+Also return non-nil if it has no test clause.  TYPE-INFO is an argument
+to supply to the test."
+  (let* ((test-info (assq 'test viewer-info))
+         (test (cdr test-info))
+         (otest test)
+         (viewer (cdr (assq 'viewer viewer-info)))
+         (default-directory (expand-file-name "~/"))
+         status parsed-test cache result)
+    (cond ((not (or (stringp viewer) (fboundp viewer)))
+           nil)                         ; Non-existent Lisp function
+          ((setq cache (assoc test mailcap-viewer-test-cache))
+           (cadr cache))
+          ((not test-info) t)           ; No test clause
+          (t
+           (setq
+            result
+            (cond
+             ((not test) nil)           ; Already failed test
+             ((eq test t) t)            ; Already passed test
+             ((functionp test)          ; Lisp function as test
+              (funcall test type-info))
+             ((and (symbolp test)       ; Lisp variable as test
+                   (boundp test))
+              (symbol-value test))
+             ((and (listp test)         ; List to be eval'd
+                   (symbolp (car test)))
+              (eval test))
+             (t
+              (setq test (mailcap-unescape-mime-test test type-info)
+                    test (list shell-file-name nil nil nil
+                               shell-command-switch test)
+                    status (apply 'call-process test))
+              (eq 0 status))))
+           (push (list otest result) mailcap-viewer-test-cache)
+           result))))
+
+(defun mailcap-add-mailcap-entry (major minor info)
+  (let ((old-major (assoc major mailcap-mime-data)))
+    (if (null old-major)                ; New major area
+        (setq mailcap-mime-data
+              (cons (cons major (list (cons minor info)))
+                    mailcap-mime-data))
+      (let ((cur-minor (assoc minor old-major)))
+        (cond
+         ((or (null cur-minor)          ; New minor area, or
+              (assq 'test info))        ; Has a test, insert at beginning
+          (setcdr old-major (cons (cons minor info) (cdr old-major))))
+         ((and (not (assq 'test info))  ; No test info, replace completely
+               (not (assq 'test cur-minor))
+               (equal (assq 'viewer info)  ; Keep alternative viewer
+                      (assq 'viewer cur-minor)))
+          (setcdr cur-minor info))
+         (t
+          (setcdr old-major (cons (cons minor info) (cdr old-major))))))
+      )))
+
+(defun mailcap-add (type viewer &optional test)
+  "Add VIEWER as a handler for TYPE.
+If TEST is not given, it defaults to t."
+  (let ((tl (split-string type "/")))
+    (when (or (not (car tl))
+              (not (cadr tl)))
+      (error "%s is not a valid MIME type" type))
+    (mailcap-add-mailcap-entry
+     (car tl) (cadr tl)
+     `((viewer . ,viewer)
+       (test . ,(if test test t))
+       (type . ,type)))))
+
+;;;
+;;; The main whabbo
+;;;
+
+(defun mailcap-viewer-lessp (x y)
+  "Return t if viewer X is more desirable than viewer Y."
+  (let ((x-wild (string-match "[*?]" (or (cdr-safe (assq 'type x)) "")))
+        (y-wild (string-match "[*?]" (or (cdr-safe (assq 'type y)) "")))
+        (x-lisp (not (stringp (or (cdr-safe (assq 'viewer x)) ""))))
+        (y-lisp (not (stringp (or (cdr-safe (assq 'viewer y)) "")))))
+    (cond
+     ((and x-wild (not y-wild))
+      nil)
+     ((and (not x-wild) y-wild)
+      t)
+     ((and (not y-lisp) x-lisp)
+      t)
+     (t nil))))
+
+(defun mailcap-mime-info (string &optional request no-decode)
+  "Get the MIME viewer command for STRING, return nil if none found.
+Expects a complete content-type header line as its argument.
+
+Second argument REQUEST specifies what information to return.  If it is
+nil or the empty string, the viewer (second field of the mailcap
+entry) will be returned.  If it is a string, then the mailcap field
+corresponding to that string will be returned (print, description,
+whatever).  If a number, then all the information for this specific
+viewer is returned.  If `all', then all possible viewers for
+this type is returned.
+
+If NO-DECODE is non-nil, don't decode STRING."
+  ;; NO-DECODE avoids calling `mail-header-parse-content-type' from
+  ;; `mail-parse.el'
+  (let (
+        major                           ; Major encoding (text, etc)
+        minor                           ; Minor encoding (html, etc)
+        info                            ; Other info
+        save-pos                        ; Misc. position during parse
+        major-info                      ; (assoc major mailcap-mime-data)
+        minor-info                      ; (assoc minor major-info)
+        test                            ; current test proc.
+        viewers                         ; Possible viewers
+        passed                          ; Viewers that passed the test
+        viewer                          ; The one and only viewer
+        ctl)
+    (save-excursion
+      (setq ctl
+            (if no-decode
+                (list (or string "text/plain"))
+              (mail-header-parse-content-type (or string "text/plain"))))
+      (setq major (split-string (car ctl) "/"))
+      (setq minor (cadr major)
+            major (car major))
+      (when (setq major-info (cdr (assoc major mailcap-mime-data)))
+        (when (setq viewers (mailcap-possible-viewers major-info minor))
+          (setq info (mapcar (lambda (a) (cons (symbol-name (car a))
+                                               (cdr a)))
+                             (cdr ctl)))
+          (while viewers
+            (if (mailcap-viewer-passes-test (car viewers) info)
+                (setq passed (cons (car viewers) passed)))
+            (setq viewers (cdr viewers)))
+          (setq passed (sort passed 'mailcap-viewer-lessp))
+          (setq viewer (car passed))))
+      (when (and (stringp (cdr (assq 'viewer viewer)))
+                 passed)
+        (setq viewer (car passed)))
+      (cond
+       ((and (null viewer) (not (equal major "default")) request)
+        (mailcap-mime-info "default" request no-decode))
+       ((or (null request) (equal request ""))
+        (mailcap-unescape-mime-test (cdr (assq 'viewer viewer)) info))
+       ((stringp request)
+        (mailcap-unescape-mime-test
+         (cdr-safe (assoc request viewer)) info))
+       ((eq request 'all)
+        passed)
+       (t
+        ;; MUST make a copy *sigh*, else we modify mailcap-mime-data
+        (setq viewer (copy-sequence viewer))
+        (let ((view (assq 'viewer viewer))
+              (test (assq 'test viewer)))
+          (if view (setcdr view (mailcap-unescape-mime-test (cdr view) info)))
+          (if test (setcdr test (mailcap-unescape-mime-test (cdr test) info))))
+        viewer)))))
+
+;;;
+;;; Experimental MIME-types parsing
+;;;
+
+(defvar mailcap-mime-extensions
+  '((""       . "text/plain")
+    (".1"     . "text/plain")  ;; Manual pages
+    (".3"     . "text/plain")
+    (".8"     . "text/plain")
+    (".abs"   . "audio/x-mpeg")
+    (".aif"   . "audio/aiff")
+    (".aifc"  . "audio/aiff")
+    (".aiff"  . "audio/aiff")
+    (".ano"   . "application/x-annotator")
+    (".au"    . "audio/ulaw")
+    (".avi"   . "video/x-msvideo")
+    (".bcpio" . "application/x-bcpio")
+    (".bin"   . "application/octet-stream")
+    (".cdf"   . "application/x-netcdr")
+    (".cpio"  . "application/x-cpio")
+    (".csh"   . "application/x-csh")
+    (".css"   . "text/css")
+    (".dvi"   . "application/x-dvi")
+    (".diff"  . "text/x-patch")
+    (".dpatch". "test/x-patch")
+    (".el"    . "application/emacs-lisp")
+    (".eps"   . "application/postscript")
+    (".etx"   . "text/x-setext")
+    (".exe"   . "application/octet-stream")
+    (".fax"   . "image/x-fax")
+    (".gif"   . "image/gif")
+    (".hdf"   . "application/x-hdf")
+    (".hqx"   . "application/mac-binhex40")
+    (".htm"   . "text/html")
+    (".html"  . "text/html")
+    (".icon"  . "image/x-icon")
+    (".ief"   . "image/ief")
+    (".jpg"   . "image/jpeg")
+    (".macp"  . "image/x-macpaint")
+    (".man"   . "application/x-troff-man")
+    (".me"    . "application/x-troff-me")
+    (".mif"   . "application/mif")
+    (".mov"   . "video/quicktime")
+    (".movie" . "video/x-sgi-movie")
+    (".mp2"   . "audio/x-mpeg")
+    (".mp3"   . "audio/x-mpeg")
+    (".mp2a"  . "audio/x-mpeg2")
+    (".mpa"   . "audio/x-mpeg")
+    (".mpa2"  . "audio/x-mpeg2")
+    (".mpe"   . "video/mpeg")
+    (".mpeg"  . "video/mpeg")
+    (".mpega" . "audio/x-mpeg")
+    (".mpegv" . "video/mpeg")
+    (".mpg"   . "video/mpeg")
+    (".mpv"   . "video/mpeg")
+    (".ms"    . "application/x-troff-ms")
+    (".nc"    . "application/x-netcdf")
+    (".nc"    . "application/x-netcdf")
+    (".oda"   . "application/oda")
+    (".patch" . "text/x-patch")
+    (".pbm"   . "image/x-portable-bitmap")
+    (".pdf"   . "application/pdf")
+    (".pgm"   . "image/portable-graymap")
+    (".pict"  . "image/pict")
+    (".png"   . "image/png")
+    (".pnm"   . "image/x-portable-anymap")
+    (".pod"   . "text/plain")
+    (".ppm"   . "image/portable-pixmap")
+    (".ps"    . "application/postscript")
+    (".qt"    . "video/quicktime")
+    (".ras"   . "image/x-raster")
+    (".rgb"   . "image/x-rgb")
+    (".rtf"   . "application/rtf")
+    (".rtx"   . "text/richtext")
+    (".sh"    . "application/x-sh")
+    (".sit"   . "application/x-stuffit")
+    (".siv"   . "application/sieve")
+    (".snd"   . "audio/basic")
+    (".soa"   . "text/dns")
+    (".src"   . "application/x-wais-source")
+    (".tar"   . "archive/tar")
+    (".tcl"   . "application/x-tcl")
+    (".tex"   . "application/x-tex")
+    (".texi"  . "application/texinfo")
+    (".tga"   . "image/x-targa")
+    (".tif"   . "image/tiff")
+    (".tiff"  . "image/tiff")
+    (".tr"    . "application/x-troff")
+    (".troff" . "application/x-troff")
+    (".tsv"   . "text/tab-separated-values")
+    (".txt"   . "text/plain")
+    (".vbs"   . "video/mpeg")
+    (".vox"   . "audio/basic")
+    (".vrml"  . "x-world/x-vrml")
+    (".wav"   . "audio/x-wav")
+    (".xls"   . "application/vnd.ms-excel")
+    (".wrl"   . "x-world/x-vrml")
+    (".xbm"   . "image/xbm")
+    (".xpm"   . "image/xpm")
+    (".xwd"   . "image/windowdump")
+    (".zip"   . "application/zip")
+    (".ai"    . "application/postscript")
+    (".jpe"   . "image/jpeg")
+    (".jpeg"  . "image/jpeg")
+    (".org"   . "text/x-org"))
+  "An alist of file extensions and corresponding MIME content-types.
+This exists for you to customize the information in Lisp.  It is
+merged with values from mailcap files by `mailcap-parse-mimetypes'.")
+
+(defvar mailcap-mimetypes-parsed-p nil)
+
+(defun mailcap-parse-mimetypes (&optional path force)
+  "Parse out all the mimetypes specified in a Unix-style path string PATH.
+Components of PATH are separated by the `path-separator' character
+appropriate for this system.  If PATH is omitted, use the value of
+environment variable MIMETYPES if set; otherwise use a default path.
+If FORCE, re-parse even if already parsed."
+  (interactive (list nil t))
+  (when (or (not mailcap-mimetypes-parsed-p)
+            force)
+    (cond
+     (path nil)
+     ((getenv "MIMETYPES") (setq path (getenv "MIMETYPES")))
+     ((memq system-type mailcap-poor-system-types)
+      (setq path '("~/mime.typ" "~/etc/mime.typ")))
+     (t (setq path
+              ;; mime.types seems to be the normal name, definitely so
+              ;; on current GNUish systems.  The search order follows
+              ;; that for mailcap.
+              '("~/.mime.types"
+                "/etc/mime.types"
+                "/usr/etc/mime.types"
+                "/usr/local/etc/mime.types"
+                "/usr/local/www/conf/mime.types"
+                "~/.mime-types"
+                "/etc/mime-types"
+                "/usr/etc/mime-types"
+                "/usr/local/etc/mime-types"
+                "/usr/local/www/conf/mime-types"))))
+    (let ((fnames (reverse (if (stringp path)
+                               (split-string path path-separator t)
+                             path)))
+          fname)
+      (while fnames
+        (setq fname (car fnames))
+        (if (and (file-readable-p fname))
+            (mailcap-parse-mimetype-file fname))
+        (setq fnames (cdr fnames))))
+    (setq mailcap-mimetypes-parsed-p t)))
+
+(defun mailcap-parse-mimetype-file (fname)
+  "Parse out a mime-types file FNAME."
+  (let (type                            ; The MIME type for this line
+        extns                           ; The extensions for this line
+        save-pos                        ; Misc. saved buffer positions
+        )
+    (with-temp-buffer
+      (insert-file-contents fname)
+      (mailcap-replace-regexp "#.*" "")
+      (mailcap-replace-regexp "\n+" "\n")
+      (mailcap-replace-regexp "[ \t]+$" "")
+      (goto-char (point-max))
+      (skip-chars-backward " \t\n")
+      (delete-region (point) (point-max))
+      (goto-char (point-min))
+      (while (not (eobp))
+        (skip-chars-forward " \t\n")
+        (setq save-pos (point))
+        (skip-chars-forward "^ \t\n")
+        (downcase-region save-pos (point))
+        (setq type (buffer-substring save-pos (point)))
+        (while (not (eolp))
+          (skip-chars-forward " \t")
+          (setq save-pos (point))
+          (skip-chars-forward "^ \t\n")
+          (setq extns (cons (buffer-substring save-pos (point)) extns)))
+        (while extns
+          (setq mailcap-mime-extensions
+                (cons
+                 (cons (if (= (string-to-char (car extns)) ?.)
+                           (car extns)
+                         (concat "." (car extns))) type)
+                 mailcap-mime-extensions)
+                extns (cdr extns)))))))
+
+(defun mailcap-extension-to-mime (extn)
+  "Return the MIME content type of the file extensions EXTN."
+  (mailcap-parse-mimetypes)
+  (if (and (stringp extn)
+           (not (eq (string-to-char extn) ?.)))
+      (setq extn (concat "." extn)))
+  (cdr (assoc (downcase extn) mailcap-mime-extensions)))
+
+;; Unused?
+(defalias 'mailcap-command-p 'executable-find)
+
+(defun mailcap-mime-types ()
+  "Return a list of MIME media types."
+  (mailcap-parse-mimetypes)
+  (delete-dups
+   (nconc
+    (mapcar 'cdr mailcap-mime-extensions)
+    (apply
+     'nconc
+     (mapcar
+      (lambda (l)
+        (delq nil
+              (mapcar
+               (lambda (m)
+                 (let ((type (cdr (assq 'type (cdr m)))))
+                   (if (equal (cadr (split-string type "/"))
+                              "*")
+                       nil
+                     type)))
+               (cdr l))))
+      mailcap-mime-data)))))
+
+;;;
+;;; Useful supplementary functions
+;;;
+
+(defun mailcap-file-default-commands (files)
+  "Return a list of default commands for FILES."
+  (mailcap-parse-mailcaps)
+  (mailcap-parse-mimetypes)
+  (let* ((all-mime-type
+          ;; All unique MIME types from file extensions
+          (delete-dups
+           (mapcar (lambda (file)
+                     (mailcap-extension-to-mime
+                      (file-name-extension file t)))
+                   files)))
+         (all-mime-info
+          ;; All MIME info lists
+          (delete-dups
+           (mapcar (lambda (mime-type)
+                     (mailcap-mime-info mime-type 'all))
+                   all-mime-type)))
+         (common-mime-info
+          ;; Intersection of mime-infos from different mime-types;
+          ;; or just the first MIME info for a single MIME type
+          (if (cdr all-mime-info)
+              (delq nil (mapcar (lambda (mi1)
+                                  (unless (memq nil (mapcar
+                                                     (lambda (mi2)
+                                                       (member mi1 mi2))
+                                                     (cdr all-mime-info)))
+                                    mi1))
+                                (car all-mime-info)))
+            (car all-mime-info)))
+         (commands
+          ;; Command strings from `viewer' field of the MIME info
+          (delete-dups
+           (delq nil (mapcar
+                      (lambda (mime-info)
+                        (let ((command (cdr (assoc 'viewer mime-info))))
+                          (if (stringp command)
+                              (replace-regexp-in-string
+                               ;; Replace mailcap's `%s' placeholder
+                               ;; with dired's `?' placeholder
+                               "%s" "?"
+                               (replace-regexp-in-string
+                                ;; Remove the final filename placeholder
+                                "[ \t\n]*\\('\\)?%s\\1?[ \t\n]*\\'" ""
+                                command nil t)
+                               nil t))))
+                             common-mime-info)))))
+    commands))
+
+(defun mailcap-view-mime (type)
+  "View the data in the current buffer that has MIME type TYPE.
+`mailcap-mime-data' determines the method to use."
+  (let ((method (mailcap-mime-info type)))
+    (if (stringp method)
+        (shell-command-on-region (point-min) (point-max)
+                                 ;; Use stdin as the "%s".
+                                 (format method "-")
+                                 (current-buffer)
+                                 t)
+      (funcall method))))
+
+(provide 'mailcap)
+
+;;; mailcap.el ends here
diff --git a/lisp/net/pop3.el b/lisp/net/pop3.el
new file mode 100644
index 00000000000..1695bbd3a40
--- /dev/null
+++ b/lisp/net/pop3.el
@@ -0,0 +1,914 @@
+;;; pop3.el --- Post Office Protocol (RFC 1460) interface
+
+;; Copyright (C) 1996-2016 Free Software Foundation, Inc.
+
+;; Author: Richard L. Pieri <ratinox@peorth.gweep.net>
+;; Maintainer: emacs-devel@gnu.org
+;; Keywords: mail
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Most of the standard Post Office Protocol version 3 (RFC 1460) commands
+;; are implemented.  The LIST command has not been implemented due to lack
+;; of actual usefulness.
+;; The optional POP3 command TOP has not been implemented.
+
+;; This program was inspired by Kyle E. Jones's vm-pop program.
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+
+(require 'mail-utils)
+(defvar parse-time-months)
+
+(defgroup pop3 nil
+  "Post Office Protocol."
+  :group 'mail
+  :group 'mail-source)
+
+(defcustom pop3-maildrop (or (user-login-name)
+                             (getenv "LOGNAME")
+                             (getenv "USER"))
+  "*POP3 maildrop."
+  :version "22.1" ;; Oort Gnus
+  :type 'string
+  :group 'pop3)
+
+(defcustom pop3-mailhost (or (getenv "MAILHOST") ;; nil -> mismatch
+                             "pop3")
+  "*POP3 mailhost."
+  :version "22.1" ;; Oort Gnus
+  :type 'string
+  :group 'pop3)
+
+(defcustom pop3-port 110
+  "*POP3 port."
+  :version "22.1" ;; Oort Gnus
+  :type 'number
+  :group 'pop3)
+
+(defcustom pop3-password-required t
+  "*Non-nil if a password is required when connecting to POP server."
+  :version "22.1" ;; Oort Gnus
+  :type 'boolean
+  :group 'pop3)
+
+;; Should this be customizable?
+(defvar pop3-password nil
+  "*Password to use when connecting to POP server.")
+
+(defcustom pop3-authentication-scheme 'pass
+  "*POP3 authentication scheme.
+Defaults to `pass', for the standard USER/PASS authentication.  The other
+valid value is `apop'."
+  :type '(choice (const :tag "Normal user/password" pass)
+                 (const :tag "APOP" apop))
+  :version "22.1" ;; Oort Gnus
+  :group 'pop3)
+
+(defcustom pop3-stream-length 100
+  "How many messages should be requested at one time.
+The lower the number, the more latency-sensitive the fetching
+will be.  If your pop3 server doesn't support streaming at all,
+set this to 1."
+  :type 'number
+  :version "24.1"
+  :group 'pop3)
+
+(defcustom pop3-leave-mail-on-server nil
+  "Non-nil if the mail is to be left on the POP server after fetching.
+Mails once fetched will never be fetched again by the UIDL control.
+
+If this is neither nil nor a number, all mails will be left on the
+server.  If this is a number, leave mails on the server for this many
+days since you first checked new mails.  If this is nil, mails will be
+deleted on the server right after fetching.
+
+Gnus users should use the `:leave' keyword in a mail source to direct
+the behavior per server, rather than directly modifying this value.
+
+Note that POP servers maintain no state information between sessions,
+so what the client believes is there and what is actually there may
+not match up.  If they do not, then you may get duplicate mails or
+the whole thing can fall apart and leave you with a corrupt mailbox."
+  :version "24.4"
+  :type '(choice (const :tag "Don't leave mails" nil)
+                 (const :tag "Leave all mails" t)
+                 (number :tag "Leave mails for this many days" :value 14))
+  :group 'pop3)
+
+(defcustom pop3-uidl-file "~/.pop3-uidl"
+  "File used to save UIDL."
+  :version "24.4"
+  :type 'file
+  :group 'pop3)
+
+(defcustom pop3-uidl-file-backup '(0 9)
+  "How to backup the UIDL file `pop3-uidl-file' when updating.
+If it is a list of numbers, the first one binds `kept-old-versions' and
+the other binds `kept-new-versions' to keep number of oldest and newest
+versions.  Otherwise, the value binds `version-control' (which see).
+
+Note: Backup will take place whenever you check new mails on a server.
+So, you may lose the backup files having been saved before a trouble
+if you set it so as to make too few backups whereas you have access to
+many servers."
+  :version "24.4"
+  :type '(choice (group :tag "Keep versions" :format "\n%v" :indent 3
+                        (number :tag "oldest")
+                        (number :tag "newest"))
+                 (sexp :format "%v"
+                       :match (lambda (widget value)
+                                (condition-case nil
+                                    (not (and (numberp (car value))
+                                              (numberp (car (cdr value)))))
+                                  (error t)))))
+  :group 'pop3)
+
+(defvar pop3-timestamp nil
+  "Timestamp returned when initially connected to the POP server.
+Used for APOP authentication.")
+
+(defvar pop3-read-point nil)
+(defvar pop3-debug nil)
+
+;; Borrowed from nnheader-accept-process-output in nnheader.el.  See the
+;; comments there for explanations about the values.
+
+(eval-and-compile
+  (if (and (fboundp 'nnheader-accept-process-output)
+           (boundp 'nnheader-read-timeout))
+      (defalias 'pop3-accept-process-output 'nnheader-accept-process-output)
+    ;; Borrowed from `nnheader.el':
+    (defvar pop3-read-timeout
+      (if (string-match "windows-nt\\|os/2\\|cygwin"
+                        (symbol-name system-type))
+          1.0
+        0.01)
+      "How long pop3 should wait between checking for the end of output.
+Shorter values mean quicker response, but are more CPU intensive.")
+    (defun pop3-accept-process-output (process)
+      (accept-process-output
+       process
+       (truncate pop3-read-timeout)
+       (truncate (* (- pop3-read-timeout
+                       (truncate pop3-read-timeout))
+                    1000))))))
+
+(defvar pop3-uidl)
+;; List of UIDLs of existing messages at present in the server:
+;; ("UIDL1" "UIDL2" "UIDL3"...)
+
+(defvar pop3-uidl-saved)
+;; Locally saved UIDL data; an alist of the server, the user, and the UIDL
+;; and timestamp pairs:
+;; (("SERVER_A" ("USER_A1" "UIDL1" TIMESTAMP1 "UIDL2" TIMESTAMP2...)
+;;              ("USER_A2" "UIDL1" TIMESTAMP1 "UIDL2" TIMESTAMP2...)
+;;              ...)
+;;  ("SERVER_B" ("USER_B1" "UIDL1" TIMESTAMP1 "UIDL2" TIMESTAMP2...)
+;;              ("USER_B2" "UIDL1" TIMESTAMP1 "UIDL2" TIMESTAMP2...)
+;;              ...))
+;; Where TIMESTAMP is the most significant two digits of an Emacs time,
+;; i.e. the return value of `current-time'.
+
+;;;###autoload
+(defun pop3-movemail (file)
+  "Transfer contents of a maildrop to the specified FILE.
+Use streaming commands."
+  (let ((process (pop3-open-server pop3-mailhost pop3-port))
+        messages total-size
+        pop3-uidl
+        pop3-uidl-saved)
+    (pop3-logon process)
+    (if pop3-leave-mail-on-server
+        (setq messages (pop3-uidl-stat process)
+              total-size (cadr messages)
+              messages (car messages))
+      (let ((size (pop3-stat process)))
+        (dotimes (i (car size)) (push (1+ i) messages))
+        (setq messages (nreverse messages)
+              total-size (cadr size))))
+    (when messages
+      (with-current-buffer (process-buffer process)
+        (pop3-send-streaming-command process "RETR" messages total-size)
+        (pop3-write-to-file file messages)
+        (unless pop3-leave-mail-on-server
+          (pop3-send-streaming-command process "DELE" messages nil))))
+    (if pop3-leave-mail-on-server
+        (when (prog1 (pop3-uidl-dele process) (pop3-quit process))
+          (pop3-uidl-save))
+      (pop3-quit process)
+      ;; Remove UIDL data for the account that got not to leave mails.
+      (setq pop3-uidl-saved (pop3-uidl-load))
+      (let ((elt (assoc pop3-maildrop
+                        (cdr (assoc pop3-mailhost pop3-uidl-saved)))))
+        (when elt
+          (setcdr elt nil)
+          (pop3-uidl-save))))
+    t))
+
+(defun pop3-send-streaming-command (process command messages total-size)
+  (erase-buffer)
+  (let ((count (length messages))
+        (i 1)
+        (start-point (point-min))
+        (waited-for 0))
+    (while messages
+      (process-send-string process (format "%s %d\r\n" command (pop messages)))
+      ;; Only do 100 messages at a time to avoid pipe stalls.
+      (when (zerop (% i pop3-stream-length))
+        (setq start-point
+              (pop3-wait-for-messages process pop3-stream-length
+                                      total-size start-point))
+        (incf waited-for pop3-stream-length))
+      (incf i))
+    (pop3-wait-for-messages process (- count waited-for)
+                            total-size start-point)))
+
+(defun pop3-wait-for-messages (process count total-size start-point)
+  (while (> count 0)
+    (goto-char start-point)
+    (while (or (and (re-search-forward "^\\+OK" nil t)
+                    (or (not total-size)
+                        (re-search-forward "^\\.\r?\n" nil t)))
+               (re-search-forward "^-ERR " nil t))
+      (decf count)
+      (setq start-point (point)))
+    (unless (memq (process-status process) '(open run))
+      (error "pop3 process died"))
+    (when total-size
+      (let ((size 0))
+        (goto-char (point-min))
+        (while (re-search-forward "^\\+OK.*\n" nil t)
+          (setq size (+ size (- (point))
+                        (if (re-search-forward "^\\.\r?\n" nil 'move)
+                            (match-beginning 0)
+                          (point)))))
+        (message "pop3 retrieved %dKB (%d%%)"
+                 (truncate (/ size 1000))
+                 (truncate (* (/ (* size 1.0) total-size) 100)))))
+    (pop3-accept-process-output process))
+  start-point)
+
+(defun pop3-write-to-file (file messages)
+  (let ((pop-buffer (current-buffer))
+        (start (point-min))
+        beg end
+        temp-buffer)
+    (with-temp-buffer
+      (setq temp-buffer (current-buffer))
+      (with-current-buffer pop-buffer
+        (goto-char (point-min))
+        (while (re-search-forward "^\\+OK" nil t)
+          (forward-line 1)
+          (setq beg (point))
+          (when (re-search-forward "^\\.\r?\n" nil t)
+            (setq start (point))
+            (forward-line -1)
+            (setq end (point)))
+          (with-current-buffer temp-buffer
+            (goto-char (point-max))
+            (let ((hstart (point)))
+              (insert-buffer-substring pop-buffer beg end)
+              (pop3-clean-region hstart (point))
+              (goto-char (point-max))
+              (pop3-munge-message-separator hstart (point))
+              (when pop3-leave-mail-on-server
+                (pop3-uidl-add-xheader hstart (pop messages)))
+              (goto-char (point-max))))))
+      (let ((coding-system-for-write 'binary))
+        (goto-char (point-min))
+        ;; Check whether something inserted a newline at the start and
+        ;; delete it.
+        (when (eolp)
+          (delete-char 1))
+        (write-region (point-min) (point-max) file nil 'nomesg)))))
+
+(defun pop3-logon (process)
+  (let ((pop3-password pop3-password))
+    ;; for debugging only
+    (if pop3-debug (switch-to-buffer (process-buffer process)))
+    ;; query for password
+    (if (and pop3-password-required (not pop3-password))
+        (setq pop3-password
+              (read-passwd (format "Password for %s: " pop3-maildrop))))
+    (cond ((equal 'apop pop3-authentication-scheme)
+           (pop3-apop process pop3-maildrop))
+          ((equal 'pass pop3-authentication-scheme)
+           (pop3-user process pop3-maildrop)
+           (pop3-pass process))
+          (t (error "Invalid POP3 authentication scheme")))))
+
+(defun pop3-get-message-count ()
+  "Return the number of messages in the maildrop."
+  (let* ((process (pop3-open-server pop3-mailhost pop3-port))
+         message-count
+         (pop3-password pop3-password))
+    ;; for debugging only
+    (if pop3-debug (switch-to-buffer (process-buffer process)))
+    ;; query for password
+    (if (and pop3-password-required (not pop3-password))
+        (setq pop3-password
+              (read-passwd (format "Password for %s: " pop3-maildrop))))
+    (cond ((equal 'apop pop3-authentication-scheme)
+           (pop3-apop process pop3-maildrop))
+          ((equal 'pass pop3-authentication-scheme)
+           (pop3-user process pop3-maildrop)
+           (pop3-pass process))
+          (t (error "Invalid POP3 authentication scheme")))
+    (setq message-count (car (pop3-stat process)))
+    (pop3-quit process)
+    message-count))
+
+(defun pop3-uidl-stat (process)
+  "Return a list of unread message numbers and total size."
+  (pop3-send-command process "UIDL")
+  (let (err messages size)
+    (if (condition-case code
+            (progn
+              (pop3-read-response process)
+              t)
+          (error (setq err (error-message-string code))
+                 nil))
+        (let ((start pop3-read-point)
+              saved list)
+          (with-current-buffer (process-buffer process)
+            (while (not (re-search-forward "^\\.\r\n" nil t))
+              (unless (memq (process-status process) '(open run))
+                (error "pop3 server closed the connection"))
+              (pop3-accept-process-output process)
+              (goto-char start))
+            (setq pop3-read-point (point-marker)
+                  pop3-uidl nil)
+            (while (progn (forward-line -1) (>= (point) start))
+              (when (looking-at "[0-9]+ \\([^\n\r ]+\\)")
+                (push (match-string 1) pop3-uidl)))
+            (when pop3-uidl
+              (setq pop3-uidl-saved (pop3-uidl-load)
+                    saved (cdr (assoc pop3-maildrop
+                                      (cdr (assoc pop3-mailhost
+                                                  pop3-uidl-saved)))))
+              (let ((i (length pop3-uidl)))
+                (while (> i 0)
+                  (unless (member (nth (1- i) pop3-uidl) saved)
+                    (push i messages))
+                  (decf i)))
+              (when messages
+                (setq list (pop3-list process)
+                      size 0)
+                (dolist (msg messages)
+                  (setq size (+ size (cdr (assq msg list)))))
+                (list messages size)))))
+      (message "%s doesn't support UIDL (%s), so we try a regressive way..."
+               pop3-mailhost err)
+      (sit-for 1)
+      (setq size (pop3-stat process))
+      (dotimes (i (car size)) (push (1+ i) messages))
+      (setcar size (nreverse messages))
+      size)))
+
+(defun pop3-uidl-dele (process)
+  "Delete messages according to `pop3-leave-mail-on-server'.
+Return non-nil if it is necessary to update the local UIDL file."
+  (let* ((ctime (current-time))
+         (srvr (assoc pop3-mailhost pop3-uidl-saved))
+         (saved (assoc pop3-maildrop (cdr srvr)))
+         i uidl mod new tstamp dele)
+    (setcdr (cdr ctime) nil)
+    ;; Add new messages to the data to be saved.
+    (cond ((and pop3-uidl saved)
+           (setq i (1- (length pop3-uidl)))
+           (while (>= i 0)
+             (unless (member (setq uidl (nth i pop3-uidl)) (cdr saved))
+               (push ctime new)
+               (push uidl new))
+             (decf i)))
+          (pop3-uidl
+           (setq new (apply 'nconc (mapcar (lambda (elt) (list elt ctime))
+                                           pop3-uidl)))))
+    (when new (setq mod t))
+    ;; List expirable messages and delete them from the data to be saved.
+    (setq ctime (when (numberp pop3-leave-mail-on-server)
+                  (/ (+ (* (car ctime) 65536.0) (cadr ctime)) 86400))
+          i (1- (length saved)))
+    (while (> i 0)
+      (if (member (setq uidl (nth (1- i) saved)) pop3-uidl)
+          (progn
+            (setq tstamp (nth i saved))
+            (if (and ctime
+                     (> (- ctime (/ (+ (* (car tstamp) 65536.0) (cadr tstamp))
+                                    86400))
+                        pop3-leave-mail-on-server))
+                ;; Mails to delete.
+                (progn
+                  (setq mod t)
+                  (push uidl dele))
+              ;; Mails to keep.
+              (push tstamp new)
+              (push uidl new)))
+        ;; Mails having been deleted in the server.
+        (setq mod t))
+      (decf i 2))
+    (cond (saved
+           (setcdr saved new))
+          (srvr
+           (setcdr (last srvr) (list (cons pop3-maildrop new))))
+          (t
+           (add-to-list 'pop3-uidl-saved
+                        (list pop3-mailhost (cons pop3-maildrop new))
+                        t)))
+    ;; Actually delete the messages in the server.
+    (when dele
+      (setq uidl nil
+            i (length pop3-uidl))
+      (while (> i 0)
+        (when (member (nth (1- i) pop3-uidl) dele)
+          (push i uidl))
+        (decf i))
+      (when uidl
+        (pop3-send-streaming-command process "DELE" uidl nil)))
+    mod))
+
+(defun pop3-uidl-load ()
+  "Load saved UIDL."
+  (when (file-exists-p pop3-uidl-file)
+    (with-temp-buffer
+      (condition-case code
+          (progn
+            (insert-file-contents pop3-uidl-file)
+            (goto-char (point-min))
+            (read (current-buffer)))
+        (error
+         (message "Error while loading %s (%s)"
+                  pop3-uidl-file (error-message-string code))
+         (sit-for 1)
+         nil)))))
+
+(defun pop3-uidl-save ()
+  "Save UIDL."
+  (with-temp-buffer
+    (if pop3-uidl-saved
+        (progn
+          (insert "(")
+          (dolist (srvr pop3-uidl-saved)
+            (when (cdr srvr)
+              (insert "(\"" (pop srvr) "\"\n  ")
+              (dolist (elt srvr)
+                (when (cdr elt)
+                  (insert "(\"" (pop elt) "\"\n   ")
+                  (while elt
+                    (insert (format "\"%s\" %s\n   " (pop elt) (pop elt))))
+                  (delete-char -4)
+                  (insert ")\n  ")))
+              (delete-char -3)
+              (if (eq (char-before) ?\))
+                  (insert ")\n ")
+                (goto-char (1+ (point-at-bol)))
+                (delete-region (point) (point-max)))))
+          (when (eq (char-before) ? )
+            (delete-char -2))
+          (insert ")\n"))
+      (insert "()\n"))
+    (let ((buffer-file-name pop3-uidl-file)
+          (delete-old-versions t)
+          (kept-new-versions kept-new-versions)
+          (kept-old-versions kept-old-versions)
+          (version-control version-control))
+      (if (consp pop3-uidl-file-backup)
+          (setq kept-new-versions (cadr pop3-uidl-file-backup)
+                kept-old-versions (car pop3-uidl-file-backup)
+                version-control t)
+        (setq version-control pop3-uidl-file-backup))
+      (save-buffer))))
+
+(defun pop3-uidl-add-xheader (start msgno)
+  "Add X-UIDL header."
+  (let ((case-fold-search t))
+    (save-restriction
+      (narrow-to-region start (progn
+                                (goto-char start)
+                                (search-forward "\n\n" nil 'move)
+                                (1- (point))))
+      (goto-char start)
+      (while (re-search-forward "^x-uidl:" nil t)
+        (while (progn
+                 (forward-line 1)
+                 (memq (char-after) '(?\t ? ))))
+        (delete-region (match-beginning 0) (point)))
+      (goto-char (point-max))
+      (insert "X-UIDL: " (nth (1- msgno) pop3-uidl) "\n"))))
+
+(defcustom pop3-stream-type nil
+  "*Transport security type for POP3 connections.
+This may be either nil (plain connection), `ssl' (use an
+SSL/TSL-secured stream) or `starttls' (use the starttls mechanism
+to turn on TLS security after opening the stream).  However, if
+this is nil, `ssl' is assumed for connections to port
+995 (pop3s)."
+  :version "23.1" ;; No Gnus
+  :group 'pop3
+  :type '(choice (const :tag "Plain" nil)
+                 (const :tag "SSL/TLS" ssl)
+                 (const starttls)))
+
+(defun pop3-open-server (mailhost port)
+  "Open TCP connection to MAILHOST on PORT.
+Returns the process associated with the connection."
+  (let ((coding-system-for-read 'binary)
+        (coding-system-for-write 'binary)
+        result)
+    (with-current-buffer
+        (get-buffer-create (concat " trace of POP session to "
+                                   mailhost))
+      (erase-buffer)
+      (setq pop3-read-point (point-min))
+      (setq result
+            (open-network-stream
+             "POP" (current-buffer) mailhost port
+             :type (cond
+                    ((or (eq pop3-stream-type 'ssl)
+                         (and (not pop3-stream-type)
+                              (member port '(995 "pop3s"))))
+                     'tls)
+                    (t
+                     (or pop3-stream-type 'network)))
+             :warn-unless-encrypted t
+             :capability-command "CAPA\r\n"
+             :end-of-command "^\\(-ERR\\|+OK\\).*\n"
+             :end-of-capability "^\\.\r?\n\\|^-ERR"
+             :success "^\\+OK.*\n"
+             :return-list t
+             :starttls-function
+             (lambda (capabilities)
+               (and (string-match "\\bSTLS\\b" capabilities)
+                    "STLS\r\n"))))
+      (when result
+        (let ((response (plist-get (cdr result) :greeting)))
+          (setq pop3-timestamp
+                (substring response (or (string-match "<" response) 0)
+                           (+ 1 (or (string-match ">" response) -1)))))
+        (set-process-query-on-exit-flag (car result) nil)
+        (erase-buffer)
+        (car result)))))
+
+;; Support functions
+
+(defun pop3-send-command (process command)
+  (set-buffer (process-buffer process))
+  (goto-char (point-max))
+  ;; (if (= (aref command 0) ?P)
+  ;;     (insert "PASS <omitted>\r\n")
+  ;;   (insert command "\r\n"))
+  (setq pop3-read-point (point))
+  (goto-char (point-max))
+  (process-send-string process (concat command "\r\n")))
+
+(defun pop3-read-response (process &optional return)
+  "Read the response from the server.
+Return the response string if optional second argument is non-nil."
+  (let ((case-fold-search nil)
+        match-end)
+    (with-current-buffer (process-buffer process)
+      (goto-char pop3-read-point)
+      (while (and (memq (process-status process) '(open run))
+                  (not (search-forward "\r\n" nil t)))
+        (pop3-accept-process-output process)
+        (goto-char pop3-read-point))
+      (setq match-end (point))
+      (goto-char pop3-read-point)
+      (if (looking-at "-ERR")
+          (error "%s" (buffer-substring (point) (- match-end 2)))
+        (if (not (looking-at "+OK"))
+            (progn (setq pop3-read-point match-end) nil)
+          (setq pop3-read-point match-end)
+          (if return
+              (buffer-substring (point) match-end)
+            t)
+          )))))
+
+(defun pop3-clean-region (start end)
+  (setq end (set-marker (make-marker) end))
+  (save-excursion
+    (goto-char start)
+    (while (and (< (point) end) (search-forward "\r\n" end t))
+      (replace-match "\n" t t))
+    (goto-char start)
+    (while (and (< (point) end) (re-search-forward "^\\." end t))
+      (replace-match "" t t)
+      (forward-char)))
+  (set-marker end nil))
+
+;; Copied from message-make-date.
+(defun pop3-make-date (&optional now)
+  "Make a valid date header.
+If NOW, use that time instead."
+  (require 'parse-time)
+  (let* ((now (or now (current-time)))
+         (zone (nth 8 (decode-time now)))
+         (sign "+"))
+    (when (< zone 0)
+      (setq sign "-")
+      (setq zone (- zone)))
+    (concat
+     (format-time-string "%d" now)
+     ;; The month name of the %b spec is locale-specific.  Pfff.
+     (format " %s "
+             (capitalize (car (rassoc (nth 4 (decode-time now))
+                                      parse-time-months))))
+     (format-time-string "%Y %H:%M:%S %z" now))))
+
+(defun pop3-munge-message-separator (start end)
+  "Check to see if a message separator exists.  If not, generate one."
+  (save-excursion
+    (save-restriction
+      (narrow-to-region start end)
+      (goto-char (point-min))
+      (if (not (or (looking-at "From .?") ; Unix mail
+                   (looking-at "\001\001\001\001\n") ; MMDF
+                   (looking-at "BABYL OPTIONS:") ; Babyl
+                   ))
+          (let* ((from (mail-strip-quoted-names (mail-fetch-field "From")))
+                 (tdate (mail-fetch-field "Date"))
+                 (date (split-string (or (and tdate
+                                              (not (string= "" tdate))
+                                              tdate)
+                                         (pop3-make-date))
+                                     " "))
+                 (From_))
+            ;; sample date formats I have seen
+            ;; Date: Tue, 9 Jul 1996 09:04:21 -0400 (EDT)
+            ;; Date: 08 Jul 1996 23:22:24 -0400
+            ;; should be
+            ;; Tue Jul 9 09:04:21 1996
+
+            ;; Fixme: This should use timezone on the date field contents.
+            (setq date
+                  (cond ((not date)
+                         "Tue Jan 1 00:00:0 1900")
+                        ((string-match "[A-Z]" (nth 0 date))
+                         (format "%s %s %s %s %s"
+                                 (nth 0 date) (nth 2 date) (nth 1 date)
+                                 (nth 4 date) (nth 3 date)))
+                        (t
+                         ;; this really needs to be better but I don't feel
+                         ;; like writing a date to day converter.
+                         (format "Sun %s %s %s %s"
+                                 (nth 1 date) (nth 0 date)
+                                 (nth 3 date) (nth 2 date)))
+                        ))
+            (setq From_ (format "\nFrom %s  %s\n" from date))
+            (while (string-match "," From_)
+              (setq From_ (concat (substring From_ 0 (match-beginning 0))
+                                  (substring From_ (match-end 0)))))
+            (goto-char (point-min))
+            (insert From_)
+            (if (search-forward "\n\n" nil t)
+                nil
+              (goto-char (point-max))
+              (insert "\n"))
+            (let ((size (- (point-max) (point))))
+              (forward-line -1)
+              (insert (format "Content-Length: %s\n" size)))
+            )))))
+
+;; The Command Set
+
+;; AUTHORIZATION STATE
+
+(defun pop3-user (process user)
+  "Send USER information to POP3 server."
+  (pop3-send-command process (format "USER %s" user))
+  (let ((response (pop3-read-response process t)))
+    (if (not (and response (string-match "+OK" response)))
+        (error "USER %s not valid" user))))
+
+(defun pop3-pass (process)
+  "Send authentication information to the server."
+  (pop3-send-command process (format "PASS %s" pop3-password))
+  (let ((response (pop3-read-response process t)))
+    (if (not (and response (string-match "+OK" response)))
+        (pop3-quit process))))
+
+(defun pop3-apop (process user)
+  "Send alternate authentication information to the server."
+  (let ((pass pop3-password))
+    (if (and pop3-password-required (not pass))
+        (setq pass
+              (read-passwd (format "Password for %s: " pop3-maildrop))))
+    (if pass
+        (let ((hash (md5 (concat pop3-timestamp pass) nil nil 'binary)))
+          (pop3-send-command process (format "APOP %s %s" user hash))
+          (let ((response (pop3-read-response process t)))
+            (if (not (and response (string-match "+OK" response)))
+                (pop3-quit process)))))
+    ))
+
+;; TRANSACTION STATE
+
+(defun pop3-stat (process)
+  "Return the number of messages in the maildrop and the maildrop's size."
+  (pop3-send-command process "STAT")
+  (let ((response (pop3-read-response process t)))
+    (list (string-to-number (nth 1 (split-string response " ")))
+          (string-to-number (nth 2 (split-string response " "))))
+    ))
+
+(defun pop3-list (process &optional msg)
+  "If MSG is nil, return an alist of (MESSAGE-ID . SIZE) pairs.
+Otherwise, return the size of the message-id MSG"
+  (pop3-send-command process (if msg
+                                 (format "LIST %d" msg)
+                               "LIST"))
+  (let ((response (pop3-read-response process t)))
+    (if msg
+        (string-to-number (nth 2 (split-string response " ")))
+      (let ((start pop3-read-point) end)
+        (with-current-buffer (process-buffer process)
+          (while (not (re-search-forward "^\\.\r\n" nil t))
+            (pop3-accept-process-output process)
+            (goto-char start))
+          (setq pop3-read-point (point-marker))
+          (goto-char (match-beginning 0))
+          (setq end (point-marker))
+          (mapcar #'(lambda (s) (let ((split (split-string s " ")))
+                                  (cons (string-to-number (nth 0 split))
+                                        (string-to-number (nth 1 split)))))
+                  (split-string (buffer-substring start end) "\r\n" t)))))))
+
+(defun pop3-retr (process msg crashbuf)
+  "Retrieve message-id MSG to buffer CRASHBUF."
+  (pop3-send-command process (format "RETR %s" msg))
+  (pop3-read-response process)
+  (let ((start pop3-read-point) end)
+    (with-current-buffer (process-buffer process)
+      (while (not (re-search-forward "^\\.\r\n" nil t))
+        (unless (memq (process-status process) '(open run))
+          (error "pop3 server closed the connection"))
+        (pop3-accept-process-output process)
+        (goto-char start))
+      (setq pop3-read-point (point-marker))
+      ;; this code does not seem to work for some POP servers...
+      ;; and I cannot figure out why not.
+      ;;      (goto-char (match-beginning 0))
+      ;;      (backward-char 2)
+      ;;      (if (not (looking-at "\r\n"))
+      ;;          (insert "\r\n"))
+      ;;      (re-search-forward "\\.\r\n")
+      (goto-char (match-beginning 0))
+      (setq end (point-marker))
+      (pop3-clean-region start end)
+      (pop3-munge-message-separator start end)
+      (with-current-buffer crashbuf
+        (erase-buffer))
+      (copy-to-buffer crashbuf start end)
+      (delete-region start end)
+      )))
+
+(defun pop3-dele (process msg)
+  "Mark message-id MSG as deleted."
+  (pop3-send-command process (format "DELE %s" msg))
+  (pop3-read-response process))
+
+(defun pop3-noop (process msg)
+  "No-operation."
+  (pop3-send-command process "NOOP")
+  (pop3-read-response process))
+
+(defun pop3-last (process)
+  "Return highest accessed message-id number for the session."
+  (pop3-send-command process "LAST")
+  (let ((response (pop3-read-response process t)))
+    (string-to-number (nth 1 (split-string response " ")))
+    ))
+
+(defun pop3-rset (process)
+  "Remove all delete marks from current maildrop."
+  (pop3-send-command process "RSET")
+  (pop3-read-response process))
+
+;; UPDATE
+
+(defun pop3-quit (process)
+  "Close connection to POP3 server.
+Tell server to remove all messages marked as deleted, unlock the maildrop,
+and close the connection."
+  (pop3-send-command process "QUIT")
+  (pop3-read-response process t)
+  (if process
+      (with-current-buffer (process-buffer process)
+        (goto-char (point-max))
+        (delete-process process))))
+
+;; Summary of POP3 (Post Office Protocol version 3) commands and responses
+
+;;; AUTHORIZATION STATE
+
+;; Initial TCP connection
+;; Arguments: none
+;; Restrictions: none
+;; Possible responses:
+;;  +OK [POP3 server ready]
+
+;; USER name
+;; Arguments: a server specific user-id (required)
+;; Restrictions: authorization state [after unsuccessful USER or PASS
+;; Possible responses:
+;;  +OK [valid user-id]
+;;  -ERR [invalid user-id]
+
+;; PASS string
+;; Arguments: a server/user-id specific password (required)
+;; Restrictions: authorization state, after successful USER
+;; Possible responses:
+;;  +OK [maildrop locked and ready]
+;;  -ERR [invalid password]
+;;  -ERR [unable to lock maildrop]
+
+;; STLS      (RFC 2595)
+;; Arguments: none
+;; Restrictions: Only permitted in AUTHORIZATION state.
+;; Possible responses:
+;;  +OK
+;;  -ERR
+
+;;; TRANSACTION STATE
+
+;; STAT
+;; Arguments: none
+;; Restrictions: transaction state
+;; Possible responses:
+;;  +OK nn mm [# of messages, size of maildrop]
+
+;; LIST [msg]
+;; Arguments: a message-id (optional)
+;; Restrictions: transaction state; msg must not be deleted
+;; Possible responses:
+;;  +OK [scan listing follows]
+;;  -ERR [no such message]
+
+;; RETR msg
+;; Arguments: a message-id (required)
+;; Restrictions: transaction state; msg must not be deleted
+;; Possible responses:
+;;  +OK [message contents follow]
+;;  -ERR [no such message]
+
+;; DELE msg
+;; Arguments: a message-id (required)
+;; Restrictions: transaction state; msg must not be deleted
+;; Possible responses:
+;;  +OK [message deleted]
+;;  -ERR [no such message]
+
+;; NOOP
+;; Arguments: none
+;; Restrictions: transaction state
+;; Possible responses:
+;;  +OK
+
+;; LAST
+;; Arguments: none
+;; Restrictions: transaction state
+;; Possible responses:
+;;  +OK nn [highest numbered message accessed]
+
+;; RSET
+;; Arguments: none
+;; Restrictions: transaction state
+;; Possible responses:
+;;  +OK [all delete marks removed]
+
+;; UIDL [msg]
+;; Arguments: a message-id (optional)
+;; Restrictions: transaction state; msg must not be deleted
+;; Possible responses:
+;;  +OK [uidl listing follows]
+;;  -ERR [no such message]
+
+;;; UPDATE STATE
+
+;; QUIT
+;; Arguments: none
+;; Restrictions: none
+;; Possible responses:
+;;  +OK [TCP connection closed]
+
+(provide 'pop3)
+
+;;; pop3.el ends here
diff --git a/lisp/net/sieve-manage.el b/lisp/net/sieve-manage.el
new file mode 100644
index 00000000000..695bbd860de
--- /dev/null
+++ b/lisp/net/sieve-manage.el
@@ -0,0 +1,575 @@
+;;; sieve-manage.el --- Implementation of the managesieve protocol in elisp
+
+;; Copyright (C) 2001-2016 Free Software Foundation, Inc.
+
+;; Author: Simon Josefsson <simon@josefsson.org>
+;;         Albert Krewinkel <tarleb@moltkeplatz.de>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This library provides an elisp API for the managesieve network
+;; protocol.
+;;
+;; It uses the SASL library for authentication, which means it
+;; supports DIGEST-MD5, CRAM-MD5, SCRAM-MD5, NTLM, PLAIN and LOGIN
+;; methods.  STARTTLS is not well tested, but should be easy to get to
+;; work if someone wants.
+;;
+;; The API should be fairly obvious for anyone familiar with the
+;; managesieve protocol, interface functions include:
+;;
+;; `sieve-manage-open'
+;; open connection to managesieve server, returning a buffer to be
+;; used by all other API functions.
+;;
+;; `sieve-manage-opened'
+;; check if a server is open or not
+;;
+;; `sieve-manage-close'
+;; close a server connection.
+;;
+;; `sieve-manage-listscripts'
+;; `sieve-manage-deletescript'
+;; `sieve-manage-getscript'
+;; performs managesieve protocol actions
+;;
+;; and that's it.  Example of a managesieve session in *scratch*:
+;;
+;; (with-current-buffer (sieve-manage-open "mail.example.com")
+;;   (sieve-manage-authenticate)
+;;   (sieve-manage-listscripts))
+;;
+;; => ((active . "main") "vacation")
+;;
+;; References:
+;;
+;; draft-martin-managesieve-02.txt,
+;; "A Protocol for Remotely Managing Sieve Scripts",
+;; by Tim Martin.
+;;
+;; Release history:
+;;
+;; 2001-10-31 Committed to Oort Gnus.
+;; 2002-07-27 Added DELETESCRIPT.  Suggested by Ned Ludd.
+;; 2002-08-03 Use SASL library.
+;; 2013-06-05 Enabled STARTTLS support, fixed bit rot.
+
+;;; Code:
+
+(if (locate-library "password-cache")
+    (require 'password-cache)
+  (require 'password))
+
+(eval-when-compile (require 'cl))
+(require 'sasl)
+(require 'starttls)
+(autoload 'sasl-find-mechanism "sasl")
+(autoload 'auth-source-search "auth-source")
+
+;; User customizable variables:
+
+(defgroup sieve-manage nil
+  "Low-level Managesieve protocol issues."
+  :group 'mail
+  :prefix "sieve-")
+
+(defcustom sieve-manage-log "*sieve-manage-log*"
+  "Name of buffer for managesieve session trace."
+  :type 'string
+  :group 'sieve-manage)
+
+(defcustom sieve-manage-server-eol "\r\n"
+  "The EOL string sent from the server."
+  :type 'string
+  :group 'sieve-manage)
+
+(defcustom sieve-manage-client-eol "\r\n"
+  "The EOL string we send to the server."
+  :type 'string
+  :group 'sieve-manage)
+
+(defcustom sieve-manage-authenticators '(digest-md5
+                                         cram-md5
+                                         scram-md5
+                                         ntlm
+                                         plain
+                                         login)
+  "Priority of authenticators to consider when authenticating to server."
+  ;; FIXME Improve this.  It's not `set'.
+  ;; It's like (repeat (choice (const ...))), where each choice can
+  ;; only appear once.
+  :type '(repeat symbol)
+  :group 'sieve-manage)
+
+(defcustom sieve-manage-authenticator-alist
+  '((cram-md5   sieve-manage-cram-md5-p       sieve-manage-cram-md5-auth)
+    (digest-md5 sieve-manage-digest-md5-p     sieve-manage-digest-md5-auth)
+    (scram-md5  sieve-manage-scram-md5-p      sieve-manage-scram-md5-auth)
+    (ntlm       sieve-manage-ntlm-p           sieve-manage-ntlm-auth)
+    (plain      sieve-manage-plain-p          sieve-manage-plain-auth)
+    (login      sieve-manage-login-p          sieve-manage-login-auth))
+  "Definition of authenticators.
+
+\(NAME CHECK AUTHENTICATE)
+
+NAME names the authenticator.  CHECK is a function returning non-nil if
+the server support the authenticator and AUTHENTICATE is a function
+for doing the actual authentication."
+  :type '(repeat (list (symbol :tag "Name") (function :tag "Check function")
+                       (function :tag "Authentication function")))
+  :group 'sieve-manage)
+
+(defcustom sieve-manage-default-port "sieve"
+  "Default port number or service name for managesieve protocol."
+  :type '(choice integer string)
+  :version "24.4"
+  :group 'sieve-manage)
+
+(defcustom sieve-manage-default-stream 'network
+  "Default stream type to use for `sieve-manage'."
+  :version "24.1"
+  :type 'symbol
+  :group 'sieve-manage)
+
+;; Internal variables:
+
+(defconst sieve-manage-local-variables '(sieve-manage-server
+                                         sieve-manage-port
+                                         sieve-manage-auth
+                                         sieve-manage-stream
+                                         sieve-manage-process
+                                         sieve-manage-client-eol
+                                         sieve-manage-server-eol
+                                         sieve-manage-capability))
+(defconst sieve-manage-coding-system-for-read 'binary)
+(defconst sieve-manage-coding-system-for-write 'binary)
+(defvar sieve-manage-stream nil)
+(defvar sieve-manage-auth nil)
+(defvar sieve-manage-server nil)
+(defvar sieve-manage-port nil)
+(defvar sieve-manage-state 'closed
+  "Managesieve state.
+Valid states are `closed', `initial', `nonauth', and `auth'.")
+(defvar sieve-manage-process nil)
+(defvar sieve-manage-capability nil)
+
+;; Internal utility functions
+(autoload 'mm-enable-multibyte "mm-util")
+
+(defun sieve-manage-make-process-buffer ()
+  (with-current-buffer
+      (generate-new-buffer (format " *sieve %s:%s*"
+                                   sieve-manage-server
+                                   sieve-manage-port))
+    (mapc 'make-local-variable sieve-manage-local-variables)
+    (mm-enable-multibyte)
+    (buffer-disable-undo)
+    (current-buffer)))
+
+(defun sieve-manage-erase (&optional p buffer)
+  (let ((buffer (or buffer (current-buffer))))
+    (and sieve-manage-log
+         (with-current-buffer (get-buffer-create sieve-manage-log)
+           (mm-enable-multibyte)
+           (buffer-disable-undo)
+           (goto-char (point-max))
+           (insert-buffer-substring buffer (with-current-buffer buffer
+                                             (point-min))
+                                    (or p (with-current-buffer buffer
+                                            (point-max)))))))
+  (delete-region (point-min) (or p (point-max))))
+
+(defun sieve-manage-open-server (server port &optional stream buffer)
+  "Open network connection to SERVER on PORT.
+Return the buffer associated with the connection."
+  (with-current-buffer buffer
+    (sieve-manage-erase)
+    (setq sieve-manage-state 'initial)
+    (destructuring-bind (proc . props)
+        (open-network-stream
+         "SIEVE" buffer server port
+         :type stream
+         :capability-command "CAPABILITY\r\n"
+         :end-of-command "^\\(OK\\|NO\\).*\n"
+         :success "^OK.*\n"
+         :return-list t
+         :starttls-function
+         (lambda (capabilities)
+           (when (string-match "\\bSTARTTLS\\b" capabilities)
+             "STARTTLS\r\n")))
+      (setq sieve-manage-process proc)
+      (setq sieve-manage-capability
+            (sieve-manage-parse-capability (plist-get props :capabilities)))
+      ;; Ignore new capabilities issues after successful STARTTLS
+      (when (and (memq stream '(nil network starttls))
+                 (eq (plist-get props :type) 'tls))
+        (sieve-manage-drop-next-answer))
+      (current-buffer))))
+
+;; Authenticators
+(defun sieve-sasl-auth (buffer mech)
+  "Login to server using the SASL MECH method."
+  (message "sieve: Authenticating using %s..." mech)
+  (with-current-buffer buffer
+    (let* ((auth-info (auth-source-search :host sieve-manage-server
+                                          :port "sieve"
+                                          :max 1
+                                          :create t))
+           (user-name (or (plist-get (nth 0 auth-info) :user) ""))
+           (user-password (or (plist-get (nth 0 auth-info) :secret) ""))
+           (user-password (if (functionp user-password)
+                              (funcall user-password)
+                            user-password))
+           (client (sasl-make-client (sasl-find-mechanism (list mech))
+                                     user-name "sieve" sieve-manage-server))
+           (sasl-read-passphrase
+            ;; We *need* to copy the password, because sasl will modify it
+            ;; somehow.
+            `(lambda (prompt) ,(copy-sequence user-password)))
+           (step (sasl-next-step client nil))
+           (tag (sieve-manage-send
+                 (concat
+                  "AUTHENTICATE \""
+                  mech
+                  "\""
+                  (and (sasl-step-data step)
+                       (concat
+                        " \""
+                        (base64-encode-string
+                         (sasl-step-data step)
+                         'no-line-break)
+                        "\"")))))
+           data rsp)
+      (catch 'done
+        (while t
+          (setq rsp nil)
+          (goto-char (point-min))
+          (while (null (or (progn
+                             (setq rsp (sieve-manage-is-string))
+                             (if (not (and rsp (looking-at
+                                                sieve-manage-server-eol)))
+                                 (setq rsp nil)
+                               (goto-char (match-end 0))
+                               rsp))
+                           (setq rsp (sieve-manage-is-okno))))
+            (accept-process-output sieve-manage-process 1)
+            (goto-char (point-min)))
+          (sieve-manage-erase)
+          (when (sieve-manage-ok-p rsp)
+            (when (and (cadr rsp)
+                       (string-match "^SASL \"\\([^\"]+\\)\"" (cadr rsp)))
+              (sasl-step-set-data
+               step (base64-decode-string (match-string 1 (cadr rsp)))))
+            (if (and (setq step (sasl-next-step client step))
+                     (setq data (sasl-step-data step)))
+                ;; We got data for server but it's finished
+                (error "Server not ready for SASL data: %s" data)
+              ;; The authentication process is finished.
+              (throw 'done t)))
+          (unless (stringp rsp)
+            (error "Server aborted SASL authentication: %s" (caddr rsp)))
+          (sasl-step-set-data step (base64-decode-string rsp))
+          (setq step (sasl-next-step client step))
+          (sieve-manage-send
+           (if (sasl-step-data step)
+               (concat "\""
+                       (base64-encode-string (sasl-step-data step)
+                                             'no-line-break)
+                       "\"")
+             ""))))
+      (message "sieve: Login using %s...done" mech))))
+
+(defun sieve-manage-cram-md5-p (buffer)
+  (sieve-manage-capability "SASL" "CRAM-MD5" buffer))
+
+(defun sieve-manage-cram-md5-auth (buffer)
+  "Login to managesieve server using the CRAM-MD5 SASL method."
+  (sieve-sasl-auth buffer "CRAM-MD5"))
+
+(defun sieve-manage-digest-md5-p (buffer)
+  (sieve-manage-capability "SASL" "DIGEST-MD5" buffer))
+
+(defun sieve-manage-digest-md5-auth (buffer)
+  "Login to managesieve server using the DIGEST-MD5 SASL method."
+  (sieve-sasl-auth buffer "DIGEST-MD5"))
+
+(defun sieve-manage-scram-md5-p (buffer)
+  (sieve-manage-capability "SASL" "SCRAM-MD5" buffer))
+
+(defun sieve-manage-scram-md5-auth (buffer)
+  "Login to managesieve server using the SCRAM-MD5 SASL method."
+  (sieve-sasl-auth buffer "SCRAM-MD5"))
+
+(defun sieve-manage-ntlm-p (buffer)
+  (sieve-manage-capability "SASL" "NTLM" buffer))
+
+(defun sieve-manage-ntlm-auth (buffer)
+  "Login to managesieve server using the NTLM SASL method."
+  (sieve-sasl-auth buffer "NTLM"))
+
+(defun sieve-manage-plain-p (buffer)
+  (sieve-manage-capability "SASL" "PLAIN" buffer))
+
+(defun sieve-manage-plain-auth (buffer)
+  "Login to managesieve server using the PLAIN SASL method."
+  (sieve-sasl-auth buffer "PLAIN"))
+
+(defun sieve-manage-login-p (buffer)
+  (sieve-manage-capability "SASL" "LOGIN" buffer))
+
+(defun sieve-manage-login-auth (buffer)
+  "Login to managesieve server using the LOGIN SASL method."
+  (sieve-sasl-auth buffer "LOGIN"))
+
+;; Managesieve API
+
+(defun sieve-manage-open (server &optional port stream auth buffer)
+  "Open a network connection to a managesieve SERVER (string).
+Optional argument PORT is port number (integer) on remote server.
+Optional argument STREAM is any of `sieve-manage-streams' (a symbol).
+Optional argument AUTH indicates authenticator to use, see
+`sieve-manage-authenticators' for available authenticators.
+If nil, chooses the best stream the server is capable of.
+Optional argument BUFFER is buffer (buffer, or string naming buffer)
+to work in."
+  (setq sieve-manage-port (or port sieve-manage-default-port))
+  (with-current-buffer (or buffer (sieve-manage-make-process-buffer))
+    (setq sieve-manage-server (or server
+                                  sieve-manage-server)
+          sieve-manage-stream (or stream
+                                  sieve-manage-stream
+                                  sieve-manage-default-stream)
+          sieve-manage-auth   (or auth
+                                  sieve-manage-auth))
+    (message "sieve: Connecting to %s..." sieve-manage-server)
+    (sieve-manage-open-server sieve-manage-server
+                              sieve-manage-port
+                              sieve-manage-stream
+                              (current-buffer))
+    (when (sieve-manage-opened (current-buffer))
+      ;; Choose authenticator
+      (when (and (null sieve-manage-auth)
+                 (not (eq sieve-manage-state 'auth)))
+        (dolist (auth sieve-manage-authenticators)
+          (when (funcall (nth 1 (assq auth sieve-manage-authenticator-alist))
+                       buffer)
+            (setq sieve-manage-auth auth)
+            (return)))
+        (unless sieve-manage-auth
+          (error "Couldn't figure out authenticator for server")))
+      (sieve-manage-erase)
+      (current-buffer))))
+
+(defun sieve-manage-authenticate (&optional buffer)
+  "Authenticate on server in BUFFER.
+Return `sieve-manage-state' value."
+  (with-current-buffer (or buffer (current-buffer))
+    (if (eq sieve-manage-state 'nonauth)
+        (when (funcall (nth 2 (assq sieve-manage-auth
+                                    sieve-manage-authenticator-alist))
+                       (current-buffer))
+          (setq sieve-manage-state 'auth))
+      sieve-manage-state)))
+
+(defun sieve-manage-opened (&optional buffer)
+  "Return non-nil if connection to managesieve server in BUFFER is open.
+If BUFFER is nil then the current buffer is used."
+  (and (setq buffer (get-buffer (or buffer (current-buffer))))
+       (buffer-live-p buffer)
+       (with-current-buffer buffer
+         (and sieve-manage-process
+              (memq (process-status sieve-manage-process) '(open run))))))
+
+(defun sieve-manage-close (&optional buffer)
+  "Close connection to managesieve server in BUFFER.
+If BUFFER is nil, the current buffer is used."
+  (with-current-buffer (or buffer (current-buffer))
+    (when (sieve-manage-opened)
+      (sieve-manage-send "LOGOUT")
+      (sit-for 1))
+    (when (and sieve-manage-process
+               (memq (process-status sieve-manage-process) '(open run)))
+      (delete-process sieve-manage-process))
+    (setq sieve-manage-process nil)
+    (sieve-manage-erase)
+    t))
+
+(defun sieve-manage-capability (&optional name value buffer)
+  "Check if capability NAME of server BUFFER match VALUE.
+If it does, return the server value of NAME. If not returns nil.
+If VALUE is nil, do not check VALUE and return server value.
+If NAME is nil, return the full server list of capabilities."
+  (with-current-buffer (or buffer (current-buffer))
+    (if (null name)
+        sieve-manage-capability
+      (let ((server-value (cadr (assoc name sieve-manage-capability))))
+        (when (or (null value)
+                  (and server-value
+                       (string-match value server-value)))
+          server-value)))))
+
+(defun sieve-manage-listscripts (&optional buffer)
+  (with-current-buffer (or buffer (current-buffer))
+    (sieve-manage-send "LISTSCRIPTS")
+    (sieve-manage-parse-listscripts)))
+
+(defun sieve-manage-havespace (name size &optional buffer)
+  (with-current-buffer (or buffer (current-buffer))
+    (sieve-manage-send (format "HAVESPACE \"%s\" %s" name size))
+    (sieve-manage-parse-okno)))
+
+(defun sieve-manage-putscript (name content &optional buffer)
+  (with-current-buffer (or buffer (current-buffer))
+    (sieve-manage-send (format "PUTSCRIPT \"%s\" {%d+}%s%s" name
+                               ;; Here we assume that the coding-system will
+                               ;; replace each char with a single byte.
+                               ;; This is always the case if `content' is
+                               ;; a unibyte string.
+                               (length content)
+                               sieve-manage-client-eol content))
+    (sieve-manage-parse-okno)))
+
+(defun sieve-manage-deletescript (name &optional buffer)
+  (with-current-buffer (or buffer (current-buffer))
+    (sieve-manage-send (format "DELETESCRIPT \"%s\"" name))
+    (sieve-manage-parse-okno)))
+
+(defun sieve-manage-getscript (name output-buffer &optional buffer)
+  (with-current-buffer (or buffer (current-buffer))
+    (sieve-manage-send (format "GETSCRIPT \"%s\"" name))
+    (let ((script (sieve-manage-parse-string)))
+      (sieve-manage-parse-crlf)
+      (with-current-buffer output-buffer
+        (insert script))
+      (sieve-manage-parse-okno))))
+
+(defun sieve-manage-setactive (name &optional buffer)
+  (with-current-buffer (or buffer (current-buffer))
+    (sieve-manage-send (format "SETACTIVE \"%s\"" name))
+    (sieve-manage-parse-okno)))
+
+;; Protocol parsing routines
+
+(defun sieve-manage-wait-for-answer ()
+  (let ((pattern "^\\(OK\\|NO\\).*\n")
+        pos)
+    (while (not pos)
+      (setq pos (search-forward-regexp pattern nil t))
+      (goto-char (point-min))
+      (sleep-for 0 50))
+    pos))
+
+(defun sieve-manage-drop-next-answer ()
+  (sieve-manage-wait-for-answer)
+  (sieve-manage-erase))
+
+(defun sieve-manage-ok-p (rsp)
+  (string= (downcase (or (car-safe rsp) "")) "ok"))
+
+(defun sieve-manage-is-okno ()
+  (when (looking-at (concat
+                     "^\\(OK\\|NO\\)\\( (\\([^)]+\\))\\)?\\( \\(.*\\)\\)?"
+                     sieve-manage-server-eol))
+    (let ((status (match-string 1))
+          (resp-code (match-string 3))
+          (response (match-string 5)))
+      (when response
+        (goto-char (match-beginning 5))
+        (setq response (sieve-manage-is-string)))
+      (list status resp-code response))))
+
+(defun sieve-manage-parse-okno ()
+  (let (rsp)
+    (while (null rsp)
+      (accept-process-output (get-buffer-process (current-buffer)) 1)
+      (goto-char (point-min))
+      (setq rsp (sieve-manage-is-okno)))
+    (sieve-manage-erase)
+    rsp))
+
+(defun sieve-manage-parse-capability (str)
+  "Parse managesieve capability string `STR'.
+Set variable `sieve-manage-capability' to "
+  (let ((capas (delq nil
+                     (mapcar #'split-string-and-unquote
+                             (split-string str "\n")))))
+    (when (string= "OK" (caar (last capas)))
+      (setq sieve-manage-state 'nonauth))
+    capas))
+
+(defun sieve-manage-is-string ()
+  (cond ((looking-at "\"\\([^\"]+\\)\"")
+         (prog1
+             (match-string 1)
+           (goto-char (match-end 0))))
+        ((looking-at (concat "{\\([0-9]+\\+?\\)}" sieve-manage-server-eol))
+         (let ((pos (match-end 0))
+               (len (string-to-number (match-string 1))))
+           (if (< (point-max) (+ pos len))
+               nil
+             (goto-char (+ pos len))
+             (buffer-substring pos (+ pos len)))))))
+
+(defun sieve-manage-parse-string ()
+  (let (rsp)
+    (while (null rsp)
+      (accept-process-output (get-buffer-process (current-buffer)) 1)
+      (goto-char (point-min))
+      (setq rsp (sieve-manage-is-string)))
+    (sieve-manage-erase (point))
+    rsp))
+
+(defun sieve-manage-parse-crlf ()
+  (when (looking-at sieve-manage-server-eol)
+    (sieve-manage-erase (match-end 0))))
+
+(defun sieve-manage-parse-listscripts ()
+  (let (tmp rsp data)
+    (while (null rsp)
+      (while (null (or (setq rsp (sieve-manage-is-okno))
+                       (setq tmp (sieve-manage-is-string))))
+        (accept-process-output (get-buffer-process (current-buffer)) 1)
+        (goto-char (point-min)))
+      (when tmp
+        (while (not (looking-at (concat "\\( ACTIVE\\)?"
+                                        sieve-manage-server-eol)))
+          (accept-process-output (get-buffer-process (current-buffer)) 1)
+          (goto-char (point-min)))
+        (if (match-string 1)
+            (push (cons 'active tmp) data)
+          (push tmp data))
+        (goto-char (match-end 0))
+        (setq tmp nil)))
+    (sieve-manage-erase)
+    (if (sieve-manage-ok-p rsp)
+        data
+      rsp)))
+
+(defun sieve-manage-send (cmdstr)
+  (setq cmdstr (concat cmdstr sieve-manage-client-eol))
+  (and sieve-manage-log
+       (with-current-buffer (get-buffer-create sieve-manage-log)
+         (mm-enable-multibyte)
+         (buffer-disable-undo)
+         (goto-char (point-max))
+         (insert cmdstr)))
+  (process-send-string sieve-manage-process cmdstr))
+
+(provide 'sieve-manage)
+
+;; sieve-manage.el ends here
diff --git a/lisp/net/sieve-mode.el b/lisp/net/sieve-mode.el
new file mode 100644
index 00000000000..7575ba67c5e
--- /dev/null
+++ b/lisp/net/sieve-mode.el
@@ -0,0 +1,221 @@
+;;; sieve-mode.el --- Sieve code editing commands for Emacs
+
+;; Copyright (C) 2001-2016 Free Software Foundation, Inc.
+
+;; Author: Simon Josefsson <simon@josefsson.org>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This file contain editing mode functions and font-lock support for
+;; editing Sieve scripts.  It sets up C-mode with support for
+;; sieve-style #-comments and a lightly hacked syntax table.  It was
+;; strongly influenced by awk-mode.el.
+;;
+;; Put something similar to the following in your .emacs to use this file:
+;;
+;; (load "~/lisp/sieve")
+;; (setq auto-mode-alist (cons '("\\.siv\\'" . sieve-mode) auto-mode-alist))
+;;
+;; References:
+;;
+;; RFC 3028,
+;; "Sieve: A Mail Filtering Language",
+;; by Tim Showalter.
+;;
+;; Release history:
+;;
+;; 2001-03-02 version 1.0 posted to gnu.emacs.sources
+;;            version 1.1 change file extension into ".siv" (official one)
+;;                        added keymap and menubar to hook into sieve-manage
+;; 2001-10-31 version 1.2 committed to Oort Gnus
+
+;;; Code:
+
+(autoload 'sieve-manage "sieve")
+(autoload 'sieve-upload "sieve")
+(eval-when-compile
+  (require 'font-lock))
+
+(defgroup sieve nil
+  "Sieve."
+  :group 'languages)
+
+(defcustom sieve-mode-hook nil
+  "Hook run in sieve mode buffers."
+  :group 'sieve
+  :type 'hook)
+
+;; Font-lock
+
+(defvar sieve-control-commands-face 'sieve-control-commands
+  "Face name used for Sieve Control Commands.")
+
+(defface sieve-control-commands
+  '((((type tty) (class color)) (:foreground "blue" :weight light))
+    (((class grayscale) (background light)) (:foreground "LightGray" :bold t))
+    (((class grayscale) (background dark)) (:foreground "DimGray" :bold t))
+    (((class color) (background light)) (:foreground "Orchid"))
+    (((class color) (background dark)) (:foreground "LightSteelBlue"))
+    (t (:bold t)))
+  "Face used for Sieve Control Commands."
+  :group 'sieve)
+;; backward-compatibility alias
+(put 'sieve-control-commands-face 'face-alias 'sieve-control-commands)
+(put 'sieve-control-commands-face 'obsolete-face "22.1")
+
+(defvar sieve-action-commands-face 'sieve-action-commands
+  "Face name used for Sieve Action Commands.")
+
+(defface sieve-action-commands
+  '((((type tty) (class color)) (:foreground "blue" :weight bold))
+    (((class color) (background light)) (:foreground "Blue"))
+    (((class color) (background dark)) (:foreground "LightSkyBlue"))
+    (t (:inverse-video t :bold t)))
+  "Face used for Sieve Action Commands."
+  :group 'sieve)
+;; backward-compatibility alias
+(put 'sieve-action-commands-face 'face-alias 'sieve-action-commands)
+(put 'sieve-action-commands-face 'obsolete-face "22.1")
+
+(defvar sieve-test-commands-face 'sieve-test-commands
+  "Face name used for Sieve Test Commands.")
+
+(defface sieve-test-commands
+  '((((type tty) (class color)) (:foreground "magenta"))
+    (((class grayscale) (background light))
+     (:foreground "LightGray" :bold t :underline t))
+    (((class grayscale) (background dark))
+     (:foreground "Gray50" :bold t :underline t))
+    (((class color) (background light)) (:foreground "CadetBlue"))
+    (((class color) (background dark)) (:foreground "Aquamarine"))
+    (t (:bold t :underline t)))
+  "Face used for Sieve Test Commands."
+  :group 'sieve)
+;; backward-compatibility alias
+(put 'sieve-test-commands-face 'face-alias 'sieve-test-commands)
+(put 'sieve-test-commands-face 'obsolete-face "22.1")
+
+(defvar sieve-tagged-arguments-face 'sieve-tagged-arguments
+  "Face name used for Sieve Tagged Arguments.")
+
+(defface sieve-tagged-arguments
+  '((((type tty) (class color)) (:foreground "cyan" :weight bold))
+    (((class grayscale) (background light)) (:foreground "LightGray" :bold t))
+    (((class grayscale) (background dark)) (:foreground "DimGray" :bold t))
+    (((class color) (background light)) (:foreground "Purple"))
+    (((class color) (background dark)) (:foreground "Cyan"))
+    (t (:bold t)))
+  "Face used for Sieve Tagged Arguments."
+  :group 'sieve)
+;; backward-compatibility alias
+(put 'sieve-tagged-arguments-face 'face-alias 'sieve-tagged-arguments)
+(put 'sieve-tagged-arguments-face 'obsolete-face "22.1")
+
+
+(defconst sieve-font-lock-keywords
+  (eval-when-compile
+    (list
+     ;; control commands
+     (cons (regexp-opt '("require" "if" "else" "elsif" "stop")
+                       'words)
+           'sieve-control-commands-face)
+     ;; action commands
+     (cons (regexp-opt '("fileinto" "redirect" "reject" "keep" "discard")
+                       'words)
+           'sieve-action-commands-face)
+     ;; test commands
+     (cons (regexp-opt '("address" "allof" "anyof" "exists" "false"
+                         "true" "header" "not" "size" "envelope"
+                         "body")
+                       'words)
+           'sieve-test-commands-face)
+     (cons "\\Sw+:\\sw+"
+           'sieve-tagged-arguments-face))))
+
+;; Syntax table
+
+(defvar sieve-mode-syntax-table nil
+  "Syntax table in use in sieve-mode buffers.")
+
+(if sieve-mode-syntax-table
+    ()
+  (setq sieve-mode-syntax-table (make-syntax-table))
+  (modify-syntax-entry ?\\ "\\" sieve-mode-syntax-table)
+  (modify-syntax-entry ?\n ">   " sieve-mode-syntax-table)
+  (modify-syntax-entry ?\f ">   " sieve-mode-syntax-table)
+  (modify-syntax-entry ?\# "<   " sieve-mode-syntax-table)
+  (modify-syntax-entry ?/ "." sieve-mode-syntax-table)
+  (modify-syntax-entry ?* "." sieve-mode-syntax-table)
+  (modify-syntax-entry ?+ "." sieve-mode-syntax-table)
+  (modify-syntax-entry ?- "." sieve-mode-syntax-table)
+  (modify-syntax-entry ?= "." sieve-mode-syntax-table)
+  (modify-syntax-entry ?% "." sieve-mode-syntax-table)
+  (modify-syntax-entry ?< "." sieve-mode-syntax-table)
+  (modify-syntax-entry ?> "." sieve-mode-syntax-table)
+  (modify-syntax-entry ?& "." sieve-mode-syntax-table)
+  (modify-syntax-entry ?| "." sieve-mode-syntax-table)
+  (modify-syntax-entry ?_ "_" sieve-mode-syntax-table)
+  (modify-syntax-entry ?\' "\"" sieve-mode-syntax-table))
+
+;; Key map definition
+
+(defvar sieve-mode-map
+  (let ((map (make-sparse-keymap)))
+    (define-key map "\C-c\C-l" 'sieve-upload)
+    (define-key map "\C-c\C-c" 'sieve-upload-and-kill)
+    (define-key map "\C-c\C-m" 'sieve-manage)
+    map)
+  "Key map used in sieve mode.")
+
+;; Menu definition
+
+(defvar sieve-mode-menu nil
+  "Menubar used in sieve mode.")
+
+;; Code for Sieve editing mode.
+(autoload 'easy-menu-add-item "easymenu")
+
+;;;###autoload
+(define-derived-mode sieve-mode c-mode "Sieve"
+  "Major mode for editing Sieve code.
+This is much like C mode except for the syntax of comments.  Its keymap
+inherits from C mode's and it has the same variables for customizing
+indentation.  It has its own abbrev table and its own syntax table.
+
+Turning on Sieve mode runs `sieve-mode-hook'."
+  (set (make-local-variable 'paragraph-start) (concat "$\\|" page-delimiter))
+  (set (make-local-variable 'paragraph-separate) paragraph-start)
+  (set (make-local-variable 'comment-start) "#")
+  (set (make-local-variable 'comment-end) "")
+  ;;(set (make-local-variable 'comment-start-skip) "\\(^\\|\\s-\\);?#+ *")
+  (set (make-local-variable 'comment-start-skip) "#+ *")
+  (set (make-local-variable 'font-lock-defaults)
+       '(sieve-font-lock-keywords nil nil ((?_ . "w"))))
+  (easy-menu-add-item nil nil sieve-mode-menu))
+
+;; Menu
+
+(easy-menu-define sieve-mode-menu sieve-mode-map
+  "Sieve Menu."
+  '("Sieve"
+    ["Upload script" sieve-upload t]
+    ["Manage scripts on server" sieve-manage t]))
+
+(provide 'sieve-mode)
+
+;; sieve-mode.el ends here
diff --git a/lisp/net/sieve.el b/lisp/net/sieve.el
new file mode 100644
index 00000000000..2046e53697d
--- /dev/null
+++ b/lisp/net/sieve.el
@@ -0,0 +1,372 @@
+;;; sieve.el --- Utilities to manage sieve scripts
+
+;; Copyright (C) 2001-2016 Free Software Foundation, Inc.
+
+;; Author: Simon Josefsson <simon@josefsson.org>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This file contain utilities to facilitate upload, download and
+;; general management of sieve scripts.  Currently only the
+;; Managesieve protocol is supported (using sieve-manage.el), but when
+;; (useful) alternatives become available, they might be supported as
+;; well.
+;;
+;; The cursor navigation was inspired by biff-mode by Franklin Lee.
+;;
+;; Release history:
+;;
+;; 2001-10-31 Committed to Oort Gnus.
+;; 2002-07-27 Fix down-mouse-2 and down-mouse-3 in manage-mode.  Fix menubar
+;;            in manage-mode.  Change some messages.  Added sieve-deactivate*,
+;;            sieve-remove.  Fixed help text in manage-mode.  Suggested by
+;;            Ned Ludd.
+;;
+;; Todo:
+;;
+;; * Namespace?  This file contains `sieve-manage' and
+;;   `sieve-manage-mode', but there is a sieve-manage.el file as well.
+;;   Can't think of a good solution though, this file need a *-mode,
+;;   and naming it `sieve-mode' would collide with sieve-mode.el.  One
+;;   solution would be to come up with some better name that this file
+;;   can use that doesn't have the managesieve specific "manage" in
+;;   it.  sieve-dired?  i dunno.  we could copy all off sieve.el into
+;;   sieve-manage.el too, but I'd like to separate the interface from
+;;   the protocol implementation since the backends are likely to
+;;   change (well).
+;;
+;; * Define servers?  We could have a customize buffer to create a server,
+;;   with authentication/stream/etc parameters, much like Gnus, and then
+;;   only use names of defined servers when interacting with M-x sieve-*.
+;;   Right now you can't use STARTTLS, which sieve-manage.el provides
+
+;;; Code:
+
+(require 'sieve-manage)
+(require 'sieve-mode)
+
+;; User customizable variables:
+
+(defgroup sieve nil
+  "Manage sieve scripts."
+  :version "22.1"
+  :group 'tools)
+
+(defcustom sieve-new-script "<new script>"
+  "Name of name script indicator."
+  :type 'string
+  :group 'sieve)
+
+(defcustom sieve-buffer "*sieve*"
+  "Name of sieve management buffer."
+  :type 'string
+  :group 'sieve)
+
+(defcustom sieve-template "\
+require \"fileinto\";
+
+# Example script (remove comment character '#' to make it effective!):
+#
+# if header :contains \"from\" \"coyote\" {
+#   discard;
+# } elsif header :contains [\"subject\"] [\"$$$\"] {
+#   discard;
+# } else {
+#  fileinto \"INBOX\";
+# }
+"
+  "Template sieve script."
+  :type 'string
+  :group 'sieve)
+
+;; Internal variables:
+
+(defvar sieve-manage-buffer nil)
+(defvar sieve-buffer-header-end nil)
+(defvar sieve-buffer-script-name nil
+  "The real script name of the buffer.")
+(make-local-variable 'sieve-buffer-script-name)
+
+;; Sieve-manage mode:
+
+(defvar sieve-manage-mode-map
+  (let ((map (make-sparse-keymap)))
+    ;; various
+    (define-key map "?" 'sieve-help)
+    (define-key map "h" 'sieve-help)
+    ;; activating
+    (define-key map "m" 'sieve-activate)
+    (define-key map "u" 'sieve-deactivate)
+    (define-key map "\M-\C-?" 'sieve-deactivate-all)
+    ;; navigation keys
+    (define-key map "\C-p" 'sieve-prev-line)
+    (define-key map [up] 'sieve-prev-line)
+    (define-key map "\C-n" 'sieve-next-line)
+    (define-key map [down] 'sieve-next-line)
+    (define-key map " " 'sieve-next-line)
+    (define-key map "n" 'sieve-next-line)
+    (define-key map "p" 'sieve-prev-line)
+    (define-key map "\C-m" 'sieve-edit-script)
+    (define-key map "f" 'sieve-edit-script)
+    (define-key map "o" 'sieve-edit-script-other-window)
+    (define-key map "r" 'sieve-remove)
+    (define-key map "q" 'sieve-bury-buffer)
+    (define-key map "Q" 'sieve-manage-quit)
+    (define-key map [(down-mouse-2)] 'sieve-edit-script)
+    (define-key map [(down-mouse-3)] 'sieve-manage-mode-menu)
+    map)
+  "Keymap for `sieve-manage-mode'.")
+
+(easy-menu-define sieve-manage-mode-menu sieve-manage-mode-map
+  "Sieve Menu."
+  '("Manage Sieve"
+    ["Edit script" sieve-edit-script t]
+    ["Activate script" sieve-activate t]
+    ["Deactivate script" sieve-deactivate t]))
+
+(define-derived-mode sieve-manage-mode fundamental-mode "Sieve-manage"
+  "Mode used for sieve script management."
+  (buffer-disable-undo (current-buffer))
+  (setq truncate-lines t)
+  (easy-menu-add sieve-manage-mode-menu sieve-manage-mode-map))
+
+(put 'sieve-manage-mode 'mode-class 'special)
+
+;; Commands used in sieve-manage mode:
+
+(defun sieve-manage-quit ()
+  "Quit Manage Sieve and close the connection."
+  (interactive)
+  (sieve-manage-close sieve-manage-buffer)
+  (kill-buffer sieve-manage-buffer)
+  (kill-buffer (current-buffer)))
+
+(defun sieve-bury-buffer ()
+  "Bury the Manage Sieve buffer without closing the connection."
+  (interactive)
+  (bury-buffer))
+
+(defun sieve-activate (&optional pos)
+  (interactive "d")
+  (let ((name (sieve-script-at-point)) err)
+    (when (or (null name) (string-equal name sieve-new-script))
+      (error "No sieve script at point"))
+    (message "Activating script %s..." name)
+    (setq err (sieve-manage-setactive name sieve-manage-buffer))
+    (sieve-refresh-scriptlist)
+    (if (sieve-manage-ok-p err)
+        (message "Activating script %s...done" name)
+      (message "Activating script %s...failed: %s" name (nth 2 err)))))
+
+(defun sieve-deactivate-all (&optional pos)
+  (interactive "d")
+  (let ((name (sieve-script-at-point)) err)
+    (message "Deactivating scripts...")
+    (setq err (sieve-manage-setactive "" sieve-manage-buffer))
+    (sieve-refresh-scriptlist)
+    (if (sieve-manage-ok-p err)
+        (message "Deactivating scripts...done")
+      (message "Deactivating scripts...failed: %s" (nth 2 err)))))
+
+(defalias 'sieve-deactivate 'sieve-deactivate-all)
+
+(defun sieve-remove (&optional pos)
+  (interactive "d")
+  (let ((name (sieve-script-at-point)) err)
+    (when (or (null name) (string-equal name sieve-new-script))
+      (error "No sieve script at point"))
+    (message "Removing sieve script %s..." name)
+    (setq err (sieve-manage-deletescript name sieve-manage-buffer))
+    (unless (sieve-manage-ok-p err)
+      (error "Removing sieve script %s...failed: " err))
+    (sieve-refresh-scriptlist)
+    (message "Removing sieve script %s...done" name)))
+
+(defun sieve-edit-script (&optional pos)
+  (interactive "d")
+  (let ((name (sieve-script-at-point)))
+    (unless name
+      (error "No sieve script at point"))
+    (if (not (string-equal name sieve-new-script))
+        (let ((newbuf (generate-new-buffer name))
+              err)
+          (setq err (sieve-manage-getscript name newbuf sieve-manage-buffer))
+          (switch-to-buffer newbuf)
+          (unless (sieve-manage-ok-p err)
+            (error "Sieve download failed: %s" err)))
+      (switch-to-buffer (get-buffer-create "template.siv"))
+      (insert sieve-template))
+    (sieve-mode)
+    (setq sieve-buffer-script-name name)
+    (goto-char (point-min))
+    (message
+     (substitute-command-keys
+      "Press \\[sieve-upload] to upload script to server."))))
+
+(defmacro sieve-change-region (&rest body)
+  "Turns off sieve-region before executing BODY, then re-enables it after.
+Used to bracket operations which move point in the sieve-buffer."
+  `(progn
+     (sieve-highlight nil)
+     ,@body
+     (sieve-highlight t)))
+(put 'sieve-change-region 'lisp-indent-function 0)
+
+(defun sieve-next-line (&optional arg)
+  (interactive)
+  (unless arg
+    (setq arg 1))
+  (if (save-excursion
+        (forward-line arg)
+        (sieve-script-at-point))
+      (sieve-change-region
+        (forward-line arg))
+    (message "End of list")))
+
+(defun sieve-prev-line (&optional arg)
+  (interactive)
+  (unless arg
+    (setq arg -1))
+  (if (save-excursion
+        (forward-line arg)
+        (sieve-script-at-point))
+      (sieve-change-region
+        (forward-line arg))
+    (message "Beginning of list")))
+
+(defun sieve-help ()
+  "Display help for various sieve commands."
+  (interactive)
+  (if (eq last-command 'sieve-help)
+      ;; would need minor-mode for log-edit-mode
+      (describe-function 'sieve-mode)
+    (message "%s" (substitute-command-keys
+              "`\\[sieve-edit-script]':edit `\\[sieve-activate]':activate `\\[sieve-deactivate]':deactivate `\\[sieve-remove]':remove"))))
+
+;; Create buffer:
+
+(defun sieve-setup-buffer (server port)
+  (setq buffer-read-only nil)
+  (erase-buffer)
+  (buffer-disable-undo)
+  (let* ((port (or port sieve-manage-default-port))
+         (header (format "Server : %s:%s\n\n" server port)))
+    (insert header))
+  (set (make-local-variable 'sieve-buffer-header-end)
+       (point-max)))
+
+(defun sieve-script-at-point (&optional pos)
+  "Return name of sieve script at point POS, or nil."
+  (interactive "d")
+  (get-char-property (or pos (point)) 'script-name))
+
+(defun sieve-highlight (on)
+  "Turn ON or off highlighting on the current language overlay."
+  (overlay-put (car (overlays-at (point))) 'face (if on 'highlight 'default)))
+
+(defun sieve-insert-scripts (scripts)
+  "Format and insert LANGUAGE-LIST strings into current buffer at point."
+  (while scripts
+    (let ((p (point))
+          (ext nil)
+          (script (pop scripts)))
+      (if (consp script)
+          (insert (format " ACTIVE %s" (cdr script)))
+        (insert (format "        %s" script)))
+      (setq ext (make-overlay p (point)))
+      (overlay-put ext 'mouse-face 'highlight)
+      (overlay-put ext 'script-name (if (consp script)
+                                        (cdr script)
+                                      script))
+      (insert "\n"))))
+
+(defun sieve-open-server (server &optional port)
+  "Open SERVER (on PORT) and authenticate."
+  (with-current-buffer
+      (or ;; open server
+       (set (make-local-variable 'sieve-manage-buffer)
+            (sieve-manage-open server port))
+       (error "Error opening server %s" server))
+    (sieve-manage-authenticate)))
+
+(defun sieve-refresh-scriptlist ()
+  (interactive)
+  (with-current-buffer sieve-buffer
+    (setq buffer-read-only nil)
+    (delete-region (or sieve-buffer-header-end (point-max)) (point-max))
+    (goto-char (point-max))
+    ;; get list of script names and print them
+    (let ((scripts (sieve-manage-listscripts sieve-manage-buffer)))
+      (if (null scripts)
+          (insert
+           (substitute-command-keys
+            (format
+             "No scripts on server, press \\[sieve-edit-script] on %s to create a new script.\n"
+             sieve-new-script)))
+        (insert
+         (substitute-command-keys
+          (format (concat "%d script%s on server, press \\[sieve-edit-script] on a script "
+                          "name edits it, or\npress \\[sieve-edit-script] on %s to create "
+                          "a new script.\n") (length scripts)
+                          (if (eq (length scripts) 1) "" "s")
+                          sieve-new-script))))
+      (save-excursion
+        (sieve-insert-scripts (list sieve-new-script))
+        (sieve-insert-scripts scripts)))
+    (sieve-highlight t)
+    (setq buffer-read-only t)))
+
+;;;###autoload
+(defun sieve-manage (server &optional port)
+  (interactive "sServer: ")
+  (switch-to-buffer (get-buffer-create sieve-buffer))
+  (sieve-manage-mode)
+  (sieve-setup-buffer server port)
+  (if (sieve-open-server server port)
+      (sieve-refresh-scriptlist)
+    (message "Could not open server %s" server)))
+
+;;;###autoload
+(defun sieve-upload (&optional name)
+  (interactive)
+  (when (or (get-buffer sieve-buffer) (call-interactively 'sieve-manage))
+    (let ((script (buffer-string)) err)
+      (with-current-buffer (get-buffer sieve-buffer)
+        (setq err (sieve-manage-putscript
+                   (or name sieve-buffer-script-name (buffer-name))
+                   script sieve-manage-buffer))
+        (if (sieve-manage-ok-p err)
+            (message (substitute-command-keys
+                      "Sieve upload done.  Use \\[sieve-manage] to manage scripts."))
+          (message "Sieve upload failed: %s" (nth 2 err)))))))
+
+;;;###autoload
+(defun sieve-upload-and-bury (&optional name)
+  (interactive)
+  (sieve-upload name)
+  (bury-buffer))
+
+;;;###autoload
+(defun sieve-upload-and-kill (&optional name)
+  (interactive)
+  (sieve-upload name)
+  (kill-buffer))
+
+(provide 'sieve)
+
+;; sieve.el ends here
diff --git a/lisp/net/starttls.el b/lisp/net/starttls.el
new file mode 100644
index 00000000000..096ed2adc0d
--- /dev/null
+++ b/lisp/net/starttls.el
@@ -0,0 +1,304 @@
+;;; starttls.el --- STARTTLS functions
+
+;; Copyright (C) 1999-2016 Free Software Foundation, Inc.
+
+;; Author: Daiki Ueno <ueno@unixuser.org>
+;; Author: Simon Josefsson <simon@josefsson.org>
+;; Created: 1999/11/20
+;; Keywords: TLS, SSL, OpenSSL, GnuTLS, mail, news
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This module defines some utility functions for STARTTLS profiles.
+
+;; [RFC 2595] "Using TLS with IMAP, POP3 and ACAP"
+;;      by Chris Newman <chris.newman@innosoft.com> (1999/06)
+
+;; This file now contains a combination of the two previous
+;; implementations both called "starttls.el".  The first one is Daiki
+;; Ueno's starttls.el which uses his own "starttls" command line tool,
+;; and the second one is Simon Josefsson's starttls.el which uses
+;; "gnutls-cli" from GnuTLS.
+;;
+;; If "starttls" is available, it is preferred by the code over
+;; "gnutls-cli", for backwards compatibility.  Use
+;; `starttls-use-gnutls' to toggle between implementations if you have
+;; both tools installed.  It is recommended to use GnuTLS, though, as
+;; it performs more verification of the certificates.
+
+;; The GnuTLS support requires GnuTLS 0.9.90 (released 2003-10-08) or
+;; later, from <http://www.gnu.org/software/gnutls/>, or "starttls"
+;; from <ftp://ftp.opaopa.org/pub/elisp/>.
+
+;; Usage is similar to `open-network-stream'.  For example:
+;;
+;; (when (setq tmp (starttls-open-stream
+;;                      "test" (current-buffer) "yxa.extundo.com" 25))
+;;   (accept-process-output tmp 15)
+;;   (process-send-string tmp "STARTTLS\n")
+;;   (accept-process-output tmp 15)
+;;   (message "STARTTLS output:\n%s" (starttls-negotiate tmp))
+;;   (process-send-string tmp "EHLO foo\n"))
+
+;; An example run yields the following output:
+;;
+;; 220 yxa.extundo.com ESMTP Sendmail 8.12.11/8.12.11/Debian-3; Wed, 26 May 2004 19:12:29 +0200; (No UCE/UBE) logging access from: c494102a.s-bi.bostream.se(OK)-c494102a.s-bi.bostream.se [217.215.27.65]
+;; 220 2.0.0 Ready to start TLS
+;; 250-yxa.extundo.com Hello c494102a.s-bi.bostream.se [217.215.27.65], pleased to meet you
+;; 250-ENHANCEDSTATUSCODES
+;; 250-PIPELINING
+;; 250-EXPN
+;; 250-VERB
+;; 250-8BITMIME
+;; 250-SIZE
+;; 250-DSN
+;; 250-ETRN
+;; 250-AUTH DIGEST-MD5 CRAM-MD5 PLAIN LOGIN
+;; 250-DELIVERBY
+;; 250 HELP
+;; nil
+;;
+;; With the message buffer containing:
+;;
+;; STARTTLS output:
+;; *** Starting TLS handshake
+;; - Server's trusted authorities:
+;;    [0]: C=SE,ST=Stockholm,L=Stockholm,O=YXA,OU=CA,CN=yxa.extundo.com,EMAIL=staff@yxa.extundo.com
+;; - Certificate type: X.509
+;;  - Got a certificate list of 2 certificates.
+;;
+;;  - Certificate[0] info:
+;;  # The hostname in the certificate matches 'yxa.extundo.com'.
+;;  # valid since: Wed May 26 12:16:00 CEST 2004
+;;  # expires at: Wed Jul 26 12:16:00 CEST 2023
+;;  # serial number: 04
+;;  # fingerprint: 7c 04 4b c1 fa 26 9b 5d 90 22 52 3c 65 3d 85 3a
+;;  # version: #1
+;;  # public key algorithm: RSA
+;;  #   Modulus: 1024 bits
+;;  # Subject's DN: C=SE,ST=Stockholm,L=Stockholm,O=YXA,OU=Mail server,CN=yxa.extundo.com,EMAIL=staff@yxa.extundo.com
+;;  # Issuer's DN: C=SE,ST=Stockholm,L=Stockholm,O=YXA,OU=CA,CN=yxa.extundo.com,EMAIL=staff@yxa.extundo.com
+;;
+;;  - Certificate[1] info:
+;;  # valid since: Sun May 23 11:35:00 CEST 2004
+;;  # expires at: Sun Jul 23 11:35:00 CEST 2023
+;;  # serial number: 00
+;;  # fingerprint: fc 76 d8 63 1a c9 0b 3b fa 40 fe ed 47 7a 58 ae
+;;  # version: #3
+;;  # public key algorithm: RSA
+;;  #   Modulus: 1024 bits
+;;  # Subject's DN: C=SE,ST=Stockholm,L=Stockholm,O=YXA,OU=CA,CN=yxa.extundo.com,EMAIL=staff@yxa.extundo.com
+;;  # Issuer's DN: C=SE,ST=Stockholm,L=Stockholm,O=YXA,OU=CA,CN=yxa.extundo.com,EMAIL=staff@yxa.extundo.com
+;;
+;; - Peer's certificate issuer is unknown
+;; - Peer's certificate is NOT trusted
+;; - Version: TLS 1.0
+;; - Key Exchange: RSA
+;; - Cipher: ARCFOUR 128
+;; - MAC: SHA
+;; - Compression: NULL
+
+;;; Code:
+
+(defgroup starttls nil
+  "Support for `Transport Layer Security' protocol."
+  :version "21.1"
+  :group 'mail)
+
+(defcustom starttls-gnutls-program "gnutls-cli"
+  "Name of GnuTLS command line tool.
+This program is used when GnuTLS is used, i.e. when
+`starttls-use-gnutls' is non-nil."
+  :version "22.1"
+  :type 'string
+  :group 'starttls)
+
+(defcustom starttls-program "starttls"
+  "The program to run in a subprocess to open an TLSv1 connection.
+This program is used when the `starttls' command is used,
+i.e. when `starttls-use-gnutls' is nil."
+  :type 'string
+  :group 'starttls)
+
+(defcustom starttls-use-gnutls (not (executable-find starttls-program))
+  "*Whether to use GnuTLS instead of the `starttls' command."
+  :version "22.1"
+  :type 'boolean
+  :group 'starttls)
+
+(defcustom starttls-extra-args nil
+  "Extra arguments to `starttls-program'.
+These apply when the `starttls' command is used, i.e. when
+`starttls-use-gnutls' is nil."
+  :type '(repeat string)
+  :group 'starttls)
+
+(defcustom starttls-extra-arguments nil
+  "Extra arguments to `starttls-gnutls-program'.
+These apply when GnuTLS is used, i.e. when `starttls-use-gnutls' is non-nil.
+
+For example, non-TLS compliant servers may require
+'(\"--protocols\" \"ssl3\").  Invoke \"gnutls-cli --help\" to
+find out which parameters are available."
+  :version "22.1"
+  :type '(repeat string)
+  :group 'starttls)
+
+(defcustom starttls-process-connection-type nil
+  "*Value for `process-connection-type' to use when starting STARTTLS process."
+  :version "22.1"
+  :type 'boolean
+  :group 'starttls)
+
+(defcustom starttls-connect "- Simple Client Mode:\n\n"
+  "*Regular expression indicating successful connection.
+The default is what GnuTLS's \"gnutls-cli\" outputs."
+  ;; GnuTLS cli.c:main() prints this string when it is starting to run
+  ;; in the application read/write phase.  If the logic, or the string
+  ;; itself, is modified, this must be updated.
+  :version "22.1"
+  :type 'regexp
+  :group 'starttls)
+
+(defcustom starttls-failure "\\*\\*\\* Handshake has failed"
+  "*Regular expression indicating failed TLS handshake.
+The default is what GnuTLS's \"gnutls-cli\" outputs."
+  ;; GnuTLS cli.c:do_handshake() prints this string on failure.  If the
+  ;; logic, or the string itself, is modified, this must be updated.
+  :version "22.1"
+  :type 'regexp
+  :group 'starttls)
+
+(defcustom starttls-success "- Compression: "
+  "*Regular expression indicating completed TLS handshakes.
+The default is what GnuTLS's \"gnutls-cli\" outputs."
+  ;; GnuTLS cli.c:do_handshake() calls, on success,
+  ;; common.c:print_info(), that unconditionally print this string
+  ;; last.  If that logic, or the string itself, is modified, this
+  ;; must be updated.
+  :version "22.1"
+  :type 'regexp
+  :group 'starttls)
+
+(defun starttls-negotiate-gnutls (process)
+  "Negotiate TLS on PROCESS opened by `open-starttls-stream'.
+This should typically only be done once.  It typically returns a
+multi-line informational message with information about the
+handshake, or nil on failure."
+  (let (buffer info old-max done-ok done-bad)
+    (if (null (setq buffer (process-buffer process)))
+        ;; XXX How to remove/extract the TLS negotiation junk?
+        (signal-process (process-id process) 'SIGALRM)
+      (with-current-buffer buffer
+        (save-excursion
+          (setq old-max (goto-char (point-max)))
+          (signal-process (process-id process) 'SIGALRM)
+          (while (and (processp process)
+                      (eq (process-status process) 'run)
+                      (save-excursion
+                        (goto-char old-max)
+                        (not (or (setq done-ok (re-search-forward
+                                                starttls-success nil t))
+                                 (setq done-bad (re-search-forward
+                                                 starttls-failure nil t))))))
+            (accept-process-output process 1 100)
+            (sit-for 0.1))
+          (setq info (buffer-substring-no-properties old-max (point-max)))
+          (delete-region old-max (point-max))
+          (if (or (and done-ok (not done-bad))
+                  ;; Prevent mitm that fake success msg after failure msg.
+                  (and done-ok done-bad (< done-ok done-bad)))
+              info
+            (message "STARTTLS negotiation failed: %s" info)
+            nil))))))
+
+(defun starttls-negotiate (process)
+  (if starttls-use-gnutls
+      (starttls-negotiate-gnutls process)
+    (signal-process (process-id process) 'SIGALRM)))
+
+(defun starttls-open-stream-gnutls (name buffer host port)
+  (message "Opening STARTTLS connection to `%s:%s'..." host port)
+  (let* (done
+         (old-max (with-current-buffer buffer (point-max)))
+         (process-connection-type starttls-process-connection-type)
+         (process (apply #'start-process name buffer
+                         starttls-gnutls-program "-s" host
+                         "-p" (if (integerp port)
+                                  (int-to-string port)
+                                port)
+                         starttls-extra-arguments)))
+    (set-process-query-on-exit-flag process nil)
+    (while (and (processp process)
+                (eq (process-status process) 'run)
+                (with-current-buffer buffer
+                  (goto-char old-max)
+                  (not (setq done (re-search-forward
+                                   starttls-connect nil t)))))
+      (accept-process-output process 0 100)
+      (sit-for 0.1))
+    (if done
+        (with-current-buffer buffer
+          (delete-region old-max done))
+      (delete-process process)
+      (setq process nil))
+    (message "Opening STARTTLS connection to `%s:%s'...%s"
+             host port (if done "done" "failed"))
+    process))
+
+;;;###autoload
+(defun starttls-open-stream (name buffer host port)
+  "Open a TLS connection for a port to a host.
+Returns a subprocess object to represent the connection.
+Input and output work as for subprocesses; `delete-process' closes it.
+Args are NAME BUFFER HOST PORT.
+NAME is name for process.  It is modified if necessary to make it unique.
+BUFFER is the buffer (or `buffer-name') to associate with the process.
+ Process output goes at end of that buffer, unless you specify
+ an output stream or filter function to handle the output.
+ BUFFER may be also nil, meaning that this process is not associated
+ with any buffer
+Third arg is name of the host to connect to, or its IP address.
+Fourth arg PORT is an integer specifying a port to connect to.
+If `starttls-use-gnutls' is nil, this may also be a service name, but
+GnuTLS requires a port number."
+  (if starttls-use-gnutls
+      (starttls-open-stream-gnutls name buffer host port)
+    (message "Opening STARTTLS connection to `%s:%s'" host (format "%s" port))
+    (let* ((process-connection-type starttls-process-connection-type)
+           (process (apply #'start-process
+                           name buffer starttls-program
+                           host (format "%s" port)
+                           starttls-extra-args)))
+      (set-process-query-on-exit-flag process nil)
+      process)))
+
+(defun starttls-available-p ()
+  "Say whether the STARTTLS programs are available."
+  (and (not (memq system-type '(windows-nt ms-dos)))
+       (executable-find (if starttls-use-gnutls
+                            starttls-gnutls-program
+                          starttls-program))))
+
+(defalias 'starttls-any-program-available 'starttls-available-p)
+(make-obsolete 'starttls-any-program-available 'starttls-available-p
+               "2011-08-02")
+
+(provide 'starttls)
+
+;;; starttls.el ends here