Mercurial > emacs
comparison lisp/international/mule-cmds.el @ 21377:bc409dfad8e7
(subset-p): Renamed from
find-safe-coding-system-list-subset-p.
(find-coding-systems-region, find-coding-systems-string): New
functions.
(find-coding-systems-for-charsets): Renamed from
find-safe-coding-system. This is now a helper function of the
above two.
(select-safe-coding-system): Adjusted for the above changes.
| author | Kenichi Handa <handa@m17n.org> |
|---|---|
| date | Mon, 06 Apr 1998 05:07:36 +0000 |
| parents | 38b621cd9169 |
| children | ae34e7d5c51f |
comparison
equal
deleted
inserted
replaced
| 21376:ea0bc6fdefd5 | 21377:bc409dfad8e7 |
|---|---|
| 226 (if (and base (interactive-p)) | 226 (if (and base (interactive-p)) |
| 227 (message "Highest priority is set to %s (base of %s)" | 227 (message "Highest priority is set to %s (base of %s)" |
| 228 base coding-system)) | 228 base coding-system)) |
| 229 (set-default-coding-systems (or base coding-system)))) | 229 (set-default-coding-systems (or base coding-system)))) |
| 230 | 230 |
| 231 (defun find-safe-coding-system-list-subset-p (list1 list2) | 231 (defun subset-p (list1 list2) |
| 232 "Return non-nil if all elements in LIST1 are included in LIST2. | 232 "Return non-nil if all elements in LIST1 are included in LIST2. |
| 233 Comparison done with EQ." | 233 Comparison done with EQ." |
| 234 (catch 'tag | 234 (catch 'tag |
| 235 (while list1 | 235 (while list1 |
| 236 (or (memq (car list1) list2) | 236 (or (memq (car list1) list2) |
| 237 (throw 'tag nil)) | 237 (throw 'tag nil)) |
| 238 (setq list1 (cdr list1))) | 238 (setq list1 (cdr list1))) |
| 239 t)) | 239 t)) |
| 240 | 240 |
| 241 (defun find-safe-coding-system (from to) | 241 (defun find-coding-systems-region (from to) |
| 242 "Return a list of proper coding systems to encode a text between FROM and TO. | 242 "Return a list of proper coding systems to encode a text between FROM and TO. |
| 243 All coding systems in the list can safely encode any multibyte characters | 243 All coding systems in the list can safely encode any multibyte characters |
| 244 in the text. | 244 in the text. |
| 245 | 245 |
| 246 If the text contains no multibyte charcters, return a list of a single | 246 If the text contains no multibyte charcters, return a list of a single |
| 247 element `undecided'. | 247 element `undecided'." |
| 248 | 248 (find-coding-systems-for-charsets (find-charset-region from to))) |
| 249 Kludgy feature: if FROM is a string, the string is the target text, | 249 |
| 250 and TO is ignored." | 250 (defun find-coding-systems-string (string) |
| 251 (let ((charset-list (if (stringp from) (find-charset-string from) | 251 "Return a list of proper coding systems to encode STRING. |
| 252 (find-charset-region from to)))) | 252 All coding systems in the list can safely encode any multibyte characters |
| 253 (if (or (null charset-list) | 253 in STRING. |
| 254 (and (= (length charset-list) 1) | 254 |
| 255 (eq 'ascii (car charset-list)))) | 255 If STRING contains no multibyte charcters, return a list of a single |
| 256 '(undecided) | 256 element `undecided'." |
| 257 (let ((l coding-system-list) | 257 (find-coding-systems-for-charsets (find-charset-string string))) |
| 258 (prefered-codings | 258 |
| 259 (mapcar (function | 259 (defun find-coding-systems-for-charsets (charsets) |
| 260 (lambda (x) | 260 "Return a list of proper coding systems to encode characters of CHARSETS. |
| 261 (get-charset-property x 'prefered-coding-system))) | 261 CHARSETS is a list of character sets." |
| 262 charset-list)) | 262 (if (or (null charsets) |
| 263 codings coding safe) | 263 (and (= (length charsets) 1) |
| 264 (while l | 264 (eq 'ascii (car charsets)))) |
| 265 (setq coding (car l) l (cdr l)) | 265 '(undecided) |
| 266 (if (and (eq coding (coding-system-base coding)) | 266 (let ((l coding-system-list) |
| 267 (setq safe (coding-system-get coding 'safe-charsets)) | 267 (prefered-codings |
| 268 (or (eq safe t) | 268 (mapcar (function |
| 269 (find-safe-coding-system-list-subset-p | 269 (lambda (x) |
| 270 charset-list safe))) | 270 (get-charset-property x 'prefered-coding-system))) |
| 271 ;; We put the higher priority to coding systems included | 271 charsets)) |
| 272 ;; in PREFERED-CODINGS, and within them, put the higher | 272 codings coding safe) |
| 273 ;; priority to coding systems which support smaller | 273 (while l |
| 274 ;; number of charsets. | 274 (setq coding (car l) l (cdr l)) |
| 275 (let ((priority | 275 (if (and (eq coding (coding-system-base coding)) |
| 276 (logior (if (coding-system-get coding 'mime-charset) | 276 (setq safe (coding-system-get coding 'safe-charsets)) |
| 277 256 0) | 277 (or (eq safe t) |
| 278 (if (memq coding prefered-codings) 128 0) | 278 (subset-p charsets safe))) |
| 279 (if (> (coding-system-type coding) 0) 64 0) | 279 ;; We put the higher priority to coding systems included |
| 280 (if (consp safe) (- 64 (length safe)) 0)))) | 280 ;; in PREFERED-CODINGS, and within them, put the higher |
| 281 (setq codings (cons (cons priority coding) codings))))) | 281 ;; priority to coding systems which support smaller |
| 282 (mapcar 'cdr | 282 ;; number of charsets. |
| 283 (sort codings (function (lambda (x y) (> (car x) (car y)))))) | 283 (let ((priority |
| 284 )))) | 284 (logior (if (coding-system-get coding 'mime-charset) |
| 285 256 0) | |
| 286 (if (memq coding prefered-codings) 128 0) | |
| 287 (if (> (coding-system-type coding) 0) 64 0) | |
| 288 (if (consp safe) (- 64 (length safe)) 0)))) | |
| 289 (setq codings (cons (cons priority coding) codings))))) | |
| 290 (mapcar 'cdr | |
| 291 (sort codings (function (lambda (x y) (> (car x) (car y)))))) | |
| 292 ))) | |
| 285 | 293 |
| 286 (defun select-safe-coding-system (from to &optional default-coding-system) | 294 (defun select-safe-coding-system (from to &optional default-coding-system) |
| 287 "Ask a user to select a safe coding system from candidates. | 295 "Ask a user to select a safe coding system from candidates. |
| 288 The candidates of coding systems which can safely encode a text | 296 The candidates of coding systems which can safely encode a text |
| 289 between FROM and TO are shown in a popup window. | 297 between FROM and TO are shown in a popup window. |
| 297 | 305 |
| 298 Kludgy feature: if FROM is a string, the string is the target text, | 306 Kludgy feature: if FROM is a string, the string is the target text, |
| 299 and TO is ignored." | 307 and TO is ignored." |
| 300 (or default-coding-system | 308 (or default-coding-system |
| 301 (setq default-coding-system buffer-file-coding-system)) | 309 (setq default-coding-system buffer-file-coding-system)) |
| 302 (let ((safe-coding-systems (find-safe-coding-system from to))) | 310 (let ((safe-coding-systems (if (stringp from) |
| 311 (find-coding-systems-string from) | |
| 312 (find-coding-systems-region from to)))) | |
| 303 (if (or (eq (car safe-coding-systems) 'undecided) | 313 (if (or (eq (car safe-coding-systems) 'undecided) |
| 304 (and default-coding-system | 314 (and default-coding-system |
| 305 (memq (coding-system-base default-coding-system) | 315 (memq (coding-system-base default-coding-system) |
| 306 safe-coding-systems))) | 316 safe-coding-systems))) |
| 307 default-coding-system | 317 default-coding-system |