branch: elpa/isl
commit 56bd2c201c5ee9893de208746e9c97ffa3e61035
Author: Thierry Volpiatto <[email protected]>
Commit: Thierry Volpiatto <[email protected]>
Delete isearch-light.el
---
isearch-light.el | 953 -------------------------------------------------------
1 file changed, 953 deletions(-)
diff --git a/isearch-light.el b/isearch-light.el
deleted file mode 100644
index 8fa43b22bd9..00000000000
--- a/isearch-light.el
+++ /dev/null
@@ -1,953 +0,0 @@
-;;; isearch-light.el --- Simple incremental search in current-buffer -*-
lexical-binding: t -*-
-
-;; Author: Thierry Volpiatto <[email protected]>
-;; Copyright (C) 2021 Thierry Volpiatto <[email protected]>
-
-;; Version: 1.0
-;; URL: https://github.com/thierryvolpiatto/isearch-light
-
-;; Compatibility: GNU Emacs 24.3+
-;; Package-Requires: ((emacs "24.3"))
-
-;; 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:
-
-;; Isearch-light is a small package to search regexp incrementaly in
-;; current-buffer. It is simple to use, just call M-x `isl-search'.
-
-;;; Code:
-
-(require 'cl-lib)
-
-(defvar iedit-aborting)
-(defvar iedit-read-only-occurrences-overlays)
-(defvar iedit-read-only-occurrences-overlays)
-(defvar iedit-case-sensitive)
-(defvar iedit-occurrences-overlays)
-(defvar iedit-mode)
-(defvar helm-occur-always-search-in-current)
-(defvar hs-minor-mode)
-(defvar hs-show-hook)
-(declare-function iedit-make-read-only-occurrence-overlay "ext:iedit-lib.el")
-(declare-function iedit-make-occurrence-overlay "ext:iedit-lib.el")
-(declare-function iedit-update-index "ext:iedit-lib.el")
-(declare-function iedit-lib-cleanup "ext:iedit-lib.el")
-(declare-function iedit-start "ext:iedit.el")
-(declare-function iedit-done "ext:iedit.el")
-(declare-function outline-show-entry "outline.el")
-(declare-function org-reveal "org.el")
-(declare-function helm-multi-occur-1 "ext:helm-occur.el")
-(declare-function hs-show-block "hideshow.el")
-(declare-function markdown-show-entry "ext:markdown-mode.el")
-
-;; Internals
-(defvar isl-pattern "")
-(defvar-local isl-last-query nil)
-(defvar-local isl-last-object nil)
-(defvar isl-visited-buffers nil)
-(defvar isl-current-buffer nil)
-(defvar isl--item-overlays nil)
-(defvar isl--iterator nil)
-(defvar isl--last-overlay nil)
-(defvar isl--direction nil)
-(defvar isl-initial-pos nil)
-(defvar isl--number-results 0)
-(defvar isl-history nil)
-(defvar isl--yank-point nil)
-(defvar isl--quit nil)
-(defvar isl--invalid nil)
-(defvar-local isl--buffer-invisibility-spec nil)
-(defconst isl-space-regexp "\\s\\\\s-"
- "Match a quoted space in a string.")
-(defconst isl--case-fold-choices '(smart nil t))
-(defvar isl--case-fold-choices-iterator nil)
-(defvar isl-help-buffer-name "*isl help*")
-(defvar isl--hidding nil)
-(defvar isl--point-min nil)
-(defvar isl--point-max nil)
-(defvar isl-help-string
- "* Isearch-light help\n
-** Commands
-\\<isl-map>
-\\[isl-display-or-quit-help]\t\tDisplay or quit this help buffer
-\\[isl-help-quit]\t\tQuit this help buffer
-\\[abort-recursive-edit]\t\tQuit isl and restore initial position
-\\[isl-goto-next]\t\tGoto next occurence
-\\[isl-goto-prev]\t\tGoto previous occurence
-\\[isl-scroll-down]\t\tScroll down
-\\[isl-scroll-up]\t\tScroll up
-\\[isl-exit-at-point]\t\tExit at current position
-\\[abort-recursive-edit]\t\tQuit and restore position
-\\[isl-yank-word-at-point]\t\tYank word at point
-\\[isl-recenter]\t\tRecenter current buffer
-\\[isl-change-matching-style]\t\tChange matching style
-\\[isl-select-case-fold-search]\t\tChange case fold search (cycle: *=smart,
1=t, 0=nil)
-\\[isl-goto-first]\t\tGoto first occurence
-\\[isl-goto-last]\t\tGoto last occurence
-\\[isl-goto-closest-from-start]\t\tGoto closest occurence from start
-\\[isl-jump-to-helm-occur]\t\tJump to helm-occur
-\\[isl-jump-to-iedit-mode]\t\tJump to iedit-mode
-\\[isl-query-replace]\t\tJump to query replace
-\\[isl-show-or-hide-context-lines]\t\tHide or show non matching lines")
-
-;; User vars
-(defvar isl-timer-delay 0.01)
-
-(defgroup isearch-light nil
- "Open `isl-search'."
- :prefix "isl-"
- :group 'matching)
-
-(defcustom isl-search-function #'re-search-forward
- "The search function that will be used by default when starting `isl-search'.
-Possible values are `re-search-forward' and `search-forward', the
-first use regexp matching while the second is using literal matching.
-Its value can be changed during `isl-search' session with
`\\<isl-map>\\[isl-change-matching-style]'."
- :type '(choice
- (function :tag "Regexp matching" re-search-forward)
- (function :tag "Literal matching" search-forward)))
-
-(defcustom isl-case-fold-search 'smart
- "The `case-fold-search' value.
-Possible value are nil, t or smart.
-Value smart means use `case-fold-search' when upcase chars are detected
-in pattern."
- :type 'symbol)
-
-(defcustom isl-after-position-string ">"
- "The string used to notify in mode-line when position is above initial pos."
- :type 'string)
-
-(defcustom isl-before-position-string "<"
- "The string used to notify in mode-line when position is below initial pos."
- :type 'string)
-
-(defcustom isl-direction-down-string "↓"
- "The string used in mode-line to notify search direction."
- :type 'string)
-
-(defcustom isl-direction-up-string "↑"
- "The string used in mode-line to notify search direction."
- :type 'string)
-
-(defcustom isl-warning-char "⚠"
- "Used to signal invalid regexp in mode-line."
- :type 'string)
-
-(defcustom isl-save-pos-to-mark-ring t
- "Save initial position to mark-ring on exit when non nil."
- :type 'boolean)
-
-(defcustom isl-requires-pattern 1
- "Start updating after this number of chars."
- :type 'integer)
-
-(defcustom isl-visible-context-lines 1
- "Number of lines to show around line when hiding non matching lines."
- :type 'integer)
-
-(defface isl-match
- '((t :background "Brown4"))
- "Face used to highlight the items matched.")
-
-(defface isl-on
- '((t :background "SandyBrown"
- :foreground "black"))
- "Face used to highlight the item where point is.")
-
-(defface isl-line
- '((t :background "Darkgoldenrod1" :extend t))
- "Face used to flash line on exit.")
-
-(defface isl-number
- '((t :foreground "green"))
- "Face used to highlight number in mode-line.")
-
-(defface isl-string
- '((t :foreground "Lightgoldenrod1" :bold t))
- "Face used to highlight pattern in mode-line.")
-
-(defface isl-case-fold
- '((t :inherit isl-string))
- "Face used to highlight case sensitivity string in mode-line.")
-
-(defvar isl-map
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map minibuffer-local-map)
- (define-key map (kbd "C-s") 'isl-goto-next)
- (define-key map (kbd "C-r") 'isl-goto-prev)
- (define-key map (kbd "C-n") 'isl-goto-next)
- (define-key map (kbd "C-p") 'isl-goto-prev)
- (define-key map (kbd "<down>") 'isl-goto-next)
- (define-key map (kbd "<up>") 'isl-goto-prev)
- (define-key map (kbd "RET") 'isl-exit-at-point)
- (define-key map (kbd "C-w") 'isl-yank-word-at-point)
- (define-key map (kbd "M-r") 'isl-change-matching-style)
- (define-key map (kbd "C-c f") 'isl-select-case-fold-search)
- (define-key map (kbd "M-<") 'isl-goto-first)
- (define-key map (kbd "M->") 'isl-goto-last)
- (define-key map (kbd "M-=") 'isl-goto-closest-from-start)
- (define-key map (kbd "M-s") 'isl-jump-to-helm-occur)
- (define-key map (kbd "C-;") 'isl-jump-to-iedit-mode)
- (define-key map (kbd "M-%") 'isl-query-replace)
- (define-key map (kbd "C-h m") 'isl-display-or-quit-help)
- (define-key map (kbd "C-q") 'isl-help-quit)
- (define-key map (kbd "C-'") 'isl-show-or-hide-context-lines)
- (define-key map (kbd "C-l") 'isl-recenter)
- (define-key map (kbd "C-v") 'isl-scroll-up)
- (define-key map (kbd "M-v") 'isl-scroll-down)
- (define-key map (kbd "C-k") 'isl-delete-minibuffer-contents)
- map))
-
-;;; Actions
-;;
-(defun isl--goto-overlay (overlay)
- "Goto OVERLAY."
- (let ((pos (and overlay (overlay-end overlay))))
- (when (and overlay pos)
- (setq isl--last-overlay overlay)
- (overlay-put overlay 'face 'isl-on)
- (goto-char pos)
- (setq isl--yank-point pos))))
-
-(defun isl--highlight-last-overlay (face)
- "Highlight `isl--last-overlay' with FACE."
- (when (overlayp isl--last-overlay)
- (overlay-put isl--last-overlay 'face face)))
-
-(defun isl-goto-next-1 (arg)
- "Main function that allow moving from one to another overlay.
-It put overlay on current position, move to next overlay using
-`isl--iterator', set `isl--yank-point' and then setup mode-line."
- (with-selected-window (minibuffer-selected-window)
- (isl--highlight-last-overlay 'isl-match)
- (when isl--iterator
- ;; This is a noop when ARG==1 i.e. (1- 1) == 0.
- (cl-loop repeat (1- arg) do (isl-iter-next isl--iterator))
- (isl--goto-overlay (isl-iter-next isl--iterator)))
- (isl-setup-mode-line)))
-
-(defun isl-scroll-1 (arg)
- "Scroll up if ARG is positive, down if it is negative."
- (let (ov)
- (with-selected-window (minibuffer-selected-window)
- (when isl--iterator
- (setq ov (if (> arg 0)
- (isl--first-ov-after-pos (window-end))
- (isl--first-ov-before-pos (window-start))))))
- (when ov
- (isl--find-and-goto-overlay ov)
- (with-selected-window (minibuffer-selected-window)
- (recenter)))))
-
-(defun isl--first-ov-after-pos (pos)
- (cl-loop for ov in isl--item-overlays
- when (> (overlay-start ov) pos)
- return ov))
-
-(defun isl--first-ov-before-pos (pos)
- (cl-loop for ov in (reverse isl--item-overlays)
- when (< (overlay-start ov) pos)
- return ov))
-
-(defun isl-scroll-up ()
- "Scroll up to closest overlay in next screen."
- (interactive)
- (isl-scroll-1 1))
-(put 'isl-scroll-up 'no-helm-mx t)
-
-(defun isl-scroll-down ()
- "Scroll down to closest overlay in previous screen."
- (interactive)
- (isl-scroll-1 -1))
-(put 'isl-scroll-down 'no-helm-mx t)
-
-(defun isl-delete-minibuffer-contents ()
- "No docstring."
- (interactive)
- (with-selected-window (minibuffer-window)
- (if (eolp)
- (delete-region (minibuffer-prompt-end) (point))
- (delete-region (point) (point-max)))))
-(put 'isl-delete-minibuffer-contents 'no-helm-mx t)
-
-(defun isl--find-and-goto-overlay (overlay)
- "Consume iterators up to OVERLAY and jump to it."
- (with-selected-window (minibuffer-selected-window)
- (let (ov)
- (while (not (eql (setq ov (isl-iter-next isl--iterator))
- overlay)))
- (isl--highlight-last-overlay 'isl-match)
- (and ov (isl--goto-overlay ov)))
- (isl-setup-mode-line)))
-
-(defun isl-goto-first ()
- "Goto first match."
- (interactive)
- (let ((ov (car isl--item-overlays)))
- (if (eql ov isl--last-overlay)
- (user-error "Already at first occurence")
- (isl--find-and-goto-overlay ov))))
-(put 'isl-goto-first 'no-helm-mx t)
-
-(defun isl-goto-last ()
- "Goto last match."
- (interactive)
- (let ((ov (car (last isl--item-overlays))))
- (if (eql ov isl--last-overlay)
- (user-error "Already at last occurence")
- (isl--find-and-goto-overlay ov))))
-(put 'isl-goto-last 'no-helm-mx t)
-
-(defun isl-goto-closest-from-start ()
- "Goto closest match from start."
- (interactive)
- (let ((ov (isl-closest-overlay
- isl-initial-pos isl--item-overlays)))
- (if (eql ov isl--last-overlay)
- (user-error "Already at closest occurence from start")
- (isl--find-and-goto-overlay ov))))
-(put 'isl-goto-closest-from-start 'no-helm-mx t)
-
-(defun isl-goto-next (&optional arg)
- "Go to next match."
- (interactive "p")
- (when (eq isl--direction 'backward)
- (setq isl--direction 'forward)
- (isl-set-iterator t))
- (isl-goto-next-1 arg))
-(put 'isl-goto-next 'no-helm-mx t)
-
-(defun isl-goto-prev (&optional arg)
- "Go to previous match"
- (interactive "p")
- (when (eq isl--direction 'forward)
- (setq isl--direction 'backward)
- (isl-set-iterator t))
- (isl-goto-next-1 arg))
-(put 'isl-goto-prev 'no-helm-mx t)
-
-(defun isl-exit-at-point ()
- "Exit minibuffer and jump at current position."
- (interactive)
- (with-selected-window (minibuffer-selected-window)
- ;; Ensure user haven't scrolled to another place.
- (goto-char (overlay-end isl--last-overlay))
- (when isl-save-pos-to-mark-ring
- (set-marker (mark-marker) isl-initial-pos)
- (push-mark isl-initial-pos 'nomsg))
- (let ((ov (make-overlay (point-at-bol) (1+ (point-at-eol)))))
- (overlay-put ov 'face 'isl-line)
- (sit-for 0.2)
- (delete-overlay ov)))
- ;; Call `exit-minibuffer' out of the `with-selected-window' block to
- ;; avoid error with the emacs-28 version.
- (exit-minibuffer))
-(put 'isl-exit-at-point 'no-helm-mx t)
-
-(defun isl-yank-word-at-point ()
- "Yank word at point in minibuffer.
-The word at point is relative to the current position in buffer, not
-the initial position i.e. the position before launching `isl-search'."
- (interactive)
- (let (str)
- (with-current-buffer isl-current-buffer
- (when (or (memq (char-syntax (or (char-after) 0)) '(?w ?_))
- (memq (char-syntax (or (char-after (1+ (point))) 0))
- '(?w ?_)))
- (setq str (buffer-substring-no-properties (or isl--yank-point (point))
- (save-excursion
- (forward-word)
- (point))))
- (when (string-match "\\` " str)
- (setq str (replace-match "\\\\ " nil nil str)))
- (with-selected-window (minibuffer-window)
- (insert str))))))
-(put 'isl-yank-word-at-point 'no-helm-mx t)
-
-(defun isl-recenter ()
- "Recenter from isl."
- (interactive)
- (with-selected-window (minibuffer-selected-window)
- (recenter)))
-(put 'isl-recenter 'no-helm-mx t)
-
-(defun isl-matching-style ()
- "Return current matching style as a string."
- (cl-ecase isl-search-function
- (re-search-forward "Regex")
- (search-forward "Literal")))
-
-(defun isl-change-matching-style ()
- "Toggle style matching in `isl-search' i.e. regexp/literal."
- (interactive)
- (with-current-buffer isl-current-buffer
- (setq-local isl-search-function
- (cl-ecase isl-search-function
- (re-search-forward #'search-forward)
- (search-forward #'re-search-forward)))
- (when (string= isl-pattern "")
- (let* ((style (isl-matching-style))
- (mode-line-format (format " Switching to %s searching" style)))
- (force-mode-line-update)
- (sit-for 1)))
- (isl-update)))
-(put 'isl-change-matching-style 'no-helm-mx t)
-
-(defun isl-jump-to-helm-occur ()
- "Invoke `helm-occur' from `isl-search'."
- (interactive)
- (cl-assert (require 'helm-occur nil t) nil "Please install Helm package")
- (let ((input isl-pattern)
- (bufs (list isl-current-buffer)))
- (run-at-time 0.1 nil
- (lambda ()
- ;; Use `helm-occur-always-search-in-current' as a
- ;; flag for `helm-occur--select-closest-candidate'.
- (let ((helm-occur-always-search-in-current t))
- (helm-multi-occur-1 bufs input))))
- (abort-recursive-edit)))
-(put 'isl-jump-to-helm-occur 'no-helm-mx t)
-
-(defun isl-query-replace (&optional arg)
- (interactive "P")
- (let ((style (isl-matching-style))
- (regexp isl-pattern)
- (start (overlay-start isl--last-overlay)))
- (run-at-time
- 0.1 nil
- (lambda ()
- (let* ((regexp-flag (string= style "Regex"))
- (prompt (if regexp-flag
- "Query replace %s regexp"
- "Query replace %s"))
- (args (list
- regexp
- (query-replace-read-to
- regexp
- (format prompt (if arg "word" ""))
- regexp-flag)
- arg)))
- (with-current-buffer isl-current-buffer
- (save-excursion
- (let ((case-fold-search t))
- (goto-char start)
- (apply #'perform-replace
- (list (nth 0 args) (nth 1 args)
- t regexp-flag (nth 2 args) nil
- multi-query-replace-map))))))))
- (abort-recursive-edit)))
-(put 'isl-query-replace 'no-helm-mx t)
-
-;; Iedit
-;;
-(defun isl--advice-iedit-start (old--fn &rest args)
- "Allow iedit matching multi pattern."
- (cl-letf (((symbol-function 'iedit-make-occurrences-overlays)
- #'isl--iedit-make-occurrences-overlays))
- (apply old--fn args)))
-
-(defun isl--iedit-make-occurrences-overlays (occurrence-regexp beg end)
- "Same as `iedit-make-occurrences-overlays' but handle multiple regexps."
- (setq iedit-aborting nil)
- (setq iedit-occurrences-overlays nil)
- (setq iedit-read-only-occurrences-overlays nil)
- ;; Find and record each occurrence's markers and add the overlay to the
occurrences
- (let ((counter 0)
- (case-fold-search (not iedit-case-sensitive))
- (length 0)
- bounds)
- (save-excursion
- (save-selected-window
- (goto-char beg)
- (while (setq bounds (isl-multi-search-fwd occurrence-regexp end t))
- (let ((beginning (car bounds))
- (ending (cdr bounds)))
- (if (and (> length 0) (/= (- ending beginning) length))
- (throw 'not-same-length 'not-same-length)
- (setq length (- ending beginning)))
- (if (text-property-not-all beginning ending 'read-only nil)
- (push (iedit-make-read-only-occurrence-overlay beginning
ending)
- iedit-read-only-occurrences-overlays)
- (push (iedit-make-occurrence-overlay beginning ending)
- iedit-occurrences-overlays))
- (setq counter (1+ counter))))))
- (iedit-update-index)
- counter))
-
-(defun isl-jump-to-iedit-mode ()
- "Start Iedit mode from `isl' using last search string as the regexp."
- (interactive)
- (cl-assert (require 'iedit nil t))
- (let ((regexp (if (eq isl-search-function 'search-forward)
- (regexp-quote isl-pattern)
- isl-pattern))
- (pos (with-current-buffer isl-current-buffer
- (overlay-end isl--last-overlay))))
- (run-at-time
- 0.1 nil
- (lambda ()
- (save-restriction
- (when (and isl--point-min isl--point-max)
- (narrow-to-region isl--point-min isl--point-max))
- (let ((case-fold-search (isl-set-case-fold-search regexp))
- result)
- (setq mark-active nil)
- (run-hooks 'deactivate-mark-hook)
- (when iedit-mode
- (iedit-lib-cleanup))
- (advice-add 'iedit-start :around #'isl--advice-iedit-start)
- (unwind-protect
- (progn
- (setq result
- (catch 'not-same-length
- (iedit-start regexp (point-min) (point-max))))
- (cond ((not iedit-occurrences-overlays)
- (message "No matches found for %s" regexp)
- (iedit-done))
- ((equal result 'not-same-length)
- (message "Matches are not the same length.")
- (iedit-done)))
- (goto-char pos))
- (advice-remove 'iedit-start #'isl--advice-iedit-start))))))
- (abort-recursive-edit)))
-(put 'isl-jump-to-iedit-mode 'no-helm-mx t)
-
-(defun isl-display-or-quit-help ()
- "Display or quit isl help buffer."
- (interactive)
- (if (get-buffer-window isl-help-buffer-name 'visible)
- (progn
- (switch-to-buffer isl-help-buffer-name)
- (quit-window t))
- (with-current-buffer-window
- (get-buffer-create isl-help-buffer-name)
- (cons 'display-buffer-below-selected
- '((window-height . fit-window-to-buffer)
- (preserve-size . (nil . t))))
- nil
- (with-current-buffer standard-output
- (insert
- (substitute-command-keys
- isl-help-string)))
- (outline-mode)
- (setq buffer-read-only t)
- (local-set-key (kbd "q") 'quit-window))))
-(put 'isl-display-or-quit-help 'no-helm-mx t)
-
-(defun isl-help-quit ()
- (interactive)
- (let ((win (get-buffer-window isl-help-buffer-name 'visible)))
- (if win
- (with-selected-window win
- (quit-window))
- (user-error "No help buffer found"))))
-(put 'isl-help-quit 'no-helm-mx t)
-
-(defun isl-show-or-hide-context-lines ()
- "Hide or show non matching lines."
- (interactive)
- (when isl--item-overlays
- (with-selected-window (minibuffer-selected-window)
- (if (setq isl--hidding (not isl--hidding))
- (let ((start 1) ; start at point-min.
- ov-end bol)
- (save-excursion
- (goto-char (overlay-end (car isl--item-overlays)))
- (setq ov-end (point))
- (set (make-local-variable 'line-move-ignore-invisible) t)
- (add-to-invisibility-spec '(isl-invisible . t))
- (while (not (eobp))
- (forward-line (- isl-visible-context-lines))
- ;; Store position from n lines before
- ;; this overlay and bol and move to next overlay.
- (when (> (setq bol (point-at-bol)) start)
- (isl--put-invisible-overlay start (1- bol)))
- (goto-char ov-end)
- ;; Go to n lines after last overlay found and jump to
- ;; next overlay from there.
- (forward-line isl-visible-context-lines)
- (setq start (1+ (point-at-eol)))
- (goto-char (next-single-char-property-change ov-end 'isl))
- (setq ov-end (point)))
- ;; Store maybe remaining lines up to eob.
- (when (< start (point-max))
- (isl--put-invisible-overlay start (point-max)))))
- (remove-overlays nil nil 'isl-invisible t)
- (remove-from-invisibility-spec '(isl-invisible . t))))))
-(put 'isl-show-or-hide-context-lines 'no-helm-mx t)
-
-(defun isl--put-invisible-overlay (beg end)
- "Make an invisible overlay from BEG to END."
- (let ((ol (make-overlay beg end)))
- (overlay-put ol 'isl-invisible t)
- (overlay-put ol 'invisible 'isl-invisible)))
-
-(defun isl-iter-circular (seq)
- "Infinite iteration on SEQ."
- (let ((lis seq))
- (lambda ()
- (let ((elm (car lis)))
- (setq lis (pcase lis (`(,_ . ,ll) (or ll seq))))
- elm))))
-
-(defun isl-iter-next (iterator)
- "Return next elm of ITERATOR."
- (and iterator (funcall iterator)))
-
-(defun isl-delete-overlays ()
- "Cleanup ovelays."
- (when isl--item-overlays
- (remove-overlays nil nil 'isl t)
- (setq isl--item-overlays nil)))
-
-(cl-defun isl-set-case-fold-search (&optional (pattern isl-pattern))
- "Return a suitable value for `case-fold-search'.
-This is done according to `isl-case-fold-search'.
-Optional argument PATTERN default to `isl-pattern'."
- (cl-case isl-case-fold-search
- (smart (let ((case-fold-search nil))
- (if (string-match "[[:upper:]]" pattern) nil t)))
- (t isl-case-fold-search)))
-
-(defun isl-select-case-fold-search ()
- "Set `case-fold-search' from `isl-search' session."
- (interactive)
- (with-current-buffer isl-current-buffer
- (if (eq last-command 'isl-select-case-fold-search)
- (setq-local isl-case-fold-search
- (isl-iter-next isl--case-fold-choices-iterator))
- (setq isl--case-fold-choices-iterator
- (isl-iter-circular
- (append (remove isl-case-fold-search isl--case-fold-choices)
- (list isl-case-fold-search))))
- (setq-local isl-case-fold-search
- (isl-iter-next isl--case-fold-choices-iterator)))
- (isl-update)))
-(put 'isl-select-case-fold-search 'no-helm-mx t)
-
-(defun isl-split-string (str)
- "Split string STR at non quoted spaces."
- (split-string
- (replace-regexp-in-string
- isl-space-regexp "\\s-" str nil t)))
-
-(defun isl-patterns (str)
- "Returns an alist of (pred . regexp) elements from STR."
- (cl-loop for s in (isl-split-string str)
- collect (if (char-equal ?! (aref s 0))
- (cons 'not (substring s 1))
- (cons 'identity s))))
-
-(defun isl-multi-search-fwd (str &optional _bound _noerror _count)
- "Returns position of symbol matched by STR.
-When arg STR contains spaces, it is converted in patterns with
-`isl-patterns' , when first pattern of list match a symbol
-subsequent patterns are used to check if all patterns match this
-symbol. The return value is a cons cell (beg . end) denoting
-symbol position."
- ;; Prevent infloop crashing Emacs with incorrect configuration.
- (cl-assert (memq isl-search-function '(re-search-forward search-forward)))
- (let* ((pattern (isl-patterns str))
- (initial (or (assq 'identity pattern)
- '(identity . "")))
- (rest (cdr pattern)))
- (cl-loop while (funcall isl-search-function (cdr initial) nil t)
- for bounds = (if rest
- (bounds-of-thing-at-point
- (if (derived-mode-p 'prog-mode)
- 'symbol 'filename))
- (cons (match-beginning 0) (match-end 0)))
- if (or (not rest)
- (cl-loop for (pred . re) in rest
- always (funcall pred
- (progn
- (goto-char (car bounds))
- (funcall isl-search-function
- re (cdr bounds) t)))))
- do (goto-char (cdr bounds)) and return bounds
- else do (goto-char (cdr bounds))
- finally return nil)))
-
-(defun isl-update ()
- "Update `current-buffer' when `isl-pattern' changes."
- (with-selected-window (minibuffer-selected-window)
- (while-no-input
- (when isl--hidding
- (remove-overlays nil nil 'isl-invisible t)
- (remove-from-invisibility-spec '(isl-invisible . t))
- (setq isl--hidding nil))
- (isl-delete-overlays)
- (setq isl--invalid nil)
- ;; We don't use the isearch-invisible mechanism which is heavy
- ;; and don't behave as we want, instead remove invisibility in
- ;; all buffer and on exit restore it and unhide only the place
- ;; where point is with appropriate functions belonging to
- ;; major-mode e.g. org => org-reveal etc...
- (when (and buffer-invisibility-spec
- (listp buffer-invisibility-spec))
- (mapc 'remove-from-invisibility-spec buffer-invisibility-spec))
- (let ((case-fold-search (isl-set-case-fold-search))
- (count 1)
- ov
- bounds)
- (unless (string= isl-pattern "")
- (save-excursion
- (goto-char (point-min))
- (condition-case-unless-debug nil
- (while (setq bounds (isl-multi-search-fwd isl-pattern nil t))
- (setq ov (make-overlay (car bounds) (cdr bounds)))
- (push ov isl--item-overlays)
- (overlay-put ov 'isl t)
- (overlay-put ov 'pos count)
- (overlay-put ov 'face 'isl-match)
- (cl-incf count))
- (invalid-regexp (setq isl--invalid t) nil))
- (setq isl--item-overlays (reverse isl--item-overlays)))
- (if (null isl--item-overlays)
- (progn (setq isl--number-results 0) (goto-char isl-initial-pos))
- (setq isl--last-overlay
- (isl-closest-overlay isl-initial-pos isl--item-overlays)
- isl--number-results (length isl--item-overlays))
- (isl--highlight-last-overlay 'isl-on)
- (isl-set-iterator)
- (goto-char (overlay-end (isl-iter-next isl--iterator)))
- (setq isl--yank-point (point)))))
- (isl-setup-mode-line))))
-
-(defun isl-setup-mode-line ()
- "Setup `mode-line-format' for `isl-search'."
- (let ((style (isl-matching-style))
- (position (with-current-buffer isl-current-buffer
- (if (> (point) isl-initial-pos)
- isl-after-position-string
- isl-before-position-string)))
- (direction (if (eq isl--direction 'forward)
- isl-direction-down-string
- isl-direction-up-string)))
- (setq mode-line-format
- (cond ((or (string= isl-pattern "")
- (<= (length isl-pattern)
- isl-requires-pattern))
- (default-value 'mode-line-format))
- ((zerop isl--number-results)
- `(" " mode-line-buffer-identification " "
- (:eval ,(format "%s `%s' [%s %s]"
- (if isl--invalid
- (propertize
- (format "%s Invalid regexp:"
isl-warning-char)
- 'face 'font-lock-warning-face)
- "No results found for pattern")
- (propertize isl-pattern
- 'face 'isl-string)
- style
- direction))
- " " mode-line-position))
- (t `(" " mode-line-buffer-identification " "
- (:eval ,(format
- "[%s/%s] result(s) found [%s %s %s %s]"
- (propertize
- (number-to-string
- (overlay-get isl--last-overlay 'pos))
- 'face 'isl-number)
- (propertize (number-to-string
- isl--number-results)
- 'face 'isl-number)
- style
- direction
- position
- (propertize (pcase isl-case-fold-search
- (`smart "*")
- (`t "1")
- (`nil "0"))
- 'face 'isl-case-fold)))
- " " mode-line-position))))))
-
-(defun isl-closest-overlay (pos overlays)
- "Return closest overlay from POS in OVERLAYS list."
- (cl-loop for ov in overlays
- for ovpos = (overlay-start ov)
- for diff = (if (> pos ovpos) (- pos ovpos) (- ovpos pos))
- collect (cons diff ov) into res
- minimize diff into min
- finally return (cdr (assq min res))))
-
-(defun isl-set-iterator (&optional skip-first)
- "Build `isl--iterator' against `isl--item-overlays' according to context.
-When SKIP-FIRST is specified build overlay with the current overlay
-appended at end."
- (let* ((revlst (if (eq isl--direction 'forward)
- isl--item-overlays
- (reverse isl--item-overlays)))
- (fwdlst (memql isl--last-overlay revlst))
- (ovlst (append (if skip-first (cdr fwdlst) fwdlst)
- (butlast revlst (length fwdlst))
- (and skip-first (list (car fwdlst))))))
- (setq isl--iterator (isl-iter-circular ovlst))))
-
-(defun isl-check-input ()
- "Check minibuffer input."
- (with-selected-window (minibuffer-window)
- (let ((input (minibuffer-contents)))
- (when (not (string= input isl-pattern))
- (setq isl-pattern input)
- (if (> (length input) isl-requires-pattern)
- (isl-update)
- (with-selected-window (minibuffer-selected-window)
- (isl-delete-overlays)
- (isl-setup-mode-line)
- (goto-char isl-initial-pos)))))))
-
-(defun isl-read-from-minibuffer (prompt &optional initial-input)
- "Read input from minibuffer with prompt PROMPT."
- (let (timer)
- (unwind-protect
- (minibuffer-with-setup-hook
- (lambda ()
- (setq timer (run-with-idle-timer
- isl-timer-delay 'repeat #'isl-check-input)))
- (read-from-minibuffer
- prompt initial-input isl-map nil 'isl-history
- (if (region-active-p)
- (buffer-substring-no-properties
- (region-beginning)
- (region-end))
- (thing-at-point 'symbol t))))
- (cancel-timer timer))))
-
-(defun isl-cleanup ()
- "Cleanup various things when `isl-search' exit."
- (with-current-buffer isl-current-buffer
- (let* ((pos (and isl--last-overlay ; nil when quitting with no results.
- (overlay-end isl--last-overlay)))
- (hs-show-hook (list (lambda () (and pos (goto-char pos))))))
- (when (buffer-live-p (get-buffer isl-help-buffer-name))
- (kill-buffer isl-help-buffer-name))
- (setq isl-last-object
- `(lambda ()
- (setq-local mode-line-format ',mode-line-format
- isl-last-query ,isl-pattern
- isl-initial-pos ,pos
- isl--yank-point ,isl--yank-point
- isl--number-results ,isl--number-results
- isl-case-fold-search ',isl-case-fold-search
- isl-search-function ',isl-search-function
- buffer-invisibility-spec ,buffer-invisibility-spec
- isl--hidding ,isl--hidding
- cursor-in-non-selected-windows
,cursor-in-non-selected-windows)))
- (isl-delete-overlays)
- (setq mode-line-format (default-value 'mode-line-format)
- isl--yank-point nil
- isl--iterator nil
- isl--item-overlays nil
- isl--last-overlay nil
- isl--number-results nil
- isl-case-fold-search (default-value 'isl-case-fold-search)
- isl-search-function (default-value 'isl-search-function)
- buffer-invisibility-spec isl--buffer-invisibility-spec
- isl--hidding nil
- cursor-in-non-selected-windows
- (default-value 'cursor-in-non-selected-windows))
- (remove-overlays nil nil 'isl-invisible t)
- (if isl--quit
- (setq isl--quit nil)
- (condition-case-unless-debug _err
- (cond ((eq major-mode 'org-mode)
- (org-reveal))
- ((eq major-mode 'outline-mode)
- (outline-show-entry))
- ((and (boundp 'hs-minor-mode)
- hs-minor-mode)
- (hs-show-block))
- ((and (boundp 'markdown-mode-map)
- (derived-mode-p 'markdown-mode))
- (markdown-show-entry)))
- (error nil))))))
-
-
-(defun isl-search-1 (&optional resume)
- "Launch isl in current-buffer."
- (unless resume
- (setq isl-initial-pos (point)
- isl-pattern ""
- isl--direction 'forward
- isl-current-buffer (current-buffer)
- isl--buffer-invisibility-spec buffer-invisibility-spec
- cursor-in-non-selected-windows nil))
- (when isl-current-buffer
- (setq isl-visited-buffers
- (cons isl-current-buffer
- (delete isl-current-buffer isl-visited-buffers))))
- (unwind-protect
- (condition-case-unless-debug nil
- (isl-read-from-minibuffer
- "Search: " (when resume
- (buffer-local-value
- 'isl-last-query isl-current-buffer)))
- (quit
- (setq isl--quit t)
- (goto-char isl-initial-pos)))
- (isl-cleanup)
- ;; Avoid loosing focus in helm help buffer.
- (unless (eq (window-buffer (selected-window))
- isl-current-buffer)
- (switch-to-buffer isl-current-buffer))))
-
-;;;###autoload
-(defun isl-search ()
- "Start incremental searching in current buffer."
- (interactive)
- (setq isl--point-min nil
- isl--point-max nil)
- (isl-search-1))
-
-(defun isl-resume (arg)
- "Resume isl session in current buffer.
-With a prefix arg choose one of the last buffers isl had visited."
- (interactive "P")
- (setq isl-current-buffer
- (cond ((and arg isl-visited-buffers)
- (get-buffer
- (completing-read
- "Resume from buffer: "
- (mapcar 'buffer-name isl-visited-buffers)
- nil t)))
- (isl-visited-buffers
- (car (memql (current-buffer)
- isl-visited-buffers)))
- (t isl-current-buffer)))
- (cl-assert isl-current-buffer
- nil "No buffer handling an isl session found")
- (switch-to-buffer isl-current-buffer)
- (with-current-buffer isl-current-buffer
- (funcall isl-last-object)
- (setq isl-pattern ""))
- (isl-search-1 'resume))
-
-;;;###autoload
-(defun isl-narrow-to-defun ()
- "Start incremental searching in current defun."
- (interactive)
- (setq isl--point-min nil
- isl--point-max nil)
- (save-restriction
- (narrow-to-defun)
- (setq isl--point-min (point-min)
- isl--point-max (point-max))
- (isl-search-1)))
-
-(provide 'isearch-light)
-
-;;; isearch-light.el ends here
