From: tomo Date: Tue, 14 May 2002 12:00:28 +0000 (+0000) Subject: Sync with apel-10_3-1. X-Git-Tag: Emacs-21_1-LEMI-1_14-0~8 X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=5c35c2f96b7bc9487143d2c9ebc5c8f46e7f167c;p=elisp%2Flemi.git Sync with apel-10_3-1. --- diff --git a/poe/inv-19.el b/poe/inv-19.el index 287a007..d96df39 100644 --- a/poe/inv-19.el +++ b/poe/inv-19.el @@ -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 ;; Keywords: invisible, text-property, region, Emacs 19 @@ -45,11 +45,11 @@ (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 diff --git a/poe/pccl-20.el b/poe/pccl-20.el index b95244a..e332020 100644 --- a/poe/pccl-20.el +++ b/poe/pccl-20.el @@ -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 +;; Author: Tanaka Akira ;; Keywords: emulation, compatibility, Mule ;; This file is part of APEL (A Portable Emacs Library). @@ -48,6 +47,26 @@ (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) "\ diff --git a/poe/pccl.el b/poe/pccl.el index c696f75..bbb2a2a 100644 --- a/poe/pccl.el +++ b/poe/pccl.el @@ -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 +;; Author: Tanaka Akira ;; Keywords: emulation, compatibility, Mule ;; This file is part of APEL (A Portable Emacs Library). @@ -34,38 +34,131 @@ (>= 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