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

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