New org capture template
[emacs.git] / .emacs.d / elisp / icicle / col-highlight.el
1 ;;; col-highlight.el --- Highlight the current column.
2 ;;
3 ;; Filename: col-highlight.el
4 ;; Description: Highlight the current column.
5 ;; Author: Drew Adams
6 ;; Maintainer: Drew Adams (concat "drew.adams" "@" "oracle" ".com")
7 ;; Copyright (C) 2006-2014, Drew Adams, all rights reserved.
8 ;; Created: Fri Sep 08 11:06:35 2006
9 ;; Version: 0
10 ;; Package-Requires: ((vline "0"))
11 ;; Last-Updated: Thu Dec 26 08:51:27 2013 (-0800)
12 ;; By: dradams
13 ;; Update #: 420
14 ;; URL: http://www.emacswiki.org/cgi-bin/wiki/col-highlight.el
15 ;; Doc URL: http://emacswiki.org/emacs/HighlightCurrentColumn
16 ;; Keywords: faces, frames, emulation, highlight, cursor, accessibility
17 ;; Compatibility: GNU Emacs: 22.x, 23.x
18 ;;
19 ;; Features that might be required by this library:
20 ;;
21 ;; `vline'.
22 ;;
23 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
24 ;;
25 ;;; Commentary:
26 ;;
27 ;; This library highlights the current column. When you move the
28 ;; cursor, the highlighting follows (tracks the cursor), as long as
29 ;; the highlighting stays on.
30 ;;
31 ;; Command `column-highlight-mode' toggles this highlighting on and
32 ;; off.
33 ;;
34 ;; If you use `column-highlight-mode' twice in succession (I bind it
35 ;; to `C-+'), you can flash the highlighting to show you the current
36 ;; column temporarily. An alternative way to flash-highlight is to
37 ;; use command `flash-column-highlight' (once). It shows the
38 ;; highlighting for just a second or two (see option
39 ;; `col-highlight-period').
40 ;;
41 ;; You can also have current-column highlighting come on
42 ;; automatically, when Emacs is idle. Command
43 ;; `toggle-highlight-column-when-idle' toggles this mode. Command
44 ;; `col-highlight-set-interval' changes the number of idle seconds to
45 ;; wait before highlighting.
46 ;;
47 ;; You can use option `col-highlight-overlay-priority' to make the
48 ;; vline (i.e., column) highlighting appear on top of other overlay
49 ;; highlighting that might exist.
50 ;;
51 ;; You can use option `col-highlight-show-only' to restrict
52 ;; current-column highlighting to a section of text of a particular
53 ;; kind: paragaph, sentence, page, defun, etc.
54 ;;
55 ;;
56 ;; To use this file, you must also have library `vline.el'.
57 ;; Put this in your Emacs init file (~/.emacs):
58 ;;
59 ;; (require 'col-highlight) ; Load this file (and `vline')
60 ;;
61 ;; If you want to turn on continual current-column highlighting by
62 ;; default, then add this to your init file:
63 ;;
64 ;; (column-highlight-mode 1)
65 ;;
66 ;; If you want to turn on automatic idle highlighting of the current
67 ;; column, then add this to your init file:
68 ;;
69 ;; (toggle-highlight-column-when-idle 1)
70 ;;
71 ;; If you want to use a different wait interval, before idle
72 ;; highlighting begins, then set it in your init file using
73 ;; `col-highlight-set-interval':
74 ;;
75 ;; (col-highlight-set-interval 6) ; Wait 6 idle secs.
76 ;;
77 ;; Note that `column-highlight-mode' is intentionally a global minor
78 ;; mode. If you want a local minor mode, so that highlighting
79 ;; affects only a particular buffer, you can use `vline-mode' (in
80 ;; `vline.el').
81 ;;
82 ;;
83 ;; See also:
84 ;;
85 ;; * Library `hl-line+.el', which offers the same functionality, but
86 ;; for the current line instead of the current column.
87 ;;
88 ;; * Library `crosshairs.el', which combines the features of
89 ;; `col-highlight.el' and `hl-line+.el', providing a crosshair
90 ;; highlighting effect. It requires `col-highlight.el' and
91 ;; `hl-line+.el'.
92 ;;
93 ;; * Library `cursor-chg.el' or library `oneonone.el', to change the
94 ;; cursor type when Emacs is idle.
95 ;;
96 ;; User options defined here:
97 ;;
98 ;; `col-highlight-period', `column-highlight-mode',
99 ;; `col-highlight-overlay-priority', `col-highlight-show-only',
100 ;; `col-highlight-vline-face-flag'.
101 ;;
102 ;; Faces defined here:
103 ;;
104 ;; `col-highlight'.
105 ;;
106 ;; Commands defined here:
107 ;;
108 ;; `col-highlight-flash', `col-highlight-set-interval',
109 ;; `col-highlight-toggle-when-idle', `column-highlight-mode',
110 ;; `flash-column-highlight', `toggle-highlight-column-when-idle'.
111 ;;
112 ;; Non-interactive functions defined here:
113 ;;
114 ;; `col-highlight-highlight', `col-highlight-unhighlight'.
115 ;;
116 ;; Internal variables defined here:
117 ;;
118 ;; `col-highlight-face', `col-highlight-idle-interval',
119 ;; `col-highlight-idle-timer', `col-highlight-when-idle-p'.
120 ;;
121 ;;
122 ;; ***** NOTE: The following function defined in `vline.el' has
123 ;; been REDEFINED HERE:
124 ;;
125 ;; `vline-show' - Respect options `col-highlight-overlay-priority'
126 ;; and `col-highlight-show-only'.
127 ;;
128 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
129 ;;
130 ;;; Change Log:
131 ;;
132 ;; 2013/08/08 dadams
133 ;; Added: col-highlight-show-only, redefinition of vline-show.
134 ;; Removed defadvice of vline-show (replaced by redefinition).
135 ;; 2012/12/25 dadams
136 ;; Added Package-Requires.
137 ;; 2012/05/18 dadams
138 ;; Added: col-highlight-overlay-priority, defadvice of vline-show.
139 ;; 2011/01/03 dadams
140 ;; Added autoload cookies for defgroup, defcustom, defface, and commands.
141 ;; 2008/09/03 dadams
142 ;; col-highlight-highlight: Bind vline-current-window-only to t.
143 ;; 2008/08/08 dadams
144 ;; col-highlight-(un)highlight: Added optional arg.
145 ;; 2008/01/21 dadams
146 ;; Use vline.el instead of column-marker.el.
147 ;; Added: group column-highlight, option col-highlight-vline-face-flag.
148 ;; col-highlight-toggle-when-idle: col-highlight-unhighlight when turn off.
149 ;; col-highlight-flash: Use col-highlight-highlight, not mode.
150 ;; col-highlight-(un)highlight: Respect col-highlight-vline-face-flag.
151 ;; Don't highlight minibuffer.
152 ;; Renamed: face col-highlight-face to col-highlight.
153 ;; Removed semi-support for Emacs 20.
154 ;; 2006/09/08 dadams
155 ;; Created.
156 ;;
157 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
158 ;;
159 ;; This program is free software; you can redistribute it and/or
160 ;; modify it under the terms of the GNU General Public License as
161 ;; published by the Free Software Foundation; either version 3, or
162 ;; (at your option) any later version.
163 ;;
164 ;; This program is distributed in the hope that it will be useful,
165 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
166 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
167 ;; General Public License for more details.
168 ;;
169 ;; You should have received a copy of the GNU General Public License
170 ;; along with this program; see the file COPYING. If not, write to
171 ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
172 ;; Floor, Boston, MA 02110-1301, USA.
173 ;;
174 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
175 ;;
176 ;;; Code:
177
178 (require 'vline)
179
180 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
181
182
183 ;;;###autoload
184 (defgroup column-highlight nil
185 "Highlight the current column."
186 :prefix "col-highlight-"
187 :group 'editing :group 'cursor :group 'hl-line :group 'frames
188 :link `(url-link :tag "Send Bug Report"
189 ,(concat "mailto:" "drew.adams" "@" "oracle" ".com?subject=\
190 col-highlight.el bug: \
191 &body=Describe bug here, starting with `emacs -q'. \
192 Don't forget to mention your Emacs and library versions."))
193 :link '(url-link :tag "Other Libraries by Drew"
194 "http://www.emacswiki.org/cgi-bin/wiki/DrewsElispLibraries")
195 :link '(url-link :tag "Download"
196 "http://www.emacswiki.org/cgi-bin/wiki/col-highlight.el"))
197
198 ;;;###autoload
199 (defcustom col-highlight-show-only nil
200 "Non-nil means `column-highlight-mode' affects only a section of text.
201 This affects `vline-mode' also.
202
203 The non-nil value determines the type of text section: paragraph,
204 sentence, defun, page...
205
206 The actual non-nil value is a forward movement command for the given
207 section type, e.g., `forward-paragraph', `end-of-defun'."
208 :type '(choice
209 (const :tag "All text" nil)
210 (const :tag "Paragraph" forward-paragraph)
211 (const :tag "Sentence" forward-sentence)
212 (const :tag "Page" forward-page)
213 (const :tag "Defun" end-of-defun)
214 (function :tag "Forward-thing function" :value forward-paragraph))
215 :group 'column-highlight)
216
217 ;;;###autoload
218 (defcustom col-highlight-vline-face-flag t
219 "*Non-nil means `column-highlight-mode' uses `col-highlight-face'.
220 nil means that it uses `vline-face'."
221 :type 'boolean :group 'column-highlight)
222
223 ;;;###autoload
224 (defcustom col-highlight-period 1
225 "*Number of seconds to highlight the current column."
226 :type 'integer :group 'column-highlight)
227
228 ;;;###autoload
229 (defcustom col-highlight-overlay-priority 300
230 "*Priority to use for overlays in `vline-overlay-table'.
231 A higher priority can make the vline highlighting appear on top of
232 other overlays that might exist."
233 :type '(choice
234 (const :tag "No priority (default priority)" nil)
235 (integer :tag "Priority" 300))
236 :group 'column-highlight)
237
238 ;;;###autoload
239 (defface col-highlight '((t (:background "SlateGray3")))
240 "*Face for current-column highlighting by `column-highlight-mode'.
241 Not used if `col-highlight-vline-face-flag' is nil."
242 :group 'column-highlight :group 'faces)
243
244 (defvar col-highlight-face 'col-highlight
245 "Face used for highlighting current column.
246 Do NOT change this.")
247
248 (defvar col-highlight-idle-interval 5
249 "Number of seconds to wait before highlighting current column.
250 Do NOT change this yourself to change the wait period; instead, use
251 `\\[col-highlight-set-interval]'.")
252
253 (defvar col-highlight-when-idle-p nil
254 "Non-nil means highlight the current column whenever Emacs is idle.
255 Do NOT change this yourself; instead, use
256 `\\[toggle-highlight-column-when-idle]'.")
257
258 (defvar col-highlight-idle-timer
259 (progn ; Cancel to prevent duplication.
260 (when (boundp 'col-highlight-idle-timer)
261 (cancel-timer col-highlight-idle-timer))
262 (run-with-idle-timer col-highlight-idle-interval t 'col-highlight-highlight))
263 "Timer used to highlight current column whenever Emacs is idle.")
264
265 ;; Turn it off, by default.
266 ;; You must use `toggle-highlight-column-when-idle' to turn it on.
267 (cancel-timer col-highlight-idle-timer)
268
269
270
271 ;; REPLACE ORIGINAL `vline-show' defined in `vline.el'.
272 ;;
273 ;; Respect options `col-highlight-overlay-priority' and `col-highlight-show-only'.
274 ;;
275 (defun vline-show (&optional point)
276 (vline-clear)
277 (save-window-excursion
278 (save-excursion
279 (if point
280 (goto-char point)
281 (setq point (point)))
282 (let* ((column (vline-current-column))
283 (lcolumn (current-column))
284 (i 0)
285 (compose-p (memq vline-style '(compose mixed)))
286 (face-p (memq vline-style '(face mixed)))
287 (line-char (if compose-p vline-line-char ?\ ))
288 (line-str (make-string 1 line-char))
289 (visual-line-str line-str)
290 (in-fringe-p (vline-into-fringe-p))
291 (only-beg (and col-highlight-show-only
292 (condition-case nil
293 (save-excursion
294 (funcall col-highlight-show-only -1)
295 (point))
296 (error nil))))
297 (only-end (and col-highlight-show-only
298 (condition-case nil
299 (save-excursion
300 (funcall col-highlight-show-only 1)
301 (point))
302 (error nil)))))
303 (when face-p
304 (setq line-str (propertize line-str 'face (vline-face nil)))
305 (setq visual-line-str (propertize visual-line-str 'face (vline-face t))))
306 (goto-char (window-end nil t))
307 (vline-forward 0)
308 (while (and (not (bobp))
309 (not in-fringe-p)
310 (< i (window-height))
311 (< i (length vline-overlay-table)))
312 (let ((cur-column (vline-move-to-column column t))
313 (cur-lcolumn (current-column)))
314 (unless (or (= (point) point) ; Non-cursor line only (eol workaround).
315 (and only-beg only-end (or (<= (point) only-beg)
316 (>= (point) only-end))))
317 (when (> cur-column column)
318 (let ((lcol (current-column)))
319 (backward-char)
320 (setq cur-column (- cur-column (- lcol (current-column))))))
321 (let* ((ovr (aref vline-overlay-table i))
322 (visual-p (or (< lcolumn (current-column))
323 (> lcolumn (+ (current-column)
324 (- column cur-column)))))
325 ;; Consider a newline, tab and wide char.
326 (str (concat (make-string (- column cur-column) ?\ )
327 (if visual-p visual-line-str line-str)))
328 (char (char-after)))
329 (unless ovr
330 (setq ovr (make-overlay 0 0))
331 (overlay-put ovr 'rear-nonsticky t)
332 (aset vline-overlay-table i ovr))
333 (overlay-put ovr 'face nil)
334 (overlay-put ovr 'before-string nil)
335 (overlay-put ovr 'after-string nil)
336 (overlay-put ovr 'invisible nil)
337 (overlay-put ovr 'window (and vline-current-window-only (selected-window)))
338 (cond ((memq char vline-multiwidth-space-list) ; Multiwidth space
339 (setq str (concat str (make-string (- (save-excursion (forward-char)
340 (current-column))
341 (current-column)
342 (string-width str))
343 ?\ )))
344 (move-overlay ovr (point) (1+ (point)))
345 (overlay-put ovr 'invisible t)
346 (overlay-put ovr 'after-string str))
347 ((eolp)
348 (move-overlay ovr (point) (point))
349 (overlay-put ovr 'after-string str)
350 (when (and (not truncate-lines) ; Do not expand more than window width.
351 (>= (1+ column) (window-width))
352 (>= column (vline-current-column))
353 (not (vline-into-fringe-p)))
354 (delete-overlay ovr)))
355 (t
356 (cond (compose-p
357 (let (str)
358 (when char
359 (setq str (compose-chars char
360 (cond ((= (char-width char) 1)
361 '(tc . tc))
362 ((= cur-column column)
363 '(tc . tr))
364 (t
365 '(tc . tl)))
366 line-char))
367 (when face-p
368 (setq str (propertize str 'face (vline-face visual-p))))
369 (move-overlay ovr (point) (1+ (point)))
370 (overlay-put ovr 'invisible t)
371 (overlay-put ovr 'after-string str))))
372 (face-p
373 (move-overlay ovr (point) (1+ (point)))
374 (overlay-put ovr 'face (vline-face visual-p))))))))
375 (setq i (1+ i))
376 (vline-forward -1))))))
377 (mapc (lambda (ov) (when (overlayp ov) ; Set overlay priority to `col-highlight-overlay-priority'.
378 (overlay-put ov 'priority col-highlight-overlay-priority)))
379 vline-overlay-table))
380
381 ;;;###autoload
382 (define-minor-mode column-highlight-mode
383 "Toggle highlighting the current column.
384 With ARG, turn column highlighting on if and only if ARG is positive.
385
386 Column-Highlight mode uses the functions
387 `col-highlight-unhighlight' and `col-highlight-highlight'
388 on `pre-command-hook' and `post-command-hook'."
389 :init-value nil :global t :group 'column-highlight
390 :link `(url-link :tag "Send Bug Report"
391 ,(concat "mailto:" "drew.adams" "@" "oracle" ".com?subject=\
392 col-highlight.el bug: \
393 &body=Describe bug here, starting with `emacs -q'. \
394 Don't forget to mention your Emacs and library versions."))
395 :link '(url-link :tag "Other Libraries by Drew"
396 "http://www.emacswiki.org/cgi-bin/wiki/DrewsElispLibraries")
397 :link '(url-link :tag
398 "Download" "http://www.emacswiki.org/cgi-bin/wiki/col-highlight.el")
399 :link '(url-link :tag "Description"
400 "http://www.emacswiki.org/cgi-bin/wiki/ChangingCursorDynamically")
401 :link '(emacs-commentary-link :tag "Commentary" "col-highlight")
402 (cond (column-highlight-mode
403 (add-hook 'pre-command-hook #'col-highlight-unhighlight)
404 (add-hook 'post-command-hook #'col-highlight-highlight))
405 (t
406 (col-highlight-unhighlight)
407 (remove-hook 'pre-command-hook #'col-highlight-unhighlight)
408 (remove-hook 'post-command-hook #'col-highlight-highlight))))
409
410 ;;;###autoload
411 (defalias 'toggle-highlight-column-when-idle 'col-highlight-toggle-when-idle)
412 ;;;###autoload
413 (defun col-highlight-toggle-when-idle (&optional arg)
414 "Turn on or off highlighting the current column when Emacs is idle.
415 With prefix argument, turn on if ARG > 0; else turn off."
416 (interactive "P")
417 (setq col-highlight-when-idle-p (if arg
418 (> (prefix-numeric-value arg) 0)
419 (not col-highlight-when-idle-p)))
420 (cond (col-highlight-when-idle-p
421 (timer-activate-when-idle col-highlight-idle-timer)
422 (add-hook 'pre-command-hook #'col-highlight-unhighlight)
423 (message "Turned ON highlighting current column when Emacs is idle."))
424 (t
425 (cancel-timer col-highlight-idle-timer)
426 (col-highlight-unhighlight)
427 (remove-hook 'pre-command-hook #'col-highlight-unhighlight)
428 (message "Turned OFF highlighting current column when Emacs is idle."))))
429
430 ;;;###autoload
431 (defun col-highlight-set-interval (n)
432 "Set the delay before highlighting current column when Emacs is idle.
433 Whenever Emacs has been idle for N seconds, the current column is
434 highlighted using the face that is the value of variable
435 `col-highlight-face'.
436
437 To turn on or off automatically highlighting the current column
438 when Emacs is idle, use `\\[toggle-highlight-column-when-idle]."
439 (interactive
440 "nSeconds to idle, before highlighting current column: ")
441 (timer-set-idle-time col-highlight-idle-timer
442 (setq col-highlight-idle-interval n)
443 t))
444
445 ;;;###autoload
446 (defalias 'flash-column-highlight 'col-highlight-flash)
447 ;;;###autoload
448 (defun col-highlight-flash (&optional arg)
449 "Highlight the current column for `col-highlight-period' seconds.
450 With a prefix ARG, highlight for that many seconds."
451 (interactive)
452 (col-highlight-highlight)
453 (let ((column-period col-highlight-period))
454 (when current-prefix-arg
455 (setq column-period (prefix-numeric-value current-prefix-arg)))
456 (run-at-time column-period nil #'col-highlight-unhighlight)))
457
458 (defun col-highlight-highlight (&optional minibuffer-also-p)
459 "Highlight current column.
460 This has no effect in the minibuffer, unless optional arg
461 MINIBUFFER-ALSO-P is non-nil."
462 (unless (and (minibufferp) (not minibuffer-also-p))
463 (let ((vline-current-window-only t))
464 (if col-highlight-vline-face-flag
465 (let ((vline-style 'face)
466 (vline-face col-highlight-face))
467 (vline-show))
468 (vline-show)))))
469
470 (defun col-highlight-unhighlight (&optional minibuffer-also-p)
471 "Turn off highlighting of current column.
472 This has no effect in the minibuffer, unless optional arg
473 MINIBUFFER-ALSO-P is non-nil."
474 (unless (and (minibufferp) (not minibuffer-also-p))
475 (if col-highlight-vline-face-flag
476 (let ((vline-style 'face)
477 (vline-face col-highlight-face))
478 (vline-clear))
479 (vline-clear))))
480
481 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
482
483 (provide 'col-highlight)
484
485 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
486 ;;; col-highlight.el ends here