Mercurial > emacs
comparison lisp/gnus/mm-util.el @ 32976:aa9dc4e7c5ac
2000-10-27 ShengHuo ZHU <zsh@cs.rochester.edu>
* mm-util.el (mm-multibyte-p): Test (featurep 'xemacs).
(mm-with-unibyte-current-buffer-mule4): New function.
(mm-enable-multibyte-mule4): New.
(mm-disable-multibyte-mule4): New.
* mm-util.el (mm-enable-multibyte-mule4): New.
(mm-disable-multibyte-mule4): New.
author | Dave Love <fx@gnu.org> |
---|---|
date | Fri, 27 Oct 2000 18:52:28 +0000 |
parents | cbdba3c57536 |
children | e06db3b8e558 |
comparison
equal
deleted
inserted
replaced
32975:5155c0078eb9 | 32976:aa9dc4e7c5ac |
---|---|
1 ;;; mm-util.el --- Utility functions for MIME things | 1 ;;; mm-util.el --- Utility functions for MIME things |
2 ;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc. | 2 ;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc. |
3 | 3 |
4 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> | 4 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> |
5 ;; MORIOKA Tomohiko <morioka@jaist.ac.jp> | 5 ;; MORIOKA Tomohiko <morioka@jaist.ac.jp> |
6 ;; Maintainer: bugs@gnus.org | |
6 ;; This file is part of GNU Emacs. | 7 ;; This file is part of GNU Emacs. |
7 | 8 |
8 ;; GNU Emacs is free software; you can redistribute it and/or modify | 9 ;; GNU Emacs is free software; you can redistribute it and/or modify |
9 ;; it under the terms of the GNU General Public License as published by | 10 ;; it under the terms of the GNU General Public License as published by |
10 ;; the Free Software Foundation; either version 2, or (at your option) | 11 ;; the Free Software Foundation; either version 2, or (at your option) |
22 | 23 |
23 ;;; Commentary: | 24 ;;; Commentary: |
24 | 25 |
25 ;;; Code: | 26 ;;; Code: |
26 | 27 |
28 (eval-when-compile (require 'cl)) | |
27 (require 'mail-prsvr) | 29 (require 'mail-prsvr) |
28 | 30 |
29 (defvar mm-mime-mule-charset-alist | 31 (defvar mm-mime-mule-charset-alist |
30 '((us-ascii ascii) | 32 '((us-ascii ascii) |
31 (iso-8859-1 latin-iso8859-1) | 33 (iso-8859-1 latin-iso8859-1) |
39 (koi8-r cyrillic-iso8859-5 gnus-koi8-r) | 41 (koi8-r cyrillic-iso8859-5 gnus-koi8-r) |
40 (iso-8859-6 arabic-iso8859-6) | 42 (iso-8859-6 arabic-iso8859-6) |
41 (iso-8859-7 greek-iso8859-7) | 43 (iso-8859-7 greek-iso8859-7) |
42 (iso-8859-8 hebrew-iso8859-8) | 44 (iso-8859-8 hebrew-iso8859-8) |
43 (iso-8859-9 latin-iso8859-9) | 45 (iso-8859-9 latin-iso8859-9) |
44 (iso-8859-14 latin-iso8859-14) | |
45 (iso-8859-15 latin-iso8859-15) | |
46 (viscii vietnamese-viscii-lower) | 46 (viscii vietnamese-viscii-lower) |
47 (iso-2022-jp latin-jisx0201 japanese-jisx0208 japanese-jisx0208-1978) | 47 (iso-2022-jp latin-jisx0201 japanese-jisx0208 japanese-jisx0208-1978) |
48 (euc-kr korean-ksc5601) | 48 (euc-kr korean-ksc5601) |
49 (cn-gb-2312 chinese-gb2312) | 49 (cn-gb-2312 chinese-gb2312) |
50 (cn-big5 chinese-big5-1 chinese-big5-2) | 50 (cn-big5 chinese-big5-1 chinese-big5-2) |
231 (defsubst mm-disable-multibyte () | 231 (defsubst mm-disable-multibyte () |
232 "Disable multibyte in the current buffer." | 232 "Disable multibyte in the current buffer." |
233 (when (fboundp 'set-buffer-multibyte) | 233 (when (fboundp 'set-buffer-multibyte) |
234 (set-buffer-multibyte nil))) | 234 (set-buffer-multibyte nil))) |
235 | 235 |
236 (defsubst mm-enable-multibyte-mule4 () | |
237 "Enable multibyte in the current buffer. | |
238 Only used in Emacs Mule 4." | |
239 (when (and (fboundp 'set-buffer-multibyte) | |
240 (boundp 'enable-multibyte-characters) | |
241 (default-value 'enable-multibyte-characters) | |
242 (not (charsetp 'eight-bit-control))) | |
243 (set-buffer-multibyte t))) | |
244 | |
245 (defsubst mm-disable-multibyte-mule4 () | |
246 "Disable multibyte in the current buffer. | |
247 Only used in Emacs Mule 4." | |
248 (when (and (fboundp 'set-buffer-multibyte) | |
249 (not (charsetp 'eight-bit-control))) | |
250 (set-buffer-multibyte nil))) | |
251 | |
236 (defun mm-preferred-coding-system (charset) | 252 (defun mm-preferred-coding-system (charset) |
237 ;; A typo in some Emacs versions. | 253 ;; A typo in some Emacs versions. |
238 (or (get-charset-property charset 'prefered-coding-system) | 254 (or (get-charset-property charset 'prefered-coding-system) |
239 (get-charset-property charset 'preferred-coding-system))) | 255 (get-charset-property charset 'preferred-coding-system))) |
240 | 256 |
241 (defun mm-charset-after (&optional pos) | 257 (defun mm-charset-after (&optional pos) |
242 "Return charset of a character in current buffer at position POS. | 258 "Return charset of a character in current buffer at position POS. |
243 If POS is nil, it defauls to the current point. | 259 If POS is nil, it defauls to the current point. |
244 If POS is out of range, the value is nil. | 260 If POS is out of range, the value is nil. |
245 If the charset is `composition', return the actual one." | 261 If the charset is `composition', return the actual one." |
246 (let ((charset (cond | 262 (let ((char (char-after pos)) charset) |
247 ((fboundp 'charset-after) | 263 (if (< (mm-char-int char) 128) |
248 (charset-after pos)) | 264 (setq charset 'ascii) |
249 ((fboundp 'char-charset) | 265 ;; charset-after is fake in some Emacsen. |
250 (char-charset (char-after pos))) | 266 (setq charset (and (fboundp 'char-charset) (char-charset char))) |
251 ((< (mm-char-int (char-after pos)) 128) | 267 (if (eq charset 'composition) |
252 'ascii) | 268 (let ((p (or pos (point)))) |
253 (mail-parse-mule-charset ;; cached mule-charset | 269 (cadr (find-charset-region p (1+ p)))) |
254 mail-parse-mule-charset) | 270 (if (and charset (not (memq charset '(ascii eight-bit-control |
255 ((boundp 'current-language-environment) | 271 eight-bit-graphic)))) |
256 (let ((entry (assoc current-language-environment | 272 charset |
257 language-info-alist))) | 273 (or |
258 (setq mail-parse-mule-charset | 274 mail-parse-mule-charset ;; cached mule-charset |
259 (or (car (last (assq 'charset entry))) | 275 (progn |
260 'latin-iso8859-1)))) | 276 (setq mail-parse-mule-charset |
261 (t ;; figure out the charset | 277 (and (boundp 'current-language-environment) |
262 (setq mail-parse-mule-charset | 278 (car (last |
263 (or (car (last (assq mail-parse-charset | 279 (assq 'charset |
264 mm-mime-mule-charset-alist))) | 280 (assoc current-language-environment |
265 'latin-iso8859-1)))))) | 281 language-info-alist)))))) |
266 (if (eq charset 'composition) | 282 (if (or (not mail-parse-mule-charset) |
267 (let ((p (or pos (point)))) | 283 (eq mail-parse-mule-charset 'ascii)) |
268 (cadr (find-charset-region p (1+ p)))) | 284 (setq mail-parse-mule-charset |
269 charset))) | 285 (or (car (last (assq mail-parse-charset |
286 mm-mime-mule-charset-alist))) | |
287 'latin-iso8859-1))) | |
288 mail-parse-mule-charset))))))) | |
270 | 289 |
271 (defun mm-mime-charset (charset) | 290 (defun mm-mime-charset (charset) |
272 "Return the MIME charset corresponding to the MULE CHARSET." | 291 "Return the MIME charset corresponding to the MULE CHARSET." |
273 (if (and (fboundp 'coding-system-get) | 292 (if (and (fboundp 'coding-system-get) (fboundp 'get-charset-property)) |
274 (fboundp 'get-charset-property)) | |
275 ;; This exists in Emacs 20. | 293 ;; This exists in Emacs 20. |
276 (or | 294 (or |
277 (and (mm-preferred-coding-system charset) | 295 (and (mm-preferred-coding-system charset) |
278 (coding-system-get | 296 (coding-system-get |
279 (mm-preferred-coding-system charset) 'mime-charset)) | 297 (mm-preferred-coding-system charset) 'mime-charset)) |
307 '(utf-8) | 325 '(utf-8) |
308 charsets))) | 326 charsets))) |
309 | 327 |
310 (defsubst mm-multibyte-p () | 328 (defsubst mm-multibyte-p () |
311 "Say whether multibyte is enabled." | 329 "Say whether multibyte is enabled." |
312 (or (featurep 'xemacs) | 330 (if (and (not (featurep 'xemacs)) |
313 (and (boundp 'enable-multibyte-characters) | 331 (boundp 'enable-multibyte-characters)) |
314 enable-multibyte-characters))) | 332 enable-multibyte-characters |
333 (featurep 'mule))) | |
315 | 334 |
316 (defmacro mm-with-unibyte-buffer (&rest forms) | 335 (defmacro mm-with-unibyte-buffer (&rest forms) |
317 "Create a temporary buffer, and evaluate FORMS there like `progn'. | 336 "Create a temporary buffer, and evaluate FORMS there like `progn'. |
318 See also `with-temp-file' and `with-output-to-string'." | 337 See also `with-temp-file' and `with-output-to-string'." |
319 (let ((temp-buffer (make-symbol "temp-buffer")) | 338 (let ((temp-buffer (make-symbol "temp-buffer")) |
320 (multibyte (make-symbol "multibyte"))) | 339 (multibyte (make-symbol "multibyte"))) |
321 `(if (or (string-match "XEmacs\\|Lucid" emacs-version) | 340 `(if (or (featurep 'xemacs) |
322 (not (boundp 'enable-multibyte-characters))) | 341 (not (boundp 'enable-multibyte-characters))) |
323 (with-temp-buffer ,@forms) | 342 (with-temp-buffer ,@forms) |
324 (let ((,multibyte (default-value 'enable-multibyte-characters)) | 343 (let ((,multibyte (default-value 'enable-multibyte-characters)) |
325 ,temp-buffer) | 344 ,temp-buffer) |
326 (unwind-protect | 345 (unwind-protect |
358 (setq-default enable-multibyte-characters ,multibyte) | 377 (setq-default enable-multibyte-characters ,multibyte) |
359 (set-buffer-multibyte ,multibyte)))))) | 378 (set-buffer-multibyte ,multibyte)))))) |
360 (put 'mm-with-unibyte-current-buffer 'lisp-indent-function 0) | 379 (put 'mm-with-unibyte-current-buffer 'lisp-indent-function 0) |
361 (put 'mm-with-unibyte-current-buffer 'edebug-form-spec '(body)) | 380 (put 'mm-with-unibyte-current-buffer 'edebug-form-spec '(body)) |
362 | 381 |
382 (defmacro mm-with-unibyte-current-buffer-mule4 (&rest forms) | |
383 "Evaluate FORMS there like `progn' in current buffer. | |
384 Mule4 only." | |
385 (let ((multibyte (make-symbol "multibyte"))) | |
386 `(if (or (featurep 'xemacs) | |
387 (not (fboundp 'set-buffer-multibyte)) | |
388 (charsetp 'eight-bit-control)) ;; For Emacs Mule 4 only. | |
389 (progn | |
390 ,@forms) | |
391 (let ((,multibyte (default-value 'enable-multibyte-characters))) | |
392 (unwind-protect | |
393 (let ((buffer-file-coding-system mm-binary-coding-system) | |
394 (coding-system-for-read mm-binary-coding-system) | |
395 (coding-system-for-write mm-binary-coding-system)) | |
396 (set-buffer-multibyte nil) | |
397 (setq-default enable-multibyte-characters nil) | |
398 ,@forms) | |
399 (setq-default enable-multibyte-characters ,multibyte) | |
400 (set-buffer-multibyte ,multibyte)))))) | |
401 (put 'mm-with-unibyte-current-buffer-mule4 'lisp-indent-function 0) | |
402 (put 'mm-with-unibyte-current-buffer-mule4 'edebug-form-spec '(body)) | |
403 | |
363 (defmacro mm-with-unibyte (&rest forms) | 404 (defmacro mm-with-unibyte (&rest forms) |
364 "Set default `enable-multibyte-characters' to `nil', eval the FORMS." | 405 "Set default `enable-multibyte-characters' to `nil', eval the FORMS." |
365 (let ((multibyte (make-symbol "multibyte"))) | 406 (let ((multibyte (make-symbol "multibyte"))) |
366 `(if (or (featurep 'xemacs) | 407 `(if (or (featurep 'xemacs) |
367 (not (boundp 'enable-multibyte-characters))) | 408 (not (boundp 'enable-multibyte-characters))) |
380 (cond | 421 (cond |
381 ((and (mm-multibyte-p) | 422 ((and (mm-multibyte-p) |
382 (fboundp 'find-charset-region)) | 423 (fboundp 'find-charset-region)) |
383 ;; Remove composition since the base charsets have been included. | 424 ;; Remove composition since the base charsets have been included. |
384 (delq 'composition (find-charset-region b e))) | 425 (delq 'composition (find-charset-region b e))) |
385 ((not (boundp 'current-language-environment)) | 426 (t |
427 ;; We are in a unibyte buffer or XEmacs non-mule, so we futz around a bit. | |
386 (save-excursion | 428 (save-excursion |
387 (save-restriction | 429 (save-restriction |
388 (narrow-to-region b e) | 430 (narrow-to-region b e) |
389 (goto-char (point-min)) | 431 (goto-char (point-min)) |
390 (skip-chars-forward "\0-\177") | 432 (skip-chars-forward "\0-\177") |
391 (if (eobp) | 433 (if (eobp) |
392 '(ascii) | 434 '(ascii) |
393 (delq nil (list 'ascii | 435 (let (charset) |
394 (or (car (last (assq mail-parse-charset | 436 (setq charset |
395 mm-mime-mule-charset-alist))) | 437 (and (boundp 'current-language-environment) |
396 'latin-iso8859-1))))))) | 438 (car (last (assq 'charset |
397 (t | 439 (assoc current-language-environment |
398 ;; We are in a unibyte buffer, so we futz around a bit. | 440 language-info-alist)))))) |
399 (save-excursion | 441 (if (eq charset 'ascii) (setq charset nil)) |
400 (save-restriction | 442 (or charset |
401 (narrow-to-region b e) | 443 (setq charset |
402 (goto-char (point-min)) | 444 (car (last (assq mail-parse-charset |
403 (let ((entry (assoc current-language-environment | 445 mm-mime-mule-charset-alist))))) |
404 language-info-alist))) | 446 (list 'ascii (or charset 'latin-iso8859-1))))))))) |
405 (skip-chars-forward "\0-\177") | |
406 (if (eobp) | |
407 '(ascii) | |
408 (delq nil (list 'ascii | |
409 (or (car (last (assq 'charset entry))) | |
410 'latin-iso8859-1)))))))))) | |
411 | 447 |
412 (if (fboundp 'shell-quote-argument) | 448 (if (fboundp 'shell-quote-argument) |
413 (defalias 'mm-quote-arg 'shell-quote-argument) | 449 (defalias 'mm-quote-arg 'shell-quote-argument) |
414 (defun mm-quote-arg (arg) | 450 (defun mm-quote-arg (arg) |
415 "Return a version of ARG that is safe to evaluate in a shell." | 451 "Return a version of ARG that is safe to evaluate in a shell." |