Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP

Loading…

add unviersal arg to easily unhighlight all symbols #1

Closed
wants to merge 9 commits into from

2 participants

@lewang

...ghlights

@nschum
Owner

Thank you. Sorry for the late response. I'm currently not using Emacs much.

I'm not a big fan of using the prefix argument to remove all symbols. It seems too asymmetric. There is a function for that after all. I also wouldn't want to replace y-or-n-p' withread-char, sincey-or-n-p' has a lot of subtle features that people might expect. If you find a way to use `y-or-n-p', I'd support adding it to interactive calls of highlight-symbol-remove-all.

What I really like is the colored list of highlighted symbols. So I've included that. Thanks!

@nschum nschum closed this
@lewang

C-u prefix is used to indicate a more forceful version of a command. It applies well in this case.

I should have opened other pull-requests, but I've also included changes here that treats a selected region as a highlight target.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Commits on Feb 25, 2012
Commits on Mar 1, 2012
Commits on Jun 30, 2012
  1. add symbol to `regexp-search-ring` when jumping

    Le Wang authored
Commits on Jul 1, 2012
Commits on Aug 31, 2012
Commits on Sep 9, 2012
  1. refactor some code in previous commit

    Le Wang authored
Commits on Sep 19, 2012
  1. fix prompt when face is not alist of properties

    Le Wang authored
Commits on Oct 16, 2012
This page is out of date. Refresh to see the latest.
Showing with 121 additions and 56 deletions.
  1. +121 −56 highlight-symbol.el
View
177 highlight-symbol.el
@@ -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.
@@ -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 ()
@@ -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."
@@ -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)
Something went wrong with that request. Please try again.