(Fread_file_name): Correct handling of dollars in file
[bpt/emacs.git] / lisp / hscroll.el
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:
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
57 (defgroup hscroll nil
58 "Minor mode to automatically scroll truncated lines horizontally."
59 :group 'editing)
60
61
62 (defcustom hscroll-global-mode nil
63 "Toggle horizontal scrolling.
64 Setting this variable directly does not take effect;
65 use either \\[customize] or the function `hscroll-global-mode'."
66 :set (lambda (symbol value)
67 (hscroll-global-mode (if value 1 -1)))
68 :initialize 'custom-initialize-default
69 :group 'hscroll
70 :type 'boolean
71 :require 'hscroll
72 :version "20.3")
73
74 (defcustom hscroll-margin 5
75 "*How many columns away from the edge of the window point is allowed to get
76 before HScroll will horizontally scroll the window."
77 :group 'hscroll
78 :type 'integer)
79
80 (defcustom hscroll-snap-threshold 30
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.
84 Set this variable to zero to disable this bias."
85 :group 'hscroll
86 :type 'integer)
87
88 (defcustom hscroll-step-percent 25
89 "*How far away to place the point from the window's edge when scrolling.
90 Expressed as a percentage of the window's width."
91 :group 'hscroll
92 :type 'integer)
93
94 (defcustom hscroll-mode-name " Hscr"
95 "*Horizontal scrolling mode line indicator.
96 Set this to nil to conserve valuable mode line space."
97 :group 'hscroll
98 :type 'string)
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)
112
113 (defvar hscroll-timer nil
114 "Timer used by HScroll mode.")
115
116 (defvar hscroll-old-truncate-local nil)
117 (defvar hscroll-old-truncate-was-global nil)
118 (make-variable-buffer-local 'hscroll-old-truncate)
119 (make-variable-buffer-local 'hscroll-old-truncate-was-global)
120
121 (defvar hscroll-old-truncate-default nil)
122
123 ;;;
124 ;;; PUBLIC COMMANDS
125 ;;;
126
127 ;;;###autoload
128 (defun turn-on-hscroll ()
129 "Unconditionally turn on Hscroll mode in the current buffer."
130 (hscroll-mode 1))
131
132 ;;;###autoload
133 (defun hscroll-mode (&optional arg)
134 "Toggle HScroll mode in the current buffer.
135 With ARG, turn HScroll mode on if ARG is positive, off otherwise.
136 In HScroll mode, truncated lines will automatically scroll left or
137 right when point gets near either edge of the window.
138 See also \\[hscroll-global-mode]."
139 (interactive "P")
140 (let ((newmode (if (null arg)
141 (not hscroll-mode)
142 (> (prefix-numeric-value arg) 0))))
143
144 (if newmode
145 ;; turn it on
146 (if (not hscroll-mode)
147 ;; it was off
148 (let ((localp (local-variable-p 'truncate-lines)))
149 (if localp
150 (setq hscroll-old-truncate-local truncate-lines))
151 (setq hscroll-old-truncate-was-global (not localp))
152 (setq truncate-lines t)
153 (setq hscroll-timer
154 (run-with-idle-timer 0 t 'hscroll-window-maybe))))
155 ;; turn it off
156 (if hscroll-mode
157 ;; it was on
158 (progn
159 (if hscroll-old-truncate-was-global
160 (kill-local-variable 'truncate-lines)
161 (setq truncate-lines hscroll-old-truncate-local))
162 (if (not truncate-lines)
163 (set-window-hscroll (selected-window) 0))
164 (cancel-timer hscroll-timer))))
165
166 (setq hscroll-mode newmode)
167 (force-mode-line-update nil)))
168
169
170 ;;;###autoload
171 (defun hscroll-global-mode (&optional arg)
172 "Toggle HScroll mode in all buffers.
173 With ARG, turn HScroll mode on if ARG is positive, off otherwise.
174 If a buffer ever has HScroll mode set locally (via \\[hscroll-mode]),
175 it will forever use the local value (i.e., \\[hscroll-global-mode]
176 will have no effect on it).
177 See also \\[hscroll-mode]."
178 (interactive "P")
179 (let* ((oldmode (default-value 'hscroll-mode))
180 (newmode (if (null arg)
181 (not oldmode)
182 (> (prefix-numeric-value arg) 0))))
183 (setq hscroll-global-mode newmode)
184 (if newmode
185 ;; turn it on
186 (if (not hscroll-mode)
187 ;; it was off
188 (progn
189 (setq hscroll-old-truncate-default (default-value truncate-lines))
190 (setq hscroll-old-truncate-was-global t)
191 (setq-default truncate-lines t)
192 (setq hscroll-timer
193 (run-with-idle-timer 0 t 'hscroll-window-maybe))))
194 ;; turn it off
195 (if hscroll-mode
196 ;; it was on
197 (progn
198 (setq-default truncate-lines hscroll-old-truncate-default)
199 (cancel-timer hscroll-timer))))
200
201 (setq-default hscroll-mode newmode)
202 (force-mode-line-update t)))
203
204 (defun hscroll-window-maybe ()
205 "Scroll horizontally if point is off or nearly off the edge of the window.
206 This is called automatically when in HScroll mode, but it can be explicitly
207 invoked as well (i.e., it can be bound to a key)."
208 (interactive)
209 ;; Only consider scrolling if truncate-lines is true,
210 ;; the window is already scrolled or partial-widths is true and this is
211 ;; a partial width window. See display_text_line() in xdisp.c.
212 (if (and hscroll-mode
213 (or truncate-lines
214 (not (zerop (window-hscroll)))
215 (and truncate-partial-width-windows
216 (< (window-width) (frame-width)))))
217 (let ((linelen (save-excursion (end-of-line) (current-column)))
218 (rightmost-char (+ (window-width) (window-hscroll))))
219 (if (< (current-column) hscroll-snap-threshold)
220 (set-window-hscroll
221 (selected-window)
222 (- (window-hscroll)))
223 (if (>= (current-column)
224 (- rightmost-char hscroll-margin
225 ;; Off-by-one if the left edge is scrolled
226 (if (not (zerop (window-hscroll))) 1 0)
227 ;; Off by one if the right edge is scrolled
228 (if (> linelen rightmost-char) 1 0)
229 ))
230 ;; Scroll to the left a proportion of the window's width.
231 (set-window-hscroll
232 (selected-window)
233 (- (+ (current-column)
234 (/ (* (window-width) hscroll-step-percent) 100))
235 (window-width)))
236 (if (< (current-column) (+ (window-hscroll) hscroll-margin))
237 ;; Scroll to the right a proportion of the window's width.
238 (set-window-hscroll
239 (selected-window)
240 (- (current-column) (/ (* (window-width) hscroll-step-percent) 100)))))))))
241
242 ;;;
243 ;;; It's not a bug, it's a *feature*
244 ;;;
245
246 (if hscroll-global-mode
247 (hscroll-global-mode 1))
248
249 (provide 'hscroll)
250
251 ;;; hscroll.el ends here