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

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