1 ;;; hscroll.el: Minor mode to automatically scroll truncated lines horizontally
2 ;;; Copyright (C) 1992, 1993, 1995, 1996 Free Software Foundation, Inc.
4 ;; Author: Wayne Mesard <wmesard@esd.sgi.com>
7 ;; This file is part of GNU Emacs.
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)
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.
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.
26 ;; Automatically scroll horizontally when the point moves off the
27 ;; left or right edge of the window.
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)
34 ;; - hscroll-margin controls how close the cursor can get to the edge
36 ;; - hscroll-step-percent controls how far to jump once we decide to do so.
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.
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
55 (defvar hscroll-version
"2.2")
58 "Minor mode to automatically scroll truncated lines horizontally."
62 (defcustom hscroll-global-mode nil
63 "Toggle horizontal scrolling.
64 You must modify via \\[customize] for this variable to have an effect."
65 :set
(lambda (symbol value
)
66 (hscroll-global-mode (if value
1 -
1)))
67 :initialize
'custom-initialize-default
73 (defcustom hscroll-margin
5
74 "*How many columns away from the edge of the window point is allowed to get
75 before HScroll will horizontally scroll the window."
79 (defcustom hscroll-snap-threshold
30
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
83 Set this variable to zero to disable this bias."
87 (defcustom hscroll-step-percent
25
88 "*How far away to place the point from the window's edge when scrolling.
89 Expressed as a percentage of the window's width."
93 (defcustom hscroll-mode-name
" Hscr"
94 "*Horizontal scrolling mode line indicator.
95 Set this to nil to conserve valuable mode line space."
99 (or (assq 'hscroll-mode minor-mode-alist
)
100 (setq minor-mode-alist
101 (cons '(hscroll-mode hscroll-mode-name
) minor-mode-alist
)))
105 ;;; PRIVATE VARIABLES
108 (defvar hscroll-mode nil
109 "Non-nil if HScroll mode is enabled.")
110 (make-variable-buffer-local 'hscroll-mode
)
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
)
118 (defvar hscroll-old-truncate-default nil
)
125 (defun turn-on-hscroll ()
126 "Unconditionally turn on Hscroll mode in the current buffer."
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]."
137 (make-local-hook 'post-command-hook
)
138 (let ((newmode (if (null arg
)
140 (> (prefix-numeric-value arg
) 0))))
144 (if (not hscroll-mode
)
146 (let ((localp (local-variable-p 'truncate-lines
)))
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
)
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
)
168 (setq hscroll-mode newmode
)
169 (force-mode-line-update nil
)
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]."
182 (let* ((oldmode (default-value 'hscroll-mode
))
183 (newmode (if (null arg
)
185 (> (prefix-numeric-value arg
) 0))))
186 (setq hscroll-global-mode newmode
)
189 (if (not hscroll-mode
)
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
))
201 (setq-default truncate-lines hscroll-old-truncate-default
)
202 (remove-hook 'post-command-hook
(function hscroll-window-maybe
))
206 (setq-default hscroll-mode newmode
)
207 (force-mode-line-update t
)
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)."
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
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)))
226 (if (< (current-column) hscroll-snap-threshold
)
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)
237 ;; Scroll to the left a proportion of the window's width.
240 (- (+ (current-column)
241 (/ (* (window-width) hscroll-step-percent
) 100))
243 (if (< (current-column) (+ (window-hscroll) hscroll-margin
))
244 ;; Scroll to the right a proportion of the window's width.
247 (- (current-column) (/ (* (window-width) hscroll-step-percent
) 100)))
252 ;;; It's not a bug, it's a *feature*
255 (if hscroll-global-mode
256 (hscroll-global-mode 1))
260 ;;; hscroll.el ends here