18360c029ddf9de92c3e43f7f9d3d06ab9968cae
[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           }
464         else 
465           {
466             x_offset = WINDOW_RIGHT (w) - scrollbar_width;
467             if (window_needs_vertical_divider (w))
468               x_offset -= window_divider_width (w);
469           }
470         y_offset = WINDOW_TEXT_TOP (w) + f->scrollbar_y_offset;
471       }
472     else
473       {
474         x_offset = WINDOW_TEXT_LEFT (w);
475         y_offset = f->scrollbar_y_offset;
476
477         if (!NILP (w->scrollbar_on_top_p))
478           {
479             y_offset += WINDOW_TOP (w);
480           }
481         else
482           {
483             y_offset += WINDOW_TEXT_BOTTOM (w);
484           }
485       }
486
487     new_x = x_offset;
488     new_y = y_offset;
489   }
490
491   /* A disabled scrollbar has its slider sized to the entire height of
492      the scrollbar.  Currently the minibuffer scrollbar is
493      disabled. */
494   if (!MINI_WINDOW_P (w) && vertical)
495     {
496       if (!DEVMETH_OR_GIVEN (d, inhibit_scrollbar_slider_size_change, (), 0))
497         {
498           new_minimum = BUF_BEGV (b);
499           new_maximum = max (BUF_ZV (b), new_minimum + 1);
500           new_slider_size = min ((end_pos - start_pos),
501                                  (new_maximum - new_minimum));
502           new_slider_position = sb_pos;
503           new_window = w;
504         }
505     }
506   else if (!MINI_WINDOW_P (w))
507     {
508       /* The minus one is to account for the truncation glyph. */
509       int wcw = window_char_width (w, 0) - 1;
510       int max_width, max_slide;
511
512       if (w->max_line_len < wcw)
513         {
514           max_width = 1;
515           max_slide = 1;
516           wcw = 1;
517         }
518       else
519         {
520           max_width = w->max_line_len + 2;
521           max_slide = max_width - wcw;
522         }
523
524       new_minimum = 0;
525       new_maximum = max_width;
526       new_slider_size = wcw;
527       new_slider_position = min (w->hscroll, max_slide);
528     }
529   else /* MINI_WINDOW_P (w) */
530     {
531       new_minimum = 1;
532       new_maximum = 2;
533       new_slider_size = 1;
534       new_slider_position = 1;
535       instance->scrollbar_is_active = 0;
536     }
537
538   DEVMETH (d, update_scrollbar_instance_values, (w, instance,
539                                                  new_line_increment,
540                                                  new_page_increment,
541                                                  new_minimum,
542                                                  new_maximum,
543                                                  new_slider_size,
544                                                  new_slider_position,
545                                                  new_width, new_height,
546                                                  new_x, new_y));
547 }
548
549 void
550 init_frame_scrollbars (struct frame *f)
551 {
552   struct device *d = XDEVICE (f->device);
553
554   if (HAS_DEVMETH_P (d, create_scrollbar_instance))
555     {
556       int depth = unlock_ghost_specifiers_protected ();
557       Lisp_Object frame;
558       XSETFRAME (frame, f);
559       call_critical_lisp_code (XDEVICE (FRAME_DEVICE (f)),
560                                Qinit_scrollbar_from_resources,
561                                frame);
562       unbind_to (depth, Qnil);
563     }
564 }
565
566 void
567 init_device_scrollbars (struct device *d)
568 {
569   if (HAS_DEVMETH_P (d, create_scrollbar_instance))
570     {
571       int depth = unlock_ghost_specifiers_protected ();
572       Lisp_Object device;
573       XSETDEVICE (device, d);
574       call_critical_lisp_code (d,
575                                Qinit_scrollbar_from_resources,
576                                device);
577       unbind_to (depth, Qnil);
578     }
579 }
580
581 void
582 init_global_scrollbars (struct device *d)
583 {
584   if (HAS_DEVMETH_P (d, create_scrollbar_instance))
585     {
586       int depth = unlock_ghost_specifiers_protected ();
587       call_critical_lisp_code (d,
588                                Qinit_scrollbar_from_resources,
589                                Qglobal);
590       unbind_to (depth, Qnil);
591     }
592 }
593
594 static void
595 vertical_scrollbar_changed_in_window (Lisp_Object specifier,
596                                       struct window *w,
597                                       Lisp_Object oldval)
598 {
599   /* Hold on your cerebella guys. If we always show the dividers,
600      changing scrollbar affects only how the text and scrollbar are
601      laid out in the window. If we do not want the dividers to show up
602      always, then we mark more drastic change, because changing
603      divider appearance changes lotta things. Although we actually need
604      to do this only if the scrollbar has appeared or disappeared
605      completely at either window edge, we do this always, as users
606      usually do not reposition scrollbars 200 times a second or so. Do
607      you? */
608   if (NILP (w->vertical_divider_always_visible_p))
609     MARK_FRAME_WINDOWS_STRUCTURE_CHANGED (XFRAME (WINDOW_FRAME (w)));
610   else
611     MARK_WINDOWS_CHANGED (w);
612 }
613
614 /* This function is called as a result of a change to the
615    `scrollbar-pointer' glyph.  */
616 static void
617 scrollbar_pointer_changed_in_window (Lisp_Object specifier, struct window *w,
618                                      Lisp_Object oldval)
619 {
620   struct frame *f = XFRAME (WINDOW_FRAME (w));
621
622   if (f->init_finished)
623     MAYBE_FRAMEMETH (f, scrollbar_pointer_changed_in_window, (w));
624 }
625
626 /* ####
627
628    All of the following stuff is functions that handle scrollbar
629    actions.  All of it should be moved into Lisp.  This may require
630    adding some badly-needed primitives. */
631
632 /********** vertical scrollbar stuff **********/
633
634 /*
635  * If the original point is still visible, put the cursor back there.
636  * Otherwise, when scrolling down stick it at the beginning of the
637  * first visible line and when scrolling up stick it at the beginning
638  * of the last visible line.
639  */
640
641 /* #### This function should be moved into Lisp */
642 static void
643 scrollbar_reset_cursor (Lisp_Object win, Lisp_Object orig_pt)
644 {
645   /* When this function is called we know that start is already
646      accurate.  We know this because either set-window-start or
647      recenter was called immediately prior to it being called. */
648   Lisp_Object buf;
649   Bufpos start_pos = XINT (Fwindow_start (win));
650   Bufpos ptint = XINT (orig_pt);
651   struct window *w = XWINDOW (win);
652   int selected = ((w == XWINDOW (Fselected_window (XFRAME (w->frame)->device)))
653                   ? 1
654                   : 0);
655
656   buf = Fwindow_buffer (win);
657   if (NILP (buf))
658     return;     /* the window was deleted out from under us */
659
660   if (ptint < XINT (Fwindow_start (win)))
661     {
662       if (selected)
663         Fgoto_char (make_int (start_pos), buf);
664       else
665         Fset_window_point (win, make_int (start_pos));
666     }
667   else if (!point_would_be_visible (XWINDOW (win), start_pos, ptint))
668     {
669       Fmove_to_window_line (make_int (-1), win);
670
671       if (selected)
672         Fbeginning_of_line (Qnil, buf);
673       else
674         {
675           /* #### Taken from forward-line. */
676           Bufpos pos;
677
678           pos = find_next_newline (XBUFFER (buf),
679                                    marker_position (w->pointm[CURRENT_DISP]),
680                                    -1);
681           Fset_window_point (win, make_int (pos));
682         }
683     }
684   else
685     {
686       if (selected)
687         Fgoto_char (orig_pt, buf);
688       else
689         Fset_window_point (win, orig_pt);
690     }
691 }
692
693 DEFUN ("scrollbar-line-up", Fscrollbar_line_up, 1, 1, 0, /*
694 Function called when the line-up arrow on the scrollbar is clicked.
695 This is the little arrow at the top of the scrollbar.  One argument, the
696 scrollbar's window.  You can advise this function to change the scrollbar
697 behavior.
698 */
699        (window))
700 {
701   CHECK_LIVE_WINDOW (window);
702   window_scroll (window, make_int (1), -1, ERROR_ME_NOT);
703   zmacs_region_stays = 1;
704   return Qnil;
705 }
706
707 DEFUN ("scrollbar-line-down", Fscrollbar_line_down, 1, 1, 0, /*
708 Function called when the line-down arrow on the scrollbar is clicked.
709 This is the little arrow at the bottom of the scrollbar.  One argument, the
710 scrollbar's window.  You can advise this function to change the scrollbar
711 behavior.
712 */
713        (window))
714 {
715   CHECK_LIVE_WINDOW (window);
716   window_scroll (window, make_int (1), 1, ERROR_ME_NOT);
717   zmacs_region_stays = 1;
718   return Qnil;
719 }
720
721 DEFUN ("scrollbar-page-up", Fscrollbar_page_up, 1, 1, 0, /*
722 Function called when the user gives the "page-up" scrollbar action.
723 \(The way this is done can vary from scrollbar to scrollbar.) One argument,
724 a cons containing the scrollbar's window and a value (#### document me!
725 This value is nil for Motif/Lucid scrollbars and a number for Athena
726 scrollbars).  You can advise this function to change the scrollbar
727 behavior.
728 */
729        (object))
730 {
731   Lisp_Object window = Fcar (object);
732
733   CHECK_LIVE_WINDOW (window);
734   /* Motif and Athena scrollbars behave differently, but in accordance
735      with their standard behaviors.  It is not possible to hide the
736      differences down in lwlib because knowledge of XEmacs buffer and
737      cursor motion routines is necessary. */
738 #if defined (LWLIB_SCROLLBARS_MOTIF) || defined (LWLIB_SCROLLBARS_LUCID) || \
739     defined (LWLIB_SCROLLBARS_ATHENA3D) || defined(HAVE_MS_WINDOWS)
740   window_scroll (window, Qnil, -1, ERROR_ME_NOT);
741 #else /* Athena */
742   {
743     Bufpos bufpos;
744     Lisp_Object value = Fcdr (object);
745
746     CHECK_INT (value);
747     Fmove_to_window_line (Qzero, window);
748     /* can't use Fvertical_motion() because it moves the buffer point
749        rather than the window's point.
750
751        #### It does?  Why does it take a window argument then? */
752     bufpos = vmotion (XWINDOW (window), XINT (Fwindow_point (window)),
753                       XINT (value), 0);
754     Fset_window_point (window, make_int (bufpos));
755     Fcenter_to_window_line (Qzero, window);
756   }
757 #endif /* Athena */
758   zmacs_region_stays = 1;
759   return Qnil;
760 }
761
762 DEFUN ("scrollbar-page-down", Fscrollbar_page_down, 1, 1, 0, /*
763 Function called when the user gives the "page-down" scrollbar action.
764 \(The way this is done can vary from scrollbar to scrollbar.) One argument,
765 a cons containing the scrollbar's window and a value (#### document me!
766 This value is nil for Motif/Lucid scrollbars and a number for Athena
767 scrollbars).  You can advise this function to change the scrollbar
768 behavior.
769 */
770        (object))
771 {
772   Lisp_Object window = Fcar (object);
773
774   CHECK_LIVE_WINDOW (window);
775   /* Motif and Athena scrollbars behave differently, but in accordance
776      with their standard behaviors.  It is not possible to hide the
777      differences down in lwlib because knowledge of XEmacs buffer and
778      cursor motion routines is necessary. */
779 #if defined (LWLIB_SCROLLBARS_MOTIF) || defined (LWLIB_SCROLLBARS_LUCID) || \
780     defined (LWLIB_SCROLLBARS_ATHENA3D) || defined (HAVE_MS_WINDOWS)
781   window_scroll (window, Qnil, 1, ERROR_ME_NOT);
782 #else /* Athena */
783   {
784     Lisp_Object value = Fcdr (object);
785     CHECK_INT (value);
786     Fmove_to_window_line (value, window);
787     Fcenter_to_window_line (Qzero, window);
788   }
789 #endif /* Athena */
790   zmacs_region_stays = 1;
791   return Qnil;
792 }
793
794 DEFUN ("scrollbar-to-top", Fscrollbar_to_top, 1, 1, 0, /*
795 Function called when the user invokes the "to-top" scrollbar action.
796 The way this is done can vary from scrollbar to scrollbar, but
797 C-button1 on the up-arrow is very common. One argument, the
798 scrollbar's window.  You can advise this function to change the
799 scrollbar behavior.
800 */
801        (window))
802 {
803   Lisp_Object orig_pt = Fwindow_point (window);
804   Fset_window_point (window, Fpoint_min (Fwindow_buffer (window)));
805   Fcenter_to_window_line (Qzero, window);
806   scrollbar_reset_cursor (window, orig_pt);
807   zmacs_region_stays = 1;
808   return Qnil;
809 }
810
811 DEFUN ("scrollbar-to-bottom", Fscrollbar_to_bottom, 1, 1, 0, /*
812 Function called when the user invokes the "to-bottom" scrollbar action.
813 The way this is done can vary from scrollbar to scrollbar, but
814 C-button1 on the down-arrow is very common. One argument, the
815 scrollbar's window.  You can advise this function to change the
816 scrollbar behavior.
817 */
818        (window))
819 {
820   Lisp_Object orig_pt = Fwindow_point (window);
821   Fset_window_point (window, Fpoint_max (Fwindow_buffer (window)));
822   Fcenter_to_window_line (make_int (-3), window);
823   scrollbar_reset_cursor (window, orig_pt);
824   zmacs_region_stays = 1;
825   return Qnil;
826 }
827
828 DEFUN ("scrollbar-vertical-drag", Fscrollbar_vertical_drag, 1, 1, 0, /*
829 Function called when the user drags the vertical scrollbar slider.
830 One argument, a cons containing the scrollbar's window and a value
831 between point-min and point-max.  You can advise this function to
832 change the scrollbar behavior.
833 */
834        (object))
835 {
836   Bufpos start_pos;
837   Lisp_Object orig_pt;
838   Lisp_Object window = Fcar (object);
839   Lisp_Object value = Fcdr (object);
840
841   orig_pt = Fwindow_point (window);
842   Fset_marker (XWINDOW (window)->sb_point, value, Fwindow_buffer (window));
843   start_pos = scrollbar_point (XWINDOW (window), 1);
844   Fset_window_start (window, make_int (start_pos), Qnil);
845   scrollbar_reset_cursor (window, orig_pt);
846   Fsit_for(Qzero, Qnil);
847   zmacs_region_stays = 1;
848   return Qnil;
849 }
850
851 DEFUN ("scrollbar-set-hscroll", Fscrollbar_set_hscroll, 2, 2, 0, /*
852 Set WINDOW's hscroll position to VALUE.
853 This ensures that VALUE is in the proper range for the horizontal scrollbar.
854 */
855        (window, value))
856 {
857   struct window *w;
858   int hscroll, wcw, max_len;
859
860   CHECK_LIVE_WINDOW (window);
861   if (!EQ (value, Qmax))
862     CHECK_INT (value);
863
864   w = XWINDOW (window);
865   wcw = window_char_width (w, 0) - 1;
866   /* #### We should be able to scroll further right as long as there is
867      a visible truncation glyph.  This calculation for max is bogus.  */
868   max_len = w->max_line_len + 2;
869
870   if (EQ (value, Qmax) || (XINT (value) > (max_len - wcw)))
871     hscroll = max_len - wcw;
872   else
873     hscroll = XINT (value);
874
875   /* Can't allow this out of set-window-hscroll's acceptable range. */
876   /* #### What hell on the earth this code limits scroll size to the
877      machine-dependent SHORT size? -- kkm */
878   if (hscroll < 0)
879     hscroll = 0;
880   else if (hscroll >= (1 << (SHORTBITS - 1)) - 1)
881     hscroll = (1 << (SHORTBITS - 1)) - 1;
882
883   if (hscroll != w->hscroll)
884     Fset_window_hscroll (window, make_int (hscroll));
885
886   return Qnil;
887 }
888
889 \f
890 /************************************************************************/
891 /*                            initialization                            */
892 /************************************************************************/
893
894 void
895 syms_of_scrollbar (void)
896 {
897   defsymbol (&Qscrollbar_line_up, "scrollbar-line-up");
898   defsymbol (&Qscrollbar_line_down, "scrollbar-line-down");
899   defsymbol (&Qscrollbar_page_up, "scrollbar-page-up");
900   defsymbol (&Qscrollbar_page_down, "scrollbar-page-down");
901   defsymbol (&Qscrollbar_to_top, "scrollbar-to-top");
902   defsymbol (&Qscrollbar_to_bottom, "scrollbar-to-bottom");
903   defsymbol (&Qscrollbar_vertical_drag, "scrollbar-vertical-drag");
904
905   defsymbol (&Qscrollbar_char_left, "scrollbar-char-left");
906   defsymbol (&Qscrollbar_char_right, "scrollbar-char-right");
907   defsymbol (&Qscrollbar_page_left, "scrollbar-page-left");
908   defsymbol (&Qscrollbar_page_right, "scrollbar-page-right");
909   defsymbol (&Qscrollbar_to_left, "scrollbar-to-left");
910   defsymbol (&Qscrollbar_to_right, "scrollbar-to-right");
911   defsymbol (&Qscrollbar_horizontal_drag, "scrollbar-horizontal-drag");
912
913   defsymbol (&Qinit_scrollbar_from_resources, "init-scrollbar-from-resources");
914
915   /* #### All these functions should be moved into Lisp.
916      See comment above. */
917   DEFSUBR (Fscrollbar_line_up);
918   DEFSUBR (Fscrollbar_line_down);
919   DEFSUBR (Fscrollbar_page_up);
920   DEFSUBR (Fscrollbar_page_down);
921   DEFSUBR (Fscrollbar_to_top);
922   DEFSUBR (Fscrollbar_to_bottom);
923   DEFSUBR (Fscrollbar_vertical_drag);
924
925   DEFSUBR (Fscrollbar_set_hscroll);
926 }
927
928 void
929 vars_of_scrollbar (void)
930 {
931   DEFVAR_LISP ("scrollbar-pointer-glyph", &Vscrollbar_pointer_glyph /*
932 *The shape of the mouse-pointer when over a scrollbar.
933 This is a glyph; use `set-glyph-image' to change it.
934 If unspecified in a particular domain, the window-system-provided
935 default pointer is used.
936 */ );
937
938   Fprovide (intern ("scrollbar"));
939 }
940
941 void
942 specifier_vars_of_scrollbar (void)
943 {
944   DEFVAR_SPECIFIER ("scrollbar-width", &Vscrollbar_width /*
945 *Width of vertical scrollbars.
946 This is a specifier; use `set-specifier' to change it.
947 */ );
948   Vscrollbar_width = make_magic_specifier (Qnatnum);
949   set_specifier_fallback
950     (Vscrollbar_width,
951      list1 (Fcons (Qnil, make_int (DEFAULT_SCROLLBAR_WIDTH))));
952   set_specifier_caching (Vscrollbar_width,
953                          offsetof (struct window, scrollbar_width),
954                          vertical_scrollbar_changed_in_window,
955                          offsetof (struct frame, scrollbar_width),
956                          frame_size_slipped);
957
958   DEFVAR_SPECIFIER ("scrollbar-height", &Vscrollbar_height /*
959 *Height of horizontal scrollbars.
960 This is a specifier; use `set-specifier' to change it.
961 */ );
962   Vscrollbar_height = make_magic_specifier (Qnatnum);
963   set_specifier_fallback
964     (Vscrollbar_height,
965      list1 (Fcons (Qnil, make_int (DEFAULT_SCROLLBAR_HEIGHT))));
966   set_specifier_caching (Vscrollbar_height,
967                          offsetof (struct window, scrollbar_height),
968                          some_window_value_changed,
969                          offsetof (struct frame, scrollbar_height),
970                          frame_size_slipped);
971
972   DEFVAR_SPECIFIER ("horizontal-scrollbar-visible-p", &Vhorizontal_scrollbar_visible_p /*
973 *Whether the horizontal scrollbar is visible.
974 This is a specifier; use `set-specifier' to change it.
975 */ );
976   Vhorizontal_scrollbar_visible_p = Fmake_specifier (Qboolean);
977   set_specifier_fallback (Vhorizontal_scrollbar_visible_p,
978                           list1 (Fcons (Qnil, Qt)));
979   set_specifier_caching (Vhorizontal_scrollbar_visible_p,
980                          offsetof (struct window,
981                                    horizontal_scrollbar_visible_p),
982                          some_window_value_changed,
983                          offsetof (struct frame,
984                                    horizontal_scrollbar_visible_p),
985                          frame_size_slipped);
986
987   DEFVAR_SPECIFIER ("vertical-scrollbar-visible-p", &Vvertical_scrollbar_visible_p /*
988 *Whether the vertical scrollbar is visible.
989 This is a specifier; use `set-specifier' to change it.
990 */ );
991   Vvertical_scrollbar_visible_p = Fmake_specifier (Qboolean);
992   set_specifier_fallback (Vvertical_scrollbar_visible_p,
993                           list1 (Fcons (Qnil, Qt)));
994   set_specifier_caching (Vvertical_scrollbar_visible_p,
995                          offsetof (struct window,
996                                    vertical_scrollbar_visible_p),
997                          vertical_scrollbar_changed_in_window,
998                          offsetof (struct frame,
999                                    vertical_scrollbar_visible_p),
1000                          frame_size_slipped);
1001
1002   DEFVAR_SPECIFIER ("scrollbar-on-left-p", &Vscrollbar_on_left_p /*
1003 *Whether the vertical scrollbar is on the left side of window or frame.
1004 This is a specifier; use `set-specifier' to change it.
1005 */ );
1006   Vscrollbar_on_left_p = Fmake_specifier (Qboolean);
1007   
1008   {
1009     /* Kludge. Under X, we want athena scrollbars on the left,
1010        while all other scrollbars go on the right by default. */
1011     Lisp_Object fallback = list1 (Fcons (Qnil, Qnil));
1012 #if defined (HAVE_X_WINDOWS)                    \
1013     && !defined (LWLIB_SCROLLBARS_MOTIF)        \
1014     && !defined (LWLIB_SCROLLBARS_LUCID)        \
1015     && !defined (LWLIB_SCROLLBARS_ATHENA3D)
1016
1017     fallback = Fcons (Fcons (list1 (Qx), Qt), fallback);
1018 #endif
1019     set_specifier_fallback (Vscrollbar_on_left_p, fallback);
1020   }
1021
1022   set_specifier_caching (Vscrollbar_on_left_p,
1023                          offsetof (struct window, scrollbar_on_left_p),
1024                          vertical_scrollbar_changed_in_window,
1025                          offsetof (struct frame, scrollbar_on_left_p),
1026                          frame_size_slipped);
1027
1028   DEFVAR_SPECIFIER ("scrollbar-on-top-p", &Vscrollbar_on_top_p /*
1029 *Whether the horizontal scrollbar is on the top side of window or frame.
1030 This is a specifier; use `set-specifier' to change it.
1031 */ );
1032   Vscrollbar_on_top_p = Fmake_specifier (Qboolean);
1033   set_specifier_fallback (Vscrollbar_on_top_p,
1034                           list1 (Fcons (Qnil, Qnil)));
1035   set_specifier_caching (Vscrollbar_on_top_p,
1036                          offsetof (struct window, scrollbar_on_top_p),
1037                          some_window_value_changed,
1038                          offsetof (struct frame, scrollbar_on_top_p),
1039                          frame_size_slipped);
1040 }
1041
1042 void
1043 complex_vars_of_scrollbar (void)
1044 {
1045   Vscrollbar_pointer_glyph = Fmake_glyph_internal (Qpointer);
1046
1047   set_specifier_caching (XGLYPH (Vscrollbar_pointer_glyph)->image,
1048                          offsetof (struct window, scrollbar_pointer),
1049                          scrollbar_pointer_changed_in_window,
1050                          0, 0);
1051 }