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)
|