Mercurial > hg > xemacs-beta
annotate src/scrollbar.c @ 5124:623d57b7fbe8 ben-lisp-object
separate regular and disksave finalization, print method fixes.
Create separate disksave method and make the finalize method only be for
actual object finalization, not disksave finalization.
Fix places where 0 was given in place of a printer -- print methods are
mandatory, and internal objects formerly without a print method now must
explicitly specify internal_object_printer().
Change the defn of CONSOLE_LIVE_P to avoid problems in some weird situations.
-------------------- ChangeLog entries follow: --------------------
src/ChangeLog addition:
2010-01-20 Ben Wing <ben@xemacs.org>
* alloc.c:
* alloc.c (very_old_free_lcrecord):
* alloc.c (disksave_object_finalization_1):
* alloc.c (make_lcrecord_list):
* alloc.c (alloc_managed_lcrecord):
* alloc.c (free_managed_lcrecord):
* alloc.c (sweep_lcrecords_1):
* buffer.c:
* bytecode.c:
* bytecode.c (Fcompiled_function_p):
* chartab.c:
* console-impl.h:
* console-impl.h (CONSOLE_TYPE_P):
* console.c:
* console.c (set_quit_events):
* data.c:
* data.c (Fmake_ephemeron):
* database.c:
* database.c (finalize_database):
* database.c (Fclose_database):
* device-msw.c:
* device-msw.c (finalize_devmode):
* device-msw.c (allocate_devmode):
* device.c:
* elhash.c:
* elhash.c (finalize_hash_table):
* eval.c:
* eval.c (bind_multiple_value_limits):
* event-stream.c:
* event-stream.c (finalize_command_builder):
* events.c:
* events.c (mark_event):
* extents.c:
* extents.c (finalize_extent_info):
* extents.c (uninit_buffer_extents):
* faces.c:
* file-coding.c:
* file-coding.c (finalize_coding_system):
* file-coding.h:
* file-coding.h (struct coding_system_methods):
* file-coding.h (struct detector):
* floatfns.c:
* floatfns.c (extract_float):
* fns.c:
* fns.c (Fidentity):
* font-mgr.c (finalize_fc_pattern):
* font-mgr.c (finalize_fc_config):
* frame.c:
* glyphs.c:
* glyphs.c (finalize_image_instance):
* glyphs.c (unmap_subwindow_instance_cache_mapper):
* gui.c:
* gui.c (gui_error):
* keymap.c:
* lisp.h (struct Lisp_Symbol):
* lrecord.h:
* lrecord.h (struct lrecord_implementation):
* lrecord.h (MC_ALLOC_CALL_FINALIZER):
* lrecord.h (MC_ALLOC_CALL_FINALIZER_FOR_DISKSAVE):
* lrecord.h (DEFINE_DUMPABLE_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_GENERAL_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_SIZABLE_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_SIZABLE_GENERAL_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_FROB_BLOCK_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_FROB_BLOCK_GENERAL_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_FROB_BLOCK_SIZABLE_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_SIZABLE_INTERNAL_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_GENERAL_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_SIZABLE_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_SIZABLE_GENERAL_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_FROB_BLOCK_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_FROB_BLOCK_GENERAL_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_FROB_BLOCK_SIZABLE_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_INTERNAL_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_SIZABLE_INTERNAL_LISP_OBJECT):
* lrecord.h (MAKE_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_MODULE_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_MODULE_GENERAL_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_MODULE_SIZABLE_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_MODULE_SIZABLE_GENERAL_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_MODULE_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_MODULE_GENERAL_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_MODULE_SIZABLE_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_MODULE_SIZABLE_GENERAL_LISP_OBJECT):
* lrecord.h (MAKE_MODULE_LISP_OBJECT):
* lstream.c:
* lstream.c (finalize_lstream):
* lstream.c (disksave_lstream):
* marker.c:
* marker.c (finalize_marker):
* mule-charset.c (make_charset):
* number.c:
* objects.c:
* objects.c (finalize_color_instance):
* objects.c (finalize_font_instance):
* opaque.c:
* opaque.c (make_opaque_ptr):
* process-nt.c:
* process-nt.c (nt_finalize_process_data):
* process-nt.c (nt_deactivate_process):
* process.c:
* process.c (finalize_process):
* procimpl.h (struct process_methods):
* scrollbar.c:
* scrollbar.c (free_scrollbar_instance):
* specifier.c (finalize_specifier):
* symbols.c:
* toolbar.c:
* toolbar.c (Ftoolbar_button_p):
* tooltalk.c:
* ui-gtk.c:
* ui-gtk.c (emacs_gtk_object_finalizer):
* ui-gtk.c (allocate_emacs_gtk_boxed_data):
* window.c:
* window.c (finalize_window):
* window.c (mark_window_as_deleted):
Separate out regular and disksave finalization. Instead of a
FOR_DISKSAVE argument to the finalizer, create a separate object
method `disksaver'. Make `finalizer' have only one argument.
Go through and separate out all finalize methods into finalize
and disksave. Delete lots of thereby redundant disksave checking.
Delete places that signal an error if we attempt to disksave --
all of these objects are non-dumpable and we will get an error
from pdump anyway if we attempt to dump them. After this is done,
only one object remains that has a disksave method -- lstream.
Change DEFINE_*_LISP_OBJECT_WITH_PROPS to DEFINE_*_GENERAL_LISP_OBJECT,
which is used for specifying either property methods or disksave
methods (or in the future, any other less-used methods).
Remove the for_disksave argument to finalize_process_data. Don't
provide a disksaver for processes because no one currently needs
it.
Clean up various places where objects didn't provide a print method.
It was made mandatory in previous changes, and all methods now
either provide their own print method or use internal_object_printer
or external_object_printer.
Change the definition of CONSOLE_LIVE_P to use the contype enum
rather than looking into the conmeths structure -- in some weird
situations with dead objects, the conmeths structure is NULL,
and printing such objects from debug_print() will crash if we try
to look into the conmeths structure.
| author | Ben Wing <ben@xemacs.org> |
|---|---|
| date | Wed, 20 Jan 2010 07:05:57 -0600 |
| parents | d1247f3cc363 |
| children | a9c41067dd88 |
| 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>. | |
| 1318 | 6 Copyright (C) 2003 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); | |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3024
diff
changeset
|
199 Lisp_Object obj = ALLOC_LISP_OBJECT (scrollbar_instance); |
|
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 { | |
|
5120
d1247f3cc363
latest work on lisp-object workspace;
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
272 total += LISP_OBJECT_STORAGE_SIZE (inst, sizeof (*inst), ovstats); |
| 428 | 273 inst = inst->next; |
| 274 } | |
| 275 | |
| 276 return total; | |
| 277 } | |
| 278 | |
| 279 #endif /* MEMORY_USAGE_STATS */ | |
| 280 | |
| 281 void | |
| 282 update_window_scrollbars (struct window *w, struct window_mirror *mirror, | |
| 283 int active, int horiz_only) | |
| 284 { | |
| 285 struct frame *f = XFRAME (w->frame); | |
| 286 struct device *d = XDEVICE (f->device); | |
| 1318 | 287 int depth; |
| 428 | 288 |
| 289 if (!HAS_DEVMETH_P (d, create_scrollbar_instance)) | |
| 290 return; | |
| 291 | |
| 1318 | 292 depth = enter_redisplay_critical_section_maybe (); |
| 428 | 293 |
| 294 /* It is possible for this to get called from the mirror update | |
| 295 routines. In that case the structure is in an indeterminate | |
| 296 state but we know exactly what struct we are working with. So we | |
| 297 pass it in in that case. We also take advantage of it at some | |
| 298 other points where we know what the mirror struct is. */ | |
| 299 if (!mirror) | |
| 300 mirror = find_window_mirror (w); | |
| 301 | |
| 302 if (!mirror->scrollbar_vertical_instance && active) | |
| 303 mirror->scrollbar_vertical_instance = get_scrollbar_instance (f, 1); | |
| 304 | |
| 305 if (!mirror->scrollbar_horizontal_instance && active) | |
| 306 mirror->scrollbar_horizontal_instance = get_scrollbar_instance (f, 0); | |
| 307 | |
| 308 if (!horiz_only && mirror->scrollbar_vertical_instance) | |
| 309 { | |
| 310 int size = (active ? window_scrollbar_width (w) : 0); | |
| 311 struct scrollbar_instance *instance; | |
| 312 | |
| 313 instance = mirror->scrollbar_vertical_instance; | |
| 314 instance->scrollbar_is_active = active; | |
| 315 instance->mirror = mirror; | |
| 316 | |
| 317 if (active && size) | |
| 318 update_scrollbar_instance (w, 1, instance); | |
| 319 MAYBE_DEVMETH (d, update_scrollbar_instance_status, | |
| 320 (w, active, size, instance)); | |
| 321 | |
| 322 if (!active) | |
| 323 { | |
| 324 release_scrollbar_instance (f, 1, instance); | |
| 325 mirror->scrollbar_vertical_instance = NULL; | |
| 326 } | |
| 327 } | |
| 328 | |
| 329 if (mirror->scrollbar_horizontal_instance) | |
| 330 { | |
| 331 int size = (active ? window_scrollbar_height (w) : 0); | |
| 332 struct scrollbar_instance *instance; | |
| 333 | |
| 334 instance = mirror->scrollbar_horizontal_instance; | |
| 335 instance->scrollbar_is_active = active; | |
| 336 instance->mirror = mirror; | |
| 337 | |
| 338 if (active && size) | |
| 339 update_scrollbar_instance (w, 0, instance); | |
| 340 MAYBE_DEVMETH (d, update_scrollbar_instance_status, | |
| 341 (w, active, size, instance)); | |
| 342 | |
| 343 if (!active) | |
| 344 { | |
| 345 release_scrollbar_instance (f, 0, instance); | |
| 346 mirror->scrollbar_horizontal_instance = NULL; | |
| 347 } | |
| 348 } | |
| 349 | |
| 1318 | 350 exit_redisplay_critical_section_maybe (depth); |
| 428 | 351 } |
| 352 | |
| 353 void | |
| 354 release_window_mirror_scrollbars (struct window_mirror *mir) | |
| 355 { | |
| 356 struct device *d = XDEVICE (mir->frame->device); | |
| 357 | |
| 358 if (!HAS_DEVMETH_P (d, create_scrollbar_instance)) | |
| 359 return; | |
| 360 | |
| 361 if (mir->scrollbar_vertical_instance) | |
| 362 { | |
| 363 release_scrollbar_instance (mir->frame, 1, | |
| 364 mir->scrollbar_vertical_instance); | |
| 365 MAYBE_DEVMETH (d, release_scrollbar_instance, | |
| 366 (mir->scrollbar_vertical_instance)); | |
| 367 } | |
| 368 mir->scrollbar_vertical_instance = 0; | |
| 369 | |
| 370 if (mir->scrollbar_horizontal_instance) | |
| 371 { | |
| 372 release_scrollbar_instance (mir->frame, 0, | |
| 373 mir->scrollbar_horizontal_instance); | |
| 374 MAYBE_DEVMETH (d, release_scrollbar_instance, | |
| 375 (mir->scrollbar_horizontal_instance)); | |
| 376 } | |
| 377 mir->scrollbar_horizontal_instance = 0; | |
| 378 } | |
| 379 | |
| 380 /* | |
| 381 * If w->sb_point is on the top line then return w->sb_point else | |
| 382 * return w->start. If flag, then return beginning point of line | |
| 383 * which w->sb_point lies on. | |
| 384 */ | |
| 665 | 385 static Charbpos |
| 428 | 386 scrollbar_point (struct window *w, int flag) |
| 387 { | |
| 665 | 388 Charbpos start_pos, end_pos, sb_pos; |
| 428 | 389 Lisp_Object buf; |
| 390 struct buffer *b; | |
| 391 | |
| 392 if (NILP (w->buffer)) /* non-leaf window */ | |
| 393 return 0; | |
| 394 | |
| 395 start_pos = marker_position (w->start[CURRENT_DISP]); | |
| 396 sb_pos = marker_position (w->sb_point); | |
| 397 | |
| 398 if (!flag && sb_pos < start_pos) | |
| 399 return start_pos; | |
| 400 | |
| 401 buf = get_buffer (w->buffer, 0); | |
| 402 if (!NILP (buf)) | |
| 403 b = XBUFFER (buf); | |
| 404 else | |
| 405 return start_pos; | |
| 406 | |
| 407 if (flag) | |
| 408 end_pos = find_next_newline_no_quit (b, sb_pos, -1); | |
| 409 else | |
| 410 end_pos = find_next_newline_no_quit (b, start_pos, 1); | |
| 411 | |
| 412 if (flag) | |
| 413 return end_pos; | |
| 414 else if (sb_pos > end_pos) | |
| 415 return start_pos; | |
| 416 else | |
| 417 return sb_pos; | |
| 418 } | |
| 419 | |
| 420 /* | |
| 421 * Update a window's horizontal or vertical scrollbar. | |
| 422 */ | |
| 423 static void | |
| 424 update_scrollbar_instance (struct window *w, int vertical, | |
| 425 struct scrollbar_instance *instance) | |
| 426 { | |
| 427 struct frame *f = XFRAME (w->frame); | |
| 428 struct device *d = XDEVICE (f->device); | |
| 429 struct buffer *b = XBUFFER (w->buffer); | |
| 665 | 430 Charbpos start_pos, end_pos, sb_pos; |
| 428 | 431 int scrollbar_width = window_scrollbar_width (w); |
| 432 int scrollbar_height = window_scrollbar_height (w); | |
| 433 | |
| 434 int new_line_increment = -1, new_page_increment = -1; | |
| 435 int new_minimum = -1, new_maximum = -1; | |
| 436 int new_slider_size = -1, new_slider_position = -1; | |
| 437 int new_width = -1, new_height = -1, new_x = -1, new_y = -1; | |
| 2286 | 438 #if 0 |
| 444 | 439 struct window *new_window = 0; /* #### currently unused */ |
| 2286 | 440 #endif |
| 428 | 441 |
| 442 end_pos = BUF_Z (b) - w->window_end_pos[CURRENT_DISP]; | |
| 443 sb_pos = scrollbar_point (w, 0); | |
| 444 start_pos = sb_pos; | |
| 445 | |
| 446 /* The end position must be strictly greater than the start | |
| 447 position, at least for the Motify scrollbar. It shouldn't hurt | |
| 448 anything for other scrollbar implementations. */ | |
| 449 if (end_pos <= start_pos) | |
| 450 end_pos = start_pos + 1; | |
| 451 | |
| 452 if (vertical) | |
| 453 { | |
| 454 new_height = WINDOW_TEXT_HEIGHT (w); | |
| 455 new_width = scrollbar_width; | |
| 456 } | |
| 457 else | |
| 458 { | |
| 459 new_height = scrollbar_height; | |
| 460 new_width = WINDOW_TEXT_WIDTH (w); | |
| 461 } | |
| 462 | |
| 463 /* If the height and width are not greater than 0, then later on the | |
| 464 Motif widgets will bitch and moan. */ | |
| 465 if (new_height <= 0) | |
| 466 new_height = 1; | |
| 467 if (new_width <= 0) | |
| 468 new_width = 1; | |
| 469 | |
| 470 assert (instance->mirror && XWINDOW (real_window(instance->mirror, 0)) == w); | |
| 471 | |
| 472 /* Only character-based scrollbars are implemented at the moment. | |
| 473 Line-based will be implemented in the future. */ | |
| 474 | |
| 475 instance->scrollbar_is_active = 1; | |
| 476 new_line_increment = 1; | |
| 477 new_page_increment = 1; | |
| 478 | |
| 479 /* We used to check for inhibit_scrollbar_slider_size_change here, | |
| 480 but that seems bogus. */ | |
| 481 { | |
| 482 int x_offset, y_offset; | |
| 483 | |
| 484 /* Scrollbars are always the farthest from the text area, barring | |
| 485 gutters. */ | |
| 486 if (vertical) | |
| 487 { | |
| 488 if (!NILP (w->scrollbar_on_left_p)) | |
| 489 { | |
| 490 x_offset = WINDOW_LEFT (w); | |
| 491 } | |
| 442 | 492 else |
| 428 | 493 { |
| 494 x_offset = WINDOW_RIGHT (w) - scrollbar_width; | |
| 495 if (window_needs_vertical_divider (w)) | |
| 496 x_offset -= window_divider_width (w); | |
| 497 } | |
| 498 y_offset = WINDOW_TEXT_TOP (w) + f->scrollbar_y_offset; | |
| 499 } | |
| 500 else | |
| 501 { | |
| 502 x_offset = WINDOW_TEXT_LEFT (w); | |
| 503 y_offset = f->scrollbar_y_offset; | |
| 504 | |
| 505 if (!NILP (w->scrollbar_on_top_p)) | |
| 506 { | |
| 507 y_offset += WINDOW_TOP (w); | |
| 508 } | |
| 509 else | |
| 510 { | |
| 511 y_offset += WINDOW_TEXT_BOTTOM (w); | |
| 512 } | |
| 513 } | |
| 514 | |
| 515 new_x = x_offset; | |
| 516 new_y = y_offset; | |
| 517 } | |
| 518 | |
| 519 /* A disabled scrollbar has its slider sized to the entire height of | |
| 520 the scrollbar. Currently the minibuffer scrollbar is | |
| 521 disabled. */ | |
| 522 if (!MINI_WINDOW_P (w) && vertical) | |
| 523 { | |
| 524 if (!DEVMETH_OR_GIVEN (d, inhibit_scrollbar_slider_size_change, (), 0)) | |
| 525 { | |
| 526 new_minimum = BUF_BEGV (b); | |
| 527 new_maximum = max (BUF_ZV (b), new_minimum + 1); | |
| 528 new_slider_size = min ((end_pos - start_pos), | |
| 529 (new_maximum - new_minimum)); | |
| 530 new_slider_position = sb_pos; | |
| 2286 | 531 #if 0 |
| 428 | 532 new_window = w; |
| 2286 | 533 #endif |
| 428 | 534 } |
| 535 } | |
| 536 else if (!MINI_WINDOW_P (w)) | |
| 537 { | |
| 538 /* The minus one is to account for the truncation glyph. */ | |
| 539 int wcw = window_char_width (w, 0) - 1; | |
| 540 int max_width, max_slide; | |
| 541 | |
| 542 if (w->max_line_len < wcw) | |
| 543 { | |
| 544 max_width = 1; | |
| 545 max_slide = 1; | |
| 546 wcw = 1; | |
| 547 } | |
| 548 else | |
| 549 { | |
| 550 max_width = w->max_line_len + 2; | |
| 551 max_slide = max_width - wcw; | |
| 552 } | |
| 553 | |
| 554 new_minimum = 0; | |
| 555 new_maximum = max_width; | |
| 556 new_slider_size = wcw; | |
| 557 new_slider_position = min (w->hscroll, max_slide); | |
| 558 } | |
| 559 else /* MINI_WINDOW_P (w) */ | |
| 560 { | |
| 561 new_minimum = 1; | |
| 562 new_maximum = 2; | |
| 563 new_slider_size = 1; | |
| 564 new_slider_position = 1; | |
| 565 instance->scrollbar_is_active = 0; | |
| 566 } | |
| 567 | |
| 568 DEVMETH (d, update_scrollbar_instance_values, (w, instance, | |
| 569 new_line_increment, | |
| 570 new_page_increment, | |
| 571 new_minimum, | |
| 572 new_maximum, | |
| 573 new_slider_size, | |
| 574 new_slider_position, | |
| 575 new_width, new_height, | |
| 576 new_x, new_y)); | |
| 577 } | |
| 578 | |
| 579 void | |
| 580 init_frame_scrollbars (struct frame *f) | |
| 581 { | |
| 582 struct device *d = XDEVICE (f->device); | |
| 583 | |
| 584 if (HAS_DEVMETH_P (d, create_scrollbar_instance)) | |
| 585 { | |
| 586 int depth = unlock_ghost_specifiers_protected (); | |
| 793 | 587 Lisp_Object frame = wrap_frame (f); |
| 588 | |
| 428 | 589 call_critical_lisp_code (XDEVICE (FRAME_DEVICE (f)), |
| 590 Qinit_scrollbar_from_resources, | |
| 591 frame); | |
| 771 | 592 unbind_to (depth); |
| 428 | 593 } |
| 594 } | |
| 595 | |
| 596 void | |
| 597 init_device_scrollbars (struct device *d) | |
| 598 { | |
| 599 if (HAS_DEVMETH_P (d, create_scrollbar_instance)) | |
| 600 { | |
| 601 int depth = unlock_ghost_specifiers_protected (); | |
| 793 | 602 Lisp_Object device = wrap_device (d); |
| 603 | |
| 428 | 604 call_critical_lisp_code (d, |
| 605 Qinit_scrollbar_from_resources, | |
| 606 device); | |
| 771 | 607 unbind_to (depth); |
| 428 | 608 } |
| 609 } | |
| 610 | |
| 611 void | |
| 612 init_global_scrollbars (struct device *d) | |
| 613 { | |
| 614 if (HAS_DEVMETH_P (d, create_scrollbar_instance)) | |
| 615 { | |
| 616 int depth = unlock_ghost_specifiers_protected (); | |
| 617 call_critical_lisp_code (d, | |
| 618 Qinit_scrollbar_from_resources, | |
| 619 Qglobal); | |
| 771 | 620 unbind_to (depth); |
| 428 | 621 } |
| 622 } | |
| 623 | |
| 624 static void | |
| 2286 | 625 vertical_scrollbar_changed_in_window (Lisp_Object UNUSED (specifier), |
| 428 | 626 struct window *w, |
| 2286 | 627 Lisp_Object UNUSED (oldval)) |
| 428 | 628 { |
| 629 /* Hold on your cerebella guys. If we always show the dividers, | |
| 630 changing scrollbar affects only how the text and scrollbar are | |
| 631 laid out in the window. If we do not want the dividers to show up | |
| 632 always, then we mark more drastic change, because changing | |
| 633 divider appearance changes lotta things. Although we actually need | |
| 634 to do this only if the scrollbar has appeared or disappeared | |
| 635 completely at either window edge, we do this always, as users | |
| 636 usually do not reposition scrollbars 200 times a second or so. Do | |
| 637 you? */ | |
| 638 if (NILP (w->vertical_divider_always_visible_p)) | |
| 639 MARK_FRAME_WINDOWS_STRUCTURE_CHANGED (XFRAME (WINDOW_FRAME (w))); | |
| 640 else | |
| 641 MARK_WINDOWS_CHANGED (w); | |
| 642 } | |
| 643 | |
| 644 /* This function is called as a result of a change to the | |
| 645 `scrollbar-pointer' glyph. */ | |
| 646 static void | |
| 2286 | 647 scrollbar_pointer_changed_in_window (Lisp_Object UNUSED (specifier), |
| 648 struct window *w, | |
| 649 Lisp_Object UNUSED (oldval)) | |
| 428 | 650 { |
| 651 struct frame *f = XFRAME (WINDOW_FRAME (w)); | |
| 652 | |
| 653 if (f->init_finished) | |
| 654 MAYBE_FRAMEMETH (f, scrollbar_pointer_changed_in_window, (w)); | |
| 655 } | |
| 656 | |
| 657 /* #### | |
| 658 | |
| 659 All of the following stuff is functions that handle scrollbar | |
| 660 actions. All of it should be moved into Lisp. This may require | |
| 661 adding some badly-needed primitives. */ | |
| 662 | |
| 663 /********** vertical scrollbar stuff **********/ | |
| 664 | |
| 665 /* | |
| 666 * If the original point is still visible, put the cursor back there. | |
| 667 * Otherwise, when scrolling down stick it at the beginning of the | |
| 668 * first visible line and when scrolling up stick it at the beginning | |
| 669 * of the last visible line. | |
| 670 */ | |
| 671 | |
| 672 /* #### This function should be moved into Lisp */ | |
| 673 static void | |
| 674 scrollbar_reset_cursor (Lisp_Object win, Lisp_Object orig_pt) | |
| 675 { | |
| 676 /* When this function is called we know that start is already | |
| 677 accurate. We know this because either set-window-start or | |
| 678 recenter was called immediately prior to it being called. */ | |
| 679 Lisp_Object buf; | |
| 665 | 680 Charbpos start_pos = XINT (Fwindow_start (win)); |
| 681 Charbpos ptint = XINT (orig_pt); | |
| 428 | 682 struct window *w = XWINDOW (win); |
| 683 int selected = ((w == XWINDOW (Fselected_window (XFRAME (w->frame)->device))) | |
| 684 ? 1 | |
| 685 : 0); | |
| 686 | |
| 687 buf = Fwindow_buffer (win); | |
| 688 if (NILP (buf)) | |
| 689 return; /* the window was deleted out from under us */ | |
| 690 | |
| 691 if (ptint < XINT (Fwindow_start (win))) | |
| 692 { | |
| 693 if (selected) | |
| 694 Fgoto_char (make_int (start_pos), buf); | |
| 695 else | |
| 696 Fset_window_point (win, make_int (start_pos)); | |
| 697 } | |
| 1708 | 698 else if (!point_would_be_visible (XWINDOW (win), start_pos, ptint, 0)) |
| 428 | 699 { |
| 700 Fmove_to_window_line (make_int (-1), win); | |
| 701 | |
| 702 if (selected) | |
| 703 Fbeginning_of_line (Qnil, buf); | |
| 704 else | |
| 705 { | |
| 706 /* #### Taken from forward-line. */ | |
| 665 | 707 Charbpos pos; |
| 428 | 708 |
| 709 pos = find_next_newline (XBUFFER (buf), | |
| 710 marker_position (w->pointm[CURRENT_DISP]), | |
| 711 -1); | |
| 712 Fset_window_point (win, make_int (pos)); | |
| 713 } | |
| 714 } | |
| 715 else | |
| 716 { | |
| 717 if (selected) | |
| 718 Fgoto_char (orig_pt, buf); | |
| 719 else | |
| 720 Fset_window_point (win, orig_pt); | |
| 721 } | |
| 722 } | |
| 723 | |
| 724 DEFUN ("scrollbar-line-up", Fscrollbar_line_up, 1, 1, 0, /* | |
| 725 Function called when the line-up arrow on the scrollbar is clicked. | |
| 726 This is the little arrow at the top of the scrollbar. One argument, the | |
| 727 scrollbar's window. You can advise this function to change the scrollbar | |
| 728 behavior. | |
| 729 */ | |
| 730 (window)) | |
| 731 { | |
| 732 CHECK_LIVE_WINDOW (window); | |
| 733 window_scroll (window, make_int (1), -1, ERROR_ME_NOT); | |
| 734 zmacs_region_stays = 1; | |
| 735 return Qnil; | |
| 736 } | |
| 737 | |
| 738 DEFUN ("scrollbar-line-down", Fscrollbar_line_down, 1, 1, 0, /* | |
| 739 Function called when the line-down arrow on the scrollbar is clicked. | |
| 740 This is the little arrow at the bottom of the scrollbar. One argument, the | |
| 741 scrollbar's window. You can advise this function to change the scrollbar | |
| 742 behavior. | |
| 743 */ | |
| 744 (window)) | |
| 745 { | |
| 746 CHECK_LIVE_WINDOW (window); | |
| 747 window_scroll (window, make_int (1), 1, ERROR_ME_NOT); | |
| 748 zmacs_region_stays = 1; | |
| 749 return Qnil; | |
| 750 } | |
| 751 | |
| 752 DEFUN ("scrollbar-page-up", Fscrollbar_page_up, 1, 1, 0, /* | |
| 753 Function called when the user gives the "page-up" scrollbar action. | |
| 754 \(The way this is done can vary from scrollbar to scrollbar.) One argument, | |
| 755 a cons containing the scrollbar's window and a value (#### document me! | |
| 756 This value is nil for Motif/Lucid scrollbars and a number for Athena | |
| 757 scrollbars). You can advise this function to change the scrollbar | |
| 758 behavior. | |
| 759 */ | |
| 760 (object)) | |
| 761 { | |
| 762 Lisp_Object window = Fcar (object); | |
| 763 | |
| 764 CHECK_LIVE_WINDOW (window); | |
| 765 /* Motif and Athena scrollbars behave differently, but in accordance | |
| 766 with their standard behaviors. It is not possible to hide the | |
| 767 differences down in lwlib because knowledge of XEmacs buffer and | |
| 768 cursor motion routines is necessary. */ | |
| 442 | 769 |
| 770 if (NILP (XCDR (object))) | |
| 771 window_scroll (window, Qnil, -1, ERROR_ME_NOT); | |
| 772 else | |
| 773 { | |
| 665 | 774 Charbpos charbpos; |
| 442 | 775 Lisp_Object value = Fcdr (object); |
| 428 | 776 |
| 442 | 777 CHECK_INT (value); |
| 778 Fmove_to_window_line (Qzero, window); | |
| 779 /* can't use Fvertical_motion() because it moves the buffer point | |
| 780 rather than the window's point. | |
| 428 | 781 |
| 442 | 782 #### It does? Why does it take a window argument then? */ |
| 665 | 783 charbpos = vmotion (XWINDOW (window), XINT (Fwindow_point (window)), |
| 442 | 784 XINT (value), 0); |
| 665 | 785 Fset_window_point (window, make_int (charbpos)); |
| 442 | 786 Fcenter_to_window_line (Qzero, window); |
| 787 } | |
| 788 | |
| 428 | 789 zmacs_region_stays = 1; |
| 790 return Qnil; | |
| 791 } | |
| 792 | |
| 793 DEFUN ("scrollbar-page-down", Fscrollbar_page_down, 1, 1, 0, /* | |
| 794 Function called when the user gives the "page-down" scrollbar action. | |
| 795 \(The way this is done can vary from scrollbar to scrollbar.) One argument, | |
| 796 a cons containing the scrollbar's window and a value (#### document me! | |
| 797 This value is nil for Motif/Lucid scrollbars and a number for Athena | |
| 798 scrollbars). You can advise this function to change the scrollbar | |
| 799 behavior. | |
| 800 */ | |
| 801 (object)) | |
| 802 { | |
| 803 Lisp_Object window = Fcar (object); | |
| 804 | |
| 805 CHECK_LIVE_WINDOW (window); | |
| 806 /* Motif and Athena scrollbars behave differently, but in accordance | |
| 807 with their standard behaviors. It is not possible to hide the | |
| 808 differences down in lwlib because knowledge of XEmacs buffer and | |
| 809 cursor motion routines is necessary. */ | |
| 442 | 810 |
| 811 if (NILP (XCDR (object))) | |
| 812 window_scroll (window, Qnil, 1, ERROR_ME_NOT); | |
| 813 else | |
| 814 { | |
| 815 Lisp_Object value = Fcdr (object); | |
| 816 CHECK_INT (value); | |
| 817 Fmove_to_window_line (value, window); | |
| 818 Fcenter_to_window_line (Qzero, window); | |
| 819 } | |
| 820 | |
| 428 | 821 zmacs_region_stays = 1; |
| 822 return Qnil; | |
| 823 } | |
| 824 | |
| 825 DEFUN ("scrollbar-to-top", Fscrollbar_to_top, 1, 1, 0, /* | |
| 826 Function called when the user invokes the "to-top" scrollbar action. | |
| 827 The way this is done can vary from scrollbar to scrollbar, but | |
| 828 C-button1 on the up-arrow is very common. One argument, the | |
| 829 scrollbar's window. You can advise this function to change the | |
| 830 scrollbar behavior. | |
| 831 */ | |
| 832 (window)) | |
| 833 { | |
| 834 Lisp_Object orig_pt = Fwindow_point (window); | |
| 835 Fset_window_point (window, Fpoint_min (Fwindow_buffer (window))); | |
| 836 Fcenter_to_window_line (Qzero, window); | |
| 837 scrollbar_reset_cursor (window, orig_pt); | |
| 838 zmacs_region_stays = 1; | |
| 839 return Qnil; | |
| 840 } | |
| 841 | |
| 842 DEFUN ("scrollbar-to-bottom", Fscrollbar_to_bottom, 1, 1, 0, /* | |
| 843 Function called when the user invokes the "to-bottom" scrollbar action. | |
| 844 The way this is done can vary from scrollbar to scrollbar, but | |
| 845 C-button1 on the down-arrow is very common. One argument, the | |
| 846 scrollbar's window. You can advise this function to change the | |
| 847 scrollbar behavior. | |
| 848 */ | |
| 849 (window)) | |
| 850 { | |
| 851 Lisp_Object orig_pt = Fwindow_point (window); | |
| 852 Fset_window_point (window, Fpoint_max (Fwindow_buffer (window))); | |
| 853 Fcenter_to_window_line (make_int (-3), window); | |
| 854 scrollbar_reset_cursor (window, orig_pt); | |
| 855 zmacs_region_stays = 1; | |
| 856 return Qnil; | |
| 857 } | |
| 858 | |
| 859 DEFUN ("scrollbar-vertical-drag", Fscrollbar_vertical_drag, 1, 1, 0, /* | |
| 860 Function called when the user drags the vertical scrollbar slider. | |
| 861 One argument, a cons containing the scrollbar's window and a value | |
| 862 between point-min and point-max. You can advise this function to | |
| 863 change the scrollbar behavior. | |
| 864 */ | |
| 865 (object)) | |
| 866 { | |
| 665 | 867 Charbpos start_pos; |
| 428 | 868 Lisp_Object orig_pt; |
| 869 Lisp_Object window = Fcar (object); | |
| 870 Lisp_Object value = Fcdr (object); | |
| 871 | |
| 872 orig_pt = Fwindow_point (window); | |
| 873 Fset_marker (XWINDOW (window)->sb_point, value, Fwindow_buffer (window)); | |
| 874 start_pos = scrollbar_point (XWINDOW (window), 1); | |
| 875 Fset_window_start (window, make_int (start_pos), Qnil); | |
| 876 scrollbar_reset_cursor (window, orig_pt); | |
| 877 Fsit_for(Qzero, Qnil); | |
| 878 zmacs_region_stays = 1; | |
| 879 return Qnil; | |
| 880 } | |
| 881 | |
| 882 DEFUN ("scrollbar-set-hscroll", Fscrollbar_set_hscroll, 2, 2, 0, /* | |
| 883 Set WINDOW's hscroll position to VALUE. | |
| 884 This ensures that VALUE is in the proper range for the horizontal scrollbar. | |
| 885 */ | |
| 886 (window, value)) | |
| 887 { | |
| 888 struct window *w; | |
| 889 int hscroll, wcw, max_len; | |
| 890 | |
| 891 CHECK_LIVE_WINDOW (window); | |
| 892 if (!EQ (value, Qmax)) | |
| 893 CHECK_INT (value); | |
| 894 | |
| 895 w = XWINDOW (window); | |
| 896 wcw = window_char_width (w, 0) - 1; | |
| 440 | 897 /* #### We should be able to scroll further right as long as there is |
| 428 | 898 a visible truncation glyph. This calculation for max is bogus. */ |
| 899 max_len = w->max_line_len + 2; | |
| 900 | |
| 901 if (EQ (value, Qmax) || (XINT (value) > (max_len - wcw))) | |
| 902 hscroll = max_len - wcw; | |
| 903 else | |
| 904 hscroll = XINT (value); | |
| 905 | |
| 906 /* Can't allow this out of set-window-hscroll's acceptable range. */ | |
| 907 /* #### What hell on the earth this code limits scroll size to the | |
| 908 machine-dependent SHORT size? -- kkm */ | |
| 909 if (hscroll < 0) | |
| 910 hscroll = 0; | |
| 911 else if (hscroll >= (1 << (SHORTBITS - 1)) - 1) | |
| 912 hscroll = (1 << (SHORTBITS - 1)) - 1; | |
| 913 | |
| 914 if (hscroll != w->hscroll) | |
| 915 Fset_window_hscroll (window, make_int (hscroll)); | |
| 916 | |
| 917 return Qnil; | |
| 918 } | |
| 919 | |
| 920 | |
| 921 /************************************************************************/ | |
| 922 /* initialization */ | |
| 923 /************************************************************************/ | |
| 924 | |
| 925 void | |
| 926 syms_of_scrollbar (void) | |
| 927 { | |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3024
diff
changeset
|
928 INIT_LISP_OBJECT (scrollbar_instance); |
| 617 | 929 |
| 563 | 930 DEFSYMBOL (Qscrollbar_line_up); |
| 931 DEFSYMBOL (Qscrollbar_line_down); | |
| 932 DEFSYMBOL (Qscrollbar_page_up); | |
| 933 DEFSYMBOL (Qscrollbar_page_down); | |
| 934 DEFSYMBOL (Qscrollbar_to_top); | |
| 935 DEFSYMBOL (Qscrollbar_to_bottom); | |
| 936 DEFSYMBOL (Qscrollbar_vertical_drag); | |
| 428 | 937 |
| 563 | 938 DEFSYMBOL (Qscrollbar_char_left); |
| 939 DEFSYMBOL (Qscrollbar_char_right); | |
| 940 DEFSYMBOL (Qscrollbar_page_left); | |
| 941 DEFSYMBOL (Qscrollbar_page_right); | |
| 942 DEFSYMBOL (Qscrollbar_to_left); | |
| 943 DEFSYMBOL (Qscrollbar_to_right); | |
| 944 DEFSYMBOL (Qscrollbar_horizontal_drag); | |
| 428 | 945 |
| 563 | 946 DEFSYMBOL (Qinit_scrollbar_from_resources); |
| 428 | 947 |
| 948 /* #### All these functions should be moved into Lisp. | |
| 949 See comment above. */ | |
| 950 DEFSUBR (Fscrollbar_line_up); | |
| 951 DEFSUBR (Fscrollbar_line_down); | |
| 952 DEFSUBR (Fscrollbar_page_up); | |
| 953 DEFSUBR (Fscrollbar_page_down); | |
| 954 DEFSUBR (Fscrollbar_to_top); | |
| 955 DEFSUBR (Fscrollbar_to_bottom); | |
| 956 DEFSUBR (Fscrollbar_vertical_drag); | |
| 957 | |
| 958 DEFSUBR (Fscrollbar_set_hscroll); | |
| 959 } | |
| 960 | |
| 961 void | |
| 962 vars_of_scrollbar (void) | |
| 963 { | |
| 964 DEFVAR_LISP ("scrollbar-pointer-glyph", &Vscrollbar_pointer_glyph /* | |
| 965 *The shape of the mouse-pointer when over a scrollbar. | |
| 966 This is a glyph; use `set-glyph-image' to change it. | |
| 967 If unspecified in a particular domain, the window-system-provided | |
| 968 default pointer is used. | |
| 969 */ ); | |
| 970 | |
| 971 Fprovide (intern ("scrollbar")); | |
| 972 } | |
| 973 | |
| 974 void | |
| 975 specifier_vars_of_scrollbar (void) | |
| 976 { | |
| 977 DEFVAR_SPECIFIER ("scrollbar-width", &Vscrollbar_width /* | |
| 978 *Width of vertical scrollbars. | |
| 979 This is a specifier; use `set-specifier' to change it. | |
| 980 */ ); | |
| 981 Vscrollbar_width = make_magic_specifier (Qnatnum); | |
| 982 set_specifier_fallback | |
| 983 (Vscrollbar_width, | |
| 1295 | 984 #ifdef HAVE_TTY |
| 1287 | 985 list2 (Fcons (list1 (Qtty), make_int (0)), |
| 1295 | 986 Fcons (Qnil, make_int (DEFAULT_SCROLLBAR_WIDTH))) |
| 987 #else | |
| 988 list1 (Fcons (Qnil, make_int (DEFAULT_SCROLLBAR_WIDTH))) | |
| 989 #endif | |
| 990 ); | |
| 428 | 991 set_specifier_caching (Vscrollbar_width, |
| 438 | 992 offsetof (struct window, scrollbar_width), |
| 428 | 993 vertical_scrollbar_changed_in_window, |
| 438 | 994 offsetof (struct frame, scrollbar_width), |
| 444 | 995 frame_size_slipped, 0); |
| 428 | 996 |
| 997 DEFVAR_SPECIFIER ("scrollbar-height", &Vscrollbar_height /* | |
| 998 *Height of horizontal scrollbars. | |
| 999 This is a specifier; use `set-specifier' to change it. | |
| 1000 */ ); | |
| 1001 Vscrollbar_height = make_magic_specifier (Qnatnum); | |
| 1002 set_specifier_fallback | |
| 1003 (Vscrollbar_height, | |
| 1295 | 1004 #ifdef HAVE_TTY |
| 1287 | 1005 list2 (Fcons (list1 (Qtty), make_int (0)), |
| 1295 | 1006 Fcons (Qnil, make_int (DEFAULT_SCROLLBAR_HEIGHT))) |
| 1007 #else | |
| 1008 list1 (Fcons (Qnil, make_int (DEFAULT_SCROLLBAR_HEIGHT))) | |
| 1009 #endif | |
| 1010 ); | |
| 428 | 1011 set_specifier_caching (Vscrollbar_height, |
| 438 | 1012 offsetof (struct window, scrollbar_height), |
| 428 | 1013 some_window_value_changed, |
| 438 | 1014 offsetof (struct frame, scrollbar_height), |
| 444 | 1015 frame_size_slipped, 0); |
| 428 | 1016 |
| 1017 DEFVAR_SPECIFIER ("horizontal-scrollbar-visible-p", &Vhorizontal_scrollbar_visible_p /* | |
| 1018 *Whether the horizontal scrollbar is visible. | |
| 1019 This is a specifier; use `set-specifier' to change it. | |
| 1020 */ ); | |
| 1021 Vhorizontal_scrollbar_visible_p = Fmake_specifier (Qboolean); | |
| 1022 set_specifier_fallback (Vhorizontal_scrollbar_visible_p, | |
| 1023 list1 (Fcons (Qnil, Qt))); | |
| 1024 set_specifier_caching (Vhorizontal_scrollbar_visible_p, | |
| 438 | 1025 offsetof (struct window, |
| 1026 horizontal_scrollbar_visible_p), | |
| 428 | 1027 some_window_value_changed, |
| 438 | 1028 offsetof (struct frame, |
| 1029 horizontal_scrollbar_visible_p), | |
| 444 | 1030 frame_size_slipped, 0); |
| 428 | 1031 |
| 1032 DEFVAR_SPECIFIER ("vertical-scrollbar-visible-p", &Vvertical_scrollbar_visible_p /* | |
| 1033 *Whether the vertical scrollbar is visible. | |
| 1034 This is a specifier; use `set-specifier' to change it. | |
| 1035 */ ); | |
| 1036 Vvertical_scrollbar_visible_p = Fmake_specifier (Qboolean); | |
| 1037 set_specifier_fallback (Vvertical_scrollbar_visible_p, | |
| 1038 list1 (Fcons (Qnil, Qt))); | |
| 1039 set_specifier_caching (Vvertical_scrollbar_visible_p, | |
| 438 | 1040 offsetof (struct window, |
| 1041 vertical_scrollbar_visible_p), | |
| 428 | 1042 vertical_scrollbar_changed_in_window, |
| 438 | 1043 offsetof (struct frame, |
| 1044 vertical_scrollbar_visible_p), | |
| 444 | 1045 frame_size_slipped, 0); |
| 428 | 1046 |
| 1047 DEFVAR_SPECIFIER ("scrollbar-on-left-p", &Vscrollbar_on_left_p /* | |
| 1048 *Whether the vertical scrollbar is on the left side of window or frame. | |
| 1049 This is a specifier; use `set-specifier' to change it. | |
| 1050 */ ); | |
| 1051 Vscrollbar_on_left_p = Fmake_specifier (Qboolean); | |
| 442 | 1052 |
| 428 | 1053 { |
| 1054 /* Kludge. Under X, we want athena scrollbars on the left, | |
| 1055 while all other scrollbars go on the right by default. */ | |
| 1056 Lisp_Object fallback = list1 (Fcons (Qnil, Qnil)); | |
| 1057 #if defined (HAVE_X_WINDOWS) \ | |
| 1058 && !defined (LWLIB_SCROLLBARS_MOTIF) \ | |
| 1059 && !defined (LWLIB_SCROLLBARS_LUCID) \ | |
| 1060 && !defined (LWLIB_SCROLLBARS_ATHENA3D) | |
| 1061 | |
| 1062 fallback = Fcons (Fcons (list1 (Qx), Qt), fallback); | |
| 1063 #endif | |
| 1064 set_specifier_fallback (Vscrollbar_on_left_p, fallback); | |
| 1065 } | |
| 1066 | |
| 1067 set_specifier_caching (Vscrollbar_on_left_p, | |
| 438 | 1068 offsetof (struct window, scrollbar_on_left_p), |
| 428 | 1069 vertical_scrollbar_changed_in_window, |
| 438 | 1070 offsetof (struct frame, scrollbar_on_left_p), |
| 444 | 1071 frame_size_slipped, 0); |
| 428 | 1072 |
| 1073 DEFVAR_SPECIFIER ("scrollbar-on-top-p", &Vscrollbar_on_top_p /* | |
| 1074 *Whether the horizontal scrollbar is on the top side of window or frame. | |
| 1075 This is a specifier; use `set-specifier' to change it. | |
| 1076 */ ); | |
| 1077 Vscrollbar_on_top_p = Fmake_specifier (Qboolean); | |
| 1078 set_specifier_fallback (Vscrollbar_on_top_p, | |
| 1079 list1 (Fcons (Qnil, Qnil))); | |
| 1080 set_specifier_caching (Vscrollbar_on_top_p, | |
| 438 | 1081 offsetof (struct window, scrollbar_on_top_p), |
| 428 | 1082 some_window_value_changed, |
| 438 | 1083 offsetof (struct frame, scrollbar_on_top_p), |
| 444 | 1084 frame_size_slipped, 0); |
| 428 | 1085 } |
| 1086 | |
| 1087 void | |
| 1088 complex_vars_of_scrollbar (void) | |
| 1089 { | |
| 1090 Vscrollbar_pointer_glyph = Fmake_glyph_internal (Qpointer); | |
| 1091 | |
| 1092 set_specifier_caching (XGLYPH (Vscrollbar_pointer_glyph)->image, | |
| 438 | 1093 offsetof (struct window, scrollbar_pointer), |
| 428 | 1094 scrollbar_pointer_changed_in_window, |
| 444 | 1095 0, 0, 0); |
| 428 | 1096 } |