--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/mylisp/ag.el Sat Jan 02 00:33:04 2021 +0200
@@ -0,0 +1,144 @@
+;;; ag.el --- Ag frontend
+
+;;; Commentary:
+;;
+
+(defgroup my-ag nil
+ "My own ag search front-end."
+ :prefix "my-ag"
+ :group 'tools
+ :group 'processes)
+
+(defun my-ag-goto ()
+ (interactive)
+ (save-excursion
+ (let ( lineno end )
+ (forward-line 1)
+ (backward-char 1)
+ (setq end (point))
+ (forward-line 0)
+ (if (not (search-forward-regexp "^\\([1-9][0-9]*\\)[:-]" end t))
+ (message "Not at line number...")
+ (setq lineno (string-to-number (match-string 1)))
+ (if (search-backward-regexp "^$" nil t)
+ (forward-char)
+ (goto-char (point-min)))
+ (search-forward-regexp "^.*")
+ (find-file-other-window (match-string 0))
+ (goto-char (point-min))
+ (forward-line (1- lineno))))))
+
+(defun my-ag-kill-process ()
+ (interactive)
+ (let ( (proc (get-buffer-process (current-buffer))) )
+ (if proc
+ (interrupt-process proc)
+ (error "The %s process is not running" (downcase mode-name)))))
+
+(defvar my-ag-mode-map (make-sparse-keymap))
+
+(define-key my-ag-mode-map (kbd "RET") 'my-ag-goto)
+(define-key my-ag-mode-map (kbd "C-c C-k") 'my-ag-kill-process)
+
+(defface my-ag/lineno-face
+ '((t :inherit warning))
+ "Face for line number."
+ :group 'my-ag)
+(defface my-ag/path-face
+ '((t :inherit success))
+ "Face for line number."
+ :group 'my-ag)
+
+(defvar my-ag/keywords
+ '(("^[1-9][0-9]\\{0,5\\}[-:]" . (0 'my-ag/lineno-face))
+ ("^[^:]\\{6\\}.*" . (0 'my-ag/path-face))))
+
+(define-derived-mode my-ag-mode fundamental-mode "Ag"
+ "Major mode for Ag parsing."
+ (setq font-lock-defaults '(my-ag/keywords t nil nil)) ; (font-lock-multiline . t)
+ (use-local-map my-ag-mode-map))
+
+(defvar my-ag/buffer-name "*ag*")
+(defvar my-ag/buffer nil)
+
+(defun my-ag/filter (proc str)
+ (when (buffer-live-p (process-buffer proc))
+ (with-current-buffer (process-buffer proc)
+ (save-excursion
+ (goto-char (process-mark proc))
+ (insert str)
+ (set-marker (process-mark proc) (point)))
+ )))
+
+(defvar my-ag/regex-history nil)
+
+(defun my-ag/setup-buffer (dir)
+ (setq my-ag/buffer (get-buffer-create my-ag/buffer-name))
+ (with-current-buffer my-ag/buffer
+ (setq default-directory dir)
+ (erase-buffer)
+ (my-ag-mode))
+ (display-buffer my-ag/buffer))
+
+(defun my-ag/run (regex &optional args)
+ (let ((default-directory (buffer-local-value 'default-directory my-ag/buffer))
+ (cmd (list "ag" "--group" "--nocolor" "--hidden")))
+ (when args
+ (nconc cmd (split-string args)))
+ (nconc cmd (list "--" regex))
+ (make-process
+ :name "ag"
+ :buffer my-ag/buffer
+ :filter 'my-ag/filter
+ :command cmd)))
+
+(defun my-ag/project-root ()
+ (condition-case err
+ (let ( backend )
+ (setq backend (vc-responsible-backend default-directory))
+ (if backend
+ (vc-call-backend backend 'root default-directory)
+ default-directory))
+ (error default-directory)))
+
+(defun my-ag/read-regex ()
+ (let* ( (def (when my-ag/regex-history (car my-ag/regex-history)))
+ (part (when def (if (< (length def) 20)
+ def
+ (concat (substring def 0 20) "...")))) )
+ (read-string
+ (if part (format "Regex [%s]: " part) "Regex: ")
+ "" 'my-ag/regex-history def t)))
+
+(defvar my-ag/extra-history nil)
+
+(defun my-ag/read-extra ()
+ (let* ( (def (when my-ag/extra-history (car my-ag/extra-history)))
+ (part (when def (if (< (length def) 20)
+ def
+ (concat (substring def 0 20) "...")))) )
+ (read-string
+ (if part (format "Extra args [%s]: " part) "Extra args: ")
+ "" 'my-ag/extra-history def t)))
+
+;;;###autoload
+(defun my-ag (regex &optional args)
+ "Search in 'ag' recursively from VCS root directory and fall to
+current directory if VCS root is not defined."
+ (interactive (if (equal current-prefix-arg '(16))
+ (list (my-ag/read-regex) (my-ag/read-extra))
+ (list (my-ag/read-regex))))
+ (my-ag/setup-buffer (if current-prefix-arg default-directory (my-ag/project-root)))
+ (my-ag/run regex args))
+
+;;;###autoload
+(defun my-ag-default-directory (regex)
+ "Search in 'ag' recursively from current directory."
+ (interactive (list (my-ag/read-regex)))
+ (my-ag/setup-buffer default-directory)
+ (my-ag/run regex))
+
+
+(provide 'ag)
+
+;;; ag.el ends here