;;; Code:
+(defun install-just-print-p ()
+ (let ((flag (getenv "MAKEFLAGS"))
+ case-fold-search)
+ (princ (format "%s\n" flag))
+ (if flag
+ (string-match "^\\(\\(--[^ ]+ \\)+-\\|[^ =-]\\)*n" flag)
+ )))
+
(defun config-apel ()
(let (prefix lisp-dir version-specific-lisp-dir)
(and (setq prefix (car command-line-args-left))
(defun install-apel ()
(compile-apel)
- (install-elisp-modules emu-modules "." EMU_DIR)
- (install-elisp-modules apel-modules "." APEL_DIR)
- )
+ (let ((just-print (install-just-print-p)))
+ (install-elisp-modules emu-modules "." EMU_DIR just-print)
+ (install-elisp-modules apel-modules "." APEL_DIR just-print)
+ ))
(defun config-apel-package ()
(let (package-dir)
(config-apel-package)
(load "EMU-ELS")
- (compile-elisp-modules emu-modules ".")
- (compile-elisp-modules apel-modules ".")
-
- (let ((dir (expand-file-name APEL_PREFIX
- (expand-file-name "lisp"
- PACKAGEDIR))))
- (install-elisp-modules emu-modules "." dir)
- (install-elisp-modules apel-modules "." dir)
+ (let ((just-print (install-just-print-p)))
+ (compile-elisp-modules emu-modules ".")
+ (compile-elisp-modules apel-modules ".")
- (setq autoload-package-name "apel")
- (add-to-list 'command-line-args-left dir)
- (batch-update-directory)
-
- (add-to-list 'command-line-args-left dir)
- (Custom-make-dependencies)
-
- (byte-compile-file (expand-file-name "auto-autoloads.el" dir))
- (byte-compile-file (expand-file-name "custom-load.el" dir))
- ))
+ (let ((dir (expand-file-name APEL_PREFIX
+ (expand-file-name "lisp"
+ PACKAGEDIR))))
+ (install-elisp-modules emu-modules "." dir just-print)
+ (install-elisp-modules apel-modules "." dir just-print)
+
+ (if just-print
+ (progn
+ (princ (format "Updating autoloads in directory %s..\n\n" dir))
+
+ (princ (format "Processing %s\n" dir))
+ (princ "Generating custom-load.el...\n\n")
+
+ (princ (format "Compiling %s...\n"
+ (expand-file-name "auto-autoloads.el" dir)))
+ (princ (format "Wrote %s\n"
+ (expand-file-name "auto-autoloads.elc" dir)))
+
+ (princ (format "Compiling %s...\n"
+ (expand-file-name "custom-load.el" dir)))
+ (princ (format "Wrote %s\n"
+ (expand-file-name "custom-load.elc" dir)))
+ )
+ (setq autoload-package-name "apel")
+ (add-to-list 'command-line-args-left dir)
+ (batch-update-directory)
+
+ (add-to-list 'command-line-args-left dir)
+ (Custom-make-dependencies)
+
+ (byte-compile-file (expand-file-name "auto-autoloads.el" dir))
+ (byte-compile-file (expand-file-name "custom-load.el" dir))
+ )
+ )))
(defun what-where-apel ()
(config-apel)
+1999-02-26 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * APEL-MK (install-just-print-p): Modify for special option of GNU
+ make.
+
+1999-02-26 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * APEL-MK (install-just-print-p): New function.
+ (install-apel): Use `install-just-print-p'.
+ (install-apel-package): Likewise.
+
+1999-02-25 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * Makefile (install): Add voodoo comment `# $(MAKE)'.
+ (install-package): Likewise.
+
+ * APEL-MK (install-apel): Run installer with `just-print' mode if
+ environment variable "MAKEFLAGS" matches "^[^ =]*n" option.
+ (install-apel-package): Likewise.
+
+1999-02-21 Mikio Nakajima <minakaji@osaka.email.ne.jp>
+
+ * install.el (install-file): New optional argument JUST-PRINT.
+ (install-files): Likewise.
+ (install-elisp-module): Likewise.
+ (install-elisp-modules): Likewise.
+
+1999-02-18 Keiichi Suzuki <kei-suzu@mail.wbs.ne.jp>
+
+ * mcs-e20.el (coding-system-get): New function.
+ (mime-charset-list): Fix for Emacs 20.2.
+
+1999-02-14 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * mcs-om.el (default-mime-charset-for-write): Delete the remaining
+ arguments for `defcustom'.
+
+1999-02-13 Tanaka Akira <akr@jaist.ac.jp>
+
+ * mcs-e20.el (charsets-mime-charset-alist): Don't set up
+ `iso-2022-int-1' in default.
+
+1999-02-11 Tanaka Akira <akr@jaist.ac.jp>
+
+ * README.en, README.ja, pccl.el: pccl does not support Mule 1.x.
+
+ * pccl-20.el: Update broken facility message with Emacs version
+ it fixes.
+
+1999-02-07 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * install.el (install-prefix): Modify for Meadow.
+
+1999-01-26 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * mcs-20.el (mime-charset-to-coding-system-default-method): New
+ user option.
+ (mime-charset-to-coding-system): Call
+ `mime-charset-to-coding-system-default-method' if suitable
+ coding-system is not found.
+
+1999-01-21 Keiichi Suzuki <kei-suzu@mail.wbs.ne.jp>
+
+ * mcs-xm.el (encode-mime-charset-region): Add new optional
+ argument `lbt'.
+ (encode-mime-charset-string): Ditto.
+
+ * mcs-nemacs.el (lbt-to-string): New inline function.
+ (encode-mime-charset-region): Add new optional argument `lbt'.
+ (encode-mime-charset-string): Ditto.
+
+ * mcs-ltn1.el (lbt-to-string): New inline function.
+ (encode-mime-charset-region): Add new optional argument `lbt'.
+ (encode-mime-charset-string): Ditto.
+ (decode-mime-charset-region): Use `lbt-to-string'.
+
+ * mcs-e20.el (encode-mime-charset-region): Add new optional
+ argument `lbt'.
+ (encode-mime-charset-string): Ditto.
+
+ * mcs-om.el (lbt-to-string): New inline function.
+ (encode-mime-charset-region): Add new optional argument `lbt'.
+ (encode-mime-charset-string): Ditto.
+ (decode-mime-charset-region): Use `lbt-to-string'.
+ (decode-mime-charset-string): Ditto.
+
+1998-12-24 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * mcs-om.el (default-mime-charset-for-write): New variable.
+ (detect-mime-charset-region): Return
+ `default-mime-charset-for-write' if suitable mime-charset is not
+ found.
+
+ * mcs-20.el (detect-mime-charset-region): Don't call
+ `default-mime-charset-detect-method-for-write' if suitable
+ mime-charset is found.
+
+ * mcharset.el (charsets-to-mime-charset): Return nil if suitable
+ mime-charset is not found; abolish optional argument `default'.
+
+1998-12-23 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * mcs-xm.el (charsets-mime-charset-alist): Don't set up
+ `iso-2022-int-1' in default.
+
+ * mcs-20.el (default-mime-charset-for-write): New user option.
+ (default-mime-charset-detect-method-for-write): New user option.
+ (detect-mime-charset-region): Refer
+ `default-mime-charset-detect-method-for-write' or
+ `default-mime-charset-for-write' if suitable mime-charset is not
+ found.
+
+ * mcharset.el (charsets-to-mime-charset): Add new optional
+ argument `default'.
+
1999-02-26 Katsumi Yamaoka <yamaoka@jpl.org>
* poem-nemacs.el (find-file-noselect-as-coding-system): Bind
1998-04-27 MORIOKA Tomohiko <morioka@jaist.ac.jp>
* calist.el (ctree-find-calist): Renamed from
- 'ctree-match-calist-all.
+ 'ctree-match-calist-all.
\f
1998-04-25 MORIOKA Tomohiko <morioka@jaist.ac.jp>
install:
$(EMACS) $(FLAGS) -f install-apel $(PREFIX) $(LISPDIR) \
- $(VERSION_SPECIFIC_LISPDIR)
+ $(VERSION_SPECIFIC_LISPDIR) # $(MAKE)
install-package:
- $(XEMACS) $(FLAGS) -f install-apel-package $(PACKAGEDIR)
+ $(XEMACS) $(FLAGS) -f install-apel-package $(PACKAGEDIR) \
+ # $(MAKE)
what-where:
broken.el --- provide information of broken facilities of Emacs.
pccl.el --- utility to write portable CCL program
- pccl-om.el --- for MULE 1.*, 2.*
+ pccl-om.el --- for MULE 2.*
pccl-20.el --- for Emacs 20/XEmacs-21-MULE
alist.el: utility for Association-list
broken.el --- Emacs \e$B$N2u$l$F$$$k5!G=$N>pJs$rDs6!$9$k\e(B
pccl.el --- \e$B0\?"2DG=$J\e(B CCL \e$B%W%m%0%i%`$r=q$/$?$a$N%f!<%F%#%j%F%#!<\e(B
- pccl-om.el --- MULE 1.*, 2.* \e$BMQ\e(B
+ pccl-om.el --- MULE 2.* \e$BMQ\e(B
pccl-20.el --- Emacs 20/XEmacs-21-MULE \e$BMQ\e(B
alist.el: \e$BO"A[%j%9%H$N$?$a$N%f!<%F%#%j%F%#!<\e(B
;;; install.el --- Emacs Lisp package install utility
-;; Copyright (C) 1996 Free Software Foundation, Inc.
+;; Copyright (C) 1996,1997,1998,1999 Free Software Foundation, Inc.
;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
;; Created: 1996/08/18
-;; Version: $Id: install.el,v 4.2 1997/11/06 15:52:08 morioka Exp $
;; Keywords: install, byte-compile, directory detection
;; This file is part of APEL (A Portable Emacs Library).
(defvar install-overwritten-file-modes (+ (* 64 6)(* 8 4) 4))
-(defun install-file (file src dest &optional move overwrite)
- (let ((src-file (expand-file-name file src)))
- (if (file-exists-p src-file)
- (let ((full-path (expand-file-name file dest)))
- (if (and (file-exists-p full-path) overwrite)
- (delete-file full-path)
- )
- (copy-file src-file full-path t t)
- (if move
- (catch 'tag
- (while (and (file-exists-p src-file)
- (file-writable-p src-file))
- (condition-case err
- (progn
- (delete-file src-file)
- (throw 'tag nil)
- )
- (error (princ (format "%s\n" (nth 1 err))))
- ))))
- (princ (format "%s -> %s\n" file dest))
- ))
- ))
+(defun install-file (file src dest &optional move overwrite just-print)
+ (if just-print
+ (princ (format "%s -> %s\n" file dest))
+ (let ((src-file (expand-file-name file src)))
+ (if (file-exists-p src-file)
+ (let ((full-path (expand-file-name file dest)))
+ (if (and (file-exists-p full-path) overwrite)
+ (delete-file full-path)
+ )
+ (copy-file src-file full-path t t)
+ (if move
+ (catch 'tag
+ (while (and (file-exists-p src-file)
+ (file-writable-p src-file))
+ (condition-case err
+ (progn
+ (delete-file src-file)
+ (throw 'tag nil)
+ )
+ (error (princ (format "%s\n" (nth 1 err))))
+ ))))
+ (princ (format "%s -> %s\n" file dest))
+ ))
+ )))
-(defun install-files (files src dest &optional move overwrite)
+(defun install-files (files src dest &optional move overwrite just-print)
(or (file-exists-p dest)
(make-directory dest t)
)
(mapcar (function (lambda (file)
- (install-file file src dest move overwrite)
+ (install-file file src dest move overwrite just-print)
))
files))
;;; @@ install Emacs Lisp files
;;;
-(defun install-elisp-module (module src dest)
+(defun install-elisp-module (module src dest &optional just-print)
(let (el-file elc-file)
(let ((name (symbol-name module)))
(setq el-file (concat name ".el"))
(setq elc-file (concat name ".elc"))
)
(let ((src-file (expand-file-name el-file src)))
- (if (file-exists-p src-file)
+ (if (not (file-exists-p src-file))
+ nil
+ (if just-print
+ (princ (format "%s -> %s\n" el-file dest))
(let ((full-path (expand-file-name el-file dest)))
(if (file-exists-p full-path)
- (delete-file full-path)
+ (delete-file full-path)
)
(copy-file src-file full-path t t)
(princ (format "%s -> %s\n" el-file dest))
- ))
+ )))
(setq src-file (expand-file-name elc-file src))
- (if (file-exists-p src-file)
+ (if (not (file-exists-p src-file))
+ nil
+ (if just-print
+ (princ (format "%s -> %s\n" elc-file dest))
(let ((full-path (expand-file-name elc-file dest)))
(if (file-exists-p full-path)
(delete-file full-path)
(error (princ (format "%s\n" (nth 1 err))))
)))
(princ (format "%s -> %s\n" elc-file dest))
- ))
+ )))
)))
-(defun install-elisp-modules (modules src dest)
+(defun install-elisp-modules (modules src dest &optional just-print)
(or (file-exists-p dest)
(make-directory dest t)
)
(mapcar (function (lambda (module)
- (install-elisp-module module src dest)
+ (install-elisp-module module src dest just-print)
))
modules))
;;;
(defvar install-prefix
- (if (or running-emacs-18 running-xemacs)
+ (if (or running-emacs-18 running-xemacs
+ (string= system-configuration-options "NT")) ; for Meadow
(expand-file-name "../../.." exec-directory)
(expand-file-name "../../../.." data-directory)
)) ; install to shared directory (maybe "/usr/local")
(defun charsets-to-mime-charset (charsets)
"Return MIME charset from list of charset CHARSETS.
-This function refers variable `charsets-mime-charset-alist'
-and `default-mime-charset'."
+Return nil if suitable mime-charset is not found."
(if charsets
- (or (catch 'tag
- (let ((rest charsets-mime-charset-alist)
- cell)
- (while (setq cell (car rest))
- (if (catch 'not-subset
- (let ((set1 charsets)
- (set2 (car cell))
- obj)
- (while set1
- (setq obj (car set1))
- (or (memq obj set2)
- (throw 'not-subset nil))
- (setq set1 (cdr set1)))
- t))
- (throw 'tag (cdr cell)))
- (setq rest (cdr rest)))))
- default-mime-charset)))
+ (catch 'tag
+ (let ((rest charsets-mime-charset-alist)
+ cell)
+ (while (setq cell (car rest))
+ (if (catch 'not-subset
+ (let ((set1 charsets)
+ (set2 (car cell))
+ obj)
+ (while set1
+ (setq obj (car set1))
+ (or (memq obj set2)
+ (throw 'not-subset nil))
+ (setq set1 (cdr set1)))
+ t))
+ (throw 'tag (cdr cell)))
+ (setq rest (cdr rest)))
+ ))))
;;; @ end
;;; mcs-20.el --- MIME charset implementation for Emacs 20 and XEmacs/mule
-;; Copyright (C) 1997,1998 Free Software Foundation, Inc.
+;; Copyright (C) 1997,1998,1999 Free Software Foundation, Inc.
;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
;; Keywords: emulation, compatibility, Mule
:group 'i18n
:type '(repeat (cons symbol coding-system)))
+(defcustom mime-charset-to-coding-system-default-method
+ nil
+ "Function called when suitable coding-system is not found from MIME-charset.
+It must be nil or function.
+If it is a function, interface must be (CHARSET LBT CODING-SYSTEM)."
+ :group 'i18n
+ :type '(choice function (const nil)))
+
(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 (stringp charset)
(setq charset (intern (downcase charset)))
)
- (let ((ret (assq charset mime-charset-coding-system-alist)))
- (if ret
- (setq charset (cdr ret))
- ))
- (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 (find-coding-system charset)
- charset
- ))
+ (let ((cs (assq charset mime-charset-coding-system-alist)))
+ (setq cs
+ (if cs
+ (cdr cs)
+ charset))
+ (if lbt
+ (setq cs (intern (format "%s-%s" cs
+ (cond ((eq lbt 'CRLF) 'dos)
+ ((eq lbt 'LF) 'unix)
+ ((eq lbt 'CR) 'mac)
+ (t lbt)))))
+ )
+ (if (find-coding-system cs)
+ cs
+ (if mime-charset-to-coding-system-default-method
+ (funcall mime-charset-to-coding-system-default-method
+ charset lbt cs)
+ ))))
(defvar widget-mime-charset-prompt-value-history nil
"History of input to `widget-mime-charset-prompt-value'.")
:group 'i18n
:type 'mime-charset)
-(defsubst detect-mime-charset-region (start end)
+(defcustom default-mime-charset-for-write
+ (if (find-coding-system 'utf-8)
+ 'utf-8
+ default-mime-charset)
+ "Default value of MIME-charset for encoding.
+It may be used when suitable MIME-charset is not found.
+It must be symbol."
+ :group 'i18n
+ :type 'mime-charset)
+
+(defcustom default-mime-charset-detect-method-for-write
+ nil
+ "Function called when suitable MIME-charset is not found to encode.
+It must be nil or function.
+If it is nil, variable `default-mime-charset-for-write' is used.
+If it is a function, interface must be (TYPE CHARSETS &rest ARGS).
+CHARSETS is list of charset.
+If TYPE is 'region, ARGS has START and END."
+ :group 'i18n
+ :type '(choice function (const nil)))
+
+(defun detect-mime-charset-region (start end)
"Return MIME charset for region between START and END."
- (charsets-to-mime-charset (find-charset-region start end)))
+ (let ((charsets (find-charset-region start end)))
+ (or (charsets-to-mime-charset charsets)
+ (if default-mime-charset-detect-method-for-write
+ (funcall default-mime-charset-detect-method-for-write
+ 'region charsets start end)
+ default-mime-charset-for-write)
+ )))
(defun write-region-as-mime-charset (charset start end filename
&optional append visit lockname)
;;; Code:
-(defsubst encode-mime-charset-region (start end charset)
+(defsubst encode-mime-charset-region (start end charset &optional lbt)
"Encode the text between START and END as MIME CHARSET."
(let (cs)
(if (and enable-multibyte-characters
- (setq cs (mime-charset-to-coding-system charset)))
+ (setq cs (mime-charset-to-coding-system charset lbt)))
(encode-coding-region start end cs)
)))
)))
-(defsubst encode-mime-charset-string (string charset)
+(defsubst encode-mime-charset-string (string charset &optional lbt)
"Encode the STRING as MIME CHARSET."
(let (cs)
(if (and enable-multibyte-characters
- (setq cs (mime-charset-to-coding-system charset)))
+ (setq cs (mime-charset-to-coding-system charset lbt)))
(encode-coding-string string cs)
string)))
latin-jisx0201 japanese-jisx0208-1978
chinese-gb2312 japanese-jisx0208
korean-ksc5601 japanese-jisx0212) . iso-2022-jp-2)
- ((ascii latin-iso8859-1 greek-iso8859-7
- latin-jisx0201 japanese-jisx0208-1978
- chinese-gb2312 japanese-jisx0208
- korean-ksc5601 japanese-jisx0212
- chinese-cns11643-1 chinese-cns11643-2) . iso-2022-int-1)
- ((ascii latin-iso8859-1 latin-iso8859-2
- cyrillic-iso8859-5 greek-iso8859-7
- latin-jisx0201 japanese-jisx0208-1978
- chinese-gb2312 japanese-jisx0208
- korean-ksc5601 japanese-jisx0212
- chinese-cns11643-1 chinese-cns11643-2
- chinese-cns11643-3 chinese-cns11643-4
- chinese-cns11643-5 chinese-cns11643-6
- chinese-cns11643-7) . iso-2022-int-1)
+; ((ascii latin-iso8859-1 greek-iso8859-7
+; latin-jisx0201 japanese-jisx0208-1978
+; chinese-gb2312 japanese-jisx0208
+; korean-ksc5601 japanese-jisx0212
+; chinese-cns11643-1 chinese-cns11643-2) . iso-2022-int-1)
+; ((ascii latin-iso8859-1 latin-iso8859-2
+; cyrillic-iso8859-5 greek-iso8859-7
+; latin-jisx0201 japanese-jisx0208-1978
+; chinese-gb2312 japanese-jisx0208
+; korean-ksc5601 japanese-jisx0212
+; chinese-cns11643-1 chinese-cns11643-2
+; chinese-cns11643-3 chinese-cns11643-4
+; chinese-cns11643-5 chinese-cns11643-6
+; chinese-cns11643-7) . iso-2022-int-1)
))
+(defun-maybe coding-system-get (coding-system prop)
+ "Extract a value from CODING-SYSTEM's property list for property PROP."
+ (plist-get (coding-system-plist coding-system) prop)
+ )
(defun coding-system-to-mime-charset (coding-system)
"Convert CODING-SYSTEM to a MIME-charset.
Return nil if corresponding MIME-charset is not found."
(or (car (rassq coding-system mime-charset-coding-system-alist))
- (coding-system-get coding-system 'mime-charset)))
+ (coding-system-get coding-system 'mime-charset)
+ ))
-(defun mime-charset-list ()
+(defun-maybe-cond mime-charset-list ()
"Return a list of all existing MIME-charset."
- (let ((dest (mapcar (function car) mime-charset-coding-system-alist))
- (rest coding-system-list)
- cs)
- (while rest
- (setq cs (car rest))
- (unless (rassq cs mime-charset-coding-system-alist)
- (if (setq cs (coding-system-get cs 'mime-charset))
+ ((boundp 'coding-system-list)
+ (let ((dest (mapcar (function car) mime-charset-coding-system-alist))
+ (rest coding-system-list)
+ cs)
+ (while rest
+ (setq cs (car rest))
+ (unless (rassq cs mime-charset-coding-system-alist)
+ (if (setq cs (coding-system-get cs 'mime-charset))
+ (or (rassq cs mime-charset-coding-system-alist)
+ (memq cs dest)
+ (setq dest (cons cs dest))
+ )))
+ (setq rest (cdr rest)))
+ dest))
+ (t
+ (let ((dest (mapcar (function car) mime-charset-coding-system-alist))
+ (rest (coding-system-list))
+ cs)
+ (while rest
+ (setq cs (car rest))
+ (unless (rassq cs mime-charset-coding-system-alist)
+ (when (setq cs (or (coding-system-get cs 'mime-charset)
+ (and
+ (setq cs (aref
+ (coding-system-get cs 'coding-spec)
+ 2))
+ (string-match "(MIME:[ \t]*\\([^,)]+\\)" cs)
+ (match-string 1 cs))))
+ (setq cs (intern (downcase cs)))
(or (rassq cs mime-charset-coding-system-alist)
- (memq cs dest)
+ (memq cs dest)
(setq dest (cons cs dest))
)))
- (setq rest (cdr rest)))
- dest))
-
+ (setq rest (cdr rest)))
+ dest)
+ ))
;;; @ end
;;;
(defvar default-mime-charset 'iso-8859-1)
+(defsubst lbt-to-string (lbt)
+ (cdr (assq lbt '((nil . nil)
+ (CRLF . "\r\n")
+ (CR . "\r")
+ (dos . "\r\n")
+ (mac . "\r"))))
+ )
+
(defun mime-charset-to-coding-system (charset)
(if (stringp charset)
(setq charset (intern (downcase charset)))
default-mime-charset
'us-ascii))
-(defun encode-mime-charset-region (start end charset)
+(defun encode-mime-charset-region (start end charset &optional lbt)
"Encode the text between START and END as MIME CHARSET."
- )
+ (let ((newline (lbt-to-string lbt)))
+ (if newline
+ (save-excursion
+ (save-restriction
+ (narrow-to-region start end)
+ (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."
- (cond ((eq lbt 'CRLF)
- (save-excursion
- (save-restriction
- (narrow-to-region start end)
- (goto-char (point-min))
- (while (search-forward "\r\n" nil t)
- (replace-match "\n"))
- ))
- )))
-
-(defun encode-mime-charset-string (string charset)
+ (let ((newline (lbt-to-string lbt)))
+ (if newline
+ (save-excursion
+ (save-restriction
+ (narrow-to-region start end)
+ (goto-char (point-min))
+ (while (search-forward newline nil t)
+ (replace-match "\n"))
+ )))
+ ))
+
+(defun encode-mime-charset-string (string charset &optional lbt)
"Encode the STRING as MIME CHARSET."
- string)
+ (if lbt
+ (with-temp-buffer
+ (insert string)
+ (encode-mime-charset-region (point-min)(point-max) charset lbt)
+ (buffer-string))
+ string))
(defun decode-mime-charset-string (string charset &optional lbt)
"Decode the STRING as MIME CHARSET."
(shift_jis . 1)
))
+(defsubst lbt-to-string (lbt)
+ (cdr (assq lbt '((nil . nil)
+ (CRLF . "\r\n")
+ (CR . "\r")
+ (dos . "\r\n")
+ (mac . "\r"))))
+ )
+
(defun mime-charset-to-coding-system (charset)
(if (stringp charset)
(setq charset (intern (downcase charset)))
default-mime-charset
'us-ascii))
-(defun encode-mime-charset-region (start end charset)
+(defun encode-mime-charset-region (start end charset &optional lbt)
"Encode the text between START and END as MIME CHARSET.
\[emu-nemacs.el]"
- (let ((cs (mime-charset-to-coding-system charset)))
+ (let ((cs (mime-charset-to-coding-system charset))
+ (nl (lbt-to-string lbt)))
(and (numberp cs)
(or (= cs 3)
(save-excursion
(save-restriction
(narrow-to-region start end)
- (convert-region-kanji-code start end 3 cs))))
- )))
+ (convert-region-kanji-code start end 3 cs)
+ (if nl
+ (progn
+ (goto-char (point-min))
+ (while (search-forward "\n" nil t)
+ (replace-match nl)))
+ )))
+ ))))
(defun decode-mime-charset-region (start end charset &optional lbt)
"Decode the text between START and END as MIME CHARSET.
\[emu-nemacs.el]"
(let ((cs (mime-charset-to-coding-system charset))
- (nl (cdr (assq lbt '((CRLF . "\r\n") (CR . "\r")
- (dos . "\r\n") (mac . "\r"))))))
+ (nl (lbt-to-string lbt)))
(and (numberp cs)
(or (= cs 3)
(save-excursion
)))
))))
-(defun encode-mime-charset-string (string charset)
+(defun encode-mime-charset-string (string charset &optional lbt)
"Encode the STRING as MIME CHARSET. [emu-nemacs.el]"
- (let ((cs (mime-charset-to-coding-system charset)))
- (if cs
- (convert-string-kanji-code string 3 cs)
- string)))
+ (with-temp-buffer
+ (insert string)
+ (encode-mime-charset-region (point-min)(point-max) charset lbt)
+ (buffer-string)))
(defun decode-mime-charset-string (string charset &optional lbt)
"Decode the STRING as MIME CHARSET. [emu-nemacs.el]"
(require 'poem)
-(defun encode-mime-charset-region (start end 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))))
))
(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)))
)
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
(require 'mcs-20)
-(defun encode-mime-charset-region (start end charset)
+(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
(encode-coding-region start end cs)
)))
(assq t mime-charset-decoder-alist)))))
(funcall func start end charset lbt)))
-(defsubst encode-mime-charset-string (string charset)
+(defsubst 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
(encode-coding-string string cs)
string)))
latin-jisx0201 japanese-jisx0208-1978
chinese-gb2312 japanese-jisx0208
korean-ksc5601 japanese-jisx0212) . iso-2022-jp-2)
- ((ascii latin-iso8859-1 greek-iso8859-7
- latin-jisx0201 japanese-jisx0208-1978
- chinese-gb2312 japanese-jisx0208
- korean-ksc5601 japanese-jisx0212
- chinese-cns11643-1 chinese-cns11643-2) . iso-2022-int-1)
+ ;; ((ascii latin-iso8859-1 greek-iso8859-7
+ ;; latin-jisx0201 japanese-jisx0208-1978
+ ;; chinese-gb2312 japanese-jisx0208
+ ;; korean-ksc5601 japanese-jisx0212
+ ;; chinese-cns11643-1 chinese-cns11643-2) . iso-2022-int-1)
))
)
(broken-facility ccl-execute-eof-block-on-encoding-null
- "Emacs forgets executing CCL_EOF_BLOCK with encoding on empty input."
+ "Emacs forgets executing CCL_EOF_BLOCK with encoding on empty input. (Fixed on Emacs 20.4)"
(equal (encode-coding-string "" 'test-ccl-eof-block-cs) "[EOF]"))
(broken-facility ccl-execute-eof-block-on-encoding-some
- "Emacs forgets executing CCL_EOF_BLOCK with encoding on non-empty input."
+ "Emacs forgets executing CCL_EOF_BLOCK with encoding on non-empty input. (Fixed on Emacs 20.3)"
(equal (encode-coding-string "a" 'test-ccl-eof-block-cs) "a[EOF]"))
(broken-facility ccl-execute-eof-block-on-decoding-null
- "Emacs forgets executing CCL_EOF_BLOCK with decoding on empty input."
+ "Emacs forgets executing CCL_EOF_BLOCK with decoding on empty input. (Fixed on Emacs 20.4)"
(equal (decode-coding-string "" 'test-ccl-eof-block-cs) "[EOF]"))
(broken-facility ccl-execute-eof-block-on-decoding-some
- "Emacs forgets executing CCL_EOF_BLOCK with decoding on non-empty input."
+ "Emacs forgets executing CCL_EOF_BLOCK with decoding on non-empty input. (Fixed on Emacs 20.4)"
(equal (decode-coding-string "a" 'test-ccl-eof-block-cs) "a[EOF]"))
(broken-facility ccl-execute-eof-block-on-encoding
-;;; pccl.el --- Portable CCL utility for Mule 1.* and Mule 2.*
+;;; pccl.el --- Portable CCL utility for Mule 2.*
;; Copyright (C) 1998 Free Software Foundation, Inc.
(require 'broken)
-;; The condition for non-XEmacs mule t may be wrong.
-;; But I don't know exact version which introduce CCL on mule.
(broken-facility ccl-usable
- "Emacs has CCL."
+ "Emacs has not CCL."
(and (featurep 'mule)
(if (featurep 'xemacs)
(>= emacs-major-version 21)
- t)))
+ (>= emacs-major-version 19))))
(unless-broken ccl-usable
(require 'ccl)
(if (featurep 'mule)
(if (featurep 'xemacs)
(if (>= emacs-major-version 21)
- ;; for XEmacs-21-mule
+ ;; for XEmacs 21 with mule
(require 'pccl-20))
(if (>= emacs-major-version 20)
;; for Emacs 20
(require 'pccl-20)
- ;; for MULE 1.* and 2.*
+ ;; for Mule 2.*
(require 'pccl-om))))
(defadvice define-ccl-program
projects / elisp / apel.git / commitdiff