;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; 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, or (at your option)
-;; any later version.
+;; 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
+;; 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; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
(defvar mm-mime-mule-charset-alist )
+;; 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)
(if (fboundp (car elem))
(defalias nfunc (car elem))
(defalias nfunc (cdr elem)))))
- '((coding-system-list . ignore)
+ `(;; `coding-system-list' is not available in XEmacs 21.4 built
+ ;; without the `file-coding' feature.
+ (coding-system-list . ignore)
+ ;; `char-int' is an XEmacs function, not available in Emacs.
(char-int . identity)
+ ;; `coding-system-equal' is an Emacs function, not available in XEmacs.
(coding-system-equal . equal)
+ ;; `annotationp' is an XEmacs function, not available in Emacs.
(annotationp . ignore)
+ ;; `set-buffer-file-coding-system' is not available in XEmacs 21.4
+ ;; built without the `file-coding' feature.
(set-buffer-file-coding-system . ignore)
+ ;; `read-charset' is an Emacs function, not available in XEmacs.
(read-charset
- . (lambda (prompt)
- "Return a charset."
- (intern
- (completing-read
- prompt
- (mapcar (lambda (e) (list (symbol-name (car e))))
- mm-mime-mule-charset-alist)
- nil t))))
+ . ,(lambda (prompt)
+ "Return a charset."
+ (intern
+ (completing-read
+ prompt
+ (mapcar (lambda (e) (list (symbol-name (car e))))
+ mm-mime-mule-charset-alist)
+ nil t))))
+ ;; `subst-char-in-string' is not available in XEmacs 21.4.
(subst-char-in-string
- . (lambda (from to string &optional inplace)
- ;; stolen (and renamed) from nnheader.el
- "Replace characters in STRING from FROM to TO.
+ . ,(lambda (from to string &optional inplace)
+ ;; stolen (and renamed) from nnheader.el
+ "Replace characters in STRING from FROM to TO.
Unless optional argument INPLACE is non-nil, return a new string."
- (let ((string (if inplace string (copy-sequence 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)))
+ (let ((string (if inplace string (copy-sequence 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)))
+ ;; `replace-in-string' is an XEmacs function, not available in Emacs.
(replace-in-string
- . (lambda (string regexp rep &optional literal)
- "See `replace-regexp-in-string', only the order of args differs."
- (replace-regexp-in-string regexp rep string nil literal)))
+ . ,(lambda (string regexp rep &optional literal)
+ "See `replace-regexp-in-string', only the order of args differs."
+ (replace-regexp-in-string regexp rep string nil literal)))
+ ;; `string-as-unibyte' is an Emacs function, not available in XEmacs.
(string-as-unibyte . identity)
+ ;; `string-make-unibyte' is an Emacs function, not available in XEmacs.
(string-make-unibyte . identity)
;; string-as-multibyte often doesn't really do what you think it does.
;; Example:
;; (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)
+ ;; `multibyte-string-p' is an Emacs function, not available in XEmacs.
(multibyte-string-p . ignore)
+ ;; `insert-byte' is available only in Emacs 23.1 or greater.
(insert-byte . insert-char)
+ ;; `multibyte-char-to-unibyte' is an Emacs function, not available
+ ;; in XEmacs.
(multibyte-char-to-unibyte . identity)
+ ;; `set-buffer-multibyte' is an Emacs function, not available in XEmacs.
+ (set-buffer-multibyte . ignore)
+ ;; `special-display-p' is an Emacs function, not available in XEmacs.
(special-display-p
- . (lambda (buffer-name)
- "Returns non-nil if a buffer named BUFFER-NAME gets a special frame."
- (and special-display-function
- (or (and (member buffer-name special-display-buffer-names) t)
- (cdr (assoc buffer-name special-display-buffer-names))
- (catch 'return
- (dolist (elem special-display-regexps)
- (and (stringp elem)
- (string-match elem buffer-name)
- (throw 'return t))
- (and (consp elem)
- (stringp (car elem))
- (string-match (car elem) buffer-name)
- (throw 'return (cdr elem))))))))))))
-
+ . ,(lambda (buffer-name)
+ "Returns non-nil if a buffer named BUFFER-NAME gets a special frame."
+ (and special-display-function
+ (or (and (member buffer-name special-display-buffer-names) t)
+ (cdr (assoc buffer-name special-display-buffer-names))
+ (catch 'return
+ (dolist (elem special-display-regexps)
+ (and (stringp elem)
+ (string-match elem buffer-name)
+ (throw 'return t))
+ (and (consp elem)
+ (stringp (car elem))
+ (string-match (car elem) buffer-name)
+ (throw 'return (cdr elem)))))))))
+ ;; `substring-no-properties' is available only in Emacs 22.1 or greater.
+ (substring-no-properties
+ . ,(lambda (string &optional from to)
+ "Return a substring of STRING, without text properties.
+It starts at index FROM and ending before TO.
+TO may be nil or omitted; then the substring runs to the end of STRING.
+If FROM is nil or omitted, the substring starts at the beginning of STRING.
+If FROM or TO is negative, it counts from the end.
+
+With one argument, just copy STRING without its properties."
+ (setq string (substring string (or from 0) to))
+ (set-text-properties 0 (length string) nil string)
+ string)))))
+
+;; `decode-coding-string', `encode-coding-string', `decode-coding-region'
+;; and `encode-coding-region' are available in Emacs and XEmacs built with
+;; the `file-coding' feature, but the XEmacs versions treat nil, that is
+;; given as the `coding-system' argument, as the `binary' coding system.
(eval-and-compile
(if (featurep 'xemacs)
(if (featurep 'file-coding)
- ;; Don't modify string if CODING-SYSTEM is nil.
(progn
(defun mm-decode-coding-string (str coding-system)
(if coding-system
(defalias 'mm-decode-coding-region 'decode-coding-region)
(defalias 'mm-encode-coding-region 'encode-coding-region)))
+;; `string-to-multibyte' is available only in Emacs 22.1 or greater.
(defalias 'mm-string-to-multibyte
(cond
((featurep 'xemacs)
'string-to-multibyte)
(t
(lambda (string)
- "Return a multibyte string with the same individual chars as string."
+ "Return a multibyte string with the same individual chars as STRING."
(mapconcat
(lambda (ch) (mm-string-as-multibyte (char-to-string ch)))
string "")))))
+;; `char-or-char-int-p' is an XEmacs function, not available in Emacs.
(eval-and-compile
(defalias 'mm-char-or-char-int-p
(cond
the alias. Else windows-NUMBER is used."
(interactive
(let ((completion-ignore-case t)
- (candidates (cp-supported-codepages)))
+ (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 (completing-read "Setup DOS Codepage: (default 437) " candidates
nil t nil nil "437"))))
(when alias
(intern (format "windows-%s" number)))))
(let* ((cp (intern (format "cp%s" number))))
(unless (mm-coding-system-p cp)
- (codepage-setup number))
+ (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))
,@(when (and (not (mm-coding-system-p 'gbk))
(mm-coding-system-p 'cp936))
'((gbk . cp936)))
+ ;; UTF8 is a bogus name for UTF-8
+ ,@(when (and (not (mm-coding-system-p 'utf8))
+ (mm-coding-system-p 'utf-8))
+ '((utf8 . utf-8)))
;; ISO8859-1 is a bogus name for ISO-8859-1
,@(when (and (not (mm-coding-system-p 'iso8859-1))
(mm-coding-system-p 'iso-8859-1))
'((iso8859-1 . iso-8859-1)))
+ ;; ISO_8859-1 is a bogus name for ISO-8859-1
+ ,@(when (and (not (mm-coding-system-p 'iso_8859-1))
+ (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.
(mm-setup-codepage-iso-8859)
(mm-setup-codepage-ibm)
-(defcustom mm-charset-override-alist
- '((iso-8859-1 . windows-1252)
- (iso-8859-8 . windows-1255)
- (iso-8859-9 . windows-1254))
- "A mapping from undesired charset names to their replacement.
-
-You may add pairs like (iso-8859-1 . windows-1252) here,
-i.e. treat iso-8859-1 as windows-1252. windows-1252 is a
-superset of iso-8859-1."
- :type '(list (set :inline t
- (const (iso-8859-1 . windows-1252))
- (const (iso-8859-8 . windows-1255))
- (const (iso-8859-9 . windows-1254))
- (const (undecided . windows-1252)))
- (repeat :inline t
- :tag "Other options"
- (cons (symbol :tag "From charset")
- (symbol :tag "To charset"))))
- :version "22.1" ;; Gnus 5.10.9
- :group 'mime)
-
+;; Note: this has to be defined before `mm-charset-to-coding-system'.
(defcustom mm-charset-eval-alist
(if (featurep 'xemacs)
nil ;; I don't know what would be useful for XEmacs.
:group 'mime)
(put 'mm-charset-eval-alist 'risky-local-variable t)
+(defvar mm-charset-override-alist)
+
+;; Note: this function has to be defined before `mm-charset-override-alist'
+;; since it will use this function in order to determine its default value
+;; when loading mm-util.elc.
+(defun mm-charset-to-coding-system (charset &optional lbt
+ allow-override silent)
+ "Return coding-system corresponding to CHARSET.
+CHARSET is a symbol naming a MIME charset.
+If optional argument LBT (`unix', `dos' or `mac') is specified, it is
+used as the line break code type of the coding system.
+
+If ALLOW-OVERRIDE is given, use `mm-charset-override-alist' to
+map undesired charset names to their replacement. This should
+only be used for decoding, not for encoding.
+
+A non-nil value of SILENT means don't issue a warning even if CHARSET
+is not available."
+ ;; OVERRIDE is used (only) in `mm-decode-body' and `mm-decode-string'.
+ (when (stringp charset)
+ (setq charset (intern (downcase charset))))
+ (when lbt
+ (setq charset (intern (format "%s-%s" charset lbt))))
+ (cond
+ ((null charset)
+ charset)
+ ;; Running in a non-MULE environment.
+ ((or (null (mm-get-coding-system-list))
+ (not (fboundp 'coding-system-get)))
+ charset)
+ ;; Check override list quite early. Should only used for decoding, not for
+ ;; encoding!
+ ((and allow-override
+ (let ((cs (cdr (assq charset mm-charset-override-alist))))
+ (and cs (mm-coding-system-p cs) cs))))
+ ;; ascii
+ ((eq charset 'us-ascii)
+ 'ascii)
+ ;; Check to see whether we can handle this charset. (This depends
+ ;; on there being some coding system matching each `mime-charset'
+ ;; property defined, as there should be.)
+ ((and (mm-coding-system-p charset)
+;;; Doing this would potentially weed out incorrect charsets.
+;;; charset
+;;; (eq charset (coding-system-get charset 'mime-charset))
+ )
+ charset)
+ ;; Eval expressions from `mm-charset-eval-alist'
+ ((let* ((el (assq charset mm-charset-eval-alist))
+ (cs (car el))
+ (form (cdr el)))
+ (and cs
+ form
+ (prog2
+ ;; Avoid errors...
+ (condition-case nil (eval form) (error nil))
+ ;; (message "Failed to eval `%s'" form))
+ (mm-coding-system-p cs)
+ (message "Added charset `%s' via `mm-charset-eval-alist'" cs))
+ cs)))
+ ;; Translate invalid charsets.
+ ((let ((cs (cdr (assq charset mm-charset-synonym-alist))))
+ (and cs
+ (mm-coding-system-p cs)
+ ;; (message
+ ;; "Using synonym `%s' from `mm-charset-synonym-alist' for `%s'"
+ ;; cs charset)
+ cs)))
+ ;; Last resort: search the coding system list for entries which
+ ;; have the right mime-charset in case the canonical name isn't
+ ;; defined (though it should be).
+ ((let (cs)
+ ;; mm-get-coding-system-list returns a list of cs without lbt.
+ ;; Do we need -lbt?
+ (dolist (c (mm-get-coding-system-list))
+ (if (and (null cs)
+ (eq charset (or (coding-system-get c :mime-charset)
+ (coding-system-get c 'mime-charset))))
+ (setq cs c)))
+ (unless (or silent cs)
+ ;; Warn the user about unknown charset:
+ (if (fboundp 'gnus-message)
+ (gnus-message 7 "Unknown charset: %s" charset)
+ (message "Unknown charset: %s" charset)))
+ cs))))
+
+;; Note: `mm-charset-to-coding-system' has to be defined before this.
+(defcustom mm-charset-override-alist
+ ;; Note: pairs that cannot be used in the Emacs version currently running
+ ;; will be removed.
+ '((gb2312 . gbk)
+ (iso-8859-1 . windows-1252)
+ (iso-8859-8 . windows-1255)
+ (iso-8859-9 . windows-1254))
+ "A mapping from undesired charset names to their replacement.
+
+You may add pairs like (iso-8859-1 . windows-1252) here,
+i.e. treat iso-8859-1 as windows-1252. windows-1252 is a
+superset of iso-8859-1."
+ :type
+ '(list
+ :convert-widget
+ (lambda (widget)
+ (let ((defaults
+ (delq nil
+ (mapcar (lambda (pair)
+ (if (mm-charset-to-coding-system (cdr pair)
+ nil nil t)
+ pair))
+ '((gb2312 . gbk)
+ (iso-8859-1 . windows-1252)
+ (iso-8859-8 . windows-1255)
+ (iso-8859-9 . windows-1254)
+ (undecided . windows-1252)))))
+ (val (copy-sequence (default-value 'mm-charset-override-alist)))
+ pair rest)
+ (while val
+ (push (if (and (prog1
+ (setq pair (assq (caar val) defaults))
+ (setq defaults (delq pair defaults)))
+ (equal (car val) pair))
+ `(const ,pair)
+ `(cons :format "%v"
+ (const :format "(%v" ,(caar val))
+ (symbol :size 3 :format " . %v)\n" ,(cdar val))))
+ rest)
+ (setq val (cdr val)))
+ (while defaults
+ (push `(const ,(pop defaults)) rest))
+ (widget-convert
+ 'list
+ `(set :inline t :format "%v" ,@(nreverse rest))
+ `(repeat :inline t :tag "Other options"
+ (cons :format "%v"
+ (symbol :size 3 :format "(%v")
+ (symbol :size 3 :format " . %v)\n")))))))
+ ;; Remove pairs that cannot be used in the Emacs version currently
+ ;; running. Note that this section will be evaluated when loading
+ ;; mm-util.elc.
+ :set (lambda (symbol value)
+ (custom-set-default
+ symbol (delq nil
+ (mapcar (lambda (pair)
+ (if (mm-charset-to-coding-system (cdr pair)
+ nil nil t)
+ pair))
+ value))))
+ :version "22.1" ;; Gnus 5.10.9
+ :group 'mime)
+
(defvar mm-binary-coding-system
(cond
((mm-coding-system-p 'binary) 'binary)
(pop alist))
out)))
-(defun mm-charset-to-coding-system (charset &optional lbt
- allow-override)
- "Return coding-system corresponding to CHARSET.
-CHARSET is a symbol naming a MIME charset.
-If optional argument LBT (`unix', `dos' or `mac') is specified, it is
-used as the line break code type of the coding system.
-
-If ALLOW-OVERRIDE is given, use `mm-charset-override-alist' to
-map undesired charset names to their replacement. This should
-only be used for decoding, not for encoding."
- ;; OVERRIDE is used (only) in `mm-decode-body' and `mm-decode-string'.
- (when (stringp charset)
- (setq charset (intern (downcase charset))))
- (when lbt
- (setq charset (intern (format "%s-%s" charset lbt))))
- (cond
- ((null charset)
- charset)
- ;; Running in a non-MULE environment.
- ((or (null (mm-get-coding-system-list))
- (not (fboundp 'coding-system-get)))
- charset)
- ;; Check override list quite early. Should only used for decoding, not for
- ;; encoding!
- ((and allow-override
- (let ((cs (cdr (assq charset mm-charset-override-alist))))
- (and cs (mm-coding-system-p cs) cs))))
- ;; ascii
- ((eq charset 'us-ascii)
- 'ascii)
- ;; Check to see whether we can handle this charset. (This depends
- ;; on there being some coding system matching each `mime-charset'
- ;; property defined, as there should be.)
- ((and (mm-coding-system-p charset)
-;;; Doing this would potentially weed out incorrect charsets.
-;;; charset
-;;; (eq charset (coding-system-get charset 'mime-charset))
- )
- charset)
- ;; Eval expressions from `mm-charset-eval-alist'
- ((let* ((el (assq charset mm-charset-eval-alist))
- (cs (car el))
- (form (cdr el)))
- (and cs
- form
- (prog2
- ;; Avoid errors...
- (condition-case nil (eval form) (error nil))
- ;; (message "Failed to eval `%s'" form))
- (mm-coding-system-p cs)
- (message "Added charset `%s' via `mm-charset-eval-alist'" cs))
- cs)))
- ;; Translate invalid charsets.
- ((let ((cs (cdr (assq charset mm-charset-synonym-alist))))
- (and cs
- (mm-coding-system-p cs)
- ;; (message
- ;; "Using synonym `%s' from `mm-charset-synonym-alist' for `%s'"
- ;; cs charset)
- cs)))
- ;; Last resort: search the coding system list for entries which
- ;; have the right mime-charset in case the canonical name isn't
- ;; defined (though it should be).
- ((let (cs)
- ;; mm-get-coding-system-list returns a list of cs without lbt.
- ;; Do we need -lbt?
- (dolist (c (mm-get-coding-system-list))
- (if (and (null cs)
- (eq charset (or (coding-system-get c :mime-charset)
- (coding-system-get c 'mime-charset))))
- (setq cs c)))
- (unless cs
- ;; Warn the user about unknown charset:
- (if (fboundp 'gnus-message)
- (gnus-message 7 "Unknown charset: %s" charset)
- (message "Unknown charset: %s" charset)))
- cs))))
-
(eval-and-compile
(defvar mm-emacs-mule (and (not (featurep 'xemacs))
(boundp 'default-enable-multibyte-characters)
(defmacro mm-with-unibyte-buffer (&rest forms)
"Create a temporary buffer, and evaluate FORMS there like `progn'.
Use unibyte mode for this."
- `(let (default-enable-multibyte-characters)
- (with-temp-buffer ,@forms)))
+ `(with-temp-buffer
+ (mm-disable-multibyte)
+ ,@forms))
(put 'mm-with-unibyte-buffer 'lisp-indent-function 0)
(put 'mm-with-unibyte-buffer 'edebug-form-spec '(body))
(defmacro mm-with-multibyte-buffer (&rest forms)
"Create a temporary buffer, and evaluate FORMS there like `progn'.
Use multibyte mode for this."
- `(let ((default-enable-multibyte-characters t))
- (with-temp-buffer ,@forms)))
+ `(with-temp-buffer
+ (mm-enable-multibyte)
+ ,@forms))
(put 'mm-with-multibyte-buffer 'lisp-indent-function 0)
(put 'mm-with-multibyte-buffer 'edebug-form-spec '(body))
(put 'mm-with-unibyte-current-buffer 'lisp-indent-function 0)
(put 'mm-with-unibyte-current-buffer '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)
- ,@forms))
-(put 'mm-with-unibyte 'lisp-indent-function 0)
-(put 'mm-with-unibyte 'edebug-form-spec '(body))
-
-(defmacro mm-with-multibyte (&rest forms)
- "Eval the FORMS with the default value of `enable-multibyte-characters' t."
- `(let ((default-enable-multibyte-characters t))
- ,@forms))
-(put 'mm-with-multibyte 'lisp-indent-function 0)
-(put 'mm-with-multibyte 'edebug-form-spec '(body))
-
(defun mm-find-charset-region (b e)
"Return a list of Emacs charsets in the region B to E."
(cond