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

Glenn Morris's avatar
Glenn Morris committed
3
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
Glenn Morris's avatar
Glenn Morris committed
4
;;   2006, 2007  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
Kenichi Handa's avatar
Kenichi Handa committed
7 8
;;   National Institute of Advanced Industrial Science and Technology (AIST)
;;   Registration Number H14PRO021
Karl Heuer's avatar
Karl Heuer committed
9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24

;; Keywords: mule, multilingual

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; 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
Karl Heuer's avatar
Karl Heuer committed
25
;; along with GNU Emacs; see the file COPYING.  If not, write to the
Lute Kamstra's avatar
Lute Kamstra committed
26 27
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
Karl Heuer's avatar
Karl Heuer committed
28

29 30
;;; Commentary:

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

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

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

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

Richard M. Stallman's avatar
Richard M. Stallman committed
42
(defvar mule-keymap (make-sparse-keymap)
43
  "Keymap for Mule (Multilingual environment) specific commands.")
Karl Heuer's avatar
Karl Heuer committed
44

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

Karl Heuer's avatar
Karl Heuer committed
48
(define-key mule-keymap "f" 'set-buffer-file-coding-system)
49
(define-key mule-keymap "r" 'revert-buffer-with-coding-system)
50
(define-key mule-keymap "F" 'set-file-name-coding-system)
Karl Heuer's avatar
Karl Heuer committed
51
(define-key mule-keymap "t" 'set-terminal-coding-system)
52 53
(define-key mule-keymap "k" 'set-keyboard-coding-system)
(define-key mule-keymap "p" 'set-buffer-process-coding-system)
54 55
(define-key mule-keymap "x" 'set-selection-coding-system)
(define-key mule-keymap "X" 'set-next-selection-coding-system)
56
(define-key mule-keymap "\C-\\" 'set-input-method)
57
(define-key mule-keymap "c" 'universal-coding-system-argument)
58
(define-key mule-keymap "l" 'set-language-environment)
Karl Heuer's avatar
Karl Heuer committed
59

Eli Zaretskii's avatar
Eli Zaretskii committed
60 61
(defvar mule-menu-keymap
  (make-sparse-keymap "Mule (Multilingual Environment)")
62
  "Keymap for Mule (Multilingual environment) menu specific commands.")
63

64 65
(defvar describe-language-environment-map
  (make-sparse-keymap "Describe Language Environment"))
66

67 68
(defvar setup-language-environment-map
  (make-sparse-keymap "Set Language Environment"))
69

70 71
(defvar set-coding-system-map
  (make-sparse-keymap "Set Coding System"))
72 73

(define-key-after mule-menu-keymap [set-language-environment]
74
  (list 'menu-item  "Set Language Environment" setup-language-environment-map))
75 76 77 78
(define-key-after mule-menu-keymap [separator-mule]
  '("--")
  t)
(define-key-after mule-menu-keymap [toggle-input-method]
Eli Zaretskii's avatar
Eli Zaretskii committed
79
  '(menu-item "Toggle Input Method" toggle-input-method)
80
  t)
81
(define-key-after mule-menu-keymap [set-input-method]
Eli Zaretskii's avatar
Eli Zaretskii committed
82
  '(menu-item "Select Input Method..." set-input-method)
83
  t)
Dave Love's avatar
Dave Love committed
84 85
(define-key-after mule-menu-keymap [describe-input-method]
  '(menu-item "Describe Input Method"  describe-input-method))
86 87 88 89
(define-key-after mule-menu-keymap [separator-input-method]
  '("--")
  t)
(define-key-after mule-menu-keymap [set-various-coding-system]
Dave Love's avatar
Dave Love committed
90
  (list 'menu-item "Set Coding Systems" set-coding-system-map
91
	:enable 'default-enable-multibyte-characters))
Eli Zaretskii's avatar
Eli Zaretskii committed
92 93 94 95 96
(define-key-after mule-menu-keymap [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")
97 98 99 100
  t)
(define-key-after mule-menu-keymap [separator-coding-system]
  '("--")
  t)
Eli Zaretskii's avatar
Eli Zaretskii committed
101 102 103
(define-key-after mule-menu-keymap [describe-language-environment]
  (list 'menu-item "Describe Language Environment"
	describe-language-environment-map
Dave Love's avatar
Dave Love committed
104
	:help "Show multilingual settings for a specific language")
105
  t)
Eli Zaretskii's avatar
Eli Zaretskii committed
106 107
(define-key-after mule-menu-keymap [describe-input-method]
  '(menu-item "Describe Input Method..." describe-input-method
Dave Love's avatar
Dave Love committed
108
	      :help "Keyboard layout for a specific input method")
Eli Zaretskii's avatar
Eli Zaretskii committed
109 110 111 112
  t)
(define-key-after mule-menu-keymap [describe-coding-system]
  '(menu-item "Describe Coding System..." describe-coding-system)
  t)
Dave Love's avatar
Dave Love committed
113 114 115
(define-key-after mule-menu-keymap [list-character-sets]
  '(menu-item "List Character Sets" list-character-sets
	      :help "Show table of available character sets"))
Eli Zaretskii's avatar
Eli Zaretskii committed
116 117 118
(define-key-after mule-menu-keymap [mule-diag]
  '(menu-item "Show All of Mule Status" mule-diag
	      :help "Display multilingual environment settings")
119 120
  t)

Richard M. Stallman's avatar
Richard M. Stallman committed
121
(define-key-after set-coding-system-map [universal-coding-system-argument]
Eli Zaretskii's avatar
Eli Zaretskii committed
122 123
  '(menu-item "For Next Command" universal-coding-system-argument
	      :help "Coding system to be used by next command")
Richard M. Stallman's avatar
Richard M. Stallman committed
124
  t)
125 126 127 128 129 130 131 132 133 134 135 136
(define-key-after set-coding-system-map [separator-1]
  '("--")
  t)
(define-key-after set-coding-system-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")
  t)
(define-key-after set-coding-system-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")
  t)
137 138 139 140
(define-key-after set-coding-system-map [set-file-name-coding-system]
  '(menu-item "For File Name" set-file-name-coding-system
	      :help "How to decode/encode file names")
  t)
141 142
(define-key-after set-coding-system-map [separator-2]
  '("--")
143
  t)
144

145
(define-key-after set-coding-system-map [set-keyboard-coding-system]
Eli Zaretskii's avatar
Eli Zaretskii committed
146 147
  '(menu-item "For Keyboard" set-keyboard-coding-system
	      :help "How to decode keyboard input")
148
  t)
149 150
(define-key-after set-coding-system-map [set-terminal-coding-system]
  '(menu-item "For Terminal" set-terminal-coding-system
151
	      :enable (null (memq initial-window-system '(x w32 mac)))
152 153 154 155
	      :help "How to encode terminal output")
  t)
(define-key-after set-coding-system-map [separator-3]
  '("--")
156
  t)
157
(define-key-after set-coding-system-map [set-selection-coding-system]
Eli Zaretskii's avatar
Eli Zaretskii committed
158 159 160
  '(menu-item "For X Selections/Clipboard" set-selection-coding-system
	      :visible (display-selections-p)
	      :help "How to en/decode data to/from selection/clipboard")
161 162
  t)
(define-key-after set-coding-system-map [set-next-selection-coding-system]
Eli Zaretskii's avatar
Eli Zaretskii committed
163 164 165
  '(menu-item "For Next X Selection" set-next-selection-coding-system
	      :visible (display-selections-p)
	      :help "How to en/decode next selection/clipboard operation")
166
  t)
167 168 169 170 171 172 173 174
(define-key-after set-coding-system-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")
  t)


175
(define-key setup-language-environment-map
Eli Zaretskii's avatar
Eli Zaretskii committed
176
  [Default] '(menu-item "Default" setup-specified-language-environment))
Karl Heuer's avatar
Karl Heuer committed
177

Dave Love's avatar
Dave Love committed
178 179 180
(define-key describe-language-environment-map
  [Default] '(menu-item "Default" describe-specified-language-support))

Karl Heuer's avatar
Karl Heuer committed
181 182 183 184 185 186 187 188
;; 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)

189 190 191 192
;; 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)
193

194 195 196 197
;;; Mule related hyperlinks.
(defconst help-xref-mule-regexp-template
  (purecopy (concat "\\(\\<\\("
		    "\\(coding system\\)\\|"
198 199 200
		    "\\(input method\\)\\|"
		    "\\(character set\\)\\|"
		    "\\(charset\\)"
201 202 203 204
		    "\\)\\s-+\\)?"
		    ;; Note starting with word-syntax character:
		    "`\\(\\sw\\(\\sw\\|\\s_\\)+\\)'")))

205 206 207 208 209 210 211 212 213 214 215 216 217 218 219
(defun coding-system-change-eol-conversion (coding-system eol-type)
  "Return a coding system which differs from CODING-SYSTEM in eol conversion.
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))))
220 221 222 223 224 225 226 227 228 229 230 231 232 233 234
  ;; 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)))))
235 236 237 238 239 240 241

(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."
242 243 244 245
  (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)))))
246

Karl Heuer's avatar
Karl Heuer committed
247
(defun toggle-enable-multibyte-characters (&optional arg)
248 249 250 251 252 253 254 255 256 257 258
  "Change whether this buffer uses multibyte characters.
With arg, use multibyte characters if the arg is positive.

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.

We suggest you avoid using use this command unless you know what you
are doing.  If you use it by mistake, and the buffer is now displayed
wrong, use this command again to toggle back to the right mode."
Karl Heuer's avatar
Karl Heuer committed
259
  (interactive "P")
260 261 262 263
  (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
264 265 266 267 268
  (force-mode-line-update))

(defun view-hello-file ()
  "Display the HELLO file which list up many languages and characters."
  (interactive)
269 270
  ;; We have to decode the file in any environment.
  (let ((default-enable-multibyte-characters t)
271
	(coding-system-for-read 'iso-2022-7bit))
272
    (view-file (expand-file-name "HELLO" data-directory))))
Karl Heuer's avatar
Karl Heuer committed
273

274
(defun universal-coding-system-argument (coding-system)
275
  "Execute an I/O command using the specified coding system."
276 277
  (interactive
   (let ((default (and buffer-file-coding-system
278 279
		       (not (eq (coding-system-type buffer-file-coding-system)
				t))
280 281 282
		       buffer-file-coding-system)))
     (list (read-coding-system
	    (if default
283
		(format "Coding system for following command (default %s): " default)
284 285 286
	      "Coding system for following command: ")
	    default))))
  (let* ((keyseq (read-key-sequence
287
		  (format "Command to execute with %s:" coding-system)))
288 289 290 291 292
	 (cmd (key-binding keyseq))
	 prefix)

    (when (eq cmd 'universal-argument)
      (call-interactively cmd)
293

294 295 296 297 298 299
      ;; 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)
Dave Love's avatar
Dave Love committed
300
	      ;; Have to bind `last-command-char' here so that
301
	      ;; `digit-argument', for instance, can compute the
302 303 304 305
	      ;; prefix arg.
	      (last-command-char (aref keyseq 0)))
	  (call-interactively cmd)))

306
      ;; This is the final call to `universal-argument-other-key', which
307 308 309
      ;; set's the final `prefix-arg.
      (let ((current-prefix-arg prefix-arg))
	(call-interactively cmd))
310

311 312 313 314 315
      ;; Read the command to execute with the given prefix arg.
      (setq prefix prefix-arg
	    keyseq (read-key-sequence nil t)
	    cmd (key-binding keyseq)))

316
    (let ((coding-system-for-read coding-system)
317
	  (coding-system-for-write coding-system)
318
	  (coding-system-require-warning t)
319
	  (current-prefix-arg prefix))
320 321 322
      (message "")
      (call-interactively cmd))))

323
(defun set-default-coding-systems (coding-system)
Kenichi Handa's avatar
Kenichi Handa committed
324
  "Set default value of various coding systems to CODING-SYSTEM.
325
This sets the following coding systems:
Kenichi Handa's avatar
Kenichi Handa committed
326
  o coding system of a newly created buffer
Kenichi Handa's avatar
Kenichi Handa committed
327 328
  o default coding system for subprocess I/O
This also sets the following values:
329 330
  o default value used as `file-name-coding-system' for converting file names
      if CODING-SYSTEM is ASCII-compatible.
331
  o default value for the command `set-terminal-coding-system' (not on MSDOS)
332 333
  o default value for the command `set-keyboard-coding-system'
      if CODING-SYSTEM is ASCII-compatible.."
334 335
  (check-coding-system coding-system)
  (setq-default buffer-file-coding-system coding-system)
336 337 338 339 340
  (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))))

341
  (if (eq system-type 'darwin)
342
      ;; The file-name coding system on Darwin systems is always utf-8.
343 344 345 346 347
      (setq default-file-name-coding-system 'utf-8)
    (if (and default-enable-multibyte-characters
	     (or (not coding-system)
		 (not (coding-system-get coding-system 'ascii-incompatible))))
	(setq default-file-name-coding-system coding-system)))
348 349 350 351
  ;; If coding-system is nil, honor that on MS-DOS as well, so
  ;; that they could reset the terminal coding system.
  (unless (and (eq window-system 'pc) coding-system)
    (setq default-terminal-coding-system coding-system))
352 353 354
  (if (or (not coding-system)
	  (not (coding-system-get coding-system 'ascii-incompatible)))
      (setq default-keyboard-coding-system coding-system))
355 356 357 358 359 360 361 362 363 364 365 366 367
  ;; 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))))
368

Kenichi Handa's avatar
Kenichi Handa committed
369 370
(defun prefer-coding-system (coding-system)
  "Add CODING-SYSTEM at the front of the priority list for automatic detection.
371
This also sets the following coding systems:
Kenichi Handa's avatar
Kenichi Handa committed
372
  o coding system of a newly created buffer
Kenichi Handa's avatar
Kenichi Handa committed
373 374
  o default coding system for subprocess I/O
This also sets the following values:
Dave Love's avatar
Dave Love committed
375
  o default value used as `file-name-coding-system' for converting file names.
376 377 378
  o default value for the command `set-terminal-coding-system' (not on MSDOS)
  o default value for the command `set-keyboard-coding-system'

379 380 381
If CODING-SYSTEM specifies a certain type of EOL conversion, the coding
systems set by this function will use that type of EOL conversion.

382 383 384
This command does not change the default value of terminal coding system
for MS-DOS terminal, because DOS terminals only support a single coding
system, and Emacs automatically sets the default to that coding system at
385 386
startup.

Dave Love's avatar
Dave Love committed
387 388 389 390
A coding system that requires automatic detection of text
encoding (e.g. undecided, unix) can't be preferred.

See also `coding-category-list' and `coding-system-category'."
Kenichi Handa's avatar
Kenichi Handa committed
391 392 393 394
  (interactive "zPrefer coding system: ")
  (if (not (and coding-system (coding-system-p coding-system)))
      (error "Invalid coding system `%s'" coding-system))
  (let ((coding-category (coding-system-category coding-system))
395 396
	(base (coding-system-base coding-system))
	(eol-type (coding-system-eol-type coding-system)))
Kenichi Handa's avatar
Kenichi Handa committed
397 398 399
    (if (not coding-category)
	;; CODING-SYSTEM is no-conversion or undecided.
	(error "Can't prefer the coding system `%s'" coding-system))
Kenichi Handa's avatar
Kenichi Handa committed
400
    (set coding-category (or base coding-system))
401
    ;; Changing the binding of a coding category requires this call.
402
    (update-coding-systems-internal)
403
    (or (eq coding-category (car coding-category-list))
Kenichi Handa's avatar
Kenichi Handa committed
404
	;; We must change the order.
405
	(set-coding-priority (list coding-category)))
Kenichi Handa's avatar
Kenichi Handa committed
406 407 408
    (if (and base (interactive-p))
	(message "Highest priority is set to %s (base of %s)"
		 base coding-system))
409
    ;; If they asked for specific EOL conversion, honor that.
410
    (if (memq eol-type '(0 1 2))
411 412 413 414
	(setq coding-system
	      (coding-system-change-eol-conversion base eol-type))
      (setq coding-system base))
    (set-default-coding-systems coding-system)))
Kenichi Handa's avatar
Kenichi Handa committed
415

416 417 418 419 420 421 422 423 424 425
(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.
426
Returns the sorted list.  CODINGS is modified by side effects.
427 428 429 430 431 432 433 434 435 436 437

If a coding system is most preferred, it has the highest priority.
Otherwise, a coding system corresponds to some MIME charset has higher
priorities.  Among them, a coding system included in `coding-system'
key of the current language environment has higher priorities.  See
also the documentation of `language-info-alist'.

If the variable `sort-coding-systems-predicate' (which see) is
non-nil, it is used to sort CODINGS in the different way than above."
  (if sort-coding-systems-predicate
      (sort codings sort-coding-systems-predicate)
438 439 440
    (let* ((from-categories (mapcar #'(lambda (x) (symbol-value x))
				    coding-category-list))
	   (most-preferred (car from-categories))
441 442 443 444 445
	   (lang-preferred (get-language-info current-language-environment
					      'coding-system))
	   (func (function
		  (lambda (x)
		    (let ((base (coding-system-base x)))
446 447 448 449 450 451 452 453 454 455 456 457
		      ;; We calculate the priority number 0..255 by
		      ;; using the 8 bits PMMLCEII as this:
		      ;; P: 1 iff most preferred.
		      ;; MM: greater than 0 iff mime-charset.
		      ;; L: 1 iff one of the current lang. env.'s codings.
		      ;; C: 1 iff one of codings listed in the category list.
		      ;; E: 1 iff not XXX-with-esc
		      ;; II: if iso-2022 based, 0..3, else 1.
		      (logior
		       (lsh (if (eq base most-preferred) 1 0) 7)
		       (lsh
			(let ((mime (coding-system-get base 'mime-charset)))
Dave Love's avatar
Dave Love committed
458 459
			   ;; Prefer coding systems corresponding to a
			   ;; MIME charset.
460
			   (if mime
Dave Love's avatar
Dave Love committed
461 462 463
			       ;; Lower utf-16 priority so that we
			       ;; normally prefer utf-8 to it, and put
			       ;; x-ctext below that.
464 465
			       (cond ((string-match "utf-16"
						    (symbol-name mime))
466
				      2)
Dave Love's avatar
Dave Love committed
467
				     ((string-match "^x-" (symbol-name mime))
468 469
				      1)
				     (t 3))
470
			     0))
471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489
			5)
		       (lsh (if (memq base lang-preferred) 1 0) 4)
		       (lsh (if (memq base from-categories) 1 0) 3)
		       (lsh (if (string-match "-with-esc\\'"
					      (symbol-name base))
				0 1) 2)
		       (if (eq (coding-system-type base) 2)
			   ;; For ISO based coding systems, prefer
			   ;; one that doesn't use escape sequences.
			   (let ((flags (coding-system-flags base)))
			     (if (or (consp (aref flags 0))
				     (consp (aref flags 1))
				     (consp (aref flags 2))
				     (consp (aref flags 3)))
				 (if (or (aref flags 8) (aref flags 9))
				     0
				   1)
			       2))
			 1)))))))
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.
Dave Love's avatar
Dave Love committed
495
If FROM is a string, find coding systems in that instead of the buffer.
496 497 498
All coding systems in the list can safely encode any multibyte characters
in the text.

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

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

(defun find-coding-systems-for-charsets (charsets)
  "Return a list of proper coding systems to encode characters of CHARSETS.
520 521 522 523
CHARSETS is a list of character sets.
It actually checks at most the first 96 characters of each charset.
So, if a charset of dimension two is included in CHARSETS, the value may
contain a coding system that can't encode all characters of the charset."
524 525 526 527 528 529 530 531 532
  (cond ((or (null charsets)
	     (and (= (length charsets) 1)
		  (eq 'ascii (car charsets))))
	 '(undecided))
	((or (memq 'eight-bit-control charsets)
	     (memq 'eight-bit-graphic charsets))
	 '(raw-text emacs-mule))
	(t
	 (let ((codings t)
533
	       charset l str)
534 535 536
	   (while (and codings charsets)
	     (setq charset (car charsets) charsets (cdr charsets))
	     (unless (eq charset 'ascii)
537 538 539 540 541 542 543 544 545 546 547 548 549
	       (setq str (make-string 96 32))
	       (if (= (charset-dimension charset) 1)
		   (if (= (charset-chars charset) 96)
		       (dotimes (i 96)
			 (aset str i (make-char charset (+ i 32))))
		     (dotimes (i 94)
		       (aset str i (make-char charset (+ i 33)))))
		 (if (= (charset-chars charset) 96)
		     (dotimes (i 96)
		       (aset str i (make-char charset 32 (+ i 32))))
		   (dotimes (i 94)
		     (aset str i (make-char charset 33 (+ i 33))))))
	       (setq l (find-coding-systems-string str))
550 551 552
	       (if (eq codings t)
		   (setq codings l)
		 (let ((ll nil))
553 554 555
		   (dolist (elt codings)
		     (if (memq elt l)
			 (setq ll (cons elt ll))))
556
		   (setq codings ll)))))
557
	   codings))))
558

559 560 561 562 563 564 565 566
(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,
567
  CHARs are the characters found from the character set.
568
Optional 3rd arg MAXCOUNT limits how many CHARs are put in the above list.
569 570 571
Optional 4th arg EXCLUDE is a list of character sets to be ignored.

For invalid characters, CHARs are actually strings."
572 573 574 575 576 577 578
  (let ((chars nil)
	charset char)
    (if (stringp from)
	(let ((idx 0))
	  (while (setq idx (string-match "[^\000-\177]" from idx))
	    (setq char (aref from idx)
		  charset (char-charset char))
579 580
	    (if (eq charset 'unknown)
		(setq char (match-string 0)))
581 582
	    (if (or (memq charset '(unknown
				    eight-bit-control eight-bit-graphic))
583
		    (not (or (eq excludes t) (memq charset excludes))))
584 585 586 587 588 589 590 591 592 593 594 595 596 597
		(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))))
      (save-excursion
	(goto-char from)
	(while (re-search-forward "[^\000-\177]" to t)
	  (setq char (preceding-char)
		charset (char-charset char))
598 599
	  (if (eq charset 'unknown)
	      (setq char (match-string 0)))
600
	  (if (or (memq charset '(unknown eight-bit-control eight-bit-graphic))
601
		  (not (or (eq excludes t) (memq charset excludes))))
602 603
	      (let ((slot (assq charset chars)))
		(if slot
604
		    (if (not (member char (nthcdr 2 slot)))
605 606 607 608 609 610 611
			(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))))))))
    (nreverse chars)))

Kenichi Handa's avatar
Kenichi Handa committed
612 613 614 615 616 617 618 619 620 621 622 623

(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.

When called from a program, the value is a position of the found character,
or nil if all characters are encodable."
  (interactive
   (list (let ((default (or buffer-file-coding-system 'us-ascii)))
	   (read-coding-system
624
	    (format "Coding-system (default %s): " default)
Kenichi Handa's avatar
Kenichi Handa committed
625 626 627 628 629 630 631 632
	    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))


633 634 635 636 637 638 639
(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.")

640
(defvar select-safe-coding-system-accept-default-p nil
641
  "If non-nil, a function to control the behavior of coding system selection.
642 643 644 645
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.")

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

793 794
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\
795
where `\\[universal-argument] \\[what-cursor-position]' will give information about it.\n"))))
796
	  (insert (substitute-command-keys "\nSelect \
797 798 799 800 801
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"))
802 803 804 805 806
	  (let ((pos (point))
		(fill-prefix "  "))
	    (dolist (x codings)
	      (princ "  ") (princ x))
	    (insert "\n")
807
	    (fill-region-as-paragraph pos (point)))))
808 809 810 811 812 813 814 815 816 817 818 819

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

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

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

However, the user is queried if the chosen coding system is
836
inconsistent with what would be selected by `find-auto-coding' from
Dave Love's avatar
Dave Love committed
837 838 839
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.)
840

841 842
Optional 3rd arg DEFAULT-CODING-SYSTEM specifies a coding system or a
list of coding systems to be prepended to the default coding system
843
list.  However, if DEFAULT-CODING-SYSTEM is a list and the first
844
element is t, the cdr part is used as the default coding system list,
845 846
i.e. `buffer-file-coding-system', `default-buffer-file-coding-system',
and the most preferred coding system are not used.
847

848 849 850 851 852
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.

853 854 855 856
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).

857 858
The variable `select-safe-coding-system-accept-default-p', if
non-nil, overrides ACCEPT-DEFAULT-P.
859 860 861

Kludgy feature: if FROM is a string, the string is the target text,
and TO is ignored."
862 863 864 865
  (if (and default-coding-system
	   (not (listp default-coding-system)))
      (setq default-coding-system (list default-coding-system)))

866 867
  (let ((no-other-defaults nil)
	auto-cs)
868
    (unless (or (stringp from) find-file-literally)
869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892
      ;; 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
		 :warning
		 (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"
			   (format "variable `%s'" (cdr auto-cs)))))
		(or (yes-or-no-p "Really proceed with writing? ")
		    (error "Save aborted"))
		(setq auto-cs nil))))))

893 894 895 896 897 898 899 900 901
    (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))

902 903 904 905 906 907 908 909 910
    (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))))

911 912 913 914 915 916 917
    (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)
918 919 920
		(setq default-coding-system
		      (append default-coding-system
			      (list (cons buffer-file-coding-system base)))))))
921 922 923 924 925 926 927

      ;; 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)
928 929
		(setq default-coding-system
		      (append default-coding-system
930
			      (list (cons default-buffer-file-coding-system
931
					  base)))))))
932 933 934 935 936

      ;; If the most preferred coding system has the property mime-charset,
      ;; append it to the defaults.
      (let ((tail coding-category-list)
	    preferred base)
937
	(while (and tail (not (setq preferred (symbol-value (car tail)))))
938 939 940 941 942
	  (setq tail (cdr tail)))
	(and (coding-system-p preferred)
	     (setq base (coding-system-base preferred))
	     (coding-system-get preferred 'mime-charset)
	     (not (rassq base default-coding-system))
943 944 945
	     (setq default-coding-system
		   (append default-coding-system
			   (list (cons preferred base)))))))
946 947 948 949

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

950 951 952 953 954 955 956
    ;; 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)
957
	      (setq default-eol-type (coding-system-eol-type
958 959
				      buffer-file-coding-system)))
	  (if (and (vectorp default-eol-type) default-buffer-file-coding-system)
960
	      (setq default-eol-type (coding-system-eol-type
961 962 963 964 965 966
				      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))))))

967 968 969 970 971
    (let ((codings (find-coding-systems-region from to))
	  (coding-system nil)
	  safe rejected unsafe)
      (if (eq (car codings) 'undecided)
	  ;; Any coding system is ok.
972 973 974 975 976
	  (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))

977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000
	;; Classify the defaults into safe, rejected, and unsafe.
	(dolist (elt default-coding-system)
	  (if (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))))

      ;; If all the defaults failed, ask a user.
      (when (not coding-system)
	(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)))))
1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022
	;; 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
1023 1024 1025 1026
		 ;; 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 "")))
1027
		 (not (coding-system-equal coding-system auto-cs)))
1028 1029 1030 1031
	    (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))
1032 1033
	      (error "Save aborted"))))
      coding-system)))
1034 1035 1036

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

1037 1038 1039 1040 1041 1042
(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'
1043 1044
  (3) value of `default-sendmail-coding-system'
  (4) value of `default-buffer-file-coding-system'
1045 1046
If the found coding system can't encode the current buffer,
or none of them are bound to a coding system,
1047
it asks the user to select a proper coding system."
1048
  (let ((coding (or (and (local-variable-p 'buffer-file-coding-system)
1049 1050 1051 1052
			  buffer-file-coding-system)
		     sendmail-coding-system
		     default-sendmail-coding-system
		     default-buffer-file-coding-system)))
1053
    (if (eq coding 'no-conversion)
Dave Love's avatar
Dave Love committed
1054
	;; We should never use no-conversion for outgoing mail.
1055 1056
	(setq coding nil))
    (if (fboundp select-safe-coding-system-function)
1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069
	(setq coding
	      (funcall select-safe-coding-system-function
		       (point-min) (point-max) coding
		       (function (lambda (x)
				   (coding-system-get x 'mime-charset))))))
    (if coding
	;; Be sure to use LF for end-of-line.
	(setq coding (coding-system-change-eol-conversion coding 'unix))
      ;; No coding system is decided.  Usually this is the case that
      ;; the current buffer contains only ASCII.  So, we hope
      ;; iso-8859-1 works.
      (setq coding 'iso-8859-1-unix))
    coding))
Karl Heuer's avatar
Karl Heuer committed
1070

1071
;;; Language support stuff.
Karl Heuer's avatar
Karl Heuer committed
1072 1073

(defvar language-info-alist nil
Richard M. Stallman's avatar
Richard M. Stallman committed
1074
  "Alist of language environment definitions.
Karl Heuer's avatar
Karl Heuer committed
1075 1076
Each element looks like:
	(LANGUAGE-NAME . ((KEY . INFO) ...))
Richard M. Stallman's avatar
Richard M. Stallman committed
1077 1078 1079 1080 1081 1082 1083 1084 1085
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.
  charset	     value is a list of the character sets used by this
			language environment.
Dave Love's avatar
Dave Love committed
1086 1087 1088
  sample-text