7f586b4936c93cb02202fc7121b1675d10a68502
[chise/xemacs-chise.git-] / src / scrollbar.c
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 \f
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 \f
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 \f
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 \f
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                          offsetof (struct window, scrollbar_width),
960                          vertical_scrollbar_changed_in_window,
961                          offsetof (struct frame, scrollbar_width),
962                          frame_size_slipped);
963
964   DEFVAR_SPECIFIER ("scrollbar-height", &Vscrollbar_height /*
965 *Height of horizontal scrollbars.
966 This is a specifier; use `set-specifier' to change it.
967 */ );
968   Vscrollbar_height = make_magic_specifier (Qnatnum);
969   set_specifier_fallback
970     (Vscrollbar_height,
971      list1 (Fcons (Qnil, make_int (DEFAULT_SCROLLBAR_HEIGHT))));
972   set_specifier_caching (Vscrollbar_height,
973                          offsetof (struct window, scrollbar_height),
974                          some_window_value_changed,
975                          offsetof (struct frame, scrollbar_height),
976                          frame_size_slipped);
977
978   DEFVAR_SPECIFIER ("horizontal-scrollbar-visible-p", &Vhorizontal_scrollbar_visible_p /*
979 *Whether the horizontal scrollbar is visible.
980 This is a specifier; use `set-specifier' to change it.
981 */ );
982   Vhorizontal_scrollbar_visible_p = Fmake_specifier (Qboolean);
983   set_specifier_fallback (Vhorizontal_scrollbar_visible_p,
984                           list1 (Fcons (Qnil, Qt)));
985   set_specifier_caching (Vhorizontal_scrollbar_visible_p,
986                          offsetof (struct window,
987                                    horizontal_scrollbar_visible_p),
988                          some_window_value_changed,
989                          offsetof (struct frame,
990                                    horizontal_scrollbar_visible_p),
991                          frame_size_slipped);
992
993   DEFVAR_SPECIFIER ("vertical-scrollbar-visible-p", &Vvertical_scrollbar_visible_p /*
994 *Whether the vertical scrollbar is visible.
995 This is a specifier; use `set-specifier' to change it.
996 */ );
997   Vvertical_scrollbar_visible_p = Fmake_specifier (Qboolean);
998   set_specifier_fallback (Vvertical_scrollbar_visible_p,
999                           list1 (Fcons (Qnil, Qt)));
1000   set_specifier_caching (Vvertical_scrollbar_visible_p,
1001                          offsetof (struct window,
1002                                    vertical_scrollbar_visible_p),
1003                          vertical_scrollbar_changed_in_window,
1004                          offsetof (struct frame,
1005                                    vertical_scrollbar_visible_p),
1006                          frame_size_slipped);
1007
1008   DEFVAR_SPECIFIER ("scrollbar-on-left-p", &Vscrollbar_on_left_p /*
1009 *Whether the vertical scrollbar is on the left side of window or frame.
1010 This is a specifier; use `set-specifier' to change it.
1011 */ );
1012   Vscrollbar_on_left_p = Fmake_specifier (Qboolean);
1013   
1014   {
1015     /* Kludge. Under X, we want athena scrollbars on the left,
1016        while all other scrollbars go on the right by default. */
1017     Lisp_Object fallback = list1 (Fcons (Qnil, Qnil));
1018 #if defined (HAVE_X_WINDOWS)                    \
1019     && !defined (LWLIB_SCROLLBARS_MOTIF)        \
1020     && !defined (LWLIB_SCROLLBARS_LUCID)        \
1021     && !defined (LWLIB_SCROLLBARS_ATHENA3D)
1022
1023     fallback = Fcons (Fcons (list1 (Qx), Qt), fallback);
1024 #endif
1025     set_specifier_fallback (Vscrollbar_on_left_p, fallback);
1026   }
1027
1028   set_specifier_caching (Vscrollbar_on_left_p,
1029                          offsetof (struct window, scrollbar_on_left_p),
1030                          vertical_scrollbar_changed_in_window,
1031                          offsetof (struct frame, scrollbar_on_left_p),
1032                          frame_size_slipped);
1033
1034   DEFVAR_SPECIFIER ("scrollbar-on-top-p", &Vscrollbar_on_top_p /*
1035 *Whether the horizontal scrollbar is on the top side of window or frame.
1036 This is a specifier; use `set-specifier' to change it.
1037 */ );
1038   Vscrollbar_on_top_p = Fmake_specifier (Qboolean);
1039   set_specifier_fallback (Vscrollbar_on_top_p,
1040                           list1 (Fcons (Qnil, Qnil)));
1041   set_specifier_caching (Vscrollbar_on_top_p,
1042                          offsetof (struct window, scrollbar_on_top_p),
1043                          some_window_value_changed,
1044                          offsetof (struct frame, scrollbar_on_top_p),
1045                          frame_size_slipped);
1046 }
1047
1048 void
1049 complex_vars_of_scrollbar (void)
1050 {
1051   Vscrollbar_pointer_glyph = Fmake_glyph_internal (Qpointer);
1052
1053   set_specifier_caching (XGLYPH (Vscrollbar_pointer_glyph)->image,
1054                          offsetof (struct window, scrollbar_pointer),
1055                          scrollbar_pointer_changed_in_window,
1056                          0, 0);
1057 }