;;; mm-util.el --- Utility functions for Mule and low level things
-;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
+;; 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
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)))))
+ string))
+ ;; `line-number-at-pos' is available only in Emacs 22.1 or greater
+ ;; and XEmacs 21.5.
+ (line-number-at-pos
+ . ,(lambda (&optional pos)
+ "Return (narrowed) buffer line number at position POS.
+If POS is nil, use current buffer location.
+Counting starts at (point-min), so the value refers
+to the contents of the accessible portion of the buffer."
+ (let ((opoint (or pos (point))) start)
+ (save-excursion
+ (goto-char (point-min))
+ (setq start (point))
+ (goto-char opoint)
+ (forward-line 0)
+ (1+ (count-lines start (point))))))))))
;; `decode-coding-string', `encode-coding-string', `decode-coding-region'
;; and `encode-coding-region' are available in Emacs and XEmacs built with
((fboundp 'char-valid-p) 'char-valid-p)
(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)
+ (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) ?#))))
+
;; 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
;; proper charset names (base coding systems which have a
(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."))))
+ (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
(unless (mm-coding-system-p cp)
(if (fboundp 'codepage-setup) ; silence compiler
(codepage-setup number)
- (error "`codepage-setup' not present in this Emacs version.")))
+ (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))
;;; (eq charset (coding-system-get charset 'mime-charset))
)
charset)
+ ;; Use coding system Emacs knows.
+ ((and (fboundp 'coding-system-from-name)
+ (coding-system-from-name charset)))
;; Eval expressions from `mm-charset-eval-alist'
((let* ((el (assq charset mm-charset-eval-alist))
(cs (car el))
"100% binary coding system.")
(defvar mm-text-coding-system
- (or (if (memq system-type '(windows-nt ms-dos ms-windows))
+ (or (if (memq system-type '(windows-nt ms-dos))
(and (mm-coding-system-p 'raw-text-dos) 'raw-text-dos)
(and (mm-coding-system-p 'raw-text) 'raw-text))
mm-binary-coding-system)
(defvar mm-auto-save-coding-system
(cond
((mm-coding-system-p 'utf-8-emacs) ; Mule 7
- (if (memq system-type '(windows-nt ms-dos ms-windows))
+ (if (memq system-type '(windows-nt ms-dos))
(if (mm-coding-system-p 'utf-8-emacs-dos)
'utf-8-emacs-dos mm-binary-coding-system)
'utf-8-emacs))
((mm-coding-system-p 'emacs-mule)
- (if (memq system-type '(windows-nt ms-dos ms-windows))
+ (if (memq system-type '(windows-nt ms-dos))
(if (mm-coding-system-p 'emacs-mule-dos)
'emacs-mule-dos mm-binary-coding-system)
'emacs-mule))
"A table of the difference character between ISO-8859-X and ISO-8859-15.")
(defcustom mm-coding-system-priorities
- (if (boundp 'current-language-environment)
- (let ((lang (symbol-value 'current-language-environment)))
- (cond ((string= lang "Japanese")
- ;; Japanese users prefer iso-2022-jp to euc-japan or
- ;; shift_jis, however iso-8859-1 should be used when
- ;; there are only ASCII text and Latin-1 characters.
- '(iso-8859-1 iso-2022-jp iso-2022-jp-2 shift_jis utf-8)))))
+ (let ((lang (if (boundp 'current-language-environment)
+ (symbol-value 'current-language-environment))))
+ (cond (;; XEmacs without Mule but with `file-coding'.
+ (not lang) nil)
+ ;; In XEmacs 21.5 it may be the one like "Japanese (UTF-8)".
+ ((string-match "\\`Japanese" lang)
+ ;; Japanese users prefer iso-2022-jp to euc-japan or
+ ;; shift_jis, however iso-8859-1 should be used when
+ ;; there are only ASCII text and Latin-1 characters.
+ '(iso-8859-1 iso-2022-jp iso-2022-jp-2 shift_jis utf-8))))
"Preferred coding systems for encoding outgoing messages.
More than one suitable coding system may be found for some text.
out)))
(eval-and-compile
- (defvar mm-emacs-mule (and (not (featurep 'xemacs))
- (boundp 'default-enable-multibyte-characters)
- default-enable-multibyte-characters
- (fboundp 'set-buffer-multibyte))
- "True in Emacs with Mule.")
-
- (if mm-emacs-mule
- (defun mm-enable-multibyte ()
- "Set the multibyte flag of the current buffer.
+ (if (featurep 'xemacs)
+ (defalias 'mm-enable-multibyte 'ignore)
+ (defun mm-enable-multibyte ()
+ "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 'to))
- (defalias 'mm-enable-multibyte 'ignore))
+ (set-buffer-multibyte t)))
- (if mm-emacs-mule
- (defun mm-disable-multibyte ()
- "Unset the multibyte flag of in the current buffer.
+ (if (featurep 'xemacs)
+ (defalias 'mm-disable-multibyte 'ignore)
+ (defun mm-disable-multibyte ()
+ "Unset the multibyte flag of in the current buffer.
This is a no-op in XEmacs."
- (set-buffer-multibyte nil))
- (defalias 'mm-disable-multibyte 'ignore)))
+ (set-buffer-multibyte nil))))
(defun mm-preferred-coding-system (charset)
;; A typo in some Emacs versions.
"Return non-nil if the session is multibyte.
This affects whether coding conversion should be attempted generally."
(if (featurep 'mule)
- (if (boundp 'default-enable-multibyte-characters)
- default-enable-multibyte-characters
+ (if (boundp 'enable-multibyte-characters)
+ (default-value 'enable-multibyte-characters)
t)))
(defun mm-iso-8859-x-to-15-region (&optional b e)
(defmacro mm-with-unibyte-current-buffer (&rest forms)
"Evaluate FORMS with current buffer temporarily made unibyte.
-Also bind `default-enable-multibyte-characters' to nil.
-Equivalent to `progn' in XEmacs
-
-NOTE: Use this macro with caution in multibyte buffers (it is not
-worth using this macro in unibyte buffers of course). Use of
-`(set-buffer-multibyte t)', which is run finally, is generally
-harmful since it is likely to modify existing data in the buffer.
-For instance, it converts \"\\300\\255\" into \"\\255\" in
-Emacs 23 (unicode)."
- (let ((multibyte (make-symbol "multibyte"))
- (buffer (make-symbol "buffer")))
- `(if mm-emacs-mule
- (let ((,multibyte enable-multibyte-characters)
- (,buffer (current-buffer)))
- (unwind-protect
- (let (default-enable-multibyte-characters)
- (set-buffer-multibyte nil)
- ,@forms)
- (set-buffer ,buffer)
- (set-buffer-multibyte ,multibyte)))
- (let (default-enable-multibyte-characters)
- ,@forms))))
+Equivalent to `progn' in XEmacs.
+
+Note: We recommend not using this macro any more; there should be
+better ways to do a similar thing. The previous version of this macro
+bound the default value of `enable-multibyte-characters' to nil while
+evaluating FORMS but it is no longer done. So, some programs assuming
+it if any may malfunction."
+ (if (featurep 'xemacs)
+ `(progn ,@forms)
+ (let ((multibyte (make-symbol "multibyte")))
+ `(let ((,multibyte enable-multibyte-characters))
+ (when ,multibyte
+ (set-buffer-multibyte nil))
+ (prog1
+ (progn ,@forms)
+ (when ,multibyte
+ (set-buffer-multibyte t)))))))
(put 'mm-with-unibyte-current-buffer 'lisp-indent-function 0)
(put 'mm-with-unibyte-current-buffer 'edebug-form-spec '(body))
`find-file-hooks', etc.
If INHIBIT is non-nil, inhibit `mm-inhibit-file-name-handlers'.
This function ensures that none of these modifications will take place."
- (let* ((format-alist nil)
- (auto-mode-alist (if inhibit nil (mm-auto-mode-alist)))
- (default-major-mode 'fundamental-mode)
- (enable-local-variables nil)
- (after-insert-file-functions nil)
- (enable-local-eval nil)
- (inhibit-file-name-operation (if inhibit
- 'insert-file-contents
- inhibit-file-name-operation))
- (inhibit-file-name-handlers
- (if inhibit
- (append mm-inhibit-file-name-handlers
- inhibit-file-name-handlers)
- inhibit-file-name-handlers))
- (ffh (if (boundp 'find-file-hook)
- 'find-file-hook
- 'find-file-hooks))
- (val (symbol-value ffh)))
+ (letf* ((format-alist nil)
+ (auto-mode-alist (if inhibit nil (mm-auto-mode-alist)))
+ ((default-value 'major-mode) 'fundamental-mode)
+ (enable-local-variables nil)
+ (after-insert-file-functions nil)
+ (enable-local-eval nil)
+ (inhibit-file-name-operation (if inhibit
+ 'insert-file-contents
+ inhibit-file-name-operation))
+ (inhibit-file-name-handlers
+ (if inhibit
+ (append mm-inhibit-file-name-handlers
+ inhibit-file-name-handlers)
+ inhibit-file-name-handlers))
+ (ffh (if (boundp 'find-file-hook)
+ 'find-file-hook
+ 'find-file-hooks))
+ (val (symbol-value ffh)))
(set ffh nil)
(unwind-protect
(insert-file-contents filename visit beg end replace)
;; Reset the umask.
(set-default-file-modes umask)))))
+(defvar mm-image-load-path-cache nil)
+
(defun mm-image-load-path (&optional package)
- (let (dir result)
- (dolist (path load-path (nreverse result))
- (when (and path
- (file-directory-p
- (setq dir (concat (file-name-directory
- (directory-file-name path))
- "etc/images/" (or package "gnus/")))))
- (push dir result))
- (push path result))))
+ (if (and mm-image-load-path-cache
+ (equal load-path (car mm-image-load-path-cache)))
+ (cdr mm-image-load-path-cache)
+ (let (dir result)
+ (dolist (path load-path)
+ (when (and path
+ (file-directory-p
+ (setq dir (concat (file-name-directory
+ (directory-file-name path))
+ "etc/images/" (or package "gnus/")))))
+ (push dir result)))
+ (setq result (nreverse result)
+ mm-image-load-path-cache (cons load-path result))
+ result)))
;; Fixme: This doesn't look useful where it's used.
(if (fboundp 'detect-coding-region)
(error
(setq err-msg (error-message-string err)))))
(when (file-exists-p err-file)
- (ignore-errors (jka-compr-delete-temp-file err-file)))
+ (ignore-errors (delete-file err-file)))
(when inplace
(unless err-msg
(delete-region (point-min) (point-max))
filename))
(mm-decompress-buffer filename nil t))))
(when decomp
- (set-buffer (let (default-enable-multibyte-characters)
- (generate-new-buffer " *temp*")))
+ (set-buffer (generate-new-buffer " *temp*"))
+ (mm-disable-multibyte)
(insert decomp)
(setq filename (file-name-sans-extension filename)))
(goto-char (point-min))
(provide 'mm-util)
-;; arch-tag: 94dc5388-825d-4fd1-bfa5-2100aa351238
;;; mm-util.el ends here