[elpa] master 8f6fe36 40/40: Add 'packages/loccur/' from commit 'fb1fbc0ff5da7a8b117542ab8083d29cd79e12b2'

[Alexey Veretennikov]

branch: master
commit 8f6fe36e1ad23834e9b772e8fcdfe85d5eb47356
Merge: ada08b0 fb1fbc0
Author: Alexey Veretennikov <address@hidden>
Commit: Alexey Veretennikov <address@hidden>

    Add 'packages/loccur/' from commit 
'fb1fbc0ff5da7a8b117542ab8083d29cd79e12b2'
    
    git-subtree-dir: packages/loccur
    git-subtree-mainline: ada08b05a1ff278c1e20d9af60fb22fe9f8e65fc
    git-subtree-split: fb1fbc0ff5da7a8b117542ab8083d29cd79e12b2
---
 packages/loccur/README.md |   50 +++++++
 packages/loccur/loccur.el |  323 +++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 373 insertions(+), 0 deletions(-)

diff --git a/packages/loccur/README.md b/packages/loccur/README.md
new file mode 100644
index 0000000..cea09cd
--- /dev/null
+++ b/packages/loccur/README.md
@@ -0,0 +1,50 @@
+# Loccur
+## Introduction
+**Loccur** is an amazing tool to quickly navigate in a file. It is a minor 
mode for Emacs acting like **occur** but w/o creating a new window. It just 
hides all the text excepting lines containing matches.
+## Installation
+Add to your `.emacs` or `.emacs.d/init.el` following lines:
+
+```scheme
+(setq package-archives '(("gnu" . "http://elpa.gnu.org/packages/";)
+                         ("melpa" . "http://melpa.milkbox.net/packages/";)))
+```
+                         
+Press `M-x` in GNU Emacs and write `list-packages`. Find the `loccur` in the 
list of packages and press `i` to select this package, `x` to install the 
package.
+
+
+## Screenshots
+Better to see it once:
+
+![loccur_gui](https://github.com/fourier/loccur/raw/screenshots/gui_emacs_with_loccur.gif
 "GUI Emacs with loccur")
+![loccur_term](https://github.com/fourier/loccur/raw/screenshots/emacs_with_loccur.gif
 "Emacs in terminal with loccur")
+
+
+## Usage
+
+To use it, add the following to your .emacs file:
+
+```scheme
+(require 'loccur)
+;; defines shortcut for loccur of the current word
+(define-key global-map [(control o)] 'loccur-current)
+;; defines shortcut for the interactive loccur command
+(define-key global-map [(control meta o)] 'loccur)
+;; defines shortcut for the loccur of the previously found word
+(define-key global-map [(control shift o)] 'loccur-previous-match)
+```
+
+Now you can point the cursor to the word and press `Ctrl+o` to hide all lines 
except those containing this word. Moving cursor to the required line and 
pressing `Ctrl+o` again will shows all the text. The good thing about this mode 
is what you can navigate through the buffer easily. `Ctrl+Shift+o` will repeat 
last search.
+
+### Available commands
+Below is the list of interactive commands available for user:
+
+* `loccur` interactively asks user for regexp to search or toggle search off 
(if `loccur-mode` is already enabled)
+* `loccur-current` searches for the current word under the cursor
+* `loccur-previous-match` repeat previous `loccur` command
+* `loccur-no-highlight` is the same as `loccur` but not highlighting matches
+* `loccur-toggle-highlight` toggles highlighting of matches
+
+### Customization
+* `loccur-jump-beginning-of-line` variable specifies if move the cursor to the 
beginning of the matching line. Default `nil`
+* `loccur-highlight-matching-regexp` variable whenever `loccur` should 
highlight matching words. Default `t`.
+* `loccur-face` face to be used while highlighting. Default points to 
`isearch` face.
diff --git a/packages/loccur/loccur.el b/packages/loccur/loccur.el
new file mode 100644
index 0000000..2921ba0
--- /dev/null
+++ b/packages/loccur/loccur.el
@@ -0,0 +1,323 @@
+;;; loccur.el --- Perform an occur-like folding in current buffer -*- 
lexical-binding: t; -*-
+
+;; Copyright (C) 2009-2016 Free Software Foundation, Inc
+;;
+;; Author: Alexey Veretennikov <address@hidden>
+;;
+;; Created: 2009-09-08
+;; Version: 1.2.2
+;; Package-Requires: ((cl-lib "0"))
+;; Keywords: matching
+;; URL: https://github.com/fourier/loccur
+;; Compatibility: GNU Emacs 23.x, GNU Emacs 24.x
+;;
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs 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.
+;;
+;; GNU Emacs 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 GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+;;
+;;; Commentary:
+;;
+;; Add the following to your .emacs file:
+;; 
+;; (require 'loccur)
+;; ;; defines shortcut for loccur of the current word
+;; (define-key global-map [(control o)] 'loccur-current)
+;; ;; defines shortcut for the interactive loccur command
+;; (define-key global-map [(control meta o)] 'loccur)
+;; ;; defines shortcut for the loccur of the previously found word
+;; (define-key global-map [(control shift o)] 'loccur-previous-match)
+;;
+;;; Issues:
+;; Using with smooth-scrolling.el sometimes
+;; gives unexpected jumps in loccur mode
+;;
+;;; TODO:
+;; 
+;;; Change Log:
+;;
+;; 2015-12-27 (1.2.2)
+;;    + Preparation for GNU ELPA submission. Removed contributions
+;;    without signed papers
+;;    + added loccur-face - face to highlight text, by default isearch
+;; 
+;; 2013-10-22 (1.2.1)
+;;    + Added custom option loccur-jump-beginning-of-line; removed some
+;;    of cl dependencies
+;;
+;; 2010-03-07 (1.1.1)
+;;    + Default value is taken from prompt instead of an edit area
+;;    (thanks to Nathaniel Flath)
+;;
+;; 2009-10-05 (1.1.0)
+;;    + Added highlighting of the matched strings
+;;    + Now inserts selected region to the prompt
+;;    + Added defun for applying last found regexp(loccur-previous-match)
+;;    + Added intangible property together with invisibility
+;;
+;; 2009-09-08 (1.0.0)
+;;    Initial Release.
+;;
+;;; Code:
+
+(require 'cl-lib)
+
+(defgroup loccur nil
+  "Perform an occur-like folding in current buffer."
+  :group 'tools)
+
+;; should be defined before define-minor-mode
+(defvar loccur-mode-map
+  (let ((map (make-sparse-keymap)))
+    (define-key map (kbd "RET") '(lambda () (interactive) (loccur nil)))
+    ;; redefine Ctrl+Up/Down to Up/Down, since it looks like some problem
+    ;; with backward-paragraph and forward-paragraph with invisible overlays
+    (define-key map (kbd "<C-up>") 'previous-line)
+    (define-key map (kbd "<C-down>") 'next-line)
+    map)
+  "Keymap for the variable `loccur-mode'.")
+
+;;;###autoload
+(define-minor-mode loccur-mode
+  "Minor mode for navigating through the file.
+Hides all lines without matches like `occur' does, but without opening
+a new window."
+  :lighter " loccur"
+  (if loccur-mode
+      (loccur-1 loccur-current-search)
+    (loccur-remove-overlays)
+    (recenter)))
+
+(defface loccur-face
+  '((t (:inherit isearch)))
+  "Loccur face")
+
+
+(defconst loccur-overlay-invisible-property-name 'loccur-invisible-overlay
+  "Property name of the overlay for all invisible text.")
+
+(defconst loccur-overlay-visible-property-name 'loccur-visible-overlay
+  "Property name of the overlay for all visible text.")
+
+(defcustom loccur-jump-beginning-of-line nil
+  "Set cursor to the beginning of the line when the loccur function is called.
+Default: nil"
+  :type '(boolean)
+  :group 'loccur)
+
+(defcustom loccur-highlight-matching-regexp t
+  "If set to nil, do not highlight matching words.
+Default: t"
+  :type '(boolean)
+  :group 'loccur)
+
+(defvar loccur-history nil
+  "History of previously searched expressions for the prompt.")
+
+(defvar-local loccur-last-match nil
+  "Last match found.")
+
+(defvar-local loccur-overlay-list nil
+  "A list of currently active overlays.")
+
+(defvar-local loccur-current-search nil
+  "The expression to search in the current active mode.")
+
+(defun loccur-current ()
+  "Call `loccur' for the current word."
+  (interactive)
+  (loccur (current-word)))
+
+
+(defun loccur-previous-match ()
+  "Call `loccur' for the previously found word."
+  (interactive)
+  (loccur loccur-last-match))
+
+(defun loccur-no-highlight (regex)
+  "Perform search like loccur, but temporary removing match highlight.
+REGEX is regexp to search"
+  (interactive
+   (if loccur-mode
+       nil
+     (list (read-string "Loccur: " (loccur-prompt) 'loccur-history))))
+  (let ((loccur-highlight-matching-regexp nil))
+    (loccur regex)))
+
+(defun loccur-toggle-highlight ()
+  "Toggle the highlighting of the match."
+  (interactive)
+  (setq loccur-highlight-matching-regexp (not 
loccur-highlight-matching-regexp))
+  (when loccur-mode
+    (dolist (ovl loccur-overlay-list)
+      (when (overlay-get ovl loccur-overlay-visible-property-name)
+        (overlay-put ovl 'face (if loccur-highlight-matching-regexp 
'loccur-face nil))))))
+
+(defun loccur (regex)
+  "Perform a simple grep in current buffer.
+
+This command hides all lines from the current buffer except those
+containing the regular expression REGEX.  A second call of the function
+unhides lines again"
+  (interactive
+   (if loccur-mode
+       (list nil)
+     (list (read-string "Loccur: " (loccur-prompt) 'loccur-history))))
+  (if (or loccur-mode
+          (= (length regex) 0))
+      (progn
+        ;; remove current search and turn off loccur mode
+        ;; to allow to call `loccur' multiple times
+        (setf loccur-current-search nil)
+        (loccur-mode 0))
+    ;; otherwise do as usual
+    ;; if the regex argument is not equal to previous search
+    (when (not (string-equal regex loccur-current-search))
+      (cl-pushnew regex loccur-history)
+      (setf loccur-current-search regex)
+      (loccur-mode)
+      (when loccur-jump-beginning-of-line
+        (beginning-of-line))))) ; optionally jump to the beginning of line
+
+
+(defun loccur-prompt ()
+  "Return the default value of the prompt.
+
+Default value for prompt is a current word or active region(selection),
+if its size is 1 line"
+  (let ((prompt
+         (if (and transient-mark-mode
+                  mark-active)
+             (let ((pos1 (region-beginning))
+                   (pos2 (region-end)))
+               ;; Check if the start and the end of an active region is on
+               ;; the same line
+               (when (save-excursion
+                       (goto-char pos1)
+                       (<= pos2 (line-end-position)))
+                   (buffer-substring-no-properties pos1 pos2)))
+           (current-word))))
+    prompt))
+
+
+(defun loccur-1 (regex)
+  "Implementation of the `loccur' functionality.
+
+REGEX is an argument to `loccur'."
+  (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))
+
+    (setq loccur-overlay-list
+          (append loccur-overlay-list
+                  (loccur-create-highlighted-overlays buffer-matches)))
+    (setq loccur-last-match regex)
+    (recenter)))
+
+(defun loccur-create-highlighted-overlays (buffer-matches)
+  "Create the list of overlays for BUFFER-MATCHES."
+  (let ((overlays
+         (mapcar (lambda (match)
+                   (make-overlay
+                    (nth 1 match)
+                    (nth 2 match)
+                    (current-buffer) t nil))
+                 buffer-matches)))
+    (mapc (lambda (ovl)
+            (overlay-put ovl loccur-overlay-visible-property-name t)
+            (when loccur-highlight-matching-regexp
+              (overlay-put ovl 'face 'loccur-face)))
+          overlays)))
+
+
+(defun loccur-create-invisible-overlays (ovl-bounds)
+  "Create a list of invisible overlays by given OVL-BOUNDS."
+  (let ((overlays
+         (mapcar (lambda (bnd)
+                   (make-overlay
+                    (car bnd)
+                    (cadr bnd)
+                    (current-buffer) t nil))
+                 ovl-bounds)))
+    (mapc (lambda (ovl)
+            (overlay-put ovl loccur-overlay-invisible-property-name t)
+            (overlay-put ovl 'invisible t)
+            ;; force intangible property if invisible property
+            ;; does not automatically set it
+            (overlay-put ovl 'intangible t))
+          overlays)))
+
+
+(defun loccur-remove-overlays ()
+  "Remove all overlays."
+  (remove-overlays (point-min) (point-max) 
loccur-overlay-visible-property-name t)
+  (remove-overlays (point-min) (point-max) 
loccur-overlay-invisible-property-name t)
+  (setq loccur-overlay-list nil))
+
+
+(defun loccur-create-overlay-bounds-btw-lines (buffer-matches)
+  "Create a list of overlays between matched lines BUFFER-MATCHES."
+  (let ((prev-end (point-min))
+        (overlays (list)))
+    (when buffer-matches
+      (mapc (lambda (line)
+              (let ((beginning (car line)))
+                (unless ( = (- beginning prev-end) 1)
+                  (let ((ovl-end  (1- beginning)))
+                    (push (list prev-end ovl-end) overlays)))
+                (setq prev-end (nth 3 line))))
+            buffer-matches)
+      (push (list (1+ prev-end) (point-max)) overlays)
+      (setq overlays (nreverse overlays)))))
+
+
+(defun loccur-find-matches (regex)
+  "Find all occurences in the current buffer for given REGEX.
+
+Returns a list of 4-number tuples, specifying begnning of the 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 ((endpoint nil)
+          (lines (list)))
+      ;; Search loop
+      (while (not (eobp))
+        ;; 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
+              ;; and store it to the overlays array
+              (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)))))
+
+        
+    
+
+
+(provide 'loccur)
+;;; loccur.el ends here