Mercurial > emacs
annotate lisp/hscroll.el @ 21347:aca24aa07fb4
(rmail-mode-2): Locally set enable-local-variables
to nil, so a local var list in a message won't confuse things.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Fri, 03 Apr 1998 05:34:10 +0000 |
parents | 2bdc3877262b |
children | 808ecc2eaa84 |
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 | |
24 ;;; Commentary:a | |
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. |
2bdc3877262b
(hscroll-global-mode): New customize variable to automatically load the
Stephen Eglen <stephen@gnu.org>
parents:
19420
diff
changeset
|
64 You must modify via \\[customize] for this variable to have an effect." |
2bdc3877262b
(hscroll-global-mode): New customize variable to automatically load the
Stephen Eglen <stephen@gnu.org>
parents:
19420
diff
changeset
|
65 :set (lambda (symbol value) |
2bdc3877262b
(hscroll-global-mode): New customize variable to automatically load the
Stephen Eglen <stephen@gnu.org>
parents:
19420
diff
changeset
|
66 (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
|
67 :initialize 'custom-initialize-default |
2bdc3877262b
(hscroll-global-mode): New customize variable to automatically load the
Stephen Eglen <stephen@gnu.org>
parents:
19420
diff
changeset
|
68 :group 'hscroll |
2bdc3877262b
(hscroll-global-mode): New customize variable to automatically load the
Stephen Eglen <stephen@gnu.org>
parents:
19420
diff
changeset
|
69 :type 'boolean |
2bdc3877262b
(hscroll-global-mode): New customize variable to automatically load the
Stephen Eglen <stephen@gnu.org>
parents:
19420
diff
changeset
|
70 :require 'hscroll) |
2bdc3877262b
(hscroll-global-mode): New customize variable to automatically load the
Stephen Eglen <stephen@gnu.org>
parents:
19420
diff
changeset
|
71 |
19420 | 72 (defcustom hscroll-margin 5 |
16583 | 73 "*How many columns away from the edge of the window point is allowed to get |
19420 | 74 before HScroll will horizontally scroll the window." |
75 :group 'hscroll | |
76 :type 'integer) | |
16583 | 77 |
19420 | 78 (defcustom hscroll-snap-threshold 30 |
16583 | 79 "*When point is this many columns (or less) from the left edge of the document, |
80 don't do any horizontal scrolling. In other words, be biased towards the left | |
81 edge of the document. | |
19420 | 82 Set this variable to zero to disable this bias." |
83 :group 'hscroll | |
84 :type 'integer) | |
16583 | 85 |
19420 | 86 (defcustom hscroll-step-percent 25 |
16583 | 87 "*How far away to place the point from the window's edge when scrolling. |
19420 | 88 Expressed as a percentage of the window's width." |
89 :group 'hscroll | |
90 :type 'integer) | |
16583 | 91 |
19420 | 92 (defcustom hscroll-mode-name " Hscr" |
16583 | 93 "*Horizontal scrolling mode line indicator. |
19420 | 94 Set this to nil to conserve valuable mode line space." |
95 :group 'hscroll | |
96 :type 'string) | |
16583 | 97 |
98 (or (assq 'hscroll-mode minor-mode-alist) | |
99 (setq minor-mode-alist | |
100 (cons '(hscroll-mode hscroll-mode-name) minor-mode-alist))) | |
101 | |
102 | |
103 ;;; | |
104 ;;; PRIVATE VARIABLES | |
105 ;;; | |
106 | |
107 (defvar hscroll-mode nil | |
108 "Non-nil if HScroll mode is enabled.") | |
109 (make-variable-buffer-local 'hscroll-mode) | |
110 | |
111 | |
112 (defvar hscroll-old-truncate-local nil) | |
113 (defvar hscroll-old-truncate-was-global nil) | |
114 (make-variable-buffer-local 'hscroll-old-truncate) | |
115 (make-variable-buffer-local 'hscroll-old-truncate-was-global) | |
116 | |
117 (defvar hscroll-old-truncate-default nil) | |
118 | |
119 ;;; | |
120 ;;; PUBLIC COMMANDS | |
121 ;;; | |
122 | |
123 ;;;###autoload | |
124 (defun turn-on-hscroll () | |
125 "Unconditionally turn on Hscroll mode in the current buffer." | |
126 (hscroll-mode 1)) | |
127 | |
128 ;;;###autoload | |
129 (defun hscroll-mode (&optional arg) | |
130 "Toggle HScroll mode in the current buffer. | |
131 With ARG, turn HScroll mode on if ARG is positive, off otherwise. | |
132 In HScroll mode, truncated lines will automatically scroll left or | |
133 right when point gets near either edge of the window. | |
134 See also \\[hscroll-global-mode]." | |
135 (interactive "P") | |
136 (make-local-hook 'post-command-hook) | |
137 (let ((newmode (if (null arg) | |
138 (not hscroll-mode) | |
139 (> (prefix-numeric-value arg) 0)))) | |
140 | |
141 (if newmode | |
142 ;; turn it on | |
143 (if (not hscroll-mode) | |
144 ;; it was off | |
145 (let ((localp (local-variable-p 'truncate-lines))) | |
146 (if localp | |
147 (setq hscroll-old-truncate-local truncate-lines)) | |
148 (setq hscroll-old-truncate-was-global (not localp)) | |
149 (setq truncate-lines t) | |
150 (add-hook 'post-command-hook | |
151 (function hscroll-window-maybe) nil t) | |
152 )) | |
153 ;; turn it off | |
154 (if hscroll-mode | |
155 ;; it was on | |
156 (progn | |
157 (if hscroll-old-truncate-was-global | |
158 (kill-local-variable 'truncate-lines) | |
159 (setq truncate-lines hscroll-old-truncate-local)) | |
160 (if (not truncate-lines) | |
161 (set-window-hscroll (selected-window) 0)) | |
162 (remove-hook 'post-command-hook | |
163 (function hscroll-window-maybe) t) | |
164 )) | |
165 ) | |
166 | |
167 (setq hscroll-mode newmode) | |
168 (force-mode-line-update nil) | |
169 )) | |
170 | |
171 | |
172 ;;;###autoload | |
173 (defun hscroll-global-mode (&optional arg) | |
174 "Toggle HScroll mode in all buffers. | |
175 With ARG, turn HScroll mode on if ARG is positive, off otherwise. | |
176 If a buffer ever has HScroll mode set locally (via \\[hscroll-mode]), | |
177 it will forever use the local value (i.e., \\[hscroll-global-mode] | |
178 will have no effect on it). | |
179 See also \\[hscroll-mode]." | |
180 (interactive "P") | |
181 (let* ((oldmode (default-value 'hscroll-mode)) | |
182 (newmode (if (null arg) | |
183 (not oldmode) | |
184 (> (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
|
185 (setq hscroll-global-mode newmode) |
16583 | 186 (if newmode |
187 ;; turn it on | |
188 (if (not hscroll-mode) | |
189 ;; it was off | |
190 (progn | |
191 (setq hscroll-old-truncate-default (default-value truncate-lines)) | |
192 (setq hscroll-old-truncate-was-global t) | |
193 (setq-default truncate-lines t) | |
194 (add-hook 'post-command-hook (function hscroll-window-maybe)) | |
195 )) | |
196 ;; turn it off | |
197 (if hscroll-mode | |
198 ;; it was on | |
199 (progn | |
200 (setq-default truncate-lines hscroll-old-truncate-default) | |
201 (remove-hook 'post-command-hook (function hscroll-window-maybe)) | |
202 )) | |
203 ) | |
204 | |
205 (setq-default hscroll-mode newmode) | |
206 (force-mode-line-update t) | |
207 )) | |
208 | |
209 (defun hscroll-window-maybe () | |
210 "Scroll horizontally if point is off or nearly off the edge of the window. | |
211 This is called automatically when in HScroll mode, but it can be explicitly | |
212 invoked as well (i.e., it can be bound to a key)." | |
213 (interactive) | |
214 ;; Only consider scrolling if truncate-lines is true, | |
215 ;; the window is already scrolled or partial-widths is true and this is | |
216 ;; a partial width window. See display_text_line() in xdisp.c. | |
217 (if (and hscroll-mode | |
218 (or truncate-lines | |
219 (not (zerop (window-hscroll))) | |
220 (and truncate-partial-width-windows | |
221 (< (window-width) (frame-width))))) | |
222 (let ((linelen (save-excursion (end-of-line) (current-column))) | |
223 (rightmost-char (+ (window-width) (window-hscroll))) | |
224 ) | |
225 (if (< (current-column) hscroll-snap-threshold) | |
226 (set-window-hscroll | |
227 (selected-window) | |
228 (- (window-hscroll))) | |
229 (if (>= (current-column) | |
230 (- rightmost-char hscroll-margin | |
231 ;; Off-by-one if the left edge is scrolled | |
232 (if (not (zerop (window-hscroll))) 1 0) | |
233 ;; Off by one if the right edge is scrolled | |
234 (if (> linelen rightmost-char) 1 0) | |
235 )) | |
236 ;; Scroll to the left a proportion of the window's width. | |
237 (set-window-hscroll | |
238 (selected-window) | |
239 (- (+ (current-column) | |
240 (/ (* (window-width) hscroll-step-percent) 100)) | |
241 (window-width))) | |
242 (if (< (current-column) (+ (window-hscroll) hscroll-margin)) | |
243 ;; Scroll to the right a proportion of the window's width. | |
244 (set-window-hscroll | |
245 (selected-window) | |
246 (- (current-column) (/ (* (window-width) hscroll-step-percent) 100))) | |
247 ))) | |
248 ))) | |
249 | |
250 ;;; | |
251 ;;; It's not a bug, it's a *feature* | |
252 ;;; | |
253 | |
20765
2bdc3877262b
(hscroll-global-mode): New customize variable to automatically load the
Stephen Eglen <stephen@gnu.org>
parents:
19420
diff
changeset
|
254 (if hscroll-global-mode |
2bdc3877262b
(hscroll-global-mode): New customize variable to automatically load the
Stephen Eglen <stephen@gnu.org>
parents:
19420
diff
changeset
|
255 (hscroll-global-mode 1)) |
2bdc3877262b
(hscroll-global-mode): New customize variable to automatically load the
Stephen Eglen <stephen@gnu.org>
parents:
19420
diff
changeset
|
256 |
16583 | 257 (provide 'hscroll) |
258 | |
259 ;;; hscroll.el ends here |