Remove the elpa/ directory from version control
All my packages are now installed via `use-package`.gerrit-package
Gergely Polonkai
7 years ago
parent
cba24cbf20
commit
3b2cf68142
@ -1,2 +0,0 @@
|
||||
;;; -*- no-byte-compile: t -*-
|
||||
(define-package "ace-window" "20161018.1624" "Quickly switch windows." '((avy "0.2.0")) :url "https://github.com/abo-abo/ace-window" :keywords '("window" "location"))
|
||||
@ -1,563 +0,0 @@
|
||||
;;; ace-window.el --- Quickly switch windows. -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2015 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Oleh Krehel <ohwoeowho@gmail.com>
|
||||
;; Maintainer: Oleh Krehel <ohwoeowho@gmail.com>
|
||||
;; URL: https://github.com/abo-abo/ace-window
|
||||
;; Package-Version: 20161018.1624
|
||||
;; Version: 0.9.0
|
||||
;; Package-Requires: ((avy "0.2.0"))
|
||||
;; Keywords: window, location
|
||||
|
||||
;; This file is part of GNU Emacs.
|
||||
|
||||
;; This file is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation; either version 3, or (at your option)
|
||||
;; any later version.
|
||||
|
||||
;; This program is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; For a full copy of the GNU General Public License
|
||||
;; see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
;;
|
||||
;; The main function, `ace-window' is meant to replace `other-window'.
|
||||
;; In fact, when there are only two windows present, `other-window' is
|
||||
;; called. If there are more, each window will have its first
|
||||
;; character highlighted. Pressing that character will switch to that
|
||||
;; window.
|
||||
;;
|
||||
;; To setup this package, just add to your .emacs:
|
||||
;;
|
||||
;; (global-set-key (kbd "M-p") 'ace-window)
|
||||
;;
|
||||
;; replacing "M-p" with an appropriate shortcut.
|
||||
;;
|
||||
;; Depending on your window usage patterns, you might want to set
|
||||
;;
|
||||
;; (setq aw-keys '(?a ?s ?d ?f ?g ?h ?j ?k ?l))
|
||||
;;
|
||||
;; This way they are all on the home row, although the intuitive
|
||||
;; ordering is lost.
|
||||
;;
|
||||
;; If you don't want the gray background that makes the red selection
|
||||
;; characters stand out more, set this:
|
||||
;;
|
||||
;; (setq aw-background nil)
|
||||
;;
|
||||
;; If you want to know the selection characters ahead of time, you can
|
||||
;; turn on `ace-window-display-mode'.
|
||||
;;
|
||||
;; When prefixed with one `universal-argument', instead of switching
|
||||
;; to selected window, the selected window is swapped with current one.
|
||||
;;
|
||||
;; When prefixed with two `universal-argument', the selected window is
|
||||
;; deleted instead.
|
||||
|
||||
;;; Code:
|
||||
(require 'avy)
|
||||
(require 'ring)
|
||||
|
||||
;;* Customization
|
||||
(defgroup ace-window nil
|
||||
"Quickly switch current window."
|
||||
:group 'convenience
|
||||
:prefix "aw-")
|
||||
|
||||
(defcustom aw-keys '(?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9)
|
||||
"Keys for selecting window.")
|
||||
|
||||
(defcustom aw-scope 'global
|
||||
"The scope used by `ace-window'."
|
||||
:type '(choice
|
||||
(const :tag "visible frames" visible)
|
||||
(const :tag "global" global)
|
||||
(const :tag "frame" frame)))
|
||||
|
||||
(defcustom aw-ignored-buffers '("*Calc Trail*" "*LV*")
|
||||
"List of buffers to ignore when selecting window."
|
||||
:type '(repeat string))
|
||||
|
||||
(defcustom aw-ignore-on t
|
||||
"When t, `ace-window' will ignore `aw-ignored-buffers'.
|
||||
Use M-0 `ace-window' to toggle this value."
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom aw-ignore-current nil
|
||||
"When t, `ace-window' will ignore `selected-window'."
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom aw-background t
|
||||
"When t, `ace-window' will dim out all buffers temporarily when used.'."
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom aw-leading-char-style 'char
|
||||
"Style of the leading char overlay."
|
||||
:type '(choice
|
||||
(const :tag "single char" 'char)
|
||||
(const :tag "full path" 'path)))
|
||||
|
||||
(defcustom aw-dispatch-always nil
|
||||
"When non-nil, `ace-window' will issue a `read-char' even for one window.
|
||||
This will make `ace-window' act different from `other-window' for
|
||||
one or two windows."
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom aw-reverse-frame-list nil
|
||||
"When non-nil `ace-window' will order frames for selection in
|
||||
the reverse of `frame-list'"
|
||||
:type 'boolean)
|
||||
|
||||
(defface aw-leading-char-face
|
||||
'((((class color)) (:foreground "red"))
|
||||
(((background dark)) (:foreground "gray100"))
|
||||
(((background light)) (:foreground "gray0"))
|
||||
(t (:foreground "gray100" :underline nil)))
|
||||
"Face for each window's leading char.")
|
||||
|
||||
(defface aw-background-face
|
||||
'((t (:foreground "gray40")))
|
||||
"Face for whole window background during selection.")
|
||||
|
||||
(defface aw-mode-line-face
|
||||
'((t (:inherit mode-line-buffer-id)))
|
||||
"Face used for displaying the ace window key in the mode-line.")
|
||||
|
||||
;;* Implementation
|
||||
(defun aw-ignored-p (window)
|
||||
"Return t if WINDOW should be ignored."
|
||||
(or (and aw-ignore-on
|
||||
(member (buffer-name (window-buffer window))
|
||||
aw-ignored-buffers))
|
||||
(and aw-ignore-current
|
||||
(equal window (selected-window)))))
|
||||
|
||||
(defun aw-window-list ()
|
||||
"Return the list of interesting windows."
|
||||
(sort
|
||||
(cl-remove-if
|
||||
(lambda (w)
|
||||
(let ((f (window-frame w)))
|
||||
(or (not (and (frame-live-p f)
|
||||
(frame-visible-p f)))
|
||||
(string= "initial_terminal" (terminal-name f))
|
||||
(aw-ignored-p w))))
|
||||
(cl-case aw-scope
|
||||
(visible
|
||||
(cl-mapcan #'window-list (visible-frame-list)))
|
||||
(global
|
||||
(cl-mapcan #'window-list (frame-list)))
|
||||
(frame
|
||||
(window-list))
|
||||
(t
|
||||
(error "Invalid `aw-scope': %S" aw-scope))))
|
||||
'aw-window<))
|
||||
|
||||
(defvar aw-overlays-back nil
|
||||
"Hold overlays for when `aw-background' is t.")
|
||||
|
||||
(defvar ace-window-mode nil
|
||||
"Minor mode during the selection process.")
|
||||
|
||||
;; register minor mode
|
||||
(or (assq 'ace-window-mode minor-mode-alist)
|
||||
(nconc minor-mode-alist
|
||||
(list '(ace-window-mode ace-window-mode))))
|
||||
|
||||
(defvar aw-empty-buffers-list nil
|
||||
"Store the read-only empty buffers which had to be modified.
|
||||
Modify them back eventually.")
|
||||
|
||||
(defun aw--done ()
|
||||
"Clean up mode line and overlays."
|
||||
;; mode line
|
||||
(aw-set-mode-line nil)
|
||||
;; background
|
||||
(mapc #'delete-overlay aw-overlays-back)
|
||||
(setq aw-overlays-back nil)
|
||||
(avy--remove-leading-chars)
|
||||
(dolist (b aw-empty-buffers-list)
|
||||
(with-current-buffer b
|
||||
(when (string= (buffer-string) " ")
|
||||
(let ((inhibit-read-only t))
|
||||
(delete-region (point-min) (point-max))))))
|
||||
(setq aw-empty-buffers-list nil))
|
||||
|
||||
(defun aw--lead-overlay (path leaf)
|
||||
"Create an overlay using PATH at LEAF.
|
||||
LEAF is (PT . WND)."
|
||||
(let ((wnd (cdr leaf)))
|
||||
(with-selected-window wnd
|
||||
(when (= 0 (buffer-size))
|
||||
(push (current-buffer) aw-empty-buffers-list)
|
||||
(let ((inhibit-read-only t))
|
||||
(insert " ")))
|
||||
(let* ((pt (car leaf))
|
||||
(ol (make-overlay pt (1+ pt) (window-buffer wnd)))
|
||||
(old-str (or
|
||||
(ignore-errors
|
||||
(with-selected-window wnd
|
||||
(buffer-substring pt (1+ pt))))
|
||||
""))
|
||||
(new-str
|
||||
(concat
|
||||
(cl-case aw-leading-char-style
|
||||
(char
|
||||
(string (avy--key-to-char (car (last path)))))
|
||||
(path
|
||||
(mapconcat
|
||||
(lambda (x) (string (avy--key-to-char x)))
|
||||
(reverse path)
|
||||
""))
|
||||
(t
|
||||
(error "Bad `aw-leading-char-style': %S"
|
||||
aw-leading-char-style)))
|
||||
(cond ((string-equal old-str "\t")
|
||||
(make-string (1- tab-width) ?\ ))
|
||||
((string-equal old-str "\n")
|
||||
"\n")
|
||||
(t
|
||||
(make-string
|
||||
(max 0 (1- (string-width old-str)))
|
||||
?\ ))))))
|
||||
(overlay-put ol 'face 'aw-leading-char-face)
|
||||
(overlay-put ol 'window wnd)
|
||||
(overlay-put ol 'display new-str)
|
||||
(push ol avy--overlays-lead)))))
|
||||
|
||||
(defun aw--make-backgrounds (wnd-list)
|
||||
"Create a dim background overlay for each window on WND-LIST."
|
||||
(when aw-background
|
||||
(setq aw-overlays-back
|
||||
(mapcar (lambda (w)
|
||||
(let ((ol (make-overlay
|
||||
(window-start w)
|
||||
(window-end w)
|
||||
(window-buffer w))))
|
||||
(overlay-put ol 'face 'aw-background-face)
|
||||
ol))
|
||||
wnd-list))))
|
||||
|
||||
(define-obsolete-variable-alias
|
||||
'aw-flip-keys 'aw--flip-keys "0.1.0"
|
||||
"Use `aw-dispatch-alist' instead.")
|
||||
|
||||
(defvar aw-dispatch-function 'aw-dispatch-default
|
||||
"Function to call when a character not in `aw-keys' is pressed.")
|
||||
|
||||
(defvar aw-action nil
|
||||
"Function to call at the end of `aw-select'.")
|
||||
|
||||
(defun aw-set-mode-line (str)
|
||||
"Set mode line indicator to STR."
|
||||
(setq ace-window-mode str)
|
||||
(force-mode-line-update))
|
||||
|
||||
(defvar aw-dispatch-alist
|
||||
'((?x aw-delete-window " Ace - Delete Window")
|
||||
(?m aw-swap-window " Ace - Swap Window")
|
||||
(?M aw-move-window " Ace - Move Window")
|
||||
(?n aw-flip-window)
|
||||
(?v aw-split-window-vert " Ace - Split Vert Window")
|
||||
(?b aw-split-window-horz " Ace - Split Horz Window")
|
||||
(?i delete-other-windows " Ace - Maximize Window")
|
||||
(?o delete-other-windows))
|
||||
"List of actions for `aw-dispatch-default'.")
|
||||
|
||||
(defun aw-dispatch-default (char)
|
||||
"Perform an action depending on CHAR."
|
||||
(let ((val (cdr (assoc char aw-dispatch-alist))))
|
||||
(if val
|
||||
(if (and (car val) (cadr val))
|
||||
(prog1 (setq aw-action (car val))
|
||||
(aw-set-mode-line (cadr val)))
|
||||
(funcall (car val))
|
||||
(throw 'done 'exit))
|
||||
(avy-handler-default char))))
|
||||
|
||||
(defun aw-select (mode-line &optional action)
|
||||
"Return a selected other window.
|
||||
Amend MODE-LINE to the mode line for the duration of the selection."
|
||||
(setq aw-action action)
|
||||
(let ((start-window (selected-window))
|
||||
(next-window-scope (cl-case aw-scope
|
||||
('visible 'visible)
|
||||
('global 'visible)
|
||||
('frame 'frame)))
|
||||
(wnd-list (aw-window-list))
|
||||
window)
|
||||
(setq window
|
||||
(cond ((<= (length wnd-list) 1)
|
||||
(when aw-dispatch-always
|
||||
(setq aw-action
|
||||
(unwind-protect
|
||||
(catch 'done
|
||||
(funcall aw-dispatch-function (read-char)))
|
||||
(aw--done)))
|
||||
(when (eq aw-action 'exit)
|
||||
(setq aw-action nil)))
|
||||
(or (car wnd-list) start-window))
|
||||
((and (= (length wnd-list) 2)
|
||||
(not aw-dispatch-always)
|
||||
(not aw-ignore-current))
|
||||
(let ((wnd (next-window nil nil next-window-scope)))
|
||||
(while (and (or (not (memq wnd wnd-list))
|
||||
(aw-ignored-p wnd))
|
||||
(not (equal wnd start-window)))
|
||||
(setq wnd (next-window wnd nil next-window-scope)))
|
||||
wnd))
|
||||
(t
|
||||
(let ((candidate-list
|
||||
(mapcar (lambda (wnd)
|
||||
(cons (aw-offset wnd) wnd))
|
||||
wnd-list)))
|
||||
(aw--make-backgrounds wnd-list)
|
||||
(aw-set-mode-line mode-line)
|
||||
;; turn off helm transient map
|
||||
(remove-hook 'post-command-hook 'helm--maybe-update-keymap)
|
||||
(unwind-protect
|
||||
(let* ((avy-handler-function aw-dispatch-function)
|
||||
(avy-translate-char-function #'identity)
|
||||
(res (avy-read (avy-tree candidate-list aw-keys)
|
||||
#'aw--lead-overlay
|
||||
#'avy--remove-leading-chars)))
|
||||
(if (eq res 'exit)
|
||||
(setq aw-action nil)
|
||||
(or (cdr res)
|
||||
start-window)))
|
||||
(aw--done))))))
|
||||
(if aw-action
|
||||
(funcall aw-action window)
|
||||
window)))
|
||||
|
||||
;;* Interactive
|
||||
;;;###autoload
|
||||
(defun ace-select-window ()
|
||||
"Ace select window."
|
||||
(interactive)
|
||||
(aw-select " Ace - Window"
|
||||
#'aw-switch-to-window))
|
||||
|
||||
;;;###autoload
|
||||
(defun ace-delete-window ()
|
||||
"Ace delete window."
|
||||
(interactive)
|
||||
(aw-select " Ace - Delete Window"
|
||||
#'aw-delete-window))
|
||||
|
||||
;;;###autoload
|
||||
(defun ace-swap-window ()
|
||||
"Ace swap window."
|
||||
(interactive)
|
||||
(aw-select " Ace - Swap Window"
|
||||
#'aw-swap-window))
|
||||
|
||||
;;;###autoload
|
||||
(defun ace-maximize-window ()
|
||||
"Ace maximize window."
|
||||
(interactive)
|
||||
(aw-select " Ace - Maximize Window"
|
||||
#'delete-other-windows))
|
||||
|
||||
;;;###autoload
|
||||
(defun ace-window (arg)
|
||||
"Select a window.
|
||||
Perform an action based on ARG described below.
|
||||
|
||||
By default, behaves like extended `other-window'.
|
||||
|
||||
Prefixed with one \\[universal-argument], does a swap between the
|
||||
selected window and the current window, so that the selected
|
||||
buffer moves to current window (and current buffer moves to
|
||||
selected window).
|
||||
|
||||
Prefixed with two \\[universal-argument]'s, deletes the selected
|
||||
window."
|
||||
(interactive "p")
|
||||
(cl-case arg
|
||||
(0
|
||||
(setq aw-ignore-on
|
||||
(not aw-ignore-on))
|
||||
(ace-select-window))
|
||||
(4 (ace-swap-window))
|
||||
(16 (ace-delete-window))
|
||||
(t (ace-select-window))))
|
||||
|
||||
;;* Utility
|
||||
(defun aw-window< (wnd1 wnd2)
|
||||
"Return true if WND1 is less than WND2.
|
||||
This is determined by their respective window coordinates.
|
||||
Windows are numbered top down, left to right."
|
||||
(let ((f1 (window-frame wnd1))
|
||||
(f2 (window-frame wnd2))
|
||||
(e1 (window-edges wnd1))
|
||||
(e2 (window-edges wnd2)))
|
||||
(cond ((string< (frame-parameter f1 'window-id)
|
||||
(frame-parameter f2 'window-id))
|
||||
aw-reverse-frame-list)
|
||||
((< (car e1) (car e2))
|
||||
t)
|
||||
((> (car e1) (car e2))
|
||||
nil)
|
||||
((< (cadr e1) (cadr e2))
|
||||
t))))
|
||||
|
||||
(defvar aw--window-ring (make-ring 10)
|
||||
"Hold the window switching history.")
|
||||
|
||||
(defun aw--push-window (window)
|
||||
"Store WINDOW to `aw--window-ring'."
|
||||
(when (or (zerop (ring-length aw--window-ring))
|
||||
(not (equal
|
||||
(ring-ref aw--window-ring 0)
|
||||
window)))
|
||||
(ring-insert aw--window-ring (selected-window))))
|
||||
|
||||
(defun aw--pop-window ()
|
||||
"Return the removed top of `aw--window-ring'."
|
||||
(let (res)
|
||||
(condition-case nil
|
||||
(while (or (not (window-live-p
|
||||
(setq res (ring-remove aw--window-ring 0))))
|
||||
(equal res (selected-window))))
|
||||
(error
|
||||
(if (= (length (aw-window-list)) 2)
|
||||
(progn
|
||||
(other-window 1)
|
||||
(setq res (selected-window)))
|
||||
(error "No previous windows stored"))))
|
||||
res))
|
||||
|
||||
(defun aw-switch-to-window (window)
|
||||
"Switch to the window WINDOW."
|
||||
(let ((frame (window-frame window)))
|
||||
(aw--push-window (selected-window))
|
||||
(when (and (frame-live-p frame)
|
||||
(not (eq frame (selected-frame))))
|
||||
(select-frame-set-input-focus frame))
|
||||
(if (window-live-p window)
|
||||
(select-window window)
|
||||
(error "Got a dead window %S" window))))
|
||||
|
||||
(defun aw-flip-window ()
|
||||
"Switch to the window you were previously in."
|
||||
(interactive)
|
||||
(aw-switch-to-window (aw--pop-window)))
|
||||
|
||||
(defun aw-delete-window (window)
|
||||
"Delete window WINDOW."
|
||||
(let ((frame (window-frame window)))
|
||||
(when (and (frame-live-p frame)
|
||||
(not (eq frame (selected-frame))))
|
||||
(select-frame-set-input-focus (window-frame window)))
|
||||
(if (= 1 (length (window-list)))
|
||||
(delete-frame frame)
|
||||
(if (window-live-p window)
|
||||
(delete-window window)
|
||||
(error "Got a dead window %S" window)))))
|
||||
|
||||
(defcustom aw-swap-invert nil
|
||||
"When non-nil, the other of the two swapped windows gets the point."
|
||||
:type 'boolean)
|
||||
|
||||
(defun aw-swap-window (window)
|
||||
"Swap buffers of current window and WINDOW."
|
||||
(cl-labels ((swap-windows (window1 window2)
|
||||
"Swap the buffers of WINDOW1 and WINDOW2."
|
||||
(let ((buffer1 (window-buffer window1))
|
||||
(buffer2 (window-buffer window2)))
|
||||
(set-window-buffer window1 buffer2)
|
||||
(set-window-buffer window2 buffer1)
|
||||
(select-window window2))))
|
||||
(let ((frame (window-frame window))
|
||||
(this-window (selected-window)))
|
||||
(when (and (frame-live-p frame)
|
||||
(not (eq frame (selected-frame))))
|
||||
(select-frame-set-input-focus (window-frame window)))
|
||||
(when (and (window-live-p window)
|
||||
(not (eq window this-window)))
|
||||
(aw--push-window this-window)
|
||||
(if aw-swap-invert
|
||||
(swap-windows window this-window)
|
||||
(swap-windows this-window window))))))
|
||||
|
||||
(defun aw-move-window (window)
|
||||
"Move the current buffer to WINDOW.
|
||||
Switch the current window to the previous buffer."
|
||||
(let ((buffer (current-buffer)))
|
||||
(switch-to-buffer (other-buffer))
|
||||
(aw-switch-to-window window)
|
||||
(switch-to-buffer buffer)))
|
||||
|
||||
(defun aw-split-window-vert (window)
|
||||
"Split WINDOW vertically."
|
||||
(select-window window)
|
||||
(split-window-vertically))
|
||||
|
||||
(defun aw-split-window-horz (window)
|
||||
"Split WINDOW horizontally."
|
||||
(select-window window)
|
||||
(split-window-horizontally))
|
||||
|
||||
(defun aw-offset (window)
|
||||
"Return point in WINDOW that's closest to top left corner.
|
||||
The point is writable, i.e. it's not part of space after newline."
|
||||
(let ((h (window-hscroll window))
|
||||
(beg (window-start window))
|
||||
(end (window-end window))
|
||||
(inhibit-field-text-motion t))
|
||||
(with-current-buffer
|
||||
(window-buffer window)
|
||||
(save-excursion
|
||||
(goto-char beg)
|
||||
(while (and (< (point) end)
|
||||
(< (- (line-end-position)
|
||||
(line-beginning-position))
|
||||
h))
|
||||
(forward-line))
|
||||
(+ (point) h)))))
|
||||
|
||||
;;* Mode line
|
||||
;;;###autoload
|
||||
(define-minor-mode ace-window-display-mode
|
||||
"Minor mode for showing the ace window key in the mode line."
|
||||
:global t
|
||||
(if ace-window-display-mode
|
||||
(progn
|
||||
(aw-update)
|
||||
(set-default
|
||||
'mode-line-format
|
||||
`((ace-window-display-mode
|
||||
(:eval (window-parameter (selected-window) 'ace-window-path)))
|
||||
,@(assq-delete-all
|
||||
'ace-window-display-mode
|
||||
(default-value 'mode-line-format))))
|
||||
(force-mode-line-update t)
|
||||
(add-hook 'window-configuration-change-hook 'aw-update))
|
||||
(set-default
|
||||
'mode-line-format
|
||||
(assq-delete-all
|
||||
'ace-window-display-mode
|
||||
(default-value 'mode-line-format)))
|
||||
(remove-hook 'window-configuration-change-hook 'aw-update)))
|
||||
|
||||
(defun aw-update ()
|
||||
"Update ace-window-path window parameter for all windows."
|
||||
(avy-traverse
|
||||
(avy-tree (aw-window-list) aw-keys)
|
||||
(lambda (path leaf)
|
||||
(set-window-parameter
|
||||
leaf 'ace-window-path
|
||||
(propertize
|
||||
(apply #'string (reverse path))
|
||||
'face 'aw-mode-line-face)))))
|
||||
|
||||
(provide 'ace-window)
|
||||
|
||||
;;; ace-window.el ends here
|
||||
@ -1,2 +0,0 @@
|
||||
;;; -*- no-byte-compile: t -*-
|
||||
(define-package "ag" "20161021.2133" "A front-end for ag ('the silver searcher'), the C ack replacement." '((dash "2.8.0") (s "1.9.0") (cl-lib "0.5")))
|
||||
@ -1,676 +0,0 @@
|
||||
;;; ag.el --- A front-end for ag ('the silver searcher'), the C ack replacement.
|
||||
|
||||
;; Copyright (C) 2013-2014 Wilfred Hughes <me@wilfred.me.uk>
|
||||
;;
|
||||
;; Author: Wilfred Hughes <me@wilfred.me.uk>
|
||||
;; Created: 11 January 2013
|
||||
;; Version: 0.48
|
||||
;; Package-Version: 20161021.2133
|
||||
;; Package-Requires: ((dash "2.8.0") (s "1.9.0") (cl-lib "0.5"))
|
||||
;;; Commentary:
|
||||
|
||||
;; Please see README.md for documentation, or read it online at
|
||||
;; https://github.com/Wilfred/ag.el/#agel
|
||||
|
||||
;;; License:
|
||||
|
||||
;; This file is not part of GNU Emacs.
|
||||
;; However, it is distributed under the same license.
|
||||
|
||||
;; GNU Emacs is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation; either version 3, or (at your option)
|
||||
;; any later version.
|
||||
|
||||
;; GNU Emacs is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs; see the file COPYING. If not, write to the
|
||||
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
|
||||
;; Boston, MA 02110-1301, USA.
|
||||
|
||||
;;; Code:
|
||||
(require 'cl-lib) ;; cl-letf, cl-defun
|
||||
(require 'dired) ;; dired-sort-inhibit
|
||||
(require 'dash)
|
||||
(require 's)
|
||||
(require 'find-dired) ;; find-dired-filter
|
||||
|
||||
(defgroup ag nil
|
||||
"A front-end for ag - The Silver Searcher."
|
||||
:group 'tools
|
||||
:group 'matching)
|
||||
|
||||
(defcustom ag-executable
|
||||
"ag"
|
||||
"Name of the ag executable to use."
|
||||
:type 'string
|
||||
:group 'ag)
|
||||
|
||||
(defcustom ag-arguments
|
||||
(list "--smart-case" "--stats")
|
||||
"Additional arguments passed to ag.
|
||||
|
||||
Ag.el internally uses --column, --line-number and --color
|
||||
options (with specific colors) to match groups, so options
|
||||
specified here should not conflict.
|
||||
|
||||
--line-number is required on Windows, as otherwise ag will not
|
||||
print line numbers when the input is a stream."
|
||||
:type '(repeat (string))
|
||||
:group 'ag)
|
||||
|
||||
(defcustom ag-context-lines nil
|
||||
"Number of context lines to include before and after a matching line."
|
||||
:type 'integer
|
||||
:group 'ag)
|
||||
|
||||
(defcustom ag-group-matches t
|
||||
"Group matches in the same file together.
|
||||
|
||||
If nil, the file name is repeated at the beginning of every match line."
|
||||
:type 'boolean
|
||||
:group 'ag)
|
||||
|
||||
(defcustom ag-highlight-search nil
|
||||
"Non-nil means we highlight the current search term in results.
|
||||
|
||||
This requires the ag command to support --color-match, which is only in v0.14+"
|
||||
:type 'boolean
|
||||
:group 'ag)
|
||||
|
||||
(defcustom ag-reuse-buffers nil
|
||||
"Non-nil means we reuse the existing search results buffer or
|
||||
dired results buffer, rather than creating one buffer per unique
|
||||
search."
|
||||
:type 'boolean
|
||||
:group 'ag)
|
||||
|
||||
(defcustom ag-reuse-window nil
|
||||
"Non-nil means we open search results in the same window,
|
||||
hiding the results buffer."
|
||||
:type 'boolean
|
||||
:group 'ag)
|
||||
|
||||
(defcustom ag-project-root-function nil
|
||||
"A function to determine the project root for `ag-project'.
|
||||
|
||||
If set to a function, call this function with the name of the
|
||||
file or directory for which to determine the project root
|
||||
directory.
|
||||
|
||||
If set to nil, fall back to finding VCS root directories."
|
||||
:type '(choice (const :tag "Default (VCS root)" nil)
|
||||
(function :tag "Function"))
|
||||
:group 'ag)
|
||||
|
||||
(defcustom ag-ignore-list nil
|
||||
"A list of patterns for files/directories to ignore when searching."
|
||||
:type '(repeat (string))
|
||||
:group 'ag)
|
||||
|
||||
(require 'compile)
|
||||
|
||||
;; Although ag results aren't exactly errors, we treat them as errors
|
||||
;; so `next-error' and `previous-error' work. However, we ensure our
|
||||
;; face inherits from `compilation-info-face' so the results are
|
||||
;; styled appropriately.
|
||||
(defface ag-hit-face '((t :inherit compilation-info))
|
||||
"Face name to use for ag matches."
|
||||
:group 'ag)
|
||||
|
||||
(defface ag-match-face '((t :inherit match))
|
||||
"Face name to use for ag matches."
|
||||
:group 'ag)
|
||||
|
||||
(defvar ag-search-finished-hook nil
|
||||
"Hook run when ag completes a search in a buffer.")
|
||||
|
||||
(defun ag/run-finished-hook (buffer how-finished)
|
||||
"Run the ag hook to signal that the search has completed."
|
||||
(with-current-buffer buffer
|
||||
(run-hooks 'ag-search-finished-hook)))
|
||||
|
||||
(defmacro ag/with-patch-function (fun-name fun-args fun-body &rest body)
|
||||
"Temporarily override the definition of FUN-NAME whilst BODY is executed.
|
||||
|
||||
Assumes FUNCTION is already defined (see http://emacs.stackexchange.com/a/3452/304)."
|
||||
`(cl-letf (((symbol-function ,fun-name)
|
||||
(lambda ,fun-args ,fun-body)))
|
||||
,@body))
|
||||
|
||||
(defun ag/next-error-function (n &optional reset)
|
||||
"Open the search result at point in the current window or a
|
||||
different window, according to `ag-reuse-window'."
|
||||
(if ag-reuse-window
|
||||
;; prevent changing the window
|
||||
(ag/with-patch-function
|
||||
'pop-to-buffer (buffer &rest args) (switch-to-buffer buffer)
|
||||
(compilation-next-error-function n reset))
|
||||
|
||||
;; just navigate to the results as normal
|
||||
(compilation-next-error-function n reset)))
|
||||
|
||||
;; Note that we want to use as tight a regexp as we can to try and
|
||||
;; handle weird file names (with colons in them) as well as possible.
|
||||
;; E.g. we use [1-9][0-9]* rather than [0-9]+ so as to accept ":034:"
|
||||
;; in file names.
|
||||
(defvar ag/file-column-pattern-nogroup
|
||||
"^\\(.+?\\):\\([1-9][0-9]*\\):\\([1-9][0-9]*\\):"
|
||||
"A regexp pattern that groups output into filename, line number and column number.")
|
||||
|
||||
(defvar ag/file-column-pattern-group
|
||||
"^\\([[:digit:]]+\\):\\([[:digit:]]+\\):"
|
||||
"A regexp pattern to match line number and column number with grouped output.")
|
||||
|
||||
(defun ag/compilation-match-grouped-filename ()
|
||||
"Match filename backwards when a line/column match is found in grouped output mode."
|
||||
(save-match-data
|
||||
(save-excursion
|
||||
(when (re-search-backward "^File: \\(.*\\)$" (point-min) t)
|
||||
(list (match-string 1))))))
|
||||
|
||||
(define-compilation-mode ag-mode "Ag"
|
||||
"Ag results compilation mode"
|
||||
(set (make-local-variable 'compilation-error-regexp-alist)
|
||||
'(compilation-ag-nogroup compilation-ag-group))
|
||||
(set (make-local-variable 'compilation-error-regexp-alist-alist)
|
||||
(list (cons 'compilation-ag-nogroup (list ag/file-column-pattern-nogroup 1 2 3))
|
||||
(cons 'compilation-ag-group (list ag/file-column-pattern-group
|
||||
'ag/compilation-match-grouped-filename 1 2))))
|
||||
(set (make-local-variable 'compilation-error-face) 'ag-hit-face)
|
||||
(set (make-local-variable 'next-error-function) #'ag/next-error-function)
|
||||
(set (make-local-variable 'compilation-finish-functions)
|
||||
#'ag/run-finished-hook)
|
||||
(add-hook 'compilation-filter-hook 'ag-filter nil t))
|
||||
|
||||
(define-key ag-mode-map (kbd "p") #'compilation-previous-error)
|
||||
(define-key ag-mode-map (kbd "n") #'compilation-next-error)
|
||||
(define-key ag-mode-map (kbd "k") '(lambda () (interactive)
|
||||
(let (kill-buffer-query-functions) (kill-buffer))))
|
||||
|
||||
(defun ag/buffer-name (search-string directory regexp)
|
||||
"Return a buffer name formatted according to ag.el conventions."
|
||||
(cond
|
||||
(ag-reuse-buffers "*ag search")
|
||||
(regexp (format "*ag search regexp:%s dir:%s" search-string directory))
|
||||
(:else (format "*ag search text:%s dir:%s" search-string directory))))
|
||||
|
||||
(defun ag/format-ignore (ignores)
|
||||
"Prepend '--ignore' to every item in IGNORES."
|
||||
(apply #'append
|
||||
(mapcar (lambda (item) (list "--ignore" item)) ignores)))
|
||||
|
||||
(cl-defun ag/search (string directory
|
||||
&key (regexp nil) (file-regex nil) (file-type nil))
|
||||
"Run ag searching for the STRING given in DIRECTORY.
|
||||
If REGEXP is non-nil, treat STRING as a regular expression."
|
||||
(let ((default-directory (file-name-as-directory directory))
|
||||
(arguments ag-arguments)
|
||||
(shell-command-switch "-c"))
|
||||
;; Add double dashes at the end of command line if not specified in
|
||||
;; ag-arguments.
|
||||
(unless (equal (car (last arguments)) "--")
|
||||
(setq arguments (append arguments '("--"))))
|
||||
(setq arguments
|
||||
(append '("--line-number" "--column" "--color" "--color-match" "30;43"
|
||||
"--color-path" "1;32")
|
||||
arguments))
|
||||
(if ag-group-matches
|
||||
(setq arguments (cons "--group" arguments))
|
||||
(setq arguments (cons "--nogroup" arguments)))
|
||||
(unless regexp
|
||||
(setq arguments (cons "--literal" arguments)))
|
||||
(when (or (eq system-type 'windows-nt) (eq system-type 'cygwin))
|
||||
;; Use --vimgrep to work around issue #97 on Windows.
|
||||
(setq arguments (cons "--vimgrep" arguments)))
|
||||
(when (char-or-string-p file-regex)
|
||||
(setq arguments (append `("--file-search-regex" ,file-regex) arguments)))
|
||||
(when file-type
|
||||
(setq arguments (cons (format "--%s" file-type) arguments)))
|
||||
(if (integerp current-prefix-arg)
|
||||
(setq arguments (cons (format "--context=%d" (abs current-prefix-arg)) arguments))
|
||||
(when ag-context-lines
|
||||
(setq arguments (cons (format "--context=%d" ag-context-lines) arguments))))
|
||||
(when ag-ignore-list
|
||||
(setq arguments (append (ag/format-ignore ag-ignore-list) arguments)))
|
||||
(unless (file-exists-p default-directory)
|
||||
(error "No such directory %s" default-directory))
|
||||
(let ((command-string
|
||||
(mapconcat #'shell-quote-argument
|
||||
(append (list ag-executable) arguments (list string "."))
|
||||
" ")))
|
||||
;; If we're called with a prefix, let the user modify the command before
|
||||
;; running it. Typically this means they want to pass additional arguments.
|
||||
;; The numeric value is used for context lines: positive is just context
|
||||
;; number (no modification), negative allows further modification.
|
||||
(when (and current-prefix-arg (not (and (integerp current-prefix-arg) (> current-prefix-arg 0))))
|
||||
;; Make a space in the command-string for the user to enter more arguments.
|
||||
(setq command-string (ag/replace-first command-string " -- " " -- "))
|
||||
;; Prompt for the command.
|
||||
(let ((adjusted-point (- (length command-string) (length string) 5)))
|
||||
(setq command-string
|
||||
(read-from-minibuffer "ag command: "
|
||||
(cons command-string adjusted-point)))))
|
||||
;; Call ag.
|
||||
(compilation-start
|
||||
command-string
|
||||
#'ag-mode
|
||||
`(lambda (mode-name) ,(ag/buffer-name string directory regexp))))))
|
||||
|
||||
(defun ag/dwim-at-point ()
|
||||
"If there's an active selection, return that.
|
||||
Otherwise, get the symbol at point, as a string."
|
||||
(cond ((use-region-p)
|
||||
(buffer-substring-no-properties (region-beginning) (region-end)))
|
||||
((symbol-at-point)
|
||||
(substring-no-properties
|
||||
(symbol-name (symbol-at-point))))))
|
||||
|
||||
(defun ag/buffer-extension-regex ()
|
||||
"If the current buffer has an extension, return
|
||||
a PCRE pattern that matches files with that extension.
|
||||
Returns an empty string otherwise."
|
||||
(let ((file-name (buffer-file-name)))
|
||||
(if (stringp file-name)
|
||||
(format "\\.%s$" (ag/escape-pcre (file-name-extension file-name)))
|
||||
"")))
|
||||
|
||||
(defun ag/longest-string (&rest strings)
|
||||
"Given a list of strings and nils, return the longest string."
|
||||
(let ((longest-string nil))
|
||||
(dolist (string strings)
|
||||
(cond ((null longest-string)
|
||||
(setq longest-string string))
|
||||
((stringp string)
|
||||
(when (< (length longest-string)
|
||||
(length string))
|
||||
(setq longest-string string)))))
|
||||
longest-string))
|
||||
|
||||
(defun ag/replace-first (string before after)
|
||||
"Replace the first occurrence of BEFORE in STRING with AFTER."
|
||||
(replace-regexp-in-string
|
||||
(concat "\\(" (regexp-quote before) "\\)" ".*\\'")
|
||||
after string
|
||||
nil nil 1))
|
||||
|
||||
(autoload 'vc-git-root "vc-git")
|
||||
|
||||
(require 'vc-svn)
|
||||
;; Emacs 23.4 doesn't provide vc-svn-root.
|
||||
(unless (functionp 'vc-svn-root)
|
||||
(defun vc-svn-root (file)
|
||||
(vc-find-root file vc-svn-admin-directory)))
|
||||
|
||||
(autoload 'vc-hg-root "vc-hg")
|
||||
|
||||
(autoload 'vc-bzr-root "vc-bzr")
|
||||
|
||||
(defun ag/project-root (file-path)
|
||||
"Guess the project root of the given FILE-PATH.
|
||||
|
||||
Use `ag-project-root-function' if set, or fall back to VCS
|
||||
roots."
|
||||
(if ag-project-root-function
|
||||
(funcall ag-project-root-function file-path)
|
||||
(or (ag/longest-string
|
||||
(vc-git-root file-path)
|
||||
(vc-svn-root file-path)
|
||||
(vc-hg-root file-path)
|
||||
(vc-bzr-root file-path))
|
||||
file-path)))
|
||||
|
||||
(defun ag/dired-align-size-column ()
|
||||
(beginning-of-line)
|
||||
(when (looking-at "^ ")
|
||||
(forward-char 2)
|
||||
(search-forward " " nil t 4)
|
||||
(let* ((size-start (point))
|
||||
(size-end (search-forward " " nil t))
|
||||
(width (and size-end (- size-end size-start))))
|
||||
(when (and size-end
|
||||
(< width 12)
|
||||
(> width 1))
|
||||
(goto-char size-start)
|
||||
(insert (make-string (- 12 width) ? ))))))
|
||||
|
||||
(defun ag/dired-filter (proc string)
|
||||
"Filter the output of ag to make it suitable for `dired-mode'."
|
||||
(let ((buf (process-buffer proc))
|
||||
(inhibit-read-only t))
|
||||
(if (buffer-name buf)
|
||||
(with-current-buffer buf
|
||||
(save-excursion
|
||||
(save-restriction
|
||||
(widen)
|
||||
(let ((beg (point-max)))
|
||||
(goto-char beg)
|
||||
(insert string)
|
||||
(goto-char beg)
|
||||
(or (looking-at "^")
|
||||
(progn
|
||||
(ag/dired-align-size-column)
|
||||
(forward-line 1)))
|
||||
(while (looking-at "^")
|
||||
(insert " ")
|
||||
(ag/dired-align-size-column)
|
||||
(forward-line 1))
|
||||
(goto-char beg)
|
||||
(beginning-of-line)
|
||||
|
||||
;; Remove occurrences of default-directory.
|
||||
(while (search-forward (concat " " default-directory) nil t)
|
||||
(replace-match " " nil t))
|
||||
|
||||
(goto-char (point-max))
|
||||
(if (search-backward "\n" (process-mark proc) t)
|
||||
(progn
|
||||
(dired-insert-set-properties (process-mark proc)
|
||||
(1+ (point)))
|
||||
(move-marker (process-mark proc) (1+ (point)))))))))
|
||||
(delete-process proc))))
|
||||
|
||||
(defun ag/dired-sentinel (proc state)
|
||||
"Update the status/modeline after the process finishes."
|
||||
(let ((buf (process-buffer proc))
|
||||
(inhibit-read-only t))
|
||||
(if (buffer-name buf)
|
||||
(with-current-buffer buf
|
||||
(let ((buffer-read-only nil))
|
||||
(save-excursion
|
||||
(goto-char (point-max))
|
||||
(insert "\n ag " state)
|
||||
(forward-char -1) ;Back up before \n at end of STATE.
|
||||
(insert " at " (substring (current-time-string) 0 19))
|
||||
(forward-char 1)
|
||||
(setq mode-line-process
|
||||
(concat ":" (symbol-name (process-status proc))))
|
||||
;; Since the buffer and mode line will show that the
|
||||
;; process is dead, we can delete it now. Otherwise it
|
||||
;; will stay around until M-x list-processes.
|
||||
(delete-process proc)
|
||||
(force-mode-line-update)))
|
||||
(run-hooks 'dired-after-readin-hook)
|
||||
(message "%s finished." (current-buffer))))))
|
||||
|
||||
(defun ag/kill-process ()
|
||||
"Kill the `ag' process running in the current buffer."
|
||||
(interactive)
|
||||
(let ((ag (get-buffer-process (current-buffer))))
|
||||
(and ag (eq (process-status ag) 'run)
|
||||
(eq (process-filter ag) (function find-dired-filter))
|
||||
(condition-case nil
|
||||
(delete-process ag)
|
||||
(error nil)))))
|
||||
|
||||
(defun ag/escape-pcre (regexp)
|
||||
"Escape the PCRE-special characters in REGEXP so that it is
|
||||
matched literally."
|
||||
(let ((alphanum "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"))
|
||||
(apply #'concat
|
||||
(mapcar
|
||||
(lambda (c)
|
||||
(cond
|
||||
((not (string-match-p (regexp-quote c) alphanum))
|
||||
(concat "\\" c))
|
||||
(t c)))
|
||||
(mapcar #'char-to-string (string-to-list regexp))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun ag (string directory)
|
||||
"Search using ag in a given DIRECTORY for a given literal search STRING,
|
||||
with STRING defaulting to the symbol under point.
|
||||
|
||||
If called with a prefix, prompts for flags to pass to ag."
|
||||
(interactive (list (ag/read-from-minibuffer "Search string")
|
||||
(read-directory-name "Directory: ")))
|
||||
(ag/search string directory))
|
||||
|
||||
;;;###autoload
|
||||
(defun ag-files (string file-type directory)
|
||||
"Search using ag in a given DIRECTORY for a given literal search STRING,
|
||||
limited to files that match FILE-TYPE. STRING defaults to the
|
||||
symbol under point.
|
||||
|
||||
If called with a prefix, prompts for flags to pass to ag."
|
||||
(interactive (list (ag/read-from-minibuffer "Search string")
|
||||
(ag/read-file-type)
|
||||
(read-directory-name "Directory: ")))
|
||||
(apply #'ag/search string directory file-type))
|
||||
|
||||
;;;###autoload
|
||||
(defun ag-regexp (string directory)
|
||||
"Search using ag in a given directory for a given regexp.
|
||||
The regexp should be in PCRE syntax, not Emacs regexp syntax.
|
||||
|
||||
If called with a prefix, prompts for flags to pass to ag."
|
||||
(interactive "sSearch regexp: \nDDirectory: ")
|
||||
(ag/search string directory :regexp t))
|
||||
|
||||
;;;###autoload
|
||||
(defun ag-project (string)
|
||||
"Guess the root of the current project and search it with ag
|
||||
for the given literal search STRING.
|
||||
|
||||
If called with a prefix, prompts for flags to pass to ag."
|
||||
(interactive (list (ag/read-from-minibuffer "Search string")))
|
||||
(ag/search string (ag/project-root default-directory)))
|
||||
|
||||
;;;###autoload
|
||||
(defun ag-project-files (string file-type)
|
||||
"Search using ag for a given literal search STRING,
|
||||
limited to files that match FILE-TYPE. STRING defaults to the
|
||||
symbol under point.
|
||||
|
||||
If called with a prefix, prompts for flags to pass to ag."
|
||||
(interactive (list (ag/read-from-minibuffer "Search string")
|
||||
(ag/read-file-type)))
|
||||
(apply 'ag/search string (ag/project-root default-directory) file-type))
|
||||
|
||||
(defun ag/read-from-minibuffer (prompt)
|
||||
"Read a value from the minibuffer with PROMPT.
|
||||
If there's a string at point, offer that as a default."
|
||||
(let* ((suggested (ag/dwim-at-point))
|
||||
(final-prompt
|
||||
(if suggested
|
||||
(format "%s (default %s): " prompt suggested)
|
||||
(format "%s: " prompt)))
|
||||
;; Ask the user for input, but add `suggested' to the history
|
||||
;; so they can use M-n if they want to modify it.
|
||||
(user-input (read-from-minibuffer
|
||||
final-prompt
|
||||
nil nil nil nil suggested)))
|
||||
;; Return the input provided by the user, or use `suggested' if
|
||||
;; the input was empty.
|
||||
(if (> (length user-input) 0)
|
||||
user-input
|
||||
suggested)))
|
||||
|
||||
;;;###autoload
|
||||
(defun ag-project-regexp (regexp)
|
||||
"Guess the root of the current project and search it with ag
|
||||
for the given regexp. The regexp should be in PCRE syntax, not
|
||||
Emacs regexp syntax.
|
||||
|
||||
If called with a prefix, prompts for flags to pass to ag."
|
||||
(interactive (list (ag/read-from-minibuffer "Search regexp")))
|
||||
(ag/search regexp (ag/project-root default-directory) :regexp t))
|
||||
|
||||
(autoload 'symbol-at-point "thingatpt")
|
||||
|
||||
;;;###autoload
|
||||
(defalias 'ag-project-at-point 'ag-project)
|
||||
(make-obsolete 'ag-project-at-point 'ag-project "0.19")
|
||||
|
||||
;;;###autoload
|
||||
(defalias 'ag-regexp-project-at-point 'ag-project-regexp)
|
||||
(make-obsolete 'ag-regexp-project-at-point 'ag-project-regexp "0.46")
|
||||
|
||||
;;;###autoload
|
||||
(defun ag-dired (dir string)
|
||||
"Recursively find files in DIR matching literal search STRING.
|
||||
|
||||
The PATTERN is matched against the full path to the file, not
|
||||
only against the file name.
|
||||
|
||||
The results are presented as a `dired-mode' buffer with
|
||||
`default-directory' being DIR.
|
||||
|
||||
See also `ag-dired-regexp'."
|
||||
(interactive "DDirectory: \nsFile pattern: ")
|
||||
(ag-dired-regexp dir (ag/escape-pcre string)))
|
||||
|
||||
;;;###autoload
|
||||
(defun ag-dired-regexp (dir regexp)
|
||||
"Recursively find files in DIR matching REGEXP.
|
||||
REGEXP should be in PCRE syntax, not Emacs regexp syntax.
|
||||
|
||||
The REGEXP is matched against the full path to the file, not
|
||||
only against the file name.
|
||||
|
||||
Results are presented as a `dired-mode' buffer with
|
||||
`default-directory' being DIR.
|
||||
|
||||
See also `find-dired'."
|
||||
(interactive "DDirectory: \nsFile regexp: ")
|
||||
(let* ((dired-buffers dired-buffers) ;; do not mess with regular dired buffers
|
||||
(orig-dir dir)
|
||||
(dir (file-name-as-directory (expand-file-name dir)))
|
||||
(buffer-name (if ag-reuse-buffers
|
||||
"*ag dired*"
|
||||
(format "*ag dired pattern:%s dir:%s*" regexp dir)))
|
||||
(cmd (concat ag-executable " --nocolor -g '" regexp "' "
|
||||
(shell-quote-argument dir)
|
||||
" | grep -v '^$' | sed s/\\'/\\\\\\\\\\'/ | xargs -I '{}' ls "
|
||||
dired-listing-switches " '{}' &")))
|
||||
(with-current-buffer (get-buffer-create buffer-name)
|
||||
(switch-to-buffer (current-buffer))
|
||||
(widen)
|
||||
(kill-all-local-variables)
|
||||
(if (fboundp 'read-only-mode)
|
||||
(read-only-mode -1)
|
||||
(setq buffer-read-only nil))
|
||||
(let ((inhibit-read-only t)) (erase-buffer))
|
||||
(setq default-directory dir)
|
||||
(run-hooks 'dired-before-readin-hook)
|
||||
(shell-command cmd (current-buffer))
|
||||
(insert " " dir ":\n")
|
||||
(insert " " cmd "\n")
|
||||
(dired-mode dir)
|
||||
(let ((map (make-sparse-keymap)))
|
||||
(set-keymap-parent map (current-local-map))
|
||||
(define-key map "\C-c\C-k" 'ag/kill-process)
|
||||
(use-local-map map))
|
||||
(set (make-local-variable 'dired-sort-inhibit) t)
|
||||
(set (make-local-variable 'revert-buffer-function)
|
||||
`(lambda (ignore-auto noconfirm)
|
||||
(ag-dired-regexp ,orig-dir ,regexp)))
|
||||
(if (fboundp 'dired-simple-subdir-alist)
|
||||
(dired-simple-subdir-alist)
|
||||
(set (make-local-variable 'dired-subdir-alist)
|
||||
(list (cons default-directory (point-min-marker)))))
|
||||
(let ((proc (get-buffer-process (current-buffer))))
|
||||
(set-process-filter proc #'ag/dired-filter)
|
||||
(set-process-sentinel proc #'ag/dired-sentinel)
|
||||
;; Initialize the process marker; it is used by the filter.
|
||||
(move-marker (process-mark proc) 1 (current-buffer)))
|
||||
(setq mode-line-process '(":%s")))))
|
||||
|
||||
;;;###autoload
|
||||
(defun ag-project-dired (pattern)
|
||||
"Recursively find files in current project matching PATTERN.
|
||||
|
||||
See also `ag-dired'."
|
||||
(interactive "sFile pattern: ")
|
||||
(ag-dired-regexp (ag/project-root default-directory) (ag/escape-pcre pattern)))
|
||||
|
||||
;;;###autoload
|
||||
(defun ag-project-dired-regexp (regexp)
|
||||
"Recursively find files in current project matching REGEXP.
|
||||
|
||||
See also `ag-dired-regexp'."
|
||||
(interactive "sFile regexp: ")
|
||||
(ag-dired-regexp (ag/project-root default-directory) regexp))
|
||||
|
||||
;;;###autoload
|
||||
(defun ag-kill-buffers ()
|
||||
"Kill all `ag-mode' buffers."
|
||||
(interactive)
|
||||
(dolist (buffer (buffer-list))
|
||||
(when (eq (buffer-local-value 'major-mode buffer) 'ag-mode)
|
||||
(kill-buffer buffer))))
|
||||
|
||||
;;;###autoload
|
||||
(defun ag-kill-other-buffers ()
|
||||
"Kill all `ag-mode' buffers other than the current buffer."
|
||||
(interactive)
|
||||
(let ((current-buffer (current-buffer)))
|
||||
(dolist (buffer (buffer-list))
|
||||
(when (and
|
||||
(eq (buffer-local-value 'major-mode buffer) 'ag-mode)
|
||||
(not (eq buffer current-buffer)))
|
||||
(kill-buffer buffer)))))
|
||||
|
||||
;; Based on grep-filter.
|
||||
(defun ag-filter ()
|
||||
"Handle escape sequences inserted by the ag process.
|
||||
This function is called from `compilation-filter-hook'."
|
||||
(save-excursion
|
||||
(forward-line 0)
|
||||
(let ((end (point)) beg)
|
||||
(goto-char compilation-filter-start)
|
||||
(forward-line 0)
|
||||
(setq beg (point))
|
||||
;; Only operate on whole lines so we don't get caught with part of an
|
||||
;; escape sequence in one chunk and the rest in another.
|
||||
(when (< (point) end)
|
||||
(setq end (copy-marker end))
|
||||
(when ag-highlight-search
|
||||
;; Highlight ag matches and delete marking sequences.
|
||||
(while (re-search-forward "\033\\[30;43m\\(.*?\\)\033\\[0m\033\\[K" end 1)
|
||||
(replace-match (propertize (match-string 1)
|
||||
'face nil 'font-lock-face 'ag-match-face)
|
||||
t t)))
|
||||
;; Add marker at start of line for files. This is used by the match
|
||||
;; in `compilation-error-regexp-alist' to extract the file name.
|
||||
(when ag-group-matches
|
||||
(goto-char beg)
|
||||
(while (re-search-forward "\033\\[1;32m\\(.*\\)\033\\[0m\033\\[K" end 1)
|
||||
(replace-match
|
||||
(concat "File: " (propertize (match-string 1) 'face nil 'font-lock-face
|
||||
'compilation-info))
|
||||
t t)))
|
||||
;; Delete all remaining escape sequences
|
||||
(goto-char beg)
|
||||
(while (re-search-forward "\033\\[[0-9;]*[mK]" end 1)
|
||||
(replace-match "" t t))))))
|
||||
|
||||
(defun ag/get-supported-types ()
|
||||
"Query the ag executable for which file types it recognises."
|
||||
(let* ((ag-output (shell-command-to-string (format "%s --list-file-types" ag-executable)))
|
||||
(lines (-map #'s-trim (s-lines ag-output)))
|
||||
(types (--keep (when (s-starts-with? "--" it) (s-chop-prefix "--" it )) lines))
|
||||
(extensions (--map (s-split " " it) (--filter (s-starts-with? "." it) lines))))
|
||||
(-zip types extensions)))
|
||||
|
||||
(defun ag/read-file-type ()
|
||||
"Prompt the user for a known file type, or let them specify a PCRE regex."
|
||||
(let* ((all-types-with-extensions (ag/get-supported-types))
|
||||
(all-types (mapcar 'car all-types-with-extensions))
|
||||
(file-type
|
||||
(completing-read "Select file type: "
|
||||
(append '("custom (provide a PCRE regex)") all-types)))
|
||||
(file-type-extensions
|
||||
(cdr (assoc file-type all-types-with-extensions))))
|
||||
(if file-type-extensions
|
||||
(list :file-type file-type)
|
||||
(list :file-regex
|
||||
(read-from-minibuffer "Filenames which match PCRE: "
|
||||
(ag/buffer-extension-regex))))))
|
||||
|
||||
(provide 'ag)
|
||||
;;; ag.el ends here
|
||||