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