1 ;;; column-marker.el --- Highlight certain character columns
   2 ;; 
   3 ;; Filename: column-marker.el
   4 ;; Description: Highlight certain character columns
   5 ;; Author: Rick Bielawski <rbielaws@i1.net>
   6 ;; Maintainer: Rick Bielawski <rbielaws@i1.net>
   7 ;; Created: Tue Nov 22 10:26:03 2005
   8 ;; Version: 
   9 ;; Last-Updated: Fri Aug 18 17:42:04 2006 (-25200 Pacific Daylight Time)
  10 ;;           By: dradams
  11 ;;     Update #: 270
  12 ;; Keywords: tools convenience highlight
  13 ;; Compatibility: GNU Emacs 21, GNU Emacs 22
  14 ;; 
  15 ;; Features that might be required by this library:
  16 ;;
  17 ;;   None
  18 ;;
  19 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  20 ;; 
  21 ;;; Commentary: 
  22 ;; 
  23 ;; Highlights the background at a given character column.
  24 ;; 
  25 ;; Commands `column-marker-1', `column-marker-2', and
  26 ;; `column-marker-3' each highlight a given column (using different
  27 ;; background colors, by default).
  28 ;;
  29 ;; - With no prefix argument, each highlights the current column
  30 ;;   (where the cursor is).
  31 ;;
  32 ;; - With a non-negative numeric prefix argument, each highlights that
  33 ;;   column.
  34 ;;
  35 ;; - With plain `C-u' (no number), each turns off its highlighting.
  36 ;;
  37 ;; - With `C-u C-u', each turns off all column highlighting.
  38 ;;
  39 ;; If two commands highlight the same column, the last-issued
  40 ;; highlighting command shadows the other - only the last-issued
  41 ;; highlighting is seen.  If that "topmost" highlighting is then
  42 ;; turned off, the other highlighting for that column then shows
  43 ;; through.
  44 ;;
  45 ;; Examples:
  46 ;;
  47 ;; M-x column-marker-1 highlights the column where the cursor is, in
  48 ;; `column-marker-1-face'.
  49 ;;
  50 ;; C-u 70 M-x column-marker-2 highlights column 70 in
  51 ;; `column-marker-2-face'.
  52 ;;
  53 ;; C-u 70 M-x column-marker-3 highlights column 70 in
  54 ;; `column-marker-3-face'.  The `column-marker-2-face' highlighting no
  55 ;; longer shows.
  56 ;;
  57 ;; C-u M-x column-marker-3 turns off highlighting for column-marker-3,
  58 ;; so `column-marker-2-face' highlighting shows again for column 70.
  59 ;;
  60 ;; C-u C-u M-x column-marker-1 (or -2 or -3) erases all column highlighting.
  61 ;;
  62 ;; These commands use `font-lock-fontify-buffer', so syntax
  63 ;; highlighting (`font-lock-mode') must be turned on.  There might be
  64 ;; a performance impact during refontification.
  65 ;;
  66 ;;
  67 ;; Installation: Place this file on your load path, and put this in
  68 ;; your init file (`.emacs'):
  69 ;;
  70 ;; (require 'column-marker)
  71 ;;
  72 ;; Other init file suggestions (examples):
  73 ;;
  74 ;; ;; Highlight column 80 in foo mode.
  75 ;; (add-hook foo-mode-hook (lambda () (interactive) (column-marker-1 80)))
  76 ;;
  77 ;; ;; Use `C-c m' interactively to highlight with `column-marker-1-face'.
  78 ;; (global-set-key [?\C-c ?m] 'column-marker-1)
  79 ;;
  80 ;;
  81 ;; Please report any bugs!
  82 ;;
  83 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  84 ;; 
  85 ;;; Change log:
  86 ;; 
  87 ;; 2006/08/18 dadams
  88 ;;     column-marker-create: Add newlines to doc-string sentences.
  89 ;; 2005/12/31 dadams
  90 ;;     column-marker-create: Add marker to column-marker-vars inside the defun,
  91 ;;       so it is done in the right buffer, updating column-marker-vars buffer-locally.
  92 ;;     column-marker-find: Corrected comment.  Changed or to progn for clarity.
  93 ;; 2005/12/29 dadams
  94 ;;     Updated wrt new version of column-marker.el (mulit-column characters).
  95 ;;     Corrected stray occurrences of column-marker-here to column-marker-1.
  96 ;;     column-marker-vars: Added make-local-variable.
  97 ;;     column-marker-create: Changed positive to non-negative.
  98 ;;     column-marker-internal: Turn off marker when col is negative, not < 1.
  99 ;; 2005-12-29 RGB
 100 ;;     column-marker.el now supports multi-column characters.
 101 ;; 2005/11/21 dadams
 102 ;;     Combined static and dynamic. 
 103 ;;     Use separate faces for each marker.  Different interactive spec.
 104 ;; 2005/10/19 RGB
 105 ;;     Initial release of column-marker.el.
 106 ;;
 107 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 108 ;;
 109 ;; This program is free software; you can redistribute it and/or modify
 110 ;; it under the terms of the GNU General Public License as published by
 111 ;; the Free Software Foundation; either version 2, or (at your option)
 112 ;; any later version.
 113 
 114 ;; This program is distributed in the hope that it will be useful,
 115 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 116 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 117 ;; GNU General Public License for more details.
 118 
 119 ;; You should have received a copy of the GNU General Public License
 120 ;; along with this program; see the file COPYING.  If not, write to
 121 ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
 122 ;; Floor, Boston, MA 02110-1301, USA.
 123 ;;
 124 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 125 ;; 
 126 ;;; Code:
 127 
 128 ;;;;;;;;;;;;;;;;;;;;;;
 129 
 130 
 131 (defvar column-marker-1-face 'column-marker-1-face
 132     "Face used for a column marker.  Usually a background color.
 133 Changing this directly affects only new markers.")
 134 
 135 (defface column-marker-1-face '((t (:background "gray")))
 136   "Face used for a column marker.  Usually a background color."
 137   :group 'faces)
 138 
 139 (defvar column-marker-2-face 'column-marker-2-face
 140     "Face used for a column marker.  Usually a background color.
 141 Changing this directly affects only new markers." )
 142 
 143 (defface column-marker-2-face '((t (:background "cyan3")))
 144   "Face used for a column marker.  Usually a background color."
 145   :group 'faces)
 146 
 147 (defvar column-marker-3-face 'column-marker-3-face
 148     "Face used for a column marker.  Usually a background color.
 149 Changing this directly affects only new markers." )
 150 
 151 (defface column-marker-3-face '((t (:background "orchid3")))
 152   "Face used for a column marker.  Usually a background color."
 153   :group 'faces)
 154 
 155 (defvar column-marker-vars nil
 156   "List of all internal column-marker variables")
 157 (make-variable-buffer-local 'column-marker-vars) ; Buffer local in all buffers.
 158 
 159 (defmacro column-marker-create (var &optional face)
 160   "Define a column marker named %%colmark%%-VAR."
 161   (setq face (or face 'column-marker-1-face))
 162   `(progn
 163      ;; define context variable ,VAR so marker can be removed if desired
 164      (defvar ,var ()
 165        "Buffer local. Used internally to store column marker spec.")
 166      ;; context must be buffer local since font-lock is 
 167      (make-variable-buffer-local ',var)
 168      ;; Define wrapper function named ,VAR to call `column-marker-internal'
 169      (defun ,var (arg)
 170        ,(concat "Highlight column with face `" (symbol-name face)
 171                 "'.\nWith no prefix argument, highlight current column.\n"
 172                 "With non-negative numeric prefix arg, highlight that column number.\n"
 173                 "With plain `C-u' (no number), turn off this column marker.\n"
 174                 "With `C-u C-u' or negative prefix arg, turn off all column-marker highlighting.")
 175        (interactive "P")
 176        (unless (memq ',var column-marker-vars) (push ',var column-marker-vars))
 177        (cond ((null arg)          ; Default: highlight current column.
 178               (column-marker-internal ',var (1+ (current-column)) ,face))
 179              ((consp arg)
 180               (if (= 4 (car arg))
 181                   (column-marker-internal ',var nil) ; `C-u': Remove this column highlighting.
 182                 (dolist (var column-marker-vars)
 183                   (column-marker-internal var nil)))) ; `C-u C-u': Remove all column highlighting.
 184              ((and (integerp arg) (>= arg 0)) ; `C-u 70': Highlight that column.
 185               (column-marker-internal ',var (1+ (prefix-numeric-value arg)) ,face))
 186              (t           ; `C-u -40': Remove all column highlighting.
 187               (dolist (var column-marker-vars)
 188                 (column-marker-internal var nil)))))))
 189 
 190 (defun column-marker-find (col)
 191   "Creates a function to locate a character in column COL."
 192   `(lambda (end)
 193      (let* ((start (point)))
 194        (when (> end (point-max)) (setq end (point-max)))
 195 
 196        ;; Try to keep `move-to-column' from going backward, though it still can.
 197        (unless (< (current-column) ,col) (forward-line 1))
 198 
 199        ;; Again, don't go backward.  Try to move to correct column.
 200        (when (< (current-column) ,col) (move-to-column ,col))
 201 
 202        ;; If not at target column, try to move to it.
 203        (while (and (< (current-column) ,col) (< (point) end)
 204                    (= 0 (+ (forward-line 1) (current-column)))) ; Should be bol.
 205          (move-to-column ,col))
 206 
 207        ;; If at target column, not past end, and not prior to start,
 208        ;; then set match data and return t.  Otherwise go to start
 209        ;; and return nil.
 210        (if (and (= ,col (current-column)) (<= (point) end) (> (point) start))
 211            (progn (set-match-data (list (1- (point)) (point))) t) ; Return t.
 212          (goto-char start) nil))))      ; Return nil.
 213 
 214 (defun column-marker-internal (sym col &optional face)
 215   "SYM is the symbol for holding the column marker context.
 216 COL is the column in which a marker should be set.
 217 FACE is the face to use for the marker.
 218 Supplying nil or 0 for COL turns off the marker."
 219   (setq face (or face 'column-marker-1-face))
 220   (when (symbol-value sym)   ; Remove any previously set column marker
 221     (font-lock-remove-keywords nil (symbol-value sym))
 222     (set sym nil))
 223   (when (or (listp col) (< col 0)) (setq col nil)) ; Allow nonsense stuff to turn off the marker
 224   (when col                             ; Generate a new column marker
 225     (set sym `((,(column-marker-find col) (0 ,face prepend t))))
 226     (font-lock-add-keywords nil (symbol-value sym) t))
 227   (font-lock-fontify-buffer))
 228 
 229 ;; If you need more markers you can create your own similarly.
 230 ;; All markers can be in use at once, and each is buffer-local,
 231 ;; so there is no good reason to define more unless you need more
 232 ;; markers in a single buffer.
 233 (column-marker-create column-marker-1 column-marker-1-face)
 234 (column-marker-create column-marker-2 column-marker-2-face)
 235 (column-marker-create column-marker-3 column-marker-3-face)
 236 
 237 ;;;###autoload
 238 (autoload 'column-marker-1 "column-marker" "Highlight a column." t)
 239 
 240 ;;;;;;;;;;;;;;;;;;
 241 
 242 (provide 'column-marker)
 243 
 244 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 245 ;;; column-marker.el ends here