Gergely Polonkai
6 years ago
1773 changed files with 2 additions and 356540 deletions
@ -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) |
||||