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