Mercurial > hg > xemacs-beta
annotate lisp/coding.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 | 257b468bf2ca |
| children | c673987f5f3d |
| rev | line source |
|---|---|
| 428 | 1 ;;; coding.el --- Coding-system functions for XEmacs. |
| 2 | |
| 3 ;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN. | |
| 4 ;; Licensed to the Free Software Foundation. | |
| 5 ;; Copyright (C) 1995 Amdahl Corporation. | |
| 6 ;; Copyright (C) 1995 Sun Microsystems. | |
| 7 ;; Copyright (C) 1997 MORIOKA Tomohiko | |
| 771 | 8 ;; Copyright (C) 2000, 2001, 2002 Ben Wing. |
| 428 | 9 |
| 10 ;; This file is part of XEmacs. | |
| 11 | |
| 12 ;; XEmacs is free software; you can redistribute it and/or modify it | |
| 13 ;; under the terms of the GNU General Public License as published by | |
| 14 ;; the Free Software Foundation; either version 2, or (at your option) | |
| 15 ;; any later version. | |
| 16 | |
| 17 ;; XEmacs is distributed in the hope that it will be useful, but | |
| 18 ;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
| 19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
| 20 ;; General Public License for more details. | |
| 21 | |
| 22 ;; You should have received a copy of the GNU General Public License | |
| 440 | 23 ;; along with XEmacs; see the file COPYING. If not, write to the |
| 428 | 24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, |
| 25 ;; Boston, MA 02111-1307, USA. | |
| 26 | |
| 27 ;;; Commentary: | |
| 28 | |
| 29 ;;; split off of mule.el. | |
| 30 | |
| 31 ;;; Code: | |
| 32 | |
| 502 | 33 (globally-declare-fboundp |
| 34 '(coding-system-lock-shift | |
| 35 coding-system-seven coding-system-charset charset-dimension)) | |
| 36 | |
| 428 | 37 (defalias 'check-coding-system 'get-coding-system) |
| 38 | |
| 39 (defun modify-coding-system-alist (target-type regexp coding-system) | |
| 40 "Modify one of look up tables for finding a coding system on I/O operation. | |
| 41 There are three of such tables, `file-coding-system-alist', | |
| 42 `process-coding-system-alist', and `network-coding-system-alist'. | |
| 43 | |
| 44 TARGET-TYPE specifies which of them to modify. | |
| 45 If it is `file', it affects `file-coding-system-alist' (which see). | |
| 46 If it is `process', it affects `process-coding-system-alist' (which see). | |
| 599 | 47 If it is `network', it affects `network-coding-system-alist' (which see). |
| 428 | 48 |
| 49 REGEXP is a regular expression matching a target of I/O operation. | |
| 50 The target is a file name if TARGET-TYPE is `file', a program name if | |
| 51 TARGET-TYPE is `process', or a network service name or a port number | |
| 52 to connect to if TARGET-TYPE is `network'. | |
| 53 | |
| 54 CODING-SYSTEM is a coding system to perform code conversion on the I/O | |
| 55 operation, or a cons cell (DECODING . ENCODING) specifying the coding systems | |
| 56 for decoding and encoding respectively, | |
| 57 or a function symbol which, when called, returns such a cons cell." | |
| 58 (or (memq target-type '(file process network)) | |
| 59 (error "Invalid target type: %s" target-type)) | |
| 60 (or (stringp regexp) | |
| 61 (and (eq target-type 'network) (integerp regexp)) | |
| 62 (error "Invalid regular expression: %s" regexp)) | |
| 63 (if (symbolp coding-system) | |
| 64 (if (not (fboundp coding-system)) | |
| 65 (progn | |
| 66 (check-coding-system coding-system) | |
| 67 (setq coding-system (cons coding-system coding-system)))) | |
| 68 (check-coding-system (car coding-system)) | |
| 69 (check-coding-system (cdr coding-system))) | |
| 70 (cond ((eq target-type 'file) | |
| 71 (let ((slot (assoc regexp file-coding-system-alist))) | |
| 72 (if slot | |
| 73 (setcdr slot coding-system) | |
| 74 (setq file-coding-system-alist | |
| 75 (cons (cons regexp coding-system) | |
| 76 file-coding-system-alist))))) | |
| 77 ((eq target-type 'process) | |
| 78 (let ((slot (assoc regexp process-coding-system-alist))) | |
| 79 (if slot | |
| 80 (setcdr slot coding-system) | |
| 81 (setq process-coding-system-alist | |
| 82 (cons (cons regexp coding-system) | |
| 83 process-coding-system-alist))))) | |
| 84 (t | |
| 85 (let ((slot (assoc regexp network-coding-system-alist))) | |
| 86 (if slot | |
| 87 (setcdr slot coding-system) | |
| 88 (setq network-coding-system-alist | |
| 89 (cons (cons regexp coding-system) | |
| 90 network-coding-system-alist))))))) | |
| 91 | |
| 92 (defsubst keyboard-coding-system () | |
| 93 "Return coding-system of what is sent from terminal keyboard." | |
| 94 keyboard-coding-system) | |
| 95 | |
| 96 (defun set-keyboard-coding-system (coding-system) | |
| 97 "Set the coding system used for TTY keyboard input. Currently broken." | |
| 98 (interactive "zkeyboard-coding-system: ") | |
| 99 (get-coding-system coding-system) ; correctness check | |
| 100 (setq keyboard-coding-system coding-system) | |
| 442 | 101 (if (eq (device-type) 'tty) |
| 502 | 102 (declare-fboundp (set-console-tty-input-coding-system |
| 103 (device-console) keyboard-coding-system))) | |
| 428 | 104 (redraw-modeline t)) |
| 105 | |
| 106 (defsubst terminal-coding-system () | |
| 107 "Return coding-system of your terminal." | |
| 108 terminal-coding-system) | |
| 109 | |
| 110 (defun set-terminal-coding-system (coding-system) | |
|
4477
e34711681f30
Don't determine whether to call general device-type code at startup,
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
111 "Set the coding system used for TTY display output." |
| 428 | 112 (interactive "zterminal-coding-system: ") |
| 113 (get-coding-system coding-system) ; correctness check | |
| 114 (setq terminal-coding-system coding-system) | |
| 115 ; #### should this affect all current tty consoles ? | |
| 116 (if (eq (device-type) 'tty) | |
| 502 | 117 (declare-fboundp (set-console-tty-output-coding-system |
| 118 (device-console) terminal-coding-system))) | |
| 428 | 119 (redraw-modeline t)) |
| 120 | |
| 121 (defun what-coding-system (start end &optional arg) | |
| 122 "Show the encoding of text in the region. | |
| 123 This function is meant to be called interactively; | |
| 124 from a Lisp program, use `detect-coding-region' instead." | |
| 125 (interactive "r\nP") | |
| 126 (princ (detect-coding-region start end))) | |
| 127 | |
|
4549
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
128 (defun decode-coding-string (str coding-system &optional nocopy) |
| 428 | 129 "Decode the string STR which is encoded in CODING-SYSTEM. |
|
4549
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
130 Normally does not modify STR. Returns the decoded string on |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
131 successful conversion. |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
132 Optional argument NOCOPY says that modifying STR and returning it is |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
133 allowed." |
| 428 | 134 (with-string-as-buffer-contents |
| 135 str (decode-coding-region (point-min) (point-max) coding-system))) | |
| 136 | |
|
4549
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
137 (defun encode-coding-string (str coding-system &optional nocopy) |
| 428 | 138 "Encode the string STR using CODING-SYSTEM. |
|
4549
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
139 Does not modify STR. Returns the encoded string on successful conversion. |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
140 Optional argument NOCOPY says that the original string may be returned |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
141 if does not differ from the encoded string. " |
| 428 | 142 (with-string-as-buffer-contents |
| 143 str (encode-coding-region (point-min) (point-max) coding-system))) | |
| 144 | |
| 145 | |
| 146 ;;;; Coding system accessors | |
| 147 | |
| 148 (defun coding-system-mnemonic (coding-system) | |
| 149 "Return the 'mnemonic property of CODING-SYSTEM." | |
| 150 (coding-system-property coding-system 'mnemonic)) | |
| 151 | |
| 771 | 152 (defun coding-system-documentation (coding-system) |
| 153 "Return the 'documentation property of CODING-SYSTEM." | |
| 154 (coding-system-property coding-system 'documentation)) | |
| 155 | |
| 156 (define-obsolete-function-alias 'coding-system-doc-string | |
| 157 'coding-system-description) | |
| 428 | 158 |
| 159 (defun coding-system-eol-type (coding-system) | |
| 160 "Return the 'eol-type property of CODING-SYSTEM." | |
| 161 (coding-system-property coding-system 'eol-type)) | |
| 162 | |
| 163 (defun coding-system-eol-lf (coding-system) | |
| 164 "Return the 'eol-lf property of CODING-SYSTEM." | |
| 165 (coding-system-property coding-system 'eol-lf)) | |
| 166 | |
| 167 (defun coding-system-eol-crlf (coding-system) | |
| 168 "Return the 'eol-crlf property of CODING-SYSTEM." | |
| 169 (coding-system-property coding-system 'eol-crlf)) | |
| 170 | |
| 171 (defun coding-system-eol-cr (coding-system) | |
| 172 "Return the 'eol-cr property of CODING-SYSTEM." | |
| 173 (coding-system-property coding-system 'eol-cr)) | |
| 174 | |
| 175 (defun coding-system-post-read-conversion (coding-system) | |
| 176 "Return the 'post-read-conversion property of CODING-SYSTEM." | |
| 177 (coding-system-property coding-system 'post-read-conversion)) | |
| 178 | |
| 179 (defun coding-system-pre-write-conversion (coding-system) | |
| 180 "Return the 'pre-write-conversion property of CODING-SYSTEM." | |
| 181 (coding-system-property coding-system 'pre-write-conversion)) | |
| 182 | |
| 502 | 183 ;;; #### bleagh!!!!!!! |
| 184 | |
| 185 (defun coding-system-get (coding-system prop) | |
| 186 "Extract a value from CODING-SYSTEM's property list for property PROP." | |
| 187 (or (plist-get | |
| 188 (get (coding-system-name coding-system) 'coding-system-property) | |
| 189 prop) | |
| 190 (condition-case nil | |
| 191 (coding-system-property coding-system prop) | |
| 192 (error nil)))) | |
| 193 | |
| 194 (defun coding-system-put (coding-system prop value) | |
| 195 "Change value in CODING-SYSTEM's property list PROP to VALUE." | |
| 196 (put (coding-system-name coding-system) | |
| 197 'coding-system-property | |
| 198 (plist-put (get (coding-system-name coding-system) | |
| 199 'coding-system-property) | |
| 200 prop value))) | |
| 201 | |
| 202 (defun coding-system-category (coding-system) | |
| 203 "Return the coding category of CODING-SYSTEM." | |
| 204 (or (coding-system-get coding-system 'category) | |
| 771 | 205 (case (coding-system-type coding-system) |
| 206 (no-conversion 'no-conversion) | |
| 207 (shift-jis 'shift-jis) | |
| 3767 | 208 (unicode (case (coding-system-property coding-system 'unicode-type) |
| 985 | 209 (utf-8 (let ((bom (coding-system-property coding-system |
| 210 'need-bom))) | |
| 211 (cond (bom 'utf-8-bom) | |
| 212 ((not bom) 'utf-8)))) | |
| 771 | 213 (ucs-4 'ucs-4) |
| 214 (utf-16 (let ((bom (coding-system-property coding-system | |
| 215 'need-bom)) | |
| 216 (le (coding-system-property coding-system | |
| 217 'little-endian))) | |
| 218 (cond ((and bom le) 'utf-16-little-endian-bom) | |
| 219 ((and bom (not le) 'utf-16-bom)) | |
| 220 ((and (not bom) le) 'utf-16-little-endian) | |
| 221 ((and (not bom) (not le) 'utf-16))))))) | |
| 222 (big5 'big5) | |
| 223 (iso2022 (cond ((coding-system-lock-shift coding-system) | |
| 224 'iso-lock-shift) | |
| 225 ((coding-system-seven coding-system) | |
| 226 'iso-7) | |
| 227 (t | |
| 228 (let ((dim 0) | |
| 229 ccs | |
| 230 (i 0)) | |
| 231 (while (< i 4) | |
| 232 (setq ccs (declare-fboundp | |
| 233 (coding-system-iso2022-charset | |
| 234 coding-system i))) | |
| 235 (if (and ccs | |
| 236 (> (charset-dimension ccs) dim)) | |
| 237 (setq dim (charset-dimension ccs)) | |
| 238 ) | |
| 239 (setq i (1+ i))) | |
| 240 (cond ((= dim 1) 'iso-8-1) | |
| 241 ((= dim 2) 'iso-8-2) | |
| 242 (t 'iso-8-designate)))))) | |
| 243 ))) | |
| 502 | 244 |
| 428 | 245 |
|
4597
7191a7b120f1
Some cosmetic namespace cleanup, glyphs.el, coding.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4570
diff
changeset
|
246 ;;; Make certain variables equivalent to coding-system aliases: |
|
7191a7b120f1
Some cosmetic namespace cleanup, glyphs.el, coding.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4570
diff
changeset
|
247 (macrolet |
|
7191a7b120f1
Some cosmetic namespace cleanup, glyphs.el, coding.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4570
diff
changeset
|
248 ((force-coding-system-equivalency (&rest details-list) |
|
4599
0347879667ed
Document the force-coding-system-equivalency macro in coding.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4598
diff
changeset
|
249 "Certain coding-system aliases should correspond to certain variables. |
|
0347879667ed
Document the force-coding-system-equivalency macro in coding.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4598
diff
changeset
|
250 |
|
0347879667ed
Document the force-coding-system-equivalency macro in coding.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4598
diff
changeset
|
251 This macro implements that correspondence. This gives us compatiblity with |
|
0347879667ed
Document the force-coding-system-equivalency macro in coding.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4598
diff
changeset
|
252 other Mule implementations (which don't use the coding system aliases), and |
|
0347879667ed
Document the force-coding-system-equivalency macro in coding.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4598
diff
changeset
|
253 a certain amount of freedom of implementation for XEmacs; using a variable's |
|
0347879667ed
Document the force-coding-system-equivalency macro in coding.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4598
diff
changeset
|
254 value in C for every file operation or write to a terminal in C is probably |
|
0347879667ed
Document the force-coding-system-equivalency macro in coding.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4598
diff
changeset
|
255 an improvement on the hash-table lookup(s) necessary for a coding system |
|
0347879667ed
Document the force-coding-system-equivalency macro in coding.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4598
diff
changeset
|
256 alias, though we haven't profiled this yet to see if it makes a difference." |
|
4597
7191a7b120f1
Some cosmetic namespace cleanup, glyphs.el, coding.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4570
diff
changeset
|
257 (loop for (alias variable-symbol) |
|
7191a7b120f1
Some cosmetic namespace cleanup, glyphs.el, coding.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4570
diff
changeset
|
258 in details-list |
|
7191a7b120f1
Some cosmetic namespace cleanup, glyphs.el, coding.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4570
diff
changeset
|
259 with result = (list 'progn) |
|
7191a7b120f1
Some cosmetic namespace cleanup, glyphs.el, coding.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4570
diff
changeset
|
260 do |
|
7191a7b120f1
Some cosmetic namespace cleanup, glyphs.el, coding.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4570
diff
changeset
|
261 (push |
|
7191a7b120f1
Some cosmetic namespace cleanup, glyphs.el, coding.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4570
diff
changeset
|
262 `(dontusethis-set-symbol-value-handler ',variable-symbol |
|
7191a7b120f1
Some cosmetic namespace cleanup, glyphs.el, coding.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4570
diff
changeset
|
263 'set-value #'(lambda (sym args fun harg handlers) |
|
7191a7b120f1
Some cosmetic namespace cleanup, glyphs.el, coding.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4570
diff
changeset
|
264 (define-coding-system-alias ',alias |
|
7191a7b120f1
Some cosmetic namespace cleanup, glyphs.el, coding.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4570
diff
changeset
|
265 (or (car args) 'binary)))) |
|
7191a7b120f1
Some cosmetic namespace cleanup, glyphs.el, coding.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4570
diff
changeset
|
266 result) |
|
7191a7b120f1
Some cosmetic namespace cleanup, glyphs.el, coding.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4570
diff
changeset
|
267 finally return (nreverse result)))) |
|
7191a7b120f1
Some cosmetic namespace cleanup, glyphs.el, coding.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4570
diff
changeset
|
268 (force-coding-system-equivalency |
|
7191a7b120f1
Some cosmetic namespace cleanup, glyphs.el, coding.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4570
diff
changeset
|
269 (file-name file-name-coding-system) |
|
7191a7b120f1
Some cosmetic namespace cleanup, glyphs.el, coding.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4570
diff
changeset
|
270 (terminal terminal-coding-system) |
|
7191a7b120f1
Some cosmetic namespace cleanup, glyphs.el, coding.el.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4570
diff
changeset
|
271 (keyboard keyboard-coding-system))) |
| 440 | 272 |
| 428 | 273 (make-compatible-variable 'enable-multibyte-characters "Unimplemented") |
| 274 | |
|
4549
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
275 ;; Sure would be nice to be able to use defface here. |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
276 (copy-face 'highlight 'query-coding-warning-face) |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
277 |
|
4690
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
278 (defun query-coding-clear-highlights (begin end &optional buffer-or-string) |
|
4555
20c32e489235
Add #'query-coding-clear-highlights.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4553
diff
changeset
|
279 "Remove extent faces added by `query-coding-region' between BEGIN and END. |
|
20c32e489235
Add #'query-coding-clear-highlights.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4553
diff
changeset
|
280 |
|
4604
e0a8715fdb1f
Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4599
diff
changeset
|
281 Optional argument BUFFER-OR-STRING is the buffer or string to use, and |
|
e0a8715fdb1f
Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4599
diff
changeset
|
282 defaults to the current buffer. |
|
4555
20c32e489235
Add #'query-coding-clear-highlights.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4553
diff
changeset
|
283 |
|
20c32e489235
Add #'query-coding-clear-highlights.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4553
diff
changeset
|
284 The HIGHLIGHTP argument to `query-coding-region' indicates that it should |
|
20c32e489235
Add #'query-coding-clear-highlights.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4553
diff
changeset
|
285 display unencodable characters using `query-coding-warning-face'. After |
|
20c32e489235
Add #'query-coding-clear-highlights.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4553
diff
changeset
|
286 this function has been called, this will no longer be the case. " |
|
20c32e489235
Add #'query-coding-clear-highlights.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4553
diff
changeset
|
287 (map-extents #'(lambda (extent ignored-arg) |
|
20c32e489235
Add #'query-coding-clear-highlights.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4553
diff
changeset
|
288 (when (eq 'query-coding-warning-face |
|
20c32e489235
Add #'query-coding-clear-highlights.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4553
diff
changeset
|
289 (extent-face extent)) |
|
4604
e0a8715fdb1f
Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4599
diff
changeset
|
290 (delete-extent extent))) buffer-or-string begin end)) |
|
4555
20c32e489235
Add #'query-coding-clear-highlights.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4553
diff
changeset
|
291 |
|
4604
e0a8715fdb1f
Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4599
diff
changeset
|
292 (defun query-coding-string (string coding-system &optional |
|
e0a8715fdb1f
Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4599
diff
changeset
|
293 ignore-invalid-sequencesp errorp highlight) |
|
e0a8715fdb1f
Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4599
diff
changeset
|
294 "Work out whether CODING-SYSTEM can losslessly encode STRING. |
|
e0a8715fdb1f
Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4599
diff
changeset
|
295 CODING-SYSTEM is the coding system to check. |
|
e0a8715fdb1f
Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4599
diff
changeset
|
296 |
|
e0a8715fdb1f
Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4599
diff
changeset
|
297 IGNORE-INVALID-SEQUENCESP, an optional argument, says to treat XEmacs |
|
e0a8715fdb1f
Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4599
diff
changeset
|
298 characters which have an unambiguous encoded representation, despite being |
|
e0a8715fdb1f
Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4599
diff
changeset
|
299 undefined in what they represent, as encodable. These chiefly arise with |
|
e0a8715fdb1f
Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4599
diff
changeset
|
300 variable-length encodings like UTF-8 and UTF-16, where an invalid sequence |
|
e0a8715fdb1f
Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4599
diff
changeset
|
301 is passed through to XEmacs as a sequence of characters with a defined |
|
e0a8715fdb1f
Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4599
diff
changeset
|
302 correspondence to the octets on disk, but no non-error semantics; see the |
|
e0a8715fdb1f
Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4599
diff
changeset
|
303 `invalid-sequence-coding-system' argument to `set-language-info'. |
|
e0a8715fdb1f
Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4599
diff
changeset
|
304 |
|
e0a8715fdb1f
Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4599
diff
changeset
|
305 They can also arise with fixed-length encodings like ISO 8859-7, where |
|
e0a8715fdb1f
Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4599
diff
changeset
|
306 certain octets on disk have undefined values, and treating them as |
|
e0a8715fdb1f
Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4599
diff
changeset
|
307 corresponding to the ISO 8859-1 characters with the same numerical values |
|
4690
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
308 may lead to data that are not understood by other applications. |
|
4604
e0a8715fdb1f
Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4599
diff
changeset
|
309 |
|
e0a8715fdb1f
Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4599
diff
changeset
|
310 Optional argument ERRORP says to signal a `text-conversion-error' if some |
|
e0a8715fdb1f
Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4599
diff
changeset
|
311 character in the region cannot be encoded, and defaults to nil. |
|
e0a8715fdb1f
Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4599
diff
changeset
|
312 |
|
e0a8715fdb1f
Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4599
diff
changeset
|
313 Optional argument HIGHLIGHT says to display unencodable characters in the |
|
e0a8715fdb1f
Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4599
diff
changeset
|
314 region using `query-coding-warning-face'. It defaults to nil. |
|
e0a8715fdb1f
Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4599
diff
changeset
|
315 |
|
4690
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
316 This function can return multiple values; the intention is that callers use |
|
4604
e0a8715fdb1f
Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4599
diff
changeset
|
317 `multiple-value-bind' or the related CL multiple value functions to deal |
|
4690
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
318 with it. The first result is `t' if the region can be encoded using |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
319 CODING-SYSTEM, or `nil' if not. If the region cannot be encoded using |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
320 CODING-SYSTEM, the second result is a range table describing the positions |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
321 of the unencodable characters. |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
322 |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
323 Ranges that describe characters that would be ignored were |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
324 IGNORE-INVALID-SEQUENCESP non-nil map to the symbol `invalid-sequence'; |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
325 other ranges map to the symbol `unencodable'. If IGNORE-INVALID-SEQUENCESP |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
326 is non-nil, all ranges will map to the symbol `unencodable'. See |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
327 `make-range-table' for more details of range tables." |
|
4549
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
328 (with-temp-buffer |
|
4604
e0a8715fdb1f
Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4599
diff
changeset
|
329 (when highlight |
|
e0a8715fdb1f
Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4599
diff
changeset
|
330 (query-coding-clear-highlights 0 (length string) string)) |
|
4549
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
331 (insert string) |
|
4690
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
332 (multiple-value-bind (result ranges) |
|
4596
4fc32a3a086e
Fix a couple of bugs, #'query-coding-region, #'query-coding-string.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4570
diff
changeset
|
333 (query-coding-region (point-min) (point-max) coding-system |
|
4609
33b8c874b2c8
Correct string offset and arg handling, #'query-coding-string and related.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4604
diff
changeset
|
334 (current-buffer) ignore-invalid-sequencesp |
|
33b8c874b2c8
Correct string offset and arg handling, #'query-coding-string and related.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4604
diff
changeset
|
335 errorp) |
|
4690
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
336 (unless result |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
337 (let ((original-ranges ranges) |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
338 extent) |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
339 (setq ranges (make-range-table)) |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
340 (map-range-table |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
341 #'(lambda (begin end value) |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
342 ;; Sigh, string indices are zero-based, buffer offsets are |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
343 ;; one-based. |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
344 (put-range-table (decf begin) (decf end) value ranges) |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
345 (when highlight |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
346 (setq extent (make-extent begin end string)) |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
347 (set-extent-priority extent (+ mouse-highlight-priority 2)) |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
348 (set-extent-property extent 'duplicable t) |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
349 (set-extent-face extent 'query-coding-warning-face))) |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
350 original-ranges))) |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
351 (if result result (values result ranges))))) |
|
4549
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
352 |
|
4570
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
353 ;; Function docstring and API are taken from GNU coding.c version 1.353, GPLv2. |
|
4549
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
354 (defun unencodable-char-position (start end coding-system |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
355 &optional count string) |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
356 "Return position of first un-encodable character in a region. |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
357 START and END specify the region and CODING-SYSTEM specifies the |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
358 encoding to check. Return nil if CODING-SYSTEM does encode the region. |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
359 |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
360 If optional 4th argument COUNT is non-nil, it specifies at most how |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
361 many un-encodable characters to search. In this case, the value is a |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
362 list of positions. |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
363 |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
364 If optional 5th argument STRING is non-nil, it is a string to search |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
365 for un-encodable characters. In that case, START and END are indexes |
|
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
366 in the string." |
|
4568
1d74a1d115ee
Add #'query-coding-region tests; do the work necessary to get them running.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4564
diff
changeset
|
367 (let ((thunk |
|
4609
33b8c874b2c8
Correct string offset and arg handling, #'query-coding-string and related.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4604
diff
changeset
|
368 #'(lambda (start end coding-system stringp count) |
|
4568
1d74a1d115ee
Add #'query-coding-region tests; do the work necessary to get them running.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4564
diff
changeset
|
369 (multiple-value-bind (result ranges) |
|
1d74a1d115ee
Add #'query-coding-region tests; do the work necessary to get them running.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4564
diff
changeset
|
370 (query-coding-region start end coding-system) |
|
1d74a1d115ee
Add #'query-coding-region tests; do the work necessary to get them running.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4564
diff
changeset
|
371 (if result |
|
1d74a1d115ee
Add #'query-coding-region tests; do the work necessary to get them running.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4564
diff
changeset
|
372 nil |
|
1d74a1d115ee
Add #'query-coding-region tests; do the work necessary to get them running.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4564
diff
changeset
|
373 (block worked-it-all-out |
|
1d74a1d115ee
Add #'query-coding-region tests; do the work necessary to get them running.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4564
diff
changeset
|
374 (if count |
|
1d74a1d115ee
Add #'query-coding-region tests; do the work necessary to get them running.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4564
diff
changeset
|
375 (map-range-table |
|
1d74a1d115ee
Add #'query-coding-region tests; do the work necessary to get them running.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4564
diff
changeset
|
376 #'(lambda (begin end value) |
|
1d74a1d115ee
Add #'query-coding-region tests; do the work necessary to get them running.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4564
diff
changeset
|
377 (while (and (< begin end) |
|
1d74a1d115ee
Add #'query-coding-region tests; do the work necessary to get them running.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4564
diff
changeset
|
378 (< (length result) count)) |
|
4609
33b8c874b2c8
Correct string offset and arg handling, #'query-coding-string and related.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4604
diff
changeset
|
379 (push (if stringp (1- begin) begin) result) |
|
4568
1d74a1d115ee
Add #'query-coding-region tests; do the work necessary to get them running.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4564
diff
changeset
|
380 (incf begin)) |
|
1d74a1d115ee
Add #'query-coding-region tests; do the work necessary to get them running.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4564
diff
changeset
|
381 (when (= (length result) count) |
|
1d74a1d115ee
Add #'query-coding-region tests; do the work necessary to get them running.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4564
diff
changeset
|
382 (return-from worked-it-all-out result))) |
|
1d74a1d115ee
Add #'query-coding-region tests; do the work necessary to get them running.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4564
diff
changeset
|
383 ranges) |
|
1d74a1d115ee
Add #'query-coding-region tests; do the work necessary to get them running.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4564
diff
changeset
|
384 (map-range-table |
|
1d74a1d115ee
Add #'query-coding-region tests; do the work necessary to get them running.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4564
diff
changeset
|
385 #'(lambda (begin end value) |
|
4609
33b8c874b2c8
Correct string offset and arg handling, #'query-coding-string and related.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4604
diff
changeset
|
386 (return-from worked-it-all-out |
|
33b8c874b2c8
Correct string offset and arg handling, #'query-coding-string and related.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4604
diff
changeset
|
387 (if stringp (1- begin) begin))) |
|
4568
1d74a1d115ee
Add #'query-coding-region tests; do the work necessary to get them running.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4564
diff
changeset
|
388 ranges)) |
|
1d74a1d115ee
Add #'query-coding-region tests; do the work necessary to get them running.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4564
diff
changeset
|
389 (assert (not (null count)) t |
|
1d74a1d115ee
Add #'query-coding-region tests; do the work necessary to get them running.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4564
diff
changeset
|
390 "We should never reach this point with null COUNT.") |
|
1d74a1d115ee
Add #'query-coding-region tests; do the work necessary to get them running.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4564
diff
changeset
|
391 result)))))) |
|
1d74a1d115ee
Add #'query-coding-region tests; do the work necessary to get them running.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4564
diff
changeset
|
392 (check-argument-type #'integer-or-marker-p start) |
|
1d74a1d115ee
Add #'query-coding-region tests; do the work necessary to get them running.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4564
diff
changeset
|
393 (check-argument-type #'integer-or-marker-p end) |
|
1d74a1d115ee
Add #'query-coding-region tests; do the work necessary to get them running.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4564
diff
changeset
|
394 (check-coding-system coding-system) |
|
4570
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
395 (when count (check-argument-type #'natnump count) |
|
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
396 ;; Special-case zero, sigh. |
|
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
397 (if (zerop count) (setq count 1))) |
|
4568
1d74a1d115ee
Add #'query-coding-region tests; do the work necessary to get them running.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4564
diff
changeset
|
398 (and string (check-argument-type #'stringp string)) |
|
4549
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
399 (if string |
|
4568
1d74a1d115ee
Add #'query-coding-region tests; do the work necessary to get them running.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4564
diff
changeset
|
400 (with-temp-buffer |
|
1d74a1d115ee
Add #'query-coding-region tests; do the work necessary to get them running.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4564
diff
changeset
|
401 (insert string) |
|
4609
33b8c874b2c8
Correct string offset and arg handling, #'query-coding-string and related.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4604
diff
changeset
|
402 (funcall thunk (1+ start) (1+ end) coding-system t count)) |
|
33b8c874b2c8
Correct string offset and arg handling, #'query-coding-string and related.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4604
diff
changeset
|
403 (funcall thunk start end coding-system nil count)))) |
|
4549
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
404 |
|
4570
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
405 ;; XEmacs; this is a GPLv3 function in coding.c in GNU. This is why we have |
|
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
406 ;; both a very divergent docstring and a very divergent implementation. |
|
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
407 (defun check-coding-systems-region (begin end coding-system-list) |
|
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
408 "Can coding systems in CODING-SYSTEM-LIST encode text in a region? |
|
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
409 |
|
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
410 CODING-SYSTEM-LIST must be a list of coding systems. BEGIN and END are |
|
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
411 normally buffer positions delimiting the region. If some coding system in |
|
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
412 CODING-SYSTEM-LIST cannot encode the entire region, the return value of this |
|
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
413 function is an alist mapping coding system names to lists of individual |
|
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
414 buffer positions (not ranges) that the individual coding systems cannot |
|
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
415 encode. |
|
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
416 |
|
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
417 If all coding systems in CODING-SYSTEM-LIST can encode the region, |
|
4622
8cbca852bcd4
#'check-coding-systems-region: return nil on success, not t.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4609
diff
changeset
|
418 this function returns nil. |
|
4570
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
419 |
|
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
420 If BEGIN is a string, `check-coding-systems-region' ignores END, and checks |
|
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
421 whether the coding systems can encode BEGIN. The alist that is returned |
|
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
422 uses zero-based string indices, not one-based buffer positions. |
|
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
423 |
|
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
424 This function is for GNU compatibility. See also `query-coding-region'." |
|
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
425 (let ((thunk |
|
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
426 #'(lambda (begin end coding-system-list stringp) |
|
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
427 (loop |
|
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
428 for coding-system in coding-system-list |
|
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
429 with result = nil |
|
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
430 with intermediate = nil |
|
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
431 with range-lambda = (if stringp |
|
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
432 #'(lambda (begin end value) |
|
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
433 (while (< begin end) |
|
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
434 (push (1- begin) intermediate) |
|
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
435 (incf begin))) |
|
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
436 #'(lambda (begin end value) |
|
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
437 (while (< begin end) |
|
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
438 (push begin intermediate) |
|
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
439 (incf begin)))) |
|
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
440 do (setq coding-system (check-coding-system coding-system)) |
|
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
441 (multiple-value-bind (encoded ranges) |
|
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
442 (query-coding-region begin end coding-system) |
|
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
443 (unless encoded |
|
4690
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
444 (setq intermediate |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
445 (list (coding-system-name coding-system))) |
|
4570
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
446 (map-range-table range-lambda ranges) |
|
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
447 (push (nreverse intermediate) result))) |
|
4622
8cbca852bcd4
#'check-coding-systems-region: return nil on success, not t.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4609
diff
changeset
|
448 finally return result)))) |
|
4570
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
449 (if (stringp begin) |
|
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
450 (with-temp-buffer |
|
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
451 (insert begin) |
|
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
452 (funcall thunk (point-min) (point-max) coding-system-list t)) |
|
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
453 (check-argument-type #'integer-or-marker-p begin) |
|
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
454 (check-argument-type #'integer-or-marker-p end) |
|
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
455 (funcall thunk begin end coding-system-list nil)))) |
|
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
456 |
|
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
457 ;; XEmacs; docstring taken from GNU, international/mule-cmds.el, revision |
|
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
458 ;; 1.311, GPLv2. |
|
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
459 (defun encode-coding-char (char coding-system &optional charset) |
|
4549
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
460 "Encode CHAR by CODING-SYSTEM and return the resulting string. |
|
4570
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
461 If CODING-SYSTEM can't safely encode CHAR, return nil. |
|
e6a7054a9c30
Add check-coding-systems-region, test it and others, fix some bugs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4568
diff
changeset
|
462 The optional third argument CHARSET is, for the moment, ignored." |
|
4549
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
463 (check-argument-type #'characterp char) |
|
4690
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
464 (and (query-coding-string char coding-system) |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
465 (encode-coding-string char coding-system))) |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
466 |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
467 (if (featurep 'mule) |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
468 (progn |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
469 ;; Under Mule, we do much of the complicated coding system creation in |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
470 ;; Lisp and especially at compile time. We need some function |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
471 ;; definition for this function to be created in this file, but we can |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
472 ;; leave assigning the docstring to the autoload cookie |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
473 ;; handling later. Thankfully; that docstring is big. |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
474 (autoload 'make-coding-system "mule/make-coding-system") |
|
4549
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
475 |
|
4690
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
476 ;; (During byte-compile before dumping, make-coding-system may already |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
477 ;; have been loaded, make sure not to overwrite the correct compiler |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
478 ;; macro:) |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
479 (when (eq 'autoload (car (symbol-function 'make-coding-system))) |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
480 ;; Make sure to pick up the correct compiler macro when compiling |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
481 ;; files: |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
482 (define-compiler-macro make-coding-system (&whole form name type |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
483 &optional description props) |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
484 (load (second (symbol-function 'make-coding-system))) |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
485 (funcall (get 'make-coding-system 'cl-compiler-macro) |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
486 form name type description props)))) |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
487 |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
488 ;; Mule's not available; |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
489 (fset 'make-coding-system (symbol-function 'make-coding-system-internal)) |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
490 (define-coding-system-alias 'escape-quoted 'binary) |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
491 |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
492 ;; These are so that gnus and friends work when not mule: |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
493 (define-coding-system-alias 'iso-8859-1 'raw-text) |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4622
diff
changeset
|
494 (define-coding-system-alias 'ctext 'raw-text)) |
|
4549
68d1ca56cffa
First part of interactive checks that coding systems encode regions.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4227
diff
changeset
|
495 |
| 728 | 496 ;;; coding.el ends here |