X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fmm-util.el;h=802ad8688de24b01ecf46e96f6060bb5c2151db0;hb=a38b9fd9d496b8bde954fcc74d99dbee48d854cc;hp=8f600fdba5131e46a8c1c457a014512ea35956aa;hpb=c20b558cfd692b47db47a8a8f908fa17e819e0cc;p=gnus diff --git a/lisp/mm-util.el b/lisp/mm-util.el index 8f600fdba..802ad8688 100644 --- a/lisp/mm-util.el +++ b/lisp/mm-util.el @@ -1,6 +1,7 @@ ;;; mm-util.el --- Utility functions for Mule and low level things -;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004 -;; Free Software Foundation, Inc. + +;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, +;; 2005, 2006 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; MORIOKA Tomohiko @@ -18,8 +19,8 @@ ;; 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., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. ;;; Commentary: @@ -54,7 +55,8 @@ mm-mime-mule-charset-alist) nil t)))) (subst-char-in-string - . (lambda (from to string &optional inplace) ;; stolen (and renamed) from nnheader.el + . (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))) @@ -66,22 +68,55 @@ (aset string idx to)) (setq idx (1+ idx))) string))) + (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))) (string-as-unibyte . identity) (string-make-unibyte . identity) + ;; 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) -> + ;; 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 . identity) + (string-to-multibyte + . (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 ""))) (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)))) + (multibyte-char-to-unibyte . identity) + (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)))))))))))) (eval-and-compile (defalias 'mm-char-or-char-int-p @@ -121,13 +156,39 @@ (defun mm-coding-system-p (cs) "Return non-nil if CS is a symbol naming a coding system. -In XEmacs, also return non-nil if CS is a coding system object." +In XEmacs, also return non-nil if CS is a coding system object. +If CS is available, return CS itself in Emacs, and return a coding +system object in XEmacs." (if (fboundp 'find-coding-system) - (find-coding-system cs) + (and cs (find-coding-system cs)) (if (fboundp 'coding-system-p) - (coding-system-p cs) - ;; Is this branch ever actually useful? - (memq cs (mm-get-coding-system-list))))) + (when (coding-system-p cs) + cs) + ;; 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 (cp-supported-codepages))) + (list (completing-read "Setup DOS Codepage: (default 437) " candidates + nil 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) + (codepage-setup number)) + (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 `( @@ -153,12 +214,60 @@ In XEmacs, also return non-nil if CS is a coding system object." (mm-coding-system-p 'cp1250)) '((windows-1250 . cp1250))) ;; A Microsoft misunderstanding. + ,@(if (and (not (mm-coding-system-p 'unicode)) + (mm-coding-system-p 'utf-16-le)) + '((unicode . utf-16-le))) + ;; A Microsoft misunderstanding. ,@(unless (mm-coding-system-p 'ks_c_5601-1987) (if (mm-coding-system-p 'cp949) '((ks_c_5601-1987 . cp949)) '((ks_c_5601-1987 . euc-kr)))) ) - "A mapping from invalid charset names to the real charset names.") + "A mapping from unknown or invalid charset names to the real charset names.") + +(defcustom mm-charset-override-alist + `((iso-8859-1 . windows-1252)) + "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 (undecided . windows-1252))) + (repeat :inline t + :tag "Other options" + (cons (symbol :tag "From charset") + (symbol :tag "To charset")))) + :version "23.0" ;; No Gnus + :group 'mime) + +(defcustom mm-charset-eval-alist + (if (featurep 'xemacs) + nil ;; I don't know what would be useful for XEmacs. + '(;; Emacs 21 offers 1250 1251 1253 1257. 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