git.chise.org Git - chise/xemacs-chise.git.1/blob - 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 }