Mercurial > hg > xemacs-beta

comparison lisp/w3/mule-sysdp.el @ 14:9ee227acff29 r19-15b90

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b90
author cvs
date Mon, 13 Aug 2007 08:48:42 +0200
parents
children 0293115a14e9
comparison
equal deleted inserted replaced
13:13c6d0aaafe5 14:9ee227acff29
1 ;;; mule-sysdp.el --- consolidate MULE-version dependencies in one file.
2
3 ;; Copyright (C) 1996 William Perry
4
5 ;; Author: William Perry <wmperry@aventail.com>
6 ;; Keywords: lisp, tools
7
8 ;; The purpose of this file is to eliminate the cruftiness that
9 ;; would otherwise be required of packages that want to run on multiple
10 ;; versions of Emacs with and without Mule support.
11
12 (require 'cl)
13
14 (defconst mule-sysdep-version (if (featurep 'mule)
15 (cond
16 ((string-match "XEmacs" emacs-version)
17 'xemacs)
18 ((and
19 (boundp 'mule-version)
20 (string-match "[0-9]+\\.[0-9]+"
21 mule-version))
22 (string-to-number (substring
23 mule-version
24 (match-beginning 0)
25 (match-end 0))))
26 (t 2.3))
27 0)
28 "What version of mule we are running under.")
29
30 (defconst mule-retrieval-coding-system
31 (case mule-sysdep-version
32 (2.3 *euc-japan*)
33 (2.4 'coding-system-euc-japan)
34 (xemacs 'euc-japan)
35 (otherwise nil))
36 "Default retrieval coding system for packages that use this package.")
37
38 (defconst mule-no-coding-system
39 (case mule-sysdep-version
40 (2.4 'no-conversion)
41 (2.3 *noconv*)
42 (xemacs 'no-conversion)
43 (otherwise nil))
44 "Coding system that means no coding system should be used.")
45
46 (defun mule-detect-coding-version (st nd)
47 (case mule-sysdep-version
48 (2.3 (code-detect-region (point-min) (point-max)))
49 (2.4 (detect-coding-region (point-min) (point-max)))
50 (xemacs (detect-coding-region (point-min) (point-max)))
51 (otherwise nil)))
52
53 (defun mule-code-convert-region (st nd code)
54 (case mule-sysdep-version
55 (2.3
56 (setq mc-flag t)
57 (code-convert-region (point-min) (point-max) code *internal*)
58 (set-file-coding-system code))
59 (2.4
60 (setq enable-multibyte-characters t)
61 (if (eq code 'coding-system-automatic)
62 nil
63 (decode-coding-region st nd code)
64 (set-buffer-file-coding-system code)))
65 (xemacs
66 (decode-coding-region (point-min) (point-max) code)
67 (set-file-coding-system code))
68 (otherwise
69 nil)))
70
71 (defun mule-inhibit-code-conversion (proc)
72 (if (process-buffer proc)
73 (save-excursion
74 (set-buffer (process-buffer proc))
75 (set 'mc-flag nil)
76 (set 'enable-multibyte-characters nil)))
77 (case mule-sysdep-version
78 ((2.4 2.3)
79 (set-process-coding-system proc mule-no-coding-system
80 mule-no-coding-system))
81 (xemacs
82 (set-process-input-coding-system proc mule-no-coding-system)
83 (set-process-input-coding-system proc mule-no-coding-system))))
84
85 (defun mule-write-region-no-coding-system (st nd file)
86 (let ((enable-multibyte-characters t)
87 (coding-system-for-write 'no-conversion)
88 (file-coding-system mule-no-coding-system)
89 (buffer-file-coding-system mule-no-coding-system)
90 (mc-flag t))
91 (case mule-sysdep-version
92 (2.3 (write-region st nd file nil nil nil *noconv*))
93 (otherwise
94 (write-region st nd file)))))
95
96 (defun mule-encode-string (str)
97 (case mule-sysdep-version
98 (2.3
99 (code-convert-string str *internal* mule-retrieval-coding-system))
100 ((2.4 xemacs)
101 (encode-coding-string str mule-retrieval-coding-system))
102 (otherwise
103 str)))
104
105 (defun mule-decode-string (str)
106 (and str
107 (case mule-sysdep-version
108 ((2.4 xemacs)
109 (decode-coding-string str mule-retrieval-coding-system))
110 (2.3
111 (code-convert-string str *internal* mule-retrieval-coding-system))
112 (otherwise
113 str))))
114
115 (defun mule-truncate-string (str len &optional pad)
116 "Truncate string STR so that string-width of STR is not greater than LEN.
117 If width of the truncated string is less than LEN, and if a character PAD is
118 defined, add padding end of it."
119 (case mule-sysdep-version
120 (2.4
121 (let ((cl (string-to-vector str)) (n 0) (sw 0))
122 (if (<= (string-width str) len) str
123 (while (<= (setq sw (+ (char-width (aref cl n)) sw)) len)
124 (setq n (1+ n)))
125 (string-match (make-string n ?.) str)
126 (setq str (substring str 0 (match-end 0))))
127 (if pad (concat str (make-string (- len (string-width str)) pad)) str)))
128 (2.3
129 (let ((cl (string-to-char-list str)) (n 0) (sw 0))
130 (if (<= (string-width str) len) str
131 (while (<= (setq sw (+ (char-width (nth n cl)) sw)) len)
132 (setq n (1+ n)))
133 (string-match (make-string n ?.) str)
134 (setq str (substring str 0 (match-end 0))))
135 (if pad (concat str (make-string (- len (string-width str)) pad)) str)))
136 (otherwise
137 (concat (if (> (length str) len) (substring str 0 len) str)
138 (if (or (null pad) (> (length str) len))
139 ""
140 (make-string (- len (length str)) pad))))))
141
142 (defun mule-make-iso-character (char)
143 (if (<= char 127)
144 char
145 (case mule-sysdep-version
146 (2.3 (make-character lc-ltn1 char))
147 (2.4 (make-char charset-latin-iso8859-1 char))
148 (xemacs char)
149 (otherwise char))))
150
151 (case mule-sysdep-version
152 ((2.3 2.4 xemacs) nil)
153 (otherwise (fset 'string-width 'length)))
154
155 (and
156 (boundp 'MULE)
157 (not (featurep 'mule))
158 (provide 'mule))
159
160 (provide 'mule-sysdp)