code.delx.au - gnu-emacs-elpa/blob - packages/ack/ack.el

   1 ;;; ack.el --- Interface to ack-like source code search tools   -*- lexical-binding: t; -*-
   2
   3 ;; Copyright (C) 2012-2013  Free Software Foundation, Inc.
   4
   5 ;; Author: Leo Liu <sdl.web@gmail.com>
   6 ;; Version: 1.3
   7 ;; Keywords: tools, processes, convenience
   8 ;; Created: 2012-03-24
   9 ;; URL: https://github.com/leoliu/ack-el
  10
  11 ;; This program is free software; you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation, either version 3 of the License, or
  14 ;; (at your option) any later version.
  15
  16 ;; This program is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  23
  24 ;;; Commentary:
  25
  26 ;; This package provides an interface to ack http://beyondgrep.com --
  27 ;; a tool like grep, designed for programmers with large trees of
  28 ;; heterogeneous source code. It builds on standard packages
  29 ;; `compile.el' and `ansi-color.el' and lets you seamlessly run `ack'
  30 ;; with its large set of options.
  31 ;;
  32 ;; Ack-like tools such as the silver search (ag) and git/hg/bzr grep
  33 ;; are well supported too.
  34
  35 ;;; Usage:
  36
  37 ;; +  Type `M-x ack' and provide a pattern to search.
  38 ;; +  Type `C-u M-x ack' to search from current project root.
  39 ;; +  Type `C-u C-u M-x ack' to interactively choose a directory to
  40 ;;    search.
  41 ;;
  42 ;; Note: use `ack-default-directory-function' for customised
  43 ;; behaviour.
  44 ;;
  45 ;; When in the minibuffer the following key bindings may be useful:
  46 ;;
  47 ;; +  `M-I' inserts a template for case-insensitive file name search
  48 ;; +  `M-G' inserts a template for `git grep', `hg grep' or `bzr grep'
  49 ;; +  `M-Y' inserts the symbol at point from the window before entering
  50 ;;    the minibuffer
  51 ;; +  `TAB' completes ack options
  52
  53 ;;; Bugs: https://github.com/leoliu/ack-el/issues
  54
  55 ;;; Code:
  56
  57 (require 'compile)
  58 (require 'ansi-color)
  59 (autoload 'shell-completion-vars "shell")
  60
  61 (eval-when-compile
  62   (unless (fboundp 'setq-local)
  63     (defmacro setq-local (var val)
  64       (list 'set (list 'make-local-variable (list 'quote var)) val))))
  65
  66 (defgroup ack nil
  67   "Run `ack' and display the results."
  68   :group 'tools
  69   :group 'processes)
  70
  71 ;; Used implicitly by `define-compilation-mode'
  72 (defcustom ack-scroll-output nil
  73   "Similar to `compilation-scroll-output' but for the *Ack* buffer."
  74   :type 'boolean
  75   :group 'ack)
  76
  77 (defcustom ack-command
  78   ;; Note: on GNU/Linux ack may be renamed to ack-grep
  79   (concat (file-name-nondirectory (or (executable-find "ack-grep")
  80                                       (executable-find "ack")
  81                                       (executable-find "ag")
  82                                       "ack")) " ")
  83   "The default command for \\[ack].
  84
  85 Note also options to ack can be specified in ACK_OPTIONS
  86 environment variable and .ackrc, which you can disable by the
  87 --noenv switch."
  88   :type 'string
  89   :safe 'stringp
  90   :group 'ack)
  91
  92 (defcustom ack-buffer-name-function nil
  93   "If non-nil, a function to compute the name of an ack buffer.
  94 See `compilation-buffer-name-function' for details."
  95   :type '(choice function (const nil))
  96   :group 'ack)
  97
  98 (defcustom ack-vc-grep-commands
  99   '((".git" . "git --no-pager grep --color -n -i")
 100     (".hg" . "hg grep -n -i")
 101     ;; Plugin bzr-grep required for bzr < 2.6
 102     (".bzr" . "bzr grep --color=always -n -i"))
 103   "An alist of vc grep commands for `ack-skel-vc-grep'.
 104 Each element is of the form (VC_DIR . CMD)."
 105   :type '(repeat (cons string string))
 106   :group 'ack)
 107
 108 (defcustom ack-default-directory-function 'ack-default-directory
 109   "A function to return the default directory for `ack'.
 110 It is called with one arg, the prefix arg to `ack'."
 111   :type 'function
 112   :group 'ack)
 113
 114 (defcustom ack-project-root-patterns
 115   (list (concat "\\`" (regexp-quote dir-locals-file) "\\'")
 116         "\\`Project\\.ede\\'"
 117         "\\.xcodeproj\\'"               ; xcode
 118         "\\`\\.ropeproject\\'"          ; python rope
 119         "\\`\\.\\(?:CVS\\|bzr\\|git\\|hg\\|svn\\)\\'")
 120   "A list of regexps to match files in a project root.
 121 Used by `ack-guess-project-root'."
 122   :type '(repeat string)
 123   :group 'ack)
 124
 125 (defcustom ack-minibuffer-setup-hook nil
 126   "Ack-specific hook for `minibuffer-setup-hook'."
 127   :type 'hook
 128   :group 'ack)
 129
 130 ;;; ======== END of USER OPTIONS ========
 131
 132 (defvar ack-history nil "History list for ack.")
 133
 134 (defvar ack-first-column 0
 135   "Value to use for `compilation-first-column' in ack buffers.")
 136
 137 (defvar ack-error-screen-columns nil
 138   "Value to use for `compilation-error-screen-columns' in ack buffers.")
 139
 140 (defvar ack-error "ack match"
 141   "Stem of message to print when no matches are found.")
 142
 143 (defun ack-filter ()
 144   "Handle match highlighting escape sequences inserted by the ack process.
 145 This function is called from `compilation-filter-hook'."
 146   (save-excursion
 147     (let ((ansi-color-apply-face-function
 148            (lambda (beg end face)
 149              (when face
 150                (ansi-color-apply-overlay-face beg end face)
 151                (put-text-property beg end 'ack-color t)))))
 152       (ansi-color-apply-on-region compilation-filter-start (point)))))
 153
 154 (defvar ack-mode-font-lock-keywords
 155   '(("^--$" 0 'shadow)
 156     ;; Command output lines.
 157     (": \\(.+\\): \\(?:Permission denied\\|No such \\(?:file or directory\\|device or address\\)\\)$"
 158      1 'compilation-error)
 159     ("^Ack \\(exited abnormally\\|interrupt\\|killed\\|terminated\\)\\(?:.*with code \\([0-9]+\\)\\)?.*"
 160      (1 'compilation-error)
 161      (2 'compilation-error nil t)))
 162   "Additional things to highlight in ack output.
 163 This gets tacked on the end of the generated expressions.")
 164
 165 (defun ack--column-start ()
 166   (or (let* ((beg (match-end 0))
 167              (end (save-excursion
 168                     (goto-char beg)
 169                     (line-end-position)))
 170              (mbeg (text-property-any beg end 'ack-color t)))
 171         (when mbeg (- mbeg beg)))
 172       ;; Use column number from `ack' itself if available
 173       (when (match-string 4)
 174         (1- (string-to-number (match-string 4))))))
 175
 176 (defun ack--column-end ()
 177   (let* ((beg (match-end 0))
 178          (end (save-excursion
 179                 (goto-char beg)
 180                 (line-end-position)))
 181          (mbeg (text-property-any beg end 'ack-color t))
 182          (mend (and mbeg (next-single-property-change
 183                           mbeg 'ack-color nil end))))
 184     (when mend (- mend beg))))
 185
 186 (defun ack--file ()
 187   (let (file)
 188     (save-excursion
 189       (while (progn
 190                (forward-line -1)
 191                (looking-at-p "^--$")))
 192       (setq file (or (get-text-property (line-beginning-position) 'ack-file)
 193                      (progn
 194                        (put-text-property (line-beginning-position)
 195                                           (line-end-position)
 196                                           'font-lock-face compilation-info-face)
 197                        (buffer-substring-no-properties
 198                         (line-beginning-position) (line-end-position))))))
 199     (put-text-property (line-beginning-position)
 200                        (min (1+ (line-end-position)) (point-max)) 'ack-file file)
 201     (list file)))
 202
 203 ;;; `compilation-mode-font-lock-keywords' ->
 204 ;;; `compilation--ensure-parse' -> `compilation--parse-region' ->
 205 ;;; `compilation-parse-errors' -> `compilation-error-properties'.
 206 ;;; `compilation-error-properties' returns nil if a previous pattern
 207 ;;; in the regexp alist has already been applied in a region.
 208
 209 (defconst ack-error-regexp-alist
 210   `(;; Grouping line (--group or --heading).
 211     ("^\\([1-9][0-9]*\\)\\(:\\|-\\)\\(?:\\(?4:[1-9][0-9]*\\)\\2\\)?"
 212      ack--file 1 (ack--column-start . ack--column-end)
 213      nil nil (4 compilation-column-face nil t))
 214     ;; None grouping line (--nogroup or --noheading). Avoid matching
 215     ;; 'Ack started at Thu Jun 6 12:27:53'.
 216     ("^\\(.+?\\)\\(:\\|-\\)\\([1-9][0-9]*\\)\\2\\(?:\\(?:\\(?4:[1-9][0-9]*\\)\\2\\)\\|[^0-9\n]\\|[0-9][^0-9\n]\\|...\\)"
 217      1 3 (ack--column-start . ack--column-end)
 218      nil 1 (4 compilation-column-face nil t))
 219     ("^Binary file \\(.+\\) matches$" 1 nil nil 0 1))
 220   "Ack version of `compilation-error-regexp-alist' (which see).")
 221
 222 (defvar ack-process-setup-function 'ack-process-setup)
 223
 224 (defun ack-process-setup ()
 225   ;; Handle `hg grep' output
 226   (when (string-match-p "^[ \t]*hg[ \t]" (car compilation-arguments))
 227     (setq compilation-error-regexp-alist
 228           '(("^\\(.+?:[0-9]+:\\)\\(?:\\([0-9]+\\):\\)?" 1 2)))
 229     (setq-local compilation-parse-errors-filename-function
 230                 (lambda (file)
 231                   (save-match-data
 232                     (if (string-match "\\(.+\\):\\([0-9]+\\):" file)
 233                         (match-string 1 file)
 234                       file)))))
 235   ;; Handle `bzr grep' output
 236   (when (string-match-p "^[ \t]*bzr[ \t]" (car compilation-arguments))
 237     (setq-local compilation-parse-errors-filename-function
 238                 (lambda (file)
 239                   (save-match-data
 240                     ;; 'bzr grep -r' has files like `termcolor.py~147'
 241                     (if (string-match "\\(.+\\)~\\([0-9]+\\)" file)
 242                         (match-string 1 file)
 243                       file))))))
 244
 245 (define-compilation-mode ack-mode "Ack"
 246   "A compilation mode tailored for ack."
 247   (setq-local compilation-disable-input t)
 248   (setq-local compilation-error-face 'compilation-info)
 249   (add-hook 'compilation-filter-hook 'ack-filter nil t))
 250
 251 ;;; `compilation-display-error' is introduced in 24.4
 252 (unless (fboundp 'compilation-display-error)
 253   (defun ack-mode-display-match ()
 254     "Display in another window the match in current line."
 255     (interactive)
 256     (setq compilation-current-error (point))
 257     (next-error-no-select 0))
 258   (define-key ack-mode-map "\C-o" #'ack-mode-display-match))
 259
 260 (defun ack-skel-file ()
 261   "Insert a template for case-insensitive file name search."
 262   (interactive)
 263   (delete-minibuffer-contents)
 264   (let ((ack (or (car (split-string ack-command nil t)) "ack")))
 265     (if (equal ack "ag")
 266         (skeleton-insert `(nil ,ack " -ig '" _ "'"))
 267       (skeleton-insert `(nil ,ack " -g '(?i:" _ ")'")))))
 268
 269 ;; Work around bug http://debbugs.gnu.org/13811
 270 (defvar ack--project-root nil)          ; dynamically bound in `ack'
 271
 272 (defun ack-skel-vc-grep ()
 273   "Insert a template for vc grep search."
 274   (interactive)
 275   (let* ((regexp (concat "\\`" (regexp-opt
 276                                 (mapcar 'car ack-vc-grep-commands))
 277                          "\\'"))
 278          (root (or (ack-guess-project-root default-directory regexp)
 279                    (error "Cannot locate vc project root")))
 280          (which (car (directory-files root nil regexp)))
 281          (backend (downcase (substring which 1)))
 282          (cmd (or (cdr (assoc which ack-vc-grep-commands))
 283                   (error "No command provided for `%s grep'" backend))))
 284     (setq ack--project-root root)
 285     (delete-minibuffer-contents)
 286     (skeleton-insert `(nil ,cmd " '" _ "'"))))
 287
 288 (defun ack-yank-symbol-at-point ()
 289   "Yank the symbol from the window before entering the minibuffer."
 290   (interactive)
 291   (let ((symbol (and (minibuffer-selected-window)
 292                      (with-current-buffer
 293                          (window-buffer (minibuffer-selected-window))
 294                        (thing-at-point 'symbol)))))
 295     (if symbol (insert symbol)
 296       (minibuffer-message "No symbol found"))))
 297
 298 (defvar ack-minibuffer-local-map
 299   (let ((map (make-sparse-keymap)))
 300     (set-keymap-parent map minibuffer-local-map)
 301     (define-key map "\t" 'completion-at-point)
 302     (define-key map "\M-I" 'ack-skel-file)
 303     (define-key map "\M-G" 'ack-skel-vc-grep)
 304     (define-key map "\M-Y" 'ack-yank-symbol-at-point)
 305     (define-key map "'" 'skeleton-pair-insert-maybe)
 306     map)
 307   "Keymap used for reading `ack' command and args in minibuffer.")
 308
 309 (defun ack-guess-project-root (start-directory &optional regexp)
 310   (let ((regexp (or regexp
 311                     (mapconcat 'identity ack-project-root-patterns "\\|")))
 312         (parent (file-name-directory
 313                  (directory-file-name (expand-file-name start-directory)))))
 314     (if (directory-files start-directory nil regexp)
 315         start-directory
 316       (unless (equal parent start-directory)
 317         (ack-guess-project-root parent regexp)))))
 318
 319 (defun ack-default-directory (arg)
 320   "A function for `ack-default-directory-function'.
 321 With no \\[universal-argument], return `default-directory';
 322 With one \\[universal-argument], find the project root according to
 323 `ack-project-root-patterns';
 324 Otherwise, interactively choose a directory."
 325   (cond
 326    ((not arg) default-directory)
 327    ((= (prefix-numeric-value arg) 4)
 328     (or (ack-guess-project-root default-directory)
 329         (ack-default-directory '(16))))
 330    (t (read-directory-name "In directory: " nil nil t))))
 331
 332 (defun ack-update-minibuffer-prompt (&optional _beg _end _len)
 333   (when (minibufferp)
 334     (let ((inhibit-read-only t))
 335       (save-excursion
 336         (goto-char (minibuffer-prompt-end))
 337         (when (looking-at "\\(\\w+\\)\\s-")
 338           (put-text-property
 339            (point-min) (minibuffer-prompt-end)
 340            'display
 341            (format "Run %s in `%s': "
 342                    (match-string-no-properties 1)
 343                    (file-name-nondirectory
 344                     (directory-file-name ack--project-root)))))))))
 345
 346 (defun ack-minibuffer-setup-function ()
 347   (shell-completion-vars)
 348   (add-hook 'after-change-functions
 349             #'ack-update-minibuffer-prompt nil t)
 350   (ack-update-minibuffer-prompt)
 351   (run-hooks 'ack-minibuffer-setup-hook))
 352
 353 ;;;###autoload
 354 (defun ack (command-args &optional directory)
 355   "Run ack using COMMAND-ARGS and collect output in a buffer.
 356 When called interactively, the value of DIRECTORY is provided by
 357 `ack-default-directory-function'.
 358
 359 The following keys are available while reading from the
 360 minibuffer:
 361
 362 \\{ack-minibuffer-local-map}"
 363   (interactive
 364    (let ((ack--project-root (or (funcall ack-default-directory-function
 365                                     current-prefix-arg)
 366                            default-directory))
 367          ;; Disable completion cycling; see http://debbugs.gnu.org/12221
 368          (completion-cycle-threshold nil))
 369      (list (minibuffer-with-setup-hook 'ack-minibuffer-setup-function
 370              (read-from-minibuffer "Ack: "
 371                                    ack-command
 372                                    ack-minibuffer-local-map
 373                                    nil 'ack-history))
 374            ack--project-root)))
 375   (let ((default-directory (expand-file-name
 376                             (or directory default-directory))))
 377     ;; Change to the compilation buffer so that `ack-buffer-name-function' can
 378     ;; make use of `compilation-arguments'.
 379     (with-current-buffer (compilation-start command-args 'ack-mode)
 380       (when ack-buffer-name-function
 381         (rename-buffer (funcall ack-buffer-name-function "ack"))))))
 382
 383 (provide 'ack)
 384 ;;; ack.el ends here