Mercurial > hg > xemacs-beta

comparison src/scrollbar.c @ 428:3ecd8885ac67 r21-2-22

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