daniel/emacs-conf
1
2
Fork 0
Code Issues 7 Pull Requests Projects Releases Wiki Activity

update packages

Browse Source
This commit is contained in:
Daniel Weschke
2025-11-25 19:52:03 +01:00
parent 14ba373378
commit dbbae92267
280 changed files with 13451 additions and 11207 deletions
Download Patch File Download Diff File Expand all files Collapse all files
lisp/async/async-bytecomp.el
+76 -44
View File
@@ -59,39 +59,85 @@ all packages are always compiled asynchronously."
(const :tag "All packages" all)
(repeat symbol)))
(defvar async-byte-compile-log-file
(concat user-emacs-directory "async-bytecomp.log"))
(defvar async-byte-compile-log-file "async-bytecomp.log"
"Prefix for a file used to pass errors from async process to the caller.
The `file-name-nondirectory' part of the value is passed to
`make-temp-file' as a prefix. When the value is an absolute
path, then the `file-name-directory' part of it is expanded in
the calling process (with `expand-file-name') and used as a value
of variable `temporary-file-directory' in async processes.")
(defvar async-bytecomp-load-variable-regexp "\\`load-path\\'"
"The variable used by `async-inject-variables' when (re)compiling async.")
(defun async-bytecomp--file-to-comp-buffer (file-or-dir &optional quiet type)
(defun async-bytecomp--file-to-comp-buffer-1 (log-file &optional postproc)
(let ((buf (get-buffer-create byte-compile-log-buffer)))
(with-current-buffer buf
(goto-char (point-max))
(let ((inhibit-read-only t))
(insert-file-contents log-file)
(compilation-mode))
(display-buffer buf)
(delete-file log-file)
(and postproc (funcall postproc)))))
(defun async-bytecomp--file-to-comp-buffer (file-or-dir &optional quiet type log-file)
(let ((bn (file-name-nondirectory (directory-file-name file-or-dir)))
(action-name (pcase type
('file "File")
('directory "Directory"))))
(if (file-exists-p async-byte-compile-log-file)
(let ((buf (get-buffer-create byte-compile-log-buffer))
(n 0))
(with-current-buffer buf
(goto-char (point-max))
(let ((inhibit-read-only t))
(insert-file-contents async-byte-compile-log-file)
(compilation-mode))
(display-buffer buf)
(delete-file async-byte-compile-log-file)
(unless quiet
(save-excursion
(goto-char (point-min))
(while (re-search-forward "^.*:Error:" nil t)
(cl-incf n)))
(if (> n 0)
(message "Failed to compile %d files in directory `%s'" n bn)
(message "%s `%s' compiled asynchronously with warnings"
action-name bn)))))
(if (and log-file (file-exists-p log-file))
(async-bytecomp--file-to-comp-buffer-1
log-file
(unless quiet
(lambda ()
(let ((n 0))
(unless quiet
(save-excursion
(goto-char (point-min))
(while (re-search-forward "^.*:Error:" nil t)
(cl-incf n)))
(if (> n 0)
(message "Failed to compile %d files in directory `%s'" n bn)
(message "%s `%s' compiled asynchronously with warnings"
action-name bn)))))))
(unless quiet
(message "%s `%s' compiled asynchronously with success" action-name bn)))))
(defmacro async-bytecomp--comp-buffer-to-file ()
"Write contents of `byte-compile-log-buffer' to a log file.
The log file is a temporary file that name is determined by
`async-byte-compile-log-file', which see. Return the actual log
file name, or nil if no log file has been created."
`(when (get-buffer byte-compile-log-buffer)
(let ((error-data (with-current-buffer byte-compile-log-buffer
(buffer-substring-no-properties (point-min) (point-max)))))
(unless (string= error-data "")
;; The `async-byte-compile-log-file' used to be an absolute file name
;; shared amongst all compilation async processes. For backward
;; compatibility the directory part of it is used to create logs the same
;; directory while the nondirectory part denotes the PREFIX for
;; `make-temp-file' call. The `temporary-file-directory' is bound, such
;; that the async process uses one set by the caller.
(let ((temporary-file-directory
,(or (when (and async-byte-compile-log-file
(file-name-absolute-p
async-byte-compile-log-file))
(expand-file-name (file-name-directory
async-byte-compile-log-file)))
temporary-file-directory))
(log-file (make-temp-file ,(let ((log-file
(file-name-nondirectory
async-byte-compile-log-file)))
(format "%s%s"
log-file
(if (string-suffix-p "." log-file)
"" "."))))))
(with-temp-file log-file
(erase-buffer)
(insert error-data))
log-file)))))
;;;###autoload
(defun async-byte-recompile-directory (directory &optional quiet)
"Compile all *.el files in DIRECTORY asynchronously.
@@ -104,23 +150,16 @@ All *.elc files are systematically deleted before proceeding."
;; This happen when recompiling its own directory.
(load "async")
(let ((call-back
(lambda (&optional _ignore)
(async-bytecomp--file-to-comp-buffer directory quiet 'directory))))
(lambda (&optional log-file)
(async-bytecomp--file-to-comp-buffer directory quiet 'directory log-file))))
(async-start
`(lambda ()
(require 'bytecomp)
,(async-inject-variables async-bytecomp-load-variable-regexp)
(let ((default-directory (file-name-as-directory ,directory))
error-data)
(let ((default-directory (file-name-as-directory ,directory)))
(add-to-list 'load-path default-directory)
(byte-recompile-directory ,directory 0 t)
(when (get-buffer byte-compile-log-buffer)
(setq error-data (with-current-buffer byte-compile-log-buffer
(buffer-substring-no-properties (point-min) (point-max))))
(unless (string= error-data "")
(with-temp-file ,async-byte-compile-log-file
(erase-buffer)
(insert error-data))))))
,(macroexpand '(async-bytecomp--comp-buffer-to-file))))
call-back)
(unless quiet (message "Started compiling asynchronously directory %s" directory))))
@@ -185,23 +224,16 @@ by default is async you don't need this."
Same as `byte-compile-file' but asynchronous."
(interactive "fFile: ")
(let ((call-back
(lambda (&optional _ignore)
(async-bytecomp--file-to-comp-buffer file nil 'file))))
(lambda (&optional log-file)
(async-bytecomp--file-to-comp-buffer file nil 'file log-file))))
(async-start
`(lambda ()
(require 'bytecomp)
,(async-inject-variables async-bytecomp-load-variable-regexp)
(let ((default-directory ,(file-name-directory file))
error-data)
(let ((default-directory ,(file-name-directory file)))
(add-to-list 'load-path default-directory)
(byte-compile-file ,file)
(when (get-buffer byte-compile-log-buffer)
(setq error-data (with-current-buffer byte-compile-log-buffer
(buffer-substring-no-properties (point-min) (point-max))))
(unless (string= error-data "")
(with-temp-file ,async-byte-compile-log-file
(erase-buffer)
(insert error-data))))))
,(macroexpand '(async-bytecomp--comp-buffer-to-file))))
call-back)))
(provide 'async-bytecomp)
lisp/async/async-package.el
+16 -16
View File
@@ -65,7 +65,14 @@ Argument ERROR-FILE is the file where errors are logged, if some."
(action-string (pcase action
('install "Installing")
('upgrade "Upgrading")
('reinstall "Reinstalling"))))
('reinstall "Reinstalling")))
;; As PACKAGES are installed and compiled in a single async
;; process we don't need to compute log-file in child process
;; i.e. we use the same log-file for all PACKAGES.
(log-file (make-temp-file
(expand-file-name
(file-name-nondirectory async-byte-compile-log-file)
temporary-file-directory))))
(message "%s %s package(s)..." action-string (length packages))
(process-put
(async-start
@@ -92,13 +99,12 @@ Argument ERROR-FILE is the file where errors are logged, if some."
(format
"%S:\n Please refresh package list before %s"
err ,action-string)))))
(let (error-data)
(when (get-buffer byte-compile-log-buffer)
(setq error-data (with-current-buffer byte-compile-log-buffer
(buffer-substring-no-properties
(point-min) (point-max))))
(when (get-buffer byte-compile-log-buffer)
(let ((error-data (with-current-buffer byte-compile-log-buffer
(buffer-substring-no-properties
(point-min) (point-max)))))
(unless (string= error-data "")
(with-temp-file ,async-byte-compile-log-file
(with-temp-file ,log-file
(erase-buffer)
(insert error-data)))))))
(lambda (result)
@@ -127,15 +133,9 @@ Argument ERROR-FILE is the file where errors are logged, if some."
'async-package-message
str (length lst)))
packages action-string)
(when (file-exists-p async-byte-compile-log-file)
(let ((buf (get-buffer-create byte-compile-log-buffer)))
(with-current-buffer buf
(goto-char (point-max))
(let ((inhibit-read-only t))
(insert-file-contents async-byte-compile-log-file)
(compilation-mode))
(display-buffer buf)
(delete-file async-byte-compile-log-file)))))))
(if (zerop (nth 7 (file-attributes log-file)))
(delete-file log-file)
(async-bytecomp--file-to-comp-buffer-1 log-file)))))
(run-hooks 'async-pkg-install-after-hook)))
'async-pkg-install t)
(async-package--modeline-mode 1)))
lisp/async/async-pkg.el
+3 -3
View File
@@ -1,10 +1,10 @@
;; -*- no-byte-compile: t; lexical-binding: nil -*-
(define-package "async" "20250325.509"
(define-package "async" "20251005.634"
"Asynchronous processing in Emacs."
'((emacs "24.4"))
:url "https://github.com/jwiegley/emacs-async"
:commit "bb3f31966ed65a76abe6fa4f80a960a2917f554e"
:revdesc "bb3f31966ed6"
:commit "31cb2fea8f4bc7a593acd76187a89075d8075500"
:revdesc "31cb2fea8f4b"
:keywords '("async")
:authors '(("John Wiegley" . "jwiegley@gmail.com"))
:maintainers '(("Thierry Volpiatto" . "thievol@posteo.net")))
lisp/async/async.el
+3 -3
View File
@@ -6,8 +6,8 @@
;; Maintainer: Thierry Volpiatto <thievol@posteo.net>
;; Created: 18 Jun 2012
;; Package-Version: 20250325.509
;; Package-Revision: bb3f31966ed6
;; Package-Version: 20251005.634
;; Package-Revision: 31cb2fea8f4b
;; Package-Requires: ((emacs "24.4"))
;; Keywords: async
@@ -118,7 +118,7 @@ is returned unmodified."
collect elm))
(t object)))
(defvar async-inject-variables-exclude-regexps '("-syntax-table\\'")
(defvar async-inject-variables-exclude-regexps '("-syntax-table\\'" "-abbrev-table\\'")
"A list of regexps that `async-inject-variables' should ignore.")
(defun async-inject-variables
lisp/async/dired-async.el
+20 -9
View File
@@ -71,7 +71,9 @@ Should take same args as `message'."
(defcustom dired-async-skip-fast nil
"If non-nil, skip async for fast operations.
Same device renames and copying and renaming files smaller than
`dired-async-small-file-max' are considered fast."
`dired-async-small-file-max' are considered fast.
If the total size of all files exceed `dired-async-small-file-max'
operation is not considered fast."
:risky t
:type 'boolean)
@@ -203,22 +205,22 @@ See `file-attributes'."
(equal (file-attribute-device-number (file-attributes f1))
(file-attribute-device-number (file-attributes f2))))
(defun dired-async--small-file-p (file)
(defun dired-async--small-file-p (file &optional attrs)
"Return non-nil if FILE is considered small.
File is considered small if it size is smaller than
`dired-async-small-file-max'."
(let ((a (file-attributes file)))
(let ((a (or attrs (file-attributes file))))
;; Directories are always large since we can't easily figure out
;; their total size.
(and (not (dired-async--directory-p a))
(< (file-attribute-size a) dired-async-small-file-max))))
(defun dired-async--skip-async-p (file-creator file name-constructor)
(defun dired-async--skip-async-p (file-creator file name-constructor &optional attrs)
"Return non-nil if we should skip async for FILE.
See `dired-create-files' for FILE-CREATOR and NAME-CONSTRUCTOR."
;; Skip async for small files.
(or (dired-async--small-file-p file)
(or (dired-async--small-file-p file attrs)
;; Also skip async for same device renames.
(and (eq file-creator 'dired-rename-file)
(let ((new (funcall name-constructor file)))
@@ -230,14 +232,22 @@ See `dired-create-files' for FILE-CREATOR and NAME-CONSTRUCTOR."
"Around advice for `dired-create-files'.
Uses async like `dired-async-create-files' but skips certain fast
cases if `dired-async-skip-fast' is non-nil."
(let (async-list quick-list)
(let ((total-size 0)
async-list quick-list)
(if (or (eq file-creator 'backup-file)
(null dired-async-skip-fast))
(setq async-list fn-list)
(dolist (old fn-list)
(if (dired-async--skip-async-p file-creator old name-constructor)
(push old quick-list)
(push old async-list))))
(let ((attrs (file-attributes old)))
(if (dired-async--skip-async-p
file-creator old name-constructor attrs)
(progn
(push old quick-list)
(setq total-size (+ total-size (nth 7 attrs))))
(push old async-list)))))
(when (> total-size dired-async-small-file-max)
(setq async-list (append quick-list async-list)
quick-list nil))
(when async-list
(dired-async-create-files
file-creator operation (nreverse async-list)
@@ -313,6 +323,7 @@ ESC or `q' to not overwrite any of the remaining files,
from to)))
;; Skip file if it is too large.
(if (and (member operation '("Copy" "Rename"))
dired-async-large-file-warning-threshold
(eq (dired-async--abort-if-file-too-large
(file-attribute-size
(file-attributes (file-truename from)))
lisp/biblio/biblio-hal.el
+1
View File
@@ -28,6 +28,7 @@
;;; Code:
(require 'biblio-core)
(require 'timezone)
(defun biblio-hal--forward-bibtex (metadata forward-to)
"Forward BibTeX for HAL entry METADATA to FORWARD-TO."
lisp/biblio/biblio-pkg.el
+3 -3
View File
@@ -1,11 +1,11 @@
;; -*- no-byte-compile: t; lexical-binding: nil -*-
(define-package "biblio" "20250409.2132"
(define-package "biblio" "20250812.1408"
"Browse and import bibliographic references and BibTeX records from CrossRef, arXiv, DBLP, HAL, IEEE Xplore, Dissemin, and doi.org."
'((emacs "24.3")
(biblio-core "0.3"))
:url "https://github.com/cpitclaudel/biblio.el"
:commit "0314982c0ca03d0f8e0ddbe9fc20588c35021098"
:revdesc "0314982c0ca0"
:commit "bb9d6b4b962fb2a4e965d27888268b66d868766b"
:revdesc "bb9d6b4b962f"
:keywords '("bib" "tex" "convenience" "hypermedia")
:authors '(("Clément Pit-Claudel" . "clement.pitclaudel@live.com"))
:maintainers '(("Clément Pit-Claudel" . "clement.pitclaudel@live.com")))
lisp/biblio/biblio.el
+2 -2
View File
@@ -3,8 +3,8 @@
;; Copyright (C) 2016 Clément Pit-Claudel
;; Author: Clément Pit-Claudel <clement.pitclaudel@live.com>
;; Package-Version: 20250409.2132
;; Package-Revision: 0314982c0ca0
;; Package-Version: 20250812.1408
;; Package-Revision: bb9d6b4b962f
;; Package-Requires: ((emacs "24.3") (biblio-core "0.3"))
;; Keywords: bib, tex, convenience, hypermedia
;; URL: https://github.com/cpitclaudel/biblio.el
lisp/cfrs/cfrs-pkg.el
+3 -3
View File
@@ -1,12 +1,12 @@
;; -*- no-byte-compile: t; lexical-binding: nil -*-
(define-package "cfrs" "20220129.1149"
(define-package "cfrs" "20250729.1422"
"Child-frame based read-string."
'((emacs "26.1")
(dash "2.11.0")
(s "1.10.0")
(posframe "0.6.0"))
:url "https://github.com/Alexander-Miller/cfrs"
:commit "f3a21f237b2a54e6b9f8a420a9da42b4f0a63121"
:revdesc "f3a21f237b2a"
:commit "981bddb3fb9fd9c58aed182e352975bd10ad74c8"
:revdesc "981bddb3fb9f"
:authors '(("Alexander Miller" . "alexanderm@web.de"))
:maintainers '(("Alexander Miller" . "alexanderm@web.de")))
lisp/cfrs/cfrs.el
+15 -4
View File
@@ -4,8 +4,8 @@
;; Author: Alexander Miller <alexanderm@web.de>
;; Package-Requires: ((emacs "26.1") (dash "2.11.0") (s "1.10.0") (posframe "0.6.0"))
;; Package-Version: 20220129.1149
;; Package-Revision: f3a21f237b2a
;; Package-Version: 20250729.1422
;; Package-Revision: 981bddb3fb9f
;; Homepage: https://github.com/Alexander-Miller/cfrs
;; This program is free software; you can redistribute it and/or modify
@@ -70,13 +70,21 @@ See also `cfrs-max-width'"
Only the `:background' part is used."
:group 'cfrs)
(defconst cfrs--buffer-name " *Pos-Frame-Read*")
(defun cfrs--detect-lost-focus (_)
"Abort the read operation when focus is lost."
(unless (eq major-mode 'cfrs-input-mode)
(posframe-hide cfrs--buffer-name)
(abort-recursive-edit)))
;;;###autoload
(defun cfrs-read (prompt &optional initial-input)
"Read a string using a pos-frame with given PROMPT and INITIAL-INPUT."
(if (not (or (display-graphic-p)
(not (fboundp #'display-buffer-in-side-window))))
(read-string prompt initial-input)
(let* ((buffer (get-buffer-create " *Pos-Frame-Read*"))
(let* ((buffer (get-buffer-create cfrs--buffer-name))
(border-color (face-attribute 'cfrs-border-color :background nil t))
(cursor (cfrs--determine-cursor-type))
(width (+ 2 ;; extra space for margin and cursor
@@ -132,7 +140,7 @@ Prevents showing an invisible cursor with a height or width of 0."
(defun cfrs--hide ()
"Hide the current cfrs frame."
(when (eq major-mode 'cfrs-input-mode)
(posframe-hide (current-buffer))
(posframe-hide cfrs--buffer-name)
(x-focus-frame (frame-parent (selected-frame)))))
(defun cfrs--adjust-height ()
@@ -150,11 +158,13 @@ Prevents showing an invisible cursor with a height or width of 0."
;; XXX: workaround for persp believing we are in a different frame
;; and need a new perspective when the recursive edit ends
(set-frame-parameter (selected-frame) 'persp--recursive nil)
(remove-hook 'window-selection-change-functions #'cfrs--detect-lost-focus :local)
(exit-recursive-edit))
(defun cfrs-cancel ()
"Cancel the `cfrs-read' call and the function that called it."
(interactive)
(remove-hook 'window-selection-change-functions #'cfrs--detect-lost-focus :local)
(cfrs--hide)
(abort-recursive-edit))
@@ -168,6 +178,7 @@ Prevents showing an invisible cursor with a height or width of 0."
(define-derived-mode cfrs-input-mode fundamental-mode "Child Frame Read String"
"Simple mode for buffers displayed in cfrs's input frames."
(add-hook 'post-command-hook #'cfrs--adjust-height nil :local)
(add-hook 'window-selection-change-functions #'cfrs--detect-lost-focus nil :local)
(display-line-numbers-mode -1))
;; https://github.com/Alexander-Miller/treemacs/issues/775
lisp/citeproc/citeproc-bibtex.el
+5 -3
View File
@@ -232,7 +232,9 @@ character was found."
(rx "\\" (1+ (any "a-z" "A-Z")) word-end)) ; \TEX-COMMAND + word-end
(defconst citeproc-bt--braces-rx
(rx "{" (group (*? anything)) "}")) ; {TEXT}
(rx (group (or string-start (not "\\"))) "{" ; unescaped {
(group (optional (seq (*? anything) (not "\\")))) ; TEXT
"}")) ; unescaped }
(defun citeproc-bt--process-brackets (s &optional lhb rhb)
"Process LaTeX curly brackets in string S.
@@ -250,11 +252,11 @@ The default is to remove them."
match t))
((string-match citeproc-bt--braces-rx result)
(setq result (replace-match
(concat lhb "\\1" rhb)
(concat "\\1" lhb "\\2" rhb)
t nil result)
match t))
(t (setq match nil))))
result))
(s-replace-all '(("\\{" . "{") ("\\}" . "}")) result)))
(defun citeproc-bt--preprocess-for-decode (s)
"Preprocess field S before decoding.
lisp/citeproc/citeproc-formatters.el
+1 -1
View File
@@ -258,7 +258,7 @@ CSL tests."
;; LaTeX
(defconst citeproc-fmt--latex-esc-regex
(regexp-opt '("_" "&" "#" "%" "$"))
(regexp-opt '("_" "&" "#" "%" "$" "{" "}" ))
"Regular expression matching characters to be escaped in LaTeX output.")
(defun citeproc-fmt--latex-escape (s)
lisp/citeproc/citeproc-locale.el
+11 -6
View File
@@ -63,7 +63,7 @@ simply the result of upcasing.")
(defun citeproc-locale-getter-from-dir (dir)
"Return a locale getter getting parsed locales from a local DIR.
If the requested locale couldn't be read then return the parsed
en-US locale, which must exist."
en-US locale, which must exist, and warn the user."
(let ((default-loc-file (f-join dir "locales-en-US.xml")))
(lambda (loc)
(let* ((ext-loc (if (or (member loc citeproc-locale--simple-locales)
@@ -75,11 +75,16 @@ en-US locale, which must exist."
(citeproc-lib-remove-xml-comments
(citeproc-lib-parse-xml-file
(if loc-available loc-file
(if (not (f-readable-p default-loc-file))
(error
"The default CSL locale file %s doesn't exist or is unreadable"
default-loc-file)
default-loc-file))))))))
(if (not (f-readable-p default-loc-file))
(error
"The default CSL locale file %s doesn't exist or is unreadable"
default-loc-file)
(display-warning
'citeproc
(format
"Could not read CSL locale file %s, using the fallback en-US locale"
loc-file))
default-loc-file))))))))
(defun citeproc-locale-termlist-from-xml-frag (frag)
"Transform xml FRAG representing citeproc--terms into a citeproc-term list."
lisp/citeproc/citeproc-pkg.el
+3 -3
View File
@@ -1,5 +1,5 @@
;; -*- no-byte-compile: t; lexical-binding: nil -*-
(define-package "citeproc" "20250525.1011"
(define-package "citeproc" "20251103.716"
"A CSL 1.0.2 Citation Processor."
'((emacs "26")
(dash "2.13.0")
@@ -11,8 +11,8 @@
(parsebib "2.4")
(compat "28.1"))
:url "https://github.com/andras-simonyi/citeproc-el"
:commit "e3bf1f80bcd64edf4afef564c0d94d38aa567d61"
:revdesc "e3bf1f80bcd6"
:commit "a3d62ab8e40a75fcfc6e4c0c107e3137b4db6db8"
:revdesc "a3d62ab8e40a"
:keywords '("bib")
:authors '(("András Simonyi" . "andras.simonyi@gmail.com"))
:maintainers '(("András Simonyi" . "andras.simonyi@gmail.com")))
lisp/citeproc/citeproc-s.el
+1 -1
View File
@@ -247,7 +247,7 @@ REPLACEMENTS is an alist with (FROM . TO) elements."
"Replace dumb apostophes in string S with smart ones.
The replacement character used is the unicode character `modifier
letter apostrophe'."
(subst-char-in-string ?' ?ʼ (subst-char-in-string ?’ ?ʼ s t) t))
(string-replace "'" "ʼ" (string-replace "’" "ʼ" s)))
(defconst citeproc-s--cull-spaces-alist
'((" " . " ") (";;" . ";") ("..." . ".") (",," . ",") (".." . "."))
lisp/citeproc/citeproc.el
+2 -2
View File
@@ -7,8 +7,8 @@
;; URL: https://github.com/andras-simonyi/citeproc-el
;; Keywords: bib
;; Package-Requires: ((emacs "26") (dash "2.13.0") (s "1.12.0") (f "0.18.0") (queue "0.2") (string-inflection "1.0") (org "9") (parsebib "2.4")(compat "28.1"))
;; Package-Version: 20250525.1011
;; Package-Revision: e3bf1f80bcd6
;; Package-Version: 20251103.716
;; Package-Revision: a3d62ab8e40a
;; 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
lisp/company-statistics/company-statistics-pkg.el
+3 -3
View File
@@ -1,11 +1,11 @@
;; -*- no-byte-compile: t; lexical-binding: nil -*-
(define-package "company-statistics" "20170210.1933"
(define-package "company-statistics" "20250805.1524"
"Sort candidates using completion history."
'((emacs "24.3")
(company "0.8.5"))
:url "https://github.com/company-mode/company-statistics"
:commit "e62157d43b2c874d2edbd547c3bdfb05d0a7ae5c"
:revdesc "e62157d43b2c"
:commit "120e982f47e01945c044e0762ba376741c41b76c"
:revdesc "120e982f47e0"
:keywords '("abbrev" "convenience" "matching")
:authors '(("Ingo Lohmar" . "i.lohmar@gmail.com"))
:maintainers '(("Ingo Lohmar" . "i.lohmar@gmail.com")))
lisp/company-statistics/company-statistics.el
+5 -3
View File
@@ -4,8 +4,8 @@
;; Author: Ingo Lohmar <i.lohmar@gmail.com>
;; URL: https://github.com/company-mode/company-statistics
;; Package-Version: 20170210.1933
;; Package-Revision: e62157d43b2c
;; Package-Version: 20250805.1524
;; Package-Revision: 120e982f47e0
;; Keywords: abbrev, convenience, matching
;; Package-Requires: ((emacs "24.3") (company "0.8.5"))
@@ -347,7 +347,9 @@ preserved automatically between Emacs sessions in the default
configuration. You can customize this behavior with
`company-statistics-auto-save', `company-statistics-auto-restore' and
`company-statistics-file'."
nil nil nil
:init-value nil
:lighter nil
:keymap nil
:global t
(if company-statistics-mode
(progn
lisp/company/company-dabbrev.el
+4 -2
View File
@@ -198,9 +198,11 @@ This variable affects both `company-dabbrev' and `company-dabbrev-code'."
(company-dabbrev--search (company-dabbrev--make-regexp)
company-dabbrev-time-limit
(pcase company-dabbrev-other-buffers
(`t (list major-mode))
('t (list major-mode))
;; `all' is a function starting with Emacs 31.
('all 'all)
((pred functionp) (funcall company-dabbrev-other-buffers (current-buffer)))
(`all `all))))
)))
;;;###autoload
(defun company-dabbrev (command &optional arg &rest _ignored)
lisp/company/company-files.el
+1 -1
View File
@@ -123,7 +123,7 @@ The values should use the same format as `completion-ignored-extensions'."
(defun company-files--prefix ()
(let ((existing (company-files--grab-existing-name)))
(when existing
(list existing (company-grab-suffix "[^ '\"\t\n\r/]*/?")))))
(list existing (company-grab-suffix "[^] '\"\t\n\r/]*/?")))))
(defun company-file--keys-match-p (new old)
(and (equal (cdr old) (cdr new))
lisp/company/company-keywords.el
+4 -4
View File
@@ -292,10 +292,10 @@
"then" "type" "where")
(python-mode
;; https://docs.python.org/3/reference/lexical_analysis.html#keywords
"False" "None" "True" "and" "as" "assert" "break" "class" "continue" "def"
"del" "elif" "else" "except" "exec" "finally" "for" "from" "global" "if"
"import" "in" "is" "lambda" "nonlocal" "not" "or" "pass" "print" "raise"
"return" "try" "while" "with" "yield")
"False" "None" "True" "and" "as" "assert" "async" "await" "break" "class"
"continue" "def" "del" "elif" "else" "except" "exec" "finally" "for" "from"
"global" "if" "import" "in" "is" "lambda" "nonlocal" "not" "or" "pass"
"print" "raise" "return" "try" "while" "with" "yield")
(ruby-mode
"BEGIN" "END" "alias" "and" "begin" "break" "case" "class" "def" "defined?"
"do" "else" "elsif" "end" "ensure" "false" "for" "if" "in" "module"
lisp/company/company-pkg.el
+3 -3
View File
@@ -1,9 +1,9 @@
;; -*- no-byte-compile: t; lexical-binding: nil -*-
(define-package "company" "20250426.1319"
(define-package "company" "20251021.2211"
"Modular text completion framework."
'((emacs "26.1"))
:url "http://company-mode.github.io/"
:commit "41f07c7d401c1374a76f3004a3448d3d36bdf347"
:revdesc "41f07c7d401c"
:commit "4ff89f7369227fbb89fe721d1db707f1af74cd0f"
:revdesc "4ff89f736922"
:keywords '("abbrev" "convenience" "matching")
:maintainers '(("Dmitry Gutov" . "dmitry@gutov.dev")))
lisp/company/company-tng.el
+6 -1
View File
@@ -124,7 +124,12 @@ confirm the selection and finish the completion."
(when (and company-selection
(not (company--company-command-p (this-command-keys))))
(company--unread-this-command-keys)
(setq this-command 'company-complete-selection)))))
(setq this-command 'company-complete-selection)))
(post-command
(when (and (eq this-command 'company-complete-selection)
(zerop (length (car (company--boundaries))))
(eql (preceding-char) (car unread-command-events)))
(delete-char -1)))))
(defvar company-clang-insert-arguments)
(defvar company-semantic-insert-arguments)
lisp/company/company.el
+4 -3
View File
@@ -5,8 +5,8 @@
;; Author: Nikolaj Schumacher
;; Maintainer: Dmitry Gutov <dmitry@gutov.dev>
;; URL: http://company-mode.github.io/
;; Package-Version: 20250426.1319
;; Package-Revision: 41f07c7d401c
;; Package-Version: 20251021.2211
;; Package-Revision: 4ff89f736922
;; Keywords: abbrev, convenience, matching
;; Package-Requires: ((emacs "26.1"))
@@ -1436,8 +1436,9 @@ be recomputed when this value changes."
(let* ((entity (and
(not (keywordp backend))
(company--force-sync backend '(prefix) backend)))
(new-len (company--prefix-len entity)))
new-len)
(when (stringp (company--prefix-str entity))
(setq new-len (company--prefix-len entity))
(or (not backends-after-with)
(unless (memq backend backends-after-with)
(setq backends-after-with nil)))
lisp/company/company.info
+41 -42
View File
@@ -1,4 +1,4 @@
This is company.info, produced by makeinfo version 7.1.1 from
This is company.info, produced by makeinfo version 7.2 from
company.texi.
This user manual is for Company version 1.0.3-snapshot
@@ -82,7 +82,6 @@ Backends
* Package Backends::
* Candidates Post-Processing::

File: company.info, Node: Overview, Next: Getting Started, Prev: Top, Up: Top
@@ -1772,52 +1771,52 @@ Concept Index
* troubleshoot: Troubleshooting. (line 6)
* usage: Usage Basics. (line 6)

Tag Table:
Node: Top575
Node: Overview2002
Node: Terminology2410
Node: Structure3713
Node: Getting Started5203
Node: Installation5481
Node: Initial Setup5864
Node: Usage Basics6712
Node: Commands7686
Ref: Commands-Footnote-110082
Node: Customization10249
Node: Customization Interface10721
Node: Configuration File11254
Ref: company-selection-wrap-around13566
Node: Frontends16055
Node: Tooltip Frontends17024
Ref: Tooltip Frontends-Footnote-127720
Node: Preview Frontends27957
Ref: Preview Frontends-Footnote-129215
Node: Echo Frontends29342
Node: Candidates Search30871
Node: Filter Candidates32203
Node: Quick Access a Candidate32983
Node: Backends34601
Node: Backends Usage Basics35631
Ref: Backends Usage Basics-Footnote-137063
Node: Grouped Backends37147
Node: Package Backends38658
Node: Code Completion39585
Node: Text Completion45102
Node: File Name Completion49526
Node: Template Expansion51072
Node: Candidates Post-Processing51791
Node: Troubleshooting54368
Node: Index56039
Node: Key Index56202
Node: Variable Index57701
Node: Function Index62554
Node: Concept Index67254
Node: Top573
Node: Overview1999
Node: Terminology2407
Node: Structure3710
Node: Getting Started5200
Node: Installation5478
Node: Initial Setup5861
Node: Usage Basics6709
Node: Commands7683
Ref: Commands-Footnote-110079
Node: Customization10246
Node: Customization Interface10718
Node: Configuration File11251
Ref: company-selection-wrap-around13563
Node: Frontends16052
Node: Tooltip Frontends17021
Ref: Tooltip Frontends-Footnote-127717
Node: Preview Frontends27954
Ref: Preview Frontends-Footnote-129212
Node: Echo Frontends29339
Node: Candidates Search30868
Node: Filter Candidates32200
Node: Quick Access a Candidate32980
Node: Backends34598
Node: Backends Usage Basics35628
Ref: Backends Usage Basics-Footnote-137060
Node: Grouped Backends37144
Node: Package Backends38655
Node: Code Completion39582
Node: Text Completion45099
Node: File Name Completion49523
Node: Template Expansion51069
Node: Candidates Post-Processing51788
Node: Troubleshooting54365
Node: Index56036
Node: Key Index56199
Node: Variable Index57698
Node: Function Index62551
Node: Concept Index67251

End Tag Table

Local Variables:
coding: utf-8
Info-documentlanguage: en
End:
lisp/dash/dash.info
+212 -212
View File
@@ -1,4 +1,4 @@
This is dash.info, produced by makeinfo version 7.1.1 from dash.texi.
This is dash.info, produced by makeinfo version 7.2 from dash.texi.
This manual is for Dash version 2.20.0.
@@ -4732,223 +4732,223 @@ Index
* global-dash-fontify-mode: Fontification of special variables.
(line 12)

Tag Table:
Node: Top734
Node: Installation2377
Node: Using in a package3139
Node: Fontification of special variables3482
Node: Info symbol lookup4272
Node: Functions4855
Node: Maps6339
Ref: -map6636
Ref: -map-when7007
Ref: -map-first7581
Ref: -map-last8176
Ref: -map-indexed8766
Ref: -annotate9450
Ref: -splice10052
Ref: -splice-list11125
Ref: -mapcat11584
Ref: -copy11957
Node: Sublist selection12223
Ref: -filter12416
Ref: -remove12967
Ref: -remove-first13514
Ref: -remove-last14358
Ref: -remove-item15086
Ref: -non-nil15486
Ref: -slice15768
Ref: -take16297
Ref: -take-last16715
Ref: -drop17152
Ref: -drop-last17599
Ref: -take-while18031
Ref: -drop-while18656
Ref: -select-by-indices19287
Ref: -select-columns19794
Ref: -select-column20497
Node: List to list20960
Ref: -keep21152
Ref: -concat21728
Ref: -flatten22508
Ref: -flatten-n23268
Ref: -replace23652
Ref: -replace-first24113
Ref: -replace-last24608
Ref: -insert-at25096
Ref: -replace-at25421
Ref: -update-at25808
Ref: -remove-at26349
Ref: -remove-at-indices26976
Node: Reductions27666
Ref: -reduce-from27862
Ref: -reduce-r-from28584
Ref: -reduce29845
Ref: -reduce-r30594
Ref: -reductions-from31870
Ref: -reductions-r-from32672
Ref: -reductions33498
Ref: -reductions-r34205
Ref: -count34946
Ref: -sum35176
Ref: -running-sum35364
Ref: -product35685
Ref: -running-product35893
Ref: -inits36234
Ref: -tails36479
Ref: -common-prefix36724
Ref: -common-suffix37018
Ref: -min37312
Ref: -min-by37538
Ref: -max38059
Ref: -max-by38284
Ref: -frequencies38810
Node: Unfolding39425
Ref: -iterate39666
Ref: -unfold40113
Ref: -repeat40918
Ref: -cycle41202
Node: Predicates41599
Ref: -some41776
Ref: -every42203
Ref: -any?42915
Ref: -all?43264
Ref: -none?44004
Ref: -only-some?44324
Ref: -contains?44869
Ref: -is-prefix?45375
Ref: -is-suffix?45707
Ref: -is-infix?46039
Ref: -cons-pair?46399
Node: Partitioning46730
Ref: -split-at46918
Ref: -split-with47582
Ref: -split-on48222
Ref: -split-when48893
Ref: -separate49536
Ref: -partition50070
Ref: -partition-all50519
Ref: -partition-in-steps50944
Ref: -partition-all-in-steps51490
Ref: -partition-by52004
Ref: -partition-by-header52382
Ref: -partition-after-pred52983
Ref: -partition-before-pred53434
Ref: -partition-before-item53819
Ref: -partition-after-item54126
Ref: -group-by54428
Node: Indexing54861
Ref: -elem-index55063
Ref: -elem-indices55550
Ref: -find-index56009
Ref: -find-last-index56676
Ref: -find-indices57325
Ref: -grade-up58085
Ref: -grade-down58492
Node: Set operations58906
Ref: -union59089
Ref: -difference59519
Ref: -intersection59947
Ref: -powerset60376
Ref: -permutations60653
Ref: -distinct61091
Ref: -same-items?61485
Node: Other list operations62094
Ref: -rotate62319
Ref: -cons*62672
Ref: -snoc63094
Ref: -interpose63506
Ref: -interleave63800
Ref: -iota64166
Ref: -zip-with64649
Ref: -zip-pair65455
Ref: -zip-lists66021
Ref: -zip-lists-fill66819
Ref: -zip67529
Ref: -zip-fill68556
Ref: -unzip-lists69470
Ref: -unzip70093
Ref: -pad71086
Ref: -table71571
Ref: -table-flat72357
Ref: -first73360
Ref: -last73891
Ref: -first-item74237
Ref: -second-item74649
Ref: -third-item75066
Ref: -fourth-item75441
Ref: -fifth-item75819
Ref: -last-item76194
Ref: -butlast76555
Ref: -sort76800
Ref: -list77294
Ref: -fix77863
Node: Tree operations78352
Ref: -tree-seq78548
Ref: -tree-map79409
Ref: -tree-map-nodes79849
Ref: -tree-reduce80713
Ref: -tree-reduce-from81595
Ref: -tree-mapreduce82195
Ref: -tree-mapreduce-from83054
Ref: -clone84339
Node: Threading macros84677
Ref: ->84902
Ref: ->>85390
Ref: -->85893
Ref: -as->86450
Ref: -some->86904
Ref: -some->>87289
Ref: -some-->87736
Ref: -doto88303
Node: Binding88856
Ref: -when-let89063
Ref: -when-let*89524
Ref: -if-let90053
Ref: -if-let*90419
Ref: -let91042
Ref: -let*97118
Ref: -lambda98055
Ref: -setq98861
Node: Side effects99662
Ref: -each99856
Ref: -each-while100381
Ref: -each-indexed101001
Ref: -each-r101593
Ref: -each-r-while102035
Ref: -dotimes102679
Node: Destructive operations103230
Ref: !cons103448
Ref: !cdr103652
Node: Function combinators103845
Ref: -partial104049
Ref: -rpartial104567
Ref: -juxt105215
Ref: -compose105667
Ref: -applify106274
Ref: -on106704
Ref: -flip107468
Ref: -rotate-args107990
Ref: -const108619
Ref: -cut108961
Ref: -not109441
Ref: -orfn109985
Ref: -andfn110778
Ref: -iteratefn111565
Ref: -fixfn112267
Ref: -prodfn113841
Node: Development114968
Node: Contribute115257
Node: Contributors116265
Node: FDL118358
Node: GPL143477
Node: Index181023
Node: Top732
Node: Installation2375
Node: Using in a package3137
Node: Fontification of special variables3480
Node: Info symbol lookup4270
Node: Functions4853
Node: Maps6337
Ref: -map6634
Ref: -map-when7005
Ref: -map-first7579
Ref: -map-last8174
Ref: -map-indexed8764
Ref: -annotate9448
Ref: -splice10050
Ref: -splice-list11123
Ref: -mapcat11582
Ref: -copy11955
Node: Sublist selection12221
Ref: -filter12414
Ref: -remove12965
Ref: -remove-first13512
Ref: -remove-last14356
Ref: -remove-item15084
Ref: -non-nil15484
Ref: -slice15766
Ref: -take16295
Ref: -take-last16713
Ref: -drop17150
Ref: -drop-last17597
Ref: -take-while18029
Ref: -drop-while18654
Ref: -select-by-indices19285
Ref: -select-columns19792
Ref: -select-column20495
Node: List to list20958
Ref: -keep21150
Ref: -concat21726
Ref: -flatten22506
Ref: -flatten-n23266
Ref: -replace23650
Ref: -replace-first24111
Ref: -replace-last24606
Ref: -insert-at25094
Ref: -replace-at25419
Ref: -update-at25806
Ref: -remove-at26347
Ref: -remove-at-indices26974
Node: Reductions27664
Ref: -reduce-from27860
Ref: -reduce-r-from28582
Ref: -reduce29843
Ref: -reduce-r30592
Ref: -reductions-from31868
Ref: -reductions-r-from32670
Ref: -reductions33496
Ref: -reductions-r34203
Ref: -count34944
Ref: -sum35174
Ref: -running-sum35362
Ref: -product35683
Ref: -running-product35891
Ref: -inits36232
Ref: -tails36477
Ref: -common-prefix36722
Ref: -common-suffix37016
Ref: -min37310
Ref: -min-by37536
Ref: -max38057
Ref: -max-by38282
Ref: -frequencies38808
Node: Unfolding39423
Ref: -iterate39664
Ref: -unfold40111
Ref: -repeat40916
Ref: -cycle41200
Node: Predicates41597
Ref: -some41774
Ref: -every42201
Ref: -any?42913
Ref: -all?43262
Ref: -none?44002
Ref: -only-some?44322
Ref: -contains?44867
Ref: -is-prefix?45373
Ref: -is-suffix?45705
Ref: -is-infix?46037
Ref: -cons-pair?46397
Node: Partitioning46728
Ref: -split-at46916
Ref: -split-with47580
Ref: -split-on48220
Ref: -split-when48891
Ref: -separate49534
Ref: -partition50068
Ref: -partition-all50517
Ref: -partition-in-steps50942
Ref: -partition-all-in-steps51488
Ref: -partition-by52002
Ref: -partition-by-header52380
Ref: -partition-after-pred52981
Ref: -partition-before-pred53432
Ref: -partition-before-item53817
Ref: -partition-after-item54124
Ref: -group-by54426
Node: Indexing54859
Ref: -elem-index55061
Ref: -elem-indices55548
Ref: -find-index56007
Ref: -find-last-index56674
Ref: -find-indices57323
Ref: -grade-up58083
Ref: -grade-down58490
Node: Set operations58904
Ref: -union59087
Ref: -difference59517
Ref: -intersection59945
Ref: -powerset60374
Ref: -permutations60651
Ref: -distinct61089
Ref: -same-items?61483
Node: Other list operations62092
Ref: -rotate62317
Ref: -cons*62670
Ref: -snoc63092
Ref: -interpose63504
Ref: -interleave63798
Ref: -iota64164
Ref: -zip-with64647
Ref: -zip-pair65453
Ref: -zip-lists66019
Ref: -zip-lists-fill66817
Ref: -zip67527
Ref: -zip-fill68554
Ref: -unzip-lists69468
Ref: -unzip70091
Ref: -pad71084
Ref: -table71569
Ref: -table-flat72355
Ref: -first73358
Ref: -last73889
Ref: -first-item74235
Ref: -second-item74647
Ref: -third-item75064
Ref: -fourth-item75439
Ref: -fifth-item75817
Ref: -last-item76192
Ref: -butlast76553
Ref: -sort76798
Ref: -list77292
Ref: -fix77861
Node: Tree operations78350
Ref: -tree-seq78546
Ref: -tree-map79407
Ref: -tree-map-nodes79847
Ref: -tree-reduce80711
Ref: -tree-reduce-from81593
Ref: -tree-mapreduce82193
Ref: -tree-mapreduce-from83052
Ref: -clone84337
Node: Threading macros84675
Ref: ->84900
Ref: ->>85388
Ref: -->85891
Ref: -as->86448
Ref: -some->86902
Ref: -some->>87287
Ref: -some-->87734
Ref: -doto88301
Node: Binding88854
Ref: -when-let89061
Ref: -when-let*89522
Ref: -if-let90051
Ref: -if-let*90417
Ref: -let91040
Ref: -let*97116
Ref: -lambda98053
Ref: -setq98859
Node: Side effects99660
Ref: -each99854
Ref: -each-while100379
Ref: -each-indexed100999
Ref: -each-r101591
Ref: -each-r-while102033
Ref: -dotimes102677
Node: Destructive operations103228
Ref: !cons103446
Ref: !cdr103650
Node: Function combinators103843
Ref: -partial104047
Ref: -rpartial104565
Ref: -juxt105213
Ref: -compose105665
Ref: -applify106272
Ref: -on106702
Ref: -flip107466
Ref: -rotate-args107988
Ref: -const108617
Ref: -cut108959
Ref: -not109439
Ref: -orfn109983
Ref: -andfn110776
Ref: -iteratefn111563
Ref: -fixfn112265
Ref: -prodfn113839
Node: Development114966
Node: Contribute115255
Node: Contributors116263
Node: FDL118356
Node: GPL143475
Node: Index181021

End Tag Table

Local Variables:
coding: utf-8
Info-documentlanguage: en
End:
lisp/diff-hl/diff-hl-autoloads.el
+58 -26
View File
@@ -28,8 +28,6 @@ evaluate the variable `diff-hl-mode'.
The mode's hook is called both when the mode is enabled and when it is
disabled.
\\{diff-hl-mode-map}
(fn &optional ARG)" t)
(autoload 'turn-on-diff-hl-mode "diff-hl" "\
Turn on `diff-hl-mode' or `diff-hl-dir-mode' in a buffer if appropriate.")
@@ -39,6 +37,11 @@ Call `turn-on-diff-hl-mode' if the current major mode is applicable.")
Set the reference revision globally to REV.
When called interactively, REV read with completion.
When called with a prefix argument, reset the global reference to the most
recent one instead. With two prefix arguments, do the same and discard
every per-project reference created by
`diff-hl-set-reference-rev-in-project`.
The default value chosen using one of methods below:
- In a log view buffer, it uses the revision of current entry.
@@ -47,9 +50,33 @@ view buffer.
- In a VC annotate buffer, it uses the revision of current line.
- In other situations, it uses the symbol at point.
Notice that this sets the reference revision globally, so in
files from other repositories, `diff-hl-mode' will not highlight
changes correctly, until you run `diff-hl-reset-reference-rev'.
Notice that this sets the reference revision globally, so in files from
other repositories, `diff-hl-mode' will not highlight changes correctly,
until you run `diff-hl-reset-reference-rev'. To set the reference on a
per-project basis, see `diff-hl-set-reference-rev-in-project`.
Also notice that this will disable `diff-hl-amend-mode' in
buffers that enables it, since `diff-hl-amend-mode' overrides its
effect.
(fn REV)" t)
(autoload 'diff-hl-set-reference-rev-in-project "diff-hl" "\
Set the reference revision in the current project to REV.
When called interactively, REV read with completion.
When called with a prefix argument, reset to the global value instead.
The default value chosen using one of methods below:
- In a log view buffer, it uses the revision of current entry.
Call `vc-print-log' or `vc-print-root-log' first to open a log
view buffer.
- In a VC annotate buffer, it uses the revision of current line.
- In other situations, it uses the symbol at point.
Projects whose reference was set with this command are unaffected by
subsequent changes to the global reference (see
`diff-hl-set-reference-rev`).
Also notice that this will disable `diff-hl-amend-mode' in
buffers that enables it, since `diff-hl-amend-mode' overrides its
@@ -57,7 +84,12 @@ effect.
(fn REV)" t)
(autoload 'diff-hl-reset-reference-rev "diff-hl" "\
Reset the reference revision globally to the most recent one." t)
Reset the reference revision globally to the most recent one.
When called with a prefix argument, do the same and discard every
per-project reference created by `diff-hl-set-reference-rev-in-project'.
(fn &optional ARG)" t)
(put 'global-diff-hl-mode 'globalized-minor-mode t)
(defvar global-diff-hl-mode nil "\
Non-nil if Global Diff-Hl mode is enabled.
@@ -82,7 +114,7 @@ would do it.
See `diff-hl-mode' for more information on Diff-Hl mode.
(fn &optional ARG)" t)
(register-definition-prefixes "diff-hl" '("diff-hl-"))
(register-definition-prefixes "diff-hl" '("diff-hl-" "static-if"))
;;; Generated autoloads from diff-hl-amend.el
@@ -192,20 +224,6 @@ disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "diff-hl-flydiff" '("diff-hl-flydiff"))
;;; Generated autoloads from diff-hl-inline-popup.el
(autoload 'diff-hl-inline-popup-hide "diff-hl-inline-popup" "\
Hide the current inline popup." t)
(autoload 'diff-hl-inline-popup-show "diff-hl-inline-popup" "\
Create a phantom overlay to show the inline popup, with some
content LINES, and a HEADER and a FOOTER, at POINT. KEYMAP is
added to the current keymaps. CLOSE-HOOK is called when the popup
is closed.
(fn LINES &optional HEADER FOOTER KEYMAP CLOSE-HOOK POINT HEIGHT)")
(register-definition-prefixes "diff-hl-inline-popup" '("diff-hl-inline-popup-"))
;;; Generated autoloads from diff-hl-margin.el
@@ -260,11 +278,6 @@ disabled.
;;; Generated autoloads from diff-hl-show-hunk.el
(autoload 'diff-hl-show-hunk-inline-popup "diff-hl-show-hunk" "\
Implementation to show the hunk in a inline popup.
BUFFER is a buffer with the hunk.
(fn BUFFER &optional IGNORED-LINE)")
(autoload 'diff-hl-show-hunk-previous "diff-hl-show-hunk" "\
Go to previous hunk/change and show it." t)
(autoload 'diff-hl-show-hunk-next "diff-hl-show-hunk" "\
@@ -325,6 +338,25 @@ Diff-Hl-Show-Hunk-Mouse mode.
(fn &optional ARG)" t)
(register-definition-prefixes "diff-hl-show-hunk" '("diff-hl-show-hunk-"))
;;; Generated autoloads from diff-hl-show-hunk-inline.el
(autoload 'diff-hl-show-hunk-inline-hide "diff-hl-show-hunk-inline" "\
Hide the current inline popup." t)
(autoload 'diff-hl-show-hunk-inline-show "diff-hl-show-hunk-inline" "\
Create a phantom overlay to show the inline popup, with some
content LINES, and a HEADER and a FOOTER, at POINT. KEYMAP is
added to the current keymaps. CLOSE-HOOK is called when the popup
is closed.
(fn LINES &optional HEADER FOOTER KEYMAP CLOSE-HOOK POINT HEIGHT)")
(autoload 'diff-hl-show-hunk-inline "diff-hl-show-hunk-inline" "\
Implementation to show the hunk in a inline popup.
BUFFER is a buffer with the hunk.
(fn BUFFER &optional IGNORED-LINE)")
(register-definition-prefixes "diff-hl-show-hunk-inline" '("diff-hl-show-hunk-inline-"))
;;; Generated autoloads from diff-hl-show-hunk-posframe.el
lisp/diff-hl/diff-hl-dired.el
+5 -1
View File
@@ -74,6 +74,10 @@ status indicators."
`(const :tag ,(symbol-name name) ,name))
vc-handled-backends))))
(defcustom diff-hl-dired-fringe-bmp-function 'diff-hl-fringe-bmp-from-type
"Function to determine fringe bitmap from change type and position."
:type 'function)
;;;###autoload
(define-minor-mode diff-hl-dired-mode
"Toggle VC diff highlighting on the side of a Dired window."
@@ -151,7 +155,7 @@ for DIR containing FILES. Call UPDATE-FUNCTION as entries are added."
(goto-char (point-min))
(when (and type (dired-goto-file-1
file (expand-file-name file) nil))
(let* ((diff-hl-fringe-bmp-function 'diff-hl-fringe-bmp-from-type)
(let* ((diff-hl-fringe-bmp-function diff-hl-dired-fringe-bmp-function)
(diff-hl-fringe-face-function 'diff-hl-dired-face-from-type)
(o (diff-hl-add-highlighting type 'single)))
(overlay-put o 'modification-hooks '(diff-hl-overlay-modified))
lisp/diff-hl/diff-hl-flydiff.el
+7 -3
View File
@@ -1,4 +1,4 @@
;; Copyright (C) 2015-2021 Free Software Foundation, Inc. -*- lexical-binding: t -*-
;; Copyright (C) 2015-2025 Free Software Foundation, Inc. -*- lexical-binding: t -*-
;; Author: Jonathan Hayase <PythonNut@gmail.com>
;; URL: https://github.com/dgutov/diff-hl
@@ -40,9 +40,13 @@
(defvar diff-hl-flydiff-timer nil)
(make-variable-buffer-local 'diff-hl-flydiff-modified-tick)
(defun diff-hl-flydiff-changes-buffer (file &optional backend)
(defun diff-hl-flydiff-changes-buffer (file backend &optional new-rev buffer)
(setq buffer (or buffer " *diff-hl-diff*"))
(setq diff-hl-flydiff-modified-tick (buffer-chars-modified-tick))
(diff-hl-diff-buffer-with-reference file " *diff-hl-diff*" backend))
(if new-rev
(diff-hl-with-diff-switches
(diff-hl-diff-against-reference file backend buffer new-rev))
(diff-hl-diff-buffer-with-reference file buffer backend)))
(defun diff-hl-flydiff-update ()
(unless (or
lisp/diff-hl/diff-hl-inline-popup.el
-289
View File
@@ -1,289 +0,0 @@
;;; diff-hl-inline-popup.el --- inline popup using phantom overlays -*- lexical-binding: t -*-
;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
;; Author: Álvaro González <alvarogonzalezsotillo@gmail.com>
;; This file is part of GNU Emacs.
;; GNU Emacs 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.
;; GNU Emacs 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 GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; Shows inline popups using phantom overlays. The lines of the popup
;; can be scrolled.
;;; Code:
(require 'subr-x)
(defvar diff-hl-inline-popup--current-popup nil "The overlay of the current inline popup.")
(defvar diff-hl-inline-popup--current-lines nil "A list of the lines to show in the popup.")
(defvar diff-hl-inline-popup--current-index nil "First line showed in popup.")
(defvar diff-hl-inline-popup--invokinkg-command nil "Command that invoked the popup.")
(defvar diff-hl-inline-popup--current-footer nil "String to be displayed in the footer.")
(defvar diff-hl-inline-popup--current-header nil "String to be displayed in the header.")
(defvar diff-hl-inline-popup--height nil "Height of the popup.")
(defvar diff-hl-inline-popup--current-custom-keymap nil "Keymap to be added to the keymap of the inline popup.")
(defvar diff-hl-inline-popup--close-hook nil "Function to be called when the popup closes.")
(make-variable-buffer-local 'diff-hl-inline-popup--current-popup)
(make-variable-buffer-local 'diff-hl-inline-popup--current-lines)
(make-variable-buffer-local 'diff-hl-inline-popup--current-index)
(make-variable-buffer-local 'diff-hl-inline-popup--current-header)
(make-variable-buffer-local 'diff-hl-inline-popup--current-footer)
(make-variable-buffer-local 'diff-hl-inline-popup--invokinkg-command)
(make-variable-buffer-local 'diff-hl-inline-popup--current-custom-keymap)
(make-variable-buffer-local 'diff-hl-inline-popup--height)
(make-variable-buffer-local 'diff-hl-inline-popup--close-hook)
(defun diff-hl-inline-popup--splice (list offset length)
"Compute a sublist of LIST starting at OFFSET, of LENGTH."
(butlast
(nthcdr offset list)
(- (length list) length offset)))
(defun diff-hl-inline-popup--ensure-enough-lines (pos content-height)
"Ensure there is enough lines below POS to show the inline popup.
CONTENT-HEIGHT specifies the height of the popup."
(let* ((line (line-number-at-pos pos))
(end (line-number-at-pos (window-end nil t)))
(height (+ 6 content-height))
(overflow (- (+ line height) end)))
(when (< 0 overflow)
(run-with-timer 0.1 nil #'scroll-up overflow))))
(defun diff-hl-inline-popup--compute-content-height (&optional content-size)
"Compute the height of the inline popup.
Default for CONTENT-SIZE is the size of the current lines"
(let ((content-size (or content-size (length diff-hl-inline-popup--current-lines)))
(max-size (- (/(window-height) 2) 3)))
(min content-size max-size)))
(defun diff-hl-inline-popup--compute-content-lines (lines index window-size)
"Compute the lines to show in the popup.
Compute it from LINES starting at INDEX with a WINDOW-SIZE."
(let* ((len (length lines))
(window-size (min window-size len))
(index (min index (- len window-size))))
(diff-hl-inline-popup--splice lines index window-size)))
(defun diff-hl-inline-popup--compute-header (width &optional header)
"Compute the header of the popup.
Compute it from some WIDTH, and some optional HEADER text."
(let* ((scroll-indicator (if (eq diff-hl-inline-popup--current-index 0) " " " ⬆ "))
(header (or header ""))
(new-width (- width (length header) (length scroll-indicator)))
(header (if (< new-width 0) "" header))
(new-width (- width (length header) (length scroll-indicator)))
(line (propertize (concat (diff-hl-inline-popup--separator new-width)
header scroll-indicator )
'face '(:underline t))))
(concat line "\n") ))
(defun diff-hl-inline-popup--compute-footer (width &optional footer)
"Compute the header of the popup.
Compute it from some WIDTH, and some optional FOOTER text."
(let* ((scroll-indicator (if (>= diff-hl-inline-popup--current-index
(- (length diff-hl-inline-popup--current-lines)
diff-hl-inline-popup--height))
" "
" ⬇ "))
(footer (or footer ""))
(new-width (- width (length footer) (length scroll-indicator)))
(footer (if (< new-width 0) "" footer))
(new-width (- width (length footer) (length scroll-indicator)))
(blank-line (if (display-graphic-p)
""
(concat "\n" (propertize (diff-hl-inline-popup--separator width)
'face '(:underline t)))))
(line (propertize (concat (diff-hl-inline-popup--separator new-width)
footer scroll-indicator)
'face '(:overline t))))
(concat blank-line "\n" line)))
(defun diff-hl-inline-popup--separator (width &optional sep)
"Return the horizontal separator with character SEP and a WIDTH."
(let ((sep (or sep ?\s)))
(make-string width sep)))
(defun diff-hl-inline-popup--available-width ()
"Compute the available width in chars."
(let ((magic-adjust 3))
(if (not (display-graphic-p))
(let* ((linumber-width (line-number-display-width nil))
(width (- (window-body-width) linumber-width magic-adjust)))
width)
(let* ((font-width (window-font-width))
(window-width (window-body-width nil t))
(linenumber-width (line-number-display-width t))
(available-pixels (- window-width linenumber-width))
(width (- (/ available-pixels font-width) magic-adjust)))
;; https://emacs.stackexchange.com/questions/5495/how-can-i-determine-the-width-of-characters-on-the-screen
width))))
(defun diff-hl-inline-popup--compute-popup-str (lines index window-size header footer)
"Compute the string that represents the popup.
There are some content LINES starting at INDEX, with a WINDOW-SIZE. HEADER and
FOOTER are showed at start and end."
(let* ((width (diff-hl-inline-popup--available-width))
(content-lines (diff-hl-inline-popup--compute-content-lines lines index window-size))
(header (diff-hl-inline-popup--compute-header width header))
(footer (diff-hl-inline-popup--compute-footer width footer)))
(concat header (string-join content-lines "\n") footer "\n")))
(defun diff-hl-inline-popup-scroll-to (index)
"Scroll the inline popup to make visible the line at position INDEX."
(when diff-hl-inline-popup--current-popup
(setq diff-hl-inline-popup--current-index (max 0 (min index (- (length diff-hl-inline-popup--current-lines) diff-hl-inline-popup--height))))
(let* ((str (diff-hl-inline-popup--compute-popup-str
diff-hl-inline-popup--current-lines
diff-hl-inline-popup--current-index
diff-hl-inline-popup--height
diff-hl-inline-popup--current-header
diff-hl-inline-popup--current-footer)))
;; https://debbugs.gnu.org/38563, `company--replacement-string'.
(add-face-text-property 0 (length str) 'default t str)
(put-text-property 0 1 'cursor 0 str)
(overlay-put diff-hl-inline-popup--current-popup 'before-string str))))
(defun diff-hl-inline-popup--popup-down()
"Scrolls one line down."
(interactive)
(diff-hl-inline-popup-scroll-to (1+ diff-hl-inline-popup--current-index) ))
(defun diff-hl-inline-popup--popup-up()
"Scrolls one line up."
(interactive)
(diff-hl-inline-popup-scroll-to (1- diff-hl-inline-popup--current-index) ))
(defun diff-hl-inline-popup--popup-pagedown()
"Scrolls one page down."
(interactive)
(diff-hl-inline-popup-scroll-to (+ diff-hl-inline-popup--current-index diff-hl-inline-popup--height) ))
(defun diff-hl-inline-popup--popup-pageup()
"Scrolls one page up."
(interactive)
(diff-hl-inline-popup-scroll-to (- diff-hl-inline-popup--current-index diff-hl-inline-popup--height) ))
(defvar diff-hl-inline-popup-transient-mode-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "<prior>") #'diff-hl-inline-popup--popup-pageup)
(define-key map (kbd "M-v") #'diff-hl-inline-popup--popup-pageup)
(define-key map (kbd "<next>") #'diff-hl-inline-popup--popup-pagedown)
(define-key map (kbd "C-v") #'diff-hl-inline-popup--popup-pagedown)
(define-key map (kbd "<up>") #'diff-hl-inline-popup--popup-up)
(define-key map (kbd "C-p") #'diff-hl-inline-popup--popup-up)
(define-key map (kbd "<down>") #'diff-hl-inline-popup--popup-down)
(define-key map (kbd "C-n") #'diff-hl-inline-popup--popup-down)
(define-key map (kbd "C-g") #'diff-hl-inline-popup-hide)
(define-key map [escape] #'diff-hl-inline-popup-hide)
(define-key map (kbd "q") #'diff-hl-inline-popup-hide)
;;http://ergoemacs.org/emacs/emacs_mouse_wheel_config.html
(define-key map (kbd "<mouse-4>") #'diff-hl-inline-popup--popup-up)
(define-key map (kbd "<wheel-up>") #'diff-hl-inline-popup--popup-up)
(define-key map (kbd "<mouse-5>") #'diff-hl-inline-popup--popup-down)
(define-key map (kbd "<wheel-down>") #'diff-hl-inline-popup--popup-down)
map)
"Keymap for command `diff-hl-inline-popup-transient-mode'.
Capture all the vertical movement of the point, and converts it
to scroll in the popup")
(defun diff-hl-inline-popup--ignorable-command-p (command)
"Decide if COMMAND is a command allowed while showing an inline popup."
;; https://emacs.stackexchange.com/questions/653/how-can-i-find-out-in-which-keymap-a-key-is-bound
(let ((keys (where-is-internal command (list diff-hl-inline-popup--current-custom-keymap
diff-hl-inline-popup-transient-mode-map ) t))
(invoking (eq command diff-hl-inline-popup--invokinkg-command)))
(or keys invoking)))
(defun diff-hl-inline-popup--post-command-hook ()
"Called each time a command is executed."
(let ((allowed-command (or
(string-match-p "diff-hl-inline-popup-" (symbol-name this-command))
(diff-hl-inline-popup--ignorable-command-p this-command))))
(unless allowed-command
(diff-hl-inline-popup-hide))))
(define-minor-mode diff-hl-inline-popup-transient-mode
"Temporal minor mode to control an inline popup"
:global nil
(remove-hook 'post-command-hook #'diff-hl-inline-popup--post-command-hook t)
(set-keymap-parent diff-hl-inline-popup-transient-mode-map nil)
(when diff-hl-inline-popup-transient-mode
(set-keymap-parent diff-hl-inline-popup-transient-mode-map
diff-hl-inline-popup--current-custom-keymap)
(add-hook 'post-command-hook #'diff-hl-inline-popup--post-command-hook 0 t)))
;;;###autoload
(defun diff-hl-inline-popup-hide()
"Hide the current inline popup."
(interactive)
(when diff-hl-inline-popup-transient-mode
(diff-hl-inline-popup-transient-mode -1))
(when diff-hl-inline-popup--close-hook
(funcall diff-hl-inline-popup--close-hook)
(setq diff-hl-inline-popup--close-hook nil))
(when diff-hl-inline-popup--current-popup
(delete-overlay diff-hl-inline-popup--current-popup)
(setq diff-hl-inline-popup--current-popup nil)))
;;;###autoload
(defun diff-hl-inline-popup-show (lines &optional header footer keymap close-hook point height)
"Create a phantom overlay to show the inline popup, with some
content LINES, and a HEADER and a FOOTER, at POINT. KEYMAP is
added to the current keymaps. CLOSE-HOOK is called when the popup
is closed."
(when diff-hl-inline-popup--current-popup
(delete-overlay diff-hl-inline-popup--current-popup)
(setq diff-hl-inline-popup--current-popup nil))
(when (< (diff-hl-inline-popup--compute-content-height 99) 2)
(user-error "There is no enough vertical space to show the inline popup"))
(let* ((the-point (or point (line-end-position)))
(the-buffer (current-buffer))
(overlay (make-overlay the-point the-point the-buffer)))
(overlay-put overlay 'phantom t)
(overlay-put overlay 'diff-hl-inline-popup t)
(setq diff-hl-inline-popup--current-popup overlay)
(setq diff-hl-inline-popup--current-lines
(mapcar (lambda (s) (replace-regexp-in-string "\n" " " s)) lines))
(setq diff-hl-inline-popup--current-header header)
(setq diff-hl-inline-popup--current-footer footer)
(setq diff-hl-inline-popup--invokinkg-command this-command)
(setq diff-hl-inline-popup--current-custom-keymap keymap)
(setq diff-hl-inline-popup--close-hook close-hook)
(setq diff-hl-inline-popup--height (diff-hl-inline-popup--compute-content-height height))
(setq diff-hl-inline-popup--height (min diff-hl-inline-popup--height
(length diff-hl-inline-popup--current-lines)))
;; (diff-hl-inline-popup--ensure-enough-lines point diff-hl-inline-popup--height)
(diff-hl-inline-popup-transient-mode 1)
(diff-hl-inline-popup-scroll-to 0)
overlay))
(defun diff-hl-inline-popup--hide-all ()
"Testing purposes, use in case some inline popups get stuck in a buffer."
(interactive)
(when diff-hl-inline-popup-transient-mode
(diff-hl-inline-popup-transient-mode -1))
(setq diff-hl-inline-popup--current-popup nil)
(let* ((all-overlays (overlays-in (point-min) (point-max)))
(overlays (cl-remove-if-not (lambda (o)(overlay-get o 'diff-hl-inline-popup)) all-overlays)))
(dolist (o overlays)
(delete-overlay o))))
(provide 'diff-hl-inline-popup)
;;; diff-hl-inline-popup ends here
lisp/diff-hl/diff-hl-margin.el
+52 -13
View File
@@ -40,6 +40,8 @@
(defvar diff-hl-margin-old-highlight-function nil)
(defvar diff-hl-margin-old-highlight-ref-function nil)
(defvar diff-hl-margin-old-width nil)
(defgroup diff-hl-margin nil
@@ -66,13 +68,25 @@
'((default :inherit dired-ignored))
"Face used to highlight changed lines on the margin.")
(defface diff-hl-margin-reference-insert
'((default :inherit diff-hl-reference-insert))
"Face used to highlight lines inserted since reference rev on the margin.")
(defface diff-hl-margin-reference-delete
'((default :inherit diff-hl-reference-delete))
"Face used to highlight lines deleted since reference rev on the margin.")
(defface diff-hl-margin-reference-change
'((default :inherit diff-hl-reference-change))
"Face used to highlight changed since reference rev on the margin.")
(defcustom diff-hl-margin-symbols-alist
'((insert . "+") (delete . "-") (change . "!")
(unknown . "?") (ignored . "i"))
(unknown . "?") (ignored . "i") (reference . " "))
"Associative list from symbols to strings."
:type '(alist :key-type symbol
:value-type string
:options (insert delete change unknown ignored))
:options (insert delete change unknown ignored reference))
:set (lambda (symbol value)
(defvar diff-hl-margin-spec-cache)
(set-default symbol value)
@@ -112,12 +126,17 @@ You probably shouldn't use this function directly."
(progn
(setq-local diff-hl-margin-old-highlight-function
diff-hl-highlight-function)
(setq-local diff-hl-margin-old-highlight-ref-function
diff-hl-highlight-reference-function)
(setq-local diff-hl-highlight-function
#'diff-hl-highlight-on-margin)
(setq-local diff-hl-highlight-reference-function
#'diff-hl-highlight-on-margin-flat)
(setq-local diff-hl-margin-old-width (symbol-value width-var))
(set width-var 1))
(when diff-hl-margin-old-highlight-function
(setq diff-hl-highlight-function diff-hl-margin-old-highlight-function
diff-hl-highlight-reference-function diff-hl-margin-old-highlight-ref-function
diff-hl-margin-old-highlight-function nil))
(set width-var diff-hl-margin-old-width)
(kill-local-variable 'diff-hl-margin-old-width)))
@@ -135,17 +154,32 @@ You probably shouldn't use this function directly."
(diff-hl-margin-build-spec-cache))))
(defun diff-hl-margin-build-spec-cache ()
(cl-loop for (type . char) in diff-hl-margin-symbols-alist
nconc
(cl-loop for side in '(left right)
collect
(cons
(cons type side)
(propertize
" " 'display
`((margin ,(intern (format "%s-margin" side)))
,(propertize char 'face
(intern (format "diff-hl-margin-%s" type)))))))))
(nconc
(cl-loop for (type . char) in diff-hl-margin-symbols-alist
unless (eq type 'reference)
nconc
(cl-loop for side in '(left right)
collect
(cons
(cons type side)
(propertize
" " 'display
`((margin ,(intern (format "%s-margin" side)))
,(propertize char 'face
(intern (format "diff-hl-margin-%s" type))))))))
(cl-loop for char = (or (assoc-default 'reference diff-hl-margin-symbols-alist)
" ")
for type in '(insert delete change)
nconc
(cl-loop for side in '(left right)
collect
(cons
(list type side 'reference)
(propertize
" " 'display
`((margin ,(intern (format "%s-margin" side)))
,(propertize char 'face
(intern (format "diff-hl-margin-reference-%s" type))))))))))
(defun diff-hl-margin-ensure-visible ()
(let ((width-var (intern (format "%s-margin-width" diff-hl-side))))
@@ -160,6 +194,11 @@ You probably shouldn't use this function directly."
(diff-hl-margin-spec-cache)))))
(overlay-put ovl 'before-string spec)))
(defun diff-hl-highlight-on-margin-flat (ovl type _shape)
(let ((spec (cdr (assoc (list type diff-hl-side 'reference)
(diff-hl-margin-spec-cache)))))
(overlay-put ovl 'before-string spec)))
(provide 'diff-hl-margin)
;;; diff-hl-margin.el ends here
lisp/diff-hl/diff-hl-pkg.el
+3 -3
View File
@@ -1,11 +1,11 @@
;; -*- no-byte-compile: t; lexical-binding: nil -*-
(define-package "diff-hl" "20250710.145"
(define-package "diff-hl" "20251125.238"
"Highlight uncommitted changes using VC."
'((cl-lib "0.2")
(emacs "26.1"))
:url "https://github.com/dgutov/diff-hl"
:commit "08243a6e0b681c34eb4e4abf1d1c4c1b251ce91e"
:revdesc "08243a6e0b68"
:commit "8dc486f568afa08dcf9932f4045677df6f5a23f8"
:revdesc "8dc486f568af"
:keywords '("vc" "diff")
:authors '(("Dmitry Gutov" . "dmitry@gutov.dev"))
:maintainers '(("Dmitry Gutov" . "dmitry@gutov.dev")))
lisp/diff-hl/diff-hl-show-hunk-inline.el
+405
View File
@@ -0,0 +1,405 @@
;;; diff-hl-show-hunk-inline.el --- inline popup using phantom overlays -*- lexical-binding: t -*-
;; Copyright (C) 2020-2025 Free Software Foundation, Inc.
;; Author: Álvaro González <alvarogonzalezsotillo@gmail.com>
;; This file is part of GNU Emacs.
;; GNU Emacs 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.
;; GNU Emacs 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 GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; Shows inline popups using phantom overlays. The lines of the popup
;; can be scrolled.
;;; Code:
(require 'subr-x)
(require 'diff-hl-show-hunk)
(define-obsolete-variable-alias 'diff-hl-inline-popup--current-lines 'diff-hl-show-hunk-inline--current-lines "0.11.0")
(define-obsolete-variable-alias 'diff-hl-inline-popup--current-index 'diff-hl-show-hunk-inline--current-index "0.11.0")
(define-obsolete-variable-alias 'diff-hl-inline-popup--invoking-command 'diff-hl-show-hunk-inline--invoking-command "0.11.0")
(define-obsolete-variable-alias 'diff-hl-inline-popup--current-footer 'diff-hl-show-hunk-inline--current-footer "0.11.0")
(define-obsolete-variable-alias 'diff-hl-inline-popup--current-header 'diff-hl-show-hunk-inline--current-header "0.11.0")
(define-obsolete-variable-alias 'diff-hl-inline-popup--height 'diff-hl-show-hunk-inline--height "0.11.0")
(define-obsolete-variable-alias 'diff-hl-inline-popup--current-custom-keymap 'diff-hl-show-hunk-inline--current-custom-keymap "0.11.0")
(define-obsolete-variable-alias 'diff-hl-inline-popup--close-hook 'diff-hl-show-hunk-inline--close-hook "0.11.0")
(define-obsolete-variable-alias 'diff-hl-show-hunk-inline-popup-hide-hunk 'diff-hl-show-hunk-inline-hide-hunk "0.11.0")
(define-obsolete-variable-alias 'diff-hl-show-hunk-inline-popup-smart-lines 'diff-hl-show-hunk-inline-smart-lines "0.11.0")
(define-obsolete-variable-alias 'diff-hl-inline-popup-transient-mode-map 'diff-hl-show-hunk-inline-transient-mode-map "0.11.0")
(defvar diff-hl-show-hunk-inline--current-popup nil "The overlay of the current inline popup.")
(defvar diff-hl-show-hunk-inline--current-lines nil "A list of the lines to show in the popup.")
(defvar diff-hl-show-hunk-inline--current-index nil "First line showed in popup.")
(defvar diff-hl-show-hunk-inline--invoking-command nil "Command that invoked the popup.")
(defvar diff-hl-show-hunk-inline--current-footer nil "String to be displayed in the footer.")
(defvar diff-hl-show-hunk-inline--current-header nil "String to be displayed in the header.")
(defvar diff-hl-show-hunk-inline--height nil "Height of the popup.")
(defvar diff-hl-show-hunk-inline--current-custom-keymap nil "Keymap to be added to the keymap of the inline popup.")
(defvar diff-hl-show-hunk-inline--close-hook nil "Function to be called when the popup closes.")
(make-variable-buffer-local 'diff-hl-show-hunk-inline--current-popup)
(make-variable-buffer-local 'diff-hl-show-hunk-inline--current-lines)
(make-variable-buffer-local 'diff-hl-show-hunk-inline--current-index)
(make-variable-buffer-local 'diff-hl-show-hunk-inline--current-header)
(make-variable-buffer-local 'diff-hl-show-hunk-inline--current-footer)
(make-variable-buffer-local 'diff-hl-show-hunk-inline--invoking-command)
(make-variable-buffer-local 'diff-hl-show-hunk-inline--current-custom-keymap)
(make-variable-buffer-local 'diff-hl-show-hunk-inline--height)
(make-variable-buffer-local 'diff-hl-show-hunk-inline--close-hook)
(defgroup diff-hl-show-hunk-inline nil
"Show vc diffs inline inside a buffer."
:group 'diff-hl-show-hunk)
(defcustom diff-hl-show-hunk-inline-hide-hunk nil
"If t, inline-popup is shown over the hunk, hiding it."
:type 'boolean)
(defcustom diff-hl-show-hunk-inline-smart-lines t
"If t, inline-popup tries to show only the deleted lines of the
hunk. The added lines are shown when scrolling the popup. If
the hunk consist only on added lines, then
`diff-hl-show-hunk--no-lines-removed-message' it is shown."
:type 'boolean)
(defun diff-hl-show-hunk-inline--splice (list offset length)
"Compute a sublist of LIST starting at OFFSET, of LENGTH."
(butlast
(nthcdr offset list)
(- (length list) length offset)))
(defun diff-hl-show-hunk-inline--ensure-enough-lines (pos content-height)
"Ensure there is enough lines below POS to show the inline popup.
CONTENT-HEIGHT specifies the height of the popup."
(let* ((line (line-number-at-pos pos))
(end (line-number-at-pos (window-end nil t)))
(height (+ 6 content-height))
(overflow (- (+ line height) end)))
(when (< 0 overflow)
(run-with-timer 0.1 nil #'scroll-up overflow))))
(defun diff-hl-show-hunk-inline--compute-content-height (&optional content-size)
"Compute the height of the inline popup.
Default for CONTENT-SIZE is the size of the current lines"
(let ((content-size (or content-size (length diff-hl-show-hunk-inline--current-lines)))
(max-size (- (/(window-height) 2) 3)))
(min content-size max-size)))
(defun diff-hl-show-hunk-inline--compute-content-lines (lines index window-size)
"Compute the lines to show in the popup.
Compute it from LINES starting at INDEX with a WINDOW-SIZE."
(let* ((len (length lines))
(window-size (min window-size len))
(index (min index (- len window-size))))
(diff-hl-show-hunk-inline--splice lines index window-size)))
(defun diff-hl-show-hunk-inline--compute-header (width &optional header)
"Compute the header of the popup.
Compute it from some WIDTH, and some optional HEADER text."
(let* ((scroll-indicator (if (eq diff-hl-show-hunk-inline--current-index 0) " " " ⬆ "))
(header (or header ""))
(new-width (- width (length header) (length scroll-indicator)))
(header (if (< new-width 0) "" header))
(new-width (- width (length header) (length scroll-indicator)))
(line (propertize (concat (diff-hl-show-hunk-inline--separator new-width)
header scroll-indicator )
'face '(:underline t))))
(concat line "\n") ))
(defun diff-hl-show-hunk-inline--compute-footer (width &optional footer)
"Compute the header of the popup.
Compute it from some WIDTH, and some optional FOOTER text."
(let* ((scroll-indicator (if (>= diff-hl-show-hunk-inline--current-index
(- (length diff-hl-show-hunk-inline--current-lines)
diff-hl-show-hunk-inline--height))
" "
" ⬇ "))
(footer (or footer ""))
(new-width (- width (length footer) (length scroll-indicator)))
(footer (if (< new-width 0) "" footer))
(new-width (- width (length footer) (length scroll-indicator)))
(blank-line (if (display-graphic-p)
""
(concat "\n" (propertize (diff-hl-show-hunk-inline--separator width)
'face '(:underline t)))))
(line (propertize (concat (diff-hl-show-hunk-inline--separator new-width)
footer scroll-indicator)
'face '(:overline t))))
(concat blank-line "\n" line)))
(defun diff-hl-show-hunk-inline--separator (width &optional sep)
"Return the horizontal separator with character SEP and a WIDTH."
(let ((sep (or sep ?\s)))
(make-string width sep)))
(defun diff-hl-show-hunk-inline--available-width ()
"Compute the available width in chars."
(let ((magic-adjust 3))
(if (not (display-graphic-p))
(let* ((linumber-width (line-number-display-width nil))
(width (- (window-body-width) linumber-width magic-adjust)))
width)
(let* ((font-width (window-font-width))
(window-width (window-body-width nil t))
(linenumber-width (line-number-display-width t))
(available-pixels (- window-width linenumber-width))
(width (- (/ available-pixels font-width) magic-adjust)))
;; https://emacs.stackexchange.com/questions/5495/how-can-i-determine-the-width-of-characters-on-the-screen
width))))
(defun diff-hl-show-hunk-inline--compute-popup-str (lines index window-size header footer)
"Compute the string that represents the popup.
There are some content LINES starting at INDEX, with a WINDOW-SIZE. HEADER and
FOOTER are showed at start and end."
(let* ((width (diff-hl-show-hunk-inline--available-width))
(content-lines (diff-hl-show-hunk-inline--compute-content-lines lines index window-size))
(header (diff-hl-show-hunk-inline--compute-header width header))
(footer (diff-hl-show-hunk-inline--compute-footer width footer)))
(concat header (string-join content-lines "\n") footer "\n")))
(defun diff-hl-show-hunk-inline-scroll-to (index)
"Scroll the inline popup to make visible the line at position INDEX."
(when diff-hl-show-hunk-inline--current-popup
(setq diff-hl-show-hunk-inline--current-index (max 0 (min index (- (length diff-hl-show-hunk-inline--current-lines) diff-hl-show-hunk-inline--height))))
(let* ((str (diff-hl-show-hunk-inline--compute-popup-str
diff-hl-show-hunk-inline--current-lines
diff-hl-show-hunk-inline--current-index
diff-hl-show-hunk-inline--height
diff-hl-show-hunk-inline--current-header
diff-hl-show-hunk-inline--current-footer)))
;; https://debbugs.gnu.org/38563, `company--replacement-string'.
(add-face-text-property 0 (length str) 'default t str)
(put-text-property 0 1 'cursor 0 str)
(overlay-put diff-hl-show-hunk-inline--current-popup 'before-string str))))
(defun diff-hl-show-hunk-inline--popup-down()
"Scrolls one line down."
(interactive)
(diff-hl-show-hunk-inline-scroll-to (1+ diff-hl-show-hunk-inline--current-index) ))
(defun diff-hl-show-hunk-inline--popup-up()
"Scrolls one line up."
(interactive)
(diff-hl-show-hunk-inline-scroll-to (1- diff-hl-show-hunk-inline--current-index) ))
(defun diff-hl-show-hunk-inline--popup-pagedown()
"Scrolls one page down."
(interactive)
(diff-hl-show-hunk-inline-scroll-to (+ diff-hl-show-hunk-inline--current-index diff-hl-show-hunk-inline--height) ))
(defun diff-hl-show-hunk-inline--popup-pageup()
"Scrolls one page up."
(interactive)
(diff-hl-show-hunk-inline-scroll-to (- diff-hl-show-hunk-inline--current-index diff-hl-show-hunk-inline--height) ))
(defvar diff-hl-show-hunk-inline-transient-mode-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "<prior>") #'diff-hl-show-hunk-inline--popup-pageup)
(define-key map (kbd "M-v") #'diff-hl-show-hunk-inline--popup-pageup)
(define-key map (kbd "<next>") #'diff-hl-show-hunk-inline--popup-pagedown)
(define-key map (kbd "C-v") #'diff-hl-show-hunk-inline--popup-pagedown)
(define-key map (kbd "<up>") #'diff-hl-show-hunk-inline--popup-up)
(define-key map (kbd "C-p") #'diff-hl-show-hunk-inline--popup-up)
(define-key map (kbd "<down>") #'diff-hl-show-hunk-inline--popup-down)
(define-key map (kbd "C-n") #'diff-hl-show-hunk-inline--popup-down)
(define-key map (kbd "C-g") #'diff-hl-show-hunk-inline-hide)
(define-key map [escape] #'diff-hl-show-hunk-inline-hide)
(define-key map (kbd "q") #'diff-hl-show-hunk-inline-hide)
;;http://ergoemacs.org/emacs/emacs_mouse_wheel_config.html
(define-key map (kbd "<mouse-4>") #'diff-hl-show-hunk-inline--popup-up)
(define-key map (kbd "<wheel-up>") #'diff-hl-show-hunk-inline--popup-up)
(define-key map (kbd "<mouse-5>") #'diff-hl-show-hunk-inline--popup-down)
(define-key map (kbd "<wheel-down>") #'diff-hl-show-hunk-inline--popup-down)
map)
"Keymap for command `diff-hl-show-hunk-inline-transient-mode'.
Capture all the vertical movement of the point, and converts it
to scroll in the popup")
(defun diff-hl-show-hunk-inline--ignorable-command-p (command)
"Decide if COMMAND is a command allowed while showing an inline popup."
;; https://emacs.stackexchange.com/questions/653/how-can-i-find-out-in-which-keymap-a-key-is-bound
(let ((keys (where-is-internal command (list diff-hl-show-hunk-inline--current-custom-keymap
diff-hl-show-hunk-inline-transient-mode-map ) t))
(invoking (eq command diff-hl-show-hunk-inline--invoking-command)))
(or keys invoking)))
(defun diff-hl-show-hunk-inline--post-command-hook ()
"Called each time a command is executed."
(let ((allowed-command (or
(diff-hl-show-hunk-ignorable-command-p this-command)
(string-match-p "diff-hl-show-hunk-inline-" (symbol-name this-command))
(diff-hl-show-hunk-inline--ignorable-command-p this-command))))
(unless allowed-command
(diff-hl-show-hunk-inline-hide))))
(define-minor-mode diff-hl-show-hunk-inline-transient-mode
"Temporal minor mode to control an inline popup"
:global nil
(remove-hook 'post-command-hook #'diff-hl-show-hunk-inline--post-command-hook t)
(set-keymap-parent diff-hl-show-hunk-inline-transient-mode-map nil)
(when diff-hl-show-hunk-inline-transient-mode
(set-keymap-parent diff-hl-show-hunk-inline-transient-mode-map
diff-hl-show-hunk-inline--current-custom-keymap)
(add-hook 'post-command-hook #'diff-hl-show-hunk-inline--post-command-hook 0 t)))
;;;###autoload
(defun diff-hl-show-hunk-inline-hide()
"Hide the current inline popup."
(interactive)
(when diff-hl-show-hunk-inline-transient-mode
(diff-hl-show-hunk-inline-transient-mode -1))
(when diff-hl-show-hunk-inline--close-hook
(funcall diff-hl-show-hunk-inline--close-hook)
(setq diff-hl-show-hunk-inline--close-hook nil))
(when diff-hl-show-hunk-inline--current-popup
(delete-overlay diff-hl-show-hunk-inline--current-popup)
(setq diff-hl-show-hunk-inline--current-popup nil)))
;;;###autoload
(defun diff-hl-show-hunk-inline-show (lines &optional header footer keymap close-hook point height)
"Create a phantom overlay to show the inline popup, with some
content LINES, and a HEADER and a FOOTER, at POINT. KEYMAP is
added to the current keymaps. CLOSE-HOOK is called when the popup
is closed."
(when diff-hl-show-hunk-inline--current-popup
(delete-overlay diff-hl-show-hunk-inline--current-popup)
(setq diff-hl-show-hunk-inline--current-popup nil))
(when (< (diff-hl-show-hunk-inline--compute-content-height 99) 2)
(user-error "There is no enough vertical space to show the inline popup"))
(let* ((the-point (or point (line-end-position)))
(the-buffer (current-buffer))
(overlay (make-overlay the-point the-point the-buffer)))
(overlay-put overlay 'phantom t)
(overlay-put overlay 'diff-hl-show-hunk-inline t)
(setq diff-hl-show-hunk-inline--current-popup overlay)
(setq diff-hl-show-hunk-inline--current-lines
(mapcar (lambda (s) (replace-regexp-in-string "\n" " " s)) lines))
(setq diff-hl-show-hunk-inline--current-header header)
(setq diff-hl-show-hunk-inline--current-footer footer)
(setq diff-hl-show-hunk-inline--invoking-command this-command)
(setq diff-hl-show-hunk-inline--current-custom-keymap keymap)
(setq diff-hl-show-hunk-inline--close-hook close-hook)
(setq diff-hl-show-hunk-inline--height (diff-hl-show-hunk-inline--compute-content-height height))
(setq diff-hl-show-hunk-inline--height (min diff-hl-show-hunk-inline--height
(length diff-hl-show-hunk-inline--current-lines)))
;; (diff-hl-show-hunk-inline--ensure-enough-lines point diff-hl-show-hunk-inline--height)
(diff-hl-show-hunk-inline-transient-mode 1)
(diff-hl-show-hunk-inline-scroll-to 0)
overlay))
(defun diff-hl-show-hunk-inline--hide-all ()
"Testing purposes, use in case some inline popups get stuck in a buffer."
(interactive)
(when diff-hl-show-hunk-inline-transient-mode
(diff-hl-show-hunk-inline-transient-mode -1))
(setq diff-hl-show-hunk-inline--current-popup nil)
(let* ((all-overlays (overlays-in (point-min) (point-max)))
(overlays (cl-remove-if-not (lambda (o)(overlay-get o 'diff-hl-show-hunk-inline)) all-overlays)))
(dolist (o overlays)
(delete-overlay o))))
;;;###autoload
(defun diff-hl-show-hunk-inline (buffer &optional _ignored-line)
"Implementation to show the hunk in a inline popup.
BUFFER is a buffer with the hunk."
;; prevent diff-hl-show-hunk-inline-hide from being called twice
(let ((diff-hl-show-hunk-inline--close-hook nil))
(diff-hl-show-hunk-inline-hide))
(setq diff-hl-show-hunk--hide-function #'diff-hl-show-hunk-inline-hide)
(let* ((lines (split-string (with-current-buffer buffer (buffer-string)) "[\n\r]+" ))
(smart-lines diff-hl-show-hunk-inline-smart-lines)
(original-lines-number (cl-count-if (lambda (s) (string-prefix-p "-" s)) lines))
(lines (if (string= (car (last lines)) "" ) (butlast lines) lines))
(lines (if (and (eq original-lines-number 0) smart-lines)
diff-hl-show-hunk--no-lines-removed-message
lines))
(overlay diff-hl-show-hunk--original-overlay)
(type (overlay-get overlay 'diff-hl-hunk-type))
(point (if (eq type 'delete) (overlay-start overlay) (overlay-end overlay)))
(propertize-line (lambda (l)
(propertize l 'face
(cond ((string-prefix-p "+" l)
'diff-added)
((string-prefix-p "-" l)
'diff-removed)))))
(propertized-lines (mapcar propertize-line lines)))
(save-excursion
;; Save point in case the hunk is hidden, so next/previous works as expected
;; If the hunk is delete type, then don't hide the hunk
;; (because the hunk is located in a non deleted line)
(when (and diff-hl-show-hunk-inline-hide-hunk
(not (eq type 'delete)))
(let* ((invisible-overlay (make-overlay (overlay-start overlay)
(overlay-end overlay))))
;; Make new overlay, since the diff-hl overlay can be changed by diff-hl-flydiff
(overlay-put invisible-overlay 'invisible t)
;; Change default hide popup function, to make the overlay visible
(setq diff-hl-show-hunk--hide-function
(lambda ()
(overlay-put invisible-overlay 'invisible nil)
(delete-overlay invisible-overlay)
(diff-hl-show-hunk-inline-hide)))))
(diff-hl-show-hunk--goto-hunk-overlay overlay)
(let ((height
(when smart-lines
(when (not (eq 0 original-lines-number))
original-lines-number)))
(footer "(q)Quit (p)Previous (n)Next (r)Revert (c)Copy original"))
(unless diff-hl-show-staged-changes
(setq footer (concat footer " (S)Stage")))
(diff-hl-show-hunk-inline-show
propertized-lines
(if (and (boundp 'diff-hl-reference-revision) diff-hl-reference-revision)
(concat "Diff with " diff-hl-reference-revision)
"Diff with HEAD")
footer
diff-hl-show-hunk-map
#'diff-hl-show-hunk-hide
point
height))
)))
(define-obsolete-function-alias 'diff-hl-inline-popup--splice 'diff-hl-show-hunk-inline--splice "0.11.0")
(define-obsolete-function-alias 'diff-hl-inline-popup--ensure-enough-lines 'diff-hl-show-hunk-inline--ensure-enough-lines "0.11.0")
(define-obsolete-function-alias 'diff-hl-inline-popup--compute-content-height 'diff-hl-show-hunk-inline--compute-content-height "0.11.0")
(define-obsolete-function-alias 'diff-hl-inline-popup--compute-content-lines 'diff-hl-show-hunk-inline--compute-content-lines "0.11.0")
(define-obsolete-function-alias 'diff-hl-inline-popup--compute-header 'diff-hl-show-hunk-inline--compute-header "0.11.0")
(define-obsolete-function-alias 'diff-hl-inline-popup--compute-footer 'diff-hl-show-hunk-inline--compute-footer "0.11.0")
(define-obsolete-function-alias 'diff-hl-inline-popup--separator 'diff-hl-show-hunk-inline--separator "0.11.0")
(define-obsolete-function-alias 'diff-hl-inline-popup--available-width 'diff-hl-show-hunk-inline--available-width "0.11.0")
(define-obsolete-function-alias 'diff-hl-inline-popup--compute-popup-str 'diff-hl-show-hunk-inline--compute-popup-str "0.11.0")
(define-obsolete-function-alias 'diff-hl-inline-popup-scroll-to 'diff-hl-show-hunk-inline-scroll-to "0.11.0")
(define-obsolete-function-alias 'diff-hl-inline-popup--popup-down 'diff-hl-show-hunk-inline--popup-down "0.11.0")
(define-obsolete-function-alias 'diff-hl-inline-popup--popup-up 'diff-hl-show-hunk-inline--popup-up "0.11.0")
(define-obsolete-function-alias 'diff-hl-inline-popup--popup-pagedown 'diff-hl-show-hunk-inline--popup-pagedown "0.11.0")
(define-obsolete-function-alias 'diff-hl-inline-popup--popup-pageup 'diff-hl-show-hunk-inline--popup-pageup "0.11.0")
(define-obsolete-function-alias 'diff-hl-inline-popup--ignorable-command-p 'diff-hl-show-hunk-inline--ignorable-command-p "0.11.0")
(define-obsolete-function-alias 'diff-hl-inline-popup--post-command-hook 'diff-hl-show-hunk-inline--post-command-hook "0.11.0")
(define-obsolete-function-alias 'diff-hl-inline-popup-transient-mode 'diff-hl-show-hunk-inline-transient-mode "0.11.0")
(define-obsolete-function-alias 'diff-hl-inline-popup-hide 'diff-hl-show-hunk-inline-hide "0.11.0")
(define-obsolete-function-alias 'diff-hl-inline-popup-show 'diff-hl-show-hunk-inline-show "0.11.0")
(define-obsolete-function-alias 'diff-hl-inline-popup--hide-all 'diff-hl-show-hunk-inline--hide-all "0.11.0")
(define-obsolete-function-alias 'diff-hl-show-hunk-inline-popup 'diff-hl-show-hunk-inline "0.11.0")
(provide 'diff-hl-inline-popup)
(provide 'diff-hl-show-hunk-inline)
;;; diff-hl-show-hunk-inline ends here
lisp/diff-hl/diff-hl-show-hunk.el
+31 -92
View File
@@ -22,9 +22,9 @@
;;; Commentary:
;; `diff-hl-show-hunk' shows a popup with the modification hunk at point.
;; `diff-hl-show-hunk-function' points to the backend used to show the
;; hunk. Its default value is `diff-hl-show-hunk-inline-popup', that
;; shows diffs inline using overlay. There is another built-in backend:
;; `diff-hl-show-hunk-function' points to the backend used to show the hunk.
;; Its default value is `diff-hl-show-hunk-inline', that shows diffs inline
;; using overlay. There is another built-in backend:
;; `diff-hl-show-hunk-posframe' (based on posframe).
;;
;; `diff-hl-show-hunk-mouse-mode' adds interaction on clicking in the
@@ -36,9 +36,31 @@
;;; Code:
(require 'diff-hl-inline-popup)
(require 'diff-hl)
(defgroup diff-hl-show-hunk nil
"Show vc diffs in a posframe or popup."
:group 'diff-hl)
(defcustom diff-hl-show-hunk-ignorable-commands
'(ignore
diff-hl-show-hunk
handle-switch-frame
diff-hl-show-hunk--click)
"Commands that will keep the hunk shown.
Any command not on this list will cause the hunk to be hidden."
:type '(repeat function)
:group 'diff-hl-show-hunk)
(defcustom diff-hl-show-hunk-function 'diff-hl-show-hunk-inline
"The function used to render the hunk.
The function receives as first parameter a buffer with the
contents of the hunk, and as second parameter the line number
corresponding to the clicked line in the original buffer."
:type '(choice
(const :tag "Show inline" diff-hl-show-hunk-inline)
(const :tag "Show using posframe" diff-hl-show-hunk-posframe)))
(defvar diff-hl-show-hunk-mouse-mode-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "<left-margin> <mouse-1>") 'diff-hl-show-hunk--click)
@@ -66,33 +88,9 @@
(defvar diff-hl-show-hunk--original-overlay nil
"Copy of the diff-hl hunk overlay.")
(defgroup diff-hl-show-hunk nil
"Show vc diffs in a posframe or popup."
:group 'diff-hl)
(defconst diff-hl-show-hunk-boundary "^@@.*@@")
(defconst diff-hl-show-hunk--no-lines-removed-message (list "<<no lines removed>>"))
(defcustom diff-hl-show-hunk-inline-popup-hide-hunk nil
"If t, inline-popup is shown over the hunk, hiding it."
:type 'boolean)
(defcustom diff-hl-show-hunk-inline-popup-smart-lines t
"If t, inline-popup tries to show only the deleted lines of the
hunk. The added lines are shown when scrolling the popup. If
the hunk consist only on added lines, then
`diff-hl-show-hunk--no-lines-removed-message' it is shown."
:type 'boolean)
(defcustom diff-hl-show-hunk-function 'diff-hl-show-hunk-inline-popup
"The function used to render the hunk.
The function receives as first parameter a buffer with the
contents of the hunk, and as second parameter the line number
corresponding to the clicked line in the original buffer."
:type '(choice
(const :tag "Show inline" diff-hl-show-hunk-inline-popup)
(const :tag "Show using posframe" diff-hl-show-hunk-posframe)))
(defvar diff-hl-show-hunk--hide-function nil
"Function to call to close the shown hunk.")
@@ -123,7 +121,7 @@ corresponding to the clicked line in the original buffer."
(defun diff-hl-show-hunk-ignorable-command-p (command)
"Decide if COMMAND is a command allowed while showing the current hunk."
(member command '(ignore diff-hl-show-hunk handle-switch-frame diff-hl-show-hunk--click)))
(member command diff-hl-show-hunk-ignorable-commands))
(defun diff-hl-show-hunk--compute-diffs ()
"Compute diffs using functions of diff-hl.
@@ -136,7 +134,10 @@ buffer."
(line (line-number-at-pos))
(dest-buffer diff-hl-show-hunk-diff-buffer-name))
(with-current-buffer buffer
(diff-hl-diff-buffer-with-reference (buffer-file-name buffer) dest-buffer)
(if (buffer-modified-p)
(diff-hl-diff-buffer-with-reference buffer-file-name dest-buffer)
(diff-hl-changes-buffer buffer-file-name (vc-backend buffer-file-name)
nil dest-buffer))
(switch-to-buffer dest-buffer)
(diff-hl-diff-skip-to line)
(setq vc-sentinel-movepoint (point)))
@@ -226,68 +227,6 @@ Returns a list with the buffer and the line number of the clicked line."
(define-key map (kbd "S") #'diff-hl-show-hunk-stage-hunk)
map))
(defvar diff-hl-show-hunk--hide-function)
;;;###autoload
(defun diff-hl-show-hunk-inline-popup (buffer &optional _ignored-line)
"Implementation to show the hunk in a inline popup.
BUFFER is a buffer with the hunk."
(diff-hl-inline-popup-hide)
(setq diff-hl-show-hunk--hide-function #'diff-hl-inline-popup-hide)
(let* ((lines (split-string (with-current-buffer buffer (buffer-string)) "[\n\r]+" ))
(smart-lines diff-hl-show-hunk-inline-popup-smart-lines)
(original-lines-number (cl-count-if (lambda (s) (string-prefix-p "-" s)) lines))
(lines (if (string= (car (last lines)) "" ) (butlast lines) lines))
(lines (if (and (eq original-lines-number 0) smart-lines)
diff-hl-show-hunk--no-lines-removed-message
lines))
(overlay diff-hl-show-hunk--original-overlay)
(type (overlay-get overlay 'diff-hl-hunk-type))
(point (if (eq type 'delete) (overlay-start overlay) (overlay-end overlay)))
(propertize-line (lambda (l)
(propertize l 'face
(cond ((string-prefix-p "+" l)
'diff-added)
((string-prefix-p "-" l)
'diff-removed)))))
(propertized-lines (mapcar propertize-line lines)))
(save-excursion
;; Save point in case the hunk is hidden, so next/previous works as expected
;; If the hunk is delete type, then don't hide the hunk
;; (because the hunk is located in a non deleted line)
(when (and diff-hl-show-hunk-inline-popup-hide-hunk
(not (eq type 'delete)))
(let* ((invisible-overlay (make-overlay (overlay-start overlay)
(overlay-end overlay))))
;; Make new overlay, since the diff-hl overlay can be changed by diff-hl-flydiff
(overlay-put invisible-overlay 'invisible t)
;; Change default hide popup function, to make the overlay visible
(setq diff-hl-show-hunk--hide-function
(lambda ()
(overlay-put invisible-overlay 'invisible nil)
(delete-overlay invisible-overlay)
(diff-hl-inline-popup-hide)))))
(diff-hl-show-hunk--goto-hunk-overlay overlay)
(let ((height
(when smart-lines
(when (not (eq 0 original-lines-number))
original-lines-number)))
(footer "(q)Quit (p)Previous (n)Next (r)Revert (c)Copy original"))
(unless diff-hl-show-staged-changes
(setq footer (concat footer " (S)Stage")))
(diff-hl-inline-popup-show
propertized-lines
(if (and (boundp 'diff-hl-reference-revision) diff-hl-reference-revision)
(concat "Diff with " diff-hl-reference-revision)
"Diff with HEAD")
footer
diff-hl-show-hunk-map
#'diff-hl-show-hunk-hide
point
height))
)))
(defun diff-hl-show-hunk-copy-original-text ()
"Extracts all the lines from BUFFER starting with '-' to the kill ring."
(interactive)
lisp/diff-hl/diff-hl.el
+573 -145
View File
File diff suppressed because it is too large Load Diff
lisp/emacsql/emacsql-pkg.el
+3 -3
View File
@@ -1,9 +1,9 @@
;; -*- no-byte-compile: t; lexical-binding: nil -*-
(define-package "emacsql" "20250601.1009"
(define-package "emacsql" "20251116.1655"
"High-level SQL database front-end."
'((emacs "26.1"))
:url "https://github.com/magit/emacsql"
:commit "ced062890061b6e4fbe4d00c0617f7ff84fff25c"
:revdesc "ced062890061"
:commit "e1908de2cf2c7b77798ef6645d514dded1d7f8a4"
:revdesc "e1908de2cf2c"
:authors '(("Christopher Wellons" . "wellons@nullprogram.com"))
:maintainers '(("Jonas Bernoulli" . "emacs.emacsql@jonas.bernoulli.dev")))
lisp/emacsql/emacsql-sqlite-builtin.el
+3 -2
View File
@@ -49,8 +49,9 @@ buffer. This is for debugging purposes."
(and (oref connection handle) t))
(cl-defmethod emacsql-close ((connection emacsql-sqlite-builtin-connection))
(sqlite-close (oref connection handle))
(oset connection handle nil))
(when (oref connection handle)
(sqlite-close (oref connection handle))
(oset connection handle nil)))
(cl-defmethod emacsql-send-message
((connection emacsql-sqlite-builtin-connection) message)
lisp/emacsql/emacsql-sqlite-module.el
+3 -2
View File
@@ -55,8 +55,9 @@ buffer. This is for debugging purposes."
(and (oref connection handle) t))
(cl-defmethod emacsql-close ((connection emacsql-sqlite-module-connection))
(sqlite3-close (oref connection handle))
(oset connection handle nil))
(when (oref connection handle)
(sqlite3-close (oref connection handle))
(oset connection handle nil)))
(cl-defmethod emacsql-send-message
((connection emacsql-sqlite-module-connection) message)
lisp/emacsql/emacsql.el
+8 -3
View File
@@ -6,8 +6,8 @@
;; Maintainer: Jonas Bernoulli <emacs.emacsql@jonas.bernoulli.dev>
;; Homepage: https://github.com/magit/emacsql
;; Package-Version: 20250601.1009
;; Package-Revision: ced062890061
;; Package-Version: 20251116.1655
;; Package-Revision: e1908de2cf2c
;; Package-Requires: ((emacs "26.1"))
;; SPDX-License-Identifier: Unlicense
@@ -19,6 +19,11 @@
;; PostgreSQL and MySQL are also supported, but use of these connectors
;; is not recommended.
;; Any readable lisp value can be stored as a value in EmacSQL,
;; including numbers, strings, symbols, lists, vectors, and closures.
;; EmacSQL has no concept of TEXT values; it's all just lisp objects.
;; The lisp object `nil' corresponds 1:1 with NULL in the database.
;; See README.md for much more complete documentation.
;;; Code:
@@ -33,7 +38,7 @@
"The EmacSQL SQL database front-end."
:group 'comm)
(defconst emacsql-version "4.3.1")
(defconst emacsql-version "4.3.3")
(defvar emacsql-global-timeout 30
"Maximum number of seconds to wait before bailing out on a SQL command.
lisp/ess/ess-custom.el
+1
View File
@@ -563,6 +563,7 @@ contain spaces on either side."
:type '(repeat string)
:group 'ess
:package-version '(ess . "25.01.1"))
(defvar ess-S-assign)
(make-obsolete-variable 'ess-S-assign 'ess-assign-list "ESS 18.10")
lisp/ess/ess-inf.el
+3 -3
View File
@@ -1,6 +1,6 @@
;;; ess-inf.el --- Support for running S as an inferior Emacs process -*- lexical-binding: t; -*-
;; Copyright (C) 1989-2023 Free Software Foundation, Inc.
;; Copyright (C) 1989-2025 Free Software Foundation, Inc.
;; Author: David Smith <dsmith@stats.adelaide.edu.au>
;; Created: 7 Jan 1994
@@ -1998,7 +1998,7 @@ meaning as for `ess-eval-region'."
(define-key map "\C-c\C-z" #'ess-switch-to-inferior-or-script-buffer) ; mask comint map
(define-key map "\C-d" #'delete-char) ; EOF no good in S
(define-key map "\t" #'completion-at-point)
(define-key map "\M-?" #'ess-complete-object-name)
(define-key map "\M-?" #'ess-complete-object-name); stealing M-? from xref(standard Emacs)
(define-key map "\C-c\C-k" #'ess-request-a-process)
(define-key map "," #'ess-smart-comma)
(define-key map "\C-c\C-d" 'ess-doc-map)
@@ -3143,7 +3143,7 @@ Uses `temp-buffer-show-function' and respects
(defun ess--inject-code-from-file (file &optional chunked)
"Load code from FILE into process.
If CHUNKED is non-nil, split the file by separator (must be at
If CHUNKED is non-nil, split the file by \\^L separator (must be at
bol) and load each chunk separately."
;; This is different from ess-load-file as it works by directly loading the
;; string into the process and thus works on remotes.
lisp/ess/ess-pkg.el
+3 -3
View File
@@ -1,10 +1,10 @@
;; -*- no-byte-compile: t; lexical-binding: nil -*-
(define-package "ess" "20250606.831"
(define-package "ess" "20251015.1619"
"Emacs Speaks Statistics."
'((emacs "25.1"))
:url "https://ess.r-project.org/"
:commit "cd85d1e1f0e897b409a948a3a4afdaffe032812e"
:revdesc "cd85d1e1f0e8"
:commit "a7d685bd9a3dbc8540edf86318012a0a0528e49e"
:revdesc "a7d685bd9a3d"
:authors '(("David Smith" . "dsmith@stats.adelaide.edu.au")
("A.J. Rossini" . "blindglobe@gmail.com")
("Richard M. Heiberger" . "rmh@temple.edu")
lisp/ess/ess-r-flymake.el
+10 -12
View File
@@ -27,7 +27,7 @@
;; Flymake is the built-in Emacs package that supports on-the-fly
;; syntax checking. This file adds support for this in ess-r-mode by
;; relying on the lintr package, available on CRAN and currently
;; hosted at https://github.com/jimhester/lintr.
;; hosted at https://github.com/r-lib/lintr.
;;; Code:
@@ -76,28 +76,26 @@ each element is passed as argument to `lintr::linters_with_defaults'."
(defvar-local ess-r--flymake-proc nil)
(defvar-local ess-r--lintr-file nil
"Location of the .lintr file for this buffer.")
"Location of the .lintr config file for this buffer.")
(defvar ess-r--flymake-def-linter
(replace-regexp-in-string
"[\n\t ]+" " "
"esslint <- function(str, ...) {
if (!suppressWarnings(require(lintr, quietly=T))) {
if (!suppressWarnings(requireNamespace('lintr', quietly=TRUE))) {
cat('@@error: @@`lintr` package not installed')
} else if (packageVersion('lintr') <= '3.0.0') {
cat('@@error: @@Need `lintr` version > v3.0.0')
} else {
if (packageVersion('lintr') <= '3.0.0') {
cat('@@error: @@Need `lintr` version > v3.0.0')
} else {
tryCatch(lintr::lint(commandArgs(TRUE), ...),
error = function(e) {
cat('@@warning: @@', conditionMessage(e))
})
}
tryCatch(lintr::lint(text=str, ..., parse_settings=TRUE),
error = function(e) {
cat('@@warning: @@', conditionMessage(e))
})
}
};"))
(defun ess-r--find-lintr-file ()
"Return the absolute path to the .lintr file.
"Return the absolute path to the .lintr config file.
Check first the current directory, then the project root, then
the package root, then the user's home directory. Return nil if
we couldn't find a .lintr file."
lisp/ess/ess-r-mode.el
+4 -4
View File
@@ -1,6 +1,6 @@
;;; ess-r-mode.el --- R customization -*- lexical-binding: t; -*-
;; Copyright (C) 1997-2022 Free Software Foundation, Inc.
;; Copyright (C) 1997-2025 Free Software Foundation, Inc.
;; Author: A.J. Rossini
;; Created: 12 Jun 1997
;; Maintainer: ESS-core <ESS-core@r-project.org>
@@ -264,7 +264,7 @@ value by using `ess-r-runners-reset'."
(defvar ess-r-mode-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "C-c C-=") #'ess-cycle-assign)
(define-key map "\M-?" #'ess-complete-object-name)
;;(define-key map "\M-?" #'ess-complete-object-name); not stealing M-? from "standard Emacs"
(define-key map (kbd "C-c C-.") 'ess-rutils-map)
map))
@@ -992,7 +992,7 @@ as `ess-r-created-runners' upon ESS initialization."
(message "Recreated %d R versions known to ESS: %s"
(length versions) versions))
(if ess-microsoft-p
(cl-mapcar (lambda (v p) (ess-define-runner v "R" p)) versions ess-rterm-version-paths)
(cl-mapc (lambda (v p) (ess-define-runner v "R" p)) versions ess-rterm-version-paths)
(mapc (lambda (v) (ess-define-runner v "R")) versions))
;; Add to menu
(when ess-r-created-runners
@@ -1619,7 +1619,7 @@ environment to the search path."
Send the contents of the etc/ESSR/R directory to the remote
process through the process connection file by file. Then,
collect all the objects into an ESSR environment and attach to
the search path. If CHUNKED is non-nil, split each file by
the search path. If CHUNKED is non-nil, split each file by \\^L
separators and send chunk by chunk."
(ess-command (format ".ess.ESSRversion <<- '%s'\n" essr-version))
(with-temp-message "Loading ESSR into remote ..."
lisp/ess/ess-rd.el
+7 -2
View File
@@ -1,6 +1,6 @@
;; ess-rd.el --- Support for editing R documentation (Rd) source -*- lexical-binding: t; -*-
;; Copyright (C) 1997-2023 Free Software Foundation, Inc.
;; Copyright (C) 1997-2025 Free Software Foundation, Inc.
;; Author: KH <Kurt.Hornik@ci.tuwien.ac.at>
;; Created: 25 July 1997
;; Maintainer: ESS-core <ESS-core@r-project.org>
@@ -48,6 +48,7 @@
("`al" "\\alias" nil :system t)
("`au" "\\author" nil :system t)
("`bf" "\\bold" nil :system t)
;; not (yet) "bibcitep" "bibcitet" "bibshow" "bibinfo"
("`co" "\\code" nil :system t)
("`de" "\\describe" nil :system t)
("`dn" "\\description" nil :system t)
@@ -62,6 +63,7 @@
("`kw" "\\keyword" nil :system t)
("`li" "\\link" nil :system t)
("`me" "\\method" nil :system t)
("`ma" "\\manual" nil :system t)
("`na" "\\name" nil :system t)
("`no" "\\note" nil :system t)
("`re" "\\references" nil :system t)
@@ -122,7 +124,7 @@ All Rd mode abbrevs start with a grave accent (`)."
"tabular" "title" "usage"
"value"))
(defvar Rd-keywords
(defvar Rd-keywords ; to be highlighted in Rd-mode
'(
;; the next two lines: only valid in R <= 2.8.1
;; commented out on 2011-01-14 for ESS version 5.13:
@@ -136,11 +138,14 @@ All Rd mode abbrevs start with a grave accent (`)."
"href"
"ifelse" "if"
"item" "kbd" "ldots" "linkS4class" "link" "method"
"manual"
"newcommand" "option" "out"
"pkg" "sQuote" "renewcommand"
"samp" "strong" "tab" "url" "var" "verb"
;; System macros (from <R>/share/Rd/macros/system.Rd ):
"bibcitep" "bibcitet" "bibshow" "bibinfo"
"CRANpkg" "PR" "sspace" "doi"
"I" ; should we?
"LaTeX"
"proglang"
"packageTitle" "packageDescription" "packageAuthor"
lisp/ess/ess-tracebug.el
+20 -11
View File
@@ -1,6 +1,6 @@
;; ess-tracebug.el --- Tracing and debugging facilities for ESS. -*- lexical-binding: t; -*-
;; Copyright (C) 2011-2022 Free Software Foundation, Inc.
;; Copyright (C) 2011-2025 Free Software Foundation, Inc.
;; Author: Vitalie Spinu
;; Maintainer: Vitalie Spinu
;; Created: Oct 14 14:15:22 2010
@@ -588,7 +588,7 @@ ESS internal code assumes default R prompts.")
(setq-local compilation-error-regexp-alist ess-error-regexp-alist)
(let (compilation-mode-font-lock-keywords)
(compilation-setup t))
(setq next-error-function 'ess-tracebug-next-error-function)
(setq next-error-function #'ess-tracebug-next-error-function)
;; new locals
(make-local-variable 'ess--tb-last-input)
(make-local-variable 'ess--tb-last-input-overlay)
@@ -1231,10 +1231,10 @@ value from EXPR and then sent to the subprocess."
(defun ess-mpi-handle-messages (buf)
"Handle all mpi messages in BUF and delete them.
The MPI message has the form TYPEFIELD... where TYPE is the
The MPI message has the form \\^[TYPE\\^^FIELD...\\^] where TYPE is the
type of the messages on which handlers in `ess-mpi-handlers' are
dispatched. And FIELDs are strings. Return :incomplete if BUF
ends with an incomplete message."
dispatched, \\^C are ASCII control chars, and FIELDs are strings.
Return `:incomplete' if BUF ends with an incomplete message."
(let ((obuf (current-buffer))
(out nil))
(with-current-buffer buf
@@ -1992,6 +1992,9 @@ Each sublist has five elements:
doesn't apply to current context."
:group 'ess-debug
:type '(alist :key-type symbol
;; FIXME: What's this `group'? The values looks like strings!
;; FIXME: The docstring talks about a 6th element (function)
;; but it's missing here.
:value-type (group string string symbol face)))
(defcustom ess-bp-inactive-spec
@@ -2001,7 +2004,8 @@ Each sublist has five elements:
;; `ess-bp-type-spec-alist' except that the second element giving
;; the R expression is meaningless here." ;;fixme: second element is missing make it nil for consistency with all other specs
:group 'ess-debug
:type 'list)
:type '(alist :key-type symbol
:value-type (group string string symbol face)))
(defcustom ess-bp-conditional-spec
'(conditional "browser(expr={%s})" "CB[ %s ]>\n" question-mark ess-bp-fringe-browser-face)
@@ -2011,14 +2015,16 @@ List format is identical to that of the elements of
expression to be replaced instead of %s in the second and third
elements of the specifications."
:group 'ess-debug
:type 'list)
:type '(alist :key-type symbol
:value-type (group string string symbol face)))
(defcustom ess-bp-logger-spec
'(logger ".ess_log_eval('%s')" "L[ \"%s\" ]>\n" hollow-square ess-bp-fringe-logger-face)
"List giving the loggers specifications.
List format is identical to that of `ess-bp-type-spec-alist'."
:group 'ess-debug
:type 'list)
:type '(alist :key-type symbol
:value-type (group string string symbol face)))
(defun ess-bp-get-bp-specs (type &optional condition no-error)
@@ -2339,7 +2345,7 @@ If there is no active R session, this command triggers an error."
(defun ess-bp-next nil
"Goto next breakpoint."
(interactive)
(when-let ((bp-pos (next-single-property-change (point) 'ess-bp)))
(when-let* ((bp-pos (next-single-property-change (point) 'ess-bp)))
(save-excursion
(goto-char bp-pos)
(when (get-text-property (1- (point)) 'ess-bp)
@@ -2352,7 +2358,7 @@ If there is no active R session, this command triggers an error."
(defun ess-bp-previous nil
"Goto previous breakpoint."
(interactive)
(if-let ((bp-pos (previous-single-property-change (point) 'ess-bp)))
(if-let* ((bp-pos (previous-single-property-change (point) 'ess-bp)))
(goto-char (or (previous-single-property-change bp-pos 'ess-bp)
bp-pos))
(message "No breakpoints before the point found")))
@@ -2820,7 +2826,10 @@ for signature and trace it with browser tracer."
"*ALL*"))
(setq fun (ess-completing-read "Undebug" debugged nil t nil nil def-val))
(if (equal fun "*ALL*" )
(ess-command (concat ".ess_dbg_UndebugALL(c(\"" (mapconcat 'identity debugged "\", \"") "\"))\n") tbuffer)
(ess-command (concat ".ess_dbg_UndebugALL(c(\""
(mapconcat #'identity debugged "\", \"")
"\"))\n")
tbuffer)
(ess-command (format ".ess_dbg_UntraceOrUndebug(\"%s\")\n" fun) tbuffer))
(with-current-buffer tbuffer
(if (= (point-max) 1) ;; not reliable TODO:
lisp/ess/ess.el
+10 -8
View File
@@ -1,6 +1,6 @@
;;; ess.el --- Emacs Speaks Statistics -*- lexical-binding: t; -*-
;; Copyright (C) 1997-2024 Free Software Foundation, Inc.
;; Copyright (C) 1997-2025 Free Software Foundation, Inc.
;; Author: David Smith <dsmith@stats.adelaide.edu.au>
;; A.J. Rossini <blindglobe@gmail.com>
@@ -17,8 +17,8 @@
;;
;; Maintainer: ESS Core Team <ESS-core@r-project.org>
;; Created: 7 Jan 1994
;; Package-Version: 20250606.831
;; Package-Revision: cd85d1e1f0e8
;; Package-Version: 20251015.1619
;; Package-Revision: a7d685bd9a3d
;; URL: https://ess.r-project.org/
;; Package-Requires: ((emacs "25.1"))
;; ESSR-Version: 1.8
@@ -129,7 +129,7 @@ Is set by \\[ess-version-string].")
(interactive)
(let ((reporter-prompt-for-summary-p 't))
(reporter-submit-bug-report
"ess-bugs@r-project.org"
"ess-help@r-project.org"
(concat "ess-mode " (ess-version-string))
(list 'ess-language
'ess-dialect
@@ -151,10 +151,12 @@ Is set by \\[ess-version-string].")
;;(goto-char (point-max))
(rfc822-goto-eoh)
(forward-line 1)
(insert "\n\n-------------------------------------------------------\n")
(insert "This bug report will be sent to the ESS bugs email list\n")
(insert "Press C-c C-c when you are ready to send your message.\n")
(insert "-------------------------------------------------------\n\n")
(insert "\n\n-------------------------------------------------------------\n")
(insert "This bug report will be sent to the ESS _help_ email list\n")
(insert ">>> _INSTEAD_ we strongly recommend you open an issue for this\n")
(insert " at https://github.com/emacs-ess/ESS/issues .\n\n")
(insert "If you still prefer to use the ESS help email, press C-c C-c to send your message.\n")
(insert "-------------------------------------------------------------\n\n")
(insert (with-current-buffer ess-dribble-buffer
(goto-char (point-max))
(forward-line -100)
lisp/ess/ess.info
+111 -115
View File
@@ -1,4 +1,4 @@
This is ess.info, produced by makeinfo version 7.1.1 from ess.texi.
This is ess.info, produced by makeinfo version 7.2 from ess.texi.
INFO-DIR-SECTION Emacs
START-INFO-DIR-ENTRY
@@ -257,7 +257,7 @@ Changes and New Features in 25.01.0:
suggest the related polymodes including poly-noweb, poly-markdown
and poly-R (installed in that order). The package polymode itself,
as well as the polymodes packages, are all on MELPA rather than
ELPA. Therefore, you need to add MELPA to the list of installation
ELPA. Therefore, you need to add MELPA to the list of installation
archives as follows. ‘(add-to-list 'package-archives
'("melpa-stable" . "https://stable.melpa.org/packages/"))’ for ‘M-x
package-install’
@@ -2896,7 +2896,6 @@ are available:
M-U . Up frame . `ess-debug-command-up'
M-Q . Quit debugging . `ess-debug-command-quit'
These are all the tracebug commands defined in ‘ess-dev-map’ (‘C-c
C-t ?’ to show this table):
@@ -2933,7 +2932,6 @@ C-t ?’ to show this table):
? . Show this help . `ess-tracebug-show-help'
To configure how electric watch window splits the display see
‘ess-watch-width-threshold’ and ‘ess-watch-height-threshold’ variables.
@@ -3828,7 +3826,6 @@ Comments as to what should be happening are prefixed by "##".
## myfile.Rout. With this suffix, the file will be opened in
## ess-transcript.

File: ess.info, Node: ESS for SAS, Next: ESS for BUGS, Prev: ESS for R, Up: Top
@@ -4541,11 +4538,11 @@ File: ess.info, Node: Reporting Bugs, Next: Mailing Lists, Prev: Bugs, Up: M
16.2 Reporting Bugs
===================
Please send bug reports, suggestions etc. to <ESS-bugs@r-project.org>,
or post them on our github issue tracker
(https://github.com/emacs-ess/ESS/issues)
Please post bug reports, suggestions etc. on our github issue tracker
(https://github.com/emacs-ess/ESS/issues); if not possible, e-mail them
to <ESS-help@r-project.org>.
The easiest way to do this is within Emacs by typing
The easiest way to set this up, is within Emacs by typing
‘M-x ess-submit-bug-report’
@@ -4567,7 +4564,7 @@ File: ess.info, Node: Mailing Lists, Next: Help with Emacs, Prev: Reporting B
==================
There is a mailing list for discussions and announcements relating to
ESS. Join the list by sending an e-mail with "subscribe ess-help" (or
ESS. Join the list by sending an e-mail with "subscribe ess-help" (or
"help") in the body to <ess-help-request@r-project.org>; contributions
to the list may be mailed to <ess-help@r-project.org>. Rest assured,
this is a fairly low-volume mailing list.
@@ -5052,113 +5049,112 @@ Concept Index
* X Windows: X11. (line 6)
* xref: Xref. (line 6)

Tag Table:
Node: Top270
Node: Introduction2908
Node: Features5694
Node: Current Features6520
Node: New features10067
Node: Credits37886
Node: Manual41545
Node: Installation44255
Node: Installing from a third-party repository45192
Node: Installing from source46139
Node: Activating and Loading ESS47763
Node: Check Installation48845
Node: Interactive ESS49069
Node: Starting up49914
Node: Multiple ESS processes50674
Node: ESS processes on Remote Computers51787
Node: Customizing startup56014
Node: Controlling buffer display58996
Node: Entering commands61633
Node: Command-line editing62795
Node: Transcript64060
Node: Last command65857
Node: Process buffer motion67315
Node: Transcript resubmit68858
Node: Saving transcripts70855
Node: Command History72689
Node: Saving History76190
Node: History expansion76971
Node: Hot keys80362
Node: Statistical Process running in ESS?84532
Node: Emacsclient85879
Node: Other86699
Node: Evaluating code87742
Node: Transcript Mode91674
Node: Resubmit92847
Node: Clean93922
Node: Editing objects94922
Node: Edit buffer96040
Node: Loading98130
Node: Error Checking99185
Node: Indenting100258
Node: Styles103410
Node: Other edit buffer commands105912
Node: Source Files107624
Node: Source Directories112340
Node: Help115549
Node: Completion120251
Node: Object names120466
Node: Function arguments123180
Node: Minibuffer completion124159
Node: Company124657
Node: Icicles125056
Node: Developing with ESS126432
Node: ESS tracebug126878
Node: Getting started with tracebug129937
Node: Editing documentation132223
Node: R documentation files132775
Node: roxygen2136590
Node: Namespaced Evaluation141113
Node: Extras143127
Node: ESS ElDoc144151
Node: ESS Flymake145731
Node: Handy commands146861
Node: Highlighting148138
Node: Parens149189
Node: Graphics149665
Node: printer150336
Node: X11151108
Node: winjava151447
Node: Imenu151859
Node: Toolbar152714
Node: Xref153122
Node: Rdired153450
Node: Package listing154529
Node: Org155977
Node: Sweave and AUCTeX156931
Node: ESS for R159563
Node: ESS(R)--Editing files159863
Node: iESS(R)--Inferior ESS processes160368
Node: Philosophies for using ESS(R)163087
Node: Example ESS usage164014
Node: ESS for SAS165419
Node: ESS(SAS)--Design philosophy166146
Node: ESS(SAS)--Editing files167083
Node: ESS(SAS)--TAB key169027
Node: ESS(SAS)--Batch SAS processes170441
Node: ESS(SAS)--Function keys for batch processing175661
Node: iESS(SAS)--Interactive SAS processes185568
Node: iESS(SAS)--Common problems189510
Node: ESS(SAS)--Graphics191124
Node: ESS(SAS)--Windows191923
Node: ESS for BUGS192507
Node: ESS for JAGS194319
Node: Mailing lists/bug reports197815
Node: Bugs198079
Node: Reporting Bugs199755
Node: Mailing Lists200652
Node: Help with Emacs201389
Node: Customization201925
Node: Indices202703
Node: Key index202878
Node: Function and program index208010
Node: Variable index217430
Node: Concept index220991
Node: Top268
Node: Introduction2906
Node: Features5692
Node: Current Features6518
Node: New features10065
Node: Credits37885
Node: Manual41544
Node: Installation44254
Node: Installing from a third-party repository45191
Node: Installing from source46138
Node: Activating and Loading ESS47762
Node: Check Installation48844
Node: Interactive ESS49068
Node: Starting up49913
Node: Multiple ESS processes50673
Node: ESS processes on Remote Computers51786
Node: Customizing startup56013
Node: Controlling buffer display58995
Node: Entering commands61632
Node: Command-line editing62794
Node: Transcript64059
Node: Last command65856
Node: Process buffer motion67314
Node: Transcript resubmit68857
Node: Saving transcripts70854
Node: Command History72688
Node: Saving History76189
Node: History expansion76970
Node: Hot keys80361
Node: Statistical Process running in ESS?84531
Node: Emacsclient85878
Node: Other86698
Node: Evaluating code87741
Node: Transcript Mode91673
Node: Resubmit92846
Node: Clean93921
Node: Editing objects94921
Node: Edit buffer96039
Node: Loading98129
Node: Error Checking99184
Node: Indenting100257
Node: Styles103409
Node: Other edit buffer commands105911
Node: Source Files107623
Node: Source Directories112339
Node: Help115548
Node: Completion120250
Node: Object names120465
Node: Function arguments123179
Node: Minibuffer completion124158
Node: Company124656
Node: Icicles125055
Node: Developing with ESS126431
Node: ESS tracebug126877
Node: Getting started with tracebug129934
Node: Editing documentation132220
Node: R documentation files132772
Node: roxygen2136587
Node: Namespaced Evaluation141110
Node: Extras143124
Node: ESS ElDoc144148
Node: ESS Flymake145728
Node: Handy commands146858
Node: Highlighting148135
Node: Parens149186
Node: Graphics149662
Node: printer150333
Node: X11151105
Node: winjava151444
Node: Imenu151856
Node: Toolbar152711
Node: Xref153119
Node: Rdired153447
Node: Package listing154526
Node: Org155974
Node: Sweave and AUCTeX156928
Node: ESS for R159560
Node: ESS(R)--Editing files159860
Node: iESS(R)--Inferior ESS processes160365
Node: Philosophies for using ESS(R)163084
Node: Example ESS usage164011
Node: ESS for SAS165415
Node: ESS(SAS)--Design philosophy166142
Node: ESS(SAS)--Editing files167079
Node: ESS(SAS)--TAB key169023
Node: ESS(SAS)--Batch SAS processes170437
Node: ESS(SAS)--Function keys for batch processing175657
Node: iESS(SAS)--Interactive SAS processes185564
Node: iESS(SAS)--Common problems189506
Node: ESS(SAS)--Graphics191120
Node: ESS(SAS)--Windows191919
Node: ESS for BUGS192503
Node: ESS for JAGS194315
Node: Mailing lists/bug reports197811
Node: Bugs198075
Node: Reporting Bugs199751
Node: Mailing Lists200670
Node: Help with Emacs201408
Node: Customization201944
Node: Indices202722
Node: Key index202897
Node: Function and program index208029
Node: Variable index217449
Node: Concept index221010

End Tag Table
lisp/flycheck/flycheck-pkg.el
+5 -4
View File
@@ -1,10 +1,11 @@
;; -*- no-byte-compile: t; lexical-binding: nil -*-
(define-package "flycheck" "20250527.907"
(define-package "flycheck" "20251119.1203"
"On-the-fly syntax checking."
'((emacs "27.1"))
'((emacs "27.1")
(seq "2.24"))
:url "https://www.flycheck.org"
:commit "a4d782e7af12e20037c0cecf0d4386cd2676c085"
:revdesc "a4d782e7af12"
:commit "1eafe2911d50c9f58efce81ff8abea59495e1ff3"
:revdesc "1eafe2911d50"
:keywords '("convenience" "languages" "tools")
:authors '(("Sebastian Wiesner" . "swiesner@lunaryorn.com"))
:maintainers '(("Clément Pit-Claudel" . "clement.pitclaudel@live.com")
lisp/flycheck/flycheck.el
+29 -6
View File
@@ -10,9 +10,9 @@
;; Bozhidar Batsov <bozhidar@batsov.dev>
;; URL: https://www.flycheck.org
;; Keywords: convenience, languages, tools
;; Package-Version: 20250527.907
;; Package-Revision: a4d782e7af12
;; Package-Requires: ((emacs "27.1"))
;; Package-Version: 20251119.1203
;; Package-Revision: 1eafe2911d50
;; Package-Requires: ((emacs "27.1") (seq "2.24"))
;; This file is not part of GNU Emacs.
@@ -10886,6 +10886,15 @@ Requires Flake8 3.0 or newer. See URL
(flycheck-def-config-file-var flycheck-python-ruff-config python-ruff
'("pyproject.toml" "ruff.toml" ".ruff.toml"))
(defun flycheck-python-ruff-explainer (err)
"Return documentation for the ruff `flycheck-error' ERR."
(when-let (error-code (flycheck-error-id err))
(lambda ()
(flycheck-call-checker-process
'python-ruff nil standard-output t "rule" error-code)
(with-current-buffer standard-output
(flycheck--fontify-as-markdown)))))
(flycheck-define-checker python-ruff
"A Python syntax and style checker using Ruff.
@@ -10907,14 +10916,16 @@ See URL `https://docs.astral.sh/ruff/'."
:error-patterns
((error line-start
(or "-" (file-name)) ":" line ":" (optional column ":") " "
"SyntaxError: "
;; first variant is produced by ruff < 0.8 and kept for backward compat
(or "SyntaxError: " "invalid-syntax: ")
(message (one-or-more not-newline))
line-end)
(warning line-start
(or "-" (file-name)) ":" line ":" (optional column ":") " "
(id (one-or-more (any alpha)) (one-or-more digit) " ")
(id (one-or-more (any alpha)) (one-or-more digit)) " "
(message (one-or-more not-newline))
line-end))
:error-explainer flycheck-python-ruff-explainer
:working-directory flycheck-python-find-project-root
:modes (python-mode python-ts-mode)
:next-checkers ((warning . python-mypy)))
@@ -12502,13 +12513,25 @@ or added as a shellcheck directive before the source command:
:safe #'booleanp
:package-version '(flycheck . "31"))
(flycheck-def-option-var flycheck-shellcheck-infer-shell nil sh-shellcheck
"Whether to let ShellCheck infer the shell from the script.
When non-nil, the --shell flag is not passed to ShellCheck,
allowing it to infer the shell from the shebang line or
shellcheck directives in the script."
:type 'boolean
:safe #'booleanp
:package-version '(flycheck . "36"))
(flycheck-define-checker sh-shellcheck
"A shell script syntax and style checker using Shellcheck.
See URL `https://github.com/koalaman/shellcheck/'."
:command ("shellcheck"
"--format" "checkstyle"
"--shell" (eval (symbol-name sh-shell))
(eval
(unless flycheck-shellcheck-infer-shell
(list "--shell" (symbol-name sh-shell))))
(option-flag "--external-sources"
flycheck-shellcheck-follow-sources)
(option "--exclude" flycheck-shellcheck-excluded-warnings list
lisp/gnuplot/gnuplot-context.el
+2 -2
View File
@@ -17,7 +17,7 @@
;; 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, see <http://www.gnu.org/licenses/>.
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -84,7 +84,7 @@
;;
;; The parsing machine and compiler are partially based on the
;; description in Medeiros and Ierusalimschy 2008, "A Parsing Machine
;; for PEGs" (http://dl.acm.org/citation.cfm?doid=1408681.1408683).
;; for PEGs" (https://dl.acm.org/citation.cfm?doid=1408681.1408683).
;;
;; The pattern-matching language
;; =============================
lisp/gnuplot/gnuplot-gui.el
+1 -1
View File
@@ -17,7 +17,7 @@
;; 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, see <http://www.gnu.org/licenses/>.
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
lisp/gnuplot/gnuplot-pkg.el
+3 -3
View File
@@ -1,11 +1,11 @@
;; -*- no-byte-compile: t; lexical-binding: nil -*-
(define-package "gnuplot" "20250613.1223"
(define-package "gnuplot" "20250724.1531"
"Major-mode and interactive frontend for gnuplot."
'((emacs "28.1")
(compat "30"))
:url "https://github.com/emacs-gnuplot/gnuplot"
:commit "f10d42221856e86c57dd5cc7400c078c021ba710"
:revdesc "f10d42221856"
:commit "43e9674b869475b1c2a32f045c167673eb2faae0"
:revdesc "43e9674b8694"
:keywords '("data" "gnuplot" "plotting")
:maintainers '(("Maxime Tréca" . "maxime@gmail.com")
("Daniel Mendler" . "mail@daniel-mendler.de")))
lisp/gnuplot/gnuplot.el
+3 -3
View File
@@ -5,8 +5,8 @@
;; Author: Jon Oddie, Bruce Ravel, Phil Type
;; Maintainer: Maxime Tréca <maxime@gmail.com>, Daniel Mendler <mail@daniel-mendler.de>
;; Created: 1998
;; Package-Version: 20250613.1223
;; Package-Revision: f10d42221856
;; Package-Version: 20250724.1531
;; Package-Revision: 43e9674b8694
;; Keywords: data gnuplot plotting
;; URL: https://github.com/emacs-gnuplot/gnuplot
;; Package-Requires: ((emacs "28.1") (compat "30"))
@@ -24,7 +24,7 @@
;; 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, see <http://www.gnu.org/licenses/>.
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
lisp/gnuplot/gnuplot.info
+792 -1688
View File
File diff suppressed because it is too large Load Diff
lisp/htmlize/htmlize-pkg.el
+3 -3
View File
@@ -1,10 +1,10 @@
;; -*- no-byte-compile: t; lexical-binding: nil -*-
(define-package "htmlize" "20250704.1928"
(define-package "htmlize" "20250724.1703"
"Convert buffer text and decorations to HTML."
'((emacs "26.1"))
:url "https://github.com/emacsorphanage/htmlize"
:commit "bf759aa3b2c4099a4252dccdc1db361fbb13a520"
:revdesc "bf759aa3b2c4"
:commit "c9a8196a59973fabb3763b28069af9a4822a5260"
:revdesc "c9a8196a5997"
:keywords '("hypermedia" "extensions")
:authors '(("Hrvoje Niksic" . "hniksic@gmail.com"))
:maintainers '(("Hrvoje Niksic" . "hniksic@gmail.com")))
lisp/htmlize/htmlize.el
+14 -15
View File
@@ -5,8 +5,8 @@
;; Author: Hrvoje Niksic <hniksic@gmail.com>
;; Homepage: https://github.com/emacsorphanage/htmlize
;; Keywords: hypermedia, extensions
;; Package-Version: 20250704.1928
;; Package-Revision: bf759aa3b2c4
;; Package-Version: 20250724.1703
;; Package-Revision: c9a8196a5997
;; Package-Requires: ((emacs "26.1"))
;; SPDX-License-Identifier: GPL-3.0-or-later
@@ -76,7 +76,7 @@
(require 'cl-lib)
(defconst htmlize-version "1.58")
(defconst htmlize-version "1.59")
(defgroup htmlize nil
"Convert buffer text and faces to HTML."
@@ -351,8 +351,8 @@ https://www.iana.org/assignments/media-types/media-types.xhtml#image")
;; overlays that specify the `face' property, even when they
;; contain smaller text properties that also specify `face'.
;; Emacs display engine merges those faces, and so must we.
(or limit
(setq limit (point-max)))
(unless limit
(setq limit (point-max)))
(let ((next-prop (next-single-property-change pos 'face nil limit))
(overlay-faces (htmlize-overlay-faces-at pos)))
(while (progn
@@ -681,9 +681,9 @@ list."
(push (htmlize-get-text-with-display pos next-change)
visible-list))
((and (eq show 'ellipsis)
(not (eq last-show 'ellipsis))
;; Conflate successive ellipses.
(push htmlize-ellipsis visible-list))))
(not (eq last-show 'ellipsis)))
;; Conflate successive ellipses.
(push htmlize-ellipsis visible-list)))
(setq pos next-change last-show show))
(htmlize-concat (nreverse visible-list))))
@@ -950,7 +950,7 @@ If no rgb.txt file is found, return nil."
;; specifying any color. Hence (htmlize-color-to-rgb nil)
;; returns nil.
)
((string-match "\\`#" color)
((string-match "\\`#[0-9a-fA-F]\\{6\\}" color)
;; The color is already in #rrggbb format.
(setq rgb-string color))
((and htmlize-use-rgb-txt
@@ -982,7 +982,7 @@ If no rgb.txt file is found, return nil."
foreground ; foreground color, #rrggbb
background ; background color, #rrggbb
size ; size
boldp ; whether face is bold
boldp ; whether face is bold
italicp ; whether face is italic
underlinep ; whether face is underlined
overlinep ; whether face is overlined
@@ -1206,9 +1206,8 @@ If no rgb.txt file is found, return nil."
(def (cond ((stringp raw-def) (list :foreground raw-def))
((listp raw-def) raw-def)
(t
(error (format (concat "face override must be an "
"attribute list or string, got %s")
raw-def))))))
(error "Face override must be %s, got %S"
"an attribute list or string" raw-def)))))
(and def
(htmlize-attrlist-to-fstruct def (symbol-name face)))))
@@ -1316,8 +1315,8 @@ overlays that specify `face'."
(let ((sym (intern (format "htmlize-%s-%s" htmlize-output-type method))))
(indirect-function (if (fboundp sym)
sym
(let ((default (intern (concat "htmlize-default-"
(symbol-name method)))))
(let ((default (intern (format "htmlize-default-%s"
method))))
(if (fboundp default)
default
'ignore))))))
lisp/ivy/ivy-pkg.el
+3 -3
View File
@@ -1,10 +1,10 @@
;; -*- no-byte-compile: t; lexical-binding: nil -*-
(define-package "ivy" "20250417.1209"
(define-package "ivy" "20251123.1023"
"Incremental Vertical completYon."
'((emacs "24.5"))
:url "https://github.com/abo-abo/swiper"
:commit "2529a23f9f510a94efa6c088bd14217aa764dafb"
:revdesc "2529a23f9f51"
:commit "ec9421340c88ebe08f05680e22308ed57ed68a3d"
:revdesc "ec9421340c88"
:keywords '("matching")
:authors '(("Oleh Krehel" . "ohwoeowho@gmail.com"))
:maintainers '(("Basil L. Contovounesios" . "basil@contovou.net")))
lisp/ivy/ivy.el
+27 -14
View File
@@ -5,8 +5,8 @@
;; Author: Oleh Krehel <ohwoeowho@gmail.com>
;; Maintainer: Basil L. Contovounesios <basil@contovou.net>
;; URL: https://github.com/abo-abo/swiper
;; Package-Version: 20250417.1209
;; Package-Revision: 2529a23f9f51
;; Package-Version: 20251123.1023
;; Package-Revision: ec9421340c88
;; Package-Requires: ((emacs "24.5"))
;; Keywords: matching
@@ -3171,11 +3171,11 @@ parts beyond their respective faces `ivy-confirm-face' and
`ivy-match-required-face'."
(dolist (pair '(("confirm" . ivy-confirm-face)
("match required" . ivy-match-required-face)))
(let ((i (string-match-p (car pair) prompt)))
(when i
(add-text-properties i (+ i (length (car pair)))
`(face ,(cdr pair) ,@props)
prompt))))
(let* ((beg (ivy--string-search (car pair) prompt))
(end (and beg (+ beg (length (car pair))))))
(when beg
(add-face-text-property beg end (cdr pair) nil prompt)
(add-text-properties beg end props prompt))))
prompt)
(defun ivy-prompt ()
@@ -3215,6 +3215,25 @@ parts beyond their respective faces `ivy-confirm-face' and
(when line (push line lines)))
(string-join (nreverse lines) "\n"))))
(defun ivy--propertize-prompt (prompt)
"Propertize PROMPT like `read-from-minibuffer' would.
Also handle `ivy-set-prompt-text-properties-function'."
(let ((len (length prompt))
;; Added unconditionally by `read-from-minibuffer'.
(props (list 'front-sticky t 'rear-nonsticky t 'field t))
;; Configurable.
(extras minibuffer-prompt-properties))
;; Filter out `face'; it is documented as being appended instead, and was
;; historically excluded from `ivy-set-prompt-text-properties-function'.
(while extras
(let ((key (pop extras))
(val (pop extras)))
(if (eq key 'face)
(add-face-text-property 0 len val t prompt)
(setq props (plist-put props key val)))))
(add-text-properties 0 len props prompt)
(funcall ivy-set-prompt-text-properties-function prompt props)))
(defun ivy--insert-prompt ()
"Update the prompt according to `ivy--prompt'."
(when (setq ivy--prompt (ivy-prompt))
@@ -3229,7 +3248,6 @@ parts beyond their respective faces `ivy-confirm-face' and
(setq head ivy--prompt)
(setq tail ""))
(let ((inhibit-read-only t)
(std-props '(front-sticky t rear-nonsticky t field t read-only t))
(n-str
(concat
(and (bound-and-true-p minibuffer-depth-indicate-mode)
@@ -3264,12 +3282,7 @@ parts beyond their respective faces `ivy-confirm-face' and
(when ivy-add-newline-after-prompt
(setq n-str (concat n-str "\n")))
(setq n-str (ivy--break-lines n-str (window-width)))
(set-text-properties 0 (length n-str)
`(face minibuffer-prompt ,@std-props)
n-str)
(setq n-str (funcall ivy-set-prompt-text-properties-function
n-str std-props))
(insert n-str))
(insert (ivy--propertize-prompt n-str)))
;; Mark prompt as selected if the user moves there or it is the only
;; option left. Since the user input stays put, we have to manually
;; remove the face as well.
lisp/ivy/ivy.info
+49 -50
View File
@@ -1,4 +1,4 @@
This is ivy.info, produced by makeinfo version 7.1.1 from ivy.texi.
This is ivy.info, produced by makeinfo version 7.2 from ivy.texi.
Ivy manual, version 0.15.1
@@ -118,7 +118,6 @@ API
* Example - counsel-locate::
* Example - ivy-read-with-extra-properties::

File: ivy.info, Node: Introduction, Next: Installation, Prev: Top, Up: Top
@@ -1911,60 +1910,60 @@ File: ivy.info, Node: Keystroke Index, Prev: Variable Index, Up: Top
* w: Hydra in the minibuffer.
(line 55)

Tag Table:
Node: Top1192
Node: Introduction3101
Node: Installation5616
Node: Installing from Emacs Package Manager5988
Node: Installing from the Git repository7235
Node: Getting started8062
Node: Basic customization8369
Node: Key bindings8969
Node: Global key bindings9161
Node: Minibuffer key bindings11582
Node: Key bindings for navigation12814
Node: Key bindings for single selection action then exit minibuffer14021
Node: Key bindings for multiple selections and actions keep minibuffer open16704
Node: Key bindings that alter the minibuffer input19326
Node: Other key bindings21275
Node: Hydra in the minibuffer21653
Node: Saving the current completion session to a buffer24071
Node: Completion Styles25483
Node: ivy--regex-plus27246
Node: ivy--regex-ignore-order28733
Node: ivy--regex-fuzzy29099
Node: Customization29590
Node: Faces29776
Node: Defcustoms32214
Node: Actions33554
Node: What are actions?33880
Node: How can different actions be called?34698
Node: How to modify the actions list?35265
Node: Example - add two actions to each command35925
Node: How to undo adding the two actions36885
Node: How to add actions to a specific command37339
Node: Example - define a new command with several actions37755
Node: Test the above function with ivy-occur38692
Node: Packages39536
Node: Commands40504
Node: File Name Completion40689
Node: Using TRAMP42698
Node: Buffer Name Completion44195
Node: Counsel commands44823
Node: API45470
Node: Required arguments for ivy-read46048
Node: Optional arguments for ivy-read46567
Node: Example - counsel-describe-function50015
Node: Example - counsel-locate52960
Node: Example - ivy-read-with-extra-properties56805
Node: Variable Index58091
Node: Keystroke Index65215
Node: Top1190
Node: Introduction3098
Node: Installation5613
Node: Installing from Emacs Package Manager5985
Node: Installing from the Git repository7232
Node: Getting started8059
Node: Basic customization8366
Node: Key bindings8966
Node: Global key bindings9158
Node: Minibuffer key bindings11579
Node: Key bindings for navigation12811
Node: Key bindings for single selection action then exit minibuffer14018
Node: Key bindings for multiple selections and actions keep minibuffer open16701
Node: Key bindings that alter the minibuffer input19323
Node: Other key bindings21272
Node: Hydra in the minibuffer21650
Node: Saving the current completion session to a buffer24068
Node: Completion Styles25480
Node: ivy--regex-plus27243
Node: ivy--regex-ignore-order28730
Node: ivy--regex-fuzzy29096
Node: Customization29587
Node: Faces29773
Node: Defcustoms32211
Node: Actions33551
Node: What are actions?33877
Node: How can different actions be called?34695
Node: How to modify the actions list?35262
Node: Example - add two actions to each command35922
Node: How to undo adding the two actions36882
Node: How to add actions to a specific command37336
Node: Example - define a new command with several actions37752
Node: Test the above function with ivy-occur38689
Node: Packages39533
Node: Commands40501
Node: File Name Completion40686
Node: Using TRAMP42695
Node: Buffer Name Completion44192
Node: Counsel commands44820
Node: API45467
Node: Required arguments for ivy-read46045
Node: Optional arguments for ivy-read46564
Node: Example - counsel-describe-function50012
Node: Example - counsel-locate52957
Node: Example - ivy-read-with-extra-properties56802
Node: Variable Index58088
Node: Keystroke Index65212

End Tag Table

Local Variables:
coding: utf-8
Info-documentlanguage: en
End:
lisp/ledger-mode/ledger-mode-pkg.el
+4 -4
View File
@@ -1,7 +1,7 @@
;; -*- no-byte-compile: t; lexical-binding: nil -*-
(define-package "ledger-mode" "20250317.529"
(define-package "ledger-mode" "20250821.1439"
"Helper code for use with the \"ledger\" command-line tool."
'((emacs "25.1"))
'((emacs "26.1"))
:url "https://github.com/ledger/ledger-mode"
:commit "d9b664820176bf294fbca5ee99c91920862cf37d"
:revdesc "d9b664820176")
:commit "e9bb645e8f05cf7ad0819b0450db7e84c9ed3f41"
:revdesc "e9bb645e8f05")
lisp/ledger-mode/ledger-mode.el
+9 -5
View File
@@ -4,9 +4,9 @@
;; This file is not part of GNU Emacs.
;; Package-Version: 20250317.529
;; Package-Revision: d9b664820176
;; Package-Requires: ((emacs "25.1"))
;; Package-Version: 20250821.1439
;; Package-Revision: e9bb645e8f05
;; Package-Requires: ((emacs "26.1"))
;; This 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
@@ -101,7 +101,7 @@
(defun ledger-read-payee-with-prompt (prompt)
"Read a payee from the minibuffer with PROMPT."
(ledger-completing-read-with-default prompt
(when-let ((payee (ledger-xact-payee)))
(when-let* ((payee (ledger-xact-payee)))
(regexp-quote payee))
(ledger-payees-list)))
@@ -457,12 +457,16 @@ With prefix ARG, decrement by that many instead."
(add-hook 'before-revert-hook 'ledger-highlight--before-revert nil t)
(add-hook 'after-revert-hook 'ledger-highlight-xact-under-point nil t)
(add-to-invisibility-spec 'ledger-occur-hidden)
(ledger-init-load-init-file)
(setq-local comment-start ";")
(setq-local indent-line-function #'ledger-indent-line)
(setq-local indent-region-function 'ledger-post-align-postings)
(setq-local beginning-of-defun-function #'ledger-navigate-beginning-of-xact)
(setq-local end-of-defun-function #'ledger-navigate-end-of-xact))
(setq-local end-of-defun-function #'ledger-navigate-end-of-xact)
(setq-local outline-regexp "[^[:space:]]"))
;;;###autoload
(add-to-list 'auto-mode-alist '("\\.ledger\\'" . ledger-mode))
lisp/ledger-mode/ledger-mode.info
+64 -66
View File
@@ -1,4 +1,4 @@
This is ledger-mode.info, produced by makeinfo version 7.1.1 from
This is ledger-mode.info, produced by makeinfo version 7.2 from
ledger-mode.texi.
Copyright © 2013, Craig Earls. All rights reserved.
@@ -1199,12 +1199,11 @@ Some users like to have org-like outlines for their ledger files. A
suggested customization is to include something like the following in
your Emacs configuration:
(eval-after-load 'ledger-mode
(progn
;; org-cycle allows completion to work whereas outline-toggle-children does not
(define-key ledger-mode-map (kbd "TAB") #'org-cycle)
(add-hook 'ledger-mode-hook #'outline-minor-mode)
(font-lock-add-keywords 'ledger-mode outline-font-lock-keywords)))
(with-eval-after-load 'ledger-mode
;; org-cycle allows completion to work whereas outline-toggle-children does not
(define-key ledger-mode-map (kbd "TAB") #'org-cycle)
(add-hook 'ledger-mode-hook #'outline-minor-mode)
(font-lock-add-keywords 'ledger-mode outline-font-lock-keywords))

File: ledger-mode.info, Node: Concept Index, Next: Command & Variable Index, Prev: Hacking Ledger-mode, Up: Top
@@ -1484,67 +1483,66 @@ Keystroke Index
* TAB: Adding Transactions. (line 6)
* y: Editing Amounts. (line 6)

Tag Table:
Node: Top1740
Node: Introduction to Ledger-mode2551
Node: Quick Installation2780
Node: Menus3712
Node: Quick Demo4027
Node: Quick Add4457
Node: Reconciliation5555
Node: Reports7239
Node: Narrowing8269
Node: The Ledger Buffer8853
Node: Navigating Transactions9259
Node: Adding Transactions9819
Node: Setting a Transactions Effective Date11316
Node: Quick Balance Display12216
Node: Copying Transactions12748
Node: Editing Amounts13350
Node: Marking Transactions14421
Node: Formatting Transactions16114
Node: Deleting Transactions16712
Node: Sorting Transactions17152
Node: Narrowing Transactions18700
Node: The Reconcile Buffer20544
Node: Basics of Reconciliation21009
Node: Starting a Reconciliation21956
Node: Mark Transactions Pending23805
Node: Edit Transactions During Reconciliation24474
Node: Finalize Reconciliation25117
Node: Adding and Deleting Transactions during Reconciliation25774
Node: Changing Reconciliation Account26358
Node: Changing Reconciliation Target26908
Node: The Report Buffer27226
Node: Running Basic Reports27484
Node: Adding and Editing Reports28917
Node: Expansion Formats30302
Node: Make Report Transactions Active31943
Node: Reversing Report Order32648
Node: Scheduling Transactions33341
Node: Specifying Upcoming Transactions34195
Node: Transactions that occur on specific dates34767
Node: Transactions that occur on specific days35808
Node: Customizing Ledger-mode36937
Node: Ledger-mode Customization37201
Node: Customization Variables37886
Node: Ledger Customization Group38366
Node: Ledger Reconcile Customization Group39006
Node: Ledger Report Customization Group41933
Node: Ledger Faces Customization Group42652
Node: Ledger Post Customization Group44399
Node: Ledger Exec Customization Group45226
Node: Ledger Test Customization Group45723
Node: Ledger Texi Customization Group46125
Node: Generating Ledger Regression Tests46617
Node: Embedding Example results in Ledger Documentation46880
Node: Hacking Ledger-mode47169
Node: Use org-like outlines47394
Node: Concept Index48059
Node: Command & Variable Index53575
Node: Keystroke Index61685
Node: Top1738
Node: Introduction to Ledger-mode2549
Node: Quick Installation2778
Node: Menus3710
Node: Quick Demo4025
Node: Quick Add4455
Node: Reconciliation5553
Node: Reports7237
Node: Narrowing8267
Node: The Ledger Buffer8851
Node: Navigating Transactions9257
Node: Adding Transactions9817
Node: Setting a Transactions Effective Date11314
Node: Quick Balance Display12214
Node: Copying Transactions12746
Node: Editing Amounts13348
Node: Marking Transactions14419
Node: Formatting Transactions16112
Node: Deleting Transactions16710
Node: Sorting Transactions17150
Node: Narrowing Transactions18698
Node: The Reconcile Buffer20542
Node: Basics of Reconciliation21007
Node: Starting a Reconciliation21954
Node: Mark Transactions Pending23803
Node: Edit Transactions During Reconciliation24472
Node: Finalize Reconciliation25115
Node: Adding and Deleting Transactions during Reconciliation25772
Node: Changing Reconciliation Account26356
Node: Changing Reconciliation Target26906
Node: The Report Buffer27224
Node: Running Basic Reports27482
Node: Adding and Editing Reports28915
Node: Expansion Formats30300
Node: Make Report Transactions Active31941
Node: Reversing Report Order32646
Node: Scheduling Transactions33339
Node: Specifying Upcoming Transactions34193
Node: Transactions that occur on specific dates34765
Node: Transactions that occur on specific days35806
Node: Customizing Ledger-mode36935
Node: Ledger-mode Customization37199
Node: Customization Variables37884
Node: Ledger Customization Group38364
Node: Ledger Reconcile Customization Group39004
Node: Ledger Report Customization Group41931
Node: Ledger Faces Customization Group42650
Node: Ledger Post Customization Group44397
Node: Ledger Exec Customization Group45224
Node: Ledger Test Customization Group45721
Node: Ledger Texi Customization Group46123
Node: Generating Ledger Regression Tests46615
Node: Embedding Example results in Ledger Documentation46878
Node: Hacking Ledger-mode47167
Node: Use org-like outlines47392
Node: Concept Index48039
Node: Command & Variable Index53555
Node: Keystroke Index61665

End Tag Table
lisp/ledger-mode/ledger-occur.el
+3 -3
View File
@@ -119,7 +119,7 @@ long, otherwise it is the word at point."
"Make an overlay for an invisible portion of the buffer, from BEG to END."
(let ((ovl (make-overlay beg end)))
(overlay-put ovl ledger-occur-overlay-property-name t)
(overlay-put ovl 'invisible t)))
(overlay-put ovl 'invisible 'ledger-occur-hidden)))
(defun ledger-occur-create-overlays (ovl-bounds)
"Create the overlays for the visible transactions.
@@ -150,8 +150,8 @@ Argument OVL-BOUNDS contains bounds for the transactions to be left visible."
;; Search loop
(while (not (eobp))
;; if something found
(when-let ((endpoint (re-search-forward regex nil 'end))
(bounds (ledger-navigate-find-element-extents endpoint)))
(when-let* ((endpoint (re-search-forward regex nil 'end))
(bounds (ledger-navigate-find-element-extents endpoint)))
(push bounds lines)
;; move to the end of the xact, no need to search inside it more
(goto-char (cadr bounds))))
lisp/ledger-mode/ledger-post.el
+1 -1
View File
@@ -210,7 +210,7 @@ Error if the commodities do not match."
(cl-loop
while (re-search-forward ledger-post-line-regexp end t)
for account-end = (match-end ledger-regex-post-line-group-account)
for amount-string = (when-let ((amount-string (match-string ledger-regex-post-line-group-amount)))
for amount-string = (when-let* ((amount-string (match-string ledger-regex-post-line-group-amount)))
(unless (string-empty-p (string-trim amount-string))
amount-string))
if (not amount-string)
lisp/ledger-mode/ledger-reconcile.el
+2 -2
View File
@@ -221,9 +221,9 @@ described above."
"Display the cleared-or-pending balance.
And calculate the target-delta of the account being reconciled."
(interactive)
(when-let (pending (ledger-reconcile-get-cleared-or-pending-balance ledger-reconcile-ledger-buf ledger-reconcile-account))
(when-let* ((pending (ledger-reconcile-get-cleared-or-pending-balance ledger-reconcile-ledger-buf ledger-reconcile-account)))
(let ((message
(if-let (diff (and ledger-reconcile-target (ledger-subtract-commodity ledger-reconcile-target pending)))
(if-let* ((diff (and ledger-reconcile-target (ledger-subtract-commodity ledger-reconcile-target pending))))
(progn
(setq ledger-reconcile-last-balance-equals-target (zerop (car diff)))
(format-message "Cleared and Pending balance: %s, Difference from target: %s"
lisp/ledger-mode/ledger-report.el
+11 -9
View File
@@ -1,4 +1,4 @@
;;; ledger-report.el --- Helper code for use with the "ledger" command-line tool -*- lexical-binding: t; -*-
;; ledger-report.el --- Helper code for use with the "ledger" command-line tool -*- lexical-binding: t; -*-
;; Copyright (C) 2003-2016 John Wiegley (johnw AT gnu DOT org)
@@ -432,8 +432,8 @@ called in the ledger buffer for which the report is being run."
(with-temp-buffer
(save-excursion (insert report-cmd))
(while (re-search-forward "%(\\([^)]*\\))" nil t)
(when-let ((specifier (match-string 1))
(f (cdr (assoc specifier ledger-report-format-specifiers))))
(when-let* ((specifier (match-string 1))
(f (cdr (assoc specifier ledger-report-format-specifiers))))
(let* ((arg (save-match-data
(with-current-buffer ledger-buf
(funcall f))))
@@ -442,7 +442,7 @@ called in the ledger buffer for which the report is being run."
(string-join arg " ")
(shell-quote-argument arg)))))
(replace-match quoted 'fixedcase 'literal))))
(buffer-string))))
(buffer-string))))
(defun ledger-report--cmd-needs-links-p (cmd)
"Check links should be added to the report produced by CMD."
@@ -553,12 +553,14 @@ specific posting at point instead."
(interactive)
(let* ((prop (get-text-property (point) 'ledger-source))
(file (car prop))
(line (cdr prop)))
(when (and file line)
(xact-position (cdr prop)))
(when (and file xact-position)
(find-file-other-window file)
(widen)
(goto-char (point-min))
(forward-line (1- line))
(if (markerp xact-position)
(goto-char xact-position)
(progn (goto-char (point-min))
(forward-line (1- xact-position))))
(when ledger-report-links-beginning-of-xact
(ledger-navigate-beginning-of-xact)))))
@@ -632,7 +634,7 @@ IGNORE-AUTO and NOCONFIRM are for compatibility with
(when (string-empty-p ledger-report-name)
(setq ledger-report-name (ledger-report-read-new-name)))
(when-let ((existing-name (ledger-report-name-exists ledger-report-name)))
(when-let* ((existing-name (ledger-report-name-exists ledger-report-name)))
(cond ((y-or-n-p (format "Overwrite existing report named '%s'? "
ledger-report-name))
(if (string-equal
lisp/ledger-mode/ledger-schedule.el
+6 -6
View File
@@ -103,15 +103,15 @@ COUNT 0) means EVERY day-of-week (eg. every Saturday)"
(cond ((zerop count) ;; Return true if day-of-week matches
`(eq (nth 6 (decode-time date)) ,day-of-week))
((> count 0) ;; Positive count
(let ((decoded (cl-gensym)))
(let ((decoded (gensym)))
`(let ((,decoded (decode-time date)))
(and (eq (nth 6 ,decoded) ,day-of-week)
(<= ,(* (1- count) 7)
(nth 3 ,decoded)
,(* count 7))))))
((< count 0)
(let ((days-in-month (cl-gensym))
(decoded (cl-gensym)))
(let ((days-in-month (gensym))
(decoded (gensym)))
`(let* ((,decoded (decode-time date))
(,days-in-month (ledger-schedule-days-in-month
(nth 4 ,decoded)
@@ -138,9 +138,9 @@ For example every second Friday, regardless of month."
(defun ledger-schedule-constrain-date-range (month1 day1 month2 day2)
"Return a form of DATE that is true if DATE falls between two dates.
The dates are given by the pairs MONTH1 DAY1 and MONTH2 DAY2."
(let ((decoded (cl-gensym))
(target-month (cl-gensym))
(target-day (cl-gensym)))
(let ((decoded (gensym))
(target-month (gensym))
(target-day (gensym)))
`(let* ((,decoded (decode-time date))
(,target-month (nth 4 decoded))
(,target-day (nth 3 decoded)))
lisp/ledger-mode/ledger-xact.el
+3 -3
View File
@@ -85,12 +85,12 @@ When nil, `ledger-add-transaction' will not prompt twice."
(defun ledger-xact-payee ()
"Return the payee of the transaction containing point or nil."
(when-let ((xact-context (ledger-xact-context)))
(when-let* ((xact-context (ledger-xact-context)))
(ledger-context-field-value xact-context 'payee)))
(defun ledger-xact-date ()
"Return the date of the transaction containing point or nil."
(when-let ((xact-context (ledger-xact-context)))
(when-let* ((xact-context (ledger-xact-context)))
(ledger-context-field-value xact-context 'date)))
(defun ledger-xact-find-slot (moment)
@@ -117,7 +117,7 @@ MOMENT is an encoded date"
(current-year (nth 5 (decode-time now))))
(while (not (eobp))
(when (looking-at ledger-iterate-regexp)
(if-let ((year (match-string 1)))
(if-let* ((year (match-string 1)))
(setq current-year (string-to-number year)) ;a Y directive was found
(let ((start (match-beginning 0))
(year (match-string (+ ledger-regex-iterate-group-actual-date 1)))
lisp/llama/llama-pkg.el
+3 -3
View File
@@ -1,9 +1,9 @@
;; -*- no-byte-compile: t; lexical-binding: nil -*-
(define-package "llama" "20250701.1529"
(define-package "llama" "20251101.2002"
"Compact syntax for short lambda."
'((emacs "26.1")
(compat "30.1"))
:url "https://github.com/tarsius/llama"
:commit "0cc2daffded18eea7f00a318cfa3e216977ffe50"
:revdesc "0cc2daffded1"
:commit "e4803de8ab85991b6a944430bb4f543ea338636d"
:revdesc "e4803de8ab85"
:keywords '("extensions"))
lisp/llama/llama.el
+6 -7
View File
@@ -6,9 +6,11 @@
;; Homepage: https://github.com/tarsius/llama
;; Keywords: extensions
;; Package-Version: 20250701.1529
;; Package-Revision: 0cc2daffded1
;; Package-Requires: ((emacs "26.1") (compat "30.1"))
;; Package-Version: 20251101.2002
;; Package-Revision: e4803de8ab85
;; Package-Requires: (
;; (emacs "26.1")
;; (compat "30.1"))
;; SPDX-License-Identifier: GPL-3.0-or-later
@@ -353,7 +355,7 @@ expansion, and the looks of this face should hint at that.")
(prog1 t
(save-excursion
(goto-char (match-beginning 0))
(when-let (((save-match-data (not (nth 8 (syntax-ppss)))))
(when-let ((_(save-match-data (not (nth 8 (syntax-ppss)))))
(expr (ignore-errors
(read-positioning-symbols (current-buffer)))))
(put-text-property (match-beginning 0) (point)
@@ -449,9 +451,6 @@ expansion, and the looks of this face should hint at that.")
(defun llama--add-font-lock-keywords ()
(font-lock-add-keywords nil llama-font-lock-keywords))
(define-obsolete-function-alias 'global-llama-fontify-mode
#'llama-fontify-mode "Llama 0.6.2")
(defun lisp--el-match-keyword@llama (limit)
"Highlight symbols following \"(##\" the same as if they followed \"(\"."
(catch 'found
lisp/magit-section/magit-section-pkg.el
+8 -7
View File
@@ -1,13 +1,14 @@
;; -*- no-byte-compile: t; lexical-binding: nil -*-
(define-package "magit-section" "20250704.2300"
(define-package "magit-section" "20251108.1923"
"Sections for read-only buffers."
'((emacs "27.1")
(compat "30.1")
(llama "1.0.0")
(seq "2.24"))
'((emacs "28.1")
(compat "30.1")
(cond-let "0.1")
(llama "1.0")
(seq "2.24"))
:url "https://github.com/magit/magit"
:commit "5b820a1d1e94649e0f218362286d520d9f29ac2c"
:revdesc "5b820a1d1e94"
:commit "2d8f43e68125d9f7cf97ba182a5d266fe1a52c67"
:revdesc "2d8f43e68125"
:keywords '("tools")
:authors '(("Jonas Bernoulli" . "emacs.magit@jonas.bernoulli.dev"))
:maintainers '(("Jonas Bernoulli" . "emacs.magit@jonas.bernoulli.dev")))
lisp/magit-section/magit-section.el
+324 -285
View File
@@ -8,13 +8,14 @@
;; Homepage: https://github.com/magit/magit
;; Keywords: tools
;; Package-Version: 20250704.2300
;; Package-Revision: 5b820a1d1e94
;; Package-Version: 20251108.1923
;; Package-Revision: 2d8f43e68125
;; Package-Requires: (
;; (emacs "27.1")
;; (compat "30.1")
;; (llama "1.0.0")
;; (seq "2.24"))
;; (emacs "28.1")
;; (compat "30.1")
;; (cond-let "0.1")
;; (llama "1.0")
;; (seq "2.24"))
;; SPDX-License-Identifier: GPL-3.0-or-later
@@ -45,8 +46,9 @@
(require 'cl-lib)
(require 'compat)
(require 'cond-let)
(require 'eieio)
(require 'llama)
(require 'llama) ; For (##these ...) see M-x describe-function RET # # RET.
(require 'subr-x)
;; For older Emacs releases we depend on an updated `seq' release from GNU
@@ -103,6 +105,9 @@ similar defect.")
(define-obsolete-variable-alias 'magit-keep-region-overlay
'magit-section-keep-region-overlay "Magit-Section 4.0.0")
(define-obsolete-variable-alias 'magit-section-visibility-indicator
'magit-section-visibility-indicators "Magit-Section 4.4.3")
;;; Hooks
(defvar magit-section-movement-hook nil
@@ -192,15 +197,17 @@ entries of this alist."
(const show)
function)))
(defcustom magit-section-visibility-indicator
(if (window-system)
'(magit-fringe-bitmap> . magit-fringe-bitmapv)
(cons (if (char-displayable-p ?…) "…" "...")
t))
(defcustom magit-section-visibility-indicators
`((magit-fringe-bitmap> . magit-fringe-bitmapv)
(,(if (char-displayable-p ?…) "…" "...") . t))
"Whether and how to indicate that a section can be expanded/collapsed.
If nil, then don't show any indicators.
Otherwise the value has to have one of these two forms:
If nil, then don't show any indicators. Otherwise the value has to
be a list with two elements. The first controls the indicators used
in graphical frames, the second the indicators in terminal frames.
For graphical frames all of the following forms are valid, while
terminal frames do not have fringes and thus do not support the first
form.
\(EXPANDABLE-BITMAP . COLLAPSIBLE-BITMAP)
@@ -211,6 +218,11 @@ Otherwise the value has to have one of these two forms:
To provide extra padding around the indicator, set
`left-fringe-width' in `magit-mode-hook'.
\(EXPANDABLE-CHAR . COLLAPSIBLE-CHAR)
In this case every section that can be expanded or collapsed
gets an indicator in the left margin.
\(STRING . BOOLEAN)
In this case STRING (usually an ellipsis) is shown at the end
@@ -221,24 +233,41 @@ Otherwise the value has to have one of these two forms:
doing so is kinda ugly."
:package-version '(magit-section . "3.0.0")
:group 'magit-section
:type '(choice (const :tag "No indicators" nil)
:type '(choice
(const :tag "No indicators" nil)
(list (choice :tag "In graphical frames"
(cons :tag "Use +- fringe indicators"
(const magit-fringe-bitmap+)
(const magit-fringe-bitmap-))
:format "%{%t%}%v\n"
(const :format " " magit-fringe-bitmap+)
(const :format " " magit-fringe-bitmap-))
(cons :tag "Use >v fringe indicators"
(const magit-fringe-bitmap>)
(const magit-fringe-bitmapv))
(cons :tag "Use bold >v fringe indicators)"
(const magit-fringe-bitmap-bold>)
(const magit-fringe-bitmap-boldv))
:format "%{%t%}%v\n"
(const :format " " magit-fringe-bitmap>)
(const :format " " magit-fringe-bitmapv))
(cons :tag "Use bold >v fringe indicators"
:format "%{%t%}%v\n"
(const :format " " magit-fringe-bitmap-bold>)
(const :format " " magit-fringe-bitmap-boldv))
(cons :tag "Use custom fringe indicators"
(variable :tag "Expandable bitmap variable")
(variable :tag "Collapsible bitmap variable"))
(cons :tag "Use margin indicators"
(character :tag "Expandable char" ?+)
(character :tag "Collapsible char" ?-))
(cons :tag "Use ellipses at end of headings"
(string :tag "Ellipsis" "…")
(choice :tag "Use face kludge"
(const :tag "Yes (potentially slow)" t)
(const :tag "No (kinda ugly)" nil)))))
(const :tag "No (kinda ugly)" nil))))
(choice :tag "In terminal frames"
(cons :tag "Use margin indicators"
(character :tag "Expandable char" ?+)
(character :tag "Collapsible char" ?-))
(cons :tag "Use ellipses at end of headings"
(string :tag "Ellipsis" "…")
(choice :tag "Use face kludge"
(const :tag "Yes (potentially slow)" t)
(const :tag "No (kinda ugly)" nil)))))))
(defcustom magit-section-keep-region-overlay nil
"Whether to keep the region overlay when there is a valid selection.
@@ -291,16 +320,6 @@ but that ship has sailed, thus this option."
:group 'magit-section
:type 'boolean)
(defcustom magit-section-show-context-menu-for-emacs<28 nil
"Whether `mouse-3' shows a context menu for Emacs < 28.
This has to be set before loading `magit-section' or it has
no effect. This also has no effect for Emacs >= 28, where
`context-menu-mode' should be enabled instead."
:package-version '(magit-section . "4.0.0")
:group 'magit-section
:type 'boolean)
;;; Variables
(defvar-local magit-section-preserve-visibility t)
@@ -369,6 +388,24 @@ no effect. This also has no effect for Emacs >= 28, where
"Face used for child counts at the end of some section headings."
:group 'magit-section-faces)
(defface magit-left-margin '((t :inherit default))
"Face used for the left margin.
Currently this is only used for section visibility indicators, and only
when `magit-section-visibility-indicator' is configured to show them in
the margin.
Due to limitations of how the margin works in Emacs, this is only used
for those parts of the margin that actually display an indicator. For
that reason you should probably avoid setting the background color.
Reasonable values include ((t)), which causes the indicator to inherit
the look of the heading (including section highlighting, if any), and
\((t :inherit default), which prevents that and causes the margin to
look like regular un-styled text in the buffer. Building on that, you
can make it look different, e.g., ((t :inherit default :weight bold)."
:group 'magit-section-faces)
;;; Classes
(defvar magit--current-section-hook nil
@@ -400,49 +437,36 @@ no effect. This also has no effect for Emacs >= 28, where
(defvar-keymap magit-section-heading-map
:doc "Keymap used in the heading line of all expandable sections.
This keymap is used in addition to the section-specific keymap, if any."
"<double-down-mouse-1>" #'ignore
"<double-mouse-1>" #'magit-mouse-toggle-section
"<double-mouse-2>" #'magit-mouse-toggle-section)
"<double-down-mouse-1>" #'ignore
"<double-mouse-1>" #'magit-mouse-toggle-section
"<double-mouse-2>" #'magit-mouse-toggle-section
"<left-margin> <mouse-1>" #'magit-mouse-toggle-section)
(defvar magit-section-mode-map
(let ((map (make-keymap)))
(suppress-keymap map t)
(when (and magit-section-show-context-menu-for-emacs<28
(< emacs-major-version 28))
(keymap-set map "<mouse-3>" nil)
(keymap-set
map "<down-mouse-3>"
`( menu-item "" ,(make-sparse-keymap)
:filter ,(lambda (_)
(let ((menu (make-sparse-keymap)))
(if (fboundp 'context-menu-local)
(context-menu-local menu last-input-event)
(magit--context-menu-local menu last-input-event))
(magit-section-context-menu menu last-input-event)
menu)))))
(keymap-set map "<left-fringe> <mouse-1>" #'magit-mouse-toggle-section)
(keymap-set map "<left-fringe> <mouse-2>" #'magit-mouse-toggle-section)
(keymap-set map "TAB" #'magit-section-toggle)
(keymap-set map "C-c TAB" #'magit-section-cycle)
(keymap-set map "C-<tab>" #'magit-section-cycle)
(keymap-set map "M-<tab>" #'magit-section-cycle)
;; <backtab> is the most portable binding for Shift+Tab.
(keymap-set map "<backtab>" #'magit-section-cycle-global)
(keymap-set map "^" #'magit-section-up)
(keymap-set map "p" #'magit-section-backward)
(keymap-set map "n" #'magit-section-forward)
(keymap-set map "M-p" #'magit-section-backward-sibling)
(keymap-set map "M-n" #'magit-section-forward-sibling)
(keymap-set map "1" #'magit-section-show-level-1)
(keymap-set map "2" #'magit-section-show-level-2)
(keymap-set map "3" #'magit-section-show-level-3)
(keymap-set map "4" #'magit-section-show-level-4)
(keymap-set map "M-1" #'magit-section-show-level-1-all)
(keymap-set map "M-2" #'magit-section-show-level-2-all)
(keymap-set map "M-3" #'magit-section-show-level-3-all)
(keymap-set map "M-4" #'magit-section-show-level-4-all)
map)
"Parent keymap for all keymaps of modes derived from `magit-section-mode'.")
(defvar-keymap magit-section-mode-map
:doc "Parent keymap for keymaps of modes derived from `magit-section-mode'."
:full t
:suppress t
"<left-fringe> <mouse-1>" #'magit-mouse-toggle-section
"<left-fringe> <mouse-2>" #'magit-mouse-toggle-section
"TAB" #'magit-section-toggle
"C-c TAB" #'magit-section-cycle
"C-<tab>" #'magit-section-cycle
"M-<tab>" #'magit-section-cycle
;; <backtab> is the most portable binding for Shift+Tab.
"<backtab>" #'magit-section-cycle-global
"^" #'magit-section-up
"p" #'magit-section-backward
"n" #'magit-section-forward
"M-p" #'magit-section-backward-sibling
"M-n" #'magit-section-forward-sibling
"1" #'magit-section-show-level-1
"2" #'magit-section-show-level-2
"3" #'magit-section-show-level-3
"4" #'magit-section-show-level-4
"M-1" #'magit-section-show-level-1-all
"M-2" #'magit-section-show-level-2-all
"M-3" #'magit-section-show-level-3-all
"M-4" #'magit-section-show-level-4-all)
(define-derived-mode magit-section-mode special-mode "Magit-Sections"
"Parent major mode from which major modes with Magit-like sections inherit.
@@ -453,11 +477,9 @@ Magit-Section is documented in info node `(magit-section)'."
(buffer-disable-undo)
(setq truncate-lines t)
(setq buffer-read-only t)
(setq-local line-move-visual t) ; see #1771
;; Turn off syntactic font locking, but not by setting
;; `font-lock-defaults' because that would enable font locking, and
;; not all magit plugins may be ready for that (see #3950).
(setq-local font-lock-syntactic-face-function #'ignore)
(setq-local line-move-visual t) ; See #1771.
;; Turn off syntactic font locking. See #5420.
(setq-local font-lock-defaults '(nil t))
(setq show-trailing-whitespace nil)
(setq-local symbol-overlay-inhibit-map t)
(setq list-buffers-directory (abbreviate-file-name default-directory))
@@ -545,8 +567,8 @@ the click occurred. Otherwise return the section at point."
The return value has the form ((TYPE . VALUE)...)."
(cons (cons (oref section type)
(magit-section-ident-value section))
(and-let* ((parent (oref section parent)))
(magit-section-ident parent))))
(and$ (oref section parent)
(magit-section-ident $))))
(defun magit-section-equal (a b)
"Return t if A an B are the same section."
@@ -606,8 +628,8 @@ instead of in the one whose root `magit-root-section' is."
If optional RAW is non-nil, return a list of section objects, beginning
with SECTION, otherwise return a list of section types."
(cons (if raw section (oref section type))
(and-let* ((parent (oref section parent)))
(magit-section-lineage parent raw))))
(and$ (oref section parent)
(magit-section-lineage $ raw))))
(defvar-local magit-insert-section--current nil "For internal use only.")
(defvar-local magit-insert-section--parent nil "For internal use only.")
@@ -638,17 +660,17 @@ with SECTION, otherwise return a list of section types."
`(menu-item
,(if (oref section hidden) "Expand section" "Collapse section")
magit-section-toggle))
(when-let (((not (oref section hidden)))
(children (oref section children)))
(when (seq-some #'magit-section-content-p children)
(when (seq-some (##oref % hidden) children)
(keymap-set-after menu "<magit-section-show-children>"
`(menu-item "Expand children"
magit-section-show-children)))
(when (seq-some (##not (oref % hidden)) children)
(keymap-set-after menu "<magit-section-hide-children>"
`(menu-item "Collapse children"
magit-section-hide-children)))))
(when-let* ((_(not (oref section hidden)))
(children (oref section children))
(_(seq-some #'magit-section-content-p children)))
(when (seq-some (##oref % hidden) children)
(keymap-set-after menu "<magit-section-show-children>"
`(menu-item "Expand children"
magit-section-show-children)))
(when (seq-some (##not (oref % hidden)) children)
(keymap-set-after menu "<magit-section-hide-children>"
`(menu-item "Collapse children"
magit-section-hide-children))))
(keymap-set-after menu "<separator-magit-1>" menu-bar-separator))
(keymap-set-after menu "<magit-describe-section>"
`(menu-item "Describe section" magit-describe-section))
@@ -662,9 +684,7 @@ with SECTION, otherwise return a list of section types."
(when (consp binding)
(define-key-after menu (vector key)
(copy-sequence binding))))
(if (fboundp 'menu-bar-keymap)
(menu-bar-keymap map)
(magit--menu-bar-keymap map)))))
(menu-bar-keymap map))))
menu)
(defun magit-menu-item (desc def &optional props)
@@ -687,11 +707,11 @@ See `magit-menu-format-desc'."
(or (ignore-errors
(save-excursion
(goto-char (magit-menu-position))
(and-let* ((key (cl-find-if-not
(lambda (key)
(string-match-p "\\`<[0-9]+>\\'"
(key-description key)))
(where-is-internal def))))
(and-let ((key (cl-find-if-not
(lambda (key)
(string-match-p "\\`<[0-9]+>\\'"
(key-description key)))
(where-is-internal def))))
(key-description key))))
""))
@@ -705,14 +725,15 @@ then return nil."
(defun magit-menu-highlight-point-section ()
(setq magit-section-highlight-force-update t)
(if (eq (current-buffer) magit--context-menu-buffer)
(setq magit--context-menu-section nil)
(if-let ((window (get-buffer-window magit--context-menu-buffer)))
(with-selected-window window
(setq magit--context-menu-section nil)
(magit-section-update-highlight))
(with-current-buffer magit--context-menu-buffer
(setq magit--context-menu-section nil))))
(cond-let
((eq (current-buffer) magit--context-menu-buffer)
(setq magit--context-menu-section nil))
([window (get-buffer-window magit--context-menu-buffer)]
(with-selected-window window
(setq magit--context-menu-section nil)
(magit-section-update-highlight)))
((with-current-buffer magit--context-menu-buffer
(setq magit--context-menu-section nil))))
(setq magit--context-menu-buffer nil))
(defvar magit--plural-append-es '(branch))
@@ -758,28 +779,6 @@ The following %-specs are allowed:
(?M . ,(or multiple value))
(?x . ,(format "%s" magit-menu-common-value))))))
(defun magit--menu-bar-keymap (keymap)
"Backport of `menu-bar-keymap' for Emacs < 28.
Slight trimmed down."
(let ((menu-bar nil))
(map-keymap (lambda (key binding)
(push (cons key binding) menu-bar))
keymap)
(cons 'keymap (nreverse menu-bar))))
(defun magit--context-menu-local (menu _click)
"Backport of `context-menu-local' for Emacs < 28."
(run-hooks 'activate-menubar-hook 'menu-bar-update-hook)
(keymap-set-after menu "<separator-local>" menu-bar-separator)
(let ((keymap (local-key-binding [menu-bar])))
(when keymap
(map-keymap (lambda (key binding)
(when (consp binding)
(define-key-after menu (vector key)
(copy-sequence binding))))
(magit--menu-bar-keymap keymap))))
menu)
(define-advice context-menu-region (:around (fn menu click) magit-section-mode)
"Disable in `magit-section-mode' buffers."
(if (derived-mode-p 'magit-section-mode)
@@ -857,23 +856,25 @@ the beginning of the current section."
"Move to the beginning of the next sibling section.
If there is no next sibling section, then move to the parent."
(interactive)
(let ((current (magit-current-section)))
(if (oref current parent)
(if-let ((next (car (magit-section-siblings current 'next))))
(magit-section-goto next)
(magit-section-forward))
(magit-section-goto 1))))
(cond-let
[[current (magit-current-section)]]
((not (oref current parent))
(magit-section-goto 1))
([next (car (magit-section-siblings current 'next))]
(magit-section-goto next))
((magit-section-forward))))
(defun magit-section-backward-sibling ()
"Move to the beginning of the previous sibling section.
If there is no previous sibling section, then move to the parent."
(interactive)
(let ((current (magit-current-section)))
(if (oref current parent)
(if-let ((previous (car (magit-section-siblings current 'prev))))
(magit-section-goto previous)
(magit-section-backward))
(magit-section-goto -1))))
(cond-let
[[current (magit-current-section)]]
((not (oref current parent))
(magit-section-goto -1))
([previous (car (magit-section-siblings current 'prev))]
(magit-section-goto previous))
((magit-section-backward))))
(defun magit-mouse-set-point (event &optional promote-to-region)
"Like `mouse-set-point' but also call `magit-section-movement-hook'."
@@ -897,7 +898,7 @@ See info node `(magit)Section Movement'."
(defmacro magit-define-section-jumper
(name heading type &optional value inserter &rest properties)
"Define an interactive function to go some section.
"Define an interactive function to go to some section.
Together TYPE and VALUE identify the section.
HEADING is the displayed heading of the section."
(declare (indent defun))
@@ -909,19 +910,23 @@ With a prefix argument also expand it." heading)
(list :description heading))
,@(and inserter
`(:if (##memq ',inserter
(bound-and-true-p magit-status-sections-hook))))
(symbol-value
(intern (format "%s-sections-hook"
(substring (symbol-name major-mode)
0 -5)))))))
:inapt-if-not (##magit-get-section
(cons (cons ',type ,value)
(magit-section-ident magit-root-section)))
(interactive "P")
(if-let ((section (magit-get-section
(cons (cons ',type ,value)
(magit-section-ident magit-root-section)))))
(progn (goto-char (oref section start))
(when expand
(with-local-quit (magit-section-show section))
(recenter 0)))
(message ,(format "Section \"%s\" wasn't found" heading)))))
(cond-let
([section (magit-get-section
(cons (cons ',type ,value)
(magit-section-ident magit-root-section)))]
(goto-char (oref section start))
(when expand
(with-local-quit (magit-section-show section))
(recenter 0)))
((message ,(format "Section \"%s\" wasn't found" heading))))))
;;;; Visibility
@@ -1026,62 +1031,61 @@ from using this key and instead bind another key to `tab-next'. Because
`tab-bar-mode' does not use a mode map but instead manipulates the
global map, this involves advising `tab-bar--define-keys'."
(interactive (list (magit-current-section)))
(cond
((and (equal (this-command-keys) [C-tab])
(eq (global-key-binding [C-tab]) 'tab-next)
(fboundp 'tab-bar-switch-to-next-tab))
(tab-bar-switch-to-next-tab current-prefix-arg))
((eq section magit-root-section)
(magit-section-cycle-global))
((oref section hidden)
(magit-section-show section)
(magit-section-hide-children section))
((let ((children (oref section children)))
(cond ((and (seq-some (##oref % hidden) children)
(seq-some (##oref % children) children))
(magit-section-show-headings section))
((seq-some #'magit-section-hidden-body children)
(magit-section-show-children section))
((magit-section-hide section)))))))
(cond-let
((and (equal (this-command-keys) [C-tab])
(eq (global-key-binding [C-tab]) 'tab-next)
(fboundp 'tab-bar-switch-to-next-tab))
(tab-bar-switch-to-next-tab current-prefix-arg))
((eq section magit-root-section)
(magit-section-cycle-global))
((oref section hidden)
(magit-section-show section)
(magit-section-hide-children section))
[[children (oref section children)]]
((and (seq-some (##oref % hidden) children)
(seq-some (##oref % children) children))
(magit-section-show-headings section))
((seq-some #'magit-section-hidden-body children)
(magit-section-show-children section))
((magit-section-hide section))))
(defun magit-section-cycle-global ()
"Cycle visibility of all sections in the current buffer."
(interactive)
(let ((children (oref magit-root-section children)))
(cond ((and (seq-some (##oref % hidden) children)
(seq-some (##oref % children) children))
(magit-section-show-headings magit-root-section))
((seq-some #'magit-section-hidden-body children)
(magit-section-show-children magit-root-section))
(t
(mapc #'magit-section-hide children)))))
(cond-let
[[children (oref magit-root-section children)]]
((and (seq-some (##oref % hidden) children)
(seq-some (##oref % children) children))
(magit-section-show-headings magit-root-section))
((seq-some #'magit-section-hidden-body children)
(magit-section-show-children magit-root-section))
((mapc #'magit-section-hide children))))
(defun magit-section-hidden (section)
"Return t if SECTION and/or an ancestor is hidden."
"Return t if the content of SECTION or of any ancestor is hidden.
Ignore whether the body of any of SECTION's descendants is hidden.
When the status of descendants is irrelevant but that of ancestors
matters, instead use `magit-section-hidden-body'."
(or (oref section hidden)
(and-let* ((parent (oref section parent)))
(magit-section-hidden parent))))
(and$ (oref section parent)
(magit-section-hidden $))))
(defun magit-section-hidden-body (section &optional pred)
"Return t if the content of SECTION or of any children is hidden."
"Return t if the content of SECTION or of any descendant is hidden.
Ignore whether the body of any of SECTION's ancestors is hidden;
if you need that use `magit-section-hidden'."
(if-let ((children (oref section children)))
(funcall (or pred #'seq-some) #'magit-section-hidden-body children)
(and (oref section content)
(oref section hidden))))
(defalias 'magit-section-invisible-p #'magit-section-hidden)
(defun magit-section-content-p (section)
"Return non-nil if SECTION has content or an unused washer function."
(with-slots (content end washer) section
(and content (or (not (= content end)) washer))))
(defun magit-section-invisible-p (section)
"Return t if the SECTION's body is invisible.
When the body of an ancestor of SECTION is collapsed then
SECTION's body (and heading) obviously cannot be visible."
(or (oref section hidden)
(and-let* ((parent (oref section parent)))
(magit-section-invisible-p parent))))
(defun magit-section-show-level (level)
"Show surrounding sections up to LEVEL.
Likewise hide sections at higher levels. If the region selects multiple
@@ -1163,12 +1167,15 @@ silently ignored."
;;;; Auxiliary
(defun magit-describe-section-briefly (section &optional ident interactive)
"Show information about the section at point.
(defun magit-describe-section-briefly (&optional section ident interactive)
"Show information about SECTION or the section at point.
With a prefix argument show the section identity instead of the
section lineage. This command is intended for debugging purposes.
\n(fn SECTION &optional IDENT)"
Non-interactively, just return the information. Interactively,
or when INTERACTIVE is non-nil, show the section in the echo area."
(interactive (list (magit-current-section) current-prefix-arg t))
(unless section
(setq section (magit-current-section)))
(let ((str (format "#<%s %S %S %s-%s%s>"
(eieio-object-class section)
(let ((val (oref section value)))
@@ -1177,19 +1184,18 @@ section lineage. This command is intended for debugging purposes.
((and (eieio-object-p val)
(fboundp 'cl-prin1-to-string))
(cl-prin1-to-string val))
(t
val)))
(val)))
(if ident
(magit-section-ident section)
(apply #'vector (magit-section-lineage section)))
(and-let* ((m (oref section start)))
(if (markerp m) (marker-position m) m))
(and$ (oref section start)
(if (markerp $) (marker-position $) $))
(if-let ((m (oref section content)))
(format "[%s-]"
(if (markerp m) (marker-position m) m))
"")
(and-let* ((m (oref section end)))
(if (markerp m) (marker-position m) m)))))
(and$ (oref section end)
(if (markerp $) (marker-position $) $)))))
(when interactive
(message "%s" str))
str))
@@ -1287,17 +1293,18 @@ of course you want to be that precise."
(defun magit-section-match-2 (condition section)
(if (eq (car condition) '*)
(or (magit-section-match-2 (cdr condition) section)
(and-let* ((parent (oref section parent)))
(magit-section-match-2 condition parent)))
(and (let ((c (car condition)))
(if (class-p c)
(cl-typep section c)
(if-let ((class (cdr (assq c magit--section-type-alist))))
(cl-typep section class)
(eq (oref section type) c))))
(and$ (oref section parent)
(magit-section-match-2 condition $)))
(and (cond-let
[[c (car condition)]]
((class-p c)
(cl-typep section c))
([class (cdr (assq c magit--section-type-alist))]
(cl-typep section class))
((eq (oref section type) c)))
(or (not (setq condition (cdr condition)))
(and-let* ((parent (oref section parent)))
(magit-section-match-2 condition parent))))))
(and$ (oref section parent)
(magit-section-match-2 condition $))))))
(defun magit-section-value-if (condition &optional section)
"If the section at point matches CONDITION, then return its value.
@@ -1308,9 +1315,9 @@ then return nil. If the section does not match, then return
nil.
See `magit-section-match' for the forms CONDITION can take."
(and-let* ((section (or section (magit-current-section))))
(and (magit-section-match condition section)
(oref section value))))
(and$ (or section (magit-current-section))
(and (magit-section-match condition $)
(oref $ value))))
(defmacro magit-section-case (&rest clauses)
"Choose among clauses on the type of the section at point.
@@ -1328,7 +1335,7 @@ matches if no other CONDITION match, even if there is no section
at point."
(declare (indent 0)
(debug (&rest (sexp body))))
`(let* ((it (magit-current-section)))
`(let ((it (magit-current-section)))
(cond ,@(mapcar (lambda (clause)
`(,(or (eq (car clause) t)
`(and it
@@ -1614,8 +1621,8 @@ is explicitly expanded."
(defun magit-section--set-section-properties (section)
(pcase-let* (((eieio start end children keymap) section)
(props `( magit-section ,section
,@(and-let* ((map (symbol-value keymap)))
(list 'keymap map)))))
,@(and$ (symbol-value keymap)
(list 'keymap $)))))
(if children
(save-excursion
(goto-char start)
@@ -1814,8 +1821,8 @@ evaluated its BODY. Admittedly that's a bit of a hack."
(and as-child
(oref section heading-highlight-face))
(slot-boundp section 'painted)
(and-let* ((children (oref section children)))
(magit-section-selective-highlight-p (car children) t))))
(and$ (oref section children)
(magit-section-selective-highlight-p (car $) t))))
;;; Paint
@@ -1910,7 +1917,7 @@ to nil." (bound-and-true-p long-line-threshold)) :warning)))))
(defun magit-section-goto-successor--same (section line char)
(let ((ident (magit-section-ident section)))
(and-let* ((found (magit-get-section ident)))
(and-let ((found (magit-get-section ident)))
(let ((start (oref found start)))
(goto-char start)
(unless (eq found magit-root-section)
@@ -1922,25 +1929,25 @@ to nil." (bound-and-true-p long-line-threshold)) :warning)))))
t))))
(defun magit-section-goto-successor--related (section)
(and-let* ((found (magit-section-goto-successor--related-1 section)))
(and-let ((found (magit-section-goto-successor--related-1 section)))
(goto-char (if (eq (oref found type) 'button)
(point-min)
(oref found start)))))
(defun magit-section-goto-successor--related-1 (section)
(or (and-let* ((alt (pcase (oref section type)
('staged 'unstaged)
('unstaged 'staged)
('unpushed 'unpulled)
('unpulled 'unpushed))))
(magit-get-section `((,alt) (status))))
(and-let* ((next (car (magit-section-siblings section 'next))))
(magit-get-section (magit-section-ident next)))
(and-let* ((prev (car (magit-section-siblings section 'prev))))
(magit-get-section (magit-section-ident prev)))
(and-let* ((parent (oref section parent)))
(or (magit-get-section (magit-section-ident parent))
(magit-section-goto-successor--related-1 parent)))))
(or (and$ (pcase (oref section type)
('staged 'unstaged)
('unstaged 'staged)
('unpushed 'unpulled)
('unpulled 'unpushed))
(magit-get-section `((,$) (status))))
(and$ (magit-section-siblings section 'next)
(magit-get-section (magit-section-ident (car $))))
(and$ (magit-section-siblings section 'prev)
(magit-get-section (magit-section-ident (car $))))
(and$ (oref section parent)
(or (magit-get-section (magit-section-ident $))
(magit-section-goto-successor--related-1 $)))))
;;; Region
@@ -1997,37 +2004,52 @@ When `magit-section-preserve-visibility' is nil, return nil."
magit-section-cache-visibility))
(magit-section-cache-visibility section)))
(defun magit-section-visibility-indicator ()
(if (window-system)
(car magit-section-visibility-indicators)
(cadr magit-section-visibility-indicators)))
(defun magit-section-maybe-update-visibility-indicator (section)
(when (and magit-section-visibility-indicator
(magit-section-content-p section))
(when-let* ((indicator (magit-section-visibility-indicator))
(_(magit-section-content-p section)))
(let* ((beg (oref section start))
(eoh (magit--eol-position beg)))
(cond
((symbolp (car-safe magit-section-visibility-indicator))
(let ((ov (magit--overlay-at beg 'magit-vis-indicator 'fringe)))
(unless ov
(setq ov (make-overlay beg eoh nil t))
(overlay-put ov 'evaporate t)
(overlay-put ov 'magit-vis-indicator 'fringe))
(overlay-put
ov 'before-string
(propertize "fringe" 'display
(list 'left-fringe
(if (oref section hidden)
(car magit-section-visibility-indicator)
(cdr magit-section-visibility-indicator))
'fringe)))))
((stringp (car-safe magit-section-visibility-indicator))
(let ((ov (magit--overlay-at (1- eoh) 'magit-vis-indicator 'eoh)))
(cond ((oref section hidden)
(unless ov
(setq ov (make-overlay (1- eoh) eoh))
(overlay-put ov 'evaporate t)
(overlay-put ov 'magit-vis-indicator 'eoh))
(overlay-put ov 'after-string
(car magit-section-visibility-indicator)))
(ov
(delete-overlay ov)))))))))
(eoh (magit--eol-position beg))
(kind (cl-typecase (car indicator)
(symbol 'fringe)
(character 'margin)
(string 'ellipsis)))
(indicator (if (or (oref section hidden)
(eq kind 'ellipsis))
(car indicator)
(cdr indicator))))
(pcase kind
((or 'fringe 'margin)
(let ((ov (magit--overlay-at beg 'magit-vis-indicator kind)))
(unless ov
(setq ov (make-overlay beg eoh nil t))
(overlay-put ov 'evaporate t)
(overlay-put ov 'magit-vis-indicator kind))
(overlay-put
ov 'before-string
(pcase kind
('fringe
(propertize "fringe" 'display
`(left-fringe ,indicator fringe)))
('margin
(propertize "margin" 'display
`((margin left-margin)
,(propertize (string indicator)
'face 'magit-left-margin))))))))
('ellipsis
(let ((ov (magit--overlay-at (1- eoh) 'magit-vis-indicator 'eoh)))
(cond ((oref section hidden)
(unless ov
(setq ov (make-overlay (1- eoh) eoh))
(overlay-put ov 'evaporate t)
(overlay-put ov 'magit-vis-indicator 'eoh))
(overlay-put ov 'after-string indicator))
(ov
(delete-overlay ov)))))))))
(defvar-local magit--ellipses-sections nil)
@@ -2035,7 +2057,8 @@ When `magit-section-preserve-visibility' is nil, return nil."
;; This is needed because we hide the body instead of "the body
;; except the final newline and additionally the newline before
;; the body"; otherwise we could use `buffer-invisibility-spec'.
(when (stringp (car-safe magit-section-visibility-indicator))
(when-let* ((indicator (car (magit-section-visibility-indicator)))
(_(stringp indicator)))
(let* ((sections (append magit--ellipses-sections
(setq magit--ellipses-sections
(or (magit-region-sections)
@@ -2057,7 +2080,7 @@ When `magit-section-preserve-visibility' is nil, return nil."
(overlay-put
ov 'after-string
(propertize
(car magit-section-visibility-indicator) 'font-lock-face
indicator 'font-lock-face
(let ((pos (overlay-start ov)))
(delq nil (nconc (mapcar (##overlay-get % 'font-lock-face)
(overlays-at pos))
@@ -2065,7 +2088,7 @@ When `magit-section-preserve-visibility' is nil, return nil."
pos 'font-lock-face))))))))))))
(defun magit-section-maybe-remove-visibility-indicator (section)
(when (and magit-section-visibility-indicator
(when (and (magit-section-visibility-indicator)
(= (oref section content)
(oref section end)))
(dolist (o (overlays-in (oref section start)
@@ -2081,16 +2104,15 @@ When `magit-section-preserve-visibility' is nil, return nil."
(let ((section (magit-current-section)))
(while section
(let ((content (oref section content)))
(if (and (magit-section-invisible-p section)
(<= (or content (oref section start))
beg
(oref section end)))
(progn
(when content
(magit-section-show section)
(push section magit-section--opened-sections))
(setq section (oref section parent)))
(setq section nil))))))
(cond ((and (magit-section-hidden section)
(<= (or content (oref section start))
beg
(oref section end)))
(when content
(magit-section-show section)
(push section magit-section--opened-sections))
(setq section (oref section parent)))
((setq section nil)))))))
(or (eq search-invisible t)
(not (isearch-range-invisible beg end))))
@@ -2103,6 +2125,12 @@ When `magit-section-preserve-visibility' is nil, return nil."
(setq magit-section--opened-sections nil))
(funcall fn)))
(defun magit-section-reveal (section)
(while section
(when (oref section hidden)
(magit-section-show section))
(setq section (oref section parent))))
;;; Utilities
(cl-defun magit-section-selected-p (section &optional (selection nil sselection))
@@ -2111,12 +2139,12 @@ When `magit-section-preserve-visibility' is nil, return nil."
(memq section (if sselection
selection
(setq selection (magit-region-sections))))
(and-let* ((parent (oref section parent)))
(magit-section-selected-p parent selection)))))
(and$ (oref section parent)
(magit-section-selected-p $ selection)))))
(defun magit-section-parent-value (section)
(and-let* ((parent (oref section parent)))
(oref parent value)))
(and$ (oref section parent)
(oref $ value)))
(defun magit-section-siblings (section &optional direction)
"Return a list of the sibling sections of SECTION.
@@ -2348,7 +2376,7 @@ Configuration'."
(message " %-50s %f %s" entry time
(cond ((> time 0.03) "!!")
((> time 0.01) "!")
(t ""))))
(""))))
(apply entry args)))))))
(cl-defun magit--overlay-at (pos prop &optional (val nil sval) testfn)
@@ -2376,8 +2404,8 @@ Configuration'."
(defun magit--add-face-text-property ( beg end face
&optional append object adopt-face)
"Like `add-face-text-property' but for `font-lock-face'.
If optional ADOPT-FACE, the replace `face' with `font-lock-face'
first. This is a hack, which is likely to be remove again."
If optional ADOPT-FACE, then replace `face' with `font-lock-face'
first. The latter is a hack, which is likely to be removed again."
(when (stringp object)
(unless beg (setq beg 0))
(unless end (setq end (length object))))
@@ -2453,7 +2481,7 @@ This is like moving to POS and then calling `pos-eol'."
(cdr magit--imenu-group-types)
section))
(magit-section-match magit--imenu-group-types section))
(and-let* ((children (oref section children)))
(and-let ((children (oref section children)))
`((,(magit--imenu-index-name section)
,@(mapcar (##cons (magit--imenu-index-name %)
(oref % start))
@@ -2485,7 +2513,7 @@ This is like moving to POS and then calling `pos-eol'."
(oref section value)))
((string-match " ([0-9]+)\\'" heading)
(substring heading 0 (match-beginning 0)))
(t heading)))))
(heading)))))
(defun magit--imenu-goto-function (_name position &rest _rest)
"Go to the section at POSITION.
@@ -2644,4 +2672,15 @@ with the variables' values as arguments, which were recorded by
;;; _
(provide 'magit-section)
;; Local Variables:
;; read-symbol-shorthands: (
;; ("and$" . "cond-let--and$")
;; ("and>" . "cond-let--and>")
;; ("and-let" . "cond-let--and-let")
;; ("if-let" . "cond-let--if-let")
;; ("when-let" . "cond-let--when-let")
;; ("while-let" . "cond-let--while-let")
;; ("match-string" . "match-string")
;; ("match-str" . "match-string-no-properties"))
;; End:
;;; magit-section.el ends here
lisp/magit-section/magit-section.info
+43 -40
View File
@@ -1,4 +1,4 @@
This is magit-section.info, produced by makeinfo version 7.1.1 from
This is magit-section.info, produced by makeinfo version 7.2 from
magit-section.texi.
Copyright (C) 2015-2025 Jonas Bernoulli
@@ -34,7 +34,7 @@ packages that have nothing to do with Magit or Git.
and user options see *note (magit)Sections::. This manual documents how
you can use sections in your own packages.
This manual is for Magit-Section version 4.3.8.
This manual is for Magit-Section version 4.4.2.
Copyright (C) 2015-2025 Jonas Bernoulli
<emacs.magit@jonas.bernoulli.dev>
@@ -99,12 +99,13 @@ File: magit-section.info, Node: Creating Sections, Next: Core Functions, Prev
appropriate package prefix. This works due to some undocumented
kludges, which are not available to other packages.
When optional HIDE is non-nil collapse the section body by default,
i.e., when first creating the section, but not when refreshing the
buffer. Else expand it by default. This can be overwritten using
‘magit-section-set-visibility-hook’. When a section is recreated
during a refresh, then the visibility of predecessor is inherited
and HIDE is ignored (but the hook is still honored).
When optional HIDE is non-‘nil’ collapse the section body by
default, i.e., when first creating the section, but not when
refreshing the buffer. Else expand it by default. This can be
overwritten using ‘magit-section-set-visibility-hook’. When a
section is recreated during a refresh, then the visibility of
predecessor is inherited and HIDE is ignored (but the hook is still
honored).
BODY is any number of forms that actually insert the section's
heading and body. Optional NAME, if specified, has to be a symbol,
@@ -131,10 +132,10 @@ File: magit-section.info, Node: Creating Sections, Next: Core Functions, Prev
at ‘point’. The section should only contain a single line when
this function is used like this.
When called with arguments ARGS, which have to be strings, or nil,
then insert those strings at point. The section should not contain
any text before this happens and afterwards it should again only
contain a single line. If the ‘face’ property is set anywhere
When called with arguments ARGS, which have to be strings, or
‘nil’, then insert those strings at point. The section should not
contain any text before this happens and afterwards it should again
only contain a single line. If the ‘face’ property is set anywhere
inside any of these strings, then insert all of them unchanged.
Otherwise use the 'magit-section-heading' face for all inserted
text.
@@ -142,19 +143,19 @@ File: magit-section.info, Node: Creating Sections, Next: Core Functions, Prev
The ‘content’ property of the section object is the end of the
heading (which lasts from ‘start’ to ‘content’) and the beginning
of the the body (which lasts from ‘content’ to ‘end’). If the
value of ‘content’ is nil, then the section has no heading and its
body cannot be collapsed. If a section does have a heading, then
its height must be exactly one line, including a trailing newline
character. This isn't enforced, you are responsible for getting it
right. The only exception is that this function does insert a
newline character if necessary.
value of ‘content’ is ‘nil’, then the section has no heading and
its body cannot be collapsed. If a section does have a heading,
then its height must be exactly one line, including a trailing
newline character. This isn't enforced, you are responsible for
getting it right. The only exception is that this function does
insert a newline character if necessary.
If provided, optional CHILD-COUNT must evaluate to an integer or
boolean. If t, then the count is determined once the children have
been inserted, using ‘magit-insert-child-count’ (which see). For
historic reasons, if the heading ends with ":", the count is
boolean. If ‘t’, then the count is determined once the children
have been inserted, using ‘magit-insert-child-count’ (which see).
For historic reasons, if the heading ends with ":", the count is
substituted for that, at this time as well. If
‘magit-section-show-child-count’ is nil, no counts are inserted
‘magit-section-show-child-count’ is ‘nil’, no counts are inserted
-- Macro: magit-insert-section-body &rest body
Use BODY to insert the section body, once the section is expanded.
@@ -203,17 +204,18 @@ Function magit-section-at &optional position
-- Function: magit-get-section ident &optional root
Return the section identified by IDENT. IDENT has to be a list as
returned by ‘magit-section-ident’. If optional ROOT is non-nil,
returned by ‘magit-section-ident’. If optional ROOT is non-‘nil’,
then search in that section tree instead of in the one whose root
‘magit-root-section’ is.
-- Function: magit-section-lineage section &optional raw
Return the lineage of SECTION. If optional RAW is non-nil, return
a list of section objects, beginning with SECTION, otherwise return
a list of section types.
Return the lineage of SECTION. If optional RAW is non-‘nil’,
return a list of section objects, beginning with SECTION, otherwise
return a list of section types.
-- Function: magit-section-content-p section
Return non-nil if SECTION has content or an unused washer function.
Return non-‘nil’ if SECTION has content or an unused washer
function.
The next two functions are replacements for the Emacs functions that
have the same name except for the ‘magit-’ prefix. Like
@@ -246,10 +248,10 @@ File: magit-section.info, Node: Matching Functions, Prev: Core Functions, Up:
-- Function: magit-section-match condition &optional (section
(magit-current-section))
Return t if SECTION matches CONDITION.
Return ‘t’ if SECTION matches CONDITION.
SECTION defaults to the section at point. If SECTION is not
specified and there also is no section at point, then return nil.
specified and there also is no section at point, then return ‘nil’.
CONDITION can take the following forms:
@@ -279,9 +281,10 @@ File: magit-section.info, Node: Matching Functions, Prev: Core Functions, Up:
-- Function: magit-section-value-if condition &optional section
If the section at point matches CONDITION, then return its value.
If optional SECTION is non-nil then test whether that matches
instead. If there is no section at point and SECTION is nil, then
return nil. If the section does not match, then return nil.
If optional SECTION is non-‘nil’ then test whether that matches
instead. If there is no section at point and SECTION is ‘nil’,
then return ‘nil’. If the section does not match, then return
‘nil’.
See ‘magit-section-match’ for the forms CONDITION can take.
@@ -293,25 +296,25 @@ File: magit-section.info, Node: Matching Functions, Prev: Core Functions, Up:
first match are evaluated sequentially and the value of the last
form is returned. Inside BODY the symbol ‘it’ is bound to the
section at point. If no clause succeeds or if there is no section
at point, return nil.
at point, return ‘nil’.
See ‘magit-section-match’ for the forms CONDITION can take.
Additionally a CONDITION of t is allowed in the final clause, and
Additionally a CONDITION of ‘t’ is allowed in the final clause, and
matches if no other CONDITION match, even if there is no section at
point.

Tag Table:
Node: Top810
Node: Introduction2111
Node: Creating Sections2881
Node: Core Functions7786
Node: Matching Functions10938
Node: Top808
Node: Introduction2109
Node: Creating Sections2879
Node: Core Functions7818
Node: Matching Functions10993

End Tag Table

Local Variables:
coding: utf-8
Info-documentlanguage: en
End:
lisp/magit/AUTHORS.md
+3 -1
View File
@@ -1,5 +1,5 @@
The following people have contributed to Magit.
For statistics see https://magit.vc/stats/magit/authors.html.
For statistics see https://stats.magit.vc/magit/authors.html.
Authors
-------
@@ -238,6 +238,7 @@ All Contributors
- Lluís Vilanova
- Loic Dachary
- Louis Roché
- Lucius Chen
- Luís Oliveira
- Luke Amdor
- Magnar Sveen
@@ -411,6 +412,7 @@ All Contributors
- Wouter Bolsterlee
- X4lldux
- Xavier Noria
- Xavier Young
- Xu Chunyang
- Yann Herklotz
- Yann Hodique
lisp/magit/git-commit.el
+44 -33
View File
@@ -235,7 +235,7 @@ Also see `magit-post-commit-hook'."
:type 'hook
:get #'magit-hook-custom-get)
(defcustom git-commit-post-finish-hook-timeout 1
(defcustom git-commit-post-finish-hook-timeout 2
"Time in seconds to wait for git to create a commit.
The hook `git-commit-post-finish-hook' (which see) is run only
@@ -502,7 +502,7 @@ the redundant bindings, then set this to nil, before loading
(not (file-accessible-directory-p
(file-name-directory buffer-file-name)))
(magit-expand-git-file-name (substring buffer-file-name 2))))
((file-accessible-directory-p (file-name-directory file)))
(_(file-accessible-directory-p (file-name-directory file)))
(inhibit-read-only t))
(insert-file-contents file t)
t))
@@ -596,9 +596,7 @@ Used as the local value of `header-line-format', in buffer using
(add-hook 'with-editor-post-finish-hook
(apply-partially #'git-commit-run-post-finish-hook
(magit-rev-parse "HEAD"))
nil t)
(when (fboundp 'magit-wip-maybe-add-commit-hook)
(magit-wip-maybe-add-commit-hook)))
nil t))
(setq with-editor-cancel-message
#'git-commit-cancel-message)
(git-commit-setup-font-lock)
@@ -619,17 +617,14 @@ Used as the local value of `header-line-format', in buffer using
(defun git-commit-run-post-finish-hook (previous)
(when git-commit-post-finish-hook
(cl-block nil
(let ((break (time-add (current-time)
(seconds-to-time
git-commit-post-finish-hook-timeout))))
(while (equal (magit-rev-parse "HEAD") previous)
(if (time-less-p (current-time) break)
(sit-for 0.01)
(message "No commit created after 1 second. Not running %s."
'git-commit-post-finish-hook)
(cl-return))))
(run-hooks 'git-commit-post-finish-hook))))
(if (with-timeout (git-commit-post-finish-hook-timeout)
(while (equal (magit-rev-parse "HEAD") previous)
(sit-for 0.01))
t)
(run-hooks 'git-commit-post-finish-hook)
(message "No commit created after %s second. Not running %s."
git-commit-post-finish-hook-timeout
'git-commit-post-finish-hook))))
(define-minor-mode git-commit-mode
"Auxiliary minor mode used when editing Git commit messages.
@@ -721,15 +716,15 @@ conventions are checked."
(save-excursion
(goto-char (point-min))
(re-search-forward (git-commit-summary-regexp) nil t)
(if (equal (match-string 1) "")
(if (equal (match-str 1) "")
t ; Just try; we don't know whether --allow-empty-message was used.
(and (or (not (memq 'overlong-summary-line
git-commit-style-convention-checks))
(equal (match-string 2) "")
(equal (match-str 2) "")
(y-or-n-p "Summary line is too long. Commit anyway? "))
(or (not (memq 'non-empty-second-line
git-commit-style-convention-checks))
(not (match-string 3))
(not (match-str 3))
(y-or-n-p "Second line is not empty. Commit anyway? ")))))))
(defun git-commit-cancel-message ()
@@ -751,7 +746,7 @@ With a numeric prefix ARG, go back ARG messages."
;; non-empty and newly written comment, because otherwise
;; it would be irreversibly lost.
(when-let* ((message (git-commit-buffer-message))
((not (ring-member log-edit-comment-ring message))))
(_(not (ring-member log-edit-comment-ring message))))
(ring-insert log-edit-comment-ring message)
(cl-incf arg)
(setq len (ring-length log-edit-comment-ring)))
@@ -799,16 +794,16 @@ Save current message first."
(defun git-commit-save-message ()
"Save current message to `log-edit-comment-ring'."
(interactive)
(if-let ((message (git-commit-buffer-message)))
(progn
(when-let ((index (ring-member log-edit-comment-ring message)))
(ring-remove log-edit-comment-ring index))
(ring-insert log-edit-comment-ring message)
(when git-commit-use-local-message-ring
(magit-repository-local-set 'log-edit-comment-ring
log-edit-comment-ring))
(message "Message saved"))
(message "Only whitespace and/or comments; message not saved")))
(cond-let
([message (git-commit-buffer-message)]
(when-let ((index (ring-member log-edit-comment-ring message)))
(ring-remove log-edit-comment-ring index))
(ring-insert log-edit-comment-ring message)
(when git-commit-use-local-message-ring
(magit-repository-local-set 'log-edit-comment-ring
log-edit-comment-ring))
(message "Message saved"))
((message "Only whitespace and/or comments; message not saved"))))
(defun git-commit-prepare-message-ring ()
(make-local-variable 'log-edit-comment-ring-index)
@@ -950,11 +945,11 @@ completion candidates. The input must have the form \"NAME <EMAIL>\"."
(sort (delete-dups
(magit-git-lines "log" "-n9999" "--format=%aN <%ae>"))
#'string<)
nil nil nil 'git-commit-read-ident-history)))
nil 'any nil 'git-commit-read-ident-history)))
(save-match-data
(if (string-match "\\`\\([^<]+\\) *<\\([^>]+\\)>\\'" str)
(list (save-match-data (string-trim (match-string 1 str)))
(string-trim (match-string 2 str)))
(list (save-match-data (string-trim (match-str 1 str)))
(string-trim (match-str 2 str)))
(user-error "Invalid input")))))
(defun git-commit--insert-ident-trailer (trailer name email)
@@ -1174,6 +1169,11 @@ Added to `font-lock-extend-region-functions'."
(delete-region (point) (point-max)))))
(let ((diff-default-read-only nil))
(diff-mode))
;; These won't survive copying to another buffer,
;; so let's not waste any time. See #5483.
(setq-local diff-refine nil)
(setq-local diff-font-lock-syntax nil)
(setq-local diff-font-lock-prettify nil)
(let ((font-lock-verbose nil)
(font-lock-support-mode nil))
(font-lock-ensure))
@@ -1221,4 +1221,15 @@ Elisp doc-strings, including this one. Unlike in doc-strings,
"git-commit 4.0.0")
(provide 'git-commit)
;; Local Variables:
;; read-symbol-shorthands: (
;; ("and$" . "cond-let--and$")
;; ("and>" . "cond-let--and>")
;; ("and-let" . "cond-let--and-let")
;; ("if-let" . "cond-let--if-let")
;; ("when-let" . "cond-let--when-let")
;; ("while-let" . "cond-let--while-let")
;; ("match-string" . "match-string")
;; ("match-str" . "match-string-no-properties"))
;; End:
;;; git-commit.el ends here
lisp/magit/git-rebase.el
+38 -29
View File
@@ -362,26 +362,26 @@ BATCH is non-nil, in which case nil is returned. Non-nil
BATCH also ignores commented lines."
(save-excursion
(goto-char (line-beginning-position))
(if-let ((re-start (if batch
"^"
(format "^\\(?99:%s\\)? *"
(regexp-quote comment-start))))
(type (seq-some (pcase-lambda (`(,type . ,re))
(let ((case-fold-search nil))
(and (looking-at (concat re-start re)) type)))
git-rebase-line-regexps)))
(git-rebase-action
(cond-let*
([re-start (if batch
"^"
(format "^\\(?99:%s\\)? *" (regexp-quote comment-start)))]
[type (seq-some (pcase-lambda (`(,type . ,re))
(let ((case-fold-search nil))
(and (looking-at (concat re-start re)) type)))
git-rebase-line-regexps)]
(git-rebase-action
:action-type type
:action (and-let* ((action (match-string-no-properties 1)))
:action (and-let ((action (match-str 1)))
(or (cdr (assoc action git-rebase-short-options))
action))
:action-options (match-string-no-properties 2)
:target (match-string-no-properties 3)
:trailer (match-string-no-properties 5)
:comment-p (and (match-string 99) t))
(and (not batch)
;; Use empty object rather than nil to ease handling.
(git-rebase-action)))))
:action-options (match-str 2)
:target (match-str 3)
:trailer (match-str 5)
:comment-p (and (match-str 99) t)))
((not batch)
;; Use empty object rather than nil to ease handling.
(git-rebase-action)))))
(defun git-rebase-set-action (action)
"Set action of commit line to ACTION.
@@ -412,15 +412,13 @@ of its action type."
(delete-region beg (+ beg 2))
(insert comment-start " ")))
(forward-line))
(t
;; In the case of --rebase-merges, commit lines may have
;; other lines with other action types, empty lines, and
;; "Branch" comments interspersed. Move along.
(forward-line)))))
(goto-char
(if git-rebase-auto-advance
end-marker
(if pt-below-p (1- end-marker) beg)))
;; In the case of --rebase-merges, commit lines may have
;; other lines with other action types, empty lines, and
;; "Branch" comments interspersed. Move along.
((forward-line)))))
(goto-char (cond (git-rebase-auto-advance end-marker)
(pt-below-p (1- end-marker))
(beg)))
(goto-char (line-beginning-position))))
(_ (ding))))
@@ -591,7 +589,7 @@ remove the label on the current line, if any."
(save-excursion
(goto-char (point-min))
(while (re-search-forward "^\\(?:l\\|label\\) \\([^ \n]+\\)" nil t)
(push (match-string-no-properties 1) labels)))
(push (match-str 1) labels)))
(nreverse labels)))
(defun git-rebase-reset (arg)
@@ -871,11 +869,11 @@ except for the \"pick\" command."
(line (concat git-rebase-comment-re "\\(?:\\( \\.? *\\)\\|"
"\\( +\\)\\([^\n,],\\) \\([^\n ]+\\) \\)")))
(while (re-search-forward line nil t)
(if (match-string 1)
(if (match-str 1)
(if (assq cmd git-rebase-fixup-descriptions)
(delete-line)
(replace-match (make-string 10 ?\s) t t nil 1))
(setq cmd (intern (concat "git-rebase-" (match-string 4))))
(setq cmd (intern (concat "git-rebase-" (match-str 4))))
(cond
((not (fboundp cmd))
(delete-line))
@@ -944,4 +942,15 @@ is used as a value for `imenu-extract-index-name-function'."
;;; _
(provide 'git-rebase)
;; Local Variables:
;; read-symbol-shorthands: (
;; ("and$" . "cond-let--and$")
;; ("and>" . "cond-let--and>")
;; ("and-let" . "cond-let--and-let")
;; ("if-let" . "cond-let--if-let")
;; ("when-let" . "cond-let--when-let")
;; ("while-let" . "cond-let--while-let")
;; ("match-string" . "match-string")
;; ("match-str" . "match-string-no-properties"))
;; End:
;;; git-rebase.el ends here
lisp/magit/magit-apply.el
+53 -57
View File
@@ -33,6 +33,7 @@
(require 'magit-diff)
(require 'magit-wip)
(require 'dired)
(require 'transient) ; See #3732.
;; For `magit-apply'
@@ -161,15 +162,15 @@ and only the second and third are to be applied, they would be
adjusted as \"@@ -10,6 +10,7 @@\" and \"@@ -18,6 +19,7 @@\"."
(let* ((first-hunk (car hunks))
(offset (if (string-match diff-hunk-header-re-unified first-hunk)
(- (string-to-number (match-string 3 first-hunk))
(string-to-number (match-string 1 first-hunk)))
(- (string-to-number (match-str 3 first-hunk))
(string-to-number (match-str 1 first-hunk)))
(error "Header hunks have to be applied individually"))))
(if (= offset 0)
hunks
(mapcar (lambda (hunk)
(if (string-match diff-hunk-header-re-unified hunk)
(replace-match (number-to-string
(- (string-to-number (match-string 3 hunk))
(- (string-to-number (match-str 3 hunk))
offset))
t t hunk 3)
(error "Hunk does not have expected header")))
@@ -218,14 +219,14 @@ adjusted as \"@@ -10,6 +10,7 @@\" and \"@@ -18,6 +19,7 @@\"."
(mapcar (##oref % value) section:s)))
(command (symbol-name this-command))
(command (if (and command (string-match "^magit-\\([^-]+\\)" command))
(match-string 1 command)
(match-str 1 command)
"apply"))
(context (magit-diff-get-context))
(ignore-context (magit-diff-ignore-any-space-p)))
(unless (magit-diff-context-p)
(user-error "Not enough context to apply patch. Increase the context"))
(when (and magit-wip-before-change-mode (not magit-inhibit-refresh))
(magit-wip-commit-before-change files (concat " before " command)))
(unless magit-inhibit-refresh
(magit-run-before-change-functions files command))
(with-temp-buffer
(insert patch)
(let ((magit-inhibit-refresh t))
@@ -234,8 +235,7 @@ adjusted as \"@@ -10,6 +10,7 @@\" and \"@@ -18,6 +19,7 @@\"."
(if ignore-context "-C0" (format "-C%s" context))
"--ignore-space-change" "-")))
(unless magit-inhibit-refresh
(when magit-wip-after-apply-mode
(magit-wip-commit-after-apply files (concat " after " command)))
(magit-run-after-apply-functions files command)
(magit-refresh))))
(defun magit-apply--get-selection ()
@@ -338,11 +338,11 @@ ignored) files."
(magit-stage-1 (if all "--all" "-u") magit-buffer-diff-files)))
(defun magit-stage-1 (arg &optional files)
(magit-wip-commit-before-change files " before stage")
(magit-run-before-change-functions files "stage")
(magit-run-git "add" arg (if files (cons "--" files) "."))
(when magit-auto-revert-mode
(mapc #'magit-turn-on-auto-revert-mode-if-desired files))
(magit-wip-commit-after-apply files " after stage"))
(magit-run-after-apply-functions files "stage"))
(defun magit-stage-untracked (&optional intent)
(let* ((section (magit-current-section))
@@ -356,7 +356,7 @@ ignored) files."
(magit-git-repo-p file t))
(push file repos)
(push file plain)))
(magit-wip-commit-before-change files " before stage")
(magit-run-before-change-functions files "stage")
(when plain
(magit-run-git "add" (and intent "--intent-to-add")
"--" plain)
@@ -388,7 +388,7 @@ ignored) files."
(expand-file-name ".gitmodules" topdir))
(let ((default-directory borg-user-emacs-directory))
(borg--maybe-absorb-gitdir package)))))))))
(magit-wip-commit-after-apply files " after stage")))
(magit-run-after-apply-functions files "stage")))
(defvar magit-post-stage-hook-commands
(list #'magit-stage
@@ -396,6 +396,7 @@ ignored) files."
#'magit-stage-modified
'magit-file-stage))
;;;###autoload
(defun magit-run-post-stage-hook ()
(when (memq this-command magit-post-stage-hook-commands)
(magit-run-hook-with-benchmark 'magit-post-stage-hook)))
@@ -442,15 +443,15 @@ ignored) files."
(magit-unstage-1 files)))
(defun magit-unstage-1 (files)
(magit-wip-commit-before-change files " before unstage")
(magit-run-before-change-functions files "unstage")
(if (magit-no-commit-p)
(magit-run-git "rm" "--cached" "--" files)
(magit-run-git "reset" "HEAD" "--" files))
(magit-wip-commit-after-apply files " after unstage"))
(magit-run-after-apply-functions files "unstage"))
(defun magit-unstage-intent (files)
(if-let ((staged (magit-staged-files))
(intent (seq-filter (##member % staged) files)))
(if-let* ((staged (magit-staged-files))
(intent (seq-filter (##member % staged) files)))
(magit-unstage-1 intent)
(user-error "Already unstaged")))
@@ -463,9 +464,9 @@ ignored) files."
(when (or (magit-anything-unstaged-p)
(magit-untracked-files))
(magit-confirm 'unstage-all-changes))
(magit-wip-commit-before-change nil " before unstage")
(magit-run-before-change-functions nil "unstage")
(magit-run-git "reset" "HEAD" "--" magit-buffer-diff-files)
(magit-wip-commit-after-apply nil " after unstage"))
(magit-run-after-apply-functions nil "unstage"))
(defvar magit-post-unstage-hook-commands
(list #'magit-unstage
@@ -473,6 +474,7 @@ ignored) files."
#'magit-unstage-all
'magit-file-unstage))
;;;###autoload
(defun magit-run-post-unstage-hook ()
(when (memq this-command magit-post-unstage-hook-commands)
(magit-run-hook-with-benchmark 'magit-post-unstage-hook)))
@@ -515,39 +517,26 @@ of a side, then keep that side without prompting."
('(?U ?U) (magit-smerge-keep-current))
(_ (magit-discard-apply section #'magit-apply-hunk)))))
(defun magit-discard-apply (section apply)
(if (eq (magit-diff-type section) 'unstaged)
(funcall apply section "--reverse")
(if (magit-anything-unstaged-p
nil (if (magit-file-section-p section)
(oref section value)
(magit-section-parent-value section)))
(progn (let ((magit-inhibit-refresh t))
(funcall apply section "--reverse" "--cached")
(funcall apply section "--reverse" "--reject"))
(magit-refresh))
(funcall apply section "--reverse" "--index"))))
(defun magit-discard-hunks (sections)
(magit-confirm 'discard
(list "Discard %d hunks from %s"
(length sections)
(magit-section-parent-value (car sections))))
(magit-discard-apply-n sections #'magit-apply-hunks))
(magit-discard-apply sections #'magit-apply-hunks))
(defun magit-discard-apply-n (sections apply)
(let ((section (car sections)))
(if (eq (magit-diff-type section) 'unstaged)
(funcall apply sections "--reverse")
(if (magit-anything-unstaged-p
nil (if (magit-file-section-p section)
(oref section value)
(magit-section-parent-value section)))
(progn (let ((magit-inhibit-refresh t))
(funcall apply sections "--reverse" "--cached")
(funcall apply sections "--reverse" "--reject"))
(magit-refresh))
(funcall apply sections "--reverse" "--index")))))
(defun magit-discard-apply (section:s apply)
(let ((primus (if (atom section:s) section:s (car section:s))))
(cond ((eq (magit-diff-type primus) 'unstaged)
(funcall apply section:s "--reverse"))
((magit-anything-unstaged-p
nil (if (magit-file-section-p primus)
(oref primus value)
(magit-section-parent-value primus)))
(let ((magit-inhibit-refresh t))
(funcall apply section:s "--reverse" "--cached")
(funcall apply section:s "--reverse" "--reject"))
(magit-refresh))
((funcall apply section:s "--reverse" "--index")))))
(defun magit-discard-file (section)
(magit-discard-files (list section)))
@@ -583,7 +572,7 @@ of a side, then keep that side without prompting."
(`(?X ?R ,(or ? ?M ?D)) (push file rename)))))
(unwind-protect
(let ((magit-inhibit-refresh t))
(magit-wip-commit-before-change files " before discard")
(magit-run-before-change-functions files "discard")
(when resolve
(magit-discard-files--resolve (nreverse resolve)))
(when resurrect
@@ -595,7 +584,7 @@ of a side, then keep that side without prompting."
(when (or discard discard-new)
(magit-discard-files--discard (nreverse discard)
(nreverse discard-new)))
(magit-wip-commit-after-apply files " after discard"))
(magit-run-after-apply-functions files "discard"))
(magit-refresh))))
(defun magit-discard-files--resolve (files)
@@ -637,7 +626,7 @@ of a side, then keep that side without prompting."
(?M (let ((temp (magit-git-string "checkout-index" "--temp" file)))
(string-match
(format "\\(.+?\\)\t%s" (regexp-quote file)) temp)
(rename-file (match-string 1 temp)
(rename-file (match-str 1 temp)
(setq temp (concat file ".~{index}~")))
(delete-file temp t))
(magit-call-git "rm" "--cached" "--force" "--" file))
@@ -675,10 +664,8 @@ of a side, then keep that side without prompting."
(setq sections
(seq-remove (##member (oref % value) binaries)
sections)))
(cond ((length= sections 1)
(magit-discard-apply (car sections) 'magit-apply-diff))
(sections
(magit-discard-apply-n sections #'magit-apply-diffs)))
(when sections
(magit-discard-apply sections #'magit-apply-diffs))
(when binaries
(let ((modified (magit-unstaged-files t)))
(setq binaries (magit--separate (##member % modified) binaries)))
@@ -733,8 +720,7 @@ so causes the change to be applied to the index as well."
magit-buffer-range)
((derived-mode-p 'magit-diff-mode)
magit-buffer-range)
(t
"--cached")))))
("--cached")))))
(magit--separate (##member (oref % value) bs)
sections))))
(magit-confirm-files 'reverse (mapcar (##oref % value) sections))
@@ -800,9 +786,8 @@ a separate commit. A typical workflow would be:
(defun magit-call-smerge (fn)
(pcase-let* ((file (magit-file-at-point t t))
(keep (get-file-buffer file))
(`(,buf ,pos)
(let ((magit-diff-visit-jump-to-change nil))
(magit-diff-visit-file--noselect file))))
(`(,buf ,pos) (magit-diff-visit-file--noselect))
(keep (eq keep buf)))
(with-current-buffer buf
(save-excursion
(save-restriction
@@ -831,4 +816,15 @@ a separate commit. A typical workflow would be:
;;; _
(provide 'magit-apply)
;; Local Variables:
;; read-symbol-shorthands: (
;; ("and$" . "cond-let--and$")
;; ("and>" . "cond-let--and>")
;; ("and-let" . "cond-let--and-let")
;; ("if-let" . "cond-let--if-let")
;; ("when-let" . "cond-let--when-let")
;; ("while-let" . "cond-let--while-let")
;; ("match-string" . "match-string")
;; ("match-str" . "match-string-no-properties"))
;; End:
;;; magit-apply.el ends here
lisp/magit/magit-autorevert.el
+52 -46
View File
@@ -104,6 +104,32 @@ seconds of user inactivity. That is not desirable."
;;; Mode
;;;###autoload
(progn ; magit-custom-initialize-after-init
(defun magit-custom-initialize-after-init (symbol value)
;; Use `apply-partially' instead of the wonders of lexical bindings,
;; because of bugs in the autoload handling of package managers, which
;; cause these variables to be treated as dynamic. See #5476 and #5485.
(internal--define-uninitialized-variable symbol)
(cond ((not after-init-time)
(letrec ((f (apply-partially
(lambda (symbol value)
(ignore-errors
(remove-hook 'after-init-hook f))
(custom-initialize-set symbol value))
symbol value)))
(add-hook 'after-init-hook f)))
((not load-file-name)
(custom-initialize-set symbol value))
((letrec ((f (apply-partially
(lambda (thisfile symbol value file)
(when (equal file thisfile)
(ignore-errors
(remove-hook 'after-load-functions f))
(custom-initialize-set symbol value)))
load-file-name symbol value)))
(add-hook 'after-load-functions f))))))
(defun magit-turn-on-auto-revert-mode-if-desired (&optional file)
(cond (file
(when-let ((buffer (find-buffer-visiting file)))
@@ -128,54 +154,20 @@ seconds of user inactivity. That is not desirable."
:link '(info-link "(magit)Automatic Reverting of File-Visiting Buffers")
:group 'magit-auto-revert
:group 'magit-essentials
;; - When `global-auto-revert-mode' is enabled, then this mode is
;; redundant.
;; - In all other cases enable the mode because if buffers are not
;; automatically reverted that would make many very common tasks
;; much more cumbersome.
:init-value (not (or global-auto-revert-mode
noninteractive)))
;; - Unfortunately `:init-value t' only sets the value of the mode
;; variable but does not cause the mode function to be called.
;; - I don't think it works like this on purpose, but since one usually
;; should not enable global modes by default, it is understandable.
;; - If the user has set the variable `magit-auto-revert-mode' to nil
;; after loading magit (instead of doing so before loading magit or
;; by using the function), then we should still respect that setting.
;; - If the user enables `global-auto-revert-mode' after loading magit
;; and after `after-init-hook' has run, then `magit-auto-revert-mode'
;; remains enabled; and there is nothing we can do about it.
;; - However if the init file causes `magit-autorevert' to be loaded
;; and only later it enables `global-auto-revert-mode', then we can
;; and should leave `magit-auto-revert-mode' disabled.
(defun magit-auto-revert-mode--init-kludge ()
"This is an internal kludge to be used on `after-init-hook'.
Do not use this function elsewhere, and don't remove it from
the `after-init-hook'. For more information see the comments
and code surrounding the definition of this function."
(if (or (not magit-auto-revert-mode)
(and global-auto-revert-mode (not after-init-time)))
(magit-auto-revert-mode -1)
(let ((start (current-time)))
(magit-message "Turning on magit-auto-revert-mode...")
(magit-auto-revert-mode 1)
(magit-message
"Turning on magit-auto-revert-mode...done%s"
(let ((elapsed (float-time (time-since start))))
(if (> elapsed 0.2)
(format " (%.3fs, %s buffers checked)" elapsed
(length (buffer-list)))
""))))))
(if after-init-time
;; Since `after-init-hook' has already been
;; run, turn the mode on or off right now.
(magit-auto-revert-mode--init-kludge)
;; By the time the init file has been fully loaded the
;; values of the relevant variables might have changed.
(add-hook 'after-init-hook #'magit-auto-revert-mode--init-kludge t))
:init-value (not (or global-auto-revert-mode noninteractive))
:initialize #'magit-custom-initialize-after-init)
(defun magit-auto-revert-mode--disable ()
"When enabling `global-auto-revert-mode', disable `magit-auto-revert-mode'."
(when (and global-auto-revert-mode
(bound-and-true-p magit-auto-revert-mode))
(magit-auto-revert-mode -1)))
(add-hook 'global-auto-revert-mode-hook #'magit-auto-revert-mode--disable)
(put 'magit-auto-revert-mode 'function-documentation
"Toggle Magit Auto Revert mode.
If called interactively, enable Magit Auto Revert mode if ARG is
positive, and disable it if ARG is zero or negative. If called
from Lisp, also enable the mode if ARG is omitted or nil, and
@@ -210,8 +202,11 @@ Like nearly every mode, this mode should be enabled or disabled
by calling the respective mode function, the reason being that
changing the state of a mode involves more than merely toggling
a single switch, so setting the mode variable is not enough.
Also, you should not use `after-init-hook' to disable this mode.")
Also, you should not use `after-init-hook' to disable this mode.
\(fn &optional ARG)")
;;;###autoload
(defun magit-auto-revert-buffers ()
(when (and magit-auto-revert-immediately
(or global-auto-revert-mode
@@ -268,4 +263,15 @@ defaults to nil) for any BUFFER."
;;; _
(provide 'magit-autorevert)
;; Local Variables:
;; read-symbol-shorthands: (
;; ("and$" . "cond-let--and$")
;; ("and>" . "cond-let--and>")
;; ("and-let" . "cond-let--and-let")
;; ("if-let" . "cond-let--if-let")
;; ("when-let" . "cond-let--when-let")
;; ("while-let" . "cond-let--while-let")
;; ("match-string" . "match-string")
;; ("match-str" . "match-string-no-properties"))
;; End:
;;; magit-autorevert.el ends here
lisp/magit/magit-base.el
+85 -83
View File
@@ -33,13 +33,14 @@
;;; Code:
;; Also update EMACS_VERSION in "default.mk".
(defconst magit--minimal-emacs "27.1")
(defconst magit--minimal-emacs "28.1")
(defconst magit--minimal-git "2.25.0")
(require 'cl-lib)
(require 'compat)
(require 'cond-let)
(require 'eieio)
(require 'llama)
(require 'llama) ; For (##these ...) see M-x describe-function RET # # RET.
(require 'subr-x)
;; For older Emacs releases we depend on an updated `seq' release from
@@ -332,11 +333,11 @@ Global settings:
for confirmation for any of these actions, you are still better
of adding all of the respective symbols individually.
When `magit-wip-before-change-mode' is enabled then these actions
can fairly easily be undone: `discard', `reverse',
`stage-all-changes', and `unstage-all-changes'. If and only if
this mode is enabled, then `safe-with-wip' has the same effect
as adding all of these symbols individually."
When `magit-wip-mode' is enabled then these actions can fairly
easily be undone: `discard', `reverse', `stage-all-changes', and
`unstage-all-changes'. If and only if this mode is enabled, then
`safe-with-wip' has the same effect as adding all of these symbols
individually."
:package-version '(magit . "2.1.0")
:group 'magit-essentials
:group 'magit-commands
@@ -425,7 +426,7 @@ the ellipsis definition. Currently the only acceptable values
for WHERE are `margin' or t (representing the default).
Whether collapsed sections are indicated using ellipsis is
controlled by `magit-section-visibility-indicator'."
controlled by option `magit-section-visibility-indicators'."
:package-version '(magit . "4.0.0")
:group 'magit-miscellaneous
:type '(repeat (list (symbol :tag "Where")
@@ -493,6 +494,7 @@ and delay of your graphical environment or operating system."
(defclass magit-hunk-section (magit-diff-section)
((keymap :initform 'magit-hunk-section-map)
(painted :initform nil)
(fontified :initform nil) ;TODO
(refined :initform nil)
(combined :initform nil :initarg :combined)
(from-range :initform nil :initarg :from-range)
@@ -576,6 +578,10 @@ acts similarly to `completing-read', except for the following:
- If REQUIRE-MATCH is nil and the user exits without a choice,
then nil is returned instead of an empty string.
- If REQUIRE-MATCH is `any', then do not require a match but
do require non-empty input (or non-nil DEFAULT, since that
is substituted for empty input).
- If REQUIRE-MATCH is non-nil and the user exits without a
choice, `user-error' is raised.
@@ -591,12 +597,13 @@ acts similarly to `completing-read', except for the following:
`minibuffer-default-prompt-format' and depending on
`magit-completing-read-default-prompt-predicate'."
(setq magit-completing-read--silent-default nil)
(if-let ((dwim (and def
(nth 2 (seq-find (pcase-lambda (`(,cmd ,re ,_))
(and (eq this-command cmd)
(or (not re)
(string-match-p re prompt))))
magit-dwim-selection)))))
(if-let ((_ def)
(dwim (seq-some (pcase-lambda (`(,cmd ,re ,dwim))
(and (eq cmd this-command)
(or (not re)
(string-match-p re prompt))
dwim))
magit-dwim-selection)))
(if (eq dwim 'ask)
(if (y-or-n-p (format "%s %s? " prompt def))
def
@@ -613,7 +620,8 @@ acts similarly to `completing-read', except for the following:
(reply (funcall magit-completing-read-function
(magit--format-prompt prompt def)
collection predicate
require-match initial-input hist def)))
(if (eq require-match 'any) nil require-match)
initial-input hist def)))
(setq this-command command)
;; Note: Avoid `string=' to support `helm-comp-read-use-marked'.
(if (equal reply "")
@@ -681,6 +689,14 @@ third-party completion frameworks."
(equal omit-nulls t))
(setq input string))
(funcall split-string string separators omit-nulls trim)))
;; Add the default to the table if absent, which is necessary
;; because we don't add it to the prompt for some frameworks.
(table (if (and def
(listp table)
(not (listp (car table)))
(not (member def table)))
(cons def table)
table))
;; Prevent `BUILT-IN' completion from messing up our existing
;; order of the completion candidates. aa5f098ab
(table (magit--completion-table table))
@@ -696,8 +712,12 @@ third-party completion frameworks."
;; And now, the moment we have all been waiting for...
(values (completing-read-multiple
(magit--format-prompt prompt def)
table predicate require-match initial-input
hist def inherit-input-method)))
table predicate
(if (eq require-match 'any) nil require-match)
initial-input hist def inherit-input-method)))
(when (and (eq require-match 'any)
(not values))
(user-error "Nothing selected"))
(if no-split input values)))
(defvar-keymap magit-minibuffer-local-ns-map
@@ -748,7 +768,7 @@ This is similar to `read-string', but
(user-error "Need non-empty input"))
((and no-whitespace (string-match-p "[\s\t\n]" val))
(user-error "Input contains whitespace"))
(t val))))
(val))))
(defun magit-read-string-ns ( prompt &optional initial-input history
default-value inherit-input-method)
@@ -779,7 +799,7 @@ ACTION is a member of option `magit-slow-confirm'."
(y-or-n-p prompt)))
(defvar magit--no-confirm-alist
'((safe-with-wip magit-wip-before-change-mode
'((safe-with-wip magit-wip-mode
discard reverse stage-all-changes unstage-all-changes)))
(cl-defun magit-confirm ( action &optional prompt prompt-n noabort
@@ -860,13 +880,14 @@ See info node `(magit)Debugging Tools' for more information."
,@(mapcan
(##list "-L" %)
(delete-dups
(mapcan
(seq-keep
(lambda (lib)
(if-let ((path (locate-library lib)))
(list (file-name-directory path))
(file-name-directory path)
(error "Cannot find mandatory dependency %s" lib)))
'(;; Like `LOAD_PATH' in `default.mk'.
"compat"
"cond-let"
"llama"
"seq"
"transient"
@@ -887,21 +908,20 @@ See info node `(magit)Debugging Tools' for more information."
(defmacro magit-bind-match-strings (varlist string &rest body)
"Bind variables to submatches according to VARLIST then evaluate BODY.
Bind the symbols in VARLIST to submatches of the current match
data, starting with 1 and incrementing by 1 for each symbol. If
the last match was against a string, then that has to be provided
as STRING."
Bind the symbols in VARLIST to submatches of the current match data,
starting with 1 and incrementing by 1 for each symbol. If the last
match was against a string, then that has to be provided as STRING."
(declare (indent 2) (debug (listp form body)))
(let ((s (gensym "string"))
(i 0))
`(let ((,s ,string))
(let ,(save-match-data
(mapcan (lambda (sym)
(cl-incf i)
(and (not (eq (aref (symbol-name sym) 0) ?_))
(list (list sym (list 'match-string i s)))))
varlist))
,@body))))
`(let* ((,s ,string)
,@(save-match-data
(seq-keep (lambda (sym)
(cl-incf i)
(and (not (eq (aref (symbol-name sym) 0) ?_))
`(,sym (match-str ,i ,s))))
varlist)))
,@body)))
(defun magit-delete-line ()
"Delete the rest of the current line."
@@ -948,8 +968,8 @@ Pad the left side of STRING so that it aligns with the text area."
(delete-char 1))
;; Valid format spec.
((looking-at "\\([-0-9.]*\\)\\([a-zA-Z]\\)")
(let* ((num (match-string 1))
(spec (string-to-char (match-string 2)))
(let* ((num (match-str 1))
(spec (string-to-char (match-str 2)))
(val (assq spec specification)))
(unless val
(error "Invalid format character: `%%%c'" spec))
@@ -968,42 +988,11 @@ Pad the left side of STRING so that it aligns with the text area."
;; Delete the percent sign.
(delete-region (1- (match-beginning 0)) (match-beginning 0)))))
;; Signal an error on bogus format strings.
(t
(error "Invalid format string"))))
((error "Invalid format string"))))
(buffer-string)))
;;; Missing from Emacs
(defun magit-kill-this-buffer ()
"Kill the current buffer."
(interactive)
(kill-buffer (current-buffer)))
(defun magit--buffer-string (&optional min max trim)
"Like `buffer-substring-no-properties' but the arguments are optional.
This combines the benefits of `buffer-string', `buffer-substring'
and `buffer-substring-no-properties' into one function that is
not as painful to use as the latter. I.e., you can write
(magit--buffer-string)
instead of
(buffer-substring-no-properties (point-min)
(point-max))
Optional MIN defaults to the value of `point-min'.
Optional MAX defaults to the value of `point-max'.
If optional TRIM is non-nil, then all leading and trailing
whitespace is remove. If it is the newline character, then
one trailing newline is added."
;; Lets write that one last time and be done with it:
(let ((str (buffer-substring-no-properties (or min (point-min))
(or max (point-max)))))
(if trim
(concat (string-trim str)
(and (eq trim ?\n) "\n"))
str)))
(defun magit--separate (pred list)
"Separate elements of LIST that do and don't satisfy PRED.
Return a list of two lists; the first containing the elements that
@@ -1085,6 +1074,8 @@ the value in the symbol's `saved-value' property if any, or
;;;###autoload
(define-advice Info-follow-nearest-node (:around (fn &optional fork) gitman)
;; Do not use `if-let*' (aka `cond-let--if-let*') because this is
;; copied to the autoload file, which does not require `cond-let'.
(let ((node (Info-get-token
(point) "\\*note[ \n\t]+"
"\\*note[ \n\t]+\\([^:]*\\):\\(:\\|[ \n\t]*(\\)?")))
@@ -1092,9 +1083,9 @@ the value in the symbol's `saved-value' property if any, or
(pcase magit-view-git-manual-method
('info (funcall fn fork))
('man (require 'man)
(man (match-string 1 node)))
(man (match-str 1 node)))
('woman (require 'woman)
(woman (match-string 1 node)))
(woman (match-str 1 node)))
(_ (user-error "Invalid value for `magit-view-git-manual-method'")))
(funcall fn fork))))
@@ -1134,7 +1125,7 @@ See <https://github.com/raxod502/straight.el/issues/520>."
(build (pcase manager
('straight (bound-and-true-p straight-build-dir))
('elpaca (bound-and-true-p elpaca-builds-directory))))
((string-prefix-p build filename))
(_(string-prefix-p build filename))
(repo (pcase manager
('straight
(and (bound-and-true-p straight-base-dir)
@@ -1172,19 +1163,19 @@ Like `message', except that `message-log-max' is bound to nil."
(defun magit--ellipsis (&optional where)
"Build an ellipsis always as string, depending on WHERE."
(if (stringp magit-ellipsis)
magit-ellipsis
(if-let ((pair (car (or
(alist-get (or where t) magit-ellipsis)
(alist-get t magit-ellipsis)))))
(pcase-let ((`(,fancy . ,universal) pair))
(let ((ellipsis (if (and fancy (char-displayable-p fancy))
fancy
universal)))
(if (characterp ellipsis)
(char-to-string ellipsis)
ellipsis)))
(user-error "Variable magit-ellipsis is invalid"))))
(cond-let
((stringp magit-ellipsis)
magit-ellipsis)
([pair (car (or (alist-get (or where t) magit-ellipsis)
(alist-get t magit-ellipsis)))]
(pcase-let* ((`(,fancy . ,universal) pair)
(ellipsis (if (and fancy (char-displayable-p fancy))
fancy
universal)))
(if (characterp ellipsis)
(char-to-string ellipsis)
ellipsis)))
((user-error "Variable magit-ellipsis is invalid"))))
(defun magit--ext-regexp-quote (string)
"Like `reqexp-quote', but for Extended Regular Expressions."
@@ -1198,4 +1189,15 @@ Like `message', except that `message-log-max' is bound to nil."
;;; _
(provide 'magit-base)
;; Local Variables:
;; read-symbol-shorthands: (
;; ("and$" . "cond-let--and$")
;; ("and>" . "cond-let--and>")
;; ("and-let" . "cond-let--and-let")
;; ("if-let" . "cond-let--if-let")
;; ("when-let" . "cond-let--when-let")
;; ("while-let" . "cond-let--while-let")
;; ("match-string" . "match-string")
;; ("match-str" . "match-string-no-properties"))
;; End:
;;; magit-base.el ends here
lisp/magit/magit-bisect.el
+14 -3
View File
@@ -53,7 +53,7 @@
;;; Commands
;;;###autoload (autoload 'magit-bisect "magit-bisect" nil t)
;;;###autoload(autoload 'magit-bisect "magit-bisect" nil t)
(transient-define-prefix magit-bisect ()
"Narrow in on the commit that introduced a bug."
:man-page "git-bisect"
@@ -258,7 +258,7 @@ bisect run'."
(pop lines))
(seq-find (##string-match done-re %) lines))))
(magit-insert-section ((eval (if bad-line 'commit 'bisect-output))
(and bad-line (match-string 1 bad-line)))
(and bad-line (match-str 1 bad-line)))
(magit-insert-heading
(propertize (or bad-line (pop lines))
'font-lock-face 'magit-section-heading))
@@ -291,7 +291,7 @@ bisect run'."
(while (progn (setq beg (point-marker))
(re-search-forward
"^\\(\\(?:git bisect\\|# status:\\) [^\n]+\n\\)" nil t))
(if (string-prefix-p "# status:" (match-string 1))
(if (string-prefix-p "# status:" (match-str 1))
(magit-delete-match)
(magit-bind-match-strings (heading) nil
(magit-delete-match)
@@ -315,4 +315,15 @@ bisect run'."
;;; _
(provide 'magit-bisect)
;; Local Variables:
;; read-symbol-shorthands: (
;; ("and$" . "cond-let--and$")
;; ("and>" . "cond-let--and>")
;; ("and-let" . "cond-let--and-let")
;; ("if-let" . "cond-let--if-let")
;; ("when-let" . "cond-let--when-let")
;; ("while-let" . "cond-let--while-let")
;; ("match-string" . "match-string")
;; ("match-str" . "match-string-no-properties"))
;; End:
;;; magit-bisect.el ends here
lisp/magit/magit-blame.el
+60 -51
View File
@@ -128,7 +128,8 @@ part of the default value:
(margin-body-face . (magit-blame-dimmed)))"
:package-version '(magit . "2.13.0")
:group 'magit-blame
:type 'string)
:type '(alist :key-type symbol
:value-type (alist :key-type symbol :value-type sexp)))
(defcustom magit-blame-echo-style 'lines
"The blame visualization style used by `magit-blame-echo'.
@@ -265,21 +266,22 @@ Also see option `magit-blame-styles'."
(magit-file-relative-name
nil (not magit-buffer-file-name))))
(line (format "%d,+1" (line-number-at-pos))))
(cond (file (with-temp-buffer
(magit-with-toplevel
(magit-git-insert
"blame" "--porcelain"
(if (memq magit-blame-type '(final removal))
(cons "--reverse" (magit-blame-arguments))
(magit-blame-arguments))
"-L" line rev "--" file)
(goto-char (point-min))
(if (eobp)
(unless noerror
(error "Cannot get blame chunk at eob"))
(car (magit-blame--parse-chunk type))))))
(noerror nil)
((error "Buffer does not visit a tracked file")))))))
(cond (file
(with-temp-buffer
(magit-with-toplevel
(magit-git-insert
"blame" "--porcelain"
(if (memq magit-blame-type '(final removal))
(cons "--reverse" (magit-blame-arguments))
(magit-blame-arguments))
"-L" line rev "--" file)
(goto-char (point-min))
(cond ((not (eobp))
(car (magit-blame--parse-chunk type)))
((not noerror)
(error "Cannot get blame chunk at eob"))))))
((not noerror)
(error "Buffer does not visit a tracked file")))))))
(defun magit-blame-chunk-at (pos)
(seq-some (##overlay-get % 'magit-blame-chunk)
@@ -326,12 +328,6 @@ in `magit-blame-read-only-mode-map' instead."
:lighter magit-blame-mode-lighter
:interactive nil
(cond (magit-blame-mode
(unless arg
;; Emacs < 28.1 doesn't support `:interactive'.
(setq magit-blame-mode nil)
(user-error
(concat "Don't call `magit-blame-mode' directly; "
"instead use `magit-blame'")))
(add-hook 'after-save-hook #'magit-blame--refresh t t)
(add-hook 'post-command-hook #'magit-blame-goto-chunk-hook t t)
(add-hook 'before-revert-hook #'magit-blame--remove-overlays t t)
@@ -422,7 +418,8 @@ modes is toggled, then this mode also gets toggled automatically.
(magit-blame-mode 1))
(message "Blaming...")
(magit-blame-run-process
(or magit-buffer-refname magit-buffer-revision)
(and$ (or magit-buffer-refname magit-buffer-revision)
(and (not (equal $ "{index}")) $))
(magit-file-relative-name nil (not magit-buffer-file-name))
(if (memq magit-blame-type '(final removal))
(cons "--reverse" args)
@@ -464,10 +461,10 @@ modes is toggled, then this mode also gets toggled automatically.
(message "Blaming...done"))
(magit-blame-assert-buffer process)
(with-current-buffer (process-get process 'command-buf)
(if magit-blame-mode
(progn (magit-blame-mode -1)
(message "Blaming...failed"))
(message "Blaming...aborted"))))
(cond (magit-blame-mode
(magit-blame-mode -1)
(message "Blaming...failed"))
((message "Blaming...aborted")))))
(kill-local-variable 'magit-blame-process))))
(defun magit-blame-process-filter (process string)
@@ -501,22 +498,22 @@ modes is toggled, then this mode also gets toggled automatically.
(buffer-substring-no-properties (point) (line-end-position))))
(with-slots (orig-rev orig-file prev-rev prev-file)
(setq chunk (magit-blame-chunk
:orig-rev (match-string 1)
:orig-line (string-to-number (match-string 2))
:final-line (string-to-number (match-string 3))
:num-lines (string-to-number (match-string 4))))
:orig-rev (match-str 1)
:orig-line (string-to-number (match-str 2))
:final-line (string-to-number (match-str 3))
:num-lines (string-to-number (match-str 4))))
(forward-line)
(let (done)
(while (not done)
(cond ((looking-at "^filename \\(.+\\)")
(setq done t)
(setf orig-file (magit-decode-git-path (match-string 1))))
(setf orig-file (magit-decode-git-path (match-str 1))))
((looking-at "^previous \\(.\\{40,\\}\\) \\(.+\\)")
(setf prev-rev (match-string 1))
(setf prev-file (magit-decode-git-path (match-string 2))))
(setf prev-rev (match-str 1))
(setf prev-file (magit-decode-git-path (match-str 2))))
((looking-at "^\\([^ ]+\\) \\(.+\\)")
(push (cons (match-string 1)
(match-string 2))
(push (cons (match-str 1)
(match-str 2))
revinfo)))
(forward-line)))
(when (and (eq type 'removal) prev-rev)
@@ -753,18 +750,18 @@ modes is toggled, then this mode also gets toggled automatically.
(delete-overlay ov)))))
(defun magit-blame-maybe-show-message ()
(when (magit-blame--style-get 'show-message)
(if-let ((msg (cdr (assoc "summary"
(gethash (oref (magit-current-blame-chunk)
orig-rev)
magit-blame-cache)))))
(progn (set-text-properties 0 (length msg) nil msg)
(magit-msg "%S" msg))
(magit-msg "Commit data not available yet. Still blaming."))))
(cond-let
((not (magit-blame--style-get 'show-message)))
([msg (cdr (assoc "summary"
(gethash (oref (magit-current-blame-chunk) orig-rev)
magit-blame-cache)))]
(set-text-properties 0 (length msg) nil msg)
(magit-msg "%S" msg))
((magit-msg "Commit data not available yet. Still blaming."))))
;;; Commands
;;;###autoload (autoload 'magit-blame-echo "magit-blame" nil t)
;;;###autoload(autoload 'magit-blame-echo "magit-blame" nil t)
(transient-define-suffix magit-blame-echo (args)
"For each line show the revision in which it was added.
Show the information about the chunk at point in the echo area
@@ -788,7 +785,7 @@ not turn on `read-only-mode'."
(read-only-mode -1)
(magit-blame--update-overlays)))
;;;###autoload (autoload 'magit-blame-addition "magit-blame" nil t)
;;;###autoload(autoload 'magit-blame-addition "magit-blame" nil t)
(transient-define-suffix magit-blame-addition (args)
"For each line show the revision in which it was added."
(interactive (list (magit-blame-arguments)))
@@ -796,7 +793,7 @@ not turn on `read-only-mode'."
(magit-blame--pre-blame-setup 'addition)
(magit-blame--run args))
;;;###autoload (autoload 'magit-blame-removal "magit-blame" nil t)
;;;###autoload(autoload 'magit-blame-removal "magit-blame" nil t)
(transient-define-suffix magit-blame-removal (args)
"For each line show the revision in which it was removed."
:if-nil 'buffer-file-name
@@ -807,7 +804,7 @@ not turn on `read-only-mode'."
(magit-blame--pre-blame-setup 'removal)
(magit-blame--run args))
;;;###autoload (autoload 'magit-blame-reverse "magit-blame" nil t)
;;;###autoload(autoload 'magit-blame-reverse "magit-blame" nil t)
(transient-define-suffix magit-blame-reverse (args)
"For each line show the last revision in which it still exists."
:if-nil 'buffer-file-name
@@ -907,8 +904,9 @@ then also kill the buffer."
#'previous-single-char-property-change
#'next-single-char-property-change)
pos 'magit-blame-chunk)))
(when-let ((o (magit-blame--overlay-at pos))
((equal (oref (magit-blame-chunk-at pos) orig-rev) rev)))
(when-let
((o (magit-blame--overlay-at pos))
(_(equal (oref (magit-blame-chunk-at pos) orig-rev) rev)))
(setq ov o))))
(if ov
(goto-char (overlay-start ov))
@@ -943,7 +941,7 @@ instead of the hash, like `kill-ring-save' would."
;;; Popup
;;;###autoload (autoload 'magit-blame "magit-blame" nil t)
;;;###autoload(autoload 'magit-blame "magit-blame" nil t)
(transient-define-prefix magit-blame ()
"Show the commits that added or removed lines in the visited file."
:man-page "git-blame"
@@ -1002,4 +1000,15 @@ instead of the hash, like `kill-ring-save' would."
;;; _
(provide 'magit-blame)
;; Local Variables:
;; read-symbol-shorthands: (
;; ("and$" . "cond-let--and$")
;; ("and>" . "cond-let--and>")
;; ("and-let" . "cond-let--and-let")
;; ("if-let" . "cond-let--if-let")
;; ("when-let" . "cond-let--when-let")
;; ("while-let" . "cond-let--while-let")
;; ("match-string" . "match-string")
;; ("match-str" . "match-string-no-properties"))
;; End:
;;; magit-blame.el ends here
lisp/magit/magit-bookmark.el
+11
View File
@@ -156,4 +156,15 @@
;;; _
(provide 'magit-bookmark)
;; Local Variables:
;; read-symbol-shorthands: (
;; ("and$" . "cond-let--and$")
;; ("and>" . "cond-let--and>")
;; ("and-let" . "cond-let--and-let")
;; ("if-let" . "cond-let--if-let")
;; ("when-let" . "cond-let--when-let")
;; ("while-let" . "cond-let--while-let")
;; ("match-string" . "match-string")
;; ("match-str" . "match-string-no-properties"))
;; End:
;;; magit-bookmark.el ends here
lisp/magit/magit-branch.el
+83 -80
View File
@@ -204,7 +204,7 @@ has to be used to view and change branch related variables."
;;; Commands
;;;###autoload (autoload 'magit-branch "magit" nil t)
;;;###autoload(autoload 'magit-branch "magit" nil t)
(transient-define-prefix magit-branch (branch)
"Add, configure or remove a branch."
:man-page "git-branch"
@@ -263,12 +263,12 @@ changes.
(interactive (list (magit-read-other-branch-or-commit "Checkout")
(magit-branch-arguments)))
(when (string-match "\\`heads/\\(.+\\)" commit)
(setq commit (match-string 1 commit)))
(setq commit (match-str 1 commit)))
(magit-run-git-async "checkout" args commit))
(defun magit--checkout (rev &optional args)
(when (string-match "\\`heads/\\(.+\\)" rev)
(setq rev (match-string 1 rev)))
(setq rev (match-str 1 rev)))
(magit-call-git "checkout" args rev))
;;;###autoload
@@ -319,7 +319,7 @@ does."
(and (not (magit-commit-p arg))
(magit-read-starting-point "Create and checkout branch" arg)))))
(when (string-match "\\`heads/\\(.+\\)" arg)
(setq arg (match-string 1 arg)))
(setq arg (match-str 1 arg)))
(if start-point
(with-suppressed-warnings ((interactive-only magit-branch-and-checkout))
(magit-branch-and-checkout arg start-point))
@@ -374,8 +374,7 @@ when using `magit-branch-and-checkout'."
choice))
((member choice local)
(list choice))
(t
(list choice (magit-read-starting-point "Create" choice))))))
((list choice (magit-read-starting-point "Create" choice))))))
(cond
((not start-point)
(magit--checkout branch (magit-branch-arguments))
@@ -496,37 +495,38 @@ from the source branch's upstream, then an error is raised."
(magit-anything-modified-p))
(message "Staying on HEAD due to uncommitted changes")
(setq checkout t))
(if-let ((current (magit-get-current-branch)))
(let ((tracked (magit-get-upstream-branch current))
base)
(when from
(unless (magit-rev-ancestor-p from current)
(user-error "Cannot spin off %s. %s is not reachable from %s"
branch from current))
(when (and tracked
(magit-rev-ancestor-p from tracked))
(user-error "Cannot spin off %s. %s is ancestor of upstream %s"
branch from tracked)))
(let ((magit-process-raise-error t))
(if checkout
(magit-call-git "checkout" "-b" branch current)
(magit-call-git "branch" branch current)))
(when-let ((upstream (magit-get-indirect-upstream-branch current)))
(magit-call-git "branch" "--set-upstream-to" upstream branch))
(when (and tracked
(setq base
(if from
(concat from "^")
(magit-git-string "merge-base" current tracked)))
(not (magit-rev-eq base current)))
(if checkout
(magit-call-git "update-ref" "-m"
(format "reset: moving to %s" base)
(concat "refs/heads/" current) base)
(magit-call-git "reset" "--hard" base))))
(if checkout
(magit-call-git "checkout" "-b" branch)
(magit-call-git "branch" branch)))
(cond-let
([current (magit-get-current-branch)]
(let ((tracked (magit-get-upstream-branch current))
base)
(when from
(unless (magit-rev-ancestor-p from current)
(user-error "Cannot spin off %s. %s is not reachable from %s"
branch from current))
(when (and tracked
(magit-rev-ancestor-p from tracked))
(user-error "Cannot spin off %s. %s is ancestor of upstream %s"
branch from tracked)))
(let ((magit-process-raise-error t))
(if checkout
(magit-call-git "checkout" "-b" branch current)
(magit-call-git "branch" branch current)))
(when-let ((upstream (magit-get-indirect-upstream-branch current)))
(magit-call-git "branch" "--set-upstream-to" upstream branch))
(when (and tracked
(setq base
(if from
(concat from "^")
(magit-git-string "merge-base" current tracked)))
(not (magit-rev-eq base current)))
(if checkout
(magit-call-git "update-ref" "-m"
(format "reset: moving to %s" base)
(concat "refs/heads/" current) base)
(magit-call-git "reset" "--hard" base)))))
(checkout
(magit-call-git "checkout" "-b" branch))
((magit-call-git "branch" branch)))
(magit-refresh))
;;;###autoload
@@ -595,16 +595,16 @@ prompt is confusing."
(setq branches
(list (magit-read-branch-prefer-other
(if force "Force delete branch" "Delete branch")))))
(when-let (((not force))
(unmerged (seq-remove #'magit-branch-merged-p branches)))
(if (magit-confirm 'delete-unmerged-branch
"Delete unmerged branch %s"
"Delete %d unmerged branches"
'noabort unmerged)
(setq force branches)
(or (setq branches
(cl-set-difference branches unmerged :test #'equal))
(user-error "Abort"))))
(cond-let
(force)
[[unmerged (seq-remove #'magit-branch-merged-p branches)]]
((magit-confirm 'delete-unmerged-branch
"Delete unmerged branch %s"
"Delete %d unmerged branches"
'noabort unmerged)
(setq force branches))
((setq branches (cl-set-difference branches unmerged :test #'equal)))
((user-error "Abort")))
(list branches force)))
(let ((refs (mapcar #'magit-ref-fullname branches)))
;; If a member of refs is nil, that means that
@@ -618,11 +618,10 @@ prompt is confusing."
(format "%s is" (seq-find #'magit-ref-ambiguous-p branches)))
((= len (length refs))
(format "These %s names are" len))
(t
(format "%s of these names are" len))))))
((format "%s of these names are" len))))))
(cond
((string-match "^refs/remotes/\\([^/]+\\)" (car refs))
(let* ((remote (match-string 1 (car refs)))
(let* ((remote (match-str 1 (car refs)))
(offset (1+ (length remote))))
(cond
((magit-confirm 'delete-branch-on-remote
@@ -728,25 +727,24 @@ prompt is confusing."
(magit-set nil "branch" branch "pushRemote"))
(defun magit-delete-remote-branch-sentinel (remote refs process event)
(when (memq (process-status process) '(exit signal))
(if (= (process-exit-status process) 1)
(if-let ((on-remote (mapcar (##concat "refs/remotes/" remote "/" %)
(magit-remote-list-branches remote)))
(rest (seq-filter (##and (not (member % on-remote))
(magit-ref-exists-p %))
refs)))
(progn
(process-put process 'inhibit-refresh t)
(magit-process-sentinel process event)
(setq magit-this-error nil)
(message "Some remote branches no longer exist. %s"
"Deleting just the local tracking refs instead...")
(dolist (ref rest)
(magit-call-git "update-ref" "-d" ref))
(magit-refresh)
(message "Deleting local remote-tracking refs...done"))
(magit-process-sentinel process event))
(magit-process-sentinel process event))))
(cond-let*
((not (memq (process-status process) '(exit signal))))
([_(= (process-exit-status process) 1)]
[on-remote (mapcar (##concat "refs/remotes/" remote "/" %)
(magit-remote-list-branches remote))]
[rest (seq-filter (##and (not (member % on-remote))
(magit-ref-exists-p %))
refs)]
(process-put process 'inhibit-refresh t)
(magit-process-sentinel process event)
(setq magit-this-error nil)
(message "Some remote branches no longer exist. %s"
"Deleting just the local tracking refs instead...")
(dolist (ref rest)
(magit-call-git "update-ref" "-d" ref))
(magit-refresh)
(message "Deleting local remote-tracking refs...done"))
((magit-process-sentinel process event))))
;;;###autoload
(defun magit-branch-rename (old new &optional force)
@@ -766,7 +764,7 @@ the remote."
nil 'magit-revision-history)
current-prefix-arg)))
(when (string-match "\\`heads/\\(.+\\)" old)
(setq old (match-string 1 old)))
(setq old (match-str 1 old)))
(when (equal old new)
(user-error "Old and new branch names are the same"))
(magit-call-git "branch" (if force "-M" "-m") old new)
@@ -787,9 +785,8 @@ the remote."
(or (not (eq magit-branch-rename-push-target 'forge-only))
(and (require (quote forge) nil t)
(fboundp 'forge--split-forge-url)
(and-let* ((url (magit-git-string
"remote" "get-url" remote)))
(forge--split-forge-url url)))))
(and$ (magit-git-string "remote" "get-url" remote)
(forge--split-forge-url $)))))
(let ((old-target (magit-get-push-branch old t))
(new-target (magit-get-push-branch new t))
(remote (magit-get-push-remote new)))
@@ -830,12 +827,7 @@ and also rename the respective reflog file."
Rename \"refs/shelved/BRANCH\" to \"refs/heads/BRANCH\". If BRANCH
is prefixed with \"YYYY-MM-DD\", then drop that part of the name.
Also rename the respective reflog file."
(interactive
(list (magit-completing-read
"Unshelve branch"
(mapcar (##substring % 8)
(nreverse (magit-list-refnames "refs/shelved")))
nil t)))
(interactive (list (magit-read-shelved-branch "Unshelve branch")))
(let ((old (concat "refs/shelved/" branch))
(new (concat "refs/heads/"
(if (string-match-p
@@ -856,7 +848,7 @@ Also rename the respective reflog file."
;;; Configure
;;;###autoload (autoload 'magit-branch-configure "magit-branch" nil t)
;;;###autoload(autoload 'magit-branch-configure "magit-branch" nil t)
(transient-define-prefix magit-branch-configure (branch)
"Configure a branch."
:man-page "git-branch"
@@ -979,4 +971,15 @@ Also rename the respective reflog file."
;;; _
(provide 'magit-branch)
;; Local Variables:
;; read-symbol-shorthands: (
;; ("and$" . "cond-let--and$")
;; ("and>" . "cond-let--and>")
;; ("and-let" . "cond-let--and-let")
;; ("if-let" . "cond-let--if-let")
;; ("when-let" . "cond-let--when-let")
;; ("while-let" . "cond-let--while-let")
;; ("match-string" . "match-string")
;; ("match-str" . "match-string-no-properties"))
;; End:
;;; magit-branch.el ends here
lisp/magit/magit-bundle.el
+14 -3
View File
@@ -33,7 +33,7 @@
;;; Commands
;;;###autoload (autoload 'magit-bundle "magit-bundle" nil t)
;;;###autoload(autoload 'magit-bundle "magit-bundle" nil t)
(transient-define-prefix magit-bundle ()
"Create or verify Git bundles."
:man-page "git-bundle"
@@ -42,7 +42,7 @@
("v" "verify" magit-bundle-verify)
("l" "list-heads" magit-bundle-list-heads)])
;;;###autoload (autoload 'magit-bundle-import "magit-bundle" nil t)
;;;###autoload(autoload 'magit-bundle-import "magit-bundle" nil t)
(transient-define-prefix magit-bundle-create (&optional file refs args)
"Create a bundle."
:man-page "git-bundle"
@@ -99,7 +99,7 @@
;;;###autoload
(defun magit-bundle-update-tracked (tag)
"Update a bundle that is being tracked using TAG."
(interactive (list (magit-read-tag "Update bundle tracked by tag" t)))
(interactive (list (magit-read-tag "Update bundle tracked by tag")))
(let (msg)
(let-alist (magit--with-temp-process-buffer
(save-excursion
@@ -136,4 +136,15 @@
;;; _
(provide 'magit-bundle)
;; Local Variables:
;; read-symbol-shorthands: (
;; ("and$" . "cond-let--and$")
;; ("and>" . "cond-let--and>")
;; ("and-let" . "cond-let--and-let")
;; ("if-let" . "cond-let--if-let")
;; ("when-let" . "cond-let--when-let")
;; ("while-let" . "cond-let--while-let")
;; ("match-string" . "match-string")
;; ("match-str" . "match-string-no-properties"))
;; End:
;;; magit-bundle.el ends here
lisp/magit/magit-clone.el
+21 -10
View File
@@ -123,7 +123,7 @@ directory where the repository has been cloned."
;;; Commands
;;;###autoload (autoload 'magit-clone "magit-clone" nil t)
;;;###autoload(autoload 'magit-clone "magit-clone" nil t)
(transient-define-prefix magit-clone (&optional transient)
"Clone a repository."
:man-page "git-clone"
@@ -314,13 +314,13 @@ Then show the status buffer for the new repository."
(defun magit-clone--url-to-name (url)
(and (string-match "\\([^/:]+?\\)\\(/?\\.git\\)?$" url)
(match-string 1 url)))
(match-str 1 url)))
(defun magit-clone--name-to-url (name)
(or (seq-some
(pcase-lambda (`(,re ,host ,user))
(and (string-match re name)
(let ((repo (match-string 1 name)))
(let ((repo (match-str 1 name)))
(magit-clone--format-url host user repo))))
magit-clone-name-alist)
(user-error "Not an url and no matching entry in `%s'"
@@ -336,16 +336,27 @@ Then show the status buffer for the new repository."
(format-spec
url-format
`((?h . ,host)
(?n . ,(if (string-search "/" repo)
repo
(if (string-search "." user)
(if-let ((user (magit-get user)))
(concat user "/" repo)
(user-error "Set %S or specify owner explicitly" user))
(concat user "/" repo))))))
(?n . ,(cond
((string-search "/" repo) repo)
((string-search "." user)
(if-let ((user (magit-get user)))
(concat user "/" repo)
(user-error "Set %S or specify owner explicitly" user)))
((concat user "/" repo))))))
(user-error
"Bogus `magit-clone-url-format' (bad type or missing default)")))
;;; _
(provide 'magit-clone)
;; Local Variables:
;; read-symbol-shorthands: (
;; ("and$" . "cond-let--and$")
;; ("and>" . "cond-let--and>")
;; ("and-let" . "cond-let--and-let")
;; ("if-let" . "cond-let--if-let")
;; ("when-let" . "cond-let--when-let")
;; ("while-let" . "cond-let--while-let")
;; ("match-string" . "match-string")
;; ("match-str" . "match-string-no-properties"))
;; End:
;;; magit-clone.el ends here
lisp/magit/magit-commit.el
+20 -8
View File
@@ -115,7 +115,7 @@ Also see https://github.com/magit/magit/issues/4132."
;;; Popup
;;;###autoload (autoload 'magit-commit "magit-commit" nil t)
;;;###autoload(autoload 'magit-commit "magit-commit" nil t)
(transient-define-prefix magit-commit ()
"Create a new commit or replace an existing commit."
:info-manual "(magit)Initiating a Commit"
@@ -539,7 +539,7 @@ is updated:
(magit-commit-absorb-modules 'run commit))
nil nil nil nil commit))))
;;;###autoload (autoload 'magit-commit-absorb "magit-commit" nil t)
;;;###autoload(autoload 'magit-commit-absorb "magit-commit" nil t)
(transient-define-prefix magit-commit-absorb (phase commit args)
"Spread staged changes across recent commits.
With a prefix argument use a transient command to select infix
@@ -572,7 +572,7 @@ See `magit-commit-autofixup' for an alternative implementation."
(when commit
(setq commit (magit-rebase-interactive-assert commit t)))
(if (and commit (eq phase 'run))
(progn (magit-run-git-async "absorb" args "-b" commit) t)
(prog1 t (magit-run-git-async "absorb" args "-b" commit))
(magit-log-select
(lambda (commit)
(with-no-warnings ; about non-interactive use
@@ -581,7 +581,7 @@ See `magit-commit-autofixup' for an alternative implementation."
(transient-augment-suffix magit-commit-absorb :transient 'transient--do-exit)
;;;###autoload (autoload 'magit-commit-autofixup "magit-commit" nil t)
;;;###autoload(autoload 'magit-commit-autofixup "magit-commit" nil t)
(transient-define-prefix magit-commit-autofixup (phase commit args)
"Spread staged or unstaged changes across recent commits.
@@ -614,7 +614,7 @@ an alternative implementation."
(when commit
(setq commit (magit-rebase-interactive-assert commit t)))
(if (and commit (eq phase 'run))
(progn (magit-run-git-async "autofixup" args commit) t)
(prog1 t (magit-run-git-async "autofixup" args commit))
(magit-log-select
(lambda (commit)
(with-no-warnings ; about non-interactive use
@@ -646,6 +646,7 @@ an alternative implementation."
#'magit-commit-instant-fixup
#'magit-commit-instant-squash))
;;;###autoload
(defun magit-run-post-commit-hook ()
(when (and (not this-command)
(memq last-command magit-post-commit-hook-commands))
@@ -707,8 +708,8 @@ an alternative implementation."
(cond
((not
(and (eq this-command 'magit-diff-while-committing)
(and-let* ((buf (magit-get-mode-buffer
'magit-diff-mode nil 'selected)))
(and-let ((buf (magit-get-mode-buffer
'magit-diff-mode nil 'selected)))
(and (equal rev (buffer-local-value 'magit-buffer-range buf))
(equal arg (buffer-local-value 'magit-buffer-typearg buf)))))))
((eq command 'magit-commit-amend)
@@ -784,7 +785,7 @@ actually insert the entry."
(narrow-to-region (point-min) (point))
(cond ((re-search-backward (format "* %s\\(?: (\\([^)]+\\))\\)?: " file)
nil t)
(when (equal (match-string 1) defun)
(when (equal (match-str 1) defun)
(setq defun nil))
(re-search-forward ": "))
(t
@@ -813,4 +814,15 @@ actually insert the entry."
;;; _
(provide 'magit-commit)
;; Local Variables:
;; read-symbol-shorthands: (
;; ("and$" . "cond-let--and$")
;; ("and>" . "cond-let--and>")
;; ("and-let" . "cond-let--and-let")
;; ("if-let" . "cond-let--if-let")
;; ("when-let" . "cond-let--when-let")
;; ("while-let" . "cond-let--while-let")
;; ("match-string" . "match-string")
;; ("match-str" . "match-string-no-properties"))
;; End:
;;; magit-commit.el ends here
lisp/magit/magit-core.el
+11
View File
@@ -120,4 +120,15 @@ Each of these options falls into one or more of these categories:
;;; _
(provide 'magit-core)
;; Local Variables:
;; read-symbol-shorthands: (
;; ("and$" . "cond-let--and$")
;; ("and>" . "cond-let--and>")
;; ("and-let" . "cond-let--and-let")
;; ("if-let" . "cond-let--if-let")
;; ("when-let" . "cond-let--when-let")
;; ("while-let" . "cond-let--while-let")
;; ("match-string" . "match-string")
;; ("match-str" . "match-string-no-properties"))
;; End:
;;; magit-core.el ends here
lisp/magit/magit-diff.el
+721 -615
View File
File diff suppressed because it is too large Load Diff
lisp/magit/magit-dired.el
+16 -1
View File
@@ -28,6 +28,8 @@
(require 'magit)
(require 'dired)
;; For `magit-do-async-shell-command'.
(declare-function dired-read-shell-command "dired-aux" (prompt arg files))
@@ -40,7 +42,9 @@ With a prefix argument, visit in another window. If there
is no file at point, then instead visit `default-directory'."
(interactive "P")
(dired-jump other-window
(and-let* ((file (magit-file-at-point)))
(and-let ((file (if (derived-mode-p 'magit-repolist-mode)
(tabulated-list-get-id)
(magit-file-at-point))))
(expand-file-name (if (file-directory-p file)
(file-name-as-directory file)
file)))))
@@ -106,4 +110,15 @@ Interactively, open the file at point."
;;; _
(provide 'magit-dired)
;; Local Variables:
;; read-symbol-shorthands: (
;; ("and$" . "cond-let--and$")
;; ("and>" . "cond-let--and>")
;; ("and-let" . "cond-let--and-let")
;; ("if-let" . "cond-let--if-let")
;; ("when-let" . "cond-let--when-let")
;; ("while-let" . "cond-let--while-let")
;; ("match-string" . "match-string")
;; ("match-str" . "match-string-no-properties"))
;; End:
;;; magit-dired.el ends here
lisp/magit/magit-ediff.el
+29 -19
View File
@@ -115,7 +115,7 @@ recommend you do not further complicate that by enabling this.")
(defvar magit-ediff-previous-winconf nil)
;;;###autoload (autoload 'magit-ediff "magit-ediff" nil)
;;;###autoload(autoload 'magit-ediff "magit-ediff" nil)
(transient-define-prefix magit-ediff ()
"Show differences using the Ediff package."
:info-manual "(ediff)"
@@ -266,21 +266,21 @@ and alternative commands."
(goto-char (point-min))
(unless (re-search-forward "^<<<<<<< " nil t)
(magit-stage-files (list file)))))))))
(if fileC
(magit-ediff-buffers
((magit-get-revision-buffer revA fileA)
(magit-find-file-noselect revA fileA))
((magit-get-revision-buffer revB fileB)
(magit-find-file-noselect revB fileB))
((magit-get-revision-buffer revC fileC)
(magit-find-file-noselect revC fileC))
setup quit file)
(magit-ediff-buffers
((magit-get-revision-buffer revA fileA)
(magit-find-file-noselect revA fileA))
((magit-get-revision-buffer revB fileB)
(magit-find-file-noselect revB fileB))
nil setup quit file))))))
(cond (fileC
(magit-ediff-buffers
((magit-get-revision-buffer revA fileA)
(magit-find-file-noselect revA fileA))
((magit-get-revision-buffer revB fileB)
(magit-find-file-noselect revB fileB))
((magit-get-revision-buffer revC fileC)
(magit-find-file-noselect revC fileC))
setup quit file))
((magit-ediff-buffers
((magit-get-revision-buffer revA fileA)
(magit-find-file-noselect revA fileA))
((magit-get-revision-buffer revB fileB)
(magit-find-file-noselect revB fileB))
nil setup quit file)))))))
;;;###autoload
(defun magit-ediff-resolve-rest (file)
@@ -332,7 +332,7 @@ FILE has to be relative to the top directory of the repository."
(bufC* (or bufC (find-file-noselect file)))
(coding-system-for-read
(buffer-local-value 'buffer-file-coding-system bufC*))
(bufA* (magit-find-file-noselect-1 "HEAD" file t))
(bufA* (magit-find-file-noselect "HEAD" file t))
(bufB* (magit-find-file-index-noselect file t)))
(with-current-buffer bufB* (setq buffer-read-only nil))
(magit-ediff-buffers
@@ -488,8 +488,7 @@ mind at all, then it asks the user for a command to run."
(magit-ediff-show-stash revB))
(file
(funcall command file))
(t
(call-interactively command)))))))
((call-interactively command)))))))
;;;###autoload
(defun magit-ediff-show-staged (file)
@@ -602,4 +601,15 @@ stash that were staged."
;;; _
(provide 'magit-ediff)
;; Local Variables:
;; read-symbol-shorthands: (
;; ("and$" . "cond-let--and$")
;; ("and>" . "cond-let--and>")
;; ("and-let" . "cond-let--and-let")
;; ("if-let" . "cond-let--if-let")
;; ("when-let" . "cond-let--when-let")
;; ("while-let" . "cond-let--while-let")
;; ("match-string" . "match-string")
;; ("match-str" . "match-string-no-properties"))
;; End:
;;; magit-ediff.el ends here
lisp/magit/magit-extras.el
+108 -105
View File
@@ -42,7 +42,7 @@
;;; Git Tools
;;;; Git-Mergetool
;;;###autoload (autoload 'magit-git-mergetool "magit-extras" nil t)
;;;###autoload(autoload 'magit-git-mergetool "magit-extras" nil t)
(transient-define-prefix magit-git-mergetool (file args &optional transient)
"Resolve conflicts in FILE using \"git mergetool --gui\".
With a prefix argument allow changing ARGS using a transient
@@ -205,9 +205,6 @@ to nil before loading Magit to prevent \"m\" from being bound.")
(with-eval-after-load 'project
(when (and magit-bind-magit-project-status
;; Added in Emacs 28.1.
(boundp 'project-prefix-map)
(boundp 'project-switch-commands)
;; Only modify if it hasn't already been modified.
(equal project-switch-commands
(eval (car (get 'project-switch-commands 'standard-value))
@@ -282,7 +279,7 @@ with two prefix arguments remove ignored files only.
(1 "untracked")
(4 "untracked and ignored")
(_ "ignored"))))
(magit-wip-commit-before-change)
(magit-run-before-change-functions nil "clean")
(magit-run-git "clean" "-f" "-d" (pcase arg (4 "-x") (16 "-X")))))
(put 'magit-clean 'disabled t)
@@ -335,10 +332,7 @@ a position in a file-visiting buffer."
(prompt-for-change-log-name)))
(pcase-let ((`(,buf ,pos) (magit-diff-visit-file--noselect)))
(magit--with-temp-position buf pos
(let ((add-log-buffer-file-name-function
(lambda ()
(or magit-buffer-file-name
(buffer-file-name)))))
(let ((add-log-buffer-file-name-function #'magit-buffer-file-name))
(add-change-log-entry whoami file-name other-window)))))
;;;###autoload
@@ -396,7 +390,7 @@ points at it) otherwise."
(put 'magit-edit-line-commit 'disabled t)
;;;###autoload
(defun magit-diff-edit-hunk-commit (file)
(defun magit-diff-edit-hunk-commit ()
"From a hunk, edit the respective commit and visit the file.
First visit the file being modified by the hunk at the correct
@@ -413,10 +407,10 @@ to be visited.
Neither the blob nor the file buffer are killed when finishing
the rebase. If that is undesirable, then it might be better to
use `magit-rebase-edit-commit' instead of this command."
(interactive (list (magit-file-at-point t t)))
(interactive)
(let ((magit-diff-visit-previous-blob nil))
(with-current-buffer
(magit-diff-visit-file--internal file nil #'pop-to-buffer-same-window)
(magit-diff-visit-file--internal nil #'pop-to-buffer-same-window)
(magit-edit-line-commit))))
(put 'magit-diff-edit-hunk-commit 'disabled t)
@@ -609,47 +603,45 @@ the minibuffer too."
default-directory))
(push (caar magit-revision-stack) magit-revision-history)
(pop magit-revision-stack)))
(if rev
(pcase-let ((`(,pnt-format ,eob-format ,idx-format)
magit-pop-revision-stack-format))
(let ((default-directory toplevel)
(idx (and idx-format
(save-excursion
(if (re-search-backward idx-format nil t)
(number-to-string
(1+ (string-to-number (match-string 1))))
"1"))))
pnt-args eob-args)
(when (listp pnt-format)
(setq pnt-args (cdr pnt-format))
(setq pnt-format (car pnt-format)))
(when (listp eob-format)
(setq eob-args (cdr eob-format))
(setq eob-format (car eob-format)))
(when pnt-format
(when idx-format
(setq pnt-format
(string-replace "%N" idx pnt-format)))
(magit-rev-insert-format pnt-format rev pnt-args)
(delete-char -1))
(when eob-format
(when idx-format
(setq eob-format
(string-replace "%N" idx eob-format)))
(save-excursion
(goto-char (point-max))
(skip-syntax-backward ">-")
(beginning-of-line)
(if (and comment-start (looking-at comment-start))
(while (looking-at comment-start)
(forward-line -1))
(forward-line)
(unless (= (current-column) 0)
(insert ?\n)))
(insert ?\n)
(magit-rev-insert-format eob-format rev eob-args)
(delete-char -1)))))
(user-error "Revision stack is empty")))
(unless rev
(user-error "Revision stack is empty"))
(pcase-let ((`(,pnt-format ,eob-format ,idx-format)
magit-pop-revision-stack-format))
(let ((default-directory toplevel)
(idx (and idx-format
(if (save-excursion
(re-search-backward idx-format nil t))
(number-to-string (1+ (string-to-number (match-str 1))))
"1")))
(pnt-args nil)
(eob-args nil))
(when (listp pnt-format)
(setq pnt-args (cdr pnt-format))
(setq pnt-format (car pnt-format)))
(when (listp eob-format)
(setq eob-args (cdr eob-format))
(setq eob-format (car eob-format)))
(when pnt-format
(when idx-format
(setq pnt-format (string-replace "%N" idx pnt-format)))
(magit-rev-insert-format pnt-format rev pnt-args)
(delete-char -1))
(when eob-format
(when idx-format
(setq eob-format (string-replace "%N" idx eob-format)))
(save-excursion
(goto-char (point-max))
(skip-syntax-backward ">-")
(beginning-of-line)
(if (and comment-start (looking-at comment-start))
(while (looking-at comment-start)
(forward-line -1))
(forward-line)
(unless (= (current-column) 0)
(insert ?\n)))
(insert ?\n)
(magit-rev-insert-format eob-format rev eob-args)
(delete-char -1))))))
;;;###autoload
(defun magit-copy-section-value (arg)
@@ -675,42 +667,41 @@ a hunk, then strip the diff marker column and keep only either
the added or removed lines, depending on the sign of the prefix
argument."
(interactive "P")
(cond
((and arg
(magit-section-internal-region-p)
(magit-section-match 'hunk))
(kill-new
(thread-last (buffer-substring-no-properties
(region-beginning)
(region-end))
(replace-regexp-in-string
(format "^\\%c.*\n?" (if (< (prefix-numeric-value arg) 0) ?+ ?-))
"")
(replace-regexp-in-string "^[ +-]" "")))
(deactivate-mark))
((use-region-p)
(call-interactively #'copy-region-as-kill))
(t
(when-let* ((section (magit-current-section))
(value (oref section value)))
(magit-section-case
((branch commit module-commit tag)
(let ((default-directory default-directory) ref)
(magit-section-case
((branch tag)
(setq ref value))
(module-commit
(setq default-directory
(file-name-as-directory
(expand-file-name (magit-section-parent-value section)
(magit-toplevel))))))
(setq value (magit-rev-parse
(and magit-copy-revision-abbreviated "--short")
value))
(push (list value default-directory) magit-revision-stack)
(kill-new (message "%s" (or (and current-prefix-arg ref)
value)))))
(t (kill-new (message "%s" value))))))))
(cond-let*
((and arg
(magit-section-internal-region-p)
(magit-section-match 'hunk))
(kill-new
(thread-last (buffer-substring-no-properties
(region-beginning)
(region-end))
(replace-regexp-in-string
(format "^\\%c.*\n?" (if (< (prefix-numeric-value arg) 0) ?+ ?-))
"")
(replace-regexp-in-string "^[ +-]" "")))
(deactivate-mark))
((use-region-p)
(call-interactively #'copy-region-as-kill))
([section (magit-current-section)]
[value (oref section value)]
(magit-section-case
((branch commit module-commit tag)
(let ((default-directory default-directory) ref)
(magit-section-case
((branch tag)
(setq ref value))
(module-commit
(setq default-directory
(file-name-as-directory
(expand-file-name (magit-section-parent-value section)
(magit-toplevel))))))
(setq value (magit-rev-parse
(and magit-copy-revision-abbreviated "--short")
value))
(push (list value default-directory) magit-revision-stack)
(kill-new (message "%s" (or (and current-prefix-arg ref)
value)))))
(t (kill-new (message "%s" value)))))))
;;;###autoload
(defun magit-copy-buffer-revision ()
@@ -739,22 +730,23 @@ When `magit-copy-revision-abbreviated' is non-nil, save the
abbreviated revision to the `kill-ring' and the
`magit-revision-stack'."
(interactive)
(if (use-region-p)
(call-interactively #'copy-region-as-kill)
(when-let ((rev (or magit-buffer-revision
(cl-case major-mode
(magit-diff-mode
(if (string-match "\\.\\.\\.?\\(.+\\)"
magit-buffer-range)
(match-string 1 magit-buffer-range)
magit-buffer-range))
(magit-status-mode "HEAD")))))
(when (magit-commit-p rev)
(setq rev (magit-rev-parse
(and magit-copy-revision-abbreviated "--short")
rev))
(push (list rev default-directory) magit-revision-stack)
(kill-new (message "%s" rev))))))
(cond-let*
((use-region-p)
(call-interactively #'copy-region-as-kill))
([rev (or magit-buffer-revision
(cl-case major-mode
(magit-diff-mode
(if (string-match "\\.\\.\\.?\\(.+\\)"
magit-buffer-range)
(match-str 1 magit-buffer-range)
magit-buffer-range))
(magit-status-mode "HEAD")))]
[_(magit-commit-p rev)]
(setq rev (magit-rev-parse
(and magit-copy-revision-abbreviated "--short")
rev))
(push (list rev default-directory) magit-revision-stack)
(kill-new (message "%s" rev)))))
;;; Buffer Switching
@@ -835,4 +827,15 @@ In Magit diffs, also skip over - and + at the beginning of the line."
;;; _
(provide 'magit-extras)
;; Local Variables:
;; read-symbol-shorthands: (
;; ("and$" . "cond-let--and$")
;; ("and>" . "cond-let--and>")
;; ("and-let" . "cond-let--and-let")
;; ("if-let" . "cond-let--if-let")
;; ("when-let" . "cond-let--when-let")
;; ("while-let" . "cond-let--while-let")
;; ("match-string" . "match-string")
;; ("match-str" . "match-string-no-properties"))
;; End:
;;; magit-extras.el ends here
lisp/magit/magit-fetch.el
+16 -6
View File
@@ -30,7 +30,7 @@
;;; Commands
;;;###autoload (autoload 'magit-fetch "magit-fetch" nil t)
;;;###autoload(autoload 'magit-fetch "magit-fetch" nil t)
(transient-define-prefix magit-fetch ()
"Fetch from another repository."
:man-page "git-fetch"
@@ -58,7 +58,7 @@
(run-hooks 'magit-credential-hook)
(magit-run-git-async "fetch" remote args))
;;;###autoload (autoload 'magit-fetch-from-pushremote "magit-fetch" nil t)
;;;###autoload(autoload 'magit-fetch-from-pushremote "magit-fetch" nil t)
(transient-define-suffix magit-fetch-from-pushremote (args)
"Fetch from the current push-remote.
@@ -84,10 +84,9 @@ push-remote."
((member remote (magit-list-remotes)) remote)
(remote
(format "%s, replacing invalid" v))
(t
(format "%s, setting that" v)))))
((format "%s, setting that" v)))))
;;;###autoload (autoload 'magit-fetch-from-upstream "magit-fetch" nil t)
;;;###autoload(autoload 'magit-fetch-from-upstream "magit-fetch" nil t)
(transient-define-suffix magit-fetch-from-upstream (remote args)
"Fetch from the \"current\" remote, usually the upstream.
@@ -156,7 +155,7 @@ removed on the respective remote."
(run-hooks 'magit-credential-hook)
(magit-run-git-async "remote" "update"))
;;;###autoload (autoload 'magit-fetch-modules "magit-fetch" nil t)
;;;###autoload(autoload 'magit-fetch-modules "magit-fetch" nil t)
(transient-define-prefix magit-fetch-modules (&optional transient args)
"Fetch all populated submodules.
@@ -183,4 +182,15 @@ with a prefix argument."
;;; _
(provide 'magit-fetch)
;; Local Variables:
;; read-symbol-shorthands: (
;; ("and$" . "cond-let--and$")
;; ("and>" . "cond-let--and>")
;; ("and-let" . "cond-let--and-let")
;; ("if-let" . "cond-let--if-let")
;; ("when-let" . "cond-let--when-let")
;; ("while-let" . "cond-let--while-let")
;; ("match-string" . "match-string")
;; ("match-str" . "match-string-no-properties"))
;; End:
;;; magit-fetch.el ends here
lisp/magit/magit-files.el
+129 -85
View File
@@ -68,17 +68,15 @@ the line and column corresponding to that location."
(defun magit-find-file-read-args (prompt)
(let ((pseudo-revs '("{worktree}" "{index}")))
(if-let ((rev (magit-completing-read "Find file from revision"
(append pseudo-revs
(magit-list-refnames nil t))
nil nil nil 'magit-revision-history
(or (magit-branch-or-commit-at-point)
(magit-get-current-branch)))))
(list rev (magit-read-file-from-rev (if (member rev pseudo-revs)
"HEAD"
rev)
prompt))
(user-error "Nothing selected"))))
(let ((rev (magit-completing-read "Find file from revision"
(append pseudo-revs
(magit-list-refnames nil t))
nil 'any nil 'magit-revision-history
(or (magit-branch-or-commit-at-point)
(magit-get-current-branch)))))
(list rev
(magit-read-file-from-rev (if (member rev pseudo-revs) "HEAD" rev)
prompt)))))
(defun magit-find-file--internal (rev file fn)
(let ((buf (magit-find-file-noselect rev file))
@@ -96,8 +94,7 @@ the line and column corresponding to that location."
(magit-buffer-revision
(setq line (magit-diff-visit--offset
file (concat magit-buffer-revision ".." rev) line)))
(t
(setq line (magit-diff-visit--offset file (list "-R" rev) line)))))
((setq line (magit-diff-visit--offset file (list "-R" rev) line)))))
(funcall fn buf)
(when line
(with-current-buffer buf
@@ -107,39 +104,35 @@ the line and column corresponding to that location."
(move-to-column col)))
buf))
(defun magit-find-file-noselect (rev file)
(defun magit-find-file-noselect (rev file &optional revert)
"Read FILE from REV into a buffer and return the buffer.
REV is a revision or one of \"{worktree}\" or \"{index}\".
FILE must be relative to the top directory of the repository."
(magit-find-file-noselect-1 rev file))
(defun magit-find-file-noselect-1 (rev file &optional revert)
"Read FILE from REV into a buffer and return the buffer.
REV is a revision or one of \"{worktree}\" or \"{index}\".
FILE must be relative to the top directory of the repository.
Non-nil REVERT means to revert the buffer. If `ask-revert',
then only after asking. A non-nil value for REVERT is ignored if REV is
\"{worktree}\"."
(if (equal rev "{worktree}")
(find-file-noselect (expand-file-name file (magit-toplevel)))
(let ((topdir (magit-toplevel)))
(when (file-name-absolute-p file)
(setq file (file-relative-name file topdir)))
(with-current-buffer (magit-get-revision-buffer-create rev file)
REV is a revision or one of \"{worktree}\" or \"{index}\". FILE must
be relative to the top directory of the repository. Non-nil REVERT
means to revert the buffer. If `ask-revert', then only after asking.
A non-nil value for REVERT is ignored if REV is \"{worktree}\"."
(let* ((topdir (magit-toplevel))
(absolute (file-name-absolute-p file))
(file-abs (if absolute file (expand-file-name file topdir)))
(file-rel (if absolute (file-relative-name file topdir) file))
(defdir (file-name-directory file-abs))
(rev (magit--abbrev-if-hash rev)))
(if (equal rev "{worktree}")
(let ((revert-without-query
(if (and$ (find-buffer-visiting file-abs)
(buffer-local-value 'auto-revert-mode $))
(cons "." revert-without-query)
revert-without-query)))
(find-file-noselect file-abs))
(with-current-buffer (magit-get-revision-buffer-create rev file-rel)
(when (or (not magit-buffer-file-name)
(if (eq revert 'ask-revert)
(y-or-n-p (format "%s already exists; revert it? "
(buffer-name))))
revert)
(setq magit-buffer-revision
(if (equal rev "{index}")
"{index}"
(magit-rev-format "%H" rev)))
(setq magit-buffer-revision rev)
(setq magit-buffer-refname rev)
(setq magit-buffer-file-name (expand-file-name file topdir))
(setq default-directory
(let ((dir (file-name-directory magit-buffer-file-name)))
(if (file-exists-p dir) dir topdir)))
(setq magit-buffer-file-name file-abs)
(setq default-directory (if (file-exists-p defdir) defdir topdir))
(setq-local revert-buffer-function #'magit-revert-rev-file-buffer)
(revert-buffer t t)
(run-hooks (if (equal rev "{index}")
@@ -182,7 +175,10 @@ then only after asking. A non-nil value for REVERT is ignored if REV is
global-diff-hl-mode-enable-in-buffers ; Emacs < 30
eglot--maybe-activate-editing-mode)
#'eq)))
(normal-mode t))
;; We want `normal-mode' to respect nil `enable-local-variables'.
;; The FIND-FILE argument wasn't designed for our use case, so we
;; have to use this strange invocation to achieve that.
(normal-mode (not enable-local-variables)))
(setq buffer-read-only t)
(set-buffer-modified-p nil)
(goto-char (point-min))))
@@ -196,11 +192,12 @@ See also https://github.com/doomemacs/doomemacs/pull/6309."
;;; Find Index
(defvar magit-find-index-hook nil)
(add-hook 'magit-find-index-hook #'magit-blob-mode)
(defun magit-find-file-index-noselect (file &optional revert)
"Read FILE from the index into a buffer and return the buffer.
FILE must to be relative to the top directory of the repository."
(magit-find-file-noselect-1 "{index}" file (or revert 'ask-revert)))
(magit-find-file-noselect "{index}" file (or revert 'ask-revert)))
(defun magit-update-index ()
"Update the index with the contents of the current buffer.
@@ -214,8 +211,7 @@ is done using `magit-find-index-noselect'."
(let ((index (make-temp-name
(expand-file-name "magit-update-index-" (magit-gitdir))))
(buffer (current-buffer)))
(when magit-wip-before-change-mode
(magit-wip-commit-before-change (list file) " before un-/stage"))
(magit-run-before-change-functions file "un-/stage")
(unwind-protect
(progn
(let ((coding-system-for-write buffer-file-coding-system))
@@ -232,8 +228,7 @@ is done using `magit-find-index-noselect'."
file)))
(ignore-errors (delete-file index)))
(set-buffer-modified-p nil)
(when magit-wip-after-apply-mode
(magit-wip-commit-after-apply (list file) " after un-/stage")))
(magit-run-after-apply-functions file "un-/stage"))
(message "Abort")))
(when-let ((buffer (magit-get-mode-buffer 'magit-status-mode)))
(with-current-buffer buffer
@@ -292,7 +287,7 @@ directory, while reading the FILENAME."
;;; File Dispatch
;;;###autoload (autoload 'magit-file-dispatch "magit" nil t)
;;;###autoload(autoload 'magit-file-dispatch "magit" nil t)
(transient-define-prefix magit-file-dispatch ()
"Invoke a Magit command that acts on the visited file.
When invoked outside a file-visiting buffer, then fall back
@@ -355,7 +350,7 @@ to `magit-dispatch'."
"b" #'magit-blame-addition
"r" #'magit-blame-removal
"f" #'magit-blame-reverse
"q" #'magit-kill-this-buffer)
"q" #'magit-bury-or-kill-buffer)
(define-minor-mode magit-blob-mode
"Enable some Magit features in blob-visiting buffers.
@@ -364,26 +359,51 @@ Currently this only adds the following key bindings.
\n\\{magit-blob-mode-map}"
:package-version '(magit . "2.3.0"))
(defun magit-blob-next ()
"Visit the next blob which modified the current file."
(interactive)
(if magit-buffer-file-name
(magit-blob-visit (or (magit-blob-successor magit-buffer-revision
magit-buffer-file-name)
magit-buffer-file-name))
(if (buffer-file-name (buffer-base-buffer))
(user-error "You have reached the end of time")
(user-error "Buffer isn't visiting a file or blob"))))
(defun magit-bury-buffer (&optional kill-buffer)
"Bury the current buffer, or with a prefix argument kill it."
(interactive "P")
(if kill-buffer (kill-buffer) (bury-buffer)))
(defun magit-blob-previous ()
"Visit the previous blob which modified the current file."
(defun magit-bury-or-kill-buffer (&optional bury-buffer)
"Bury the current buffer if displayed in multiple windows, else kill it.
With a prefix argument only bury the buffer even if it is only displayed
in a single window."
(interactive "P")
(if (or bury-buffer (cdr (get-buffer-window-list nil nil t)))
(bury-buffer)
(kill-buffer)))
(defun magit-kill-this-buffer ()
"Kill the current buffer."
(interactive)
(if-let ((file (or magit-buffer-file-name
(buffer-file-name (buffer-base-buffer)))))
(if-let ((ancestor (magit-blob-ancestor magit-buffer-revision file)))
(magit-blob-visit ancestor)
(user-error "You have reached the beginning of time"))
(user-error "Buffer isn't visiting a file or blob")))
(kill-buffer))
(transient-define-suffix magit-blob-previous ()
"Visit the previous blob which modified the current file."
:inapt-if-not (##and$ (magit-buffer-file-name)
(magit-blob-ancestor (magit-buffer-revision) $))
(interactive)
(cond-let
[[rev (or magit-buffer-revision "{worktree}")]
[file (magit-buffer-file-name)]]
((not file)
(user-error "Buffer isn't visiting a file or blob"))
([prev (magit-blob-ancestor rev file)]
(apply #'magit-blob-visit prev))
((user-error "You have reached the beginning of time"))))
(transient-define-suffix magit-blob-next ()
"Visit the next blob which modified the current file."
:inapt-if-nil 'magit-buffer-file-name
(interactive)
(cond-let
[[rev (or magit-buffer-revision "{worktree}")]
[file (magit-buffer-file-name)]]
((not file)
(user-error "Buffer isn't visiting a file or blob"))
([next (magit-blob-successor rev file)]
(apply #'magit-blob-visit next))
((user-error "You have reached the end of time"))))
;;;###autoload
(defun magit-blob-visit-file ()
@@ -395,30 +415,40 @@ the same location in the respective file in the working tree."
(magit-find-file--internal "{worktree}" file #'pop-to-buffer-same-window)
(user-error "Not visiting a blob")))
(defun magit-blob-visit (blob-or-file)
(if (stringp blob-or-file)
(find-file blob-or-file)
(pcase-let ((`(,rev ,file) blob-or-file))
(magit-find-file rev file)
(apply #'message "%s (%s %s ago)"
(magit-rev-format "%s" rev)
(magit--age (magit-rev-format "%ct" rev))))))
(defun magit-blob-visit (rev file)
(magit-find-file rev file)
(unless (member rev '("{worktree}" "{index}"))
(apply #'message "%s (%s %s ago)"
(magit-rev-format "%s" rev)
(magit--age (magit-rev-format "%ct" rev)))))
(defun magit-blob-ancestor (rev file)
(let ((lines (magit-with-toplevel
(magit-git-lines "log" "-2" "--format=%H" "--name-only"
"--follow" (or rev "HEAD") "--" file))))
(if rev (cddr lines) (butlast lines 2))))
(pcase rev
((and "{worktree}" (guard (magit-anything-staged-p nil file)))
(list "{index}" file))
((or "{worktree}" "{index}")
(list (magit-rev-abbrev "HEAD") file))
(_ (nth (if rev 1 0)
(magit-with-toplevel
(seq-partition
(magit-git-lines "log" "-2" "--format=%h" "--name-only"
"--follow" (or rev "HEAD") "--" file)
2))))))
(defun magit-blob-successor (rev file)
(let ((lines (magit-with-toplevel
(magit-git-lines "log" "--format=%H" "--name-only" "--follow"
"HEAD" "--" file))))
(catch 'found
(while lines
(if (equal (nth 2 lines) rev)
(throw 'found (list (nth 0 lines) (nth 1 lines)))
(setq lines (nthcdr 2 lines)))))))
(pcase rev
("{worktree}" nil)
("{index}" (list "{worktree}" file))
(_ (let ((lines (magit-with-toplevel
(magit-git-lines "log" "--format=%h" "--name-only"
"--follow" "HEAD" "--" file))))
(catch 'found
(while lines
(if (equal (nth 2 lines) rev)
(throw 'found (list (nth 0 lines) (nth 1 lines)))
(setq lines (nthcdr 2 lines))))
(list (if (magit-anything-staged-p nil file) "{index}" "{worktree}")
file))))))
;;; File Commands
@@ -591,5 +621,19 @@ If DEFAULT is non-nil, use this as the default value instead of
(define-obsolete-function-alias 'magit-unstage-buffer-file
'magit-file-unstage "Magit 4.3.2")
(define-obsolete-function-alias 'magit-find-file-noselect-1
'magit-find-file-noselect "Magit 4.4.0")
(provide 'magit-files)
;; Local Variables:
;; read-symbol-shorthands: (
;; ("and$" . "cond-let--and$")
;; ("and>" . "cond-let--and>")
;; ("and-let" . "cond-let--and-let")
;; ("if-let" . "cond-let--if-let")
;; ("when-let" . "cond-let--when-let")
;; ("while-let" . "cond-let--while-let")
;; ("match-string" . "match-string")
;; ("match-str" . "match-string-no-properties"))
;; End:
;;; magit-files.el ends here
lisp/magit/magit-git.el
+355 -343
View File
File diff suppressed because it is too large Load Diff
lisp/magit/magit-gitignore.el
+16 -5
View File
@@ -30,7 +30,7 @@
;;; Transient
;;;###autoload (autoload 'magit-gitignore "magit-gitignore" nil t)
;;;###autoload(autoload 'magit-gitignore "magit-gitignore" nil t)
(transient-define-prefix magit-gitignore ()
"Instruct Git to ignore a file or pattern."
:man-page "gitignore"
@@ -118,9 +118,9 @@ Rules that are defined in that file affect all local repositories."
(mapcan
(lambda (file)
(cons (concat "/" file)
(and-let* ((ext (file-name-extension file)))
(list (concat "/" (file-name-directory file) "*." ext)
(concat "*." ext)))))
(and$ (file-name-extension file)
(list (concat "/" (file-name-directory file) "*." $)
(concat "*." $)))))
(sort (nconc
(magit-untracked-files nil base)
;; The untracked section of the status buffer lists
@@ -138,7 +138,7 @@ Rules that are defined in that file affect all local repositories."
(unless (member default choices)
(setq default nil))))
(magit-completing-read "File or pattern to ignore"
choices nil nil nil nil default)))
choices nil 'any nil nil default)))
;;; Skip Worktree Commands
@@ -192,4 +192,15 @@ Rules that are defined in that file affect all local repositories."
;;; _
(provide 'magit-gitignore)
;; Local Variables:
;; read-symbol-shorthands: (
;; ("and$" . "cond-let--and$")
;; ("and>" . "cond-let--and>")
;; ("and-let" . "cond-let--and-let")
;; ("if-let" . "cond-let--if-let")
;; ("when-let" . "cond-let--when-let")
;; ("while-let" . "cond-let--while-let")
;; ("match-string" . "match-string")
;; ("match-str" . "match-string-no-properties"))
;; End:
;;; magit-gitignore.el ends here
lisp/magit/magit-log.el
+288 -219
View File
@@ -31,8 +31,7 @@
(require 'magit-core)
(require 'magit-diff)
(declare-function magit--any-wip-mode-enabled-p "magit-wip" ())
(declare-function magit-blob-visit "magit-files" (blob-or-file))
(declare-function magit-blob-visit "magit-files" (rev file))
(declare-function magit-cherry-apply "magit-sequence" (commit &optional args))
(declare-function magit-insert-head-branch-header "magit-status"
(&optional branch))
@@ -48,9 +47,10 @@
(defvar magit-refs-focus-column-width)
(defvar magit-refs-margin)
(defvar magit-refs-show-commit-count)
(defvar magit-buffer-margin)
(defvar magit--right-margin-config)
(defvar magit-status-margin)
(defvar magit-status-sections-hook)
(defvar magit-status-use-buffer-arguments)
(require 'ansi-color)
(require 'crm)
@@ -170,6 +170,23 @@ want to use the same functions for both hooks."
:options (list #'magit-highlight-squash-markers
#'magit-highlight-bracket-keywords))
(defcustom magit-log-trailer-labels nil
"Whether and how to insert labels, derived from commit message trailers.
If non-nil, the value has the form (FUNCTION . OPTIONS). FUNCTION is
called with one argument, the trailers as an alist, and should return a
string, which is then inserted in between the refnames and the message,
or nil. OPTIONS specifies additional options for \"%(trailers)\". You
should probably use something like \"key=KEY1,key=KEY2,only=true\".
\"unfold=true,separator=^^,key_value_separator=^_\" is always appended
to the options specified here. See the git-log(1) manpage."
:package-version '(magit . "4.4.1")
:group 'magit-log
:type '(choice (const :tag "Ignore trailers" nil)
(cons :tag "Process trailers"
(function :tag "Formatting function")
(string :tag "Options for %%(trailers)"))))
(defcustom magit-log-header-line-function #'magit-log-header-line-sentence
"Function used to generate text shown in header line of log buffers."
:package-version '(magit . "2.12.0")
@@ -370,11 +387,15 @@ commits before and half after."
;;;; Prefix Methods
(cl-defmethod transient-prefix-value ((obj magit-log-prefix))
(let ((args (cl-call-next-method obj)))
(list (seq-filter #'atom args)
(cdr (assoc "--" args)))))
(cl-defmethod transient-init-value ((obj magit-log-prefix))
(pcase-let ((`(,args ,files)
(magit-log--get-value 'magit-log-mode
magit-prefix-use-buffer-arguments)))
(when-let (((not (eq transient-current-command 'magit-dispatch)))
(magit-log--get-value 'magit-log-mode 'prefix)))
(when-let ((_(not (eq transient-current-command 'magit-dispatch)))
(file (magit-file-relative-name)))
(setq files (list file)))
(oset obj value (if files `(("--" ,@files) ,@args) args))))
@@ -396,40 +417,38 @@ commits before and half after."
(defun magit-log-arguments (&optional mode)
"Return the current log arguments."
(if (memq transient-current-command '(magit-log magit-log-refresh))
(magit--transient-args-and-files)
(magit-log--get-value (or mode 'magit-log-mode))))
(transient-args transient-current-command)
(magit-log--get-value (or mode 'magit-log-mode) 'direct)))
(defun magit-log--get-value (mode &optional use-buffer-args)
(unless use-buffer-args
(setq use-buffer-args magit-direct-use-buffer-arguments))
(let (args files)
(cond
((and (memq use-buffer-args '(always selected current))
(eq major-mode mode))
(setq args magit-buffer-log-args)
(setq files magit-buffer-log-files))
((when-let (((memq use-buffer-args '(always selected)))
(buffer (magit-get-mode-buffer
mode nil
(eq use-buffer-args 'selected))))
(setq args (buffer-local-value 'magit-buffer-log-args buffer))
(setq files (buffer-local-value 'magit-buffer-log-files buffer))
t))
((plist-member (symbol-plist mode) 'magit-log-current-arguments)
(setq args (get mode 'magit-log-current-arguments)))
((when-let ((elt (assq (intern (format "magit-log:%s" mode))
transient-values)))
(setq args (cdr elt))
t))
(t
(setq args (get mode 'magit-log-default-arguments))))
(list args files)))
(setq use-buffer-args
(pcase-exhaustive use-buffer-args
('prefix magit-prefix-use-buffer-arguments)
('status magit-status-use-buffer-arguments)
('direct magit-direct-use-buffer-arguments)
('nil magit-direct-use-buffer-arguments)
((or 'always 'selected 'current 'never)
use-buffer-args)))
(cond-let
((and (memq use-buffer-args '(always selected current))
(eq major-mode mode))
(list magit-buffer-log-args
magit-buffer-log-files))
([_(memq use-buffer-args '(always selected))]
[buffer (magit-get-mode-buffer mode nil (eq use-buffer-args 'selected))]
(list (buffer-local-value 'magit-buffer-log-args buffer)
(buffer-local-value 'magit-buffer-log-files buffer)))
((plist-member (symbol-plist mode) 'magit-log-current-arguments)
(list (get mode 'magit-log-current-arguments) nil))
([elt (assq (intern (format "magit-log:%s" mode)) transient-values)]
(list (cdr elt) nil))
((list (get mode 'magit-log-default-arguments) nil))))
(defun magit-log--set-value (obj &optional save)
(pcase-let* ((obj (oref obj prototype))
(mode (or (oref obj major-mode) major-mode))
(key (intern (format "magit-log:%s" mode)))
(`(,args ,files) (magit--transient-args-and-files)))
(`(,args ,files) (transient-args (oref obj command))))
(put mode 'magit-log-current-arguments args)
(when save
(setf (alist-get key transient-values) args)
@@ -494,7 +513,7 @@ commits before and half after."
(eq major-mode 'magit-log-mode)
t))
;;;###autoload (autoload 'magit-log "magit-log" nil t)
;;;###autoload(autoload 'magit-log "magit-log" nil t)
(transient-define-prefix magit-log ()
"Show a commit or reference log."
:man-page "git-log"
@@ -516,14 +535,14 @@ commits before and half after."
("r" "current" magit-reflog-current)
("O" "other" magit-reflog-other)
("H" "HEAD" magit-reflog-head)]
[:if magit--any-wip-mode-enabled-p
[:if-mode magit-wip-mode
:description "Wiplog"
("i" "index" magit-wip-log-index)
("w" "worktree" magit-wip-log-worktree)]
["Other"
("s" "shortlog" magit-shortlog)]])
;;;###autoload (autoload 'magit-log-refresh "magit-log" nil t)
;;;###autoload(autoload 'magit-log-refresh "magit-log" nil t)
(transient-define-prefix magit-log-refresh ()
"Change the arguments used for the log(s) in the current buffer."
:man-page "git-log"
@@ -639,13 +658,13 @@ commits before and half after."
"SPC" #'self-insert-command)
(defun magit-log-read-revs (&optional use-current)
(or (and use-current (and-let* ((buf (magit-get-current-branch))) (list buf)))
(or (and use-current (and$ (magit-get-current-branch) (list $)))
(let ((crm-separator "\\(\\.\\.\\.?\\|[, ]\\)")
(crm-local-completion-map magit-log-read-revs-map))
(split-string (magit-completing-read-multiple
"Log rev,s: "
(magit-list-refnames nil t)
nil nil nil 'magit-revision-history
nil 'any nil 'magit-revision-history
(or (magit-branch-or-commit-at-point)
(and (not use-current)
(magit-get-previous-branch)))
@@ -656,7 +675,7 @@ commits before and half after."
"Read a string from the user to pass as parameter to OPTION."
(magit-read-string (format "Type a pattern to pass to %s" option)))
;;;###autoload (autoload 'magit-log-current "magit-log" nil t)
;;;###autoload(autoload 'magit-log-current "magit-log" nil t)
(transient-define-suffix magit-log-current (&optional args files)
"Show log for the current branch, or `HEAD' if no branch is checked out."
:description (##if (magit-get-current-branch) "current" "HEAD")
@@ -722,18 +741,18 @@ completion candidates."
;;;###autoload
(defun magit-log-matching-branches (pattern &optional args files)
"Show log for all branches matching PATTERN and `HEAD'."
(interactive (cons (magit-log-read-pattern "--branches") (magit-log-arguments)))
(magit-log-setup-buffer
(list "HEAD" (format "--branches=%s" pattern))
args files))
(interactive (cons (magit-log-read-pattern "--branches")
(magit-log-arguments)))
(magit-log-setup-buffer (list "HEAD" (format "--branches=%s" pattern))
args files))
;;;###autoload
(defun magit-log-matching-tags (pattern &optional args files)
"Show log for all tags matching PATTERN and `HEAD'."
(interactive (cons (magit-log-read-pattern "--tags") (magit-log-arguments)))
(magit-log-setup-buffer
(list "HEAD" (format "--tags=%s" pattern))
args files))
(interactive (cons (magit-log-read-pattern "--tags")
(magit-log-arguments)))
(magit-log-setup-buffer (list "HEAD" (format "--tags=%s" pattern))
args files))
;;;###autoload
(defun magit-log-all-branches (&optional args files)
@@ -748,10 +767,7 @@ completion candidates."
(defun magit-log-all (&optional args files)
"Show log for all references and `HEAD'."
(interactive (magit-log-arguments))
(magit-log-setup-buffer (if (magit-get-current-branch)
(list "--all")
(list "HEAD" "--all"))
args files))
(magit-log-setup-buffer (list "--all") args files))
;;;###autoload
(defun magit-log-buffer-file (&optional follow beg end)
@@ -865,6 +881,13 @@ https://github.com/mhagger/git-when-merged."
(user-error "Could not find when %s was merged into %s: %s"
commit branch m)))))
;;;###autoload
(defun magit-delete-shelved-branch (branch)
"Delete the shelved BRANCH.
Delete a ref created by `magit-branch-shelve'."
(interactive (list (magit-read-shelved-branch "Log shelved branch")))
(magit-run-git "update-ref" "-d" (concat "refs/shelved/" branch)))
;;;; Limit Commands
(defun magit-log-toggle-commit-limit ()
@@ -887,7 +910,7 @@ limit. Otherwise set it to 256."
(defun magit-log-set-commit-limit (fn)
(let* ((val magit-buffer-log-args)
(arg (seq-find (##string-match "^-n\\([0-9]+\\)?$" %) val))
(num (and arg (string-to-number (match-string 1 arg))))
(num (and arg (string-to-number (match-str 1 arg))))
(num (if num (funcall fn num 2) 256)))
(setq val (remove arg val))
(setq magit-buffer-log-args
@@ -897,9 +920,9 @@ limit. Otherwise set it to 256."
(magit-refresh))
(defun magit-log-get-commit-limit (&optional args)
(and-let* ((str (seq-find (##string-match "^-n\\([0-9]+\\)?$" %)
(or args magit-buffer-log-args))))
(string-to-number (match-string 1 str))))
(and$ (seq-find (##string-match "^-n\\([0-9]+\\)?$" %)
(or args magit-buffer-log-args))
(string-to-number (match-str 1 $))))
;;;; Mode Commands
@@ -909,15 +932,15 @@ Like `magit-mode-bury-buffer' (which see) but with a negative
prefix argument instead bury the revision buffer, provided it
is displayed in the current frame."
(interactive "p")
(if (< arg 0)
(let* ((buf (magit-get-mode-buffer 'magit-revision-mode))
(win (and buf (get-buffer-window buf (selected-frame)))))
(if win
(with-selected-window win
(with-current-buffer buf
(magit-mode-bury-buffer (> (abs arg) 1))))
(user-error "No revision buffer in this frame")))
(magit-mode-bury-buffer (> arg 1))))
(cond-let*
((>= arg 0)
(magit-mode-bury-buffer (> arg 1)))
([buf (magit-get-mode-buffer 'magit-revision-mode)]
[win (get-buffer-window buf (selected-frame))]
(with-selected-window win
(with-current-buffer buf
(magit-mode-bury-buffer (> (abs arg) 1)))))
((user-error "No revision buffer in this frame"))))
;;;###autoload
(defun magit-log-move-to-parent (&optional n)
@@ -947,27 +970,25 @@ nothing else.
If invoked outside any log buffer, then display the log buffer
of the current repository first; creating it if necessary."
(interactive
(list (or (magit-completing-read
"In log, jump to"
(magit-list-refnames nil t)
nil nil nil 'magit-revision-history
(or (and-let* ((rev (magit-commit-at-point)))
(magit-rev-fixup-target rev))
(magit-get-current-branch)))
(user-error "Nothing selected"))))
(list (magit-completing-read
"In log, jump to"
(magit-list-refnames nil t)
nil 'any nil 'magit-revision-history
(or (and$ (magit-commit-at-point)
(magit-rev-fixup-target $))
(magit-get-current-branch)))))
(with-current-buffer
(cond ((derived-mode-p 'magit-log-mode)
(current-buffer))
((and-let* ((buf (magit-get-mode-buffer 'magit-log-mode)))
(pop-to-buffer-same-window buf)))
(t
(apply #'magit-log-all-branches (magit-log-arguments))))
((and$ (magit-get-mode-buffer 'magit-log-mode)
(pop-to-buffer-same-window $)))
((apply #'magit-log-all-branches (magit-log-arguments))))
(unless (magit-log-goto-commit-section (magit-rev-abbrev commit))
(user-error "%s isn't visible in the current log buffer" commit))))
;;;; Shortlog Commands
;;;###autoload (autoload 'magit-shortlog "magit-log" nil t)
;;;###autoload(autoload 'magit-shortlog "magit-log" nil t)
(transient-define-prefix magit-shortlog ()
"Show a history summary."
:man-page "git-shortlog"
@@ -1203,6 +1224,19 @@ Type \\[magit-reset] to reset `HEAD' to the commit at point.
(declare (obsolete magit--insert-log "Magit 4.0.0"))
(magit--insert-log nil revs args files))
(defconst magit-log-heading-format
;; See `magit-log-heading-re'.
(concat "--format="
"%s" ; 4 graph --graph
"%%h%%x0c" ; 1 %h hash
"%s%%x0c" ; 3 %D refs --decorate
"%s%%x0c" ; 7 %G? gpg --show-signature
"%%aN%%x0c" ; 5 %aN author
"%s%%x0c" ; 6 %at date magit-log-margin-show-committer-date
"%s%%x0c" ; 12 %() trailers magit-log-trailer-labels
"%%s" ; 2 %s msg
"%s")) ; \n .. headers magit-log-revision-headers-format
(defun magit--insert-log (keep-error revs &optional args files)
"Insert a log section.
Do not add this to a hook variable."
@@ -1212,7 +1246,7 @@ Do not add this to a hook variable."
(remove "--literal-pathspecs" magit-git-global-arguments)))
(magit--git-wash (apply-partially #'magit-log-wash-log 'log) keep-error
"log"
(format "--format=%s%%h%%x0c%s%%x0c%s%%x0c%%aN%%x0c%s%%x0c%%s%s"
(format magit-log-heading-format
(if (and (member "--left-right" args)
(not (member "--graph" args)))
"%m "
@@ -1235,6 +1269,13 @@ Do not add this to a hook variable."
"")
("%G?"))))
(if magit-log-margin-show-committer-date "%ct" "%at")
(if magit-log-trailer-labels
(format "%%(trailers:%s%s)"
(if (not (equal (cdr magit-log-trailer-labels) ""))
(concat (cdr magit-log-trailer-labels) ",")
"")
"unfold=true,separator=,key_value_separator=")
"")
(if (member "++header" args)
(if (member "--graph" (setq args (remove "++header" args)))
(concat "\n" magit-log-revision-headers-format "\n")
@@ -1243,7 +1284,7 @@ Do not add this to a hook variable."
(progn
(when-let ((order (seq-find (##string-match "^\\+\\+order=\\(.+\\)$" %)
args)))
(setq args (cons (format "--%s-order" (match-string 1 order))
(setq args (cons (format "--%s-order" (match-str 1 order))
(remove order args))))
(when (member "--decorate" args)
(setq args (cons "--decorate=full" (remove "--decorate" args))))
@@ -1271,18 +1312,20 @@ Do not add this to a hook variable."
:parent magit-commit-section-map)
(defconst magit-log-heading-re
;; Note: A form feed instead of a null byte is used as the delimiter
;; because using the latter interferes with the graph prefix when
;; ++header is used.
;; Use a form feed instead of a null byte as the delimiter because using
;; the latter interferes with the graph prefix when ++header is used.
(concat "^"
"\\(?4:[-_/|\\*o<>. ]*\\)" ; graph
"\\(?1:[0-9a-fA-F]+\\)? " ; hash
"\\(?3:[^ \n]+\\)? " ; refs
"\\(?7:[BGUXYREN]\\)? " ; gpg
"\\(?5:[^ \n]*\\) " ; author
;; Note: Date is optional because, prior to Git v2.19.0,
;; `git rebase -i --root` corrupts the root's author date.
;; Prior to Git v2.19.0, "git rebase -i --root" corrupted the
;; root's author date. Keep date optional because even though
;; we no longer support such old releases, the roots they create
;; may live on.
"\\(?6:[^ \n]*\\) " ; date
"\\(?12:[^ \n]+\\)? " ; trailers
"\\(?2:.*\\)$")) ; msg
(defconst magit-log-cherry-re
@@ -1376,129 +1419,145 @@ Do not add this to a hook variable."
('stash magit-log-stash-re)
('bisect-vis magit-log-bisect-vis-re)
('bisect-log magit-log-bisect-log-re)))
(magit-bind-match-strings
(hash msg refs graph author date gpg cherry _ refsub side) nil
(setq msg (substring-no-properties msg))
(when refs
(setq refs (substring-no-properties refs)))
(let ((align (or (eq style 'cherry)
(not (member "--stat" magit-buffer-log-args))))
(non-graph-re (if (eq style 'bisect-vis)
magit-log-bisect-vis-re
magit-log-heading-re)))
(magit-delete-line)
;; If the reflog entries have been pruned, the output of `git
;; reflog show' includes a partial line that refers to the hash
;; of the youngest expired reflog entry.
(when (and (eq style 'reflog) (not date))
(cl-return-from magit-log-wash-rev t))
(magit-insert-section
((eval (pcase style
('stash 'stash)
('module 'module-commit)
(_ 'commit)))
hash)
(setq hash (propertize (if (eq style 'bisect-log)
(magit-rev-parse "--short" hash)
hash)
'font-lock-face
(pcase (and gpg (aref gpg 0))
(?G 'magit-signature-good)
(?B 'magit-signature-bad)
(?U 'magit-signature-untrusted)
(?X 'magit-signature-expired)
(?Y 'magit-signature-expired-key)
(?R 'magit-signature-revoked)
(?E 'magit-signature-error)
(?N 'magit-hash)
(_ 'magit-hash))))
(when cherry
(when (and (derived-mode-p 'magit-refs-mode)
magit-refs-show-commit-count)
(insert (make-string (1- magit-refs-focus-column-width) ?\s)))
(insert (propertize cherry 'font-lock-face
(if (string= cherry "-")
'magit-cherry-equivalent
'magit-cherry-unmatched)))
(insert ?\s))
(when side
(insert (propertize side 'font-lock-face
(if (string= side "<")
'magit-cherry-equivalent
'magit-cherry-unmatched)))
(insert ?\s))
(when align
(insert hash ?\s))
(when graph
(insert graph))
(unless align
(insert hash ?\s))
(when (and refs (not magit-log-show-refname-after-summary))
(insert (magit-format-ref-labels refs) ?\s))
(when (eq style 'reflog)
(insert (format "%-2s " (1- magit-log-count)))
(when refsub
(insert (magit-reflog-format-subject
(substring refsub 0
(if (string-search ":" refsub) -2 -1))))))
(insert (magit-log--wash-summary msg))
(when (and refs magit-log-show-refname-after-summary)
(insert ?\s)
(insert (magit-format-ref-labels refs)))
(insert ?\n)
(when (memq style '(log reflog stash))
(goto-char (line-beginning-position))
(when (and refsub
(string-match "\\`\\([^ ]\\) \\+\\(..\\)\\(..\\)" date))
(setq date (+ (string-to-number (match-string 1 date))
(* (string-to-number (match-string 2 date)) 60 60)
(* (string-to-number (match-string 3 date)) 60))))
(magit-log-format-margin hash author date))
(when (and (eq style 'cherry)
(magit-buffer-margin-p))
(apply #'magit-log-format-margin hash
(split-string (magit-rev-format "%aN%x00%ct" hash) "\0")))
(when (and graph
(not (eobp))
(not (looking-at non-graph-re)))
(when (looking-at "")
(let* ((hash (match-str 1))
(msg (match-str 2))
(refs (match-str 3))
(refs (and refs (magit-format-ref-labels refs)))
(graph (match-string 4))
(author (match-str 5))
(date (match-str 6))
(gpg (match-str 7))
(cherry (match-str 8))
(refsub (match-str 10))
(side (match-str 11))
(trailers (match-str 12))
(trailers (and trailers
(funcall (car magit-log-trailer-labels)
(mapcar (##split-string % "")
(split-string trailers "")))))
(align (or (eq style 'cherry)
(not (member "--stat" magit-buffer-log-args))))
(non-graph-re (if (eq style 'bisect-vis)
magit-log-bisect-vis-re
magit-log-heading-re)))
(magit-delete-line)
;; If the reflog entries have been pruned, the output of `git
;; reflog show' includes a partial line that refers to the hash
;; of the youngest expired reflog entry.
(when (and (eq style 'reflog) (not date))
(cl-return-from magit-log-wash-rev t))
(magit-insert-section
((eval (pcase style
('stash 'stash)
('module 'module-commit)
(_ 'commit)))
hash)
(setq hash (propertize (if (eq style 'bisect-log)
(magit-rev-parse "--short" hash)
hash)
'font-lock-face
(pcase (and gpg (aref gpg 0))
(?G 'magit-signature-good)
(?B 'magit-signature-bad)
(?U 'magit-signature-untrusted)
(?X 'magit-signature-expired)
(?Y 'magit-signature-expired-key)
(?R 'magit-signature-revoked)
(?E 'magit-signature-error)
(?N 'magit-hash)
(_ 'magit-hash))))
(when cherry
(when (and (derived-mode-p 'magit-refs-mode)
magit-refs-show-commit-count)
(insert (make-string (1- magit-refs-focus-column-width) ?\s)))
(insert (propertize cherry 'font-lock-face
(if (string= cherry "-")
'magit-cherry-equivalent
'magit-cherry-unmatched)))
(insert ?\s))
(when side
(insert (propertize side 'font-lock-face
(if (string= side "<")
'magit-cherry-equivalent
'magit-cherry-unmatched)))
(insert ?\s))
(when align
(insert hash ?\s))
(when graph
(insert graph))
(unless align
(insert hash ?\s))
(unless magit-log-show-refname-after-summary
(when refs
(insert refs ?\s))
(when trailers
(insert trailers ?\s)))
(when (eq style 'reflog)
(insert (format "%-2s " (1- magit-log-count)))
(when refsub
(insert (magit-reflog-format-subject
(substring refsub 0
(if (string-search ":" refsub) -2 -1))))))
(insert (magit-log--wash-summary msg))
(when magit-log-show-refname-after-summary
(when refs
(insert ?\s refs))
(when trailers
(insert ?\s trailers)))
(insert ?\n)
(when (memq style '(log reflog stash))
(goto-char (line-beginning-position))
(when (and refsub
(string-match "\\`\\([^ ]\\) \\+\\(..\\)\\(..\\)" date))
(setq date (+ (string-to-number (match-str 1 date))
(* (string-to-number (match-str 2 date)) 60 60)
(* (string-to-number (match-str 3 date)) 60))))
(magit-log-format-margin hash author date))
(when (and (eq style 'cherry)
(magit--right-margin-active))
(apply #'magit-log-format-margin hash
(split-string (magit-rev-format "%aN%x00%ct" hash) "\0")))
(when (and graph
(not (eobp))
(not (looking-at non-graph-re)))
(when (looking-at "")
(magit-insert-heading)
(delete-char 1)
(magit-insert-section (commit-header)
(forward-line)
(magit-insert-heading)
(delete-char 1)
(magit-insert-section (commit-header)
(forward-line)
(magit-insert-heading)
(re-search-forward "")
(delete-char -1)
(forward-char)
(insert ?\n))
(delete-char 1))
(if (looking-at "^\\(---\\|\n\s\\|\ndiff\\)")
(let ((limit (save-excursion
(and (re-search-forward non-graph-re nil t)
(match-beginning 0)))))
(unless (oref magit-insert-section--current content)
(magit-insert-heading))
(delete-char (if (looking-at "\n") 1 4))
(magit-diff-wash-diffs (list "--stat") limit))
(re-search-forward "")
(delete-char -1)
(forward-char)
(insert ?\n))
(delete-char 1))
(if (looking-at "^\\(---\\|\n\s\\|\ndiff\\)")
(let ((limit (save-excursion
(and (re-search-forward non-graph-re nil t)
(match-beginning 0)))))
(unless (oref magit-insert-section--current content)
(magit-insert-heading))
(delete-char (if (looking-at "\n") 1 4))
(magit-diff-wash-diffs (list "--stat") limit))
(when align
(setq align (make-string (1+ abbrev) ? )))
(when (and (not (eobp)) (not (looking-at non-graph-re)))
(when align
(setq align (make-string (1+ abbrev) ? )))
(when (and (not (eobp)) (not (looking-at non-graph-re)))
(while (and (not (eobp)) (not (looking-at non-graph-re)))
(when align
(setq align (make-string (1+ abbrev) ? )))
(while (and (not (eobp)) (not (looking-at non-graph-re)))
(when align
(save-excursion (insert align)))
(forward-line)
(magit-make-margin-overlay))
;; When `--format' is used and its value isn't one of the
;; predefined formats, then `git-log' does not insert a
;; separator line.
(save-excursion
(forward-line -1)
(looking-at "[-_/|\\*o<>. ]*"))
(setq graph (match-string 0))
(unless (string-match-p "[/\\.]" graph)
(insert graph ?\n))))))))
(save-excursion (insert align)))
(forward-line)
(magit-make-margin-overlay))
;; When `--format' is used and its value isn't one of the
;; predefined formats, then `git-log' does not insert a
;; separator line.
(save-excursion
(forward-line -1)
(looking-at "[-_/|\\*o<>. ]*"))
(setq graph (match-string 0))
(unless (string-match-p "[/\\.]" graph)
(insert graph ?\n)))))))
t)
(defun magit-log--wash-summary (summary)
@@ -1582,9 +1641,9 @@ See also info node `(magit)Section Movement'."
(with-selected-window (get-buffer-window buf)
(with-current-buffer buf
(save-excursion
(magit-blob-visit (list (magit-rev-parse rev)
(magit-file-relative-name
magit-buffer-file-name)))))))))))))
(magit-blob-visit (magit-rev-parse rev)
(magit-file-relative-name
magit-buffer-file-name))))))))))))
(defun magit-log-goto-commit-section (rev)
(let ((abbrev (magit-rev-format "%h" rev)))
@@ -1611,18 +1670,18 @@ The shortstat style is experimental and rather slow."
(interactive)
(setq magit-log-margin-show-shortstat
(not magit-log-margin-show-shortstat))
(magit-set-buffer-margin nil t))
(magit-set-buffer-margins nil t))
(defun magit-log-format-margin (rev author date)
(when (magit-margin-option)
(when (magit--right-margin-option)
(if magit-log-margin-show-shortstat
(magit-log-format-shortstat-margin rev)
(magit-log-format-author-margin author date))))
(defun magit-log-format-author-margin (author date)
(pcase-let ((`(,_ ,style ,width ,details ,details-width)
(or magit-buffer-margin
(symbol-value (magit-margin-option))
(or magit--right-margin-config
(symbol-value (magit--right-margin-option))
(error "No margin format specified for %s" major-mode))))
(magit-make-margin-overlay
(concat (and details
@@ -1745,15 +1804,14 @@ Type \\[magit-log-select-quit] to abort without selecting a commit."
(magit-log-select-setup-buffer
(or branch (magit-get-current-branch) "HEAD")
(append args
(car (magit-log--get-value 'magit-log-select-mode
magit-direct-use-buffer-arguments))))
(car (magit-log--get-value 'magit-log-select-mode 'direct))))
(if initial
(magit-log-goto-commit-section initial)
(while-let ((rev (magit-section-value-if 'commit))
((string-match-p "\\`\\(squash!\\|fixup!\\|amend!\\)"
(magit-rev-format "%s" rev)))
(section (magit-current-section))
(next (car (magit-section-siblings section 'next))))
(while-let* ((rev (magit-section-value-if 'commit))
(_(string-match-p "\\`\\(squash!\\|fixup!\\|amend!\\)"
(magit-rev-format "%s" rev)))
(section (magit-current-section))
(next (car (magit-section-siblings section 'next))))
(magit-section-goto next)))
(setq magit-log-select-pick-function pick)
(setq magit-log-select-quit-function quit)
@@ -1911,7 +1969,7 @@ need an unique value, so we use that string in the pushremote case."
"Insert commits that haven't been pulled from the push-remote yet."
(when-let* ((target (magit-get-push-branch))
(range (concat ".." target))
((magit--insert-pushremote-log-p)))
(_(magit--insert-pushremote-log-p)))
(magit-insert-section (unpulled range t)
(magit-insert-heading
(format (propertize "Unpulled from %s."
@@ -1991,7 +2049,7 @@ Show the last `magit-log-section-commit-count' commits."
"Insert commits that haven't been pushed to the push-remote yet."
(when-let* ((target (magit-get-push-branch))
(range (concat target ".."))
((magit--insert-pushremote-log-p)))
(_(magit--insert-pushremote-log-p)))
(magit-insert-section (unpushed range t)
(magit-insert-heading
(format (propertize "Unpushed to %s."
@@ -2050,4 +2108,15 @@ all others with \"-\"."
;;; _
(provide 'magit-log)
;; Local Variables:
;; read-symbol-shorthands: (
;; ("and$" . "cond-let--and$")
;; ("and>" . "cond-let--and>")
;; ("and-let" . "cond-let--and-let")
;; ("if-let" . "cond-let--if-let")
;; ("when-let" . "cond-let--when-let")
;; ("while-let" . "cond-let--while-let")
;; ("match-string" . "match-string")
;; ("match-str" . "match-string-no-properties"))
;; End:
;;; magit-log.el ends here
lisp/magit/magit-margin.el
+94 -76
View File
@@ -49,17 +49,32 @@ does not carry to other options."
:link '(info-link "(magit)Log Margin")
:group 'magit-log)
(defvar-local magit-buffer-margin nil)
(put 'magit-buffer-margin 'permanent-local t)
;;; Settings
(defvar-local magit-set-buffer-margin-refresh nil)
(defvar-local magit--right-margin-delayed nil)
(defvar magit--age-spec)
(defvar-local magit--right-margin-config nil)
(put 'magit--right-margin-config 'permanent-local t)
(defun magit--right-margin-active ()
(car magit--right-margin-config))
(defun magit--right-margin-option ()
(pcase major-mode
('magit-cherry-mode 'magit-cherry-margin)
('magit-log-mode 'magit-log-margin)
('magit-log-select-mode 'magit-log-select-margin)
('magit-reflog-mode 'magit-reflog-margin)
('magit-refs-mode 'magit-refs-margin)
('magit-stashes-mode 'magit-stashes-margin)
('magit-status-mode 'magit-status-margin)
('forge-notifications-mode 'magit-status-margin)
('forge-topics-mode 'magit-status-margin)))
;;; Commands
(transient-define-prefix magit-margin-settings ()
"Change what information is displayed in the margin."
"Change what information is displayed in the right margin."
:info-manual "(magit) Log Margin"
["Margin"
(magit-toggle-margin)
@@ -68,96 +83,89 @@ does not carry to other options."
(magit-refs-set-show-commit-count)])
(transient-define-suffix magit-toggle-margin ()
"Show or hide the Magit margin."
"Show or hide the right margin."
:description "Toggle visibility"
:key "L"
:transient t
(interactive)
(unless (magit-margin-option)
(unless (magit--right-margin-option)
(user-error "Magit margin isn't supported in this buffer"))
(setcar magit-buffer-margin (not (magit-buffer-margin-p)))
(magit-set-buffer-margin))
(setcar magit--right-margin-config (not (magit--right-margin-active)))
(magit-set-buffer-margins))
(defvar magit-margin-default-time-format nil
"See https://github.com/magit/magit/pull/4605.")
(transient-define-suffix magit-cycle-margin-style ()
"Cycle style used for the Magit margin."
"Cycle style used for the right margin."
:description "Cycle style"
:key "l"
:transient t
(interactive)
(unless (magit-margin-option)
(unless (magit--right-margin-option)
(user-error "Magit margin isn't supported in this buffer"))
;; This is only suitable for commit margins (there are not others).
(setf (cadr magit-buffer-margin)
(pcase (cadr magit-buffer-margin)
(setf (cadr magit--right-margin-config)
(pcase (cadr magit--right-margin-config)
('age 'age-abbreviated)
('age-abbreviated
(let ((default (or magit-margin-default-time-format
(cadr (symbol-value (magit-margin-option))))))
(cadr (symbol-value (magit--right-margin-option))))))
(if (stringp default) default "%Y-%m-%d %H:%M ")))
(_ 'age)))
(magit-set-buffer-margin nil t))
(magit-set-buffer-margins nil t))
(transient-define-suffix magit-toggle-margin-details ()
"Show or hide details in the Magit margin."
"Show or hide details in the right margin."
:description "Toggle details"
:key "d"
:transient t
(interactive)
(unless (magit-margin-option)
(unless (magit--right-margin-option)
(user-error "Magit margin isn't supported in this buffer"))
(setf (nth 3 magit-buffer-margin)
(not (nth 3 magit-buffer-margin)))
(magit-set-buffer-margin nil t))
(setf (nth 3 magit--right-margin-config)
(not (nth 3 magit--right-margin-config)))
(magit-set-buffer-margins nil t))
;;; Core
(defun magit-buffer-margin-p ()
(car magit-buffer-margin))
(defun magit-set-buffer-margins (&optional reset-right refresh-right)
(let ((lmargin nil)
(rmargin nil)
(roption (magit--right-margin-option)))
(when (or lmargin roption)
(when roption
(let* ((default (symbol-value roption))
(default-width (nth 2 default)))
(when (or reset-right (not magit--right-margin-config))
(setq magit--right-margin-config (copy-sequence default)))
(pcase-let ((`(,enable ,style ,_width ,details ,details-width)
magit--right-margin-config))
(setq rmargin enable)
(when (functionp default-width)
(setf (nth 2 magit--right-margin-config)
(funcall default-width style details details-width))))))
(dolist (window (get-buffer-window-list nil nil 0))
(with-selected-window window
(magit-set-window-margins window)
(if (or lmargin rmargin)
(add-hook 'window-configuration-change-hook
#'magit-set-window-margins nil t)
(remove-hook 'window-configuration-change-hook
#'magit-set-window-margins t))))
(when (and rmargin (or refresh-right magit--right-margin-delayed))
(magit-refresh-buffer)))))
(defun magit-margin-option ()
(pcase major-mode
('magit-cherry-mode 'magit-cherry-margin)
('magit-log-mode 'magit-log-margin)
('magit-log-select-mode 'magit-log-select-margin)
('magit-reflog-mode 'magit-reflog-margin)
('magit-refs-mode 'magit-refs-margin)
('magit-stashes-mode 'magit-stashes-margin)
('magit-status-mode 'magit-status-margin)
('forge-notifications-mode 'magit-status-margin)
('forge-topics-mode 'magit-status-margin)))
(defun magit-set-buffer-margin (&optional reset refresh)
(when-let ((option (magit-margin-option)))
(let* ((default (symbol-value option))
(default-width (nth 2 default)))
(when (or reset (not magit-buffer-margin))
(setq magit-buffer-margin (copy-sequence default)))
(pcase-let ((`(,enable ,style ,_width ,details ,details-width)
magit-buffer-margin))
(when (functionp default-width)
(setf (nth 2 magit-buffer-margin)
(funcall default-width style details details-width)))
(dolist (window (get-buffer-window-list nil nil 0))
(with-selected-window window
(magit-set-window-margin window)
(if enable
(add-hook 'window-configuration-change-hook
#'magit-set-window-margin nil t)
(remove-hook 'window-configuration-change-hook
#'magit-set-window-margin t))))
(when (and enable (or refresh magit-set-buffer-margin-refresh))
(magit-refresh-buffer))))))
(defun magit-set-window-margin (&optional window)
(defun magit-set-window-margins (&optional window)
(when (or window (setq window (get-buffer-window)))
(with-selected-window window
(set-window-margins
nil (car (window-margins))
(and (magit-buffer-margin-p)
(nth 2 magit-buffer-margin))))))
nil
(if (characterp (car (magit-section-visibility-indicator)))
1
(car (window-margins)))
(and (magit--right-margin-active)
(nth 2 magit--right-margin-config))))))
(cl-defun magit-make-margin-overlay (&optional string (previous-line nil sline))
"Display STRING in the margin of the previous (or current) line.
@@ -180,7 +188,7 @@ line is affected."
[remote branchbuf]
[shelved branchbuf]
[tags branchbuf]
topics issues pullreqs))
topics discussions issues pullreqs))
(defun magit-maybe-make-margin-overlay ()
(when (magit-section-match magit-margin-overlay-conditions
@@ -195,7 +203,7 @@ line is affected."
(dolist (buffer (buffer-list))
(with-current-buffer buffer
(when (eq major-mode mode)
(magit-set-buffer-margin t)
(magit-set-buffer-margins t)
(magit-refresh))))
(message "Updating margins in %s buffers...done" mode))
@@ -233,21 +241,31 @@ as an option, because most other parts of Magit are always in
English.")
(defun magit--age (date &optional abbreviate)
(cl-labels ((fn (age spec)
(pcase-let ((`(,char ,unit ,units ,weight) (car spec)))
(let ((cnt (round (/ age weight 1.0))))
(if (or (not (cdr spec))
(>= (/ age weight) 1))
(list cnt (cond (abbreviate char)
((= cnt 1) unit)
(t units)))
(fn age (cdr spec)))))))
(fn (abs (- (float-time)
(if (stringp date)
(string-to-number date)
date)))
magit--age-spec)))
(named-let calc ((age (abs (- (float-time)
(if (stringp date)
(string-to-number date)
date))))
(spec magit--age-spec))
(pcase-let* ((`((,char ,unit ,units ,weight) . ,spec) spec)
(cnt (round (/ age weight 1.0))))
(if (or (not spec)
(>= (/ age weight) 1))
(list cnt (cond (abbreviate char)
((= cnt 1) unit)
(units)))
(calc age spec)))))
;;; _
(provide 'magit-margin)
;; Local Variables:
;; read-symbol-shorthands: (
;; ("and$" . "cond-let--and$")
;; ("and>" . "cond-let--and>")
;; ("and-let" . "cond-let--and-let")
;; ("if-let" . "cond-let--if-let")
;; ("when-let" . "cond-let--when-let")
;; ("while-let" . "cond-let--while-let")
;; ("match-string" . "match-string")
;; ("match-str" . "match-string-no-properties"))
;; End:
;;; magit-margin.el ends here
lisp/magit/magit-merge.el
+29 -19
View File
@@ -33,7 +33,7 @@
;;; Commands
;;;###autoload (autoload 'magit-merge "magit" nil t)
;;;###autoload(autoload 'magit-merge "magit" nil t)
(transient-define-prefix magit-merge ()
"Merge branches."
:man-page "git-merge"
@@ -172,21 +172,21 @@ then also remove the respective remote branch."
(format "Do you really want to merge `%s' into another branch? "
branch))
(user-error "Abort")))
(if-let ((target (magit-get-push-branch branch t)))
(progn
(magit-git-push branch target (list "--force-with-lease"))
(set-process-sentinel
magit-this-process
(lambda (process event)
(when (memq (process-status process) '(exit signal))
(if (not (zerop (process-exit-status process)))
(magit-process-sentinel process event)
(process-put process 'inhibit-refresh t)
(magit-process-sentinel process event)
(magit--merge-absorb-1 branch args))
(when message
(message message))))))
(magit--merge-absorb-1 branch args)))
(cond-let
([target (magit-get-push-branch branch t)]
(magit-git-push branch target (list "--force-with-lease"))
(set-process-sentinel
magit-this-process
(lambda (process event)
(when (memq (process-status process) '(exit signal))
(if (not (zerop (process-exit-status process)))
(magit-process-sentinel process event)
(process-put process 'inhibit-refresh t)
(magit-process-sentinel process event)
(magit--merge-absorb-1 branch args))
(when message
(message message))))))
((magit--merge-absorb-1 branch args))))
(defun magit--merge-absorb-1 (branch args)
(if-let ((pr (magit-get "branch" branch "pullRequest")))
@@ -241,15 +241,14 @@ then also remove the respective remote branch."
"During a conflict checkout and stage side, or restore conflict."
(interactive
(let ((file (magit-completing-read "Checkout file"
(magit-tracked-files) nil nil nil
(magit-tracked-files) nil 'any nil
'magit-read-file-hist
(magit-current-file))))
(cond ((member file (magit-unmerged-files))
(list file (magit-checkout-read-stage file)))
((yes-or-no-p (format "Restore conflicts in %s? " file))
(list file "--merge"))
(t
(user-error "Quit")))))
((user-error "Quit")))))
(pcase (cons arg (cddr (car (magit-file-status file))))
((or `("--ours" ?D ,_)
'("--ours" ?U ?A)
@@ -312,4 +311,15 @@ If no merge is in progress, do nothing."
;;; _
(provide 'magit-merge)
;; Local Variables:
;; read-symbol-shorthands: (
;; ("and$" . "cond-let--and$")
;; ("and>" . "cond-let--and>")
;; ("and-let" . "cond-let--and-let")
;; ("if-let" . "cond-let--if-let")
;; ("when-let" . "cond-let--when-let")
;; ("while-let" . "cond-let--while-let")
;; ("match-string" . "match-string")
;; ("match-str" . "match-string-no-properties"))
;; End:
;;; magit-merge.el ends here
lisp/magit/magit-mode.el
+206 -155
View File
@@ -47,24 +47,22 @@
(declare-function elp-restore-all "elp" ())
(defvar magit--wip-inhibit-autosave)
(defvar magit-wip-after-save-local-mode)
(defvar magit-wip-mode)
(declare-function magit-wip-get-ref "magit-wip" ())
(declare-function magit-wip-commit-worktree "magit-wip" (ref files msg))
;;; Options
(defcustom magit-mode-hook
(list #'magit-load-config-extensions)
(defcustom magit-mode-hook nil
"Hook run when entering a mode derived from Magit mode."
:package-version '(magit . "3.0.0")
:package-version '(magit . "4.4.2")
:group 'magit-modes
:type 'hook
:options (list #'magit-load-config-extensions
#'bug-reference-mode))
:options (list #'bug-reference-mode))
(defcustom magit-setup-buffer-hook
(list #'magit-maybe-save-repository-buffers
'magit-set-buffer-margin) ; from magit-margin.el
'magit-set-buffer-margins) ; from magit-margin.el
"Hook run by `magit-setup-buffer'.
This is run right after displaying the buffer and right before
@@ -76,7 +74,7 @@ should be used instead of this one."
:group 'magit-modes
:type 'hook
:options (list #'magit-maybe-save-repository-buffers
'magit-set-buffer-margin))
'magit-set-buffer-margins))
(defcustom magit-pre-refresh-hook
(list #'magit-maybe-save-repository-buffers)
@@ -95,6 +93,7 @@ inside your function."
(defcustom magit-post-refresh-hook
;; Do not function-quote to avoid circular dependencies.
;; Functions added here have to be autoloaded.
'(magit-auto-revert-buffers
magit-run-post-commit-hook
magit-run-post-stage-hook
@@ -425,6 +424,7 @@ recommended value."
"C-c C-w" 'magit-copy-thing
"C-w" 'magit-copy-section-value
"M-w" 'magit-copy-buffer-revision
"<remap> <mouse-set-point>" 'magit-mouse-set-point
"<remap> <back-to-indentation>" 'magit-back-to-indentation
"<remap> <previous-line>" 'magit-previous-line
"<remap> <next-line>" 'magit-next-line
@@ -435,52 +435,52 @@ recommended value."
"This is a placeholder command, which signals an error if called.
Where applicable, other keymaps remap this command to another,
which actually deletes the thing at point."
(declare (completion ignore))
(interactive)
(user-error "There is no thing at point that could be deleted"))
;; Starting with Emacs 28.1 we could use (declare (completion ignore)).
(put 'magit-delete-thing 'completion-predicate #'ignore)
(defun magit-visit-thing ()
"This is a placeholder command, which may signal an error if called.
Where applicable, other keymaps remap this command to another,
which actually visits the thing at point."
(declare (completion ignore))
(interactive)
(if (eq transient-current-command 'magit-dispatch)
(call-interactively (key-binding (this-command-keys)))
(if-let ((url (thing-at-point 'url t)))
(browse-url url)
(user-error "There is no thing at point that could be visited"))))
(put 'magit-visit-thing 'completion-predicate #'ignore)
(cond-let
((eq transient-current-command 'magit-dispatch)
(call-interactively (key-binding (this-command-keys))))
([url (thing-at-point 'url t)]
(browse-url url))
((user-error "There is no thing at point that could be visited"))))
(defun magit-edit-thing ()
"This is a placeholder command, which may signal an error if called.
Where applicable, other keymaps remap this command to another,
which actually lets you edit the thing at point, likely in another
buffer."
(declare (completion ignore))
(interactive)
(if (eq transient-current-command 'magit-dispatch)
(call-interactively (key-binding (this-command-keys)))
(user-error "There is no thing at point that could be edited")))
(put 'magit-edit-thing 'completion-predicate #'ignore)
(defun magit-browse-thing ()
"This is a placeholder command, which may signal an error if called.
Where applicable, other keymaps remap this command to another,
which actually visits thing at point using `browse-url'."
(declare (completion ignore))
(interactive)
(if-let ((url (thing-at-point 'url t)))
(browse-url url)
(user-error "There is no thing at point that could be browsed")))
(put 'magit-browse-thing 'completion-predicate #'ignore)
(defun magit-copy-thing ()
"This is a placeholder command, which signals an error if called.
Where applicable, other keymaps remap this command to another,
which actually copies some representation of the thing at point
to the kill ring."
(declare (completion ignore))
(interactive)
(user-error "There is no thing at point that we know how to copy"))
(put 'magit-copy-thing 'completion-predicate #'ignore)
;;;###autoload
(defun magit-info ()
@@ -554,13 +554,6 @@ to the kill ring."
;;; Mode
(defun magit-load-config-extensions ()
"Load Magit extensions that are defined at the Git config layer."
(dolist (ext (magit-get-all "magit.extension"))
(let ((sym (intern (format "magit-%s-mode" ext))))
(when (fboundp sym)
(funcall sym 1)))))
(define-derived-mode magit-mode magit-section-mode "Magit"
"Parent major mode from which Magit major modes inherit.
@@ -615,6 +608,21 @@ Magit is documented in info node `(magit)'."
;; function does not reinstate this.
(put 'magit-buffer-diff-files-suspended 'permanent-local t)
(defun magit-buffer-file-name ()
"Return `magit-buffer-file-name' or if that is nil `buffer-file-name'.
In an indirect buffer get the value for its base buffer."
(or magit-buffer-file-name
(buffer-file-name (buffer-base-buffer))))
(defun magit-buffer-revision ()
"Return `magit-buffer-revision' or if that is nil \"{worktree}\".
If not visiting a blob or file, or the file isn't being tracked,
return nil."
(or magit-buffer-revision
(and buffer-file-name
(magit-file-tracked-p buffer-file-name)
"{worktree}")))
(cl-defgeneric magit-buffer-value ()
"Return the value of the current buffer.
The \"value\" identifies what is being displayed in the buffer.
@@ -626,24 +634,35 @@ The buffer's major-mode should derive from `magit-section-mode'."
;;; Setup Buffer
(defmacro magit-setup-buffer (mode &optional locked &rest bindings)
(declare (indent 2))
`(magit-setup-buffer-internal
,mode ,locked
,(cons 'list (mapcar (pcase-lambda (`(,var ,form))
`(list ',var ,form))
bindings))))
(defmacro magit-setup-buffer (mode &optional locked &rest args)
"\n\n(fn MODE &optional LOCKED &key BUFFER DIRECTORY \
INITIAL-SECTION SELECT-SECTION &rest BINDINGS)"
(declare (indent 2)
(debug (form [&optional locked]
[&rest keywordp form]
[&rest (symbolp form)])))
(let (kwargs)
(while (keywordp (car args))
(push (pop args) kwargs)
(push (pop args) kwargs))
`(magit-setup-buffer-internal
,mode ,locked
,(cons 'list (mapcar (pcase-lambda (`(,var ,form))
`(list ',var ,form))
args))
,@(nreverse kwargs))))
(defun magit-setup-buffer-internal ( mode locked bindings
&optional buffer-or-name directory)
(cl-defun magit-setup-buffer-internal
( mode locked bindings
&key buffer directory initial-section select-section)
(let* ((value (and locked
(with-temp-buffer
(pcase-dolist (`(,var ,val) bindings)
(set (make-local-variable var) val))
(let ((major-mode mode))
(magit-buffer-value)))))
(buffer (if buffer-or-name
(get-buffer-create buffer-or-name)
(buffer (if buffer
(get-buffer-create buffer)
(magit-get-mode-buffer mode value)))
(section (and buffer (magit-current-section)))
(created (not buffer)))
@@ -662,7 +681,9 @@ The buffer's major-mode should derive from `magit-section-mode'."
(magit-display-buffer buffer)
(with-current-buffer buffer
(run-hooks 'magit-setup-buffer-hook)
(magit-refresh-buffer created)
(magit-refresh-buffer created
:initial-section initial-section
:select-section select-section)
(when created
(run-hooks 'magit-post-create-buffer-hook)))
buffer))
@@ -689,8 +710,8 @@ and `magit-post-display-buffer-hook'."
(let ((window (funcall (or display-function magit-display-buffer-function)
buffer)))
(unless magit-display-buffer-noselect
(let* ((old-frame (selected-frame))
(new-frame (window-frame window)))
(let ((old-frame (selected-frame))
(new-frame (window-frame window)))
(select-window window)
(unless (eq old-frame new-frame)
(select-frame-set-input-focus new-frame)))))
@@ -777,8 +798,7 @@ split is made vertically or horizontally is determined by
((with-current-buffer buffer
(derived-mode-p 'magit-diff-mode 'magit-process-mode))
'(magit--display-buffer-topleft))
(t
'(display-buffer-same-window)))))
('(display-buffer-same-window)))))
(defun magit--display-buffer-fullcolumn (buffer alist)
(when-let ((window (or (display-buffer-reuse-window buffer alist)
@@ -809,8 +829,7 @@ the mode of the current buffer derives from `magit-log-mode' or
((with-current-buffer buffer
(derived-mode-p 'magit-process-mode))
nil)
(t
'(magit--display-buffer-fullcolumn)))))
('(magit--display-buffer-fullcolumn)))))
(defun magit-maybe-set-dedicated ()
"Mark the selected window as dedicated if appropriate.
@@ -944,32 +963,33 @@ and another unlocked buffer already exists for that mode and
repository, then the former buffer is instead deleted and the
latter is displayed in its place."
(interactive)
(if magit-buffer-locked-p
(if-let ((unlocked (magit-get-mode-buffer major-mode)))
(let ((locked (current-buffer)))
(switch-to-buffer unlocked nil t)
(kill-buffer locked))
(setq magit-buffer-locked-p nil)
(let ((name (funcall magit-generate-buffer-name-function major-mode))
(buffer (current-buffer))
(mode major-mode))
(rename-buffer (generate-new-buffer-name name))
(with-temp-buffer
(magit--maybe-uniquify-buffer-names buffer name mode))))
(if-let ((value (magit-buffer-value)))
(if-let ((locked (magit-get-mode-buffer major-mode value)))
(let ((unlocked (current-buffer)))
(switch-to-buffer locked nil t)
(kill-buffer unlocked))
(setq magit-buffer-locked-p t)
(let ((name (funcall magit-generate-buffer-name-function
major-mode value))
(buffer (current-buffer))
(mode major-mode))
(rename-buffer (generate-new-buffer-name name))
(with-temp-buffer
(magit--maybe-uniquify-buffer-names buffer name mode))))
(user-error "Buffer has no value it could be locked to"))))
(cond-let
(magit-buffer-locked-p
(if-let ((unlocked (magit-get-mode-buffer major-mode)))
(let ((locked (current-buffer)))
(switch-to-buffer unlocked nil t)
(kill-buffer locked))
(setq magit-buffer-locked-p nil)
(let ((name (funcall magit-generate-buffer-name-function major-mode))
(buffer (current-buffer))
(mode major-mode))
(rename-buffer (generate-new-buffer-name name))
(with-temp-buffer
(magit--maybe-uniquify-buffer-names buffer name mode)))))
([value (magit-buffer-value)]
(if-let ((locked (magit-get-mode-buffer major-mode value)))
(let ((unlocked (current-buffer)))
(switch-to-buffer locked nil t)
(kill-buffer unlocked))
(setq magit-buffer-locked-p t)
(let ((name (funcall magit-generate-buffer-name-function
major-mode value))
(buffer (current-buffer))
(mode major-mode))
(rename-buffer (generate-new-buffer-name name))
(with-temp-buffer
(magit--maybe-uniquify-buffer-names buffer name mode)))))
((user-error "Buffer has no value it could be locked to"))))
;;; Bury Buffer
@@ -1065,10 +1085,10 @@ Run hooks `magit-pre-refresh-hook' and `magit-post-refresh-hook'."
(defvar-local magit--refresh-start-time nil)
(defvar magit--initial-section-hook nil)
(defun magit-refresh-buffer (&optional created)
"Refresh the current Magit buffer."
(cl-defun magit-refresh-buffer ( &optional created
&key initial-section select-section)
"Refresh the current Magit buffer.
The arguments are for internal use."
(interactive)
(when-let ((refresh (magit--refresh-buffer-function)))
(let ((magit--refreshing-buffer-p t)
@@ -1080,8 +1100,8 @@ Run hooks `magit-pre-refresh-hook' and `magit-post-refresh-hook'."
(cond
(created
(funcall refresh)
(run-hooks 'magit--initial-section-hook)
(setq-local magit--initial-section-hook nil))
(cond (initial-section (funcall initial-section))
(select-section (funcall select-section))))
(t
(deactivate-mark)
(setq magit-section-pre-command-section nil)
@@ -1091,7 +1111,8 @@ Run hooks `magit-pre-refresh-hook' and `magit-post-refresh-hook'."
(setq magit-section-focused-sections nil)
(let ((positions (magit--refresh-buffer-get-positions)))
(funcall refresh)
(magit--refresh-buffer-set-positions positions))))
(cond (select-section (funcall select-section))
((magit--refresh-buffer-set-positions positions))))))
(let ((magit-section-cache-visibility nil))
(magit-section-show magit-root-section))
(run-hooks 'magit-refresh-buffer-hook)
@@ -1117,17 +1138,20 @@ Run hooks `magit-pre-refresh-hook' and `magit-post-refresh-hook'."
(lambda (window)
(with-selected-window window
(with-current-buffer buffer
(and-let* ((section (magit-section-at)))
(and-let ((section (magit-section-at)))
`((,window
,section
,@(magit-section-get-relative-position section)
,@(and-let* ((ws (magit-section-at (window-start))))
,@(and-let ((ws (magit-section-at (window-start))))
(list ws
(car (magit-section-get-relative-position ws))
(window-start)))))))))
(get-buffer-window-list buffer nil t)))
(and-let* ((section (magit-section-at)))
`((nil ,section ,@(magit-section-get-relative-position section))))))
;; For hunks we run `magit-section-movement-hook' (once for
;; each window displaying the buffer). The selected window
;; comes first in this list, but we want to process it last.
(nreverse (get-buffer-window-list buffer nil t))))
(and$ (magit-section-at)
`((nil ,$ ,@(magit-section-get-relative-position $))))))
(defun magit--refresh-buffer-set-positions (positions)
(pcase-dolist
@@ -1136,18 +1160,26 @@ Run hooks `magit-pre-refresh-hook' and `magit-post-refresh-hook'."
(if window
(with-selected-window window
(magit-section-goto-successor section line char)
(cond
((or (not window-start)
(> window-start (point))))
((magit-section-equal ws-section (magit-section-at window-start))
(set-window-start window window-start t))
((not (derived-mode-p 'magit-log-mode))
(when-let ((pos (save-excursion
(and (magit-section-goto-successor--same
ws-section ws-line 0)
(point)))))
(set-window-start window pos t)))))
(magit-section-goto-successor section line char))))
(cond-let
((derived-mode-p 'magit-log-mode))
((or (not window-start)
(> window-start (point))))
((magit-section-equal ws-section (magit-section-at window-start))
(set-window-start window window-start t))
([pos (save-excursion
(and (magit-section-goto-successor--same
ws-section ws-line 0)
(point)))]
(set-window-start window pos t))))
;; We must make sure this does not call `set-window-start',
;; which the HUNK METHOD does by calling `magit-section-goto'
;; because that runs the `magit-section-goto-successor-hook'
;; and thus `magit-hunk-set-window-start'. The window does
;; not display this buffer, so the window start would be set
;; for the wrong buffer. Originally reported in #4196 and
;; fixed with 482c25a3204468a4f6c2fe12ff061666b61f5f4d.
(let ((magit-section-movement-hook nil))
(magit-section-goto-successor section line char)))))
(defun magit-revert-buffer (_ignore-auto _noconfirm)
"Wrapper around `magit-refresh-buffer' suitable as `revert-buffer-function'."
@@ -1214,8 +1246,8 @@ Note that refreshing a Magit buffer is done by re-creating its
contents from scratch, which can be slow in large repositories.
If you are not satisfied with Magit's performance, then you
should obviously not add this function to that hook."
(when-let (((and (not magit-inhibit-refresh)
(magit-inside-worktree-p t)))
(when-let ((_(not magit-inhibit-refresh))
(_(magit-inside-worktree-p t))
(buf (ignore-errors (magit-get-mode-buffer 'magit-status-mode))))
(cl-pushnew buf magit-after-save-refresh-buffers)
(add-hook 'post-command-hook #'magit-after-save-refresh-buffers)))
@@ -1238,16 +1270,51 @@ if you so desire."
(defvar-local magit-inhibit-refresh-save nil)
(defvar magit-save-repository-buffers-predicate
(lambda (topdir)
(let ((remote (file-remote-p default-directory))
(topdirs nil)
;; If the current file is modified and resides inside
;; a repository, and a let-binding is in effect, which
;; places us in another repository, then this binding
;; is needed to prevent that file from being saved.
(default-directory default-directory))
(and buffer-file-name
(setq default-directory (file-name-directory buffer-file-name))
;; Check whether the repository still exists.
(file-exists-p default-directory)
;; Check whether refreshing is disabled.
(not magit-inhibit-refresh-save)
;; Check whether the visited file is either on the
;; same remote as the repository, or both are on
;; the local system.
(equal (file-remote-p buffer-file-name) remote)
;; Delayed checks that are more expensive for remote
;; repositories, due to the required network access.
;;
;; Check whether the file is inside the repository.
(equal (or (cdr (assoc default-directory topdirs))
(let ((top (magit-rev-parse-safe "--show-toplevel")))
(push (cons default-directory top) topdirs)
top))
topdir)
;; Check whether the file is actually writable.
(file-writable-p buffer-file-name))))
"Predicate for `magit-save-repository-buffers'.
This function is called for each buffer that might need saving with
one argument, the working tree of the respective repository. If it
returns non-nil, the current buffer is saved.")
(defun magit-save-repository-buffers (&optional arg)
"Save file-visiting buffers belonging to the current repository.
After any buffer where `buffer-save-without-query' is non-nil
is saved without asking, the user is asked about each modified
buffer which visits a file in the current repository. Optional
buffer, which visits a file in the current repository. Optional
argument (the prefix) non-nil means save all with no questions."
(interactive "P")
(when-let ((topdir (magit-rev-parse-safe "--show-toplevel")))
(let ((remote (file-remote-p default-directory))
(save-some-buffers-action-alist
(let ((save-some-buffers-action-alist
`((?Y ,(##with-current-buffer %
(setq buffer-save-without-query t)
(save-buffer))
@@ -1256,53 +1323,26 @@ argument (the prefix) non-nil means save all with no questions."
(setq magit-inhibit-refresh-save t))
"to skip the current buffer and remember choice")
,@save-some-buffers-action-alist))
(topdirs nil)
(unwiped nil)
(magit--wip-inhibit-autosave t))
;; Create a single wip commit for all saved files.
(magit--wip-inhibit-autosave t)
(saved nil))
(unwind-protect
(save-some-buffers
arg
(lambda ()
;; If the current file is modified and resides inside
;; a repository, and a let-binding is in effect, which
;; places us in another repository, then this binding
;; is needed to prevent that file from being saved.
(and-let* ((default-directory
(and buffer-file-name
(file-name-directory buffer-file-name))))
(and
;; Check whether the repository still exists.
(file-exists-p default-directory)
;; Check whether refreshing is disabled.
(not magit-inhibit-refresh-save)
;; Check whether the visited file is either on the
;; same remote as the repository, or both are on
;; the local system.
(equal (file-remote-p buffer-file-name) remote)
;; Delayed checks that are more expensive for remote
;; repositories, due to the required network access.
;;
;; Check whether the file is inside the repository.
(equal (or (cdr (assoc default-directory topdirs))
(let ((top (magit-rev-parse-safe "--show-toplevel")))
(push (cons default-directory top) topdirs)
top))
topdir)
;; Check whether the file is actually writable.
(file-writable-p buffer-file-name)
(prog1 t
;; Schedule for wip commit, if appropriate.
(when magit-wip-after-save-local-mode
(push (expand-file-name buffer-file-name) unwiped)))))))
(when unwiped
(and (funcall magit-save-repository-buffers-predicate topdir)
(prog1 t
(when magit-wip-mode
(push (expand-file-name buffer-file-name) saved))))))
(when saved
(let ((default-directory topdir))
(magit-wip-commit-worktree
(magit-wip-get-ref)
unwiped
(if (cdr unwiped)
(format "autosave %s files after save" (length unwiped))
saved
(if (cdr saved)
(format "autosave %s files after save" (length saved))
(format "autosave %s after save"
(file-relative-name (car unwiped)))))))))))
(file-relative-name (car saved)))))))))))
;;; Restore Window Configuration
@@ -1316,12 +1356,12 @@ argument (the prefix) non-nil means save all with no questions."
Later, when the buffer is buried, it may be restored by
`magit-restore-window-configuration'."
(if magit-inhibit-save-previous-winconf
(when (eq magit-inhibit-save-previous-winconf 'unset)
(setq magit-previous-window-configuration nil))
(unless (get-buffer-window (current-buffer) (selected-frame))
(setq magit-previous-window-configuration
(current-window-configuration)))))
(cond (magit-inhibit-save-previous-winconf
(when (eq magit-inhibit-save-previous-winconf 'unset)
(setq magit-previous-window-configuration nil)))
((not (get-buffer-window (current-buffer) (selected-frame)))
(setq magit-previous-window-configuration
(current-window-configuration)))))
(defun magit-restore-window-configuration (&optional kill-buffer)
"Bury or kill the current buffer and restore previous window configuration."
@@ -1443,9 +1483,9 @@ Return a (KEY . VALUE) cons cell.
The KEY is matched using `equal'.
Unless specified, REPOSITORY is the current buffer's repository."
(and-let* ((cache (assoc (or repository
(magit-repository-local-repository))
magit-repository-local-cache)))
(and-let ((cache (assoc (or repository
(magit-repository-local-repository))
magit-repository-local-cache)))
(assoc key (cdr cache))))
(defun magit-repository-local-get (key &optional default repository)
@@ -1466,13 +1506,13 @@ Unless specified, REPOSITORY is the current buffer's repository."
Unless specified, REPOSITORY is the current buffer's repository.
If REPOSITORY is `all', then delete the value for KEY for all
repositories."
(if (eq repository 'all)
(dolist (cache magit-repository-local-cache)
(setf cache (compat-call assoc-delete-all key cache)))
(when-let ((cache (assoc (or repository
(magit-repository-local-repository))
magit-repository-local-cache)))
(setf cache (compat-call assoc-delete-all key cache)))))
(cond-let
((eq repository 'all)
(dolist (cache magit-repository-local-cache)
(setf cache (compat-call assoc-delete-all key cache))))
([cache (assoc (or repository (magit-repository-local-repository))
magit-repository-local-cache)]
(setf cache (compat-call assoc-delete-all key cache)))))
(defmacro magit--with-repository-local-cache (key &rest body)
(declare (indent 1) (debug (form body)))
@@ -1556,7 +1596,7 @@ The additional output can be found in the *Messages* buffer."
The returned value has the form (BEGINNING-LINE END-LINE). If
the region end at the beginning of a line, do not include that
line. Avoid including the line after the end of the file."
(and (or magit-buffer-file-name buffer-file-name)
(and (magit-buffer-file-name)
(region-active-p)
(not (= (region-beginning) (region-end) (1+ (buffer-size))))
(let ((beg (region-beginning))
@@ -1569,4 +1609,15 @@ line. Avoid including the line after the end of the file."
;;; _
(provide 'magit-mode)
;; Local Variables:
;; read-symbol-shorthands: (
;; ("and$" . "cond-let--and$")
;; ("and>" . "cond-let--and>")
;; ("and-let" . "cond-let--and-let")
;; ("if-let" . "cond-let--if-let")
;; ("when-let" . "cond-let--when-let")
;; ("while-let" . "cond-let--while-let")
;; ("match-string" . "match-string")
;; ("match-str" . "match-string-no-properties"))
;; End:
;;; magit-mode.el ends here

Some files were not shown because too many files have changed in this diff Show More