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 ;; Keywords: tools, processes, convenience
   7 ;; Created: 2012-03-24
   8 ;; Version: 0.7
   9
  10 ;; This program is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation, either version 3 of the License, or
  13 ;; (at your option) any later version.
  14
  15 ;; This program is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  22
  23 ;;; Commentary:
  24
  25 ;; ack is a tool like grep, designed for programmers with large trees
  26 ;; of heterogeneous source code - http://betterthangrep.com/.
  27
  28 ;;; Code:
  29
  30 (require 'compile)
  31 (require 'ansi-color)
  32 (when (>= emacs-major-version 24)
  33   (autoload 'shell-completion-vars "shell"))
  34
  35 (defgroup ack nil
  36   "Run `ack' and display the results."
  37   :group 'tools
  38   :group 'processes)
  39
  40 (defcustom ack-project-pattern-list
  41   (list (concat "\\`" (regexp-quote dir-locals-file) "\\'")
  42         "\\`Project\\.ede\\'"
  43         "\\.xcodeproj\\'"         ; xcode
  44         "\\`\\.ropeproject\\'"    ; python rope
  45         ;; ".git" ".svn" ".hg" ".bzr" ".CVS"
  46         "\\`\\.\\(?:CVS\\|bzr\\|git\\|hg\\|svn\\)\\'")
  47   "A list of regexps that match files in a project root."
  48   :type '(repeat string)
  49   :group 'ack)
  50
  51 ;; Used implicitly by `define-compilation-mode'
  52 (defcustom ack-scroll-output nil
  53   "Similar to `compilation-scroll-output' but for the *Ack* buffer."
  54   :type 'boolean
  55   :group 'ack)
  56
  57 (defcustom ack-command
  58   ;; Note: on GNU/Linux ack may be renamed to ack-grep
  59   (concat (file-name-nondirectory (or (executable-find "ack-grep")
  60                                       (executable-find "ack")
  61                                       "ack")) " ")
  62   "The default ack command for \\[ack].
  63
  64 Note also options to ack can be specified in ACK_OPTIONS
  65 environment variable and ~/.ackrc, which you can disable by the
  66 --noenv switch."
  67   :type 'string
  68   :group 'ack)
  69
  70 ;;; ======== END of USER OPTIONS ========
  71
  72 (defvar ack-history nil "History list for ack.")
  73
  74 (defvar ack-first-column 0
  75   "Value to use for `compilation-first-column' in ack buffers.")
  76
  77 (defvar ack-error-screen-columns nil
  78   "Value to use for `compilation-error-screen-columns' in ack buffers.")
  79
  80 (defvar ack-error "ack match"
  81   "Stem of message to print when no matches are found.")
  82
  83 (defun ack-filter ()
  84   "Handle match highlighting escape sequences inserted by the ack process.
  85 This function is called from `compilation-filter-hook'."
  86   (save-excursion
  87     (let ((ansi-color-apply-face-function
  88            (lambda (beg end face)
  89              (when face
  90                (ansi-color-apply-overlay-face beg end face)
  91                (put-text-property beg end 'ack-color t)))))
  92       (ansi-color-apply-on-region compilation-filter-start (point)))))
  93
  94 (defvar ack-mode-font-lock-keywords
  95   '(("^--$" 0 'shadow)
  96     ;; Command output lines.
  97     (": \\(.+\\): \\(?:Permission denied\\|No such \\(?:file or directory\\|device or address\\)\\)$"
  98      1 'compilation-error)
  99     ;; Remove match from ack-error-regexp-alist before fontifying
 100     ("^Ack \\(?:started\\|finished\\) at.*"
 101      (0 '(face nil compilation-message nil message nil help-echo nil mouse-face nil) t))
 102     ("^Ack \\(exited abnormally\\|interrupt\\|killed\\|terminated\\)\\(?:.*with code \\([0-9]+\\)\\)?.*"
 103      (0 '(face nil compilation-message nil message nil help-echo nil mouse-face nil) t)
 104      (1 'compilation-error)
 105      (2 'compilation-error nil t)))
 106   "Additional things to highlight in ack output.
 107 This gets tacked on the end of the generated expressions.")
 108
 109 (when (< emacs-major-version 24)
 110   (defvar ack--column-start 'ack--column-start)
 111   (defvar ack--column-end 'ack--column-end))
 112
 113 (defun ack--column-start ()
 114   (or (let* ((beg (match-end 0))
 115              (end (save-excursion
 116                     (goto-char beg)
 117                     (line-end-position)))
 118              (mbeg (text-property-any beg end 'ack-color t)))
 119         (when mbeg (- mbeg beg)))
 120       ;; Use column number from `ack' itself if available
 121       (when (match-string 4)
 122         (1- (string-to-number (match-string 4))))))
 123
 124 (defun ack--column-end ()
 125   (let* ((beg (match-end 0))
 126          (end (save-excursion
 127                 (goto-char beg)
 128                 (line-end-position)))
 129          (mbeg (text-property-any beg end 'ack-color t))
 130          (mend (and mbeg (next-single-property-change
 131                           mbeg 'ack-color nil end))))
 132     (when mend (- mend beg))))
 133
 134 (defun ack--file ()
 135   (let (file)
 136     (save-excursion
 137       (while (progn
 138                (forward-line -1)
 139                (looking-at-p "^--$")))
 140       (setq file (or (get-text-property (line-beginning-position) 'ack-file)
 141                      (progn
 142                        (put-text-property (line-beginning-position)
 143                                           (line-end-position)
 144                                           'font-lock-face compilation-info-face)
 145                        (buffer-substring-no-properties
 146                         (line-beginning-position) (line-end-position))))))
 147     (put-text-property (line-beginning-position)
 148                        (min (1+ (line-end-position)) (point-max)) 'ack-file file)
 149     (list file)))
 150
 151 ;;; For emacs < 24
 152 (when (< emacs-major-version 24)
 153   (defun ack--line (file col)
 154     (if (string-match-p "\\`[1-9][0-9]*\\'" (car file))
 155         (let ((has-ansi-color (overlays-at (match-beginning 1))))
 156           ;; See `compilation-mode-font-lock-keywords' where there is
 157           ;; overriding font-locking of FILE. Thus use the display
 158           ;; property here to avoid being overridden.
 159           (put-text-property
 160            (match-beginning 1) (match-end 1)
 161            'display
 162            (propertize (match-string-no-properties 1)
 163                        'face (list (and (not has-ansi-color)
 164                                         compilation-line-face)
 165                                    :weight 'normal :inherit 'underline)))
 166           (list nil (ack--file)
 167                 (string-to-number (match-string 1))
 168                 (1- (string-to-number (match-string 3)))))
 169       (put-text-property (match-beginning 3)
 170                          (match-end 3)
 171                          'font-lock-face compilation-line-face)
 172       (list nil file
 173             (string-to-number (match-string 3))
 174             (when (match-string 4)
 175               (put-text-property (match-beginning 4)
 176                                  (match-end 4)
 177                                  'font-lock-face compilation-column-face)
 178               (1- (string-to-number (match-string 4))))))))
 179
 180 ;;; In emacs-24 and above, `compilation-mode-font-lock-keywords' ->
 181 ;;; `compilation--ensure-parse' -> `compilation--parse-region' ->
 182 ;;; `compilation-parse-errors' -> `compilation-error-properties'.
 183 ;;; `compilation-error-properties' returns nil if a previous pattern
 184 ;;; in the regexp alist has already been applied in a region.
 185 ;;;
 186 ;;; In emacs-23, `ack-regexp-alist' is a part of `font-lock-keywords'
 187 ;;; after some transformation, so later entries can override earlier
 188 ;;; entries.
 189 ;;;
 190 ;;; The output of 'ack --group --column WHATEVER' matches both regexps
 191 ;;; in `ack-regexp-alist' and this fails emacs-23 in finding the right
 192 ;;; file. So ack--line is used to disambiguate this case.
 193
 194 (defconst ack-error-regexp-alist
 195   `(;; grouping line (--group or --heading)
 196     ("^\\([1-9][0-9]*\\)\\(:\\|-\\)\\(?:\\(?4:[1-9][0-9]*\\)\\2\\)?"
 197      ack--file 1 (ack--column-start . ack--column-end)
 198      nil nil (4 compilation-column-face nil t))
 199     ;; none grouping line (--nogroup or --noheading)
 200     ("^\\(.+?\\)\\(:\\|-\\)\\([1-9][0-9]*\\)\\2\\(?:\\(?4:[1-9][0-9]*\\)\\2\\)?"
 201      ,@(if (>= emacs-major-version 24)
 202            '(1 3 (ack--column-start . ack--column-end)
 203                nil nil (4 compilation-column-face nil t))
 204          '(1 ack--line 4)))
 205     ("^Binary file \\(.+\\) matches$" 1 nil nil 0 1))
 206   "Ack version of `compilation-error-regexp-alist' (which see).")
 207
 208 (defvar ack--ansi-color-last-marker)
 209
 210 (define-compilation-mode ack-mode "Ack"
 211   "A compilation mode tailored for ack."
 212   (set (make-local-variable 'compilation-disable-input) t)
 213   (set (make-local-variable 'compilation-error-face)
 214        'compilation-info)
 215   (if (>= emacs-major-version 24)
 216       (add-hook 'compilation-filter-hook 'ack-filter nil t)
 217     (set (make-local-variable 'ack--ansi-color-last-marker)
 218          (point-min-marker))
 219     (font-lock-add-keywords
 220      nil '(((lambda (limit)
 221               (let ((beg (marker-position ack--ansi-color-last-marker)))
 222                 (move-marker ack--ansi-color-last-marker limit)
 223                 (ansi-color-apply-on-region beg ack--ansi-color-last-marker))
 224               nil))))))
 225
 226 (defun ack-skel-file ()
 227   "Insert a template for case-insensitive filename search."
 228   (interactive)
 229   (delete-minibuffer-contents)
 230   (let ((ack (or (car (split-string ack-command nil t)) "ack")))
 231     (skeleton-insert '(nil ack " -g '(?i:" _ ")'"))))
 232
 233 (defvar ack-minibuffer-local-map
 234   (let ((map (make-sparse-keymap)))
 235     (set-keymap-parent map minibuffer-local-map)
 236     (define-key map "\t" (if (>= emacs-major-version 24)
 237                              'completion-at-point
 238                            'pcomplete))
 239     (define-key map "\M-I" 'ack-skel-file)
 240     (define-key map "'" 'skeleton-pair-insert-maybe)
 241     map)
 242   "Keymap used for reading `ack' command and args in minibuffer.")
 243
 244 (defun ack-guess-project-root (start-directory &optional regexp)
 245   (let ((regexp (or regexp
 246                     (mapconcat 'identity ack-project-pattern-list "\\|")))
 247         (parent (file-name-directory
 248                  (directory-file-name (expand-file-name start-directory)))))
 249     (if (directory-files start-directory nil regexp)
 250         start-directory
 251       (unless (equal parent start-directory)
 252         (ack-guess-project-root parent regexp)))))
 253
 254 ;;;###autoload
 255 (defun ack (command-args &optional directory)
 256   "Run ack using COMMAND-ARGS and collect output in a buffer.
 257 With prefix, ask for the DIRECTORY to run ack; otherwise the
 258 current project root is used.
 259
 260 The following keys are available while reading from the
 261 minibuffer:
 262
 263 \\{ack-minibuffer-local-map}"
 264   (interactive
 265    (list (minibuffer-with-setup-hook (if (>= emacs-major-version 24)
 266                                          'shell-completion-vars
 267                                        'pcomplete-shell-setup)
 268            (read-from-minibuffer "Run ack (like this): "
 269                                  ack-command ack-minibuffer-local-map
 270                                  nil 'ack-history))
 271          (if current-prefix-arg
 272              (read-directory-name "In directory: " nil nil t)
 273            (ack-guess-project-root default-directory))))
 274   (let ((default-directory (expand-file-name
 275                             (or directory default-directory))))
 276     (compilation-start command-args 'ack-mode)))
 277
 278 (provide 'ack)
 279 ;;; ack.el ends here