├── .gitignore ├── README.md ├── swoop-edit.el ├── swoop-lib.el └── swoop.el /.gitignore: -------------------------------------------------------------------------------- 1 | .DS_Store -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # !!DEPRECATED warning!! 2 | 3 | This package is deprecated and we suggest to move [helm-swoop](https://github.com/emacsorphanage/helm-swoop) instead. 4 | [helm-swoop](https://github.com/emacsorphanage/helm-swoop) is the successor to `swoop` and is well maintained. 5 | 6 | There are no additional feature updates and it is a low priority for bugs to be fixed. 7 | 8 | # Swoop.el 9 | 10 | Peculiar buffer navigation for Emacs. 11 | 12 | ![swoop.el](https://raw.githubusercontent.com/ShingoFukuyama/images/master/swoop.gif) 13 | 14 | ## Feature 15 | 16 | * Search words through a whole buffer or across buffers 17 | * Highlight target line and matched words 18 | * Stick to the nearest line even after update the list 19 | * Utilize PCRE (Perl Compatible Regular Expressions) like search 20 | * Utilize migemo (Japanese words search command) 21 | * Edit matched lines synchronously 22 | * Cache buffer information to start quickly 23 | * Shrink text size in buffers to view more 24 | * and more 25 | 26 | ## Config example 27 | 28 | ``` 29 | (require 'swoop) 30 | (global-set-key (kbd "C-o") 'swoop) 31 | (global-set-key (kbd "C-M-o") 'swoop-multi) 32 | (global-set-key (kbd "M-o") 'swoop-pcre-regexp) 33 | (global-set-key (kbd "C-S-o") 'swoop-back-to-last-position) 34 | (global-set-key (kbd "H-6") 'swoop-migemo) ;; Option for Japanese match 35 | ``` 36 | 37 | ## Swoop Edit Mode 38 | During swoop, press [C-c C-e] 39 | You can edit buffers synchronously. 40 | 41 | ## Transition 42 | 43 | ``` 44 | ;; isearch > press [C-o] > swoop 45 | ;; evil-search > press [C-o] > swoop 46 | ;; swoop > press [C-o] > swoop-multi 47 | (define-key isearch-mode-map (kbd "C-o") 'swoop-from-isearch) 48 | (define-key evil-motion-state-map (kbd "C-o") 'swoop-from-evil-search) 49 | (define-key swoop-map (kbd "C-o") 'swoop-multi-from-swoop) 50 | ``` 51 | swoop > swoop-multi can also inherit PCRE or migemo condition. 52 | 53 | ## Resume 54 | Use last used query by pressing C-u M-x swoop 55 | 56 | 57 | ## Require other elisp packages 58 | 59 | async.el https://github.com/jwiegley/emacs-async 60 | 61 | pcre2el.el https://github.com/joddie/pcre2el 62 | 63 | ht.el https://github.com/Wilfred/ht.el 64 | 65 | ## Options 66 | 67 | ### Window configuration 68 | ``` 69 | ;; t: Show swoop lines within the current window 70 | ;; nil: Show swoop lines in another window 71 | (setq swoop-window-split-current-window: nil) 72 | ;; Determine the split direction 'split-window-horizontally or 'split-window-vertically 73 | (setq swoop-window-split-direction: 'split-window-vertically) 74 | ``` 75 | 76 | 77 | ### Font size change 78 | ``` 79 | ;; Change whole buffer's font size (t or nil) 80 | (setq swoop-font-size-change: t) 81 | ;; Font size (e.g. 0.8, 1.0, 1.5, 80, 135) 82 | (setq swoop-font-size: 0.9) 83 | ``` 84 | 85 | 86 | ### Magnify around target line 87 | ``` 88 | ;; 89 | ;; Enable around target lines magnifier (t or nil) 90 | (setq swoop-use-target-magnifier: t) 91 | ;; Magnify area from target line 92 | (setq swoop-use-target-magnifier-around: 10) 93 | ;; Font size for magnify area (e.g. 0.8, 1.0, 1.5, 80, 135) 94 | (setq swoop-use-target-magnifier-size: 1.2) 95 | ``` 96 | 97 | 98 | ## Option for Japanese match by cmigemo command 99 | 100 | ``` 101 | ;; Install cmigemo command 102 | From https://github.com/koron/cmigemo 103 | 104 | If you use homebrew on Mac OSX 105 | `brew install cmigemo` 106 | 107 | ;; Specify the migemo-dict place in your system. 108 | (defvar swoop-migemo-options 109 | "-q -e -d /usr/local/share/migemo/utf-8/migemo-dict") 110 | ``` 111 | -------------------------------------------------------------------------------- /swoop-edit.el: -------------------------------------------------------------------------------- 1 | ;;; swoop-edit.el --- Peculiar buffer navigation -*- lexical-binding: t -*- 2 | 3 | ;; Copyright (C) 2014 by Shingo Fukuyama 4 | 5 | ;; This program is free software; you can redistribute it and/or 6 | ;; modify it under the terms of the GNU General Public License as 7 | ;; published by the Free Software Foundation; either version 2 of 8 | ;; the License, or (at your option) any later version. 9 | 10 | ;; This program is distributed in the hope that it will be 11 | ;; useful, but WITHOUT ANY WARRANTY; without even the implied 12 | ;; warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR 13 | ;; PURPOSE. See the GNU General Public License for more details. 14 | 15 | ;;; Commentary: 16 | 17 | ;;; Code: 18 | 19 | (require 'swoop-lib) 20 | 21 | (defvar swoop-edit-buffer "*Swoop Edit*") 22 | 23 | (defvar swoop-edit-map 24 | (let (($map (make-sparse-keymap))) 25 | ;; (define-key $map (kbd "C-x C-s") 'swoop-edit-apply-changes) 26 | (define-key $map (kbd "C-x C-s") 'swoop-edit-finish) 27 | (define-key $map (kbd "C-c C-c") 'swoop-edit-finish) 28 | $map)) 29 | (define-key swoop-map (kbd "C-c C-e") 'swoop-edit) 30 | 31 | (defun swoop-edit-finish () 32 | "Kill the edit buffer. The changes should have already been applied." 33 | (interactive) 34 | (select-window swoop--target-window) 35 | (with-current-buffer swoop--target-buffer 36 | (set-window-buffer nil swoop--target-buffer) 37 | (goto-char swoop--target-last-position)) 38 | (kill-buffer swoop-edit-buffer)) 39 | 40 | (defun swoop-modify-buffer-content ($bufcont) 41 | "Modify the original buffer content, but it causes slow rendering." 42 | $bufcont) 43 | 44 | (defsubst swoop-line-beg-point ($line &optional $buf) 45 | (with-current-buffer (or $buf (current-buffer)) 46 | (save-excursion 47 | (swoop-goto-line $line) (point)))) 48 | 49 | (defsubst swoop-set-marker ($line &optional $buf) 50 | (with-current-buffer (or $buf (current-buffer)) 51 | (save-excursion 52 | (swoop-goto-line $line) 53 | (set-marker (make-marker) (point))))) 54 | 55 | (defun swoop-edit () 56 | "Modify matched lines. Changes are automatically applying to target buffers." 57 | (interactive) 58 | (let (($bufcont (with-current-buffer swoop-buffer 59 | (buffer-substring 60 | (point-min) (point-max))))) 61 | (run-with-timer 62 | 0 nil 63 | (lambda ($bufcont $bufname) 64 | (when (get-buffer swoop-edit-buffer) 65 | (kill-buffer swoop-edit-buffer)) 66 | (funcall swoop-display-function swoop-edit-buffer) 67 | (erase-buffer) 68 | ;; Header 69 | (insert (propertize 70 | (concat " " $bufname "\n") 71 | 'face 72 | 'swoop-line-buffer-name-face 73 | 'intangible t)) 74 | ;; Body 75 | (insert $bufcont) 76 | (save-excursion 77 | (goto-char (point-min)) 78 | (add-text-properties (point-min) (point-max) 79 | '(read-only t rear-nonsticky t front-sticky t)) 80 | (let (($linum) 81 | (inhibit-read-only t)) 82 | (goto-char (point-min)) 83 | (while (not (eobp)) 84 | (goto-char (or (next-single-property-change (point) 'swl) (point-max))) 85 | (when (setq $linum (get-text-property (point) 'swl)) 86 | (let (($line-buf (get-text-property (point) 'swb))) 87 | (insert (propertize 88 | (format "%s:: " $linum) 89 | 'swp t 90 | 'face 'swoop-face-line-number 91 | 'intangible t 92 | 'rear-nonsticky t 93 | 'read-only t)) 94 | (put-text-property 95 | (point-at-bol) (point-at-eol) 96 | 'swm (save-excursion 97 | (with-current-buffer $line-buf 98 | (swoop-goto-line $linum) 99 | (set-marker 100 | (make-marker) 101 | (point))))) 102 | (remove-text-properties (point) (point-at-eol) '(read-only t)) 103 | (set-text-properties (point-at-eol) (1+ (point-at-eol)) 104 | '(read-only t rear-nonsticky t))))))) 105 | (swoop-overlay-word swoop-last-pattern (current-buffer)) 106 | (goto-char (point-min)) 107 | (forward-line 1) 108 | (re-search-forward "^[[:space:]]*\\([0-9]+\\)::[[:space:]]" nil t) 109 | (add-hook 'after-change-functions 'swoop-edit-sync nil t) 110 | (use-local-map swoop-edit-map)) 111 | ;; Args 112 | $bufcont 113 | swoop--target-buffer) 114 | (exit-minibuffer))) 115 | 116 | (defun swoop-edit-sync ($beg $end $length) 117 | "Sync edit." 118 | (save-excursion 119 | (goto-char $beg) 120 | (let* (($line-beg (point-at-bol)) 121 | ($marker (get-text-property $line-beg 'swm)) 122 | ($buf (marker-buffer $marker)) 123 | $col) 124 | (with-current-buffer $buf 125 | (when buffer-read-only 126 | (if (y-or-n-p "Do you want to disable read-only-mode? ") 127 | (read-only-mode -1) 128 | (kill-buffer swoop-edit-buffer) 129 | (error "Buffer \"%s\" is read only" (buffer-name))))) 130 | (when (and (get-text-property $line-beg 'swp) 131 | (not (get-text-property $end 'swp))) 132 | (when (= $length 0) 133 | (put-text-property $beg $end 'swm $marker) 134 | (save-excursion 135 | (and (re-search-forward "\n" $end t) 136 | (delete-region (1- (point)) $end)))) 137 | (let* (($line (- (line-number-at-pos) 138 | (line-number-at-pos (window-start)))) 139 | ($readonly (with-current-buffer $buf buffer-read-only)) 140 | ($win (or (get-buffer-window $buf) 141 | (display-buffer $buf 142 | '(nil (inhibit-same-window . t) 143 | (inhibit-switch-frame . t))))) 144 | ($line-end (point-at-eol)) 145 | ($text (save-excursion 146 | (goto-char (next-single-property-change 147 | $line-beg 'swp nil 148 | $line-end)) 149 | (setq $col (- (point) $line-beg)) 150 | (buffer-substring-no-properties (point) $line-end)))) 151 | (with-selected-window $win 152 | (goto-char $marker) 153 | ;; Unveil invisible block 154 | (swoop-mapc $ov 155 | (overlays-in (point-at-bol) 156 | (point-at-eol)) 157 | (let (($type (overlay-get $ov 'invisible))) 158 | (when $type 159 | (overlay-put $ov 'invisible nil)))) 160 | (recenter $line) 161 | (if $readonly 162 | (message "Buffer `%s' is read only." $buf) 163 | (delete-region (point-at-bol) (point-at-eol)) 164 | (insert $text)) 165 | (move-to-column $col))))))) 166 | 167 | 168 | (provide 'swoop-edit) 169 | ;;; swoop-edit.el ends here 170 | -------------------------------------------------------------------------------- /swoop-lib.el: -------------------------------------------------------------------------------- 1 | ;;; swoop-lib.el --- Peculiar buffer navigation -*- lexical-binding: t -*- 2 | 3 | ;; Copyright (C) 2014 by Shingo Fukuyama 4 | 5 | ;; This program is free software; you can redistribute it and/or 6 | ;; modify it under the terms of the GNU General Public License as 7 | ;; published by the Free Software Foundation; either version 2 of 8 | ;; the License, or (at your option) any later version. 9 | 10 | ;; This program is distributed in the hope that it will be 11 | ;; useful, but WITHOUT ANY WARRANTY; without even the implied 12 | ;; warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR 13 | ;; PURPOSE. See the GNU General Public License for more details. 14 | 15 | ;;; Commentary: 16 | 17 | ;;; Code: 18 | 19 | (require 'cl-lib) 20 | (require 'async) 21 | (require 'pcre2el) 22 | (require 'ht) 23 | 24 | (defgroup swoop nil 25 | "Group for swoop" 26 | :prefix "swoop-" :group 'convenience) 27 | 28 | (defvar swoop-buffer "*Swoop*") 29 | (defvar swoop-window nil) 30 | (defvar swoop-overlay-buffer-selection nil) 31 | (defvar swoop-overlay-target-buffer nil) 32 | (defvar swoop-overlay-target-buffer-selection nil) 33 | (defvar swoop-last-selected-buffer nil) 34 | (defvar swoop-last-selected-line nil) 35 | (defvar swoop-buffer-info (ht-create 'equal)) 36 | (defvar swoop-minibuffer-input-dilay 0) 37 | (defvar swoop-input-threshold 2) 38 | (defvar swoop-minibuffer-history nil) 39 | (defvar swoop-last-query-plain nil) 40 | (defvar swoop-last-query-converted nil) 41 | (defvar swoop-last-pattern nil) 42 | (defvar swoop-minibuf-last-content nil) 43 | (defvar swoop-parameters (ht-create 'equal) 44 | "To hand over current state to swoop-multi.") 45 | (defvar swoop-match-beginning-line nil) 46 | (defvar swoop-split-denominator 3000) 47 | 48 | (defvar swoop--target-buffer nil) 49 | (defvar swoop--target-window nil) 50 | (defvar swoop--target-buffer-info nil) 51 | (defvar swoop--target-last-position nil) 52 | (defvar swoop--target-last-line nil) 53 | 54 | (defvar swoop-map 55 | (let ((map (make-sparse-keymap))) 56 | (set-keymap-parent map minibuffer-local-map) 57 | (define-key map (kbd "C-n") 'swoop-action-goto-line-next) 58 | (define-key map (kbd "C-p") 'swoop-action-goto-line-prev) 59 | (define-key map (kbd "C-g") 'swoop-action-cancel) 60 | (define-key map (kbd "M-<") 'swoop-action-goto-line-top) 61 | (define-key map (kbd "M->") 'swoop-action-goto-line-bottom) 62 | (define-key map (kbd "RET") 'swoop-action-goto-target-point) 63 | (define-key map (kbd "") 'swoop-action-goto-target-point) 64 | map)) 65 | 66 | (defface swoop-face-target-line 67 | '((t :background "#e3e300" :foreground "#222222")) 68 | "Target line face" 69 | :group 'swoop) 70 | (defface swoop-face-target-words 71 | '((t :background "#7700ff" :foreground "#ffffff")) 72 | "Target words face" 73 | :group 'swoop) 74 | (defface swoop-face-header-format-line 75 | '((t :height 1.3 :foreground "#999999" :weight bold)) 76 | "Currently selecting buffer name which appears on the header line" 77 | :group 'swoop) 78 | (defface swoop-face-line-buffer-name 79 | '((t :height 1.5 :background "#0099cc" :foreground "#111111" :weight bold)) 80 | "Buffer name line face" 81 | :group 'swoop) 82 | (defface swoop-face-line-number 83 | '((t :foreground "#ff9900")) 84 | "Line number face" 85 | :group 'swoop) 86 | (defvar swoop-n 'swoop-face-line-number 87 | "Abbreviate name in order to reduce async transfer size.") 88 | 89 | (defcustom swoop-use-target-magnifier: nil 90 | "Magnify around target line font size." 91 | :group 'swoop :type 'boolean) 92 | (defcustom swoop-use-target-magnifier-around: 7 93 | "Magnify around target line font size." 94 | :group 'swoop :type 'boolean) 95 | (defcustom swoop-use-target-magnifier-size: 1.2 96 | "Magnify around target line font size." 97 | :group 'swoop :type 'boolean) 98 | (defcustom swoop-line-move-loop: t 99 | "If the selected line is at one of the edges of the list, and move further. 100 | The selected line position will be at the other side of the list." 101 | :group 'swoop :type 'boolean) 102 | (defcustom swoop-window-split-current-window: nil 103 | "Split window when having multiple windows open." 104 | :group 'swoop :type 'boolean) 105 | (defcustom swoop-window-split-direction: 'split-window-vertically 106 | "Split window direction." 107 | :type '(choice (const :tag "vertically" split-window-vertically) 108 | (const :tag "horizontally" split-window-horizontally)) 109 | :group 'swoop) 110 | (defcustom swoop-font-size-change: t 111 | "Change font size temporarily during swoop." 112 | :group 'swoop :type 'boolean) 113 | (defcustom swoop-font-size: 0.9 114 | "Specify font size if `swoop-font-size-change:' is not nil." 115 | :group 'swoop :type 'number) 116 | 117 | 118 | (defmacro swoop-mapc ($variable $list &rest $body) 119 | "Same as `mapc'." 120 | (declare (indent 2)) 121 | (let (($list-unique (cl-gensym))) 122 | `(let ((,$list-unique ,$list)) 123 | (mapc (lambda (,$variable) 124 | ,@$body) 125 | ,$list-unique)))) 126 | (defmacro swoop-mapcr ($variable $list &rest $body) 127 | "Same as `mapcar'." 128 | (declare (indent 2)) 129 | (let (($list-unique (cl-gensym))) 130 | `(let ((,$list-unique ,$list) 131 | ($results)) 132 | (mapc (lambda (,$variable) 133 | (setq $results (cons (progn ,@$body) $results))) 134 | ,$list-unique) 135 | $results))) 136 | 137 | ;; Move line up and down 138 | (defsubst swoop-line-move-within-target-window () 139 | "Manage the target window's behavior." 140 | (let (($line-num (get-text-property (point) 'swl)) 141 | ($buf (get-text-property (point) 'swb))) 142 | (cl-labels ((line-action () 143 | (swoop-recenter) 144 | (move-overlay 145 | swoop-overlay-target-buffer-selection 146 | (point) (min (1+ (point-at-eol)) (point-max)) 147 | (get-buffer $buf)) 148 | (if swoop-use-target-magnifier: 149 | (swoop-magnify-around-target :$buffer $buf)) 150 | (swoop-unveil-invisible-overlay))) 151 | (with-selected-window swoop--target-window 152 | (if (not (equal $buf swoop-last-selected-buffer)) 153 | (progn 154 | (with-current-buffer $buf 155 | (set-window-buffer nil $buf) 156 | (swoop-goto-line $line-num) 157 | (line-action)) 158 | (swoop-header-format-line-set $buf)) 159 | (swoop-goto-line $line-num) 160 | (line-action)) 161 | (setq swoop-last-selected-buffer $buf))))) 162 | 163 | (defsubst swoop-action-goto-line-next () 164 | "Exec goto line next action." 165 | (interactive) 166 | (swoop-line-move 'down)) 167 | (defsubst swoop-action-goto-line-prev () 168 | "Exec goto line prev action." 169 | (interactive) 170 | (swoop-line-move 'up)) 171 | (defsubst swoop-action-goto-line-top () 172 | "Exec goto line top action." 173 | (interactive) 174 | (swoop-line-move 'top)) 175 | (defsubst swoop-action-goto-line-bottom () 176 | "Exec goto line bottom action." 177 | (interactive) 178 | (swoop-line-move 'bottom)) 179 | (defsubst swoop-line-forward () 180 | "Exec line forward." 181 | (let (($po (next-single-property-change (point) 'swl))) 182 | (if $po 183 | (if (get-text-property $po 'swl) 184 | (goto-char $po) 185 | (let (($over-header (next-single-property-change $po 'swl))) 186 | (if (get-text-property $over-header 'swl) 187 | (goto-char $over-header)))) 188 | ;; Loop 189 | (if swoop-line-move-loop: 190 | (swoop-action-goto-line-top))))) 191 | (defsubst swoop-line-backward () 192 | "Exec line backward." 193 | (let (($po (previous-single-property-change (point) 'swl))) 194 | (if $po 195 | (if (get-text-property $po 'swl) 196 | (goto-char $po) 197 | (let (($over-header (previous-single-property-change $po 'swl))) 198 | (if (get-text-property $over-header 'swl) 199 | (goto-char $over-header)))) 200 | (if swoop-line-move-loop: 201 | (swoop-action-goto-line-bottom))))) 202 | (cl-defun swoop-line-move ($direction) 203 | "Exec line move." 204 | (with-selected-window swoop-window 205 | (let ((current-pos (point)) is-init) 206 | (cl-case $direction 207 | (up (swoop-line-backward)) 208 | (down (swoop-line-forward)) 209 | (top (unless (eq (point-min) (point-max)) 210 | (goto-char (point-min)) 211 | (swoop-line-forward))) 212 | (bottom (unless (eq (point-min) (point-max)) 213 | (goto-char (point-max)) 214 | (swoop-line-backward))) 215 | (init (cond 216 | ((and (bobp) (eobp)) 217 | (cl-return-from swoop-line-move nil)) 218 | ((bobp) 219 | (swoop-line-forward) 220 | (move-beginning-of-line 1)) 221 | ((eobp) 222 | (swoop-line-backward) 223 | (move-beginning-of-line 1)) 224 | (t (move-beginning-of-line 1))) 225 | (setq is-init t))) 226 | (when (or (not (eq current-pos (point))) is-init) 227 | (move-overlay 228 | swoop-overlay-buffer-selection 229 | (point) (min (1+ (point-at-eol)) (point-max))) 230 | (swoop-line-move-within-target-window) 231 | (swoop-recenter))))) 232 | 233 | ;; Window configuration 234 | (defvar swoop-display-function 235 | (lambda ($buf) 236 | (if swoop-window-split-current-window: 237 | (funcall swoop-window-split-direction:) 238 | (when (one-window-p) 239 | (funcall swoop-window-split-direction:))) 240 | (other-window 1) 241 | (switch-to-buffer $buf)) 242 | "Determine how to deploy swoop window.") 243 | 244 | ;; Font size manipulation 245 | (defun swoop-overlay-font-size-change (&optional $multi) 246 | "Change whole buffer's text size." 247 | (when swoop-font-size-change: 248 | (let (($ov (make-overlay (point-min) (point-max)))) 249 | (setq swoop-overlay-target-buffer (cons $ov nil)) 250 | (overlay-put $ov 'face `(:height ,swoop-font-size:))) 251 | (swoop-recenter) 252 | (when $multi 253 | (swoop-mapc $b (ht-keys swoop-buffer-info) 254 | (unless (equal swoop--target-buffer $b) 255 | (with-current-buffer $b 256 | (let (($ov (make-overlay (point-min) (point-max)))) 257 | (setq swoop-overlay-target-buffer 258 | (cons $ov swoop-overlay-target-buffer)) 259 | (overlay-put $ov 'face `(:height ,swoop-font-size:))))))))) 260 | 261 | (defvar swoop-overlay-magnify-around-target-line nil) 262 | (cl-defun swoop-magnify-around-target 263 | (&key ($around swoop-use-target-magnifier-around:) 264 | ($size swoop-use-target-magnifier-size:) 265 | $delete $buffer) 266 | "Magnify lines around the target line." 267 | (with-selected-window swoop--target-window 268 | (cond ((not swoop-overlay-magnify-around-target-line) 269 | (setq swoop-overlay-magnify-around-target-line 270 | (make-overlay 271 | (point-at-bol (- 0 $around)) 272 | (point-at-bol $around))) 273 | (overlay-put swoop-overlay-magnify-around-target-line 274 | 'face `(:height ,$size)) 275 | (overlay-put swoop-overlay-magnify-around-target-line 276 | 'priority 100)) 277 | ((and $delete swoop-overlay-magnify-around-target-line) 278 | (delete-overlay swoop-overlay-magnify-around-target-line)) 279 | (t (move-overlay 280 | swoop-overlay-magnify-around-target-line 281 | (point-at-bol (- 0 $around)) 282 | (point-at-bol $around) 283 | (get-buffer $buffer)))))) 284 | 285 | (defsubst swoop-goto-line ($line) 286 | "Do `goto-line' considering narrowing." 287 | (goto-char (point-min)) 288 | (forward-line (1- $line))) 289 | 290 | (defsubst swoop-recenter () 291 | "Recenter." 292 | (recenter (/ (window-height) 2))) 293 | 294 | (defsubst swoop-boblp (&optional $point) 295 | "Boblp." 296 | (save-excursion 297 | (goto-char (point-min)) 298 | (eq (line-number-at-pos) 299 | (progn (goto-char (or $point (point))) (line-number-at-pos))))) 300 | 301 | (defsubst swoop-eoblp (&optional $point) 302 | "Eoblp." 303 | (save-excursion 304 | (goto-char (point-max)) 305 | (eq (line-number-at-pos) 306 | (progn (goto-char (or $point (point))) (line-number-at-pos))))) 307 | 308 | (defun swoop-header-format-line-set ($buffer-name) 309 | "Header format line set." 310 | (when (stringp $buffer-name) 311 | (with-selected-window swoop-window 312 | (setq header-line-format 313 | (propertize $buffer-name 'face 'swoop-face-header-format-line))))) 314 | 315 | ;; Converter 316 | ;; \w{2,3}.html?$ 317 | ;; (swoop-pcre-convert (read-string "PCRE: " "\\w{2,3}.html?$")) 318 | ;; ^\s*\w \d{2,3} 319 | ;; (swoop-pcre-convert (read-string "PCRE: " "^\\s*\\w \\d{2,3}")) 320 | (defvar swoop-use-pcre nil) 321 | (defsubst swoop-pcre-convert ($query) 322 | "Pcre convert." 323 | (nreverse 324 | (swoop-mapcr $q (split-string $query " " t) 325 | (rxt-pcre-to-elisp $q)))) 326 | 327 | ;; (swoop-migemo-convert "kaki kuke") 328 | ;; (swoop-migemo-convert "kakuku") 329 | (defvar swoop-use-migemo nil) 330 | (defvar swoop-migemo-options 331 | "-q -e -d /usr/local/share/migemo/utf-8/migemo-dict") 332 | (defsubst swoop-migemo-convert ($query) 333 | "Convert migemo." 334 | (if (executable-find "cmigemo") 335 | (nreverse 336 | (swoop-mapcr $q (split-string $query " " t) 337 | (replace-regexp-in-string 338 | "\n" "" 339 | (shell-command-to-string 340 | (concat "cmigemo" " -w " $q " " swoop-migemo-options))))) 341 | (error "cmigemo not found..."))) 342 | 343 | (defun swoop-convert-input ($input) 344 | "Convert input." 345 | (cond 346 | ;; PCRE 347 | ((and swoop-use-pcre 348 | (not swoop-use-migemo)) 349 | (setq $input (swoop-pcre-convert $input))) 350 | ;; MIGEMO 351 | ((and swoop-use-migemo 352 | (not swoop-use-pcre)) 353 | (setq $input (swoop-migemo-convert $input))) 354 | (t 355 | (if (string-match "^\\\\b$" $input) (setq $input nil)) 356 | (if (string-match "[^\\]\\\\$" $input) (setq $input nil)) 357 | (if (string-match "\\[[^\]]*$" $input) (setq $input nil)))) 358 | $input) 359 | 360 | ;; Unveil a hidden target block of lines 361 | (defvar swoop-invisible-targets nil) 362 | (defsubst swoop-restore-unveiled-overlay () 363 | "Restore unveiled overlay." 364 | (when swoop-invisible-targets 365 | (swoop-mapc $ov swoop-invisible-targets 366 | (overlay-put (car $ov) 'invisible (cdr $ov))) 367 | (setq swoop-invisible-targets nil))) 368 | (defsubst swoop-unveil-invisible-overlay () 369 | "Show hidden text temporarily to view it during swoop. 370 | This function needs to call after latest 371 | swoop-overlay-target-buffer-selection moved." 372 | (swoop-restore-unveiled-overlay) 373 | (swoop-mapc $ov 374 | (overlays-in (overlay-start swoop-overlay-target-buffer-selection) 375 | (overlay-end swoop-overlay-target-buffer-selection)) 376 | (let (($type (overlay-get $ov 'invisible))) 377 | (when $type 378 | (overlay-put $ov 'invisible nil) 379 | (setq swoop-invisible-targets 380 | (cons (cons $ov $type) swoop-invisible-targets)))))) 381 | 382 | (defun swoop-set-buffer-info ($buf) 383 | "Collect buffers information. It's used for multiple uses." 384 | (with-current-buffer $buf 385 | (let* (($buf-content (buffer-substring-no-properties 386 | (point-min) (point-max))) 387 | ($point (point)) 388 | ($point-min (point-min)) 389 | ($point-max (point-max)) 390 | ($max-line (line-number-at-pos $point-max)) 391 | ($max-line-digit (length (number-to-string $max-line))) 392 | ($line-format (concat "%0" 393 | (number-to-string $max-line-digit) 394 | "s: ")) 395 | ($by swoop-split-denominator) ; Buffer divide by 396 | ($result (/ $max-line $by)) ; Result of division 397 | ($rest (% $max-line $by)) ; Rest of division 398 | ;; Number of divided parts of a buffer 399 | ($buf-num (if (eq 0 $rest) $result (1+ $result))) 400 | ($separated-buffer)) 401 | (let (($with-end-break (concat $buf-content "\n"))) 402 | (cl-dotimes ($i $buf-num) 403 | (setq $separated-buffer 404 | (cons 405 | (substring-no-properties 406 | $with-end-break 407 | (1- (save-excursion (swoop-goto-line (1+ (* $i $by))) (point))) 408 | (if (>= (* (1+ $i) $by) $max-line) 409 | nil 410 | (1- (save-excursion 411 | (swoop-goto-line (1+ (* (1+ $i) $by))) (point))))) 412 | $separated-buffer)))) 413 | (setq swoop--target-buffer-info 414 | (ht ("buf-separated" (nreverse $separated-buffer)) 415 | ("buf-number" $buf-num) 416 | ("point" $point) 417 | ("point-min" $point-min) 418 | ("point-max" $point-max) 419 | ("max-line" $max-line) 420 | ("max-line-digit" $max-line-digit) 421 | ("line-format" $line-format) 422 | ("divide-by" $by))) 423 | (ht-set swoop-buffer-info $buf swoop--target-buffer-info))) 424 | nil) 425 | 426 | (defvar swoop-multi-ignore-buffers-match "^\\*" 427 | "Regexp to eliminate buffers you don't want to see.") 428 | (defun swoop-multi-get-buffer-list () 429 | (let ($buflist1 $buflist2) 430 | ;; eliminate buffers start with whitespace and dired buffers 431 | (mapc (lambda ($buf) 432 | (setq $buf (buffer-name $buf)) 433 | (unless (string-match "^\\s-" $buf) 434 | (unless (eq 'dired-mode (with-current-buffer $buf major-mode)) 435 | (setq $buflist1 (cons $buf $buflist1))))) 436 | (buffer-list)) 437 | ;; eliminate buffers match pattern 438 | (mapc (lambda ($buf) 439 | (unless (string-match 440 | swoop-multi-ignore-buffers-match 441 | $buf) 442 | (setq $buflist2 (cons $buf $buflist2)))) 443 | $buflist1) 444 | $buflist2)) 445 | 446 | (defun swoop-set-buffer-info-all () 447 | (let (($bufs (swoop-multi-get-buffer-list))) 448 | (swoop-mapc $buf $bufs 449 | (if (member $buf (ht-keys swoop-buffer-info)) 450 | (if (with-current-buffer $buf (buffer-modified-p)) 451 | (swoop-set-buffer-info $buf)) 452 | (swoop-set-buffer-info $buf))) 453 | (swoop-mapc $buf (ht-keys swoop-buffer-info) 454 | (unless (member $buf $bufs) 455 | (ht-remove! swoop-buffer-info $buf))))) 456 | 457 | (defun swoop-buffer-info-get ($buf $key2) 458 | (ht-get (ht-get swoop-buffer-info $buf) $key2)) 459 | 460 | (defun swoop-buffer-info-get-map ($key) 461 | (ht-map (lambda (ignored $binfo) 462 | (ht-get $binfo $key)) 463 | swoop-buffer-info)) 464 | 465 | ;; (swoop-nearest-line 50 '(10 90 20 80 30 40 45 56 70)) 466 | (defun swoop-nearest-line ($target $list) 467 | "Return the nearest number of $target out of $list." 468 | (when (and $target $list) 469 | (let ($result) 470 | (cl-labels ((filter ($fn $elem $list) 471 | (let ($r) 472 | (mapc (lambda ($e) 473 | (if (funcall $fn $elem $e) 474 | (setq $r (cons $e $r)))) 475 | $list) $r))) 476 | (if (eq 1 (length $list)) 477 | (setq $result (car $list)) 478 | (let* (($lts (filter '> $target $list)) 479 | ($gts (filter '< $target $list)) 480 | ($lt (if $lts (apply 'max $lts))) 481 | ($gt (if $gts (apply 'min $gts))) 482 | ($ltg (if $lt (- $target $lt))) 483 | ($gtg (if $gt (- $gt $target)))) 484 | (setq $result 485 | (cond ((memq $target $list) $target) 486 | ((and (not $lt) (not $gt)) nil) 487 | ((not $gtg) $lt) 488 | ((not $ltg) $gt) 489 | ((eq $ltg $gtg) $gt) 490 | ((< $ltg $gtg) $lt) 491 | ((> $ltg $gtg) $gt) 492 | (t 1)))))) 493 | $result))) 494 | 495 | 496 | ;; Async 497 | (defvar swoop-async-pool (make-hash-table :test 'equal)) 498 | (defvar swoop-async-id-latest nil) 499 | (defvar swoop-async-id-last nil) 500 | (defvar swoop-async-get-match-lines-list 501 | "Byte compiled function. It works in async process.") 502 | 503 | (defsubst swoop-async-old-session? () 504 | (not (equal swoop-async-id-last swoop-async-id-latest))) 505 | 506 | (defmacro swoop-async-start ($start-func $finish-func) 507 | (require 'find-func) 508 | (let ((procvar (make-symbol "proc"))) 509 | `(let* ((sexp ,$start-func) 510 | (,procvar 511 | (swoop-async-start-process 512 | "swoop-batch" (file-truename 513 | (expand-file-name invocation-name 514 | invocation-directory)) 515 | ,$finish-func 516 | "-Q" "-l" ,(symbol-file 'async-batch-invoke 'defun) 517 | "-batch" "-f" "async-batch-invoke" 518 | (if async-send-over-pipe 519 | "" 520 | (with-temp-buffer 521 | (async--insert-sexp (list 'quote sexp)) 522 | (buffer-string)))))) 523 | (if async-send-over-pipe 524 | (async--transmit-sexp ,procvar (list 'quote sexp))) 525 | ,procvar))) 526 | 527 | (defun swoop-async-start-process (name program finish-func &rest program-args) 528 | (let* ((buf (generate-new-buffer (concat "*" name "*"))) 529 | (proc (let ((process-connection-type nil)) 530 | (apply #'start-process name buf program program-args)))) 531 | (with-current-buffer buf 532 | (set (make-local-variable 'async-callback) finish-func) 533 | (set-process-sentinel proc #'async-when-done) 534 | (unless (string= name "swoop-batch") 535 | (set (make-local-variable 'async-callback-for-process) t)) 536 | proc))) 537 | 538 | (defun swoop-async-kill-process-buffer () 539 | (mapc (lambda ($buf) 540 | (setq $buf (buffer-name $buf)) 541 | (when (string-match "^\\*swoop-batch\\*" $buf) 542 | (let ((kill-buffer-query-functions nil)) 543 | (kill-buffer $buf)))) 544 | (buffer-list))) 545 | 546 | (defun swoop-async-kill-process () 547 | (mapc (lambda ($proc) 548 | (when (string-match "swoop-batch" (process-name $proc)) 549 | (delete-process $proc))) 550 | (process-list))) 551 | 552 | (defun swoop-async-get-match-lines-list 553 | ($query $from $line-format $line-face $buf &optional $pre-select $match-beginning) 554 | "Distributed processing by async.el." 555 | ;; Prevent "Odd length text property list" error 556 | (setq vc-handled-backends nil) 557 | (save-excursion 558 | (let* (($lines nil) 559 | ($pos-min (point-min)) 560 | ($pos-max (point-max)) 561 | (buffer-invisibility-spec nil) 562 | ($match-lines) 563 | ($match-total 564 | (if $pre-select 565 | (let (($max-line (line-number-at-pos $pos-max))) 566 | (cons 567 | (sort (delq nil (mapcar (lambda ($n) 568 | (if (and (> $n $from) 569 | (<= $n (+ $max-line $from))) 570 | (- $n $from))) 571 | $pre-select)) 572 | '>) 573 | nil)))) 574 | ($match-lines-common) 575 | ($match-position-fn 576 | (if $match-beginning 577 | (lambda () (line-number-at-pos (match-beginning 0))) 578 | (lambda () (line-number-at-pos))))) 579 | (goto-char $pos-min) 580 | (put-text-property $pos-min $pos-max 'swb $buf) 581 | ;; Get lines at least one match 582 | (mapc (lambda ($q) 583 | (save-excursion 584 | (goto-char $pos-min) 585 | (while (re-search-forward $q nil t) 586 | (setq $match-lines (cons (funcall $match-position-fn) 587 | $match-lines)) 588 | (forward-line)) 589 | (setq $match-total (cons $match-lines $match-total)) 590 | (setq $match-lines nil))) 591 | $query) 592 | ;; Common match line mapping 593 | (let* (($results) 594 | ($length (length $match-total))) 595 | (when (> $length 0) 596 | (setq $results (car-safe $match-total)) 597 | (if (> $length 1) 598 | (mapc (lambda ($l) 599 | (setq $results 600 | (let (($r) ($nth 0)) 601 | (while $results 602 | (let (($top (car $results))) 603 | (when (memq $top $l) 604 | (setq $r (cons $top $r)))) 605 | (setq $nth (1+ $nth)) 606 | (setq $results (cdr $results))) 607 | (nreverse $r)))) 608 | (cdr $match-total)))) 609 | (setq $match-lines-common $results)) 610 | ;; Culling all words match lines 611 | (mapc (lambda ($l) 612 | (goto-char $pos-min) 613 | (forward-line (1- $l)) 614 | (let (($line-num (+ $l $from))) 615 | (setq $lines 616 | (cons 617 | (propertize 618 | (buffer-substring (point) (1+ (point-at-eol))) 619 | 'line-prefix 620 | (propertize 621 | (format $line-format $line-num) 622 | 'face $line-face) 623 | 'swl $line-num) 624 | $lines)))) 625 | $match-lines-common) 626 | (setq $match-lines-common 627 | (mapcar (lambda ($ln) (+ $ln $from)) $match-lines-common)) 628 | (cons $match-lines-common $lines)))) 629 | (setq swoop-async-get-match-lines-list 630 | (if (byte-code-function-p (symbol-function 'swoop-async-get-match-lines-list)) 631 | (symbol-function 'swoop-async-get-match-lines-list) 632 | (byte-compile 'swoop-async-get-match-lines-list))) 633 | 634 | 635 | (cl-defun swoop-overlay-word ($pattern $buf) 636 | "Overlay match words." 637 | (with-current-buffer $buf 638 | (save-excursion 639 | (goto-char (point-min)) 640 | (overlay-recenter (point-max)) 641 | (while (re-search-forward $pattern nil t) 642 | (if (swoop-async-old-session?) (cl-return-from stop1)) 643 | (let* (($beg (match-beginning 0)) 644 | ($end (match-end 0)) 645 | ($ov (make-overlay $beg $end))) 646 | (if (eq $beg $end) (cl-return-from swoop-overlay-word)) 647 | (overlay-put $ov 'face 'swoop-face-target-words) 648 | (overlay-put $ov 'swoop-temporary t) 649 | (overlay-put $ov 'priority 20)))))) 650 | 651 | 652 | (provide 'swoop-lib) 653 | ;;; swoop-lib.el ends here 654 | -------------------------------------------------------------------------------- /swoop.el: -------------------------------------------------------------------------------- 1 | ;;; swoop.el --- Peculiar buffer navigation -*- lexical-binding: t -*- 2 | 3 | ;; Copyright (C) 2014 by Shingo Fukuyama 4 | 5 | ;; Version: 1.0 6 | ;; Author: Shingo Fukuyama - http://fukuyama.co 7 | ;; URL: https://github.com/ShingoFukuyama/emacs-swoop 8 | ;; Created: Feb 14 2014 9 | ;; Keywords: tools swoop inner buffer search navigation 10 | ;; Package-Requires: ((emacs "24.3") (ht "2.0") (pcre2el "1.5") (async "1.1")) 11 | 12 | ;; This program is free software; you can redistribute it and/or 13 | ;; modify it under the terms of the GNU General Public License as 14 | ;; published by the Free Software Foundation; either version 2 of 15 | ;; the License, or (at your option) any later version. 16 | 17 | ;; This program is distributed in the hope that it will be 18 | ;; useful, but WITHOUT ANY WARRANTY; without even the implied 19 | ;; warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR 20 | ;; PURPOSE. See the GNU General Public License for more details. 21 | 22 | ;;; Commentary: 23 | 24 | ;; Feature: 25 | ;; * Search words through a whole buffer or across buffers 26 | ;; * Highlight target line and matched words 27 | ;; * Stick to the nearest line even after update the list 28 | ;; * Utilize PCRE (Perl Compatible Regular Expressions) like search 29 | ;; * Utilize migemo (Japanese words search command) 30 | ;; * Edit matched lines synchronously 31 | ;; * Cache buffer information to start quickly 32 | ;; * Shrink text size in buffers to view more 33 | ;; * and more 34 | 35 | ;; Example config 36 | ;; ---------------------------------------------------------------- 37 | ;; ;; Require 38 | ;; ;; async.el https://github.com/jwiegley/emacs-async 39 | ;; ;; pcre2el.el https://github.com/joddie/pcre2el 40 | ;; ;; ht.el https://github.com/Wilfred/ht.el 41 | ;; (require 'swoop) 42 | ;; (global-set-key (kbd "C-o") 'swoop) 43 | ;; (global-set-key (kbd "C-M-o") 'swoop-multi) 44 | ;; (global-set-key (kbd "M-o") 'swoop-pcre-regexp) 45 | ;; (global-set-key (kbd "C-S-o") 'swoop-back-to-last-position) 46 | ;; (global-set-key (kbd "H-6") 'swoop-migemo) 47 | 48 | ;; ;; Transition 49 | ;; ;; isearch > press [C-o] > swoop 50 | ;; ;; evil-search > press [C-o] > swoop 51 | ;; ;; swoop > press [C-o] > swoop-multi 52 | ;; (define-key isearch-mode-map (kbd "C-o") 'swoop-from-isearch) 53 | ;; (define-key evil-motion-state-map (kbd "C-o") 'swoop-from-evil-search) 54 | ;; (define-key swoop-map (kbd "C-o") 'swoop-multi-from-swoop) 55 | 56 | ;; ;; Resume 57 | ;; ;; C-u M-x swoop : Use last used query 58 | 59 | ;; ;; Swoop Edit Mode 60 | ;; ;; During swoop, press [C-c C-e] 61 | ;; ;; You can edit synchronously 62 | 63 | ;;; TODO: 64 | ;; Unpropertize (thing-at-point 'symbol) 65 | ;; Prevent long time loop words (], \\b, {0,} ...) 66 | 67 | ;;; Code: 68 | 69 | (require 'swoop-lib) 70 | (require 'swoop-edit) 71 | 72 | ;; Cache control 73 | (defun swoop-cache-clear () 74 | "Clear cache." 75 | (when (not (ht-empty? swoop-buffer-info)) 76 | (ht-clear! swoop-buffer-info) 77 | (swoop-async-kill-process) 78 | (swoop-async-kill-process-buffer))) 79 | (add-hook 'after-save-hook 'swoop-cache-clear) 80 | 81 | ;; Cancel action 82 | (defvar swoop-abort-hook nil) 83 | (defun swoop-action-cancel () 84 | "This is assigned to `C-g' as default. 85 | Exit from Swoop (minibuffer) and execute functions listed in swoop-abort-hook." 86 | (interactive) 87 | (run-with-timer 88 | 0 nil (lambda () (run-hooks 'swoop-abort-hook))) 89 | (exit-minibuffer)) 90 | (defun swoop-back-to-last-position () 91 | "Back cursor position to where the last swoop happened." 92 | (interactive) 93 | (let (($po swoop--target-last-position)) 94 | (setq swoop--target-last-position (point)) 95 | (with-selected-window swoop--target-window 96 | (goto-char $po)))) 97 | (defun swoop-highlight-for-cancel () 98 | "Prevent loosing sight of cursor position. It'll evaporate at once." 99 | (interactive) 100 | (let* (($lbeg (point)) 101 | ($lend (point-at-eol)) 102 | ($lov (make-overlay $lbeg $lend)) 103 | ($lbeg2 (point-at-bol)) 104 | ($lend2 $lbeg) 105 | ($lov2 (make-overlay $lbeg2 $lend2))) 106 | (swoop-recenter) 107 | (run-with-timer 0.3 nil (lambda ($o) (delete-overlay $o)) $lov) 108 | (overlay-put $lov 'face 'swoop-face-target-words) 109 | (run-with-timer 0.3 nil (lambda ($o) (delete-overlay $o)) $lov2) 110 | (overlay-put $lov2 'face 'swoop-face-target-line))) 111 | (add-hook 'swoop-abort-hook 'swoop-back-to-last-position) 112 | (add-hook 'swoop-abort-hook 'swoop-highlight-for-cancel) 113 | 114 | ;; Default action 115 | (defun swoop-action-goto-target-point () 116 | "Finish searching and goto the target line." 117 | (interactive) 118 | (run-with-timer 119 | 0 nil 120 | (lambda ($info) 121 | (with-selected-window swoop--target-window 122 | (with-current-buffer (cdr $info) 123 | (set-window-buffer nil (cdr $info)) 124 | (swoop-goto-line (car $info)) 125 | (save-excursion 126 | (re-search-forward 127 | (concat 128 | "\\(" 129 | (mapconcat 'identity swoop-last-query-converted "\\|") 130 | "\\)") 131 | nil t)) 132 | (goto-char (match-beginning 0)) 133 | ;; Highlight for few seconds after jump 134 | (let* (($lbeg (point-at-bol)) 135 | ($lend (point-at-eol)) 136 | ($lov (make-overlay $lbeg $lend)) 137 | ($wbeg (match-beginning 0)) 138 | ($wend (match-end 0)) 139 | ($wov (make-overlay $wbeg $wend))) 140 | (run-with-timer 0.28 nil (lambda ($o) (delete-overlay $o)) $lov) 141 | (overlay-put $lov 'face 'swoop-face-target-words) 142 | (run-with-timer 0.4 nil (lambda ($o) (delete-overlay $o)) $wov) 143 | (overlay-put $wov 'face 'swoop-face-target-line) 144 | (swoop-recenter))))) 145 | (with-selected-window swoop-window 146 | (cons (get-text-property (point) 'swl) (get-text-property (point) 'swb)))) 147 | (exit-minibuffer)) 148 | 149 | ;; Overlay 150 | (cl-defun swoop-overlay-clear (&key $to-empty $kill $multi) 151 | "Clear overlays, and kill swoop-buffer." 152 | (if (and $kill (get-buffer swoop-buffer)) 153 | (kill-buffer swoop-buffer)) 154 | (if swoop-use-target-magnifier: 155 | (swoop-magnify-around-target :$delete t)) 156 | (if (and swoop-overlay-target-buffer-selection 157 | (not $to-empty)) 158 | (delete-overlay swoop-overlay-target-buffer-selection)) 159 | (when (and swoop-font-size-change: 160 | $kill 161 | (not $multi) 162 | (eq 1 (length swoop-overlay-target-buffer))) 163 | (delete-overlay (car swoop-overlay-target-buffer)) 164 | (setq swoop-overlay-target-buffer nil)) 165 | (when (and swoop-font-size-change: 166 | $kill 167 | $multi 168 | (< 1 (length swoop-overlay-target-buffer))) 169 | (swoop-mapc $ov swoop-overlay-target-buffer 170 | (delete-overlay $ov)) 171 | (setq swoop-overlay-target-buffer nil)) 172 | (swoop-mapc $buf (if $multi 173 | (ht-keys swoop-buffer-info) 174 | (list swoop--target-buffer)) 175 | (if (and (swoop-async-old-session?) 176 | (not $to-empty) 177 | (not $kill)) 178 | (cl-return-from swoop-overlay-clear)) 179 | (with-current-buffer $buf 180 | (overlay-recenter (point-max)) 181 | (swoop-mapc $ov (overlays-in (point-min) (point-max)) 182 | (if (and (swoop-async-old-session?) 183 | (not $to-empty) 184 | (not $kill)) 185 | (cl-return)) 186 | (when (overlay-get $ov 'swoop-temporary) 187 | (delete-overlay $ov)))))) 188 | 189 | (defsubst swoop-overlay-selection-buffer-set () 190 | "Overlay selection buffer set." 191 | (setq swoop-overlay-buffer-selection 192 | (make-overlay (point-at-bol) 193 | (min (1+ (point-at-eol)) (point-max)))) 194 | (overlay-put swoop-overlay-buffer-selection 'face 'swoop-face-target-line) 195 | (overlay-put swoop-overlay-buffer-selection 'priority 15)) 196 | 197 | (defsubst swoop-overlay-selection-target-buffer-set () 198 | "Overlay selection target buffer set." 199 | (setq swoop-overlay-target-buffer-selection 200 | (make-overlay (point-at-bol) 201 | (min (1+ (point-at-eol)) (point-max)))) 202 | (overlay-put swoop-overlay-target-buffer-selection 203 | 'face 'swoop-face-target-line) 204 | (overlay-put swoop-overlay-target-buffer-selection 'priority 15)) 205 | 206 | 207 | 208 | (cl-defun swoop-core (&key $query $reserve $resume $multi $pre-select) 209 | (setq 210 | swoop--target-last-position (point) 211 | swoop--target-last-line (line-number-at-pos) 212 | swoop--target-buffer (buffer-name (current-buffer)) 213 | swoop--target-window (get-buffer-window swoop--target-buffer)) 214 | (if $multi 215 | (swoop-set-buffer-info-all) 216 | (swoop-set-buffer-info swoop--target-buffer)) 217 | (swoop-overlay-font-size-change $multi) 218 | (swoop-overlay-selection-target-buffer-set) 219 | (setq swoop-parameters 220 | (ht ("reserve" $reserve) 221 | ("pcre" swoop-use-pcre) 222 | ("migemo" swoop-use-migemo))) 223 | (save-window-excursion 224 | (progn 225 | (funcall swoop-display-function swoop-buffer) 226 | (setq swoop-window (get-buffer-window swoop-buffer)) 227 | (make-local-variable 'swoop--target-buffer) 228 | (make-local-variable 'swoop--target-window) 229 | (make-local-variable 'swoop--target-buffer-info) 230 | (make-local-variable 'swoop--target-last-position) 231 | (make-local-variable 'swoop--target-last-line) 232 | (swoop-overlay-selection-buffer-set)) 233 | (unwind-protect 234 | (when (get-buffer swoop-buffer) 235 | (ht-clear! swoop-async-pool) 236 | (when $resume 237 | ;; Prevent following minibuffer session once 238 | (setq swoop-minibuf-last-content $query) 239 | ;; First time 240 | (swoop-update :$query swoop-last-query-converted 241 | :$reserve $reserve 242 | :$multi $multi 243 | :$pre-select $pre-select)) 244 | (when (or $reserve $pre-select) 245 | (swoop-update :$query (or $query "") 246 | :$reserve $reserve 247 | :$multi $multi 248 | :$pre-select $pre-select)) 249 | (swoop-minibuffer-read-from-string :$query $query 250 | :$reserve $reserve 251 | :$multi $multi 252 | :$pre-select $pre-select)) 253 | (when (get-buffer swoop-buffer) 254 | (swoop-overlay-clear :$kill t :$multi (or $multi nil))) 255 | ;; Restore last position of other buffers 256 | (when $multi 257 | (swoop-mapc $buf (ht-keys swoop-buffer-info) 258 | (unless (equal $buf (buffer-name (current-buffer))) 259 | (goto-char (swoop-buffer-info-get $buf "point"))))) 260 | (setq swoop-use-pcre nil) 261 | (setq swoop-use-migemo nil) 262 | (setq swoop-match-beginning-line nil) 263 | (ht-clear! swoop-parameters)))) 264 | 265 | (defcustom swoop-pre-input-point-at-function 266 | (lambda () 267 | (let ((query (thing-at-point 'symbol))) 268 | (if query 269 | (format "%s" (read query)) 270 | ""))) 271 | "Change pre input action. Default is get symbol where cursor at." 272 | :group 'swoop :type 'symbol) 273 | (define-obsolete-variable-alias 274 | 'swoop-pre-input-point-at-function: 275 | 'swoop-pre-input-point-at-function 276 | 1.1) 277 | 278 | (defun swoop-pre-input (&optional $resume) 279 | "Pre input function. Utilize region and at point symbol." 280 | (let ($results) 281 | (if $resume 282 | (setq $results swoop-last-query-plain) 283 | (setq $results (cond (mark-active 284 | (buffer-substring-no-properties 285 | (region-beginning) (region-end))) 286 | ((funcall swoop-pre-input-point-at-function)) 287 | (t nil))) 288 | (deactivate-mark) 289 | (when $results 290 | (setq $results (replace-regexp-in-string "\*" "\\\\*" $results)) 291 | (setq $results (replace-regexp-in-string "\+" "\\\\+" $results)))) 292 | $results)) 293 | 294 | ;;;###autoload 295 | (defun swoop (&optional $query) 296 | "Search through words within the current buffer." 297 | (interactive) 298 | (if current-prefix-arg 299 | (swoop-core :$resume t :$query swoop-last-query-plain) 300 | (swoop-core :$query (or $query (swoop-pre-input))))) 301 | ;;;###autoload 302 | (defun swoop-multi (&optional $query) 303 | "Search words across currently opened multiple buffers. 304 | Ignore non file buffer." 305 | (interactive) 306 | (if current-prefix-arg 307 | (swoop-core :$resume t :$query swoop-last-query-plain :$multi t) 308 | (swoop-core :$query (or $query (swoop-pre-input)) :$multi t))) 309 | ;;;###autoload 310 | (defun swoop-pcre-regexp (&optional $query) 311 | "Use PCRE like regexp to swoop." 312 | (interactive) 313 | (setq swoop-use-pcre t) 314 | (if current-prefix-arg 315 | (swoop-core :$resume t :$query swoop-last-query-plain) 316 | (swoop-core :$query (or $query (swoop-pre-input))))) 317 | ;;;###autoload 318 | (defun swoop-migemo (&optional $query) 319 | "Japanese words matching with the alphabet." 320 | (interactive) 321 | (setq swoop-use-migemo t) 322 | (if current-prefix-arg 323 | (swoop-core :$resume t :$query swoop-last-query-plain) 324 | (swoop-core :$query (or $query (swoop-pre-input))))) 325 | ;;;###autoload 326 | (defun swoop-line-length-over80 () 327 | "Get over 80 colomn number linees." 328 | (interactive) 329 | (swoop-core :$reserve "^[^\n]\\{80,\\}")) 330 | ;;;###autoload 331 | (defun swoop-from-isearch () 332 | "During isearch, switch over to swoop." 333 | (interactive) 334 | (swoop-core :$query (if isearch-regexp 335 | isearch-string 336 | (regexp-quote isearch-string)))) 337 | ;; (define-key isearch-mode-map (kbd "C-o") 'swoop-from-isearch) 338 | 339 | ;;;###autoload 340 | (defun swoop-function (&optional $query) 341 | "Show function list in buffer judging from `major-mode' and regexp. 342 | Currently `c-mode' only." 343 | (interactive) 344 | (setq swoop-match-beginning-line t) 345 | (swoop-core :$query (or $query (swoop-pre-input)) 346 | :$reserve 347 | (cl-case major-mode 348 | (c-mode 349 | (concat 350 | "^[[:alnum:]]+\\s-\\([[:alnum:]_:<>~]+\\s-*\\)+" 351 | "\\([^)]\\|\\s-\\)+)[^;]"))))) 352 | 353 | (defun swoop-multi-from-swoop () 354 | "During swoop, switch over to swoop-multi." 355 | (interactive) 356 | (let (($last-query swoop-minibuf-last-content) 357 | ($reserve (ht-get swoop-parameters "reserve")) 358 | ($pcre (ht-get swoop-parameters "pcre")) 359 | ($migemo (ht-get swoop-parameters "migemo"))) 360 | (run-with-timer 361 | 0 nil 362 | (lambda ($q) 363 | (cond ($pcre (setq swoop-use-pcre t)) 364 | ($migemo (setq swoop-use-migemo t))) 365 | (swoop-core :$query $q 366 | :$resume t 367 | :$multi t 368 | :$reserve $reserve)) 369 | $last-query) 370 | (exit-minibuffer))) 371 | ;; (define-key swoop-map (kbd "C-o") 'swoop-multi-from-swoop) 372 | 373 | ;;;###autoload 374 | (defun swoop-from-evil-search () 375 | "During evil-search, switch over to swoop." 376 | (interactive) 377 | (if (string-match "\\(isearch-\\|evil.*search\\)" 378 | (symbol-name real-last-command)) 379 | (swoop-core :$query (if isearch-regexp 380 | isearch-string 381 | (regexp-quote isearch-string))) 382 | (swoop))) 383 | ;; (define-key evil-motion-state-map (kbd "C-o") 'swoop-from-evil-search) 384 | 385 | (cl-defun swoop-update (&key $query $reserve $multi $pre-select) 386 | (when (get-buffer swoop-buffer) 387 | (swoop-async-kill-process) 388 | ;; Issue a session ID 389 | (setq swoop-async-id-latest (symbol-name (cl-gensym))) 390 | (unless (listp $query) 391 | (setq $query (split-string $query " " t))) 392 | (setq swoop-last-query-converted $query) 393 | (with-current-buffer swoop-buffer 394 | (if (and (not $query) (not $pre-select) (not $reserve)) 395 | (swoop-overlay-clear :$to-empty t :$multi $multi) 396 | (swoop-async-divider :$query $query 397 | :$reserve $reserve 398 | :$multi $multi 399 | :$pre-select $pre-select))))) 400 | 401 | (defun swoop-async-checker ($result $tots $pattern $multi) 402 | "Async checker." 403 | (let* (($id (car $result)) 404 | ($check-key (car $id))) 405 | (if (equal swoop-async-id-latest $check-key) 406 | (let (($buf (cdr $id)) 407 | ($lines (cdr $result))) 408 | (let (($v (ht-get swoop-async-pool $buf))) 409 | (if $v 410 | (ht-set swoop-async-pool $buf (cons $lines $v)) 411 | (ht-set swoop-async-pool $buf (cons $lines nil)))) 412 | (let (($n (or (ht-get swoop-async-pool "number") 0))) 413 | (ht-set swoop-async-pool "number" (1+ $n)) 414 | (when (eq $tots (1+ $n)) 415 | (ht-remove swoop-async-pool "number") 416 | (swoop-render $pattern $multi))))))) 417 | 418 | (cl-defun swoop-render ($pattern $multi) 419 | "Rendering results, and repositioning the selected line." 420 | (swoop-overlay-clear :$multi $multi) 421 | (setq swoop-last-selected-buffer 422 | (or (get-text-property (point-at-bol) 'swb) 423 | swoop--target-buffer)) 424 | (setq swoop-last-selected-line 425 | (or (get-text-property (point-at-bol) 'swl) 426 | swoop--target-last-line 427 | (ht-get (ht-get swoop-buffer-info swoop--target-buffer) "max-line") 428 | 1)) 429 | (erase-buffer) 430 | (with-selected-window swoop-window 431 | (let (($cont "") 432 | ($match-lines-common) 433 | ($nearest-line)) 434 | (erase-buffer) 435 | ;; swoop-async-pool ;=> (($parts-id $match-list $content-list) ...) 436 | (ht-each (lambda ($buf $val) 437 | (if (swoop-async-old-session?) (cl-return-from swoop-render)) 438 | (let (($con "") 439 | ($length (length $val))) 440 | (if (eq 1 $length) 441 | (progn 442 | (setq $con (mapconcat 'identity 443 | (cdr (cdr (car $val))) "")) 444 | (if (equal $buf swoop-last-selected-buffer) 445 | (setq $match-lines-common (nth 1 (car $val))))) 446 | (swoop-mapc $p (cl-sort $val 'string< :key 'car) 447 | (unless (equal $p "") 448 | (setq $con (concat $con (mapconcat 'identity (cddr $p) ""))) 449 | (if (equal $buf swoop-last-selected-buffer) 450 | (setq $match-lines-common 451 | (append (nth 1 $p) $match-lines-common)))))) 452 | (when (not (equal "" $con)) 453 | (setq $con 454 | (concat 455 | (propertize 456 | (concat $buf "\n") 457 | 'face 'swoop-face-line-buffer-name 458 | 'swd (if (equal $buf swoop-last-selected-buffer) t nil)) 459 | $con))) 460 | (setq $cont (concat $cont $con)))) 461 | swoop-async-pool) 462 | (insert $cont) 463 | (setq $nearest-line 464 | (swoop-nearest-line swoop-last-selected-line $match-lines-common)) 465 | ;; Words overlay 466 | (swoop-overlay-word $pattern swoop-buffer) 467 | (if $multi 468 | (swoop-mapc $b (ht-keys swoop-buffer-info) 469 | (if (swoop-async-old-session?) (cl-return-from swoop-render)) 470 | (swoop-overlay-word $pattern $b)) 471 | (swoop-overlay-word $pattern swoop--target-buffer)) 472 | ;; Adjust position 473 | (with-selected-window swoop-window 474 | (goto-char (or (next-single-property-change (point-min) 'swl) (point-min))) 475 | (if $nearest-line 476 | (goto-char 477 | (or (text-property-any 478 | (text-property-any (point-min) (point-max) 'swd t) 479 | (point-max) 'swl $nearest-line) 480 | (point-min)))) 481 | (cond ((and (bobp) (eobp)) 482 | nil) 483 | ((bobp) 484 | (swoop-action-goto-line-next)) 485 | ((eobp) 486 | (swoop-action-goto-line-prev))) 487 | (swoop-line-move 'init) 488 | (swoop-header-format-line-set 489 | (get-text-property (point-at-bol) 'swb)))))) 490 | 491 | (cl-defun swoop-async-divider (&key $query $reserve $multi $pre-select) 492 | "Divide buffers for async process." 493 | (with-current-buffer swoop-buffer 494 | (setq swoop-async-id-last swoop-async-id-latest) 495 | (let (($pattern (concat "\\(" (mapconcat 'identity $query "\\|") "\\)")) 496 | ($tots (let (($r 0)) 497 | (swoop-mapc $n (swoop-buffer-info-get-map "buf-number") 498 | (setq $r (+ $n $r))) 499 | $r))) 500 | (when $reserve 501 | (setq $query (cons $reserve $query))) 502 | (setq swoop-last-pattern $pattern) 503 | (unless $multi 504 | (let* (($buf swoop--target-buffer) 505 | ($buf-hash (ht-get swoop-buffer-info $buf)) 506 | ($tot (ht-get $buf-hash "buf-number")) 507 | ($buf-sep (ht-get $buf-hash "buf-separated")) 508 | ($by (ht-get $buf-hash "divide-by")) 509 | ($line-format (ht-get $buf-hash "line-format")) 510 | ($buf-sep-id)) 511 | (cl-dotimes ($i $tot) 512 | (setq $buf-sep-id (symbol-name (cl-gensym))) 513 | (if (swoop-async-old-session?) (cl-return-from swoop-async-divider)) 514 | (swoop-async-start 515 | `(lambda () 516 | (fundamental-mode) 517 | (insert ,(nth $i $buf-sep)) 518 | (cons (cons ,swoop-async-id-latest ,$buf) 519 | (cons ,$buf-sep-id 520 | (funcall ,swoop-async-get-match-lines-list 521 | ',$query ,(* $i $by) 522 | ,$line-format 523 | ',swoop-n 524 | ,$buf 525 | ',$pre-select 526 | ,swoop-match-beginning-line)))) 527 | (lambda ($result) 528 | (when (get-buffer swoop-buffer) 529 | (with-current-buffer swoop-buffer 530 | (swoop-async-checker $result $tot $pattern $multi)))))))) 531 | 532 | (when $multi 533 | (ht-each 534 | (lambda ($b $buf-hash) 535 | (if (swoop-async-old-session?) (cl-return-from swoop-async-divider)) 536 | (let* (($tot (ht-get $buf-hash "buf-number")) 537 | ($buf-sep (ht-get $buf-hash "buf-separated")) 538 | ($by (ht-get $buf-hash "divide-by")) 539 | ($line-format (ht-get $buf-hash "line-format")) 540 | ($buf-sep-id)) 541 | (cl-dotimes ($i $tot) 542 | (setq $buf-sep-id (symbol-name (cl-gensym))) 543 | (if (swoop-async-old-session?) (cl-return-from swoop-async-divider)) 544 | (swoop-async-start 545 | `(lambda () 546 | (fundamental-mode) 547 | (insert ,(nth $i $buf-sep)) 548 | (cons (cons ,swoop-async-id-latest ,$b) 549 | (cons ,$buf-sep-id 550 | (funcall ,swoop-async-get-match-lines-list 551 | ',$query ,(* $i $by) 552 | ,$line-format 553 | ',swoop-n 554 | ,$b 555 | ',$pre-select 556 | ,swoop-match-beginning-line)))) 557 | (lambda ($result) 558 | (when (get-buffer swoop-buffer) 559 | (with-current-buffer swoop-buffer 560 | (swoop-async-checker $result $tots $pattern $multi)))))))) 561 | swoop-buffer-info))))) 562 | 563 | ;; Minibuffer 564 | (cl-defun swoop-minibuffer-read-from-string (&key $query $reserve $multi $pre-select) 565 | "Observe minibuffer inputs." 566 | (if (equal "" $query) (setq swoop-minibuf-last-content nil)) 567 | (let (($timer nil)) 568 | (unwind-protect 569 | (minibuffer-with-setup-hook 570 | (lambda () 571 | (setq 572 | $timer 573 | (run-with-idle-timer 574 | swoop-minibuffer-input-dilay 575 | 'repeat 576 | (lambda () 577 | (with-selected-window (or (active-minibuffer-window) 578 | (minibuffer-window)) 579 | (let* (($content (format "%s" (minibuffer-contents)))) 580 | (when (and (not (equal swoop-minibuf-last-content 581 | $content)) 582 | (or 583 | ;; When becomeing empty again 584 | (equal "" $content) 585 | ;; Avoid too many matching 586 | (>= (length $content) 587 | swoop-input-threshold))) 588 | ;; Stop old async process 589 | (ht-clear! swoop-async-pool) 590 | (setq swoop-minibuf-last-content $content) 591 | (swoop-update :$query (swoop-convert-input $content) 592 | :$reserve $reserve 593 | :$multi $multi 594 | :$pre-select $pre-select)))))))) 595 | (read-from-minibuffer 596 | "Swoop: " (or $query "") 597 | swoop-map nil swoop-minibuffer-history nil t)) 598 | (when $timer (cancel-timer $timer) (setq $timer nil)) 599 | (setq swoop-last-query-plain swoop-minibuf-last-content) 600 | (setq swoop-minibuf-last-content "") 601 | (swoop-recenter)))) 602 | 603 | 604 | (provide 'swoop) 605 | ;;; swoop.el ends here 606 | --------------------------------------------------------------------------------