├── README.md ├── screenshot.png ├── stripe-buffer.el └── todo.org /README.md: -------------------------------------------------------------------------------- 1 | # stripe-buffer mode 2 | 3 | Use different background colors for even and odd lines. 4 | 5 | With the help of library `hl-line-mode` yet another color can be used 6 | for the current line. 7 | 8 | ![screenshot](https://github.com/sabof/stripe-buffer/raw/master/screenshot.png) 9 | 10 | Based on the [original](http://www.emacswiki.org/emacs/StripeBuffer) 11 | `stripe-buffer.el` by Andy Steward. 12 | 13 | ## Usage: 14 | 15 | ### Common case: 16 | 17 | (add-hook 'dired-mode-hook 'turn-on-stripe-buffer-mode) 18 | 19 | ### Add stripes in list-style modes (ex. dired-mode) 20 | 21 | As above, or you can use the following to get a horizontal line instead of a 22 | cursor. It uses the `stripe-hl-line` face, which you might wish to customize. 23 | 24 | (add-hook 'dired-mode-hook 'stripe-listify-buffer) 25 | 26 | ### Add stripes to tables 27 | 28 | You might want to have stripes only for tables. Whether a line will be 29 | considered a "table line" is determined by `stripe-in-table-regex`. The default value supports org-mode and table.el tables, as well as tables printed by mysql. 30 | 31 | (add-hook 'org-mode-hook 'turn-on-stripe-table-mode) 32 | 33 | ## Customization: 34 | 35 | ### Faces 36 | 37 | `stripe-highlight` -- color of stripes 38 | 39 | `stripe-hl-line` -- color for hl-line, when using `stripe-listify-buffer` 40 | 41 | ### Variables 42 | 43 | `stripe-height` -- height of the stripes 44 | 45 | `stripe-in-table-regex` -- Regex for determining whether a line is part of a table. Used in `stripe-table-mode` 46 | -------------------------------------------------------------------------------- /screenshot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/sabof/stripe-buffer/c252080f55cb78c951b19ebab9687f6d00237baf/screenshot.png -------------------------------------------------------------------------------- /stripe-buffer.el: -------------------------------------------------------------------------------- 1 | ;;; stripe-buffer.el --- Use a different background for even and odd lines 2 | 3 | ;; Copyright (C) 2008-2009 Andy Stewart 4 | ;; Copyright (C) 2012-2013 sabof 5 | 6 | ;; Author: Andy Stewart 7 | ;; Maintainer: sabof 8 | ;; URL: https://github.com/sabof/stripe-buffer 9 | ;; Package-Requires: ((cl-lib "1.0")) 10 | ;; Version: 0.2.4 11 | 12 | ;;; Commentary: 13 | 14 | ;; Use different background colors for even and odd lines. With the 15 | ;; help of library `hl-line' yet another color can be used for the 16 | ;; current line. 17 | 18 | ;; The project is hosted at https://github.com/sabof/stripe-buffer 19 | 20 | ;;; License: 21 | 22 | ;; This file is NOT part of GNU Emacs. 23 | ;; 24 | ;; This program is free software; you can redistribute it and/or 25 | ;; modify it under the terms of the GNU General Public License as 26 | ;; published by the Free Software Foundation; either version 2, or (at 27 | ;; your option) any later version. 28 | ;; 29 | ;; This program is distributed in the hope that it will be useful, but 30 | ;; WITHOUT ANY WARRANTY; without even the implied warranty of 31 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 32 | ;; General Public License for more details. 33 | ;; 34 | ;; You should have received a copy of the GNU General Public License 35 | ;; along with this program ; see the file COPYING. If not, write to 36 | ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, 37 | ;; Boston, MA 02111-1307, USA. 38 | 39 | ;;; Code: 40 | 41 | (require 'cl-lib) 42 | 43 | (defgroup stripe-buffer nil 44 | "Use different background for even and odd lines." 45 | :group 'wp) 46 | 47 | (defface stripe-highlight 48 | '((((class color) (background dark)) 49 | (:background "#444444")) 50 | (((class color) (background light)) 51 | (:background "#CCCCCC"))) 52 | "Face for stripes." 53 | :group 'stripe-buffer) 54 | 55 | (defface stripe-hl-line 56 | `((t 57 | :background ,(face-attribute 'default :foreground) 58 | :foreground ,(face-attribute 'default :background))) 59 | "Bold face for highlighting the current line in Hl-Line mode." 60 | :group 'stripe-buffer) 61 | 62 | (defcustom stripe-height 1 63 | "Height of stripes." 64 | :group 'stripe-buffer 65 | :type 'integer) 66 | 67 | (defcustom stripe-in-table-regex 68 | "^[ \t]*\\(?1:[|+].+[|+]\\) *$" 69 | "Regular expression that determines whether a line contains a table row. 70 | Used by `stripe-table-mode' Only the first matching group will be painted." 71 | :group 'stripe-buffer 72 | :type 'string) 73 | 74 | (defvar stripe-highlight-face 'stripe-highlight) 75 | 76 | (defvar-local sb/overlays nil) 77 | (defvar-local sb/is-listified nil) 78 | (defvar-local sb/modified-flag nil) 79 | (defvar-local sb/timer nil) 80 | 81 | (defun sb/window-limits (&optional window) 82 | (save-excursion 83 | (let (( win-start (window-start window))) 84 | (goto-char (window-end window t)) 85 | (unless (= (line-beginning-position) (point)) 86 | (forward-line 1)) 87 | (cons win-start (point))))) 88 | 89 | (defun sb/buffer-visible-regions (&optional buffer-or-name) 90 | (mapcar 'sb/window-limits 91 | (cl-remove-if-not 92 | (lambda (win) (frame-visible-p (window-frame win))) 93 | (get-buffer-window-list buffer-or-name nil t)))) 94 | 95 | (defun sb/compress-ranges (ranges) 96 | (let* (( dirty (cl-sort (cl-copy-list ranges) 97 | '< :key 'car)) 98 | clean) 99 | (while (cond 100 | ( (not dirty) 101 | nil) 102 | ( (null (cdr dirty)) 103 | (push (pop dirty) clean) 104 | nil) 105 | ( (>= (cdr (car dirty)) 106 | (car (cadr dirty))) 107 | (setq dirty (cons (cons (car (car dirty)) 108 | (max (cdr (car dirty)) 109 | (cdr (cadr dirty)))) 110 | (nthcdr 2 dirty)))) 111 | ( t (push (pop dirty) clean)))) 112 | (nreverse clean))) 113 | 114 | (defun sb/buffer-visible-regions-compressed () 115 | (sb/compress-ranges (sb/buffer-visible-regions))) 116 | 117 | (defun sb/clear-stripes (&rest ignore) 118 | "Clear stripe overlays in current buffer." 119 | (mapc 'delete-overlay sb/overlays) 120 | (setq sb/overlays nil)) 121 | 122 | (defun sb/redraw-region (start end get-overlay-create-function) 123 | (let* (( interval 124 | (* 2 stripe-height)) 125 | ( draw-stripe 126 | (lambda (height) 127 | ;; `region' available through dynamic binding 128 | (when (< (point) end) 129 | (let* (( stripe-region 130 | (list (point) 131 | (progn 132 | (forward-line height) 133 | (if (<= (point) end) 134 | (point) 135 | (progn 136 | (goto-char end) 137 | (point)))))) 138 | ( overlay (apply get-overlay-create-function stripe-region))) 139 | (overlay-put overlay 'face stripe-highlight-face) 140 | (overlay-put overlay 'is-stripe t) 141 | (push overlay sb/overlays))))) 142 | ( goto-start-pos 143 | (lambda () 144 | (let (( start-offset (mod (1- (line-number-at-pos)) interval))) 145 | (if (< start-offset stripe-height) ; in first part 146 | (progn 147 | (forward-line (- stripe-height start-offset)) 148 | (funcall draw-stripe stripe-height)) 149 | (funcall draw-stripe (- interval start-offset)) 150 | ))))) 151 | (funcall goto-start-pos) 152 | (while (< (point) end) 153 | (forward-line stripe-height) 154 | (funcall draw-stripe stripe-height) 155 | ) 156 | )) 157 | 158 | (defun sb/redraw-regions (regions available) 159 | (let* (( get-overlay-create 160 | (lambda (start end) 161 | (let ((old-overlay (pop available))) 162 | (if old-overlay 163 | (progn 164 | (move-overlay old-overlay start end) 165 | old-overlay) 166 | (make-overlay start end)))))) 167 | (save-excursion 168 | (cl-dolist (region regions) 169 | (goto-char (car region)) 170 | (sb/redraw-region (car region) (cdr region) 171 | get-overlay-create)) 172 | (mapc 'delete-overlay available)))) 173 | 174 | (defun sb/redraw-window (&optional window &rest ignore) 175 | (let* (( region (sb/window-limits window)) 176 | ( old-overlays (cl-remove-if-not 177 | (lambda (ov) (overlay-get ov 'is-stripe)) 178 | (overlays-in (car region) (cdr region))))) 179 | (setq sb/overlays (cl-set-difference sb/overlays old-overlays)) 180 | (sb/redraw-regions (list region) old-overlays) 181 | )) 182 | 183 | (defun sb/redraw-buffer-in-all-windows (&rest ignore) 184 | (sb/redraw-regions (sb/buffer-visible-regions-compressed) 185 | (prog1 sb/overlays 186 | (setq sb/overlays nil)))) 187 | 188 | (defun sb/visible-table-ranges () 189 | (let (( visible-ranges (sb/buffer-visible-regions-compressed)) 190 | ranges) 191 | (cl-dolist (vr visible-ranges) 192 | (save-excursion 193 | (goto-char (car vr)) 194 | (while (and (<= (point) (cdr vr)) 195 | (re-search-forward stripe-in-table-regex (cdr vr) t) 196 | (not (invisible-p (match-beginning 0)))) 197 | (push (cons (match-beginning 1) (match-end 1)) ranges) 198 | ))) 199 | (sb/compress-ranges ranges))) 200 | 201 | (defun sb/redraw-all-tables (&rest ignore) 202 | (sb/redraw-regions (sb/visible-table-ranges) 203 | (prog1 sb/overlays 204 | (setq sb/overlays nil)))) 205 | 206 | (defun sb/add-hooks (hooks) 207 | (cl-dolist (hook hooks) 208 | (add-hook (car hook) (cdr hook) nil t))) 209 | 210 | (defun sb/remove-hooks (hooks) 211 | (cl-dolist (hook hooks) 212 | (remove-hook (car hook) (cdr hook) t))) 213 | 214 | ;;; Interface 215 | 216 | (defun sb/set-timer (redraw-func) 217 | (unless sb/timer 218 | (setq sb/timer 219 | (run-with-idle-timer 220 | 0 nil (lambda (buffer redraw-func) 221 | (when (buffer-live-p buffer) 222 | (with-current-buffer buffer 223 | (funcall redraw-func) 224 | (setq sb/timer nil)))) 225 | (current-buffer) 226 | redraw-func)))) 227 | 228 | (defun sb/cancel-timer () 229 | (when sb/timer 230 | (cancel-timer sb/timer) 231 | (setq sb/timer nil))) 232 | 233 | ;;;###autoload 234 | (define-minor-mode stripe-buffer-mode 235 | "Stripe buffer mode" 236 | nil nil nil 237 | (let* (( after-change 238 | (lambda (&rest ignore) 239 | (setq sb/modified-flag t) 240 | ;; For cases when a change is made by a timer, or a process filter 241 | (sb/set-timer 'sb/redraw-buffer-in-all-windows))) 242 | ( post-command 243 | (lambda (&rest ignore) 244 | (if sb/modified-flag 245 | (progn 246 | (sb/redraw-buffer-in-all-windows) 247 | (sb/cancel-timer)) 248 | (sb/set-timer 'sb/redraw-buffer-in-all-windows)) 249 | (setq sb/modified-flag nil))) 250 | ( hooks `((after-change-functions . ,after-change) 251 | (post-command-hook . ,post-command) 252 | (window-scroll-functions . sb/redraw-window) 253 | (change-major-mode-hook . sb/clear-stripes) 254 | (window-configuration-change-hook . sb/redraw-buffer-in-all-windows) 255 | ))) 256 | (if stripe-buffer-mode 257 | (progn 258 | (stripe-table-mode -1) 259 | (sb/add-hooks hooks) 260 | (sb/redraw-buffer-in-all-windows)) 261 | (sb/remove-hooks hooks) 262 | (sb/clear-stripes) 263 | ))) 264 | 265 | ;;;###autoload 266 | (defun turn-on-stripe-buffer-mode () 267 | "Turn on `stripe-buffer-mode'." 268 | (interactive) 269 | (stripe-buffer-mode 1)) 270 | 271 | ;;;###autoload 272 | (define-minor-mode stripe-table-mode 273 | "Stripe table mode" 274 | nil nil nil 275 | (let* (( after-change 276 | (lambda (&rest ignore) 277 | (setq sb/modified-flag t) 278 | (sb/set-timer 'sb/redraw-all-tables))) 279 | ( post-command 280 | (lambda (&rest ignore) 281 | (if sb/modified-flag 282 | (progn 283 | (sb/redraw-all-tables) 284 | (sb/cancel-timer)) 285 | (sb/set-timer 'sb/redraw-all-tables)) 286 | (setq sb/modified-flag nil))) 287 | ( hooks 288 | `((after-change-functions . ,after-change) 289 | (post-command-hook . ,post-command) 290 | (window-scroll-functions . sb/redraw-all-tables) 291 | (change-major-mode-hook . sb/clear-stripes) 292 | (window-configuration-change-hook . sb/redraw-all-tables)))) 293 | (if stripe-table-mode 294 | (progn 295 | (stripe-buffer-mode -1) 296 | (sb/add-hooks hooks) 297 | (sb/redraw-all-tables)) 298 | (progn 299 | (sb/remove-hooks hooks) 300 | (sb/clear-stripes) 301 | )))) 302 | 303 | ;;;###autoload 304 | (defun turn-on-stripe-table-mode () 305 | "Turn on `stripe-table-mode'." 306 | (interactive) 307 | (stripe-table-mode 1)) 308 | 309 | ;;;###autoload 310 | (defun org-table-stripes-enable () 311 | "Backward compatibility" 312 | (interactive) 313 | (stripe-table-mode 1)) 314 | 315 | ;;;###autoload 316 | (defun stripe-listify-buffer () 317 | "Turn on `stripe-buffer-mode' and `hl-line-mode'." 318 | (interactive) 319 | (setq sb/is-listified t) 320 | (setq cursor-type nil) 321 | (stripe-buffer-mode 1) 322 | (setq-local face-remapping-alist 323 | `((hl-line stripe-hl-line))) 324 | (hl-line-mode 1)) 325 | 326 | (defadvice hl-line-highlight (after stripe-set-priority activate) 327 | (when stripe-buffer-mode 328 | (overlay-put hl-line-overlay 'priority 10))) 329 | 330 | (defun stripe-wdired-enable-cursor () 331 | (when sb/is-listified 332 | (hl-line-mode -1) 333 | (setq cursor-type t))) 334 | 335 | (add-hook 'wdired-mode-hook 'stripe-wdired-enable-cursor) 336 | 337 | (defadvice wdired-finish-edit (before stripe-hide-cursor activate) 338 | (when sb/is-listified 339 | (hl-line-mode 1) 340 | (setq cursor-type nil))) 341 | 342 | (defadvice image-dired-dired-toggle-marked-thumbs 343 | (around disable-stripes activate) 344 | (let (( was-stripe-buffer-mode 345 | stripe-buffer-mode)) 346 | (when was-stripe-buffer-mode 347 | (stripe-buffer-mode -1)) 348 | ad-do-it 349 | (when was-stripe-buffer-mode 350 | (stripe-buffer-mode 1)))) 351 | 352 | (provide 'stripe-buffer) 353 | ;; Local Variables: 354 | ;; indent-tabs-mode: nil 355 | ;; lisp-backquote-indentation: t 356 | ;; End: 357 | ;;; stripe-buffer.el ends here 358 | -------------------------------------------------------------------------------- /todo.org: -------------------------------------------------------------------------------- 1 | * DONE Implement after-change-hook 2 | --------------------------------------------------------------------------------