X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/26e06f4464c58704889bdc536edc25b73e8c0179..eebc475df54de7ad5c04ef7cddc083c865235540:/lisp/scroll-bar.el diff --git a/lisp/scroll-bar.el b/lisp/scroll-bar.el index f12e0b42b9..87c24018c0 100644 --- a/lisp/scroll-bar.el +++ b/lisp/scroll-bar.el @@ -1,10 +1,10 @@ ;;; scroll-bar.el --- window system-independent scroll bar support -;; Copyright (C) 1993, 1994, 1995, 1999, 2000, 2001, 2002, 2003, -;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. +;; Copyright (C) 1993-1995, 1999-2011 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: hardware +;; Package: emacs ;; This file is part of GNU Emacs. @@ -29,6 +29,7 @@ ;;; Code: (require 'mouse) +(eval-when-compile (require 'cl)) ;;;; Utilities. @@ -79,9 +80,6 @@ SIDE must be the symbol `left' or `right'." "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." (if scroll-bar-mode @@ -94,7 +92,7 @@ This is nil while loading `scroll-bar.el', and t afterward.") scroll-bar-mode))))) (defcustom scroll-bar-mode default-frame-scroll-bars - "*Specify whether to have vertical scroll bars, and on which side. + "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' @@ -107,27 +105,23 @@ Setting the variable with a customization buffer also takes effect." ;; 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) + :set (lambda (sym val) (set-scroll-bar-mode val))) ;; 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) +(defun get-scroll-bar-mode () scroll-bar-mode) +(defsetf get-scroll-bar-mode set-scroll-bar-mode) +(define-minor-mode scroll-bar-mode "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") - - ;; Tweedle the variable according to the argument. - (set-scroll-bar-mode (if (if (null flag) - (not scroll-bar-mode) - (setq flag (prefix-numeric-value flag)) - (or (not (numberp flag)) (>= flag 0))) - (or previous-scroll-bar-mode - default-frame-scroll-bars)))) +With a numeric argument, if the argument is positive +turn on scroll bars; otherwise turn off scroll bars." + :variable (eq (get-scroll-bar-mode) + (or previous-scroll-bar-mode + default-frame-scroll-bars))) (defun toggle-scroll-bar (arg) "Toggle whether or not the selected frame has vertical scroll bars. @@ -156,7 +150,7 @@ 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. +;; 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." @@ -164,8 +158,7 @@ EVENT should be a scroll bar click or drag event." (let* ((end-position (event-end event)) (window (nth 0 end-position)) (portion-whole (nth 2 end-position))) - (save-excursion - (set-buffer (window-buffer window)) + (with-current-buffer (window-buffer window) (save-excursion (goto-char (+ (point-min) (scroll-bar-scale portion-whole @@ -195,8 +188,7 @@ EVENT should be a scroll bar click or drag event." portion-start next-portion-start (current-start (window-start window))) - (save-excursion - (set-buffer (window-buffer window)) + (with-current-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) @@ -212,14 +204,14 @@ EVENT should be a scroll bar click or drag 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))))) + (save-excursion + (with-current-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. @@ -339,7 +331,7 @@ EVENT should be a scroll bar click." ;;;; Bindings. -;;; For now, we'll set things up to work like xterm. +;; 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)) @@ -358,5 +350,4 @@ EVENT should be a scroll bar click." (provide 'scroll-bar) -;; arch-tag: 6f1d01d0-0b1e-4bf8-86db-d491e0f399f3 ;;; scroll-bar.el ends here