Mercurial > hg > xemacs-beta

comparison lisp/mule/mule-cmds.el @ 444:576fb035e263 r21-2-37

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-37
author cvs
date Mon, 13 Aug 2007 11:36:19 +0200
parents abe6d1db359e
children 3078fd1074e8
comparison
equal deleted inserted replaced
443:a8296e22da4e 444:576fb035e263
21 ;; You should have received a copy of the GNU General Public License 21 ;; You should have received a copy of the GNU General Public License
22 ;; along with XEmacs; see the file COPYING. If not, write to the Free 22 ;; along with XEmacs; see the file COPYING. If not, write to the Free
23 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 23 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
24 ;; 02111-1307, USA. 24 ;; 02111-1307, USA.
25 25
26 ;; Note: Some of the code here is now in code-cmds.el
27
26 ;;; Code: 28 ;;; Code:
27 29
28 ;;; MULE related key bindings and menus. 30 ;;; MULE related key bindings and menus.
29 31
30 (defvar mule-keymap (make-sparse-keymap "Mule") 32 (require 'code-cmds)
31 "Keymap for Mule (Multilingual environment) specific commands.") 33
32 34 ;; Preserve the old name
33 ;; Keep "C-x C-m ..." for mule specific commands. 35 (defvaralias 'mule-keymap 'coding-keymap)
34 (define-key ctl-x-map "\C-m" mule-keymap) 36
35
36 (define-key mule-keymap "f" 'set-buffer-file-coding-system)
37 (define-key mule-keymap "F" 'set-default-buffer-file-coding-system) ; XEmacs
38 (define-key mule-keymap "t" 'set-terminal-coding-system)
39 (define-key mule-keymap "k" 'set-keyboard-coding-system)
40 (define-key mule-keymap "p" 'set-buffer-process-coding-system)
41 (define-key mule-keymap "x" 'set-selection-coding-system) 37 (define-key mule-keymap "x" 'set-selection-coding-system)
42 (define-key mule-keymap "X" 'set-next-selection-coding-system) 38 (define-key mule-keymap "X" 'set-next-selection-coding-system)
43 (define-key mule-keymap "\C-\\" 'set-input-method) 39 (define-key mule-keymap "\C-\\" 'set-input-method)
44 (define-key mule-keymap "c" 'universal-coding-system-argument)
45 ;;(define-key mule-keymap "c" 'list-coding-system-briefly) ; XEmacs 40 ;;(define-key mule-keymap "c" 'list-coding-system-briefly) ; XEmacs
46 (define-key mule-keymap "C" 'describe-coding-system) ; XEmacs 41 (define-key mule-keymap "C" 'describe-coding-system) ; XEmacs
47 (define-key mule-keymap "r" 'toggle-display-direction) ; XEmacs 42 (define-key mule-keymap "r" 'toggle-display-direction) ; XEmacs
48 (define-key mule-keymap "l" 'set-language-environment) 43 (define-key mule-keymap "l" 'set-language-environment)
49 44
121 (interactive) 116 (interactive)
122 ;; We have to decode the file in any environment. 117 ;; We have to decode the file in any environment.
123 (let ((coding-system-for-read 'iso-2022-7bit)) 118 (let ((coding-system-for-read 'iso-2022-7bit))
124 (find-file-read-only (expand-file-name "HELLO" data-directory)))) 119 (find-file-read-only (expand-file-name "HELLO" data-directory))))
125 120
126 (defun universal-coding-system-argument ()
127 "Execute an I/O command using the specified coding system."
128 (interactive)
129 (let* ((default (and buffer-file-coding-system
130 (not (eq (coding-system-type buffer-file-coding-system)
131 t))
132 (coding-system-name buffer-file-coding-system)))
133 (coding-system
134 (read-coding-system
135 (if default
136 (format "Coding system for following command (default, %s): "
137 default)
138 "Coding system for following command: ")
139 default))
140 (keyseq (read-key-sequence
141 (format "Command to execute with %s:" coding-system)))
142 (cmd (key-binding keyseq)))
143 (let ((coding-system-for-read coding-system)
144 (coding-system-for-write coding-system))
145 (message "")
146 (call-interactively cmd))))
147
148 (defun set-default-coding-systems (coding-system)
149 "Set default value of various coding systems to CODING-SYSTEM.
150 This sets the following coding systems:
151 o coding system of a newly created buffer
152 o default coding system for terminal output
153 o default coding system for keyboard input
154 o default coding system for subprocess I/O
155 o default coding system for converting file names."
156 (check-coding-system coding-system)
157 ;;(setq-default buffer-file-coding-system coding-system)
158 (set-default-buffer-file-coding-system coding-system)
159 ;; (if default-enable-multibyte-characters
160 ;; (setq default-file-name-coding-system coding-system))
161 ;; If coding-system is nil, honor that on MS-DOS as well, so
162 ;; that they could reset the terminal coding system.
163 ;; (unless (and (eq window-system 'pc) coding-system)
164 ;; (setq default-terminal-coding-system coding-system))
165 (set-terminal-coding-system coding-system)
166 ;;(setq default-keyboard-coding-system coding-system)
167 (set-keyboard-coding-system coding-system)
168 ;;(setq default-process-coding-system (cons coding-system coding-system))
169 ;; Refer to coding-system-for-read and coding-system-for-write
170 ;; so that C-x RET c works.
171 (add-hook 'comint-exec-hook
172 `(lambda ()
173 (let ((proc (get-buffer-process (current-buffer))))
174 (set-process-input-coding-system
175 proc (or coding-system-for-read ',coding-system))
176 (set-process-output-coding-system
177 proc (or coding-system-for-write ',coding-system))))
178 'append)
179 (setq file-name-coding-system coding-system))
180
181 (defun prefer-coding-system (coding-system)
182 "Add CODING-SYSTEM at the front of the priority list for automatic detection.
183 This also sets the following coding systems:
184 o coding system of a newly created buffer
185 o default coding system for terminal output
186 o default coding system for keyboard input
187 o default coding system for converting file names.
188
189 If CODING-SYSTEM specifies a certain type of EOL conversion, the coding
190 systems set by this function will use that type of EOL conversion.
191
192 This command does not change the default value of terminal coding system
193 for MS-DOS terminal, because DOS terminals only support a single coding
194 system, and Emacs automatically sets the default to that coding system at
195 startup."
196 (interactive "zPrefer coding system: ")
197 (if (not (and coding-system (find-coding-system coding-system)))
198 (error "Invalid coding system `%s'" coding-system))
199 (let ((coding-category (coding-system-category coding-system))
200 (base (coding-system-base coding-system))
201 (eol-type (coding-system-eol-type coding-system)))
202 (if (not coding-category)
203 ;; CODING-SYSTEM is no-conversion or undecided.
204 (error "Can't prefer the coding system `%s'" coding-system))
205 (set-coding-category-system coding-category (or base coding-system))
206 ;; (update-coding-systems-internal)
207 (or (eq coding-category (car (coding-category-list)))
208 ;; We must change the order.
209 (set-coding-priority-list (list coding-category)))
210 (if (and base (interactive-p))
211 (message "Highest priority is set to %s (base of %s)"
212 base coding-system))
213 ;; If they asked for specific EOL conversion, honor that.
214 (if (memq eol-type '(lf crlf mac))
215 (setq coding-system
216 (coding-system-change-eol-conversion base eol-type))
217 (setq coding-system base))
218 (set-default-coding-systems coding-system)))
219
220 ;; (defun find-coding-systems-region-subset-p (list1 list2)
221 ;; "Return non-nil if all elements in LIST1 are included in LIST2.
222 ;; Comparison done with EQ."
223 ;; (catch 'tag
224 ;; (while list1
225 ;; (or (memq (car list1) list2)
226 ;; (throw 'tag nil))
227 ;; (setq list1 (cdr list1)))
228 ;; t))
229
230 ;; (defun find-coding-systems-region (from to)
231 ;; "Return a list of proper coding systems to encode a text between FROM and TO.
232 ;; All coding systems in the list can safely encode any multibyte characters
233 ;; in the text.
234 ;;
235 ;; If the text contains no multibyte characters, return a list of a single
236 ;; element `undecided'."
237 ;; (find-coding-systems-for-charsets (find-charset-region from to)))
238
239 ;; (defun find-coding-systems-string (string)
240 ;; "Return a list of proper coding systems to encode STRING.
241 ;; All coding systems in the list can safely encode any multibyte characters
242 ;; in STRING.
243 ;;
244 ;; If STRING contains no multibyte characters, return a list of a single
245 ;; element `undecided'."
246 ;; (find-coding-systems-for-charsets (find-charset-string string)))
247
248 ;; (defun find-coding-systems-for-charsets (charsets)
249 ;; "Return a list of proper coding systems to encode characters of CHARSETS.
250 ;; CHARSETS is a list of character sets."
251 ;; (if (or (null charsets)
252 ;; (and (= (length charsets) 1)
253 ;; (eq 'ascii (car charsets))))
254 ;; '(undecided)
255 ;; (setq charsets (delq 'composition charsets))
256 ;; (let ((l (coding-system-list 'base-only))
257 ;; (charset-preferred-codings
258 ;; (mapcar (function
259 ;; (lambda (x)
260 ;; (if (eq x 'unknown)
261 ;; 'raw-text
262 ;; (get-charset-property x 'preferred-coding-system))))
263 ;; charsets))
264 ;; (priorities (mapcar (function (lambda (x) (symbol-value x)))
265 ;; coding-category-list))
266 ;; codings coding safe)
267 ;; (if (memq 'unknown charsets)
268 ;; ;; The region contains invalid multibyte characters.
269 ;; (setq l '(raw-text)))
270 ;; (while l
271 ;; (setq coding (car l) l (cdr l))
272 ;; (if (and (setq safe (coding-system-get coding 'safe-charsets))
273 ;; (or (eq safe t)
274 ;; (find-coding-systems-region-subset-p charsets safe)))
275 ;; ;; We put the higher priority to coding systems included
276 ;; ;; in CHARSET-PREFERRED-CODINGS, and within them, put the
277 ;; ;; higher priority to coding systems which support smaller
278 ;; ;; number of charsets.
279 ;; (let ((priority
280 ;; (+ (if (coding-system-get coding 'mime-charset) 4096 0)
281 ;; (lsh (length (memq coding priorities)) 7)
282 ;; (if (memq coding charset-preferred-codings) 64 0)
283 ;; (if (> (coding-system-type coding) 0) 32 0)
284 ;; (if (consp safe) (- 32 (length safe)) 0))))
285 ;; (setq codings (cons (cons priority coding) codings)))))
286 ;; (mapcar 'cdr
287 ;; (sort codings (function (lambda (x y) (> (car x) (car y))))))
288 ;; )))
289
290 ;; (defun find-multibyte-characters (from to &optional maxcount excludes)
291 ;; "Find multibyte characters in the region specified by FROM and TO.
292 ;; If FROM is a string, find multibyte characters in the string.
293 ;; The return value is an alist of the following format:
294 ;; ((CHARSET COUNT CHAR ...) ...)
295 ;; where
296 ;; CHARSET is a character set,
297 ;; COUNT is a number of characters,
298 ;; CHARs are found characters of the character set.
299 ;; Optional 3rd arg MAXCOUNT limits how many CHARs are put in the above list.
300 ;; Optional 4th arg EXCLUDE is a list of character sets to be ignored.
301 ;;
302 ;; For invalid characters, CHARs are actually strings."
303 ;; (let ((chars nil)
304 ;; charset char)
305 ;; (if (stringp from)
306 ;; (let ((idx 0))
307 ;; (while (setq idx (string-match "[^\000-\177]" from idx))
308 ;; (setq char (aref from idx)
309 ;; charset (char-charset char))
310 ;; (if (eq charset 'unknown)
311 ;; (setq char (match-string 0)))
312 ;; (if (or (eq charset 'unknown)
313 ;; (not (or (eq excludes t) (memq charset excludes))))
314 ;; (let ((slot (assq charset chars)))
315 ;; (if slot
316 ;; (if (not (memq char (nthcdr 2 slot)))
317 ;; (let ((count (nth 1 slot)))
318 ;; (setcar (cdr slot) (1+ count))
319 ;; (if (or (not maxcount) (< count maxcount))
320 ;; (nconc slot (list char)))))
321 ;; (setq chars (cons (list charset 1 char) chars)))))
322 ;; (setq idx (1+ idx))))
323 ;; (save-excursion
324 ;; (goto-char from)
325 ;; (while (re-search-forward "[^\000-\177]" to t)
326 ;; (setq char (preceding-char)
327 ;; charset (char-charset char))
328 ;; (if (eq charset 'unknown)
329 ;; (setq char (match-string 0)))
330 ;; (if (or (eq charset 'unknown)
331 ;; (not (or (eq excludes t) (memq charset excludes))))
332 ;; (let ((slot (assq charset chars)))
333 ;; (if slot
334 ;; (if (not (member char (nthcdr 2 slot)))
335 ;; (let ((count (nth 1 slot)))
336 ;; (setcar (cdr slot) (1+ count))
337 ;; (if (or (not maxcount) (< count maxcount))
338 ;; (nconc slot (list char)))))
339 ;; (setq chars (cons (list charset 1 char) chars))))))))
340 ;; (nreverse chars)))
341
342 ;; (defvar last-coding-system-specified nil
343 ;; "Most recent coding system explicitly specified by the user when asked.
344 ;; This variable is set whenever Emacs asks the user which coding system
345 ;; to use in order to write a file. If you set it to nil explicitly,
346 ;; then call `write-region', then afterward this variable will be non-nil
347 ;; only if the user was explicitly asked and specified a coding system.")
348
349 ;; (defun select-safe-coding-system (from to &optional default-coding-system)
350 ;; "Ask a user to select a safe coding system from candidates.
351 ;; The candidates of coding systems which can safely encode a text
352 ;; between FROM and TO are shown in a popup window.
353 ;;
354 ;; Optional arg DEFAULT-CODING-SYSTEM specifies a coding system to be
355 ;; checked at first. If omitted, buffer-file-coding-system of the
356 ;; current buffer is used.
357 ;;
358 ;; If the text can be encoded safely by DEFAULT-CODING-SYSTEM, it is
359 ;; returned without any user interaction.
360 ;;
361 ;; Kludgy feature: if FROM is a string, the string is the target text,
362 ;; and TO is ignored."
363 ;; (or default-coding-system
364 ;; (setq default-coding-system buffer-file-coding-system))
365 ;; (let* ((charsets (if (stringp from) (find-charset-string from)
366 ;; (find-charset-region from to)))
367 ;; (safe-coding-systems (find-coding-systems-for-charsets charsets)))
368 ;; (if (or (not enable-multibyte-characters)
369 ;; (eq (car safe-coding-systems) 'undecided)
370 ;; (eq default-coding-system 'no-conversion)
371 ;; (and default-coding-system
372 ;; (memq (coding-system-base default-coding-system)
373 ;; safe-coding-systems)))
374 ;; default-coding-system
375 ;;
376 ;; ;; At first, change each coding system to the corresponding
377 ;; ;; mime-charset name if it is also a coding system.
378 ;; (let ((l safe-coding-systems)
379 ;; mime-charset)
380 ;; (while l
381 ;; (setq mime-charset (coding-system-get (car l) 'mime-charset))
382 ;; (if (and mime-charset (coding-system-p mime-charset))
383 ;; (setcar l mime-charset))
384 ;; (setq l (cdr l))))
385 ;;
386 ;; (let ((non-safe-chars (find-multibyte-characters
387 ;; from to 3
388 ;; (and default-coding-system
389 ;; (coding-system-get default-coding-system
390 ;; 'safe-charsets))))
391 ;; show-position overlays)
392 ;; (save-excursion
393 ;; ;; Highlight characters that default-coding-system can't encode.
394 ;; (when (integerp from)
395 ;; (goto-char from)
396 ;; (let ((found nil))
397 ;; (while (and (not found)
398 ;; (re-search-forward "[^\000-\177]" to t))
399 ;; (setq found (assq (char-charset (preceding-char))
400 ;; non-safe-chars))))
401 ;; (forward-line -1)
402 ;; (setq show-position (point))
403 ;; (save-excursion
404 ;; (while (and (< (length overlays) 256)
405 ;; (re-search-forward "[^\000-\177]" to t))
406 ;; (let* ((char (preceding-char))
407 ;; (charset (char-charset char)))
408 ;; (when (assq charset non-safe-chars)
409 ;; (setq overlays (cons (make-overlay (1- (point)) (point))
410 ;; overlays))
411 ;; (overlay-put (car overlays) 'face 'highlight))))))
412 ;;
413 ;; ;; At last, ask a user to select a proper coding system.
414 ;; (unwind-protect
415 ;; (save-window-excursion
416 ;; (when show-position
417 ;; ;; At first, be sure to show the current buffer.
418 ;; (set-window-buffer (selected-window) (current-buffer))
419 ;; (set-window-start (selected-window) show-position))
420 ;; ;; Then, show a helpful message.
421 ;; (with-output-to-temp-buffer "*Warning*"
422 ;; (save-excursion
423 ;; (set-buffer standard-output)
424 ;; (insert "The target text contains the following non ASCII character(s):\n")
425 ;; (let ((len (length non-safe-chars))
426 ;; (shown 0))
427 ;; (while (and non-safe-chars (< shown 3))
428 ;; (when (> (length (car non-safe-chars)) 2)
429 ;; (setq shown (1+ shown))
430 ;; (insert (format "%25s: " (car (car non-safe-chars))))
431 ;; (let ((l (nthcdr 2 (car non-safe-chars))))
432 ;; (while l
433 ;; (if (or (stringp (car l)) (char-valid-p (car l)))
434 ;; (insert (car l)))
435 ;; (setq l (cdr l))))
436 ;; (if (> (nth 1 (car non-safe-chars)) 3)
437 ;; (insert "..."))
438 ;; (insert "\n"))
439 ;; (setq non-safe-chars (cdr non-safe-chars)))
440 ;; (if (< shown len)
441 ;; (insert (format "%27s\n" "..."))))
442 ;; (insert (format "\
443 ;; These can't be encoded safely by the coding system %s.
444 ;;
445 ;; Please select one from the following safe coding systems:\n"
446 ;; default-coding-system))
447 ;; (let ((pos (point))
448 ;; (fill-prefix " "))
449 ;; (mapcar (function (lambda (x) (princ " ") (princ x)))
450 ;; safe-coding-systems)
451 ;; (fill-region-as-paragraph pos (point)))))
452 ;;
453 ;; ;; Read a coding system.
454 ;; (let* ((safe-names (mapcar (lambda (x) (list (symbol-name x)))
455 ;; safe-coding-systems))
456 ;; (name (completing-read
457 ;; (format "Select coding system (default %s): "
458 ;; (car safe-coding-systems))
459 ;; safe-names nil t nil nil
460 ;; (car (car safe-names)))))
461 ;; (setq last-coding-system-specified (intern name))
462 ;; (if (integerp (coding-system-eol-type default-coding-system))
463 ;; (setq last-coding-system-specified
464 ;; (coding-system-change-eol-conversion
465 ;; last-coding-system-specified
466 ;; (coding-system-eol-type default-coding-system))))
467 ;; last-coding-system-specified))
468 ;; (kill-buffer "*Warning*")
469 ;; (while overlays
470 ;; (delete-overlay (car overlays))
471 ;; (setq overlays (cdr overlays)))))))))
472
473 ;; (setq select-safe-coding-system-function 'select-safe-coding-system)
474
475 ;; (defun select-message-coding-system ()
476 ;; "Return a coding system to encode the outgoing message of the current buffer.
477 ;; It at first tries the first coding system found in these variables
478 ;; in this order:
479 ;; (1) local value of `buffer-file-coding-system'
480 ;; (2) value of `sendmail-coding-system'
481 ;; (3) value of `default-buffer-file-coding-system'
482 ;; (4) value of `default-sendmail-coding-system'
483 ;; If the found coding system can't encode the current buffer,
484 ;; or none of them are bound to a coding system,
485 ;; it asks the user to select a proper coding system."
486 ;; (let ((coding (or (and (local-variable-p 'buffer-file-coding-system)
487 ;; buffer-file-coding-system)
488 ;; sendmail-coding-system
489 ;; default-buffer-file-coding-system
490 ;; default-sendmail-coding-system)))
491 ;; (if (eq coding 'no-conversion)
492 ;; ;; We should never use no-conversion for outgoing mails.
493 ;; (setq coding nil))
494 ;; (if (fboundp select-safe-coding-system-function)
495 ;; (funcall select-safe-coding-system-function
496 ;; (point-min) (point-max) coding)
497 ;; coding)))
498 121
499 ;;; Language support stuff. 122 ;;; Language support stuff.
500 123
501 (defvar language-info-alist nil 124 (defvar language-info-alist nil
502 "Alist of language environment definitions. 125 "Alist of language environment definitions.
1055 (defun reset-language-environment () 678 (defun reset-language-environment ()
1056 "Reset multilingual environment of Emacs to the default status. 679 "Reset multilingual environment of Emacs to the default status.
1057 680
1058 The default status is as follows: 681 The default status is as follows:
1059 682
1060 The default value of buffer-file-coding-system is nil. 683 The default value of `buffer-file-coding-system' is nil.
1061 The default coding system for process I/O is nil. 684 The default coding system for process I/O is nil.
1062 The default value for the command `set-terminal-coding-system' is nil. 685 The default value for the command `set-terminal-coding-system' is nil.
1063 The default value for the command `set-keyboard-coding-system' is nil. 686 The default value for the command `set-keyboard-coding-system' is nil.
1064 687
1065 The order of priorities of coding categories and the coding system 688 The order of priorities of coding categories and the coding system