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