From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Masatake YAMATO Newsgroups: gmane.emacs.devel Subject: Re: highlight current line when Emacs is idle Date: Tue, 05 Sep 2006 16:15:01 +0900 (JST) Message-ID: <20060905.161501.201907546.jet@gyve.org> References: NNTP-Posting-Host: main.gmane.org Mime-Version: 1.0 Content-Type: Text/Plain; charset=us-ascii Content-Transfer-Encoding: 7bit X-Trace: sea.gmane.org 1157440544 11694 80.91.229.2 (5 Sep 2006 07:15:44 GMT) X-Complaints-To: usenet@sea.gmane.org NNTP-Posting-Date: Tue, 5 Sep 2006 07:15:44 +0000 (UTC) Cc: emacs-devel@gnu.org Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Tue Sep 05 09:15:42 2006 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([199.232.76.165]) by ciao.gmane.org with esmtp (Exim 4.43) id 1GKV9m-0001z1-7u for ged-emacs-devel@m.gmane.org; Tue, 05 Sep 2006 09:15:38 +0200 Original-Received: from localhost ([127.0.0.1] helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1GKV9l-0000eu-J3 for ged-emacs-devel@m.gmane.org; Tue, 05 Sep 2006 03:15:37 -0400 Original-Received: from mailman by lists.gnu.org with tmda-scanned (Exim 4.43) id 1GKV9Z-0000bC-4g for emacs-devel@gnu.org; Tue, 05 Sep 2006 03:15:25 -0400 Original-Received: from exim by lists.gnu.org with spam-scanned (Exim 4.43) id 1GKV9V-0000Wa-AD for emacs-devel@gnu.org; Tue, 05 Sep 2006 03:15:24 -0400 Original-Received: from [199.232.76.173] (helo=monty-python.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1GKV9U-0000WG-W7 for emacs-devel@gnu.org; Tue, 05 Sep 2006 03:15:21 -0400 Original-Received: from [66.187.233.31] (helo=mx1.redhat.com) by monty-python.gnu.org with esmtp (Exim 4.52) id 1GKVKB-0001m0-Ux for emacs-devel@gnu.org; Tue, 05 Sep 2006 03:26:24 -0400 Original-Received: from int-mx1.corp.redhat.com (int-mx1.corp.redhat.com [172.16.52.254]) by mx1.redhat.com (8.12.11.20060308/8.12.11) with ESMTP id k857FGhA001388; Tue, 5 Sep 2006 03:15:16 -0400 Original-Received: from pobox.tokyo.redhat.com (pobox.tokyo.redhat.com [172.16.33.225]) by int-mx1.corp.redhat.com (8.12.11.20060308/8.12.11) with ESMTP id k857FEIP017562; Tue, 5 Sep 2006 03:15:15 -0400 Original-Received: from localhost (dhcp92.tokyo.redhat.com [172.16.33.92]) by pobox.tokyo.redhat.com (8.12.8/8.12.8) with ESMTP id k857FCm0022079; Tue, 5 Sep 2006 16:15:13 +0900 Original-To: drew.adams@oracle.com In-Reply-To: X-Mailer: Mew version 4.2.53 on Emacs 22.0.51 / Mule 5.0 (SAKAKI) X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.5 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Original-Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.devel:59354 Archived-At: (I know we are in pretest stage.) > A follow-on to that follow-on: Perhaps optionally highlight the current > column as well. How about this one? ;;; hl-column.el --- highlight the current column ;; Copyright 2004 2005 Masatake YAMATO ;; ;; Author: Masatake YAMATO ;; Keywords: ;; X-URL: not distributed yet ;; This program 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 program 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 this program; if not, write to the Free Software ;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Commentary: ;; This is the column version of hl-line.el. ;; ;; Put this file into your load-path and the following into your ~/.emacs: ;; (require 'hl-column) ;; then ;; M-x hl-column-mode ;; ;; Next key binding is optional. ;; (define-key global-map "\C-x|" 'hl-column-highlight) ;; ;; TODO ;; - Stocking the overlays ;;; Code: (provide 'hl-column) (eval-when-compile (require 'cl)) ;;;;########################################################################## ;;;; User Options, Variables ;;;;########################################################################## (defgroup hl-column nil "Highlight the current column." :group 'editing) (defcustom hl-column-face 'highlight "Face with which to highlight the current column." :type 'face :group 'hl-column) (defcustom hl-column-string nil "String to indicate the current column." :type '(choice (const :tag "No overlay string" nil) (const :tag "Bar" "|") (string)) :group 'hl-column) (defcustom hl-column-accept-tab t "Highlight tab character or not. Generally tab character takes wider area than the other." :type 'boolean :group 'hl-column) ;;;;########################################################################## ;;;; Functions ;;;;########################################################################## ;; Requirement ;; line-number-at-pos ;; line-move-to-column (defun hl-column-highlight (&optional column) "Highlight the current columns." (interactive "P") (let* ((start-line (line-number-at-pos (window-start))) (end-line (line-number-at-pos (window-end))) (cc (if column (prefix-numeric-value column) (current-column))) (goal-column cc) (p (point)) l overlays overlay) (unwind-protect (progn (save-excursion (setq l (line-number-at-pos)) (while (<= start-line l) (when (and ;(not (zerop (current-column))) (or (eq cc (current-column)) (and (< cc (current-column)) (< 1 (char-width (char-before))) (prog1 t (goto-char (1- (point)))))) (or hl-column-accept-tab (not (eq (char-after) ?\t))) (not (eolp))) (setq overlay (make-overlay (point) (1+ (point))) overlays (cons overlay overlays)) (overlay-put overlay 'face hl-column-face) (when hl-column-string (overlay-put overlay 'display hl-column-string))) (condition-case nil (progn (previous-line 1) (setq l (line-number-at-pos))) (error (setq l (1- start-line))))) (goto-char p) (while (<= (line-number-at-pos) end-line) (line-move-to-column cc) ;(move-to-column cc t) (when (and ;(not (zerop (current-column))) (or (eq cc (current-column)) (and (< cc (current-column)) (< 1 (char-width (char-before))) (prog1 t (goto-char (1- (point)))))) (not (eq (char-after) ?\t)) (not (eolp))) (setq overlay (make-overlay (point) (1+ (point))) overlays (cons overlay overlays)) (overlay-put overlay 'face hl-column-face) (when hl-column-string (overlay-put overlay 'display hl-column-string))) (when (or (< 0 (forward-line 1)) (eobp)) (setq end-line -1)))) (sit-for 99999)) (mapc (lambda (o) (delete-overlay o)) overlays)))) (define-minor-mode hl-column-mode "Buffer-local minor mode to highlight the column about point." nil nil nil :group 'hl-column-mode (if hl-column-mode (add-hook 'post-command-hook 'hl-column-highlight nil t) (remove-hook 'post-command-hook 'hl-column-highlight t))) ;; arch-tag: 8d30b572-81a8-4b7b-acb5-d2f8a03ae6bf ;;; hl-column.el ends here