hscroll.el 8.54 KB
Newer Older
Karl Heuer's avatar
Karl Heuer committed
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23
;;; hscroll.el: Minor mode to automatically scroll truncated lines horizontally
;;; Copyright (C) 1992, 1993, 1995, 1996 Free Software Foundation, Inc.

;; Author: Wayne Mesard <wmesard@esd.sgi.com>
;; Keywords: display

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

24
;;; Commentary:
Karl Heuer's avatar
Karl Heuer committed
25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56
;;
;;    Automatically scroll horizontally when the point moves off the
;;    left or right edge of the window.  
;;
;;    - Type "M-x hscroll-mode" to enable it in the current buffer.
;;    - Type "M-x hscroll-global-mode" to enable it in every buffer.
;;    - "turn-on-hscroll" is useful in mode hooks as in:
;;          (add-hook 'text-mode-hook 'turn-on-hscroll)
;;
;;    - hscroll-margin controls how close the cursor can get to the edge 
;;      of the window.
;;    - hscroll-step-percent controls how far to jump once we decide to do so.
;;
;;    Most users won't want to mess with the other variables defined
;;    here.  But they're all documented, and they all start with
;;    "hscroll-" if you're curious.
;;
;;    Oh, you should also know that if you set the hscroll-margin and
;;    hscroll-step-percent large enough, you can get an interesting, but
;;    undesired ping-pong effect as the point bounces from one edge to
;;    the other.
;;
;;    wmesard@sgi.com

;;; Code:

;;; 
;;; PUBLIC VARIABLES
;;; 

(defvar hscroll-version "2.2")

Richard M. Stallman's avatar
Richard M. Stallman committed
57 58 59 60
(defgroup hscroll nil
  "Minor mode to automatically scroll truncated lines horizontally."
  :group 'editing)

61 62 63

(defcustom hscroll-global-mode nil
  "Toggle horizontal scrolling.
Dave Love's avatar
Dave Love committed
64 65
Setting this variable directly does not take effect;
use either \\[customize] or the function `hscroll-global-mode'."
66 67 68 69 70
  :set (lambda (symbol value)
	 (hscroll-global-mode (if value 1 -1)))
  :initialize 'custom-initialize-default
  :group 'hscroll
  :type 'boolean
Dan Nicolaescu's avatar
Dan Nicolaescu committed
71 72
  :require 'hscroll
  :version "20.3")
73

Richard M. Stallman's avatar
Richard M. Stallman committed
74
(defcustom hscroll-margin 5 
Karl Heuer's avatar
Karl Heuer committed
75
  "*How many columns away from the edge of the window point is allowed to get
Richard M. Stallman's avatar
Richard M. Stallman committed
76 77 78
before HScroll will horizontally scroll the window."
  :group 'hscroll
  :type 'integer)
Karl Heuer's avatar
Karl Heuer committed
79

Richard M. Stallman's avatar
Richard M. Stallman committed
80
(defcustom hscroll-snap-threshold 30
Karl Heuer's avatar
Karl Heuer committed
81 82 83
  "*When point is this many columns (or less) from the left edge of the document, 
don't do any horizontal scrolling.  In other words, be biased towards the left
edge of the document.
Richard M. Stallman's avatar
Richard M. Stallman committed
84 85 86
  Set this variable to zero to disable this bias."
  :group 'hscroll
  :type 'integer)
Karl Heuer's avatar
Karl Heuer committed
87

Richard M. Stallman's avatar
Richard M. Stallman committed
88
(defcustom hscroll-step-percent 25
Karl Heuer's avatar
Karl Heuer committed
89
  "*How far away to place the point from the window's edge when scrolling.
Richard M. Stallman's avatar
Richard M. Stallman committed
90 91 92
Expressed as a percentage of the window's width."
  :group 'hscroll
  :type 'integer)
Karl Heuer's avatar
Karl Heuer committed
93

Richard M. Stallman's avatar
Richard M. Stallman committed
94
(defcustom hscroll-mode-name " Hscr"
Karl Heuer's avatar
Karl Heuer committed
95
  "*Horizontal scrolling mode line indicator.
Richard M. Stallman's avatar
Richard M. Stallman committed
96 97 98
Set this to nil to conserve valuable mode line space."
  :group 'hscroll
  :type 'string)
Karl Heuer's avatar
Karl Heuer committed
99 100 101 102 103 104 105 106 107 108 109 110 111

(or (assq 'hscroll-mode minor-mode-alist)
    (setq minor-mode-alist
	  (cons '(hscroll-mode hscroll-mode-name) minor-mode-alist)))


;;; 
;;; PRIVATE VARIABLES
;;; 

(defvar hscroll-mode nil 
  "Non-nil if HScroll mode is enabled.")
(make-variable-buffer-local 'hscroll-mode)
112 113 114
;; Make it a permanent local
;; so it will only turn off when WE turn it off.
(put 'hscroll-mode 'permanent-local t)
Karl Heuer's avatar
Karl Heuer committed
115

116 117
(defvar hscroll-timer nil
  "Timer used by HScroll mode.")
Karl Heuer's avatar
Karl Heuer committed
118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147

(defvar hscroll-old-truncate-local nil)
(defvar hscroll-old-truncate-was-global nil)
(make-variable-buffer-local 'hscroll-old-truncate)
(make-variable-buffer-local 'hscroll-old-truncate-was-global)

(defvar hscroll-old-truncate-default nil)

;;; 
;;; PUBLIC COMMANDS
;;; 

;;;###autoload
(defun turn-on-hscroll ()
  "Unconditionally turn on Hscroll mode in the current buffer."
  (hscroll-mode 1))

;;;###autoload
(defun hscroll-mode (&optional arg)
  "Toggle HScroll mode in the current buffer.
With ARG, turn HScroll mode on if ARG is positive, off otherwise.
In HScroll mode, truncated lines will automatically scroll left or
right when point gets near either edge of the window.
  See also \\[hscroll-global-mode]."
  (interactive "P")
  (let ((newmode (if (null arg)
		      (not hscroll-mode)
		    (> (prefix-numeric-value arg) 0))))

    (if newmode
148
	;; Turn it on.
Karl Heuer's avatar
Karl Heuer committed
149
	(if (not hscroll-mode)
150
	    ;; It was off.
Karl Heuer's avatar
Karl Heuer committed
151 152 153 154 155
	    (let ((localp (local-variable-p 'truncate-lines)))
	      (if localp
		  (setq hscroll-old-truncate-local truncate-lines))
	      (setq hscroll-old-truncate-was-global (not localp))
	      (setq truncate-lines t)
156 157
              (setq hscroll-timer
                    (run-with-idle-timer 0 t 'hscroll-window-maybe))))
158
      ;; Turn it off.
Karl Heuer's avatar
Karl Heuer committed
159
      (if hscroll-mode
160
	  ;; It was on.
Karl Heuer's avatar
Karl Heuer committed
161 162 163 164 165 166
	  (progn
	    (if hscroll-old-truncate-was-global
		(kill-local-variable 'truncate-lines)
	      (setq truncate-lines hscroll-old-truncate-local))
	    (if (not truncate-lines)
		(set-window-hscroll (selected-window) 0))
167 168 169 170 171 172 173
	    ;; If hscroll is not enabled in any buffer now,
	    ;; turn off the timer.
	    (unless (memq t (mapcar (lambda (buffer)
				      (with-current-buffer buffer
					hscroll-mode))
				    (buffer-list)))
	      (cancel-timer hscroll-timer)))))
Karl Heuer's avatar
Karl Heuer committed
174 175

    (setq hscroll-mode newmode)
176
    (force-mode-line-update nil)))
Karl Heuer's avatar
Karl Heuer committed
177 178 179 180


;;;###autoload
(defun hscroll-global-mode  (&optional arg)
181
  "Toggle HScroll mode in all buffers (excepting minibuffers).
Karl Heuer's avatar
Karl Heuer committed
182 183 184 185 186 187 188 189 190 191
With ARG, turn HScroll mode on if ARG is positive, off otherwise.
If a buffer ever has HScroll mode set locally (via \\[hscroll-mode]), 
it will forever use the local value (i.e., \\[hscroll-global-mode] 
will have no effect on it).
  See also \\[hscroll-mode]."
  (interactive "P")
  (let* ((oldmode (default-value 'hscroll-mode))
	 (newmode (if (null arg)
		      (not oldmode)
		    (> (prefix-numeric-value arg) 0))))
192
    (setq hscroll-global-mode newmode)
Karl Heuer's avatar
Karl Heuer committed
193 194 195 196 197 198 199 200
    (if newmode
	;; turn it on
	(if (not hscroll-mode)
	    ;; it was off
	    (progn
	      (setq hscroll-old-truncate-default (default-value truncate-lines))
	      (setq hscroll-old-truncate-was-global t)
	      (setq-default truncate-lines t)
201 202
              (setq hscroll-timer
                    (run-with-idle-timer 0 t 'hscroll-window-maybe))))
Karl Heuer's avatar
Karl Heuer committed
203 204 205 206 207
      ;; turn it off
      (if hscroll-mode
	  ;; it was on
	  (progn
	    (setq-default truncate-lines hscroll-old-truncate-default)
208
            (cancel-timer hscroll-timer))))
Karl Heuer's avatar
Karl Heuer committed
209 210

    (setq-default hscroll-mode newmode)
211
    (force-mode-line-update t)))
Karl Heuer's avatar
Karl Heuer committed
212 213 214 215

(defun hscroll-window-maybe ()
  "Scroll horizontally if point is off or nearly off the edge of the window.
This is called automatically when in HScroll mode, but it can be explicitly
216 217
invoked as well (i.e., it can be bound to a key).
This does nothing in the minibuffer."
Karl Heuer's avatar
Karl Heuer committed
218 219 220
  (interactive)
  ;; Only consider scrolling if truncate-lines is true, 
  ;; the window is already scrolled or partial-widths is true and this is
221
  ;; a partial width window.  See display_text_line in xdisp.c.
Karl Heuer's avatar
Karl Heuer committed
222
  (if (and hscroll-mode
223
           (not (window-minibuffer-p (selected-window)))
Karl Heuer's avatar
Karl Heuer committed
224 225 226 227 228
	   (or truncate-lines
	       (not (zerop (window-hscroll)))
	       (and truncate-partial-width-windows
		    (< (window-width) (frame-width)))))
      (let ((linelen (save-excursion (end-of-line) (current-column)))
229
	    (rightmost-char (+ (window-width) (window-hscroll))))
Karl Heuer's avatar
Karl Heuer committed
230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250
 	(if (< (current-column) hscroll-snap-threshold)
 	    (set-window-hscroll 
 	     (selected-window) 
 	     (- (window-hscroll)))
 	  (if (>= (current-column)
		(- rightmost-char hscroll-margin
		   ;; Off-by-one if the left edge is scrolled
		   (if (not (zerop (window-hscroll))) 1 0)
		   ;; Off by one if the right edge is scrolled
		   (if (> linelen rightmost-char) 1 0)
		   ))
	    ;; Scroll to the left a proportion of the window's width.
	    (set-window-hscroll 
	     (selected-window) 
	     (- (+ (current-column) 
		   (/ (* (window-width) hscroll-step-percent) 100))
		(window-width)))
	  (if (< (current-column) (+ (window-hscroll) hscroll-margin))
	      ;; Scroll to the right a proportion of the window's width.
	      (set-window-hscroll
	       (selected-window)
251
	       (- (current-column) (/ (* (window-width) hscroll-step-percent) 100)))))))))
Karl Heuer's avatar
Karl Heuer committed
252 253 254 255 256

;;; 
;;; It's not a bug, it's a *feature*
;;; 

257 258 259
(if hscroll-global-mode
    (hscroll-global-mode 1))

Karl Heuer's avatar
Karl Heuer committed
260 261 262
(provide 'hscroll)

;;; hscroll.el ends here