-
Notifications
You must be signed in to change notification settings - Fork 0
/
ar-thingatpt-highlight.el
140 lines (109 loc) · 4.84 KB
/
ar-thingatpt-highlight.el
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
;;; ar-thingatpt-highlight.el --- th-at-point edit functions -*- lexical-binding: t; -*-
;; Copyright (C) 2010-2024 Andreas Röhler, unless
;; indicated otherwise
;; Author: Andreas Röhler <[email protected]>, unless
;; indicated otherwise
;; Version: 0.1
;; Keywords: convenience
;; This file 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 file 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:
;;; Code:
(require 'ar-thingatpt-utils-core)
(require 'ar-thingatpt-basic-definitions)
;;; highlight-thing stuff
;; Basicely inspired by `highlight-current-line.el'. Please
;; visit
;; http://www.emacswiki.org/emacs-en/HighlightCurrentLine
;; to get the credits.
(defgroup highlight-thing nil
"Highlight thing where the cursor is in."
:load 'highlight-thing
:group 'faces)
(defface highlight-thing-face
'((t (:background "grey50")))
"Face used to highlight current line."
:group 'highlight-thing)
(defvar highlight-thing-minor-mode nil
"Non-nil if using highlight-thing mode as a minor mode.")
(make-variable-buffer-local 'highlight-thing-minor-mode)
(defvar highlight-thing-overlay
(make-overlay 1 1)
"Overlay for highlighting.")
(overlay-put highlight-thing-overlay
'face 'highlight-thing-face)
(defvar highlight-thing-beg-function nil)
(defvar highlight-thing-end-function nil)
;; (setq highlight-thing-beg-function 'ar-word-beginning-position-atpt)
;; (setq highlight-thing-end-function 'ar-word-end-position-atpt)
(defun ar-th-highlight (thing &optional arg)
(setq highlight-thing-beg-function (intern-soft (concat "ar-" (format "%s" thing) "-beginning-position-atpt")))
(setq highlight-thing-end-function (intern-soft (concat "ar-" (format "%s" thing) "-end-position-atpt")))
(highlight-thing-minor-mode))
(defun highlight-thing-hook ()
(let ((beg (funcall highlight-thing-beg-function))
(end (funcall highlight-thing-end-function)))
(highlight-thing-hook-intern beg end nil)))
(defun highlight-thing-hook-intern (beg end &optional arg)
"Post-Command-Hook for highlighting."
(condition-case ()
(if highlight-thing-minor-mode
(let ((arg (or arg 0)))
(move-overlay highlight-thing-overlay
beg end (current-buffer))))
(error nil)))
(defconst highlight-thing-no-color (if (boundp 'xemacs-logo)
'[]
nil)
"'color' value that represents \"no color\".")
;; Compatibility code - Set highlight-foregroundcolor.
(defun highlight-thing-set-fg-color (color)
"Set foregroundcolor for highlighting cursor-word to COLOR.
Key: \\[highlight-thing-set-fg-color]"
(interactive "sForeground color (\"none\" means no color): ")
(if (equal "none" color)
(setq color highlight-thing-no-color))
(set-face-foreground 'highlight-thing-face color))
;; Compatibility code - Set highlight-backgroundcolor.
(defun highlight-thing-set-bg-color (color)
"Set backgroundcolor for highlighting cursor-word to COLOR.
Key: \\[highlight-thing-set-bg-color]"
(interactive "sBackground color (\"none\" means no color): ")
(if (equal "none" color)
(setq color highlight-thing-no-color))
(set-face-background 'highlight-thing-face color))
;; Enable/Disable Highlighting
(defun highlight-thing (&optional on-off local)
"Switch highlighting of cursor-word ON-OFF
If LOCAL is non-nil, do so locally for the current buffer only."
(cond
(on-off
(when
(featurep 'xemacs)
(make-local-hook 'post-command-hook))
(add-hook 'post-command-hook 'highlight-thing-hook nil local))
(t
(remove-hook 'post-command-hook 'highlight-thing-hook t)
(delete-overlay highlight-thing-overlay))))
(defun highlight-thing-minor-mode (&optional arg)
"Toggle highlight-thing minor mode.
With ARG, turn minor mode on if ARG is positive, off otherwise.
You can customize the face of the highlighted line and whether the entire
line is hightlighted by customizing the group highlight-thing."
(setq highlight-thing-minor-mode
(if (null arg)
(not highlight-thing-minor-mode)
(> (prefix-numeric-value arg) 0)))
(if highlight-thing-minor-mode
(highlight-thing t t)
(highlight-thing nil t)))
(provide 'ar-thingatpt-highlight)
;;; ar-thingatpt-highlight.el ends here