Mercurial > emacs
annotate lisp/hscroll.el @ 22312:eed3a1470e83
(install-arch-indep): Don't die if site-lisp/ isn't writable.
author | Karl Heuer <kwzh@gnu.org> |
---|---|
date | Mon, 01 Jun 1998 03:46:31 +0000 |
parents | 808ecc2eaa84 |
children | 7d763e90da82 |
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 |
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 | |
112 | |
113 (defvar hscroll-old-truncate-local nil) | |
114 (defvar hscroll-old-truncate-was-global nil) | |
115 (make-variable-buffer-local 'hscroll-old-truncate) | |
116 (make-variable-buffer-local 'hscroll-old-truncate-was-global) | |
117 | |
118 (defvar hscroll-old-truncate-default nil) | |
119 | |
120 ;;; | |
121 ;;; PUBLIC COMMANDS | |
122 ;;; | |
123 | |
124 ;;;###autoload | |
125 (defun turn-on-hscroll () | |
126 "Unconditionally turn on Hscroll mode in the current buffer." | |
127 (hscroll-mode 1)) | |
128 | |
129 ;;;###autoload | |
130 (defun hscroll-mode (&optional arg) | |
131 "Toggle HScroll mode in the current buffer. | |
132 With ARG, turn HScroll mode on if ARG is positive, off otherwise. | |
133 In HScroll mode, truncated lines will automatically scroll left or | |
134 right when point gets near either edge of the window. | |
135 See also \\[hscroll-global-mode]." | |
136 (interactive "P") | |
137 (make-local-hook 'post-command-hook) | |
138 (let ((newmode (if (null arg) | |
139 (not hscroll-mode) | |
140 (> (prefix-numeric-value arg) 0)))) | |
141 | |
142 (if newmode | |
143 ;; turn it on | |
144 (if (not hscroll-mode) | |
145 ;; it was off | |
146 (let ((localp (local-variable-p 'truncate-lines))) | |
147 (if localp | |
148 (setq hscroll-old-truncate-local truncate-lines)) | |
149 (setq hscroll-old-truncate-was-global (not localp)) | |
150 (setq truncate-lines t) | |
151 (add-hook 'post-command-hook | |
152 (function hscroll-window-maybe) nil t) | |
153 )) | |
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)) | |
163 (remove-hook 'post-command-hook | |
164 (function hscroll-window-maybe) t) | |
165 )) | |
166 ) | |
167 | |
168 (setq hscroll-mode newmode) | |
169 (force-mode-line-update nil) | |
170 )) | |
171 | |
172 | |
173 ;;;###autoload | |
174 (defun hscroll-global-mode (&optional arg) | |
175 "Toggle HScroll mode in all buffers. | |
176 With ARG, turn HScroll mode on if ARG is positive, off otherwise. | |
177 If a buffer ever has HScroll mode set locally (via \\[hscroll-mode]), | |
178 it will forever use the local value (i.e., \\[hscroll-global-mode] | |
179 will have no effect on it). | |
180 See also \\[hscroll-mode]." | |
181 (interactive "P") | |
182 (let* ((oldmode (default-value 'hscroll-mode)) | |
183 (newmode (if (null arg) | |
184 (not oldmode) | |
185 (> (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
|
186 (setq hscroll-global-mode newmode) |
16583 | 187 (if newmode |
188 ;; turn it on | |
189 (if (not hscroll-mode) | |
190 ;; it was off | |
191 (progn | |
192 (setq hscroll-old-truncate-default (default-value truncate-lines)) | |
193 (setq hscroll-old-truncate-was-global t) | |
194 (setq-default truncate-lines t) | |
195 (add-hook 'post-command-hook (function hscroll-window-maybe)) | |
196 )) | |
197 ;; turn it off | |
198 (if hscroll-mode | |
199 ;; it was on | |
200 (progn | |
201 (setq-default truncate-lines hscroll-old-truncate-default) | |
202 (remove-hook 'post-command-hook (function hscroll-window-maybe)) | |
203 )) | |
204 ) | |
205 | |
206 (setq-default hscroll-mode newmode) | |
207 (force-mode-line-update t) | |
208 )) | |
209 | |
210 (defun hscroll-window-maybe () | |
211 "Scroll horizontally if point is off or nearly off the edge of the window. | |
212 This is called automatically when in HScroll mode, but it can be explicitly | |
213 invoked as well (i.e., it can be bound to a key)." | |
214 (interactive) | |
215 ;; Only consider scrolling if truncate-lines is true, | |
216 ;; the window is already scrolled or partial-widths is true and this is | |
217 ;; a partial width window. See display_text_line() in xdisp.c. | |
218 (if (and hscroll-mode | |
219 (or truncate-lines | |
220 (not (zerop (window-hscroll))) | |
221 (and truncate-partial-width-windows | |
222 (< (window-width) (frame-width))))) | |
223 (let ((linelen (save-excursion (end-of-line) (current-column))) | |
224 (rightmost-char (+ (window-width) (window-hscroll))) | |
225 ) | |
226 (if (< (current-column) hscroll-snap-threshold) | |
227 (set-window-hscroll | |
228 (selected-window) | |
229 (- (window-hscroll))) | |
230 (if (>= (current-column) | |
231 (- rightmost-char hscroll-margin | |
232 ;; Off-by-one if the left edge is scrolled | |
233 (if (not (zerop (window-hscroll))) 1 0) | |
234 ;; Off by one if the right edge is scrolled | |
235 (if (> linelen rightmost-char) 1 0) | |
236 )) | |
237 ;; Scroll to the left a proportion of the window's width. | |
238 (set-window-hscroll | |
239 (selected-window) | |
240 (- (+ (current-column) | |
241 (/ (* (window-width) hscroll-step-percent) 100)) | |
242 (window-width))) | |
243 (if (< (current-column) (+ (window-hscroll) hscroll-margin)) | |
244 ;; Scroll to the right a proportion of the window's width. | |
245 (set-window-hscroll | |
246 (selected-window) | |
247 (- (current-column) (/ (* (window-width) hscroll-step-percent) 100))) | |
248 ))) | |
249 ))) | |
250 | |
251 ;;; | |
252 ;;; It's not a bug, it's a *feature* | |
253 ;;; | |
254 | |
20765
2bdc3877262b
(hscroll-global-mode): New customize variable to automatically load the
Stephen Eglen <stephen@gnu.org>
parents:
19420
diff
changeset
|
255 (if hscroll-global-mode |
2bdc3877262b
(hscroll-global-mode): New customize variable to automatically load the
Stephen Eglen <stephen@gnu.org>
parents:
19420
diff
changeset
|
256 (hscroll-global-mode 1)) |
2bdc3877262b
(hscroll-global-mode): New customize variable to automatically load the
Stephen Eglen <stephen@gnu.org>
parents:
19420
diff
changeset
|
257 |
16583 | 258 (provide 'hscroll) |
259 | |
260 ;;; hscroll.el ends here |