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