Mercurial > hg > xemacs-beta
annotate src/scrollbar.c @ 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 | 623d57b7fbe8 |
| children | f965e31a35f0 |
| rev | line source |
|---|---|
| 428 | 1 /* Generic scrollbar implementation. |
| 2 Copyright (C) 1994, 1995 Board of Trustees, University of Illinois. | |
| 3 Copyright (C) 1995 Free Software Foundation, Inc. | |
| 4 Copyright (C) 1995 Sun Microsystems, Inc. | |
| 5 Copyright (C) 1995 Darrell Kindred <dkindred+@cmu.edu>. | |
|
5127
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5124
diff
changeset
|
6 Copyright (C) 2003, 2010 Ben Wing. |
| 428 | 7 |
| 8 This file is part of XEmacs. | |
| 9 | |
| 10 XEmacs is free software; you can redistribute it and/or modify it | |
| 11 under the terms of the GNU General Public License as published by the | |
| 12 Free Software Foundation; either version 2, or (at your option) any | |
| 13 later version. | |
| 14 | |
| 15 XEmacs is distributed in the hope that it will be useful, but WITHOUT | |
| 16 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
| 17 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
| 18 for more details. | |
| 19 | |
| 20 You should have received a copy of the GNU General Public License | |
| 21 along with XEmacs; see the file COPYING. If not, write to | |
| 22 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
| 23 Boston, MA 02111-1307, USA. */ | |
| 24 | |
| 25 /* Synched up with: Not in FSF. */ | |
| 26 | |
| 27 /* This file has been Mule-ized. */ | |
| 28 | |
| 29 #include <config.h> | |
| 30 #include "lisp.h" | |
| 31 | |
| 32 #include "buffer.h" | |
| 33 #include "commands.h" | |
| 34 #include "scrollbar.h" | |
| 872 | 35 #include "device-impl.h" |
| 36 #include "frame-impl.h" | |
| 428 | 37 #include "glyphs.h" |
| 38 #include "gutter.h" | |
| 39 #include "window.h" | |
| 40 | |
| 41 Lisp_Object Qinit_scrollbar_from_resources; | |
| 42 | |
| 43 Lisp_Object Qscrollbar_line_up; | |
| 44 Lisp_Object Qscrollbar_line_down; | |
| 45 Lisp_Object Qscrollbar_page_up; | |
| 46 Lisp_Object Qscrollbar_page_down; | |
| 47 Lisp_Object Qscrollbar_to_top; | |
| 48 Lisp_Object Qscrollbar_to_bottom; | |
| 49 Lisp_Object Qscrollbar_vertical_drag; | |
| 50 | |
| 51 Lisp_Object Qscrollbar_char_left; | |
| 52 Lisp_Object Qscrollbar_char_right; | |
| 53 Lisp_Object Qscrollbar_page_left; | |
| 54 Lisp_Object Qscrollbar_page_right; | |
| 55 Lisp_Object Qscrollbar_to_left; | |
| 56 Lisp_Object Qscrollbar_to_right; | |
| 57 Lisp_Object Qscrollbar_horizontal_drag; | |
| 58 | |
| 59 #define DEFAULT_SCROLLBAR_WIDTH 15 | |
| 60 #define DEFAULT_SCROLLBAR_HEIGHT 15 | |
| 61 | |
| 62 /* Width and height of the scrollbar. */ | |
| 63 Lisp_Object Vscrollbar_width; | |
| 64 Lisp_Object Vscrollbar_height; | |
| 65 | |
| 66 /* Scrollbar visibility specifiers */ | |
| 67 Lisp_Object Vhorizontal_scrollbar_visible_p; | |
| 68 Lisp_Object Vvertical_scrollbar_visible_p; | |
| 69 | |
| 70 /* Scrollbar location specifiers */ | |
| 71 Lisp_Object Vscrollbar_on_left_p; | |
| 72 Lisp_Object Vscrollbar_on_top_p; | |
| 73 | |
| 74 Lisp_Object Vscrollbar_pointer_glyph; | |
| 75 | |
| 76 EXFUN (Fcenter_to_window_line, 2); | |
| 77 | |
| 78 static void update_scrollbar_instance (struct window *w, int vertical, | |
| 79 struct scrollbar_instance *instance); | |
| 80 | |
| 1204 | 81 static const struct memory_description scrollbar_instance_description [] = { |
| 934 | 82 { XD_LISP_OBJECT, offsetof (struct scrollbar_instance, mirror) }, |
| 83 { XD_LISP_OBJECT, offsetof (struct scrollbar_instance, next) }, | |
| 84 { XD_END } | |
| 85 }; | |
| 86 | |
| 428 | 87 |
| 617 | 88 static Lisp_Object |
| 89 mark_scrollbar_instance (Lisp_Object obj) | |
| 90 { | |
| 91 struct scrollbar_instance *data = XSCROLLBAR_INSTANCE (obj); | |
| 92 mark_object (wrap_window_mirror (data->mirror)); | |
| 93 if (data->next) | |
| 94 return wrap_scrollbar_instance (data->next); | |
| 95 else | |
| 96 return Qnil; | |
| 97 } | |
| 98 | |
|
5124
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5120
diff
changeset
|
99 DEFINE_NODUMP_INTERNAL_LISP_OBJECT ("scrollbar-instance", scrollbar_instance, |
|
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5120
diff
changeset
|
100 mark_scrollbar_instance, |
|
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5120
diff
changeset
|
101 scrollbar_instance_description, |
|
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5120
diff
changeset
|
102 struct scrollbar_instance); |
| 617 | 103 |
| 428 | 104 static void |
| 105 free_scrollbar_instance (struct scrollbar_instance *instance, | |
| 106 struct frame *frame) | |
| 107 { | |
| 108 if (!instance) | |
| 109 return; | |
| 110 else | |
| 111 { | |
| 112 struct device *d = XDEVICE (frame->device); | |
| 113 | |
| 114 MAYBE_DEVMETH (d, free_scrollbar_instance, (instance)); | |
| 617 | 115 /* not worth calling free_managed_lcrecord() -- scrollbar instances |
| 116 are not created that frequently and it's dangerous. */ | |
| 428 | 117 } |
| 118 } | |
| 119 | |
| 120 static void | |
| 121 free_window_mirror_scrollbars (struct window_mirror *mir) | |
| 122 { | |
| 123 free_scrollbar_instance (mir->scrollbar_vertical_instance, mir->frame); | |
| 124 mir->scrollbar_vertical_instance = 0; | |
| 125 | |
| 126 free_scrollbar_instance (mir->scrollbar_horizontal_instance, mir->frame); | |
| 127 mir->scrollbar_horizontal_instance = 0; | |
| 128 } | |
| 129 | |
| 130 static struct window_mirror * | |
| 131 free_scrollbars_loop (Lisp_Object window, struct window_mirror *mir) | |
| 132 { | |
| 133 struct window_mirror *retval = NULL; | |
| 134 | |
| 135 while (mir) | |
| 136 { | |
| 137 assert (!NILP (window)); | |
| 138 | |
| 139 if (mir->vchild) | |
| 140 { | |
| 141 retval = free_scrollbars_loop (XWINDOW (window)->vchild, | |
| 142 mir->vchild); | |
| 143 } | |
| 144 else if (mir->hchild) | |
| 145 { | |
| 146 retval = free_scrollbars_loop (XWINDOW (window)->hchild, | |
| 147 mir->hchild); | |
| 148 } | |
| 149 | |
| 150 if (retval != NULL) | |
| 151 return retval; | |
| 152 | |
| 153 if (mir->scrollbar_vertical_instance || | |
| 154 mir->scrollbar_horizontal_instance) | |
| 155 free_window_mirror_scrollbars (mir); | |
| 156 | |
| 157 mir = mir->next; | |
| 158 window = XWINDOW (window)->next; | |
| 159 } | |
| 160 | |
| 161 return NULL; | |
| 162 } | |
| 163 | |
| 164 /* Destroy all scrollbars associated with FRAME. Only called from | |
| 165 delete_frame_internal. */ | |
| 166 void | |
| 167 free_frame_scrollbars (struct frame *f) | |
| 168 { | |
| 169 if (!HAS_FRAMEMETH_P (f, create_scrollbar_instance)) | |
| 170 return; | |
| 171 | |
| 172 if (f->mirror_dirty) | |
| 173 update_frame_window_mirror (f); | |
| 174 | |
| 617 | 175 free_scrollbars_loop (f->root_window, XWINDOW_MIRROR (f->root_mirror)); |
| 428 | 176 |
| 177 while (FRAME_SB_VCACHE (f)) | |
| 178 { | |
| 179 struct scrollbar_instance *tofree = FRAME_SB_VCACHE (f); | |
| 180 FRAME_SB_VCACHE (f) = FRAME_SB_VCACHE (f)->next; | |
| 181 tofree->next = NULL; | |
| 182 free_scrollbar_instance (tofree, f); | |
| 183 } | |
| 184 | |
| 185 while (FRAME_SB_HCACHE (f)) | |
| 186 { | |
| 187 struct scrollbar_instance *tofree = FRAME_SB_HCACHE (f); | |
| 188 FRAME_SB_HCACHE (f) = FRAME_SB_HCACHE (f)->next; | |
| 189 tofree->next = NULL; | |
| 190 free_scrollbar_instance (tofree, f); | |
| 191 } | |
| 192 } | |
| 193 | |
| 194 | |
| 195 static struct scrollbar_instance * | |
| 196 create_scrollbar_instance (struct frame *f, int vertical) | |
| 197 { | |
| 198 struct device *d = XDEVICE (f->device); | |
|
5127
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5124
diff
changeset
|
199 Lisp_Object obj = ALLOC_NORMAL_LISP_OBJECT (scrollbar_instance); |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3024
diff
changeset
|
200 struct scrollbar_instance *instance = XSCROLLBAR_INSTANCE (obj); |
| 428 | 201 |
| 202 MAYBE_DEVMETH (d, create_scrollbar_instance, (f, vertical, instance)); | |
| 203 | |
| 204 return instance; | |
| 205 } | |
| 206 | |
| 207 | |
| 208 #define GET_SCROLLBAR_INSTANCE_INTERNAL(cache) \ | |
| 209 do { \ | |
| 210 if (FRAME_SB_##cache (f)) \ | |
| 211 { \ | |
| 212 struct scrollbar_instance *retval = FRAME_SB_##cache (f); \ | |
| 213 FRAME_SB_##cache (f) = FRAME_SB_##cache (f)->next; \ | |
| 214 retval->next = NULL; \ | |
| 215 return retval; \ | |
| 216 } \ | |
| 217 } while (0) | |
| 218 | |
| 219 static struct scrollbar_instance * | |
| 220 get_scrollbar_instance (struct frame *f, int vertical) | |
| 221 { | |
| 222 /* Check if there are any available scrollbars already in existence. */ | |
| 223 if (vertical) | |
| 224 GET_SCROLLBAR_INSTANCE_INTERNAL (VCACHE); | |
| 225 else | |
| 226 GET_SCROLLBAR_INSTANCE_INTERNAL (HCACHE); | |
| 227 | |
| 228 return create_scrollbar_instance (f, vertical); | |
| 229 } | |
| 230 #undef GET_SCROLLBAR_INSTANCE_INTERNAL | |
| 231 | |
| 232 #define RELEASE_SCROLLBAR_INSTANCE_INTERNAL(cache) \ | |
| 233 do { \ | |
| 234 if (!FRAME_SB_##cache (f)) \ | |
| 235 { \ | |
| 236 instance->next = NULL; \ | |
| 237 FRAME_SB_##cache (f) = instance; \ | |
| 238 } \ | |
| 239 else \ | |
| 240 { \ | |
| 241 instance->next = FRAME_SB_##cache (f); \ | |
| 242 FRAME_SB_##cache (f) = instance; \ | |
| 243 } \ | |
| 244 } while (0) | |
| 245 | |
| 246 static void | |
| 247 release_scrollbar_instance (struct frame *f, int vertical, | |
| 248 struct scrollbar_instance *instance) | |
| 249 { | |
| 250 /* #### should we do "instance->mir = 0;" for safety? */ | |
| 251 if (vertical) | |
| 252 RELEASE_SCROLLBAR_INSTANCE_INTERNAL (VCACHE); | |
| 253 else | |
| 254 RELEASE_SCROLLBAR_INSTANCE_INTERNAL (HCACHE); | |
| 255 } | |
| 256 #undef RELEASE_SCROLLBAR_INSTANCE_INTERNAL | |
| 257 | |
| 258 #ifdef MEMORY_USAGE_STATS | |
| 259 | |
| 260 int | |
| 261 compute_scrollbar_instance_usage (struct device *d, | |
| 262 struct scrollbar_instance *inst, | |
| 263 struct overhead_stats *ovstats) | |
| 264 { | |
| 265 int total = 0; | |
| 266 | |
| 2469 | 267 if (HAS_DEVMETH_P(d, compute_scrollbar_instance_usage)) |
| 268 total += DEVMETH (d, compute_scrollbar_instance_usage, (d, inst, ovstats)); | |
| 428 | 269 |
| 270 while (inst) | |
| 271 { | |
|
5127
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5124
diff
changeset
|
272 total += lisp_object_storage_size (wrap_scrollbar_instance (inst), |
|
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5124
diff
changeset
|
273 ovstats); |
| 428 | 274 inst = inst->next; |
| 275 } | |
| 276 | |
| 277 return total; | |
| 278 } | |
| 279 | |
| 280 #endif /* MEMORY_USAGE_STATS */ | |
| 281 | |
| 282 void | |
| 283 update_window_scrollbars (struct window *w, struct window_mirror *mirror, | |
| 284 int active, int horiz_only) | |
| 285 { | |
| 286 struct frame *f = XFRAME (w->frame); | |
| 287 struct device *d = XDEVICE (f->device); | |
| 1318 | 288 int depth; |
| 428 | 289 |
| 290 if (!HAS_DEVMETH_P (d, create_scrollbar_instance)) | |
| 291 return; | |
| 292 | |
| 1318 | 293 depth = enter_redisplay_critical_section_maybe (); |
| 428 | 294 |
| 295 /* It is possible for this to get called from the mirror update | |
| 296 routines. In that case the structure is in an indeterminate | |
| 297 state but we know exactly what struct we are working with. So we | |
| 298 pass it in in that case. We also take advantage of it at some | |
| 299 other points where we know what the mirror struct is. */ | |
| 300 if (!mirror) | |
| 301 mirror = find_window_mirror (w); | |
| 302 | |
| 303 if (!mirror->scrollbar_vertical_instance && active) | |
| 304 mirror->scrollbar_vertical_instance = get_scrollbar_instance (f, 1); | |
| 305 | |
| 306 if (!mirror->scrollbar_horizontal_instance && active) | |
| 307 mirror->scrollbar_horizontal_instance = get_scrollbar_instance (f, 0); | |
| 308 | |
| 309 if (!horiz_only && mirror->scrollbar_vertical_instance) | |
| 310 { | |
| 311 int size = (active ? window_scrollbar_width (w) : 0); | |
| 312 struct scrollbar_instance *instance; | |
| 313 | |
| 314 instance = mirror->scrollbar_vertical_instance; | |
| 315 instance->scrollbar_is_active = active; | |
| 316 instance->mirror = mirror; | |
| 317 | |
| 318 if (active && size) | |
| 319 update_scrollbar_instance (w, 1, instance); | |
| 320 MAYBE_DEVMETH (d, update_scrollbar_instance_status, | |
| 321 (w, active, size, instance)); | |
| 322 | |
| 323 if (!active) | |
| 324 { | |
| 325 release_scrollbar_instance (f, 1, instance); | |
| 326 mirror->scrollbar_vertical_instance = NULL; | |
| 327 } | |
| 328 } | |
| 329 | |
| 330 if (mirror->scrollbar_horizontal_instance) | |
| 331 { | |
| 332 int size = (active ? window_scrollbar_height (w) : 0); | |
| 333 struct scrollbar_instance *instance; | |
| 334 | |
| 335 instance = mirror->scrollbar_horizontal_instance; | |
| 336 instance->scrollbar_is_active = active; | |
| 337 instance->mirror = mirror; | |
| 338 | |
| 339 if (active && size) | |
| 340 update_scrollbar_instance (w, 0, instance); | |
| 341 MAYBE_DEVMETH (d, update_scrollbar_instance_status, | |
| 342 (w, active, size, instance)); | |
| 343 | |
| 344 if (!active) | |
| 345 { | |
| 346 release_scrollbar_instance (f, 0, instance); | |
| 347 mirror->scrollbar_horizontal_instance = NULL; | |
| 348 } | |
| 349 } | |
| 350 | |
| 1318 | 351 exit_redisplay_critical_section_maybe (depth); |
| 428 | 352 } |
| 353 | |
| 354 void | |
| 355 release_window_mirror_scrollbars (struct window_mirror *mir) | |
| 356 { | |
| 357 struct device *d = XDEVICE (mir->frame->device); | |
| 358 | |
| 359 if (!HAS_DEVMETH_P (d, create_scrollbar_instance)) | |
| 360 return; | |
| 361 | |
| 362 if (mir->scrollbar_vertical_instance) | |
| 363 { | |
| 364 release_scrollbar_instance (mir->frame, 1, | |
| 365 mir->scrollbar_vertical_instance); | |
| 366 MAYBE_DEVMETH (d, release_scrollbar_instance, | |
| 367 (mir->scrollbar_vertical_instance)); | |
| 368 } | |
| 369 mir->scrollbar_vertical_instance = 0; | |
| 370 | |
| 371 if (mir->scrollbar_horizontal_instance) | |
| 372 { | |
| 373 release_scrollbar_instance (mir->frame, 0, | |
| 374 mir->scrollbar_horizontal_instance); | |
| 375 MAYBE_DEVMETH (d, release_scrollbar_instance, | |
| 376 (mir->scrollbar_horizontal_instance)); | |
| 377 } | |
| 378 mir->scrollbar_horizontal_instance = 0; | |
| 379 } | |
| 380 | |
| 381 /* | |
| 382 * If w->sb_point is on the top line then return w->sb_point else | |
| 383 * return w->start. If flag, then return beginning point of line | |
| 384 * which w->sb_point lies on. | |
| 385 */ | |
| 665 | 386 static Charbpos |
| 428 | 387 scrollbar_point (struct window *w, int flag) |
| 388 { | |
| 665 | 389 Charbpos start_pos, end_pos, sb_pos; |
| 428 | 390 Lisp_Object buf; |
| 391 struct buffer *b; | |
| 392 | |
| 393 if (NILP (w->buffer)) /* non-leaf window */ | |
| 394 return 0; | |
| 395 | |
| 396 start_pos = marker_position (w->start[CURRENT_DISP]); | |
| 397 sb_pos = marker_position (w->sb_point); | |
| 398 | |
| 399 if (!flag && sb_pos < start_pos) | |
| 400 return start_pos; | |
| 401 | |
| 402 buf = get_buffer (w->buffer, 0); | |
| 403 if (!NILP (buf)) | |
| 404 b = XBUFFER (buf); | |
| 405 else | |
| 406 return start_pos; | |
| 407 | |
| 408 if (flag) | |
| 409 end_pos = find_next_newline_no_quit (b, sb_pos, -1); | |
| 410 else | |
| 411 end_pos = find_next_newline_no_quit (b, start_pos, 1); | |
| 412 | |
| 413 if (flag) | |
| 414 return end_pos; | |
| 415 else if (sb_pos > end_pos) | |
| 416 return start_pos; | |
| 417 else | |
| 418 return sb_pos; | |
| 419 } | |
| 420 | |
| 421 /* | |
| 422 * Update a window's horizontal or vertical scrollbar. | |
| 423 */ | |
| 424 static void | |
| 425 update_scrollbar_instance (struct window *w, int vertical, | |
| 426 struct scrollbar_instance *instance) | |
| 427 { | |
| 428 struct frame *f = XFRAME (w->frame); | |
| 429 struct device *d = XDEVICE (f->device); | |
| 430 struct buffer *b = XBUFFER (w->buffer); | |
| 665 | 431 Charbpos start_pos, end_pos, sb_pos; |
| 428 | 432 int scrollbar_width = window_scrollbar_width (w); |
| 433 int scrollbar_height = window_scrollbar_height (w); | |
| 434 | |
| 435 int new_line_increment = -1, new_page_increment = -1; | |
| 436 int new_minimum = -1, new_maximum = -1; | |
| 437 int new_slider_size = -1, new_slider_position = -1; | |
| 438 int new_width = -1, new_height = -1, new_x = -1, new_y = -1; | |
| 2286 | 439 #if 0 |
| 444 | 440 struct window *new_window = 0; /* #### currently unused */ |
| 2286 | 441 #endif |
| 428 | 442 |
| 443 end_pos = BUF_Z (b) - w->window_end_pos[CURRENT_DISP]; | |
| 444 sb_pos = scrollbar_point (w, 0); | |
| 445 start_pos = sb_pos; | |
| 446 | |
| 447 /* The end position must be strictly greater than the start | |
| 448 position, at least for the Motify scrollbar. It shouldn't hurt | |
| 449 anything for other scrollbar implementations. */ | |
| 450 if (end_pos <= start_pos) | |
| 451 end_pos = start_pos + 1; | |
| 452 | |
| 453 if (vertical) | |
| 454 { | |
| 455 new_height = WINDOW_TEXT_HEIGHT (w); | |
| 456 new_width = scrollbar_width; | |
| 457 } | |
| 458 else | |
| 459 { | |
| 460 new_height = scrollbar_height; | |
| 461 new_width = WINDOW_TEXT_WIDTH (w); | |
| 462 } | |
| 463 | |
| 464 /* If the height and width are not greater than 0, then later on the | |
| 465 Motif widgets will bitch and moan. */ | |
| 466 if (new_height <= 0) | |
| 467 new_height = 1; | |
| 468 if (new_width <= 0) | |
| 469 new_width = 1; | |
| 470 | |
| 471 assert (instance->mirror && XWINDOW (real_window(instance->mirror, 0)) == w); | |
| 472 | |
| 473 /* Only character-based scrollbars are implemented at the moment. | |
| 474 Line-based will be implemented in the future. */ | |
| 475 | |
| 476 instance->scrollbar_is_active = 1; | |
| 477 new_line_increment = 1; | |
| 478 new_page_increment = 1; | |
| 479 | |
| 480 /* We used to check for inhibit_scrollbar_slider_size_change here, | |
| 481 but that seems bogus. */ | |
| 482 { | |
| 483 int x_offset, y_offset; | |
| 484 | |
| 485 /* Scrollbars are always the farthest from the text area, barring | |
| 486 gutters. */ | |
| 487 if (vertical) | |
| 488 { | |
| 489 if (!NILP (w->scrollbar_on_left_p)) | |
| 490 { | |
| 491 x_offset = WINDOW_LEFT (w); | |
| 492 } | |
| 442 | 493 else |
| 428 | 494 { |
| 495 x_offset = WINDOW_RIGHT (w) - scrollbar_width; | |
| 496 if (window_needs_vertical_divider (w)) | |
| 497 x_offset -= window_divider_width (w); | |
| 498 } | |
| 499 y_offset = WINDOW_TEXT_TOP (w) + f->scrollbar_y_offset; | |
| 500 } | |
| 501 else | |
| 502 { | |
| 503 x_offset = WINDOW_TEXT_LEFT (w); | |
| 504 y_offset = f->scrollbar_y_offset; | |
| 505 | |
| 506 if (!NILP (w->scrollbar_on_top_p)) | |
| 507 { | |
| 508 y_offset += WINDOW_TOP (w); | |
| 509 } | |
| 510 else | |
| 511 { | |
| 512 y_offset += WINDOW_TEXT_BOTTOM (w); | |
| 513 } | |
| 514 } | |
| 515 | |
| 516 new_x = x_offset; | |
| 517 new_y = y_offset; | |
| 518 } | |
| 519 | |
| 520 /* A disabled scrollbar has its slider sized to the entire height of | |
| 521 the scrollbar. Currently the minibuffer scrollbar is | |
| 522 disabled. */ | |
| 523 if (!MINI_WINDOW_P (w) && vertical) | |
| 524 { | |
| 525 if (!DEVMETH_OR_GIVEN (d, inhibit_scrollbar_slider_size_change, (), 0)) | |
| 526 { | |
| 527 new_minimum = BUF_BEGV (b); | |
| 528 new_maximum = max (BUF_ZV (b), new_minimum + 1); | |
| 529 new_slider_size = min ((end_pos - start_pos), | |
| 530 (new_maximum - new_minimum)); | |
| 531 new_slider_position = sb_pos; | |
| 2286 | 532 #if 0 |
| 428 | 533 new_window = w; |
| 2286 | 534 #endif |
| 428 | 535 } |
| 536 } | |
| 537 else if (!MINI_WINDOW_P (w)) | |
| 538 { | |
| 539 /* The minus one is to account for the truncation glyph. */ | |
| 540 int wcw = window_char_width (w, 0) - 1; | |
| 541 int max_width, max_slide; | |
| 542 | |
| 543 if (w->max_line_len < wcw) | |
| 544 { | |
| 545 max_width = 1; | |
| 546 max_slide = 1; | |
| 547 wcw = 1; | |
| 548 } | |
| 549 else | |
| 550 { | |
| 551 max_width = w->max_line_len + 2; | |
| 552 max_slide = max_width - wcw; | |
| 553 } | |
| 554 | |
| 555 new_minimum = 0; | |
| 556 new_maximum = max_width; | |
| 557 new_slider_size = wcw; | |
| 558 new_slider_position = min (w->hscroll, max_slide); | |
| 559 } | |
| 560 else /* MINI_WINDOW_P (w) */ | |
| 561 { | |
| 562 new_minimum = 1; | |
| 563 new_maximum = 2; | |
| 564 new_slider_size = 1; | |
| 565 new_slider_position = 1; | |
| 566 instance->scrollbar_is_active = 0; | |
| 567 } | |
| 568 | |
| 569 DEVMETH (d, update_scrollbar_instance_values, (w, instance, | |
| 570 new_line_increment, | |
| 571 new_page_increment, | |
| 572 new_minimum, | |
| 573 new_maximum, | |
| 574 new_slider_size, | |
| 575 new_slider_position, | |
| 576 new_width, new_height, | |
| 577 new_x, new_y)); | |
| 578 } | |
| 579 | |
| 580 void | |
| 581 init_frame_scrollbars (struct frame *f) | |
| 582 { | |
| 583 struct device *d = XDEVICE (f->device); | |
| 584 | |
| 585 if (HAS_DEVMETH_P (d, create_scrollbar_instance)) | |
| 586 { | |
| 587 int depth = unlock_ghost_specifiers_protected (); | |
| 793 | 588 Lisp_Object frame = wrap_frame (f); |
| 589 | |
| 428 | 590 call_critical_lisp_code (XDEVICE (FRAME_DEVICE (f)), |
| 591 Qinit_scrollbar_from_resources, | |
| 592 frame); | |
| 771 | 593 unbind_to (depth); |
| 428 | 594 } |
| 595 } | |
| 596 | |
| 597 void | |
| 598 init_device_scrollbars (struct device *d) | |
| 599 { | |
| 600 if (HAS_DEVMETH_P (d, create_scrollbar_instance)) | |
| 601 { | |
| 602 int depth = unlock_ghost_specifiers_protected (); | |
| 793 | 603 Lisp_Object device = wrap_device (d); |
| 604 | |
| 428 | 605 call_critical_lisp_code (d, |
| 606 Qinit_scrollbar_from_resources, | |
| 607 device); | |
| 771 | 608 unbind_to (depth); |
| 428 | 609 } |
| 610 } | |
| 611 | |
| 612 void | |
| 613 init_global_scrollbars (struct device *d) | |
| 614 { | |
| 615 if (HAS_DEVMETH_P (d, create_scrollbar_instance)) | |
| 616 { | |
| 617 int depth = unlock_ghost_specifiers_protected (); | |
| 618 call_critical_lisp_code (d, | |
| 619 Qinit_scrollbar_from_resources, | |
| 620 Qglobal); | |
| 771 | 621 unbind_to (depth); |
| 428 | 622 } |
| 623 } | |
| 624 | |
| 625 static void | |
| 2286 | 626 vertical_scrollbar_changed_in_window (Lisp_Object UNUSED (specifier), |
| 428 | 627 struct window *w, |
| 2286 | 628 Lisp_Object UNUSED (oldval)) |
| 428 | 629 { |
| 630 /* Hold on your cerebella guys. If we always show the dividers, | |
| 631 changing scrollbar affects only how the text and scrollbar are | |
| 632 laid out in the window. If we do not want the dividers to show up | |
| 633 always, then we mark more drastic change, because changing | |
| 634 divider appearance changes lotta things. Although we actually need | |
| 635 to do this only if the scrollbar has appeared or disappeared | |
| 636 completely at either window edge, we do this always, as users | |
| 637 usually do not reposition scrollbars 200 times a second or so. Do | |
| 638 you? */ | |
| 639 if (NILP (w->vertical_divider_always_visible_p)) | |
| 640 MARK_FRAME_WINDOWS_STRUCTURE_CHANGED (XFRAME (WINDOW_FRAME (w))); | |
| 641 else | |
| 642 MARK_WINDOWS_CHANGED (w); | |
| 643 } | |
| 644 | |
| 645 /* This function is called as a result of a change to the | |
| 646 `scrollbar-pointer' glyph. */ | |
| 647 static void | |
| 2286 | 648 scrollbar_pointer_changed_in_window (Lisp_Object UNUSED (specifier), |
| 649 struct window *w, | |
| 650 Lisp_Object UNUSED (oldval)) | |
| 428 | 651 { |
| 652 struct frame *f = XFRAME (WINDOW_FRAME (w)); | |
| 653 | |
| 654 if (f->init_finished) | |
| 655 MAYBE_FRAMEMETH (f, scrollbar_pointer_changed_in_window, (w)); | |
| 656 } | |
| 657 | |
| 658 /* #### | |
| 659 | |
| 660 All of the following stuff is functions that handle scrollbar | |
| 661 actions. All of it should be moved into Lisp. This may require | |
| 662 adding some badly-needed primitives. */ | |
| 663 | |
| 664 /********** vertical scrollbar stuff **********/ | |
| 665 | |
| 666 /* | |
| 667 * If the original point is still visible, put the cursor back there. | |
| 668 * Otherwise, when scrolling down stick it at the beginning of the | |
| 669 * first visible line and when scrolling up stick it at the beginning | |
| 670 * of the last visible line. | |
| 671 */ | |
| 672 | |
| 673 /* #### This function should be moved into Lisp */ | |
| 674 static void | |
| 675 scrollbar_reset_cursor (Lisp_Object win, Lisp_Object orig_pt) | |
| 676 { | |
| 677 /* When this function is called we know that start is already | |
| 678 accurate. We know this because either set-window-start or | |
| 679 recenter was called immediately prior to it being called. */ | |
| 680 Lisp_Object buf; | |
| 665 | 681 Charbpos start_pos = XINT (Fwindow_start (win)); |
| 682 Charbpos ptint = XINT (orig_pt); | |
| 428 | 683 struct window *w = XWINDOW (win); |
| 684 int selected = ((w == XWINDOW (Fselected_window (XFRAME (w->frame)->device))) | |
| 685 ? 1 | |
| 686 : 0); | |
| 687 | |
| 688 buf = Fwindow_buffer (win); | |
| 689 if (NILP (buf)) | |
| 690 return; /* the window was deleted out from under us */ | |
| 691 | |
| 692 if (ptint < XINT (Fwindow_start (win))) | |
| 693 { | |
| 694 if (selected) | |
| 695 Fgoto_char (make_int (start_pos), buf); | |
| 696 else | |
| 697 Fset_window_point (win, make_int (start_pos)); | |
| 698 } | |
| 1708 | 699 else if (!point_would_be_visible (XWINDOW (win), start_pos, ptint, 0)) |
| 428 | 700 { |
| 701 Fmove_to_window_line (make_int (-1), win); | |
| 702 | |
| 703 if (selected) | |
| 704 Fbeginning_of_line (Qnil, buf); | |
| 705 else | |
| 706 { | |
| 707 /* #### Taken from forward-line. */ | |
| 665 | 708 Charbpos pos; |
| 428 | 709 |
| 710 pos = find_next_newline (XBUFFER (buf), | |
| 711 marker_position (w->pointm[CURRENT_DISP]), | |
| 712 -1); | |
| 713 Fset_window_point (win, make_int (pos)); | |
| 714 } | |
| 715 } | |
| 716 else | |
| 717 { | |
| 718 if (selected) | |
| 719 Fgoto_char (orig_pt, buf); | |
| 720 else | |
| 721 Fset_window_point (win, orig_pt); | |
| 722 } | |
| 723 } | |
| 724 | |
| 725 DEFUN ("scrollbar-line-up", Fscrollbar_line_up, 1, 1, 0, /* | |
| 726 Function called when the line-up arrow on the scrollbar is clicked. | |
| 727 This is the little arrow at the top of the scrollbar. One argument, the | |
| 728 scrollbar's window. You can advise this function to change the scrollbar | |
| 729 behavior. | |
| 730 */ | |
| 731 (window)) | |
| 732 { | |
| 733 CHECK_LIVE_WINDOW (window); | |
| 734 window_scroll (window, make_int (1), -1, ERROR_ME_NOT); | |
| 735 zmacs_region_stays = 1; | |
| 736 return Qnil; | |
| 737 } | |
| 738 | |
| 739 DEFUN ("scrollbar-line-down", Fscrollbar_line_down, 1, 1, 0, /* | |
| 740 Function called when the line-down arrow on the scrollbar is clicked. | |
| 741 This is the little arrow at the bottom of the scrollbar. One argument, the | |
| 742 scrollbar's window. You can advise this function to change the scrollbar | |
| 743 behavior. | |
| 744 */ | |
| 745 (window)) | |
| 746 { | |
| 747 CHECK_LIVE_WINDOW (window); | |
| 748 window_scroll (window, make_int (1), 1, ERROR_ME_NOT); | |
| 749 zmacs_region_stays = 1; | |
| 750 return Qnil; | |
| 751 } | |
| 752 | |
| 753 DEFUN ("scrollbar-page-up", Fscrollbar_page_up, 1, 1, 0, /* | |
| 754 Function called when the user gives the "page-up" scrollbar action. | |
| 755 \(The way this is done can vary from scrollbar to scrollbar.) One argument, | |
| 756 a cons containing the scrollbar's window and a value (#### document me! | |
| 757 This value is nil for Motif/Lucid scrollbars and a number for Athena | |
| 758 scrollbars). You can advise this function to change the scrollbar | |
| 759 behavior. | |
| 760 */ | |
| 761 (object)) | |
| 762 { | |
| 763 Lisp_Object window = Fcar (object); | |
| 764 | |
| 765 CHECK_LIVE_WINDOW (window); | |
| 766 /* Motif and Athena scrollbars behave differently, but in accordance | |
| 767 with their standard behaviors. It is not possible to hide the | |
| 768 differences down in lwlib because knowledge of XEmacs buffer and | |
| 769 cursor motion routines is necessary. */ | |
| 442 | 770 |
| 771 if (NILP (XCDR (object))) | |
| 772 window_scroll (window, Qnil, -1, ERROR_ME_NOT); | |
| 773 else | |
| 774 { | |
| 665 | 775 Charbpos charbpos; |
| 442 | 776 Lisp_Object value = Fcdr (object); |
| 428 | 777 |
| 442 | 778 CHECK_INT (value); |
| 779 Fmove_to_window_line (Qzero, window); | |
| 780 /* can't use Fvertical_motion() because it moves the buffer point | |
| 781 rather than the window's point. | |
| 428 | 782 |
| 442 | 783 #### It does? Why does it take a window argument then? */ |
| 665 | 784 charbpos = vmotion (XWINDOW (window), XINT (Fwindow_point (window)), |
| 442 | 785 XINT (value), 0); |
| 665 | 786 Fset_window_point (window, make_int (charbpos)); |
| 442 | 787 Fcenter_to_window_line (Qzero, window); |
| 788 } | |
| 789 | |
| 428 | 790 zmacs_region_stays = 1; |
| 791 return Qnil; | |
| 792 } | |
| 793 | |
| 794 DEFUN ("scrollbar-page-down", Fscrollbar_page_down, 1, 1, 0, /* | |
| 795 Function called when the user gives the "page-down" scrollbar action. | |
| 796 \(The way this is done can vary from scrollbar to scrollbar.) One argument, | |
| 797 a cons containing the scrollbar's window and a value (#### document me! | |
| 798 This value is nil for Motif/Lucid scrollbars and a number for Athena | |
| 799 scrollbars). You can advise this function to change the scrollbar | |
| 800 behavior. | |
| 801 */ | |
| 802 (object)) | |
| 803 { | |
| 804 Lisp_Object window = Fcar (object); | |
| 805 | |
| 806 CHECK_LIVE_WINDOW (window); | |
| 807 /* Motif and Athena scrollbars behave differently, but in accordance | |
| 808 with their standard behaviors. It is not possible to hide the | |
| 809 differences down in lwlib because knowledge of XEmacs buffer and | |
| 810 cursor motion routines is necessary. */ | |
| 442 | 811 |
| 812 if (NILP (XCDR (object))) | |
| 813 window_scroll (window, Qnil, 1, ERROR_ME_NOT); | |
| 814 else | |
| 815 { | |
| 816 Lisp_Object value = Fcdr (object); | |
| 817 CHECK_INT (value); | |
| 818 Fmove_to_window_line (value, window); | |
| 819 Fcenter_to_window_line (Qzero, window); | |
| 820 } | |
| 821 | |
| 428 | 822 zmacs_region_stays = 1; |
| 823 return Qnil; | |
| 824 } | |
| 825 | |
| 826 DEFUN ("scrollbar-to-top", Fscrollbar_to_top, 1, 1, 0, /* | |
| 827 Function called when the user invokes the "to-top" scrollbar action. | |
| 828 The way this is done can vary from scrollbar to scrollbar, but | |
| 829 C-button1 on the up-arrow is very common. One argument, the | |
| 830 scrollbar's window. You can advise this function to change the | |
| 831 scrollbar behavior. | |
| 832 */ | |
| 833 (window)) | |
| 834 { | |
| 835 Lisp_Object orig_pt = Fwindow_point (window); | |
| 836 Fset_window_point (window, Fpoint_min (Fwindow_buffer (window))); | |
| 837 Fcenter_to_window_line (Qzero, window); | |
| 838 scrollbar_reset_cursor (window, orig_pt); | |
| 839 zmacs_region_stays = 1; | |
| 840 return Qnil; | |
| 841 } | |
| 842 | |
| 843 DEFUN ("scrollbar-to-bottom", Fscrollbar_to_bottom, 1, 1, 0, /* | |
| 844 Function called when the user invokes the "to-bottom" scrollbar action. | |
| 845 The way this is done can vary from scrollbar to scrollbar, but | |
| 846 C-button1 on the down-arrow is very common. One argument, the | |
| 847 scrollbar's window. You can advise this function to change the | |
| 848 scrollbar behavior. | |
| 849 */ | |
| 850 (window)) | |
| 851 { | |
| 852 Lisp_Object orig_pt = Fwindow_point (window); | |
| 853 Fset_window_point (window, Fpoint_max (Fwindow_buffer (window))); | |
| 854 Fcenter_to_window_line (make_int (-3), window); | |
| 855 scrollbar_reset_cursor (window, orig_pt); | |
| 856 zmacs_region_stays = 1; | |
| 857 return Qnil; | |
| 858 } | |
| 859 | |
| 860 DEFUN ("scrollbar-vertical-drag", Fscrollbar_vertical_drag, 1, 1, 0, /* | |
| 861 Function called when the user drags the vertical scrollbar slider. | |
| 862 One argument, a cons containing the scrollbar's window and a value | |
| 863 between point-min and point-max. You can advise this function to | |
| 864 change the scrollbar behavior. | |
| 865 */ | |
| 866 (object)) | |
| 867 { | |
| 665 | 868 Charbpos start_pos; |
| 428 | 869 Lisp_Object orig_pt; |
| 870 Lisp_Object window = Fcar (object); | |
| 871 Lisp_Object value = Fcdr (object); | |
| 872 | |
| 873 orig_pt = Fwindow_point (window); | |
| 874 Fset_marker (XWINDOW (window)->sb_point, value, Fwindow_buffer (window)); | |
| 875 start_pos = scrollbar_point (XWINDOW (window), 1); | |
| 876 Fset_window_start (window, make_int (start_pos), Qnil); | |
| 877 scrollbar_reset_cursor (window, orig_pt); | |
| 878 Fsit_for(Qzero, Qnil); | |
| 879 zmacs_region_stays = 1; | |
| 880 return Qnil; | |
| 881 } | |
| 882 | |
| 883 DEFUN ("scrollbar-set-hscroll", Fscrollbar_set_hscroll, 2, 2, 0, /* | |
| 884 Set WINDOW's hscroll position to VALUE. | |
| 885 This ensures that VALUE is in the proper range for the horizontal scrollbar. | |
| 886 */ | |
| 887 (window, value)) | |
| 888 { | |
| 889 struct window *w; | |
| 890 int hscroll, wcw, max_len; | |
| 891 | |
| 892 CHECK_LIVE_WINDOW (window); | |
| 893 if (!EQ (value, Qmax)) | |
| 894 CHECK_INT (value); | |
| 895 | |
| 896 w = XWINDOW (window); | |
| 897 wcw = window_char_width (w, 0) - 1; | |
| 440 | 898 /* #### We should be able to scroll further right as long as there is |
| 428 | 899 a visible truncation glyph. This calculation for max is bogus. */ |
| 900 max_len = w->max_line_len + 2; | |
| 901 | |
| 902 if (EQ (value, Qmax) || (XINT (value) > (max_len - wcw))) | |
| 903 hscroll = max_len - wcw; | |
| 904 else | |
| 905 hscroll = XINT (value); | |
| 906 | |
| 907 /* Can't allow this out of set-window-hscroll's acceptable range. */ | |
| 908 /* #### What hell on the earth this code limits scroll size to the | |
| 909 machine-dependent SHORT size? -- kkm */ | |
| 910 if (hscroll < 0) | |
| 911 hscroll = 0; | |
| 912 else if (hscroll >= (1 << (SHORTBITS - 1)) - 1) | |
| 913 hscroll = (1 << (SHORTBITS - 1)) - 1; | |
| 914 | |
| 915 if (hscroll != w->hscroll) | |
| 916 Fset_window_hscroll (window, make_int (hscroll)); | |
| 917 | |
| 918 return Qnil; | |
| 919 } | |
| 920 | |
| 921 | |
| 922 /************************************************************************/ | |
| 923 /* initialization */ | |
| 924 /************************************************************************/ | |
| 925 | |
| 926 void | |
| 927 syms_of_scrollbar (void) | |
| 928 { | |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3024
diff
changeset
|
929 INIT_LISP_OBJECT (scrollbar_instance); |
| 617 | 930 |
| 563 | 931 DEFSYMBOL (Qscrollbar_line_up); |
| 932 DEFSYMBOL (Qscrollbar_line_down); | |
| 933 DEFSYMBOL (Qscrollbar_page_up); | |
| 934 DEFSYMBOL (Qscrollbar_page_down); | |
| 935 DEFSYMBOL (Qscrollbar_to_top); | |
| 936 DEFSYMBOL (Qscrollbar_to_bottom); | |
| 937 DEFSYMBOL (Qscrollbar_vertical_drag); | |
| 428 | 938 |
| 563 | 939 DEFSYMBOL (Qscrollbar_char_left); |
| 940 DEFSYMBOL (Qscrollbar_char_right); | |
| 941 DEFSYMBOL (Qscrollbar_page_left); | |
| 942 DEFSYMBOL (Qscrollbar_page_right); | |
| 943 DEFSYMBOL (Qscrollbar_to_left); | |
| 944 DEFSYMBOL (Qscrollbar_to_right); | |
| 945 DEFSYMBOL (Qscrollbar_horizontal_drag); | |
| 428 | 946 |
| 563 | 947 DEFSYMBOL (Qinit_scrollbar_from_resources); |
| 428 | 948 |
| 949 /* #### All these functions should be moved into Lisp. | |
| 950 See comment above. */ | |
| 951 DEFSUBR (Fscrollbar_line_up); | |
| 952 DEFSUBR (Fscrollbar_line_down); | |
| 953 DEFSUBR (Fscrollbar_page_up); | |
| 954 DEFSUBR (Fscrollbar_page_down); | |
| 955 DEFSUBR (Fscrollbar_to_top); | |
| 956 DEFSUBR (Fscrollbar_to_bottom); | |
| 957 DEFSUBR (Fscrollbar_vertical_drag); | |
| 958 | |
| 959 DEFSUBR (Fscrollbar_set_hscroll); | |
| 960 } | |
| 961 | |
| 962 void | |
| 963 vars_of_scrollbar (void) | |
| 964 { | |
| 965 DEFVAR_LISP ("scrollbar-pointer-glyph", &Vscrollbar_pointer_glyph /* | |
| 966 *The shape of the mouse-pointer when over a scrollbar. | |
| 967 This is a glyph; use `set-glyph-image' to change it. | |
| 968 If unspecified in a particular domain, the window-system-provided | |
| 969 default pointer is used. | |
| 970 */ ); | |
| 971 | |
| 972 Fprovide (intern ("scrollbar")); | |
| 973 } | |
| 974 | |
| 975 void | |
| 976 specifier_vars_of_scrollbar (void) | |
| 977 { | |
| 978 DEFVAR_SPECIFIER ("scrollbar-width", &Vscrollbar_width /* | |
| 979 *Width of vertical scrollbars. | |
| 980 This is a specifier; use `set-specifier' to change it. | |
| 981 */ ); | |
| 982 Vscrollbar_width = make_magic_specifier (Qnatnum); | |
| 983 set_specifier_fallback | |
| 984 (Vscrollbar_width, | |
| 1295 | 985 #ifdef HAVE_TTY |
| 1287 | 986 list2 (Fcons (list1 (Qtty), make_int (0)), |
| 1295 | 987 Fcons (Qnil, make_int (DEFAULT_SCROLLBAR_WIDTH))) |
| 988 #else | |
| 989 list1 (Fcons (Qnil, make_int (DEFAULT_SCROLLBAR_WIDTH))) | |
| 990 #endif | |
| 991 ); | |
| 428 | 992 set_specifier_caching (Vscrollbar_width, |
| 438 | 993 offsetof (struct window, scrollbar_width), |
| 428 | 994 vertical_scrollbar_changed_in_window, |
| 438 | 995 offsetof (struct frame, scrollbar_width), |
| 444 | 996 frame_size_slipped, 0); |
| 428 | 997 |
| 998 DEFVAR_SPECIFIER ("scrollbar-height", &Vscrollbar_height /* | |
| 999 *Height of horizontal scrollbars. | |
| 1000 This is a specifier; use `set-specifier' to change it. | |
| 1001 */ ); | |
| 1002 Vscrollbar_height = make_magic_specifier (Qnatnum); | |
| 1003 set_specifier_fallback | |
| 1004 (Vscrollbar_height, | |
| 1295 | 1005 #ifdef HAVE_TTY |
| 1287 | 1006 list2 (Fcons (list1 (Qtty), make_int (0)), |
| 1295 | 1007 Fcons (Qnil, make_int (DEFAULT_SCROLLBAR_HEIGHT))) |
| 1008 #else | |
| 1009 list1 (Fcons (Qnil, make_int (DEFAULT_SCROLLBAR_HEIGHT))) | |
| 1010 #endif | |
| 1011 ); | |
| 428 | 1012 set_specifier_caching (Vscrollbar_height, |
| 438 | 1013 offsetof (struct window, scrollbar_height), |
| 428 | 1014 some_window_value_changed, |
| 438 | 1015 offsetof (struct frame, scrollbar_height), |
| 444 | 1016 frame_size_slipped, 0); |
| 428 | 1017 |
| 1018 DEFVAR_SPECIFIER ("horizontal-scrollbar-visible-p", &Vhorizontal_scrollbar_visible_p /* | |
| 1019 *Whether the horizontal scrollbar is visible. | |
| 1020 This is a specifier; use `set-specifier' to change it. | |
| 1021 */ ); | |
| 1022 Vhorizontal_scrollbar_visible_p = Fmake_specifier (Qboolean); | |
| 1023 set_specifier_fallback (Vhorizontal_scrollbar_visible_p, | |
| 1024 list1 (Fcons (Qnil, Qt))); | |
| 1025 set_specifier_caching (Vhorizontal_scrollbar_visible_p, | |
| 438 | 1026 offsetof (struct window, |
| 1027 horizontal_scrollbar_visible_p), | |
| 428 | 1028 some_window_value_changed, |
| 438 | 1029 offsetof (struct frame, |
| 1030 horizontal_scrollbar_visible_p), | |
| 444 | 1031 frame_size_slipped, 0); |
| 428 | 1032 |
| 1033 DEFVAR_SPECIFIER ("vertical-scrollbar-visible-p", &Vvertical_scrollbar_visible_p /* | |
| 1034 *Whether the vertical scrollbar is visible. | |
| 1035 This is a specifier; use `set-specifier' to change it. | |
| 1036 */ ); | |
| 1037 Vvertical_scrollbar_visible_p = Fmake_specifier (Qboolean); | |
| 1038 set_specifier_fallback (Vvertical_scrollbar_visible_p, | |
| 1039 list1 (Fcons (Qnil, Qt))); | |
| 1040 set_specifier_caching (Vvertical_scrollbar_visible_p, | |
| 438 | 1041 offsetof (struct window, |
| 1042 vertical_scrollbar_visible_p), | |
| 428 | 1043 vertical_scrollbar_changed_in_window, |
| 438 | 1044 offsetof (struct frame, |
| 1045 vertical_scrollbar_visible_p), | |
| 444 | 1046 frame_size_slipped, 0); |
| 428 | 1047 |
| 1048 DEFVAR_SPECIFIER ("scrollbar-on-left-p", &Vscrollbar_on_left_p /* | |
| 1049 *Whether the vertical scrollbar is on the left side of window or frame. | |
| 1050 This is a specifier; use `set-specifier' to change it. | |
| 1051 */ ); | |
| 1052 Vscrollbar_on_left_p = Fmake_specifier (Qboolean); | |
| 442 | 1053 |
| 428 | 1054 { |
| 1055 /* Kludge. Under X, we want athena scrollbars on the left, | |
| 1056 while all other scrollbars go on the right by default. */ | |
| 1057 Lisp_Object fallback = list1 (Fcons (Qnil, Qnil)); | |
| 1058 #if defined (HAVE_X_WINDOWS) \ | |
| 1059 && !defined (LWLIB_SCROLLBARS_MOTIF) \ | |
| 1060 && !defined (LWLIB_SCROLLBARS_LUCID) \ | |
| 1061 && !defined (LWLIB_SCROLLBARS_ATHENA3D) | |
| 1062 | |
| 1063 fallback = Fcons (Fcons (list1 (Qx), Qt), fallback); | |
| 1064 #endif | |
| 1065 set_specifier_fallback (Vscrollbar_on_left_p, fallback); | |
| 1066 } | |
| 1067 | |
| 1068 set_specifier_caching (Vscrollbar_on_left_p, | |
| 438 | 1069 offsetof (struct window, scrollbar_on_left_p), |
| 428 | 1070 vertical_scrollbar_changed_in_window, |
| 438 | 1071 offsetof (struct frame, scrollbar_on_left_p), |
| 444 | 1072 frame_size_slipped, 0); |
| 428 | 1073 |
| 1074 DEFVAR_SPECIFIER ("scrollbar-on-top-p", &Vscrollbar_on_top_p /* | |
| 1075 *Whether the horizontal scrollbar is on the top side of window or frame. | |
| 1076 This is a specifier; use `set-specifier' to change it. | |
| 1077 */ ); | |
| 1078 Vscrollbar_on_top_p = Fmake_specifier (Qboolean); | |
| 1079 set_specifier_fallback (Vscrollbar_on_top_p, | |
| 1080 list1 (Fcons (Qnil, Qnil))); | |
| 1081 set_specifier_caching (Vscrollbar_on_top_p, | |
| 438 | 1082 offsetof (struct window, scrollbar_on_top_p), |
| 428 | 1083 some_window_value_changed, |
| 438 | 1084 offsetof (struct frame, scrollbar_on_top_p), |
| 444 | 1085 frame_size_slipped, 0); |
| 428 | 1086 } |
| 1087 | |
| 1088 void | |
| 1089 complex_vars_of_scrollbar (void) | |
| 1090 { | |
| 1091 Vscrollbar_pointer_glyph = Fmake_glyph_internal (Qpointer); | |
| 1092 | |
| 1093 set_specifier_caching (XGLYPH (Vscrollbar_pointer_glyph)->image, | |
| 438 | 1094 offsetof (struct window, scrollbar_pointer), |
| 428 | 1095 scrollbar_pointer_changed_in_window, |
| 444 | 1096 0, 0, 0); |
| 428 | 1097 } |