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