Skip to content

Instantly share code, notes, and snippets.

@xuchunyang

xuchunyang/highlight-some-text.el

Created May 31, 2016 10:10
Show Gist options

  • Select an option

    Learn more about clone URLs
  • Save xuchunyang/1eb3217be2e63a124f4e3d8a154f4db8 to your computer and use it in GitHub Desktop.

Select an option

Learn more about clone URLs
Save xuchunyang/1eb3217be2e63a124f4e3d8a154f4db8 to your computer and use it in GitHub Desktop.
Download ZIP

Revisions

  1. xuchunyang created this gist May 31, 2016.
    37 changes: 37 additions & 0 deletions highlight-some-text.el
    View file
    Original file line number Diff line number Diff line change
    @@ -0,0 +1,37 @@
    ;; 用绿色高亮「申请人」、黄色高亮「被申请人」

    (defun my-highlight-some-text ()
    (hi-lock-set-pattern+ "被申请人" 0 'hi-yellow)
    (hi-lock-set-pattern+ "[^被]\\(申请人\\)" 1 'hi-green))

    (add-hook 'org-mode-hook #'my-highlight-some-text)


    (defun hi-lock-set-pattern+ (regexp group face)
    "Highlight REGEXP with face FACE."
    ;; Hashcons the regexp, so it can be passed to remove-overlays later.
    (setq regexp (hi-lock--hashcons regexp))
    (let ((pattern (list regexp (list 0 (list 'quote face) 'prepend))))
    ;; Refuse to highlight a text that is already highlighted.
    (unless (assoc regexp hi-lock-interactive-patterns)
    (push pattern hi-lock-interactive-patterns)
    (if (and font-lock-mode (font-lock-specified-p major-mode))
    (progn
    (font-lock-add-keywords nil (list pattern) t)
    (font-lock-flush))
    (let* ((range-min (- (point) (/ hi-lock-highlight-range 2)))
    (range-max (+ (point) (/ hi-lock-highlight-range 2)))
    (search-start
    (max (point-min)
    (- range-min (max 0 (- range-max (point-max))))))
    (search-end
    (min (point-max)
    (+ range-max (max 0 (- (point-min) range-min))))))
    (save-excursion
    (goto-char search-start)
    (while (re-search-forward regexp search-end t)
    (let ((overlay (make-overlay (match-beginning group) (match-end group))))
    (overlay-put overlay 'hi-lock-overlay t)
    (overlay-put overlay 'hi-lock-overlay-regexp regexp)
    (overlay-put overlay 'face face))
    (goto-char (match-end group)))))))))