diff lisp/w3/mule-sysdp.el @ 80:1ce6082ce73f r20-0b90

Import from CVS: tag r20-0b90
author cvs
date Mon, 13 Aug 2007 09:06:37 +0200
parents 9ee227acff29
children 0293115a14e9
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/w3/mule-sysdp.el	Mon Aug 13 09:06:37 2007 +0200
@@ -0,0 +1,160 @@
+;;; mule-sysdp.el --- consolidate MULE-version dependencies in one file.
+
+;; Copyright (C) 1996 William Perry
+
+;; Author: William Perry <wmperry@aventail.com>
+;; Keywords: lisp, tools
+
+;; The purpose of this file is to eliminate the cruftiness that
+;; would otherwise be required of packages that want to run on multiple
+;; versions of Emacs with and without Mule support.
+
+(require 'cl)
+
+(defconst mule-sysdep-version (if (featurep 'mule)
+				  (cond
+				   ((string-match "XEmacs" emacs-version)
+				    'xemacs)
+				   ((and
+				     (boundp 'mule-version)
+				     (string-match "[0-9]+\\.[0-9]+"
+						   mule-version))
+				    (string-to-number (substring
+						       mule-version
+						       (match-beginning 0)
+						       (match-end 0))))
+				   (t 2.3))
+				0)
+  "What version of mule we are running under.")
+
+(defconst mule-retrieval-coding-system
+  (case mule-sysdep-version
+    (2.3 *euc-japan*)
+    (2.4 'coding-system-euc-japan)
+    (xemacs 'euc-japan)
+    (otherwise nil))
+  "Default retrieval coding system for packages that use this package.")
+
+(defconst mule-no-coding-system
+  (case mule-sysdep-version
+    (2.4 'no-conversion)
+    (2.3 *noconv*)
+    (xemacs 'no-conversion)
+    (otherwise nil))
+  "Coding system that means no coding system should be used.")
+
+(defun mule-detect-coding-version (st nd)
+  (case mule-sysdep-version
+    (2.3 (code-detect-region (point-min) (point-max)))
+    (2.4 (detect-coding-region (point-min) (point-max)))
+    (xemacs (detect-coding-region (point-min) (point-max)))
+    (otherwise nil)))
+
+(defun mule-code-convert-region (st nd code)
+  (case mule-sysdep-version
+    (2.3
+     (setq mc-flag t)
+     (code-convert-region (point-min) (point-max) code *internal*)
+     (set-file-coding-system code))
+    (2.4
+     (setq enable-multibyte-characters t)
+     (if (eq code 'coding-system-automatic)
+	 nil
+       (decode-coding-region st nd code)
+       (set-buffer-file-coding-system code)))
+    (xemacs
+     (decode-coding-region (point-min) (point-max) code)
+     (set-file-coding-system code))
+    (otherwise
+     nil)))
+
+(defun mule-inhibit-code-conversion (proc)
+  (if (process-buffer proc)
+      (save-excursion
+	(set-buffer (process-buffer proc))
+	(set 'mc-flag nil)
+	(set 'enable-multibyte-characters nil)))
+  (case mule-sysdep-version
+    ((2.4 2.3)
+     (set-process-coding-system proc mule-no-coding-system
+				mule-no-coding-system))
+    (xemacs
+     (set-process-input-coding-system proc mule-no-coding-system)
+     (set-process-input-coding-system proc mule-no-coding-system))))
+
+(defun mule-write-region-no-coding-system (st nd file)
+  (let ((enable-multibyte-characters t)
+	(coding-system-for-write 'no-conversion)
+	(file-coding-system mule-no-coding-system)
+	(buffer-file-coding-system mule-no-coding-system)
+	(mc-flag t))
+    (case mule-sysdep-version
+      (2.3 (write-region st nd file nil nil nil *noconv*))
+      (otherwise
+       (write-region st nd file)))))
+
+(defun mule-encode-string (str)
+  (case mule-sysdep-version
+    (2.3
+     (code-convert-string str *internal* mule-retrieval-coding-system))
+    ((2.4 xemacs)
+     (encode-coding-string str mule-retrieval-coding-system))
+    (otherwise
+     str)))
+
+(defun mule-decode-string (str)
+  (and str
+       (case mule-sysdep-version
+	 ((2.4 xemacs)
+	  (decode-coding-string str mule-retrieval-coding-system))
+	 (2.3
+	  (code-convert-string str *internal* mule-retrieval-coding-system))
+	 (otherwise
+	  str))))
+
+(defun mule-truncate-string (str len &optional pad)
+  "Truncate string STR so that string-width of STR is not greater than LEN.
+ If width of the truncated string is less than LEN, and if a character PAD is
+ defined, add padding end of it."
+  (case mule-sysdep-version
+    (2.4
+     (let ((cl (string-to-vector str)) (n 0) (sw 0))
+       (if (<= (string-width str) len) str
+	 (while (<= (setq sw (+ (char-width (aref cl n)) sw)) len)
+	   (setq n (1+ n)))
+	 (string-match (make-string n ?.) str)
+	 (setq str (substring str 0 (match-end 0))))
+       (if pad (concat str (make-string (- len (string-width str)) pad)) str)))
+    (2.3
+     (let ((cl (string-to-char-list str)) (n 0) (sw 0))
+       (if (<= (string-width str) len) str
+	 (while (<= (setq sw (+ (char-width (nth n cl)) sw)) len)
+	   (setq n (1+ n)))
+	 (string-match (make-string n ?.) str)
+	 (setq str (substring str 0 (match-end 0))))
+       (if pad (concat str (make-string (- len (string-width str)) pad)) str)))
+    (otherwise
+     (concat (if (> (length str) len) (substring str 0 len) str)
+	     (if (or (null pad) (> (length str) len))
+		 ""
+	       (make-string (- len (length str)) pad))))))
+
+(defun mule-make-iso-character (char)
+  (if (<= char 127)
+      char
+    (case mule-sysdep-version
+      (2.3 (make-character lc-ltn1 char))
+      (2.4 (make-char charset-latin-iso8859-1 char))
+      (xemacs char)
+      (otherwise char))))
+
+(case mule-sysdep-version
+  ((2.3 2.4 xemacs) nil)
+  (otherwise (fset 'string-width 'length)))
+
+(and
+ (boundp 'MULE)
+ (not (featurep 'mule))
+ (provide 'mule))
+
+(provide 'mule-sysdp)