Mercurial > hg > xemacs-beta

comparison src/scrollbar.c @ 0:376386a54a3c r19-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children ac2d302a0011
comparison
equal deleted inserted replaced
-1:000000000000 0:376386a54a3c
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>.
6
7 This file is part of XEmacs.
8
9 XEmacs is free software; you can redistribute it and/or modify it
10 under the terms of the GNU General Public License as published by the
11 Free Software Foundation; either version 2, or (at your option) any
12 later version.
13
14 XEmacs is distributed in the hope that it will be useful, but WITHOUT
15 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
16 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
17 for more details.
18
19 You should have received a copy of the GNU General Public License
20 along with XEmacs; see the file COPYING. If not, write to
21 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
22 Boston, MA 02111-1307, USA. */
23
24 /* Synched up with: Not in FSF. */
25
26 /* This file has been Mule-ized. */
27
28 #include <config.h>
29 #include "lisp.h"
30
31 #include "buffer.h"
32 #include "commands.h"
33 #include "scrollbar.h"
34 #include "device.h"
35 #include "frame.h"
36 #include "glyphs.h"
37 #include "window.h"
38
39 Lisp_Object Qinit_scrollbar_from_resources;
40
41 Lisp_Object Qscrollbar_line_up;
42 Lisp_Object Qscrollbar_line_down;
43 Lisp_Object Qscrollbar_page_up;
44 Lisp_Object Qscrollbar_page_down;
45 Lisp_Object Qscrollbar_to_top;
46 Lisp_Object Qscrollbar_to_bottom;
47 Lisp_Object Qscrollbar_vertical_drag;
48
49 Lisp_Object Qscrollbar_char_left;
50 Lisp_Object Qscrollbar_char_right;
51 Lisp_Object Qscrollbar_page_left;
52 Lisp_Object Qscrollbar_page_right;
53 Lisp_Object Qscrollbar_to_left;
54 Lisp_Object Qscrollbar_to_right;
55 Lisp_Object Qscrollbar_horizontal_drag;
56
57 #define DEFAULT_SCROLLBAR_WIDTH 15
58 #define DEFAULT_SCROLLBAR_HEIGHT 15
59
60 /* Width of the scrollbar. */
61 Lisp_Object Vscrollbar_width;
62
63 /* Height of the scrollbar. */
64 Lisp_Object Vscrollbar_height;
65
66 Lisp_Object Vscrollbar_pointer_glyph;
67
68 static void update_scrollbar_instance (struct window *w, int vertical,
69 struct scrollbar_instance *instance);
70
71
72 static void
73 free_scrollbar_instance (struct scrollbar_instance *instance,
74 struct frame *frame)
75 {
76 if (!instance)
77 return;
78 else
79 {
80 struct device *d = XDEVICE (frame->device);
81
82 MAYBE_DEVMETH (d, free_scrollbar_instance, (instance));
83 xfree (instance);
84 }
85 }
86
87 static void
88 free_window_mirror_scrollbars (struct window_mirror *mir)
89 {
90 struct frame *f = mir->frame;
91 free_scrollbar_instance (mir->scrollbar_vertical_instance, f);
92 mir->scrollbar_vertical_instance = 0;
93 free_scrollbar_instance (mir->scrollbar_horizontal_instance, f);
94 mir->scrollbar_horizontal_instance = 0;
95 }
96
97 static struct window_mirror *
98 free_scrollbars_loop (Lisp_Object window, struct window_mirror *mir)
99 {
100 struct window_mirror *retval = NULL;
101
102 while (mir)
103 {
104 struct scrollbar_instance *vinst = mir->scrollbar_vertical_instance;
105 struct scrollbar_instance *hinst = mir->scrollbar_horizontal_instance;
106 struct frame *f;
107
108 assert (!NILP (window));
109 f = XFRAME (XWINDOW (window)->frame);
110
111 if (mir->vchild)
112 {
113 retval = free_scrollbars_loop (XWINDOW (window)->vchild,
114 mir->vchild);
115 }
116 else if (mir->hchild)
117 {
118 retval = free_scrollbars_loop (XWINDOW (window)->hchild,
119 mir->hchild);
120 }
121
122 if (retval != NULL)
123 return retval;
124
125 if (hinst || vinst)
126 free_window_mirror_scrollbars (mir);
127
128 mir = mir->next;
129 window = XWINDOW (window)->next;
130 }
131
132 return NULL;
133 }
134
135 /* Destroy all scrollbars associated with FRAME. Only called from
136 delete_frame_internal.
137 */
138 #define FREE_FRAME_SCROLLBARS_INTERNAL(cache) \
139 do { \
140 while (FRAME_SB_##cache (f)) \
141 { \
142 struct scrollbar_instance *tofree = FRAME_SB_##cache (f); \
143 FRAME_SB_##cache (f) = FRAME_SB_##cache (f)->next; \
144 tofree->next = NULL; \
145 free_scrollbar_instance (tofree, f); \
146 } \
147 } while (0)
148
149 void
150 free_frame_scrollbars (struct frame *f)
151 {
152 if (!HAS_FRAMEMETH_P (f, create_scrollbar_instance))
153 return;
154
155 if (f->mirror_dirty)
156 update_frame_window_mirror (f);
157
158 free_scrollbars_loop (f->root_window, f->root_mirror);
159
160 FREE_FRAME_SCROLLBARS_INTERNAL (VCACHE);
161 FREE_FRAME_SCROLLBARS_INTERNAL (HCACHE);
162 }
163 #undef FREE_FRAME_SCROLLBARS_INTERNAL
164
165
166 static struct scrollbar_instance *
167 create_scrollbar_instance (struct frame *f, int vertical)
168 {
169 struct device *d = XDEVICE (f->device);
170 struct scrollbar_instance *instance =
171 (struct scrollbar_instance *) xmalloc (sizeof (*instance));
172
173 memset (instance, 0, sizeof (*instance));
174 MAYBE_DEVMETH (d, create_scrollbar_instance, (f, vertical, instance));
175
176 return instance;
177 }
178
179
180 #define GET_SCROLLBAR_INSTANCE_INTERNAL(cache) \
181 do { \
182 if (FRAME_SB_##cache (f)) \
183 { \
184 struct scrollbar_instance *retval = FRAME_SB_##cache (f); \
185 FRAME_SB_##cache (f) = FRAME_SB_##cache (f)->next; \
186 retval->next = NULL; \
187 return retval; \
188 } \
189 } while (0)
190
191 static struct scrollbar_instance *
192 get_scrollbar_instance (struct frame *f, int vertical)
193 {
194 /* Check if there are any available scrollbars already in existence. */
195 if (vertical)
196 GET_SCROLLBAR_INSTANCE_INTERNAL (VCACHE);
197 else
198 GET_SCROLLBAR_INSTANCE_INTERNAL (HCACHE);
199
200 return create_scrollbar_instance (f, vertical);
201 }
202 #undef GET_SCROLLBAR_INSTANCE_INTERNAL
203
204 #define RELEASE_SCROLLBAR_INSTANCE_INTERNAL(cache) \
205 do { \
206 if (!FRAME_SB_##cache (f)) \
207 { \
208 instance->next = NULL; \
209 FRAME_SB_##cache (f) = instance; \
210 } \
211 else \
212 { \
213 instance->next = FRAME_SB_##cache (f); \
214 FRAME_SB_##cache (f) = instance; \
215 } \
216 } while (0)
217
218 static void
219 release_scrollbar_instance (struct frame *f, int vertical,
220 struct scrollbar_instance *instance)
221 {
222 /* #### should we do "instance->mir = 0;" for safety? */
223 if (vertical)
224 RELEASE_SCROLLBAR_INSTANCE_INTERNAL (VCACHE);
225 else
226 RELEASE_SCROLLBAR_INSTANCE_INTERNAL (HCACHE);
227 }
228 #undef RELEASE_SCROLLBAR_INSTANCE_INTERNAL
229
230 #ifdef MEMORY_USAGE_STATS
231
232 int
233 compute_scrollbar_instance_usage (struct device *d,
234 struct scrollbar_instance *inst,
235 struct overhead_stats *ovstats)
236 {
237 int total = 0;
238
239 total += DEVMETH (d, compute_scrollbar_instance_usage, (d, inst, ovstats));
240
241 while (inst)
242 {
243 total += malloced_storage_size (inst, sizeof (*inst), ovstats);
244 inst = inst->next;
245 }
246
247 return total;
248 }
249
250 #endif /* MEMORY_USAGE_STATS */
251
252 void
253 update_window_scrollbars (struct window *w, struct window_mirror *mirror,
254 int active, int horiz_only)
255 {
256 struct frame *f = XFRAME (w->frame);
257 struct device *d = XDEVICE (f->device);
258
259 if (!HAS_DEVMETH_P (d, create_scrollbar_instance))
260 return;
261
262 in_display++;
263
264 /* It is possible for this to get called from the mirror update
265 routines. In that case the structure is in an indeterminate
266 state but we know exactly what struct we are working with. So we
267 pass it in in that case. We also take advantage of it at some
268 other points where we know what the mirror struct is. */
269 if (!mirror)
270 mirror = find_window_mirror (w);
271
272 if (!mirror->scrollbar_vertical_instance && active)
273 mirror->scrollbar_vertical_instance = get_scrollbar_instance (f, 1);
274
275 if (!mirror->scrollbar_horizontal_instance && active)
276 mirror->scrollbar_horizontal_instance = get_scrollbar_instance (f, 0);
277
278 if (!horiz_only && mirror->scrollbar_vertical_instance)
279 {
280 int size = (active ? window_scrollbar_width (w) : 0);
281 struct scrollbar_instance *instance;
282
283 instance = mirror->scrollbar_vertical_instance;
284 instance->scrollbar_is_active = active;
285 instance->mirror = mirror;
286
287 if (active && size)
288 update_scrollbar_instance (w, 1, instance);
289 MAYBE_DEVMETH (d, update_scrollbar_instance_status,
290 (w, active, size, instance));
291
292 if (!active)
293 {
294 release_scrollbar_instance (f, 1, instance);
295 mirror->scrollbar_vertical_instance = NULL;
296 }
297 }
298
299 if (mirror->scrollbar_horizontal_instance)
300 {
301 int size = (active ? window_scrollbar_height (w) : 0);
302 struct scrollbar_instance *instance;
303
304 instance = mirror->scrollbar_horizontal_instance;
305 instance->scrollbar_is_active = active;
306 instance->mirror = mirror;
307
308 if (active && size)
309 update_scrollbar_instance (w, 0, instance);
310 MAYBE_DEVMETH (d, update_scrollbar_instance_status,
311 (w, active, size, instance));
312
313 if (!active)
314 {
315 release_scrollbar_instance (f, 0, instance);
316 mirror->scrollbar_horizontal_instance = NULL;
317 }
318 }
319
320 in_display--;
321 }
322
323 void
324 release_window_mirror_scrollbars (struct window_mirror *mir)
325 {
326 struct device *d = XDEVICE (mir->frame->device);
327
328 if (!HAS_DEVMETH_P (d, create_scrollbar_instance))
329 return;
330
331 if (mir->scrollbar_vertical_instance)
332 {
333 release_scrollbar_instance (mir->frame, 1,
334 mir->scrollbar_vertical_instance);
335 MAYBE_DEVMETH (d, release_scrollbar_instance,
336 (mir->scrollbar_vertical_instance));
337 }
338 mir->scrollbar_vertical_instance = 0;
339
340 if (mir->scrollbar_horizontal_instance)
341 {
342 release_scrollbar_instance (mir->frame, 0,
343 mir->scrollbar_horizontal_instance);
344 MAYBE_DEVMETH (d, release_scrollbar_instance,
345 (mir->scrollbar_horizontal_instance));
346 }
347 mir->scrollbar_horizontal_instance = 0;
348 }
349
350 /* This check needs to be done in the device-specific side. */
351 #define UPDATE_DATA_FIELD(field, value) \
352 if (instance->field != value) {\
353 instance->field = value;\
354 instance->scrollbar_instance_changed = 1;\
355 }\
356
357 /*
358 * If w->sb_point is on the top line then return w->sb_point else
359 * return w->start. If flag, then return beginning point of line
360 * which w->sb_point lies on.
361 */
362 static Bufpos
363 scrollbar_point (struct window *w, int flag)
364 {
365 Bufpos start_pos, end_pos, sb_pos;
366 Lisp_Object buf;
367 struct buffer *b;
368
369 if (NILP (w->buffer)) /* non-leaf window */
370 return 0;
371
372 start_pos = marker_position (w->start[CURRENT_DISP]);
373 sb_pos = marker_position (w->sb_point);
374
375 if (!flag && sb_pos < start_pos)
376 return start_pos;
377
378 buf = get_buffer (w->buffer, 0);
379 if (!NILP (buf))
380 b = XBUFFER (buf);
381 else
382 return start_pos;
383
384 if (flag)
385 end_pos = find_next_newline_no_quit (b, sb_pos, -1);
386 else
387 end_pos = find_next_newline_no_quit (b, start_pos, 1);
388
389 if (flag)
390 return end_pos;
391 else if (sb_pos > end_pos)
392 return start_pos;
393 else
394 return sb_pos;
395 }
396
397 /*
398 * Update a window's horizontal or vertical scrollbar.
399 */
400 static void
401 update_scrollbar_instance (struct window *w, int vertical,
402 struct scrollbar_instance *instance)
403 {
404 struct frame *f = XFRAME (w->frame);
405 struct device *d = XDEVICE (f->device);
406 struct buffer *b = XBUFFER (w->buffer);
407 Bufpos start_pos, end_pos, sb_pos;
408 int scrollbar_width = window_scrollbar_width (w);
409 int scrollbar_height = window_scrollbar_height (w);
410
411 int new_line_increment = -1, new_page_increment = -1;
412 int new_minimum = -1, new_maximum = -1;
413 int new_slider_size = -1, new_slider_position = -1;
414 int new_width = -1, new_height = -1, new_x = -1, new_y = -1;
415 struct window *new_window = 0; /* kludge city */
416
417 end_pos = BUF_Z (b) - w->window_end_pos[CURRENT_DISP];
418 sb_pos = scrollbar_point (w, 0);
419 start_pos = sb_pos;
420
421 /* The end position must be strictly greater than the start
422 position, at least for the Motify scrollbar. It shouldn't hurt
423 anything for other scrollbar implementations. */
424 if (end_pos <= start_pos)
425 end_pos = start_pos + 1;
426
427 if (vertical)
428 {
429 new_height = WINDOW_TEXT_HEIGHT (w);
430 new_width = scrollbar_width;
431 }
432 else
433 {
434 new_height = scrollbar_height;
435 new_width = WINDOW_TEXT_WIDTH (w);
436 }
437
438 /* If the height and width are not greater than 0, then later on the
439 Motif widgets will bitch and moan. */
440 if (new_height <= 0)
441 new_height = 1;
442 if (new_width <= 0)
443 new_width = 1;
444
445 assert (instance->mirror && XWINDOW (real_window(instance->mirror, 0)) == w);
446
447 /* Only character-based scrollbars are implemented at the moment.
448 Line-based will be implemented in the future. */
449
450 instance->scrollbar_is_active = 1;
451 new_line_increment = 1;
452 new_page_increment = 1;
453
454 if (!DEVMETH_OR_GIVEN (d, inhibit_scrollbar_thumb_size_change, (), 0))
455 {
456 int x_offset, y_offset;
457
458 /* Scrollbars are always the farthest from the text area. */
459 if (vertical)
460 {
461 x_offset = (f->scrollbar_on_left
462 ? WINDOW_LEFT (w)
463 : WINDOW_RIGHT (w) - scrollbar_width);
464 y_offset = WINDOW_TEXT_TOP (w) + f->scrollbar_y_offset;
465 }
466 else
467 {
468 x_offset = WINDOW_TEXT_LEFT (w);
469 y_offset = f->scrollbar_y_offset +
470 (f->scrollbar_on_top
471 ? WINDOW_TOP (w)
472 : WINDOW_TEXT_BOTTOM (w) + window_bottom_toolbar_height (w));
473 }
474
475 new_x = x_offset;
476 new_y = y_offset;
477 }
478
479 /* A disabled scrollbar has its slider sized to the entire height of
480 the scrollbar. Currently the minibuffer scrollbar is
481 disabled. */
482 if (!MINI_WINDOW_P (w) && vertical)
483 {
484 if (!DEVMETH_OR_GIVEN (d, inhibit_scrollbar_thumb_size_change, (), 0))
485 {
486 new_minimum = BUF_BEGV (b);
487 new_maximum = max (BUF_ZV (b), new_minimum + 1);
488 new_slider_size = min ((end_pos - start_pos),
489 (new_maximum - new_minimum));
490 new_slider_position = sb_pos;
491 new_window = w;
492 }
493 }
494 else if (!MINI_WINDOW_P (w))
495 {
496 /* The minus one is to account for the truncation glyph. */
497 int wcw = window_char_width (w, 0) - 1;
498 int max_width, max_slide;
499
500 if (w->max_line_len < wcw)
501 {
502 max_width = 1;
503 max_slide = 1;
504 wcw = 1;
505 }
506 else
507 {
508 max_width = w->max_line_len + 2;
509 max_slide = max_width - wcw;
510 }
511
512 new_minimum = 0;
513 new_maximum = max_width;
514 new_slider_size = wcw;
515 new_slider_position = min (w->hscroll, max_slide);
516 }
517 else
518 {
519 new_minimum = 1;
520 new_maximum = 2;
521 new_slider_size = 1;
522 new_slider_position = 1;
523 instance->scrollbar_is_active = 0;
524 }
525
526 DEVMETH (d, update_scrollbar_instance_values, (w, instance,
527 new_line_increment,
528 new_page_increment,
529 new_minimum,
530 new_maximum,
531 new_slider_size,
532 new_slider_position,
533 new_width, new_height,
534 new_x, new_y));
535 }
536
537 void
538 init_frame_scrollbars (struct frame *f)
539 {
540 struct device *d = XDEVICE (f->device);
541
542 if (HAS_DEVMETH_P (d, create_scrollbar_instance))
543 {
544 Lisp_Object frame = Qnil;
545
546 XSETFRAME (frame, f);
547 call_critical_lisp_code (XDEVICE (FRAME_DEVICE (f)),
548 Qinit_scrollbar_from_resources,
549 frame);
550 }
551 }
552
553 void
554 init_device_scrollbars (struct device *d)
555 {
556 if (HAS_DEVMETH_P (d, create_scrollbar_instance))
557 {
558 Lisp_Object device = Qnil;
559
560 XSETDEVICE (device, d);
561 call_critical_lisp_code (d,
562 Qinit_scrollbar_from_resources,
563 device);
564 }
565 }
566
567 void
568 init_global_scrollbars (struct device *d)
569 {
570 if (HAS_DEVMETH_P (d, create_scrollbar_instance))
571 {
572 call_critical_lisp_code (d,
573 Qinit_scrollbar_from_resources,
574 Qglobal);
575 }
576 }
577
578
579 /* This function is called as a result of a change to the
580 `scrollbar-width' specifier. */
581 static void
582 scrollbar_width_changed_in_frame (Lisp_Object specifier, struct frame *f,
583 Lisp_Object oldval)
584 {
585 MAYBE_FRAMEMETH (f, scrollbar_width_changed_in_frame,
586 (specifier, f, oldval));
587 }
588
589 /* This function is called as a result of a change to the
590 `scrollbar-height' specifier. */
591 static void
592 scrollbar_height_changed_in_frame (Lisp_Object specifier, struct frame *f,
593 Lisp_Object oldval)
594 {
595 MAYBE_FRAMEMETH (f, scrollbar_height_changed_in_frame,
596 (specifier, f, oldval));
597 }
598
599 /* This function is called as a result of a change to the
600 `scrollbar-pointer' glyph. */
601 static void
602 scrollbar_pointer_changed_in_window (Lisp_Object specifier, struct window *w,
603 Lisp_Object oldval)
604 {
605 struct frame *f = XFRAME (WINDOW_FRAME (w));
606
607 if (f->init_finished)
608 MAYBE_FRAMEMETH (f, scrollbar_pointer_changed_in_window, (w));
609 }
610
611 /* ####
612
613 All of the following stuff is functions that handle scrollbar
614 actions. All of it should be moved into Lisp. This may require
615 adding some badly-needed primitives. */
616
617 /********** vertical scrollbar stuff **********/
618
619 /*
620 * If the original point is still visible, put the cursor back there.
621 * Otherwise, when scrolling down stick it at the beginning of the
622 * first visible line and when scrolling up stick it at the beginning
623 * of the last visible line.
624 */
625
626 /* #### This function should be moved into Lisp */
627 static void
628 scrollbar_reset_cursor (Lisp_Object win, Lisp_Object orig_pt)
629 {
630 /* When this function is called we know that start is already
631 accurate. We know this because either set-window-start or
632 recenter was called immediately prior to it being called. */
633 Lisp_Object buf;
634 Bufpos start_pos = XINT (Fwindow_start (win));
635 Bufpos ptint = XINT (orig_pt);
636 struct window *w = XWINDOW (win);
637 int selected = ((w == XWINDOW (Fselected_window (XFRAME (w->frame)->device)))
638 ? 1
639 : 0);
640
641 buf = Fwindow_buffer (win);
642 if (NILP (buf))
643 return; /* the window was deleted out from under us */
644
645 if (ptint < XINT (Fwindow_start (win)))
646 {
647 if (selected)
648 Fgoto_char (make_int (start_pos), buf);
649 else
650 Fset_window_point (win, make_int (start_pos));
651 }
652 else if (!point_would_be_visible (XWINDOW (win), start_pos, ptint))
653 {
654 Fmove_to_window_line (make_int (-1), win);
655
656 if (selected)
657 Fbeginning_of_line (Qnil, buf);
658 else
659 {
660 /* #### Taken from forward-line. */
661 Bufpos pos;
662
663 pos = find_next_newline (XBUFFER (buf),
664 marker_position (w->pointm[CURRENT_DISP]),
665 -1);
666 Fset_window_point (win, make_int (pos));
667 }
668 }
669 else
670 {
671 if (selected)
672 Fgoto_char (orig_pt, buf);
673 else
674 Fset_window_point (win, orig_pt);
675 }
676 }
677
678 DEFUN ("scrollbar-line-up", Fscrollbar_line_up, Sscrollbar_line_up, 1, 1, 0 /*
679 Function called when the line-up arrow on the scrollbar is clicked.
680 This is the little arrow at the top of the scrollbar. One argument, the
681 scrollbar's window. You can advise this function to change the scrollbar
682 behavior.
683 */ )
684 (window)
685 Lisp_Object window;
686 {
687 CHECK_LIVE_WINDOW (window);
688 window_scroll (window, make_int (1), -1, ERROR_ME_NOT);
689 zmacs_region_stays = 1;
690 return Qnil;
691 }
692
693 DEFUN ("scrollbar-line-down", Fscrollbar_line_down, Sscrollbar_line_down,
694 1, 1, 0 /*
695 Function called when the line-down arrow on the scrollbar is clicked.
696 This is the little arrow at the bottom of the scrollbar. One argument, the
697 scrollbar's window. You can advise this function to change the scrollbar
698 behavior.
699 */ )
700 (window)
701 Lisp_Object window;
702 {
703 CHECK_LIVE_WINDOW (window);
704 window_scroll (window, make_int (1), 1, ERROR_ME_NOT);
705 zmacs_region_stays = 1;
706 return Qnil;
707 }
708
709 DEFUN ("scrollbar-page-up", Fscrollbar_page_up, Sscrollbar_page_up,
710 1, 1, 0 /*
711 Function called when the user gives the \"page-up\" scrollbar action.
712 (The way this is done can vary from scrollbar to scrollbar.) One argument,
713 a cons containing the scrollbar's window and a value (#### document me!
714 This value is nil for Motif/Lucid scrollbars and a number for Athena
715 scrollbars). You can advise this function to change the scrollbar
716 behavior.
717 */ )
718 (object)
719 Lisp_Object object;
720 {
721 Lisp_Object window = Fcar (object);
722
723 CHECK_LIVE_WINDOW (window);
724 /* Motif and Athena scrollbars behave differently, but in accordance
725 with their standard behaviors. It is not possible to hide the
726 differences down in lwlib because knowledge of XEmacs buffer and
727 cursor motion routines is necessary. */
728 #if defined (LWLIB_SCROLLBARS_MOTIF) || defined (LWLIB_SCROLLBARS_LUCID)
729 window_scroll (window, Qnil, -1, ERROR_ME_NOT);
730 #else /* Athena */
731 {
732 Bufpos bufpos;
733 Lisp_Object value = Fcdr (object);
734
735 CHECK_INT (value);
736 Fmove_to_window_line (Qzero, window);
737 /* can't use Fvertical_motion() because it moves the buffer point
738 rather than the window's point.
739
740 #### It does? Why does it take a window argument then? */
741 bufpos = vmotion (XWINDOW (window), XINT (Fwindow_point (window)),
742 XINT (value), 0);
743 Fset_window_point (window, make_int (bufpos));
744 Frecenter (Qzero, window);
745 }
746 #endif /* Athena */
747 zmacs_region_stays = 1;
748 return Qnil;
749 }
750
751 DEFUN ("scrollbar-page-down", Fscrollbar_page_down, Sscrollbar_page_down,
752 1, 1, 0 /*
753 Function called when the user gives the \"page-down\" 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 Lisp_Object 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. */
770 #if defined (LWLIB_SCROLLBARS_MOTIF) || defined (LWLIB_SCROLLBARS_LUCID)
771 window_scroll (window, Qnil, 1, ERROR_ME_NOT);
772 #else /* Athena */
773 {
774 Lisp_Object value = Fcdr (object);
775 CHECK_INT (value);
776 Fmove_to_window_line (value, window);
777 Frecenter (Qzero, window);
778 }
779 #endif /* Athena */
780 zmacs_region_stays = 1;
781 return Qnil;
782 }
783
784 DEFUN ("scrollbar-to-top", Fscrollbar_to_top, Sscrollbar_to_top,
785 1, 1, 0 /*
786 Function called when the user gives the \"to-top\" scrollbar action.
787 (The way this is done can vary from scrollbar to scrollbar.). One argument,
788 the scrollbar's window. You can advise this function to change the
789 scrollbar behavior.
790 */ )
791 (window)
792 Lisp_Object window;
793 {
794 Lisp_Object orig_pt;
795
796 orig_pt = Fwindow_point (window);
797 Fset_window_point (window, Fpoint_min (Fwindow_buffer (window)));
798 Frecenter (Qzero, window);
799 scrollbar_reset_cursor (window, orig_pt);
800 zmacs_region_stays = 1;
801 return Qnil;
802 }
803
804 DEFUN ("scrollbar-to-bottom", Fscrollbar_to_bottom, Sscrollbar_to_bottom,
805 1, 1, 0 /*
806 Function called when the user gives the \"to-bottom\" scrollbar action.
807 (The way this is done can vary from scrollbar to scrollbar.). One argument,
808 the scrollbar's window. You can advise this function to change the
809 scrollbar behavior.
810 */ )
811 (window)
812 Lisp_Object window;
813 {
814 Lisp_Object orig_pt;
815
816 orig_pt = Fwindow_point (window);
817 Fset_window_point (window, Fpoint_max (Fwindow_buffer (window)));
818 Frecenter (Qzero, window);
819 scrollbar_reset_cursor (window, orig_pt);
820 zmacs_region_stays = 1;
821 return Qnil;
822 }
823
824 DEFUN ("scrollbar-vertical-drag", Fscrollbar_vertical_drag,
825 Sscrollbar_vertical_drag, 1, 1, 0 /*
826 Function called when the user drags the vertical scrollbar thumb.
827 One argument, a cons containing the scrollbar's window and a value
828 (#### document me!). You can advise this function to change the
829 scrollbar behavior.
830 */ )
831 (object)
832 Lisp_Object object;
833 {
834 Bufpos start_pos;
835 Lisp_Object orig_pt;
836 Lisp_Object window = Fcar (object);
837 Lisp_Object value = Fcdr (object);
838
839 orig_pt = Fwindow_point (window);
840 Fset_marker (XWINDOW (window)->sb_point, value, Fwindow_buffer (window));
841 start_pos = scrollbar_point (XWINDOW (window), 1);
842 Fset_window_start (window, make_int (start_pos), Qnil);
843 scrollbar_reset_cursor (window, orig_pt);
844 zmacs_region_stays = 1;
845 return Qnil;
846 }
847
848 DEFUN ("scrollbar-set-hscroll", Fscrollbar_set_hscroll, Sscrollbar_set_hscroll,
849 2, 2, 0 /*
850 Sets WINDOW's hscroll position to VALUE.
851 This ensures that VALUE is in the proper range for the horizontal scrollbar.
852 */ )
853 (window, value)
854 Lisp_Object window, value;
855 {
856 struct window *w;
857 int hscroll, wcw, max_len;
858
859 CHECK_LIVE_WINDOW (window);
860 if (!EQ (value, Qmax))
861 CHECK_INT (value);
862
863 w = XWINDOW (window);
864 wcw = window_char_width (w, 0) - 1;
865 max_len = w->max_line_len + 1;
866
867 if (EQ (value, Qmax) || (XINT (value) > (max_len - wcw)))
868 hscroll = max_len - wcw;
869 else
870 hscroll = XINT (value);
871
872 /* Can't allow this out of set-window-hscroll's acceptable range. */
873 if (hscroll < 0)
874 hscroll = 0;
875 else if (hscroll >= (1 << (SHORTBITS - 1)))
876 hscroll = (1 << (SHORTBITS - 1)) - 1;
877
878 if (hscroll != w->hscroll)
879 Fset_window_hscroll (window, make_int (hscroll));
880
881 return Qnil;
882 }
883
884
885 /************************************************************************/
886 /* initialization */
887 /************************************************************************/
888
889 void
890 syms_of_scrollbar (void)
891 {
892 defsymbol (&Qscrollbar_line_up, "scrollbar-line-up");
893 defsymbol (&Qscrollbar_line_down, "scrollbar-line-down");
894 defsymbol (&Qscrollbar_page_up, "scrollbar-page-up");
895 defsymbol (&Qscrollbar_page_down, "scrollbar-page-down");
896 defsymbol (&Qscrollbar_to_top, "scrollbar-to-top");
897 defsymbol (&Qscrollbar_to_bottom, "scrollbar-to-bottom");
898 defsymbol (&Qscrollbar_vertical_drag, "scrollbar-vertical-drag");
899
900 defsymbol (&Qscrollbar_char_left, "scrollbar-char-left");
901 defsymbol (&Qscrollbar_char_right, "scrollbar-char-right");
902 defsymbol (&Qscrollbar_page_left, "scrollbar-page-left");
903 defsymbol (&Qscrollbar_page_right, "scrollbar-page-right");
904 defsymbol (&Qscrollbar_to_left, "scrollbar-to-left");
905 defsymbol (&Qscrollbar_to_right, "scrollbar-to-right");
906 defsymbol (&Qscrollbar_horizontal_drag, "scrollbar-horizontal-drag");
907
908 defsymbol (&Qinit_scrollbar_from_resources, "init-scrollbar-from-resources");
909
910 /* #### All these functions should be moved into Lisp.
911 See comment above. */
912 defsubr (&Sscrollbar_line_up);
913 defsubr (&Sscrollbar_line_down);
914 defsubr (&Sscrollbar_page_up);
915 defsubr (&Sscrollbar_page_down);
916 defsubr (&Sscrollbar_to_top);
917 defsubr (&Sscrollbar_to_bottom);
918 defsubr (&Sscrollbar_vertical_drag);
919
920 defsubr (&Sscrollbar_set_hscroll);
921 }
922
923 void
924 vars_of_scrollbar (void)
925 {
926 DEFVAR_LISP ("scrollbar-pointer-glyph", &Vscrollbar_pointer_glyph /*
927 *The shape of the mouse-pointer when over a scrollbar.
928 This is a glyph; use `set-glyph-image' to change it.
929 If unspecified in a particular domain, the window-system-provided
930 default pointer is used.
931 */ );
932
933 Fprovide (intern ("scrollbar"));
934 }
935
936 void
937 specifier_vars_of_scrollbar (void)
938 {
939 DEFVAR_SPECIFIER ("scrollbar-width", &Vscrollbar_width /*
940 *Width of vertical scrollbars.
941 This is a specifier; use `set-specifier' to change it.
942 */ );
943 Vscrollbar_width = Fmake_specifier (Qnatnum);
944 set_specifier_fallback
945 (Vscrollbar_width,
946 list1 (Fcons (Qnil, make_int (DEFAULT_SCROLLBAR_WIDTH))));
947 set_specifier_caching (Vscrollbar_width,
948 slot_offset (struct window,
949 scrollbar_width),
950 some_window_value_changed,
951 slot_offset (struct frame,
952 scrollbar_width),
953 scrollbar_width_changed_in_frame);
954
955 DEFVAR_SPECIFIER ("scrollbar-height", &Vscrollbar_height /*
956 *Height of horizontal scrollbars.
957 This is a specifier; use `set-specifier' to change it.
958 */ );
959 Vscrollbar_height = Fmake_specifier (Qnatnum);
960 set_specifier_fallback
961 (Vscrollbar_height,
962 list1 (Fcons (Qnil, make_int (DEFAULT_SCROLLBAR_HEIGHT))));
963 set_specifier_caching (Vscrollbar_height,
964 slot_offset (struct window,
965 scrollbar_height),
966 some_window_value_changed,
967 slot_offset (struct frame,
968 scrollbar_height),
969 scrollbar_height_changed_in_frame);
970 }
971
972 void
973 complex_vars_of_scrollbar (void)
974 {
975 Vscrollbar_pointer_glyph = Fmake_glyph_internal (Qpointer);
976
977 set_specifier_caching (XGLYPH (Vscrollbar_pointer_glyph)->image,
978 slot_offset (struct window,
979 scrollbar_pointer),
980 scrollbar_pointer_changed_in_window,
981 0, 0);
982 }