Mercurial > emacs
annotate lisp/hscroll.el @ 25118:08ae9ffe6763
(init_display) [MSDOS]: Don't initialize frame faces,
it will be done later.
author | Eli Zaretskii <eliz@gnu.org> |
---|---|
date | Fri, 30 Jul 1999 08:38:10 +0000 |
parents | db6ed843d5e8 |
children | 856179ce1645 |
rev | line source |
---|---|
16583 | 1 ;;; hscroll.el: Minor mode to automatically scroll truncated lines horizontally |
2 ;;; Copyright (C) 1992, 1993, 1995, 1996 Free Software Foundation, Inc. | |
3 | |
4 ;; Author: Wayne Mesard <wmesard@esd.sgi.com> | |
5 ;; Keywords: display | |
6 | |
7 ;; This file is part of GNU Emacs. | |
8 | |
9 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
10 ;; it under the terms of the GNU General Public License as published by | |
11 ;; the Free Software Foundation; either version 2, or (at your option) | |
12 ;; any later version. | |
13 | |
14 ;; GNU Emacs is distributed in the hope that it will be useful, | |
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
17 ;; GNU General Public License for more details. | |
18 | |
19 ;; You should have received a copy of the GNU General Public License | |
20 ;; along with GNU Emacs; see the file COPYING. If not, write to the | |
21 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
22 ;; Boston, MA 02111-1307, USA. | |
23 | |
23789
7d763e90da82
(hscroll-mode, hscroll-global-mode, hscroll-window-maybe):
Richard M. Stallman <rms@gnu.org>
parents:
21670
diff
changeset
|
24 ;;; Commentary: |
16583 | 25 ;; |
26 ;; Automatically scroll horizontally when the point moves off the | |
27 ;; left or right edge of the window. | |
28 ;; | |
29 ;; - Type "M-x hscroll-mode" to enable it in the current buffer. | |
30 ;; - Type "M-x hscroll-global-mode" to enable it in every buffer. | |
31 ;; - "turn-on-hscroll" is useful in mode hooks as in: | |
32 ;; (add-hook 'text-mode-hook 'turn-on-hscroll) | |
33 ;; | |
34 ;; - hscroll-margin controls how close the cursor can get to the edge | |
35 ;; of the window. | |
36 ;; - hscroll-step-percent controls how far to jump once we decide to do so. | |
37 ;; | |
38 ;; Most users won't want to mess with the other variables defined | |
39 ;; here. But they're all documented, and they all start with | |
40 ;; "hscroll-" if you're curious. | |
41 ;; | |
42 ;; Oh, you should also know that if you set the hscroll-margin and | |
43 ;; hscroll-step-percent large enough, you can get an interesting, but | |
44 ;; undesired ping-pong effect as the point bounces from one edge to | |
45 ;; the other. | |
46 ;; | |
47 ;; wmesard@sgi.com | |
48 | |
49 ;;; Code: | |
50 | |
51 ;;; | |
52 ;;; PUBLIC VARIABLES | |
53 ;;; | |
54 | |
55 (defvar hscroll-version "2.2") | |
56 | |
19420 | 57 (defgroup hscroll nil |
58 "Minor mode to automatically scroll truncated lines horizontally." | |
59 :group 'editing) | |
60 | |
20765
2bdc3877262b
(hscroll-global-mode): New customize variable to automatically load the
Stephen Eglen <stephen@gnu.org>
parents:
19420
diff
changeset
|
61 |
2bdc3877262b
(hscroll-global-mode): New customize variable to automatically load the
Stephen Eglen <stephen@gnu.org>
parents:
19420
diff
changeset
|
62 (defcustom hscroll-global-mode nil |
2bdc3877262b
(hscroll-global-mode): New customize variable to automatically load the
Stephen Eglen <stephen@gnu.org>
parents:
19420
diff
changeset
|
63 "Toggle horizontal scrolling. |
24643 | 64 Setting this variable directly does not take effect; |
65 use either \\[customize] or the function `hscroll-global-mode'." | |
20765
2bdc3877262b
(hscroll-global-mode): New customize variable to automatically load the
Stephen Eglen <stephen@gnu.org>
parents:
19420
diff
changeset
|
66 :set (lambda (symbol value) |
2bdc3877262b
(hscroll-global-mode): New customize variable to automatically load the
Stephen Eglen <stephen@gnu.org>
parents:
19420
diff
changeset
|
67 (hscroll-global-mode (if value 1 -1))) |
2bdc3877262b
(hscroll-global-mode): New customize variable to automatically load the
Stephen Eglen <stephen@gnu.org>
parents:
19420
diff
changeset
|
68 :initialize 'custom-initialize-default |
2bdc3877262b
(hscroll-global-mode): New customize variable to automatically load the
Stephen Eglen <stephen@gnu.org>
parents:
19420
diff
changeset
|
69 :group 'hscroll |
2bdc3877262b
(hscroll-global-mode): New customize variable to automatically load the
Stephen Eglen <stephen@gnu.org>
parents:
19420
diff
changeset
|
70 :type 'boolean |
21670
808ecc2eaa84
*** empty log message ***
Dan Nicolaescu <done@ece.arizona.edu>
parents:
20765
diff
changeset
|
71 :require 'hscroll |
808ecc2eaa84
*** empty log message ***
Dan Nicolaescu <done@ece.arizona.edu>
parents:
20765
diff
changeset
|
72 :version "20.3") |
20765
2bdc3877262b
(hscroll-global-mode): New customize variable to automatically load the
Stephen Eglen <stephen@gnu.org>
parents:
19420
diff
changeset
|
73 |
19420 | 74 (defcustom hscroll-margin 5 |
16583 | 75 "*How many columns away from the edge of the window point is allowed to get |
19420 | 76 before HScroll will horizontally scroll the window." |
77 :group 'hscroll | |
78 :type 'integer) | |
16583 | 79 |
19420 | 80 (defcustom hscroll-snap-threshold 30 |
16583 | 81 "*When point is this many columns (or less) from the left edge of the document, |
82 don't do any horizontal scrolling. In other words, be biased towards the left | |
83 edge of the document. | |
19420 | 84 Set this variable to zero to disable this bias." |
85 :group 'hscroll | |
86 :type 'integer) | |
16583 | 87 |
19420 | 88 (defcustom hscroll-step-percent 25 |
16583 | 89 "*How far away to place the point from the window's edge when scrolling. |
19420 | 90 Expressed as a percentage of the window's width." |
91 :group 'hscroll | |
92 :type 'integer) | |
16583 | 93 |
19420 | 94 (defcustom hscroll-mode-name " Hscr" |
16583 | 95 "*Horizontal scrolling mode line indicator. |
19420 | 96 Set this to nil to conserve valuable mode line space." |
97 :group 'hscroll | |
98 :type 'string) | |
16583 | 99 |
100 (or (assq 'hscroll-mode minor-mode-alist) | |
101 (setq minor-mode-alist | |
102 (cons '(hscroll-mode hscroll-mode-name) minor-mode-alist))) | |
103 | |
104 | |
105 ;;; | |
106 ;;; PRIVATE VARIABLES | |
107 ;;; | |
108 | |
109 (defvar hscroll-mode nil | |
110 "Non-nil if HScroll mode is enabled.") | |
111 (make-variable-buffer-local 'hscroll-mode) | |
24922
ebff04ce5d74
(hscroll-window-maybe): Do nothing in the minibuffer.
Richard M. Stallman <rms@gnu.org>
parents:
24643
diff
changeset
|
112 ;; Make it a permanent local |
ebff04ce5d74
(hscroll-window-maybe): Do nothing in the minibuffer.
Richard M. Stallman <rms@gnu.org>
parents:
24643
diff
changeset
|
113 ;; so it will only turn off when WE turn it off. |
ebff04ce5d74
(hscroll-window-maybe): Do nothing in the minibuffer.
Richard M. Stallman <rms@gnu.org>
parents:
24643
diff
changeset
|
114 (put 'hscroll-mode 'permanent-local t) |
16583 | 115 |
23789
7d763e90da82
(hscroll-mode, hscroll-global-mode, hscroll-window-maybe):
Richard M. Stallman <rms@gnu.org>
parents:
21670
diff
changeset
|
116 (defvar hscroll-timer nil |
7d763e90da82
(hscroll-mode, hscroll-global-mode, hscroll-window-maybe):
Richard M. Stallman <rms@gnu.org>
parents:
21670
diff
changeset
|
117 "Timer used by HScroll mode.") |
16583 | 118 |
119 (defvar hscroll-old-truncate-local nil) | |
120 (defvar hscroll-old-truncate-was-global nil) | |
121 (make-variable-buffer-local 'hscroll-old-truncate) | |
122 (make-variable-buffer-local 'hscroll-old-truncate-was-global) | |
123 | |
124 (defvar hscroll-old-truncate-default nil) | |
125 | |
126 ;;; | |
127 ;;; PUBLIC COMMANDS | |
128 ;;; | |
129 | |
130 ;;;###autoload | |
131 (defun turn-on-hscroll () | |
132 "Unconditionally turn on Hscroll mode in the current buffer." | |
133 (hscroll-mode 1)) | |
134 | |
135 ;;;###autoload | |
136 (defun hscroll-mode (&optional arg) | |
137 "Toggle HScroll mode in the current buffer. | |
138 With ARG, turn HScroll mode on if ARG is positive, off otherwise. | |
139 In HScroll mode, truncated lines will automatically scroll left or | |
140 right when point gets near either edge of the window. | |
141 See also \\[hscroll-global-mode]." | |
142 (interactive "P") | |
143 (let ((newmode (if (null arg) | |
144 (not hscroll-mode) | |
145 (> (prefix-numeric-value arg) 0)))) | |
146 | |
147 (if newmode | |
24922
ebff04ce5d74
(hscroll-window-maybe): Do nothing in the minibuffer.
Richard M. Stallman <rms@gnu.org>
parents:
24643
diff
changeset
|
148 ;; Turn it on. |
16583 | 149 (if (not hscroll-mode) |
24922
ebff04ce5d74
(hscroll-window-maybe): Do nothing in the minibuffer.
Richard M. Stallman <rms@gnu.org>
parents:
24643
diff
changeset
|
150 ;; It was off. |
16583 | 151 (let ((localp (local-variable-p 'truncate-lines))) |
152 (if localp | |
153 (setq hscroll-old-truncate-local truncate-lines)) | |
154 (setq hscroll-old-truncate-was-global (not localp)) | |
155 (setq truncate-lines t) | |
23789
7d763e90da82
(hscroll-mode, hscroll-global-mode, hscroll-window-maybe):
Richard M. Stallman <rms@gnu.org>
parents:
21670
diff
changeset
|
156 (setq hscroll-timer |
7d763e90da82
(hscroll-mode, hscroll-global-mode, hscroll-window-maybe):
Richard M. Stallman <rms@gnu.org>
parents:
21670
diff
changeset
|
157 (run-with-idle-timer 0 t 'hscroll-window-maybe)))) |
24922
ebff04ce5d74
(hscroll-window-maybe): Do nothing in the minibuffer.
Richard M. Stallman <rms@gnu.org>
parents:
24643
diff
changeset
|
158 ;; Turn it off. |
16583 | 159 (if hscroll-mode |
24922
ebff04ce5d74
(hscroll-window-maybe): Do nothing in the minibuffer.
Richard M. Stallman <rms@gnu.org>
parents:
24643
diff
changeset
|
160 ;; It was on. |
16583 | 161 (progn |
162 (if hscroll-old-truncate-was-global | |
163 (kill-local-variable 'truncate-lines) | |
164 (setq truncate-lines hscroll-old-truncate-local)) | |
165 (if (not truncate-lines) | |
166 (set-window-hscroll (selected-window) 0)) | |
24922
ebff04ce5d74
(hscroll-window-maybe): Do nothing in the minibuffer.
Richard M. Stallman <rms@gnu.org>
parents:
24643
diff
changeset
|
167 ;; If hscroll is not enabled in any buffer now, |
ebff04ce5d74
(hscroll-window-maybe): Do nothing in the minibuffer.
Richard M. Stallman <rms@gnu.org>
parents:
24643
diff
changeset
|
168 ;; turn off the timer. |
ebff04ce5d74
(hscroll-window-maybe): Do nothing in the minibuffer.
Richard M. Stallman <rms@gnu.org>
parents:
24643
diff
changeset
|
169 (unless (memq t (mapcar (lambda (buffer) |
ebff04ce5d74
(hscroll-window-maybe): Do nothing in the minibuffer.
Richard M. Stallman <rms@gnu.org>
parents:
24643
diff
changeset
|
170 (with-current-buffer buffer |
ebff04ce5d74
(hscroll-window-maybe): Do nothing in the minibuffer.
Richard M. Stallman <rms@gnu.org>
parents:
24643
diff
changeset
|
171 hscroll-mode)) |
ebff04ce5d74
(hscroll-window-maybe): Do nothing in the minibuffer.
Richard M. Stallman <rms@gnu.org>
parents:
24643
diff
changeset
|
172 (buffer-list))) |
ebff04ce5d74
(hscroll-window-maybe): Do nothing in the minibuffer.
Richard M. Stallman <rms@gnu.org>
parents:
24643
diff
changeset
|
173 (cancel-timer hscroll-timer))))) |
16583 | 174 |
175 (setq hscroll-mode newmode) | |
23789
7d763e90da82
(hscroll-mode, hscroll-global-mode, hscroll-window-maybe):
Richard M. Stallman <rms@gnu.org>
parents:
21670
diff
changeset
|
176 (force-mode-line-update nil))) |
16583 | 177 |
178 | |
179 ;;;###autoload | |
180 (defun hscroll-global-mode (&optional arg) | |
24922
ebff04ce5d74
(hscroll-window-maybe): Do nothing in the minibuffer.
Richard M. Stallman <rms@gnu.org>
parents:
24643
diff
changeset
|
181 "Toggle HScroll mode in all buffers (excepting minibuffers). |
16583 | 182 With ARG, turn HScroll mode on if ARG is positive, off otherwise. |
183 If a buffer ever has HScroll mode set locally (via \\[hscroll-mode]), | |
184 it will forever use the local value (i.e., \\[hscroll-global-mode] | |
185 will have no effect on it). | |
186 See also \\[hscroll-mode]." | |
187 (interactive "P") | |
188 (let* ((oldmode (default-value 'hscroll-mode)) | |
189 (newmode (if (null arg) | |
190 (not oldmode) | |
191 (> (prefix-numeric-value arg) 0)))) | |
20765
2bdc3877262b
(hscroll-global-mode): New customize variable to automatically load the
Stephen Eglen <stephen@gnu.org>
parents:
19420
diff
changeset
|
192 (setq hscroll-global-mode newmode) |
16583 | 193 (if newmode |
194 ;; turn it on | |
195 (if (not hscroll-mode) | |
196 ;; it was off | |
197 (progn | |
198 (setq hscroll-old-truncate-default (default-value truncate-lines)) | |
24939
db6ed843d5e8
(hscroll-minibuffer-hook): New function.
Richard M. Stallman <rms@gnu.org>
parents:
24922
diff
changeset
|
199 (setq-default hscroll-old-truncate-was-global t) |
16583 | 200 (setq-default truncate-lines t) |
24939
db6ed843d5e8
(hscroll-minibuffer-hook): New function.
Richard M. Stallman <rms@gnu.org>
parents:
24922
diff
changeset
|
201 (add-hook 'minibuffer-setup-hook 'hscroll-minibuffer-hook) |
23789
7d763e90da82
(hscroll-mode, hscroll-global-mode, hscroll-window-maybe):
Richard M. Stallman <rms@gnu.org>
parents:
21670
diff
changeset
|
202 (setq hscroll-timer |
7d763e90da82
(hscroll-mode, hscroll-global-mode, hscroll-window-maybe):
Richard M. Stallman <rms@gnu.org>
parents:
21670
diff
changeset
|
203 (run-with-idle-timer 0 t 'hscroll-window-maybe)))) |
16583 | 204 ;; turn it off |
205 (if hscroll-mode | |
206 ;; it was on | |
207 (progn | |
24939
db6ed843d5e8
(hscroll-minibuffer-hook): New function.
Richard M. Stallman <rms@gnu.org>
parents:
24922
diff
changeset
|
208 (remove-hook 'minibuffer-setup-hook 'hscroll-minibuffer-hook) |
16583 | 209 (setq-default truncate-lines hscroll-old-truncate-default) |
23789
7d763e90da82
(hscroll-mode, hscroll-global-mode, hscroll-window-maybe):
Richard M. Stallman <rms@gnu.org>
parents:
21670
diff
changeset
|
210 (cancel-timer hscroll-timer)))) |
16583 | 211 |
212 (setq-default hscroll-mode newmode) | |
23789
7d763e90da82
(hscroll-mode, hscroll-global-mode, hscroll-window-maybe):
Richard M. Stallman <rms@gnu.org>
parents:
21670
diff
changeset
|
213 (force-mode-line-update t))) |
16583 | 214 |
24939
db6ed843d5e8
(hscroll-minibuffer-hook): New function.
Richard M. Stallman <rms@gnu.org>
parents:
24922
diff
changeset
|
215 (defun hscroll-minibuffer-hook () |
db6ed843d5e8
(hscroll-minibuffer-hook): New function.
Richard M. Stallman <rms@gnu.org>
parents:
24922
diff
changeset
|
216 (setq truncate-lines hscroll-old-truncate-default)) |
db6ed843d5e8
(hscroll-minibuffer-hook): New function.
Richard M. Stallman <rms@gnu.org>
parents:
24922
diff
changeset
|
217 |
16583 | 218 (defun hscroll-window-maybe () |
219 "Scroll horizontally if point is off or nearly off the edge of the window. | |
220 This is called automatically when in HScroll mode, but it can be explicitly | |
24922
ebff04ce5d74
(hscroll-window-maybe): Do nothing in the minibuffer.
Richard M. Stallman <rms@gnu.org>
parents:
24643
diff
changeset
|
221 invoked as well (i.e., it can be bound to a key). |
ebff04ce5d74
(hscroll-window-maybe): Do nothing in the minibuffer.
Richard M. Stallman <rms@gnu.org>
parents:
24643
diff
changeset
|
222 This does nothing in the minibuffer." |
16583 | 223 (interactive) |
224 ;; Only consider scrolling if truncate-lines is true, | |
225 ;; the window is already scrolled or partial-widths is true and this is | |
24922
ebff04ce5d74
(hscroll-window-maybe): Do nothing in the minibuffer.
Richard M. Stallman <rms@gnu.org>
parents:
24643
diff
changeset
|
226 ;; a partial width window. See display_text_line in xdisp.c. |
16583 | 227 (if (and hscroll-mode |
24922
ebff04ce5d74
(hscroll-window-maybe): Do nothing in the minibuffer.
Richard M. Stallman <rms@gnu.org>
parents:
24643
diff
changeset
|
228 (not (window-minibuffer-p (selected-window))) |
16583 | 229 (or truncate-lines |
230 (not (zerop (window-hscroll))) | |
231 (and truncate-partial-width-windows | |
232 (< (window-width) (frame-width))))) | |
233 (let ((linelen (save-excursion (end-of-line) (current-column))) | |
23789
7d763e90da82
(hscroll-mode, hscroll-global-mode, hscroll-window-maybe):
Richard M. Stallman <rms@gnu.org>
parents:
21670
diff
changeset
|
234 (rightmost-char (+ (window-width) (window-hscroll)))) |
16583 | 235 (if (< (current-column) hscroll-snap-threshold) |
236 (set-window-hscroll | |
237 (selected-window) | |
238 (- (window-hscroll))) | |
239 (if (>= (current-column) | |
240 (- rightmost-char hscroll-margin | |
241 ;; Off-by-one if the left edge is scrolled | |
242 (if (not (zerop (window-hscroll))) 1 0) | |
243 ;; Off by one if the right edge is scrolled | |
244 (if (> linelen rightmost-char) 1 0) | |
245 )) | |
246 ;; Scroll to the left a proportion of the window's width. | |
247 (set-window-hscroll | |
248 (selected-window) | |
249 (- (+ (current-column) | |
250 (/ (* (window-width) hscroll-step-percent) 100)) | |
251 (window-width))) | |
252 (if (< (current-column) (+ (window-hscroll) hscroll-margin)) | |
253 ;; Scroll to the right a proportion of the window's width. | |
254 (set-window-hscroll | |
255 (selected-window) | |
23789
7d763e90da82
(hscroll-mode, hscroll-global-mode, hscroll-window-maybe):
Richard M. Stallman <rms@gnu.org>
parents:
21670
diff
changeset
|
256 (- (current-column) (/ (* (window-width) hscroll-step-percent) 100))))))))) |
16583 | 257 |
258 ;;; | |
259 ;;; It's not a bug, it's a *feature* | |
260 ;;; | |
261 | |
20765
2bdc3877262b
(hscroll-global-mode): New customize variable to automatically load the
Stephen Eglen <stephen@gnu.org>
parents:
19420
diff
changeset
|
262 (if hscroll-global-mode |
2bdc3877262b
(hscroll-global-mode): New customize variable to automatically load the
Stephen Eglen <stephen@gnu.org>
parents:
19420
diff
changeset
|
263 (hscroll-global-mode 1)) |
2bdc3877262b
(hscroll-global-mode): New customize variable to automatically load the
Stephen Eglen <stephen@gnu.org>
parents:
19420
diff
changeset
|
264 |
16583 | 265 (provide 'hscroll) |
266 | |
267 ;;; hscroll.el ends here |