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