(require 'mail-prsvr)
(require 'timer)
-(defvar mm-mime-mule-charset-alist )
-;; Note this is not presently used on Emacs >= 23, which is good,
-;; since it means standalone message-mode (which requires mml and
-;; hence mml-util) does not load gnus-util.
-(autoload 'gnus-completing-read "gnus-util")
-
-;; Emulate functions that are not available in every (X)Emacs version.
-;; The name of a function is prefixed with mm-, like `mm-char-int' for
-;; `char-int' that is a native XEmacs function, not available in Emacs.
-;; Gnus programs all should use mm- functions, not the original ones.
-(eval-and-compile
- (mapc
- (lambda (elem)
- (let ((nfunc (intern (format "mm-%s" (car elem)))))
- (if (fboundp (car elem))
- (defalias nfunc (car elem))
- (defalias nfunc (cdr elem)))))
- `(
- ;; string-as-multibyte often doesn't really do what you think it does.
- ;; Example:
- ;; (aref (string-as-multibyte "\201") 0) -> 129 (aka ?\201)
- ;; (aref (string-as-multibyte "\300") 0) -> 192 (aka ?\300)
- ;; (aref (string-as-multibyte "\300\201") 0) -> 192 (aka ?\300)
- ;; (aref (string-as-multibyte "\300\201") 1) -> 129 (aka ?\201)
- ;; but
- ;; (aref (string-as-multibyte "\201\300") 0) -> 2240
- ;; (aref (string-as-multibyte "\201\300") 1) -> <error>
- ;; Better use string-to-multibyte or encode-coding-string.
- ;; If you really need string-as-multibyte somewhere it's usually
- ;; because you're using the internal emacs-mule representation (maybe
- ;; because you're using string-as-unibyte somewhere), which is
- ;; generally a problem in itself.
- ;; Here is an approximate equivalence table to help think about it:
- ;; (string-as-multibyte s) ~= (decode-coding-string s 'emacs-mule)
- ;; (string-to-multibyte s) ~= (decode-coding-string s 'binary)
- ;; (string-make-multibyte s) ~= (decode-coding-string s locale-coding-system)
- ;; `string-as-multibyte' is an Emacs function, not available in XEmacs.
- (string-as-multibyte . identity))))
+(defvar mm-mime-mule-charset-alist)
(defun mm-ucs-to-char (codepoint)
"Convert Unicode codepoint to character."
(mm-coding-system-p 'iso-8859-1))
'((iso_8859-1 . iso-8859-1)))
)
- "A mapping from unknown or invalid charset names to the real charset names.
-
-See `mm-codepage-iso-8859-list' and `mm-codepage-ibm-list'.")
-
-(defun mm-codepage-setup (number &optional alias)
- "Create a coding system cpNUMBER.
-The coding system is created using `codepage-setup'. If ALIAS is
-non-nil, an alias is created and added to
-`mm-charset-synonym-alist'. If ALIAS is a string, it's used as
-the alias. Else windows-NUMBER is used."
- (interactive
- (let ((completion-ignore-case t)
- (candidates (if (fboundp 'cp-supported-codepages)
- (cp-supported-codepages)
- ;; Removed in Emacs 23 (unicode), so signal an error:
- (error "`codepage-setup' not present in this Emacs version"))))
- (list (gnus-completing-read "Setup DOS Codepage" candidates
- t nil nil "437"))))
- (when alias
- (setq alias (if (stringp alias)
- (intern alias)
- (intern (format "windows-%s" number)))))
- (let* ((cp (intern (format "cp%s" number))))
- (unless (mm-coding-system-p cp)
- (if (fboundp 'codepage-setup) ; silence compiler
- (codepage-setup number)
- (error "`codepage-setup' not present in this Emacs version")))
- (when (and alias
- ;; Don't add alias if setup of cp failed.
- (mm-coding-system-p cp))
- (add-to-list 'mm-charset-synonym-alist (cons alias cp)))))
-
-(defcustom mm-codepage-iso-8859-list
- (list 1250 ;; Windows-1250 is a variant of Latin-2 heavily used by Microsoft
- ;; Outlook users in Czech republic. Use this to allow reading of
- ;; their e-mails.
- '(1252 . 1) ;; Windows-1252 is a superset of iso-8859-1 (West
- ;; Europe). See also `gnus-article-dumbquotes-map'.
- '(1254 . 9) ;; Windows-1254 is a superset of iso-8859-9 (Turkish).
- '(1255 . 8));; Windows-1255 is a superset of iso-8859-8 (Hebrew).
- "A list of Windows codepage numbers and iso-8859 charset numbers.
-
-If an element is a number corresponding to a supported windows
-codepage, appropriate entries to `mm-charset-synonym-alist' are
-added by `mm-setup-codepage-iso-8859'. An element may also be a
-cons cell where the car is a codepage number and the cdr is the
-corresponding number of an iso-8859 charset."
- :type '(list (set :inline t
- (const 1250 :tag "Central and East European")
- (const (1252 . 1) :tag "West European")
- (const (1254 . 9) :tag "Turkish")
- (const (1255 . 8) :tag "Hebrew"))
- (repeat :inline t
- :tag "Other options"
- (choice
- (integer :tag "Windows codepage number")
- (cons (integer :tag "Windows codepage number")
- (integer :tag "iso-8859 charset number")))))
- :version "22.1" ;; Gnus 5.10.9
- :group 'mime)
-
-(defcustom mm-codepage-ibm-list
- (list 437 ;; (US etc.)
- 860 ;; (Portugal)
- 861 ;; (Iceland)
- 862 ;; (Israel)
- 863 ;; (Canadian French)
- 865 ;; (Nordic)
- 852 ;;
- 850 ;; (Latin 1)
- 855 ;; (Cyrillic)
- 866 ;; (Cyrillic - Russian)
- 857 ;; (Turkish)
- 864 ;; (Arabic)
- 869 ;; (Greek)
- 874);; (Thai)
- ;; In Emacs 23 (unicode), cp... and ibm... are aliases.
- ;; Cf. http://thread.gmane.org/v9lkng5nwy.fsf@marauder.physik.uni-ulm.de
- "List of IBM codepage numbers.
-
-The codepage mappings slightly differ between IBM and other vendors.
-See \"ftp://ftp.unicode.org/Public/MAPPINGS/VENDORS/IBM/README.TXT\".
-
-If an element is a number corresponding to a supported windows
-codepage, appropriate entries to `mm-charset-synonym-alist' are
-added by `mm-setup-codepage-ibm'."
- :type '(list (set :inline t
- (const 437 :tag "US etc.")
- (const 860 :tag "Portugal")
- (const 861 :tag "Iceland")
- (const 862 :tag "Israel")
- (const 863 :tag "Canadian French")
- (const 865 :tag "Nordic")
- (const 852)
- (const 850 :tag "Latin 1")
- (const 855 :tag "Cyrillic")
- (const 866 :tag "Cyrillic - Russian")
- (const 857 :tag "Turkish")
- (const 864 :tag "Arabic")
- (const 869 :tag "Greek")
- (const 874 :tag "Thai"))
- (repeat :inline t
- :tag "Other options"
- (integer :tag "Codepage number")))
- :version "22.1" ;; Gnus 5.10.9
- :group 'mime)
-
-(defun mm-setup-codepage-iso-8859 (&optional list)
- "Add appropriate entries to `mm-charset-synonym-alist'.
-Unless LIST is given, `mm-codepage-iso-8859-list' is used."
- (unless list
- (setq list mm-codepage-iso-8859-list))
- (dolist (i list)
- (let (cp windows iso)
- (if (consp i)
- (setq cp (intern (format "cp%d" (car i)))
- windows (intern (format "windows-%d" (car i)))
- iso (intern (format "iso-8859-%d" (cdr i))))
- (setq cp (intern (format "cp%d" i))
- windows (intern (format "windows-%d" i))))
- (unless (mm-coding-system-p windows)
- (if (mm-coding-system-p cp)
- (add-to-list 'mm-charset-synonym-alist (cons windows cp))
- (add-to-list 'mm-charset-synonym-alist (cons windows iso)))))))
-
-(defun mm-setup-codepage-ibm (&optional list)
- "Add appropriate entries to `mm-charset-synonym-alist'.
-Unless LIST is given, `mm-codepage-ibm-list' is used."
- (unless list
- (setq list mm-codepage-ibm-list))
- (dolist (number list)
- (let ((ibm (intern (format "ibm%d" number)))
- (cp (intern (format "cp%d" number))))
- (when (and (not (mm-coding-system-p ibm))
- (mm-coding-system-p cp))
- (add-to-list 'mm-charset-synonym-alist (cons ibm cp))))))
-
-;; Initialize:
-(mm-setup-codepage-iso-8859)
-(mm-setup-codepage-ibm)
+ "A mapping from unknown or invalid charset names to the real charset names.")
;; Note: this has to be defined before `mm-charset-to-coding-system'.
-(defcustom mm-charset-eval-alist
- '(
- ;; Emacs 22 provides autoloads for 1250-1258
- ;; (i.e. `mm-codepage-setup' does nothing).
- (windows-1250 . (mm-codepage-setup 1250 t))
- (windows-1251 . (mm-codepage-setup 1251 t))
- (windows-1253 . (mm-codepage-setup 1253 t))
- (windows-1257 . (mm-codepage-setup 1257 t)))
+(defcustom mm-charset-eval-alist nil
"An alist of (CHARSET . FORM) pairs.
If an article is encoded in an unknown CHARSET, FORM is
evaluated. This allows the loading of additional libraries
providing charsets on demand. If supported by your Emacs
version, you could use `autoload-coding-system' here."
:version "22.1" ;; Gnus 5.10.9
- :type '(list (set :inline t
- (const (windows-1250 . (mm-codepage-setup 1250 t)))
- (const (windows-1251 . (mm-codepage-setup 1251 t)))
- (const (windows-1253 . (mm-codepage-setup 1253 t)))
- (const (windows-1257 . (mm-codepage-setup 1257 t)))
- (const (cp850 . (mm-codepage-setup 850 nil))))
- (repeat :inline t
+ :type '(list (repeat :inline t
:tag "Other options"
(cons (symbol :tag "charset")
(symbol :tag "form"))))
;; Fixme: some of the cars here aren't valid MIME charsets. That
;; should only matter with XEmacs, though.
(defvar mm-mime-mule-charset-alist
- `((us-ascii ascii)
+ '((us-ascii ascii)
(iso-8859-1 latin-iso8859-1)
(iso-8859-2 latin-iso8859-2)
(iso-8859-3 latin-iso8859-3)
(iso-2022-jp-3 latin-jisx0201 japanese-jisx0208-1978 japanese-jisx0208
japanese-jisx0213-1 japanese-jisx0213-2)
(shift_jis latin-jisx0201 katakana-jisx0201 japanese-jisx0208)
- ,(cond ((fboundp 'unicode-precedence-list)
- (cons 'utf-8 (delq 'ascii (mapcar 'charset-name
- (unicode-precedence-list)))))
- ((or (not (fboundp 'charsetp)) ;; non-Mule case
- (charsetp 'unicode-a)
- (not (mm-coding-system-p 'mule-utf-8)))
- '(utf-8 unicode-a unicode-b unicode-c unicode-d unicode-e))
- (t ;; If we have utf-8 we're in Mule 5+.
- (append '(utf-8)
- (delete 'ascii
- (coding-system-get 'mule-utf-8 'safe-charsets))))))
+ (utf-8))
"Alist of MIME-charset/MULE-charsets.")
;; Correct by construction, but should be unnecessary for Emacs:
"A table of the difference character between ISO-8859-X and ISO-8859-15.")
(defcustom mm-coding-system-priorities
- (let ((lang (if (boundp 'current-language-environment)
- (symbol-value 'current-language-environment))))
- (cond (;; XEmacs without Mule but with `file-coding'.
- (not lang) nil)
- ;; In XEmacs 21.5 it may be the one like "Japanese (UTF-8)".
- ((string-match "\\`Japanese" lang)
- ;; Japanese users prefer iso-2022-jp to others usually used
- ;; for `buffer-file-coding-system', however iso-8859-1 should
- ;; be used when there are only ASCII and Latin-1 characters.
- '(iso-8859-1 iso-2022-jp utf-8))))
+ (and (string-match "\\`Japanese" current-language-environment)
+ ;; Japanese users prefer iso-2022-jp to others usually used
+ ;; for `buffer-file-coding-system', however iso-8859-1 should
+ ;; be used when there are only ASCII and Latin-1 characters.
+ '(iso-8859-1 iso-2022-jp utf-8))
"Preferred coding systems for encoding outgoing messages.
More than one suitable coding system may be found for some text.
:group 'mime)
;; ??
-(defvar mm-use-find-coding-systems-region
- (fboundp 'find-coding-systems-region)
+(defvar mm-use-find-coding-systems-region t
"Use `find-coding-systems-region' to find proper coding systems.
Setting it to nil is useful on Emacsen supporting Unicode if sending
(defun mm-mule-charset-to-mime-charset (charset)
"Return the MIME charset corresponding to the given Mule CHARSET."
- (if (and (fboundp 'find-coding-systems-for-charsets)
- (fboundp 'sort-coding-systems))
- (let ((css (sort (sort-coding-systems
- (find-coding-systems-for-charsets (list charset)))
- 'mm-sort-coding-systems-predicate))
- cs mime)
- (while (and (not mime)
- css)
- (when (setq cs (pop css))
- (setq mime (or (coding-system-get cs :mime-charset)
- (coding-system-get cs 'mime-charset)))))
- mime)
- (let ((alist (mapcar (lambda (cs)
- (assq cs mm-mime-mule-charset-alist))
- (sort (mapcar 'car mm-mime-mule-charset-alist)
- 'mm-sort-coding-systems-predicate)))
- out)
- (while alist
- (when (memq charset (cdar alist))
- (setq out (caar alist)
- alist nil))
- (pop alist))
- out)))
+ (let ((css (sort (sort-coding-systems
+ (find-coding-systems-for-charsets (list charset)))
+ 'mm-sort-coding-systems-predicate))
+ cs mime)
+ (while (and (not mime)
+ css)
+ (when (setq cs (pop css))
+ (setq mime (or (coding-system-get cs :mime-charset)
+ (coding-system-get cs 'mime-charset)))))
+ mime))
(defun mm-enable-multibyte ()
"Set the multibyte flag of the current buffer.
mail-parse-mule-charset ;; cached mule-charset
(progn
(setq mail-parse-mule-charset
- (and (boundp 'current-language-environment)
- (car (last
+ (and (car (last
(assq 'charset
(assoc current-language-environment
language-info-alist))))))
(defun mm-charset-after (&optional pos)
"Return charset of a character in current buffer at position POS.
If POS is nil, it defaults to the current point.
-If POS is out of range, the value is nil.
-If the charset is `composition', return the actual one."
+If POS is out of range, the value is nil."
(let ((char (char-after pos)) charset)
(if (< char 128)
(setq charset 'ascii)
- ;; charset-after is fake in some Emacsen.
- (setq charset (and (fboundp 'char-charset) (char-charset char)))
- (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
- eight-bit-graphic))))
- charset
- (mm-guess-charset))))))
+ (setq charset (char-charset char))
+ (if (and charset (not (memq charset '(ascii eight-bit-control
+ eight-bit-graphic))))
+ charset
+ (mm-guess-charset)))))
(defun mm-mime-charset (charset)
"Return the MIME charset corresponding to the given Mule CHARSET."
- (if (eq charset 'unknown)
- (error "The message contains non-printable characters, please use attachment"))
- (if (and (fboundp 'coding-system-get) (fboundp 'get-charset-property))
- (or
- (and (mm-preferred-coding-system charset)
- (or (coding-system-get
- (mm-preferred-coding-system charset) :mime-charset)
- (coding-system-get
- (mm-preferred-coding-system charset) 'mime-charset)))
- (and (eq charset 'ascii)
- 'us-ascii)
- (mm-preferred-coding-system charset)
- (mm-mule-charset-to-mime-charset charset))
- ;; This is for XEmacs.
- (mm-mule-charset-to-mime-charset charset)))
+ (when (eq charset 'unknown)
+ (error "The message contains non-printable characters, please use attachment"))
+ (or
+ (and (mm-preferred-coding-system charset)
+ (coding-system-get (mm-preferred-coding-system charset) 'mime-charset))
+ (and (eq charset 'ascii)
+ 'us-ascii)
+ (mm-preferred-coding-system charset)
+ (mm-mule-charset-to-mime-charset charset)))
;; Fixme: This is used in places when it should be testing the
;; default multibyteness.
enable-multibyte-characters)
(defun mm-iso-8859-x-to-15-region (&optional b e)
- (if (fboundp 'char-charset)
- (let (charset item c inconvertible)
- (save-restriction
- (if e (narrow-to-region b e))
- (goto-char (point-min))
- (skip-chars-forward "\0-\177")
- (while (not (eobp))
- (cond
- ((not (setq item (assq (char-charset (setq c (char-after)))
- mm-iso-8859-x-to-15-table)))
- (forward-char))
- ((memq c (cdr (cdr item)))
- (setq inconvertible t)
- (forward-char))
- (t
- (insert-before-markers (prog1 (+ c (car (cdr item)))
- (delete-char 1)))))
- (skip-chars-forward "\0-\177")))
- (not inconvertible))))
+ (let (charset item c inconvertible)
+ (save-restriction
+ (if e (narrow-to-region b e))
+ (goto-char (point-min))
+ (skip-chars-forward "\0-\177")
+ (while (not (eobp))
+ (cond
+ ((not (setq item (assq (char-charset (setq c (char-after)))
+ mm-iso-8859-x-to-15-table)))
+ (forward-char))
+ ((memq c (cdr (cdr item)))
+ (setq inconvertible t)
+ (forward-char))
+ (t
+ (insert-before-markers (prog1 (+ c (car (cdr item)))
+ (delete-char 1)))))
+ (skip-chars-forward "\0-\177")))
+ (not inconvertible)))
(defun mm-sort-coding-systems-predicate (a b)
(let ((priorities
(defun mm-find-charset-region (b e)
"Return a list of Emacs charsets in the region B to E."
(cond
- ((and (mm-multibyte-p)
- (fboundp 'find-charset-region))
+ ((mm-multibyte-p)
;; Remove composition since the base charsets have been included.
;; Remove eight-bit-*, treat them as ascii.
(let ((css (find-charset-region b e)))
- (dolist (cs
- '(composition eight-bit-control eight-bit-graphic control-1)
- css)
- (setq css (delq cs css)))))
+ (dolist (cs '(composition eight-bit-control eight-bit-graphic control-1))
+ (setq css (delq cs css)))
+ css))
(t
;; We are in a unibyte buffer, so we futz around a bit.
(save-excursion
(if (eobp)
'(ascii)
(let (charset)
- (setq charset
- (and (boundp 'current-language-environment)
- (car (last (assq 'charset
- (assoc current-language-environment
- language-info-alist))))))
+ (setq charset (car (last (assq 'charset
+ (assoc current-language-environment
+ language-info-alist)))))
(if (eq charset 'ascii) (setq charset nil))
(or charset
(setq charset
"Like `insert-file-contents', but only reads in the file.
A buffer may be modified in several ways after reading into the buffer due
to advanced Emacs features, such as file-name-handlers, format decoding,
-`find-file-hooks', etc.
+`find-file-hook', etc.
If INHIBIT is non-nil, inhibit `mm-inhibit-file-name-handlers'.
- This function ensures that none of these modifications will take place."
+This function ensures that none of these modifications will take place."
(letf* ((format-alist nil)
(auto-mode-alist (if inhibit nil (mm-auto-mode-alist)))
((default-value 'major-mode) 'fundamental-mode)
(append mm-inhibit-file-name-handlers
inhibit-file-name-handlers)
inhibit-file-name-handlers))
- (ffh (if (boundp 'find-file-hook)
- 'find-file-hook
- 'find-file-hooks))
- (val (symbol-value ffh)))
- (set ffh nil)
- (unwind-protect
- (insert-file-contents filename visit beg end replace)
- (set ffh val))))
+ (find-file-hook nil))
+ (insert-file-contents filename visit beg end replace)))
(defun mm-append-to-file (start end filename &optional codesys inhibit)
"Append the contents of the region to the end of file FILENAME.
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 ((coding-systems
- (detect-coding-region start end)))
- (or (car-safe coding-systems)
- coding-systems)))
- (defun mm-detect-coding-region (start end)
- (let ((point (point)))
- (goto-char start)
- (skip-chars-forward "\0-\177" end)
- (prog1
- (if (eq (point) end) 'ascii (mm-guess-charset))
- (goto-char point)))))
+(defun mm-detect-coding-region (start end)
+ "Like `detect-coding-region' except returning the best one."
+ (let ((coding-systems (detect-coding-region start end)))
+ (or (car-safe coding-systems)
+ coding-systems)))
(declare-function mm-detect-coding-region "mm-util" (start end))
-(if (fboundp 'coding-system-get)
- (defun mm-detect-mime-charset-region (start end)
- "Detect MIME charset of the text in the region between START and END."
- (let ((cs (mm-detect-coding-region start end)))
- (or (coding-system-get cs :mime-charset)
- (coding-system-get cs 'mime-charset))))
- (defun mm-detect-mime-charset-region (start end)
- "Detect MIME charset of the text in the region between START and END."
- (let ((cs (mm-detect-coding-region start end)))
- cs)))
+(defun mm-detect-mime-charset-region (start end)
+ "Detect MIME charset of the text in the region between START and END."
+ (let ((cs (mm-detect-coding-region start end)))
+ (coding-system-get cs 'mime-charset)))
(defun mm-coding-system-to-mime-charset (coding-system)
"Return the MIME charset corresponding to CODING-SYSTEM."
- (when coding-system
- (or (coding-system-get coding-system :mime-charset)
- (coding-system-get coding-system 'mime-charset))))
+ (and coding-system
+ (coding-system-get coding-system 'mime-charset)))
(defvar jka-compr-acceptable-retval-list)
(declare-function jka-compr-make-temp-name "jka-compr" (&optional local))
(message "%s" (or err-msg (concat msg "done")))
retval)))))
-(eval-when-compile
- (unless (fboundp 'coding-system-name)
- (defalias 'coding-system-name 'ignore))
- (unless (fboundp 'find-file-coding-system-for-read-from-filename)
- (defalias 'find-file-coding-system-for-read-from-filename 'ignore))
- (unless (fboundp 'find-operation-coding-system)
- (defalias 'find-operation-coding-system 'ignore)))
-
(defun mm-find-buffer-file-coding-system (&optional filename)
"Find coding system used to decode the contents of the current buffer.
This function looks for the coding system magic cookie or examines the