Skip to content

Commit

Permalink
Import of version 1.0
Browse files Browse the repository at this point in the history
  • Loading branch information
@nschum
nschum committed Jun 19, 2008
1 parent b00b25d commit e767d4b
Showing 1 changed file with 78 additions and 38 deletions.
116 changes: 78 additions & 38 deletions highlight-symbol.el
View file
@@ -1,8 +1,14 @@
;;; highlight-symbol.el --- automatic and manual symbol highlighting ;;; highlight-symbol.el --- automatic and manual symbol highlighting
;; ;;
;; Copyright (C) 2007 Nikolaj Schumacher <bugs * nschum , de> ;; Copyright (C) 2007 Nikolaj Schumacher
;; ;;
;;; License ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Author: Nikolaj Schumacher <bugs * nschum de>
;; Version: 1.0
;; Keywords: faces, matching
;; URL: http://nschum.de/src/emacs/highlight-symbol/
;; Compatibility: GNU Emacs 22.x
;;
;; This file is NOT part of GNU Emacs.
;; ;;
;; This program is free software; you can redistribute it and/or ;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License ;; modify it under the terms of the GNU General Public License
Expand All @@ -17,18 +23,15 @@
;; You should have received a copy of the GNU General Public License ;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>. ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;; ;;
;;; Configuration ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Commentary:
;; ;;
;; Add the following to your .emacs file: ;; Add the following to your .emacs file:
;;
;; (require 'highlight-symbol) ;; (require 'highlight-symbol)
;; (global-set-key [(control f3)] 'highlight-symbol-at-point) ;; (global-set-key [(control f3)] 'highlight-symbol-at-point)
;; (global-set-key [f3] 'highlight-symbol-next) ;; (global-set-key [f3] 'highlight-symbol-next)
;; (global-set-key [(shift f3)] 'highlight-symbol-prev) ;; (global-set-key [(shift f3)] 'highlight-symbol-prev)
;; (global-set-key [(meta f3)] 'highlight-symbol-prev))) ;; (global-set-key [(meta f3)] 'highlight-symbol-prev)))
;; ;;
;;; Usage ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Use `highlight-symbol-at-point' to toggle highlighting of the symbol at ;; Use `highlight-symbol-at-point' to toggle highlighting of the symbol at
;; point throughout the current buffer. Use `highlight-symbol-mode' to keep the ;; point throughout the current buffer. Use `highlight-symbol-mode' to keep the
;; symbol at point highlighted. ;; symbol at point highlighted.
Expand All @@ -37,19 +40,31 @@
;; `highlight-symbol-next-in-defun' and `highlight-symbol-prev-in-defun' allow ;; `highlight-symbol-next-in-defun' and `highlight-symbol-prev-in-defun' allow
;; for cycling through the locations of any symbol at point. ;; for cycling through the locations of any symbol at point.
;; ;;
;;; Changes ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Change Log:
;;
;; 2007-07-30 (1.0)
;; Keep temp highlight while jumping.
;; Replaced `highlight-symbol-faces' with `highlight-symbol-colors'.
;; Fixed dependency and Emacs 21 bug. (thanks to Gregor Gorjanc)
;; Prevent calling `highlight-symbol-at-point' on nil.
;; ;;
;; 2007-04-20 (0.9.1) ;; 2007-04-20 (0.9.1)
;; Fixed bug in `highlight-symbol-jump'. (thanks to Per Nordlöw) ;; Fixed bug in `highlight-symbol-jump'. (thanks to Per Nordlöw)
;; ;;
;; 2007-04-06 (0.9) ;; 2007-04-06 (0.9)
;; Initial release. ;; Initial release.
;; ;;
;;; Customizable Variables ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Code:

(require 'thingatpt)
(require 'hi-lock)

(push "^No symbol at point$" debug-ignored-errors)


(defgroup highlight-symbol nil (defgroup highlight-symbol nil
"Automatic and manual symbols highlighting" "Automatic and manual symbols highlighting"
:group 'convenience) :group 'faces
:group 'matching)


(defface highlight-symbol-face (defface highlight-symbol-face
'((((class color) (background dark)) '((((class color) (background dark))
Expand All @@ -67,22 +82,37 @@ disabled for all buffers."
:type 'number :type 'number
:group 'highlight-symbol) :group 'highlight-symbol)


(defvar highlight-symbol-faces '('hi-yellow 'hi-pink 'hi-green 'hi-blue) (defcustom highlight-symbol-colors
"The faces that, in this order, will be used for `highlight-symbol-at-point'. '("yellow" "DeepPink" "cyan" "MediumPurple1" "SpringGreen1"
This list will be rotated after each call to `highlight-symbol-at-point', so "DarkOrange" "HotPink1" "RoyalBlue1" "OliveDrab")
that the first element will go to the end.") "*Colors used by `highlight-symbol-at-point'.
highlighting the symbols will use these colors in order."
:type '(repeat color)
:group 'highlight-symbol)

(defvar highlight-symbol-color-index 0)
(make-variable-buffer-local 'highlight-symbol-color-index)

(defvar highlight-symbol-timer nil)
(defvar highlight-symbol-instances nil)

(defvar highlight-symbol nil)
(make-variable-buffer-local 'highlight-symbol)

(defvar highlight-symbol-list nil)
(make-variable-buffer-local 'highlight-symbol-list)


;;; Interactive Functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defconst highlight-symbol-border-pattern
(if (>= emacs-major-version 22) '("\\_<" . "\\_>") '("\\<" . "\\>")))


;;;###autoload ;;;###autoload
(define-minor-mode highlight-symbol-mode (define-minor-mode highlight-symbol-mode
"Minor mode that highlights the symbol under point throughout the buffer. "Minor mode that highlights the symbol under point throughout the buffer.
Highlighting takes place after `highlight-symbol-idle-delay'." Highlighting takes place after `highlight-symbol-idle-delay'."
nil " hl-s" nil nil " hl-s" nil
(require 'thingatpt)
(require 'hi-lock)
(if highlight-symbol-mode (if highlight-symbol-mode
;; on ;; on
(unless hi-lock-mode (hi-lock-mode 1))
(progn (progn
(add-to-list 'highlight-symbol-instances (current-buffer)) (add-to-list 'highlight-symbol-instances (current-buffer))
(unless highlight-symbol-timer (unless highlight-symbol-timer
Expand Down Expand Up @@ -111,6 +141,8 @@ This highlights or unhighlights the symbol at point using the first
element in of `highlight-symbol-faces'." element in of `highlight-symbol-faces'."
(interactive) (interactive)
(let ((symbol (highlight-symbol-get-symbol))) (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) (if (member symbol highlight-symbol-list)
;; remove ;; remove
(progn (progn
Expand All @@ -119,53 +151,55 @@ element in of `highlight-symbol-faces'."
;; add ;; add
(when (equal symbol highlight-symbol) (when (equal symbol highlight-symbol)
(highlight-symbol-mode-remove-temp)) (highlight-symbol-mode-remove-temp))
(let ((face (pop highlight-symbol-faces))) (let ((color (nth highlight-symbol-color-index
;; rotate faces highlight-symbol-colors)))
(setq highlight-symbol-faces (if color ;; wrap
(nconc highlight-symbol-faces `(,face))) (incf highlight-symbol-color-index)
(setq highlight-symbol-color-index 0
color (car highlight-symbol-colors)))
(setq color `((background-color . ,color)
(foreground-color . "black")))
;; highlight ;; highlight
(hi-lock-set-pattern symbol face) (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))))) (push symbol highlight-symbol-list)))))


;;;###autoload
(defun highlight-symbol-next () (defun highlight-symbol-next ()
"Jump to the next location of the symbol at point within the function." "Jump to the next location of the symbol at point within the function."
(interactive) (interactive)
(highlight-symbol-jump 1)) (highlight-symbol-jump 1))


;;;###autoload
(defun highlight-symbol-prev () (defun highlight-symbol-prev ()
"Jump to the previous location of the symbol at point within the function." "Jump to the previous location of the symbol at point within the function."
(interactive) (interactive)
(highlight-symbol-jump -1)) (highlight-symbol-jump -1))


;;;###autoload
(defun highlight-symbol-next-in-defun () (defun highlight-symbol-next-in-defun ()
"Jump to the next location of the symbol at point within the defun." "Jump to the next location of the symbol at point within the defun."
(interactive) (interactive)
(save-restriction (save-restriction
(narrow-to-defun) (narrow-to-defun)
(highlight-symbol-jump 1))) (highlight-symbol-jump 1)))


;;;###autoload
(defun highlight-symbol-prev-in-defun () (defun highlight-symbol-prev-in-defun ()
"Jump to the previous location of the symbol at point within the defun." "Jump to the previous location of the symbol at point within the defun."
(interactive) (interactive)
(save-restriction (save-restriction
(narrow-to-defun) (narrow-to-defun)
(highlight-symbol-jump -11))) (highlight-symbol-jump -11)))


;;; Internal ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defvar highlight-symbol-timer nil)
(defvar highlight-symbol-instances nil)

(defvar highlight-symbol nil)
(make-variable-buffer-local 'highlight-symbol)

(defvar highlight-symbol-list nil)
(make-variable-buffer-local 'highlight-symbol-list)

(defun highlight-symbol-get-symbol () (defun highlight-symbol-get-symbol ()
"Return a regular expression dandifying the symbol at point." "Return a regular expression dandifying the symbol at point."
(let ((symbol (thing-at-point 'symbol))) (let ((symbol (thing-at-point 'symbol)))
(when symbol (concat "\\_<" (regexp-quote symbol) "\\_>")))) (when symbol (concat (car highlight-symbol-border-pattern)
(regexp-quote symbol)
(cdr highlight-symbol-border-pattern)))))


(defun highlight-symbol-temp-highlight () (defun highlight-symbol-temp-highlight ()
"Highlight the current symbol until a command is executed." "Highlight the current symbol until a command is executed."
Expand All @@ -189,7 +223,8 @@ Remove the temporary symbol highlighting and, unless a timeout is specified,
create the new one." create the new one."
(unless (eq this-command 'highlight-symbol-jump-to-next) (unless (eq this-command 'highlight-symbol-jump-to-next)
(if highlight-symbol-timer (if highlight-symbol-timer
(highlight-symbol-mode-remove-temp) (unless (eq this-command 'highlight-symbol-jump)
(highlight-symbol-mode-remove-temp))
(highlight-symbol-temp-highlight)))) (highlight-symbol-temp-highlight))))


(defun highlight-symbol-jump (dir) (defun highlight-symbol-jump (dir)
Expand All @@ -200,13 +235,18 @@ DIR has to be 1 or -1."
(let* ((case-fold-search nil) (let* ((case-fold-search nil)
(bounds (bounds-of-thing-at-point 'symbol)) (bounds (bounds-of-thing-at-point 'symbol))
(offset (- (point) (if (< 0 dir) (cdr bounds) (car bounds))))) (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 ;; move a little, so we don't find the same instance again
(goto-char (- (point) offset)) (goto-char (- (point) offset))
(let ((target (re-search-forward symbol nil t dir))) (let ((target (re-search-forward symbol nil t dir)))
(unless target (unless target
(goto-char (if (< 0 dir) (point-min) (point-max))) (goto-char (if (< 0 dir) (point-min) (point-max)))
(setq target (re-search-forward symbol nil nil dir))) (setq target (re-search-forward symbol nil nil dir)))
(goto-char (+ target offset)))) (goto-char (+ target offset)))
(message "No symbol at point")))) (setq this-command 'highlight-symbol-jump))
(error "No symbol at point"))))


(provide 'highlight-symbol) (provide 'highlight-symbol)

;;; highlight-symbol.el ends here

0 comments on commit e767d4b

Please sign in to comment.