annotate lisp/code-cmds.el @ 4981:4aebb0131297

Cleanups/renaming of EXTERNAL_TO_C_STRING and friends -------------------- ChangeLog entries follow: -------------------- modules/ChangeLog addition: 2010-02-05 Ben Wing <ben@xemacs.org> * postgresql/postgresql.c: * postgresql/postgresql.c (CHECK_LIVE_CONNECTION): * postgresql/postgresql.c (Fpq_connectdb): * postgresql/postgresql.c (Fpq_connect_start): * postgresql/postgresql.c (Fpq_lo_import): * postgresql/postgresql.c (Fpq_lo_export): * ldap/eldap.c (Fldap_open): * ldap/eldap.c (Fldap_search_basic): * ldap/eldap.c (Fldap_add): * ldap/eldap.c (Fldap_modify): * ldap/eldap.c (Fldap_delete): * canna/canna_api.c (Fcanna_initialize): * canna/canna_api.c (Fcanna_store_yomi): * canna/canna_api.c (Fcanna_parse): * canna/canna_api.c (Fcanna_henkan_begin): EXTERNAL_TO_C_STRING returns its argument instead of storing it in a parameter, and is renamed to EXTERNAL_TO_ITEXT. Similar things happen to related macros. See entry in src/ChangeLog. More Mule-izing of postgresql.c. Extract out common code between `pq-connectdb' and `pq-connect-start'. Fix places that signal an error string using a formatted string to instead follow the standard and have a fixed reason followed by the particular error message stored as one of the frobs. src/ChangeLog addition: 2010-02-05 Ben Wing <ben@xemacs.org> * console-msw.c (write_string_to_mswindows_debugging_output): * console-msw.c (Fmswindows_message_box): * console-x.c (x_perhaps_init_unseen_key_defaults): * console.c: * database.c (dbm_get): * database.c (dbm_put): * database.c (dbm_remove): * database.c (berkdb_get): * database.c (berkdb_put): * database.c (berkdb_remove): * database.c (Fopen_database): * device-gtk.c (gtk_init_device): * device-msw.c (msprinter_init_device_internal): * device-msw.c (msprinter_default_printer): * device-msw.c (msprinter_init_device): * device-msw.c (sync_printer_with_devmode): * device-msw.c (Fmsprinter_select_settings): * device-x.c (sanity_check_geometry_resource): * device-x.c (Dynarr_add_validified_lisp_string): * device-x.c (x_init_device): * device-x.c (Fx_put_resource): * device-x.c (Fx_valid_keysym_name_p): * device-x.c (Fx_set_font_path): * dialog-msw.c (push_lisp_string_as_unicode): * dialog-msw.c (handle_directory_dialog_box): * dialog-msw.c (handle_file_dialog_box): * dialog-x.c (dbox_descriptor_to_widget_value): * editfns.c (Fformat_time_string): * editfns.c (Fencode_time): * editfns.c (Fset_time_zone_rule): * emacs.c (make_argc_argv): * emacs.c (Fdump_emacs): * emodules.c (emodules_load): * eval.c: * eval.c (maybe_signal_error_1): * event-msw.c (Fdde_alloc_advise_item): * event-msw.c (mswindows_dde_callback): * event-msw.c (mswindows_wnd_proc): * fileio.c (report_error_with_errno): * fileio.c (Fsysnetunam): * fileio.c (Fdo_auto_save): * font-mgr.c (extract_fcapi_string): * font-mgr.c (Ffc_config_app_font_add_file): * font-mgr.c (Ffc_config_app_font_add_dir): * font-mgr.c (Ffc_config_filename): * frame-gtk.c (gtk_set_frame_text_value): * frame-gtk.c (gtk_create_widgets): * frame-msw.c (mswindows_init_frame_1): * frame-msw.c (mswindows_set_title_from_ibyte): * frame-msw.c (msprinter_init_frame_3): * frame-x.c (x_set_frame_text_value): * frame-x.c (x_set_frame_properties): * frame-x.c (start_drag_internal_1): * frame-x.c (x_cde_transfer_callback): * frame-x.c (x_create_widgets): * glyphs-eimage.c (my_jpeg_output_message): * glyphs-eimage.c (jpeg_instantiate): * glyphs-eimage.c (gif_instantiate): * glyphs-eimage.c (png_instantiate): * glyphs-eimage.c (tiff_instantiate): * glyphs-gtk.c (xbm_instantiate_1): * glyphs-gtk.c (gtk_xbm_instantiate): * glyphs-gtk.c (gtk_xpm_instantiate): * glyphs-gtk.c (gtk_xface_instantiate): * glyphs-gtk.c (cursor_font_instantiate): * glyphs-gtk.c (gtk_redisplay_widget): * glyphs-gtk.c (gtk_widget_instantiate_1): * glyphs-gtk.c (gtk_add_tab_item): * glyphs-msw.c (mswindows_xpm_instantiate): * glyphs-msw.c (bmp_instantiate): * glyphs-msw.c (mswindows_resource_instantiate): * glyphs-msw.c (xbm_instantiate_1): * glyphs-msw.c (mswindows_xbm_instantiate): * glyphs-msw.c (mswindows_xface_instantiate): * glyphs-msw.c (mswindows_redisplay_widget): * glyphs-msw.c (mswindows_widget_instantiate): * glyphs-msw.c (add_tree_item): * glyphs-msw.c (add_tab_item): * glyphs-msw.c (mswindows_combo_box_instantiate): * glyphs-msw.c (mswindows_widget_query_string_geometry): * glyphs-x.c (x_locate_pixmap_file): * glyphs-x.c (xbm_instantiate_1): * glyphs-x.c (x_xbm_instantiate): * glyphs-x.c (extract_xpm_color_names): * glyphs-x.c (x_xpm_instantiate): * glyphs-x.c (x_xface_instantiate): * glyphs-x.c (autodetect_instantiate): * glyphs-x.c (safe_XLoadFont): * glyphs-x.c (cursor_font_instantiate): * glyphs-x.c (x_redisplay_widget): * glyphs-x.c (Fchange_subwindow_property): * glyphs-x.c (x_widget_instantiate): * glyphs-x.c (x_tab_control_redisplay): * glyphs.c (pixmap_to_lisp_data): * gui-x.c (menu_separator_style_and_to_external): * gui-x.c (add_accel_and_to_external): * gui-x.c (button_item_to_widget_value): * hpplay.c (player_error_internal): * hpplay.c (play_sound_file): * hpplay.c (play_sound_data): * intl.c (Fset_current_locale): * lisp.h: * menubar-gtk.c (gtk_xemacs_set_accel_keys): * menubar-msw.c (populate_menu_add_item): * menubar-msw.c (populate_or_checksum_helper): * menubar-x.c (menu_item_descriptor_to_widget_value_1): * nt.c (init_user_info): * nt.c (get_long_basename): * nt.c (nt_get_resource): * nt.c (init_mswindows_environment): * nt.c (get_cached_volume_information): * nt.c (mswindows_readdir): * nt.c (read_unc_volume): * nt.c (mswindows_stat): * nt.c (mswindows_getdcwd): * nt.c (mswindows_executable_type): * nt.c (Fmswindows_short_file_name): * ntplay.c (nt_play_sound_file): * objects-gtk.c: * objects-gtk.c (gtk_valid_color_name_p): * objects-gtk.c (gtk_initialize_font_instance): * objects-gtk.c (gtk_font_list): * objects-msw.c (font_enum_callback_2): * objects-msw.c (parse_font_spec): * objects-x.c (x_parse_nearest_color): * objects-x.c (x_valid_color_name_p): * objects-x.c (x_initialize_font_instance): * objects-x.c (x_font_instance_truename): * objects-x.c (x_font_list): * objects-xlike-inc.c (XFUN): * objects-xlike-inc.c (xft_find_charset_font): * process-nt.c (mswindows_report_winsock_error): * process-nt.c (nt_create_process): * process-nt.c (get_internet_address): * process-nt.c (nt_open_network_stream): * process-unix.c: * process-unix.c (allocate_pty): * process-unix.c (get_internet_address): * process-unix.c (unix_canonicalize_host_name): * process-unix.c (unix_open_network_stream): * realpath.c: * select-common.h (lisp_data_to_selection_data): * select-gtk.c (symbol_to_gtk_atom): * select-gtk.c (atom_to_symbol): * select-msw.c (symbol_to_ms_cf): * select-msw.c (mswindows_register_selection_data_type): * select-x.c (symbol_to_x_atom): * select-x.c (x_atom_to_symbol): * select-x.c (hack_motif_clipboard_selection): * select-x.c (Fx_store_cutbuffer_internal): * sound.c (Fplay_sound_file): * sound.c (Fplay_sound): * sound.h (sound_perror): * sysdep.c: * sysdep.c (qxe_allocating_getcwd): * sysdep.c (qxe_execve): * sysdep.c (copy_in_passwd): * sysdep.c (qxe_getpwnam): * sysdep.c (qxe_ctime): * sysdll.c (dll_open): * sysdll.c (dll_function): * sysdll.c (dll_variable): * sysdll.c (search_linked_libs): * sysdll.c (dll_error): * sysfile.h: * sysfile.h (PATHNAME_CONVERT_OUT_TSTR): * sysfile.h (PATHNAME_CONVERT_OUT_UTF_8): * sysfile.h (PATHNAME_CONVERT_OUT): * sysfile.h (LISP_PATHNAME_CONVERT_OUT): * syswindows.h (ITEXT_TO_TSTR): * syswindows.h (LOCAL_FILE_FORMAT_TO_TSTR): * syswindows.h (TSTR_TO_LOCAL_FILE_FORMAT): * syswindows.h (LOCAL_FILE_FORMAT_TO_INTERNAL_MSWIN): * syswindows.h (LISP_LOCAL_FILE_FORMAT_MAYBE_URL_TO_TSTR): * text.h: * text.h (eicpy_ext_len): * text.h (enum new_dfc_src_type): * text.h (EXTERNAL_TO_ITEXT): * text.h (GET_STRERROR): * tooltalk.c (check_status): * tooltalk.c (Fadd_tooltalk_message_arg): * tooltalk.c (Fadd_tooltalk_pattern_attribute): * tooltalk.c (Fadd_tooltalk_pattern_arg): * win32.c (tstr_to_local_file_format): * win32.c (mswindows_lisp_error_1): * win32.c (mswindows_report_process_error): * win32.c (Fmswindows_shell_execute): * win32.c (mswindows_read_link_1): Changes involving external/internal format conversion, mostly code cleanup and renaming. 1. Eliminate the previous macros like LISP_STRING_TO_EXTERNAL that stored its result in a parameter. The new version of LISP_STRING_TO_EXTERNAL returns its result through the return value, same as the previous NEW_LISP_STRING_TO_EXTERNAL. Use the new-style macros throughout the code. 2. Rename C_STRING_TO_EXTERNAL and friends to ITEXT_TO_EXTERNAL, in keeping with overall naming rationalization involving Itext and related types. Macros involved in previous two: EXTERNAL_TO_C_STRING -> EXTERNAL_TO_ITEXT EXTERNAL_TO_C_STRING_MALLOC -> EXTERNAL_TO_ITEXT_MALLOC SIZED_EXTERNAL_TO_C_STRING -> SIZED_EXTERNAL_TO_ITEXT SIZED_EXTERNAL_TO_C_STRING_MALLOC -> SIZED_EXTERNAL_TO_ITEXT_MALLOC C_STRING_TO_EXTERNAL -> ITEXT_TO_EXTERNAL C_STRING_TO_EXTERNAL_MALLOC -> ITEXT_TO_EXTERNAL_MALLOC LISP_STRING_TO_EXTERNAL LISP_STRING_TO_EXTERNAL_MALLOC LISP_STRING_TO_TSTR C_STRING_TO_TSTR -> ITEXT_TO_TSTR TSTR_TO_C_STRING -> TSTR_TO_ITEXT The following four still return their values through parameters, since they have more than one value to return: C_STRING_TO_SIZED_EXTERNAL -> ITEXT_TO_SIZED_EXTERNAL LISP_STRING_TO_SIZED_EXTERNAL C_STRING_TO_SIZED_EXTERNAL_MALLOC -> ITEXT_TO_SIZED_EXTERNAL_MALLOC LISP_STRING_TO_SIZED_EXTERNAL_MALLOC Sometimes additional casts had to be inserted, since the old macros played strange games and completely defeated the type system of the store params. 3. Rewrite many places where direct calls to TO_EXTERNAL_FORMAT occurred with calls to one of the convenience macros listed above, or to make_extstring(). 4. Eliminate SIZED_C_STRING macros (they were hardly used, anyway) and use a direct call to TO_EXTERNAL_FORMAT or TO_INTERNAL_FORMAT. 4. Use LISP_PATHNAME_CONVERT_OUT in many places instead of something like LISP_STRING_TO_EXTERNAL(..., Qfile_name). 5. Eliminate some temporary variables that are no longer necessary now that we return a value rather than storing it into a variable. 6. Some Mule-izing in database.c. 7. Error functions: -- A bit of code cleanup in maybe_signal_error_1. -- Eliminate report_file_type_error; it's just an alias for signal_error_2 with params in a different order. -- Fix some places in the hostname-handling code that directly inserted externally-retrieved error strings into the supposed ASCII "reason" param instead of doing the right thing and sticking text descriptive of what was going on in "reason" and putting the external message in a frob. 8. Use Ascbyte instead of CIbyte in process-unix.c and maybe one or two other places. 9. Some code cleanup in copy_in_passwd() in sysdep.c. 10. Fix a real bug due to accidental variable shadowing in tstr_to_local_file_format() in win32.c.
author Ben Wing <ben@xemacs.org>
date Fri, 05 Feb 2010 11:02:24 -0600
parents 59d576895891
children 308d34e9f07d
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
1 ;;; code-cmds.el --- Commands for manipulating coding systems.
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
2
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
3 ;; Copyright (C) 1995,1999 Electrotechnical Laboratory, JAPAN.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
4 ;; Licensed to the Free Software Foundation.
3416
59d576895891 [xemacs-hg @ 2006-05-23 12:56:19 by stephent]
stephent
parents: 1318
diff changeset
5 ;; Copyright (C) 2000,2006 Free Software Foundation
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
6 ;; Copyright (C) 1997 MORIOKA Tomohiko
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
7 ;; Copyright (C) 2001, 2002 Ben Wing.
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
8
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
9
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
10 ;; This file is part of XEmacs.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
11
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
12 ;; XEmacs is free software; you can redistribute it and/or modify it
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
13 ;; under the terms of the GNU General Public License as published by
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
14 ;; the Free Software Foundation; either version 2, or (at your option)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
15 ;; any later version.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
16
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
17 ;; XEmacs is distributed in the hope that it will be useful, but
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
18 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
20 ;; General Public License for more details.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
21
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
22 ;; You should have received a copy of the GNU General Public License
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
23 ;; along with XEmacs; see the file COPYING. If not, write to the Free
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
24 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
25 ;; 02111-1307, USA.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
26
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
27 ;;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
28 ;; This code defines the keybindings and utility commands for the
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
29 ;; user to manipulate coding systems.
3416
59d576895891 [xemacs-hg @ 2006-05-23 12:56:19 by stephent]
stephent
parents: 1318
diff changeset
30 ;; This code used to be in mule-cmds.el which now contains only the
59d576895891 [xemacs-hg @ 2006-05-23 12:56:19 by stephent]
stephent
parents: 1318
diff changeset
31 ;; additional bindings/commands that are available for full Mule.
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
32
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
33
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
34 ;;; Code:
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
35
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
36 ;;; Coding related key bindings and menus.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
37
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
38 (defvar coding-keymap (make-sparse-keymap "Coding+Mule")
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
39 "Keymap for coding-system-specific and (when available) Mule commands.")
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
40
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
41 ;; Keep "C-x C-m ..." for coding/mule specific commands.
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
42 (define-key ctl-x-map "\C-m" coding-keymap)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
43
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
44 (define-key coding-keymap "f" 'set-buffer-file-coding-system)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
45 (define-key coding-keymap "F" 'set-default-buffer-file-coding-system) ; XEmacs
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
46 (define-key coding-keymap "t" 'set-terminal-coding-system)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
47 (define-key coding-keymap "p" 'set-buffer-process-coding-system)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
48 (define-key coding-keymap "c" 'universal-coding-system-argument)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
49 ;;(define-key coding-keymap "c" 'list-coding-system-briefly) ; XEmacs
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
50 (when-fboundp 'describe-coding-system
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
51 (define-key coding-keymap "C" 'describe-coding-system)) ; XEmacs
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
52 (when-fboundp 'set-selection-coding-system
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
53 (define-key coding-keymap "x" 'set-selection-coding-system)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
54 (define-key coding-keymap "X" 'set-next-selection-coding-system))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
55
3416
59d576895891 [xemacs-hg @ 2006-05-23 12:56:19 by stephent]
stephent
parents: 1318
diff changeset
56 ;; XEmacs change: make code readable, and sanity-check EOL-TYPE.
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
57 (defun coding-system-change-eol-conversion (coding-system eol-type)
3416
59d576895891 [xemacs-hg @ 2006-05-23 12:56:19 by stephent]
stephent
parents: 1318
diff changeset
58 "Return a version of CODING-SYSTEM that provides EOL-TYPE eol conversion.
59d576895891 [xemacs-hg @ 2006-05-23 12:56:19 by stephent]
stephent
parents: 1318
diff changeset
59 EOL-TYPE should be `lf', `crlf', `cr' or nil. nil means the returned coding
59d576895891 [xemacs-hg @ 2006-05-23 12:56:19 by stephent]
stephent
parents: 1318
diff changeset
60 system automatically detects the end-of-line convention while decoding.
59d576895891 [xemacs-hg @ 2006-05-23 12:56:19 by stephent]
stephent
parents: 1318
diff changeset
61 EOL-TYPE may also be one of the symbols `unix', `dos' or `mac', meaning
59d576895891 [xemacs-hg @ 2006-05-23 12:56:19 by stephent]
stephent
parents: 1318
diff changeset
62 `lf', `crlf', and `cr' respectively."
59d576895891 [xemacs-hg @ 2006-05-23 12:56:19 by stephent]
stephent
parents: 1318
diff changeset
63 (setq eol-type (cond ((or (eq eol-type 'unix) (eq eol-type 'lf)) 'eol-lf)
59d576895891 [xemacs-hg @ 2006-05-23 12:56:19 by stephent]
stephent
parents: 1318
diff changeset
64 ((or (eq eol-type 'dos) (eq eol-type 'crlf)) 'eol-crlf)
59d576895891 [xemacs-hg @ 2006-05-23 12:56:19 by stephent]
stephent
parents: 1318
diff changeset
65 ((or (eq eol-type 'mac) (eq eol-type 'cr)) 'eol-cr)
59d576895891 [xemacs-hg @ 2006-05-23 12:56:19 by stephent]
stephent
parents: 1318
diff changeset
66 ((null eol-type) nil)
59d576895891 [xemacs-hg @ 2006-05-23 12:56:19 by stephent]
stephent
parents: 1318
diff changeset
67 (t (error 'invalid-constant eol-type))))
1318
b531bf8658e9 [xemacs-hg @ 2003-02-21 06:56:46 by ben]
ben
parents: 771
diff changeset
68 (coding-system-name
3416
59d576895891 [xemacs-hg @ 2006-05-23 12:56:19 by stephent]
stephent
parents: 1318
diff changeset
69 (let ((orig-eol-type (cdr (assq (coding-system-eol-type coding-system)
59d576895891 [xemacs-hg @ 2006-05-23 12:56:19 by stephent]
stephent
parents: 1318
diff changeset
70 '((lf . eol-lf)
59d576895891 [xemacs-hg @ 2006-05-23 12:56:19 by stephent]
stephent
parents: 1318
diff changeset
71 (cr . eol-cr)
59d576895891 [xemacs-hg @ 2006-05-23 12:56:19 by stephent]
stephent
parents: 1318
diff changeset
72 (crlf . eol-crlf)
59d576895891 [xemacs-hg @ 2006-05-23 12:56:19 by stephent]
stephent
parents: 1318
diff changeset
73 ;; #### also returns nil if not a key
59d576895891 [xemacs-hg @ 2006-05-23 12:56:19 by stephent]
stephent
parents: 1318
diff changeset
74 (nil . nil)))))
59d576895891 [xemacs-hg @ 2006-05-23 12:56:19 by stephent]
stephent
parents: 1318
diff changeset
75 (base (coding-system-base coding-system)))
59d576895891 [xemacs-hg @ 2006-05-23 12:56:19 by stephent]
stephent
parents: 1318
diff changeset
76 (cond ((eq eol-type orig-eol-type) coding-system)
59d576895891 [xemacs-hg @ 2006-05-23 12:56:19 by stephent]
stephent
parents: 1318
diff changeset
77 ((null orig-eol-type)
59d576895891 [xemacs-hg @ 2006-05-23 12:56:19 by stephent]
stephent
parents: 1318
diff changeset
78 (coding-system-property coding-system eol-type))
59d576895891 [xemacs-hg @ 2006-05-23 12:56:19 by stephent]
stephent
parents: 1318
diff changeset
79 ((null eol-type) base)
59d576895891 [xemacs-hg @ 2006-05-23 12:56:19 by stephent]
stephent
parents: 1318
diff changeset
80 ((null (coding-system-eol-type base))
59d576895891 [xemacs-hg @ 2006-05-23 12:56:19 by stephent]
stephent
parents: 1318
diff changeset
81 (coding-system-property base eol-type))
59d576895891 [xemacs-hg @ 2006-05-23 12:56:19 by stephent]
stephent
parents: 1318
diff changeset
82 (t (warn "couldn't change EOL conversion of %s from %s to %s."
59d576895891 [xemacs-hg @ 2006-05-23 12:56:19 by stephent]
stephent
parents: 1318
diff changeset
83 coding-system orig-eol-type eol-type)
59d576895891 [xemacs-hg @ 2006-05-23 12:56:19 by stephent]
stephent
parents: 1318
diff changeset
84 ;; return nil for compatibility with old code
59d576895891 [xemacs-hg @ 2006-05-23 12:56:19 by stephent]
stephent
parents: 1318
diff changeset
85 nil)))))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
86
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
87 ;; (defun coding-system-change-text-conversion (coding-system coding)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
88 ;; "Return a coding system which differs from CODING-SYSTEM in text conversion.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
89 ;; The returned coding system converts text by CODING
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
90 ;; but end-of-line as the same way as CODING-SYSTEM.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
91 ;; If CODING is nil, the returned coding system detects
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
92 ;; how text is formatted automatically while decoding."
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
93 ;; (if (not coding)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
94 ;; (coding-system-base coding-system)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
95 ;; (let ((eol-type (coding-system-eol-type coding-system)))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
96 ;; (coding-system-change-eol-conversion
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
97 ;; coding
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
98 ;; (if (numberp eol-type) (aref [unix dos mac] eol-type))))))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
99
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
100 (defun universal-coding-system-argument ()
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
101 "Execute an I/O command using the specified coding system."
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
102 (interactive)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
103 (let* ((default (and buffer-file-coding-system
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
104 (not (eq (coding-system-type buffer-file-coding-system)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
105 t))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
106 (coding-system-name buffer-file-coding-system)))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
107 (coding-system
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
108 (read-coding-system
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
109 (if default
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
110 (format "Coding system for following command (default, %s): "
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
111 default)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
112 "Coding system for following command: ")
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
113 default))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
114 (keyseq (read-key-sequence
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
115 (format "Command to execute with %s:" coding-system)))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
116 (cmd (key-binding keyseq)))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
117 (let ((coding-system-for-read coding-system)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
118 (coding-system-for-write coding-system))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
119 (message "")
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
120 (call-interactively cmd))))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
121
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
122 (defun set-default-output-coding-systems (coding-system)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
123 "Set default value for coding system output to CODING-SYSTEM.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
124 This sets the coding system of newly created buffers (the default value of
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
125 `buffer-file-coding-system') and the default coding system for output to a
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
126 subprocess (the CDR of `default-process-coding-system').
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
127
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
128 Other defaults are not changed; see `prefer-coding-system' for why."
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
129 (check-coding-system coding-system)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
130 (set-default-buffer-file-coding-system coding-system)
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
131 (setq default-process-coding-system
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
132 (cons (car default-process-coding-system) coding-system)))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
133
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
134 (defun prefer-coding-system (coding-system)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
135 "Add CODING-SYSTEM at the front of the priority list for automatic detection.
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
136 This also sets the coding system of newly created buffers (the default
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
137 value of `buffer-file-coding-system') and the default coding system for
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
138 output to a subprocess (the CDR of `default-process-coding-system').
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
139
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
140 If CODING-SYSTEM specifies a certain type of EOL conversion, the coding
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
141 systems set by this function will use that type of EOL conversion.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
142
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
143 This does not change the default coding system for converting file names
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
144 because that is dependent on the current locale; it's changed when
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
145 `set-language-environment' is called. It does not change
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
146 `terminal-coding-system' or `keyboard-coding-system'; they should get set
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
147 when the terminal is opened (and are typically an inherent property of the
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
148 terminal), and don't change afterward. It does not change the default
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
149 coding system for reading files or input from a subprocess; they should
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
150 remain as `undecided' so that automatic detection is done."
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
151 (interactive "zPrefer coding system: ")
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
152 (if (not (and coding-system (find-coding-system coding-system)))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
153 (error "Invalid coding system `%s'" coding-system))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
154 (let ((coding-category (coding-system-category coding-system))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
155 (base (coding-system-base coding-system))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
156 (eol-type (coding-system-eol-type coding-system)))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
157 (if (not coding-category)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
158 ;; CODING-SYSTEM is no-conversion or undecided.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
159 (error "Can't prefer the coding system `%s'" coding-system))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
160 (set-coding-category-system coding-category (or base coding-system))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
161 ;; (update-coding-systems-internal)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
162 (or (eq coding-category (car (coding-category-list)))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
163 ;; We must change the order.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
164 (set-coding-priority-list (list coding-category)))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
165 (if (and base (interactive-p))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
166 (message "Highest priority is set to %s (base of %s)"
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
167 base coding-system))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
168 ;; If they asked for specific EOL conversion, honor that.
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
169 (if (memq eol-type '(lf crlf cr unix dos mac))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
170 (setq coding-system
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
171 (coding-system-change-eol-conversion base eol-type))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
172 (setq coding-system base))
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
173 (set-default-output-coding-systems coding-system)))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
174
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
175 ;; (defun find-coding-systems-region-subset-p (list1 list2)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
176 ;; "Return non-nil if all elements in LIST1 are included in LIST2.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
177 ;; Comparison done with EQ."
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
178 ;; (catch 'tag
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
179 ;; (while list1
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
180 ;; (or (memq (car list1) list2)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
181 ;; (throw 'tag nil))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
182 ;; (setq list1 (cdr list1)))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
183 ;; t))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
184
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
185 ;; (defun find-coding-systems-region (from to)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
186 ;; "Return a list of proper coding systems to encode a text between FROM and TO.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
187 ;; All coding systems in the list can safely encode any multibyte characters
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
188 ;; in the text.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
189 ;;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
190 ;; If the text contains no multibyte characters, return a list of a single
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
191 ;; element `undecided'."
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
192 ;; (find-coding-systems-for-charsets (find-charset-region from to)))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
193
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
194 ;; (defun find-coding-systems-string (string)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
195 ;; "Return a list of proper coding systems to encode STRING.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
196 ;; All coding systems in the list can safely encode any multibyte characters
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
197 ;; in STRING.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
198 ;;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
199 ;; If STRING contains no multibyte characters, return a list of a single
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
200 ;; element `undecided'."
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
201 ;; (find-coding-systems-for-charsets (find-charset-string string)))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
202
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
203 ;; (defun find-coding-systems-for-charsets (charsets)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
204 ;; "Return a list of proper coding systems to encode characters of CHARSETS.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
205 ;; CHARSETS is a list of character sets."
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
206 ;; (if (or (null charsets)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
207 ;; (and (= (length charsets) 1)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
208 ;; (eq 'ascii (car charsets))))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
209 ;; '(undecided)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
210 ;; (setq charsets (delq 'composition charsets))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
211 ;; (let ((l (coding-system-list 'base-only))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
212 ;; (charset-preferred-codings
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
213 ;; (mapcar (function
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
214 ;; (lambda (x)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
215 ;; (if (eq x 'unknown)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
216 ;; 'raw-text
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
217 ;; (get-charset-property x 'preferred-coding-system))))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
218 ;; charsets))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
219 ;; (priorities (mapcar (function (lambda (x) (symbol-value x)))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
220 ;; coding-category-list))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
221 ;; codings coding safe)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
222 ;; (if (memq 'unknown charsets)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
223 ;; ;; The region contains invalid multibyte characters.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
224 ;; (setq l '(raw-text)))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
225 ;; (while l
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
226 ;; (setq coding (car l) l (cdr l))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
227 ;; (if (and (setq safe (coding-system-get coding 'safe-charsets))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
228 ;; (or (eq safe t)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
229 ;; (find-coding-systems-region-subset-p charsets safe)))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
230 ;; ;; We put the higher priority to coding systems included
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
231 ;; ;; in CHARSET-PREFERRED-CODINGS, and within them, put the
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
232 ;; ;; higher priority to coding systems which support smaller
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
233 ;; ;; number of charsets.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
234 ;; (let ((priority
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
235 ;; (+ (if (coding-system-get coding 'mime-charset) 4096 0)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
236 ;; (lsh (length (memq coding priorities)) 7)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
237 ;; (if (memq coding charset-preferred-codings) 64 0)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
238 ;; (if (> (coding-system-type coding) 0) 32 0)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
239 ;; (if (consp safe) (- 32 (length safe)) 0))))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
240 ;; (setq codings (cons (cons priority coding) codings)))))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
241 ;; (mapcar 'cdr
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
242 ;; (sort codings (function (lambda (x y) (> (car x) (car y))))))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
243 ;; )))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
244
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
245 ;; (defun find-multibyte-characters (from to &optional maxcount excludes)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
246 ;; "Find multibyte characters in the region specified by FROM and TO.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
247 ;; If FROM is a string, find multibyte characters in the string.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
248 ;; The return value is an alist of the following format:
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
249 ;; ((CHARSET COUNT CHAR ...) ...)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
250 ;; where
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
251 ;; CHARSET is a character set,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
252 ;; COUNT is a number of characters,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
253 ;; CHARs are found characters of the character set.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
254 ;; Optional 3rd arg MAXCOUNT limits how many CHARs are put in the above list.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
255 ;; Optional 4th arg EXCLUDE is a list of character sets to be ignored.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
256 ;;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
257 ;; For invalid characters, CHARs are actually strings."
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
258 ;; (let ((chars nil)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
259 ;; charset char)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
260 ;; (if (stringp from)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
261 ;; (let ((idx 0))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
262 ;; (while (setq idx (string-match "[^\000-\177]" from idx))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
263 ;; (setq char (aref from idx)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
264 ;; charset (char-charset char))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
265 ;; (if (eq charset 'unknown)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
266 ;; (setq char (match-string 0)))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
267 ;; (if (or (eq charset 'unknown)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
268 ;; (not (or (eq excludes t) (memq charset excludes))))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
269 ;; (let ((slot (assq charset chars)))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
270 ;; (if slot
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
271 ;; (if (not (memq char (nthcdr 2 slot)))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
272 ;; (let ((count (nth 1 slot)))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
273 ;; (setcar (cdr slot) (1+ count))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
274 ;; (if (or (not maxcount) (< count maxcount))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
275 ;; (nconc slot (list char)))))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
276 ;; (setq chars (cons (list charset 1 char) chars)))))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
277 ;; (setq idx (1+ idx))))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
278 ;; (save-excursion
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
279 ;; (goto-char from)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
280 ;; (while (re-search-forward "[^\000-\177]" to t)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
281 ;; (setq char (preceding-char)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
282 ;; charset (char-charset char))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
283 ;; (if (eq charset 'unknown)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
284 ;; (setq char (match-string 0)))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
285 ;; (if (or (eq charset 'unknown)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
286 ;; (not (or (eq excludes t) (memq charset excludes))))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
287 ;; (let ((slot (assq charset chars)))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
288 ;; (if slot
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
289 ;; (if (not (member char (nthcdr 2 slot)))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
290 ;; (let ((count (nth 1 slot)))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
291 ;; (setcar (cdr slot) (1+ count))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
292 ;; (if (or (not maxcount) (< count maxcount))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
293 ;; (nconc slot (list char)))))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
294 ;; (setq chars (cons (list charset 1 char) chars))))))))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
295 ;; (nreverse chars)))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
296
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
297 ;; (defvar last-coding-system-specified nil
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
298 ;; "Most recent coding system explicitly specified by the user when asked.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
299 ;; This variable is set whenever Emacs asks the user which coding system
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
300 ;; to use in order to write a file. If you set it to nil explicitly,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
301 ;; then call `write-region', then afterward this variable will be non-nil
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
302 ;; only if the user was explicitly asked and specified a coding system.")
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
303
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
304 ;; (defun select-safe-coding-system (from to &optional default-coding-system)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
305 ;; "Ask a user to select a safe coding system from candidates.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
306 ;; The candidates of coding systems which can safely encode a text
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
307 ;; between FROM and TO are shown in a popup window.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
308 ;;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
309 ;; Optional arg DEFAULT-CODING-SYSTEM specifies a coding system to be
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
310 ;; checked at first. If omitted, buffer-file-coding-system of the
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
311 ;; current buffer is used.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
312 ;;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
313 ;; If the text can be encoded safely by DEFAULT-CODING-SYSTEM, it is
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
314 ;; returned without any user interaction.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
315 ;;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
316 ;; Kludgy feature: if FROM is a string, the string is the target text,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
317 ;; and TO is ignored."
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
318 ;; (or default-coding-system
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
319 ;; (setq default-coding-system buffer-file-coding-system))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
320 ;; (let* ((charsets (if (stringp from) (find-charset-string from)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
321 ;; (find-charset-region from to)))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
322 ;; (safe-coding-systems (find-coding-systems-for-charsets charsets)))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
323 ;; (if (or (not enable-multibyte-characters)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
324 ;; (eq (car safe-coding-systems) 'undecided)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
325 ;; (eq default-coding-system 'no-conversion)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
326 ;; (and default-coding-system
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
327 ;; (memq (coding-system-base default-coding-system)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
328 ;; safe-coding-systems)))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
329 ;; default-coding-system
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
330 ;;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
331 ;; ;; At first, change each coding system to the corresponding
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
332 ;; ;; mime-charset name if it is also a coding system.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
333 ;; (let ((l safe-coding-systems)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
334 ;; mime-charset)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
335 ;; (while l
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
336 ;; (setq mime-charset (coding-system-get (car l) 'mime-charset))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
337 ;; (if (and mime-charset (coding-system-p mime-charset))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
338 ;; (setcar l mime-charset))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
339 ;; (setq l (cdr l))))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
340 ;;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
341 ;; (let ((non-safe-chars (find-multibyte-characters
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
342 ;; from to 3
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
343 ;; (and default-coding-system
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
344 ;; (coding-system-get default-coding-system
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
345 ;; 'safe-charsets))))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
346 ;; show-position overlays)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
347 ;; (save-excursion
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
348 ;; ;; Highlight characters that default-coding-system can't encode.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
349 ;; (when (integerp from)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
350 ;; (goto-char from)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
351 ;; (let ((found nil))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
352 ;; (while (and (not found)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
353 ;; (re-search-forward "[^\000-\177]" to t))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
354 ;; (setq found (assq (char-charset (preceding-char))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
355 ;; non-safe-chars))))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
356 ;; (forward-line -1)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
357 ;; (setq show-position (point))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
358 ;; (save-excursion
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
359 ;; (while (and (< (length overlays) 256)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
360 ;; (re-search-forward "[^\000-\177]" to t))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
361 ;; (let* ((char (preceding-char))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
362 ;; (charset (char-charset char)))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
363 ;; (when (assq charset non-safe-chars)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
364 ;; (setq overlays (cons (make-overlay (1- (point)) (point))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
365 ;; overlays))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
366 ;; (overlay-put (car overlays) 'face 'highlight))))))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
367 ;;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
368 ;; ;; At last, ask a user to select a proper coding system.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
369 ;; (unwind-protect
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
370 ;; (save-window-excursion
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
371 ;; (when show-position
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
372 ;; ;; At first, be sure to show the current buffer.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
373 ;; (set-window-buffer (selected-window) (current-buffer))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
374 ;; (set-window-start (selected-window) show-position))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
375 ;; ;; Then, show a helpful message.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
376 ;; (with-output-to-temp-buffer "*Warning*"
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
377 ;; (save-excursion
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
378 ;; (set-buffer standard-output)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
379 ;; (insert "The target text contains the following non ASCII character(s):\n")
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
380 ;; (let ((len (length non-safe-chars))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
381 ;; (shown 0))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
382 ;; (while (and non-safe-chars (< shown 3))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
383 ;; (when (> (length (car non-safe-chars)) 2)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
384 ;; (setq shown (1+ shown))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
385 ;; (insert (format "%25s: " (car (car non-safe-chars))))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
386 ;; (let ((l (nthcdr 2 (car non-safe-chars))))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
387 ;; (while l
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
388 ;; (if (or (stringp (car l)) (char-valid-p (car l)))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
389 ;; (insert (car l)))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
390 ;; (setq l (cdr l))))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
391 ;; (if (> (nth 1 (car non-safe-chars)) 3)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
392 ;; (insert "..."))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
393 ;; (insert "\n"))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
394 ;; (setq non-safe-chars (cdr non-safe-chars)))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
395 ;; (if (< shown len)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
396 ;; (insert (format "%27s\n" "..."))))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
397 ;; (insert (format "\
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
398 ;; These can't be encoded safely by the coding system %s.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
399 ;;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
400 ;; Please select one from the following safe coding systems:\n"
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
401 ;; default-coding-system))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
402 ;; (let ((pos (point))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
403 ;; (fill-prefix " "))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
404 ;; (mapcar (function (lambda (x) (princ " ") (princ x)))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
405 ;; safe-coding-systems)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
406 ;; (fill-region-as-paragraph pos (point)))))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
407 ;;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
408 ;; ;; Read a coding system.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
409 ;; (let* ((safe-names (mapcar (lambda (x) (list (symbol-name x)))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
410 ;; safe-coding-systems))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
411 ;; (name (completing-read
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
412 ;; (format "Select coding system (default %s): "
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
413 ;; (car safe-coding-systems))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
414 ;; safe-names nil t nil nil
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
415 ;; (car (car safe-names)))))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
416 ;; (setq last-coding-system-specified (intern name))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
417 ;; (if (integerp (coding-system-eol-type default-coding-system))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
418 ;; (setq last-coding-system-specified
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
419 ;; (coding-system-change-eol-conversion
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
420 ;; last-coding-system-specified
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
421 ;; (coding-system-eol-type default-coding-system))))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
422 ;; last-coding-system-specified))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
423 ;; (kill-buffer "*Warning*")
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
424 ;; (while overlays
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
425 ;; (delete-overlay (car overlays))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
426 ;; (setq overlays (cdr overlays)))))))))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
427
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
428 ;; (setq select-safe-coding-system-function 'select-safe-coding-system)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
429
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
430 ;; (defun select-message-coding-system ()
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
431 ;; "Return a coding system to encode the outgoing message of the current buffer.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
432 ;; It at first tries the first coding system found in these variables
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
433 ;; in this order:
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
434 ;; (1) local value of `buffer-file-coding-system'
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
435 ;; (2) value of `sendmail-coding-system'
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
436 ;; (3) value of `default-buffer-file-coding-system'
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
437 ;; (4) value of `default-sendmail-coding-system'
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
438 ;; If the found coding system can't encode the current buffer,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
439 ;; or none of them are bound to a coding system,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
440 ;; it asks the user to select a proper coding system."
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
441 ;; (let ((coding (or (and (local-variable-p 'buffer-file-coding-system)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
442 ;; buffer-file-coding-system)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
443 ;; sendmail-coding-system
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
444 ;; default-buffer-file-coding-system
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
445 ;; default-sendmail-coding-system)))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
446 ;; (if (eq coding 'no-conversion)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
447 ;; ;; We should never use no-conversion for outgoing mails.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
448 ;; (setq coding nil))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
449 ;; (if (fboundp select-safe-coding-system-function)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
450 ;; (funcall select-safe-coding-system-function
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
451 ;; (point-min) (point-max) coding)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 444
diff changeset
452 ;; coding)))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
453
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
454 (provide 'code-cmds)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
455
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents:
diff changeset
456 ;;; code-cmds.el ends here