| 1 | ;;; -*- coding: utf-8; mode: emacs-lisp; -*- |
|---|
| 2 | ;;; anything-c-moccur.el |
|---|
| 3 | |
|---|
| 4 | ;; Author: Kenji.Imakado <ken.imakaado -at- gmail.com> |
|---|
| 5 | ;; Keywords: occur |
|---|
| 6 | ;; Prefix: anything-c-moccur- |
|---|
| 7 | |
|---|
| 8 | ;; This file is free software; you can redistribute it and/or modify |
|---|
| 9 | ;; it under the terms of the GNU General Public License as published by |
|---|
| 10 | ;; the Free Software Foundation; either version 2, or (at your option) |
|---|
| 11 | ;; any later version. |
|---|
| 12 | |
|---|
| 13 | ;; This file is distributed in the hope that it will be useful, |
|---|
| 14 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
|---|
| 15 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
|---|
| 16 | ;; GNU General Public License for more details. |
|---|
| 17 | |
|---|
| 18 | ;; You should have received a copy of the GNU General Public License |
|---|
| 19 | ;; along with GNU Emacs; see the file COPYING. If not, write to the |
|---|
| 20 | ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
|---|
| 21 | ;; Boston, MA 02110-1301, USA. |
|---|
| 22 | |
|---|
| 23 | |
|---|
| 24 | ;;; Commentary: |
|---|
| 25 | ;; Tested on Emacs 22 |
|---|
| 26 | |
|---|
| 27 | ;; sample config |
|---|
| 28 | ;; (require 'anything-c-moccur) |
|---|
| 29 | ;; (global-set-key (kbd "M-o") 'anything-c-moccur-occur-by-moccur) |
|---|
| 30 | ;; (global-set-key (kbd "C-M-o") 'anything-c-moccur-dmoccur) |
|---|
| 31 | ;; (add-hook 'dired-mode-hook |
|---|
| 32 | ;; '(lambda () |
|---|
| 33 | ;; (local-set-key (kbd "O") 'anything-c-moccur-dired-do-moccur-by-moccur))) |
|---|
| 34 | ;; (global-set-key (kbd "C-M-s") 'anything-c-moccur-isearch-forward) |
|---|
| 35 | ;; (global-set-key (kbd "C-M-r") 'anything-c-moccur-isearch-backward) |
|---|
| 36 | |
|---|
| 37 | ;;; Todo: |
|---|
| 38 | ;; resume |
|---|
| 39 | |
|---|
| 40 | ;;;code: |
|---|
| 41 | |
|---|
| 42 | (require 'anything) |
|---|
| 43 | (require 'cl) |
|---|
| 44 | (require 'color-moccur) |
|---|
| 45 | (require 'rx) |
|---|
| 46 | |
|---|
| 47 | (defgroup anything-c-moccur nil |
|---|
| 48 | "" |
|---|
| 49 | :group 'anything-c-moccur) |
|---|
| 50 | |
|---|
| 51 | |
|---|
| 52 | (defcustom anything-c-moccur-anything-idle-delay nil |
|---|
| 53 | "anything-c-moccurが提供するコマンドでanythingが起動された際の`anything-idle-delay'の値 |
|---|
| 54 | nilなら`anything-idle-delay'の値を使う" |
|---|
| 55 | :type '(choice (integer) |
|---|
| 56 | (boolean)) |
|---|
| 57 | :group 'anything-c-moccur) |
|---|
| 58 | |
|---|
| 59 | (defcustom anything-c-moccur-push-mark-flag nil |
|---|
| 60 | "non-nilならコマンド起動時に現在のポイントにマークをセットする" |
|---|
| 61 | :type 'boolean |
|---|
| 62 | :group 'anything-c-moccur) |
|---|
| 63 | |
|---|
| 64 | (defcustom anything-c-moccur-widen-when-goto-line-flag nil |
|---|
| 65 | "non-nilなら必要に応じてナローイングを解除する" |
|---|
| 66 | :type 'boolean |
|---|
| 67 | :group 'anything-c-moccur) |
|---|
| 68 | |
|---|
| 69 | (defcustom anything-c-moccur-show-all-when-goto-line-flag nil ;outline |
|---|
| 70 | "non-nilなら必要に応じてoutlineの折畳み表示を解除する" |
|---|
| 71 | :type 'boolean |
|---|
| 72 | :group 'anything-c-moccur |
|---|
| 73 | ) |
|---|
| 74 | |
|---|
| 75 | (defcustom anything-c-moccur-higligt-info-line-flag nil |
|---|
| 76 | "non-nilならdmoccur, dired-do-moccurの候補を表示する際にバッファ名などの情報をハイライト表示する" |
|---|
| 77 | :type 'boolean |
|---|
| 78 | :group 'anything-c-moccur) |
|---|
| 79 | |
|---|
| 80 | (defcustom anything-c-moccur-enable-auto-look-flag nil |
|---|
| 81 | "non-nilなら選択中の候補を他のバッファにリアルタイムに表示する" |
|---|
| 82 | :type 'boolean |
|---|
| 83 | :group 'anything-c-moccur) |
|---|
| 84 | |
|---|
| 85 | (defcustom anything-c-moccur-enable-initial-pattern nil |
|---|
| 86 | "non-nilなら`anything-c-moccur-occur-by-moccur'を起動する際に、ポイントの位置の単語をpatternの初期値として起動する。" |
|---|
| 87 | :type 'boolean |
|---|
| 88 | :group 'anything-c-moccur) |
|---|
| 89 | |
|---|
| 90 | (defcustom anything-c-moccur-use-moccur-anything-map-flag t |
|---|
| 91 | "non-nilならanything-c-moccurのデフォルトのキーバインドを使用する |
|---|
| 92 | nilなら使用しない" |
|---|
| 93 | :type 'boolean |
|---|
| 94 | :group 'anything-c-moccur) |
|---|
| 95 | |
|---|
| 96 | (defcustom anything-c-moccur-recenter-count 10 |
|---|
| 97 | "これは選択した候補の位置にポイントを移動した後に呼ばれる 関数`recenter'に引数として渡される値である" |
|---|
| 98 | :type '(choice (integer) |
|---|
| 99 | (boolean)) |
|---|
| 100 | :group 'anything-c-moccur) |
|---|
| 101 | |
|---|
| 102 | |
|---|
| 103 | ;;; variables |
|---|
| 104 | (defvar anything-c-moccur-version 0.32) |
|---|
| 105 | (defvar anything-c-moccur-anything-invoking-flag nil) |
|---|
| 106 | (defvar anything-c-moccur-anything-initial-pattern "") |
|---|
| 107 | (defvar anything-c-moccur-anything-current-buffer nil) |
|---|
| 108 | (defvar anything-c-moccur-saved-info nil) |
|---|
| 109 | (defvar anything-c-moccur-anything-map |
|---|
| 110 | (let ((map (copy-keymap anything-map))) |
|---|
| 111 | (when anything-c-moccur-use-moccur-anything-map-flag |
|---|
| 112 | (define-key map (kbd "D") 'anything-c-moccur-wrap-symbol) |
|---|
| 113 | (define-key map (kbd "W") 'anything-c-moccur-wrap-word) |
|---|
| 114 | (define-key map (kbd "F") 'anything-c-moccur-match-only-function) |
|---|
| 115 | (define-key map (kbd "C") 'anything-c-moccur-match-only-comment) |
|---|
| 116 | (define-key map (kbd "S") 'anything-c-moccur-match-only-string) |
|---|
| 117 | |
|---|
| 118 | (define-key map (kbd "U") 'anything-c-moccur-start-symbol) |
|---|
| 119 | (define-key map (kbd "I") 'anything-c-moccur-end-symbol) |
|---|
| 120 | (define-key map (kbd "O") 'anything-c-moccur-start-word) |
|---|
| 121 | (define-key map (kbd "P") 'anything-c-moccur-end-word) |
|---|
| 122 | |
|---|
| 123 | (define-key map (kbd "J") 'scroll-other-window) |
|---|
| 124 | (define-key map (kbd "K") 'scroll-other-window-down) |
|---|
| 125 | |
|---|
| 126 | ;; anything |
|---|
| 127 | (define-key map (kbd "C-n") 'anything-c-moccur-next-line) |
|---|
| 128 | (define-key map (kbd "C-p") 'anything-c-moccur-previous-line) |
|---|
| 129 | |
|---|
| 130 | (define-key map (kbd "C-M-f") 'anything-c-moccur-anything-next-file-matches) |
|---|
| 131 | (define-key map (kbd "C-M-b") 'anything-c-moccur-anything-previous-file-matches) |
|---|
| 132 | |
|---|
| 133 | (define-key map (kbd "C-M-%") 'anything-c-moccur-query-replace-regexp) |
|---|
| 134 | ) |
|---|
| 135 | map)) |
|---|
| 136 | |
|---|
| 137 | ;;overlay |
|---|
| 138 | (defvar anything-c-moccur-current-line-overlay |
|---|
| 139 | (make-overlay (point) (point))) |
|---|
| 140 | |
|---|
| 141 | ;;; utilities |
|---|
| 142 | (defun anything-c-moccur-widen-if-need () |
|---|
| 143 | (when anything-c-moccur-widen-when-goto-line-flag |
|---|
| 144 | (widen)) |
|---|
| 145 | (when anything-c-moccur-show-all-when-goto-line-flag |
|---|
| 146 | (require 'outline) |
|---|
| 147 | (show-all))) |
|---|
| 148 | |
|---|
| 149 | ;; regexp from `moccur-get-info' |
|---|
| 150 | (defvar anything-c-moccur-info-line-re "^[-+ ]*Buffer:[ ]*\\([^\r\n]*\\) File\\([^:/\r\n]*\\):[ ]*\\([^\r\n]+\\)$") |
|---|
| 151 | |
|---|
| 152 | (defun anything-c-moccur-anything-move-selection-if-info-line (direction) |
|---|
| 153 | (unless (= (buffer-size (get-buffer anything-buffer)) 0) |
|---|
| 154 | (with-current-buffer anything-buffer |
|---|
| 155 | (let ((re anything-c-moccur-info-line-re)) |
|---|
| 156 | (when (save-excursion |
|---|
| 157 | (beginning-of-line) |
|---|
| 158 | (looking-at re)) |
|---|
| 159 | (case direction |
|---|
| 160 | (next (anything-next-line)) |
|---|
| 161 | (previous (anything-previous-line))))) |
|---|
| 162 | (anything-mark-current-line)))) |
|---|
| 163 | |
|---|
| 164 | (defun anything-c-moccur-next-line-if-info-line () |
|---|
| 165 | (anything-c-moccur-anything-move-selection-if-info-line 'next)) |
|---|
| 166 | |
|---|
| 167 | (defun anything-c-moccur-previous-line-if-info-line () |
|---|
| 168 | (anything-c-moccur-anything-move-selection-if-info-line 'previous)) |
|---|
| 169 | |
|---|
| 170 | (defun anything-c-moccur-get-info () |
|---|
| 171 | "return (values buffer file)" |
|---|
| 172 | (cond |
|---|
| 173 | (anything-c-moccur-saved-info |
|---|
| 174 | anything-c-moccur-saved-info) |
|---|
| 175 | (t |
|---|
| 176 | (unless (or (= (buffer-size (get-buffer anything-buffer)) 0)) |
|---|
| 177 | (with-current-buffer anything-buffer |
|---|
| 178 | (save-excursion |
|---|
| 179 | (let ((re anything-c-moccur-info-line-re)) |
|---|
| 180 | (when (re-search-backward re nil t) |
|---|
| 181 | (values (match-string-no-properties 1) ;buffer |
|---|
| 182 | (match-string-no-properties 3)))))))))) |
|---|
| 183 | |
|---|
| 184 | (defun anything-c-moccur-anything-move-selection (unit direction) |
|---|
| 185 | (unless (or (= (buffer-size (get-buffer anything-buffer)) 0) |
|---|
| 186 | (not (get-buffer-window anything-buffer 'visible))) |
|---|
| 187 | (save-selected-window |
|---|
| 188 | (select-window (get-buffer-window anything-buffer 'visible)) |
|---|
| 189 | |
|---|
| 190 | (case unit |
|---|
| 191 | (file (let ((search-fn (case direction |
|---|
| 192 | (next 're-search-forward) |
|---|
| 193 | (previous (prog1 're-search-backward |
|---|
| 194 | (re-search-backward anything-c-moccur-info-line-re nil t))) |
|---|
| 195 | (t (error "Invalid direction."))))) |
|---|
| 196 | ;;(funcall search-fn (rx bol "Buffer:" (* not-newline) "File:") nil t))) |
|---|
| 197 | (funcall search-fn anything-c-moccur-info-line-re nil t))) |
|---|
| 198 | |
|---|
| 199 | (t (error "Invalid unit."))) |
|---|
| 200 | |
|---|
| 201 | (while (anything-pos-header-line-p) |
|---|
| 202 | (forward-line (if (and (eq direction 'previous) |
|---|
| 203 | (not (eq (line-beginning-position) |
|---|
| 204 | (point-min)))) |
|---|
| 205 | -1 |
|---|
| 206 | 1))) |
|---|
| 207 | |
|---|
| 208 | (if (eobp) |
|---|
| 209 | (forward-line -1)) |
|---|
| 210 | (anything-mark-current-line) |
|---|
| 211 | |
|---|
| 212 | ;; top |
|---|
| 213 | (recenter 0)))) |
|---|
| 214 | |
|---|
| 215 | (defun anything-c-moccur-anything-next-file-matches () |
|---|
| 216 | (interactive) |
|---|
| 217 | (anything-c-moccur-anything-move-selection 'file 'next) |
|---|
| 218 | (anything-c-moccur-next-line-if-info-line) |
|---|
| 219 | (anything-c-moccur-anything-try-execute-persistent-action)) |
|---|
| 220 | |
|---|
| 221 | (defun anything-c-moccur-anything-previous-file-matches () |
|---|
| 222 | (interactive) |
|---|
| 223 | (anything-c-moccur-anything-move-selection 'file 'previous) |
|---|
| 224 | (anything-c-moccur-next-line-if-info-line) |
|---|
| 225 | (anything-c-moccur-anything-try-execute-persistent-action)) |
|---|
| 226 | |
|---|
| 227 | (defun anything-c-moccur-initialize () |
|---|
| 228 | (setq anything-c-moccur-saved-info nil |
|---|
| 229 | anything-c-moccur-anything-invoking-flag t)) |
|---|
| 230 | |
|---|
| 231 | (defun anything-c-moccur-anything-try-execute-persistent-action () |
|---|
| 232 | (when (and anything-c-moccur-enable-auto-look-flag |
|---|
| 233 | anything-c-moccur-anything-invoking-flag) |
|---|
| 234 | (unless (zerop (buffer-size (get-buffer (anything-buffer-get)))) |
|---|
| 235 | (anything-execute-persistent-action)))) |
|---|
| 236 | |
|---|
| 237 | (defvar anything-c-moccur-last-buffer nil) |
|---|
| 238 | (defmacro anything-c-moccur-with-anything-env (sources &rest body) |
|---|
| 239 | (declare (indent 1)) |
|---|
| 240 | `(let ((anything-sources ,sources) |
|---|
| 241 | (anything-map anything-c-moccur-anything-map) |
|---|
| 242 | (anything-idle-delay (cond |
|---|
| 243 | ((integerp anything-c-moccur-anything-idle-delay) |
|---|
| 244 | anything-c-moccur-anything-idle-delay) |
|---|
| 245 | (t anything-idle-delay)))) |
|---|
| 246 | (add-hook 'anything-c-moccur-anything-after-update-hook 'anything-c-moccur-anything-try-execute-persistent-action) |
|---|
| 247 | (unwind-protect |
|---|
| 248 | (progn |
|---|
| 249 | ,@body) |
|---|
| 250 | (remove-hook 'anything-c-moccur-anything-after-update-hook 'anything-c-moccur-anything-try-execute-persistent-action) |
|---|
| 251 | (setq anything-c-moccur-last-buffer anything-current-buffer)))) |
|---|
| 252 | |
|---|
| 253 | |
|---|
| 254 | (defun anything-c-moccur-clean-up () |
|---|
| 255 | (setq anything-c-moccur-anything-invoking-flag nil) |
|---|
| 256 | (when (overlayp anything-c-moccur-current-line-overlay) |
|---|
| 257 | (delete-overlay anything-c-moccur-current-line-overlay))) |
|---|
| 258 | |
|---|
| 259 | ;; (anything-next-line) 後のanything-update-hook |
|---|
| 260 | ;; persistent-actionを動作させるために実装 |
|---|
| 261 | (defvar anything-c-moccur-anything-after-update-hook nil) |
|---|
| 262 | (defadvice anything-process-delayed-sources (after anything-c-moccur-anything-after-update-hook activate protect) |
|---|
| 263 | (when (and (boundp 'anything-c-moccur-anything-invoking-flag) |
|---|
| 264 | anything-c-moccur-anything-invoking-flag) |
|---|
| 265 | (ignore-errors |
|---|
| 266 | (run-hooks 'anything-c-moccur-anything-after-update-hook)))) |
|---|
| 267 | |
|---|
| 268 | (defadvice anything-select-action (before anything-c-moccur-saved-info activate) |
|---|
| 269 | (when (and (boundp 'anything-c-moccur-anything-invoking-flag) |
|---|
| 270 | anything-c-moccur-anything-invoking-flag) |
|---|
| 271 | (ignore-errors |
|---|
| 272 | (unless anything-c-moccur-saved-info |
|---|
| 273 | (setq anything-c-moccur-saved-info (anything-c-moccur-get-info)))))) |
|---|
| 274 | |
|---|
| 275 | (defadvice moccur-search (around anything-c-moccur-no-window-change) |
|---|
| 276 | (cond |
|---|
| 277 | ((and (boundp 'anything-c-moccur-anything-invoking-flag) |
|---|
| 278 | anything-c-moccur-anything-invoking-flag) |
|---|
| 279 | (let ((regexp (ad-get-arg 0)) |
|---|
| 280 | (arg (ad-get-arg 1)) |
|---|
| 281 | (buffers (ad-get-arg 2))) |
|---|
| 282 | (when (or (not regexp) |
|---|
| 283 | (string= regexp "")) |
|---|
| 284 | (error "No search word specified!")) |
|---|
| 285 | ;; initialize |
|---|
| 286 | (let ((lst (list regexp arg buffers))) |
|---|
| 287 | (if (equal lst (car moccur-searched-list)) |
|---|
| 288 | () |
|---|
| 289 | (setq moccur-searched-list (cons (list regexp arg buffers) moccur-searched-list)))) |
|---|
| 290 | (setq moccur-special-word nil) |
|---|
| 291 | (moccur-set-regexp) |
|---|
| 292 | (moccur-set-regexp-for-color) |
|---|
| 293 | ;; variable reset |
|---|
| 294 | (setq dmoccur-project-name nil) |
|---|
| 295 | (setq moccur-matches 0) |
|---|
| 296 | (setq moccur-match-buffers nil) |
|---|
| 297 | (setq moccur-regexp-input regexp) |
|---|
| 298 | (if (string= (car regexp-history) moccur-regexp-input) |
|---|
| 299 | () |
|---|
| 300 | (setq regexp-history (cons moccur-regexp-input regexp-history))) |
|---|
| 301 | (save-excursion |
|---|
| 302 | (setq moccur-mocur-buffer (generate-new-buffer "*Moccur*")) |
|---|
| 303 | (set-buffer moccur-mocur-buffer) |
|---|
| 304 | (insert "Lines matching " moccur-regexp-input "\n") |
|---|
| 305 | (setq moccur-buffers buffers) |
|---|
| 306 | ;; search all buffers |
|---|
| 307 | (while buffers |
|---|
| 308 | (if (and (car buffers) |
|---|
| 309 | (buffer-live-p (car buffers)) |
|---|
| 310 | ;; if b:regexp exists, |
|---|
| 311 | (if (and moccur-file-name-regexp |
|---|
| 312 | moccur-split-word) |
|---|
| 313 | (string-match moccur-file-name-regexp (buffer-name (car buffers))) |
|---|
| 314 | t)) |
|---|
| 315 | (if (and (not arg) |
|---|
| 316 | (not (buffer-file-name (car buffers)))) |
|---|
| 317 | (setq buffers (cdr buffers)) |
|---|
| 318 | (if (moccur-search-buffer (car moccur-regexp-list) (car buffers)) |
|---|
| 319 | (setq moccur-match-buffers (cons (car buffers) moccur-match-buffers))) |
|---|
| 320 | (setq buffers (cdr buffers))) |
|---|
| 321 | ;; illegal buffer |
|---|
| 322 | (setq buffers (cdr buffers))))))) |
|---|
| 323 | (t |
|---|
| 324 | ad-do-it))) |
|---|
| 325 | |
|---|
| 326 | (defun anything-c-moccur-bad-regexp-p (re) |
|---|
| 327 | (or (string-match (rx bol (+ space) eol) re) |
|---|
| 328 | (string-equal "" re) |
|---|
| 329 | (string-match (rx (or bol (+ space)) (+ (any "<" ">" "\\" "_" "`")) (or eol (+ space ))) re))) |
|---|
| 330 | |
|---|
| 331 | (defun anything-c-moccur-moccur-search (regexp arg buffers) |
|---|
| 332 | (ignore-errors |
|---|
| 333 | (unwind-protect |
|---|
| 334 | (progn |
|---|
| 335 | ;; active advice |
|---|
| 336 | (ad-enable-advice 'moccur-search 'around 'anything-c-moccur-no-window-change) |
|---|
| 337 | (ad-activate 'moccur-search) |
|---|
| 338 | ;; 空白のみで呼ばれると固まることがあったので追加 |
|---|
| 339 | (when (anything-c-moccur-bad-regexp-p anything-pattern) |
|---|
| 340 | (error "")) |
|---|
| 341 | |
|---|
| 342 | (save-window-excursion |
|---|
| 343 | (moccur-setup) |
|---|
| 344 | (moccur-search regexp arg buffers))) |
|---|
| 345 | ;; disable advance |
|---|
| 346 | (ad-disable-advice 'moccur-search 'around 'anything-c-moccur-no-window-change) |
|---|
| 347 | (ad-activate 'moccur-search)))) |
|---|
| 348 | |
|---|
| 349 | (defun anything-c-moccur-occur-by-moccur-scraper () |
|---|
| 350 | (when (buffer-live-p moccur-mocur-buffer) |
|---|
| 351 | (with-current-buffer moccur-mocur-buffer |
|---|
| 352 | (let* ((buf (buffer-substring (point-min) (point-max))) |
|---|
| 353 | (lines (delete "" (subseq (split-string buf "\n") 3)))) |
|---|
| 354 | lines)))) |
|---|
| 355 | |
|---|
| 356 | (defun anything-c-moccur-occur-by-moccur-get-candidates () |
|---|
| 357 | (anything-c-moccur-moccur-search anything-pattern t (list anything-current-buffer)) |
|---|
| 358 | (anything-c-moccur-occur-by-moccur-scraper)) |
|---|
| 359 | |
|---|
| 360 | (defun anything-c-moccur-occur-by-moccur-persistent-action (candidate) |
|---|
| 361 | (anything-c-moccur-widen-if-need) |
|---|
| 362 | (goto-line (string-to-number candidate)) |
|---|
| 363 | (recenter anything-c-moccur-recenter-count) |
|---|
| 364 | (when (overlayp anything-c-moccur-current-line-overlay) |
|---|
| 365 | (move-overlay anything-c-moccur-current-line-overlay |
|---|
| 366 | (line-beginning-position) |
|---|
| 367 | (line-end-position) |
|---|
| 368 | (current-buffer)) |
|---|
| 369 | (overlay-put anything-c-moccur-current-line-overlay 'face 'highlight))) |
|---|
| 370 | |
|---|
| 371 | (defun anything-c-moccur-occur-by-moccur-goto-line (candidate) |
|---|
| 372 | (anything-c-moccur-widen-if-need) ;utility |
|---|
| 373 | (goto-line (string-to-number candidate)) |
|---|
| 374 | (recenter anything-c-moccur-recenter-count)) |
|---|
| 375 | |
|---|
| 376 | (defvar anything-c-source-occur-by-moccur |
|---|
| 377 | `((name . "Occur by Moccur") |
|---|
| 378 | (candidates . anything-c-moccur-occur-by-moccur-get-candidates) |
|---|
| 379 | (action . (("Goto line" . anything-c-moccur-occur-by-moccur-goto-line))) |
|---|
| 380 | (persistent-action . anything-c-moccur-occur-by-moccur-persistent-action) |
|---|
| 381 | (init . anything-c-moccur-initialize) |
|---|
| 382 | (cleanup . anything-c-moccur-clean-up) |
|---|
| 383 | (match . (identity)) |
|---|
| 384 | (requires-pattern . 3) |
|---|
| 385 | (delayed) |
|---|
| 386 | (volatile))) |
|---|
| 387 | |
|---|
| 388 | (defun anything-c-moccur-occur-by-moccur (&optional prefix) |
|---|
| 389 | (interactive "P") |
|---|
| 390 | (if prefix |
|---|
| 391 | (anything-c-moccur-resume) |
|---|
| 392 | (anything-c-moccur-with-anything-env (list anything-c-source-occur-by-moccur) |
|---|
| 393 | (let* ((initial-pattern (if anything-c-moccur-enable-initial-pattern |
|---|
| 394 | (regexp-quote (or (thing-at-point 'symbol) "")) |
|---|
| 395 | ""))) |
|---|
| 396 | (when anything-c-moccur-push-mark-flag |
|---|
| 397 | (push-mark)) |
|---|
| 398 | (anything nil initial-pattern))))) |
|---|
| 399 | |
|---|
| 400 | (defun anything-c-moccur-occur-by-moccur-only-function () |
|---|
| 401 | (interactive) |
|---|
| 402 | (anything-c-moccur-with-anything-env (list anything-c-source-occur-by-moccur) |
|---|
| 403 | (when anything-c-moccur-push-mark-flag |
|---|
| 404 | (push-mark)) |
|---|
| 405 | (anything nil "! "))) |
|---|
| 406 | |
|---|
| 407 | (defun anything-c-moccur-occur-by-moccur-only-comment () |
|---|
| 408 | (interactive) |
|---|
| 409 | (anything-c-moccur-with-anything-env (list anything-c-source-occur-by-moccur) |
|---|
| 410 | (when anything-c-moccur-push-mark-flag |
|---|
| 411 | (push-mark)) |
|---|
| 412 | (anything nil ";;; "))) |
|---|
| 413 | |
|---|
| 414 | (defun anything-c-moccur-query-replace-regexp () |
|---|
| 415 | (interactive) |
|---|
| 416 | (lexical-let ((input-re (minibuffer-contents)) |
|---|
| 417 | (cur-point (first anything-current-position))) |
|---|
| 418 | (setq anything-saved-action (lambda (dummy) |
|---|
| 419 | (let ((to-string (read-from-minibuffer "to: " input-re))) |
|---|
| 420 | (unwind-protect |
|---|
| 421 | (perform-replace input-re to-string t t nil nil nil (point-min) (point-max)) |
|---|
| 422 | (goto-char cur-point))))) |
|---|
| 423 | (anything-exit-minibuffer))) |
|---|
| 424 | |
|---|
| 425 | ;;; dmoccur |
|---|
| 426 | (defvar anything-c-moccur-dmoccur-buffers nil) |
|---|
| 427 | |
|---|
| 428 | (defun anything-c-moccur-dmoccur-higligt-info-line () |
|---|
| 429 | (let ((re anything-c-moccur-info-line-re)) |
|---|
| 430 | (loop initially (goto-char (point-min)) |
|---|
| 431 | while (re-search-forward re nil t) |
|---|
| 432 | do (put-text-property (line-beginning-position) |
|---|
| 433 | (line-end-position) |
|---|
| 434 | 'face |
|---|
| 435 | anything-header-face)))) |
|---|
| 436 | |
|---|
| 437 | (defun anything-c-moccur-dmoccur-scraper () |
|---|
| 438 | (when (buffer-live-p moccur-mocur-buffer) |
|---|
| 439 | (with-current-buffer moccur-mocur-buffer |
|---|
| 440 | (let ((lines nil) |
|---|
| 441 | (re (rx bol (group (+ not-newline)) eol))) |
|---|
| 442 | |
|---|
| 443 | ;; put face [Buffer:...] line |
|---|
| 444 | (when anything-c-moccur-higligt-info-line-flag |
|---|
| 445 | (anything-c-moccur-dmoccur-higligt-info-line)) |
|---|
| 446 | |
|---|
| 447 | (loop initially (progn (goto-char (point-min)) |
|---|
| 448 | (forward-line 1)) |
|---|
| 449 | while (re-search-forward re nil t) |
|---|
| 450 | do (push (match-string 0) lines)) |
|---|
| 451 | (nreverse lines))))) |
|---|
| 452 | |
|---|
| 453 | (defun anything-c-moccur-dmoccur-get-candidates () |
|---|
| 454 | (anything-c-moccur-moccur-search anything-pattern nil anything-c-moccur-dmoccur-buffers) |
|---|
| 455 | (anything-c-moccur-dmoccur-scraper)) |
|---|
| 456 | |
|---|
| 457 | (defun anything-c-moccur-dmoccur-persistent-action (candidate) |
|---|
| 458 | (anything-c-moccur-next-line-if-info-line) |
|---|
| 459 | |
|---|
| 460 | (let ((real-candidate (anything-get-selection))) |
|---|
| 461 | |
|---|
| 462 | (multiple-value-bind (buffer file-path) |
|---|
| 463 | (anything-c-moccur-get-info) ;return (values buffer file) |
|---|
| 464 | (when (and (stringp buffer) |
|---|
| 465 | (bufferp (get-buffer buffer)) |
|---|
| 466 | (stringp file-path) |
|---|
| 467 | (file-readable-p file-path)) |
|---|
| 468 | |
|---|
| 469 | (find-file file-path) |
|---|
| 470 | |
|---|
| 471 | (anything-c-moccur-widen-if-need) |
|---|
| 472 | |
|---|
| 473 | (let ((line-number (string-to-number real-candidate))) |
|---|
| 474 | (when (and (numberp line-number) |
|---|
| 475 | (not (= line-number 0))) |
|---|
| 476 | (goto-line line-number) |
|---|
| 477 | |
|---|
| 478 | (recenter anything-c-moccur-recenter-count) |
|---|
| 479 | (when (overlayp anything-c-moccur-current-line-overlay) |
|---|
| 480 | (move-overlay anything-c-moccur-current-line-overlay |
|---|
| 481 | (line-beginning-position) |
|---|
| 482 | (line-end-position) |
|---|
| 483 | (current-buffer)) |
|---|
| 484 | (overlay-put anything-c-moccur-current-line-overlay 'face 'highlight)))))))) |
|---|
| 485 | |
|---|
| 486 | (defun anything-c-moccur-dmoccur-goto-line (candidate) |
|---|
| 487 | (multiple-value-bind (buffer file-path) |
|---|
| 488 | (anything-c-moccur-get-info) |
|---|
| 489 | (let ((line-number (string-to-number candidate))) |
|---|
| 490 | (when (and (stringp buffer) |
|---|
| 491 | (bufferp (get-buffer buffer)) |
|---|
| 492 | (stringp file-path) |
|---|
| 493 | (file-readable-p file-path)) |
|---|
| 494 | (find-file file-path) |
|---|
| 495 | (goto-line line-number))))) |
|---|
| 496 | |
|---|
| 497 | (defvar anything-c-source-dmoccur |
|---|
| 498 | '((name . "DMoccur") |
|---|
| 499 | (candidates . anything-c-moccur-dmoccur-get-candidates) |
|---|
| 500 | (action . (("Goto line" . anything-c-moccur-dmoccur-goto-line))) |
|---|
| 501 | (persistent-action . anything-c-moccur-dmoccur-persistent-action) |
|---|
| 502 | (match . (identity)) |
|---|
| 503 | (requires-pattern . 5) |
|---|
| 504 | (init . anything-c-moccur-initialize) |
|---|
| 505 | (cleanup . anything-c-moccur-clean-up) |
|---|
| 506 | (delayed) |
|---|
| 507 | (volatile))) |
|---|
| 508 | |
|---|
| 509 | (defun anything-c-moccur-dmoccur (dir) |
|---|
| 510 | (interactive (list (dmoccur-read-from-minibuf current-prefix-arg))) |
|---|
| 511 | (let ((buffers (sort |
|---|
| 512 | (moccur-add-directory-to-search-list dir) |
|---|
| 513 | moccur-buffer-sort-method))) |
|---|
| 514 | |
|---|
| 515 | (setq anything-c-moccur-dmoccur-buffers buffers) |
|---|
| 516 | |
|---|
| 517 | (anything-c-moccur-with-anything-env (list anything-c-source-dmoccur) |
|---|
| 518 | (anything)))) |
|---|
| 519 | |
|---|
| 520 | ;;; dired-do-moccur |
|---|
| 521 | (defvar anything-c-moccur-dired-do-moccur-buffers nil) |
|---|
| 522 | |
|---|
| 523 | (defun anything-c-moccur-dired-get-buffers () |
|---|
| 524 | (moccur-add-files-to-search-list |
|---|
| 525 | (funcall (cond ((fboundp 'dired-get-marked-files) ; GNU Emacs |
|---|
| 526 | 'dired-get-marked-files) |
|---|
| 527 | ((fboundp 'dired-mark-get-files) ; XEmacs |
|---|
| 528 | 'dired-mark-get-files)) |
|---|
| 529 | t nil) default-directory t 'dired)) |
|---|
| 530 | |
|---|
| 531 | (defun anything-c-moccur-dired-do-moccur-by-moccur-get-candidates () |
|---|
| 532 | (anything-c-moccur-moccur-search anything-pattern nil anything-c-moccur-dired-do-moccur-buffers) |
|---|
| 533 | (anything-c-moccur-dmoccur-scraper)) |
|---|
| 534 | |
|---|
| 535 | (defvar anything-c-source-dired-do-moccur |
|---|
| 536 | '((name . "Dired do Moccur") |
|---|
| 537 | (candidates . anything-c-moccur-dired-do-moccur-by-moccur-get-candidates) |
|---|
| 538 | (action . (("Goto line" . anything-c-moccur-dmoccur-goto-line))) |
|---|
| 539 | (persistent-action . anything-c-moccur-dmoccur-persistent-action) |
|---|
| 540 | (match . (identity)) |
|---|
| 541 | (requires-pattern . 3) |
|---|
| 542 | (init . anything-c-moccur-initialize) |
|---|
| 543 | (cleanup . anything-c-moccur-clean-up) |
|---|
| 544 | (delayed) |
|---|
| 545 | (volatile))) |
|---|
| 546 | |
|---|
| 547 | (defun anything-c-moccur-dired-do-moccur-by-moccur () |
|---|
| 548 | (interactive) |
|---|
| 549 | (let ((buffers (anything-c-moccur-dired-get-buffers))) |
|---|
| 550 | (setq anything-c-moccur-dired-do-moccur-buffers buffers) |
|---|
| 551 | |
|---|
| 552 | (anything-c-moccur-with-anything-env (list anything-c-source-dired-do-moccur) |
|---|
| 553 | (anything)))) |
|---|
| 554 | |
|---|
| 555 | ;;; Commands |
|---|
| 556 | |
|---|
| 557 | (defun anything-c-moccur-last-sources-is-moccur-p () |
|---|
| 558 | (and (equal anything-c-moccur-last-buffer (current-buffer)) |
|---|
| 559 | (every (lambda (source) |
|---|
| 560 | (let ((source (if (listp source) source (symbol-value source)))) |
|---|
| 561 | (string-match "moccur" (assoc-default 'name source)))) |
|---|
| 562 | anything-last-sources))) |
|---|
| 563 | |
|---|
| 564 | (defun anything-c-moccur-resume () |
|---|
| 565 | (interactive) |
|---|
| 566 | (if (anything-c-moccur-last-sources-is-moccur-p) |
|---|
| 567 | (anything-c-moccur-with-anything-env anything-last-sources |
|---|
| 568 | (anything-c-moccur-initialize) |
|---|
| 569 | (anything-resume)) |
|---|
| 570 | (message "last source is not anything-c-moccur source"))) |
|---|
| 571 | |
|---|
| 572 | (defun anything-c-moccur-isearch-forward () |
|---|
| 573 | (interactive) |
|---|
| 574 | (let ((anything-c-moccur-widen-when-goto-line-flag nil)) |
|---|
| 575 | (save-window-excursion |
|---|
| 576 | (save-restriction |
|---|
| 577 | (narrow-to-region (point-at-bol) (point-max)) |
|---|
| 578 | (anything-c-moccur-occur-by-moccur))))) |
|---|
| 579 | |
|---|
| 580 | (defun anything-c-moccur-isearch-backward () |
|---|
| 581 | (interactive) |
|---|
| 582 | (let* ((anything-c-moccur-widen-when-goto-line-flag nil) |
|---|
| 583 | (copied-source (copy-alist anything-c-source-occur-by-moccur)) ;anything-c-source-occur-by-moccur is list. not symbol |
|---|
| 584 | (anything-c-source-occur-by-moccur (cons '(candidate-transformer . (lambda (-candidates) |
|---|
| 585 | (reverse -candidates))) |
|---|
| 586 | copied-source))) |
|---|
| 587 | (save-window-excursion |
|---|
| 588 | (save-restriction |
|---|
| 589 | (narrow-to-region (point-min) (point-at-eol)) |
|---|
| 590 | (anything-c-moccur-occur-by-moccur))))) |
|---|
| 591 | |
|---|
| 592 | ;;; Commands for `anything-c-moccur-anything-map' |
|---|
| 593 | (defun anything-c-moccur-next-line () |
|---|
| 594 | (interactive) |
|---|
| 595 | (anything-next-line) |
|---|
| 596 | (anything-c-moccur-next-line-if-info-line) |
|---|
| 597 | (anything-c-moccur-anything-try-execute-persistent-action)) |
|---|
| 598 | |
|---|
| 599 | (defun anything-c-moccur-previous-line () |
|---|
| 600 | (interactive) |
|---|
| 601 | (anything-previous-line) |
|---|
| 602 | (anything-c-moccur-previous-line-if-info-line) |
|---|
| 603 | (anything-c-moccur-anything-try-execute-persistent-action)) |
|---|
| 604 | |
|---|
| 605 | |
|---|
| 606 | (defun anything-c-moccur-wrap-word-internal (s1 s2) |
|---|
| 607 | (ignore-errors |
|---|
| 608 | (let ((cur-syntax-table |
|---|
| 609 | (with-current-buffer anything-current-buffer |
|---|
| 610 | (syntax-table)))) |
|---|
| 611 | (when (syntax-table-p cur-syntax-table) |
|---|
| 612 | (with-syntax-table cur-syntax-table |
|---|
| 613 | (save-excursion |
|---|
| 614 | (backward-sexp) |
|---|
| 615 | (insert s1)) |
|---|
| 616 | (insert s2)))))) |
|---|
| 617 | |
|---|
| 618 | (defun anything-c-moccur-start-symbol () |
|---|
| 619 | (interactive) |
|---|
| 620 | (anything-c-moccur-wrap-word-internal "\\_<" "")) |
|---|
| 621 | |
|---|
| 622 | (defun anything-c-moccur-end-symbol () |
|---|
| 623 | (interactive) |
|---|
| 624 | (anything-c-moccur-wrap-word-internal "" "\\_>")) |
|---|
| 625 | |
|---|
| 626 | (defun anything-c-moccur-wrap-symbol () |
|---|
| 627 | (interactive) |
|---|
| 628 | (anything-c-moccur-wrap-word-internal "\\_<" "\\_>")) |
|---|
| 629 | |
|---|
| 630 | (defun anything-c-moccur-start-word () |
|---|
| 631 | (interactive) |
|---|
| 632 | (anything-c-moccur-wrap-word-internal "\\<" "")) |
|---|
| 633 | |
|---|
| 634 | (defun anything-c-moccur-end-word () |
|---|
| 635 | (interactive) |
|---|
| 636 | (anything-c-moccur-wrap-word-internal "" "\\>")) |
|---|
| 637 | |
|---|
| 638 | (defun anything-c-moccur-wrap-word () |
|---|
| 639 | (interactive) |
|---|
| 640 | (anything-c-moccur-wrap-word-internal "\\<" "\\>")) |
|---|
| 641 | |
|---|
| 642 | |
|---|
| 643 | |
|---|
| 644 | ;; minibuf: hoge |
|---|
| 645 | ;; => minibuf: ! hoge |
|---|
| 646 | (defun anything-c-moccur-delete-special-word () |
|---|
| 647 | (let ((re (rx (or "!" ";" "\"") |
|---|
| 648 | (* space)))) |
|---|
| 649 | (ignore-errors |
|---|
| 650 | (save-excursion |
|---|
| 651 | (beginning-of-line) |
|---|
| 652 | (when (looking-at re) |
|---|
| 653 | (replace-match "")))))) |
|---|
| 654 | |
|---|
| 655 | (defun anything-c-moccur-match-only-internal (str) |
|---|
| 656 | (anything-c-moccur-delete-special-word) |
|---|
| 657 | (save-excursion |
|---|
| 658 | (beginning-of-line) |
|---|
| 659 | (insert-before-markers str))) |
|---|
| 660 | |
|---|
| 661 | (defun anything-c-moccur-match-only-function () |
|---|
| 662 | (interactive) |
|---|
| 663 | (anything-c-moccur-match-only-internal "! ")) |
|---|
| 664 | |
|---|
| 665 | (defun anything-c-moccur-match-only-comment () |
|---|
| 666 | (interactive) |
|---|
| 667 | (anything-c-moccur-match-only-internal "; ")) |
|---|
| 668 | |
|---|
| 669 | (defun anything-c-moccur-match-only-string () |
|---|
| 670 | (interactive) |
|---|
| 671 | (anything-c-moccur-match-only-internal "\" ")) |
|---|
| 672 | |
|---|
| 673 | |
|---|
| 674 | (dont-compile |
|---|
| 675 | (when (fboundp 'expectations) |
|---|
| 676 | (expectations |
|---|
| 677 | (desc "initialize test") |
|---|
| 678 | (expect t |
|---|
| 679 | (let (v) |
|---|
| 680 | (anything-test-candidates |
|---|
| 681 | '(((name . "TEST") |
|---|
| 682 | (candidates "foo") |
|---|
| 683 | (init . (lambda () |
|---|
| 684 | (anything-c-moccur-initialize) |
|---|
| 685 | (setq v anything-c-moccur-anything-invoking-flag))) |
|---|
| 686 | (cleanup . anything-c-moccur-clean-up)))) |
|---|
| 687 | v)) |
|---|
| 688 | (desc "cleanup test") |
|---|
| 689 | (expect nil |
|---|
| 690 | (let ((anything-c-moccur-anything-invoking-flag t)) |
|---|
| 691 | (anything-test-candidates |
|---|
| 692 | '(anything-c-source-occur-by-moccur)) |
|---|
| 693 | anything-c-moccur-anything-invoking-flag)) |
|---|
| 694 | (desc "anything-c-source-occur-by-moccur") |
|---|
| 695 | (expect '(("Occur by Moccur" (" 2 bbb"))) |
|---|
| 696 | (let ((buf (get-buffer-create "*test anything-c-moccur*"))) |
|---|
| 697 | (with-current-buffer buf |
|---|
| 698 | (insert "aaa\nbbb\nccc") |
|---|
| 699 | (prin1 |
|---|
| 700 | (anything-test-candidates |
|---|
| 701 | '(anything-c-source-occur-by-moccur) "bbb") |
|---|
| 702 | (kill-buffer buf))))) |
|---|
| 703 | (desc "anything-c-moccur-bad-regexp-p") |
|---|
| 704 | (expect t |
|---|
| 705 | (when (anything-c-moccur-bad-regexp-p "\\_>") t)) |
|---|
| 706 | (expect t |
|---|
| 707 | (when (anything-c-moccur-bad-regexp-p "\\_> ") t)) |
|---|
| 708 | (expect t |
|---|
| 709 | (when (anything-c-moccur-bad-regexp-p " \\_>") t)) |
|---|
| 710 | (expect t |
|---|
| 711 | (when (anything-c-moccur-bad-regexp-p " \\_> ") t)) |
|---|
| 712 | (expect t |
|---|
| 713 | (when (anything-c-moccur-bad-regexp-p "g \\_> ") t)) |
|---|
| 714 | (expect t |
|---|
| 715 | (when (anything-c-moccur-bad-regexp-p "g \\_>") t)) |
|---|
| 716 | (expect t |
|---|
| 717 | (when (anything-c-moccur-bad-regexp-p " \\_> g") t)) |
|---|
| 718 | (expect nil |
|---|
| 719 | (when (anything-c-moccur-bad-regexp-p "g\\_> ") t)) |
|---|
| 720 | (expect nil |
|---|
| 721 | (when (anything-c-moccur-bad-regexp-p " g\\_>") t)) |
|---|
| 722 | ))) |
|---|
| 723 | |
|---|
| 724 | |
|---|
| 725 | (provide 'anything-c-moccur) |
|---|
| 726 | |
|---|
| 727 | ;;; anything-c-moccur.el ends here |
|---|
![(please configure the [header_logo] section in trac.ini)](/share/chrome/site/your_project_logo.png){kind=logo}
