[elpa] master 440c96e 10/40: Added possibility of desactivating regex highlighting.

[Alexey Veretennikov]

branch: master
commit 440c96ebd3ae0b8e51a82da6835240489d62a35b
Author: Leo Perrin <address@hidden>
Commit: Alexey Veretennikov <address@hidden>

    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)