Search code examples
emacsscrollbarelisp

How to automatically add / remove scroll-bars as needed by text height


Many commercial word processors have a default behavior that automatically hides the vertical scroll bars when the lines of text in the document are less than the visible window; and, the scroll bars appear automatically when the lines of text in the document are greater than the visible window. Emacs is missing that ability and I'd like that to be the default behavior in a variety of different modes.

Does anyone have some ideas how to automatically remove or add the scroll-bars on the fly as the size (lines of text) of the document increases or decreases?

I was thinking of perhaps weaving it into the the functions for line numbers using a prior sample by @phils in a related thread:  https://stackoverflow.com/a/10593165/2112489

I'd like it work even when I'm not using linum-mode. However, I don't think the scroll-bar function should run after every single command -- it should run only when a new line is added or subtracted, taking into consideration visual-line-mode (i.e., wrapping being active) potentially being active.

The following snippet was inspired by a previous answer from @abo-abo in a related thread: https://stackoverflow.com/a/20923695/2112489

(cond
  ((not (> (count-lines (point-min) (point-max)) (window-height)))
    (set-window-scroll-bars (get-buffer-window (buffer-name) (selected-frame)) 0 nil))
  ((and
      (> (count-lines (point-min) (point-max)) (window-height))
      (not (equal (window-scroll-bars) `(15 2 t nil))))
    (set-window-scroll-bars (get-buffer-window (buffer-name) (selected-frame)) 15 'right)))

EDIT (January 17, 2014):  Working draft based upon the helpful answer to this thread by @Drew.

EDIT (January 19, 2014):  Added a function to count each word-wrapped line using vertical-motion. Setting the initial-frame-default seems to be read by Emacs after the initial frame is created, so the scroll bars are visible for a split second -- to avoid seeing this, modifying the frame parameters of the initial frame seems to fix this visual issue. Now using window-text-height instead of window-height -- The returned height does not include dividers, the mode line, any header line, nor any partial-height lines at the bottom of the text area. Copied the method used by linum-mode in terms of using -- the post-command-hook, the change-major-mode-hook, and the window-configuration-change-hook). Added window-live-p condition to avoid post-command-hook errors when starting Emacs while various buffers are loading out of sight. Added condition to deal with narrow-to-region -- still unsure why that situation causes Emacs to freeze in a loop or something -- the workaround is needed for now. The latest version of Emacs Trunk from January 19, 2014 appears to fix visual display issues experienced in prior versions -- as such, redraw-frame is no longer necessary. Added (redisplay t) to the function count-vertical-lines, which speeds up displaying the new buffer when switching buffers. Added regexp for buffers that will always have scroll bars or never have scroll bars.

EDIT (January 20, 2014):  Added just one main condition that there be a live window, and removed the same conditions from the various branches of the lawlist-scroll-bar function. Added additional condition for a narrow-to-region situation such that removing the scroll bars only need occur if scroll bars were present prior to narrowing.

EDIT (January 21, 2014):  With this revision, it is no longer necessary to count lines (which causes a slow-down in large buffers). The new method is a much simpler mathematical calculation based on four (4) points that are determined in a mere fraction of a second -- i.e., point-min, point-max, window-start and window-end. If point-min moves off the screen, scroll bars are added -- I think this behavior makes sense -- although, I did stop to ponder whether the scroll-bar should also serve as a visual representation of whether the characters within the parameters of point-min to point-max could actually fit into the window regardless of whether point-min had moved beyond the window. None of the hooks in this example are able to deal with a display-buffer situation (targeting the same window of the same frame that both already have focus) -- so, I created my own display-buffer-hook (which is beyond the scope of this example).

;;;;;;;;;;;;;;;;;;;;;;;;;; LAWLIST SCROLL BAR MODE ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defvar regexp-always-scroll-bar '("\\.yes" "\\*Scroll-Bar\\*")
  "Regexp matching buffer names that will always have scroll bars.")

(defvar regexp-never-scroll-bar '("\\.off" "\\.not")
  "Regexp matching buffer names that will never have scroll bars.")

(add-to-list 'default-frame-alist '(vertical-scroll-bars . nil))

(modify-all-frames-parameters (list (cons 'vertical-scroll-bars nil)))

(defun lawlist-scroll-bar ()
  (when (window-live-p (get-buffer-window (current-buffer)))
    (redisplay t)
    (cond
      ;; not regexp matches | not narrow-to-region
      ((and
          (not (regexp-match-p regexp-always-scroll-bar (buffer-name)))
          (not (regexp-match-p regexp-never-scroll-bar (buffer-name)))
          (equal (- (point-max) (point-min)) (buffer-size)))
        (cond
          ;; Lines of text are less-than or equal-to window height,
          ;; and scroll bars are present (which need to be removed).
          ((and
              (<= (- (point-max) (point-min)) (- (window-end) (window-start)))
              (equal (window-scroll-bars) `(15 2 right nil)))
            (set-window-scroll-bars (selected-window) 0 'right nil))
          ;; Lines of text are greater-than window height, and
          ;; scroll bars are not present and need to be added.
          ((and
              (> (- (point-max) (point-min)) (- (window-end) (window-start)))
              (not (equal (window-scroll-bars) `(15 2 right nil))))
            (set-window-scroll-bars (selected-window) 15 'right nil))))
      ;; Narrow-to-region is active, and scroll bars are present
      ;; (which need to be removed).
      ((and
          (not (equal (- (point-max) (point-min)) (buffer-size)))
          (equal (window-scroll-bars) `(15 2 right nil)))
        (set-window-scroll-bars (selected-window) 0 'right nil))
      ;; not narrow-to-region | regexp always scroll-bars
      ((and
          (equal (- (point-max) (point-min)) (buffer-size))
          (regexp-match-p regexp-always-scroll-bar (buffer-name)))
        (set-window-scroll-bars (selected-window) 15 'right nil))
      ;; not narrow-to-region | regexp never scroll-bars
      ((and
          (equal (- (point-max) (point-min)) (buffer-size))
          (regexp-match-p regexp-never-scroll-bar (buffer-name)))
        (set-window-scroll-bars (selected-window) 0 'right nil)))))

(define-minor-mode lawlist-scroll-bar-mode
  "This is a custom scroll bar mode."
  :lighter " sc"
  (if lawlist-scroll-bar-mode
    (progn
      (add-hook 'post-command-hook 'lawlist-scroll-bar nil t)
      ;; (add-hook 'change-major-mode-hook 'lawlist-scroll-bar nil t)
      ;; (add-hook 'window-configuration-change-hook 'lawlist-scroll-bar nil t)
       )
    (remove-hook 'post-command-hook 'lawlist-scroll-bar t)
    (remove-hook 'change-major-mode-hook 'lawlist-scroll-bar t)
    (remove-hook 'window-configuration-change-hook 'lawlist-scroll-bar t)))

(define-globalized-minor-mode global-lawlist-scroll-bar-mode
  lawlist-scroll-bar-mode lawlist-scroll-bar-on)

(defun lawlist-scroll-bar-on ()
  (unless (minibufferp)
    (lawlist-scroll-bar-mode 1)))

(global-lawlist-scroll-bar-mode)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

Supporting regexp function:

;; https://github.com/kentaro/auto-save-buffers-enhanced
;; `regexp-match-p` function modified by @sds on stackoverflow
;; https://stackoverflow.com/questions/20343048/distinguishing-files-with-extensions-from-hidden-files-and-no-extensions
(defun regexp-match-p (regexps string)
  (and string
       (catch 'matched
         (let ((inhibit-changing-match-data t)) ; small optimization
           (dolist (regexp regexps)
             (when (string-match regexp string)
               (throw 'matched t)))))))

Solution

  • If you just want to toggle scroll bars on/off interactively, or on a hook, or from your code, then scroll-bar-mode should be all you need.

    You can also use menu-bar-no-scroll-bar, menu-bar-left-scroll-bar, and menu-bar-right-scroll-bar. Or just do what each of those commands does: (customize-set-variable 'scroll-bar-mode WHATEVER). Or use set-scroll-bar-mode or set-window-scroll-bars, similarly. It depends on what behavior you are looking for.

    I recommend M-x apropos scroll-bar. (Or if you use Icicles, just C-h f scroll-bar S-TAB, then repeat C-M-down...)

    You can add it to mode-line-position, so that update of the mode line automatically triggers turning scroll bars on/off. This pretty much works, for instance:

    (setq-default
     mode-line-position
     '(:eval
       (progn
         (if (> (count-lines (point-min) (point-max)) (window-height))
             (set-window-scroll-bars nil 20 t)
           (set-window-scroll-bars nil 0 t))
         `((-3 ,(propertize
                 "%p"
                 'local-map mode-line-column-line-number-mode-map
                 'mouse-face 'mode-line-highlight
                 'help-echo "Buffer position, mouse-1: Line/col menu"))
           (line-number-mode
            ((column-number-mode
              (10 ,(propertize
                    " (%l,%c)"
                    'face (and (> (current-column)
                                  modelinepos-column-limit)
                               'modelinepos-column-warning)
                    'local-map mode-line-column-line-number-mode-map
                    'mouse-face 'mode-line-highlight
                    'help-echo "Line and column, mouse-1: Line/col menu"))
              (6 ,(propertize
                   " L%l"
                   'local-map mode-line-column-line-number-mode-map
                   'mouse-face 'mode-line-highlight
                   'help-echo "Line number, mouse-1: Line/col menu"))))
            ((column-number-mode
              (5 ,(propertize
                   " C%c"
                   'face (and (> (current-column)
                                 modelinepos-column-limit)
                              'modelinepos-column-warning)
                   'local-map mode-line-column-line-number-mode-map
                   'mouse-face 'mode-line-highlight
                   'help-echo "Column number, mouse-1: Line/col menu")))))))))
    

    You can alternatively use the following, which employs Stefan's suggestion to make it work better with scaled text, visual-line-mode, images, etc. However, in that case, scroll bars kick in whenever some text is outside the window because of scrolling, regardless of whether that text would fit in the window. Whether that is a feature or not is for you to decide. ;-)

    (setq-default
     mode-line-position
     '(:eval
       (let ((scroll-bars  (nth 2 (window-scroll-bars))))
         (if (or (> (point-max) (window-end))  (< (point-min) (window-start)))
             (unless scroll-bars (set-window-scroll-bars nil 20 t))
           (when scroll-bars (set-window-scroll-bars nil 0 t)))
         (unless (equal scroll-bars (nth 2 (window-scroll-bars))) (redraw-frame))
         `((-3 ,(propertize
                 "%p"
                 'local-map mode-line-column-line-number-mode-map
                 'mouse-face 'mode-line-highlight
                 'help-echo "Buffer position, mouse-1: Line/col menu"))
           (line-number-mode
            ((column-number-mode
              (10 ,(propertize
                    " (%l,%c)"
                    'face (and (> (current-column)
                                  modelinepos-column-limit)
                               'modelinepos-column-warning)
                    'local-map mode-line-column-line-number-mode-map
                    'mouse-face 'mode-line-highlight
                    'help-echo "Line and column, mouse-1: Line/col menu"))
              (6 ,(propertize
                   " L%l"
                   'local-map mode-line-column-line-number-mode-map
                   'mouse-face 'mode-line-highlight
                   'help-echo "Line number, mouse-1: Line/col menu"))))
            ((column-number-mode
              (5 ,(propertize
                   " C%c"
                   'face (and (> (current-column)
                                 modelinepos-column-limit)
                              'modelinepos-column-warning)
                   'local-map mode-line-column-line-number-mode-map
                   'mouse-face 'mode-line-highlight
                   'help-echo "Column number, mouse-1: Line/col menu")))))))))