Mercurial > hg > xemacs-beta
annotate src/doc.c @ 4952:19a72041c5ed
Mule-izing, various fixes related to char * arguments
-------------------- ChangeLog entries follow: --------------------
modules/ChangeLog addition:
2010-01-26 Ben Wing <ben@xemacs.org>
* postgresql/postgresql.c:
* postgresql/postgresql.c (CHECK_LIVE_CONNECTION):
* postgresql/postgresql.c (print_pgresult):
* postgresql/postgresql.c (Fpq_conn_defaults):
* postgresql/postgresql.c (Fpq_connectdb):
* postgresql/postgresql.c (Fpq_connect_start):
* postgresql/postgresql.c (Fpq_result_status):
* postgresql/postgresql.c (Fpq_res_status):
Mule-ize large parts of it.
2010-01-26 Ben Wing <ben@xemacs.org>
* ldap/eldap.c (print_ldap):
* ldap/eldap.c (allocate_ldap):
Use write_ascstring().
src/ChangeLog addition:
2010-01-26 Ben Wing <ben@xemacs.org>
* alloc.c:
* alloc.c (build_ascstring):
* alloc.c (build_msg_cistring):
* alloc.c (staticpro_1):
* alloc.c (staticpro_name):
* alloc.c (staticpro_nodump_1):
* alloc.c (staticpro_nodump_name):
* alloc.c (unstaticpro_nodump_1):
* alloc.c (mcpro_1):
* alloc.c (mcpro_name):
* alloc.c (object_memory_usage_stats):
* alloc.c (common_init_alloc_early):
* alloc.c (init_alloc_once_early):
* buffer.c (print_buffer):
* buffer.c (vars_of_buffer):
* buffer.c (common_init_complex_vars_of_buffer):
* buffer.c (init_initial_directory):
* bytecode.c (invalid_byte_code):
* bytecode.c (print_compiled_function):
* bytecode.c (mark_compiled_function):
* chartab.c (print_table_entry):
* chartab.c (print_char_table):
* config.h.in:
* console-gtk.c:
* console-gtk.c (gtk_device_to_console_connection):
* console-gtk.c (gtk_semi_canonicalize_console_connection):
* console-gtk.c (gtk_canonicalize_console_connection):
* console-gtk.c (gtk_semi_canonicalize_device_connection):
* console-gtk.c (gtk_canonicalize_device_connection):
* console-stream.c (stream_init_frame_1):
* console-stream.c (vars_of_console_stream):
* console-stream.c (init_console_stream):
* console-x.c (x_semi_canonicalize_console_connection):
* console-x.c (x_semi_canonicalize_device_connection):
* console-x.c (x_canonicalize_device_connection):
* console-x.h:
* data.c (eq_with_ebola_notice):
* data.c (Fsubr_interactive):
* data.c (Fnumber_to_string):
* data.c (digit_to_number):
* device-gtk.c (gtk_init_device):
* device-msw.c (print_devmode):
* device-x.c (x_event_name):
* dialog-msw.c (handle_directory_dialog_box):
* dialog-msw.c (handle_file_dialog_box):
* dialog-msw.c (vars_of_dialog_mswindows):
* doc.c (weird_doc):
* doc.c (Fsnarf_documentation):
* doc.c (vars_of_doc):
* dumper.c (pdump):
* dynarr.c:
* dynarr.c (Dynarr_realloc):
* editfns.c (Fuser_real_login_name):
* editfns.c (get_home_directory):
* elhash.c (print_hash_table_data):
* elhash.c (print_hash_table):
* emacs.c (main_1):
* emacs.c (vars_of_emacs):
* emodules.c:
* emodules.c (_emodules_list):
* emodules.c (Fload_module):
* emodules.c (Funload_module):
* emodules.c (Flist_modules):
* emodules.c (find_make_module):
* emodules.c (attempt_module_delete):
* emodules.c (emodules_load):
* emodules.c (emodules_doc_subr):
* emodules.c (emodules_doc_sym):
* emodules.c (syms_of_module):
* emodules.c (vars_of_module):
* emodules.h:
* eval.c (print_subr):
* eval.c (signal_call_debugger):
* eval.c (build_error_data):
* eval.c (signal_error):
* eval.c (maybe_signal_error):
* eval.c (signal_continuable_error):
* eval.c (maybe_signal_continuable_error):
* eval.c (signal_error_2):
* eval.c (maybe_signal_error_2):
* eval.c (signal_continuable_error_2):
* eval.c (maybe_signal_continuable_error_2):
* eval.c (signal_ferror):
* eval.c (maybe_signal_ferror):
* eval.c (signal_continuable_ferror):
* eval.c (maybe_signal_continuable_ferror):
* eval.c (signal_ferror_with_frob):
* eval.c (maybe_signal_ferror_with_frob):
* eval.c (signal_continuable_ferror_with_frob):
* eval.c (maybe_signal_continuable_ferror_with_frob):
* eval.c (syntax_error):
* eval.c (syntax_error_2):
* eval.c (maybe_syntax_error):
* eval.c (sferror):
* eval.c (sferror_2):
* eval.c (maybe_sferror):
* eval.c (invalid_argument):
* eval.c (invalid_argument_2):
* eval.c (maybe_invalid_argument):
* eval.c (invalid_constant):
* eval.c (invalid_constant_2):
* eval.c (maybe_invalid_constant):
* eval.c (invalid_operation):
* eval.c (invalid_operation_2):
* eval.c (maybe_invalid_operation):
* eval.c (invalid_change):
* eval.c (invalid_change_2):
* eval.c (maybe_invalid_change):
* eval.c (invalid_state):
* eval.c (invalid_state_2):
* eval.c (maybe_invalid_state):
* eval.c (wtaerror):
* eval.c (stack_overflow):
* eval.c (out_of_memory):
* eval.c (print_multiple_value):
* eval.c (issue_call_trapping_problems_warning):
* eval.c (backtrace_specials):
* eval.c (backtrace_unevalled_args):
* eval.c (Fbacktrace):
* eval.c (warn_when_safe):
* event-Xt.c (modwarn):
* event-Xt.c (modbarf):
* event-Xt.c (check_modifier):
* event-Xt.c (store_modifier):
* event-Xt.c (emacs_Xt_format_magic_event):
* event-Xt.c (describe_event):
* event-gtk.c (dragndrop_data_received):
* event-gtk.c (store_modifier):
* event-gtk.c (gtk_reset_modifier_mapping):
* event-msw.c (dde_eval_string):
* event-msw.c (Fdde_alloc_advise_item):
* event-msw.c (mswindows_dde_callback):
* event-msw.c (FROB):
* event-msw.c (emacs_mswindows_format_magic_event):
* event-stream.c (external_debugging_print_event):
* event-stream.c (execute_help_form):
* event-stream.c (vars_of_event_stream):
* events.c (print_event_1):
* events.c (print_event):
* events.c (event_equal):
* extents.c (print_extent_1):
* extents.c (print_extent):
* extents.c (vars_of_extents):
* faces.c (print_face):
* faces.c (complex_vars_of_faces):
* file-coding.c:
* file-coding.c (print_coding_system):
* file-coding.c (print_coding_system_in_print_method):
* file-coding.c (default_query_method):
* file-coding.c (find_coding_system):
* file-coding.c (make_coding_system_1):
* file-coding.c (chain_print):
* file-coding.c (undecided_print):
* file-coding.c (gzip_print):
* file-coding.c (vars_of_file_coding):
* file-coding.c (complex_vars_of_file_coding):
* fileio.c:
* fileio.c (report_file_type_error):
* fileio.c (report_error_with_errno):
* fileio.c (report_file_error):
* fileio.c (barf_or_query_if_file_exists):
* fileio.c (vars_of_fileio):
* floatfns.c (matherr):
* fns.c (print_bit_vector):
* fns.c (Fmapconcat):
* fns.c (add_suffix_to_symbol):
* fns.c (add_prefix_to_symbol):
* frame-gtk.c:
* frame-gtk.c (Fgtk_window_id):
* frame-x.c (def):
* frame-x.c (x_cde_transfer_callback):
* frame.c:
* frame.c (Fmake_frame):
* gc.c (show_gc_cursor_and_message):
* gc.c (vars_of_gc):
* glyphs-eimage.c (png_instantiate):
* glyphs-eimage.c (tiff_instantiate):
* glyphs-gtk.c (gtk_print_image_instance):
* glyphs-msw.c (mswindows_print_image_instance):
* glyphs-x.c (x_print_image_instance):
* glyphs-x.c (update_widget_face):
* glyphs.c (make_string_from_file):
* glyphs.c (print_image_instance):
* glyphs.c (signal_image_error):
* glyphs.c (signal_image_error_2):
* glyphs.c (signal_double_image_error):
* glyphs.c (signal_double_image_error_2):
* glyphs.c (xbm_mask_file_munging):
* glyphs.c (pixmap_to_lisp_data):
* glyphs.h:
* gui.c (gui_item_display_flush_left):
* hpplay.c (player_error_internal):
* hpplay.c (myHandler):
* intl-win32.c:
* intl-win32.c (langcode_to_lang):
* intl-win32.c (sublangcode_to_lang):
* intl-win32.c (Fmswindows_get_locale_info):
* intl-win32.c (lcid_to_locale_mule_or_no):
* intl-win32.c (mswindows_multibyte_to_unicode_print):
* intl-win32.c (complex_vars_of_intl_win32):
* keymap.c:
* keymap.c (print_keymap):
* keymap.c (ensure_meta_prefix_char_keymapp):
* keymap.c (Fkey_description):
* keymap.c (Ftext_char_description):
* lisp.h:
* lisp.h (struct):
* lisp.h (DECLARE_INLINE_HEADER):
* lread.c (Fload_internal):
* lread.c (locate_file):
* lread.c (read_escape):
* lread.c (read_raw_string):
* lread.c (read1):
* lread.c (read_list):
* lread.c (read_compiled_function):
* lread.c (init_lread):
* lrecord.h:
* marker.c (print_marker):
* marker.c (marker_equal):
* menubar-msw.c (displayable_menu_item):
* menubar-x.c (command_builder_operate_menu_accelerator):
* menubar.c (vars_of_menubar):
* minibuf.c (reinit_complex_vars_of_minibuf):
* minibuf.c (complex_vars_of_minibuf):
* mule-charset.c (Fmake_charset):
* mule-charset.c (complex_vars_of_mule_charset):
* mule-coding.c (iso2022_print):
* mule-coding.c (fixed_width_query):
* number.c (bignum_print):
* number.c (ratio_print):
* number.c (bigfloat_print):
* number.c (bigfloat_finalize):
* objects-msw.c:
* objects-msw.c (mswindows_color_to_string):
* objects-msw.c (mswindows_color_list):
* objects-tty.c:
* objects-tty.c (tty_font_list):
* objects-tty.c (tty_find_charset_font):
* objects-xlike-inc.c (xft_find_charset_font):
* objects-xlike-inc.c (endif):
* print.c:
* print.c (write_istring):
* print.c (write_ascstring):
* print.c (Fterpri):
* print.c (Fprint):
* print.c (print_error_message):
* print.c (print_vector_internal):
* print.c (print_cons):
* print.c (print_string):
* print.c (printing_unreadable_object):
* print.c (print_internal):
* print.c (print_float):
* print.c (print_symbol):
* process-nt.c (mswindows_report_winsock_error):
* process-nt.c (nt_canonicalize_host_name):
* process-unix.c (unix_canonicalize_host_name):
* process.c (print_process):
* process.c (report_process_error):
* process.c (report_network_error):
* process.c (make_process_internal):
* process.c (Fstart_process_internal):
* process.c (status_message):
* process.c (putenv_internal):
* process.c (vars_of_process):
* process.h:
* profile.c (vars_of_profile):
* rangetab.c (print_range_table):
* realpath.c (vars_of_realpath):
* redisplay.c (vars_of_redisplay):
* search.c (wordify):
* search.c (Freplace_match):
* sheap.c (sheap_adjust_h):
* sound.c (report_sound_error):
* sound.c (Fplay_sound_file):
* specifier.c (print_specifier):
* symbols.c (Fsubr_name):
* symbols.c (do_symval_forwarding):
* symbols.c (set_default_buffer_slot_variable):
* symbols.c (set_default_console_slot_variable):
* symbols.c (store_symval_forwarding):
* symbols.c (default_value):
* symbols.c (defsymbol_massage_name_1):
* symbols.c (defsymbol_massage_name_nodump):
* symbols.c (defsymbol_massage_name):
* symbols.c (defsymbol_massage_multiword_predicate_nodump):
* symbols.c (defsymbol_massage_multiword_predicate):
* symbols.c (defsymbol_nodump):
* symbols.c (defsymbol):
* symbols.c (defkeyword):
* symbols.c (defkeyword_massage_name):
* symbols.c (check_module_subr):
* symbols.c (deferror_1):
* symbols.c (deferror):
* symbols.c (deferror_massage_name):
* symbols.c (deferror_massage_name_and_message):
* symbols.c (defvar_magic):
* symeval.h:
* symeval.h (DEFVAR_SYMVAL_FWD):
* sysdep.c:
* sysdep.c (init_system_name):
* sysdll.c:
* sysdll.c (MAYBE_PREPEND_UNDERSCORE):
* sysdll.c (dll_function):
* sysdll.c (dll_variable):
* sysdll.c (dll_error):
* sysdll.c (dll_open):
* sysdll.c (dll_close):
* sysdll.c (image_for_address):
* sysdll.c (my_find_image):
* sysdll.c (search_linked_libs):
* sysdll.h:
* sysfile.h:
* sysfile.h (DEFAULT_DIRECTORY_FALLBACK):
* syswindows.h:
* tests.c (DFC_CHECK_LENGTH):
* tests.c (DFC_CHECK_CONTENT):
* tests.c (Ftest_hash_tables):
* text.c (vars_of_text):
* text.h:
* tooltalk.c (tt_opnum_string):
* tooltalk.c (tt_message_arg_ival_string):
* tooltalk.c (Ftooltalk_default_procid):
* tooltalk.c (Ftooltalk_default_session):
* tooltalk.c (init_tooltalk):
* tooltalk.c (vars_of_tooltalk):
* ui-gtk.c (Fdll_load):
* ui-gtk.c (type_to_marshaller_type):
* ui-gtk.c (Fgtk_import_function_internal):
* ui-gtk.c (emacs_gtk_object_printer):
* ui-gtk.c (emacs_gtk_boxed_printer):
* unicode.c (unicode_to_ichar):
* unicode.c (unicode_print):
* unicode.c (unicode_query):
* unicode.c (vars_of_unicode):
* unicode.c (complex_vars_of_unicode):
* win32.c:
* win32.c (mswindows_report_process_error):
* window.c (print_window):
* xemacs.def.in.in:
BASIC IDEA: Further fixing up uses of char * and CIbyte *
to reflect their actual semantics; Mule-izing some code;
redoing of the not-yet-working code to handle message translation.
Clean up code to handle message-translation (not yet working).
Create separate versions of build_msg_string() for working with
Ibyte *, CIbyte *, and Ascbyte * arguments. Assert that Ascbyte *
arguments are pure-ASCII. Make build_msg_string() be the same
as build_msg_ascstring(). Create same three versions of GETTEXT()
and DEFER_GETTEXT(). Also create build_defer_string() and
variants for the equivalent of DEFER_GETTEXT() when building a
string. Remove old CGETTEXT(). Clean up code where GETTEXT(),
DEFER_GETTEXT(), build_msg_string(), etc. was being called and
introduce some new calls to build_msg_string(), etc. Remove
GETTEXT() from calls to weird_doc() -- we assume that the
message snarfer knows about weird_doc(). Remove uses of
DEFER_GETTEXT() from error messages in sysdep.c and instead use
special comments /* @@@begin-snarf@@@ */ and /* @@@end-snarf@@@ */
that the message snarfer presumably knows about.
Create build_ascstring() and use it in many instances in place
of build_string(). The purpose of having Ascbyte * variants is
to make the code more self-documenting in terms of what sort of
semantics is expected for char * strings. In fact in the process
of looking for uses of build_string(), much improperly Mule-ized
was discovered.
Mule-ize a lot of code as described in previous paragraph,
e.g. in sysdep.c.
Make the error functions take Ascbyte * strings and fix up a
couple of places where non-pure-ASCII strings were being passed in
(file-coding.c, mule-coding.c, unicode.c). (It's debatable whether
we really need to make the error functions work this way. It
helps catch places where code is written in a way that message
translation won't work, but we may well never implement message
translation.)
Make staticpro() and friends take Ascbyte * strings instead of
raw char * strings. Create a const_Ascbyte_ptr dynarr type
to describe what's held by staticpro_names[] and friends,
create pdump descriptions for const_Ascbyte_ptr dynarrs, and
use them in place of specially-crafted staticpro descriptions.
Mule-ize certain other functions (e.g. x_event_name) by correcting
raw use of char * to Ascbyte *, Rawbyte * or another such type,
and raw use of char[] buffers to another type (usually Ascbyte[]).
Change many uses of write_c_string() to write_msg_string(),
write_ascstring(), etc.
Mule-ize emodules.c, emodules.h, sysdll.h.
Fix some un-Mule-ized code in intl-win32.c.
A comment in event-Xt.c and the limitations of the message
snarfer (make-msgfile or whatever) is presumably incorrect --
it should be smart enough to handle function calls spread over
more than one line. Clean up code in event-Xt.c that was
written awkwardly for this reason.
In config.h.in, instead of NEED_ERROR_CHECK_TYPES_INLINES,
create a more general XEMACS_DEFS_NEEDS_INLINE_DECLS to
indicate when inlined functions need to be declared in
xemacs.defs.in.in, and make use of it in xemacs.defs.in.in.
We need to do this because postgresql.c now calls qxestrdup(),
which is an inline function.
Make nconc2() and other such functions MODULE_API and put
them in xemacs.defs.in.in since postgresql.c now uses them.
Clean up indentation in lread.c and a few other places.
In text.h, document ASSERT_ASCTEXT_ASCII() and
ASSERT_ASCTEXT_ASCII_LEN(), group together the stand-in
encodings and add some more for DLL symbols, function and
variable names, etc.
| author | Ben Wing <ben@xemacs.org> |
|---|---|
| date | Tue, 26 Jan 2010 23:22:30 -0600 |
| parents | 061e030e3270 |
| children | 304aebb79cd3 |
| rev | line source |
|---|---|
| 428 | 1 /* Record indices of function doc strings stored in a file. |
| 2 Copyright (C) 1985, 1986, 1992, 1993, 1994, 1995 | |
| 3 Free Software Foundation, Inc. | |
| 2367 | 4 Copyright (C) 2001, 2002, 2004 Ben Wing. |
| 428 | 5 |
| 6 This file is part of XEmacs. | |
| 7 | |
| 8 XEmacs is free software; you can redistribute it and/or modify it | |
| 9 under the terms of the GNU General Public License as published by the | |
| 10 Free Software Foundation; either version 2, or (at your option) any | |
| 11 later version. | |
| 12 | |
| 13 XEmacs is distributed in the hope that it will be useful, but WITHOUT | |
| 14 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
| 15 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
| 16 for more details. | |
| 17 | |
| 18 You should have received a copy of the GNU General Public License | |
| 19 along with XEmacs; see the file COPYING. If not, write to | |
| 20 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
| 21 Boston, MA 02111-1307, USA. */ | |
| 22 | |
| 23 /* Synched up with: FSF 19.30. */ | |
| 24 | |
| 814 | 25 /* This file has been Mule-ized. */ |
| 428 | 26 |
| 27 #include <config.h> | |
| 28 #include "lisp.h" | |
| 29 | |
| 30 #include "buffer.h" | |
| 31 #include "bytecode.h" | |
| 814 | 32 #include "file-coding.h" |
| 428 | 33 #include "insdel.h" |
| 34 #include "keymap.h" | |
| 814 | 35 #include "lstream.h" |
| 428 | 36 #include "sysfile.h" |
| 37 | |
| 38 Lisp_Object Vinternal_doc_file_name; | |
| 39 | |
|
4367
69e6352406f0
Handle macros, autoloads correctly in symbol-file. Add an incomplete TYPE arg.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3548
diff
changeset
|
40 Lisp_Object QSsubstitute, Qdefvar; |
| 428 | 41 |
| 3368 | 42 /* Work out what source file a function or variable came from, taking the |
| 43 information from the documentation file. */ | |
| 44 | |
| 45 static Lisp_Object | |
| 46 extract_object_file_name (int fd, EMACS_INT doc_pos, | |
| 47 Ibyte *name_nonreloc, Lisp_Object name_reloc, | |
| 48 int standard_doc_file) | |
| 49 { | |
| 3383 | 50 Ibyte buf[DOC_MAX_FILENAME_LENGTH+1]; |
| 3368 | 51 Ibyte *buffer = buf; |
| 3411 | 52 int buffer_size = sizeof (buf) - 1, space_left; |
| 3368 | 53 Ibyte *from, *to; |
| 54 REGISTER Ibyte *p = buffer; | |
| 55 Lisp_Object return_me; | |
| 56 Lisp_Object fdstream = Qnil, instream = Qnil; | |
| 57 struct gcpro gcpro1, gcpro2; | |
| 58 EMACS_INT position, seenS = 0; | |
| 59 | |
| 60 GCPRO2 (fdstream, instream); | |
| 61 | |
| 3411 | 62 position = doc_pos > buffer_size ? |
| 63 doc_pos - buffer_size : 0; | |
| 3368 | 64 |
| 65 if (0 > lseek (fd, position, 0)) | |
| 66 { | |
| 67 if (name_nonreloc) | |
| 68 name_reloc = build_intstring (name_nonreloc); | |
| 69 return_me = list3 (build_msg_string | |
| 70 ("Position out of range in doc string file"), | |
| 71 name_reloc, make_int (position)); | |
| 72 goto done; | |
| 73 } | |
| 74 | |
| 75 fdstream = make_filedesc_input_stream (fd, 0, -1, 0); | |
| 76 Lstream_set_buffering (XLSTREAM (fdstream), LSTREAM_UNBUFFERED, 0); | |
| 77 instream = | |
| 78 make_coding_input_stream | |
| 79 (XLSTREAM (fdstream), standard_doc_file ? Qescape_quoted : Qbinary, | |
| 80 CODING_DECODE, 0); | |
| 81 Lstream_set_buffering (XLSTREAM (instream), LSTREAM_UNBUFFERED, 0); | |
| 82 | |
| 83 space_left = buffer_size - (p - buffer); | |
| 84 while (space_left > 0) | |
| 85 { | |
| 86 int nread; | |
| 87 | |
| 88 nread = Lstream_read (XLSTREAM (instream), p, space_left); | |
| 89 if (nread < 0) | |
| 90 { | |
| 91 return_me = list1 (build_msg_string | |
| 92 ("Read error on documentation file")); | |
| 93 goto done; | |
| 94 } | |
| 95 | |
| 96 p[nread] = 0; | |
| 97 | |
| 98 if (!nread) | |
| 99 break; | |
| 100 | |
| 101 p += nread; | |
| 102 space_left = buffer_size - (p - buffer); | |
| 103 } | |
| 104 | |
| 105 /* First, search backward for the "\037S" that marks the beginning of the | |
| 106 file name, then search forward from that to the newline or to the end | |
| 107 of the buffer. */ | |
| 108 from = p; | |
| 109 | |
| 110 while (from > buf) | |
| 111 { | |
| 112 --from; | |
| 113 if (seenS) | |
| 114 { | |
| 115 if ('\037' == *from) | |
| 116 { | |
| 117 /* Got a file name; adjust `from' to point to it, break out of | |
| 118 the loop. */ | |
| 119 from += 2; | |
| 120 break; | |
| 121 } | |
| 122 } | |
| 123 /* Is *from 'S' ? */ | |
| 124 seenS = ('S' == *from); | |
| 125 } | |
| 126 | |
| 127 if (buf == from) | |
| 128 { | |
| 129 /* We've scanned back to the beginning of the buffer without hitting | |
| 130 the file name. Either the file name plus the symbol name is longer | |
| 131 than DOC_MAX_FILENAME_LENGTH--which shouldn't happen, because it'll | |
| 132 trigger an assertion failure in make-docfile, the DOC file is | |
| 133 corrupt, or it was produced by a version of make-docfile that | |
| 134 doesn't store the file name with the symbol name and docstring. */ | |
| 135 return_me = list1 (build_msg_string | |
| 136 ("Object file name not stored in doc file")); | |
| 137 goto done; | |
| 138 } | |
| 139 | |
| 140 to = from; | |
| 141 /* Search for the end of the file name. */ | |
| 142 while (++to < p) | |
| 143 { | |
| 144 if ('\n' == *to || '\037' == *to) | |
| 145 { | |
| 146 break; | |
| 147 } | |
| 148 } | |
| 149 | |
| 150 /* Don't require the file name to end in a newline. */ | |
| 151 return_me = make_string (from, to - from); | |
| 152 | |
| 153 done: | |
| 154 if (!NILP (instream)) | |
| 155 { | |
| 156 Lstream_delete (XLSTREAM (instream)); | |
| 157 Lstream_delete (XLSTREAM (fdstream)); | |
| 158 } | |
| 159 | |
| 160 UNGCPRO; | |
| 161 return return_me; | |
| 162 } | |
| 428 | 163 |
| 164 Lisp_Object | |
| 165 unparesseuxify_doc_string (int fd, EMACS_INT position, | |
| 867 | 166 Ibyte *name_nonreloc, Lisp_Object name_reloc, |
| 814 | 167 int standard_doc_file) |
| 428 | 168 { |
| 867 | 169 Ibyte buf[512 * 32 + 1]; |
| 170 Ibyte *buffer = buf; | |
| 3411 | 171 int buffer_size = sizeof (buf) - 1; |
| 867 | 172 Ibyte *from, *to; |
| 173 REGISTER Ibyte *p = buffer; | |
| 428 | 174 Lisp_Object return_me; |
| 814 | 175 Lisp_Object fdstream = Qnil, instream = Qnil; |
| 176 struct gcpro gcpro1, gcpro2; | |
| 177 | |
| 178 GCPRO2 (fdstream, instream); | |
| 428 | 179 |
| 180 if (0 > lseek (fd, position, 0)) | |
| 181 { | |
| 182 if (name_nonreloc) | |
| 771 | 183 name_reloc = build_intstring (name_nonreloc); |
| 184 return_me = list3 (build_msg_string | |
| 428 | 185 ("Position out of range in doc string file"), |
| 186 name_reloc, make_int (position)); | |
| 187 goto done; | |
| 188 } | |
| 189 | |
| 814 | 190 fdstream = make_filedesc_input_stream (fd, 0, -1, 0); |
| 191 Lstream_set_buffering (XLSTREAM (fdstream), LSTREAM_UNBUFFERED, 0); | |
| 192 instream = | |
| 193 make_coding_input_stream | |
| 194 /* Major trouble if we are too clever when reading byte-code | |
| 195 instructions! | |
| 196 | |
| 197 #### We should have a way of handling escape-quoted elc files | |
| 198 (i.e. files with non-ASCII/Latin-1 chars in them). Currently this | |
| 199 is "solved" in bytecomp.el by never inserting lazy references in | |
| 200 such files. */ | |
| 826 | 201 (XLSTREAM (fdstream), standard_doc_file ? Qescape_quoted : Qbinary, |
| 814 | 202 CODING_DECODE, 0); |
| 203 Lstream_set_buffering (XLSTREAM (instream), LSTREAM_UNBUFFERED, 0); | |
| 204 | |
| 428 | 205 /* Read the doc string into a buffer. |
| 206 Use the fixed buffer BUF if it is big enough; otherwise allocate one. | |
| 207 We store the buffer in use in BUFFER and its size in BUFFER_SIZE. */ | |
| 208 | |
| 209 while (1) | |
| 210 { | |
| 211 int space_left = buffer_size - (p - buffer); | |
| 212 int nread; | |
| 213 | |
| 214 /* Switch to a bigger buffer if we need one. */ | |
| 215 if (space_left == 0) | |
| 216 { | |
| 867 | 217 Ibyte *old_buffer = buffer; |
| 3411 | 218 buffer_size *= 2; |
| 219 | |
| 771 | 220 if (buffer == buf) |
| 221 { | |
| 3411 | 222 buffer = xnew_ibytes (buffer_size + 1); |
| 771 | 223 memcpy (buffer, old_buffer, p - old_buffer); |
| 224 } | |
| 225 else | |
| 3411 | 226 XREALLOC_ARRAY (buffer, Ibyte, buffer_size + 1); |
| 428 | 227 p += buffer - old_buffer; |
| 228 space_left = buffer_size - (p - buffer); | |
| 229 } | |
| 230 | |
| 231 /* Don't read too much at one go. */ | |
| 232 if (space_left > 1024 * 8) | |
| 233 space_left = 1024 * 8; | |
| 814 | 234 nread = Lstream_read (XLSTREAM (instream), p, space_left); |
| 428 | 235 if (nread < 0) |
| 236 { | |
| 771 | 237 return_me = list1 (build_msg_string |
| 428 | 238 ("Read error on documentation file")); |
| 239 goto done; | |
| 240 } | |
| 241 p[nread] = 0; | |
| 242 if (!nread) | |
| 243 break; | |
| 244 { | |
| 867 | 245 Ibyte *p1 = qxestrchr (p, '\037'); /* End of doc string marker */ |
| 814 | 246 if (p1) |
| 247 { | |
| 248 *p1 = 0; | |
| 249 p = p1; | |
| 250 break; | |
| 251 } | |
| 428 | 252 } |
| 253 p += nread; | |
| 254 } | |
| 255 | |
| 256 /* Scan the text and remove quoting with ^A (char code 1). | |
| 257 ^A^A becomes ^A, ^A0 becomes a null char, and ^A_ becomes a ^_. */ | |
| 258 from = to = buffer; | |
| 259 while (from < p) | |
| 260 { | |
| 261 if (*from != 1 /*^A*/) | |
| 262 *to++ = *from++; | |
| 263 else | |
| 264 { | |
| 265 int c = *(++from); | |
| 266 | |
| 267 from++; | |
| 268 switch (c) | |
| 269 { | |
| 270 case 1: *to++ = c; break; | |
| 271 case '0': *to++ = '\0'; break; | |
| 272 case '_': *to++ = '\037'; break; | |
| 273 default: | |
| 771 | 274 return_me = list2 (build_msg_string |
| 428 | 275 ("Invalid data in documentation file -- ^A followed by weird code"), |
| 276 make_int (c)); | |
| 277 goto done; | |
| 278 } | |
| 279 } | |
| 280 } | |
| 281 | |
| 814 | 282 return_me = make_string (buffer, to - buffer); |
| 428 | 283 |
| 284 done: | |
| 814 | 285 if (!NILP (instream)) |
| 286 { | |
| 287 Lstream_delete (XLSTREAM (instream)); | |
| 288 Lstream_delete (XLSTREAM (fdstream)); | |
| 289 } | |
| 290 UNGCPRO; | |
| 428 | 291 if (buffer != buf) /* We must have allocated buffer above */ |
| 1726 | 292 xfree (buffer, Ibyte *); |
| 428 | 293 return return_me; |
| 294 } | |
| 295 | |
| 771 | 296 #define string_join(dest, s1, s2) \ |
| 297 memcpy (dest, XSTRING_DATA (s1), XSTRING_LENGTH (s1)); \ | |
| 298 memcpy (dest + XSTRING_LENGTH (s1), XSTRING_DATA (s2), \ | |
| 299 XSTRING_LENGTH (s2)); \ | |
| 428 | 300 dest[XSTRING_LENGTH (s1) + XSTRING_LENGTH (s2)] = '\0' |
| 301 | |
| 302 /* Extract a doc string from a file. FILEPOS says where to get it. | |
| 303 (This could actually be byte code instructions/constants instead | |
| 304 of a doc string.) | |
| 305 If it is an integer, use that position in the standard DOC file. | |
| 306 If it is (FILE . INTEGER), use FILE as the file name | |
| 307 and INTEGER as the position in that file. | |
| 308 But if INTEGER is negative, make it positive. | |
| 309 (A negative integer is used for user variables, so we can distinguish | |
| 310 them without actually fetching the doc string.) */ | |
| 311 | |
| 312 static Lisp_Object | |
| 313 get_doc_string (Lisp_Object filepos) | |
| 314 { | |
| 315 REGISTER int fd; | |
| 867 | 316 REGISTER Ibyte *name_nonreloc = 0; |
| 428 | 317 EMACS_INT position; |
| 318 Lisp_Object file, tem; | |
| 319 Lisp_Object name_reloc = Qnil; | |
| 814 | 320 int standard_doc_file = 0; |
| 428 | 321 |
| 322 if (INTP (filepos)) | |
| 323 { | |
| 324 file = Vinternal_doc_file_name; | |
| 814 | 325 standard_doc_file = 1; |
| 428 | 326 position = XINT (filepos); |
| 327 } | |
| 328 else if (CONSP (filepos) && INTP (XCDR (filepos))) | |
| 329 { | |
| 330 file = XCAR (filepos); | |
| 331 position = XINT (XCDR (filepos)); | |
| 332 if (position < 0) | |
| 333 position = - position; | |
| 334 } | |
| 335 else | |
| 336 return Qnil; | |
| 337 | |
| 338 if (!STRINGP (file)) | |
| 339 return Qnil; | |
| 340 | |
| 341 /* Put the file name in NAME as a C string. | |
| 342 If it is relative, combine it with Vdoc_directory. */ | |
| 343 | |
| 344 tem = Ffile_name_absolute_p (file); | |
| 345 if (NILP (tem)) | |
| 346 { | |
| 647 | 347 Bytecount minsize; |
| 428 | 348 /* XEmacs: Move this check here. OK if called during loadup to |
| 349 load byte code instructions. */ | |
| 350 if (!STRINGP (Vdoc_directory)) | |
| 351 return Qnil; | |
| 352 | |
| 353 minsize = XSTRING_LENGTH (Vdoc_directory); | |
| 354 /* sizeof ("../lib-src/") == 12 */ | |
| 355 if (minsize < 12) | |
| 356 minsize = 12; | |
| 867 | 357 name_nonreloc = alloca_ibytes (minsize + XSTRING_LENGTH (file) + 8); |
| 428 | 358 string_join (name_nonreloc, Vdoc_directory, file); |
| 359 } | |
| 360 else | |
| 361 name_reloc = file; | |
| 362 | |
| 771 | 363 fd = qxe_open (name_nonreloc ? name_nonreloc : |
| 364 XSTRING_DATA (name_reloc), O_RDONLY | OPEN_BINARY, 0); | |
| 428 | 365 if (fd < 0) |
| 366 { | |
| 367 if (purify_flag) | |
| 368 { | |
| 369 /* sizeof ("../lib-src/") == 12 */ | |
| 2367 | 370 name_nonreloc = alloca_ibytes (12 + XSTRING_LENGTH (file) + 8); |
| 428 | 371 /* Preparing to dump; DOC file is probably not installed. |
| 372 So check in ../lib-src. */ | |
| 2367 | 373 qxestrcpy_ascii (name_nonreloc, "../lib-src/"); |
| 771 | 374 qxestrcat (name_nonreloc, XSTRING_DATA (file)); |
| 428 | 375 |
| 771 | 376 fd = qxe_open (name_nonreloc, O_RDONLY | OPEN_BINARY, 0); |
| 428 | 377 } |
| 378 | |
| 379 if (fd < 0) | |
| 814 | 380 report_file_error ("Cannot open doc string file", |
| 381 name_nonreloc ? build_intstring (name_nonreloc) : | |
| 382 name_reloc); | |
| 428 | 383 } |
| 384 | |
| 814 | 385 tem = unparesseuxify_doc_string (fd, position, name_nonreloc, name_reloc, |
| 386 standard_doc_file); | |
| 771 | 387 retry_close (fd); |
| 428 | 388 |
| 389 if (!STRINGP (tem)) | |
| 563 | 390 signal_error_1 (Qinvalid_byte_code, tem); |
| 428 | 391 |
| 392 return tem; | |
| 393 } | |
| 394 | |
| 395 /* Get a string from position FILEPOS and pass it through the Lisp reader. | |
| 396 We use this for fetching the bytecode string and constants vector | |
| 397 of a compiled function from the .elc file. */ | |
| 398 | |
| 399 Lisp_Object | |
| 400 read_doc_string (Lisp_Object filepos) | |
| 401 { | |
| 402 Lisp_Object string = get_doc_string (filepos); | |
| 403 | |
| 404 if (!STRINGP (string)) | |
| 563 | 405 invalid_state ("loading bytecode failed to return string", string); |
| 428 | 406 return Fread (string); |
| 407 } | |
| 408 | |
| 3368 | 409 static Lisp_Object |
| 410 get_object_file_name (Lisp_Object filepos) | |
| 411 { | |
| 412 REGISTER int fd; | |
| 413 REGISTER Ibyte *name_nonreloc = 0; | |
| 414 EMACS_INT position; | |
| 415 Lisp_Object file, tem; | |
| 416 Lisp_Object name_reloc = Qnil; | |
| 417 int standard_doc_file = 0; | |
| 418 | |
| 419 if (INTP (filepos)) | |
| 420 { | |
| 421 file = Vinternal_doc_file_name; | |
| 422 standard_doc_file = 1; | |
| 423 position = XINT (filepos); | |
| 424 } | |
| 425 else if (CONSP (filepos) && INTP (XCDR (filepos))) | |
| 426 { | |
| 427 file = XCAR (filepos); | |
| 428 position = XINT (XCDR (filepos)); | |
| 429 if (position < 0) | |
| 430 position = - position; | |
| 431 } | |
| 432 else | |
| 433 return Qnil; | |
| 434 | |
| 435 if (!STRINGP (file)) | |
| 436 return Qnil; | |
| 437 | |
| 438 /* Put the file name in NAME as a C string. | |
| 439 If it is relative, combine it with Vdoc_directory. */ | |
| 440 | |
| 441 tem = Ffile_name_absolute_p (file); | |
| 442 if (NILP (tem)) | |
| 443 { | |
| 444 Bytecount minsize; | |
| 445 /* XEmacs: Move this check here. OK if called during loadup to | |
| 446 load byte code instructions. */ | |
| 447 if (!STRINGP (Vdoc_directory)) | |
| 448 return Qnil; | |
| 449 | |
| 450 minsize = XSTRING_LENGTH (Vdoc_directory); | |
| 451 /* sizeof ("../lib-src/") == 12 */ | |
| 452 if (minsize < 12) | |
| 453 minsize = 12; | |
| 454 name_nonreloc = alloca_ibytes (minsize + XSTRING_LENGTH (file) + 8); | |
| 455 string_join (name_nonreloc, Vdoc_directory, file); | |
| 456 } | |
| 457 else | |
| 458 name_reloc = file; | |
| 459 | |
| 460 fd = qxe_open (name_nonreloc ? name_nonreloc : | |
| 461 XSTRING_DATA (name_reloc), O_RDONLY | OPEN_BINARY, 0); | |
| 462 if (fd < 0) | |
| 463 { | |
| 464 if (purify_flag) | |
| 465 { | |
| 466 /* sizeof ("../lib-src/") == 12 */ | |
| 467 name_nonreloc = alloca_ibytes (12 + XSTRING_LENGTH (file) + 8); | |
| 468 /* Preparing to dump; DOC file is probably not installed. | |
| 469 So check in ../lib-src. */ | |
| 470 qxestrcpy_ascii (name_nonreloc, "../lib-src/"); | |
| 471 qxestrcat (name_nonreloc, XSTRING_DATA (file)); | |
| 472 | |
| 473 fd = qxe_open (name_nonreloc, O_RDONLY | OPEN_BINARY, 0); | |
| 474 } | |
| 475 | |
| 476 if (fd < 0) | |
| 477 report_file_error ("Cannot open doc string file", | |
| 478 name_nonreloc ? build_intstring (name_nonreloc) : | |
| 479 name_reloc); | |
| 480 } | |
| 481 | |
| 482 tem = extract_object_file_name (fd, position, name_nonreloc, name_reloc, | |
| 483 standard_doc_file); | |
| 484 retry_close (fd); | |
| 485 | |
| 486 if (!STRINGP (tem)) | |
| 487 signal_error_1 (Qinvalid_byte_code, tem); | |
| 488 | |
| 489 return tem; | |
| 490 } | |
| 491 | |
| 492 | |
| 493 static void | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4539
diff
changeset
|
494 weird_doc (Lisp_Object sym, const Ascbyte *weirdness, const Ascbyte *type, |
| 3368 | 495 int pos) |
| 496 { | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4539
diff
changeset
|
497 if (!strcmp (weirdness, "duplicate")) return; |
| 3368 | 498 message ("Note: Strange doc (%s) for %s %s @ %d", |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4539
diff
changeset
|
499 GETTEXT (weirdness), GETTEXT (type), |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4539
diff
changeset
|
500 XSTRING_DATA (XSYMBOL (sym)->name), pos); |
| 3368 | 501 } |
| 502 | |
|
4367
69e6352406f0
Handle macros, autoloads correctly in symbol-file. Add an incomplete TYPE arg.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3548
diff
changeset
|
503 DEFUN ("built-in-symbol-file", Fbuilt_in_symbol_file, 1, 2, 0, /* |
| 3368 | 504 Return the C source file built-in symbol SYM comes from. |
| 505 Don't use this. Use the more general `symbol-file' (q.v.) instead. | |
|
4367
69e6352406f0
Handle macros, autoloads correctly in symbol-file. Add an incomplete TYPE arg.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3548
diff
changeset
|
506 |
|
69e6352406f0
Handle macros, autoloads correctly in symbol-file. Add an incomplete TYPE arg.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3548
diff
changeset
|
507 If TYPE is nil or omitted, any kind of definition is acceptable. |
|
69e6352406f0
Handle macros, autoloads correctly in symbol-file. Add an incomplete TYPE arg.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3548
diff
changeset
|
508 If TYPE is `defun', then function, subr, special form or macro definitions |
|
69e6352406f0
Handle macros, autoloads correctly in symbol-file. Add an incomplete TYPE arg.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3548
diff
changeset
|
509 are acceptable. |
|
69e6352406f0
Handle macros, autoloads correctly in symbol-file. Add an incomplete TYPE arg.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3548
diff
changeset
|
510 If TYPE is `defvar', then variable definitions are acceptable. |
| 3368 | 511 */ |
|
4367
69e6352406f0
Handle macros, autoloads correctly in symbol-file. Add an incomplete TYPE arg.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3548
diff
changeset
|
512 (symbol, type)) |
| 3368 | 513 { |
| 514 /* This function can GC */ | |
| 515 Lisp_Object fun; | |
| 516 Lisp_Object filename = Qnil; | |
| 517 | |
|
4367
69e6352406f0
Handle macros, autoloads correctly in symbol-file. Add an incomplete TYPE arg.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3548
diff
changeset
|
518 if (EQ(Ffboundp(symbol), Qt) && (EQ(type, Qnil) || EQ(type, Qdefun))) |
| 3368 | 519 { |
| 520 fun = Findirect_function (symbol); | |
| 521 | |
|
4367
69e6352406f0
Handle macros, autoloads correctly in symbol-file. Add an incomplete TYPE arg.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3548
diff
changeset
|
522 if (SUBRP (fun) || (CONSP(fun) && (EQ (Qmacro, Fcar_safe (fun))) |
|
4381
3906442b491b
Improve style and add tests for 'built-in-symbol-file'.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4377
diff
changeset
|
523 && (fun = Fcdr_safe (fun), SUBRP (fun)))) |
| 3368 | 524 { |
| 525 if (XSUBR (fun)->doc == 0) | |
| 526 return Qnil; | |
| 527 | |
| 528 if ((EMACS_INT) XSUBR (fun)->doc >= 0) | |
| 529 { | |
| 530 weird_doc (symbol, "No file info available for function", | |
| 531 GETTEXT("function"), 0); | |
| 532 return Qnil; | |
| 533 } | |
| 534 else | |
|
4539
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4381
diff
changeset
|
535 { |
|
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4381
diff
changeset
|
536 filename = get_object_file_name |
|
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4381
diff
changeset
|
537 (make_int (- (EMACS_INT) XSUBR (fun)->doc)); |
|
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4381
diff
changeset
|
538 return filename; |
|
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4381
diff
changeset
|
539 } |
|
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4381
diff
changeset
|
540 } |
|
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4381
diff
changeset
|
541 |
|
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4381
diff
changeset
|
542 if (COMPILED_FUNCTIONP (fun) || (CONSP(fun) && |
|
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4381
diff
changeset
|
543 (EQ (Qmacro, Fcar_safe (fun))) |
|
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4381
diff
changeset
|
544 && (fun = Fcdr_safe (fun), |
|
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4381
diff
changeset
|
545 COMPILED_FUNCTIONP (fun)))) |
|
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4381
diff
changeset
|
546 { |
|
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4381
diff
changeset
|
547 Lisp_Object tem; |
|
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4381
diff
changeset
|
548 Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (fun); |
|
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4381
diff
changeset
|
549 |
|
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4381
diff
changeset
|
550 if (! (f->flags.documentationp)) |
|
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4381
diff
changeset
|
551 return Qnil; |
|
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4381
diff
changeset
|
552 tem = compiled_function_documentation (f); |
|
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4381
diff
changeset
|
553 if (NATNUMP (tem) || CONSP (tem)) |
|
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4381
diff
changeset
|
554 { |
|
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4381
diff
changeset
|
555 filename = get_object_file_name (tem); |
|
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4381
diff
changeset
|
556 return filename; |
|
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4381
diff
changeset
|
557 } |
| 3368 | 558 } |
| 559 } | |
|
4539
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4381
diff
changeset
|
560 |
|
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4381
diff
changeset
|
561 if (EQ(Fboundp(symbol), Qt) && (EQ(type, Qnil) || EQ(type, Qdefvar))) |
| 3368 | 562 { |
| 563 Lisp_Object doc_offset = Fget (symbol, Qvariable_documentation, Qnil); | |
| 564 | |
| 565 if (!NILP(doc_offset)) | |
| 566 { | |
| 567 if (INTP(doc_offset)) | |
| 568 { | |
| 569 filename = get_object_file_name | |
| 570 (XINT (doc_offset) > 0 ? doc_offset | |
| 571 : make_int (- XINT (doc_offset))); | |
| 572 } | |
| 573 else if (CONSP(doc_offset)) | |
| 574 { | |
| 575 filename = get_object_file_name(doc_offset); | |
| 576 } | |
|
4539
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4381
diff
changeset
|
577 return filename; |
| 3368 | 578 } |
| 579 } | |
|
4539
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4381
diff
changeset
|
580 |
|
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4381
diff
changeset
|
581 return Qnil; |
| 3368 | 582 } |
| 583 | |
| 428 | 584 DEFUN ("documentation", Fdocumentation, 1, 2, 0, /* |
| 585 Return the documentation string of FUNCTION. | |
| 444 | 586 Unless a non-nil second argument RAW is given, the |
| 428 | 587 string is passed through `substitute-command-keys'. |
| 588 */ | |
| 589 (function, raw)) | |
| 590 { | |
| 591 /* This function can GC */ | |
| 592 Lisp_Object fun; | |
| 593 Lisp_Object doc; | |
| 594 | |
| 595 fun = Findirect_function (function); | |
| 596 | |
| 597 if (SUBRP (fun)) | |
| 598 { | |
| 599 if (XSUBR (fun)->doc == 0) | |
| 600 return Qnil; | |
| 601 if ((EMACS_INT) XSUBR (fun)->doc >= 0) | |
| 602 doc = build_string (XSUBR (fun)->doc); | |
| 603 else | |
| 604 doc = get_doc_string (make_int (- (EMACS_INT) XSUBR (fun)->doc)); | |
| 605 } | |
| 606 else if (COMPILED_FUNCTIONP (fun)) | |
| 607 { | |
| 608 Lisp_Object tem; | |
| 440 | 609 Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (fun); |
| 428 | 610 if (! (f->flags.documentationp)) |
| 611 return Qnil; | |
| 612 tem = compiled_function_documentation (f); | |
| 613 if (STRINGP (tem)) | |
| 614 doc = tem; | |
| 615 else if (NATNUMP (tem) || CONSP (tem)) | |
| 616 doc = get_doc_string (tem); | |
| 617 else | |
| 618 return Qnil; | |
| 619 } | |
| 620 else if (KEYMAPP (fun)) | |
| 771 | 621 return build_msg_string ("Prefix command (definition is a keymap of subcommands)."); |
| 428 | 622 else if (STRINGP (fun) || VECTORP (fun)) |
| 771 | 623 return build_msg_string ("Keyboard macro."); |
| 428 | 624 else if (CONSP (fun)) |
| 625 { | |
| 626 Lisp_Object funcar = Fcar (fun); | |
| 627 | |
| 628 if (!SYMBOLP (funcar)) | |
| 629 return Fsignal (Qinvalid_function, list1 (fun)); | |
| 630 else if (EQ (funcar, Qlambda) | |
| 631 || EQ (funcar, Qautoload)) | |
| 632 { | |
| 633 Lisp_Object tem, tem1; | |
| 634 tem1 = Fcdr (Fcdr (fun)); | |
| 635 tem = Fcar (tem1); | |
| 636 if (STRINGP (tem)) | |
| 637 doc = tem; | |
| 638 /* Handle a doc reference--but these never come last | |
| 639 in the function body, so reject them if they are last. */ | |
| 640 else if ((NATNUMP (tem) || CONSP (tem)) | |
| 641 && ! NILP (XCDR (tem1))) | |
| 642 doc = get_doc_string (tem); | |
| 643 else | |
| 644 return Qnil; | |
| 645 } | |
| 646 else if (EQ (funcar, Qmacro)) | |
| 647 return Fdocumentation (Fcdr (fun), raw); | |
| 648 else | |
| 649 goto oops; | |
| 650 } | |
| 651 else | |
| 652 { | |
| 653 oops: | |
| 654 return Fsignal (Qinvalid_function, list1 (fun)); | |
| 655 } | |
| 656 | |
| 657 if (NILP (raw)) | |
| 658 { | |
| 659 struct gcpro gcpro1; | |
| 660 #ifdef I18N3 | |
| 661 Lisp_Object domain = Qnil; | |
| 662 if (COMPILED_FUNCTIONP (fun)) | |
| 663 domain = compiled_function_domain (XCOMPILED_FUNCTION (fun)); | |
| 664 if (NILP (domain)) | |
| 665 doc = Fgettext (doc); | |
| 666 else | |
| 667 doc = Fdgettext (domain, doc); | |
| 668 #endif | |
| 669 | |
| 670 GCPRO1 (doc); | |
| 671 doc = Fsubstitute_command_keys (doc); | |
| 672 UNGCPRO; | |
| 673 } | |
| 674 return doc; | |
| 675 } | |
| 676 | |
| 677 DEFUN ("documentation-property", Fdocumentation_property, 2, 3, 0, /* | |
| 678 Return the documentation string that is SYMBOL's PROP property. | |
| 679 This is like `get', but it can refer to strings stored in the | |
| 680 `doc-directory/DOC' file; and if the value is a string, it is passed | |
| 681 through `substitute-command-keys'. A non-nil third argument avoids this | |
| 682 translation. | |
| 683 */ | |
| 444 | 684 (symbol, prop, raw)) |
| 428 | 685 { |
| 686 /* This function can GC */ | |
| 1849 | 687 Lisp_Object doc = Qnil; |
| 428 | 688 #ifdef I18N3 |
| 689 REGISTER Lisp_Object domain; | |
| 690 #endif | |
| 691 struct gcpro gcpro1; | |
| 692 | |
| 693 GCPRO1 (doc); | |
| 694 | |
| 444 | 695 doc = Fget (symbol, prop, Qnil); |
| 428 | 696 if (INTP (doc)) |
| 697 doc = get_doc_string (XINT (doc) > 0 ? doc : make_int (- XINT (doc))); | |
| 698 else if (CONSP (doc)) | |
| 699 doc = get_doc_string (doc); | |
| 700 #ifdef I18N3 | |
| 701 if (!NILP (doc)) | |
| 702 { | |
| 444 | 703 domain = Fget (symbol, Qvariable_domain, Qnil); |
| 428 | 704 if (NILP (domain)) |
| 705 doc = Fgettext (doc); | |
| 706 else | |
| 707 doc = Fdgettext (domain, doc); | |
| 708 } | |
| 709 #endif | |
| 710 if (NILP (raw) && STRINGP (doc)) | |
| 711 doc = Fsubstitute_command_keys (doc); | |
| 712 UNGCPRO; | |
| 713 return doc; | |
| 714 } | |
| 715 | |
| 716 | |
| 717 DEFUN ("Snarf-documentation", Fsnarf_documentation, 1, 1, 0, /* | |
| 718 Used during Emacs initialization, before dumping runnable Emacs, | |
| 719 to find pointers to doc strings stored in `.../lib-src/DOC' and | |
| 720 record them in function definitions. | |
| 721 One arg, FILENAME, a string which does not include a directory. | |
| 722 The file is written to `../lib-src', and later found in `exec-directory' | |
| 723 when doc strings are referred to in the dumped Emacs. | |
| 724 */ | |
| 725 (filename)) | |
| 726 { | |
| 727 int fd; | |
| 867 | 728 Ibyte buf[1024 + 1]; |
| 428 | 729 REGISTER int filled; |
| 730 REGISTER int pos; | |
| 867 | 731 REGISTER Ibyte *p, *end; |
| 428 | 732 Lisp_Object sym, fun, tem; |
| 867 | 733 Ibyte *name; |
| 428 | 734 |
| 814 | 735 /* This function should not pass the data it's reading through a coding |
| 736 stream. The reason is that the only purpose of this function is to | |
| 737 find the file offsets for the documentation of the various functions, | |
| 738 not do anything with the documentation itself. If we pass through a | |
| 739 coding stream, the pointers will get messed up when we start reading | |
| 740 ISO 2022 data because our pointers will reflect internal format, not | |
| 741 external format. */ | |
| 742 | |
| 428 | 743 if (!purify_flag) |
| 563 | 744 invalid_operation ("Snarf-documentation can only be called in an undumped Emacs", Qunbound); |
| 428 | 745 |
| 746 CHECK_STRING (filename); | |
| 747 | |
| 1330 | 748 { |
| 749 name = alloca_ibytes (XSTRING_LENGTH (filename) + 14); | |
| 2367 | 750 qxestrcpy_ascii (name, "../lib-src/"); |
| 1330 | 751 } |
| 428 | 752 |
| 771 | 753 qxestrcat (name, XSTRING_DATA (filename)); |
| 428 | 754 |
| 771 | 755 fd = qxe_open (name, O_RDONLY | OPEN_BINARY, 0); |
| 428 | 756 if (fd < 0) |
| 771 | 757 report_file_error ("Opening doc string file", build_intstring (name)); |
| 428 | 758 Vinternal_doc_file_name = filename; |
| 759 filled = 0; | |
| 760 pos = 0; | |
| 761 while (1) | |
| 762 { | |
| 763 if (filled < 512) | |
| 771 | 764 filled += retry_read (fd, &buf[filled], sizeof (buf) - 1 - filled); |
| 428 | 765 if (!filled) |
| 766 break; | |
| 767 | |
| 768 buf[filled] = 0; | |
| 769 p = buf; | |
| 770 end = buf + (filled < 512 ? filled : filled - 128); | |
| 771 while (p != end && *p != '\037') p++; | |
| 772 /* p points to ^_Ffunctionname\n or ^_Vvarname\n. */ | |
| 773 if (p != end) | |
| 774 { | |
| 771 | 775 end = qxestrchr (p, '\n'); |
| 3548 | 776 /* If you trigger a failure with this assertion, you probably |
| 777 configured with --quick-build and need to rebuild your DOC | |
| 3545 | 778 file. */ |
| 779 assert((end - p - 2) > -1); | |
| 771 | 780 sym = oblookup (Vobarray, p + 2, end - p - 2); |
| 428 | 781 if (SYMBOLP (sym)) |
| 782 { | |
| 783 Lisp_Object offset = make_int (pos + end + 1 - buf); | |
| 784 /* Attach a docstring to a variable */ | |
| 785 if (p[1] == 'V') | |
| 786 { | |
| 787 /* Install file-position as variable-documentation property | |
| 788 and make it negative for a user-variable | |
| 789 (doc starts with a `*'). */ | |
| 790 Lisp_Object old = Fget (sym, Qvariable_documentation, Qzero); | |
| 791 if (!ZEROP (old)) | |
| 792 { | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4539
diff
changeset
|
793 weird_doc (sym, "duplicate", |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4539
diff
changeset
|
794 "variable", pos); |
| 428 | 795 /* In the case of duplicate doc file entries, always |
| 796 take the later one. But if the doc is not an int | |
| 797 (a string, say) leave it alone. */ | |
| 798 if (!INTP (old)) | |
| 799 goto weird; | |
| 800 } | |
| 801 Fput (sym, Qvariable_documentation, | |
| 802 ((end[1] == '*') | |
| 803 ? make_int (- XINT (offset)) | |
| 804 : offset)); | |
| 805 } | |
| 806 /* Attach a docstring to a function. | |
| 807 The type determines where the docstring is stored. */ | |
| 808 else if (p[1] == 'F') | |
| 809 { | |
| 810 fun = indirect_function (sym,0); | |
| 811 | |
| 812 if (CONSP (fun) && EQ (XCAR (fun), Qmacro)) | |
| 813 fun = XCDR (fun); | |
| 814 | |
| 815 if (UNBOUNDP (fun)) | |
| 816 { | |
| 771 | 817 #if 0 /* There are lots of legitimate cases where this message will appear |
| 818 (e.g. any function that's only defined when MULE is defined, | |
| 819 provided that the function is used somewhere in a dumped Lisp | |
| 820 file, so that the symbol is interned in the dumped XEmacs), and | |
| 821 there's not a lot that can be done to eliminate the warning other | |
| 822 than kludges like moving the function to a Mule-only source file, | |
| 823 which often results in ugly code. Furthermore, the only point of | |
| 824 this warning is to warn you when you have a DEFUN that you forget | |
| 825 to DEFSUBR, but the compiler will also warn you, because the DEFUN | |
| 826 declares a static object, and the object will be unused -- you'll | |
| 827 get something like | |
| 828 | |
| 829 /src/xemacs/mule/src/abbrev.c:269: warning: `SFexpand_abbrev' defined but not used | |
| 830 | |
| 831 So I'm disabling this. --ben */ | |
| 832 | |
| 428 | 833 /* May have been #if'ed out or something */ |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4539
diff
changeset
|
834 weird_doc (sym, "not fboundp", |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4539
diff
changeset
|
835 "function", pos); |
| 771 | 836 #endif |
| 428 | 837 goto weird; |
| 838 } | |
| 839 else if (SUBRP (fun)) | |
| 840 { | |
| 841 /* Lisp_Subrs have a slot for it. */ | |
| 842 if (XSUBR (fun)->doc) | |
| 843 { | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4539
diff
changeset
|
844 weird_doc (sym, "duplicate", |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4539
diff
changeset
|
845 "subr", pos); |
| 428 | 846 goto weird; |
| 847 } | |
| 848 XSUBR (fun)->doc = (char *) (- XINT (offset)); | |
| 849 } | |
| 850 else if (CONSP (fun)) | |
| 851 { | |
| 852 /* If it's a lisp form, stick it in the form. */ | |
| 853 tem = XCAR (fun); | |
| 854 if (EQ (tem, Qlambda) || EQ (tem, Qautoload)) | |
| 855 { | |
| 856 tem = Fcdr (Fcdr (fun)); | |
| 857 if (CONSP (tem) && | |
| 858 INTP (XCAR (tem))) | |
| 859 { | |
| 860 Lisp_Object old = XCAR (tem); | |
| 861 if (!ZEROP (old)) | |
| 862 { | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4539
diff
changeset
|
863 if (EQ (tem, Qlambda)) |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4539
diff
changeset
|
864 weird_doc (sym, "duplicate", "lambda", |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4539
diff
changeset
|
865 pos); |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4539
diff
changeset
|
866 else |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4539
diff
changeset
|
867 weird_doc (sym, "duplicate", "autoload", |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4539
diff
changeset
|
868 pos); |
| 428 | 869 /* In the case of duplicate doc file entries, |
| 870 always take the later one. But if the doc | |
| 871 is not an int (a string, say) leave it | |
| 872 alone. */ | |
| 873 if (!INTP (old)) | |
| 874 goto weird; | |
| 875 } | |
| 876 XCAR (tem) = offset; | |
| 877 } | |
| 878 else if (!CONSP (tem)) | |
| 879 { | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4539
diff
changeset
|
880 weird_doc (sym, "!CONSP(tem)", "function", pos); |
| 428 | 881 goto cont; |
| 882 } | |
| 883 else | |
| 884 { | |
| 885 /* DOC string is a string not integer 0 */ | |
| 886 #if 0 | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4539
diff
changeset
|
887 weird_doc (sym, "!INTP(XCAR(tem))", |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4539
diff
changeset
|
888 "function", pos); |
| 428 | 889 #endif |
| 890 goto cont; | |
| 891 } | |
| 892 } | |
| 893 else | |
| 894 { | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4539
diff
changeset
|
895 weird_doc (sym, "not lambda or autoload", |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4539
diff
changeset
|
896 "function", pos); |
| 428 | 897 goto cont; |
| 898 } | |
| 899 } | |
| 900 else if (COMPILED_FUNCTIONP (fun)) | |
| 901 { | |
| 902 /* Compiled-Function objects sometimes have | |
| 903 slots for it. */ | |
| 440 | 904 Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (fun); |
| 428 | 905 |
| 906 /* This compiled-function object must have a | |
| 907 slot for the docstring, since we've found a | |
| 908 docstring for it. Unless there were multiple | |
| 909 definitions of it, and the latter one didn't | |
| 910 have any doc, which is a legal if slightly | |
| 911 bogus situation, so don't blow up. */ | |
| 912 | |
| 913 if (! (f->flags.documentationp)) | |
| 914 { | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4539
diff
changeset
|
915 weird_doc (sym, "no doc slot", "bytecode", pos); |
| 428 | 916 goto weird; |
| 917 } | |
| 918 else | |
| 919 { | |
| 920 Lisp_Object old = | |
| 921 compiled_function_documentation (f); | |
| 922 if (!ZEROP (old)) | |
| 923 { | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4539
diff
changeset
|
924 weird_doc (sym, "duplicate", "bytecode", pos); |
| 428 | 925 /* In the case of duplicate doc file entries, |
| 926 always take the later one. But if the doc is | |
| 927 not an int (a string, say) leave it alone. */ | |
| 928 if (!INTP (old)) | |
| 929 goto weird; | |
| 930 } | |
| 931 set_compiled_function_documentation (f, offset); | |
| 932 } | |
| 933 } | |
| 934 else | |
| 935 { | |
| 936 /* Otherwise the function is undefined or | |
| 937 otherwise weird. Ignore it. */ | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4539
diff
changeset
|
938 weird_doc (sym, "weird function", "function", pos); |
| 428 | 939 goto weird; |
| 940 } | |
| 941 } | |
| 942 else | |
| 943 { | |
| 944 /* lose: */ | |
| 771 | 945 signal_error (Qfile_error, "DOC file invalid at position", |
| 946 make_int (pos)); | |
| 428 | 947 weird: |
| 948 /* goto lose */; | |
| 949 } | |
| 950 } | |
| 951 } | |
| 952 cont: | |
| 953 pos += end - buf; | |
| 954 filled -= end - buf; | |
| 955 memmove (buf, end, filled); | |
| 956 } | |
| 771 | 957 retry_close (fd); |
| 428 | 958 return Qnil; |
| 959 } | |
| 960 | |
| 961 #if 1 /* Don't warn about functions whose doc was lost because they were | |
| 962 wrapped by advice-freeze.el... */ | |
| 963 static int | |
| 964 kludgily_ignore_lost_doc_p (Lisp_Object sym) | |
| 965 { | |
| 966 # define kludge_prefix "ad-Orig-" | |
| 793 | 967 Lisp_Object name = XSYMBOL (sym)->name; |
| 968 return (XSTRING_LENGTH (name) > (Bytecount) (sizeof (kludge_prefix)) && | |
| 2367 | 969 !qxestrncmp_ascii (XSTRING_DATA (name), kludge_prefix, |
| 793 | 970 sizeof (kludge_prefix) - 1)); |
| 428 | 971 # undef kludge_prefix |
| 972 } | |
| 973 #else | |
| 974 # define kludgily_ignore_lost_doc_p(sym) 0 | |
| 975 #endif | |
| 976 | |
| 977 | |
| 978 static int | |
| 979 verify_doc_mapper (Lisp_Object sym, void *arg) | |
| 980 { | |
| 793 | 981 Lisp_Object closure = * (Lisp_Object *) arg; |
| 428 | 982 |
| 983 if (!NILP (Ffboundp (sym))) | |
| 984 { | |
| 985 int doc = 0; | |
| 986 Lisp_Object fun = XSYMBOL (sym)->function; | |
| 987 if (CONSP (fun) && | |
| 988 EQ (XCAR (fun), Qmacro)) | |
| 989 fun = XCDR (fun); | |
| 990 | |
| 991 if (SUBRP (fun)) | |
| 992 doc = (EMACS_INT) XSUBR (fun)->doc; | |
| 993 else if (SYMBOLP (fun)) | |
| 994 doc = -1; | |
| 995 else if (KEYMAPP (fun)) | |
| 996 doc = -1; | |
| 997 else if (CONSP (fun)) | |
| 998 { | |
| 999 Lisp_Object tem = XCAR (fun); | |
| 1000 if (EQ (tem, Qlambda) || EQ (tem, Qautoload)) | |
| 1001 { | |
| 1002 doc = -1; | |
| 1003 tem = Fcdr (Fcdr (fun)); | |
| 1004 if (CONSP (tem) && | |
| 1005 INTP (XCAR (tem))) | |
| 1006 doc = XINT (XCAR (tem)); | |
| 1007 } | |
| 1008 } | |
| 1009 else if (COMPILED_FUNCTIONP (fun)) | |
| 1010 { | |
| 440 | 1011 Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (fun); |
| 428 | 1012 if (! (f->flags.documentationp)) |
| 1013 doc = -1; | |
| 1014 else | |
| 1015 { | |
| 1016 Lisp_Object tem = compiled_function_documentation (f); | |
| 1017 if (INTP (tem)) | |
| 1018 doc = XINT (tem); | |
| 1019 } | |
| 1020 } | |
| 1021 | |
| 1022 if (doc == 0 && !kludgily_ignore_lost_doc_p (sym)) | |
| 1023 { | |
| 1024 message ("Warning: doc lost for function %s.", | |
| 793 | 1025 XSTRING_DATA (XSYMBOL (sym)->name)); |
| 428 | 1026 XCDR (closure) = Qt; |
| 1027 } | |
| 1028 } | |
| 1029 if (!NILP (Fboundp (sym))) | |
| 1030 { | |
| 1031 Lisp_Object doc = Fget (sym, Qvariable_documentation, Qnil); | |
| 1032 if (ZEROP (doc)) | |
| 1033 { | |
| 1034 message ("Warning: doc lost for variable %s.", | |
| 793 | 1035 XSTRING_DATA (XSYMBOL (sym)->name)); |
| 428 | 1036 XCDR (closure) = Qt; |
| 1037 } | |
| 1038 } | |
| 1039 return 0; /* Never stop */ | |
| 1040 } | |
| 1041 | |
| 1042 DEFUN ("Verify-documentation", Fverify_documentation, 0, 0, 0, /* | |
| 1043 Used to make sure everything went well with Snarf-documentation. | |
| 1044 Writes to stderr if not. | |
| 1045 */ | |
| 1046 ()) | |
| 1047 { | |
| 1048 Lisp_Object closure = Fcons (Qnil, Qnil); | |
| 1049 struct gcpro gcpro1; | |
| 1050 GCPRO1 (closure); | |
| 1051 map_obarray (Vobarray, verify_doc_mapper, &closure); | |
| 1052 if (!NILP (Fcdr (closure))) | |
| 1053 message ("\n" | |
| 1054 "This is usually because some files were preloaded by loaddefs.el or\n" | |
| 1055 "site-load.el, but were not passed to make-docfile by Makefile.\n"); | |
| 1056 UNGCPRO; | |
| 1057 return NILP (Fcdr (closure)) ? Qt : Qnil; | |
| 1058 } | |
| 1059 | |
| 1060 | |
| 1061 DEFUN ("substitute-command-keys", Fsubstitute_command_keys, 1, 1, 0, /* | |
| 1062 Substitute key descriptions for command names in STRING. | |
| 1063 Return a new string which is STRING with substrings of the form \\=\\[COMMAND] | |
| 1064 replaced by either: a keystroke sequence that will invoke COMMAND, | |
| 1065 or "M-x COMMAND" if COMMAND is not on any keys. | |
| 1066 Substrings of the form \\=\\{MAPVAR} are replaced by summaries | |
| 444 | 1067 \(made by `describe-bindings') of the value of MAPVAR, taken as a keymap. |
| 428 | 1068 Substrings of the form \\=\\<MAPVAR> specify to use the value of MAPVAR |
| 1069 as the keymap for future \\=\\[COMMAND] substrings. | |
| 1070 \\=\\= quotes the following character and is discarded; | |
| 1071 thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ into the output. | |
| 1072 */ | |
| 444 | 1073 (string)) |
| 428 | 1074 { |
| 1075 /* This function can GC */ | |
| 867 | 1076 Ibyte *buf; |
| 428 | 1077 int changed = 0; |
| 867 | 1078 REGISTER Ibyte *strdata; |
| 1079 REGISTER Ibyte *bufp; | |
| 428 | 1080 Bytecount strlength; |
| 1081 Bytecount idx; | |
| 1082 Bytecount bsize; | |
| 3025 | 1083 Ibyte *new_; |
| 444 | 1084 Lisp_Object tem = Qnil; |
| 1085 Lisp_Object keymap = Qnil; | |
| 1086 Lisp_Object name = Qnil; | |
| 867 | 1087 Ibyte *start; |
| 428 | 1088 Bytecount length; |
| 1089 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; | |
| 1090 | |
| 444 | 1091 if (NILP (string)) |
| 428 | 1092 return Qnil; |
| 1093 | |
| 444 | 1094 CHECK_STRING (string); |
| 1095 GCPRO4 (string, tem, keymap, name); | |
| 428 | 1096 |
| 1097 /* There is the possibility that the string is not destined for a | |
| 1098 translating stream, and it could be argued that we should do the | |
| 1099 same thing here as in Fformat(), but there are very few times | |
| 1100 when this will be the case and many calls to this function | |
| 1101 would have to have `gettext' calls added. (I18N3) */ | |
| 444 | 1102 string = LISP_GETTEXT (string); |
| 428 | 1103 |
| 1104 /* KEYMAP is either nil (which means search all the active keymaps) | |
| 1105 or a specified local map (which means search just that and the | |
| 1106 global map). If non-nil, it might come from Voverriding_local_map, | |
| 444 | 1107 or from a \\<mapname> construct in STRING itself.. */ |
| 428 | 1108 #if 0 /* FSFmacs */ |
| 1109 /* This is really weird and garbagey. If keymap is nil and there's | |
| 1110 an overriding-local-map, `where-is-internal' will correctly note | |
| 1111 this, so there's no reason to do it here. Maybe FSFmacs | |
| 1112 `where-is-internal' is broken. */ | |
| 1113 /* | |
| 1114 keymap = current_kboard->Voverriding_terminal_local_map; | |
| 1115 if (NILP (keymap)) | |
| 1116 keymap = Voverriding_local_map; | |
| 1117 */ | |
| 1118 #endif | |
| 1119 | |
| 444 | 1120 strlength = XSTRING_LENGTH (string); |
| 2367 | 1121 bsize = ITEXT_ZTERM_SIZE + strlength; |
| 1122 buf = xnew_ibytes (bsize); | |
| 428 | 1123 bufp = buf; |
| 1124 | |
| 1125 /* Have to reset strdata every time GC might be called */ | |
| 444 | 1126 strdata = XSTRING_DATA (string); |
| 428 | 1127 for (idx = 0; idx < strlength; ) |
| 1128 { | |
| 867 | 1129 Ibyte *strp = strdata + idx; |
| 428 | 1130 |
| 1131 if (strp[0] != '\\') | |
| 1132 { | |
| 1133 /* just copy other chars */ | |
| 1134 /* As it happens, this will work with Mule even if the | |
| 1135 character quoted is multi-byte; the remaining multi-byte | |
| 1136 characters will just be copied by this loop. */ | |
| 1137 *bufp++ = *strp; | |
| 1138 idx++; | |
| 1139 } | |
| 1140 else switch (strp[1]) | |
| 1141 { | |
| 1142 default: | |
| 1143 { | |
| 1144 /* just copy unknown escape sequences */ | |
| 1145 *bufp++ = *strp; | |
| 1146 idx++; | |
| 1147 break; | |
| 1148 } | |
| 1149 case '=': | |
| 1150 { | |
| 1151 /* \= quotes the next character; | |
| 1152 thus, to put in \[ without its special meaning, use \=\[. */ | |
| 1153 /* As it happens, this will work with Mule even if the | |
| 1154 character quoted is multi-byte; the remaining multi-byte | |
| 1155 characters will just be copied by this loop. */ | |
| 1156 changed = 1; | |
| 1157 *bufp++ = strp[2]; | |
| 1158 idx += 3; | |
| 1159 break; | |
| 1160 } | |
| 1161 case '[': | |
| 1162 { | |
| 1163 changed = 1; | |
| 1164 idx += 2; /* skip \[ */ | |
| 1165 strp += 2; | |
| 1166 start = strp; | |
| 1167 | |
| 1168 while ((idx < strlength) | |
| 1169 && *strp != ']') | |
| 1170 { | |
| 1171 strp++; | |
| 1172 idx++; | |
| 1173 } | |
| 1174 length = strp - start; | |
| 1175 idx++; /* skip ] */ | |
| 1176 | |
| 1177 tem = Fintern (make_string (start, length), Qnil); | |
| 1178 tem = Fwhere_is_internal (tem, keymap, Qt, Qnil, Qnil); | |
| 1179 | |
| 1180 #if 0 /* FSFmacs */ | |
| 444 | 1181 /* Disregard menu bar bindings; it is positively annoying to |
| 1182 mention them when there's no menu bar, and it isn't terribly | |
| 1183 useful even when there is a menu bar. */ | |
| 1184 if (!NILP (tem)) | |
| 1185 { | |
| 1186 firstkey = Faref (tem, Qzero); | |
| 1187 if (EQ (firstkey, Qmenu_bar)) | |
| 1188 tem = Qnil; | |
| 1189 } | |
| 428 | 1190 #endif |
| 1191 | |
| 1192 if (NILP (tem)) /* but not on any keys */ | |
| 1193 { | |
| 3025 | 1194 new_ = (Ibyte *) xrealloc (buf, bsize += 4); |
| 1195 bufp += new_ - buf; | |
| 1196 buf = new_; | |
| 428 | 1197 memcpy (bufp, "M-x ", 4); |
| 1198 bufp += 4; | |
| 1199 goto subst; | |
| 1200 } | |
| 1201 else | |
| 1202 { /* function is on a key */ | |
| 1203 tem = Fkey_description (tem); | |
| 1204 goto subst_string; | |
| 1205 } | |
| 1206 } | |
| 1207 case '{': | |
| 1208 case '<': | |
| 1209 { | |
| 444 | 1210 Lisp_Object buffer = Fget_buffer_create (QSsubstitute); |
| 1211 struct buffer *buf_ = XBUFFER (buffer); | |
| 428 | 1212 |
| 1213 Fbuffer_disable_undo (buffer); | |
| 1214 Ferase_buffer (buffer); | |
| 1215 | |
| 1216 /* \{foo} is replaced with a summary of keymap (symbol-value foo). | |
| 1217 \<foo> just sets the keymap used for \[cmd]. */ | |
| 1218 changed = 1; | |
| 1219 idx += 2; /* skip \{ or \< */ | |
| 1220 strp += 2; | |
| 1221 start = strp; | |
| 1222 | |
| 1223 while ((idx < strlength) | |
| 1224 && *strp != '}' && *strp != '>') | |
| 1225 { | |
| 1226 strp++; | |
| 1227 idx++; | |
| 1228 } | |
| 1229 length = strp - start; | |
| 1230 idx++; /* skip } or > */ | |
| 1231 | |
| 1232 /* Get the value of the keymap in TEM, or nil if undefined. | |
| 1233 Do this while still in the user's current buffer | |
| 1234 in case it is a local variable. */ | |
| 1235 name = Fintern (make_string (start, length), Qnil); | |
| 1236 tem = Fboundp (name); | |
| 1237 if (! NILP (tem)) | |
| 1238 { | |
| 1239 tem = Fsymbol_value (name); | |
| 1240 if (! NILP (tem)) | |
| 1241 tem = get_keymap (tem, 0, 1); | |
| 1242 } | |
| 1243 | |
| 1244 if (NILP (tem)) | |
| 1245 { | |
| 444 | 1246 buffer_insert_c_string (buf_, "(uses keymap \""); |
| 1247 buffer_insert_lisp_string (buf_, Fsymbol_name (name)); | |
| 1248 buffer_insert_c_string (buf_, "\", which is not currently defined) "); | |
| 428 | 1249 |
| 1250 if (start[-1] == '<') keymap = Qnil; | |
| 1251 } | |
| 1252 else if (start[-1] == '<') | |
| 1253 keymap = tem; | |
| 1254 else | |
| 1255 describe_map_tree (tem, 1, Qnil, Qnil, 0, buffer); | |
| 1256 | |
| 1257 tem = make_string_from_buffer (buf_, BUF_BEG (buf_), | |
| 1258 BUF_Z (buf_) - BUF_BEG (buf_)); | |
| 1259 Ferase_buffer (buffer); | |
| 444 | 1260 } |
| 1261 goto subst_string; | |
| 428 | 1262 |
| 444 | 1263 subst_string: |
| 1264 start = XSTRING_DATA (tem); | |
| 1265 length = XSTRING_LENGTH (tem); | |
| 1266 subst: | |
| 1267 bsize += length; | |
| 3025 | 1268 new_ = (Ibyte *) xrealloc (buf, bsize); |
| 1269 bufp += new_ - buf; | |
| 1270 buf = new_; | |
| 444 | 1271 memcpy (bufp, start, length); |
| 1272 bufp += length; | |
| 428 | 1273 |
| 444 | 1274 /* Reset STRDATA in case gc relocated it. */ |
| 1275 strdata = XSTRING_DATA (string); | |
| 428 | 1276 |
| 444 | 1277 break; |
| 428 | 1278 } |
| 1279 } | |
| 1280 | |
| 1281 if (changed) /* don't bother if nothing substituted */ | |
| 1282 tem = make_string (buf, bufp - buf); | |
| 1283 else | |
| 444 | 1284 tem = string; |
| 1726 | 1285 xfree (buf, Ibyte *); |
| 428 | 1286 UNGCPRO; |
| 1287 return tem; | |
| 1288 } | |
| 1289 | |
| 1290 | |
| 1291 /************************************************************************/ | |
| 1292 /* initialization */ | |
| 1293 /************************************************************************/ | |
| 1294 | |
| 1295 void | |
| 1296 syms_of_doc (void) | |
| 1297 { | |
| 3368 | 1298 DEFSUBR (Fbuilt_in_symbol_file); |
| 428 | 1299 DEFSUBR (Fdocumentation); |
| 1300 DEFSUBR (Fdocumentation_property); | |
| 1301 DEFSUBR (Fsnarf_documentation); | |
| 1302 DEFSUBR (Fverify_documentation); | |
| 1303 DEFSUBR (Fsubstitute_command_keys); | |
|
4367
69e6352406f0
Handle macros, autoloads correctly in symbol-file. Add an incomplete TYPE arg.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3548
diff
changeset
|
1304 |
|
69e6352406f0
Handle macros, autoloads correctly in symbol-file. Add an incomplete TYPE arg.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3548
diff
changeset
|
1305 DEFSYMBOL (Qdefvar); |
| 428 | 1306 } |
| 1307 | |
| 1308 void | |
| 1309 vars_of_doc (void) | |
| 1310 { | |
| 1311 DEFVAR_LISP ("internal-doc-file-name", &Vinternal_doc_file_name /* | |
| 1312 Name of file containing documentation strings of built-in symbols. | |
| 1313 */ ); | |
| 1314 Vinternal_doc_file_name = Qnil; | |
| 1315 | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4539
diff
changeset
|
1316 QSsubstitute = build_ascstring (" *substitute*"); |
| 428 | 1317 staticpro (&QSsubstitute); |
| 1318 } |