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

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