-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathpel-scroll.el
315 lines (275 loc) · 11.5 KB
/
pel-scroll.el
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
;;; pel-scroll.el --- PEL Window Scrolling Utilities -*-lexical-binding: t; -*-
;; Copyright (C) 2020, 2021, 2022, 2024 Pierre Rouleau
;; Author: Pierre Rouleau <[email protected]>
;; This file is not part of GNU Emacs.
;;; License:
;; This program 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 3 of the License, or
;; (at your option) any later version.
;;
;; This program 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 this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;; The `pel-scroll' file provides a set of window scrolling facilities.
;;
;; The following 2 commands are used to scroll the current window, and
;; other windows that may be placed inside the PEL window scroll group:
;;
;; - `pel-scroll-up' which scrolls text up,
;; - `pel-scroll-down' which scrolls text down.
;;
;; The following commands scrool the 'other' window by one line (but do not
;; support the PEL window scroll group):
;;
;; - `pel-scroll-up-other'
;; - `pel-scroll-down-other'
;;
;; The file also provides the creation and management of a group of
;; windows into the *PEL window scroll sync* group, a list stored inside
;; the `pel-in-scroll-sync' variable identifying windows that will be
;; scrolled together.
;;
;; The following commands are used to activate and manage the
;; *PEL window scroll sync* group:
;;
;; - `pel-toggle-scroll-sync' toggles scroll lock on/off. When turning it on
;; it locks scrolling of the current and the next window.
;; - `pel-add-window-to-scroll-sync' adds the current window to the already
;; existing group of scroll locked windows. If there is none it locks
;; scrolling of the current and the next window.
;; - `pel-remove-window-from-scroll-sync' removes the currenbt window from the
;; group of scroll locked windows. Removing the last one disables the
;; window scroll sync. If only one window is left in the group the command
;; informs the user but allows it. That way another window can be added to
;; the group.
;;
;; The scrolling of multiple windows is currently only performed when the
;; following commands are used:
;;
;; - `pel-scroll-up' which scrolls text up,
;; - `pel-scroll-down' which scrolls text down,
;; - `pel-home' and `pel-end', defined in `pel-navigation', which move
;; point the the beginning or end of current field, line, window or buffer.
;;
;;; --------------------------------------------------------------------------
;;; Dependencies:
(require 'pel-window) ; use: `pel-move-to-window'
;; ; `pel-window-direction-for'
;;; --------------------------------------------------------------------------
;;; Code:
;; Uses scroll-other-window and scroll-other-window-down from window.el, which is
;; part of Emacs but taht file does not 'provide' itself, so the code does not
;; 'require' it.
(defvar pel-in-scroll-sync nil "If non-nil, hold a list of windows to scroll.")
;;-pel-autoload
(defun pel-toggle-scroll-sync (&optional n)
"Toggle window scroll sync mode between current and other window.
Tie scroll of the current window and next window or the one selected by the
optional N argument.
N can be:
- 8 := \\='up
- 4 := \\='left 6 := \\='right
- 2 := \\='down
"
(interactive "P")
(if (null pel-in-scroll-sync)
(let ((window1 (selected-window))
(window2 (progn
(if n
(pel-move-to-window
(pel-window-direction-for
(prefix-numeric-value n)
'other))
(other-window 1))
(selected-window))))
(setq pel-in-scroll-sync (list window1 window2))
(select-window window1)
(message
"Window scroll sync enabled between %s and %s"
window1
window2))
(setq pel-in-scroll-sync nil)
(message "Window scroll sync disabled.")))
;;-pel-autoload
(defun pel-add-window-to-scroll-sync ()
"Add current window to window scroll sync.
If scroll sync is currently disabled, adds this window and the next."
(interactive)
(if (null pel-in-scroll-sync)
(pel-toggle-scroll-sync)
(let ((current-window (selected-window)))
(if (member current-window pel-in-scroll-sync)
(user-error
"Window %s is already inside the scroll sync group"
current-window)
(setq pel-in-scroll-sync (cons current-window pel-in-scroll-sync))
(message "Window scroll sync of %s" pel-in-scroll-sync)))))
;;-pel-autoload
(defun pel-remove-window-from-scroll-sync ()
"Remove current window from window scroll sync."
(interactive)
(if (null pel-in-scroll-sync)
(user-error "No scroll sync currently active")
(let ((current-window (selected-window)))
(if (member current-window pel-in-scroll-sync)
(progn
(setq pel-in-scroll-sync
(delete current-window pel-in-scroll-sync))
(let ((group-size (length pel-in-scroll-sync)))
(cond ((eq group-size 1)
(user-error
"Just 1 window left in scroll sync: %s"
pel-in-scroll-sync))
((eq group-size 0)
(message "Window scroll sync disabled."))
(t (message
"Window removed from scroll sync list %s."
pel-in-scroll-sync)))))
(user-error
"Current window is not part of the window scroll sync group")))))
;; --
(defun pel-scroll-up-all-insync (including-current &optional n)
"Scroll up N line(s) the scroll synced windows INCLUDING-CURRENT if is is t.
If INCLUDING-CURRENT is nil, then scroll all windows except current window.
Scrolling up means moving text up.
Default N is 1 line."
(interactive "p")
(let ((original-window (selected-window)))
(when (member original-window pel-in-scroll-sync)
(dolist (window pel-in-scroll-sync)
(when (or including-current
(not (equal window original-window)))
;; Ignore error caused by one window being at the top
;; already: don't exit the loop & process other windows.
(ignore-errors
(select-window window)
(scroll-up n))))
(select-window original-window))))
;;-pel-autoload
(defun pel-scroll-up (&optional n)
"Scroll up 1 line: move text up (same direction as forward).
Scrolling up is bringing text ahead into view.
If N is specified it identifies a repetition count.
If N is negative it means the other direction.
This command prevents screen re-centering done by the low level
scroll function."
(interactive "P")
(let ((n (prefix-numeric-value n))
;; (scroll-conservatively 10000)
(scroll-step 1)) ; prevent screen re-centering by low level scroll
(if (< n 0)
(pel-scroll-down (abs n))
(unless (and pel-in-scroll-sync
(pel-scroll-up-all-insync :all n))
(scroll-up n)))))
;; --
;;-pel-autoload
(defun pel-scroll-down-other (&optional n)
"Scroll the other window 1 line: move text down (same direction as backward).
Scrolling down is bringing text below into view.
If N is specified it identifies a repetition count.
If N is negative it means the other direction."
(interactive "p")
;; flip the meaning of n and call scroll-other-window-down with it:
;; nil -> 1
;; x -> x
(scroll-other-window-down (or n 1)))
;;-pel-autoload
(defun pel-scroll-up-other (&optional n)
"Scroll the other window 1 line: move text up (same direction as forward).
Scrolling up is bringing text ahead into view.
If N is specified it identifies a repetition count.
If N is negative it means the other direction."
(interactive "p")
;; flip the meaning of n and call scroll-other-window with it:
;; nil -> 1
;; x -> x
(scroll-other-window (or n 1)))
;; --
(defun pel-scroll-down-all-insync (including-current &optional n)
"Scroll down N line(s) the scroll synced windows INCLUDING-CURRENT if it is t.
If INCLUDING-CURRENT is nil, then scroll all windows except current window.
Scrolling down means moving text down.
Default N is 1 line."
(interactive)
(let ((original-window (selected-window)))
(when (member original-window pel-in-scroll-sync)
(dolist (window pel-in-scroll-sync)
(when (or including-current
(not (equal window original-window)))
;; Ignore error caused by one window being at the top
;; already: don't exit the loop & process other windows.
(ignore-errors
(select-window window)
(scroll-down n))))
(select-window original-window))))
;; TODO: in graphics mode on Emacs 26.3, I have seen the scroll-down and scroll-up by 1
;; do nothing, even after several calls. I have never seen this behaviour on
;; Emacs in terminal mode (which I use much more often).
;; I tried to fix it by forcing scroll-conservatively but that did not
;; change anything. I'd have to learn the low level Emacs scroll
;; control code, which is written in C to understand why it's sometimes
;; doing this.
;;-pel-autoload
(defun pel-scroll-down (&optional n)
"Scroll down 1 line: move text down (same direction as backwards).
Scrolling down is bringing text behind into view.
If N is specified it identifies a repetition count.
If N is negative it means the other direction.
This command prevents screen re-centering done by the low level
scroll function."
(interactive "P")
(let ((n (prefix-numeric-value n))
;; (scroll-conservatively 10000)
(scroll-step 1)) ; prevent screen re-centering by low level scroll
(if (< n 0)
(pel-scroll-up (abs n))
(unless (and pel-in-scroll-sync
(pel-scroll-down-all-insync :all n))
(scroll-down n)))))
;; --
;;-pel-autoload
(defun pel-scroll-down-only-this (&optional n)
"Scroll down by N only this window during a scroll sync session."
(interactive "P")
(unless pel-in-scroll-sync
(user-error "Use this command only while sync scrolling!"))
(let ((orig-scroll-set pel-in-scroll-sync))
(setq pel-in-scroll-sync nil)
(pel-scroll-down n)
(setq pel-in-scroll-sync orig-scroll-set)))
;;-pel-autoload
(defun pel-scroll-up-only-this (&optional n)
"Scroll up by N only this window during a scroll sync session."
(interactive "P")
(unless pel-in-scroll-sync
(user-error "Use this command only while sync scrolling!"))
(let ((orig-scroll-set pel-in-scroll-sync))
(setq pel-in-scroll-sync nil)
(pel-scroll-up n)
(setq pel-in-scroll-sync orig-scroll-set)))
;; --
;; Simple Horizontal scroll entire window
;;-pel-autoload
(defun pel-scroll-left (&optional n)
"Simple horizontal scroll of 1 column left the entire window.
If N is specified, repeat N times."
(interactive "P")
(dotimes (_i (abs (or n 1)))
(scroll-left 1)))
(defun pel-scroll-right (&optional n)
"Simple horizontal scroll of 1 column left the entire window.
If N is specified, repeat N times."
(interactive "P")
(dotimes (_i (abs (or n 1)))
(scroll-right 1)))
;; -----------------------------------------------------------------------------
(provide 'pel-scroll)
;;; pel-scroll.el ends here