Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

add unviersal arg to easily unhighlight all symbols #1

Closed
wants to merge 9 commits into from
Closed

add unviersal arg to easily unhighlight all symbols #1

Changes from all commits
Commits
Show all changes
9 commits
Select commit Hold shift + click to select a range
c1e29be
add universal arg to highlight-symbol-at-point to prompt to clear all…
Feb 25, 2012
4ee4399
fix unhighlight prompt to set case-fold-search nil
Mar 1, 2012
fc1e503
add symbol to `regexp-search-ring` when jumping
Jun 30, 2012
b5cbd23
fix using issue when background comes from overlay instead of text-pr…
Jul 1, 2012
a489023
use region when active instead of symbol-at-point
Aug 31, 2012
b1162a7
refactor some code in previous commit
Sep 9, 2012
e14a50c
don't assume symbol is symbol when constructing prompt
Sep 19, 2012
fd9c18f
fix prompt when face is not alist of properties
Sep 19, 2012
ebbc4f6
handle case when highlit symbol is delete from buffer
Oct 16, 2012
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Jump to
Jump to file
Failed to load files.
Diff view
Diff view
177 changes: 121 additions & 56 deletions highlight-symbol.el
View file
Open in desktop
Expand Up @@ -150,6 +150,31 @@ highlighting the symbols will use these colors in order."
(defconst highlight-symbol-border-pattern
(if (>= emacs-major-version 22) '("\\_<" . "\\_>") '("\\<" . "\\>")))

(defun highlight-symbol-get-prompt ()
(mapconcat
'identity
(let ((case-fold-search nil)
fg bg)
(loop for i from 0 below (length highlight-symbol-list)
for sym in (reverse highlight-symbol-list)
collect (save-excursion
(save-restriction
(widen)
(goto-char (point-min))
(if (re-search-forward sym nil 'no-error)
(let ((face-setting (car (get-char-property-and-overlay (1- (point)) 'face))))
(if (listp face-setting)
(setq bg (cdr (assq 'background-color face-setting))
fg (cdr (assq 'foreground-color face-setting)))
(setq bg nil
fg nil))
(propertize
sym
'face
(list :background bg :foreground fg)))
(format "(missing: %s)" sym))))))
", "))

;;;###autoload
(define-minor-mode highlight-symbol-mode
"Minor mode that highlights the symbol under point throughout the buffer.
Expand All @@ -167,36 +192,52 @@ Highlighting takes place after `highlight-symbol-idle-delay'."
(kill-local-variable 'highlight-symbol)))

;;;###autoload
(defun highlight-symbol-at-point ()
(defun highlight-symbol-at-point (arg)
"Toggle highlighting of the symbol at point.
This highlights or unhighlights the symbol at point using the first
element in of `highlight-symbol-faces'."
(interactive)
(let ((symbol (highlight-symbol-get-symbol)))
(unless symbol (error "No symbol at point"))
(unless hi-lock-mode (hi-lock-mode 1))
(if (member symbol highlight-symbol-list)
;; remove
(progn
(setq highlight-symbol-list (delete symbol highlight-symbol-list))
(hi-lock-unface-buffer symbol))
;; add
(when (equal symbol highlight-symbol)
(highlight-symbol-mode-remove-temp))
(let ((color (nth highlight-symbol-color-index
highlight-symbol-colors)))
(if color ;; wrap
(incf highlight-symbol-color-index)
(setq highlight-symbol-color-index 1
color (car highlight-symbol-colors)))
(setq color `((background-color . ,color)
(foreground-color . "black")))
;; highlight
(with-no-warnings
(if (< emacs-major-version 22)
(hi-lock-set-pattern `(,symbol (0 (quote ,color) t)))
(hi-lock-set-pattern symbol color)))
(push symbol highlight-symbol-list)))))
element in of `highlight-symbol-faces'.

With universal arg (C-u), prompt to remove all highlights."
(interactive "P")
(if (null arg)
(let ((symbol (if (use-region-p)
(progn
(setq deactivate-mark t)
(regexp-quote (filter-buffer-substring (region-beginning) (region-end))))
(highlight-symbol-get-symbol))))
(unless hi-lock-mode (hi-lock-mode 1))
(if (member symbol highlight-symbol-list)
;; remove
(progn
(setq highlight-symbol-list (delete symbol highlight-symbol-list))
(hi-lock-unface-buffer symbol))
;; add
(when (equal symbol highlight-symbol)
(highlight-symbol-mode-remove-temp))
(let ((color (nth highlight-symbol-color-index
highlight-symbol-colors)))
(if color ;; wrap
(incf highlight-symbol-color-index)
(setq highlight-symbol-color-index 1
color (car highlight-symbol-colors)))
(setq color `((background-color . ,color)
(foreground-color . "black")))
;; highlight
(with-no-warnings
(if (< emacs-major-version 22)
(hi-lock-set-pattern `(,symbol (0 (quote ,color) t)))
(hi-lock-set-pattern symbol color)))
(push symbol highlight-symbol-list))))
(if (null highlight-symbol-list)
(message "No symbols currently highlighted.")
(let ((prompt
(concat "Unhighlight "
(highlight-symbol-get-prompt)
"? (y/n)" ))
(cursor-in-echo-area t)
input)
(when (eq (upcase (read-char prompt)) ?Y)
(highlight-symbol-remove-all))))))

;;;###autoload
(defun highlight-symbol-remove-all ()
Expand Down Expand Up @@ -234,26 +275,36 @@ element in of `highlight-symbol-faces'."
(highlight-symbol-jump -1)))

;;;###autoload
(defun highlight-symbol-query-replace (replacement)
"*Replace the symbol at point."
(interactive (let ((symbol (or (thing-at-point 'symbol)
(error "No symbol at point"))))
(defun highlight-symbol-query-replace (symbol replacement)
"*Replace the symbol at point."
(interactive (let ((symbol (highlight-symbol-get-symbol)))
(highlight-symbol-temp-highlight)
(set query-replace-to-history-variable
(cons (substring-no-properties symbol)
(cons symbol
(eval query-replace-to-history-variable)))
(list
symbol
(read-from-minibuffer "Replacement: " nil nil nil
query-replace-to-history-variable))))
(goto-char (beginning-of-thing 'symbol))
(query-replace-regexp (highlight-symbol-get-symbol) replacement))
(goto-char (car (highlight-symbol-bounds)))
(query-replace-regexp symbol replacement))

(defun highlight-symbol-get-symbol ()
"Return a regular expression dandifying the symbol at point."
(let ((symbol (thing-at-point 'symbol)))
(when symbol (concat (car highlight-symbol-border-pattern)
(regexp-quote symbol)
(cdr highlight-symbol-border-pattern)))))
"Return current highlit thing at point or failing that,
return a regular expression dandifying the symbol at point."
(let* ((bounds (highlight-symbol-bounds))
(beg (car bounds))
(end (cdr bounds))
res)
(when (and beg end)
(setq res (let ((str (filter-buffer-substring beg end)))
(dolist (regex highlight-symbol-list)
(when (string-match regex str)
(return regex))))))
(or res
(concat (car highlight-symbol-border-pattern)
(filter-buffer-substring beg end)
(cdr highlight-symbol-border-pattern)))))

(defun highlight-symbol-temp-highlight ()
"Highlight the current symbol until a command is executed."
Expand Down Expand Up @@ -286,22 +337,36 @@ create the new one."
(defun highlight-symbol-jump (dir)
"Jump to the next or previous occurence of the symbol at point.
DIR has to be 1 or -1."
(let ((symbol (highlight-symbol-get-symbol)))
(if symbol
(let* ((case-fold-search nil)
(bounds (bounds-of-thing-at-point 'symbol))
(offset (- (point) (if (< 0 dir) (cdr bounds) (car bounds)))))
(unless (eq last-command 'highlight-symbol-jump)
(push-mark))
;; move a little, so we don't find the same instance again
(goto-char (- (point) offset))
(let ((target (re-search-forward symbol nil t dir)))
(unless target
(goto-char (if (< 0 dir) (point-min) (point-max)))
(setq target (re-search-forward symbol nil nil dir)))
(goto-char (+ target offset)))
(setq this-command 'highlight-symbol-jump))
(error "No symbol at point"))))
(let* ((case-fold-search nil)
(bounds (highlight-symbol-bounds))
(symbol (highlight-symbol-get-symbol))
(offset (- (point) (if (< 0 dir) (cdr bounds) (car bounds)))))
(unless (eq last-command 'highlight-symbol-jump)
(push-mark))
;; move a little, so we don't find the same instance again
(goto-char (- (point) offset))
(let ((target (re-search-forward symbol nil t dir)))
(unless target
(goto-char (if (< 0 dir) (point-min) (point-max)))
(setq target (re-search-forward symbol nil nil dir)))
(goto-char (+ target offset)))
(setq this-command 'highlight-symbol-jump)
(setq regexp-search-ring (cons symbol (delete symbol regexp-search-ring)))))

(defun highlight-symbol-bounds ()
"Return cons (beg . end) of bounds of highlit item."
(let* ((prop (get-char-property-and-overlay (point) 'face))
(fg (and (consp (car prop))
(cdr (assq 'foreground-color (car prop)))))
(bg (and (consp (car prop))
(cdr (assq 'background-color (car prop))))))
(if (and fg bg)
(cons (previous-single-property-change (point) 'face)
(next-single-property-change (point) 'face))
(let ((symbol (bounds-of-thing-at-point 'symbol)))
(or symbol
(error "No symbol at point"))))))


(provide 'highlight-symbol)

Expand Down