File: mule-sysdp.el

package info (click to toggle)
xemacs20 20.4-13
  • links: PTS
  • area: main
  • in suites: slink
  • size: 67,324 kB
  • ctags: 57,643
  • sloc: lisp: 586,197; ansic: 184,662; sh: 4,296; asm: 3,179; makefile: 2,021; perl: 1,059; csh: 96; sed: 22
file content (197 lines) | stat: -rw-r--r-- 6,255 bytes parent folder | download | duplicates (3)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
;;; mule-sysdp.el --- consolidate MULE-version dependencies in one file.

;; Copyright (c) 1996, 1997 William Perry

;; Author: William Perry <wmperry@cs.indiana.edu>
;; 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)
    (3.0 '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.3 *noconv*)
    (2.4 'no-conversion)
    (3.0 'no-conversion)
    (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 3.0 xemacs)
     (detect-coding-region (point-min) (point-max)))
    (otherwise nil)))

(defun mule-code-convert-region (st nd code)
  (if (and (listp code) (car code))
      (setq code (car code)))
  (case mule-sysdep-version
    (2.3
     (set 'mc-flag t)
     (code-convert-region (point-min) (point-max) code *internal*)
     (set-file-coding-system code))
    (2.4
     (set (make-local-variable 'enable-multibyte-characters) t)
     (if (memq code '(autodetect coding-system-automatic))
	 nil
       (decode-coding-region st nd code)
       (set-buffer-file-coding-system code)))
    (3.0
     (set (make-local-variable 'enable-multibyte-characters) t)
     (if (memq code '(autodetect automatic-conversion))
	 nil
       (or code (setq code 'automatic-conversion))
       (decode-coding-region st nd code)
       (set-buffer-file-coding-system code)))
    (xemacs
     (if (and (listp code) (not (car code)))
	 (progn
	   (setq code 'autodetect)
	   (condition-case ()
	       (get-coding-system 'autodetect)
	     (error (setq code 'automatic-conversion)))))
     (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
    ((3.0 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 3.0 xemacs)
     (encode-coding-string str mule-retrieval-coding-system))
    (otherwise
     str)))

(defun mule-decode-string (str)
  (and str
       (case mule-sysdep-version
	 ((2.4 3.0 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 3.0)
     (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-find-charset-region (beg end &optional table)
  (case mule-sysdep-version
    (2.3 (code-detect-region beg end))
    ((2.4 3.0) (find-charset-region beg end table))
    (xemacs (charsets-in-region beg end))
    (otherwise '(no-conversion))))

(defun mule-coding-system-name (codesys)
  (case mule-sysdep-version
    (3.0 nil)
    (xemacs (coding-system-name codesys))))

(defun mule-find-coding-system (sys)
  (case mule-sysdep-version
    ((2.3 2.4) nil)
    (3.0 (if (get sys 'coding-system) sys nil))
    (xemacs (find-coding-system sys))
    (otherwise nil)))
     
(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))
      (3.0 (make-char 'latin-iso8859-1 char))
      (xemacs char)
      (otherwise char))))

(case mule-sysdep-version
  ((2.3 2.4 3.0 xemacs) nil)
  (otherwise (fset 'string-width 'length)))

(and
 (boundp 'MULE)
 (not (featurep 'mule))
 (provide 'mule))

(provide 'mule-sysdp)