1 ;;; vline.el --- show vertical line (column highlighting) mode.
3 ;; Copyright (C) 2002, 2008, 2009, 2010 by Taiki SUGAWARA <buzz.taiki@gmail.com>
5 ;; Author: Taiki SUGAWARA <buzz.taiki@gmail.com>
6 ;; Keywords: faces, editing, emulating
8 ;; Time-stamp: <2010-02-02 19:37:18 UTC taiki>
9 ;; URL: http://www.emacswiki.org/cgi-bin/wiki/vline.el
10 ;; URL: http://bitbucket.org/buzztaiki/elisp/src/tip/vline.el
12 ;; This file is free software; you can redistribute it and/or modify
13 ;; it under the terms of the GNU General Public License as published by
14 ;; the Free Software Foundation; either version 2, or (at your option)
17 ;; This file is distributed in the hope that it will be useful,
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;; GNU General Public License for more details.
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with GNU Emacs; see the file COPYING. If not, write to
24 ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
25 ;; Boston, MA 02110-1301, USA.
28 ;; put followings your .emacs
31 ;; if you display a vertical line, type M-x vline-mode. `vline-mode' doesn't
32 ;; effect other buffers, because it is a buffer local minor mode. if you hide
33 ;; a vertical line, type M-x vline-mode again.
35 ;; if you display a vertical line in all buffers, type M-x vline-global-mode.
37 ;; `vline-style' provides a display style of vertical line. see
38 ;; `vline-style' docstring.
40 ;; if you don't want to visual line highlighting (ex. for performance
41 ;; issue), please to set `vline-visual' to nil.
43 ;; if you don't want to use timer (ex. you want to highlight column
44 ;; during moving cursors), please to set `vline-use-timer' to nil.
48 ;; improve performance.
51 ;; support org-mode, outline-mode
54 ;; add autoload cookies.
57 ;; fix last line highlighting probrem.
60 ;; support visual line highlighting.
61 ;; - Added face vline-visual.
62 ;; - Added defcustom vline-visual-face.
63 ;; - Added defcustom vline-visual.
66 ;; fix continuas line problem.
67 ;; - Don't display vline when cursor into fringe
68 ;; - Don't expand eol more than window width.
71 ;; fix coding-system problem.
72 ;; - Added vline-multiwidth-space-list
73 ;; - Use ucs code-point for japanese fullwidth space.
76 ;; applied patch from Lennart Borgman
77 ;; - Added :group 'vline
78 ;; - Added defcustom vline-current-window-only
79 ;; - Added header items to simplify for users
82 ;; - track window-scroll-functions, window-size-change-functions.
83 ;; - consider other minor modes (using {after,before}-string overlay).
84 ;; - don't use {post,after}-command-hook for performance??
88 (defvar vline-overlay-table-size 200)
89 (defvar vline-overlay-table (make-vector vline-overlay-table-size nil))
90 (defvar vline-line-char ?|)
91 (defvar vline-multiwidth-space-list
94 (decode-char 'ucs #x3000) ; japanese fullwidth space
96 (defvar vline-timer nil)
98 (defcustom vline-style 'face
99 "This variable holds vertical line display style.
100 Available values are followings:
102 `compose' : use composit char.
103 `mixed' : use face and composit char."
112 '((t (:background "light steel blue")))
113 "A default face for vertical line highlighting."
116 (defface vline-visual
117 '((t (:background "gray90")))
118 "A default face for vertical line highlighting in visual lines."
121 (defcustom vline-face 'vline
122 "A face for vertical line highlighting."
126 (defcustom vline-visual-face 'vline-visual
127 "A face for vertical line highlighting in visual lines."
131 (defcustom vline-current-window-only nil
132 "If non-nil then highlight column in current window only.
133 If the buffer is shown in several windows then highlight column only
134 in the currently selected window."
138 (defcustom vline-visual t
139 "If non-nil then highlight column in visual lines.
140 If you specified `force' then use force visual line highlighting even
141 if `truncate-lines' is non-nil."
148 (defcustom vline-use-timer t
149 "If non-nil then vline use idle timer instead
150 of (post|after)-command-hook."
154 (defcustom vline-idle-time 0.02
155 "Idle time for highlighting column."
160 (define-minor-mode vline-mode
161 "Display vertical line mode."
167 (add-hook 'pre-command-hook 'vline-pre-command-hook nil t)
170 (add-hook 'post-command-hook 'vline-post-command-hook nil t)))
173 (remove-hook 'pre-command-hook 'vline-pre-command-hook t)
174 (remove-hook 'post-command-hook 'vline-post-command-hook t)))
177 (define-global-minor-mode vline-global-mode
180 (unless (minibufferp)
184 (defun vline-pre-command-hook ()
185 (when (and vline-mode (not (minibufferp)))
188 (defun vline-post-command-hook ()
189 (when (and vline-mode (not (minibufferp)))
192 (defun vline-set-timer ()
195 vline-idle-time t 'vline-timer-callback)))
197 (defun vline-cancel-timer ()
198 (when (timerp vline-timer)
199 (cancel-timer vline-timer)))
201 (defun vline-timer-callback ()
202 (when (and vline-mode (not (minibufferp)))
205 (defun vline-clear ()
206 (mapcar (lambda (ovr)
207 (and ovr (delete-overlay ovr)))
208 vline-overlay-table))
210 (defsubst vline-into-fringe-p ()
211 (eq (nth 1 (posn-at-point)) 'right-fringe))
213 (defsubst vline-visual-p ()
214 (or (eq vline-visual 'force)
215 (and (not truncate-lines)
218 (defsubst vline-current-column ()
219 (if (or (not (vline-visual-p))
220 ;; margin for full-width char
221 (< (1+ (current-column)) (window-width)))
223 ;; hmm.. posn-at-point is not consider tab width.
229 (defsubst vline-move-to-column (col &optional bol-p)
230 (if (or (not (vline-visual-p))
231 ;; margin for full-width char
232 (< (1+ (current-column)) (window-width)))
236 (let ((bol-col (current-column)))
237 (- (move-to-column (+ bol-col col))
240 (defsubst vline-invisible-p (pos)
241 (let ((inv (get-char-property pos 'invisible)))
243 (or (eq buffer-invisibility-spec t)
244 (memq inv buffer-invisibility-spec)
245 (assq inv buffer-invisibility-spec)))))
247 (defsubst vline-forward (n)
248 (unless (memq n '(-1 0 1))
249 (error "n(%s) must be 0 or 1" n))
250 (if (not (vline-visual-p))
253 ;; take care of org-mode, outline-mode
254 (when (and (not (bobp))
255 (vline-invisible-p (1- (point))))
256 (goto-char (1- (point))))
257 (when (vline-invisible-p (point))
259 (while (and (not (bobp)) (vline-invisible-p (point)))
260 (goto-char (previous-char-property-change (point))))
261 (while (and (not (bobp)) (vline-invisible-p (point)))
262 (goto-char (next-char-property-change (point))))
264 (vertical-motion n)))
266 (defun vline-face (visual-p)
271 (defun vline-show (&optional point)
273 (save-window-excursion
277 (setq point (point)))
278 (let* ((column (vline-current-column))
279 (lcolumn (current-column))
281 (compose-p (memq vline-style '(compose mixed)))
282 (face-p (memq vline-style '(face mixed)))
283 (line-char (if compose-p vline-line-char ? ))
284 (line-str (make-string 1 line-char))
285 (visual-line-str line-str)
286 (in-fringe-p (vline-into-fringe-p)))
288 (setq line-str (propertize line-str 'face (vline-face nil)))
289 (setq visual-line-str (propertize visual-line-str 'face (vline-face t))))
290 (goto-char (window-end nil t))
292 (while (and (not in-fringe-p)
293 (< i (window-height))
294 (< i (length vline-overlay-table))
296 (let ((cur-column (vline-move-to-column column t))
297 (cur-lcolumn (current-column)))
298 ;; non-cursor line only (workaround of eol probrem.
299 (unless (= (point) point)
300 ;; if column over the cursor's column (when tab or wide char is appered.
301 (when (> cur-column column)
302 (let ((lcol (current-column)))
304 (setq cur-column (- cur-column (- lcol (current-column))))))
305 (let* ((ovr (aref vline-overlay-table i))
306 (visual-p (or (< lcolumn (current-column))
307 (> lcolumn (+ (current-column)
308 (- column cur-column)))))
309 ;; consider a newline, tab and wide char.
310 (str (concat (make-string (- column cur-column) ? )
311 (if visual-p visual-line-str line-str)))
313 ;; create overlay if not found.
315 (setq ovr (make-overlay 0 0))
316 (overlay-put ovr 'rear-nonsticky t)
317 (aset vline-overlay-table i ovr))
319 ;; initialize overlay.
320 (overlay-put ovr 'face nil)
321 (overlay-put ovr 'before-string nil)
322 (overlay-put ovr 'after-string nil)
323 (overlay-put ovr 'invisible nil)
324 (overlay-put ovr 'window
325 (if vline-current-window-only
331 ((memq char vline-multiwidth-space-list)
334 (make-string (- (save-excursion (forward-char)
339 (move-overlay ovr (point) (1+ (point)))
340 (overlay-put ovr 'invisible t)
341 (overlay-put ovr 'after-string str))
344 (move-overlay ovr (point) (point))
345 (overlay-put ovr 'after-string str)
346 ;; don't expand eol more than window width
347 (when (and (not truncate-lines)
348 (>= (1+ column) (window-width))
349 (>= column (vline-current-column))
350 (not (vline-into-fringe-p)))
351 (delete-overlay ovr)))
357 (setq str (compose-chars
359 (cond ((= (char-width char) 1)
361 ((= cur-column column)
367 (setq str (propertize str 'face (vline-face visual-p))))
368 (move-overlay ovr (point) (1+ (point)))
369 (overlay-put ovr 'invisible t)
370 (overlay-put ovr 'after-string str))))
372 (move-overlay ovr (point) (1+ (point)))
373 (overlay-put ovr 'face (vline-face visual-p))))))))
375 (vline-forward -1)))))))
379 ;;; vline.el ends here