mule-cmds.el 116 KB
Newer Older
1
;;; mule-cmds.el --- commands for multilingual environment -*-coding: iso-2022-7bit -*-
2

Glenn Morris's avatar
Glenn Morris committed
3
;; Copyright (C) 1997-2012 Free Software Foundation, Inc.
Kenichi Handa's avatar
Kenichi Handa committed
4
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
5
;;   2005, 2006, 2007, 2008, 2009, 2010, 2011
Kenichi Handa's avatar
Kenichi Handa committed
6 7
;;   National Institute of Advanced Industrial Science and Technology (AIST)
;;   Registration Number H14PRO021
Kenichi Handa's avatar
Kenichi Handa committed
8
;; Copyright (C) 2003
9 10
;;   National Institute of Advanced Industrial Science and Technology (AIST)
;;   Registration Number H13PRO009
Karl Heuer's avatar
Karl Heuer committed
11

Dave Love's avatar
Dave Love committed
12
;; Keywords: mule, i18n
Karl Heuer's avatar
Karl Heuer committed
13 14 15

;; This file is part of GNU Emacs.

16
;; GNU Emacs is free software: you can redistribute it and/or modify
Karl Heuer's avatar
Karl Heuer committed
17
;; it under the terms of the GNU General Public License as published by
18 19
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
Karl Heuer's avatar
Karl Heuer committed
20 21 22 23 24 25 26

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
27
;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
Karl Heuer's avatar
Karl Heuer committed
28

29 30
;;; Commentary:

Karl Heuer's avatar
Karl Heuer committed
31 32
;;; Code:

33 34
(defvar dos-codepage)
(autoload 'widget-value "wid-edit")
Dave Love's avatar
Dave Love committed
35

36 37
(defvar mac-system-coding-system)

Karl Heuer's avatar
Karl Heuer committed
38 39
;;; MULE related key bindings and menus.

40 41 42 43 44 45 46 47 48 49 50 51 52 53
(defvar mule-keymap
  (let ((map (make-sparse-keymap)))
    (define-key map "f" 'set-buffer-file-coding-system)
    (define-key map "r" 'revert-buffer-with-coding-system)
    (define-key map "F" 'set-file-name-coding-system)
    (define-key map "t" 'set-terminal-coding-system)
    (define-key map "k" 'set-keyboard-coding-system)
    (define-key map "p" 'set-buffer-process-coding-system)
    (define-key map "x" 'set-selection-coding-system)
    (define-key map "X" 'set-next-selection-coding-system)
    (define-key map "\C-\\" 'set-input-method)
    (define-key map "c" 'universal-coding-system-argument)
    (define-key map "l" 'set-language-environment)
    map)
54
  "Keymap for Mule (Multilingual environment) specific commands.")
Karl Heuer's avatar
Karl Heuer committed
55

56
;; Keep "C-x C-m ..." for mule specific commands.
Richard M. Stallman's avatar
Richard M. Stallman committed
57
(define-key ctl-x-map "\C-m" mule-keymap)
Kenichi Handa's avatar
Kenichi Handa committed
58

59
(defvar describe-language-environment-map
60
  (let ((map (make-sparse-keymap "Describe Language Environment")))
61 62
    (bindings--define-key map
      [Default] '(menu-item "Default" describe-specified-language-support))
63
    map))
64

65
(defvar setup-language-environment-map
66
  (let ((map (make-sparse-keymap "Set Language Environment")))
67 68
    (bindings--define-key map
      [Default] '(menu-item "Default" setup-specified-language-environment))
69
    map))
70

71
(defvar set-coding-system-map
72
  (let ((map (make-sparse-keymap "Set Coding System")))
73 74
    (bindings--define-key map [set-buffer-process-coding-system]
      '(menu-item "For I/O with Subprocess" set-buffer-process-coding-system
75 76
        :visible (fboundp 'start-process)
        :enable (get-buffer-process (current-buffer))
77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94
        :help "How to en/decode I/O from/to subprocess connected to this buffer"))
    (bindings--define-key map [set-next-selection-coding-system]
      '(menu-item "For Next X Selection" set-next-selection-coding-system
        :visible (display-selections-p)
        :help "How to en/decode next selection/clipboard operation"))
    (bindings--define-key map [set-selection-coding-system]
      '(menu-item "For X Selections/Clipboard" set-selection-coding-system
        :visible (display-selections-p)
        :help "How to en/decode data to/from selection/clipboard"))

    (bindings--define-key map [separator-3] menu-bar-separator)
    (bindings--define-key map [set-terminal-coding-system]
      '(menu-item "For Terminal" set-terminal-coding-system
        :enable (null (memq initial-window-system '(x w32 ns)))
        :help "How to encode terminal output"))
    (bindings--define-key map [set-keyboard-coding-system]
      '(menu-item "For Keyboard" set-keyboard-coding-system
        :help "How to decode keyboard input"))
95

96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111
    (bindings--define-key map [separator-2] menu-bar-separator)
    (bindings--define-key map [set-file-name-coding-system]
      '(menu-item "For File Name" set-file-name-coding-system
        :help "How to decode/encode file names"))
    (bindings--define-key map [revert-buffer-with-coding-system]
      '(menu-item "For Reverting This File Now"
        revert-buffer-with-coding-system
        :enable buffer-file-name
        :help "Revisit this file immediately using specified coding system"))
    (bindings--define-key map [set-buffer-file-coding-system]
      '(menu-item "For Saving This Buffer" set-buffer-file-coding-system
        :help "How to encode this buffer when saved"))
    (bindings--define-key map [separator-1] menu-bar-separator)
    (bindings--define-key map [universal-coding-system-argument]
      '(menu-item "For Next Command" universal-coding-system-argument
        :help "Coding system to be used by next command"))
112 113 114 115
    map))

(defvar mule-menu-keymap
  (let ((map (make-sparse-keymap "Mule (Multilingual Environment)")))
116 117 118 119 120 121 122 123 124 125 126 127 128 129 130
    (bindings--define-key map [mule-diag]
      '(menu-item "Show All Multilingual Settings" mule-diag
        :help "Display multilingual environment settings"))
    (bindings--define-key map [list-character-sets]
      '(menu-item "List Character Sets" list-character-sets
        :help "Show table of available character sets"))
    (bindings--define-key map [describe-coding-system]
      '(menu-item "Describe Coding System..." describe-coding-system))
    (bindings--define-key map [describe-input-method]
      '(menu-item "Describe Input Method..." describe-input-method
        :help "Keyboard layout for a specific input method"))
    (bindings--define-key map [describe-language-environment]
      `(menu-item "Describe Language Environment"
            ,describe-language-environment-map
            :help "Show multilingual settings for a specific language"))
131

132 133 134
    (bindings--define-key map [separator-coding-system] menu-bar-separator)
    (bindings--define-key map [view-hello-file]
      '(menu-item "Show Multilingual Sample Text" view-hello-file
135 136
        :enable (file-readable-p
                 (expand-file-name "HELLO" data-directory))
137 138 139 140
        :help "Demonstrate various character sets"))
    (bindings--define-key map [set-various-coding-system]
      `(menu-item "Set Coding Systems" ,set-coding-system-map
		  :enable (default-value 'enable-multibyte-characters)))
141

142 143 144 145 146 147 148 149 150 151 152
    (bindings--define-key map [separator-input-method] menu-bar-separator)
    (bindings--define-key map [describe-input-method]
      '(menu-item "Describe Input Method"  describe-input-method))
    (bindings--define-key map [set-input-method]
      '(menu-item "Select Input Method..." set-input-method))
    (bindings--define-key map [toggle-input-method]
      '(menu-item "Toggle Input Method" toggle-input-method))

    (bindings--define-key map [separator-mule] menu-bar-separator)
    (bindings--define-key map [set-language-environment]
      `(menu-item  "Set Language Environment" ,setup-language-environment-map))
153 154
    map)
  "Keymap for Mule (Multilingual environment) menu specific commands.")
Dave Love's avatar
Dave Love committed
155

Karl Heuer's avatar
Karl Heuer committed
156 157 158 159 160 161 162 163
;; This should be a single character key binding because users use it
;; very frequently while editing multilingual text.  Now we can use
;; only two such keys: "\C-\\" and "\C-^", but the latter is not
;; convenient because it requires shifting on most keyboards.  An
;; alternative is "\C-\]" which is now bound to `abort-recursive-edit'
;; but it won't be used that frequently.
(define-key global-map "\C-\\" 'toggle-input-method)

164 165 166 167
;; This is no good because people often type Shift-SPC
;; meaning to type SPC.  -- rms.
;; ;; Here's an alternative key binding for X users (Shift-SPACE).
;; (define-key global-map [?\S- ] 'toggle-input-method)
168

169 170 171 172
;;; Mule related hyperlinks.
(defconst help-xref-mule-regexp-template
  (purecopy (concat "\\(\\<\\("
		    "\\(coding system\\)\\|"
173 174 175
		    "\\(input method\\)\\|"
		    "\\(character set\\)\\|"
		    "\\(charset\\)"
176 177 178 179
		    "\\)\\s-+\\)?"
		    ;; Note starting with word-syntax character:
		    "`\\(\\sw\\(\\sw\\|\\s_\\)+\\)'")))

180
(defun coding-system-change-eol-conversion (coding-system eol-type)
181
  "Return a coding system which differs from CODING-SYSTEM in EOL conversion.
182 183 184 185 186 187 188 189 190 191 192 193 194
The returned coding system converts end-of-line by EOL-TYPE
but text as the same way as CODING-SYSTEM.
EOL-TYPE should be `unix', `dos', `mac', or nil.
If EOL-TYPE is nil, the returned coding system detects
how end-of-line is formatted automatically while decoding.

EOL-TYPE can be specified by an integer 0, 1, or 2.
They means `unix', `dos', and `mac' respectively."
  (if (symbolp eol-type)
      (setq eol-type (cond ((eq eol-type 'unix) 0)
			   ((eq eol-type 'dos) 1)
			   ((eq eol-type 'mac) 2)
			   (t eol-type))))
195 196 197 198 199 200 201 202 203 204 205 206 207 208 209
  ;; We call `coding-system-base' before `coding-system-eol-type',
  ;; because the coding-system may not be initialized until then.
  (let* ((base (coding-system-base coding-system))
	 (orig-eol-type (coding-system-eol-type coding-system)))
    (cond ((vectorp orig-eol-type)
	   (if (not eol-type)
	       coding-system
	     (aref orig-eol-type eol-type)))
	  ((not eol-type)
	   base)
	  ((= eol-type orig-eol-type)
	   coding-system)
	  ((progn (setq orig-eol-type (coding-system-eol-type base))
		  (vectorp orig-eol-type))
	   (aref orig-eol-type eol-type)))))
210 211 212 213 214 215 216

(defun coding-system-change-text-conversion (coding-system coding)
  "Return a coding system which differs from CODING-SYSTEM in text conversion.
The returned coding system converts text by CODING
but end-of-line as the same way as CODING-SYSTEM.
If CODING is nil, the returned coding system detects
how text is formatted automatically while decoding."
217 218 219 220
  (let ((eol-type (coding-system-eol-type coding-system)))
    (coding-system-change-eol-conversion
     (if coding coding 'undecided)
     (if (numberp eol-type) (aref [unix dos mac] eol-type)))))
221

222 223 224 225
;; Canonicalize the coding system name NAME by removing some prefixes
;; and delimiter characters.  Support function of
;; coding-system-from-name.
(defun canonicalize-coding-system-name (name)
226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241
  (if (string-match "^\\(ms\\|ibm\\|windows-\\)\\([0-9]+\\)$" name)
      ;; "ms950", "ibm950", "windows-950" -> "cp950"
      (concat "cp" (match-string 2 name))
    (if (string-match "^iso[-_ ]?[0-9]" name)
	;; "iso-8859-1" -> "8859-1", "iso-2022-jp" ->"2022-jp"
	(setq name (substring name (1- (match-end 0)))))
    (let ((idx (string-match "[-_ /]" name)))
      ;; Delete "-", "_", " ", "/" but do distinguish "16-be" and "16be".
      (while idx
	(if (and (>= idx 2)
		 (eq (string-match "16-[lb]e$" name (- idx 2))
		     (- idx 2)))
	    (setq idx (string-match "[-_ /]" name (match-end 0)))
	  (setq name (concat (substring name 0 idx) (substring name (1+ idx)))
		idx (string-match "[-_ /]" name idx))))
      name)))
242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262

(defun coding-system-from-name (name)
  "Return a coding system whose name matches with NAME (string or symbol)."
  (let (sym)
    (if (stringp name) (setq sym (intern name))
      (setq sym name name (symbol-name name)))
    (if (coding-system-p sym)
	sym
      (let ((eol-type
	     (if (string-match "-\\(unix\\|dos\\|mac\\)$" name)
		 (prog1 (intern (match-string 1 name))
		   (setq name (substring name 0 (match-beginning 0)))))))
	(setq name (canonicalize-coding-system-name (downcase name)))
	(catch 'tag
	  (dolist (elt (coding-system-list))
	    (if (string= (canonicalize-coding-system-name (symbol-name elt))
			 name)
		(throw 'tag (if eol-type (coding-system-change-eol-conversion
					  elt eol-type)
			      elt)))))))))

Karl Heuer's avatar
Karl Heuer committed
263
(defun toggle-enable-multibyte-characters (&optional arg)
264
  "Change whether this buffer uses multibyte characters.
265
With ARG, use multibyte characters if the ARG is positive.
266 267 268 269 270 271

Note that this command does not convert the byte contents of
the buffer; it only changes the way those bytes are interpreted.
In general, therefore, this command *changes* the sequence of
characters that the current buffer contains.

272 273
We suggest you avoid using this command unless you know what you are
doing.  If you use it by mistake, and the buffer is now displayed
274
wrong, use this command again to toggle back to the right mode."
Karl Heuer's avatar
Karl Heuer committed
275
  (interactive "P")
276 277 278 279
  (let ((new-flag
	 (if (null arg) (null enable-multibyte-characters)
	   (> (prefix-numeric-value arg) 0))))
    (set-buffer-multibyte new-flag))
Karl Heuer's avatar
Karl Heuer committed
280 281 282
  (force-mode-line-update))

(defun view-hello-file ()
283
  "Display the HELLO file, which lists many languages and characters."
Karl Heuer's avatar
Karl Heuer committed
284
  (interactive)
285
  ;; We have to decode the file in any environment.
286
  (let ((coding-system-for-read 'iso-2022-7bit))
287
    (view-file (expand-file-name "HELLO" data-directory))))
Karl Heuer's avatar
Karl Heuer committed
288

289
(defun universal-coding-system-argument (coding-system)
290
  "Execute an I/O command using the specified coding system."
291 292
  (interactive
   (let ((default (and buffer-file-coding-system
293
		       (not (eq (coding-system-type buffer-file-coding-system)
294
				'undecided))
295 296 297
		       buffer-file-coding-system)))
     (list (read-coding-system
	    (if default
298
		(format "Coding system for following command (default %s): " default)
299 300 301
	      "Coding system for following command: ")
	    default))))
  (let* ((keyseq (read-key-sequence
302
		  (format "Command to execute with %s:" coding-system)))
303 304
	 (cmd (key-binding keyseq))
	 prefix)
305 306
    ;; read-key-sequence ignores quit, so make an explicit check.
    ;; Like many places, this assumes quit == C-g, but it need not be.
307
    (if (equal last-input-event ?\C-g)
308
	(keyboard-quit))
309
    (when (memq cmd '(universal-argument digit-argument))
310
      (call-interactively cmd)
311

312 313 314 315 316 317
      ;; Process keys bound in `universal-argument-map'.
      (while (progn
	       (setq keyseq (read-key-sequence nil t)
		     cmd (key-binding keyseq t))
	       (not (eq cmd 'universal-argument-other-key)))
	(let ((current-prefix-arg prefix-arg)
318
	      ;; Have to bind `last-command-event' here so that
Kenichi Handa's avatar
Kenichi Handa committed
319
	      ;; `digit-argument', for instance, can compute the
320
	      ;; prefix arg.
321
	      (last-command-event (aref keyseq 0)))
322 323
	  (call-interactively cmd)))

Dave Love's avatar
Dave Love committed
324
      ;; This is the final call to `universal-argument-other-key', which
325 326 327
      ;; set's the final `prefix-arg.
      (let ((current-prefix-arg prefix-arg))
	(call-interactively cmd))
328

329 330 331 332 333
      ;; Read the command to execute with the given prefix arg.
      (setq prefix prefix-arg
	    keyseq (read-key-sequence nil t)
	    cmd (key-binding keyseq)))

334
    (let ((coding-system-for-read coding-system)
335
	  (coding-system-for-write coding-system)
336
	  (coding-system-require-warning t)
337
	  (current-prefix-arg prefix))
338 339 340
      (message "")
      (call-interactively cmd))))

341
(defun set-default-coding-systems (coding-system)
Kenichi Handa's avatar
Kenichi Handa committed
342
  "Set default value of various coding systems to CODING-SYSTEM.
343
This sets the following coding systems:
Kenichi Handa's avatar
Kenichi Handa committed
344
  o coding system of a newly created buffer
Kenichi Handa's avatar
Kenichi Handa committed
345 346
  o default coding system for subprocess I/O
This also sets the following values:
347
  o default value used as `file-name-coding-system' for converting file names
348
      if CODING-SYSTEM is ASCII-compatible
349
  o default value for the command `set-terminal-coding-system'
350
  o default value for the command `set-keyboard-coding-system'
351
      if CODING-SYSTEM is ASCII-compatible"
352 353
  (check-coding-system coding-system)
  (setq-default buffer-file-coding-system coding-system)
Kenichi Handa's avatar
Kenichi Handa committed
354

355
  (if (eq system-type 'darwin)
356
      ;; The file-name coding system on Darwin systems is always utf-8.
357
      (setq default-file-name-coding-system 'utf-8)
358
    (if (and (default-value 'enable-multibyte-characters)
359 360 361
	     (or (not coding-system)
		 (coding-system-get coding-system 'ascii-compatible-p)))
	(setq default-file-name-coding-system coding-system)))
362
  (setq default-terminal-coding-system coding-system)
363 364 365
  ;; Prevent default-terminal-coding-system from converting ^M to ^J.
  (setq default-keyboard-coding-system
	(coding-system-change-eol-conversion coding-system 'unix))
366 367 368 369 370 371 372 373 374 375 376 377 378
  ;; Preserve eol-type from existing default-process-coding-systems.
  ;; On non-unix-like systems in particular, these may have been set
  ;; carefully by the user, or by the startup code, to deal with the
  ;; users shell appropriately, so should not be altered by changing
  ;; language environment.
  (let ((output-coding
	 (coding-system-change-text-conversion
	  (car default-process-coding-system) coding-system))
	(input-coding
	 (coding-system-change-text-conversion
	  (cdr default-process-coding-system) coding-system)))
    (setq default-process-coding-system
	  (cons output-coding input-coding))))
379

Kenichi Handa's avatar
Kenichi Handa committed
380 381
(defun prefer-coding-system (coding-system)
  "Add CODING-SYSTEM at the front of the priority list for automatic detection.
382
This also sets the following coding systems:
Kenichi Handa's avatar
Kenichi Handa committed
383
  o coding system of a newly created buffer
Kenichi Handa's avatar
Kenichi Handa committed
384 385
  o default coding system for subprocess I/O
This also sets the following values:
386
  o default value used as `file-name-coding-system' for converting file names
387
  o default value for the command `set-terminal-coding-system'
388 389
  o default value for the command `set-keyboard-coding-system'

390 391 392
If CODING-SYSTEM specifies a certain type of EOL conversion, the coding
systems set by this function will use that type of EOL conversion.

393
A coding system that requires automatic detection of text+encoding
394 395 396 397 398
\(e.g. undecided, unix) can't be preferred.

To prefer, for instance, utf-8, say the following:

  \(prefer-coding-system 'utf-8)"
Kenichi Handa's avatar
Kenichi Handa committed
399 400 401
  (interactive "zPrefer coding system: ")
  (if (not (and coding-system (coding-system-p coding-system)))
      (error "Invalid coding system `%s'" coding-system))
402 403 404
  (if (memq (coding-system-type coding-system) '(raw-text undecided))
      (error "Can't prefer the coding system `%s'" coding-system))
  (let ((base (coding-system-base coding-system))
405
	(eol-type (coding-system-eol-type coding-system)))
406
    (set-coding-system-priority base)
407
    (and (called-interactively-p 'interactive)
408 409 410
	 (or (eq base coding-system)
	     (message "Highest priority is set to %s (base of %s)"
		      base coding-system)))
411
    ;; If they asked for specific EOL conversion, honor that.
412
    (if (memq eol-type '(0 1 2))
413 414
	(setq base
	      (coding-system-change-eol-conversion base eol-type)))
415 416 417 418
    (set-default-coding-systems base)
    (if (called-interactively-p 'interactive)
	(or (eq base default-file-name-coding-system)
	    (message "The default value of `file-name-coding-system' was not changed because the specified coding system is not suitable for file names.")))))
Kenichi Handa's avatar
Kenichi Handa committed
419

420 421 422 423 424 425 426 427 428 429
(defvar sort-coding-systems-predicate nil
  "If non-nil, a predicate function to sort coding systems.

It is called with two coding systems, and should return t if the first
one is \"less\" than the second.

The function `sort-coding-systems' use it.")

(defun sort-coding-systems (codings)
  "Sort coding system list CODINGS by a priority of each coding system.
430
Return the sorted list.  CODINGS is modified by side effects.
431 432

If a coding system is most preferred, it has the highest priority.
433 434 435 436
Otherwise, coding systems that correspond to MIME charsets have
higher priorities.  Among them, a coding system included in the
`coding-system' key of the current language environment has higher
priority.  See also the documentation of `language-info-alist'.
437 438

If the variable `sort-coding-systems-predicate' (which see) is
439
non-nil, it is used to sort CODINGS instead."
440 441
  (if sort-coding-systems-predicate
      (sort codings sort-coding-systems-predicate)
Kenichi Handa's avatar
Kenichi Handa committed
442 443
    (let* ((from-priority (coding-system-priority-list))
	   (most-preferred (car from-priority))
444 445 446 447 448
	   (lang-preferred (get-language-info current-language-environment
					      'coding-system))
	   (func (function
		  (lambda (x)
		    (let ((base (coding-system-base x)))
449 450
		      ;; We calculate the priority number 0..255 by
		      ;; using the 8 bits PMMLCEII as this:
451 452 453 454 455
		      ;; P: 1 if most preferred.
		      ;; MM: greater than 0 if mime-charset.
		      ;; L: 1 if one of the current lang. env.'s codings.
		      ;; C: 1 if one of codings listed in the category list.
		      ;; E: 1 if not XXX-with-esc
456 457 458 459
		      ;; II: if iso-2022 based, 0..3, else 1.
		      (logior
		       (lsh (if (eq base most-preferred) 1 0) 7)
		       (lsh
Kenichi Handa's avatar
Kenichi Handa committed
460
			(let ((mime (coding-system-get base :mime-charset)))
Dave Love's avatar
Dave Love committed
461 462
			   ;; Prefer coding systems corresponding to a
			   ;; MIME charset.
463
			   (if mime
Dave Love's avatar
Dave Love committed
464 465 466
			       ;; Lower utf-16 priority so that we
			       ;; normally prefer utf-8 to it, and put
			       ;; x-ctext below that.
467 468
			       (cond ((string-match-p "utf-16"
						      (symbol-name mime))
469
				      2)
470
				     ((string-match-p "^x-" (symbol-name mime))
471 472
				      1)
				     (t 3))
473
			     0))
474 475
			5)
		       (lsh (if (memq base lang-preferred) 1 0) 4)
Kenichi Handa's avatar
Kenichi Handa committed
476
		       (lsh (if (memq base from-priority) 1 0) 3)
477 478
		       (lsh (if (string-match-p "-with-esc\\'"
						(symbol-name base))
479
				0 1) 2)
Kenichi Handa's avatar
Kenichi Handa committed
480 481 482 483 484
		       (if (eq (coding-system-type base) 'iso-2022)
			   (let ((category (coding-system-category base)))
			     ;; For ISO based coding systems, prefer
			     ;; one that doesn't use designation nor
			     ;; locking/single shifting.
485 486 487 488 489 490 491 492 493 494
			       (cond
				((or (eq category 'coding-category-iso-8-1)
				     (eq category 'coding-category-iso-8-2))
				 2)
				((or (eq category 'coding-category-iso-7-tight)
				     (eq category 'coding-category-iso-7))
				 1)
				(t
				 0)))
			   1)
Dave Love's avatar
Dave Love committed
495
			 ))))))
496 497
      (sort codings (function (lambda (x y)
				(> (funcall func x) (funcall func y))))))))
498

Kenichi Handa's avatar
Kenichi Handa committed
499
(defun find-coding-systems-region (from to)
500
  "Return a list of proper coding systems to encode a text between FROM and TO.
Kenichi Handa's avatar
Kenichi Handa committed
501

Dave Love's avatar
Dave Love committed
502
If FROM is a string, find coding systems in that instead of the buffer.
503 504 505
All coding systems in the list can safely encode any multibyte characters
in the text.

Karl Heuer's avatar
Karl Heuer committed
506
If the text contains no multibyte characters, return a list of a single
Kenichi Handa's avatar
Kenichi Handa committed
507
element `undecided'."
508 509 510 511 512 513 514
  (let ((codings (find-coding-systems-region-internal from to)))
    (if (eq codings t)
	;; The text contains only ASCII characters.  Any coding
	;; systems are safe.
	'(undecided)
      ;; We need copy-sequence because sorting will alter the argument.
      (sort-coding-systems (copy-sequence codings)))))
515

Kenichi Handa's avatar
Kenichi Handa committed
516 517 518 519 520
(defun find-coding-systems-string (string)
  "Return a list of proper coding systems to encode STRING.
All coding systems in the list can safely encode any multibyte characters
in STRING.

Karl Heuer's avatar
Karl Heuer committed
521
If STRING contains no multibyte characters, return a list of a single
Kenichi Handa's avatar
Kenichi Handa committed
522
element `undecided'."
523
  (find-coding-systems-region string nil))
Kenichi Handa's avatar
Kenichi Handa committed
524 525 526

(defun find-coding-systems-for-charsets (charsets)
  "Return a list of proper coding systems to encode characters of CHARSETS.
527
CHARSETS is a list of character sets.
Dave Love's avatar
Dave Love committed
528 529 530

This only finds coding systems of type `charset', whose
`:charset-list' property includes all of CHARSETS (plus `ascii' for
531
ASCII-compatible coding systems).  It was used in older versions of
Dave Love's avatar
Dave Love committed
532 533 534 535 536
Emacs, but is unlikely to be what you really want now."
  ;; Deal with aliases.
  (setq charsets (mapcar (lambda (c)
			   (get-charset-property c :name))
			 charsets))
537 538 539 540 541 542
  (cond ((or (null charsets)
	     (and (= (length charsets) 1)
		  (eq 'ascii (car charsets))))
	 '(undecided))
	((or (memq 'eight-bit-control charsets)
	     (memq 'eight-bit-graphic charsets))
Dave Love's avatar
Dave Love committed
543
	 '(raw-text utf-8-emacs))
544
	(t
Dave Love's avatar
Dave Love committed
545 546
	 (let (codings)
	   (dolist (cs (coding-system-list t))
547 548
	     (let ((cs-charsets (and (eq (coding-system-type cs) 'charset)
				     (coding-system-charset-list cs)))
Dave Love's avatar
Dave Love committed
549 550 551 552 553 554 555 556 557 558 559
		   (charsets charsets))
	       (if (coding-system-get cs :ascii-compatible-p)
		   (add-to-list 'cs-charsets 'ascii))
	       (if (catch 'ok
		     (when cs-charsets
		       (while charsets
			 (unless (memq (pop charsets) cs-charsets)
			   (throw 'ok nil)))
		       t))
		   (push cs codings))))
	   (nreverse codings)))))
560

561 562 563 564 565 566 567 568
(defun find-multibyte-characters (from to &optional maxcount excludes)
  "Find multibyte characters in the region specified by FROM and TO.
If FROM is a string, find multibyte characters in the string.
The return value is an alist of the following format:
  ((CHARSET COUNT CHAR ...) ...)
where
  CHARSET is a character set,
  COUNT is a number of characters,
Dave Love's avatar
Dave Love committed
569
  CHARs are the characters found from the character set.
570
Optional 3rd arg MAXCOUNT limits how many CHARs are put in the above list.
571
Optional 4th arg EXCLUDES is a list of character sets to be ignored."
572 573 574
  (let ((chars nil)
	charset char)
    (if (stringp from)
575 576
	(if (multibyte-string-p from)
	    (let ((idx 0))
577
	      (while (setq idx (string-match-p "[^\000-\177]" from idx))
578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596
		(setq char (aref from idx)
		      charset (char-charset char))
		(unless (memq charset excludes)
		  (let ((slot (assq charset chars)))
		    (if slot
			(if (not (memq char (nthcdr 2 slot)))
			    (let ((count (nth 1 slot)))
			      (setcar (cdr slot) (1+ count))
			      (if (or (not maxcount) (< count maxcount))
				  (nconc slot (list char)))))
		      (setq chars (cons (list charset 1 char) chars)))))
		(setq idx (1+ idx)))))
      (if enable-multibyte-characters
	  (save-excursion
	    (goto-char from)
	    (while (re-search-forward "[^\000-\177]" to t)
	      (setq char (preceding-char)
		    charset (char-charset char))
	      (unless (memq charset excludes)
597 598
		(let ((slot (assq charset chars)))
		  (if slot
599
		      (if (not (member char (nthcdr 2 slot)))
600 601 602 603
			  (let ((count (nth 1 slot)))
			    (setcar (cdr slot) (1+ count))
			    (if (or (not maxcount) (< count maxcount))
				(nconc slot (list char)))))
604
		    (setq chars (cons (list charset 1 char) chars)))))))))
605 606
    (nreverse chars)))

Kenichi Handa's avatar
Kenichi Handa committed
607 608 609 610 611 612
(defun search-unencodable-char (coding-system)
  "Search forward from point for a character that is not encodable.
It asks which coding system to check.
If such a character is found, set point after that character.
Otherwise, don't move point.

613 614
When called from a program, the value is the position of the unencodable
character found, or nil if all characters are encodable."
Kenichi Handa's avatar
Kenichi Handa committed
615 616 617
  (interactive
   (list (let ((default (or buffer-file-coding-system 'us-ascii)))
	   (read-coding-system
618
	    (format "Coding-system (default %s): " default)
Kenichi Handa's avatar
Kenichi Handa committed
619 620 621 622 623 624 625
	    default))))
  (let ((pos (unencodable-char-position (point) (point-max) coding-system)))
    (if pos
	(goto-char (1+ pos))
      (message "All following characters are encodable by %s" coding-system))
    pos))

626 627 628 629 630 631 632
(defvar last-coding-system-specified nil
  "Most recent coding system explicitly specified by the user when asked.
This variable is set whenever Emacs asks the user which coding system
to use in order to write a file.  If you set it to nil explicitly,
then call `write-region', then afterward this variable will be non-nil
only if the user was explicitly asked and specified a coding system.")

633
(defvar select-safe-coding-system-accept-default-p nil
634
  "If non-nil, a function to control the behavior of coding system selection.
635 636 637 638
The meaning is the same as the argument ACCEPT-DEFAULT-P of the
function `select-safe-coding-system' (which see).  This variable
overrides that argument.")

639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675
(defun select-safe-coding-system-interactively (from to codings unsafe
						&optional rejected default)
  "Select interactively a coding system for the region FROM ... TO.
FROM can be a string, as in `write-region'.
CODINGS is the list of base coding systems known to be safe for this region,
  typically obtained with `find-coding-systems-region'.
UNSAFE is a list of coding systems known to be unsafe for this region.
REJECTED is a list of coding systems which were safe but for some reason
  were not recommended in the particular context.
DEFAULT is the coding system to use by default in the query."
  ;; At first, if some defaults are unsafe, record at most 11
  ;; problematic characters and their positions for them by turning
  ;;	(CODING ...)
  ;; into
  ;;	((CODING (POS . CHAR) (POS . CHAR) ...) ...)
  (if unsafe
      (setq unsafe
	    (mapcar #'(lambda (coding)
			(cons coding
			      (if (stringp from)
				  (mapcar #'(lambda (pos)
					      (cons pos (aref from pos)))
					  (unencodable-char-position
					   0 (length from) coding
					   11 from))
				(mapcar #'(lambda (pos)
					    (cons pos (char-after pos)))
					(unencodable-char-position
					 from to coding 11)))))
		    unsafe)))

  ;; Change each safe coding system to the corresponding
  ;; mime-charset name if it is also a coding system.  Such a name
  ;; is more friendly to users.
  (let ((l codings)
	mime-charset)
    (while l
676 677 678
      (setq mime-charset (coding-system-get (car l) :mime-charset))
      (if (and mime-charset (coding-system-p mime-charset)
	       (coding-system-equal (car l) mime-charset))
679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729
	  (setcar l mime-charset))
      (setq l (cdr l))))

  ;; Don't offer variations with locking shift, which you
  ;; basically never want.
  (let (l)
    (dolist (elt codings (setq codings (nreverse l)))
      (unless (or (eq 'coding-category-iso-7-else
		      (coding-system-category elt))
		  (eq 'coding-category-iso-8-else
		      (coding-system-category elt)))
	(push elt l))))

  ;; Remove raw-text, emacs-mule and no-conversion unless nothing
  ;; else is available.
  (setq codings
	(or (delq 'raw-text
		  (delq 'emacs-mule
			(delq 'no-conversion codings)))
	    '(raw-text emacs-mule no-conversion)))

  (let ((window-configuration (current-window-configuration))
	(bufname (buffer-name))
	coding-system)
    (save-excursion
      ;; If some defaults are unsafe, make sure the offending
      ;; buffer is displayed.
      (when (and unsafe (not (stringp from)))
	(pop-to-buffer bufname)
	(goto-char (apply 'min (mapcar #'(lambda (x) (car (cadr x)))
				       unsafe))))
      ;; Then ask users to select one from CODINGS while showing
      ;; the reason why none of the defaults are not used.
      (with-output-to-temp-buffer "*Warning*"
	(with-current-buffer standard-output
	  (if (and (null rejected) (null unsafe))
	      (insert "No default coding systems to try for "
		      (if (stringp from)
			  (format "string \"%s\"." from)
			(format "buffer `%s'." bufname)))
	    (insert
	     "These default coding systems were tried to encode"
	     (if (stringp from)
		 (concat " \"" (if (> (length from) 10)
				   (concat (substring from 0 10) "...\"")
				 (concat from "\"")))
	       (format " text\nin the buffer `%s'" bufname))
	     ":\n")
	    (let ((pos (point))
		  (fill-prefix "  "))
	      (dolist (x (append rejected unsafe))
730
		(princ "  ") (princ x))
731 732 733
	      (insert "\n")
	      (fill-region-as-paragraph pos (point)))
	    (when rejected
734 735
	      (insert "These safely encode the text in the buffer,
but are not recommended for encoding text in this context,
736 737 738 739 740
e.g., for sending an email message.\n ")
	      (dolist (x rejected)
		(princ " ") (princ x))
	      (insert "\n"))
	    (when unsafe
741
	      (insert (if rejected "The other coding systems"
742
			"However, each of them")
743
		      " encountered characters it couldn't encode:\n")
744
	      (dolist (coding unsafe)
745
		(insert (format "  %s cannot encode these:" (car coding)))
746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768
		(let ((i 0)
		      (func1
		       #'(lambda (bufname pos)
			   (when (buffer-live-p (get-buffer bufname))
			     (pop-to-buffer bufname)
			     (goto-char pos))))
		      (func2
		       #'(lambda (bufname pos coding)
			   (when (buffer-live-p (get-buffer bufname))
			     (pop-to-buffer bufname)
			     (if (< (point) pos)
				 (goto-char pos)
			       (forward-char 1)
			       (search-unencodable-char coding)
			       (forward-char -1))))))
		  (dolist (elt (cdr coding))
		    (insert " ")
		    (if (stringp from)
			(insert (if (< i 10) (cdr elt) "..."))
		      (if (< i 10)
			  (insert-text-button
			   (cdr elt)
			   :type 'help-xref
769
			   'face 'link
770 771 772 773 774 775 776
			   'help-echo
			   "mouse-2, RET: jump to this character"
			   'help-function func1
			   'help-args (list bufname (car elt)))
			(insert-text-button
			 "..."
			 :type 'help-xref
777
			 'face 'link
778 779 780 781 782 783 784
			 'help-echo
			 "mouse-2, RET: next unencodable character"
			 'help-function func2
			 'help-args (list bufname (car elt)
					  (car coding)))))
		    (setq i (1+ i))))
		(insert "\n"))
785
	      (insert (substitute-command-keys "\
786

787 788
Click on a character (or switch to this window by `\\[other-window]'\n\
and select the characters by RET) to jump to the place it appears,\n\
789
where `\\[universal-argument] \\[what-cursor-position]' will give information about it.\n"))))
790
	  (insert (substitute-command-keys "\nSelect \
791 792 793 794 795
one of the safe coding systems listed below,\n\
or cancel the writing with \\[keyboard-quit] and edit the buffer\n\
   to remove or modify the problematic characters,\n\
or specify any other coding system (and risk losing\n\
   the problematic characters).\n\n"))
796 797 798 799 800
	  (let ((pos (point))
		(fill-prefix "  "))
	    (dolist (x codings)
	      (princ "  ") (princ x))
	    (insert "\n")
801
	    (fill-region-as-paragraph pos (point)))))
802 803 804 805 806 807 808 809 810 811 812 813

      ;; Read a coding system.
      (setq coding-system
	    (read-coding-system
	     (format "Select coding system (default %s): " default)
	     default))
      (setq last-coding-system-specified coding-system))

    (kill-buffer "*Warning*")
    (set-window-configuration window-configuration)
    coding-system))

814
(defun select-safe-coding-system (from to &optional default-coding-system
815
				       accept-default-p file)
816 817
  "Ask a user to select a safe coding system from candidates.
The candidates of coding systems which can safely encode a text
818 819 820
between FROM and TO are shown in a popup window.  Among them, the most
proper one is suggested as the default.

821
The list of `buffer-file-coding-system' of the current buffer, the
822
default `buffer-file-coding-system', and the most preferred coding
823 824 825 826
system (if it corresponds to a MIME charset) is treated as the
default coding system list.  Among them, the first one that safely
encodes the text is normally selected silently and returned without
any user interaction.  See also the command `prefer-coding-system'.
Dave Love's avatar
Dave Love committed
827 828

However, the user is queried if the chosen coding system is
829
inconsistent with what would be selected by `find-auto-coding' from
Dave Love's avatar
Dave Love committed
830 831 832
coding cookies &c. if the contents of the region were read from a
file.  (That could lead to data corruption in a file subsequently
re-visited and edited.)
833

834 835
Optional 3rd arg DEFAULT-CODING-SYSTEM specifies a coding system or a
list of coding systems to be prepended to the default coding system
836
list.  However, if DEFAULT-CODING-SYSTEM is a list and the first
837
element is t, the cdr part is used as the default coding system list,
838
i.e. current `buffer-file-coding-system', default `buffer-file-coding-system',
839
and the most preferred coding system are not used.
840

841 842 843 844 845
Optional 4th arg ACCEPT-DEFAULT-P, if non-nil, is a function to
determine the acceptability of the silently selected coding system.
It is called with that coding system, and should return nil if it
should not be silently selected and thus user interaction is required.

846 847 848 849
Optional 5th arg FILE is the file name to use for this purpose.
That is different from `buffer-file-name' when handling `write-region'
\(for example).

850 851
The variable `select-safe-coding-system-accept-default-p', if non-nil,
overrides ACCEPT-DEFAULT-P.
852 853 854

Kludgy feature: if FROM is a string, the string is the target text,
and TO is ignored."
855
  (if (not (listp default-coding-system))
856 857
      (setq default-coding-system (list default-coding-system)))

858 859
  (let ((no-other-defaults nil)
	auto-cs)
860
    (unless (or (stringp from) find-file-literally)
Juanma Barranquero's avatar
Juanma Barranquero committed
861
      ;; Find an auto-coding that is specified for the current
862 863 864 865 866 867 868 869 870 871 872
      ;; buffer and file from the region FROM and TO.
      (save-excursion
	(save-restriction
	  (widen)
	  (goto-char from)
	  (setq auto-cs (find-auto-coding (or file buffer-file-name "")
					  (- to from)))
	  (if auto-cs
	      (if (coding-system-p (car auto-cs))
		  (setq auto-cs (car auto-cs))
		(display-warning
873
		 'mule
874 875 876 877 878 879
		 (format "\
Invalid coding system `%s' is specified
for the current buffer/file by the %s.
It is highly recommended to fix it before writing to a file."
			 (car auto-cs)
			 (if (eq (cdr auto-cs) :coding) ":coding tag"
880 881
			   (format "variable `%s'" (cdr auto-cs))))
		 :warning)
882 883 884 885
		(or (yes-or-no-p "Really proceed with writing? ")
		    (error "Save aborted"))
		(setq auto-cs nil))))))

886 887 888 889 890 891 892 893 894
    (if (eq (car default-coding-system) t)
	(setq no-other-defaults t
	      default-coding-system (cdr default-coding-system)))

    ;; Change elements of the list to (coding . base-coding).
    (setq default-coding-system
	  (mapcar (function (lambda (x) (cons x (coding-system-base x))))
		  default-coding-system))

895
    (if (and auto-cs (not no-other-defaults))
896 897
	;; If the file has a coding cookie, use it regardless of any
	;; other setting.
898
	(let ((base (coding-system-base auto-cs)))
899 900 901
	  (unless (memq base '(nil undecided))
            (setq default-coding-system (list (cons auto-cs base)))
            (setq no-other-defaults t))))
902

903 904 905 906 907 908 909
    (unless no-other-defaults
      ;; If buffer-file-coding-system is not nil nor undecided, append it
      ;; to the defaults.
      (if buffer-file-coding-system
	  (let ((base (coding-system-base buffer-file-coding-system)))
	    (or (eq base 'undecided)
		(rassq base default-coding-system)
910 911 912
		(setq default-coding-system
		      (append default-coding-system
			      (list (cons buffer-file-coding-system base)))))))
913

914 915
      (unless (and buffer-file-coding-system-explicit
		   (cdr buffer-file-coding-system-explicit))
916
	;; If default buffer-file-coding-system is not nil nor undecided,
917
	;; append it to the defaults.
918 919 920 921 922 923 924 925 926 927
	(when (default-value 'buffer-file-coding-system)
          (let ((base (coding-system-base
                       (default-value 'buffer-file-coding-system))))
            (or (eq base 'undecided)
                (rassq base default-coding-system)
                (setq default-coding-system
                      (append default-coding-system
                              (list (cons (default-value
                                            'buffer-file-coding-system)
                                          base)))))))
928 929 930 931 932 933 934 935 936 937 938 939

	;; If the most preferred coding system has the property mime-charset,
	;; append it to the defaults.
	(let ((preferred (coding-system-priority-list t))
	      base)
	  (and (coding-system-p preferred)
	       (setq base (coding-system-base preferred))
	       (coding-system-get preferred :mime-charset)
	       (not (rassq base default-coding-system))
	       (setq default-coding-system
		     (append default-coding-system
			     (list (cons preferred base))))))))
940 941 942 943

    (if select-safe-coding-system-accept-default-p
	(setq accept-default-p select-safe-coding-system-accept-default-p))

944
    ;; Decide the eol-type from the top of the default codings,
945
    ;; current buffer-file-coding-system, or default buffer-file-coding-system.
946 947 948 949
    (if default-coding-system
	(let ((default-eol-type (coding-system-eol-type
				 (caar default-coding-system))))
	  (if (and (vectorp default-eol-type) buffer-file-coding-system)
950
	      (setq default-eol-type (coding-system-eol-type
951
				      buffer-file-coding-system)))
952 953 954 955 956
	  (if (and (vectorp default-eol-type)
                   (default-value 'buffer-file-coding-system))
	      (setq default-eol-type
                    (coding-system-eol-type
                     (default-value 'buffer-file-coding-system))))
957 958 959 960 961
	  (if (and default-eol-type (not (vectorp default-eol-type)))
	      (dolist (elt default-coding-system)
		(setcar elt (coding-system-change-eol-conversion
			     (car elt) default-eol-type))))))

962 963
    (let ((codings (find-coding-systems-region from to))
	  (coding-system nil)
964
	  (tick (if (not (stringp from)) (buffer-chars-modified-tick)))
965
	  safe rejected unsafe)
966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983
      (if (eq (car codings) 'undecided)
	  ;; Any coding system is ok.
	  (setq coding-system (caar default-coding-system))
	;; Reverse the list so that elements are accumulated in safe,
	;; rejected, and unsafe in the correct order.
	(setq default-coding-system (nreverse default-coding-system))

	;; Classify the defaults into safe, rejected, and unsafe.
	(dolist (elt default-coding-system)
	  (if (or (eq (car codings) 'undecided)
		  (memq (cdr elt) codings))
	      (if (and (functionp accept-default-p)
		       (not (funcall accept-default-p (cdr elt))))
		  (push (car elt) rejected)
		(push (car elt) safe))
	    (push (car elt) unsafe)))
	(if safe
	    (setq coding-system (car safe))))
984 985

      ;; If all the defaults failed, ask a user.
986
      (when (not coding-system)
987 988 989 990 991 992 993 994 995 996 997
	(setq coding-system (select-safe-coding-system-interactively
			     from to codings unsafe rejected (car codings))))

      ;; Check we're not inconsistent with what `coding:' spec &c would
      ;; give when file is re-read.
      ;; But don't do this if we explicitly ignored the cookie
      ;; by using `find-file-literally'.
      (when (and auto-cs
		 (not (and
		       coding-system
		       (memq (coding-system-type coding-system) '(0 5)))))
Kenichi Handa's avatar
Kenichi Handa committed
998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019
	;; Merge coding-system and auto-cs as far as possible.
	(if (not coding-system)
	    (setq coding-system auto-cs)
	  (if (not auto-cs)
	      (setq auto-cs coding-system)
	    (let ((eol-type-1 (coding-system-eol-type coding-system))
		  (eol-type-2 (coding-system-eol-type auto-cs)))
	    (if (eq (coding-system-base coding-system) 'undecided)
		(setq coding-system (coding-system-change-text-conversion
				     coding-system auto-cs))
	      (if (eq (coding-system-base auto-cs) 'undecided)
		  (setq auto-cs (coding-system-change-text-conversion
				 auto-cs coding-system))))
	    (if (vectorp eol-type-1)
		(or (vectorp eol-type-2)
		    (setq coding-system (coding-system-change-eol-conversion
					 coding-system eol-type-2)))
	      (if (vectorp eol-type-2)
		  (setq auto-cs (coding-system-change-eol-conversion
				 auto-cs eol-type-1)))))))

	(if (and auto-cs
Dave Love's avatar
Dave Love committed
1020 1021 1022 1023
		 ;; Don't barf if writing a compressed file, say.
		 ;; This check perhaps isn't ideal, but is probably
		 ;; the best thing to do.
		 (not (auto-coding-alist-lookup (or file buffer-file-name "")))
Kenichi Handa's avatar
Kenichi Handa committed
1024
		 (not (coding-system-equal coding-system auto-cs)))
1025 1026 1027 1028
	    (unless (yes-or-no-p
		     (format "Selected encoding %s disagrees with \
%s specified by file contents.  Really save (else edit coding cookies \
and try again)? " coding-system auto-cs))
1029
	      (error "Save aborted"))))
1030
      (when (and tick (/= tick (buffer-chars-modified-tick)))
Paul Eggert's avatar
Paul Eggert committed
1031
	(error "Canceled because the buffer was modified"))
1032
      coding-system)))
1033 1034 1035

(setq select-safe-coding-system-function 'select-safe-coding-system)

1036 1037 1038 1039 1040 1041
(defun select-message-coding-system ()
  "Return a coding system to encode the outgoing message of the current buffer.
It at first tries the first coding system found in these variables
in this order:
  (1) local value of `buffer-file-coding-system'
  (2) value of `sendmail-coding-system'
1042
  (3) value of `default-sendmail-coding-system'