351 lines
10 KiB
EmacsLisp
351 lines
10 KiB
EmacsLisp
|
;;; vline.el --- show vertical line (column highlighting) mode.
|
||
|
|
|
||
|
|
;; Copyright (C) 2002, 2008, 2009 by Taiki SUGAWARA <buzz.taiki@gmail.com>
|
||
|
|
|
||
|
|
;; Author: Taiki SUGAWARA <buzz.taiki@gmail.com>
|
||
|
|
;; Keywords: faces, editing, emulating
|
||
|
|
;; Version: 1.09
|
||
|
|
;; Time-stamp: <2009-10-12 16:55:13 UTC taiki>
|
||
|
|
;; URL: http://www.emacswiki.org/cgi-bin/wiki/vline.el
|
||
|
|
|
||
|
|
;; This file is free software; you can redistribute it and/or modify
|
||
|
|
;; it under the terms of the GNU General Public License as published by
|
||
|
|
;; the Free Software Foundation; either version 2, or (at your option)
|
||
|
|
;; any later version.
|
||
|
|
|
||
|
|
;; This file is distributed in the hope that it will be useful,
|
||
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||
|
|
;; GNU General Public License for more details.
|
||
|
|
|
||
|
|
;; You should have received a copy of the GNU General Public License
|
||
|
|
;; along with GNU Emacs; see the file COPYING. If not, write to
|
||
|
|
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
|
||
|
|
;; Boston, MA 02110-1301, USA.
|
||
|
|
|
||
|
|
;;; Usage
|
||
|
|
;; put followings your .emacs
|
||
|
|
;; (require 'vline)
|
||
|
|
;;
|
||
|
|
;; if you display a vertical line, type M-x vline-mode. `vline-mode' doesn't
|
||
|
|
;; effect other buffers, because it is a buffer local minor mode. if you hide
|
||
|
|
;; a vertical line, type M-x vline-mode again.
|
||
|
|
;;
|
||
|
|
;; if you display a vertical line in all buffers, type M-x vline-global-mode.
|
||
|
|
;;
|
||
|
|
;; `vline-style' provides a display style of vertical line. see
|
||
|
|
;; `vline-style' docstring.
|
||
|
|
;;
|
||
|
|
;; if you don't want to visual line highlighting (ex. for performance issue), please to set `vline-visual' to nil.
|
||
|
|
|
||
|
|
;;; Changes
|
||
|
|
;; 2009-08-26 taiki
|
||
|
|
;; support org-mode, outline-mode
|
||
|
|
|
||
|
|
;; 2009-08-18 taiki
|
||
|
|
;; add autoload cookies.
|
||
|
|
|
||
|
|
;; 2009-08-18 taiki
|
||
|
|
;; fix last line highlighting probrem.
|
||
|
|
|
||
|
|
;; 2009-08-18 taiki
|
||
|
|
;; support visual line highlighting.
|
||
|
|
;; - Added face vline-visual.
|
||
|
|
;; - Added defcustom vline-visual-face.
|
||
|
|
;; - Added defcustom vline-visual.
|
||
|
|
;;
|
||
|
|
;; 2009-08-17 taiki
|
||
|
|
;; fix continuas line problem.
|
||
|
|
;; - Don't display vline when cursor into fringe
|
||
|
|
;; - Don't expand eol more than window width.
|
||
|
|
;;
|
||
|
|
;; 2008-10-22 taiki
|
||
|
|
;; fix coding-system problem.
|
||
|
|
;; - Added vline-multiwidth-space-list
|
||
|
|
;; - Use ucs code-point for japanese fullwidth space.
|
||
|
|
;;
|
||
|
|
;; 2008-01-22 taiki
|
||
|
|
;; applied patch from Lennart Borgman
|
||
|
|
;; - Added :group 'vline
|
||
|
|
;; - Added defcustom vline-current-window-only
|
||
|
|
;; - Added header items to simplify for users
|
||
|
|
|
||
|
|
;;; TODO:
|
||
|
|
;; - track window-scroll-functions, window-size-change-functions.
|
||
|
|
;; - consider other minor modes (using {after,before}-string overlay).
|
||
|
|
;; - don't use {post,after}-command-hook for performance??
|
||
|
|
|
||
|
|
;;; Code:
|
||
|
|
|
||
|
|
(defvar vline-overlay-table-size 200)
|
||
|
|
(defvar vline-overlay-table (make-vector vline-overlay-table-size nil))
|
||
|
|
(defvar vline-line-char ?|)
|
||
|
|
(defvar vline-multiwidth-space-list
|
||
|
|
(list
|
||
|
|
?\t
|
||
|
|
(decode-char 'ucs #x3000) ; japanese fullwidth space
|
||
|
|
))
|
||
|
|
|
||
|
|
(defcustom vline-style 'face
|
||
|
|
"*This variable holds vertical line display style.
|
||
|
|
Available values are followings:
|
||
|
|
`face' : use face.
|
||
|
|
`compose' : use composit char.
|
||
|
|
`mixed' : use face and composit char."
|
||
|
|
:type '(radio
|
||
|
|
(const face)
|
||
|
|
(const compose)
|
||
|
|
(const mixed))
|
||
|
|
:group 'vline)
|
||
|
|
|
||
|
|
|
||
|
|
(defface vline
|
||
|
|
'((t (:background "light steel blue")))
|
||
|
|
"*A default face for vertical line highlighting."
|
||
|
|
:group 'vline)
|
||
|
|
|
||
|
|
(defface vline-visual
|
||
|
|
'((t (:background "gray90")))
|
||
|
|
"*A default face for vertical line highlighting in visual lines."
|
||
|
|
:group 'vline)
|
||
|
|
|
||
|
|
(defcustom vline-face 'vline
|
||
|
|
"*A face for vertical line highlighting."
|
||
|
|
:type 'face
|
||
|
|
:group 'vline)
|
||
|
|
|
||
|
|
(defcustom vline-visual-face 'vline-visual
|
||
|
|
"*A face for vertical line highlighting in visual lines."
|
||
|
|
:type 'face
|
||
|
|
:group 'vline)
|
||
|
|
|
||
|
|
(defcustom vline-current-window-only nil
|
||
|
|
"*If non-nil then show column in current window only.
|
||
|
|
If the buffer is shown in several windows then show column only
|
||
|
|
in the currently selected window."
|
||
|
|
:type 'boolean
|
||
|
|
:group 'vline)
|
||
|
|
|
||
|
|
(defcustom vline-visual t
|
||
|
|
"*If non-nil then show column in visual lines.
|
||
|
|
If you specified `force' then use force visual line highlighting even
|
||
|
|
if `truncate-lines' is non-nil."
|
||
|
|
:type '(radio
|
||
|
|
(const nil)
|
||
|
|
(const t)
|
||
|
|
(const force))
|
||
|
|
:group 'vline)
|
||
|
|
|
||
|
|
;;;###autoload
|
||
|
|
(define-minor-mode vline-mode
|
||
|
|
"Display vertical line mode."
|
||
|
|
:global nil
|
||
|
|
:lighter " VL"
|
||
|
|
:group 'vline
|
||
|
|
(if vline-mode
|
||
|
|
(progn
|
||
|
|
(add-hook 'pre-command-hook 'vline-pre-command-hook nil t)
|
||
|
|
(add-hook 'post-command-hook 'vline-post-command-hook nil t))
|
||
|
|
(vline-clear)
|
||
|
|
(remove-hook 'pre-command-hook 'vline-pre-command-hook t)
|
||
|
|
(remove-hook 'post-command-hook 'vline-post-command-hook t)))
|
||
|
|
|
||
|
|
;;;###autoload
|
||
|
|
(define-minor-mode vline-global-mode
|
||
|
|
"Display vertical line mode as globally."
|
||
|
|
:global t
|
||
|
|
:lighter " VL"
|
||
|
|
:group 'vline
|
||
|
|
(if vline-global-mode
|
||
|
|
(progn
|
||
|
|
(add-hook 'pre-command-hook 'vline-global-pre-command-hook)
|
||
|
|
(add-hook 'post-command-hook 'vline-global-post-command-hook))
|
||
|
|
(vline-clear)
|
||
|
|
(remove-hook 'pre-command-hook 'vline-global-pre-command-hook)
|
||
|
|
(remove-hook 'post-command-hook 'vline-global-post-command-hook)))
|
||
|
|
|
||
|
|
(defun vline-pre-command-hook ()
|
||
|
|
(when (and vline-mode (not (minibufferp)))
|
||
|
|
(vline-clear)))
|
||
|
|
|
||
|
|
(defun vline-post-command-hook ()
|
||
|
|
(when (and vline-mode (not (minibufferp)))
|
||
|
|
(vline-show)))
|
||
|
|
|
||
|
|
(defun vline-global-pre-command-hook ()
|
||
|
|
(when (and vline-global-mode (not (minibufferp)))
|
||
|
|
(vline-clear)))
|
||
|
|
|
||
|
|
(defun vline-global-post-command-hook ()
|
||
|
|
(when (and vline-global-mode (not (minibufferp)))
|
||
|
|
(vline-show)))
|
||
|
|
|
||
|
|
(defun vline-clear ()
|
||
|
|
(mapcar (lambda (ovr)
|
||
|
|
(and ovr (delete-overlay ovr)))
|
||
|
|
vline-overlay-table))
|
||
|
|
|
||
|
|
(defsubst vline-into-fringe-p ()
|
||
|
|
(eq (nth 1 (posn-at-point)) 'right-fringe))
|
||
|
|
|
||
|
|
(defsubst vline-visual-p ()
|
||
|
|
(or (eq vline-visual 'force)
|
||
|
|
(and (not truncate-lines)
|
||
|
|
vline-visual)))
|
||
|
|
|
||
|
|
(defsubst vline-current-column ()
|
||
|
|
(if (or (not (vline-visual-p))
|
||
|
|
;; margin for full-width char
|
||
|
|
(< (1+ (current-column)) (window-width)))
|
||
|
|
(current-column)
|
||
|
|
;; hmm.. posn-at-point is not consider tab width.
|
||
|
|
(- (current-column)
|
||
|
|
(save-excursion
|
||
|
|
(vertical-motion 0)
|
||
|
|
(current-column)))))
|
||
|
|
|
||
|
|
(defsubst vline-move-to-column (col &optional bol-p)
|
||
|
|
(if (or (not (vline-visual-p))
|
||
|
|
;; margin for full-width char
|
||
|
|
(< (1+ (current-column)) (window-width)))
|
||
|
|
(move-to-column col)
|
||
|
|
(unless bol-p
|
||
|
|
(vertical-motion 0))
|
||
|
|
(let ((bol-col (current-column)))
|
||
|
|
(- (move-to-column (+ bol-col col))
|
||
|
|
bol-col))))
|
||
|
|
|
||
|
|
(defsubst vline-forward (n)
|
||
|
|
(unless (memq n '(-1 0 1))
|
||
|
|
(error "n(%s) must be 0 or 1" n))
|
||
|
|
(if (not (vline-visual-p))
|
||
|
|
(progn
|
||
|
|
(forward-line n)
|
||
|
|
;; take care of org-mode, outline-mode
|
||
|
|
(when (and (not (bobp))
|
||
|
|
(invisible-p (1- (point))))
|
||
|
|
(goto-char (1- (point))))
|
||
|
|
(when (invisible-p (point))
|
||
|
|
(if (< n 0)
|
||
|
|
(while (and (not (bobp)) (invisible-p (point)))
|
||
|
|
(goto-char (previous-char-property-change (point))))
|
||
|
|
(while (and (not (bobp)) (invisible-p (point)))
|
||
|
|
(goto-char (next-char-property-change (point))))
|
||
|
|
(forward-line 1))))
|
||
|
|
(vertical-motion n)))
|
||
|
|
|
||
|
|
(defun vline-face (visual-p)
|
||
|
|
(if visual-p
|
||
|
|
vline-visual-face
|
||
|
|
vline-face))
|
||
|
|
|
||
|
|
(defun vline-show (&optional point)
|
||
|
|
(vline-clear)
|
||
|
|
(save-window-excursion
|
||
|
|
(save-excursion
|
||
|
|
(if point
|
||
|
|
(goto-char point)
|
||
|
|
(setq point (point)))
|
||
|
|
(let* ((column (vline-current-column))
|
||
|
|
(lcolumn (current-column))
|
||
|
|
(i 0)
|
||
|
|
(compose-p (memq vline-style '(compose mixed)))
|
||
|
|
(face-p (memq vline-style '(face mixed)))
|
||
|
|
(line-char (if compose-p vline-line-char ? ))
|
||
|
|
(line-str (make-string 1 line-char))
|
||
|
|
(visual-line-str line-str)
|
||
|
|
(in-fringe-p (vline-into-fringe-p)))
|
||
|
|
(when face-p
|
||
|
|
(setq line-str (propertize line-str 'face (vline-face nil)))
|
||
|
|
(setq visual-line-str (propertize visual-line-str 'face (vline-face t))))
|
||
|
|
(goto-char (window-end nil t))
|
||
|
|
(vline-forward 0)
|
||
|
|
(while (and (not in-fringe-p)
|
||
|
|
(< i (window-height))
|
||
|
|
(< i (length vline-overlay-table))
|
||
|
|
(not (bobp)))
|
||
|
|
(let ((cur-column (vline-move-to-column column t))
|
||
|
|
(cur-lcolumn (current-column)))
|
||
|
|
;; non-cursor line only (workaround of eol probrem.
|
||
|
|
(unless (= (point) point)
|
||
|
|
;; if column over the cursor's column (when tab or wide char is appered.
|
||
|
|
(when (> cur-column column)
|
||
|
|
(let ((lcol (current-column)))
|
||
|
|
(backward-char)
|
||
|
|
(setq cur-column (- cur-column (- lcol (current-column))))))
|
||
|
|
(let* ((ovr (aref vline-overlay-table i))
|
||
|
|
(visual-p (or (< lcolumn (current-column))
|
||
|
|
(> lcolumn (+ (current-column)
|
||
|
|
(- column cur-column)))))
|
||
|
|
;; consider a newline, tab and wide char.
|
||
|
|
(str (concat (make-string (- column cur-column) ? )
|
||
|
|
(if visual-p visual-line-str line-str)))
|
||
|
|
(char (char-after)))
|
||
|
|
;; create overlay if not found.
|
||
|
|
(unless ovr
|
||
|
|
(setq ovr (make-overlay 0 0))
|
||
|
|
(overlay-put ovr 'rear-nonsticky t)
|
||
|
|
(aset vline-overlay-table i ovr))
|
||
|
|
|
||
|
|
;; initialize overlay.
|
||
|
|
(overlay-put ovr 'face nil)
|
||
|
|
(overlay-put ovr 'before-string nil)
|
||
|
|
(overlay-put ovr 'after-string nil)
|
||
|
|
(overlay-put ovr 'invisible nil)
|
||
|
|
(overlay-put ovr 'window
|
||
|
|
(if vline-current-window-only
|
||
|
|
(selected-window)
|
||
|
|
nil))
|
||
|
|
|
||
|
|
(cond
|
||
|
|
;; multiwidth space
|
||
|
|
((memq char vline-multiwidth-space-list)
|
||
|
|
(setq str
|
||
|
|
(concat str
|
||
|
|
(make-string (- (save-excursion (forward-char)
|
||
|
|
(current-column))
|
||
|
|
(current-column)
|
||
|
|
(string-width str))
|
||
|
|
? )))
|
||
|
|
(move-overlay ovr (point) (1+ (point)))
|
||
|
|
(overlay-put ovr 'invisible t)
|
||
|
|
(overlay-put ovr 'after-string str))
|
||
|
|
;; eol
|
||
|
|
((eolp)
|
||
|
|
(move-overlay ovr (point) (point))
|
||
|
|
(overlay-put ovr 'after-string str)
|
||
|
|
;; don't expand eol more than window width
|
||
|
|
(when (and (not truncate-lines)
|
||
|
|
(>= (1+ column) (window-width))
|
||
|
|
(>= column (vline-current-column))
|
||
|
|
(not (vline-into-fringe-p)))
|
||
|
|
(delete-overlay ovr)))
|
||
|
|
(t
|
||
|
|
(cond
|
||
|
|
(compose-p
|
||
|
|
(let (str)
|
||
|
|
(when char
|
||
|
|
(setq str (compose-chars
|
||
|
|
char
|
||
|
|
(cond ((= (char-width char) 1)
|
||
|
|
'(tc . tc))
|
||
|
|
((= cur-column column)
|
||
|
|
'(tc . tr))
|
||
|
|
(t
|
||
|
|
'(tc . tl)))
|
||
|
|
line-char))
|
||
|
|
(when face-p
|
||
|
|
(setq str (propertize str 'face (vline-face visual-p))))
|
||
|
|
(move-overlay ovr (point) (1+ (point)))
|
||
|
|
(overlay-put ovr 'invisible t)
|
||
|
|
(overlay-put ovr 'after-string str))))
|
||
|
|
(face-p
|
||
|
|
(move-overlay ovr (point) (1+ (point)))
|
||
|
|
(overlay-put ovr 'face (vline-face visual-p))))))))
|
||
|
|
(setq i (1+ i))
|
||
|
|
(vline-forward -1)))))))
|
||
|
|
|
||
|
|
(provide 'vline)
|
||
|
|
|
||
|
|
;;; vline.el ends here
|