Mercurial > emacs

comparison lisp/scroll-bar.el @ 1981:bde0ca7e33b3

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Use the term `scroll bar', instead of `scrollbar'. * term/x-win.el, frame.el, mouse.el: Terminology changed. * scrollbar.el: Renamed to scroll-bar.el.
author Jim Blandy <jimb@redhat.com>
date Tue, 02 Mar 1993 07:29:47 +0000
parents 3a08dacd8bfb
children 4f9d60f7de9d
comparison
equal deleted inserted replaced
1980:263033210413 1981:bde0ca7e33b3
1 ;;; scrollbar.el -- window system-independent scrollbar support. 1 ;;; scroll-bar.el -- window system-independent scroll bar support.
2 2
3 ;;; Copyright (C) 1993 Free Software Foundation, Inc. 3 ;;; Copyright (C) 1993 Free Software Foundation, Inc.
4 4
5 ;; Maintainer: FSF 5 ;; Maintainer: FSF
6 ;; Keywords: hardware 6 ;; Keywords: hardware
24 (require 'mouse) 24 (require 'mouse)
25 25
26 26
27 ;;;; Utilities. 27 ;;;; Utilities.
28 28
29 (defun scrollbar-scale (num-denom whole) 29 (defun scroll-bar-scale (num-denom whole)
30 "Given a pair (NUM . DENOM) and WHOLE, return (/ (* NUM WHOLE) DENOM). 30 "Given a pair (NUM . DENOM) and WHOLE, return (/ (* NUM WHOLE) DENOM).
31 This is handy for scaling a position on a scrollbar into real units, 31 This is handy for scaling a position on a scroll bar into real units,
32 like buffer positions. If SCROLLBAR-POS is the (PORTION . WHOLE) pair 32 like buffer positions. If SCROLL-BAR-POS is the (PORTION . WHOLE) pair
33 from a scrollbar event, then (scrollbar-scale SCROLLBAR-POS 33 from a scroll bar event, then (scroll-bar-scale SCROLL-BAR-POS
34 \(buffer-size)) is the position in the current buffer corresponding to 34 \(buffer-size)) is the position in the current buffer corresponding to
35 that scrollbar position." 35 that scroll bar position."
36 ;; We multiply before we divide to maintain precision. 36 ;; We multiply before we divide to maintain precision.
37 ;; We use floating point because the product of a large buffer size 37 ;; We use floating point because the product of a large buffer size
38 ;; with a large scrollbar portion can easily overflow a lisp int. 38 ;; with a large scroll bar portion can easily overflow a lisp int.
39 (truncate (/ (* (float (car num-denom)) whole) (cdr num-denom)))) 39 (truncate (/ (* (float (car num-denom)) whole) (cdr num-denom))))
40 40
41 41
42 ;;;; Helpful functions for enabling and disabling scroll bars. 42 ;;;; Helpful functions for enabling and disabling scroll bars.
43 (defvar scroll-bar-mode nil) 43 (defvar scroll-bar-mode nil)
58 (if (consp parameter) 58 (if (consp parameter)
59 (setcdr parameter scroll-bar-mode) 59 (setcdr parameter scroll-bar-mode)
60 (setq default-frame-alist 60 (setq default-frame-alist
61 (cons (cons param-name scroll-bar-mode) 61 (cons (cons param-name scroll-bar-mode)
62 default-frame-alist)))))) 62 default-frame-alist))))))
63 '(vertical-scrollbars horizontal-scrollbars)) 63 '(vertical-scroll-bars horizontal-scroll-bars))
64 (let ((frames (frame-list))) 64 (let ((frames (frame-list)))
65 (while frames 65 (while frames
66 (modify-frame-parameters 66 (modify-frame-parameters
67 (car frames) 67 (car frames)
68 (list (cons 'vertical-scrollbars scroll-bar-mode) 68 (list (cons 'vertical-scroll-bars scroll-bar-mode)
69 (cons 'horizontal-scrollbars scroll-bar-mode))) 69 (cons 'horizontal-scroll-bars scroll-bar-mode)))
70 (setq frames (cdr frames))))) 70 (setq frames (cdr frames)))))
71 71
72 ;;;; Buffer navigation using the scrollbar. 72 ;;;; Buffer navigation using the scroll bar.
73 73
74 (defun scrollbar-set-window-start (event) 74 (defun scroll-bar-set-window-start (event)
75 "Set the window start according to where the scrollbar is dragged. 75 "Set the window start according to where the scroll bar is dragged.
76 EVENT should be a scrollbar click or drag event." 76 EVENT should be a scroll bar click or drag event."
77 (interactive "e") 77 (interactive "e")
78 (let* ((end-position (event-end event)) 78 (let* ((end-position (event-end event))
79 (window (nth 0 end-position)) 79 (window (nth 0 end-position))
80 (portion-whole (nth 2 end-position))) 80 (portion-whole (nth 2 end-position)))
81 (save-excursion 81 (save-excursion
82 (set-buffer (window-buffer window)) 82 (set-buffer (window-buffer window))
83 (save-excursion 83 (save-excursion
84 (goto-char (scrollbar-scale portion-whole (buffer-size))) 84 (goto-char (scroll-bar-scale portion-whole (buffer-size)))
85 (beginning-of-line) 85 (beginning-of-line)
86 (set-window-start window (point)))))) 86 (set-window-start window (point))))))
87 87
88 (defun scrollbar-scroll-down (event) 88 (defun scroll-bar-scroll-down (event)
89 "Scroll the window's top line down to the location of the scrollbar click. 89 "Scroll the window's top line down to the location of the scroll bar click.
90 EVENT should be a scrollbar click." 90 EVENT should be a scroll bar click."
91 (interactive "e") 91 (interactive "e")
92 (let ((old-selected-window (selected-window))) 92 (let ((old-selected-window (selected-window)))
93 (unwind-protect 93 (unwind-protect
94 (progn 94 (progn
95 (let* ((end-position (event-end event)) 95 (let* ((end-position (event-end event))
96 (window (nth 0 end-position)) 96 (window (nth 0 end-position))
97 (portion-whole (nth 2 end-position))) 97 (portion-whole (nth 2 end-position)))
98 (select-window window) 98 (select-window window)
99 (scroll-down 99 (scroll-down
100 (scrollbar-scale portion-whole (1- (window-height)))))) 100 (scroll-bar-scale portion-whole (1- (window-height))))))
101 (select-window old-selected-window)))) 101 (select-window old-selected-window))))
102 102
103 (defun scrollbar-scroll-up (event) 103 (defun scroll-bar-scroll-up (event)
104 "Scroll the line next to the scrollbar click to the top of the window. 104 "Scroll the line next to the scroll bar click to the top of the window.
105 EVENT should be a scrollbar click." 105 EVENT should be a scroll bar click."
106 (interactive "e") 106 (interactive "e")
107 (let ((old-selected-window (selected-window))) 107 (let ((old-selected-window (selected-window)))
108 (unwind-protect 108 (unwind-protect
109 (progn 109 (progn
110 (let* ((end-position (event-end event)) 110 (let* ((end-position (event-end event))
111 (window (nth 0 end-position)) 111 (window (nth 0 end-position))
112 (portion-whole (nth 2 end-position))) 112 (portion-whole (nth 2 end-position)))
113 (select-window window) 113 (select-window window)
114 (scroll-up 114 (scroll-up
115 (scrollbar-scale portion-whole (1- (window-height)))))) 115 (scroll-bar-scale portion-whole (1- (window-height))))))
116 (select-window old-selected-window)))) 116 (select-window old-selected-window))))
117 117
118 118
119 ;;;; Bindings. 119 ;;;; Bindings.
120 120
121 ;;; For now, we'll set things up to work like xterm. 121 ;;; For now, we'll set things up to work like xterm.
122 (global-set-key [vertical-scrollbar mouse-1] 'scrollbar-scroll-up) 122 (global-set-key [vertical-scroll-bar mouse-1] 'scroll-bar-scroll-up)
123 (global-set-key [vertical-scrollbar drag-mouse-1] 'scrollbar-scroll-up) 123 (global-set-key [vertical-scroll-bar drag-mouse-1] 'scroll-bar-scroll-up)
124 124
125 (global-set-key [vertical-scrollbar mouse-2] 'scrollbar-set-window-start) 125 (global-set-key [vertical-scroll-bar mouse-2] 'scroll-bar-set-window-start)
126 (global-set-key [vertical-scrollbar drag-mouse-2] 'scrollbar-set-window-start) 126 (global-set-key [vertical-scroll-bar drag-mouse-2] 'scroll-bar-set-window-start)
127 127
128 (global-set-key [vertical-scrollbar mouse-3] 'scrollbar-scroll-down) 128 (global-set-key [vertical-scroll-bar mouse-3] 'scroll-bar-scroll-down)
129 (global-set-key [vertical-scrollbar drag-mouse-3] 'scrollbar-scroll-down) 129 (global-set-key [vertical-scroll-bar drag-mouse-3] 'scroll-bar-scroll-down)
130 130
131 131
132 (provide 'scroll-bar) 132 (provide 'scroll-bar)
133 133
134 ;;; scrollbar.el ends here 134 ;;; scroll-bar.el ends here