X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/cf4eb316c1a3c33882e2fad6cf943abe93933d85..052ca4d1d2fffca52c6e69c4f8cd480ca547463e:/lisp/scroll-bar.el diff --git a/lisp/scroll-bar.el b/lisp/scroll-bar.el index 4499c0b0b5..2d2921e9fc 100644 --- a/lisp/scroll-bar.el +++ b/lisp/scroll-bar.el @@ -1,6 +1,7 @@ -;;; scroll-bar.el --- window system-independent scroll bar support. +;;; scroll-bar.el --- window system-independent scroll bar support -;; Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc. +;; Copyright (C) 1993, 1994, 1995, 1999, 2000, 2001, 2003 +;; Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: hardware @@ -53,6 +54,23 @@ that scroll bar position." ;; with a large scroll bar portion can easily overflow a lisp int. (truncate (/ (* (float (car num-denom)) whole) (cdr num-denom)))) +(defun scroll-bar-columns (side) + "Return the width, measured in columns, of the vertical scrollbar on SIDE. +SIDE must be the symbol `left' or `right'." + (let* ((wsb (window-scroll-bars)) + (vtype (nth 2 wsb)) + (cols (nth 1 wsb))) + (cond + ((not (memq side '(left right))) + (error "`left' or `right' expected instead of %S" side)) + ((and (eq vtype side) cols)) + ((eq (frame-parameter nil 'vertical-scroll-bars) side) + ;; nil means it's a non-toolkit scroll bar, and its width in + ;; columns is 14 pixels rounded up. + (ceiling (or (frame-parameter nil 'scroll-bar-width) 14) + (frame-char-width))) + (0)))) + ;;;; Helpful functions for enabling and disabling scroll bars. @@ -86,37 +104,40 @@ This is nil while loading `scroll-bar.el', and t afterward.") (list (cons 'vertical-scroll-bars scroll-bar-mode))) (setq frames (cdr frames)))))) -(defcustom scroll-bar-mode - (if (eq system-type 'windows-nt) 'right 'left) +(defcustom scroll-bar-mode default-frame-scroll-bars "*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)") + :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 (flag) +(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)) - (if (eq system-type 'windows-nt) 'right 'left))))) + (set-scroll-bar-mode (if (if (null flag) + (not scroll-bar-mode) + (setq flag (prefix-numeric-value flag)) + (or (not (numberp flag)) (>= flag 0))) + default-frame-scroll-bars))) (defun toggle-scroll-bar (arg) "Toggle whether or not the selected frame has vertical scroll bars. @@ -134,8 +155,7 @@ when they are turned on; if it is nil, they go on the left." (selected-frame) (list (cons 'vertical-scroll-bars (if (> arg 0) - (or scroll-bar-mode - (if (eq system-type 'windows-nt) 'right 'left))))))) + (or scroll-bar-mode default-frame-scroll-bars)))))) (defun toggle-horizontal-scroll-bar (arg) "Toggle whether or not the selected frame has horizontal scroll bars. @@ -208,7 +228,7 @@ EVENT should be a scroll bar click or drag event." (goto-char (+ (point-min) (scroll-bar-scale portion-whole (- (point-max) (point-min))))) - (beginning-of-line) + (vertical-motion 0 window) (set-window-start window (point))))) (defun scroll-bar-drag (event) @@ -286,26 +306,13 @@ EVENT should be a scroll bar click." ;;; Tookit scroll bars. -;; Due to its event handling, Emacs is currently not able to handle Xt -;; timeouts which toolkit scroll bars use to implement auto-repeat. -;; As a workaround, we start a timer whenever a scroll bar action -;; occurs, and remove it again when are notified that the user no -;; longer interacts with the scroll bar. The timer function gives Xt -;; the chance to call Xt timeout functions. - -(defvar scroll-bar-timer nil - "Timer running while scroll bar is active.") - (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) - (when scroll-bar-timer - (cancel-timer scroll-bar-timer) - (setq scroll-bar-timer nil))) + (cond ((eq part 'end-scroll)) (t (with-current-buffer (window-buffer window) (setq before-scroll point-before-scroll)) @@ -316,6 +323,13 @@ EVENT should be a scroll bar click." (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) @@ -328,9 +342,6 @@ EVENT should be a scroll bar click." ((eq part 'handle) (scroll-bar-drag-1 event)))) (sit-for 0) - (unless scroll-bar-timer - (setq scroll-bar-timer - (run-with-timer 0.1 0.1 'xt-process-timeouts))) (with-current-buffer (window-buffer window) (setq point-before-scroll before-scroll)))))) @@ -339,7 +350,7 @@ EVENT should be a scroll bar click." ;;;; Bindings. ;;; For now, we'll set things up to work like xterm. -(cond (x-toolkit-scroll-bars-p +(cond ((and (boundp 'x-toolkit-scroll-bars) x-toolkit-scroll-bars) (global-set-key [vertical-scroll-bar mouse-1] 'scroll-bar-toolkit-scroll)) (t @@ -357,4 +368,5 @@ EVENT should be a scroll bar click." (provide 'scroll-bar) +;;; arch-tag: 6f1d01d0-0b1e-4bf8-86db-d491e0f399f3 ;;; scroll-bar.el ends here