Sync with apel-10_3-1.
authortomo <tomo>
Tue, 14 May 2002 12:00:28 +0000 (12:00 +0000)
committertomo <tomo>
Tue, 14 May 2002 12:00:28 +0000 (12:00 +0000)
poe/inv-19.el
poe/pccl-20.el
poe/pccl.el

index 287a007..d96df39 100644 (file)
@@ -1,6 +1,6 @@
 ;;; inv-19.el --- invisible feature implementation for Emacs 19 or later
 
-;; Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc.
+;; Copyright (C) 1995,1996,1997,1998,1999,2001 Free Software Foundation, Inc.
 
 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
 ;; Keywords: invisible, text-property, region, Emacs 19
   (get-text-property pos 'invisible))
 
 (defun next-visible-point (pos)
-  (save-excursion
-    (goto-char (next-single-property-change pos 'invisible))
-    (if (eq (following-char) ?\n)
-       (forward-char))
-    (point)))
+  (if (setq pos (next-single-property-change pos 'invisible))
+      (if (eq ?\n (char-after pos))
+         (1+ pos)
+       pos)
+    (point-max)))
 
 
 ;;; @ end
index b95244a..e332020 100644 (file)
@@ -1,9 +1,8 @@
 ;;; pccl-20.el --- Portable CCL utility for Emacs 20 and XEmacs-21-mule
 
-;; Copyright (C) 1998 Free Software Foundation, Inc.
-;; Copyright (C) 1998 Tanaka Akira
+;; Copyright (C) 1998,1999,2000 Free Software Foundation, Inc.
 
-;; Author: Tanaka Akira  <akr@jaist.ac.jp>
+;; Author: Tanaka Akira  <akr@m17n.org>
 ;; Keywords: emulation, compatibility, Mule
 
 ;; This file is part of APEL (A Portable Emacs Library).
 
 (eval-and-compile
 
+  (static-if (featurep 'xemacs)
+      (defadvice make-coding-system (before ccl-compat (name type &rest ad-subr-args) activate)
+       (when (and (integerp type)
+                  (eq type 4)
+                  (characterp (ad-get-arg 2))
+                  (stringp (ad-get-arg 3))
+                  (consp (ad-get-arg 4))
+                  (symbolp (car (ad-get-arg 4)))
+                  (symbolp (cdr (ad-get-arg 4))))
+         (setq type 'ccl)
+         (setq ad-subr-args
+               (list
+                (ad-get-arg 3)
+                (append
+                 (list
+                  'mnemonic (char-to-string (ad-get-arg 2))
+                  'decode (symbol-value (car (ad-get-arg 4)))
+                  'encode (symbol-value (cdr (ad-get-arg 4))))
+                 (ad-get-arg 5)))))))
+
   (if (featurep 'xemacs)
       (defun make-ccl-coding-system (name mnemonic docstring decoder encoder)
        "\
index c696f75..bbb2a2a 100644 (file)
@@ -1,8 +1,8 @@
 ;;; pccl.el --- Portable CCL utility for Mule 2.*
 
-;; Copyright (C) 1998 Free Software Foundation, Inc.
+;; Copyright (C) 1998,1999,2001,2002 Free Software Foundation, Inc.
 
-;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; Author: Tanaka Akira <akr@m17n.org>
 ;; Keywords: emulation, compatibility, Mule
 
 ;; This file is part of APEL (A Portable Emacs Library).
          (>= emacs-major-version 19))))
 
 (unless-broken ccl-usable
-  (require 'ccl)
   (require 'advice)
 
   (if (featurep 'mule)
-      (if (featurep 'xemacs)
-          (if (>= emacs-major-version 21)
-              ;; for XEmacs 21 with mule
-              (require 'pccl-20))
-        (if (>= emacs-major-version 20)
-            ;; for Emacs 20
-            (require 'pccl-20)
-          ;; 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 automaticaly."
-    (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))))))))
-  )
+      (progn
+       (require 'ccl)
+       (if (featurep 'xemacs)
+            (if (>= emacs-major-version 21)
+                ;; for XEmacs 21 with mule
+                (require 'pccl-20))
+          (if (>= emacs-major-version 20)
+              ;; for Emacs 20
+              (require 'pccl-20)
+            ;; for Mule 2.*
+            (require 'pccl-om)))))
+
+  (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)
+             nil (, 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)
+             nil (, 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 (and (symbolp type) (not (memq type '(t nil))))
+        (let ((args (apply 'transform-make-coding-system-args
+                          name type ad-subr-args)))
+         (setq type (cadr args)
+               ad-subr-args (cddr args)))))))
 
 
 ;;; @ end