-;;; ack.el --- Emacs interface to ack
+;;; ack.el --- Emacs interface to ack -*- lexical-binding: t; -*-
-;; Copyright (C) 2012 Free Software Foundation, Inc.
+;; Copyright (C) 2012, 2013 Free Software Foundation, Inc.
;; Author: Leo Liu <sdl.web@gmail.com>
-;; Version: 0.8
+;; Version: 0.9
;; Keywords: tools, processes, convenience
;; Created: 2012-03-24
;; URL: https://github.com/leoliu/ack-el
(require 'compile)
(require 'ansi-color)
-(when (>= emacs-major-version 24)
- (autoload 'shell-completion-vars "shell"))
+(autoload 'shell-completion-vars "shell")
+
+(eval-when-compile
+ (unless (fboundp 'setq-local)
+ (defmacro setq-local (var val)
+ (list 'set (list 'make-local-variable (list 'quote var)) val))))
(defgroup ack nil
"Run `ack' and display the results."
:type 'string
:group 'ack)
+(defcustom ack-buffer-name-function nil
+ "If non-nil, a function to compute the name of an ack buffer.
+See `compilation-buffer-name-function' for details."
+ :type '(choice function (const nil))
+ :group 'ack)
+
(defcustom ack-vc-grep-commands
'((".git" . "git --no-pager grep --color -n -i")
(".hg" . "hg grep -n -i")
:type '(repeat string)
:group 'ack)
+(defcustom ack-minibuffer-setup-hook nil
+ "Ack-specific hook for `minibuffer-setup-hook'."
+ :type 'hook
+ :group 'ack)
+
;;; ======== END of USER OPTIONS ========
(defvar ack-history nil "History list for ack.")
"Additional things to highlight in ack output.
This gets tacked on the end of the generated expressions.")
-(when (< emacs-major-version 24)
- (defvar ack--column-start 'ack--column-start)
- (defvar ack--column-end 'ack--column-end))
-
(defun ack--column-start ()
(or (let* ((beg (match-end 0))
(end (save-excursion
(min (1+ (line-end-position)) (point-max)) 'ack-file file)
(list file)))
-;;; For emacs < 24
-(when (< emacs-major-version 24)
- (defun ack--line (file col)
- (if (string-match-p "\\`[1-9][0-9]*\\'" (car file))
- (let ((has-ansi-color (overlays-at (match-beginning 1))))
- ;; See `compilation-mode-font-lock-keywords' where there is
- ;; overriding font-locking of FILE. Thus use the display
- ;; property here to avoid being overridden.
- (put-text-property
- (match-beginning 1) (match-end 1)
- 'display
- (propertize (match-string-no-properties 1)
- 'face (list (and (not has-ansi-color)
- compilation-line-face)
- :weight 'normal :inherit 'underline)))
- (list nil (ack--file)
- (string-to-number (match-string 1))
- (1- (string-to-number (match-string 3)))))
- (put-text-property (match-beginning 3)
- (match-end 3)
- 'font-lock-face compilation-line-face)
- (list nil file
- (string-to-number (match-string 3))
- (when (match-string 4)
- (put-text-property (match-beginning 4)
- (match-end 4)
- 'font-lock-face compilation-column-face)
- (1- (string-to-number (match-string 4))))))))
-
-;;; In emacs-24 and above, `compilation-mode-font-lock-keywords' ->
+;;; `compilation-mode-font-lock-keywords' ->
;;; `compilation--ensure-parse' -> `compilation--parse-region' ->
;;; `compilation-parse-errors' -> `compilation-error-properties'.
;;; `compilation-error-properties' returns nil if a previous pattern
;;; in the regexp alist has already been applied in a region.
-;;;
-;;; In emacs-23, `ack-regexp-alist' is a part of `font-lock-keywords'
-;;; after some transformation, so later entries can override earlier
-;;; entries.
-;;;
-;;; The output of 'ack --group --column WHATEVER' matches both regexps
-;;; in `ack-regexp-alist' and this fails emacs-23 in finding the right
-;;; file. So ack--line is used to disambiguate this case.
(defconst ack-error-regexp-alist
`(;; grouping line (--group or --heading)
nil nil (4 compilation-column-face nil t))
;; none grouping line (--nogroup or --noheading)
("^\\(.+?\\)\\(:\\|-\\)\\([1-9][0-9]*\\)\\2\\(?:\\(?4:[1-9][0-9]*\\)\\2\\)?"
- ,@(if (>= emacs-major-version 24)
- '(1 3 (ack--column-start . ack--column-end)
- nil nil (4 compilation-column-face nil t))
- '(1 ack--line 4)))
+ 1 3 (ack--column-start . ack--column-end)
+ nil nil (4 compilation-column-face nil t))
("^Binary file \\(.+\\) matches$" 1 nil nil 0 1))
"Ack version of `compilation-error-regexp-alist' (which see).")
-(defvar ack--ansi-color-last-marker)
-
(defvar ack-process-setup-function 'ack-process-setup)
(defun ack-process-setup ()
(when (string-match-p "^[ \t]*hg[ \t]" (car compilation-arguments))
(setq compilation-error-regexp-alist
'(("^\\(.+?:[0-9]+:\\)\\(?:\\([0-9]+\\):\\)?" 1 2)))
- (when (< emacs-major-version 24)
- (setq font-lock-keywords (compilation-mode-font-lock-keywords)))
- (make-local-variable 'compilation-parse-errors-filename-function)
- (setq compilation-parse-errors-filename-function
- (lambda (file)
- (save-match-data
- (if (string-match "\\(.+\\):\\([0-9]+\\):" file)
- (match-string 1 file)
- file)))))
+ (setq-local compilation-parse-errors-filename-function
+ (lambda (file)
+ (save-match-data
+ (if (string-match "\\(.+\\):\\([0-9]+\\):" file)
+ (match-string 1 file)
+ file)))))
;; Handle `bzr grep' output
(when (string-match-p "^[ \t]*bzr[ \t]" (car compilation-arguments))
- (make-local-variable 'compilation-parse-errors-filename-function)
- (setq compilation-parse-errors-filename-function
- (lambda (file)
- (save-match-data
- ;; 'bzr grep -r' has files like `termcolor.py~147'
- (if (string-match "\\(.+\\)~\\([0-9]+\\)" file)
- (match-string 1 file)
- file))))))
+ (setq-local compilation-parse-errors-filename-function
+ (lambda (file)
+ (save-match-data
+ ;; 'bzr grep -r' has files like `termcolor.py~147'
+ (if (string-match "\\(.+\\)~\\([0-9]+\\)" file)
+ (match-string 1 file)
+ file))))))
+
+(defun ack-mode-display-match ()
+ "Display in another window the match in current line."
+ (interactive)
+ (setq compilation-current-error (point))
+ (next-error-no-select 0))
(define-compilation-mode ack-mode "Ack"
"A compilation mode tailored for ack."
- (set (make-local-variable 'compilation-disable-input) t)
- (set (make-local-variable 'compilation-error-face)
- 'compilation-info)
- (if (>= emacs-major-version 24)
- (add-hook 'compilation-filter-hook 'ack-filter nil t)
- (set (make-local-variable 'ack--ansi-color-last-marker)
- (point-min-marker))
- (font-lock-add-keywords
- nil '(((lambda (limit)
- (let ((beg (marker-position ack--ansi-color-last-marker)))
- (move-marker ack--ansi-color-last-marker limit)
- (ansi-color-apply-on-region beg ack--ansi-color-last-marker))
- nil))))))
+ (setq-local compilation-disable-input t)
+ (setq-local compilation-error-face 'compilation-info)
+ (add-hook 'compilation-filter-hook 'ack-filter nil t)
+ (define-key ack-mode-map "\C-o" #'ack-mode-display-match))
(defun ack-skel-file ()
"Insert a template for case-insensitive file name search."
(interactive)
(delete-minibuffer-contents)
(let ((ack (or (car (split-string ack-command nil t)) "ack")))
- (skeleton-insert '(nil ack " -g '(?i:" _ ")'"))))
+ (skeleton-insert `(nil ,ack " -g '(?i:" _ ")'"))))
-(defvar project-root) ; dynamically bound in `ack'
+;; Work around bug http://debbugs.gnu.org/13811
+(defvar ack--project-root nil) ; dynamically bound in `ack'
(defun ack-skel-vc-grep ()
"Insert a template for vc grep search."
(root (or (ack-guess-project-root default-directory regexp)
(error "Cannot locate vc project root")))
(which (car (directory-files root nil regexp)))
+ (backend (downcase (substring which 1)))
(cmd (or (cdr (assoc which ack-vc-grep-commands))
- (error "No command provided for `%s grep'"
- (substring which 1)))))
- (setq project-root root)
+ (error "No command provided for `%s grep'" backend))))
+ (setq ack--project-root root)
(delete-minibuffer-contents)
- (skeleton-insert '(nil cmd " '" _ "'"))))
+ (skeleton-insert `(nil ,cmd " '" _ "'"))))
+
+(defun ack-yank-symbol-at-point ()
+ "Yank the symbol from the window before entering the minibuffer."
+ (interactive)
+ (let ((symbol (and (minibuffer-selected-window)
+ (with-current-buffer
+ (window-buffer (minibuffer-selected-window))
+ (thing-at-point 'symbol)))))
+ (if symbol (insert symbol)
+ (minibuffer-message "No symbol found"))))
(defvar ack-minibuffer-local-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map minibuffer-local-map)
- (define-key map "\t" (if (>= emacs-major-version 24)
- 'completion-at-point
- 'pcomplete))
+ (define-key map "\t" 'completion-at-point)
(define-key map "\M-I" 'ack-skel-file)
(define-key map "\M-G" 'ack-skel-vc-grep)
+ (define-key map "\M-Y" 'ack-yank-symbol-at-point)
(define-key map "'" 'skeleton-pair-insert-maybe)
map)
"Keymap used for reading `ack' command and args in minibuffer.")
(ack-default-directory '(16))))
(t (read-directory-name "In directory: " nil nil t))))
+(defun ack-update-minibuffer-prompt (&optional _beg _end _len)
+ (when (minibufferp)
+ (let ((inhibit-read-only t))
+ (save-excursion
+ (goto-char (minibuffer-prompt-end))
+ (when (looking-at "\\(\\w+\\)\\s-")
+ (put-text-property
+ (point-min) (minibuffer-prompt-end)
+ 'display
+ (format "Run %s in `%s': "
+ (match-string-no-properties 1)
+ (file-name-nondirectory
+ (directory-file-name ack--project-root)))))))))
+
+(defun ack-minibuffer-setup-function ()
+ (shell-completion-vars)
+ (add-hook 'after-change-functions
+ #'ack-update-minibuffer-prompt nil t)
+ (ack-update-minibuffer-prompt)
+ (run-hooks 'ack-minibuffer-setup-hook))
+
;;;###autoload
(defun ack (command-args &optional directory)
"Run ack using COMMAND-ARGS and collect output in a buffer.
\\{ack-minibuffer-local-map}"
(interactive
- (let ((project-root (funcall ack-default-directory-function
- current-prefix-arg))
+ (let ((ack--project-root (or (funcall ack-default-directory-function
+ current-prefix-arg)
+ default-directory))
;; Disable completion cycling; see http://debbugs.gnu.org/12221
(completion-cycle-threshold nil))
- (list (minibuffer-with-setup-hook (if (>= emacs-major-version 24)
- 'shell-completion-vars
- 'pcomplete-shell-setup)
- (read-from-minibuffer "Run ack (like this): "
- ack-command ack-minibuffer-local-map
+ (list (minibuffer-with-setup-hook 'ack-minibuffer-setup-function
+ (read-from-minibuffer "Ack: "
+ ack-command
+ ack-minibuffer-local-map
nil 'ack-history))
- project-root)))
+ ack--project-root)))
(let ((default-directory (expand-file-name
(or directory default-directory))))
- (compilation-start command-args 'ack-mode)))
+ ;; Change to the compilation buffer so that `ack-buffer-name-function' can
+ ;; make use of `compilation-arguments'.
+ (with-current-buffer (compilation-start command-args 'ack-mode)
+ (when ack-buffer-name-function
+ (rename-buffer (funcall ack-buffer-name-function "ack"))))))
(provide 'ack)
;;; ack.el ends here