Mercurial > emacs
annotate lisp/scroll-bar.el @ 2262:29579cd51981
Added unlock and relock.
author | Eric S. Raymond <esr@snark.thyrsus.com> |
---|---|
date | Fri, 19 Mar 1993 07:49:20 +0000 |
parents | fb0ed5a1d0f3 |
children | 9e7ec92a4fdf |
rev | line source |
---|---|
2232
4f9d60f7de9d
Add standard library headers.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
1981
diff
changeset
|
1 ;;; scroll-bar.el --- window system-independent scroll bar support. |
1772 | 2 |
3 ;;; Copyright (C) 1993 Free Software Foundation, Inc. | |
4 | |
5 ;; Maintainer: FSF | |
6 ;; Keywords: hardware | |
7 | |
8 ;;; This file is part of GNU Emacs. | |
9 | |
10 ;;; GNU Emacs is free software; you can redistribute it and/or modify | |
11 ;;; it under the terms of the GNU General Public License as published by | |
12 ;;; the Free Software Foundation; either version 2, or (at your option) | |
13 ;;; any later version. | |
14 | |
15 ;;; GNU Emacs is distributed in the hope that it will be useful, | |
16 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
17 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
18 ;;; GNU General Public License for more details. | |
19 | |
20 ;;; You should have received a copy of the GNU General Public License | |
21 ;;; along with GNU Emacs; see the file COPYING. If not, write to | |
22 ;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. | |
23 | |
2233
fb0ed5a1d0f3
Add standard library headers.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2232
diff
changeset
|
24 ;;; Code: |
fb0ed5a1d0f3
Add standard library headers.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2232
diff
changeset
|
25 |
1821
04fb1d3d6992
JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents:
1772
diff
changeset
|
26 (require 'mouse) |
04fb1d3d6992
JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents:
1772
diff
changeset
|
27 |
1772 | 28 |
29 ;;;; Utilities. | |
30 | |
1981
bde0ca7e33b3
Use the term `scroll bar', instead of `scrollbar'.
Jim Blandy <jimb@redhat.com>
parents:
1973
diff
changeset
|
31 (defun scroll-bar-scale (num-denom whole) |
1772 | 32 "Given a pair (NUM . DENOM) and WHOLE, return (/ (* NUM WHOLE) DENOM). |
1981
bde0ca7e33b3
Use the term `scroll bar', instead of `scrollbar'.
Jim Blandy <jimb@redhat.com>
parents:
1973
diff
changeset
|
33 This is handy for scaling a position on a scroll bar into real units, |
bde0ca7e33b3
Use the term `scroll bar', instead of `scrollbar'.
Jim Blandy <jimb@redhat.com>
parents:
1973
diff
changeset
|
34 like buffer positions. If SCROLL-BAR-POS is the (PORTION . WHOLE) pair |
bde0ca7e33b3
Use the term `scroll bar', instead of `scrollbar'.
Jim Blandy <jimb@redhat.com>
parents:
1973
diff
changeset
|
35 from a scroll bar event, then (scroll-bar-scale SCROLL-BAR-POS |
1772 | 36 \(buffer-size)) is the position in the current buffer corresponding to |
1981
bde0ca7e33b3
Use the term `scroll bar', instead of `scrollbar'.
Jim Blandy <jimb@redhat.com>
parents:
1973
diff
changeset
|
37 that scroll bar position." |
1772 | 38 ;; We multiply before we divide to maintain precision. |
39 ;; We use floating point because the product of a large buffer size | |
1981
bde0ca7e33b3
Use the term `scroll bar', instead of `scrollbar'.
Jim Blandy <jimb@redhat.com>
parents:
1973
diff
changeset
|
40 ;; with a large scroll bar portion can easily overflow a lisp int. |
1772 | 41 (truncate (/ (* (float (car num-denom)) whole) (cdr num-denom)))) |
42 | |
43 | |
1954
059d99d03aae
* term/x-win.el (scroll-bar-mode, scroll-bar-mode): Move these
Jim Blandy <jimb@redhat.com>
parents:
1821
diff
changeset
|
44 ;;;; Helpful functions for enabling and disabling scroll bars. |
059d99d03aae
* term/x-win.el (scroll-bar-mode, scroll-bar-mode): Move these
Jim Blandy <jimb@redhat.com>
parents:
1821
diff
changeset
|
45 (defvar scroll-bar-mode nil) |
059d99d03aae
* term/x-win.el (scroll-bar-mode, scroll-bar-mode): Move these
Jim Blandy <jimb@redhat.com>
parents:
1821
diff
changeset
|
46 |
059d99d03aae
* term/x-win.el (scroll-bar-mode, scroll-bar-mode): Move these
Jim Blandy <jimb@redhat.com>
parents:
1821
diff
changeset
|
47 (defun scroll-bar-mode (flag) |
059d99d03aae
* term/x-win.el (scroll-bar-mode, scroll-bar-mode): Move these
Jim Blandy <jimb@redhat.com>
parents:
1821
diff
changeset
|
48 "Toggle display of vertical scroll bars on each frame. |
059d99d03aae
* term/x-win.el (scroll-bar-mode, scroll-bar-mode): Move these
Jim Blandy <jimb@redhat.com>
parents:
1821
diff
changeset
|
49 This command applies to all frames that exist and frames to be |
059d99d03aae
* term/x-win.el (scroll-bar-mode, scroll-bar-mode): Move these
Jim Blandy <jimb@redhat.com>
parents:
1821
diff
changeset
|
50 created in the future. |
059d99d03aae
* term/x-win.el (scroll-bar-mode, scroll-bar-mode): Move these
Jim Blandy <jimb@redhat.com>
parents:
1821
diff
changeset
|
51 With a numeric argument, if the argument is negative, |
059d99d03aae
* term/x-win.el (scroll-bar-mode, scroll-bar-mode): Move these
Jim Blandy <jimb@redhat.com>
parents:
1821
diff
changeset
|
52 turn off scroll bars; otherwise, turn on scroll bars." |
059d99d03aae
* term/x-win.el (scroll-bar-mode, scroll-bar-mode): Move these
Jim Blandy <jimb@redhat.com>
parents:
1821
diff
changeset
|
53 (interactive "P") |
059d99d03aae
* term/x-win.el (scroll-bar-mode, scroll-bar-mode): Move these
Jim Blandy <jimb@redhat.com>
parents:
1821
diff
changeset
|
54 (setq scroll-bar-mode (if (null flag) (not scroll-bar-mode) |
059d99d03aae
* term/x-win.el (scroll-bar-mode, scroll-bar-mode): Move these
Jim Blandy <jimb@redhat.com>
parents:
1821
diff
changeset
|
55 (or (not (numberp flag)) (>= flag 0)))) |
059d99d03aae
* term/x-win.el (scroll-bar-mode, scroll-bar-mode): Move these
Jim Blandy <jimb@redhat.com>
parents:
1821
diff
changeset
|
56 (mapcar |
059d99d03aae
* term/x-win.el (scroll-bar-mode, scroll-bar-mode): Move these
Jim Blandy <jimb@redhat.com>
parents:
1821
diff
changeset
|
57 (function |
059d99d03aae
* term/x-win.el (scroll-bar-mode, scroll-bar-mode): Move these
Jim Blandy <jimb@redhat.com>
parents:
1821
diff
changeset
|
58 (lambda (param-name) |
059d99d03aae
* term/x-win.el (scroll-bar-mode, scroll-bar-mode): Move these
Jim Blandy <jimb@redhat.com>
parents:
1821
diff
changeset
|
59 (let ((parameter (assq param-name default-frame-alist))) |
059d99d03aae
* term/x-win.el (scroll-bar-mode, scroll-bar-mode): Move these
Jim Blandy <jimb@redhat.com>
parents:
1821
diff
changeset
|
60 (if (consp parameter) |
059d99d03aae
* term/x-win.el (scroll-bar-mode, scroll-bar-mode): Move these
Jim Blandy <jimb@redhat.com>
parents:
1821
diff
changeset
|
61 (setcdr parameter scroll-bar-mode) |
059d99d03aae
* term/x-win.el (scroll-bar-mode, scroll-bar-mode): Move these
Jim Blandy <jimb@redhat.com>
parents:
1821
diff
changeset
|
62 (setq default-frame-alist |
059d99d03aae
* term/x-win.el (scroll-bar-mode, scroll-bar-mode): Move these
Jim Blandy <jimb@redhat.com>
parents:
1821
diff
changeset
|
63 (cons (cons param-name scroll-bar-mode) |
059d99d03aae
* term/x-win.el (scroll-bar-mode, scroll-bar-mode): Move these
Jim Blandy <jimb@redhat.com>
parents:
1821
diff
changeset
|
64 default-frame-alist)))))) |
1981
bde0ca7e33b3
Use the term `scroll bar', instead of `scrollbar'.
Jim Blandy <jimb@redhat.com>
parents:
1973
diff
changeset
|
65 '(vertical-scroll-bars horizontal-scroll-bars)) |
1954
059d99d03aae
* term/x-win.el (scroll-bar-mode, scroll-bar-mode): Move these
Jim Blandy <jimb@redhat.com>
parents:
1821
diff
changeset
|
66 (let ((frames (frame-list))) |
059d99d03aae
* term/x-win.el (scroll-bar-mode, scroll-bar-mode): Move these
Jim Blandy <jimb@redhat.com>
parents:
1821
diff
changeset
|
67 (while frames |
059d99d03aae
* term/x-win.el (scroll-bar-mode, scroll-bar-mode): Move these
Jim Blandy <jimb@redhat.com>
parents:
1821
diff
changeset
|
68 (modify-frame-parameters |
059d99d03aae
* term/x-win.el (scroll-bar-mode, scroll-bar-mode): Move these
Jim Blandy <jimb@redhat.com>
parents:
1821
diff
changeset
|
69 (car frames) |
1981
bde0ca7e33b3
Use the term `scroll bar', instead of `scrollbar'.
Jim Blandy <jimb@redhat.com>
parents:
1973
diff
changeset
|
70 (list (cons 'vertical-scroll-bars scroll-bar-mode) |
bde0ca7e33b3
Use the term `scroll bar', instead of `scrollbar'.
Jim Blandy <jimb@redhat.com>
parents:
1973
diff
changeset
|
71 (cons 'horizontal-scroll-bars scroll-bar-mode))) |
1954
059d99d03aae
* term/x-win.el (scroll-bar-mode, scroll-bar-mode): Move these
Jim Blandy <jimb@redhat.com>
parents:
1821
diff
changeset
|
72 (setq frames (cdr frames))))) |
059d99d03aae
* term/x-win.el (scroll-bar-mode, scroll-bar-mode): Move these
Jim Blandy <jimb@redhat.com>
parents:
1821
diff
changeset
|
73 |
1981
bde0ca7e33b3
Use the term `scroll bar', instead of `scrollbar'.
Jim Blandy <jimb@redhat.com>
parents:
1973
diff
changeset
|
74 ;;;; Buffer navigation using the scroll bar. |
1772 | 75 |
1981
bde0ca7e33b3
Use the term `scroll bar', instead of `scrollbar'.
Jim Blandy <jimb@redhat.com>
parents:
1973
diff
changeset
|
76 (defun scroll-bar-set-window-start (event) |
bde0ca7e33b3
Use the term `scroll bar', instead of `scrollbar'.
Jim Blandy <jimb@redhat.com>
parents:
1973
diff
changeset
|
77 "Set the window start according to where the scroll bar is dragged. |
bde0ca7e33b3
Use the term `scroll bar', instead of `scrollbar'.
Jim Blandy <jimb@redhat.com>
parents:
1973
diff
changeset
|
78 EVENT should be a scroll bar click or drag event." |
1772 | 79 (interactive "e") |
1821
04fb1d3d6992
JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents:
1772
diff
changeset
|
80 (let* ((end-position (event-end event)) |
1772 | 81 (window (nth 0 end-position)) |
82 (portion-whole (nth 2 end-position))) | |
83 (save-excursion | |
84 (set-buffer (window-buffer window)) | |
85 (save-excursion | |
1981
bde0ca7e33b3
Use the term `scroll bar', instead of `scrollbar'.
Jim Blandy <jimb@redhat.com>
parents:
1973
diff
changeset
|
86 (goto-char (scroll-bar-scale portion-whole (buffer-size))) |
1772 | 87 (beginning-of-line) |
88 (set-window-start window (point)))))) | |
89 | |
1981
bde0ca7e33b3
Use the term `scroll bar', instead of `scrollbar'.
Jim Blandy <jimb@redhat.com>
parents:
1973
diff
changeset
|
90 (defun scroll-bar-scroll-down (event) |
bde0ca7e33b3
Use the term `scroll bar', instead of `scrollbar'.
Jim Blandy <jimb@redhat.com>
parents:
1973
diff
changeset
|
91 "Scroll the window's top line down to the location of the scroll bar click. |
bde0ca7e33b3
Use the term `scroll bar', instead of `scrollbar'.
Jim Blandy <jimb@redhat.com>
parents:
1973
diff
changeset
|
92 EVENT should be a scroll bar click." |
1772 | 93 (interactive "e") |
94 (let ((old-selected-window (selected-window))) | |
95 (unwind-protect | |
96 (progn | |
1821
04fb1d3d6992
JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents:
1772
diff
changeset
|
97 (let* ((end-position (event-end event)) |
1772 | 98 (window (nth 0 end-position)) |
99 (portion-whole (nth 2 end-position))) | |
100 (select-window window) | |
101 (scroll-down | |
1981
bde0ca7e33b3
Use the term `scroll bar', instead of `scrollbar'.
Jim Blandy <jimb@redhat.com>
parents:
1973
diff
changeset
|
102 (scroll-bar-scale portion-whole (1- (window-height)))))) |
1772 | 103 (select-window old-selected-window)))) |
104 | |
1981
bde0ca7e33b3
Use the term `scroll bar', instead of `scrollbar'.
Jim Blandy <jimb@redhat.com>
parents:
1973
diff
changeset
|
105 (defun scroll-bar-scroll-up (event) |
bde0ca7e33b3
Use the term `scroll bar', instead of `scrollbar'.
Jim Blandy <jimb@redhat.com>
parents:
1973
diff
changeset
|
106 "Scroll the line next to the scroll bar click to the top of the window. |
bde0ca7e33b3
Use the term `scroll bar', instead of `scrollbar'.
Jim Blandy <jimb@redhat.com>
parents:
1973
diff
changeset
|
107 EVENT should be a scroll bar click." |
1772 | 108 (interactive "e") |
109 (let ((old-selected-window (selected-window))) | |
110 (unwind-protect | |
111 (progn | |
1821
04fb1d3d6992
JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents:
1772
diff
changeset
|
112 (let* ((end-position (event-end event)) |
1772 | 113 (window (nth 0 end-position)) |
114 (portion-whole (nth 2 end-position))) | |
115 (select-window window) | |
116 (scroll-up | |
1981
bde0ca7e33b3
Use the term `scroll bar', instead of `scrollbar'.
Jim Blandy <jimb@redhat.com>
parents:
1973
diff
changeset
|
117 (scroll-bar-scale portion-whole (1- (window-height)))))) |
1772 | 118 (select-window old-selected-window)))) |
119 | |
120 | |
121 ;;;; Bindings. | |
122 | |
123 ;;; For now, we'll set things up to work like xterm. | |
1981
bde0ca7e33b3
Use the term `scroll bar', instead of `scrollbar'.
Jim Blandy <jimb@redhat.com>
parents:
1973
diff
changeset
|
124 (global-set-key [vertical-scroll-bar mouse-1] 'scroll-bar-scroll-up) |
bde0ca7e33b3
Use the term `scroll bar', instead of `scrollbar'.
Jim Blandy <jimb@redhat.com>
parents:
1973
diff
changeset
|
125 (global-set-key [vertical-scroll-bar drag-mouse-1] 'scroll-bar-scroll-up) |
1772 | 126 |
1981
bde0ca7e33b3
Use the term `scroll bar', instead of `scrollbar'.
Jim Blandy <jimb@redhat.com>
parents:
1973
diff
changeset
|
127 (global-set-key [vertical-scroll-bar mouse-2] 'scroll-bar-set-window-start) |
bde0ca7e33b3
Use the term `scroll bar', instead of `scrollbar'.
Jim Blandy <jimb@redhat.com>
parents:
1973
diff
changeset
|
128 (global-set-key [vertical-scroll-bar drag-mouse-2] 'scroll-bar-set-window-start) |
1772 | 129 |
1981
bde0ca7e33b3
Use the term `scroll bar', instead of `scrollbar'.
Jim Blandy <jimb@redhat.com>
parents:
1973
diff
changeset
|
130 (global-set-key [vertical-scroll-bar mouse-3] 'scroll-bar-scroll-down) |
bde0ca7e33b3
Use the term `scroll bar', instead of `scrollbar'.
Jim Blandy <jimb@redhat.com>
parents:
1973
diff
changeset
|
131 (global-set-key [vertical-scroll-bar drag-mouse-3] 'scroll-bar-scroll-down) |
1772 | 132 |
133 | |
1973
3a08dacd8bfb
These are in preparation for a more thorough renaming to occur soon.
Jim Blandy <jimb@redhat.com>
parents:
1954
diff
changeset
|
134 (provide 'scroll-bar) |
1772 | 135 |
1981
bde0ca7e33b3
Use the term `scroll bar', instead of `scrollbar'.
Jim Blandy <jimb@redhat.com>
parents:
1973
diff
changeset
|
136 ;;; scroll-bar.el ends here |