+2003-05-04 Dave Love <fx@gnu.org>
+
+ * rfc2047.el (with-syntax-table): Define if necessary.
+ (rfc2047-syntax-table): Fix last change for XEmacs.
+
+2003-05-03 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus.el: Don't test for `mm-guess-mime-charset'.
+
+ * mm-util.el (mm-guess-mime-charset): Remove. Not used any more.
+
+ * gnus.el (gnus-default-charset): Set default value to
+ `undecided'.
+
+ * gnus-art.el (article-decode-charset): Don't supply 4th arg to
+ mm-decode-body.
+
+ * mm-bodies.el (mm-decode-coding-region-safely): Remove.
+ (mm-decode-body): Don't use mm-decode-coding-region-safely.
+
+2003-05-03 Vasily Korytov <deskpot@despammed.com> (tiny change)
+
+ * gnus-util.el (gnus-multiple-choice): Add ", ?".
+
+2003-05-03 Dave Love <fx@gnu.org>
+
+ * rfc2047.el (rfc2047-syntax-table): Don't call make-char-table
+ with 2 args.
+ (rfc2047-decode-string): Don't set the buffer multibyte before
+ calling buffer-string.
+
+ * mm-encode.el (mm-long-lines-p): Autoload.
+ (mm-encode-content-transfer-encoding): Doc fix. Don't make buffer
+ unibyte. Signal error on unknown encoding.
+ (mm-encode-buffer, mm-qp-or-base64): Doc fix.
+
+ * rfc2047.el (rfc2047-point-at-bol, rfc2047-point-at-eol): New.
+ Callers of gnus- versions changed to use them.
+ (rfc2047-header-encoding-alist): Add `address-mime' part. Doc
+ fixes.
+ (rfc2047-encoding-type): New.
+ (rfc2047-encode-message-header): Use mm-charset-to-coding-system.
+ Don't include header name field in encoding. Add `address-mime'
+ case and bind rfc2047-encoding-type for `mime' case.
+ (rfc2047-encodable-p): Deleted.
+ (rfc2047-syntax-table): New.
+ (rfc2047-encode-region, rfc2047-encode): Rewritten to take account
+ of rfc2047 rules with respect to rfc2822 tokens and to do encoding
+ in place rather than by passing strings.
+ (rfc2047-encode-string): Doc fix.
+ (rfc2047-q-encode-region): Don't use
+ mm-with-unibyte-current-buffer.
+ (rfc2047-encoded-word-regexp): eval-and-compile.
+ (rfc2047-decode-region): Avoid concatenation in loop.
+ (rfc2047-parse-and-decode): Remove useless disjunction.
+
+2003-05-02 Dave Love <fx@gnu.org>
+
+ * rfc2047.el (rfc2047-q-encode-region, rfc2047-decode): Use
+ mm-with-unibyte-current-buffer.
+ (ietf-drums, gnus-util): don't require.
+
+ * sieve.el (sieve-manage-mode-menu): Define before use.
+
+ * mml-smime.el (message-narrow-to-headers): Autoload.
+
+ * mm-util.el (mm-coding-system-p): Don't override nil from
+ coding-system-p.
+ (mm-mule4-p, mm-disable-multibyte-mule4)
+ (mm-with-unibyte-current-buffer-mule4): Deleted.
+ (mm-multibyte-p): Use defun, not defalias.
+ (mm-make-temp-file): Moved to group at top of file.
+ (mm-point-at-eol, mm-point-at-bol): New.
+
+ * gnus-cite.el (gnus-art): Require.
+
+ * gnus-ems.el (gnus-get-buffer-create)
+ (nnheader-find-etc-directory, message-text-with-property):
+ Autoload.
+ (gnus-tmp-unread, gnus-tmp-replied, gnus-tmp-score-char)
+ (gnus-tmp-indentation, gnus-tmp-opening-bracket, gnus-tmp-lines)
+ (gnus-tmp-name, gnus-tmp-closing-bracket, gnus-tmp-subject-or-nil)
+ (gnus-check-before-posting): Only defvar when compiling.
+
+ * gnus-int.el (gnus-agent-expire): Autoload, don't defun.
+
+ * gnus-util.el (rmail-default-rmail-file, mm-text-coding-system):
+ Defvar when compiling.
+ (gnus-output-to-rmail): Require mm-util.
+
+ * mail-source.el (mail-source-callback): Use mm-make-temp-file.
+ (mail-source-make-complex-temp-name): Deleted.
+
+ * message.el (message-use-idna): Use mm-coding-system-p.
+ (message-tokenize-header, message-make-organization)
+ (message-make-from): Use with-temp-buffer.
+ (message-set-work-buffer): Deleted.
+ (message-fill-paragraph): Use `if' not `and' for compiler warning.
+ (message-check-news-header-syntax): Remove useless lambda.
+ (message-forward-make-body): Use mm-disable-multibyte,
+ mm-with-unibyte-current-buffer, mm-enable-multibyte.
+ (message-replace-chars-in-string): Deleted.
+
+ * mm-extern.el (mm-extern-local-file): Use mm-disable-multibyte.
+ (mm-extern-url): Use mm-with-unibyte-current-buffer,
+ mm-disable-multibyte.
+ (mm-extern-anon-ftp): Use mm-disable-multibyte.
+
+ * mml1991.el (mml1991-mailcrypt-encrypt, mml1991-gpg-encrypt): Use
+ mm-with-unibyte-current-buffer.
+
+ * mml2015.el (mml): Require.
+ (mml2015-mailcrypt-encrypt, mml2015-gpg-encrypt): Use
+ mm-with-unibyte-current-buffer.
+
+ * nnheader.el (gnus-util): Require.
+
+ * nntp.el (format-spec, format-spec-make, open-tls-stream):
+ Autoload.
+
+ * rfc2231.el (mail-header-remove-comments, mm-encode-body)
+ (mail-header-remove-whitespace): Autoload.
+
+ * sieve-manage.el (starttls-negotiate): Autoload.
+
2003-05-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
* nnrss.el (nnrss-find-rss-via-syndic8): Indent.
(mm-decode-body
charset (and cte (intern (downcase
(gnus-strip-whitespace cte))))
- (car ctl) prompt))))))
+ (car ctl)))))))
(defun article-decode-encoded-words ()
"Remove encoded-word encoding from headers."
(require 'gnus)
(require 'gnus-range)
+(require 'gnus-art)
(require 'message) ; for message-cite-prefix-regexp
;;; Customization:
(eval-and-compile
(autoload 'gnus-xmas-define "gnus-xmas")
(autoload 'gnus-xmas-redefine "gnus-xmas")
- (autoload 'appt-select-lowest-window "appt"))
+ (autoload 'appt-select-lowest-window "appt")
+ (autoload 'gnus-get-buffer-create "gnus")
+ (autoload 'nnheader-find-etc-directory "nnheader"))
(if (or (featurep 'xemacs)
(>= emacs-major-version 21))
(autoload 'smiley-region "smiley")
(autoload 'smiley-region "smiley-mule"))
+;; Fixme: shouldn't require message
+(autoload 'message-text-with-property "message")
+
(defun gnus-kill-all-overlays ()
"Delete all overlays in the current buffer."
(let* ((overlayss (overlay-lists))
(defvar gnus-mouse-face-prop 'mouse-face
"Property used for highlighting mouse regions.")))
-(defvar gnus-tmp-unread)
-(defvar gnus-tmp-replied)
-(defvar gnus-tmp-score-char)
-(defvar gnus-tmp-indentation)
-(defvar gnus-tmp-opening-bracket)
-(defvar gnus-tmp-lines)
-(defvar gnus-tmp-name)
-(defvar gnus-tmp-closing-bracket)
-(defvar gnus-tmp-subject-or-nil)
-(defvar gnus-check-before-posting)
+(eval-when-compile
+ (defvar gnus-tmp-unread)
+ (defvar gnus-tmp-replied)
+ (defvar gnus-tmp-score-char)
+ (defvar gnus-tmp-indentation)
+ (defvar gnus-tmp-opening-bracket)
+ (defvar gnus-tmp-lines)
+ (defvar gnus-tmp-name)
+ (defvar gnus-tmp-closing-bracket)
+ (defvar gnus-tmp-subject-or-nil)
+ (defvar gnus-check-before-posting)
+ (defvar gnus-mouse-face)
+ (defvar gnus-group-buffer))
(defun gnus-ems-redefine ()
(cond
(require 'message)
(require 'gnus-range)
-(eval-when-compile
- (defun gnus-agent-expire (&optional a b c)))
+(autoload 'gnus-agent-expire "gnus-agent")
(defcustom gnus-open-server-hook nil
"Hook called just before opening connection to the news server."
;; used by Gnus and may be used by any other package without loading
;; Gnus first.
+;; [Unfortunately, it does depend on other parts of Gnus, e.g. the
+;; autoloads below...]
+
;;; Code:
(eval-when-compile
;;; Functions for saving to babyl/mail files.
-(defvar rmail-default-rmail-file)
+(eval-when-compile
+ (defvar rmail-default-rmail-file)
+ (defvar mm-text-coding-system))
+
(defun gnus-output-to-rmail (filename &optional ask)
"Append the current article to an Rmail file named FILENAME."
(require 'rmail)
+ (require 'mm-util)
;; Most of these codes are borrowed from rmailout.el.
(setq filename (expand-file-name filename))
(setq rmail-default-rmail-file filename)
(while (not tchar)
(message "%s (%s): "
prompt
- (mapconcat (lambda (s) (char-to-string (car s)))
- choice ", "))
+ (concat
+ (mapconcat (lambda (s) (char-to-string (car s)))
+ choice ", ") ", ?"))
(setq tchar (read-char))
(when (not (assq tchar choice))
(setq tchar nil)
:group 'gnus-agent
:type 'boolean)
-(defcustom gnus-default-charset 'iso-8859-1
+(defcustom gnus-default-charset 'undecided
"Default charset assumed to be used when viewing non-ASCII characters.
This variable is overridden on a group-to-group basis by the
`gnus-group-charset-alist' variable and is only used on groups not
(error "Cannot get new mail"))
0)))))))))
-(eval-and-compile
- (if (fboundp 'make-temp-file)
- (defalias 'mail-source-make-complex-temp-name 'make-temp-file)
- (defun mail-source-make-complex-temp-name (prefix)
- (let ((newname (make-temp-name prefix))
- (newprefix prefix))
- (while (file-exists-p newname)
- (setq newprefix (concat newprefix "x"))
- (setq newname (make-temp-name newprefix)))
- newname))))
-
(defun mail-source-delete-old-incoming (&optional age confirm)
"Remove incoming files older than AGE days.
If CONFIRM is non-nil, ask for confirmation before removing a file."
(if (eq mail-source-delete-incoming t)
(delete-file mail-source-crash-box)
(let ((incoming
- (mail-source-make-complex-temp-name
+ (mm-make-temp-file
(expand-file-name
mail-source-incoming-file-prefix
mail-source-directory))))
:group 'message-various
:type 'regexp)
+;; Fixme: Why are all these things autoloaded?
+
;;; marking inserted text
;;;###autoload
(defcustom message-use-idna (and (condition-case nil (require 'idna)
(file-error))
- (fboundp 'coding-system-p)
- (coding-system-p 'utf-8)
+ (mm-coding-system-p 'utf-8)
'ask)
"Whether to encode non-ASCII in domain names into ASCII according to IDNA."
:group 'message-headers
(beg 1)
(first t)
quoted elems paren)
- (save-excursion
- (message-set-work-buffer)
+ (with-temp-buffer
+ (set-buffer-multibyte t)
(insert header)
(goto-char (point-min))
(while (not (eobp))
(mail-narrow-to-head)
(message-fetch-field header))))
-(defun message-set-work-buffer ()
- (if (get-buffer " *message work*")
- (progn
- (set-buffer " *message work*")
- (erase-buffer))
- (set-buffer (get-buffer-create " *message work*"))
- (kill-all-local-variables)))
-
(defun message-functionp (form)
"Return non-nil if FORM is funcallable."
(or (and (symbolp form) (fboundp form))
(defun message-fill-paragraph (&optional arg)
"Like `fill-paragraph'."
(interactive (list (if current-prefix-arg 'full)))
- (if (and (boundp 'filladapt-mode) filladapt-mode)
+ (if (if (boundp 'filladapt-mode) filladapt-mode)
nil
(message-newline-and-reformat arg t)
t))
(length
(setq to (completing-read
"Followups to (default: no Followup-To header) "
- (mapcar (lambda (g) (list g))
+ (mapcar #'list
(cons "poster"
(message-tokenize-header
newsgroups)))))))))
(if (message-functionp message-user-organization)
(funcall message-user-organization)
message-user-organization))))
- (save-excursion
- (message-set-work-buffer)
+ (with-temp-buffer
+ (set-buffer-multibyte t)
(cond ((stringp organization)
(insert organization))
((and (eq t organization)
(user-full-name))))
(when (string= fullname "&")
(setq fullname (user-login-name)))
- (save-excursion
- (message-set-work-buffer)
+ (with-temp-buffer
+ (set-buffer-multibyte t)
(cond
((or (null style)
(equal fullname ""))
(set-alist 'mime-edit-message-inserter-alist
'message-mode (function message-mime-insert-article))
-;;; Miscellaneous functions
-
-;; stolen (and renamed) from nnheader.el
-(static-if (fboundp 'subst-char-in-string)
- (defsubst message-replace-chars-in-string (string from to)
- (subst-char-in-string from to string))
- (defun message-replace-chars-in-string (string from to)
- "Replace characters in STRING from FROM to TO."
- (let ((string (substring string 0)) ;Copy string.
- (len (length string))
- (idx 0))
- ;; Replace all occurrences of FROM with TO.
- (while (< idx len)
- (when (= (aref string idx) from)
- (aset string idx to))
- (setq idx (1+ idx)))
- string)))
-
;;;
;;; MIME functions
;;;
(while (search-forward "\r\n" nil t)
(replace-match "\n" t t)))))
-(defun mm-decode-body (charset &optional encoding type force)
+(defun mm-decode-body (charset &optional encoding type)
"Decode the current article that has been encoded with ENCODING.
The characters in CHARSET should then be decoded. If FORCE is non-nil
use the supplied charset unconditionally."
- (let ((charset-supplied charset))
- (when (stringp charset)
- (setq charset (intern (downcase charset))))
- (when (or (not charset)
- (eq 'gnus-all mail-parse-ignored-charsets)
- (memq 'gnus-all mail-parse-ignored-charsets)
- (memq charset mail-parse-ignored-charsets))
- (setq charset mail-parse-charset
- charset-supplied nil))
- (save-excursion
- (when encoding
- (mm-decode-content-transfer-encoding encoding type))
- (when (featurep 'mule)
- (let ((coding-system (mm-charset-to-coding-system charset)))
- (if (and (not coding-system)
- (listp mail-parse-ignored-charsets)
- (memq 'gnus-unknown mail-parse-ignored-charsets))
- (setq coding-system
- (mm-charset-to-coding-system mail-parse-charset)))
- (when (and charset coding-system
- ;; buffer-file-coding-system
- ;;Article buffer is nil coding system
- ;;in XEmacs
- (mm-multibyte-p)
- (or (not (eq coding-system 'ascii))
- (setq coding-system mail-parse-charset))
- (not (eq coding-system 'gnus-decoded)))
- (if (or force
- ;; If a charset was supplied, then use the
- ;; supplied charset unconditionally.
- charset-supplied)
- (mm-decode-coding-region (point-min) (point-max)
- coding-system)
- ;; Otherwise allow Emacs to auto-detect the charset.
- (mm-decode-coding-region-safely (point-min) (point-max)
- coding-system)))
- (setq buffer-file-coding-system
- (if (boundp 'last-coding-system-used)
- (symbol-value 'last-coding-system-used)
- coding-system)))))))
-
-(defun mm-decode-coding-region-safely (start end coding-system)
- "Decode region between START and END with CODING-SYSTEM.
-If CODING-SYSTEM is not a valid coding system for the text, let Emacs
-decide which coding system to use."
- (let* ((orig (buffer-substring start end))
- charsets)
- (save-restriction
- (narrow-to-region start end)
- (mm-decode-coding-region (point-min) (point-max) coding-system)
- (setq charsets (find-charset-region (point-min) (point-max)))
- (when (or (memq 'eight-bit-control charsets)
- (memq 'eight-bit-graphic charsets))
- (delete-region (point-min) (point-max))
- (insert orig)
- (mm-decode-coding-region (point-min) (point-max) 'undecided)))))
+ (when (stringp charset)
+ (setq charset (intern (downcase charset))))
+ (when (or (not charset)
+ (eq 'gnus-all mail-parse-ignored-charsets)
+ (memq 'gnus-all mail-parse-ignored-charsets)
+ (memq charset mail-parse-ignored-charsets))
+ (setq charset mail-parse-charset))
+ (save-excursion
+ (when encoding
+ (mm-decode-content-transfer-encoding encoding type))
+ (when (featurep 'mule)
+ (let ((coding-system (mm-charset-to-coding-system charset)))
+ (if (and (not coding-system)
+ (listp mail-parse-ignored-charsets)
+ (memq 'gnus-unknown mail-parse-ignored-charsets))
+ (setq coding-system
+ (mm-charset-to-coding-system mail-parse-charset)))
+ (when (and charset coding-system
+ ;; buffer-file-coding-system
+ ;;Article buffer is nil coding system
+ ;;in XEmacs
+ (mm-multibyte-p)
+ (or (not (eq coding-system 'ascii))
+ (setq coding-system mail-parse-charset))
+ (not (eq coding-system 'gnus-decoded)))
+ (mm-decode-coding-region (point-min) (point-max)
+ coding-system))
+ (setq buffer-file-coding-system
+ (if (boundp 'last-coding-system-used)
+ (symbol-value 'last-coding-system-used)
+ coding-system))))))
(defun mm-decode-string (string charset)
"Decode STRING with CHARSET."
(require 'mail-parse)
(require 'gnus-mailcap)
(eval-and-compile
- (autoload 'mm-body-7-or-8 "mm-bodies"))
+ (autoload 'mm-body-7-or-8 "mm-bodies")
+ (autoload 'mm-long-lines-p "mm-bodies"))
(defcustom mm-content-transfer-encoding-defaults
'(("text/x-patch" 8bit)
(mailcap-extension-to-mime (match-string 0 file))))
(defun mm-safer-encoding (encoding)
- "Return a safer but similar encoding."
+ "Return an encoding similar to ENCODING but safer than it."
(cond
((memq encoding '(7bit 8bit quoted-printable)) 'quoted-printable)
;; The remaining encodings are binary and base64 (and perhaps some
(t 'base64)))
(defun mm-encode-content-transfer-encoding (encoding &optional type)
+ "Encode the current buffer with ENCODING for MIME type TYPE.
+ENCODING can be: nil (do nothing); one of `quoted-printable', `base64';
+`7bit', `8bit' or `binary' (all do nothing); a function to do the encoding."
(cond
((eq encoding 'quoted-printable)
- (mm-with-unibyte-current-buffer-mule4
- (quoted-printable-encode-region (point-min) (point-max) t)))
+ ;; This used to try to make a multibyte buffer unibyte. That's
+ ;; completely wrong, since you'd get QP-encoded emacs-mule. If
+ ;; this gets run on multibyte text it's an error that needs
+ ;; fixing, and the encoding function will signal an error.
+ ;; Likewise base64 below.
+ (quoted-printable-encode-region (point-min) (point-max) t))
((eq encoding 'base64)
(when (equal type "text/plain")
(goto-char (point-min))
(while (search-forward "\n" nil t)
(replace-match "\r\n" t t)))
- (condition-case error
- (base64-encode-region (point-min) (point-max))
- (error
- (message "Error while decoding: %s" error)
- nil)))
+ (base64-encode-region (point-min) (point-max)))
((memq encoding '(7bit 8bit binary))
;; Do nothing.
)
((null encoding)
;; Do nothing.
)
+ ;; Fixme: Ignoring errors here looks bogus.
((functionp encoding)
(ignore-errors (funcall encoding (point-min) (point-max))))
(t
- (message "Unknown encoding %s; treating it as 8bit" encoding))))
+ (error "Unknown encoding %s" encoding))))
(defun mm-encode-buffer (type)
- "Encode the buffer which contains data of TYPE.
+ "Encode the buffer which contains data of MIME type TYPE.
+TYPE is a string or a list of the components.
The encoding used is returned."
(let* ((mime-type (if (stringp type) type (car type)))
(encoding
(pop rules)))))
(defun mm-qp-or-base64 ()
+ "Return the type with which to encode the buffer.
+This is either `base64' or `quoted-printable'."
(if (equal mm-use-ultra-safe-encoding '(sign . "pgp"))
;; perhaps not always accurate?
'quoted-printable
(coding-system-for-read mm-binary-coding-system))
(unless name
(error "The filename is not specified"))
- (mm-disable-multibyte-mule4)
+ (mm-disable-multibyte)
(if (file-exists-p name)
(mm-insert-file-contents name nil nil nil nil t)
(error (format "File %s is gone" name)))))
(coding-system-for-read mm-binary-coding-system))
(unless url
(error "URL is not specified"))
- (mm-with-unibyte-current-buffer-mule4
+ (mm-with-unibyte-current-buffer
(mm-url-insert-file-contents url))
- (mm-disable-multibyte-mule4)
+ (mm-disable-multibyte)
(setq buffer-file-name name)))
(defun mm-extern-anon-ftp (handle)
(coding-system-for-read mm-binary-coding-system))
(unless name
(error "The filename is not specified"))
- (mm-disable-multibyte-mule4)
+ (mm-disable-multibyte)
(mm-insert-file-contents path nil nil nil nil t)))
(defun mm-extern-ftp (handle)
(string-make-unibyte . identity)
(string-as-multibyte . identity)
(multibyte-string-p . ignore)
+ ;; It is not a MIME function, but some MIME functions use it.
+ (make-temp-file . (lambda (prefix &optional dir-flag)
+ (let ((file (expand-file-name
+ (make-temp-name prefix)
+ (if (fboundp 'temp-directory)
+ (temp-directory)
+ temporary-file-directory))))
+ (if dir-flag
+ (make-directory file))
+ file)))
(insert-byte . insert-char)
(multibyte-char-to-unibyte . identity))))
(defun mm-coding-system-p (sym)
"Return non-nil if SYM is a coding system."
- (or (and (fboundp 'coding-system-p) (coding-system-p sym))
- (memq sym (mm-get-coding-system-list))))
+ (if (fboundp 'coding-system-p)
+ (coding-system-p sym)
+ (memq sym (mm-get-coding-system-list))))
(defvar mm-charset-synonym-alist
`(
;; Apparently not defined in Emacs 20, but is a valid MIME name.
,@(unless (mm-coding-system-p 'gb2312)
'((gb2312 . cn-gb-2312)))
- ;; ISO-8859-15 is very similar to ISO-8859-1.
- ,@(unless (mm-coding-system-p 'iso-8859-15) ; Emacs 21 defines it.
+ ;; ISO-8859-15 is very similar to ISO-8859-1. But it's _different_!
+ ,@(unless (mm-coding-system-p 'iso-8859-15)
'((iso-8859-15 . iso-8859-1)))
;; Windows-1252 is actually a superset of Latin-1. See also
;; `gnus-article-dumbquotes-map'.
(boundp 'default-enable-multibyte-characters)
default-enable-multibyte-characters
(fboundp 'set-buffer-multibyte))
- "Emacs mule.")
-
- (defvar mm-mule4-p (and mm-emacs-mule
- (fboundp 'charsetp)
- (not (charsetp 'eight-bit-control)))
- "Mule version 4.")
+ "True in Emacs with Mule.")
(if mm-emacs-mule
(defun mm-enable-multibyte ()
"Unset the multibyte flag of in the current buffer.
This is a no-op in XEmacs."
(set-buffer-multibyte nil))
- (defalias 'mm-disable-multibyte 'ignore))
-
- (if mm-mule4-p
- (defun mm-enable-multibyte-mule4 ()
- "Enable multibyte in the current buffer.
-Only used in Emacs Mule 4."
- (set-buffer-multibyte t))
- (defalias 'mm-enable-multibyte-mule4 'ignore))
-
- (if mm-mule4-p
- (defun mm-disable-multibyte-mule4 ()
- "Disable multibyte in the current buffer.
-Only used in Emacs Mule 4."
- (set-buffer-multibyte nil))
- (defalias 'mm-disable-multibyte-mule4 'ignore)))
+ (defalias 'mm-disable-multibyte 'ignore)))
(defun mm-preferred-coding-system (charset)
;; A typo in some Emacs versions.
(or (get-charset-property charset 'preferred-coding-system)
(get-charset-property charset 'prefered-coding-system)))
+;; Mule charsets shouldn't be used.
(defsubst mm-guess-charset ()
"Guess Mule charset from the language environment."
(or
(setq charset 'ascii)
;; charset-after is fake in some Emacsen.
(setq charset (and (fboundp 'char-charset) (char-charset char)))
- (if (eq charset 'composition)
+ (if (eq charset 'composition) ; Mule 4
(let ((p (or pos (point))))
(cadr (find-charset-region p (1+ p))))
(if (and charset (not (memq charset '(ascii eight-bit-control
(setq result (cons head result)))
(nreverse result)))
-(if (and (not (featurep 'xemacs))
- (boundp 'enable-multibyte-characters))
- (defalias 'mm-multibyte-p
- (lambda ()
- "Say whether multibyte is enabled in the current buffer."
- enable-multibyte-characters))
- (defalias 'mm-multibyte-p (lambda () (featurep 'mule))))
+(eval-and-compile
+ (if (and (not (featurep 'xemacs))
+ (boundp 'enable-multibyte-characters))
+ (defun mm-multibyte-p ()
+ "Non-nil if multibyte is enabled in the current buffer."
+ enable-multibyte-characters)
+ (defun mm-multibyte-p () (featurep 'mule))))
(defun mm-iso-8859-x-to-15-region (&optional b e)
(if (fboundp 'char-charset)
(let ((multibyte (make-symbol "multibyte"))
(buffer (make-symbol "buffer")))
`(if mm-emacs-mule
- (let ((,multibyte enable-multibyte-characters)
+ (let ((,multibyte enable-multibyte-characters)
(,buffer (current-buffer)))
(unwind-protect
(let (default-enable-multibyte-characters)
(put 'mm-with-unibyte-current-buffer 'lisp-indent-function 0)
(put 'mm-with-unibyte-current-buffer 'edebug-form-spec '(body))
-(defmacro mm-with-unibyte-current-buffer-mule4 (&rest forms)
- "Evaluate FORMS there like `progn' in current buffer.
-Mule4 only."
- (let ((multibyte (make-symbol "multibyte"))
- (buffer (make-symbol "buffer")))
- `(if mm-mule4-p
- (let ((,multibyte enable-multibyte-characters)
- (,buffer (current-buffer)))
- (unwind-protect
- (let (default-enable-multibyte-characters)
- (set-buffer-multibyte nil)
- ,@forms)
- (set-buffer ,buffer)
- (set-buffer-multibyte ,multibyte)))
- (let (default-enable-multibyte-characters)
- ,@forms))))
-(put 'mm-with-unibyte-current-buffer-mule4 'lisp-indent-function 0)
-(put 'mm-with-unibyte-current-buffer-mule4 'edebug-form-spec '(body))
-
(defmacro mm-with-unibyte (&rest forms)
"Eval the FORMS with the default value of `enable-multibyte-characters' nil, ."
`(let (default-enable-multibyte-characters)
(push dir result))
(push path result))))
+;; Fixme: This doesn't look useful where it's used.
(if (fboundp 'detect-coding-region)
(defun mm-detect-coding-region (start end)
"Like `detect-coding-region' except returning the best one."
(let ((cs (mm-detect-coding-region start end)))
cs)))
-(defun mm-guess-mime-charset ()
- "Guess the default MIME charset from the language environment."
- (let ((language-info
- (and (boundp 'current-language-environment)
- (assoc current-language-environment
- language-info-alist)))
- item)
- (cond
- ((null language-info)
- 'iso-8859-1)
- ((setq item
- (cadr
- (or (assq 'coding-priority language-info)
- (assq 'coding-system language-info))))
- (if (fboundp 'coding-system-get)
- (or (coding-system-get item 'mime-charset)
- item)
- item))
- ((setq item (car (last (assq 'charset language-info))))
- (if (eq item 'ascii)
- 'iso-8859-1
- (mm-mime-charset item)))
- (t
- 'iso-8859-1))))
-
-;; It is not a MIME function, but some MIME functions use it.
-(defalias 'mm-make-temp-file
- (if (fboundp 'make-temp-file)
- 'make-temp-file
- (lambda (prefix &optional dir-flag)
- (let ((file (expand-file-name
- (make-temp-name prefix)
- (if (fboundp 'temp-directory)
- (temp-directory)
- temporary-file-directory))))
- (if dir-flag
- (make-directory file))
- file))))
(provide 'mm-util)
(require 'smime)
(require 'mm-decode)
+(autoload 'message-narrow-to-headers "message")
(defun mml-smime-sign (cont)
(when (null smime-keys)
(while (looking-at "^Content[^ ]+:") (forward-line))
(unless (bobp)
(delete-region (point-min) (point)))
- (mm-with-unibyte-current-buffer-mule4
+ (mm-with-unibyte-current-buffer
(with-temp-buffer
(setq cipher (current-buffer))
(insert-buffer-substring text)
(while (looking-at "^Content[^ ]+:") (forward-line))
(unless (bobp)
(delete-region (point-min) (point)))
- (mm-with-unibyte-current-buffer-mule4
+ (mm-with-unibyte-current-buffer
(with-temp-buffer
(flet ((gpg-encrypt-func
(sign plaintext ciphertext result recipients &optional
(eval-when-compile (require 'gnus-clfns))
(require 'mm-decode)
(require 'mm-util)
+(require 'mml)
(defvar mml2015-use (or
(progn
(or (y-or-n-p "Sign the message? ")
'not))))
'never)))
- (mm-with-unibyte-current-buffer-mule4
+ (mm-with-unibyte-current-buffer
(mc-encrypt-generic
(or (message-options-get 'message-recipients)
(message-options-set 'message-recipients
(funcall mml-boundary-function (incf mml-multipart-number)))
(text (current-buffer))
cipher)
- (mm-with-unibyte-current-buffer-mule4
+ (mm-with-unibyte-current-buffer
(with-temp-buffer
;; set up a function to call the correct gpg encrypt routine
;; with the right arguments. (FIXME: this should be done
;;(eval-when-compile (require 'gnus-util))
(require 'mail-utils)
+(require 'gnus-util)
;; Reduce the required value of `recursive-load-depth-limit' for Emacs 21.
(require 'pces)
(open-network-stream-as-binary
"nntpd" buffer nntp-address nntp-port-number))
+(autoload 'format-spec "format")
+(autoload 'format-spec-make "format")
+(autoload 'open-tls-stream "tls")
+
(defun nntp-open-ssl-stream (buffer)
(let* ((process-connection-type nil)
(proc (as-binary-process
(set-buffer (process-buffer process))
(goto-char start)
(while (not (re-search-forward "^\\.\r\n" nil t))
+ ;; Fixme: Shouldn't depend on nnheader.
(nnheader-accept-process-output process)
(goto-char start))
(setq pop3-read-point (point-marker))
-;;; rfc2047.el --- Functions for encoding and decoding rfc2047 messages
-;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003 Free Software Foundation, Inc.
+;;; rfc2047.el --- functions for encoding and decoding rfc2047 messages
+;; Copyright (C) 1998, 1999, 2000, 2002, 2003 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
(eval-when-compile
(require 'cl)
- (defvar message-posting-charset))
+ (defvar message-posting-charset)
+ (unless (fboundp 'with-syntax-table) ; not in Emacs 20
+ (defmacro with-syntax-table (table &rest body)
+ "Evaluate BODY with syntax table of current buffer set to TABLE.
+The syntax table of the current buffer is saved, BODY is evaluated, and the
+saved table is restored, even in case of an abnormal exit.
+Value is what BODY returns."
+ (let ((old-table (make-symbol "table"))
+ (old-buffer (make-symbol "buffer")))
+ `(let ((,old-table (syntax-table))
+ (,old-buffer (current-buffer)))
+ (unwind-protect
+ (progn
+ (set-syntax-table ,table)
+ ,@body)
+ (save-current-buffer
+ (set-buffer ,old-buffer)
+ (set-syntax-table ,old-table))))))))
(require 'qp)
(require 'mm-util)
-(require 'ietf-drums)
+;; Fixme: Avoid this (used for mail-parse-charset) mm dependence on gnus.
(require 'mail-prsvr)
(require 'base64)
-;; Fixme: Avoid this (for gnus-point-at-...) mm dependence on gnus.
-(require 'gnus-util)
(autoload 'mm-body-7-or-8 "mm-bodies")
+;; Avoid gnus-util for mm- code.
+(defalias 'rfc2047-point-at-bol
+ (if (fboundp 'point-at-bol)
+ 'point-at-bol
+ 'line-beginning-position))
+
+(defalias 'rfc2047-point-at-eol
+ (if (fboundp 'point-at-eol)
+ 'point-at-eol
+ 'line-end-position))
+
(defvar rfc2047-header-encoding-alist
'(("Newsgroups" . nil)
("Followup-To" . nil)
("Message-ID" . nil)
("\\(Resent-\\)?\\(From\\|Cc\\|To\\|Bcc\\|Reply-To\\|Sender\\)" .
- "-A-Za-z0-9!*+/=_")
+ address-mime)
(t . mime))
"*Header/encoding method alist.
The list is traversed sequentially. The keys can either be
1) nil, in which case no encoding is done;
2) `mime', in which case the header will be encoded according to RFC2047;
-3) a charset, in which case it will be encoded as that charset;
-4) `default', in which case the field will be encoded as the rest
- of the article.
-5) a string, like `mime', expect for using it as word-chars.")
+3) `address-mime', like `mime', but takes account of the rules for address
+ fields (where quoted strings and comments must be treated separately);
+4) a charset, in which case it will be encoded as that charset;
+5) `default', in which case the field will be encoded as the rest
+ of the article.")
(defvar rfc2047-charset-encoding-alist
'((us-ascii . nil)
(re-search-forward ":[ \t\n]*" nil t)
(buffer-substring (point) (point-max)))))
+(defvar rfc2047-encoding-type 'address-mime
+ "The type of encoding done by `rfc2047-encode-region'.
+This should be dynamically bound around calls to
+`rfc2047-encode-region' to either `mime' or `address-mime'. See
+`rfc2047-header-encoding-alist', for definitions.")
+
(defun rfc2047-encode-message-header ()
"Encode the message header according to `rfc2047-header-encoding-alist'.
Should be called narrowed to the head of the message."
(mm-coding-system-p
(car message-posting-charset)))
;; 8 bit must be decoded.
- ;; Is message-posting-charset a coding system?
(mm-encode-coding-region
(point-min) (point-max)
- (car message-posting-charset))
- nil)
+ (mm-charset-to-coding-system
+ (car message-posting-charset))))
;; No encoding necessary, but folding is nice
(rfc2047-fold-region
(save-excursion
(eq (car elem) t))
(setq alist nil
method (cdr elem))))
+ (goto-char (point-min))
+ (re-search-forward "^[^:]+: *" nil t)
(cond
- ((stringp method)
- (rfc2047-encode-region (point-min) (point-max) method))
+ ((eq method 'address-mime)
+ (rfc2047-encode-region (point) (point-max)))
((eq method 'mime)
- (rfc2047-encode-region (point-min) (point-max)))
+ (let (rfc2047-encoding-type)
+ (rfc2047-encode-region (point) (point-max))))
((eq method 'default)
(if (and (featurep 'mule)
(if (boundp 'default-enable-multibyte-characters)
default-enable-multibyte-characters)
mail-parse-charset)
- (mm-encode-coding-region (point-min) (point-max)
+ (mm-encode-coding-region (point) (point-max)
mail-parse-charset)))
;; We get this when CC'ing messsages to newsgroups with
- ;; 8-bit names. The group name mail copy just get
+ ;; 8-bit names. The group name mail copy just got
;; unconditionally encoded. Previously, it would ask
;; whether to encode, which was quite confusing for the
;; user. If the new behaviour is wrong, tell me. I have
;; left the old code commented out below.
;; -- Per Abrahamsen <abraham@dina.kvl.dk> Date: 2001-10-07.
+ ;; Modified by Dave Love, with the commented-out code changed
+ ;; in accordance with changes elsewhere.
((null method)
- (when (delq 'ascii
- (mm-find-charset-region (point-min) (point-max)))
- (rfc2047-encode-region (point-min) (point-max))))
-;;; ((null method)
-;;; (and (delq 'ascii
-;;; (mm-find-charset-region (point-min)
-;;; (point-max)))
-;;; (if (or (message-options-get
-;;; 'rfc2047-encode-message-header-encode-any)
-;;; (message-options-set
-;;; 'rfc2047-encode-message-header-encode-any
-;;; (y-or-n-p
-;;; "Some texts are not encoded. Encode anyway?")))
-;;; (rfc2047-encode-region (point-min) (point-max))
-;;; (error "Cannot send unencoded text"))))
+ (rfc2047-encode-region (point) (point-max)))
+;;; ((null method)
+;;; (if (or (message-options-get
+;;; 'rfc2047-encode-message-header-encode-any)
+;;; (message-options-set
+;;; 'rfc2047-encode-message-header-encode-any
+;;; (y-or-n-p
+;;; "Some texts are not encoded. Encode anyway?")))
+;;; (rfc2047-encode-region (point-min) (point-max))
+;;; (error "Cannot send unencoded text")))
((mm-coding-system-p method)
(if (and (featurep 'mule)
(if (boundp 'default-enable-multibyte-characters)
default-enable-multibyte-characters))
- (mm-encode-coding-region (point-min) (point-max) method)))
+ (mm-encode-coding-region (point) (point-max) method)))
;; Hm.
(t)))
(goto-char (point-max)))))))
The buffer may be narrowed."
(require 'message) ; for message-posting-charset
(let ((charsets
- (mapcar
- 'mm-mime-charset
- (mm-find-charset-region (point-min) (point-max))))
- (cs (list 'us-ascii (car message-posting-charset)))
- found)
- (while charsets
- (unless (memq (pop charsets) cs)
- (setq found t)))
- found))
-
-(defun rfc2047-dissect-region (b e &optional word-chars)
- "Dissect the region between B and E into words."
- (unless word-chars
- ;; Anything except most CTLs, WSP
- (setq word-chars "\010\012\014\041-\177"))
- (let (mail-parse-mule-charset
- words point current
- result word)
- (save-restriction
- (narrow-to-region b e)
- (goto-char (point-min))
- (skip-chars-forward "\000-\177")
- (while (not (eobp))
- (setq point (point))
- (skip-chars-backward word-chars b)
- (unless (eq b (point))
- (push (cons (buffer-substring b (point)) nil) words))
- (setq b (point))
- (goto-char point)
- (setq current (mm-charset-after))
- (forward-char 1)
- (skip-chars-forward word-chars)
- (while (and (not (eobp))
- (eq (mm-charset-after) current))
- (forward-char 1)
- (skip-chars-forward word-chars))
- (unless (eq b (point))
- (push (cons (buffer-substring b (point)) current) words))
- (setq b (point))
- (skip-chars-forward "\000-\177"))
- (unless (eq b (point))
- (push (cons (buffer-substring b (point)) nil) words)))
- ;; merge adjacent words
- (setq word (pop words))
- (while word
- (if (and (cdr word)
- (caar words)
- (not (cdar words))
- (not (string-match "[^ \t]" (caar words))))
- (if (eq (cdr (nth 1 words)) (cdr word))
- (progn
- (setq word (cons (concat
- (car (nth 1 words)) (caar words)
- (car word))
- (cdr word)))
- (pop words)
- (pop words))
- (push (cons (concat (caar words) (car word)) (cdr word))
- result)
- (pop words)
- (setq word (pop words)))
- (push word result)
- (setq word (pop words))))
- result))
-
-(defun rfc2047-encode-region (b e &optional word-chars)
- "Encode all encodable words in region B to E."
- (let ((words (rfc2047-dissect-region b e word-chars)) word)
- (save-restriction
- (narrow-to-region b e)
- (delete-region (point-min) (point-max))
- (while (setq word (pop words))
- (if (not (cdr word))
- (insert (car word))
- (rfc2047-fold-region (gnus-point-at-bol) (point))
- (goto-char (point-max))
- (if (> (- (point) (save-restriction
- (widen)
- (gnus-point-at-bol))) 76)
- (insert "\n "))
- ;; Insert blank between encoded words
- (if (eq (char-before) ?=) (insert " "))
- (rfc2047-encode (point)
- (progn (insert (car word)) (point))
- (cdr word))))
- (rfc2047-fold-region (point-min) (point-max)))))
-
-(defun rfc2047-encode-string (string &optional word-chars)
- "Encode words in STRING."
+ (mm-find-mime-charset-region (point-min) (point-max))))
+ (and charsets (not (equal charsets (list message-posting-charset))))))
+
+;; Use this syntax table when parsing into regions that may need
+;; encoding. Double quotes are string delimiters, backslash is
+;; character quoting, and all other RFC 2822 special characters are
+;; treated as punctuation so we can use forward-sexp/forward-word to
+;; skip to the end of regions appropriately. Nb. ietf-drums does
+;; things differently.
+(defconst rfc2047-syntax-table
+ ;; This is what we should do, but XEmacs doesn't support the optional
+ ;; arg of `make-syntax-table':
+;; (let ((table (make-char-table 'syntax-table '(2))))
+ (let ((table (make-syntax-table)))
+ (map-char-table (lambda (k v) (modify-syntax-entry k "w" table)) table)
+ (modify-syntax-entry ?\\ "\\" table)
+ (modify-syntax-entry ?\" "\"" table)
+ (modify-syntax-entry ?\( "." table)
+ (modify-syntax-entry ?\) "." table)
+ (modify-syntax-entry ?\< "." table)
+ (modify-syntax-entry ?\> "." table)
+ (modify-syntax-entry ?\[ "." table)
+ (modify-syntax-entry ?\] "." table)
+ (modify-syntax-entry ?: "." table)
+ (modify-syntax-entry ?\; "." table)
+ (modify-syntax-entry ?, "." table)
+ (modify-syntax-entry ?@ "." table)
+ table))
+
+(defun rfc2047-encode-region (b e)
+ "Encode words in region B to E that need encoding.
+By default, the region is treated as containing RFC2822 addresses.
+Dynamically bind `rfc2047-encoding-type' to change that."
+ (save-restriction
+ (narrow-to-region b e)
+ (if (eq 'mime rfc2047-encoding-type)
+ ;; Simple case -- treat as single word.
+ (progn
+ (goto-char (point-min))
+ ;; Does it need encoding?
+ (skip-chars-forward "\000-\177" e)
+ (unless (eobp)
+ (rfc2047-encode b e)))
+ ;; `address-mime' case -- take care of quoted words, comments.
+ (with-syntax-table rfc2047-syntax-table
+ (let ((start) ; start of current token
+ end ; end of current token
+ ;; Whether there's an encoded word before the current
+ ;; token, either immediately or separated by space.
+ last-encoded)
+ (goto-char (point-min))
+ (condition-case nil ; in case of unbalanced quotes
+ ;; Look for rfc2822-style: sequences of atoms, quoted
+ ;; strings, specials, whitespace. (Specials mustn't be
+ ;; encoded.)
+ (while (not (eobp))
+ (setq start (point))
+ ;; Skip whitespace.
+ (unless (= 0 (skip-chars-forward " \t"))
+ (setq start (point)))
+ (cond
+ ((not (char-after))) ; eob
+ ;; else token start
+ ((eq ?\" (char-syntax (char-after)))
+ ;; Quoted word.
+ (forward-sexp)
+ (setq end (point))
+ ;; Does it need encoding?
+ (goto-char start)
+ (skip-chars-forward "\000-\177" end)
+ (if (= end (point))
+ (setq last-encoded nil)
+ ;; It needs encoding. Strip the quotes first,
+ ;; since encoded words can't occur in quotes.
+ (goto-char end)
+ (delete-backward-char 1)
+ (goto-char start)
+ (delete-char 1)
+ (when last-encoded
+ ;; There was a preceding quoted word. We need
+ ;; to include any separating whitespace in this
+ ;; word to avoid it getting lost.
+ (skip-chars-backward " \t")
+ ;; A space is needed between the encoded words.
+ (insert ? )
+ (setq start (point)
+ end (1+ end)))
+ ;; Adjust the end position for the deleted quotes.
+ (rfc2047-encode start (- end 2))
+ (setq last-encoded t))) ; record that it was encoded
+ ((eq ?. (char-syntax (char-after)))
+ ;; Skip other delimiters, but record that they've
+ ;; potentially separated quoted words.
+ (forward-char)
+ (setq last-encoded nil))
+ (t ; normal token/whitespace sequence
+ ;; Find the end.
+ (forward-word 1)
+ (skip-chars-backward " \t")
+ (setq end (point))
+ ;; Deal with encoding and leading space as for
+ ;; quoted words.
+ (goto-char start)
+ (skip-chars-forward "\000-\177" end)
+ (if (= end (point))
+ (setq last-encoded nil)
+ (when last-encoded
+ (goto-char start)
+ (skip-chars-backward " \t")
+ (insert ? )
+ (setq start (point)
+ end (1+ end)))
+ (rfc2047-encode start end)
+ (setq last-encoded t)))))
+ (error (error "Invalid data for rfc2047 encoding: %s"
+ (buffer-substring b e)))))))
+ (rfc2047-fold-region b (point))))
+
+(defun rfc2047-encode-string (string)
+ "Encode words in STRING.
+By default, the string is treated as containing addresses (see
+`rfc2047-special-chars')."
(with-temp-buffer
(insert string)
- (rfc2047-encode-region (point-min) (point-max) word-chars)
+ (rfc2047-encode-region (point-min) (point-max))
(buffer-string)))
-(defun rfc2047-encode (b e charset)
- "Encode the word in the region B to E with CHARSET."
- (let* ((mime-charset (mm-mime-charset charset))
- (cs (mm-charset-to-coding-system mime-charset))
- (encoding (or (cdr (assq mime-charset
+(defun rfc2047-encode (b e)
+ "Encode the word(s) in the region B to E.
+By default, the region is treated as containing addresses (see
+`rfc2047-special-chars')."
+ (let* ((mime-charset (mm-find-mime-charset-region b e))
+ (cs (if (> (length mime-charset) 1)
+ ;; Fixme: Instead of this, try to break region into
+ ;; parts that can be encoded separately.
+ (error "Can't rfc2047-encode `%s'"
+ (buffer-substring b e))
+ (setq mime-charset (car mime-charset))
+ (mm-charset-to-coding-system mime-charset)))
+ ;; Fixme: Better, calculate the number of non-ASCII
+ ;; characters, at least for 8-bit charsets.
+ (encoding (if (assq mime-charset
+ rfc2047-charset-encoding-alist)
+ (cdr (assq mime-charset
rfc2047-charset-encoding-alist))
- 'B))
+ 'B))
(start (concat
"=?" (downcase (symbol-name mime-charset)) "?"
(downcase (symbol-name encoding)) "?"))
(first t))
- (save-restriction
- (narrow-to-region b e)
- (when (eq encoding 'B)
- ;; break into lines before encoding
- (goto-char (point-min))
- (while (not (eobp))
- (goto-char (min (point-max) (+ 15 (point))))
- (unless (eobp)
- (insert "\n"))))
- (if (and (mm-multibyte-p)
- (mm-coding-system-p cs))
- (mm-encode-coding-region (point-min) (point-max) cs))
- (funcall (cdr (assq encoding rfc2047-encoding-function-alist))
- (point-min) (point-max))
- (goto-char (point-min))
- (while (not (eobp))
- (unless first
- (insert " "))
- (setq first nil)
- (insert start)
- (end-of-line)
- (insert "?=")
- (forward-line 1)))))
+ (if mime-charset
+ (save-restriction
+ (narrow-to-region b e)
+ (when (eq encoding 'B)
+ ;; break into lines before encoding
+ (goto-char (point-min))
+ (while (not (eobp))
+ (goto-char (min (point-max) (+ 15 (point))))
+ (unless (eobp)
+ (insert ?\n))))
+ (if (and (mm-multibyte-p)
+ (mm-coding-system-p cs))
+ (mm-encode-coding-region (point-min) (point-max) cs))
+ (funcall (cdr (assq encoding rfc2047-encoding-function-alist))
+ (point-min) (point-max))
+ (goto-char (point-min))
+ (while (not (eobp))
+ (unless first
+ (insert ? ))
+ (setq first nil)
+ (insert start)
+ (end-of-line)
+ (insert "?=")
+ (forward-line 1))))))
(defun rfc2047-fold-field ()
- "Fold the current line."
+ "Fold the current header field."
(save-excursion
(save-restriction
(rfc2047-narrow-to-field)
(first t)
(bol (save-restriction
(widen)
- (gnus-point-at-bol))))
+ (rfc2047-point-at-bol))))
(while (not (eobp))
(when (and (or break qword-break)
(> (- (point) bol) 76))
(setq break nil
qword-break nil)
(if (looking-at "[ \t]")
- (insert "\n")
+ (insert ?\n)
(insert "\n "))
(setq bol (1- (point)))
;; Don't break before the first non-LWSP characters.
(setq break nil
qword-break nil)
(if (looking-at "[ \t]")
- (insert "\n")
+ (insert ?\n)
(insert "\n "))
(setq bol (1- (point)))
;; Don't break before the first non-LWSP characters.
(goto-char (point-min))
(let ((bol (save-restriction
(widen)
- (gnus-point-at-bol)))
- (eol (gnus-point-at-eol)))
+ (rfc2047-point-at-bol)))
+ (eol (rfc2047-point-at-eol))
+ leading)
(forward-line 1)
(while (not (eobp))
(if (and (looking-at "[ \t]")
- (< (- (gnus-point-at-eol) bol) 76))
+ (< (- (rfc2047-point-at-eol) bol) 76))
(delete-region eol (progn
(goto-char eol)
(skip-chars-forward "\r\n")
(point)))
- (setq bol (gnus-point-at-bol)))
- (setq eol (gnus-point-at-eol))
+ (setq bol (rfc2047-point-at-bol)))
+ (setq eol (rfc2047-point-at-eol))
(forward-line 1)))))
(defun rfc2047-b-encode-region (b e)
(let ((alist rfc2047-q-encoding-alist)
(bol (save-restriction
(widen)
- (gnus-point-at-bol))))
+ (rfc2047-point-at-bol))))
(while alist
(when (looking-at (caar alist))
- (mm-with-unibyte-current-buffer-mule4
- (quoted-printable-encode-region
- (point-min) (point-max) nil (cdar alist)))
+ (quoted-printable-encode-region b e nil (cdar alist))
(subst-char-in-region (point-min) (point-max) ? ?_)
(setq alist nil))
(pop alist))
(goto-char (min (point-max) (+ 56 bol)))
(search-backward "=" (- (point) 2) t)
(unless (or (bobp) (eobp))
- (insert "\n")
+ (insert ?\n)
(setq bol (point)))))))))
;;;
;;; Functions for decoding RFC2047 messages
;;;
-(defvar rfc2047-encoded-word-regexp
- "=\\?\\([^][\000-\040()<>@,\;:\\\"/?.=]+\\)\\?\\(B\\|Q\\)\\?\\([!->@-~ +]*\\)\\?=")
+(eval-and-compile
+ (defconst rfc2047-encoded-word-regexp
+ "=\\?\\([^][\000-\040()<>@,\;:\\\"/?.=]+\\)\\?\\(B\\|Q\\)\
+\\?\\([!->@-~ +]*\\)\\?="))
+
+;; Fixme: This should decode in place, not cons intermediate strings.
+;; Also check whether it needs to worry about delimiting fields like
+;; encoding.
(defun rfc2047-decode-region (start end)
"Decode MIME-encoded words in region between START and END."
(goto-char (point-min))
;; Remove whitespace between encoded words.
(while (re-search-forward
- (concat "\\(" rfc2047-encoded-word-regexp "\\)"
- "\\(\n?[ \t]\\)+"
- "\\(" rfc2047-encoded-word-regexp "\\)")
+ (eval-when-compile
+ (concat "\\(" rfc2047-encoded-word-regexp "\\)"
+ "\\(\n?[ \t]\\)+"
+ "\\(" rfc2047-encoded-word-regexp "\\)"))
nil t)
(delete-region (goto-char (match-end 1)) (match-beginning 6)))
;; Decode the encoded words.
(prog1
(match-string 0)
(delete-region (match-beginning 0) (match-end 0)))))
- ;; Remove newlines between decoded words. Though such things
- ;; must not be essentially there.
+ ;; Remove newlines between decoded words, though such things
+ ;; essentially must not be there.
(save-restriction
(narrow-to-region e (point))
(goto-char e)
mail-parse-charset
(not (eq mail-parse-charset 'us-ascii))
(not (eq mail-parse-charset 'gnus-decoded)))
- (mm-decode-coding-region-safely b (point-max) mail-parse-charset))))))
+ (mm-decode-coding-region b (point-max) mail-parse-charset))))))
(defun rfc2047-decode-string (string)
"Decode the quoted-printable-encoded STRING and return the results."
(let ((m (mm-multibyte-p)))
(if (string-match "=\\?" string)
(with-temp-buffer
+ ;; Fixme: This logic is wrong, but seems to be required by
+ ;; Gnus summary buffer generation. The value of `m' depends
+ ;; on the current buffer, not global multibyteness or that
+ ;; of the string. Also the string returned should always be
+ ;; multibyte in a multibyte session, i.e. the buffer should
+ ;; be multibyte before `buffer-string' is called.
(when m
(mm-enable-multibyte))
(insert string)
(inline
(rfc2047-decode-region (point-min) (point-max)))
(buffer-string))
+ ;; Fixme: As above, `m' here is inappropriate.
(if (and m
mail-parse-charset
(not (eq mail-parse-charset 'us-ascii))
(not (eq mail-parse-charset 'gnus-decoded)))
- (let* ((decoded (mm-decode-coding-string string mail-parse-charset))
- (charsets (find-charset-string decoded)))
- (if (or (memq 'eight-bit-control charsets)
- (memq 'eight-bit-graphic charsets))
- (mm-decode-coding-string string 'undecided)
- decoded))
- string))))
+ (mm-decode-coding-string string mail-parse-charset)
+ (mm-string-as-multibyte string)))))
(defun rfc2047-parse-and-decode (word)
"Decode WORD and return it if it is an encoded word.
-Return WORD if not."
+Return WORD if it is not not an encoded word or if the charset isn't
+decodable."
(if (not (string-match rfc2047-encoded-word-regexp word))
word
- (or
- (condition-case nil
- (rfc2047-decode
- (match-string 1 word)
- (upcase (match-string 2 word))
- (match-string 3 word))
- (error word))
- word)))
+ (condition-case nil
+ (rfc2047-decode
+ (match-string 1 word)
+ (upcase (match-string 2 word))
+ (match-string 3 word))
+ (error word))))
(defun rfc2047-pad-base64 (string)
"Pad STRING to quartets."
(when (and (eq cs 'ascii)
mail-parse-charset)
(setq cs mail-parse-charset))
- (mm-with-unibyte-current-buffer-mule4
+ ;; Fixme: What's this for? The following comment makes no sense. -- fx
+ (mm-with-unibyte-current-buffer
;; In Emacs Mule 4, decoding UTF-8 should be in unibyte mode.
(mm-decode-coding-string
(cond
(eval-when-compile (require 'cl))
(require 'ietf-drums)
(require 'rfc2047)
+(autoload 'mm-encode-body "mm-bodies")
+(autoload 'mail-header-remove-whitespace "mail-parse")
+(autoload 'mail-header-remove-comments "mail-parse")
(defun rfc2231-get-value (ct attribute)
"Return the value of ATTRIBUTE from CT."
(or (fboundp 'md5)
(require 'md5))
(eval-and-compile
- (autoload 'starttls-open-stream "starttls"))
+ (autoload 'starttls-open-stream "starttls")
+ (autoload 'starttls-negotiate "starttls"))
;; User customizable variables:
(define-key sieve-manage-mode-map [(down-mouse-2)] 'sieve-edit-script)
(define-key sieve-manage-mode-map [(down-mouse-3)] 'sieve-manage-mode-menu))
+(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"
"Mode used for sieve script management."
(setq mode-name "SIEVE")
(put 'sieve-manage-mode 'mode-class 'special)
-(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]))
-
;; This is necessary to allow correct handling of \\[cvs-mode-diff-map]
;; in substitute-command-keys.
;(fset 'sieve-manage-mode-map sieve-manage-mode-map)
(defvar smime-details-buffer "*OpenSSL output*")
+;; Use mm-util?
(eval-and-compile
(defalias 'smime-make-temp-file
(if (fboundp 'make-temp-file)
(caddr curkey)
(smime-get-certfiles keyfile otherkeys)))))
+;; Use mm-util?
(eval-and-compile
(defalias 'smime-point-at-eol
(if (fboundp 'point-at-eol)
+2003-05-03 Kai Gro\e,A_\e(Bjohann <kai.grossjohann@gmx.net>
+
+ * gnus.texi (Agent Basics): Explain that some servers can be
+ agentized, whereas others aren't.
+
2003-05-01 Reiner Steib <Reiner.Steib@gmx.de>
* gnus.texi (Oort Gnus): Add prefix limit feature.
\e$B%^%7%s$K<h$C$F$/$k$3$H$r0UL#$7$^$9!#%"%C%W%m!<%I\e(B (@dfn{upload}) \e$B$O$=$N5U\e(B
\e$B$r$9$k$3$H$G$9!#\e(B
+@c TRANSLATEME
+You know that Gnus gives you all the opportunity you'd ever want for
+shooting yourself in the foot. Some people call it flexibility. Gnus
+is also customizable to a great extent, which means that the user has a
+say on how Gnus behaves. Other newsreaders might unconditionally shoot
+you in your foot, but with Gnus, you have a choice!
+
+Gnus is never really in plugged or unplugged state. Rather, it applies
+that state to each server individually. This means that some servers
+can be plugged while others can be unplugged. Additionally, some
+servers can be ignored by the Agent altogether (which means that
+they're kinda like plugged always).
+
+So when you unplug the Agent and then wonder why is Gnus opening a
+connection to the Net, the next step to do is to look whether all
+servers are agentized. If there is an unagentized server, you found
+the culprit.
+
+Another thing is the @dfn{offline} state. Sometimes, servers aren't
+reachable. When Gnus notices this, it asks you whether you want the
+server to be switched to offline state. If you say yes, then the
+server will behave somewhat as if it was unplugged, except that Gnus
+will ask you whether you want to switch it back online again.
+
\e$B%(!<%8%'%s%H$r;H$C$?E57?E*$J\e(B gnus \e$B$NBPOCA`:n$r8+$F$_$^$7$g$&!#\e(B
@itemize @bullet
\e$B$I$N%5!<%P!<$r%(!<%8%'%s%H$GLLE]$r8+$k$+$r7h$a$^$9!#$b$7%a!<%k%P%C%/%(%s\e(B
\e$B%I$,$"$l$P!"$=$l$r%(!<%8%'%s%H$KLLE]$r8+$5$;$k$N$O$*$=$i$/L50UL#$G$7$g$&!#\e(B
\e$B%5!<%P!<%P%C%U%!!<$K0\F0$7\e(B (\e$B%0%k!<%W%P%C%U%!!<$G\e(B @kbd{^})\e$B!"%(!<%8%'%s%H\e(B
-\e$B$K07$C$FM_$7$$%5!<%P!<\e(B(\e$BJ#?t2D\e(B)\e$B$G\e(B @kbd{J a} \e$B$r2!$9$+!"$^$?$O%(!<%8%'%s%H\e(B
-\e$B$K07$C$FM_$7$/$J$$$N$K<+F0E*$KDI2C$5$l$?%5!<%P!<$G\e(B @kbd{J r} \e$B$r2!$7$^$9!#\e(B
-\e$B%G%#%U%)%k%H$G\e(B
+\e$B$K07$C$FM_$7$$%5!<%P!<\e(B(\e$BJ#?t2D\e(B)\e$B$G\e(B @kbd{J a} \e$B$r2!$9\e(B (@pxref{Server Agent
+Commands}) \e$B$+!"$^$?$O%(!<%8%'%s%H$K07$C$FM_$7$/$J$$$N$K<+F0E*$KDI2C$5$l\e(B
+\e$B$?%5!<%P!<$G\e(B @kbd{J r} \e$B$r2!$7$^$9!#%G%#%U%)%k%H$G\e(B
\e$B$O\e(B @code{gnus-select-method} \e$B$H\e(B @code{gnus-secondary-select-methods} \e$B$K\e(B
-\e$B$"$k$9$Y$F$N\e(B @code{nntp} \e$B$H\e(B @code{nnimap} \e$B%0%k!<%W$,%(!<%8%'%s%H2=$5$l$^\e(B
+\e$B$"$k$9$Y$F$N\e(B @code{nntp} \e$B$H\e(B @code{nnimap} \e$B%5!<%P!<$,%(!<%8%'%s%H2=$5$l$^\e(B
\e$B$9!#\e(B
@item
@dfn{Downloading} means fetching things from the net to your local
machine. @dfn{Uploading} is doing the opposite.
+You know that Gnus gives you all the opportunity you'd ever want for
+shooting yourself in the foot. Some people call it flexibility. Gnus
+is also customizable to a great extent, which means that the user has a
+say on how Gnus behaves. Other newsreaders might unconditionally shoot
+you in your foot, but with Gnus, you have a choice!
+
+Gnus is never really in plugged or unplugged state. Rather, it applies
+that state to each server individually. This means that some servers
+can be plugged while others can be unplugged. Additionally, some
+servers can be ignored by the Agent altogether (which means that
+they're kinda like plugged always).
+
+So when you unplug the Agent and then wonder why is Gnus opening a
+connection to the Net, the next step to do is to look whether all
+servers are agentized. If there is an unagentized server, you found
+the culprit.
+
+Another thing is the @dfn{offline} state. Sometimes, servers aren't
+reachable. When Gnus notices this, it asks you whether you want the
+server to be switched to offline state. If you say yes, then the
+server will behave somewhat as if it was unplugged, except that Gnus
+will ask you whether you want to switch it back online again.
+
Let's take a typical Gnus session using the Agent.
@itemize @bullet
@kbd{J a} on the server (or servers) that you wish to have covered by the
Agent (@pxref{Server Agent Commands}), or @kbd{J r} on automatically
added servers you do not wish to have covered by the Agent. By default,
-all @code{nntp} and @code{nnimap} groups in @code{gnus-select-method} and
+all @code{nntp} and @code{nnimap} servers in @code{gnus-select-method} and
@code{gnus-secondary-select-methods} are agentized.
@item
projects / elisp / gnus.git- / commitdiff