Mercurial > hg > xemacs-beta
annotate lisp/next-error.el @ 5127:a9c41067dd88 ben-lisp-object
more cleanups, terminology clarification, lots of doc work
-------------------- ChangeLog entries follow: --------------------
man/ChangeLog addition:
2010-03-05 Ben Wing <ben@xemacs.org>
* internals/internals.texi (Introduction to Allocation):
* internals/internals.texi (Integers and Characters):
* internals/internals.texi (Allocation from Frob Blocks):
* internals/internals.texi (lrecords):
* internals/internals.texi (Low-level allocation):
Rewrite section on allocation of Lisp objects to reflect the new
reality. Remove references to nonexistent XSETINT and XSETCHAR.
modules/ChangeLog addition:
2010-03-05 Ben Wing <ben@xemacs.org>
* postgresql/postgresql.c (allocate_pgconn):
* postgresql/postgresql.c (allocate_pgresult):
* postgresql/postgresql.h (struct Lisp_PGconn):
* postgresql/postgresql.h (struct Lisp_PGresult):
* ldap/eldap.c (allocate_ldap):
* ldap/eldap.h (struct Lisp_LDAP):
Same changes as in src/ dir. See large log there in ChangeLog,
but basically:
ALLOC_LISP_OBJECT -> ALLOC_NORMAL_LISP_OBJECT
LISP_OBJECT_HEADER -> NORMAL_LISP_OBJECT_HEADER
../hlo/src/ChangeLog addition:
2010-03-05 Ben Wing <ben@xemacs.org>
* alloc.c:
* alloc.c (old_alloc_sized_lcrecord):
* alloc.c (very_old_free_lcrecord):
* alloc.c (copy_lisp_object):
* alloc.c (zero_sized_lisp_object):
* alloc.c (zero_nonsized_lisp_object):
* alloc.c (lisp_object_storage_size):
* alloc.c (free_normal_lisp_object):
* alloc.c (FREE_FIXED_TYPE_WHEN_NOT_IN_GC):
* alloc.c (ALLOC_FROB_BLOCK_LISP_OBJECT):
* alloc.c (Fcons):
* alloc.c (noseeum_cons):
* alloc.c (make_float):
* alloc.c (make_bignum):
* alloc.c (make_bignum_bg):
* alloc.c (make_ratio):
* alloc.c (make_ratio_bg):
* alloc.c (make_ratio_rt):
* alloc.c (make_bigfloat):
* alloc.c (make_bigfloat_bf):
* alloc.c (size_vector):
* alloc.c (make_compiled_function):
* alloc.c (Fmake_symbol):
* alloc.c (allocate_extent):
* alloc.c (allocate_event):
* alloc.c (make_key_data):
* alloc.c (make_button_data):
* alloc.c (make_motion_data):
* alloc.c (make_process_data):
* alloc.c (make_timeout_data):
* alloc.c (make_magic_data):
* alloc.c (make_magic_eval_data):
* alloc.c (make_eval_data):
* alloc.c (make_misc_user_data):
* alloc.c (Fmake_marker):
* alloc.c (noseeum_make_marker):
* alloc.c (size_string_direct_data):
* alloc.c (make_uninit_string):
* alloc.c (make_string_nocopy):
* alloc.c (mark_lcrecord_list):
* alloc.c (alloc_managed_lcrecord):
* alloc.c (free_managed_lcrecord):
* alloc.c (sweep_lcrecords_1):
* alloc.c (malloced_storage_size):
* buffer.c (allocate_buffer):
* buffer.c (compute_buffer_usage):
* buffer.c (DEFVAR_BUFFER_LOCAL_1):
* buffer.c (nuke_all_buffer_slots):
* buffer.c (common_init_complex_vars_of_buffer):
* buffer.h (struct buffer_text):
* buffer.h (struct buffer):
* bytecode.c:
* bytecode.c (make_compiled_function_args):
* bytecode.c (size_compiled_function_args):
* bytecode.h (struct compiled_function_args):
* casetab.c (allocate_case_table):
* casetab.h (struct Lisp_Case_Table):
* charset.h (struct Lisp_Charset):
* chartab.c (fill_char_table):
* chartab.c (Fmake_char_table):
* chartab.c (make_char_table_entry):
* chartab.c (copy_char_table_entry):
* chartab.c (Fcopy_char_table):
* chartab.c (put_char_table):
* chartab.h (struct Lisp_Char_Table_Entry):
* chartab.h (struct Lisp_Char_Table):
* console-gtk-impl.h (struct gtk_device):
* console-gtk-impl.h (struct gtk_frame):
* console-impl.h (struct console):
* console-msw-impl.h (struct Lisp_Devmode):
* console-msw-impl.h (struct mswindows_device):
* console-msw-impl.h (struct msprinter_device):
* console-msw-impl.h (struct mswindows_frame):
* console-msw-impl.h (struct mswindows_dialog_id):
* console-stream-impl.h (struct stream_console):
* console-stream.c (stream_init_console):
* console-tty-impl.h (struct tty_console):
* console-tty-impl.h (struct tty_device):
* console-tty.c (allocate_tty_console_struct):
* console-x-impl.h (struct x_device):
* console-x-impl.h (struct x_frame):
* console.c (allocate_console):
* console.c (nuke_all_console_slots):
* console.c (DEFVAR_CONSOLE_LOCAL_1):
* console.c (common_init_complex_vars_of_console):
* data.c (make_weak_list):
* data.c (make_weak_box):
* data.c (make_ephemeron):
* database.c:
* database.c (struct Lisp_Database):
* database.c (allocate_database):
* database.c (finalize_database):
* device-gtk.c (allocate_gtk_device_struct):
* device-impl.h (struct device):
* device-msw.c:
* device-msw.c (mswindows_init_device):
* device-msw.c (msprinter_init_device):
* device-msw.c (finalize_devmode):
* device-msw.c (allocate_devmode):
* device-tty.c (allocate_tty_device_struct):
* device-x.c (allocate_x_device_struct):
* device.c:
* device.c (nuke_all_device_slots):
* device.c (allocate_device):
* dialog-msw.c (handle_question_dialog_box):
* elhash.c:
* elhash.c (struct Lisp_Hash_Table):
* elhash.c (finalize_hash_table):
* elhash.c (make_general_lisp_hash_table):
* elhash.c (Fcopy_hash_table):
* elhash.h (htentry):
* emacs.c (main_1):
* eval.c:
* eval.c (size_multiple_value):
* event-stream.c (finalize_command_builder):
* event-stream.c (allocate_command_builder):
* event-stream.c (free_command_builder):
* event-stream.c (event_stream_generate_wakeup):
* event-stream.c (event_stream_resignal_wakeup):
* event-stream.c (event_stream_disable_wakeup):
* event-stream.c (event_stream_wakeup_pending_p):
* events.h (struct Lisp_Timeout):
* events.h (struct command_builder):
* extents-impl.h:
* extents-impl.h (struct extent_auxiliary):
* extents-impl.h (struct extent_info):
* extents-impl.h (set_extent_no_chase_aux_field):
* extents-impl.h (set_extent_no_chase_normal_field):
* extents.c:
* extents.c (gap_array_marker):
* extents.c (gap_array):
* extents.c (extent_list_marker):
* extents.c (extent_list):
* extents.c (stack_of_extents):
* extents.c (gap_array_make_marker):
* extents.c (extent_list_make_marker):
* extents.c (allocate_extent_list):
* extents.c (SLOT):
* extents.c (mark_extent_auxiliary):
* extents.c (allocate_extent_auxiliary):
* extents.c (attach_extent_auxiliary):
* extents.c (size_gap_array):
* extents.c (finalize_extent_info):
* extents.c (allocate_extent_info):
* extents.c (uninit_buffer_extents):
* extents.c (allocate_soe):
* extents.c (copy_extent):
* extents.c (vars_of_extents):
* extents.h:
* faces.c (allocate_face):
* faces.h (struct Lisp_Face):
* faces.h (struct face_cachel):
* file-coding.c:
* file-coding.c (finalize_coding_system):
* file-coding.c (sizeof_coding_system):
* file-coding.c (Fcopy_coding_system):
* file-coding.h (struct Lisp_Coding_System):
* file-coding.h (MARKED_SLOT):
* fns.c (size_bit_vector):
* font-mgr.c:
* font-mgr.c (finalize_fc_pattern):
* font-mgr.c (print_fc_pattern):
* font-mgr.c (Ffc_pattern_p):
* font-mgr.c (Ffc_pattern_create):
* font-mgr.c (Ffc_name_parse):
* font-mgr.c (Ffc_name_unparse):
* font-mgr.c (Ffc_pattern_duplicate):
* font-mgr.c (Ffc_pattern_add):
* font-mgr.c (Ffc_pattern_del):
* font-mgr.c (Ffc_pattern_get):
* font-mgr.c (fc_config_create_using):
* font-mgr.c (fc_strlist_to_lisp_using):
* font-mgr.c (fontset_to_list):
* font-mgr.c (Ffc_config_p):
* font-mgr.c (Ffc_config_up_to_date):
* font-mgr.c (Ffc_config_build_fonts):
* font-mgr.c (Ffc_config_get_cache):
* font-mgr.c (Ffc_config_get_fonts):
* font-mgr.c (Ffc_config_set_current):
* font-mgr.c (Ffc_config_get_blanks):
* font-mgr.c (Ffc_config_get_rescan_interval):
* font-mgr.c (Ffc_config_set_rescan_interval):
* font-mgr.c (Ffc_config_app_font_add_file):
* font-mgr.c (Ffc_config_app_font_add_dir):
* font-mgr.c (Ffc_config_app_font_clear):
* font-mgr.c (size):
* font-mgr.c (Ffc_config_substitute):
* font-mgr.c (Ffc_font_render_prepare):
* font-mgr.c (Ffc_font_match):
* font-mgr.c (Ffc_font_sort):
* font-mgr.c (finalize_fc_config):
* font-mgr.c (print_fc_config):
* font-mgr.h:
* font-mgr.h (struct fc_pattern):
* font-mgr.h (XFC_PATTERN):
* font-mgr.h (struct fc_config):
* font-mgr.h (XFC_CONFIG):
* frame-gtk.c (allocate_gtk_frame_struct):
* frame-impl.h (struct frame):
* frame-msw.c (mswindows_init_frame_1):
* frame-x.c (allocate_x_frame_struct):
* frame.c (nuke_all_frame_slots):
* frame.c (allocate_frame_core):
* gc.c:
* gc.c (GC_CHECK_NOT_FREE):
* glyphs.c (finalize_image_instance):
* glyphs.c (allocate_image_instance):
* glyphs.c (Fcolorize_image_instance):
* glyphs.c (allocate_glyph):
* glyphs.c (unmap_subwindow_instance_cache_mapper):
* glyphs.c (register_ignored_expose):
* glyphs.h (struct Lisp_Image_Instance):
* glyphs.h (struct Lisp_Glyph):
* glyphs.h (struct glyph_cachel):
* glyphs.h (struct expose_ignore):
* gui.c (allocate_gui_item):
* gui.h (struct Lisp_Gui_Item):
* keymap.c (struct Lisp_Keymap):
* keymap.c (make_keymap):
* lisp.h:
* lisp.h (struct Lisp_String_Direct_Data):
* lisp.h (struct Lisp_String_Indirect_Data):
* lisp.h (struct Lisp_Vector):
* lisp.h (struct Lisp_Bit_Vector):
* lisp.h (DECLARE_INLINE_LISP_BIT_VECTOR):
* lisp.h (struct weak_box):
* lisp.h (struct ephemeron):
* lisp.h (struct weak_list):
* lrecord.h:
* lrecord.h (struct lrecord_implementation):
* lrecord.h (MC_ALLOC_CALL_FINALIZER):
* lrecord.h (struct lcrecord_list):
* lstream.c (finalize_lstream):
* lstream.c (sizeof_lstream):
* lstream.c (Lstream_new):
* lstream.c (Lstream_delete):
* lstream.h (struct lstream):
* marker.c:
* marker.c (finalize_marker):
* marker.c (compute_buffer_marker_usage):
* mule-charset.c:
* mule-charset.c (make_charset):
* mule-charset.c (compute_charset_usage):
* objects-impl.h (struct Lisp_Color_Instance):
* objects-impl.h (struct Lisp_Font_Instance):
* objects-tty-impl.h (struct tty_color_instance_data):
* objects-tty-impl.h (struct tty_font_instance_data):
* objects-tty.c (tty_initialize_color_instance):
* objects-tty.c (tty_initialize_font_instance):
* objects.c (finalize_color_instance):
* objects.c (Fmake_color_instance):
* objects.c (finalize_font_instance):
* objects.c (Fmake_font_instance):
* objects.c (reinit_vars_of_objects):
* opaque.c:
* opaque.c (sizeof_opaque):
* opaque.c (make_opaque_ptr):
* opaque.c (free_opaque_ptr):
* opaque.h:
* opaque.h (Lisp_Opaque):
* opaque.h (Lisp_Opaque_Ptr):
* print.c (printing_unreadable_lcrecord):
* print.c (external_object_printer):
* print.c (debug_p4):
* process.c (finalize_process):
* process.c (make_process_internal):
* procimpl.h (struct Lisp_Process):
* rangetab.c (Fmake_range_table):
* rangetab.c (Fcopy_range_table):
* rangetab.h (struct Lisp_Range_Table):
* scrollbar.c:
* scrollbar.c (create_scrollbar_instance):
* scrollbar.c (compute_scrollbar_instance_usage):
* scrollbar.h (struct scrollbar_instance):
* specifier.c (finalize_specifier):
* specifier.c (sizeof_specifier):
* specifier.c (set_specifier_caching):
* specifier.h (struct Lisp_Specifier):
* specifier.h (struct specifier_caching):
* symeval.h:
* symeval.h (SYMBOL_VALUE_MAGIC_P):
* symeval.h (DEFVAR_SYMVAL_FWD):
* symsinit.h:
* syntax.c (init_buffer_syntax_cache):
* syntax.h (struct syntax_cache):
* toolbar.c:
* toolbar.c (allocate_toolbar_button):
* toolbar.c (update_toolbar_button):
* toolbar.h (struct toolbar_button):
* tooltalk.c (struct Lisp_Tooltalk_Message):
* tooltalk.c (make_tooltalk_message):
* tooltalk.c (struct Lisp_Tooltalk_Pattern):
* tooltalk.c (make_tooltalk_pattern):
* ui-gtk.c:
* ui-gtk.c (allocate_ffi_data):
* ui-gtk.c (emacs_gtk_object_finalizer):
* ui-gtk.c (allocate_emacs_gtk_object_data):
* ui-gtk.c (allocate_emacs_gtk_boxed_data):
* ui-gtk.h:
* window-impl.h (struct window):
* window-impl.h (struct window_mirror):
* window.c (finalize_window):
* window.c (allocate_window):
* window.c (new_window_mirror):
* window.c (mark_window_as_deleted):
* window.c (make_dummy_parent):
* window.c (compute_window_mirror_usage):
* window.c (compute_window_usage):
Overall point of this change and previous ones in this repository:
(1) Introduce new, clearer terminology: everything other than int
or char is a "record" object, which comes in two types: "normal
objects" and "frob-block objects". Fix up all places that
referred to frob-block objects as "simple", "basic", etc.
(2) Provide an advertised interface for doing operations on Lisp
objects, including creating new types, that is clean and
consistent in its naming, uses the above-referenced terms and
avoids referencing "lrecords", "old lcrecords", etc., which should
hide under the surface.
(3) Make the size_in_bytes and finalizer methods take a
Lisp_Object rather than a void * for consistency with other methods.
(4) Separate finalizer method into finalizer and disksaver, so
that normal finalize methods don't have to worry about disksaving.
Other specifics:
(1) Renaming:
LISP_OBJECT_HEADER -> NORMAL_LISP_OBJECT_HEADER
ALLOC_LISP_OBJECT -> ALLOC_NORMAL_LISP_OBJECT
implementation->basic_p -> implementation->frob_block_p
ALLOCATE_FIXED_TYPE_AND_SET_IMPL -> ALLOC_FROB_BLOCK_LISP_OBJECT
*FCCONFIG*, wrap_fcconfig -> *FC_CONFIG*, wrap_fc_config
*FCPATTERN*, wrap_fcpattern -> *FC_PATTERN*, wrap_fc_pattern
(the last two changes make the naming of these macros consistent
with the naming of all other macros, since the objects are named
fc-config and fc-pattern with a hyphen)
(2) Lots of documentation fixes in lrecord.h.
(3) Eliminate macros for copying, freeing, zeroing objects, getting
their storage size. Instead, new functions:
zero_sized_lisp_object()
zero_nonsized_lisp_object()
lisp_object_storage_size()
free_normal_lisp_object()
(copy_lisp_object() already exists)
LISP_OBJECT_FROB_BLOCK_P() (actually a macro)
Eliminated:
free_lrecord()
zero_lrecord()
copy_lrecord()
copy_sized_lrecord()
old_copy_lcrecord()
old_copy_sized_lcrecord()
old_zero_lcrecord()
old_zero_sized_lcrecord()
LISP_OBJECT_STORAGE_SIZE()
COPY_SIZED_LISP_OBJECT()
COPY_SIZED_LCRECORD()
COPY_LISP_OBJECT()
ZERO_LISP_OBJECT()
FREE_LISP_OBJECT()
(4) Catch the remaining places where lrecord stuff was used directly
and use the advertised interface, e.g. alloc_sized_lrecord() ->
ALLOC_SIZED_LISP_OBJECT().
(5) Make certain statically-declared pseudo-objects
(buffer_local_flags, console_local_flags) have their lheader
initialized correctly, so things like copy_lisp_object() can work
on them. Make extent_auxiliary_defaults a proper heap object
Vextent_auxiliary_defaults, and make extent auxiliaries dumpable
so that this object can be dumped. allocate_extent_auxiliary()
now just creates the object, and attach_extent_auxiliary()
creates an extent auxiliary and attaches to an extent, like the
old allocate_extent_auxiliary().
(6) Create EXTENT_AUXILIARY_SLOTS macro, similar to the foo-slots.h
files but in a macro instead of a file. The purpose is to avoid
duplication when iterating over all the slots in an extent auxiliary.
Use it.
(7) In lstream.c, don't zero out object after allocation because
allocation routines take care of this.
(8) In marker.c, fix a mistake in computing marker overhead.
(9) In print.c, clean up printing_unreadable_lcrecord(),
external_object_printer() to avoid lots of ifdef NEW_GC's.
(10) Separate toolbar-button allocation into a separate
allocate_toolbar_button() function for use in the example code
in lrecord.h.
| author | Ben Wing <ben@xemacs.org> |
|---|---|
| date | Fri, 05 Mar 2010 04:08:17 -0600 |
| parents | b593e47979a5 |
| children | 308d34e9f07d |
| rev | line source |
|---|---|
| 3000 | 1 ;;; next-error.el --- Next error support framework |
| 2 | |
| 3 ;; Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1996, 1997, 1998, 1999, | |
| 4 ;; 2000, 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc. | |
| 5 | |
| 6 ;; Maintainer: XEmacs Development Team | |
| 7 ;; Keywords: internal | |
| 8 | |
| 9 ;; This file is part of XEmacs. | |
| 10 | |
| 11 ;; XEmacs is free software; you can redistribute it and/or modify | |
| 12 ;; it under the terms of the GNU General Public License as published by | |
| 13 ;; the Free Software Foundation; either version 2, or (at your option) | |
| 14 ;; any later version. | |
| 15 | |
| 16 ;; XEmacs is distributed in the hope that it will be useful, | |
| 17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
| 18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
| 19 ;; GNU General Public License for more details. | |
| 20 | |
| 21 ;; You should have received a copy of the GNU General Public License | |
| 22 ;; along with XEmacs; see the file COPYING. If not, write to the | |
| 23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, | |
| 24 ;; Boston, MA 02110-1301, USA. | |
| 25 | |
| 26 ;;; Synched up with: FSF 22.0.50.1 (CVS) | |
| 3299 | 27 ;;; Some functions renamed with the next-error-framework prefix to avoid |
| 28 ;;; clashes with the next-error code in compile.el. One day compile.el | |
| 29 ;;; will use this framework. | |
| 3000 | 30 |
| 31 (defgroup next-error nil | |
| 32 "`next-error' support framework." | |
| 33 :group 'compilation | |
| 34 :version "22.1") | |
| 35 | |
| 36 (defface next-error | |
| 37 '((t (:inherit region))) | |
| 38 "Face used to highlight next error locus." | |
| 39 :group 'next-error | |
| 40 :version "22.1") | |
| 41 | |
| 42 (defcustom next-error-highlight 0.1 | |
| 43 "*Highlighting of locations in selected source buffers. | |
| 44 If number, highlight the locus in `next-error' face for given time in seconds. | |
| 45 If t, use persistent overlays fontified in `next-error' face. | |
| 46 If nil, don't highlight the locus in the source buffer. | |
| 47 If `fringe-arrow', indicate the locus by the fringe arrow." | |
| 48 :type '(choice (number :tag "Delay") | |
| 49 (const :tag "Persistent overlay" t) | |
| 50 (const :tag "No highlighting" nil) | |
| 51 (const :tag "Fringe arrow" 'fringe-arrow)) | |
| 52 :group 'next-error | |
| 53 :version "22.1") | |
| 54 | |
| 55 (defcustom next-error-highlight-no-select 0.1 | |
| 56 "*Highlighting of locations in non-selected source buffers. | |
| 57 If number, highlight the locus in `next-error' face for given time in seconds. | |
| 58 If t, use persistent overlays fontified in `next-error' face. | |
| 59 If nil, don't highlight the locus in the source buffer. | |
| 60 If `fringe-arrow', indicate the locus by the fringe arrow." | |
| 61 :type '(choice (number :tag "Delay") | |
| 62 (const :tag "Persistent overlay" t) | |
| 63 (const :tag "No highlighting" nil) | |
| 64 (const :tag "Fringe arrow" 'fringe-arrow)) | |
| 65 :group 'next-error | |
| 66 :version "22.1") | |
| 67 | |
| 68 (defcustom next-error-hook nil | |
| 69 "*List of hook functions run by `next-error' after visiting source file." | |
| 70 :type 'hook | |
| 71 :group 'next-error) | |
| 72 | |
| 73 (defvar next-error-highlight-timer nil) | |
| 74 | |
| 75 ;(defvar next-error-overlay-arrow-position nil) | |
| 76 ;(put 'next-error-overlay-arrow-position 'overlay-arrow-string "=>") | |
| 77 ;(add-to-list 'overlay-arrow-variable-list 'next-error-overlay-arrow-position) | |
| 78 | |
| 79 (defvar next-error-last-buffer nil | |
| 80 "The most recent `next-error' buffer. | |
| 81 A buffer becomes most recent when its compilation, grep, or | |
| 82 similar mode is started, or when it is used with \\[next-error] | |
| 83 or \\[compile-goto-error].") | |
| 84 | |
| 85 (defvar next-error-function nil | |
| 86 "Function to use to find the next error in the current buffer. | |
| 87 The function is called with 2 parameters: | |
| 88 ARG is an integer specifying by how many errors to move. | |
| 89 RESET is a boolean which, if non-nil, says to go back to the beginning | |
| 90 of the errors before moving. | |
| 91 Major modes providing compile-like functionality should set this variable | |
| 92 to indicate to `next-error' that this is a candidate buffer and how | |
| 93 to navigate in it.") | |
| 94 | |
| 95 (make-variable-buffer-local 'next-error-function) | |
| 96 | |
| 97 (defsubst next-error-buffer-p (buffer | |
| 98 &optional avoid-current | |
| 99 extra-test-inclusive | |
| 100 extra-test-exclusive) | |
| 101 "Test if BUFFER is a `next-error' capable buffer. | |
| 102 | |
| 103 If AVOID-CURRENT is non-nil, treat the current buffer | |
| 104 as an absolute last resort only. | |
| 105 | |
| 106 The function EXTRA-TEST-INCLUSIVE, if non-nil, is called in each buffer | |
| 107 that normally would not qualify. If it returns t, the buffer | |
| 108 in question is treated as usable. | |
| 109 | |
| 110 The function EXTRA-TEST-EXCLUSIVE, if non-nil is called in each buffer | |
| 111 that would normally be considered usable. If it returns nil, | |
| 112 that buffer is rejected." | |
| 113 (and (buffer-name buffer) ;First make sure it's live. | |
| 114 (not (and avoid-current (eq buffer (current-buffer)))) | |
| 115 (with-current-buffer buffer | |
| 116 (if next-error-function ; This is the normal test. | |
| 117 ;; Optionally reject some buffers. | |
| 118 (if extra-test-exclusive | |
| 119 (funcall extra-test-exclusive) | |
| 120 t) | |
| 121 ;; Optionally accept some other buffers. | |
| 122 (and extra-test-inclusive | |
| 123 (funcall extra-test-inclusive)))))) | |
| 124 | |
| 125 (defun next-error-find-buffer (&optional avoid-current | |
| 126 extra-test-inclusive | |
| 127 extra-test-exclusive) | |
| 128 "Return a `next-error' capable buffer. | |
| 129 If AVOID-CURRENT is non-nil, treat the current buffer | |
| 130 as an absolute last resort only. | |
| 131 | |
| 132 The function EXTRA-TEST-INCLUSIVE, if non-nil, is called in each buffer | |
| 133 that normally would not qualify. If it returns t, the buffer | |
| 134 in question is treated as usable. | |
| 135 | |
| 136 The function EXTRA-TEST-EXCLUSIVE, if non-nil is called in each buffer | |
| 137 that would normally be considered usable. If it returns nil, | |
| 138 that buffer is rejected." | |
| 139 (or | |
| 140 ;; 1. If one window on the selected frame displays such buffer, return it. | |
| 141 (let ((window-buffers | |
| 142 (delete-dups | |
| 143 (delq nil (mapcar (lambda (w) | |
| 144 (if (next-error-buffer-p | |
| 145 (window-buffer w) | |
| 146 avoid-current | |
| 147 extra-test-inclusive extra-test-exclusive) | |
| 148 (window-buffer w))) | |
| 149 (window-list)))))) | |
| 150 (if (eq (length window-buffers) 1) | |
| 151 (car window-buffers))) | |
| 152 ;; 2. If next-error-last-buffer is an acceptable buffer, use that. | |
| 153 (if (and next-error-last-buffer | |
| 154 (next-error-buffer-p next-error-last-buffer avoid-current | |
| 155 extra-test-inclusive extra-test-exclusive)) | |
| 156 next-error-last-buffer) | |
| 157 ;; 3. If the current buffer is acceptable, choose it. | |
| 158 (if (next-error-buffer-p (current-buffer) avoid-current | |
| 159 extra-test-inclusive extra-test-exclusive) | |
| 160 (current-buffer)) | |
| 161 ;; 4. Look for any acceptable buffer. | |
| 162 (let ((buffers (buffer-list))) | |
| 163 (while (and buffers | |
| 164 (not (next-error-buffer-p | |
| 165 (car buffers) avoid-current | |
| 166 extra-test-inclusive extra-test-exclusive))) | |
| 167 (setq buffers (cdr buffers))) | |
| 168 (car buffers)) | |
| 169 ;; 5. Use the current buffer as a last resort if it qualifies, | |
| 170 ;; even despite AVOID-CURRENT. | |
| 171 (and avoid-current | |
| 172 (next-error-buffer-p (current-buffer) nil | |
| 173 extra-test-inclusive extra-test-exclusive) | |
| 174 (progn | |
| 175 (message "This is the only next-error capable buffer") | |
| 176 (current-buffer))) | |
| 177 ;; 6. Give up. | |
| 178 (error "No next-error capable buffer found"))) | |
| 179 | |
| 180 ;;;###autoload | |
| 3299 | 181 (defun next-error-framework-next-error (&optional arg reset) |
| 182 "Visit next `next-error-framework-next-error' message and corresponding source code. | |
| 3000 | 183 |
| 184 If all the error messages parsed so far have been processed already, | |
| 185 the message buffer is checked for new ones. | |
| 186 | |
| 187 A prefix ARG specifies how many error messages to move; | |
| 188 negative means move back to previous error messages. | |
| 189 Just \\[universal-argument] as a prefix means reparse the error message buffer | |
| 190 and start at the first error. | |
| 191 | |
| 192 The RESET argument specifies that we should restart from the beginning. | |
| 193 | |
| 3299 | 194 \\[next-error-framework-next-error] normally uses the most recently started |
| 3000 | 195 compilation, grep, or occur buffer. It can also operate on any |
| 196 buffer with output from the \\[compile], \\[grep] commands, or, | |
| 197 more generally, on any buffer in Compilation mode or with | |
| 198 Compilation Minor mode enabled, or any buffer in which | |
| 199 `next-error-function' is bound to an appropriate function. | |
| 200 To specify use of a particular buffer for error messages, type | |
| 3299 | 201 \\[next-error-framework-next-error] in that buffer when it is the only one displayed |
| 3000 | 202 in the current frame. |
| 203 | |
| 3299 | 204 Once \\[next-error-framework-next-error] has chosen the buffer for error messages, it |
| 3000 | 205 runs `next-error-hook' with `run-hooks', and stays with that buffer |
| 206 until you use it in some other buffer which uses Compilation mode | |
| 207 or Compilation Minor mode. | |
| 208 | |
| 209 See variables `compilation-parse-errors-function' and | |
| 210 \`compilation-error-regexp-alist' for customization ideas." | |
| 211 (interactive "P") | |
| 212 (if (consp arg) (setq reset t arg nil)) | |
| 213 (when (setq next-error-last-buffer (next-error-find-buffer)) | |
| 214 ;; we know here that next-error-function is a valid symbol we can funcall | |
| 215 (with-current-buffer next-error-last-buffer | |
| 216 (funcall next-error-function (prefix-numeric-value arg) reset) | |
| 217 (run-hooks 'next-error-hook)))) | |
| 218 | |
| 3299 | 219 (defalias 'goto-next-locus 'next-error-framework-next-error) |
| 220 (defalias 'next-match 'next-error-framework-next-error) | |
| 3000 | 221 |
| 3299 | 222 (defun next-error-framework-previous-error (&optional n) |
| 223 "Visit previous `next-error-framework-next-error' message and corresponding source code. | |
| 3000 | 224 |
| 225 Prefix arg N says how many error messages to move backwards (or | |
| 226 forwards, if negative). | |
| 227 | |
| 228 This operates on the output from the \\[compile] and \\[grep] commands." | |
| 229 (interactive "p") | |
| 3299 | 230 (next-error-framework-next-error (- (or n 1)))) |
| 3000 | 231 |
| 3299 | 232 (defun next-error-framework-first-error (&optional n) |
| 3000 | 233 "Restart at the first error. |
| 234 Visit corresponding source code. | |
| 235 With prefix arg N, visit the source code of the Nth error. | |
| 236 This operates on the output from the \\[compile] command, for instance." | |
| 237 (interactive "p") | |
| 3299 | 238 (next-error-framework-next-error n t)) |
| 3000 | 239 |
| 240 (defun next-error-no-select (&optional n) | |
| 241 "Move point to the next error in the `next-error' buffer and highlight match. | |
| 242 Prefix arg N says how many error messages to move forwards (or | |
| 243 backwards, if negative). | |
| 244 Finds and highlights the source line like \\[next-error], but does not | |
| 245 select the source buffer." | |
| 246 (interactive "p") | |
| 247 (let ((next-error-highlight next-error-highlight-no-select)) | |
| 3299 | 248 (next-error-framework-next-error n)) |
| 3000 | 249 (pop-to-buffer next-error-last-buffer)) |
| 250 | |
| 251 (defun previous-error-no-select (&optional n) | |
| 252 "Move point to the previous error in the `next-error' buffer and highlight match. | |
| 253 Prefix arg N says how many error messages to move backwards (or | |
| 254 forwards, if negative). | |
| 255 Finds and highlights the source line like \\[previous-error], but does not | |
| 256 select the source buffer." | |
| 257 (interactive "p") | |
| 258 (next-error-no-select (- (or n 1)))) | |
| 259 | |
| 260 ;;; Internal variable for `next-error-follow-mode-post-command-hook'. | |
| 261 (defvar next-error-follow-last-line nil) | |
| 262 | |
| 263 (define-minor-mode next-error-follow-minor-mode | |
| 264 "Minor mode for compilation, occur and diff modes. | |
| 265 When turned on, cursor motion in the compilation, grep, occur or diff | |
| 266 buffer causes automatic display of the corresponding source code | |
| 267 location." | |
| 268 :group 'next-error :init-value nil :lighter " Fol" | |
| 269 (if (not next-error-follow-minor-mode) | |
| 270 (remove-hook 'post-command-hook 'next-error-follow-mode-post-command-hook t) | |
| 271 (add-hook 'post-command-hook 'next-error-follow-mode-post-command-hook nil t) | |
| 272 (make-local-variable 'next-error-follow-last-line))) | |
| 273 | |
| 274 ;;; Used as a `post-command-hook' by `next-error-follow-mode' | |
| 275 ;;; for the *Compilation* *grep* and *Occur* buffers. | |
| 3017 | 276 (defvar compilation-current-error) |
| 277 (defvar compilation-context-lines) | |
| 3000 | 278 (defun next-error-follow-mode-post-command-hook () |
| 279 (unless (equal next-error-follow-last-line (line-number-at-pos)) | |
| 280 (setq next-error-follow-last-line (line-number-at-pos)) | |
| 281 (condition-case nil | |
| 282 (let ((compilation-context-lines nil)) | |
| 283 (setq compilation-current-error (point)) | |
| 284 (next-error-no-select 0)) | |
| 285 (error t)))) | |
| 286 | |
| 287 (provide 'next-error) |