X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fmm-util.el;h=e9119284a04f23e9cb51f6392a9f12e37e7b379b;hp=65543d11bb55024c4beb98f8ffab72dd98c55e2b;hb=55c26cf1a9939dc7b28fcbab35f1d05d56d53242;hpb=a07fef39c45c3c3c77cafef422daca2460f34882 diff --git a/lisp/mm-util.el b/lisp/mm-util.el index 65543d11b..e9119284a 100644 --- a/lisp/mm-util.el +++ b/lisp/mm-util.el @@ -1,7 +1,6 @@ ;;; mm-util.el --- Utility functions for Mule and low level things -;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, -;; 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1998-2012 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; MORIOKA Tomohiko @@ -24,7 +23,7 @@ ;;; Code: -;; For Emacs < 22.2. +;; For Emacs <22.2 and XEmacs. (eval-and-compile (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) @@ -39,6 +38,10 @@ (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 @@ -202,19 +205,10 @@ to the contents of the accessible portion of the buffer." (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) - 'identity) - ((fboundp 'string-to-multibyte) - 'string-to-multibyte) - (t - (lambda (string) - "Return a multibyte string with the same individual chars as STRING." - (mapconcat - (lambda (ch) (mm-string-as-multibyte (char-to-string ch))) - string ""))))) +;; `string-to-multibyte' is available only in Emacs. +(defalias 'mm-string-to-multibyte (if (featurep 'xemacs) + 'identity + 'string-to-multibyte)) ;; `char-or-char-int-p' is an XEmacs function, not available in Emacs. (eval-and-compile @@ -225,42 +219,43 @@ to the contents of the accessible portion of the buffer." (t 'identity)))) ;; `ucs-to-char' is a function that Mule-UCS provides. -(if (featurep 'xemacs) - (cond ((and (fboundp 'unicode-to-char) ;; XEmacs 21.5. - (subrp (symbol-function 'unicode-to-char))) - (if (featurep 'mule) - (defalias 'mm-ucs-to-char 'unicode-to-char) +(eval-and-compile + (if (featurep 'xemacs) + (cond ((and (fboundp 'unicode-to-char) ;; XEmacs 21.5. + (subrp (symbol-function 'unicode-to-char))) + (if (featurep 'mule) + (defalias 'mm-ucs-to-char 'unicode-to-char) + (defun mm-ucs-to-char (codepoint) + "Convert Unicode codepoint to character." + (or (unicode-to-char codepoint) ?#)))) + ((featurep 'mule) + (defun mm-ucs-to-char (codepoint) + "Convert Unicode codepoint to character." + (if (fboundp 'ucs-to-char) ;; Mule-UCS is loaded. + (progn + (defalias 'mm-ucs-to-char + (lambda (codepoint) + "Convert Unicode codepoint to character." + (condition-case nil + (or (ucs-to-char codepoint) ?#) + (error ?#)))) + (mm-ucs-to-char codepoint)) + (condition-case nil + (or (int-to-char codepoint) ?#) + (error ?#))))) + (t (defun mm-ucs-to-char (codepoint) "Convert Unicode codepoint to character." - (or (unicode-to-char codepoint) ?#)))) - ((featurep 'mule) - (defun mm-ucs-to-char (codepoint) - "Convert Unicode codepoint to character." - (if (fboundp 'ucs-to-char) ;; Mule-UCS is loaded. - (progn - (defalias 'mm-ucs-to-char - (lambda (codepoint) - "Convert Unicode codepoint to character." - (condition-case nil - (or (ucs-to-char codepoint) ?#) - (error ?#)))) - (mm-ucs-to-char codepoint)) (condition-case nil (or (int-to-char codepoint) ?#) (error ?#))))) - (t - (defun mm-ucs-to-char (codepoint) - "Convert Unicode codepoint to character." - (condition-case nil - (or (int-to-char codepoint) ?#) - (error ?#))))) - (if (let ((char (make-char 'japanese-jisx0208 36 34))) - (eq char (decode-char 'ucs char))) - ;; Emacs 23. - (defalias 'mm-ucs-to-char 'identity) - (defun mm-ucs-to-char (codepoint) - "Convert Unicode codepoint to character." - (or (decode-char 'ucs codepoint) ?#)))) + (if (let ((char (make-char 'japanese-jisx0208 36 34))) + (eq char (decode-char 'ucs char))) + ;; Emacs 23. + (defalias 'mm-ucs-to-char 'identity) + (defun mm-ucs-to-char (codepoint) + "Convert Unicode codepoint to character." + (or (decode-char 'ucs codepoint) ?#))))) ;; Fixme: This seems always to be used to read a MIME charset, so it ;; should be re-named and fixed (in Emacs) to offer completion only on @@ -272,18 +267,19 @@ to the contents of the accessible portion of the buffer." ;; Actually, there should be an `mm-coding-system-mime-charset'. (eval-and-compile (defalias 'mm-read-coding-system - (cond - ((fboundp 'read-coding-system) - (if (and (featurep 'xemacs) - (<= (string-to-number emacs-version) 21.1)) - (lambda (prompt &optional default-coding-system) - (read-coding-system prompt)) - 'read-coding-system)) - (t (lambda (prompt &optional default-coding-system) - "Prompt the user for a coding system." - (gnus-completing-read - prompt (mapcar (lambda (s) (symbol-name (car s))) - mm-mime-mule-charset-alist))))))) + (if (featurep 'emacs) 'read-coding-system + (cond + ((fboundp 'read-coding-system) + (if (and (featurep 'xemacs) + (<= (string-to-number emacs-version) 21.1)) + (lambda (prompt &optional default-coding-system) + (read-coding-system prompt)) + 'read-coding-system)) + (t (lambda (prompt &optional default-coding-system) + "Prompt the user for a coding system." + (gnus-completing-read + prompt (mapcar (lambda (s) (symbol-name (car s))) + mm-mime-mule-charset-alist)))))))) (defvar mm-coding-system-list nil) (defun mm-get-coding-system-list () @@ -304,34 +300,6 @@ system object in XEmacs." ;; no-MULE XEmacs: (car (memq cs (mm-get-coding-system-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))))) - (defvar mm-charset-synonym-alist `( ;; Not in XEmacs, but it's not a proper MIME charset anyhow. @@ -380,6 +348,34 @@ the alias. Else windows-NUMBER is used." 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 @@ -428,7 +424,7 @@ corresponding number of an iso-8859 charset." ;; Cf. http://thread.gmane.org/v9lkng5nwy.fsf@marauder.physik.uni-ulm.de "List of IBM codepage numbers. -The codepage mappings slighly differ between IBM and other vendors. +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 @@ -554,7 +550,8 @@ is not available." (let ((cs (cdr (assq charset mm-charset-override-alist)))) (and cs (mm-coding-system-p cs) cs)))) ;; ascii - ((eq charset 'us-ascii) + ((or (eq charset 'us-ascii) + (string-match "ansi.x3.4" (symbol-name charset))) 'ascii) ;; Check to see whether we can handle this charset. (This depends ;; on there being some coding system matching each `mime-charset' @@ -870,6 +867,21 @@ variable is set, it overrides the default priority." Setting it to nil is useful on Emacsen supporting Unicode if sending mail with multiple parts is preferred to sending a Unicode one.") +(defvar mm-extra-numeric-entities + (mapcar + (lambda (item) + (cons (car item) (mm-ucs-to-char (cdr item)))) + '((#x80 . #x20AC) (#x82 . #x201A) (#x83 . #x0192) (#x84 . #x201E) + (#x85 . #x2026) (#x86 . #x2020) (#x87 . #x2021) (#x88 . #x02C6) + (#x89 . #x2030) (#x8A . #x0160) (#x8B . #x2039) (#x8C . #x0152) + (#x8E . #x017D) (#x91 . #x2018) (#x92 . #x2019) (#x93 . #x201C) + (#x94 . #x201D) (#x95 . #x2022) (#x96 . #x2013) (#x97 . #x2014) + (#x98 . #x02DC) (#x99 . #x2122) (#x9A . #x0161) (#x9B . #x203A) + (#x9C . #x0153) (#x9E . #x017E) (#x9F . #x0178))) + "*Alist of extra numeric entities and characters other than ISO 10646. +This table is used for decoding extra numeric entities to characters, +like \"€\" to the euro sign, mainly in html messages.") + ;;; Internal variables: ;;; Functions: @@ -907,7 +919,7 @@ mail with multiple parts is preferred to sending a Unicode one.") "Set the multibyte flag of the current buffer. Only do this if the default value of `enable-multibyte-characters' is non-nil. This is a no-op in XEmacs." - (set-buffer-multibyte t))) + (set-buffer-multibyte 'to))) (if (featurep 'xemacs) (defalias 'mm-disable-multibyte 'ignore) @@ -944,7 +956,7 @@ This is a no-op in XEmacs." (defun mm-charset-after (&optional pos) "Return charset of a character in current buffer at position POS. -If POS is nil, it defauls to the current point. +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." (let ((char (char-after pos)) charset) @@ -978,6 +990,7 @@ If the charset is `composition', return the actual one." ;; This is for XEmacs. (mm-mule-charset-to-mime-charset charset))) +;; `delete-dups' is not available in XEmacs 21.4. (if (fboundp 'delete-dups) (defalias 'mm-delete-duplicates 'delete-dups) (defun mm-delete-duplicates (list) @@ -1591,7 +1604,7 @@ gzip, bzip2, etc. are allowed." (insert decomp) (setq filename (file-name-sans-extension filename))) (goto-char (point-min)) - (prog1 + (unwind-protect (cond ((boundp 'set-auto-coding-function) ;; Emacs (if filename