From: akr Date: Thu, 24 May 2001 03:03:19 +0000 (+0000) Subject: * pccl.el (accept-long-ccl-program): Don't advice for Emacs 21. X-Git-Tag: apel-10_3-1~18 X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=dfd2f7162fe8801265f2a62e66567e00ea0ffe97;p=elisp%2Fapel.git * pccl.el (accept-long-ccl-program): Don't advice for Emacs 21. (transform-make-coding-system-args): New emulating function. (ccl-compat): new advice for `make-coding-system' of Emacs 20 or former to handle XEmacs style CCL coding system definition. --- diff --git a/ChangeLog b/ChangeLog index d18752a..62d4668 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,10 @@ +2001-05-24 Tanaka Akira + + * pccl.el (accept-long-ccl-program): Don't advice for Emacs 21. + (transform-make-coding-system-args): New emulating function. + (ccl-compat): new advice for `make-coding-system' of + Emacs 20 or former to handle XEmacs style CCL coding system definition. + 2001-04-29 Shuhei KOBAYASHI * poe.el (remassoc, remassq, remrassoc, remrassq): Fixed. diff --git a/pccl.el b/pccl.el index 7f7f3a9..4b0dead 100644 --- a/pccl.el +++ b/pccl.el @@ -48,24 +48,114 @@ ;; for Mule 2.* (require 'pccl-om)))) - (defadvice define-ccl-program - (before accept-long-ccl-program activate) - "When CCL-PROGRAM is too long, internal buffer is extended automatically." - (let ((try-ccl-compile t) - (prog (eval (ad-get-arg 1)))) - (ad-set-arg 1 (` '(, prog))) - (while try-ccl-compile - (setq try-ccl-compile nil) - (condition-case sig - (ccl-compile prog) - (args-out-of-range - (if (and (eq (car (cdr sig)) ccl-program-vector) - (= (car (cdr (cdr sig))) (length ccl-program-vector))) - (setq ccl-program-vector - (make-vector (* 2 (length ccl-program-vector)) 0) - try-ccl-compile t) - (signal (car sig) (cdr sig)))))))) - ) + (static-if (or (featurep 'xemacs) (< emacs-major-version 21)) + (defadvice define-ccl-program + (before accept-long-ccl-program activate) + "When CCL-PROGRAM is too long, internal buffer is extended automatically." + (let ((try-ccl-compile t) + (prog (eval (ad-get-arg 1)))) + (ad-set-arg 1 (` '(, prog))) + (while try-ccl-compile + (setq try-ccl-compile nil) + (condition-case sig + (ccl-compile prog) + (args-out-of-range + (if (and (eq (car (cdr sig)) ccl-program-vector) + (= (car (cdr (cdr sig))) (length ccl-program-vector))) + (setq ccl-program-vector + (make-vector (* 2 (length ccl-program-vector)) 0) + try-ccl-compile t) + (signal (car sig) (cdr sig))))))))) + + (static-when (and (not (featurep 'xemacs)) (< emacs-major-version 21)) + (defun-maybe transform-make-coding-system-args (name type &optional doc-string props) + "For internal use only. +Transform XEmacs style args for `make-coding-system' to Emacs style. +Value is a list of transformed arguments." + (let ((mnemonic (string-to-char (or (plist-get props 'mnemonic) "?"))) + (eol-type (plist-get props 'eol-type)) + properties tmp) + (cond + ((eq eol-type 'lf) (setq eol-type 'unix)) + ((eq eol-type 'crlf) (setq eol-type 'dos)) + ((eq eol-type 'cr) (setq eol-type 'mac))) + (if (setq tmp (plist-get props 'post-read-conversion)) + (setq properties (plist-put properties 'post-read-conversion tmp))) + (if (setq tmp (plist-get props 'pre-write-conversion)) + (setq properties (plist-put properties 'pre-write-conversion tmp))) + (cond + ((eq type 'shift-jis) + `(,name 1 ,mnemonic ,doc-string () ,properties ,eol-type)) + ((eq type 'iso2022) ; This is not perfect. + (if (plist-get props 'escape-quoted) + (error "escape-quoted is not supported: %S" + `(,name ,type ,doc-string ,props))) + (let ((g0 (plist-get props 'charset-g0)) + (g1 (plist-get props 'charset-g1)) + (g2 (plist-get props 'charset-g2)) + (g3 (plist-get props 'charset-g3)) + (use-roman + (and + (eq (cadr (assoc 'latin-jisx0201 + (plist-get props 'input-charset-conversion))) + 'ascii) + (eq (cadr (assoc 'ascii + (plist-get props 'output-charset-conversion))) + 'latin-jisx0201))) + (use-oldjis + (and + (eq (cadr (assoc 'japanese-jisx0208-1978 + (plist-get props 'input-charset-conversion))) + 'japanese-jisx0208) + (eq (cadr (assoc 'japanese-jisx0208 + (plist-get props 'output-charset-conversion))) + 'japanese-jisx0208-1978)))) + (if (charsetp g0) + (if (plist-get props 'force-g0-on-output) + (setq g0 `(nil ,g0)) + (setq g0 `(,g0 t)))) + (if (charsetp g1) + (if (plist-get props 'force-g1-on-output) + (setq g1 `(nil ,g1)) + (setq g1 `(,g1 t)))) + (if (charsetp g2) + (if (plist-get props 'force-g2-on-output) + (setq g2 `(nil ,g2)) + (setq g2 `(,g2 t)))) + (if (charsetp g3) + (if (plist-get props 'force-g3-on-output) + (setq g3 `(nil ,g3)) + (setq g3 `(,g3 t)))) + `(,name 2 ,mnemonic ,doc-string + (,g0 ,g1 ,g2 ,g3 + ,(plist-get props 'short) + ,(not (plist-get props 'no-ascii-eol)) + ,(not (plist-get props 'no-ascii-cntl)) + ,(plist-get props 'seven) + t + ,(not (plist-get props 'lock-shift)) + ,use-roman + ,use-oldjis + ,(plist-get props 'no-iso6429) + nil nil nil nil) + ,properties ,eol-type))) + ((eq type 'big5) + `(,name 3 ,mnemonic ,doc-string () ,properties ,eol-type)) + ((eq type 'ccl) + `(,name 4 ,mnemonic ,doc-string + (,(plist-get props 'decode) . ,(plist-get props 'encode)) + ,properties ,eol-type)) + (t + (error "unsupported XEmacs style make-coding-style arguments: %S" + `(,name ,type ,doc-string ,props)))))) + (defadvice make-coding-system + (before ccl-compat (name type &rest ad-subr-args) activate) + "Emulate XEmacs style make-coding-system." + (when (symbolp type) + (let ((args (apply 'transform-make-coding-system-args + name type ad-subr-args))) + (setq type (cadr args) + ad-subr-args (cddr args))))))) ;;; @ end