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