Mercurial > emacs
view lisp/scroll-bar.el @ 51207:7e176ef34c10
Make (many) trivial substitutions for renamed and
new macros in dispextern.h, frame.h and window.h.
(make_window): Initialize new members
left_margin_cols, right_margin_cols, left_fringe_width,
right_fringe_width, fringes_outside_margins, scroll_bar_width,
and vertical_scroll_bar_type.
(coordinates_in_window): Adapted to new fringe/margin positions
and per-window fringes and scroll-bars.
Fix bug related to incorrectly adjusting coordinates by
frame's internal_border_width (the effect normally negible since
the internal_border_width is typically 0 or 1 pixel, but very
noticeable for an internal_border_width of e.g. 25 pixels).
Upon successful return (other than ON_NOTHING), the coordinates
are now always properly converted to window relative for the
given display element.
(window_from_coordinates): Add new parameters wx and wy to
return the window relative x and y position in the returned
window and part. A null arg means, don't return the position.
All callers changed.
(adjust_window_margins): New function which may reduce the width
of the display margins if a window's text area is too small after
resizing or splitting windows.
(size_window): Fix bug that did not account for display margin
widths when checking the minimum width of a window; use
adjust_window_margins.
(set_window_buffer): Call Fset_window_fringes and
Fset_window_scroll_bars to setup per-window elements.
Add new arg KEEP_MARGINS_P. Non-nil means to keep window's
existing display margin, fringe widths, and scroll bar settings
(e.g. after splitting a window or resizing the frame). All
callers changed.
(Fset_window_buffer): New arg KEEP_MARGINS. All callers changed.
(Fsplit_window): Duplicate original window's display margin,
fringe, and scroll-bar settings; then call Fset_window_buffer with
KEEP_MARGINS non-nil. This fixes a bug which caused a split
window to only preserve the display margins in one of the windows.
When splitting horisontally, call adjust_window_margins on both
windows to ensure that the text area of the new windows is non too
narrow. This fixes a bug which could cause emacs to trap if the
width of the split window was less than the width of the display
margins.
(window_box_text_cols): Renamed from window_internal_width. All
uses changed. Adapt to per-window fringes and scroll bars.
Fix bug that caused vertical separator to be subtracted also on
window frames. Fix another bug that did not reduce the returned
value by the columns used for display margins.
(window_scroll_line_based): Fix bug related to scrolling too much
when display margins are present (implicitly fixed by the fix to
window_box_text_cols).
(scroll_left, scroll_right): Fix bug related to scrolling too far
by default when display margins are present (implicitly fixed by
the fix to window_box_text_cols).
(struct saved_window): Rename members left to left_col, top to
top_line, width to total_cols, height to total_lines, orig_top to
orig_top_line, orig_height to orig_total_lines. All uses changed.
New members left_margin_cols, right_margin_cols,
left_fringe_width, right_fringe_width, fringes_outside_margins,
scroll_bar_width, and vertical_scroll_bar_type for saving
per-window display elements.
(Fset_window_configuration): Restore display margins, fringes,
and scroll bar settings. This fixes a bug which caused display
margins to be discarded when saving and restoring a window
configuration.
(save_window_save): Save display margins, fringes, and scroll bar
settings. This fixes a bug which caused display margins to be
discarded when saving and restoring a window configuration.
(Fset_window_margins): Do nothing if display margins are not
really changed. Otherwise, call adjust_window_margins to ensure
the text area doesn't get too narrow. This fixes a bug which
could cause emacs to trap if setting display margins wider than
the width of the window.
(Fset_window_fringes): New defun to allow user to specifically set
this window's fringe widths and position vs. display margins.
(Fwindow_fringes): New defun to return window's actual fringe
settings.
(Fset_window_scroll_bars): New defun to allow user to specifically
set this window's scroll bar width and position.
(Fwindow_scroll_bars): New defun to return window's actual scroll
bar settings.
(compare_window_configurations): Also compare display margins,
fringes, and scroll bar settings.
(syms_of_window): Defsubr new defuns for fringe and scroll bars.
author | Kim F. Storm <storm@cua.dk> |
---|---|
date | Sat, 24 May 2003 22:07:51 +0000 |
parents | 318f8d4ecf5a |
children | 695cf19ef79e |
line wrap: on
line source
;;; scroll-bar.el --- window system-independent scroll bar support ;; Copyright (C) 1993, 1994, 1995, 1999, 2000, 2001, 2003 ;; Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: hardware ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to the ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. ;;; Commentary: ;; Window-system-independent bindings of mouse clicks on the scroll bar. ;; Presently emulates the scroll-bar behavior of xterm. ;;; Code: (require 'mouse) ;;;; Utilities. (defun scroll-bar-event-ratio (event) "Given a scroll bar event EVENT, return the scroll bar position as a ratio. The value is a cons cell (PORTION . WHOLE) containing two integers whose ratio gives the event's vertical position in the scroll bar, with 0 referring to the top and 1 to the bottom." (nth 2 event)) (defun scroll-bar-scale (num-denom whole) "Given a pair (NUM . DENOM) and WHOLE, return (/ (* NUM WHOLE) DENOM). This is handy for scaling a position on a scroll bar into real units, like buffer positions. If SCROLL-BAR-POS is the (PORTION . WHOLE) pair from a scroll bar event, then (scroll-bar-scale SCROLL-BAR-POS \(buffer-size)) is the position in the current buffer corresponding to that scroll bar position." ;; We multiply before we divide to maintain precision. ;; We use floating point because the product of a large buffer size ;; with a large scroll bar portion can easily overflow a lisp int. (truncate (/ (* (float (car num-denom)) whole) (cdr num-denom)))) ;;;; Helpful functions for enabling and disabling scroll bars. (defvar scroll-bar-mode) (defvar scroll-bar-mode-explicit nil "Non-nil means `set-scroll-bar-mode' should really do something. This is nil while loading `scroll-bar.el', and t afterward.") (defun set-scroll-bar-mode-1 (ignore value) (set-scroll-bar-mode value)) (defun set-scroll-bar-mode (value) "Set `scroll-bar-mode' to VALUE and put the new value into effect." (setq scroll-bar-mode value) (when scroll-bar-mode-explicit ;; Apply it to default-frame-alist. (let ((parameter (assq 'vertical-scroll-bars default-frame-alist))) (if (consp parameter) (setcdr parameter scroll-bar-mode) (setq default-frame-alist (cons (cons 'vertical-scroll-bars scroll-bar-mode) default-frame-alist)))) ;; Apply it to existing frames. (let ((frames (frame-list))) (while frames (modify-frame-parameters (car frames) (list (cons 'vertical-scroll-bars scroll-bar-mode))) (setq frames (cdr frames)))))) (defcustom scroll-bar-mode (cond ((eq system-type 'windows-nt) 'right) ((featurep 'mac-carbon) 'right) (t 'left)) "*Specify whether to have vertical scroll bars, and on which side. Possible values are nil (no scroll bars), `left' (scroll bars on left) and `right' (scroll bars on right). To set this variable in a Lisp program, use `set-scroll-bar-mode' to make it take real effect. Setting the variable with a customization buffer also takes effect." :type '(choice (const :tag "none (nil)" nil) (const left) (const right)) :group 'frames ;; The default value for :initialize would try to use :set ;; when processing the file in cus-dep.el. :initialize 'custom-initialize-default :set 'set-scroll-bar-mode-1) ;; We just set scroll-bar-mode, but that was the default. ;; If it is set again, that is for real. (setq scroll-bar-mode-explicit t) (defun scroll-bar-mode (&optional flag) "Toggle display of vertical scroll bars on all frames. This command applies to all frames that exist and frames to be created in the future. With a numeric argument, if the argument is negative, turn off scroll bars; otherwise, turn on scroll bars." (interactive "P") (if flag (setq flag (prefix-numeric-value flag))) ;; Tweedle the variable according to the argument. (set-scroll-bar-mode (if (null flag) (not scroll-bar-mode) (and (or (not (numberp flag)) (>= flag 0)) (cond ((eq system-type 'windows-nt) 'right) ((featurep 'mac-carbon) 'right) (t 'left)))))) (defun toggle-scroll-bar (arg) "Toggle whether or not the selected frame has vertical scroll bars. With arg, turn vertical scroll bars on if and only if arg is positive. The variable `scroll-bar-mode' controls which side the scroll bars are on when they are turned on; if it is nil, they go on the left." (interactive "P") (if (null arg) (setq arg (if (cdr (assq 'vertical-scroll-bars (frame-parameters (selected-frame)))) -1 1)) (setq arg (prefix-numeric-value arg))) (modify-frame-parameters (selected-frame) (list (cons 'vertical-scroll-bars (if (> arg 0) (or scroll-bar-mode (cond ((eq system-type 'windows-nt) 'right) ((featurep 'mac-carbon) 'right) (t 'left)))))))) (defun toggle-horizontal-scroll-bar (arg) "Toggle whether or not the selected frame has horizontal scroll bars. With arg, turn horizontal scroll bars on if and only if arg is positive. Horizontal scroll bars aren't implemented yet." (interactive "P") (error "Horizontal scroll bars aren't implemented yet")) ;;;; Buffer navigation using the scroll bar. ;;; This was used for up-events on button 2, but no longer. (defun scroll-bar-set-window-start (event) "Set the window start according to where the scroll bar is dragged. EVENT should be a scroll bar click or drag event." (interactive "e") (let* ((end-position (event-end event)) (window (nth 0 end-position)) (portion-whole (nth 2 end-position))) (save-excursion (set-buffer (window-buffer window)) (save-excursion (goto-char (+ (point-min) (scroll-bar-scale portion-whole (- (point-max) (point-min))))) (beginning-of-line) (set-window-start window (point)))))) (defun scroll-bar-drag-position (portion-whole) "Calculate new window start for drag event." (save-excursion (goto-char (+ (point-min) (scroll-bar-scale portion-whole (- (point-max) (point-min))))) (beginning-of-line) (point))) (defun scroll-bar-maybe-set-window-start (event) "Set the window start according to where the scroll bar is dragged. Only change window start if the new start is substantially different. EVENT should be a scroll bar click or drag event." (interactive "e") (let* ((end-position (event-end event)) (window (nth 0 end-position)) (portion-whole (nth 2 end-position)) (next-portion-whole (cons (1+ (car portion-whole)) (cdr portion-whole))) portion-start next-portion-start (current-start (window-start window))) (save-excursion (set-buffer (window-buffer window)) (setq portion-start (scroll-bar-drag-position portion-whole)) (setq next-portion-start (max (scroll-bar-drag-position next-portion-whole) (1+ portion-start))) (if (or (>= current-start next-portion-start) (< current-start portion-start)) (set-window-start window portion-start) ;; Always set window start, to ensure scroll bar position is updated. (set-window-start window current-start))))) ;; Scroll the window to the proper position for EVENT. (defun scroll-bar-drag-1 (event) (let* ((start-position (event-start event)) (window (nth 0 start-position)) (portion-whole (nth 2 start-position))) (save-excursion (set-buffer (window-buffer window)) ;; Calculate position relative to the accessible part of the buffer. (goto-char (+ (point-min) (scroll-bar-scale portion-whole (- (point-max) (point-min))))) (vertical-motion 0 window) (set-window-start window (point))))) (defun scroll-bar-drag (event) "Scroll the window by dragging the scroll bar slider. If you click outside the slider, the window scrolls to bring the slider there." (interactive "e") (let* (done (echo-keystrokes 0) (end-position (event-end event)) (window (nth 0 end-position)) (before-scroll)) (with-current-buffer (window-buffer window) (setq before-scroll point-before-scroll)) (save-selected-window (select-window window) (setq before-scroll (or before-scroll (point)))) (scroll-bar-drag-1 event) (track-mouse (while (not done) (setq event (read-event)) (if (eq (car-safe event) 'mouse-movement) (setq event (read-event))) (cond ((eq (car-safe event) 'scroll-bar-movement) (scroll-bar-drag-1 event)) (t ;; Exit when we get the drag event; ignore that event. (setq done t))))) (sit-for 0) (with-current-buffer (window-buffer window) (setq point-before-scroll before-scroll)))) (defun scroll-bar-scroll-down (event) "Scroll the window's top line down to the location of the scroll bar click. EVENT should be a scroll bar click." (interactive "e") (let* ((end-position (event-end event)) (window (nth 0 end-position)) (before-scroll)) (with-current-buffer (window-buffer window) (setq before-scroll point-before-scroll)) (unwind-protect (save-selected-window (let ((portion-whole (nth 2 end-position))) (select-window window) (setq before-scroll (or before-scroll (point))) (scroll-down (scroll-bar-scale portion-whole (1- (window-height))))) (sit-for 0)) (with-current-buffer (window-buffer window) (setq point-before-scroll before-scroll))))) (defun scroll-bar-scroll-up (event) "Scroll the line next to the scroll bar click to the top of the window. EVENT should be a scroll bar click." (interactive "e") (let* ((end-position (event-end event)) (window (nth 0 end-position)) (before-scroll)) (with-current-buffer (window-buffer window) (setq before-scroll point-before-scroll)) (unwind-protect (save-selected-window (let ((portion-whole (nth 2 end-position))) (select-window window) (setq before-scroll (or before-scroll (point))) (scroll-up (scroll-bar-scale portion-whole (1- (window-height))))) (sit-for 0)) (with-current-buffer (window-buffer window) (setq point-before-scroll before-scroll))))) ;;; Tookit scroll bars. (defun scroll-bar-toolkit-scroll (event) (interactive "e") (let* ((end-position (event-end event)) (window (nth 0 end-position)) (part (nth 4 end-position)) before-scroll) (cond ((eq part 'end-scroll)) (t (with-current-buffer (window-buffer window) (setq before-scroll point-before-scroll)) (save-selected-window (select-window window) (setq before-scroll (or before-scroll (point))) (cond ((eq part 'above-handle) (scroll-up '-)) ((eq part 'below-handle) (scroll-up nil)) ((eq part 'ratio) (let* ((portion-whole (nth 2 end-position)) (lines (scroll-bar-scale portion-whole (1- (window-height))))) (scroll-up (cond ((not (zerop lines)) lines) ((< (car portion-whole) 0) -1) (t 1))))) ((eq part 'up) (scroll-up -1)) ((eq part 'down) (scroll-up 1)) ((eq part 'top) (set-window-start window (point-min))) ((eq part 'bottom) (goto-char (point-max)) (recenter)) ((eq part 'handle) (scroll-bar-drag-1 event)))) (sit-for 0) (with-current-buffer (window-buffer window) (setq point-before-scroll before-scroll)))))) ;;;; Bindings. ;;; For now, we'll set things up to work like xterm. (cond ((and (boundp 'x-toolkit-scroll-bars) x-toolkit-scroll-bars) (global-set-key [vertical-scroll-bar mouse-1] 'scroll-bar-toolkit-scroll)) (t (global-set-key [vertical-scroll-bar mouse-1] 'scroll-bar-scroll-up) (global-set-key [vertical-scroll-bar drag-mouse-1] 'scroll-bar-scroll-up) (global-set-key [vertical-scroll-bar down-mouse-2] 'scroll-bar-drag) (global-set-key [vertical-scroll-bar mouse-3] 'scroll-bar-scroll-down) (global-set-key [vertical-scroll-bar drag-mouse-3] 'scroll-bar-scroll-down))) (provide 'scroll-bar) ;;; scroll-bar.el ends here