update sublime, emac

This commit is contained in:
2026-01-05 13:05:43 -05:00
parent a3c66044ec
commit 3e83361c0a
24 changed files with 4466 additions and 1610 deletions

View File

@@ -86,6 +86,28 @@
"Return non-nil if current directory is in a Git repository."
(simple-git--root))
;;; ============================================================================
;;; Mouse Support
;;; ============================================================================
(defface simple-git-highlight-face
'((t :inherit highlight))
"Face for mouse hover on clickable items.")
(defun simple-git-mouse-action (event)
"Perform default action at mouse click EVENT."
(interactive "e")
(mouse-set-point event)
(let ((cmd (lookup-key (current-local-map) (kbd "RET"))))
(when cmd
(call-interactively cmd))))
(defun simple-git-mouse-visit-file (event)
"Visit file at mouse click EVENT."
(interactive "e")
(mouse-set-point event)
(simple-git-visit-file))
;;; ============================================================================
;;; Status Mode
;;; ============================================================================
@@ -102,14 +124,16 @@
(define-key map (kbd "P") #'simple-git-push)
(define-key map (kbd "F") #'simple-git-pull)
(define-key map (kbd "b") #'simple-git-switch-branch)
(define-key map (kbd "B") #'simple-git-branch-graph)
(define-key map (kbd "G") #'simple-git-branch-graph)
(define-key map (kbd "l") #'simple-git-log)
(define-key map (kbd "d") #'simple-git-diff-file)
(define-key map (kbd "v") #'simple-git-visit-file)
(define-key map (kbd "m") #'simple-git-merge)
(define-key map (kbd "q") #'quit-window)
(define-key map (kbd "RET") #'simple-git-visit-file)
(define-key map (kbd "RET") #'simple-git-diff-file)
(define-key map (kbd "n") #'next-line)
(define-key map (kbd "p") #'previous-line)
(define-key map [mouse-1] #'simple-git-mouse-action)
(define-key map [C-mouse-1] #'simple-git-mouse-visit-file)
map)
"Keymap for `simple-git-status-mode'.")
@@ -189,6 +213,8 @@
"\n\n")
;; Help
(insert "Commands: ")
(insert (propertize "RET" 'face 'font-lock-keyword-face) " diff ")
(insert (propertize "v" 'face 'font-lock-keyword-face) "iew file ")
(insert (propertize "s" 'face 'font-lock-keyword-face) "tage ")
(insert (propertize "u" 'face 'font-lock-keyword-face) "nstage ")
(insert (propertize "S" 'face 'font-lock-keyword-face) "tage-all ")
@@ -197,9 +223,8 @@
(insert (propertize "P" 'face 'font-lock-keyword-face) "ush ")
(insert (propertize "F" 'face 'font-lock-keyword-face) "etch/pull ")
(insert (propertize "b" 'face 'font-lock-keyword-face) "ranch ")
(insert (propertize "B" 'face 'font-lock-keyword-face) "ranch-graph ")
(insert (propertize "G" 'face 'font-lock-keyword-face) "raph ")
(insert (propertize "l" 'face 'font-lock-keyword-face) "og ")
(insert (propertize "d" 'face 'font-lock-keyword-face) "iff ")
(insert (propertize "m" 'face 'font-lock-keyword-face) "erge ")
(insert (propertize "r" 'face 'font-lock-keyword-face) "evert ")
(insert (propertize "g" 'face 'font-lock-keyword-face) " refresh ")
@@ -216,8 +241,9 @@
'face 'simple-git-staged-face)
(propertize (car item) 'face 'simple-git-staged-face)
"\n")
(put-text-property line-start (point) 'simple-git-file (car item))
(put-text-property line-start (point) 'simple-git-staged t)))
(put-text-property line-start (1- (point)) 'simple-git-file (car item))
(put-text-property line-start (1- (point)) 'simple-git-staged t)
(put-text-property line-start (1- (point)) 'mouse-face 'simple-git-highlight-face)))
(insert " (none)\n")))
(insert "\n")
;; Unstaged files
@@ -231,9 +257,10 @@
'face 'simple-git-unstaged-face)
(propertize (car item) 'face 'simple-git-unstaged-face)
"\n")
(put-text-property line-start (point) 'simple-git-file (car item))
(put-text-property line-start (point) 'simple-git-staged nil)
(put-text-property line-start (point) 'simple-git-unstaged t)))
(put-text-property line-start (1- (point)) 'simple-git-file (car item))
(put-text-property line-start (1- (point)) 'simple-git-staged nil)
(put-text-property line-start (1- (point)) 'simple-git-unstaged t)
(put-text-property line-start (1- (point)) 'mouse-face 'simple-git-highlight-face)))
(insert " (none)\n")))
(insert "\n")
;; Untracked files
@@ -245,8 +272,9 @@
(let ((line-start (point)))
(insert " " (propertize file 'face 'simple-git-untracked-face)
"\n")
(put-text-property line-start (point) 'simple-git-file file)
(put-text-property line-start (point) 'simple-git-untracked t)))
(put-text-property line-start (1- (point)) 'simple-git-file file)
(put-text-property line-start (1- (point)) 'simple-git-untracked t)
(put-text-property line-start (1- (point)) 'mouse-face 'simple-git-highlight-face)))
(insert " (none)\n")))
(goto-char (min pos (point-max))))))
@@ -501,9 +529,12 @@
(let ((map (make-sparse-keymap)))
(define-key map (kbd "RET") #'simple-git-log-show-commit)
(define-key map (kbd "q") #'quit-window)
(define-key map (kbd "n") #'next-line)
(define-key map (kbd "p") #'previous-line)
(define-key map (kbd "g") #'simple-git-log-refresh)
(define-key map (kbd "n") #'simple-git-log-next-page)
(define-key map (kbd "p") #'simple-git-log-prev-page)
(define-key map (kbd "N") #'simple-git-log-last-page)
(define-key map (kbd "P") #'simple-git-log-first-page)
(define-key map [mouse-1] #'simple-git-mouse-action)
map)
"Keymap for `simple-git-log-mode'.")
@@ -513,7 +544,17 @@
(setq truncate-lines t))
(defvar simple-git-log-count 50
"Number of commits to show in log.")
"Number of commits to show per page in log.")
(defvar-local simple-git--log-page 0
"Current page number in log view.")
(defvar-local simple-git--log-total-commits nil
"Total number of commits in log.")
(defun simple-git--get-total-commits ()
"Get total number of commits in repository."
(string-to-number (string-trim (simple-git--run "rev-list" "--count" "HEAD"))))
(defun simple-git-log-refresh ()
"Refresh the log buffer."
@@ -521,35 +562,80 @@
(when (eq major-mode 'simple-git-log-mode)
(let ((inhibit-read-only t)
(pos (point))
(default-directory (simple-git--root)))
(erase-buffer)
(insert (propertize "Commit History" 'face 'simple-git-header-face) "\n")
(insert "Commands: "
(propertize "RET" 'face 'font-lock-keyword-face) " show commit "
(propertize "g" 'face 'font-lock-keyword-face) " refresh "
(propertize "q" 'face 'font-lock-keyword-face) "uit\n\n")
(let ((output (simple-git--run "log"
(format "-n%d" simple-git-log-count)
"--pretty=format:%h|%an|%ar|%s")))
(dolist (line (split-string output "\n" t))
(let* ((parts (split-string line "|"))
(hash (nth 0 parts))
(author (nth 1 parts))
(date (nth 2 parts))
(subject (nth 3 parts)))
(insert (propertize hash 'face 'simple-git-commit-hash-face
'simple-git-commit hash)
" "
(propertize (format "%-20s" (truncate-string-to-width (or author "") 20))
'face 'simple-git-commit-author-face)
" "
(propertize (format "%-15s" (truncate-string-to-width (or date "") 15))
'face 'simple-git-commit-date-face)
" "
(or subject "")
"\n"))))
(default-directory (simple-git--root))
(skip (* simple-git--log-page simple-git-log-count)))
;; Get total commits if not cached
(unless simple-git--log-total-commits
(setq simple-git--log-total-commits (simple-git--get-total-commits)))
(let ((max-page (max 0 (1- (ceiling (/ (float simple-git--log-total-commits) simple-git-log-count))))))
;; Cap page number
(when (> simple-git--log-page max-page)
(setq simple-git--log-page max-page)
(setq skip (* simple-git--log-page simple-git-log-count)))
(erase-buffer)
(insert (propertize "Commit History" 'face 'simple-git-header-face)
(format " (page %d/%d)" (1+ simple-git--log-page) (1+ max-page))
"\n")
(insert "Commands: "
(propertize "RET" 'face 'font-lock-keyword-face) " show commit "
(propertize "n" 'face 'font-lock-keyword-face) "ext page "
(propertize "p" 'face 'font-lock-keyword-face) "rev page "
(propertize "N" 'face 'font-lock-keyword-face) " last "
(propertize "P" 'face 'font-lock-keyword-face) " first "
(propertize "g" 'face 'font-lock-keyword-face) " refresh "
(propertize "q" 'face 'font-lock-keyword-face) "uit\n\n")
(let ((output (simple-git--run "log"
(format "--skip=%d" skip)
(format "-n%d" simple-git-log-count)
"--pretty=format:%h|%an|%ar|%s")))
(dolist (line (split-string output "\n" t))
(let* ((parts (split-string line "|"))
(hash (nth 0 parts))
(author (nth 1 parts))
(date (nth 2 parts))
(subject (nth 3 parts))
(line-start (point)))
(insert (propertize hash 'face 'simple-git-commit-hash-face
'simple-git-commit hash)
" "
(propertize (format "%-20s" (truncate-string-to-width (or author "") 20))
'face 'simple-git-commit-author-face)
" "
(propertize (format "%-15s" (truncate-string-to-width (or date "") 15))
'face 'simple-git-commit-date-face)
" "
(or subject "")
"\n")
(put-text-property line-start (1- (point)) 'mouse-face 'simple-git-highlight-face)))))
(goto-char (min pos (point-max))))))
(defun simple-git-log-next-page ()
"Go to next page of log."
(interactive)
(setq simple-git--log-page (1+ simple-git--log-page))
(simple-git-log-refresh))
(defun simple-git-log-prev-page ()
"Go to previous page of log."
(interactive)
(when (> simple-git--log-page 0)
(setq simple-git--log-page (1- simple-git--log-page))
(simple-git-log-refresh)))
(defun simple-git-log-first-page ()
"Go to first page of log."
(interactive)
(setq simple-git--log-page 0)
(simple-git-log-refresh))
(defun simple-git-log-last-page ()
"Go to last page of log."
(interactive)
(unless simple-git--log-total-commits
(setq simple-git--log-total-commits (simple-git--get-total-commits)))
(setq simple-git--log-page (max 0 (1- (ceiling (/ (float simple-git--log-total-commits) simple-git-log-count)))))
(simple-git-log-refresh))
(defun simple-git--commit-at-point ()
"Get the commit hash at point."
(get-text-property (line-beginning-position) 'simple-git-commit))
@@ -565,6 +651,7 @@
(define-key map (kbd "q") #'quit-window)
(define-key map (kbd "n") #'next-line)
(define-key map (kbd "p") #'previous-line)
(define-key map [mouse-1] #'simple-git-mouse-action)
map)
"Keymap for `simple-git-commit-detail-mode'.")
@@ -623,8 +710,9 @@
("D" 'simple-git-unstaged-face)
(_ 'simple-git-untracked-face)))
file "\n")
(put-text-property line-start (point) 'simple-git-commit-file file)
(put-text-property line-start (point) 'simple-git-commit-hash hash))))))))
(put-text-property line-start (1- (point)) 'simple-git-commit-file file)
(put-text-property line-start (1- (point)) 'simple-git-commit-hash hash)
(put-text-property line-start (1- (point)) 'mouse-face 'simple-git-highlight-face))))))))
(simple-git-commit-detail-mode)
(goto-char (point-min)))
(display-buffer buf))))
@@ -728,10 +816,13 @@
(define-key map (kbd "RET") #'simple-git-file-history-show-diff)
(define-key map (kbd "v") #'simple-git-file-history-view-file)
(define-key map (kbd "c") #'simple-git-file-history-show-commit)
(define-key map (kbd "n") #'simple-git-file-history-next-page)
(define-key map (kbd "p") #'simple-git-file-history-prev-page)
(define-key map (kbd "N") #'simple-git-file-history-last-page)
(define-key map (kbd "P") #'simple-git-file-history-first-page)
(define-key map (kbd "q") #'quit-window)
(define-key map (kbd "n") #'next-line)
(define-key map (kbd "p") #'previous-line)
(define-key map (kbd "g") #'simple-git-file-history-refresh)
(define-key map [mouse-1] #'simple-git-mouse-action)
map)
"Keymap for `simple-git-file-history-mode'.")
@@ -746,6 +837,16 @@
(defvar-local simple-git--file-history-root nil
"The git root for file history mode.")
(defvar-local simple-git--file-history-page 0
"Current page number in file history view.")
(defvar-local simple-git--file-history-total-commits nil
"Total number of commits for file.")
(defun simple-git--get-file-total-commits (file)
"Get total number of commits for FILE."
(string-to-number (string-trim (simple-git--run "rev-list" "--count" "--follow" "HEAD" "--" file))))
(defun simple-git-file-history-refresh ()
"Refresh the file history buffer."
(interactive)
@@ -753,23 +854,40 @@
(let ((inhibit-read-only t)
(pos (point))
(file simple-git--file-history-file)
(root simple-git--file-history-root))
(erase-buffer)
(insert (propertize "File History" 'face 'simple-git-header-face) "\n")
(insert (propertize "File: " 'face 'simple-git-header-face)
file "\n\n")
(insert "Commands: "
(propertize "RET" 'face 'font-lock-keyword-face) " show diff "
(propertize "v" 'face 'font-lock-keyword-face) "iew file at this point "
(propertize "c" 'face 'font-lock-keyword-face) "ommit view "
(propertize "g" 'face 'font-lock-keyword-face) " refresh "
(propertize "q" 'face 'font-lock-keyword-face) "uit\n\n")
;; Get log with file names to track renames
(let* ((default-directory root)
(output (simple-git--run "log" "--follow" "--name-status"
(format "-n%d" simple-git-log-count)
"--pretty=format:%h|%an|%ar|%s"
"--" file))
(root simple-git--file-history-root)
(skip (* simple-git--file-history-page simple-git-log-count)))
;; Get total commits if not cached
(let ((default-directory root))
(unless simple-git--file-history-total-commits
(setq simple-git--file-history-total-commits (simple-git--get-file-total-commits file))))
(let ((max-page (max 0 (1- (ceiling (/ (float simple-git--file-history-total-commits) simple-git-log-count))))))
;; Cap page number
(when (> simple-git--file-history-page max-page)
(setq simple-git--file-history-page max-page)
(setq skip (* simple-git--file-history-page simple-git-log-count)))
(erase-buffer)
(insert (propertize "File History" 'face 'simple-git-header-face)
(format " (page %d/%d)" (1+ simple-git--file-history-page) (1+ max-page))
"\n")
(insert (propertize "File: " 'face 'simple-git-header-face)
file "\n\n")
(insert "Commands: "
(propertize "RET" 'face 'font-lock-keyword-face) " show diff "
(propertize "v" 'face 'font-lock-keyword-face) "iew file at this point "
(propertize "c" 'face 'font-lock-keyword-face) "ommit view "
(propertize "n" 'face 'font-lock-keyword-face) "ext page "
(propertize "p" 'face 'font-lock-keyword-face) "rev page "
(propertize "N" 'face 'font-lock-keyword-face) " last "
(propertize "P" 'face 'font-lock-keyword-face) " first "
(propertize "g" 'face 'font-lock-keyword-face) " refresh "
(propertize "q" 'face 'font-lock-keyword-face) "uit\n\n")
;; Get log with file names to track renames
(let* ((default-directory root)
(output (simple-git--run "log" "--follow" "--name-status"
(format "--skip=%d" skip)
(format "-n%d" simple-git-log-count)
"--pretty=format:%h|%an|%ar|%s"
"--" file))
(lines (split-string output "\n"))
(current-file file))
;; Parse output - each commit has format line, then blank, then file status
@@ -807,9 +925,10 @@
" "
(or subject "")
"\n")
(put-text-property line-start (point) 'simple-git-commit-hash hash)
(put-text-property line-start (point) 'simple-git-commit-file file-at-commit)))))
(setq i (1+ i)))))
(put-text-property line-start (1- (point)) 'simple-git-commit-hash hash)
(put-text-property line-start (1- (point)) 'simple-git-commit-file file-at-commit)
(put-text-property line-start (1- (point)) 'mouse-face 'simple-git-highlight-face)))))
(setq i (1+ i))))))
(goto-char (min pos (point-max))))))
(defun simple-git-file-history-show-diff ()
@@ -911,14 +1030,45 @@
("D" 'simple-git-unstaged-face)
(_ 'simple-git-untracked-face)))
file "\n")
(put-text-property line-start (point) 'simple-git-commit-file file)
(put-text-property line-start (point) 'simple-git-commit-hash hash)))))))))
(put-text-property line-start (1- (point)) 'simple-git-commit-file file)
(put-text-property line-start (1- (point)) 'simple-git-commit-hash hash)
(put-text-property line-start (1- (point)) 'mouse-face 'simple-git-highlight-face)))))))))
(with-current-buffer buf
(simple-git-commit-detail-mode)
(goto-char (point-min)))
(display-buffer buf))
(message "No commit at point"))))
(defun simple-git-file-history-next-page ()
"Go to next page of file history."
(interactive)
(setq simple-git--file-history-page (1+ simple-git--file-history-page))
(simple-git-file-history-refresh))
(defun simple-git-file-history-prev-page ()
"Go to previous page of file history."
(interactive)
(when (> simple-git--file-history-page 0)
(setq simple-git--file-history-page (1- simple-git--file-history-page))
(simple-git-file-history-refresh)))
(defun simple-git-file-history-first-page ()
"Go to first page of file history."
(interactive)
(setq simple-git--file-history-page 0)
(simple-git-file-history-refresh))
(defun simple-git-file-history-last-page ()
"Go to last page of file history."
(interactive)
(let ((default-directory simple-git--file-history-root))
(unless simple-git--file-history-total-commits
(setq simple-git--file-history-total-commits
(simple-git--get-file-total-commits simple-git--file-history-file))))
(setq simple-git--file-history-page
(max 0 (1- (ceiling (/ (float simple-git--file-history-total-commits) simple-git-log-count)))))
(simple-git-file-history-refresh))
;;;###autoload
(defun simple-git-file-history ()
"Show commit history for the current file."
@@ -934,9 +1084,252 @@
(simple-git-file-history-mode)
(setq simple-git--file-history-file file)
(setq simple-git--file-history-root root)
(setq simple-git--file-history-page 0)
(simple-git-file-history-refresh))
(pop-to-buffer buf)))
;;; ============================================================================
;;; Line Blame Mode
;;; ============================================================================
(defvar simple-git-line-blame-mode-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "RET") #'simple-git-line-blame-show-diff)
(define-key map (kbd "v") #'simple-git-line-blame-view-file)
(define-key map (kbd "c") #'simple-git-line-blame-show-commit)
(define-key map (kbd "q") #'quit-window)
(define-key map (kbd "n") #'next-line)
(define-key map (kbd "p") #'previous-line)
(define-key map [mouse-1] #'simple-git-mouse-action)
map)
"Keymap for `simple-git-line-blame-mode'.")
(define-derived-mode simple-git-line-blame-mode special-mode "SimpleGit:LineBlame"
"Major mode for viewing line blame history."
(setq buffer-read-only t)
(setq truncate-lines t))
(defvar-local simple-git--line-blame-file nil
"The file being viewed in line blame mode.")
(defvar-local simple-git--line-blame-root nil
"The git root for line blame mode.")
(defvar-local simple-git--line-blame-line nil
"The line number being blamed.")
(defun simple-git--get-line-history (file line root)
"Get history of commits that modified LINE in FILE.
Returns list of (hash author date subject file-at-commit)."
(let* ((default-directory root)
(results '())
(current-file file)
(current-line line)
(seen-hashes (make-hash-table :test 'equal))
(iterations 0)
(max-iterations 50))
;; Iteratively trace the line back through history
(while (and current-file current-line (< iterations max-iterations))
(let* ((blame-output (simple-git--run "blame" "-L" (format "%d,%d" current-line current-line)
"--porcelain" "-w" current-file)))
(if (string-match "^\\([a-f0-9]+\\)" blame-output)
(let ((hash (match-string 1 blame-output)))
(if (or (string-prefix-p "00000000" hash)
(gethash hash seen-hashes))
;; Uncommitted or already seen - stop
(setq current-file nil)
;; New commit found
(puthash hash t seen-hashes)
(let* ((info (simple-git--run "show" "--no-patch"
"--format=%h|%an|%ar|%s" hash))
(parts (split-string (car (split-string info "\n")) "|"))
(short-hash (nth 0 parts))
(author (nth 1 parts))
(date (nth 2 parts))
(subject (nth 3 parts)))
(push (list short-hash author date subject current-file hash) results))
;; Find parent commit and line number
(let* ((parent-output (simple-git--run "rev-parse" (concat hash "^")))
(parent (string-trim parent-output)))
(if (or (string-empty-p parent) (string-prefix-p "fatal:" parent))
(setq current-file nil)
;; Try to find the line in parent
(let ((blame-parent (simple-git--run "blame" "-L" (format "%d,%d" current-line current-line)
"--porcelain" "-w" parent "--" current-file)))
(if (string-match "^\\([a-f0-9]+\\)" blame-parent)
;; Line exists in parent, continue tracing
nil
;; Line doesn't exist in parent with same number, stop
(setq current-file nil)))))))
;; No blame output - stop
(setq current-file nil)))
(setq iterations (1+ iterations)))
(nreverse results)))
(defun simple-git-line-blame-refresh ()
"Refresh the line blame buffer."
(let ((inhibit-read-only t)
(file simple-git--line-blame-file)
(root simple-git--line-blame-root)
(line simple-git--line-blame-line))
(erase-buffer)
(insert (propertize "Line History (Blame)" 'face 'simple-git-header-face) "\n")
(insert (propertize "File: " 'face 'simple-git-header-face) file "\n")
(insert (propertize "Line: " 'face 'simple-git-header-face) (number-to-string line) "\n\n")
(insert "Commands: "
(propertize "RET" 'face 'font-lock-keyword-face) " show diff "
(propertize "v" 'face 'font-lock-keyword-face) "iew file at this point "
(propertize "c" 'face 'font-lock-keyword-face) "ommit view "
(propertize "q" 'face 'font-lock-keyword-face) "uit\n\n")
(let ((history (simple-git--get-line-history file line root)))
(if history
(dolist (entry history)
(let* ((hash (nth 0 entry))
(author (nth 1 entry))
(date (nth 2 entry))
(subject (nth 3 entry))
(file-at-commit (nth 4 entry))
(full-hash (nth 5 entry))
(line-start (point)))
(insert (propertize hash 'face 'simple-git-commit-hash-face)
" "
(propertize (format "%-20s" (truncate-string-to-width (or author "") 20))
'face 'simple-git-commit-author-face)
" "
(propertize (format "%-15s" (truncate-string-to-width (or date "") 15))
'face 'simple-git-commit-date-face)
" "
(or subject "")
"\n")
(put-text-property line-start (1- (point)) 'simple-git-commit-hash full-hash)
(put-text-property line-start (1- (point)) 'simple-git-commit-file file-at-commit)
(put-text-property line-start (1- (point)) 'mouse-face 'simple-git-highlight-face)))
(insert " (no history found)\n")))
(goto-char (point-min))))
(defun simple-git-line-blame-show-diff ()
"Show diff for commit at point."
(interactive)
(let* ((hash (get-text-property (line-beginning-position) 'simple-git-commit-hash))
(file (get-text-property (line-beginning-position) 'simple-git-commit-file))
(root simple-git--line-blame-root)
(return-buf (current-buffer)))
(if (and hash file)
(let ((buf (get-buffer-create "*simple-git-diff*")))
(with-current-buffer buf
(let ((inhibit-read-only t)
(default-directory root))
(erase-buffer)
(call-process "git" nil t nil "show" "--format=" hash "--" file)
(goto-char (point-min))
(simple-git-diff-mode)
(setq simple-git--diff-return-buffer return-buf)))
(display-buffer buf))
(message "No commit at point"))))
(defun simple-git-line-blame-view-file ()
"View file at commit at point."
(interactive)
(let* ((hash (get-text-property (line-beginning-position) 'simple-git-commit-hash))
(file (get-text-property (line-beginning-position) 'simple-git-commit-file))
(root simple-git--line-blame-root))
(if (and hash file)
(let* ((buf-name (format "*simple-git:%s@%s*" (file-name-nondirectory file) (substring hash 0 7)))
(buf (get-buffer-create buf-name)))
(with-current-buffer buf
(let ((inhibit-read-only t)
(default-directory root))
(erase-buffer)
(call-process "git" nil t nil "show" (concat hash ":" file))
(goto-char (point-min))
(let ((mode (assoc-default file auto-mode-alist 'string-match)))
(when mode (funcall mode)))
(setq buffer-read-only t)))
(let ((main-window (or (seq-find (lambda (w)
(not (window-parameter w 'window-side)))
(window-list))
(selected-window))))
(select-window main-window)
(switch-to-buffer buf)))
(message "No commit at point"))))
(defun simple-git-line-blame-show-commit ()
"Show full commit details for commit at point."
(interactive)
(let* ((hash (get-text-property (line-beginning-position) 'simple-git-commit-hash))
(root simple-git--line-blame-root))
(if hash
(let ((buf (get-buffer-create "*simple-git-commit-detail*")))
(with-current-buffer buf
(let ((inhibit-read-only t)
(default-directory root))
(erase-buffer)
(let* ((info (simple-git--run "show" "--no-patch"
"--format=%h%n%an%n%ar%n%s%n%b" hash))
(lines (split-string info "\n"))
(short-hash (nth 0 lines))
(author (nth 1 lines))
(date (nth 2 lines))
(subject (nth 3 lines))
(body (string-trim (mapconcat #'identity (nthcdr 4 lines) "\n"))))
(insert (propertize "Commit: " 'face 'simple-git-header-face)
(propertize short-hash 'face 'simple-git-commit-hash-face) "\n")
(insert (propertize "Author: " 'face 'simple-git-header-face)
(propertize author 'face 'simple-git-commit-author-face) "\n")
(insert (propertize "Date: " 'face 'simple-git-header-face)
(propertize date 'face 'simple-git-commit-date-face) "\n\n")
(insert (propertize subject 'face 'bold) "\n")
(when (not (string-empty-p body))
(insert "\n" body "\n"))
(insert "\n")
(insert "Commands: "
(propertize "RET" 'face 'font-lock-keyword-face) " show diff "
(propertize "v" 'face 'font-lock-keyword-face) "iew file at this point "
(propertize "q" 'face 'font-lock-keyword-face) "uit\n\n")
(let* ((files-output (simple-git--run "show" "--name-status" "--format=" hash))
(file-lines (split-string files-output "\n" t)))
(insert (propertize "Changed files:\n" 'face 'simple-git-header-face))
(dolist (file-line file-lines)
(when (string-match "^\\([AMDRT]\\)\t\\(.+\\)$" file-line)
(let ((status (match-string 1 file-line))
(file (match-string 2 file-line)))
(let ((line-start (point)))
(insert " "
(propertize (format "[%s] " status)
'face (pcase status
("A" 'simple-git-staged-face)
("D" 'simple-git-unstaged-face)
(_ 'simple-git-untracked-face)))
file "\n")
(put-text-property line-start (1- (point)) 'simple-git-commit-file file)
(put-text-property line-start (1- (point)) 'simple-git-commit-hash hash)
(put-text-property line-start (1- (point)) 'mouse-face 'simple-git-highlight-face)))))))))
(with-current-buffer buf
(simple-git-commit-detail-mode)
(goto-char (point-min)))
(display-buffer buf))
(message "No commit at point"))))
;;;###autoload
(defun simple-git-line-blame ()
"Show blame history for the current line."
(interactive)
(unless (simple-git--in-repo-p)
(user-error "Not in a Git repository"))
(unless buffer-file-name
(user-error "Buffer is not visiting a file"))
(let* ((root (simple-git--root))
(file (file-relative-name buffer-file-name root))
(line (line-number-at-pos))
(buf (get-buffer-create (format "*simple-git-blame:%s:%d*" (file-name-nondirectory file) line))))
(with-current-buffer buf
(simple-git-line-blame-mode)
(setq simple-git--line-blame-file file)
(setq simple-git--line-blame-root root)
(setq simple-git--line-blame-line line)
(simple-git-line-blame-refresh))
(pop-to-buffer buf)))
;;; ============================================================================
;;; Branch Graph Mode
;;; ============================================================================
@@ -945,9 +1338,12 @@
(let ((map (make-sparse-keymap)))
(define-key map (kbd "RET") #'simple-git-branch-graph-show-commit)
(define-key map (kbd "q") #'quit-window)
(define-key map (kbd "n") #'next-line)
(define-key map (kbd "p") #'previous-line)
(define-key map (kbd "g") #'simple-git-branch-graph-refresh)
(define-key map (kbd "n") #'simple-git-branch-graph-next-page)
(define-key map (kbd "p") #'simple-git-branch-graph-prev-page)
(define-key map (kbd "N") #'simple-git-branch-graph-last-page)
(define-key map (kbd "P") #'simple-git-branch-graph-first-page)
(define-key map [mouse-1] #'simple-git-mouse-action)
map)
"Keymap for `simple-git-branch-graph-mode'.")
@@ -956,6 +1352,12 @@
(setq buffer-read-only t)
(setq truncate-lines t))
(defvar-local simple-git--graph-page 0
"Current page number in graph view.")
(defvar-local simple-git--graph-total-commits nil
"Total number of commits in graph.")
(defface simple-git-graph-branch-1
'((t :foreground "#e06c75"))
"Face for branch 1 in graph.")
@@ -1014,24 +1416,44 @@
(setq i (1+ i)))
result))
(defun simple-git--get-all-commits-count ()
"Get total number of commits across all branches."
(string-to-number (string-trim (simple-git--run "rev-list" "--count" "--all"))))
(defun simple-git-branch-graph-refresh ()
"Refresh the branch graph buffer."
(interactive)
(when (eq major-mode 'simple-git-branch-graph-mode)
(let ((inhibit-read-only t)
(pos (point))
(default-directory (simple-git--root)))
(erase-buffer)
(insert (propertize "Branch Graph" 'face 'simple-git-header-face) "\n\n")
(insert "Commands: "
(propertize "RET" 'face 'font-lock-keyword-face) " show commit "
(propertize "g" 'face 'font-lock-keyword-face) " refresh "
(propertize "q" 'face 'font-lock-keyword-face) "uit\n\n")
;; Get graph with commit info
(let* ((output (simple-git--run "log" "--all" "--graph"
(format "-n%d" simple-git-branch-graph-count)
"--pretty=format:%h|%an|%ar|%s|%d"))
(lines (split-string output "\n")))
(default-directory (simple-git--root))
(skip (* simple-git--graph-page simple-git-branch-graph-count)))
;; Get total commits if not cached
(unless simple-git--graph-total-commits
(setq simple-git--graph-total-commits (simple-git--get-all-commits-count)))
(let ((max-page (max 0 (1- (ceiling (/ (float simple-git--graph-total-commits) simple-git-branch-graph-count))))))
;; Cap page number
(when (> simple-git--graph-page max-page)
(setq simple-git--graph-page max-page)
(setq skip (* simple-git--graph-page simple-git-branch-graph-count)))
(erase-buffer)
(insert (propertize "Branch Graph" 'face 'simple-git-header-face)
(format " (page %d/%d)" (1+ simple-git--graph-page) (1+ max-page))
"\n\n")
(insert "Commands: "
(propertize "RET" 'face 'font-lock-keyword-face) " show commit "
(propertize "n" 'face 'font-lock-keyword-face) "ext page "
(propertize "p" 'face 'font-lock-keyword-face) "rev page "
(propertize "N" 'face 'font-lock-keyword-face) " last "
(propertize "P" 'face 'font-lock-keyword-face) " first "
(propertize "g" 'face 'font-lock-keyword-face) " refresh "
(propertize "q" 'face 'font-lock-keyword-face) "uit\n\n")
;; Get graph with commit info
(let* ((output (simple-git--run "log" "--all" "--graph"
(format "--skip=%d" skip)
(format "-n%d" simple-git-branch-graph-count)
"--pretty=format:%h|%an|%ar|%s|%d"))
(lines (split-string output "\n")))
(dolist (line lines)
(if (string-match "^\\([*| /\\\\]+\\)\\([a-f0-9]+\\)|\\([^|]*\\)|\\([^|]*\\)|\\([^|]*\\)|\\(.*\\)$" line)
;; Line with commit info
@@ -1050,12 +1472,41 @@
(insert (propertize (truncate-string-to-width (or author "") 15)
'face 'simple-git-commit-author-face) " ")
(insert (or subject "") "\n")
(put-text-property line-start (point) 'simple-git-commit-hash hash))
(put-text-property line-start (1- (point)) 'simple-git-commit-hash hash)
(put-text-property line-start (1- (point)) 'mouse-face 'simple-git-highlight-face))
;; Graph-only line (no commit)
(when (string-match "^\\([*| /\\\\]+\\)$" line)
(insert (simple-git--colorize-graph (match-string 1 line)) "\n")))))
(insert (simple-git--colorize-graph (match-string 1 line)) "\n"))))))
(goto-char (min pos (point-max))))))
(defun simple-git-branch-graph-next-page ()
"Go to next page of graph."
(interactive)
(setq simple-git--graph-page (1+ simple-git--graph-page))
(simple-git-branch-graph-refresh))
(defun simple-git-branch-graph-prev-page ()
"Go to previous page of graph."
(interactive)
(when (> simple-git--graph-page 0)
(setq simple-git--graph-page (1- simple-git--graph-page))
(simple-git-branch-graph-refresh)))
(defun simple-git-branch-graph-first-page ()
"Go to first page of graph."
(interactive)
(setq simple-git--graph-page 0)
(simple-git-branch-graph-refresh))
(defun simple-git-branch-graph-last-page ()
"Go to last page of graph."
(interactive)
(unless simple-git--graph-total-commits
(setq simple-git--graph-total-commits (simple-git--get-all-commits-count)))
(setq simple-git--graph-page
(max 0 (1- (ceiling (/ (float simple-git--graph-total-commits) simple-git-branch-graph-count)))))
(simple-git-branch-graph-refresh))
(defun simple-git-branch-graph-show-commit ()
"Show commit details for commit at point."
(interactive)
@@ -1106,8 +1557,9 @@
("D" 'simple-git-unstaged-face)
(_ 'simple-git-untracked-face)))
file "\n")
(put-text-property line-start (point) 'simple-git-commit-file file)
(put-text-property line-start (point) 'simple-git-commit-hash hash)))))))))
(put-text-property line-start (1- (point)) 'simple-git-commit-file file)
(put-text-property line-start (1- (point)) 'simple-git-commit-hash hash)
(put-text-property line-start (1- (point)) 'mouse-face 'simple-git-highlight-face)))))))))
(with-current-buffer buf
(simple-git-commit-detail-mode)
(goto-char (point-min)))

View File

@@ -1,731 +0,0 @@
;;; xah-find.el --- find replace in pure emacs lisp. Purpose similar to grep/sed. -*- coding: utf-8; lexical-binding: t; -*-
;; Copyright © 2012-2021 by Xah Lee
;; Author: Xah Lee ( http://xahlee.info/ )
;; Version: 5.4.20211014135145
;; Created: 02 April 2012
;; Package-Requires: ((emacs "24.1"))
;; Keywords: convenience, extensions, files, tools, unix
;; License: GPL v3
;; Homepage: http://ergoemacs.org/emacs/elisp-xah-find-text.html
;; This file is not part of GNU Emacs.
;;; Commentary:
;; Provides emacs commands for find/replace text of files in a directory, written entirely in emacs lisp.
;; This package provides these commands:
;; xah-find-text
;; xah-find-text-regex
;; xah-find-count
;; xah-find-replace-text
;; xah-find-replace-text-regex
;; • Pure emacs lisp. No dependencies on unix/linux grep/sed/find. Especially useful on Windows.
;; • Output is highlighted and clickable for jumping to occurrence.
;; • Using emacs regex, not bash/perl etc regex.
;; These commands treats find/replace string as sequence of chars, not as lines as in grep/sed, so it's easier to find or replace a text containing lots newlines, especially programming language source code.
;; • Reliably Find/Replace string that contains newline chars.
;; • Reliably Find/Replace string that contains lots Unicode chars. See http://xahlee.info/comp/unix_uniq_unicode_bug.html and http://ergoemacs.org/emacs/emacs_grep_problem.html
;; • Reliably Find/Replace string that contains lots escape slashes or backslashes. For example, regex in source code, Microsoft Windows' path.
;; The result output is also not based on lines. Instead, visual separators are used for easy reading.
;; For each occurrence or replacement, n chars will be printed before and after. The number of chars to show is defined by `xah-find-context-char-count-before' and `xah-find-context-char-count-after'
;; Each “block of text” in output is one occurrence.
;; For example, if a line in a file has 2 occurrences, then the same line will be reported twice, as 2 “blocks”.
;; so, the number of blocks corresponds exactly to the number of occurrences.
;; Keys
;; -----------------------
;; TAB xah-find-next-match
;; <backtab> xah-find-previous-match
;; RET xah-find--jump-to-place
;; <mouse-1> xah-find--mouse-jump-to-place
;; <left> xah-find-previous-match
;; <right> xah-find-next-match
;; <down> xah-find-next-file
;; <up> xah-find-previous-file
;; M-n xah-find-next-file
;; M-p xah-find-previous-file
;; IGNORE DIRECTORIES
;; By default, .git dir is ignored. You can add to it by adding the following in your init:
;; (setq
;; xah-find-dir-ignore-regex-list
;; [
;; "\\.git/"
;; ; more regex here. regex is matched against file full path
;; ])
;; USE CASE
;; To give a idea what file size, number of files, are practical, here's my typical use pattern:
;; • 5 thousand HTML files match file name regex.
;; • Each HTML file size are usually less than 200k bytes.
;; • search string length have been up to 13 lines of text.
;; Homepage: http://ergoemacs.org/emacs/elisp-xah-find-text.html
;; Like it?
;; Buy Xah Emacs Tutorial
;; http://ergoemacs.org/emacs/buy_xah_emacs_tutorial.html
;; Thank you.
;;; INSTALL
;; To install manually, place this file in the directory [~/.emacs.d/lisp/]
;; Then, place the following code in your emacs init file
;; (add-to-list 'load-path "~/.emacs.d/lisp/")
;; (autoload 'xah-find-text "xah-find" "find replace" t)
;; (autoload 'xah-find-text-regex "xah-find" "find replace" t)
;; (autoload 'xah-find-replace-text "xah-find" "find replace" t)
;; (autoload 'xah-find-replace-text-regex "xah-find" "find replace" t)
;; (autoload 'xah-find-count "xah-find" "find replace" t)
;;; HISTORY
;; version 2.1.0, 2015-05-30 Complete rewrite.
;; version 1.0, 2012-04-02 First version.
;;; CONTRIBUTOR
;; 2015-12-09 Peter Buckley (dx-pbuckley). defcustom for result highlight color.
;; HHH___________________________________________________________________
;;; Code:
(require 'ido)
(require 'seq)
(ido-common-initialization)
;; 2015-07-26 else, when ido-read-directory-name is called, Return key insert line return instead of submit. For some reason i dunno.
(defvar xah-find-context-char-count-before 100 "Number of characters to print before search string." )
(defvar xah-find-context-char-count-after 50 "Number of characters to print after search string." )
(defvar xah-find-dir-ignore-regex-list
[
"\\.git/"
]
"A list or vector of regex patterns, if match, that directory will be ignored.
The regex match is Case Insensitive."
)
(defface xah-find-file-path-highlight
'((t :foreground "black"
:background "pink"
))
"Face of file path where a text match is found."
:group 'xah-find
)
(defface xah-find-match-highlight
'((t :foreground "black"
:background "yellow"
))
"Face for matched text."
:group 'xah-find
)
(defface xah-find-replace-highlight
'((t :foreground "black"
:background "green"
))
"Face for replaced text."
:group 'xah-find
)
(defvar xah-find-file-separator
"ff━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━\n\n"
"A string as visual separator."
)
(defvar xah-find-occur-separator
"oo────────────────────────────────────────────────────────────\n\n"
"A string as visual separator."
)
(defvar xah-find-occur-prefix "" "A left-bracket string that marks matched text and navigate previous/next. This string should basically never occure in your files. If it does, jumping to the location may not work." )
(defvar xah-find-occur-postfix "" "A right-bracket string that marks matched text and navigate previous/next. See also `xah-find-occur-prefix'." )
(defvar xah-find-replace-prefix "" "A left-bracket string that marks matched text and navigate previous/next. See also `xah-find-occur-prefix'." )
(defvar xah-find-replace-postfix "" "A right-bracket string that marks matched text and navigate previous/next. See also `xah-find-occur-prefix'." )
;; more brackets at http://xahlee.info/comp/unicode_matching_brackets.html
(defvar xah-find-filepath-prefix "" "A left-bracket string used to mark file path and navigate previous/next. See also `xah-find-occur-prefix'." )
(defvar xah-find-filepath-postfix "" "A right-bracket string used to mark file path and navigate previous/next. See also `xah-find-occur-prefix'." )
(defvar xah-find-pos-prefix "" "A string of left bracket that marks line column position of occurrence. See also `xah-find-occur-prefix'." )
(defvar xah-find-pos-postfix "" "A string of right bracket that marks line column position of occurrence. See also `xah-find-occur-prefix'." )
;; HHH___________________________________________________________________
(defvar xah-find-file-path-regex-history '() "File path regex history list, used by `xah-find-text' and others.")
(defun xah-find--ignore-dir-p (Path)
"Return true if one of `xah-find-dir-ignore-regex-list' matches PATH. Else, nil.
version 2016-11-16 2021-10-11"
(let ((case-fold-search t))
(catch 'exit25001
(mapc
(lambda ($regex)
(when (string-match $regex Path) (throw 'exit25001 $regex)))
xah-find-dir-ignore-regex-list)
nil
)))
;; HHH___________________________________________________________________
(defvar xah-find-output-mode-map nil "Keybinding for `xah-find.el output'")
(progn
(setq xah-find-output-mode-map (make-sparse-keymap))
(define-key xah-find-output-mode-map (kbd "<left>") 'xah-find-previous-match)
(define-key xah-find-output-mode-map (kbd "<right>") 'xah-find-next-match)
(define-key xah-find-output-mode-map (kbd "<down>") 'xah-find-next-file)
(define-key xah-find-output-mode-map (kbd "<up>") 'xah-find-previous-file)
(define-key xah-find-output-mode-map (kbd "TAB") 'xah-find-next-match)
(define-key xah-find-output-mode-map (kbd "<backtab>") 'xah-find-previous-match)
(define-key xah-find-output-mode-map (kbd "<mouse-1>") 'xah-find--mouse-jump-to-place)
(define-key xah-find-output-mode-map (kbd "M-n") 'xah-find-next-file)
(define-key xah-find-output-mode-map (kbd "M-p") 'xah-find-previous-file)
(define-key xah-find-output-mode-map (kbd "RET") 'xah-find--jump-to-place)
)
(defvar xah-find-output-syntax-table nil "Syntax table for `xah-find-output-mode'.")
(setq xah-find-output-syntax-table
(let ( (synTable (make-syntax-table)))
(modify-syntax-entry ?\" "." synTable)
;; (modify-syntax-entry ?〖 "(〗" synTable)
;; (modify-syntax-entry ?〗 "(〖" synTable)
synTable))
(setq xah-find-font-lock-keywords
(let (
(xMatch (format "%s\\([^%s]+\\)%s" xah-find-occur-prefix xah-find-occur-postfix xah-find-occur-postfix))
(xRep (format "%s\\([^%s]+\\)%s" xah-find-replace-prefix xah-find-replace-postfix xah-find-replace-postfix))
(xfPath (format "%s\\([^%s]+\\)%s" xah-find-filepath-prefix xah-find-filepath-postfix xah-find-filepath-postfix)))
`(
(,xMatch . (1 'xah-find-match-highlight))
(,xRep . (1 'xah-find-replace-highlight))
(,xfPath . (1 'xah-find-file-path-highlight)))))
(define-derived-mode xah-find-output-mode fundamental-mode "∑xah-find"
"Major mode for reading output for xah-find commands.
home page:
URL `http://ergoemacs.org/emacs/elisp-xah-find-text.html'
\\{xah-find-output-mode-map}
Version 2021-06-23"
(setq font-lock-defaults '((xah-find-font-lock-keywords)))
(set-syntax-table xah-find-output-syntax-table))
(defun xah-find-next-match ()
"Put cursor to next occurrence."
(interactive)
(search-forward xah-find-occur-prefix nil t ))
(defun xah-find-previous-match ()
"Put cursor to previous occurrence."
(interactive)
(search-backward xah-find-occur-postfix nil t ))
(defun xah-find-next-file ()
"Put cursor to next file."
(interactive)
(search-forward xah-find-filepath-prefix nil t ))
(defun xah-find-previous-file ()
"Put cursor to previous file."
(interactive)
(search-backward xah-find-filepath-postfix nil t ))
(defun xah-find--mouse-jump-to-place (Event)
"Open file and put cursor at location of the occurrence.
Version 2016-12-18"
(interactive "e")
(let* (
($pos (posn-point (event-end Event)))
($fpath (get-text-property $pos 'xah-find-fpath))
($posJumpTo (get-text-property $pos 'xah-find-pos)))
(when $fpath
(progn
(find-file-other-window $fpath)
(when $posJumpTo (goto-char $posJumpTo))))))
;; (defun xah-find--jump-to-place ()
;; "Open file and put cursor at location of the occurrence.
;; Version 2017-04-07"
;; (interactive)
;; (let (($fpath (get-text-property (point) 'xah-find-fpath))
;; ($posJumpTo (get-text-property (point) 'xah-find-pos)))
;; (if $fpath
;; (if (file-exists-p $fpath)
;; (progn
;; (find-file-other-window $fpath)
;; (when $posJumpTo (goto-char $posJumpTo)))
;; (error "File at 「%s」 does not exist." $fpath))
;; (insert "\n"))))
(defun xah-find--jump-to-place ()
"Open file and put cursor at location of the occurrence.
Version 2019-03-14"
(interactive)
(let (($fpath (get-text-property (point) 'xah-find-fpath))
($posJumpTo (get-text-property (point) 'xah-find-pos))
($p0 (point))
$p1 $p2
)
(if $fpath
(if (file-exists-p $fpath)
(progn
(find-file-other-window $fpath)
(when $posJumpTo (goto-char $posJumpTo)))
(error "File at 「%s」 does not exist." $fpath))
(progn
(save-excursion
(goto-char $p0)
;; (if (eq (char-after (line-beginning-position)) (string-to-char xah-find-filepath-prefix ))
;; (progn )
;; (progn ))
(search-forward xah-find-file-separator)
(search-backward xah-find-filepath-prefix )
(setq $p1 (1+ (point)))
(search-forward xah-find-filepath-postfix)
(setq $p2 (1- (point)))
(setq $fpath (buffer-substring-no-properties $p1 $p2))
(progn
(goto-char $p0)
(if (search-backward xah-find-pos-prefix nil t)
(progn
(setq $p1 (1+ (point)))
(search-forward xah-find-pos-postfix )
(setq $p2 (1- (point)))
(setq $posJumpTo (string-to-number (buffer-substring-no-properties $p1 $p2))))
(setq $posJumpTo nil))))
(if (file-exists-p $fpath)
(progn
(find-file-other-window $fpath)
(when $posJumpTo (goto-char $posJumpTo)))
(error "File at 「%s」 does not exist." $fpath))))))
;; HHH___________________________________________________________________
(defun xah-find--backup-suffix (S)
"Return a string of the form 「~S~date time stamp~」"
(concat "~" S (format-time-string "%Y%m%dT%H%M%S") "~"))
(defun xah-find--current-date-time-string ()
"Return current date-time string in this format 「2012-04-05T21:08:24-07:00」"
(concat
(format-time-string "%Y-%m-%dT%T")
(funcall (lambda (x) (format "%s:%s" (substring x 0 3) (substring x 3 5))) (format-time-string "%z"))))
(defun xah-find--print-header (BufferObj Cmd InputDir PathRegex SearchStr &optional ReplaceStr Write-file-p BackupQ)
"Print things"
(princ
(concat
"-*- coding: utf-8; mode: xah-find-output -*-" "\n"
"Datetime: " (xah-find--current-date-time-string) "\n"
"Result of: " Cmd "\n"
(format "Directory: %s\n" InputDir )
(format "Path regex: %s\n" PathRegex )
(format "Write to file: %s\n" Write-file-p )
(format "Backup: %s\n" BackupQ )
(format "Search string: %s\n" SearchStr )
(when ReplaceStr (format "Replace string [[%s]]\n" ReplaceStr))
"~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\n"
)
BufferObj))
(defun xah-find--occur-output (P1 P2 Fpath Buff &optional NoContextString-p AltColor)
"Print result to a output buffer, with text properties (e.g. highlight and link).
P1 P2 are region boundary. Region of current buffer are grabbed. The region typically is the searched text.
Fpath is file path to be used as property value for clickable link.
Buff is the buffer to insert P1 P2 region.
NoContextString-p if true, don't add text before and after the region of interest. Else, `xah-find-context-char-count-before' number of chars are inserted before, and similar for `xah-find-context-char-count-after'.
AltColor if true, use a different highlight color face `xah-find-replace-highlight'. Else, use `xah-find-match-highlight'.
Version 2017-04-07 2021-08-05"
(let* (
($begin (max 1 (- P1 xah-find-context-char-count-before )))
($end (min (point-max) (+ P2 xah-find-context-char-count-after )))
($textBefore (if NoContextString-p "" (buffer-substring-no-properties $begin P1 )))
$textMiddle
($textAfter (if NoContextString-p "" (buffer-substring-no-properties P2 $end)))
($face (if AltColor 'xah-find-replace-highlight 'xah-find-match-highlight))
$bracketL $bracketR
)
(put-text-property P1 P2 'face $face)
(put-text-property P1 P2 'xah-find-fpath Fpath)
(put-text-property P1 P2 'xah-find-pos P1)
(add-text-properties P1 P2 '(mouse-face highlight))
(setq $textMiddle (buffer-substring P1 P2 ))
(if AltColor
(setq $bracketL xah-find-replace-prefix $bracketR xah-find-replace-postfix )
(setq $bracketL xah-find-occur-prefix $bracketR xah-find-occur-postfix ))
(with-current-buffer Buff
(insert
(format "%s%s%s\n" xah-find-pos-prefix P1 xah-find-pos-postfix)
$textBefore
$bracketL
$textMiddle
$bracketR
$textAfter
"\n"
xah-find-occur-separator ))))
;; (defun xah-find--print-replace-block (P1 P2 Buff)
;; "print "
;; (princ (concat "❬" (buffer-substring-no-properties P1 P2 ) "❭" "\n" xah-find-occur-separator) Buff))
(defun xah-find--print-file-count (Filepath4287 Count8086 BuffObj32)
"Print file path and count"
(princ (format "%d %s%s%s\n%s"
Count8086
xah-find-filepath-prefix
Filepath4287
xah-find-filepath-postfix
xah-find-file-separator)
BuffObj32))
(defun xah-find--switch-to-output (Buffer)
"switch to Buffer and highlight stuff"
(let ($p3 $p4)
(switch-to-buffer Buffer)
(progn
(goto-char (point-min))
(while (search-forward xah-find-filepath-prefix nil t)
(setq $p3 (point))
(search-forward xah-find-filepath-postfix nil nil)
(setq $p4 (match-beginning 0))
(put-text-property $p3 $p4 'xah-find-fpath (buffer-substring-no-properties $p3 $p4))
(add-text-properties $p3 $p4 '(mouse-face highlight))
(put-text-property (line-beginning-position) (line-end-position) 'face 'xah-find-file-path-highlight)))
(goto-char (point-min))
(search-forward "" nil t) ; todo, need fix
(search-forward xah-find-occur-prefix nil t)
(xah-find-output-mode)
))
;; HHH___________________________________________________________________
(defun xah-find--get-fpath-regex (&optional DefaultExt)
"Returns a string, that is a regex to match a file extension.
The result is based on current buffer's file extension.
If current file doesn't have extension or current buffer isn't a file, then extension DefaultExt is used.
DefaultExt should be a string, without dot, such as 「\"html\"」.
If DefaultExt is nil, 「\"html\"」 is used.
Example return value: 「ββ.htmlββ'」, where β is a backslash.
"
(let (
($buff-is-file-p (buffer-file-name))
$fname-ext
$default-ext
)
(setq $default-ext (if (null DefaultExt)
(progn "html")
(progn DefaultExt)))
(if $buff-is-file-p
(progn
(setq $fname-ext (file-name-extension (buffer-file-name)))
(if (or (null $fname-ext) (equal $fname-ext ""))
(progn (concat "\\." $default-ext "$"))
(progn (concat "\\." $fname-ext "$"))))
(progn (concat "\\." $default-ext "$")))))
;;;###autoload
(defun xah-find-count (SearchStr CountExpr CountNumber InputDir PathRegex)
"Report how many occurrences of a string, of a given dir.
Similar to `rgrep', but written in pure elisp.
Result is shown in buffer *xah-find output*.
Case sensitivity is determined by `case-fold-search'. Call `toggle-case-fold-search' to change.
`xah-find-dir-ignore-regex-list' is respected.
\\{xah-find-output-mode-map}
Version 2021-10-11"
(interactive
(let ( $operator)
(list
(read-string (format "Search string (default %s): " (current-word)) nil 'query-replace-history (current-word))
(setq $operator (ido-completing-read "Report on: " '("greater than" "greater or equal to" "equal" "not equal" "less than" "less or equal to" )))
(read-string (format "Count %s: " $operator) "0")
(ido-read-directory-name "Directory: " default-directory default-directory "MUSTMATCH")
(read-from-minibuffer "File path regex: " (xah-find--get-fpath-regex "el") nil nil 'dired-regexp-history))))
(let* (($outBufName "*xah-find output*")
$outBuffer
($countOperator
(cond
((string-equal "less than" CountExpr ) '<)
((string-equal "less or equal to" CountExpr ) '<=)
((string-equal "greater than" CountExpr ) '>)
((string-equal "greater or equal to" CountExpr ) '>=)
((string-equal "equal" CountExpr ) '=)
((string-equal "not equal" CountExpr ) '/=)
(t (error "count expression 「%s」 is wrong!" CountExpr ))))
($countNumber (string-to-number CountNumber)))
(when (get-buffer $outBufName) (kill-buffer $outBufName))
(setq $outBuffer (generate-new-buffer $outBufName))
(xah-find--print-header $outBuffer "xah-find-count" InputDir PathRegex SearchStr )
(mapc
(lambda ($f)
(let (($count 0))
(with-temp-buffer
(insert-file-contents $f)
(goto-char (point-min))
(while (search-forward SearchStr nil t) (setq $count (1+ $count)))
(when (funcall $countOperator $count $countNumber)
(xah-find--print-file-count $f $count $outBuffer)))))
(seq-filter (lambda (x) (not (xah-find--ignore-dir-p x)))
(directory-files-recursively InputDir PathRegex)))
(princ "Done." $outBuffer)
(xah-find--switch-to-output $outBuffer)))
;;;###autoload
(defun xah-find-text (SearchStr InputDir PathRegex FixedCaseSearchQ PrintContext-p)
"Report files that contain string.
By default, not case sensitive, and print surrounding text.
If `universal-argument' is called first, prompt to ask.
`xah-find-dir-ignore-regex-list' is respected.
Result is shown in buffer *xah-find output*.
\\{xah-find-output-mode-map}
version 2021-10-11"
(interactive
(let (($defaultInput (if (region-active-p) (buffer-substring-no-properties (region-beginning) (region-end)) (current-word))))
(list
(read-string (format "Search string (default %s): " $defaultInput) nil 'query-replace-history $defaultInput)
(ido-read-directory-name "Directory: " default-directory default-directory "MUSTMATCH")
(read-from-minibuffer "File path regex: " (xah-find--get-fpath-regex "html") nil nil 'dired-regexp-history)
(if current-prefix-arg (y-or-n-p "Fixed case in search?") nil )
(if current-prefix-arg (y-or-n-p "Print surrounding Text?") t ))))
(let* ((case-fold-search (not FixedCaseSearchQ))
($count 0)
($outBufName "*xah-find output*")
$outBuffer
)
(setq InputDir (file-name-as-directory InputDir)) ; normalize dir path
(when (get-buffer $outBufName) (kill-buffer $outBufName))
(setq $outBuffer (generate-new-buffer $outBufName))
(xah-find--print-header $outBuffer "xah-find-text" InputDir PathRegex SearchStr )
(mapc
(lambda ($path)
(setq $count 0)
(with-temp-buffer
(insert-file-contents $path)
(while (search-forward SearchStr nil t)
(setq $count (1+ $count))
(when PrintContext-p (xah-find--occur-output (match-beginning 0) (match-end 0) $path $outBuffer)))
(when (> $count 0) (xah-find--print-file-count $path $count $outBuffer))))
(seq-filter (lambda (x) (not (xah-find--ignore-dir-p x)))
(directory-files-recursively InputDir PathRegex)))
(princ "Done." $outBuffer)
(xah-find--switch-to-output $outBuffer)))
(defun xah-find-count-slash (Path)
"Count the number of slash in path.
Useful for finding the level of a nested dir.
Note: you should probably call `expand-file-name' on Path first to canonize path, to make sure dir name always ends in slash.
Version 2021-10-11"
(interactive)
(seq-count (lambda (x) (char-equal x ?/)) Path))
;;;###autoload
(defun xah-find-replace-text (SearchStr ReplaceStr InputDir PathRegex DepthMin DepthMax WriteToFileQ FixedCaseSearchQ FixedCaseReplaceQ BackupQ)
"Find/Replace string in all files of a directory.
Search string can span multiple lines.
Search string is not regex.
`xah-find-dir-ignore-regex-list' is respected.
Backup, if requested, backup filenames has suffix with timestamp, like this: ~xf20150531T233826~
Result is shown in buffer *xah-find output*.
\\{xah-find-output-mode-map}
version 2021-10-11"
(interactive
(let (($searchStr (read-string (format "Search string (default %s): " (current-word)) nil 'query-replace-history (current-word)))
($replaceStr (read-string "Replace string: " nil 'query-replace-history))
($inputDir (ido-read-directory-name "Directory: " default-directory default-directory "MUSTMATCH"))
($pathRegex (read-from-minibuffer "File path regex: " (xah-find--get-fpath-regex "el") nil nil 'dired-regexp-history))
;; ($recurseQ (yes-or-no-p "Recurse to subdirs?"))
($depthMin (read-number "Min dir depth. Start dir has depth 0:" 0))
($depthMax (read-number "Max dir depth. (max+1 depth subdir files are excluded):" 9))
($writeToFileQ (y-or-n-p "Write changes to file?"))
($fixedCaseSearchQ (y-or-n-p "Fixed case in search?"))
($fixedCaseReplaceQ (y-or-n-p "Fixed case in replacement?"))
($backupQ (y-or-n-p "Make backup?")))
(list $searchStr $replaceStr $inputDir $pathRegex
$depthMin $depthMax
$writeToFileQ $fixedCaseSearchQ $fixedCaseReplaceQ $backupQ)))
(let (($outBufName "*xah-find output*")
$outBuffer
($backupSuffix (xah-find--backup-suffix "xf"))
($rootDepth (xah-find-count-slash (expand-file-name InputDir))))
(when (get-buffer $outBufName) (kill-buffer $outBufName))
(setq $outBuffer (generate-new-buffer $outBufName))
(xah-find--print-header $outBuffer "xah-find-replace-text" InputDir PathRegex SearchStr ReplaceStr WriteToFileQ BackupQ)
(mapc
(lambda ($f)
(let ((case-fold-search (not FixedCaseSearchQ))
($count 0))
(with-temp-buffer
(insert-file-contents $f)
(while (search-forward SearchStr nil t)
(setq $count (1+ $count))
(replace-match ReplaceStr FixedCaseReplaceQ "literalreplace")
(xah-find--occur-output (match-beginning 0) (point) $f $outBuffer))
(when (> $count 0)
(when WriteToFileQ
(when BackupQ (copy-file $f (concat $f $backupSuffix) t))
(write-region (point-min) (point-max) $f nil 3))
(xah-find--print-file-count $f $count $outBuffer)))))
(seq-filter
(lambda (x)
(let (($df (- (xah-find-count-slash x) $rootDepth)))
(and (>= $df DepthMin) (<= $df DepthMax))))
(directory-files-recursively InputDir PathRegex)))
(princ "Done." $outBuffer)
(xah-find--switch-to-output $outBuffer)))
;;;###autoload
(defun xah-find-text-regex (SearchRegex InputDir PathRegex RecurseQ FixedCaseSearchQ PrintContextLevel)
"Report files that contain a string pattern, similar to `rgrep'.
Result is shown in buffer *xah-find output*.
`xah-find-dir-ignore-regex-list' is respected.
\\{xah-find-output-mode-map}
Version 2016-12-21 2021-10-11"
(interactive
(list
(read-string (format "Search regex (default %s): " (current-word)) nil 'query-replace-history (current-word))
(ido-read-directory-name "Directory: " default-directory default-directory "MUSTMATCH")
(read-from-minibuffer "File path regex: " (xah-find--get-fpath-regex "el") nil nil 'dired-regexp-history)
(yes-or-no-p "Recurse to subdirs?")
(y-or-n-p "Fixed case search?")
(ido-completing-read "Print context level: " '("with context string" "just matched pattern" "none"))))
(let (($count 0)
($outBufName "*xah-find output*")
$outBuffer
)
(setq InputDir (file-name-as-directory InputDir)) ; add ending slash
(when (get-buffer $outBufName) (kill-buffer $outBufName))
(setq $outBuffer (generate-new-buffer $outBufName))
(xah-find--print-header $outBuffer "xah-find-text-regex" InputDir PathRegex SearchRegex)
(mapc
(lambda ($fp)
(setq $count 0)
(with-temp-buffer
(insert-file-contents $fp)
(setq case-fold-search (not FixedCaseSearchQ))
(while (re-search-forward SearchRegex nil t)
(setq $count (1+ $count))
(cond
((equal PrintContextLevel "none") nil)
((equal PrintContextLevel "just matched pattern")
(xah-find--occur-output (match-beginning 0) (match-end 0) $fp $outBuffer t))
((equal PrintContextLevel "with context string")
(xah-find--occur-output (match-beginning 0) (match-end 0) $fp $outBuffer))))
(when (> $count 0) (xah-find--print-file-count $fp $count $outBuffer))))
(seq-filter (lambda (x) (not (xah-find--ignore-dir-p x)))
(if RecurseQ
(directory-files-recursively InputDir PathRegex)
(directory-files InputDir t PathRegex))))
(princ "Done." $outBuffer)
(xah-find--switch-to-output $outBuffer)))
;;;###autoload
(defun xah-find-replace-text-regex (Regex ReplaceStr InputDir PathRegex WriteToFileQ FixedCaseSearchQ FixedCaseReplaceQ ShowcontexQ BackupQ)
"Find/Replace by regex in all files of a directory.
`xah-find-dir-ignore-regex-list' is respected.
Backup, if requested, backup filenames has suffix with timestamp, like this: ~xf20150531T233826~
When called in lisp code:
Regex is a regex pattern.
ReplaceStr is replacement string.
InputDir is input directory to search (includes all nested subdirectories).
PathRegex is a regex to filter file paths.
WriteToFileQ, when true, write to file, else, print a report of changes only.
FixedCaseSearchQ sets `case-fold-search' for this operation.
FixedCaseReplaceQ if true, then the letter-case in replacement is literal. (this is relevant only if FixedCaseSearchQ is true.)
ShowcontexQ print characters before and after match.
BackupQ if ture does backup.
Result is shown in buffer *xah-find output*.
\\{xah-find-output-mode-map}
Version 2018-08-20 2021-10-11"
(interactive
(list
(read-regexp "Find regex: " )
(read-string (format "Replace string: ") nil 'query-replace-history)
(ido-read-directory-name "Directory: " default-directory default-directory "MUSTMATCH")
(read-from-minibuffer "File path regex: " (xah-find--get-fpath-regex "el") nil nil 'dired-regexp-history)
(y-or-n-p "Write changes to file?")
(y-or-n-p "Fixed case in search?")
(y-or-n-p "Fixed case in replacement?")
(y-or-n-p "Show context before after in output?")
(y-or-n-p "Make backup?")))
(let (($outBufName "*xah-find output*")
$outBuffer
($backupSuffix (xah-find--backup-suffix "xfr")))
(when (get-buffer $outBufName) (kill-buffer $outBufName))
(setq $outBuffer (generate-new-buffer $outBufName))
(xah-find--print-header $outBuffer "xah-find-replace-text-regex" InputDir PathRegex Regex ReplaceStr WriteToFileQ BackupQ )
(mapc
(lambda ($fp)
(let (($count 0))
(with-temp-buffer
(insert-file-contents $fp)
(setq case-fold-search (not FixedCaseSearchQ))
(while (re-search-forward Regex nil t)
(setq $count (1+ $count))
;; (xah-find--print-occur-block (match-beginning 0) (match-end 0) $outBuffer)
(xah-find--occur-output (match-beginning 0) (match-end 0) $fp $outBuffer t)
(replace-match ReplaceStr FixedCaseReplaceQ)
(xah-find--occur-output (match-beginning 0) (point) $fp $outBuffer (not ShowcontexQ) t))
(when (> $count 0)
(xah-find--print-file-count $fp $count $outBuffer)
(when WriteToFileQ
(when BackupQ
(copy-file $fp (concat $fp $backupSuffix) t))
(write-region (point-min) (point-max) $fp nil 3))))))
(seq-filter (lambda (x) (not (xah-find--ignore-dir-p x)))
(directory-files-recursively InputDir PathRegex)))
(princ "Done." $outBuffer)
(xah-find--switch-to-output $outBuffer)))
(provide 'xah-find)
;;; xah-find.el ends here