emacs/.emacs.d/site-lisp/highlight-symbol.el

   1 ;;; highlight-symbol.el --- automatic and manual symbol highlighting
   2 ;;
   3 ;; Copyright (C) 2007-2009 Nikolaj Schumacher
   4 ;;
   5 ;; Author: Nikolaj Schumacher <bugs * nschum de>
   6 ;; Version: 1.1
   7 ;; Keywords: faces, matching
   8 ;; URL: http://nschum.de/src/emacs/highlight-symbol/
   9 ;; Compatibility: GNU Emacs 22.x, GNU Emacs 23.x
  10 ;;
  11 ;; This file is NOT part of GNU Emacs.
  12 ;;
  13 ;; This program is free software; you can redistribute it and/or
  14 ;; modify it under the terms of the GNU General Public License
  15 ;; as published by the Free Software Foundation; either version 2
  16 ;; of the License, or (at your option) any later version.
  17 ;;
  18 ;; This program is distributed in the hope that it will be useful,
  19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21 ;; GNU General Public License for more details.
  22 ;;
  23 ;; You should have received a copy of the GNU General Public License
  24 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  25 ;;
  26 ;;; Commentary:
  27 ;;
  28 ;; Add the following to your .emacs file:
  29 ;; (require 'highlight-symbol)
  30 ;; (global-set-key [(control f3)] 'highlight-symbol-at-point)
  31 ;; (global-set-key [f3] 'highlight-symbol-next)
  32 ;; (global-set-key [(shift f3)] 'highlight-symbol-prev)
  33 ;; (global-set-key [(meta f3)] 'highlight-symbol-prev)))
  34 ;; (global-set-key [(control meta f3)] 'highlight-symbol-query-replace)
  35 ;;
  36 ;; Use `highlight-symbol-at-point' to toggle highlighting of the symbol at
  37 ;; point throughout the current buffer.  Use `highlight-symbol-mode' to keep the
  38 ;; symbol at point highlighted.
  39 ;;
  40 ;; The functions `highlight-symbol-next', `highlight-symbol-prev',
  41 ;; `highlight-symbol-next-in-defun' and `highlight-symbol-prev-in-defun' allow
  42 ;; for cycling through the locations of any symbol at point.
  43 ;; When `highlight-symbol-on-navigation-p' is set, highlighting is triggered
  44 ;; regardless of `highlight-symbol-idle-delay'.
  45 ;;
  46 ;; `highlight-symbol-query-replace' can be used to replace the symbol.
  47 ;;
  48 ;;; Change Log:
  49 ;;
  50 ;; 2009-04-13 (1.1)
  51 ;;    Added `highlight-symbol-query-replace'.
  52 ;;
  53 ;; 2009-03-19 (1.0.5)
  54 ;;    Fixed `highlight-symbol-idle-delay' void variable message.
  55 ;;    Fixed color repetition bug.  (thanks to Hugo Schmitt)
  56 ;;
  57 ;; 2008-05-02 (1.0.4)
  58 ;;    Added `highlight-symbol-on-navigation-p' option.
  59 ;;
  60 ;; 2008-02-26 (1.0.3)
  61 ;;    Added `highlight-symbol-remove-all'.
  62 ;;
  63 ;; 2007-09-06 (1.0.2)
  64 ;;    Fixed highlighting with delay set to 0.  (thanks to Stefan Persson)
  65 ;;
  66 ;; 2007-09-05 (1.0.1)
  67 ;;    Fixed completely broken temporary highlighting.
  68 ;;
  69 ;; 2007-07-30 (1.0)
  70 ;;    Keep temp highlight while jumping.
  71 ;;    Replaced `highlight-symbol-faces' with `highlight-symbol-colors'.
  72 ;;    Fixed dependency and Emacs 21 bug.  (thanks to Gregor Gorjanc)
  73 ;;    Prevent calling `highlight-symbol-at-point' on nil.
  74 ;;
  75 ;; 2007-04-20 (0.9.1)
  76 ;;    Fixed bug in `highlight-symbol-jump'.  (thanks to Per Nordlöw)
  77 ;;
  78 ;; 2007-04-06 (0.9)
  79 ;;    Initial release.
  80 ;;
  81 ;;; Code:
  82
  83 (require 'thingatpt)
  84 (require 'hi-lock)
  85 (eval-when-compile (require 'cl))
  86
  87 (push "^No symbol at point$" debug-ignored-errors)
  88
  89 (defgroup highlight-symbol nil
  90   "Automatic and manual symbols highlighting"
  91   :group 'faces
  92   :group 'matching)
  93
  94 (defface highlight-symbol-face
  95   '((((class color) (background dark))
  96      (:background "gray30"))
  97     (((class color) (background light))
  98      (:background "gray90")))
  99   "*Face used by `highlight-symbol-mode'."
 100   :group 'highlight-symbol)
 101
 102 (defvar highlight-symbol-timer nil)
 103
 104 (defun highlight-symbol-update-timer (value)
 105   (when highlight-symbol-timer
 106     (cancel-timer highlight-symbol-timer))
 107   (setq highlight-symbol-timer
 108         (and value (/= value 0)
 109              (run-with-idle-timer value t 'highlight-symbol-temp-highlight))))
 110
 111 (defvar highlight-symbol-mode nil)
 112
 113 (defun highlight-symbol-set (symbol value)
 114   (when symbol (set symbol value))
 115   (when highlight-symbol-mode
 116     (highlight-symbol-update-timer value)))
 117
 118 (defcustom highlight-symbol-idle-delay 1.5
 119   "*Number of seconds of idle time before highlighting the current symbol.
 120 If this variable is set to 0, no idle time is required.
 121 Changing this does not take effect until `highlight-symbol-mode' has been
 122 disabled for all buffers."
 123   :type 'number
 124   :set 'highlight-symbol-set
 125   :group 'highlight-symbol)
 126
 127 (defcustom highlight-symbol-colors
 128   '("yellow" "DeepPink" "cyan" "MediumPurple1" "SpringGreen1"
 129     "DarkOrange" "HotPink1" "RoyalBlue1" "OliveDrab")
 130   "*Colors used by `highlight-symbol-at-point'.
 131 highlighting the symbols will use these colors in order."
 132   :type '(repeat color)
 133   :group 'highlight-symbol)
 134
 135 (defcustom highlight-symbol-on-navigation-p nil
 136   "*Wether or not to temporary highlight the symbol when using
 137 `highlight-symbol-jump' family of functions."
 138   :type 'boolean
 139   :group 'highlight-symbol)
 140
 141 (defvar highlight-symbol-color-index 0)
 142 (make-variable-buffer-local 'highlight-symbol-color-index)
 143
 144 (defvar highlight-symbol nil)
 145 (make-variable-buffer-local 'highlight-symbol)
 146
 147 (defvar highlight-symbol-list nil)
 148 (make-variable-buffer-local 'highlight-symbol-list)
 149
 150 (defconst highlight-symbol-border-pattern
 151   (if (>= emacs-major-version 22) '("\\_<" . "\\_>") '("\\<" . "\\>")))
 152
 153 ;;;###autoload
 154 (define-minor-mode highlight-symbol-mode
 155   "Minor mode that highlights the symbol under point throughout the buffer.
 156 Highlighting takes place after `highlight-symbol-idle-delay'."
 157   nil " hl-s" nil
 158   (if highlight-symbol-mode
 159       ;; on
 160       (let ((hi-lock-archaic-interface-message-used t))
 161         (unless hi-lock-mode (hi-lock-mode 1))
 162         (highlight-symbol-update-timer highlight-symbol-idle-delay)
 163         (add-hook 'post-command-hook 'highlight-symbol-mode-post-command nil t))
 164     ;; off
 165     (remove-hook 'post-command-hook 'highlight-symbol-mode-post-command t)
 166     (highlight-symbol-mode-remove-temp)
 167     (kill-local-variable 'highlight-symbol)))
 168
 169 ;;;###autoload
 170 (defun highlight-symbol-at-point ()
 171   "Toggle highlighting of the symbol at point.
 172 This highlights or unhighlights the symbol at point using the first
 173 element in of `highlight-symbol-faces'."
 174   (interactive)
 175   (let ((symbol (highlight-symbol-get-symbol)))
 176     (unless symbol (error "No symbol at point"))
 177     (unless hi-lock-mode (hi-lock-mode 1))
 178     (if (member symbol highlight-symbol-list)
 179         ;; remove
 180         (progn
 181           (setq highlight-symbol-list (delete symbol highlight-symbol-list))
 182           (hi-lock-unface-buffer symbol))
 183       ;; add
 184       (when (equal symbol highlight-symbol)
 185         (highlight-symbol-mode-remove-temp))
 186       (let ((color (nth highlight-symbol-color-index
 187                         highlight-symbol-colors)))
 188         (if color ;; wrap
 189             (incf highlight-symbol-color-index)
 190           (setq highlight-symbol-color-index 1
 191                 color (car highlight-symbol-colors)))
 192         (setq color `((background-color . ,color)
 193                       (foreground-color . "black")))
 194         ;; highlight
 195         (with-no-warnings
 196           (if (< emacs-major-version 22)
 197               (hi-lock-set-pattern `(,symbol (0 (quote ,color) t)))
 198             (hi-lock-set-pattern symbol color)))
 199         (push symbol highlight-symbol-list)))))
 200
 201 ;;;###autoload
 202 (defun highlight-symbol-remove-all ()
 203   "Remove symbol highlighting in buffer."
 204   (interactive)
 205   (mapc 'hi-lock-unface-buffer highlight-symbol-list)
 206   (setq highlight-symbol-list nil))
 207
 208 ;;;###autoload
 209 (defun highlight-symbol-next ()
 210   "Jump to the next location of the symbol at point within the function."
 211   (interactive)
 212   (highlight-symbol-jump 1))
 213
 214 ;;;###autoload
 215 (defun highlight-symbol-prev ()
 216   "Jump to the previous location of the symbol at point within the function."
 217   (interactive)
 218   (highlight-symbol-jump -1))
 219
 220 ;;;###autoload
 221 (defun highlight-symbol-next-in-defun ()
 222   "Jump to the next location of the symbol at point within the defun."
 223   (interactive)
 224   (save-restriction
 225     (narrow-to-defun)
 226     (highlight-symbol-jump 1)))
 227
 228 ;;;###autoload
 229 (defun highlight-symbol-prev-in-defun ()
 230   "Jump to the previous location of the symbol at point within the defun."
 231   (interactive)
 232   (save-restriction
 233     (narrow-to-defun)
 234     (highlight-symbol-jump -1)))
 235
 236 ;;;###autoload
 237 (defun highlight-symbol-query-replace (replacement)
 238   "*Replace the symbol at point."
 239   (interactive (let ((symbol (or (thing-at-point 'symbol)
 240                                  (error "No symbol at point"))))
 241                  (highlight-symbol-temp-highlight)
 242                  (set query-replace-to-history-variable
 243                       (cons (substring-no-properties symbol)
 244                             (eval query-replace-to-history-variable)))
 245                  (list
 246                   (read-from-minibuffer "Replacement: " nil nil nil
 247                                         query-replace-to-history-variable))))
 248   (goto-char (beginning-of-thing 'symbol))
 249   (query-replace-regexp (highlight-symbol-get-symbol) replacement))
 250
 251 (defun highlight-symbol-get-symbol ()
 252   "Return a regular expression dandifying the symbol at point."
 253   (let ((symbol (thing-at-point 'symbol)))
 254     (when symbol (concat (car highlight-symbol-border-pattern)
 255                          (regexp-quote symbol)
 256                          (cdr highlight-symbol-border-pattern)))))
 257
 258 (defun highlight-symbol-temp-highlight ()
 259   "Highlight the current symbol until a command is executed."
 260   (when highlight-symbol-mode
 261     (let ((symbol (highlight-symbol-get-symbol)))
 262       (unless (or (equal symbol highlight-symbol)
 263                   (member symbol highlight-symbol-list))
 264         (highlight-symbol-mode-remove-temp)
 265         (when symbol
 266           (setq highlight-symbol symbol)
 267           (hi-lock-set-pattern symbol 'highlight-symbol-face))))))
 268
 269 (defun highlight-symbol-mode-remove-temp ()
 270   "Remove the temporary symbol highlighting."
 271   (when highlight-symbol
 272     (hi-lock-unface-buffer highlight-symbol)
 273     (setq highlight-symbol nil)))
 274
 275 (defun highlight-symbol-mode-post-command ()
 276   "After a command, change the temporary highlighting.
 277 Remove the temporary symbol highlighting and, unless a timeout is specified,
 278 create the new one."
 279   (if (eq this-command 'highlight-symbol-jump)
 280       (when highlight-symbol-on-navigation-p
 281         (highlight-symbol-temp-highlight))
 282     (if (eql highlight-symbol-idle-delay 0)
 283         (highlight-symbol-temp-highlight)
 284       (highlight-symbol-mode-remove-temp))))
 285
 286 (defun highlight-symbol-jump (dir)
 287   "Jump to the next or previous occurence of the symbol at point.
 288 DIR has to be 1 or -1."
 289   (let ((symbol (highlight-symbol-get-symbol)))
 290     (if symbol
 291         (let* ((case-fold-search nil)
 292                (bounds (bounds-of-thing-at-point 'symbol))
 293                (offset (- (point) (if (< 0 dir) (cdr bounds) (car bounds)))))
 294           (unless (eq last-command 'highlight-symbol-jump)
 295             (push-mark))
 296           ;; move a little, so we don't find the same instance again
 297           (goto-char (- (point) offset))
 298           (let ((target (re-search-forward symbol nil t dir)))
 299             (unless target
 300               (goto-char (if (< 0 dir) (point-min) (point-max)))
 301               (setq target (re-search-forward symbol nil nil dir)))
 302             (goto-char (+ target offset)))
 303           (setq this-command 'highlight-symbol-jump))
 304       (error "No symbol at point"))))
 305
 306 (provide 'highlight-symbol)
 307
 308 ;;; highlight-symbol.el ends here