Extend symbol-overlay with hyrda and some extra functions #Emacs

init-hilight.el

;;; init-hilight.el --- Init hilight -*- lexical-binding: t; -*-

;; Copyright (C) 2019 Gong Qijian <gongqijian@gmail.com>

;; Author: Gong Qijian <gongqijian@gmail.com>
;; Created: 2019/02/15
;; Version: 0.1.0
;; Package-Requires: ((symbol-overlay "4.1") (hydra "0.14) (dash "2.0"))
;; Keywords: faces, matching

;; This program 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 3 of the License, or
;; (at your option) any later version.

;; This program 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 this program.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;; Extend symbol-overlay with hyrda and some extra functions
;; to make symbol and region highlighting easier.

;;; Change Log:

;;  0.1.0  2019/02/15  Initial version.

;;; Code:

(require 'dash)
(require 'hydra)
(require 'symbol-overlay)

(define-advice symbol-overlay-put-one (:override (symbol &optional face) without-keymap)
  "Put overlay on current occurrence of SYMBOL after a match.
If FACE is non-nil, use it as the overlay’s face.
Otherwise apply `symbol-overlay-default-face'."
  (let ((ov (make-overlay (match-beginning 0) (match-end 0))))
    (if face (progn (overlay-put ov 'face face)
		    ;; (overlay-put ov 'keymap symbol-overlay-map) ;; ---
		    (overlay-put ov 'evaporate t)
		    (overlay-put ov 'symbol symbol))
      (overlay-put ov 'face 'symbol-overlay-default-face)
      (overlay-put ov 'symbol ""))))

(defun hilight--newest-overlay-symbol-at-point (pos)
  "Return symbol of newest overlay.
If there are multiple overlays at point, return the newest region overlay, skip the symbol overlay.
If there is only one overlay at point, just return it, no matter region or symbol."
  (interactive)
  (let ((symbols (--map (overlay-get it 'symbol)
                       (overlays-at pos))))
    (car (if (cdr symbols)
             (reverse
              (--filter (not (or (string-prefix-p "\\_<" it)
                                 (string-suffix-p "\\_>" it)))
                        symbols))
           symbols))))

(defun hilight--jump (&optional backward)
  (interactive)
  (let* ((pos (point))
         (sym (hilight--newest-overlay-symbol-at-point pos))
         (testfn (if backward '< '>))
         (pointfn (if backward 'overlay-end 'overlay-start)))
    (catch 'break
      (--map
       (when (string= sym (overlay-get it 'symbol))
         (let ((dst (funcall pointfn it)))
           (when (funcall testfn dst pos)
             (goto-char (- dst (if backward 1 0)))
             (throw 'break nil))))
       (symbol-overlay-get-list)))))

(defun hilight-toggle (&optional beg end)
  "Toggle all overlays of symbol or region at point."
  (interactive "r")
  (unless (minibufferp)
    (let* ((symbol (if (region-active-p)
                       (prog1 (buffer-substring-no-properties beg end)
                         (deactivate-mark))
                     (symbol-overlay-get-symbol)))
           (keyword (symbol-overlay-assoc symbol)))
      (if keyword
          (if (symbol-overlay-maybe-reput symbol keyword)
              (symbol-overlay-maybe-count keyword)
            (symbol-overlay-maybe-remove keyword)
            (symbol-overlay-maybe-put-temp))
        (and (looking-at-p "\\_>") (backward-char))
        (symbol-overlay-maybe-count
         (symbol-overlay-put-all symbol symbol-overlay-scope)
         t)))))

(defun hilight-jump-next ()
  (interactive)
  (hilight--jump))

(defun hilight-jump-prev ()
  (interactive)
  (hilight--jump t))

(defhydra hydra-hilight-jump (:hint nil)
  "\n <-- _p_rev _n_ext -->\n"
  ("n" hilight-jump-next)
  ("p" hilight-jump-prev))

(defun hilight-jump-next+hydra ()
  (interactive)
  (hilight-jump-next)
  (hydra-hilight-jump/body))

(defun hilight-jump-prev+hydra ()
  (interactive)
  (hilight-jump-prev)
  (hydra-hilight-jump/body))

(evil-leader/set-key
 "hh" 'hilight-toggle          ;; instead of `symbol-overlay-put'
 "hn" 'hilight-jump-next+hydra ;; instead of `symbol-overlay-jump-next'
 "hp" 'hilight-jump-prev+hydra ;; instead of `symbol-overlay-jump-prev'
 "ht" 'symbol-overlay-toggle-in-scope
 "ha" 'symbol-overlay-remove-all
 "he" 'symbol-overlay-echo-mark
 "hd" 'symbol-overlay-jump-to-definition
 "hs" 'symbol-overlay-isearch-literally
 "hq" 'symbol-overlay-query-replace
 "hr" 'symbol-overlay-rename)

(provide 'init-hilight)

;;; init-hilight.el ends here