Mercurial > emacs
comparison lisp/international/mule-cmds.el @ 21882:4fb3860a1f26
(find-coding-systems-for-charsets):
Consider priority of each coding system too.
(select-safe-coding-system): Show mime-charset name (if it is also
a coding system) instead of base coding system name.
(select-safe-coding-system): Always delete *Warning* buffer.
(universal-coding-system-argument): Use buffer-file-coding-system
as default.
| author | Kenichi Handa <handa@m17n.org> |
|---|---|
| date | Fri, 01 May 1998 04:16:29 +0000 |
| parents | 68e39b75b862 |
| children | 487cd71c058d |
comparison
equal
deleted
inserted
replaced
| 21881:1a80d464c77a | 21882:4fb3860a1f26 |
|---|---|
| 174 (find-file-read-only (expand-file-name "HELLO" data-directory)))) | 174 (find-file-read-only (expand-file-name "HELLO" data-directory)))) |
| 175 | 175 |
| 176 (defun universal-coding-system-argument () | 176 (defun universal-coding-system-argument () |
| 177 "Execute an I/O command using the specified coding system." | 177 "Execute an I/O command using the specified coding system." |
| 178 (interactive) | 178 (interactive) |
| 179 (let* ((coding-system (read-coding-system "Coding system for following command: ")) | 179 (let* ((default (and buffer-file-coding-system |
| 180 (not (eq (coding-system-type buffer-file-coding-system) | |
| 181 t)) | |
| 182 buffer-file-coding-system)) | |
| 183 (coding-system (read-coding-system | |
| 184 (if default | |
| 185 (format "Coding system for following command (default, %s): " default) | |
| 186 "Coding system for following command: ") | |
| 187 default)) | |
| 180 (keyseq (read-key-sequence | 188 (keyseq (read-key-sequence |
| 181 (format "Command to execute with %s:" coding-system))) | 189 (format "Command to execute with %s:" coding-system))) |
| 182 (cmd (key-binding keyseq))) | 190 (cmd (key-binding keyseq))) |
| 183 (let ((coding-system-for-read coding-system) | 191 (let ((coding-system-for-read coding-system) |
| 184 (coding-system-for-write coding-system)) | 192 (coding-system-for-write coding-system)) |
| 264 (if (or (null charsets) | 272 (if (or (null charsets) |
| 265 (and (= (length charsets) 1) | 273 (and (= (length charsets) 1) |
| 266 (eq 'ascii (car charsets)))) | 274 (eq 'ascii (car charsets)))) |
| 267 '(undecided) | 275 '(undecided) |
| 268 (let ((l coding-system-list) | 276 (let ((l coding-system-list) |
| 269 (prefered-codings | 277 (charset-prefered-codings |
| 270 (mapcar (function | 278 (mapcar (function |
| 271 (lambda (x) | 279 (lambda (x) |
| 272 (get-charset-property x 'prefered-coding-system))) | 280 (get-charset-property x 'prefered-coding-system))) |
| 273 charsets)) | 281 charsets)) |
| 282 (priorities (mapcar (function (lambda (x) (symbol-value x))) | |
| 283 coding-category-list)) | |
| 274 codings coding safe) | 284 codings coding safe) |
| 275 (while l | 285 (while l |
| 276 (setq coding (car l) l (cdr l)) | 286 (setq coding (car l) l (cdr l)) |
| 277 (if (and (eq coding (coding-system-base coding)) | 287 (if (and (eq coding (coding-system-base coding)) |
| 278 (setq safe (coding-system-get coding 'safe-charsets)) | 288 (setq safe (coding-system-get coding 'safe-charsets)) |
| 279 (or (eq safe t) | 289 (or (eq safe t) |
| 280 (subset-p charsets safe))) | 290 (subset-p charsets safe))) |
| 281 ;; We put the higher priority to coding systems included | 291 ;; We put the higher priority to coding systems included |
| 282 ;; in PREFERED-CODINGS, and within them, put the higher | 292 ;; in CHARSET-PREFERED-CODINGS, and within them, put the |
| 283 ;; priority to coding systems which support smaller | 293 ;; higher priority to coding systems which support smaller |
| 284 ;; number of charsets. | 294 ;; number of charsets. |
| 285 (let ((priority | 295 (let ((priority |
| 286 (logior (if (coding-system-get coding 'mime-charset) | 296 (+ (if (coding-system-get coding 'mime-charset) 4096 0) |
| 287 256 0) | 297 (lsh (length (memq coding priorities)) 7) |
| 288 (if (memq coding prefered-codings) 128 0) | 298 (if (memq coding charset-prefered-codings) 64 0) |
| 289 (if (> (coding-system-type coding) 0) 64 0) | 299 (if (> (coding-system-type coding) 0) 32 0) |
| 290 (if (consp safe) (- 64 (length safe)) 0)))) | 300 (if (consp safe) (- 32 (length safe)) 0)))) |
| 291 (setq codings (cons (cons priority coding) codings))))) | 301 (setq codings (cons (cons priority coding) codings))))) |
| 292 (mapcar 'cdr | 302 (mapcar 'cdr |
| 293 (sort codings (function (lambda (x y) (> (car x) (car y)))))) | 303 (sort codings (function (lambda (x y) (> (car x) (car y)))))) |
| 294 ))) | 304 ))) |
| 295 | 305 |
| 316 (and default-coding-system | 326 (and default-coding-system |
| 317 (memq (coding-system-base default-coding-system) | 327 (memq (coding-system-base default-coding-system) |
| 318 safe-coding-systems))) | 328 safe-coding-systems))) |
| 319 default-coding-system | 329 default-coding-system |
| 320 | 330 |
| 321 ;; Ask a user to select a proper coding system. | 331 ;; At first, change each coding system to the corresponding |
| 332 ;; mime-charset name if it is also a coding system. | |
| 333 (let ((l safe-coding-systems) | |
| 334 mime-charset) | |
| 335 (while l | |
| 336 (setq mime-charset (coding-system-get (car l) 'mime-charset)) | |
| 337 (if (and mime-charset (coding-system-p mime-charset)) | |
| 338 (setcar l mime-charset)) | |
| 339 (setq l (cdr l)))) | |
| 340 | |
| 341 ;; Then, ask a user to select a proper coding system. | |
| 322 (save-window-excursion | 342 (save-window-excursion |
| 323 ;; At first, show a helpful message. | 343 ;; At first, show a helpful message. |
| 324 (with-output-to-temp-buffer "*Warning*" | 344 (with-output-to-temp-buffer "*Warning*" |
| 325 (save-excursion | 345 (save-excursion |
| 326 (set-buffer standard-output) | 346 (set-buffer standard-output) |
| 335 (mapcar (function (lambda (x) (princ " ") (princ x))) | 355 (mapcar (function (lambda (x) (princ " ") (princ x))) |
| 336 safe-coding-systems) | 356 safe-coding-systems) |
| 337 (fill-region-as-paragraph pos (point))))) | 357 (fill-region-as-paragraph pos (point))))) |
| 338 | 358 |
| 339 ;; Read a coding system. | 359 ;; Read a coding system. |
| 340 (let* ((safe-names (mapcar (lambda (x) (list (symbol-name x))) | 360 (unwind-protect |
| 341 safe-coding-systems)) | 361 (let* ((safe-names (mapcar (lambda (x) (list (symbol-name x))) |
| 342 (name (completing-read | 362 safe-coding-systems)) |
| 343 (format "Select coding system (default %s): " | 363 (name (completing-read |
| 344 (car safe-coding-systems)) | 364 (format "Select coding system (default %s): " |
| 345 safe-names nil t nil nil (car (car safe-names))))) | 365 (car safe-coding-systems)) |
| 346 (kill-buffer "*Warning*") | 366 safe-names nil t nil nil (car (car safe-names))))) |
| 347 (intern name)))))) | 367 (intern name)) |
| 368 (kill-buffer "*Warning*")))))) | |
| 348 | 369 |
| 349 (setq select-safe-coding-system-function 'select-safe-coding-system) | 370 (setq select-safe-coding-system-function 'select-safe-coding-system) |
| 350 | 371 |
| 351 | 372 |
| 352 ;;; Language support staffs. | 373 ;;; Language support staffs. |