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