code.delx.au - gnu-emacs/blob - 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 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
  68   :group 'hscroll
  69   :type 'boolean
  70   :require 'hscroll
  71   :version "20.3")
  72
  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."
  76   :group 'hscroll
  77   :type 'integer)
  78
  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
  82 edge of the document.
  83   Set this variable to zero to disable this bias."
  84   :group 'hscroll
  85   :type 'integer)
  86
  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."
  90   :group 'hscroll
  91   :type 'integer)
  92
  93 (defcustom hscroll-mode-name " Hscr"
  94   "*Horizontal scrolling mode line indicator.
  95 Set this to nil to conserve valuable mode line space."
  96   :group 'hscroll
  97   :type 'string)
  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 (defvar hscroll-timer nil
 113   "Timer used by HScroll mode.")
 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)
 152               (setq hscroll-timer
 153                     (run-with-idle-timer 0 t 'hscroll-window-maybe))))
 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             (cancel-timer hscroll-timer))))
 164
 165     (setq hscroll-mode newmode)
 166     (force-mode-line-update nil)))
 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))))
 182     (setq hscroll-global-mode newmode)
 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)
 191               (setq hscroll-timer
 192                     (run-with-idle-timer 0 t 'hscroll-window-maybe))))
 193       ;; turn it off
 194       (if hscroll-mode
 195           ;; it was on
 196           (progn
 197             (setq-default truncate-lines hscroll-old-truncate-default)
 198             (cancel-timer hscroll-timer))))
 199
 200     (setq-default hscroll-mode newmode)
 201     (force-mode-line-update t)))
 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)))
 217             (rightmost-char (+ (window-width) (window-hscroll))))
 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)
 239                (- (current-column) (/ (* (window-width) hscroll-step-percent) 100)))))))))
 240
 241 ;;;
 242 ;;; It's not a bug, it's a *feature*
 243 ;;;
 244
 245 (if hscroll-global-mode
 246     (hscroll-global-mode 1))
 247
 248 (provide 'hscroll)
 249
 250 ;;; hscroll.el ends here