From: Keith David Bershatsky <esq@lawlist.com>
To: 16475@debbugs.gnu.org
Subject: bug#16475: 24.3.50; enhancement request: remove vertical scroll bar automatically when not needed
Date: Thu, 11 Feb 2016 18:46:22 -0800 [thread overview]
Message-ID: <m2h9hemyrl.wl%esq@lawlist.com> (raw)
In-Reply-To: <8bfbddfb-237e-47b1-aed7-b28fc97d1f92@default>
If and when feature request 22404 ever comes to fruition (to accurately calculate window-start/window-end every command loop under all circumstances), the following is a minor mode that demonstrates how to add/remove scroll bars depending upon the length of the buffer. It can undoubtedly use some improvements, but I am already successfully using it for my own personal setup with the latest draft/patch for the `window-start-end-hook`.
https://debbugs.gnu.org/cgi/bugreport.cgi?bug=22404
[NOTE: Eli has indicated that a `post-redisplay-hook' (which does not introduce user Lisp into the redisplay mix) would be a better alternative to the proposed `window-start-end-hook`, and I completely respect Eli's opinion in that regard. However, I wanted to get something working for my own personal use and I am enjoying familiarizing myself with some basic C language coding relating to feature 22404.]
Thanks,
Keith
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; sb-mode
;; https://github.com/kentaro/auto-save-buffers-enhanced
;; `sb-regexp-match-p` function modified by @sds on stackoverflow
;; http://stackoverflow.com/a/20343715/2112489
(defun sb-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)))))))
(defgroup sb nil
"A group for the lawlist scroll-bar."
:tag "Scroll Bar"
:group 'convenience)
(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" "\\*Calendar\\*")
"Regexp matching buffer names that will never have scroll bars.")
(defun lawlist-scroll-bar-fn (win start end pbol-start peol-end fully-p)
(when
(and
(window-live-p win)
(not (minibufferp)))
(let* (
(buffer-size (buffer-size))
(point-min (point-min))
(point-max (point-max))
(window-scroll-bars (window-scroll-bars))
(buffer-name (buffer-name)))
(cond
;; not regexp matches | not narrow-to-region
((and
(not (sb-regexp-match-p regexp-always-scroll-bar buffer-name))
(not (sb-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) (- end start))
(or
(equal window-scroll-bars '(15 2 right nil)) ;; GNU Emacs 24.5.1 of 2015-04-10 on builder10-6.porkrind.org
(equal window-scroll-bars '(15 2 right 0 0 nil)) ;; 10/01/2014
(equal window-scroll-bars '(15 2 right nil 0 nil)) )) ;; 11/19/2014
(set-window-scroll-bars win 0 'right nil))
;; Lines of text are greater-than window height, and
;; scroll bars are not present (which need to be added).
((and
(> (- point-max point-min) (- end start))
(or
(equal window-scroll-bars '(0 0 nil nil)) ;; GNU Emacs 24.5.1 of 2015-04-10 on builder10-6.porkrind.org
(equal window-scroll-bars '(0 0 t nil)) ;; GNU Emacs 24.5.1 of 2015-04-10 on builder10-6.porkrind.org
(equal window-scroll-bars '(0 0 t 0 0 t)) ;; windows-nt (default)
(equal window-scroll-bars '(nil 0 t nil 0 nil)) ;; darwin (default) ;; 11/19/2014
(equal window-scroll-bars '(0 0 t 0 0 nil)) ;; darwin (default) ;; 10/01/2014
(equal window-scroll-bars '(0 0 nil nil 0 nil)) ;; 11/19/2014 (after scroll bars are removed)
(equal window-scroll-bars '(0 0 nil 0 0 nil)))) ;; windows-nt / darwin
(set-window-scroll-bars win 15 'right nil))))
;; Narrow-to-region is active, and scroll bars are present
;; (which need to be removed).
((and
(buffer-narrowed-p)
(or
(equal window-scroll-bars '(15 2 right nil)) ;; GNU Emacs 24.5.1 of 2015-04-10 on builder10-6.porkrind.org
(equal window-scroll-bars '(15 2 right 0 0 nil)) ;; 10/01/2014
(equal window-scroll-bars '(15 2 right nil 0 nil)) )) ;; 11/19/2014
(set-window-scroll-bars win 0 'right nil))
;; not narrow-to-region | regexp always scroll-bars
((and
(equal (- point-max point-min) buffer-size)
(eq major-mode 'calendar-mode)
(sb-regexp-match-p regexp-always-scroll-bar buffer-name))
(set-window-scroll-bars win 15 'right nil))
;; not narrow-to-region | regexp never scroll-bars
((and
(equal (- point-max point-min) buffer-size)
(sb-regexp-match-p regexp-never-scroll-bar buffer-name))
(set-window-scroll-bars win 0 'right nil))))))
(defvar sb-mode-display-hook nil
"Hook used primarily for `lawlist-scroll-bar-fn'.")
(define-minor-mode sb-mode
"This is a minor-mode for lawlist-scroll-bar."
:init-value nil
:lighter " SB"
:keymap nil
:global nil
:group 'sb
(cond
(sb-mode
(add-hook 'window-start-end-hook 'lawlist-scroll-bar-fn nil t)
(when (called-interactively-p 'any)
(message "Globally turned ON `sb-mode`.")))
(t
(remove-hook 'window-start-end-hook 'lawlist-scroll-bar-fn t)
(set-window-scroll-bars (selected-window) 0 'right nil)
(when (called-interactively-p 'any)
(message "Globally turned OFF `sb-mode`.") ))))
(provide 'lawlist-sb)
next prev parent reply other threads:[~2016-02-12 2:46 UTC|newest]
Thread overview: 15+ messages / expand[flat|nested] mbox.gz Atom feed top
2014-01-17 4:42 bug#16475: 24.3.50; enhancement request: remove vertical scroll bar automatically when not needed Drew Adams
2014-01-17 14:35 ` Stefan Monnier
2016-02-12 2:46 ` Keith David Bershatsky [this message]
2017-10-25 5:27 ` bug#16475: " Keith David Bershatsky
2017-10-25 7:47 ` martin rudalics
2017-10-25 14:40 ` Eli Zaretskii
2017-10-26 7:56 ` martin rudalics
2017-10-26 15:59 ` Eli Zaretskii
2017-10-27 8:25 ` martin rudalics
2017-10-27 2:44 ` Richard Stallman
2017-10-25 22:25 ` Keith David Bershatsky
2017-10-26 16:30 ` Eli Zaretskii
2017-10-26 16:03 ` Keith David Bershatsky
2017-10-26 17:07 ` Eli Zaretskii
2017-10-27 8:26 ` martin rudalics
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/emacs/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=m2h9hemyrl.wl%esq@lawlist.com \
--to=esq@lawlist.com \
--cc=16475@debbugs.gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).