180 lines
6.5 KiB
EmacsLisp
180 lines
6.5 KiB
EmacsLisp
|
;;; rg-header.el --- Header line for rg-mode -*- lexical-binding: t; -*-
|
|||
|
|
|
|||
|
|
;; Copyright (C) 2018 David Landell <david.landell@sunnyhill.email>
|
|||
|
|
;;
|
|||
|
|
;; Author: David Landell <david.landell@sunnyhill.email>
|
|||
|
|
;; URL: https://github.com/dajva/rg.el
|
|||
|
|
|
|||
|
|
;; This file is not part of GNU Emacs.
|
|||
|
|
|
|||
|
|
;; This program is free software; you can redistribute it and/or
|
|||
|
|
;; modify it under the terms of the GNU General Public License
|
|||
|
|
;; as published by the Free Software Foundation; either version 3
|
|||
|
|
;; of the License, or (at your option) any later version.
|
|||
|
|
|
|||
|
|
;; This program is distributed in the hope that it will be useful,
|
|||
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|||
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|||
|
|
;; GNU General Public License for more details.
|
|||
|
|
|
|||
|
|
;; You should have received a copy of the GNU General Public License
|
|||
|
|
;; along with this program; if not, write to the Free Software
|
|||
|
|
;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
|
|||
|
|
;; 02110-1301, USA.
|
|||
|
|
|
|||
|
|
;;; Commentary:
|
|||
|
|
|
|||
|
|
;; Header line format for rg-mode result buffer.
|
|||
|
|
|
|||
|
|
;;; Code:
|
|||
|
|
|
|||
|
|
(require 'mouse)
|
|||
|
|
|
|||
|
|
(declare-function rg-cur-search-pattern "rg-result.el")
|
|||
|
|
|
|||
|
|
|
|||
|
|
;; Customization
|
|||
|
|
(defcustom rg-header-max-search-string-length nil
|
|||
|
|
"The max line length of header line search string item."
|
|||
|
|
:type '(choice (const :tag "Don't truncate" nil)
|
|||
|
|
(number :tag "The max width"))
|
|||
|
|
:group 'rg)
|
|||
|
|
|
|||
|
|
|
|||
|
|
;; Faces
|
|||
|
|
(defface rg-toggle-on-face
|
|||
|
|
'((t :inherit rg-file-tag-face))
|
|||
|
|
"face for toggle \"on\" text in header."
|
|||
|
|
:group 'rg-face)
|
|||
|
|
|
|||
|
|
(defface rg-toggle-off-face
|
|||
|
|
'((t :inherit rg-error-face))
|
|||
|
|
"face for toggle \"off\" text in header."
|
|||
|
|
:group 'rg-face)
|
|||
|
|
|
|||
|
|
(defface rg-literal-face
|
|||
|
|
'((t :inherit rg-filename-face))
|
|||
|
|
"face for literal label in header."
|
|||
|
|
:group 'rg-face)
|
|||
|
|
|
|||
|
|
(defface rg-regexp-face
|
|||
|
|
'((t :inherit compilation-line-number))
|
|||
|
|
"face for regexp label in header."
|
|||
|
|
:group 'rg-face)
|
|||
|
|
|
|||
|
|
|
|||
|
|
;; Defuns
|
|||
|
|
(defun rg-header-render-label (labelform)
|
|||
|
|
"Return a fontified header label.
|
|||
|
|
LABELFORM is either a string to render or a form where the `car' is a
|
|||
|
|
conditional and the two following items are then and else specs.
|
|||
|
|
Specs are lists where the the `car' is the labels string and the
|
|||
|
|
`cadr' is font to use for that string."
|
|||
|
|
(list '(:propertize "[" font-lock-face (header-line bold))
|
|||
|
|
(cond
|
|||
|
|
((stringp labelform)
|
|||
|
|
`(:propertize ,labelform font-lock-face (header-line bold)))
|
|||
|
|
((listp labelform)
|
|||
|
|
(let* ((condition (nth 0 labelform))
|
|||
|
|
(then (nth 1 labelform))
|
|||
|
|
(else (nth 2 labelform)))
|
|||
|
|
`(:eval (if ,condition
|
|||
|
|
(propertize ,(nth 0 then) 'font-lock-face '(,(nth 1 then) header-line bold))
|
|||
|
|
(propertize ,(nth 0 else) 'font-lock-face '(,(nth 1 else) header-line bold))))))
|
|||
|
|
(t (error "Not a string or list")))
|
|||
|
|
'(:propertize "]" font-lock-face (header-line bold))
|
|||
|
|
'(": ")))
|
|||
|
|
|
|||
|
|
(defun rg-header-render-toggle (on)
|
|||
|
|
"Return a fontified toggle symbol.
|
|||
|
|
If ON is non nil, render \"on\" string, otherwise render \"off\"
|
|||
|
|
string."
|
|||
|
|
`(:eval (let* ((on ,on)
|
|||
|
|
(value (if on "on " "off"))
|
|||
|
|
(face (if on 'rg-toggle-on-face 'rg-toggle-off-face)))
|
|||
|
|
(propertize value 'font-lock-face `(bold ,face)))))
|
|||
|
|
|
|||
|
|
(defun rg-header-mouse-action (command help &rest items)
|
|||
|
|
"Add a keymap with mouse click action for COMMAND.
|
|||
|
|
When hoovering HELP is shown as a tooltip. ITEMS is the header line
|
|||
|
|
items that the map will be applied to."
|
|||
|
|
(let ((map (make-sparse-keymap)))
|
|||
|
|
(define-key map
|
|||
|
|
(if (or (> emacs-major-version 30)
|
|||
|
|
(and (= emacs-major-version 30) (>= emacs-minor-version 2)))
|
|||
|
|
[header-line mouse-1]
|
|||
|
|
[header-line mouse-2])
|
|||
|
|
(lambda (click)
|
|||
|
|
(interactive "e")
|
|||
|
|
(mouse-select-window click)
|
|||
|
|
(call-interactively command)))
|
|||
|
|
`(:propertize ,items mouse-face header-line-highlight
|
|||
|
|
help-echo ,help
|
|||
|
|
keymap ,map)))
|
|||
|
|
|
|||
|
|
(defun rg-header-truncate-search-pattern (search)
|
|||
|
|
"Truncate SEARCH if it exceeds `rg-header-max-search-string-length'."
|
|||
|
|
(if (rg-header-truncates-p search)
|
|||
|
|
(truncate-string-to-width search
|
|||
|
|
rg-header-max-search-string-length
|
|||
|
|
0
|
|||
|
|
nil
|
|||
|
|
t)
|
|||
|
|
search))
|
|||
|
|
|
|||
|
|
(defun rg-header-truncates-p (search)
|
|||
|
|
"Verify that SEARCH would be truncated."
|
|||
|
|
(and (numberp rg-header-max-search-string-length)
|
|||
|
|
(< rg-header-max-search-string-length (length search))))
|
|||
|
|
|
|||
|
|
(defun rg-header-search-help ()
|
|||
|
|
"Get the search help for the current buffer."
|
|||
|
|
(let ((pattern (rg-cur-search-pattern)))
|
|||
|
|
|
|||
|
|
(if (rg-header-truncates-p pattern)
|
|||
|
|
(concat "Change search string: " pattern)
|
|||
|
|
"Change search string")))
|
|||
|
|
|
|||
|
|
;; Use full-command here to avoid dependency on rg-search
|
|||
|
|
;; struct. Should be properly fixed.
|
|||
|
|
(defun rg-create-header-line (search full-command)
|
|||
|
|
"Create the header line for SEARCH.
|
|||
|
|
If FULL-COMMAND specifies if the full command line search was done."
|
|||
|
|
(let ((itemspace " "))
|
|||
|
|
(setq header-line-format
|
|||
|
|
(if full-command
|
|||
|
|
(list (rg-header-render-label "command line") "no refinement")
|
|||
|
|
(list
|
|||
|
|
(rg-header-mouse-action
|
|||
|
|
'rg-rerun-toggle-rexexp-literal "Toggle literal/regexp"
|
|||
|
|
(rg-header-render-label `((rg-search-literal ,search)
|
|||
|
|
("literal" rg-literal-face)
|
|||
|
|
("regexp" rg-regexp-face))))
|
|||
|
|
(rg-header-mouse-action
|
|||
|
|
'rg-rerun-change-query (rg-header-search-help)
|
|||
|
|
`(:eval (rg-header-truncate-search-pattern (rg-search-pattern ,search))))
|
|||
|
|
itemspace
|
|||
|
|
(rg-header-render-label "files")
|
|||
|
|
(rg-header-mouse-action
|
|||
|
|
'rg-rerun-change-files "Change file types"
|
|||
|
|
`(:eval (rg-search-files ,search)))
|
|||
|
|
itemspace
|
|||
|
|
(rg-header-render-label "case")
|
|||
|
|
(rg-header-mouse-action
|
|||
|
|
'rg-rerun-toggle-case "Toggle case"
|
|||
|
|
(rg-header-render-toggle
|
|||
|
|
`(not (member "-i" (rg-search-flags ,search)))))
|
|||
|
|
itemspace
|
|||
|
|
(rg-header-render-label "ign")
|
|||
|
|
(rg-header-mouse-action
|
|||
|
|
'rg-rerun-toggle-ignore "Toggle ignore"
|
|||
|
|
(rg-header-render-toggle
|
|||
|
|
`(not (member "--no-ignore" (rg-search-flags ,search)))))
|
|||
|
|
itemspace
|
|||
|
|
(rg-header-render-label "hits")
|
|||
|
|
'(:eval (format "%d" rg-hit-count)))))))
|
|||
|
|
|
|||
|
|
(provide 'rg-header)
|
|||
|
|
|
|||
|
|
;;; rg-header.el ends here
|