X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fmm-util.el;h=161d2ca75504795a6709cab50ea388b663942e98;hb=c3e1fa9581a5bfd59386b25a438fbb6650441f79;hp=aaae62d5df86f34efc91b25bab8f7f4b2d255d74;hpb=82300762c3419b73fc2e994b14e3d520fe88b0a9;p=elisp%2Fgnus.git- diff --git a/lisp/mm-util.el b/lisp/mm-util.el index aaae62d..161d2ca 100644 --- a/lisp/mm-util.el +++ b/lisp/mm-util.el @@ -24,39 +24,18 @@ ;;; Code: -(defvar mm-running-xemacs (string-match "XEmacs" emacs-version)) +(defconst mm-running-xemacs (string-match "XEmacs" emacs-version)) -(defvar mm-running-ntemacs - (and (not mm-running-xemacs) - (string-match "nt" system-configuration))) - -(defvar mm-binary-coding-system +(defconst mm-binary-coding-system (if mm-running-xemacs 'binary 'no-conversion) - "100% binary coding system.") - -(defvar mm-text-coding-system - (cond - ((not (fboundp 'coding-system-p)) nil) - (mm-running-xemacs ;; XEmacs - (and (coding-system-p 'no-conversion) 'no-conversion)) - (mm-running-ntemacs ;; NTEmacs - (and (coding-system-p 'raw-text-dos) 'raw-text-dos)) - ((coding-system-p 'raw-text) 'raw-text) ;; Emacs - (t nil)) - "100% text coding system, for removing ^M.") - -(defvar mm-default-coding-system nil - "The default coding system to use.") - -(defvar mm-known-charsets '(iso-8859-1) - "List of known charsets. -Use this under non-Mule Emacsen to specify which charsets your Emacs -can display. Also see `mm-default-charset'.") - -(defvar mm-default-charset 'iso-8859-1 - "Default charset assumed to be used when viewing non-ASCII characters. -This variable is used only in non-Mule Emacsen.") + "100% binary coding system.") + +(defconst mm-text-coding-system + (and (fboundp 'coding-system-list) + (if (memq system-type '(windows-nt ms-dos ms-windows)) + 'raw-text-dos 'raw-text)) + "Text-safe coding system (For removing ^M).") (defvar mm-mime-mule-charset-alist '((us-ascii ascii) @@ -70,16 +49,19 @@ This variable is used only in non-Mule Emacsen.") (iso-8859-7 greek-iso8859-7) (iso-8859-8 hebrew-iso8859-8) (iso-8859-9 latin-iso8859-9) - (iso-2022-jp-2 japanese-jisx0208) - (iso-2022-jp latin-jisx0201 - japanese-jisx0208-1978) + (viscii vietnamese-viscii-lower) + (iso-2022-jp latin-jisx0201 japanese-jisx0208 japanese-jisx0208-1978) (euc-kr korean-ksc5601) (cn-gb-2312 chinese-gb2312) (cn-big5 chinese-big5-1 chinese-big5-2) + (tibetan tibetan) + (thai-tis620 thai-tis620) + (iso-2022-7bit ethiopic arabic-1-column arabic-2-column) (iso-2022-jp-2 latin-iso8859-1 greek-iso8859-7 latin-jisx0201 japanese-jisx0208-1978 chinese-gb2312 japanese-jisx0208 - korean-ksc5601 japanese-jisx0212) + korean-ksc5601 japanese-jisx0212 + katakana-jisx0201) (iso-2022-int-1 latin-iso8859-1 greek-iso8859-7 latin-jisx0201 japanese-jisx0208-1978 chinese-gb2312 japanese-jisx0208 @@ -130,23 +112,15 @@ This variable is used only in non-Mule Emacsen.") (or mm-coding-system-list (setq mm-coding-system-list (mm-coding-system-list)))) -(defvar mm-charset-coding-system-alist - (let ((rest - '((gb2312 . cn-gb-2312) - (iso-2022-jp-2 . iso-2022-7bit-ss2) - (x-ctext . ctext))) - (systems (mm-get-coding-system-list)) - dest) - (while rest - (let ((pair (car rest))) - (unless (memq (car pair) systems) - (setq dest (cons pair dest)))) - (setq rest (cdr rest))) - dest) - "Charset/coding system alist.") - -;;;Internal variable -(defvar mm-charset-iso-8859-1-forced nil) +(defvar mm-charset-synonym-alist + '((big5 . cn-big5) + (gb2312 . cn-gb-2312) + (x-ctext . ctext)) + "A mapping from invalid charset names to the real charset names.") + +;;; Internal variables: + +;;; Functions: (defun mm-mule-charset-to-mime-charset (charset) "Return the MIME charset corresponding to MULE CHARSET." @@ -166,19 +140,14 @@ If optional argument LBT (`unix', `dos' or `mac') is specified, it is used as the line break code type of the coding system." (when (stringp charset) (setq charset (intern (downcase charset)))) - (if (and mm-charset-iso-8859-1-forced - (eq charset 'iso-8859-1)) - (setq charset mm-charset-iso-8859-1-forced)) (setq charset - (or (cdr (assq charset mm-charset-coding-system-alist)) + (or (cdr (assq charset mm-charset-synonym-alist)) charset)) (when lbt (setq charset (intern (format "%s-%s" charset lbt)))) (cond ;; Running in a non-MULE environment. - ((and (null (mm-get-coding-system-list)) - (or (eq charset mm-default-charset) - (memq charset mm-known-charsets))) + ((null (mm-get-coding-system-list)) charset) ;; ascii ((eq charset 'us-ascii) @@ -213,22 +182,36 @@ used as the line break code type of the coding system." (when (fboundp 'set-buffer-multibyte) (set-buffer-multibyte nil))) -(defun mm-mime-charset (charset b e) +(defun mm-preferred-coding-system (charset) + ;; A typo in some Emacs versions. + (or (get-charset-property charset 'prefered-coding-system) + (get-charset-property charset 'preffered-coding-system))) + +(defun mm-mime-charset (charset) + "Return the MIME charset corresponding to the MULE CHARSET." (if (fboundp 'coding-system-get) + ;; This exists in Emacs 20. (or - (and - mm-default-coding-system - (let ((safe (coding-system-get mm-default-coding-system - 'safe-charsets))) - (or (eq safe t) (memq charset safe))) - (coding-system-get mm-default-coding-system 'mime-charset)) - (coding-system-get - (get-charset-property charset 'prefered-coding-system) - 'mime-charset) - (car (memq charset (find-coding-systems-region - (point-min) (point-max))))) + (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)) + ;; This is for XEmacs. (mm-mule-charset-to-mime-charset charset))) +(defun mm-find-mime-charset-region (b e) + "Return the MIME charsets needed to encode the region between B and E." + (let ((charsets + (mapcar 'mm-mime-charset + (delq 'ascii + (mm-find-charset-region b e))))) + (when (memq 'iso-2022-jp-2 charsets) + (setq charsets (delq 'iso-2022-jp charsets))) + (delete-duplicates charsets))) + (defsubst mm-multibyte-p () "Say whether multibyte is enabled." (and (boundp 'enable-multibyte-characters) @@ -264,8 +247,8 @@ See also `with-temp-file' and `with-output-to-string'." "Return a list of charsets in the region." (cond ((and (boundp 'enable-multibyte-characters) - enable-multibyte-characters - (fboundp 'find-charset-region)) + enable-multibyte-characters + (fboundp 'find-charset-region)) (find-charset-region b e)) ((not (boundp 'current-language-environment)) (save-excursion @@ -275,8 +258,7 @@ See also `with-temp-file' and `with-output-to-string'." (skip-chars-forward "\0-\177") (if (eobp) '(ascii) - ;;;!!!bogus - (list 'ascii 'latin-iso8859-1))))) + (delq nil (list 'ascii mail-parse-charset)))))) (t ;; We are in a unibyte buffer, so we futz around a bit. (save-excursion @@ -290,6 +272,53 @@ See also `with-temp-file' and `with-output-to-string'." '(ascii) (list 'ascii (car (last (assq 'charset entry))))))))))) +(defun mm-read-charset (prompt) + "Return a charset." + (intern + (completing-read + prompt + (mapcar (lambda (e) (list (symbol-name (car e)))) + mm-mime-mule-charset-alist) + nil t))) + +(defun mm-quote-arg (arg) + "Return a version of ARG that is safe to evaluate in a shell." + (let ((pos 0) new-pos accum) + ;; *** bug: we don't handle newline characters properly + (while (setq new-pos (string-match "[]*[;!'`\"$\\& \t{} |()<>]" arg pos)) + (push (substring arg pos new-pos) accum) + (push "\\" accum) + (push (list (aref arg new-pos)) accum) + (setq pos (1+ new-pos))) + (if (= pos 0) + arg + (apply 'concat (nconc (nreverse accum) (list (substring arg pos))))))) + +(defun mm-auto-mode-alist () + "Return an `auto-mode-alist' with only the .gz (etc) thingies." + (let ((alist auto-mode-alist) + out) + (while alist + (when (listp (cdar alist)) + (push (car alist) out)) + (pop alist)) + (nreverse out))) + +(defun mm-insert-file-contents (filename &optional visit beg end replace) + "Like `insert-file-contents', q.v., 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. + This function ensures that none of these modifications will take place." + (let ((format-alist nil) + (auto-mode-alist (mm-auto-mode-alist)) + (default-major-mode 'fundamental-mode) + (enable-local-variables nil) + (after-insert-file-functions nil) + (enable-local-eval nil) + (find-file-hooks nil)) + (insert-file-contents filename visit beg end replace))) + (provide 'mm-util) ;;; mm-util.el ends here