isearch hacks, objed integration

my-isearch.el

;;; -*-lexical-binding: t; -*-

(when (fboundp #'global-anzu-mode)
  (global-anzu-mode 1))

(setq isearch-allow-scroll t)
(setq isearch-lazy-highlight-initial-delay 0)


(defun flash-mode-line ()
  (let ((nc (face-attribute 'isearch :background))
        (color (face-attribute 'mode-line :background))
        (box (face-attribute 'mode-line :box)))
    (set-face-attribute 'mode-line nil :background nc)
    (when box
      (set-face-attribute 'mode-line nil
                          :box (plist-put (copy-sequence box)
                                          :color nc)))
    ;; this call redisplay...
    (sit-for (or time 0.15))
    (set-face-attribute 'mode-line nil :background color)
    (set-face-attribute 'mode-line nil :box box)))

(defun my-flash-bottom (&optional time)
  (if (or (= (line-end-position) (point-max))
          (= (1+ (line-end-position)) (point-max)))
      (flash-mode-line)
  (require 'pulse)
  (let ((pulse-delay 0.03))
    (redisplay)
    (pulse-momentary-highlight-one-line (save-excursion
                                          (forward-line 1)
                                          (point))
                                        'isearch))))

(defun my-flash-top ()
  (require 'pulse)
  (let ((pulse-delay 0.03))
    (redisplay)
    (pulse-momentary-highlight-one-line (save-excursion
                                          (forward-line -1)
                                          (point))
                                        'isearch)))

(add-hook 'isearch-mode-hook
          (defun my-isearch-init-fun ()
            (setq my-cursor-color (frame-parameter nil 'cursor-color))
            (let ((str (car (if isearch-regexp regexp-search-ring search-ring))))
              (when str
                (setq isearch-message (concat isearch-message "[ " str " ] "))
                (isearch-update)))))

(add-hook 'isearch-update-post-hook
          (defun my-isearch-update-fun ()
            (when isearch-wrapped
              (if isearch-forward
                  (my-flash-top)
                (my-flash-bottom))
              (setq isearch-wrapped nil))
            (when (and (memq last-command
                             '(isearch-forward-regexp
                               isearch-backward-regexp
                               isearch-forward
                               isearch-backward))
                       (string-match
                        (format "\\`\\[ %s \\] "
                                (car (if isearch-regexp
                                         regexp-search-ring
                                       search-ring)))
                                     isearch-message)
                       (eq this-command 'isearch-printing-char))
              (setq isearch-message isearch-string)
              (isearch-update))))


;; wrapping and quick direction change
(defun my-isearch-repeat-forward ()
  (interactive)
  (unless isearch-forward
    (goto-char isearch-other-end))
  (isearch-repeat-forward)
  (unless isearch-success
    (isearch-repeat-forward)))

(defun my-isearch-repeat-backward ()
  (interactive)
  (when (and isearch-forward isearch-other-end)
    (goto-char isearch-other-end))
  (isearch-repeat-backward)
  (unless isearch-success
    (isearch-repeat-backward)))


;; * Isearch M-n/M-p

(defun my-get-isearch-suggestions ()
  (delete
   isearch-string
   (delete-dups
    (delete ""
            (delq nil
                  (if isearch-regexp
                      (list (find-tag-default-as-regexp)
                            (find-tag-default-as-symbol-regexp))
                    (list (thing-at-point 'symbol))))))))

(defun my-isearch-advance ()
  (interactive)
  (if (symbol-value (if isearch-regexp
                        'regexp-search-ring-yank-pointer
                      'search-ring-yank-pointer))
      (call-interactively
       (setq this-command 'isearch-ring-advance))
    (let ((curr isearch-string))
      (when (eq last-command this-command)
        (isearch-pop-state))
      (let ((string (car (delete curr (my-get-isearch-suggestions)))))
        (when string
          (if (and isearch-case-fold-search
                   (eq 'not-yanks search-upper-case))
              (setq string (downcase string)))
          ;; Don't move cursor in reverse search.
          (setq isearch-yank-flag t)
          (setq isearch-string string)
          (setq isearch-message string)
          (isearch-search-and-update)
          (my-isearch-modal))))))

(define-key isearch-mode-map [remap isearch-ring-advance]
  #'my-isearch-advance)


;; * modal settings, objed integration

(defvar my-cursor-color nil)
(defvar objed-cursor-color "#e52b50")

(defun my-isearch-modal (&rest _)
  (unless (isearch-fail-pos)
    (set-cursor-color objed-cursor-color)
    (hl-line-mode 1)
    (set-transient-map my-isearch-modal-map)))


(defun my-ivy-reverse-i-search ()
  (interactive)
  (minibuffer-with-setup-hook
      'my-ivy-reverse-i-search-1
      (isearch-edit-string)))

(defun my-ivy-reverse-i-search-1 ()
  (let ((enable-recursive-minibuffers t)
        (history (cdr regexp-search-ring))
        (old-last ivy-last)
        (ivy-recursive-restore nil))
    (ivy-read "Reverse-i-search: "
              (delete-dups (copy-sequence history))
              :action (lambda (x)
                        (ivy--reset-state
                         (setq ivy-last old-last))
                        (delete-minibuffer-contents)
                        (insert (substring-no-properties x))
                        ;; exit back to search
                        (setq unread-command-events
                              (listify-key-sequence (kbd "RET")))))))

(defvar my-isearch-modal-map
  (let ((map (make-composed-keymap nil isearch-mode-map)))
    (define-key map [remap isearch-printing-char] 'isearch-exit)
    (define-key map (kbd "C-s") 'my-isearch-repeat-forward)
    (define-key map (kbd "s") 'my-isearch-repeat-forward)
    (define-key map (kbd "r") 'my-isearch-repeat-backward)
    (define-key map (kbd "c") 'objed-object-map)
    (define-key map (kbd "C-r") 'my-isearch-repeat-backward)
    (define-key map (kbd "C-g") 'isearch-abort)
    (define-key map (kbd "g") 'isearch-exit)

    (define-key map "j" 'swiper-from-isearch)
    (define-key map (kbd "M-p") 'my-ivy-reverse-i-search)
    (define-key map "z" 'avy-isearch)

    ;; show non modal state
    (define-key map (kbd "%") (if (bound-and-true-p global-anzu-mode)
                                  'anzu-isearch-query-replace-regexp
                                'isearch-query-replace-regexp))

    (define-key map (kbd "DEL") (lambda () (interactive)
                                  (isearch-del-char)
                                  (set-cursor-color my-cursor-color)
                                  (hl-line-mode -1)))

    (define-key map (kbd "<backspace>") (lambda () (interactive)
                                          (isearch-del-char)
                                          (set-cursor-color my-cursor-color)
                                          (hl-line-mode -1)))
    ;; will call end-hook...
    (define-key map [t] 'isearch-exit)
    map))

(add-hook 'isearch-mode-end-hook
      (defun my-isearch-modal-reset ()
        (set-cursor-color my-cursor-color)
            (hl-line-mode -1)
            (let (cmd)
              ;; executre command which exited the map
              (cond ((and (bound-and-true-p objed-mode)
                          (setq cmd (lookup-key objed-map (this-command-keys-vector)))
                          ;; exclude command which exit to some other command
                          (not (memq cmd '(objed-occur objed-ace objed-objed-replace))))
                     (objed--init 'char))
                    ((setq cmd (key-binding (this-command-keys-vector)))))
              (when (and (symbolp cmd)
                         (commandp cmd)
                         (not (eq this-command 'avy-isearch))
                         ;; map indirection somewhow lets this exectue two times
                         (not (string-match "-object$" (symbol-name cmd)))
                         (not (memq cmd
                                    '(self-insert-command org-self-insert-command
                                                          outshine-self-insert-command))))
                (call-interactively cmd)))))



(advice-add 'isearch-repeat-forward :after 'my-isearch-modal)
(advice-add 'isearch-repeat-backward :after 'my-isearch-modal)
(advice-add 'isearch-forward-symbol-at-point :after 'my-isearch-modal)
(advice-add 'isearch-edit-string :after 'my-isearch-modal)


(define-key isearch-mode-map [remap isearch-ring-retreat] 'my-ivy-reverse-i-search)
(define-key isearch-mode-map [remap isearch-repeat-forward] 'my-isearch-repeat-forward)
(define-key isearch-mode-map [remap isearch-repeat-backward] 'my-isearch-repeat-backward)
(define-key isearch-mode-map [remap isearch-delete-char] 'my-isearch-delete);;'isearch-del-char)

;; see https://emacs.stackexchange.com/a/10360/9198
(defun my-isearch-delete ()
  "Delete the failed portion of the search string, or the last char if successful."
  (interactive)
  (if (= 0 (length isearch-string))
      (ding)
    (setq isearch-string
          (substring
           isearch-string 0 (or (isearch-fail-pos) (1- (length isearch-string))))
          isearch-message
          (mapconcat 'isearch-text-char-description isearch-string "")))
  ;; Do the following before moving point.
  (funcall (or isearch-message-function #'isearch-message) nil t)
  ;; Use the isearch-other-end as new starting point to be able
  ;; to find the remaining part of the search string again.
  ;; This is like what `isearch-search-and-update' does,
  ;; but currently it doesn't support deletion of characters
  ;; for the case where unsuccessful search may become successful
  ;; by deletion of characters.
  (if isearch-other-end (goto-char isearch-other-end))
  (isearch-search)
  (isearch-push-state)
  (isearch-update))


;; smarter isearch for regions:
(defun isearch-region-dwim-helper ()
  (when (region-active-p)
    (let* ((beg (min (mark) (point)))
           (end (max (mark) (point)))
           (search-text (buffer-substring-no-properties beg end))
           (symbol-bounds (bounds-of-thing-at-point 'symbol)))
      (when (and search-text
                 ;; Assume that multi-line regions should be extended,
                 ;; not searched literally.
                 (= (line-number-at-pos beg)
                    (line-number-at-pos end)))
        (deactivate-mark)
        (setq isearch-regexp t
              ;; If region is a subregion of the current symbol, then
              ;; limit it to the contents of symbols in the current buffer
              isearch-string (if (and (car symbol-bounds)
                                      (>= beg (car symbol-bounds))
                                      (<= end (cdr symbol-bounds)))
                                 (concat "\\_<"
                                         ;; If the region matches the
                                         ;; beginning or end of a symbol
                                         ;; anchor it there.
                                         (if (= beg (car symbol-bounds)) ""
                                           "\\(\\s_\\|\\sw\\)*")
                                         (regexp-quote search-text)
                                         (if (= end (cdr symbol-bounds)) ""
                                           "\\(\\s_\\|\\sw\\)*")
                                         "\\_>")
                               (regexp-quote search-text))
              isearch-message (mapconcat #'isearch-text-char-description
                                         isearch-string
                                         ""))))))

(add-hook 'isearch-mode-hook #'isearch-region-dwim-helper)


(provide 'isearch-hacks)