* mcs-om.el (mime-charset-coding-system-alist): Move forward.
[elisp/apel.git] / mcs-om.el
index 433262d..4ddb1b5 100644 (file)
--- a/mcs-om.el
+++ b/mcs-om.el
 
 (require 'poem)
 
-(defun encode-mime-charset-region (start end charset)
+(condition-case nil
+    (require 'cyrillic)
+  (error nil))
+
+(defvar mime-charset-coding-system-alist
+  '((iso-8859-1      . *ctext*)
+    (x-ctext         . *ctext*)
+    (gb2312          . *euc-china*)
+    (koi8-r          . *koi8*)
+    (iso-2022-jp-2   . *iso-2022-ss2-7*)
+    (x-iso-2022-jp-2 . *iso-2022-ss2-7*)
+    (shift_jis       . *sjis*)
+    (x-shiftjis      . *sjis*)))
+
+(defsubst mime-charset-to-coding-system (charset &optional lbt)
+  "Return coding-system corresponding with CHARSET.
+CHARSET is a symbol whose name is MIME charset.
+If optional argument LBT (`CRLF', `LF', `CR', `unix', `dos' or `mac')
+is specified, it is used as line break code type of coding-system."
+  (if (stringp charset)
+      (setq charset (intern (downcase charset))))
+  (setq charset (or (cdr (assq charset mime-charset-coding-system-alist))
+                   (intern (concat "*" (symbol-name charset) "*"))))
+  (if lbt
+      (setq charset (intern (format "%s%s" charset
+                                   (cond ((eq lbt 'CRLF) 'dos)
+                                         ((eq lbt 'LF) 'unix)
+                                         ((eq lbt 'CR) 'mac)
+                                         (t lbt))))))
+  (if (coding-system-p charset)
+      charset))
+
+(defsubst lbt-to-string (lbt)
+  (cdr (assq lbt '((nil . nil)
+                  (CRLF . "\r\n")
+                  (CR . "\r")
+                  (dos . "\r\n")
+                  (mac . "\r")))))
+
+(defun encode-mime-charset-region (start end charset &optional lbt)
   "Encode the text between START and END as MIME CHARSET."
-  (let ((cs (mime-charset-to-coding-system charset)))
+  (let ((cs (mime-charset-to-coding-system charset lbt)))
     (if cs
        (code-convert start end *internal* cs)
-      )))
+      (if (and lbt (setq cs (mime-charset-to-coding-system charset)))
+         (let ((newline (lbt-to-string lbt)))
+           (save-excursion
+             (save-restriction
+               (narrow-to-region start end)
+               (code-convert (point-min) (point-max) *internal* cs)
+               (if newline
+                   (goto-char (point-min))
+                 (while (search-forward "\n" nil t)
+                   (replace-match newline))))))))))
 
 (defun decode-mime-charset-region (start end charset &optional lbt)
   "Decode the text between START and END as MIME CHARSET."
-  (let ((cs (mime-charset-to-coding-system charset lbt))
-       newline)
+  (let ((cs (mime-charset-to-coding-system charset lbt)))
     (if cs
        (code-convert start end cs *internal*)
       (if (and lbt (setq cs (mime-charset-to-coding-system charset)))
-         (progn
-           (if (setq newline (cdr (assq lbt '((CRLF . "\r\n") (CR . "\r")))))
+         (let ((newline (lbt-to-string lbt)))
+           (if newline
                (save-excursion
                  (save-restriction
                    (narrow-to-region start end)
                  (code-convert (point-min) (point-max) cs *internal*))
              (code-convert start end cs *internal*)))))))
 
-(defun encode-mime-charset-string (string charset)
+(defun encode-mime-charset-string (string charset &optional lbt)
   "Encode the STRING as MIME CHARSET."
-  (let ((cs (mime-charset-to-coding-system charset)))
+  (let ((cs (mime-charset-to-coding-system charset lbt)))
     (if cs
        (code-convert-string string *internal* cs)
-      string)))
+      (if (and lbt (setq cs (mime-charset-to-coding-system charset)))
+         (let ((newline (lbt-to-string lbt)))
+           (if newline
+               (with-temp-buffer
+                 (insert string)
+                 (code-convert (point-min) (point-max) *internal* cs)
+                 (goto-char (point-min))
+                 (while (search-forward "\n" nil t)
+                   (replace-match newline))
+                 (buffer-string))
+             (decode-coding-string string cs)))
+       string))))
 
 (defun decode-mime-charset-string (string charset &optional lbt)
   "Decode the STRING which is encoded in MIME CHARSET."
-  (let ((cs (mime-charset-to-coding-system charset lbt))
-       newline)
+  (let ((cs (mime-charset-to-coding-system charset lbt)))
     (if cs
        (decode-coding-string string cs)
       (if (and lbt (setq cs (mime-charset-to-coding-system charset)))
-         (progn
-           (if (setq newline (cdr (assq lbt '((CRLF . "\r\n") (CR . "\r")))))
+         (let ((newline (lbt-to-string lbt)))
+           (if newline
                (with-temp-buffer
-                (insert string)
-                (goto-char (point-min))
-                (while (search-forward newline nil t)
-                  (replace-match "\n"))
-                (code-convert (point-min) (point-max) cs *internal*)
-                (buffer-string))
+                 (insert string)
+                 (goto-char (point-min))
+                 (while (search-forward newline nil t)
+                   (replace-match "\n"))
+                 (code-convert (point-min) (point-max) cs *internal*)
+                 (buffer-string))
              (decode-coding-string string cs)))
        string))))
 
 (cond
- (running-emacs-19_29-or-later
+ ((and (>= emacs-major-version 19) (>= emacs-minor-version 29))
   ;; for MULE 2.3 based on Emacs 19.34.
   (defun write-region-as-mime-charset (charset start end filename
                                               &optional append visit lockname)
   ))
 
 
-;;; @ to coding-system
-;;;
-
-(require 'cyrillic)
-
-(defvar mime-charset-coding-system-alist
-  '((iso-8859-1      . *ctext*)
-    (x-ctext         . *ctext*)
-    (gb2312          . *euc-china*)
-    (koi8-r          . *koi8*)
-    (iso-2022-jp-2   . *iso-2022-ss2-7*)
-    (x-iso-2022-jp-2 . *iso-2022-ss2-7*)
-    (shift_jis       . *sjis*)
-    (x-shiftjis      . *sjis*)
-    ))
-
-(defsubst mime-charset-to-coding-system (charset &optional lbt)
-  (if (stringp charset)
-      (setq charset (intern (downcase charset)))
-    )
-  (setq charset (or (cdr (assq charset mime-charset-coding-system-alist))
-                   (intern (concat "*" (symbol-name charset) "*"))))
-  (if lbt
-      (setq charset (intern (format "%s%s" charset
-                                   (cond ((eq lbt 'CRLF) 'dos)
-                                         ((eq lbt 'LF) 'unix)
-                                         ((eq lbt 'CR) 'mac)
-                                         (t lbt)))))
-    )
-  (if (coding-system-p charset)
-      charset
-    ))
-
-
 ;;; @ detection
 ;;;
 
 It is used when MIME-charset is not specified.
 It must be symbol.")
 
+(defvar default-mime-charset-for-write
+  default-mime-charset
+  "Default value of MIME-charset for encoding.
+It is used when suitable MIME-charset is not found.
+It must be symbol.")
+
 (defun detect-mime-charset-region (start end)
   "Return MIME charset for region between START and END."
-  (charsets-to-mime-charset
-   (cons lc-ascii (find-charset-region start end))))
+  (or (charsets-to-mime-charset
+       (cons lc-ascii (find-charset-region start end)))
+      default-mime-charset-for-write))
 
 
 ;;; @ end
 ;;;
 
-(provide 'mcs-om)
+(require 'product)
+(product-provide (provide 'mcs-om) (require 'apel-ver))
 
 ;;; mcs-om.el ends here