branch: master
commit 440c96ebd3ae0b8e51a82da6835240489d62a35b
Author: Leo Perrin <leoper...@picarresursix.fr>
Commit: Alexey Veretennikov <alexey.veretenni...@gmail.com>
Added possibility of desactivating regex highlighting.
---
loccur.el | 139 ++++++++++++++++++++++++++++++++----------------------------
1 files changed, 74 insertions(+), 65 deletions(-)
diff --git a/loccur.el b/loccur.el
index a9aec5a..5c55f8a 100644
--- a/loccur.el
+++ b/loccur.el
@@ -1,13 +1,13 @@
;;; loccur.el --- Perform an occur-like folding in current buffer
-;; Copyright (C) 2009-2012 Alexey Veretennikov
+;; Copyright (C) 2009 Alexey Veretennikov
;;
;; Author: Alexey Veretennikov <alexey dot veretennikov at gmail dot com>
;; Created: 2009-09-08
-;; Version: 1.1.3
+;; Version: 1.1.1
;; Keywords: matching
-;; URL: https://github.com/fourier/loccur
-;; Compatibility: GNU Emacs 23.x, GNU Emacs 24.x
+;; URL: http://loccur.sourceforge.net/
+;; Compatibility: GNU Emacs 22.x, GNU Emacs 23.x
;;
;; This file is NOT part of GNU Emacs.
;;
@@ -44,14 +44,6 @@
;;
;;; Change Log:
;;
-;; 2012-09-27 (1.1.3)
-;; + Recenter on exit from loccur-mode
-;;
-;;
-;; 2012-09-25 (1.1.2)
-;; + Removed cl dependency
-;;
-;;
;; 2010-03-07 (1.1.1)
;; + Default value is taken from prompt instead of an edit area
;; (thanks to Nathaniel Flath)
@@ -68,12 +60,28 @@
;;
;;; Code:
+(eval-when-compile (require 'cl))
+
(defconst loccur-overlay-property-name 'loccur-custom-buffer-grep)
+(defvar loccur-highlight-matching-regexp t
+ "If set to a non-nil value, the part of the line matching the
+regex is highlighted. Use loccur-toggle-highlight to modify its
+value interactively.")
+
+
+(defun loccur-toggle-highlight()
+ "Toggles the highlighting of the part of the line matching the
+regex given in the loccur buffer."
+ (interactive)
+ (if loccur-highlight-matching-regexp
+ (setq loccur-highlight-matching-regexp nil)
+ (setq loccur-highlight-matching-regexp t)))
+
(or (assq 'loccur-mode minor-mode-alist)
(nconc minor-mode-alist
- (list '(loccur-mode loccur-mode))))
+ (list '(loccur-mode loccur-mode))))
(defvar loccur-mode nil) ;; name of the minor mode
@@ -97,16 +105,15 @@
(defun loccur-mode (regex)
(setq loccur-mode
- (if (or loccur-mode
- (null regex)
- (zerop (length regex)))
- nil
- " Loccur"))
+ (if (or loccur-mode
+ (null regex)
+ (zerop (length regex)))
+ nil
+ " Loccur"))
(force-mode-line-update)
(loccur-remove-overlays)
- (if loccur-mode
- (loccur-1 regex)
- (recenter)))
+ (when loccur-mode
+ (loccur-1 regex)))
(defun loccur-current ()
@@ -158,38 +165,40 @@ if its size is 1 line"
(defun loccur-1 (regex)
(let* ((buffer-matches (loccur-find-matches regex))
- (ovl-bounds (loccur-create-overlay-bounds-btw-lines buffer-matches)))
- (setq loccur-overlay-list
- (loccur-create-invisible-overlays ovl-bounds))
+ (ovl-bounds (loccur-create-overlay-bounds-btw-lines
buffer-matches)))
+ (setq loccur-overlay-list
+ (loccur-create-invisible-overlays ovl-bounds))
(setq loccur-overlay-list
(append loccur-overlay-list
(loccur-create-highlighted-overlays buffer-matches)))
(setq loccur-last-match regex)
- (recenter)))
+ (recenter)))
(defun loccur-create-highlighted-overlays(buffer-matches)
(let ((overlays
- (mapcar (lambda (match)
- (make-overlay
- (nth 1 match)
- (nth 2 match)
- (current-buffer) t nil))
- buffer-matches)))
- (mapcar (lambda (ovl)
- (overlay-put ovl loccur-overlay-property-name t)
- (overlay-put ovl 'face 'isearch))
- overlays)))
+ (map 'list #'(lambda (match)
+ (make-overlay
+ (nth 1 match)
+ (nth 2 match)
+ (current-buffer) t nil))
+ buffer-matches)))
+ ;; !ME! To remove highlighting of the matching regexp
+ (if loccur-highlight-matching-regexp
+ (mapcar (lambda (ovl)
+ (overlay-put ovl loccur-overlay-property-name t)
+ (overlay-put ovl 'face 'isearch))
+ overlays))))
(defun loccur-create-invisible-overlays (ovl-bounds)
(let ((overlays
- (mapcar (lambda (bnd)
- (make-overlay
- (car bnd)
- (cadr bnd)
- (current-buffer) t nil))
- ovl-bounds)))
- (mapcar (lambda (ovl)
+ (map 'list #'(lambda (bnd)
+ (make-overlay
+ (car bnd)
+ (cadr bnd)
+ (current-buffer) t nil))
+ ovl-bounds)))
+ (mapcar (lambda (ovl)
(overlay-put ovl loccur-overlay-property-name t)
(overlay-put ovl 'invisible t)
;; force intangible property if invisible property
@@ -205,9 +214,9 @@ if its size is 1 line"
(defun loccur-create-overlay-bounds-btw-lines (buffer-matches)
(let ((prev-end (point-min))
- (overlays (list)))
- (when buffer-matches
- (mapcar (lambda (line)
+ (overlays (list)))
+ (when buffer-matches
+ (mapcar (lambda (line)
(let ((beginning (car line)))
(unless ( = (- beginning prev-end) 1)
(let ((ovl-start (if (= prev-end 1) 1 prev-end))
@@ -215,8 +224,8 @@ if its size is 1 line"
(push (list ovl-start ovl-end) overlays)))
(setq prev-end (nth 3 line))))
buffer-matches)
- (push (list (1+ prev-end) (point-max)) overlays)
- (setq overlays (nreverse overlays)))))
+ (push (list (1+ prev-end) (point-max)) overlays)
+ (setq overlays (nreverse overlays)))))
(defun loccur-find-matches (regex)
@@ -224,19 +233,19 @@ if its size is 1 line"
1st match begin of a line, 1st match end of a line, end of a line
containing match"
(save-excursion
- ;; Go to the beginnig of buffer
- (goto-char (point-min))
- ;; Set initial values for variables
- (let ((matches 0)
- (curpoint nil)
- (endpoint nil)
- (lines (list)))
- ;; Search loop
- (while (not (eobp))
- (setq curpoint (point))
- ;; if something found
- (when (setq endpoint (re-search-forward regex nil t))
- (save-excursion
+ ;; Go to the beginnig of buffer
+ (goto-char (point-min))
+ ;; Set initial values for variables
+ (let ((matches 0)
+ (curpoint nil)
+ (endpoint nil)
+ (lines (list)))
+ ;; Search loop
+ (while (not (eobp))
+ (setq curpoint (point))
+ ;; if something found
+ (when (setq endpoint (re-search-forward regex nil t))
+ (save-excursion
(let ((found-begin (match-beginning 0))
(found-end (match-end 0)))
;; Get the start and the and of the matching line
@@ -244,11 +253,11 @@ containing match"
(goto-char found-begin)
(setq endpoint (line-end-position))
(push (list (line-beginning-position) found-begin found-end
endpoint) lines)))
- ;; maybe add some code to highlight matches like in occur-mode?
- ;; goto the end of line for any case
- (goto-char endpoint))
- (forward-line 1))
- (setq lines (nreverse lines)))))
+ ;; maybe add some code to highlight matches like in
occur-mode?
+ ;; goto the end of line for any case
+ (goto-char endpoint))
+ (forward-line 1))
+ (setq lines (nreverse lines)))))
(provide 'loccur)
