My personal dotfiles
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

column-marker.el 10KB

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