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

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

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

;; This file is part of GNU Emacs.

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

;; 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
28
;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
Karl Heuer's avatar
Karl Heuer committed
29

30 31
;;; Commentary:

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

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

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

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

41 42 43 44 45 46 47 48 49 50 51 52 53 54
(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)
55
  "Keymap for Mule (Multilingual environment) specific commands.")
Karl Heuer's avatar
Karl Heuer committed
56

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

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

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

72
(defvar set-coding-system-map
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
  (let ((map (make-sparse-keymap "Set Coding System")))
    (define-key-after map [universal-coding-system-argument]
      '(menu-item "For Next Command" universal-coding-system-argument
        :help "Coding system to be used by next command"))
    (define-key-after map [separator-1] '("--"))
    (define-key-after 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"))
    (define-key-after 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"))
    (define-key-after map [set-file-name-coding-system]
      '(menu-item "For File Name" set-file-name-coding-system
        :help "How to decode/encode file names"))
    (define-key-after map [separator-2] '("--"))

    (define-key-after map [set-keyboard-coding-system]
      '(menu-item "For Keyboard" set-keyboard-coding-system
        :help "How to decode keyboard input"))
    (define-key-after 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"))
    (define-key-after map [separator-3] '("--"))

    (define-key-after 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"))
    (define-key-after 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"))
    (define-key-after map [set-buffer-process-coding-system]
      '(menu-item "For I/O with Subprocess" set-buffer-process-coding-system
        :visible (fboundp 'start-process)
        :enable (get-buffer-process (current-buffer))
        :help "How to en/decode I/O from/to subprocess connected to this buffer"))
    map))

(defvar mule-menu-keymap
  (let ((map (make-sparse-keymap "Mule (Multilingual Environment)")))
    (define-key-after map [set-language-environment]
      `(menu-item  "Set Language Environment" ,setup-language-environment-map))
    (define-key-after map [separator-mule] '("--"))

    (define-key-after map [toggle-input-method]
      '(menu-item "Toggle Input Method" toggle-input-method))
    (define-key-after map [set-input-method]
      '(menu-item "Select Input Method..." set-input-method))
    (define-key-after map [describe-input-method]
      '(menu-item "Describe Input Method"  describe-input-method))
    (define-key-after map [separator-input-method] '("--"))

    (define-key-after map [set-various-coding-system]
      (list 'menu-item "Set Coding Systems" set-coding-system-map
            :enable 'default-enable-multibyte-characters))
    (define-key-after map [view-hello-file]
      '(menu-item "Show Multi-lingual Text" view-hello-file
        :enable (file-readable-p
                 (expand-file-name "HELLO" data-directory))
        :help "Display file which says HELLO in many languages"))
    (define-key-after map [separator-coding-system] '("--"))

    (define-key-after map [describe-language-environment]
      (list 'menu-item "Describe Language Environment"
            describe-language-environment-map
            :help "Show multilingual settings for a specific language"))
    (define-key-after map [describe-input-method]
      '(menu-item "Describe Input Method..." describe-input-method
        :help "Keyboard layout for a specific input method"))
    (define-key-after map [describe-coding-system]
      '(menu-item "Describe Coding System..." describe-coding-system))
    (define-key-after map [list-character-sets]
      '(menu-item "List Character Sets" list-character-sets
        :help "Show table of available character sets"))
    (define-key-after map [mule-diag]
      '(menu-item "Show All of Mule Status" mule-diag
        :help "Display multilingual environment settings"))
    map)
  "Keymap for Mule (Multilingual environment) menu specific commands.")
Dave Love's avatar
Dave Love committed
156

Karl Heuer's avatar
Karl Heuer committed
157 158 159 160 161 162 163 164
;; 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)

165 166 167 168
;; 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)
169

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

181
(defun coding-system-change-eol-conversion (coding-system eol-type)
182
  "Return a coding system which differs from CODING-SYSTEM in EOL conversion.
183 184 185 186 187 188 189 190 191 192 193 194 195
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))))
196 197 198 199 200 201 202 203 204 205 206 207 208 209 210
  ;; 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)))))
211 212 213 214 215 216 217

(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."
218 219 220 221
  (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)))))
222

223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260
;; 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)
  (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))

(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
261
(defun toggle-enable-multibyte-characters (&optional arg)
262
  "Change whether this buffer uses multibyte characters.
263
With ARG, use multibyte characters if the ARG is positive.
264 265 266 267 268 269

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.

270 271
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
272
wrong, use this command again to toggle back to the right mode."
Karl Heuer's avatar
Karl Heuer committed
273
  (interactive "P")
274 275 276 277
  (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
278 279 280
  (force-mode-line-update))

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

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

311 312 313 314 315 316
      ;; 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)
317
	      ;; Have to bind `last-command-event' here so that
Kenichi Handa's avatar
Kenichi Handa committed
318
	      ;; `digit-argument', for instance, can compute the
319
	      ;; prefix arg.
320
	      (last-command-event (aref keyseq 0)))
321 322
	  (call-interactively cmd)))

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

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

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

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

358
  (if (eq system-type 'darwin)
359
      ;; The file-name coding system on Darwin systems is always utf-8.
360 361 362 363 364
      (setq default-file-name-coding-system 'utf-8)
    (if (and default-enable-multibyte-characters
	     (or (not coding-system)
		 (coding-system-get coding-system 'ascii-compatible-p)))
	(setq default-file-name-coding-system coding-system)))
365
  (setq default-terminal-coding-system coding-system)
366
  (setq default-keyboard-coding-system coding-system)
367 368 369 370 371 372 373 374 375 376 377 378 379
  ;; 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))))
380

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

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

394 395
A coding system that requires automatic detection of text+encoding
\(e.g. undecided, unix) can't be preferred."
Kenichi Handa's avatar
Kenichi Handa committed
396 397 398
  (interactive "zPrefer coding system: ")
  (if (not (and coding-system (coding-system-p coding-system)))
      (error "Invalid coding system `%s'" coding-system))
399 400 401
  (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))
402
	(eol-type (coding-system-eol-type coding-system)))
403 404 405 406 407
    (set-coding-system-priority base)
    (and (interactive-p)
	 (or (eq base coding-system)
	     (message "Highest priority is set to %s (base of %s)"
		      base coding-system)))
408
    ;; If they asked for specific EOL conversion, honor that.
409
    (if (memq eol-type '(0 1 2))
410 411 412
	(setq base
	      (coding-system-change-eol-conversion base eol-type)))
    (set-default-coding-systems base)))
Kenichi Handa's avatar
Kenichi Handa committed
413

414 415 416 417 418 419 420 421 422 423
(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.
424
Return the sorted list.  CODINGS is modified by side effects.
425 426

If a coding system is most preferred, it has the highest priority.
427 428 429 430
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'.
431 432

If the variable `sort-coding-systems-predicate' (which see) is
433
non-nil, it is used to sort CODINGS instead."
434 435
  (if sort-coding-systems-predicate
      (sort codings sort-coding-systems-predicate)
Kenichi Handa's avatar
Kenichi Handa committed
436 437
    (let* ((from-priority (coding-system-priority-list))
	   (most-preferred (car from-priority))
438 439 440 441 442
	   (lang-preferred (get-language-info current-language-environment
					      'coding-system))
	   (func (function
		  (lambda (x)
		    (let ((base (coding-system-base x)))
443 444
		      ;; We calculate the priority number 0..255 by
		      ;; using the 8 bits PMMLCEII as this:
445 446 447 448 449
		      ;; 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
450 451 452 453
		      ;; 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
454
			(let ((mime (coding-system-get base :mime-charset)))
Dave Love's avatar
Dave Love committed
455 456
			   ;; Prefer coding systems corresponding to a
			   ;; MIME charset.
457
			   (if mime
Dave Love's avatar
Dave Love committed
458 459 460
			       ;; Lower utf-16 priority so that we
			       ;; normally prefer utf-8 to it, and put
			       ;; x-ctext below that.
461 462
			       (cond ((string-match-p "utf-16"
						      (symbol-name mime))
463
				      2)
464
				     ((string-match-p "^x-" (symbol-name mime))
465 466
				      1)
				     (t 3))
467
			     0))
468 469
			5)
		       (lsh (if (memq base lang-preferred) 1 0) 4)
Kenichi Handa's avatar
Kenichi Handa committed
470
		       (lsh (if (memq base from-priority) 1 0) 3)
471 472
		       (lsh (if (string-match-p "-with-esc\\'"
						(symbol-name base))
473
				0 1) 2)
Kenichi Handa's avatar
Kenichi Handa committed
474 475 476 477 478
		       (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.
479 480 481 482 483 484 485 486 487 488
			       (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
489
			 ))))))
490 491
      (sort codings (function (lambda (x y)
				(> (funcall func x) (funcall func y))))))))
492

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

Dave Love's avatar
Dave Love committed
496
If FROM is a string, find coding systems in that instead of the buffer.
497 498 499
All coding systems in the list can safely encode any multibyte characters
in the text.

Karl Heuer's avatar
Karl Heuer committed
500
If the text contains no multibyte characters, return a list of a single
Kenichi Handa's avatar
Kenichi Handa committed
501
element `undecided'."
502 503 504 505 506 507 508
  (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)))))
509

Kenichi Handa's avatar
Kenichi Handa committed
510 511 512 513 514
(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
515
If STRING contains no multibyte characters, return a list of a single
Kenichi Handa's avatar
Kenichi Handa committed
516
element `undecided'."
517
  (find-coding-systems-region string nil))
Kenichi Handa's avatar
Kenichi Handa committed
518 519 520

(defun find-coding-systems-for-charsets (charsets)
  "Return a list of proper coding systems to encode characters of CHARSETS.
521
CHARSETS is a list of character sets.
Dave Love's avatar
Dave Love committed
522 523 524

This only finds coding systems of type `charset', whose
`:charset-list' property includes all of CHARSETS (plus `ascii' for
525
ASCII-compatible coding systems).  It was used in older versions of
Dave Love's avatar
Dave Love committed
526 527 528 529 530
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))
531 532 533 534 535 536
  (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
537
	 '(raw-text utf-8-emacs))
538
	(t
Dave Love's avatar
Dave Love committed
539 540
	 (let (codings)
	   (dolist (cs (coding-system-list t))
541 542
	     (let ((cs-charsets (and (eq (coding-system-type cs) 'charset)
				     (coding-system-charset-list cs)))
Dave Love's avatar
Dave Love committed
543 544 545 546 547 548 549 550 551 552 553
		   (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)))))
554

555 556 557 558 559 560 561 562
(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
563
  CHARs are the characters found from the character set.
564
Optional 3rd arg MAXCOUNT limits how many CHARs are put in the above list.
565
Optional 4th arg EXCLUDES is a list of character sets to be ignored."
566 567 568
  (let ((chars nil)
	charset char)
    (if (stringp from)
569 570
	(if (multibyte-string-p from)
	    (let ((idx 0))
571
	      (while (setq idx (string-match-p "[^\000-\177]" from idx))
572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590
		(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)
591 592
		(let ((slot (assq charset chars)))
		  (if slot
593
		      (if (not (member char (nthcdr 2 slot)))
594 595 596 597
			  (let ((count (nth 1 slot)))
			    (setcar (cdr slot) (1+ count))
			    (if (or (not maxcount) (< count maxcount))
				(nconc slot (list char)))))
598
		    (setq chars (cons (list charset 1 char) chars)))))))))
599 600
    (nreverse chars)))

Kenichi Handa's avatar
Kenichi Handa committed
601 602 603 604 605 606
(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.

607 608
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
609 610 611
  (interactive
   (list (let ((default (or buffer-file-coding-system 'us-ascii)))
	   (read-coding-system
612
	    (format "Coding-system (default %s): " default)
Kenichi Handa's avatar
Kenichi Handa committed
613 614 615 616 617 618 619
	    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))

620 621 622 623 624 625 626
(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.")

627
(defvar select-safe-coding-system-accept-default-p nil
628
  "If non-nil, a function to control the behavior of coding system selection.
629 630 631 632
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.")

633 634 635 636 637 638 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
(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
670 671 672
      (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))
673 674 675 676 677 678 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
	  (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))
724
		(princ "  ") (princ x))
725 726 727
	      (insert "\n")
	      (fill-region-as-paragraph pos (point)))
	    (when rejected
728 729
	      (insert "These safely encode the text in the buffer,
but are not recommended for encoding text in this context,
730 731 732 733 734
e.g., for sending an email message.\n ")
	      (dolist (x rejected)
		(princ " ") (princ x))
	      (insert "\n"))
	    (when unsafe
735
	      (insert (if rejected "The other coding systems"
736
			"However, each of them")
737
		      " encountered characters it couldn't encode:\n")
738
	      (dolist (coding unsafe)
739
		(insert (format "  %s cannot encode these:" (car coding)))
740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762
		(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
763
			   'face 'link
764 765 766 767 768 769 770
			   'help-echo
			   "mouse-2, RET: jump to this character"
			   'help-function func1
			   'help-args (list bufname (car elt)))
			(insert-text-button
			 "..."
			 :type 'help-xref
771
			 'face 'link
772 773 774 775 776 777 778
			 '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"))
779
	      (insert (substitute-command-keys "\
780

781 782
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\
783
where `\\[universal-argument] \\[what-cursor-position]' will give information about it.\n"))))
784
	  (insert (substitute-command-keys "\nSelect \
785 786 787 788 789
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"))
790 791 792 793 794
	  (let ((pos (point))
		(fill-prefix "  "))
	    (dolist (x codings)
	      (princ "  ") (princ x))
	    (insert "\n")
795
	    (fill-region-as-paragraph pos (point)))))
796 797 798 799 800 801 802 803 804 805 806 807

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

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

815 816 817 818 819 820
The list of `buffer-file-coding-system' of the current buffer, the
`default-buffer-file-coding-system', and the most preferred coding
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
821 822

However, the user is queried if the chosen coding system is
823
inconsistent with what would be selected by `find-auto-coding' from
Dave Love's avatar
Dave Love committed
824 825 826
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.)
827

828 829
Optional 3rd arg DEFAULT-CODING-SYSTEM specifies a coding system or a
list of coding systems to be prepended to the default coding system
830
list.  However, if DEFAULT-CODING-SYSTEM is a list and the first
831
element is t, the cdr part is used as the default coding system list,
832 833
i.e. `buffer-file-coding-system', `default-buffer-file-coding-system',
and the most preferred coding system are not used.
834

835 836 837 838 839
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.

840 841 842 843
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).

844 845
The variable `select-safe-coding-system-accept-default-p', if non-nil,
overrides ACCEPT-DEFAULT-P.
846 847 848

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

852 853
  (let ((no-other-defaults nil)
	auto-cs)
854
    (unless (or (stringp from) find-file-literally)
855 856 857 858 859 860 861 862 863 864 865 866
      ;; Find an auto-coding that is specified for the the current
      ;; 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
867
		 'mule
868 869 870 871 872 873
		 (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"
874 875
			   (format "variable `%s'" (cdr auto-cs))))
		 :warning)
876 877 878 879
		(or (yes-or-no-p "Really proceed with writing? ")
		    (error "Save aborted"))
		(setq auto-cs nil))))))

880 881 882 883 884 885 886 887 888
    (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))

889 890 891 892 893 894 895 896 897
    (if (and auto-cs (not no-other-defaults))
	;; If the file has a coding cookie, try to use it before anything
	;; else (i.e. before default-coding-system which will typically come
	;; from file-coding-system-alist).
	(let ((base (coding-system-base auto-cs)))
	  (or (memq base '(nil undecided))
	      (rassq base default-coding-system)
	      (push (cons auto-cs base) default-coding-system))))

898 899 900 901 902 903 904
    (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)
905 906 907
		(setq default-coding-system
		      (append default-coding-system
			      (list (cons buffer-file-coding-system base)))))))
908

909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932
      (unless (and buffer-file-coding-system-explicit
		   (cdr buffer-file-coding-system-explicit))
	;; If default-buffer-file-coding-system is not nil nor undecided,
	;; append it to the defaults.
	(if default-buffer-file-coding-system
	    (let ((base (coding-system-base default-buffer-file-coding-system)))
	      (or (eq base 'undecided)
		  (rassq base default-coding-system)
		  (setq default-coding-system
			(append default-coding-system
				(list (cons default-buffer-file-coding-system
					    base)))))))

	;; 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))))))))
933 934 935 936

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

937 938 939 940 941 942 943
    ;; Decide the eol-type from the top of the default codings,
    ;; buffer-file-coding-system, or
    ;; default-buffer-file-coding-system.
    (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)
944
	      (setq default-eol-type (coding-system-eol-type
945 946
				      buffer-file-coding-system)))
	  (if (and (vectorp default-eol-type) default-buffer-file-coding-system)
947
	      (setq default-eol-type (coding-system-eol-type
948 949 950 951 952 953
				      default-buffer-file-coding-system)))
	  (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))))))

954 955
    (let ((codings (find-coding-systems-region from to))
	  (coding-system nil)
956
	  (tick (if (not (stringp from)) (buffer-chars-modified-tick)))
957
	  safe rejected unsafe)
958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975
      (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))))
976 977

      ;; If all the defaults failed, ask a user.
978
      (when (not coding-system)
979 980 981 982 983 984 985 986 987 988 989
	(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
990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011
	;; 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
1012 1013 1014 1015
		 ;; 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
1016
		 (not (coding-system-equal coding-system auto-cs)))
1017 1018 1019 1020
	    (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))
1021
	      (error "Save aborted"))))
1022
      (when (and tick (/= tick (buffer-chars-modified-tick)))
1023
	(error "Cancelled because the buffer was modified"))
1024
      coding-system)))
1025 1026 1027

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

1028 1029 1030 1031 1032 1033
(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'
1034 1035
  (3) value of `default-sendmail-coding-system'
  (4) value of `default-buffer-file-coding-system'
1036 1037
If the found coding system can't encode the current buffer,
or none of them are bound to a coding system,
1038
it asks the user to select a proper coding system."
1039
  (let ((coding (or (and (local-variable-p 'buffer-file-coding-system)
1040 1041 1042 1043
			  buffer-file-coding-system)
		     sendmail-coding-system
		     default-sendmail-coding-system
		     default-buffer-file-coding-system)))
1044
    (if (eq coding 'no-conversion)
Dave Love's avatar
Dave Love committed
1045
	;; We should never use no-conversion for outgoing mail.
1046 1047 1048
	(setq coding nil))
    (if (fboundp select-safe-coding-system-function)
	(funcall select-safe-coding-system-function
1049
		 (point-min) (point-max) coding
Dave Love's avatar
Dave Love committed
1050
		 (function (lambda (x) (coding-system-get x :mime-charset))))
1051
      coding)))
Karl Heuer's avatar
Karl Heuer committed
1052

1053
;;; Language support stuff.
Karl Heuer's avatar
Karl Heuer committed
1054 1055

(defvar language-info-alist nil
Richard M. Stallman's avatar
Richard M. Stallman committed
1056
  "Alist of language environment definitions.
Karl Heuer's avatar
Karl Heuer committed
1057 1058
Each element looks like:
	(LANGUAGE-NAME . ((KEY . INFO) ...))
Richard M. Stallman's avatar
Richard M. Stallman committed
1059 1060 1061 1062 1063 1064 1065
where LANGUAGE-NAME is a string, the name of the language environment,
KEY is a symbol denoting the kind of information, and
INFO is the data associated with KEY.
Meaningful values for KEY include

  documentation      value is documentation of what this language environment
			is meant for, and how to use it.
1066 1067
  charset	     value is a list of the character sets mainly used
			by this language environment.
Dave Love's avatar
Dave Love committed
1068 1069 1070
  sample-text	     value is an expression which is evalled to generate
                        a line of text written using characters appropriate
                        for this language environment.
Richard M. Stallman's avatar
Richard M. Stallman committed
1071 1072 1073 1074
  setup-function     value is a function to call to switch to this
			language environment.
  exit-function      value is a function to call to leave this
		        language environment.
1075 1076
  coding-system      value is a list of coding systems that are good for
			saving text written in this language environment.
Richard M. Stallman's avatar
Richard M. Stallman committed
1077 1078 1079 1080 1081
			This list serves as suggestions to the user;
			in effect, as a kind of documentation.
  coding-priority    value is a list of coding systems for this language
			environment, in order of decreasing priority.
			This is used to set up the coding system priority
1082
			list when you switch to this language environment.
1083
  nonascii-translation
1084 1085 1086
		     value is a charset of dimension one to use for
			converting a unibyte character to multibyte
			and vice versa.
1087 1088