highlight current column and possibly line

[Drew Adams]

In September 2006, in thread "highlight current line when Emacs is idle", I
suggested code to highlight the current column and line. Here is code to do
that (below), for possible inclusion in Emacs now.

I added a mode analogous to `hl-line-mode', to highlight the current column.
It uses Rick Bielawski's library `column-marker.el', which I propose that we
add to Emacs, if Rick agrees. I've included Rick's library below also.

There is thus line highlighting code (`hl-line.el') and column highlighting
code. For each of these, I've also added code to highlight (line, column,
both) only when Emacs is idle, or only temporarily (flash), and I've added
"crosshairs" commands to combine line and column highlighting.

If others agree to add these features, and if Rick agrees to including
`column-marker.el' in Emacs, then my column-highlighting enhancements and
`hl-line.el' could be wrapped into a single library, or they could be in
separate libraries. If in the same library, it should have a different name
from `hl-line.el'. One argument for including them in the same library is
that the line, column, and crosshairs commands, functions, and variables all
follow the same model. Rick's `column-marker.el' should be a separate
library, because it has additional uses, besides serving as a base for
current-column highlighting.

The library below (`crosshairs.el') combines my column and crosshairs
highlighting code and my idle and temporary highlighting code. It does not
include Rick's `column-marker.el' code or the `hl-line.el' code - it
requires both. It assumes the enhancements to `hl-line.el' that I proposed
this morning in thread "highlight current line when Emacs is idle".

Regarding command prefixes: The library below combines two of my own
libraries, which each use a different command prefix: `col-highlight-' and
`crosshairs-'. Depending on what gets included in Emacs and how that is
packaged, we might want to change the prefixes. Currently, I have prefixes
`hl-line-', `col-highlight-', and `crosshairs-', and library
`column-marker.el' uses prefix `column-marker-'.

To try out this code:

1. Load the `hl-line.el' patched version I sent this morning.
2. Eval the `column-marker.el' code below.
3. Eval the `crosshairs.el' code below.
4. Try one of these bindings to test crosshairs highlighting:
   (global-set-key [(control ?+)] 'crosshairs-flash)
   (global-set-key [(control ?+)] 'crosshairs-mode)
5. Try this to test crosshairs highlighting when Emacs is idle:
   M-x toggle-crosshairs-when-idle
6. To try only line or column highlighting, do #4 or #5 with
   "hl-line" or "col-highlight" substituted for "crosshairs".

-------------------8<------------------------------------

;;; crosshairs.el --- Highlight the current line or column or both.
;;
;; Copyright (C) 2007 Free Software Foundation, Inc.
;;
;; Filename: crosshairs.el
;; Description: Highlight the current line or column or both.
;; Author: Drew Adams
;; Maintainer: FSF
;; Created: 2006-09-08
;; Keywords: faces, frames, emulation, highlight, cursor, accessibility

;; This file is part of GNU Emacs.

;; GNU Emacs 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.

;; GNU Emacs 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.

;;; Commentary:

;; This library provides a minor mode, `column-highlight-mode', to
;; continually highlight the current column in all buffers (until you
;; use this command again to toggle highlighting off).  When you move
;; the cursor, the highlighting follows (tracks the cursor).

;; In sum, `column-highlight-mode' does for the current column what
;; `hl-line-mode' does for the current line.  This library requires
;; libraries `hl-line.el' and `column-marker.el'.

;; This library also provides commands to turn on/off highlighting of
;; the current column whenever Emacs is idle
;; (`toggle-highlight-column-when-idle'), and to flash this column
;; highlighting temporarily (`flash-column-highlight').  These are
;; alternatives to leaving column highlighting on all the time.  They
;; help you locate the cursor with less distraction.

;; You can use both line and column highlighting at once, with the
;; analogous commands `crosshairs-mode',
;; `toggle-crosshairs-when-idle', and `crosshairs-flash'.

;; To use this library, put this in your Emacs init file (~/.emacs):
;;
;;     (require 'cross-hairs)

;;  To turn on automatic idle crosshairs or column highlighting, add
;;  one of these to your init file:
;;
;;     (toggle-crosshairs-when-idle 1)
;; or  (toggle-toggle-highlight-column-when-idle 1)

;; Note that whether you want to highlight the current line, column,
;; or both, there are two alternative handy ways to use a key for
;; temporary (flash) highlighting:
;;
;; * Bind one of the "flash" commands, and use it once.
;; * Bind one of the "mode commands, and use it twice in succession.
;;
;; For example:
;;
;;     (global-set-key [(control ?+)] 'crosshairs-flash)
;; or  (global-set-key [(control ?+)] 'crosshairs-mode)

;;; Code:

(require 'hl-line)
(require 'column-marker)

;;; Column highlighting

(defcustom col-highlight-period 1
  "Number of seconds to highlight the current column."
  :type 'integer :group 'cursor :group 'hl-line)

(defconst col-highlight-face 'col-highlight-face
    "Face used for temporarily highlighting current column.
Do NOT change this.")

(defface col-highlight-face
    '((((class color) (min-colors 88) (background light)) :background
"SlateGray3")
      (t :inherit highlight))
  "Face used for temporarily highlighting current column.
Usually a background color."
  :group 'faces)

(defvar col-highlight-idle-interval 5
  "Number of seconds to wait before highlighting current column.
Do NOT change this yourself to change the wait period; instead, use
`\\[col-highlight-set-interval]'.")

(defvar col-highlight-when-idle-p nil
  "Non-nil means highlight the current column whenever Emacs is idle.
Do NOT change this yourself; instead, use
`\\[toggle-highlight-column-when-idle]'.")

(defvar col-highlight-idle-timer
  (progn                                ; Cancel to prevent duplication.
    (when (boundp 'col-highlight-idle-timer) (cancel-timer
col-highlight-idle-timer))
    (run-with-idle-timer col-highlight-idle-interval t
'col-highlight-highlight))
  "Timer used to highlight current column whenever Emacs is idle.")

;; Turn it off, by default. Use `toggle-highlight-column-when-idle' to turn
it on.
(cancel-timer col-highlight-idle-timer)

;; Create the column marker.  This defines command and variable
`column-highlight'.
(column-marker-create column-highlight col-highlight-face)
(defalias 'highlight-column 'column-highlight)

(define-minor-mode column-highlight-mode
    "Toggle highlighting the current column.
With ARG, turn column highlighting on if and only if ARG is positive.

Column-Highlight mode uses the functions
`col-highlight-unhighlight' and `col-highlight-highlight'
on `pre-command-hook' and `post-command-hook'."
  :init-value nil :global t :group 'cursor :group 'hl-line :group 'frames
  (cond (column-highlight-mode
         (add-hook 'pre-command-hook #'col-highlight-unhighlight)
         (add-hook 'post-command-hook #'col-highlight-highlight))
        (t
         (col-highlight-unhighlight)
         (remove-hook 'pre-command-hook #'col-highlight-unhighlight)
         (remove-hook 'post-command-hook #'col-highlight-highlight))))

(defalias 'toggle-highlight-column-when-idle
'col-highlight-toggle-when-idle)
(defun col-highlight-toggle-when-idle (&optional arg)
"Turn on or off highlighting the current column when Emacs is idle.
With prefix argument, turn on if ARG > 0; else turn off."
  (interactive "P")
  (setq col-highlight-when-idle-p
        (if arg (> (prefix-numeric-value arg) 0) (not
col-highlight-when-idle-p)))
  (cond (col-highlight-when-idle-p
         (timer-activate-when-idle col-highlight-idle-timer)
         (add-hook 'pre-command-hook 'col-highlight-unhighlight)
         (message "Turned ON highlighting current column when Emacs is
idle."))
        (t
         (cancel-timer col-highlight-idle-timer)
         (remove-hook 'pre-command-hook 'col-highlight-unhighlight)
         (message "Turned OFF highlighting current column when Emacs is
idle."))))

(defun col-highlight-set-interval (secs)
  "Set wait until highlight current column when Emacs is idle.
Whenever Emacs is idle for this many seconds, the current column
will be highlighted in face `col-highlight-face'.

To turn on or off automatically highlighting the current column
when Emacs is idle, use `\\[toggle-highlight-column-when-idle]."
  (interactive
   "nSeconds to idle, before highlighting current column: ")
  (timer-set-idle-time col-highlight-idle-timer (setq
col-highlight-idle-interval secs) t))

(defalias 'flash-column-highlight 'col-highlight-flash)
(defun col-highlight-flash (&optional arg)
    "Highlight the current column for `col-highlight-period' seconds.
With a prefix argument, highlight for that many seconds."
    (interactive)
    (column-highlight-mode 1)
    (let ((column-period col-highlight-period))
      (when current-prefix-arg
        (setq column-period (prefix-numeric-value current-prefix-arg)))
      (run-at-time column-period nil #'column-highlight-mode -1)))

(defun col-highlight-highlight ()
  "Highlight current column."
  (column-highlight nil))

(defun col-highlight-unhighlight ()
  "Turn off highlighting of current column."
  (column-highlight '(4)))

;;; Crosshair highlighting (line + column)

(defvar crosshairs-highlight-when-idle-p nil
  "Non-nil means highlight current line and column when Emacs is idle.
Do NOT change this yourself; instead, use
`\\[toggle-crosshairs-when-idle]'.")

(define-minor-mode crosshairs-mode
    "Toggle highlighting the current line and column.
With ARG, turn highlighting on if and only if ARG is positive."
  :init-value nil :global t :group 'cursor :group 'hl-line :group 'frames
  (cond (crosshairs-mode
         (unless global-hl-line-mode
           (global-hl-line-mode 1)
           (global-hl-line-highlight))
         (column-highlight-mode 1))
        (t
         (global-hl-line-mode -1)
         (global-hl-line-unhighlight)
         (column-highlight-mode -1))))

(defalias 'toggle-crosshairs-when-idle 'crosshairs-toggle-when-idle)
(defun crosshairs-toggle-when-idle (&optional arg)
  "Toggle highlighting the current line and column when Emacs is idle.
With prefix argument, turn on if ARG > 0; else turn off."
  (interactive "P")
    (setq col-highlight-when-idle-p
          (if arg (> (prefix-numeric-value arg) 0) (not
col-highlight-when-idle-p)))
    (setq hl-line-when-idle-p col-highlight-when-idle-p)
    (cond (col-highlight-when-idle-p
           (timer-activate-when-idle col-highlight-idle-timer)
           (timer-activate-when-idle hl-line-idle-timer)
           (add-hook 'pre-command-hook 'col-highlight-unhighlight)
           (add-hook 'pre-command-hook 'hl-line-unhighlight-now)
           (message "Turned ON highlighting line and column when Emacs is
idle."))
          (t
           (cancel-timer col-highlight-idle-timer)
           (cancel-timer hl-line-idle-timer)
           (remove-hook 'pre-command-hook 'col-highlight-unhighlight)
           (remove-hook 'pre-command-hook 'hl-line-unhighlight-now)
           (message "Turned OFF highlighting line and column when Emacs is
idle."))))

(defalias 'flash-crosshairs 'crosshairs-flash)
(defun crosshairs-flash (&optional arg)
  "Highlight the current line and column temporarily.
Highlight the line for `line-show-period' and the column for
`column-show-period' seconds.  With a prefix argument, highlight
both for that many seconds."
  (interactive "P")
  (hl-line-highlight-now)
  (column-highlight-mode 1)
  (let ((line-period line-show-period)
        (column-period col-highlight-period))
    (when current-prefix-arg
      (setq line-period (prefix-numeric-value current-prefix-arg)
            column-period line-period))
    (run-at-time line-period nil #'hl-line-unhighlight-now)
    (run-at-time column-period nil #'column-highlight-mode -1)))

(provide 'crosshairs)

;;; crosshairs.el ends here


-------------------8<------------------------------------

;;; column-marker.el --- Highlight certain character columns
;;
;; Filename: column-marker.el
;; Description: Highlight certain character columns
;; Author: Rick Bielawski <address@hidden>
;; Maintainer: Rick Bielawski <address@hidden>
;; Created: Tue Nov 22 10:26:03 2005
;; Version:
;; Last-Updated: Fri Aug 18 17:42:04 2006 (-25200 Pacific Daylight Time)
;;           By: dradams
;;     Update #: 270
;; Keywords: tools convenience highlight
;; Compatibility: GNU Emacs 21, GNU Emacs 22
;;
;; Features that might be required by this library:
;;
;;   None
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Commentary:
;;
;; Highlights the background at a given character column.
;;
;; Commands `column-marker-1', `column-marker-2', and
;; `column-marker-3' each highlight a given column (using different
;; background colors, by default).
;;
;; - With no prefix argument, each highlights the current column
;;   (where the cursor is).
;;
;; - With a non-negative numeric prefix argument, each highlights that
;;   column.
;;
;; - With plain `C-u' (no number), each turns off its highlighting.
;;
;; - With `C-u C-u', each turns off all column highlighting.
;;
;; If two commands highlight the same column, the last-issued
;; highlighting command shadows the other - only the last-issued
;; highlighting is seen.  If that "topmost" highlighting is then
;; turned off, the other highlighting for that column then shows
;; through.
;;
;; Examples:
;;
;; M-x column-marker-1 highlights the column where the cursor is, in
;; `column-marker-1-face'.
;;
;; C-u 70 M-x column-marker-2 highlights column 70 in
;; `column-marker-2-face'.
;;
;; C-u 70 M-x column-marker-3 highlights column 70 in
;; `column-marker-3-face'.  The `column-marker-2-face' highlighting no
;; longer shows.
;;
;; C-u M-x column-marker-3 turns off highlighting for column-marker-3,
;; so `column-marker-2-face' highlighting shows again for column 70.
;;
;; C-u C-u M-x column-marker-1 (or -2 or -3) erases all column highlighting.
;;
;; These commands use `font-lock-fontify-buffer', so syntax
;; highlighting (`font-lock-mode') must be turned on.  There might be
;; a performance impact during refontification.
;;
;;
;; Installation: Place this file on your load path, and put this in
;; your init file (`.emacs'):
;;
;; (require 'column-marker)
;;
;; Other init file suggestions (examples):
;;
;; ;; Highlight column 80 in foo mode.
;; (add-hook foo-mode-hook (lambda () (interactive) (column-marker-1 80)))
;;
;; ;; Use `C-c m' interactively to highlight with `column-marker-1-face'.
;; (global-set-key [?\C-c ?m] 'column-marker-1)
;;
;;
;; Please report any bugs!
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Change log:
;;
;; 2006/08/18 dadams
;;     column-marker-create: Add newlines to doc-string sentences.
;; 2005/12/31 dadams
;;     column-marker-create: Add marker to column-marker-vars inside the
defun,
;;       so it is done in the right buffer, updating column-marker-vars
buffer-locally.
;;     column-marker-find: Corrected comment.  Changed or to progn for
clarity.
;; 2005/12/29 dadams
;;     Updated wrt new version of column-marker.el (multi-column
characters).
;;     Corrected stray occurrences of column-marker-here to column-marker-1.
;;     column-marker-vars: Added make-local-variable.
;;     column-marker-create: Changed positive to non-negative.
;;     column-marker-internal: Turn off marker when col is negative, not <
1.
;; 2005-12-29 RGB
;;     column-marker.el now supports multi-column characters.
;; 2005/11/21 dadams
;;     Combined static and dynamic.
;;     Use separate faces for each marker.  Different interactive spec.
;; 2005/10/19 RGB
;;     Initial release of column-marker.el.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; 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; see the file COPYING.  If not, write to
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
;; Floor, Boston, MA 02110-1301, USA.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Code:

;;;;;;;;;;;;;;;;;;;;;;


(defvar column-marker-1-face 'column-marker-1-face
    "Face used for a column marker.  Usually a background color.
Changing this directly affects only new markers.")

(defface column-marker-1-face '((t (:background "gray")))
  "Face used for a column marker.  Usually a background color."
  :group 'faces)

(defvar column-marker-2-face 'column-marker-2-face
    "Face used for a column marker.  Usually a background color.
Changing this directly affects only new markers." )

(defface column-marker-2-face '((t (:background "cyan3")))
  "Face used for a column marker.  Usually a background color."
  :group 'faces)

(defvar column-marker-3-face 'column-marker-3-face
    "Face used for a column marker.  Usually a background color.
Changing this directly affects only new markers." )

(defface column-marker-3-face '((t (:background "orchid3")))
  "Face used for a column marker.  Usually a background color."
  :group 'faces)

(defvar column-marker-vars nil
  "List of all internal column-marker variables")
(make-variable-buffer-local 'column-marker-vars) ; Buffer local in all
buffers.

(defmacro column-marker-create (var &optional face)
  "Define a column marker named %%colmark%%-VAR."
  (setq face (or face 'column-marker-1-face))
  `(progn
     ;; define context variable ,VAR so marker can be removed if desired
     (defvar ,var ()
       "Buffer local. Used internally to store column marker spec.")
     ;; context must be buffer local since font-lock is
     (make-variable-buffer-local ',var)
     ;; Define wrapper function named ,VAR to call `column-marker-internal'
     (defun ,var (arg)
       ,(concat "Highlight column with face `" (symbol-name face)
                "'.\nWith no prefix argument, highlight current column.\n"
                "With non-negative numeric prefix arg, highlight that column
number.\n"
                "With plain `C-u' (no number), turn off this column
marker.\n"
                "With `C-u C-u' or negative prefix arg, turn off all
column-marker highlighting.")
       (interactive "P")
       (unless (memq ',var column-marker-vars) (push ',var
column-marker-vars))
       (cond ((null arg)          ; Default: highlight current column.
              (column-marker-internal ',var (1+ (current-column)) ,face))
             ((consp arg)
              (if (= 4 (car arg))
                  (column-marker-internal ',var nil) ; `C-u': Remove this
column highlighting.
                (dolist (var column-marker-vars)
                  (column-marker-internal var nil)))) ; `C-u C-u': Remove
all column highlighting.
             ((and (integerp arg) (>= arg 0)) ; `C-u 70': Highlight that
column.
              (column-marker-internal ',var (1+ (prefix-numeric-value arg))
,face))
             (t           ; `C-u -40': Remove all column highlighting.
              (dolist (var column-marker-vars)
                (column-marker-internal var nil)))))))

(defun column-marker-find (col)
  "Creates a function to locate a character in column COL."
  `(lambda (end)
     (let* ((start (point)))
       (when (> end (point-max)) (setq end (point-max)))

       ;; Try to keep `move-to-column' from going backward, though it still
can.
       (unless (< (current-column) ,col) (forward-line 1))

       ;; Again, don't go backward.  Try to move to correct column.
       (when (< (current-column) ,col) (move-to-column ,col))

       ;; If not at target column, try to move to it.
       (while (and (< (current-column) ,col) (< (point) end)
                   (= 0 (+ (forward-line 1) (current-column)))) ; Should be
bol.
         (move-to-column ,col))

       ;; If at target column, not past end, and not prior to start,
       ;; then set match data and return t.  Otherwise go to start
       ;; and return nil.
       (if (and (= ,col (current-column)) (<= (point) end) (> (point)
start))
           (progn (set-match-data (list (1- (point)) (point))) t) ; Return
t.
         (goto-char start) nil))))      ; Return nil.

(defun column-marker-internal (sym col &optional face)
  "SYM is the symbol for holding the column marker context.
COL is the column in which a marker should be set.
FACE is the face to use for the marker.
Supplying nil or 0 for COL turns off the marker."
  (setq face (or face 'column-marker-1-face))
  (when (symbol-value sym)   ; Remove any previously set column marker
    (font-lock-remove-keywords nil (symbol-value sym))
    (set sym nil))
  (when (or (listp col) (< col 0)) (setq col nil)) ; Allow nonsense stuff to
turn off the marker
  (when col                             ; Generate a new column marker
    (set sym `((,(column-marker-find col) (0 ,face prepend t))))
    (font-lock-add-keywords nil (symbol-value sym) t))
  (font-lock-fontify-buffer))

;; If you need more markers you can create your own similarly.
;; All markers can be in use at once, and each is buffer-local,
;; so there is no good reason to define more unless you need more
;; markers in a single buffer.
(column-marker-create column-marker-1 column-marker-1-face)
(column-marker-create column-marker-2 column-marker-2-face)
(column-marker-create column-marker-3 column-marker-3-face)

;;;###autoload
(autoload 'column-marker-1 "column-marker" "Highlight a column." t)

;;;;;;;;;;;;;;;;;;

(provide 'column-marker)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; column-marker.el ends here