diff options
Diffstat (limited to 'emacs.d/nxhtml/util/vline.el')
| -rw-r--r-- | emacs.d/nxhtml/util/vline.el | 350 |
1 files changed, 350 insertions, 0 deletions
diff --git a/emacs.d/nxhtml/util/vline.el b/emacs.d/nxhtml/util/vline.el new file mode 100644 index 0000000..62bc8dd --- /dev/null +++ b/emacs.d/nxhtml/util/vline.el @@ -0,0 +1,350 @@ +;;; 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 |