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) (const :tag "All packages" all)
(repeat symbol))) (repeat symbol)))
(defvar async-byte-compile-log-file (defvar async-byte-compile-log-file "async-bytecomp.log"
(concat user-emacs-directory "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\\'" (defvar async-bytecomp-load-variable-regexp "\\`load-path\\'"
"The variable used by `async-inject-variables' when (re)compiling async.") "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))) (let ((bn (file-name-nondirectory (directory-file-name file-or-dir)))
(action-name (pcase type (action-name (pcase type
('file "File") ('file "File")
('directory "Directory")))) ('directory "Directory"))))
(if (file-exists-p async-byte-compile-log-file) (if (and log-file (file-exists-p log-file))
(let ((buf (get-buffer-create byte-compile-log-buffer)) (async-bytecomp--file-to-comp-buffer-1
(n 0)) log-file
(with-current-buffer buf (unless quiet
(goto-char (point-max)) (lambda ()
(let ((inhibit-read-only t)) (let ((n 0))
(insert-file-contents async-byte-compile-log-file) (unless quiet
(compilation-mode)) (save-excursion
(display-buffer buf) (goto-char (point-min))
(delete-file async-byte-compile-log-file) (while (re-search-forward "^.*:Error:" nil t)
(unless quiet (cl-incf n)))
(save-excursion (if (> n 0)
(goto-char (point-min)) (message "Failed to compile %d files in directory `%s'" n bn)
(while (re-search-forward "^.*:Error:" nil t) (message "%s `%s' compiled asynchronously with warnings"
(cl-incf n))) action-name bn)))))))
(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 (unless quiet
(message "%s `%s' compiled asynchronously with success" action-name bn))))) (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 ;;;###autoload
(defun async-byte-recompile-directory (directory &optional quiet) (defun async-byte-recompile-directory (directory &optional quiet)
"Compile all *.el files in DIRECTORY asynchronously. "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. ;; This happen when recompiling its own directory.
(load "async") (load "async")
(let ((call-back (let ((call-back
(lambda (&optional _ignore) (lambda (&optional log-file)
(async-bytecomp--file-to-comp-buffer directory quiet 'directory)))) (async-bytecomp--file-to-comp-buffer directory quiet 'directory log-file))))
(async-start (async-start
`(lambda () `(lambda ()
(require 'bytecomp) (require 'bytecomp)
,(async-inject-variables async-bytecomp-load-variable-regexp) ,(async-inject-variables async-bytecomp-load-variable-regexp)
(let ((default-directory (file-name-as-directory ,directory)) (let ((default-directory (file-name-as-directory ,directory)))
error-data)
(add-to-list 'load-path default-directory) (add-to-list 'load-path default-directory)
(byte-recompile-directory ,directory 0 t) (byte-recompile-directory ,directory 0 t)
(when (get-buffer byte-compile-log-buffer) ,(macroexpand '(async-bytecomp--comp-buffer-to-file))))
(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))))))
call-back) call-back)
(unless quiet (message "Started compiling asynchronously directory %s" directory)))) (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." Same as `byte-compile-file' but asynchronous."
(interactive "fFile: ") (interactive "fFile: ")
(let ((call-back (let ((call-back
(lambda (&optional _ignore) (lambda (&optional log-file)
(async-bytecomp--file-to-comp-buffer file nil 'file)))) (async-bytecomp--file-to-comp-buffer file nil 'file log-file))))
(async-start (async-start
`(lambda () `(lambda ()
(require 'bytecomp) (require 'bytecomp)
,(async-inject-variables async-bytecomp-load-variable-regexp) ,(async-inject-variables async-bytecomp-load-variable-regexp)
(let ((default-directory ,(file-name-directory file)) (let ((default-directory ,(file-name-directory file)))
error-data)
(add-to-list 'load-path default-directory) (add-to-list 'load-path default-directory)
(byte-compile-file ,file) (byte-compile-file ,file)
(when (get-buffer byte-compile-log-buffer) ,(macroexpand '(async-bytecomp--comp-buffer-to-file))))
(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))))))
call-back))) call-back)))
(provide 'async-bytecomp) (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 (action-string (pcase action
('install "Installing") ('install "Installing")
('upgrade "Upgrading") ('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)) (message "%s %s package(s)..." action-string (length packages))
(process-put (process-put
(async-start (async-start
@@ -92,13 +99,12 @@ Argument ERROR-FILE is the file where errors are logged, if some."
(format (format
"%S:\n Please refresh package list before %s" "%S:\n Please refresh package list before %s"
err ,action-string))))) err ,action-string)))))
(let (error-data) (when (get-buffer byte-compile-log-buffer)
(when (get-buffer byte-compile-log-buffer) (let ((error-data (with-current-buffer byte-compile-log-buffer
(setq error-data (with-current-buffer byte-compile-log-buffer (buffer-substring-no-properties
(buffer-substring-no-properties (point-min) (point-max)))))
(point-min) (point-max))))
(unless (string= error-data "") (unless (string= error-data "")
(with-temp-file ,async-byte-compile-log-file (with-temp-file ,log-file
(erase-buffer) (erase-buffer)
(insert error-data))))))) (insert error-data)))))))
(lambda (result) (lambda (result)
@@ -127,15 +133,9 @@ Argument ERROR-FILE is the file where errors are logged, if some."
'async-package-message 'async-package-message
str (length lst))) str (length lst)))
packages action-string) packages action-string)
(when (file-exists-p async-byte-compile-log-file) (if (zerop (nth 7 (file-attributes log-file)))
(let ((buf (get-buffer-create byte-compile-log-buffer))) (delete-file log-file)
(with-current-buffer buf (async-bytecomp--file-to-comp-buffer-1 log-file)))))
(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)))))))
(run-hooks 'async-pkg-install-after-hook))) (run-hooks 'async-pkg-install-after-hook)))
'async-pkg-install t) 'async-pkg-install t)
(async-package--modeline-mode 1))) (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 -*- ;; -*- no-byte-compile: t; lexical-binding: nil -*-
(define-package "async" "20250325.509" (define-package "async" "20251005.634"
"Asynchronous processing in Emacs." "Asynchronous processing in Emacs."
'((emacs "24.4")) '((emacs "24.4"))
:url "https://github.com/jwiegley/emacs-async" :url "https://github.com/jwiegley/emacs-async"
:commit "bb3f31966ed65a76abe6fa4f80a960a2917f554e" :commit "31cb2fea8f4bc7a593acd76187a89075d8075500"
:revdesc "bb3f31966ed6" :revdesc "31cb2fea8f4b"
:keywords '("async") :keywords '("async")
:authors '(("John Wiegley" . "jwiegley@gmail.com")) :authors '(("John Wiegley" . "jwiegley@gmail.com"))
:maintainers '(("Thierry Volpiatto" . "thievol@posteo.net"))) :maintainers '(("Thierry Volpiatto" . "thievol@posteo.net")))
lisp/async/async.el
+3 -3
View File
@@ -6,8 +6,8 @@
;; Maintainer: Thierry Volpiatto <thievol@posteo.net> ;; Maintainer: Thierry Volpiatto <thievol@posteo.net>
;; Created: 18 Jun 2012 ;; Created: 18 Jun 2012
;; Package-Version: 20250325.509 ;; Package-Version: 20251005.634
;; Package-Revision: bb3f31966ed6 ;; Package-Revision: 31cb2fea8f4b
;; Package-Requires: ((emacs "24.4")) ;; Package-Requires: ((emacs "24.4"))
;; Keywords: async ;; Keywords: async
@@ -118,7 +118,7 @@ is returned unmodified."
collect elm)) collect elm))
(t object))) (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.") "A list of regexps that `async-inject-variables' should ignore.")
(defun async-inject-variables (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 (defcustom dired-async-skip-fast nil
"If non-nil, skip async for fast operations. "If non-nil, skip async for fast operations.
Same device renames and copying and renaming files smaller than 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 :risky t
:type 'boolean) :type 'boolean)
@@ -203,22 +205,22 @@ See `file-attributes'."
(equal (file-attribute-device-number (file-attributes f1)) (equal (file-attribute-device-number (file-attributes f1))
(file-attribute-device-number (file-attributes f2)))) (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. "Return non-nil if FILE is considered small.
File is considered small if it size is smaller than File is considered small if it size is smaller than
`dired-async-small-file-max'." `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 ;; Directories are always large since we can't easily figure out
;; their total size. ;; their total size.
(and (not (dired-async--directory-p a)) (and (not (dired-async--directory-p a))
(< (file-attribute-size a) dired-async-small-file-max)))) (< (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. "Return non-nil if we should skip async for FILE.
See `dired-create-files' for FILE-CREATOR and NAME-CONSTRUCTOR." See `dired-create-files' for FILE-CREATOR and NAME-CONSTRUCTOR."
;; Skip async for small files. ;; 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. ;; Also skip async for same device renames.
(and (eq file-creator 'dired-rename-file) (and (eq file-creator 'dired-rename-file)
(let ((new (funcall name-constructor 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'. "Around advice for `dired-create-files'.
Uses async like `dired-async-create-files' but skips certain fast Uses async like `dired-async-create-files' but skips certain fast
cases if `dired-async-skip-fast' is non-nil." 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) (if (or (eq file-creator 'backup-file)
(null dired-async-skip-fast)) (null dired-async-skip-fast))
(setq async-list fn-list) (setq async-list fn-list)
(dolist (old fn-list) (dolist (old fn-list)
(if (dired-async--skip-async-p file-creator old name-constructor) (let ((attrs (file-attributes old)))
(push old quick-list) (if (dired-async--skip-async-p
(push old async-list)))) 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 (when async-list
(dired-async-create-files (dired-async-create-files
file-creator operation (nreverse async-list) file-creator operation (nreverse async-list)
@@ -313,6 +323,7 @@ ESC or `q' to not overwrite any of the remaining files,
from to))) from to)))
;; Skip file if it is too large. ;; Skip file if it is too large.
(if (and (member operation '("Copy" "Rename")) (if (and (member operation '("Copy" "Rename"))
dired-async-large-file-warning-threshold
(eq (dired-async--abort-if-file-too-large (eq (dired-async--abort-if-file-too-large
(file-attribute-size (file-attribute-size
(file-attributes (file-truename from))) (file-attributes (file-truename from)))
lisp/biblio/biblio-hal.el
+1
View File
@@ -28,6 +28,7 @@
;;; Code: ;;; Code:
(require 'biblio-core) (require 'biblio-core)
(require 'timezone)
(defun biblio-hal--forward-bibtex (metadata forward-to) (defun biblio-hal--forward-bibtex (metadata forward-to)
"Forward BibTeX for HAL entry METADATA to 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 -*- ;; -*- 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." "Browse and import bibliographic references and BibTeX records from CrossRef, arXiv, DBLP, HAL, IEEE Xplore, Dissemin, and doi.org."
'((emacs "24.3") '((emacs "24.3")
(biblio-core "0.3")) (biblio-core "0.3"))
:url "https://github.com/cpitclaudel/biblio.el" :url "https://github.com/cpitclaudel/biblio.el"
:commit "0314982c0ca03d0f8e0ddbe9fc20588c35021098" :commit "bb9d6b4b962fb2a4e965d27888268b66d868766b"
:revdesc "0314982c0ca0" :revdesc "bb9d6b4b962f"
:keywords '("bib" "tex" "convenience" "hypermedia") :keywords '("bib" "tex" "convenience" "hypermedia")
:authors '(("Clément Pit-Claudel" . "clement.pitclaudel@live.com")) :authors '(("Clément Pit-Claudel" . "clement.pitclaudel@live.com"))
:maintainers '(("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 ;; Copyright (C) 2016 Clément Pit-Claudel
;; Author: Clément Pit-Claudel <clement.pitclaudel@live.com> ;; Author: Clément Pit-Claudel <clement.pitclaudel@live.com>
;; Package-Version: 20250409.2132 ;; Package-Version: 20250812.1408
;; Package-Revision: 0314982c0ca0 ;; Package-Revision: bb9d6b4b962f
;; Package-Requires: ((emacs "24.3") (biblio-core "0.3")) ;; Package-Requires: ((emacs "24.3") (biblio-core "0.3"))
;; Keywords: bib, tex, convenience, hypermedia ;; Keywords: bib, tex, convenience, hypermedia
;; URL: https://github.com/cpitclaudel/biblio.el ;; 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 -*- ;; -*- no-byte-compile: t; lexical-binding: nil -*-
(define-package "cfrs" "20220129.1149" (define-package "cfrs" "20250729.1422"
"Child-frame based read-string." "Child-frame based read-string."
'((emacs "26.1") '((emacs "26.1")
(dash "2.11.0") (dash "2.11.0")
(s "1.10.0") (s "1.10.0")
(posframe "0.6.0")) (posframe "0.6.0"))
:url "https://github.com/Alexander-Miller/cfrs" :url "https://github.com/Alexander-Miller/cfrs"
:commit "f3a21f237b2a54e6b9f8a420a9da42b4f0a63121" :commit "981bddb3fb9fd9c58aed182e352975bd10ad74c8"
:revdesc "f3a21f237b2a" :revdesc "981bddb3fb9f"
:authors '(("Alexander Miller" . "alexanderm@web.de")) :authors '(("Alexander Miller" . "alexanderm@web.de"))
:maintainers '(("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> ;; Author: Alexander Miller <alexanderm@web.de>
;; Package-Requires: ((emacs "26.1") (dash "2.11.0") (s "1.10.0") (posframe "0.6.0")) ;; Package-Requires: ((emacs "26.1") (dash "2.11.0") (s "1.10.0") (posframe "0.6.0"))
;; Package-Version: 20220129.1149 ;; Package-Version: 20250729.1422
;; Package-Revision: f3a21f237b2a ;; Package-Revision: 981bddb3fb9f
;; Homepage: https://github.com/Alexander-Miller/cfrs ;; Homepage: https://github.com/Alexander-Miller/cfrs
;; This program is free software; you can redistribute it and/or modify ;; 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." Only the `:background' part is used."
:group 'cfrs) :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 ;;;###autoload
(defun cfrs-read (prompt &optional initial-input) (defun cfrs-read (prompt &optional initial-input)
"Read a string using a pos-frame with given PROMPT and INITIAL-INPUT." "Read a string using a pos-frame with given PROMPT and INITIAL-INPUT."
(if (not (or (display-graphic-p) (if (not (or (display-graphic-p)
(not (fboundp #'display-buffer-in-side-window)))) (not (fboundp #'display-buffer-in-side-window))))
(read-string prompt initial-input) (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)) (border-color (face-attribute 'cfrs-border-color :background nil t))
(cursor (cfrs--determine-cursor-type)) (cursor (cfrs--determine-cursor-type))
(width (+ 2 ;; extra space for margin and cursor (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 () (defun cfrs--hide ()
"Hide the current cfrs frame." "Hide the current cfrs frame."
(when (eq major-mode 'cfrs-input-mode) (when (eq major-mode 'cfrs-input-mode)
(posframe-hide (current-buffer)) (posframe-hide cfrs--buffer-name)
(x-focus-frame (frame-parent (selected-frame))))) (x-focus-frame (frame-parent (selected-frame)))))
(defun cfrs--adjust-height () (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 ;; XXX: workaround for persp believing we are in a different frame
;; and need a new perspective when the recursive edit ends ;; and need a new perspective when the recursive edit ends
(set-frame-parameter (selected-frame) 'persp--recursive nil) (set-frame-parameter (selected-frame) 'persp--recursive nil)
(remove-hook 'window-selection-change-functions #'cfrs--detect-lost-focus :local)
(exit-recursive-edit)) (exit-recursive-edit))
(defun cfrs-cancel () (defun cfrs-cancel ()
"Cancel the `cfrs-read' call and the function that called it." "Cancel the `cfrs-read' call and the function that called it."
(interactive) (interactive)
(remove-hook 'window-selection-change-functions #'cfrs--detect-lost-focus :local)
(cfrs--hide) (cfrs--hide)
(abort-recursive-edit)) (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" (define-derived-mode cfrs-input-mode fundamental-mode "Child Frame Read String"
"Simple mode for buffers displayed in cfrs's input frames." "Simple mode for buffers displayed in cfrs's input frames."
(add-hook 'post-command-hook #'cfrs--adjust-height nil :local) (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)) (display-line-numbers-mode -1))
;; https://github.com/Alexander-Miller/treemacs/issues/775 ;; 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 (rx "\\" (1+ (any "a-z" "A-Z")) word-end)) ; \TEX-COMMAND + word-end
(defconst citeproc-bt--braces-rx (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) (defun citeproc-bt--process-brackets (s &optional lhb rhb)
"Process LaTeX curly brackets in string S. "Process LaTeX curly brackets in string S.
@@ -250,11 +252,11 @@ The default is to remove them."
match t)) match t))
((string-match citeproc-bt--braces-rx result) ((string-match citeproc-bt--braces-rx result)
(setq result (replace-match (setq result (replace-match
(concat lhb "\\1" rhb) (concat "\\1" lhb "\\2" rhb)
t nil result) t nil result)
match t)) match t))
(t (setq match nil)))) (t (setq match nil))))
result)) (s-replace-all '(("\\{" . "{") ("\\}" . "}")) result)))
(defun citeproc-bt--preprocess-for-decode (s) (defun citeproc-bt--preprocess-for-decode (s)
"Preprocess field S before decoding. "Preprocess field S before decoding.
lisp/citeproc/citeproc-formatters.el
+1 -1
View File
@@ -258,7 +258,7 @@ CSL tests."
;; LaTeX ;; LaTeX
(defconst citeproc-fmt--latex-esc-regex (defconst citeproc-fmt--latex-esc-regex
(regexp-opt '("_" "&" "#" "%" "$")) (regexp-opt '("_" "&" "#" "%" "$" "{" "}" ))
"Regular expression matching characters to be escaped in LaTeX output.") "Regular expression matching characters to be escaped in LaTeX output.")
(defun citeproc-fmt--latex-escape (s) (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) (defun citeproc-locale-getter-from-dir (dir)
"Return a locale getter getting parsed locales from a local DIR. "Return a locale getter getting parsed locales from a local DIR.
If the requested locale couldn't be read then return the parsed 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"))) (let ((default-loc-file (f-join dir "locales-en-US.xml")))
(lambda (loc) (lambda (loc)
(let* ((ext-loc (if (or (member loc citeproc-locale--simple-locales) (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-remove-xml-comments
(citeproc-lib-parse-xml-file (citeproc-lib-parse-xml-file
(if loc-available loc-file (if loc-available loc-file
(if (not (f-readable-p default-loc-file)) (if (not (f-readable-p default-loc-file))
(error (error
"The default CSL locale file %s doesn't exist or is unreadable" "The default CSL locale file %s doesn't exist or is unreadable"
default-loc-file) default-loc-file)
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) (defun citeproc-locale-termlist-from-xml-frag (frag)
"Transform xml FRAG representing citeproc--terms into a citeproc-term list." "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 -*- ;; -*- no-byte-compile: t; lexical-binding: nil -*-
(define-package "citeproc" "20250525.1011" (define-package "citeproc" "20251103.716"
"A CSL 1.0.2 Citation Processor." "A CSL 1.0.2 Citation Processor."
'((emacs "26") '((emacs "26")
(dash "2.13.0") (dash "2.13.0")
@@ -11,8 +11,8 @@
(parsebib "2.4") (parsebib "2.4")
(compat "28.1")) (compat "28.1"))
:url "https://github.com/andras-simonyi/citeproc-el" :url "https://github.com/andras-simonyi/citeproc-el"
:commit "e3bf1f80bcd64edf4afef564c0d94d38aa567d61" :commit "a3d62ab8e40a75fcfc6e4c0c107e3137b4db6db8"
:revdesc "e3bf1f80bcd6" :revdesc "a3d62ab8e40a"
:keywords '("bib") :keywords '("bib")
:authors '(("András Simonyi" . "andras.simonyi@gmail.com")) :authors '(("András Simonyi" . "andras.simonyi@gmail.com"))
:maintainers '(("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. "Replace dumb apostophes in string S with smart ones.
The replacement character used is the unicode character `modifier The replacement character used is the unicode character `modifier
letter apostrophe'." letter apostrophe'."
(subst-char-in-string ?' ?ʼ (subst-char-in-string ?’ ?ʼ s t) t)) (string-replace "'" "ʼ" (string-replace "’" "ʼ" s)))
(defconst citeproc-s--cull-spaces-alist (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 ;; URL: https://github.com/andras-simonyi/citeproc-el
;; Keywords: bib ;; 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-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-Version: 20251103.716
;; Package-Revision: e3bf1f80bcd6 ;; Package-Revision: a3d62ab8e40a
;; This program is free software; you can redistribute it and/or modify ;; 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 ;; 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 -*- ;; -*- no-byte-compile: t; lexical-binding: nil -*-
(define-package "company-statistics" "20170210.1933" (define-package "company-statistics" "20250805.1524"
"Sort candidates using completion history." "Sort candidates using completion history."
'((emacs "24.3") '((emacs "24.3")
(company "0.8.5")) (company "0.8.5"))
:url "https://github.com/company-mode/company-statistics" :url "https://github.com/company-mode/company-statistics"
:commit "e62157d43b2c874d2edbd547c3bdfb05d0a7ae5c" :commit "120e982f47e01945c044e0762ba376741c41b76c"
:revdesc "e62157d43b2c" :revdesc "120e982f47e0"
:keywords '("abbrev" "convenience" "matching") :keywords '("abbrev" "convenience" "matching")
:authors '(("Ingo Lohmar" . "i.lohmar@gmail.com")) :authors '(("Ingo Lohmar" . "i.lohmar@gmail.com"))
:maintainers '(("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> ;; Author: Ingo Lohmar <i.lohmar@gmail.com>
;; URL: https://github.com/company-mode/company-statistics ;; URL: https://github.com/company-mode/company-statistics
;; Package-Version: 20170210.1933 ;; Package-Version: 20250805.1524
;; Package-Revision: e62157d43b2c ;; Package-Revision: 120e982f47e0
;; Keywords: abbrev, convenience, matching ;; Keywords: abbrev, convenience, matching
;; Package-Requires: ((emacs "24.3") (company "0.8.5")) ;; 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 configuration. You can customize this behavior with
`company-statistics-auto-save', `company-statistics-auto-restore' and `company-statistics-auto-save', `company-statistics-auto-restore' and
`company-statistics-file'." `company-statistics-file'."
nil nil nil :init-value nil
:lighter nil
:keymap nil
:global t :global t
(if company-statistics-mode (if company-statistics-mode
(progn (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--search (company-dabbrev--make-regexp)
company-dabbrev-time-limit company-dabbrev-time-limit
(pcase company-dabbrev-other-buffers (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))) ((pred functionp) (funcall company-dabbrev-other-buffers (current-buffer)))
(`all `all)))) )))
;;;###autoload ;;;###autoload
(defun company-dabbrev (command &optional arg &rest _ignored) (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 () (defun company-files--prefix ()
(let ((existing (company-files--grab-existing-name))) (let ((existing (company-files--grab-existing-name)))
(when existing (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) (defun company-file--keys-match-p (new old)
(and (equal (cdr old) (cdr new)) (and (equal (cdr old) (cdr new))
lisp/company/company-keywords.el
+4 -4
View File
@@ -292,10 +292,10 @@
"then" "type" "where") "then" "type" "where")
(python-mode (python-mode
;; https://docs.python.org/3/reference/lexical_analysis.html#keywords ;; https://docs.python.org/3/reference/lexical_analysis.html#keywords
"False" "None" "True" "and" "as" "assert" "break" "class" "continue" "def" "False" "None" "True" "and" "as" "assert" "async" "await" "break" "class"
"del" "elif" "else" "except" "exec" "finally" "for" "from" "global" "if" "continue" "def" "del" "elif" "else" "except" "exec" "finally" "for" "from"
"import" "in" "is" "lambda" "nonlocal" "not" "or" "pass" "print" "raise" "global" "if" "import" "in" "is" "lambda" "nonlocal" "not" "or" "pass"
"return" "try" "while" "with" "yield") "print" "raise" "return" "try" "while" "with" "yield")
(ruby-mode (ruby-mode
"BEGIN" "END" "alias" "and" "begin" "break" "case" "class" "def" "defined?" "BEGIN" "END" "alias" "and" "begin" "break" "case" "class" "def" "defined?"
"do" "else" "elsif" "end" "ensure" "false" "for" "if" "in" "module" "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 -*- ;; -*- no-byte-compile: t; lexical-binding: nil -*-
(define-package "company" "20250426.1319" (define-package "company" "20251021.2211"
"Modular text completion framework." "Modular text completion framework."
'((emacs "26.1")) '((emacs "26.1"))
:url "http://company-mode.github.io/" :url "http://company-mode.github.io/"
:commit "41f07c7d401c1374a76f3004a3448d3d36bdf347" :commit "4ff89f7369227fbb89fe721d1db707f1af74cd0f"
:revdesc "41f07c7d401c" :revdesc "4ff89f736922"
:keywords '("abbrev" "convenience" "matching") :keywords '("abbrev" "convenience" "matching")
:maintainers '(("Dmitry Gutov" . "dmitry@gutov.dev"))) :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 (when (and company-selection
(not (company--company-command-p (this-command-keys)))) (not (company--company-command-p (this-command-keys))))
(company--unread-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-clang-insert-arguments)
(defvar company-semantic-insert-arguments) (defvar company-semantic-insert-arguments)
lisp/company/company.el
+4 -3
View File
@@ -5,8 +5,8 @@
;; Author: Nikolaj Schumacher ;; Author: Nikolaj Schumacher
;; Maintainer: Dmitry Gutov <dmitry@gutov.dev> ;; Maintainer: Dmitry Gutov <dmitry@gutov.dev>
;; URL: http://company-mode.github.io/ ;; URL: http://company-mode.github.io/
;; Package-Version: 20250426.1319 ;; Package-Version: 20251021.2211
;; Package-Revision: 41f07c7d401c ;; Package-Revision: 4ff89f736922
;; Keywords: abbrev, convenience, matching ;; Keywords: abbrev, convenience, matching
;; Package-Requires: ((emacs "26.1")) ;; Package-Requires: ((emacs "26.1"))
@@ -1436,8 +1436,9 @@ be recomputed when this value changes."
(let* ((entity (and (let* ((entity (and
(not (keywordp backend)) (not (keywordp backend))
(company--force-sync backend '(prefix) backend))) (company--force-sync backend '(prefix) backend)))
(new-len (company--prefix-len entity))) new-len)
(when (stringp (company--prefix-str entity)) (when (stringp (company--prefix-str entity))
(setq new-len (company--prefix-len entity))
(or (not backends-after-with) (or (not backends-after-with)
(unless (memq backend backends-after-with) (unless (memq backend backends-after-with)
(setq backends-after-with nil))) (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. company.texi.
This user manual is for Company version 1.0.3-snapshot This user manual is for Company version 1.0.3-snapshot
@@ -82,7 +82,6 @@ Backends
* Package Backends:: * Package Backends::
* Candidates Post-Processing:: * Candidates Post-Processing::
 
File: company.info, Node: Overview, Next: Getting Started, Prev: Top, Up: Top File: company.info, Node: Overview, Next: Getting Started, Prev: Top, Up: Top
@@ -1772,52 +1771,52 @@ Concept Index
* troubleshoot: Troubleshooting. (line 6) * troubleshoot: Troubleshooting. (line 6)
* usage: Usage Basics. (line 6) * usage: Usage Basics. (line 6)
 
Tag Table: Tag Table:
Node: Top575 Node: Top573
Node: Overview2002 Node: Overview1999
Node: Terminology2410 Node: Terminology2407
Node: Structure3713 Node: Structure3710
Node: Getting Started5203 Node: Getting Started5200
Node: Installation5481 Node: Installation5478
Node: Initial Setup5864 Node: Initial Setup5861
Node: Usage Basics6712 Node: Usage Basics6709
Node: Commands7686 Node: Commands7683
Ref: Commands-Footnote-110082 Ref: Commands-Footnote-110079
Node: Customization10249 Node: Customization10246
Node: Customization Interface10721 Node: Customization Interface10718
Node: Configuration File11254 Node: Configuration File11251
Ref: company-selection-wrap-around13566 Ref: company-selection-wrap-around13563
Node: Frontends16055 Node: Frontends16052
Node: Tooltip Frontends17024 Node: Tooltip Frontends17021
Ref: Tooltip Frontends-Footnote-127720 Ref: Tooltip Frontends-Footnote-127717
Node: Preview Frontends27957 Node: Preview Frontends27954
Ref: Preview Frontends-Footnote-129215 Ref: Preview Frontends-Footnote-129212
Node: Echo Frontends29342 Node: Echo Frontends29339
Node: Candidates Search30871 Node: Candidates Search30868
Node: Filter Candidates32203 Node: Filter Candidates32200
Node: Quick Access a Candidate32983 Node: Quick Access a Candidate32980
Node: Backends34601 Node: Backends34598
Node: Backends Usage Basics35631 Node: Backends Usage Basics35628
Ref: Backends Usage Basics-Footnote-137063 Ref: Backends Usage Basics-Footnote-137060
Node: Grouped Backends37147 Node: Grouped Backends37144
Node: Package Backends38658 Node: Package Backends38655
Node: Code Completion39585 Node: Code Completion39582
Node: Text Completion45102 Node: Text Completion45099
Node: File Name Completion49526 Node: File Name Completion49523
Node: Template Expansion51072 Node: Template Expansion51069
Node: Candidates Post-Processing51791 Node: Candidates Post-Processing51788
Node: Troubleshooting54368 Node: Troubleshooting54365
Node: Index56039 Node: Index56036
Node: Key Index56202 Node: Key Index56199
Node: Variable Index57701 Node: Variable Index57698
Node: Function Index62554 Node: Function Index62551
Node: Concept Index67254 Node: Concept Index67251
 
End Tag Table End Tag Table
 
Local Variables: Local Variables:
coding: utf-8 coding: utf-8
Info-documentlanguage: en
End: 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. This manual is for Dash version 2.20.0.
@@ -4732,223 +4732,223 @@ Index
* global-dash-fontify-mode: Fontification of special variables. * global-dash-fontify-mode: Fontification of special variables.
(line 12) (line 12)
 
Tag Table: Tag Table:
Node: Top734 Node: Top732
Node: Installation2377 Node: Installation2375
Node: Using in a package3139 Node: Using in a package3137
Node: Fontification of special variables3482 Node: Fontification of special variables3480
Node: Info symbol lookup4272 Node: Info symbol lookup4270
Node: Functions4855 Node: Functions4853
Node: Maps6339 Node: Maps6337
Ref: -map6636 Ref: -map6634
Ref: -map-when7007 Ref: -map-when7005
Ref: -map-first7581 Ref: -map-first7579
Ref: -map-last8176 Ref: -map-last8174
Ref: -map-indexed8766 Ref: -map-indexed8764
Ref: -annotate9450 Ref: -annotate9448
Ref: -splice10052 Ref: -splice10050
Ref: -splice-list11125 Ref: -splice-list11123
Ref: -mapcat11584 Ref: -mapcat11582
Ref: -copy11957 Ref: -copy11955
Node: Sublist selection12223 Node: Sublist selection12221
Ref: -filter12416 Ref: -filter12414
Ref: -remove12967 Ref: -remove12965
Ref: -remove-first13514 Ref: -remove-first13512
Ref: -remove-last14358 Ref: -remove-last14356
Ref: -remove-item15086 Ref: -remove-item15084
Ref: -non-nil15486 Ref: -non-nil15484
Ref: -slice15768 Ref: -slice15766
Ref: -take16297 Ref: -take16295
Ref: -take-last16715 Ref: -take-last16713
Ref: -drop17152 Ref: -drop17150
Ref: -drop-last17599 Ref: -drop-last17597
Ref: -take-while18031 Ref: -take-while18029
Ref: -drop-while18656 Ref: -drop-while18654
Ref: -select-by-indices19287 Ref: -select-by-indices19285
Ref: -select-columns19794 Ref: -select-columns19792
Ref: -select-column20497 Ref: -select-column20495
Node: List to list20960 Node: List to list20958
Ref: -keep21152 Ref: -keep21150
Ref: -concat21728 Ref: -concat21726
Ref: -flatten22508 Ref: -flatten22506
Ref: -flatten-n23268 Ref: -flatten-n23266
Ref: -replace23652 Ref: -replace23650
Ref: -replace-first24113 Ref: -replace-first24111
Ref: -replace-last24608 Ref: -replace-last24606
Ref: -insert-at25096 Ref: -insert-at25094
Ref: -replace-at25421 Ref: -replace-at25419
Ref: -update-at25808 Ref: -update-at25806
Ref: -remove-at26349 Ref: -remove-at26347
Ref: -remove-at-indices26976 Ref: -remove-at-indices26974
Node: Reductions27666 Node: Reductions27664
Ref: -reduce-from27862 Ref: -reduce-from27860
Ref: -reduce-r-from28584 Ref: -reduce-r-from28582
Ref: -reduce29845 Ref: -reduce29843
Ref: -reduce-r30594 Ref: -reduce-r30592
Ref: -reductions-from31870 Ref: -reductions-from31868
Ref: -reductions-r-from32672 Ref: -reductions-r-from32670
Ref: -reductions33498 Ref: -reductions33496
Ref: -reductions-r34205 Ref: -reductions-r34203
Ref: -count34946 Ref: -count34944
Ref: -sum35176 Ref: -sum35174
Ref: -running-sum35364 Ref: -running-sum35362
Ref: -product35685 Ref: -product35683
Ref: -running-product35893 Ref: -running-product35891
Ref: -inits36234 Ref: -inits36232
Ref: -tails36479 Ref: -tails36477
Ref: -common-prefix36724 Ref: -common-prefix36722
Ref: -common-suffix37018 Ref: -common-suffix37016
Ref: -min37312 Ref: -min37310
Ref: -min-by37538 Ref: -min-by37536
Ref: -max38059 Ref: -max38057
Ref: -max-by38284 Ref: -max-by38282
Ref: -frequencies38810 Ref: -frequencies38808
Node: Unfolding39425 Node: Unfolding39423
Ref: -iterate39666 Ref: -iterate39664
Ref: -unfold40113 Ref: -unfold40111
Ref: -repeat40918 Ref: -repeat40916
Ref: -cycle41202 Ref: -cycle41200
Node: Predicates41599 Node: Predicates41597
Ref: -some41776 Ref: -some41774
Ref: -every42203 Ref: -every42201
Ref: -any?42915 Ref: -any?42913
Ref: -all?43264 Ref: -all?43262
Ref: -none?44004 Ref: -none?44002
Ref: -only-some?44324 Ref: -only-some?44322
Ref: -contains?44869 Ref: -contains?44867
Ref: -is-prefix?45375 Ref: -is-prefix?45373
Ref: -is-suffix?45707 Ref: -is-suffix?45705
Ref: -is-infix?46039 Ref: -is-infix?46037
Ref: -cons-pair?46399 Ref: -cons-pair?46397
Node: Partitioning46730 Node: Partitioning46728
Ref: -split-at46918 Ref: -split-at46916
Ref: -split-with47582 Ref: -split-with47580
Ref: -split-on48222 Ref: -split-on48220
Ref: -split-when48893 Ref: -split-when48891
Ref: -separate49536 Ref: -separate49534
Ref: -partition50070 Ref: -partition50068
Ref: -partition-all50519 Ref: -partition-all50517
Ref: -partition-in-steps50944 Ref: -partition-in-steps50942
Ref: -partition-all-in-steps51490 Ref: -partition-all-in-steps51488
Ref: -partition-by52004 Ref: -partition-by52002
Ref: -partition-by-header52382 Ref: -partition-by-header52380
Ref: -partition-after-pred52983 Ref: -partition-after-pred52981
Ref: -partition-before-pred53434 Ref: -partition-before-pred53432
Ref: -partition-before-item53819 Ref: -partition-before-item53817
Ref: -partition-after-item54126 Ref: -partition-after-item54124
Ref: -group-by54428 Ref: -group-by54426
Node: Indexing54861 Node: Indexing54859
Ref: -elem-index55063 Ref: -elem-index55061
Ref: -elem-indices55550 Ref: -elem-indices55548
Ref: -find-index56009 Ref: -find-index56007
Ref: -find-last-index56676 Ref: -find-last-index56674
Ref: -find-indices57325 Ref: -find-indices57323
Ref: -grade-up58085 Ref: -grade-up58083
Ref: -grade-down58492 Ref: -grade-down58490
Node: Set operations58906 Node: Set operations58904
Ref: -union59089 Ref: -union59087
Ref: -difference59519 Ref: -difference59517
Ref: -intersection59947 Ref: -intersection59945
Ref: -powerset60376 Ref: -powerset60374
Ref: -permutations60653 Ref: -permutations60651
Ref: -distinct61091 Ref: -distinct61089
Ref: -same-items?61485 Ref: -same-items?61483
Node: Other list operations62094 Node: Other list operations62092
Ref: -rotate62319 Ref: -rotate62317
Ref: -cons*62672 Ref: -cons*62670
Ref: -snoc63094 Ref: -snoc63092
Ref: -interpose63506 Ref: -interpose63504
Ref: -interleave63800 Ref: -interleave63798
Ref: -iota64166 Ref: -iota64164
Ref: -zip-with64649 Ref: -zip-with64647
Ref: -zip-pair65455 Ref: -zip-pair65453
Ref: -zip-lists66021 Ref: -zip-lists66019
Ref: -zip-lists-fill66819 Ref: -zip-lists-fill66817
Ref: -zip67529 Ref: -zip67527
Ref: -zip-fill68556 Ref: -zip-fill68554
Ref: -unzip-lists69470 Ref: -unzip-lists69468
Ref: -unzip70093 Ref: -unzip70091
Ref: -pad71086 Ref: -pad71084
Ref: -table71571 Ref: -table71569
Ref: -table-flat72357 Ref: -table-flat72355
Ref: -first73360 Ref: -first73358
Ref: -last73891 Ref: -last73889
Ref: -first-item74237 Ref: -first-item74235
Ref: -second-item74649 Ref: -second-item74647
Ref: -third-item75066 Ref: -third-item75064
Ref: -fourth-item75441 Ref: -fourth-item75439
Ref: -fifth-item75819 Ref: -fifth-item75817
Ref: -last-item76194 Ref: -last-item76192
Ref: -butlast76555 Ref: -butlast76553
Ref: -sort76800 Ref: -sort76798
Ref: -list77294 Ref: -list77292
Ref: -fix77863 Ref: -fix77861
Node: Tree operations78352 Node: Tree operations78350
Ref: -tree-seq78548 Ref: -tree-seq78546
Ref: -tree-map79409 Ref: -tree-map79407
Ref: -tree-map-nodes79849 Ref: -tree-map-nodes79847
Ref: -tree-reduce80713 Ref: -tree-reduce80711
Ref: -tree-reduce-from81595 Ref: -tree-reduce-from81593
Ref: -tree-mapreduce82195 Ref: -tree-mapreduce82193
Ref: -tree-mapreduce-from83054 Ref: -tree-mapreduce-from83052
Ref: -clone84339 Ref: -clone84337
Node: Threading macros84677 Node: Threading macros84675
Ref: ->84902 Ref: ->84900
Ref: ->>85390 Ref: ->>85388
Ref: -->85893 Ref: -->85891
Ref: -as->86450 Ref: -as->86448
Ref: -some->86904 Ref: -some->86902
Ref: -some->>87289 Ref: -some->>87287
Ref: -some-->87736 Ref: -some-->87734
Ref: -doto88303 Ref: -doto88301
Node: Binding88856 Node: Binding88854
Ref: -when-let89063 Ref: -when-let89061
Ref: -when-let*89524 Ref: -when-let*89522
Ref: -if-let90053 Ref: -if-let90051
Ref: -if-let*90419 Ref: -if-let*90417
Ref: -let91042 Ref: -let91040
Ref: -let*97118 Ref: -let*97116
Ref: -lambda98055 Ref: -lambda98053
Ref: -setq98861 Ref: -setq98859
Node: Side effects99662 Node: Side effects99660
Ref: -each99856 Ref: -each99854
Ref: -each-while100381 Ref: -each-while100379
Ref: -each-indexed101001 Ref: -each-indexed100999
Ref: -each-r101593 Ref: -each-r101591
Ref: -each-r-while102035 Ref: -each-r-while102033
Ref: -dotimes102679 Ref: -dotimes102677
Node: Destructive operations103230 Node: Destructive operations103228
Ref: !cons103448 Ref: !cons103446
Ref: !cdr103652 Ref: !cdr103650
Node: Function combinators103845 Node: Function combinators103843
Ref: -partial104049 Ref: -partial104047
Ref: -rpartial104567 Ref: -rpartial104565
Ref: -juxt105215 Ref: -juxt105213
Ref: -compose105667 Ref: -compose105665
Ref: -applify106274 Ref: -applify106272
Ref: -on106704 Ref: -on106702
Ref: -flip107468 Ref: -flip107466
Ref: -rotate-args107990 Ref: -rotate-args107988
Ref: -const108619 Ref: -const108617
Ref: -cut108961 Ref: -cut108959
Ref: -not109441 Ref: -not109439
Ref: -orfn109985 Ref: -orfn109983
Ref: -andfn110778 Ref: -andfn110776
Ref: -iteratefn111565 Ref: -iteratefn111563
Ref: -fixfn112267 Ref: -fixfn112265
Ref: -prodfn113841 Ref: -prodfn113839
Node: Development114968 Node: Development114966
Node: Contribute115257 Node: Contribute115255
Node: Contributors116265 Node: Contributors116263
Node: FDL118358 Node: FDL118356
Node: GPL143477 Node: GPL143475
Node: Index181023 Node: Index181021
 
End Tag Table End Tag Table
 
Local Variables: Local Variables:
coding: utf-8 coding: utf-8
Info-documentlanguage: en
End: 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 The mode's hook is called both when the mode is enabled and when it is
disabled. disabled.
\\{diff-hl-mode-map}
(fn &optional ARG)" t) (fn &optional ARG)" t)
(autoload 'turn-on-diff-hl-mode "diff-hl" "\ (autoload 'turn-on-diff-hl-mode "diff-hl" "\
Turn on `diff-hl-mode' or `diff-hl-dir-mode' in a buffer if appropriate.") 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. Set the reference revision globally to REV.
When called interactively, REV read with completion. 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: The default value chosen using one of methods below:
- In a log view buffer, it uses the revision of current entry. - 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 a VC annotate buffer, it uses the revision of current line.
- In other situations, it uses the symbol at point. - In other situations, it uses the symbol at point.
Notice that this sets the reference revision globally, so in Notice that this sets the reference revision globally, so in files from
files from other repositories, `diff-hl-mode' will not highlight other repositories, `diff-hl-mode' will not highlight changes correctly,
changes correctly, until you run `diff-hl-reset-reference-rev'. 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 Also notice that this will disable `diff-hl-amend-mode' in
buffers that enables it, since `diff-hl-amend-mode' overrides its buffers that enables it, since `diff-hl-amend-mode' overrides its
@@ -57,7 +84,12 @@ effect.
(fn REV)" t) (fn REV)" t)
(autoload 'diff-hl-reset-reference-rev "diff-hl" "\ (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) (put 'global-diff-hl-mode 'globalized-minor-mode t)
(defvar global-diff-hl-mode nil "\ (defvar global-diff-hl-mode nil "\
Non-nil if Global Diff-Hl mode is enabled. 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. See `diff-hl-mode' for more information on Diff-Hl mode.
(fn &optional ARG)" t) (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 ;;; Generated autoloads from diff-hl-amend.el
@@ -192,20 +224,6 @@ disabled.
(fn &optional ARG)" t) (fn &optional ARG)" t)
(register-definition-prefixes "diff-hl-flydiff" '("diff-hl-flydiff")) (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 ;;; Generated autoloads from diff-hl-margin.el
@@ -260,11 +278,6 @@ disabled.
;;; Generated autoloads from diff-hl-show-hunk.el ;;; 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" "\ (autoload 'diff-hl-show-hunk-previous "diff-hl-show-hunk" "\
Go to previous hunk/change and show it." t) Go to previous hunk/change and show it." t)
(autoload 'diff-hl-show-hunk-next "diff-hl-show-hunk" "\ (autoload 'diff-hl-show-hunk-next "diff-hl-show-hunk" "\
@@ -325,6 +338,25 @@ Diff-Hl-Show-Hunk-Mouse mode.
(fn &optional ARG)" t) (fn &optional ARG)" t)
(register-definition-prefixes "diff-hl-show-hunk" '("diff-hl-show-hunk-")) (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 ;;; 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)) `(const :tag ,(symbol-name name) ,name))
vc-handled-backends)))) 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 ;;;###autoload
(define-minor-mode diff-hl-dired-mode (define-minor-mode diff-hl-dired-mode
"Toggle VC diff highlighting on the side of a Dired window." "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)) (goto-char (point-min))
(when (and type (dired-goto-file-1 (when (and type (dired-goto-file-1
file (expand-file-name file) nil)) 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) (diff-hl-fringe-face-function 'diff-hl-dired-face-from-type)
(o (diff-hl-add-highlighting type 'single))) (o (diff-hl-add-highlighting type 'single)))
(overlay-put o 'modification-hooks '(diff-hl-overlay-modified)) (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> ;; Author: Jonathan Hayase <PythonNut@gmail.com>
;; URL: https://github.com/dgutov/diff-hl ;; URL: https://github.com/dgutov/diff-hl
@@ -40,9 +40,13 @@
(defvar diff-hl-flydiff-timer nil) (defvar diff-hl-flydiff-timer nil)
(make-variable-buffer-local 'diff-hl-flydiff-modified-tick) (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)) (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 () (defun diff-hl-flydiff-update ()
(unless (or (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-function nil)
(defvar diff-hl-margin-old-highlight-ref-function nil)
(defvar diff-hl-margin-old-width nil) (defvar diff-hl-margin-old-width nil)
(defgroup diff-hl-margin nil (defgroup diff-hl-margin nil
@@ -66,13 +68,25 @@
'((default :inherit dired-ignored)) '((default :inherit dired-ignored))
"Face used to highlight changed lines on the margin.") "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 (defcustom diff-hl-margin-symbols-alist
'((insert . "+") (delete . "-") (change . "!") '((insert . "+") (delete . "-") (change . "!")
(unknown . "?") (ignored . "i")) (unknown . "?") (ignored . "i") (reference . " "))
"Associative list from symbols to strings." "Associative list from symbols to strings."
:type '(alist :key-type symbol :type '(alist :key-type symbol
:value-type string :value-type string
:options (insert delete change unknown ignored)) :options (insert delete change unknown ignored reference))
:set (lambda (symbol value) :set (lambda (symbol value)
(defvar diff-hl-margin-spec-cache) (defvar diff-hl-margin-spec-cache)
(set-default symbol value) (set-default symbol value)
@@ -112,12 +126,17 @@ You probably shouldn't use this function directly."
(progn (progn
(setq-local diff-hl-margin-old-highlight-function (setq-local diff-hl-margin-old-highlight-function
diff-hl-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 (setq-local diff-hl-highlight-function
#'diff-hl-highlight-on-margin) #'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)) (setq-local diff-hl-margin-old-width (symbol-value width-var))
(set width-var 1)) (set width-var 1))
(when diff-hl-margin-old-highlight-function (when diff-hl-margin-old-highlight-function
(setq diff-hl-highlight-function 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)) diff-hl-margin-old-highlight-function nil))
(set width-var diff-hl-margin-old-width) (set width-var diff-hl-margin-old-width)
(kill-local-variable '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)))) (diff-hl-margin-build-spec-cache))))
(defun 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
nconc (cl-loop for (type . char) in diff-hl-margin-symbols-alist
(cl-loop for side in '(left right) unless (eq type 'reference)
collect nconc
(cons (cl-loop for side in '(left right)
(cons type side) collect
(propertize (cons
" " 'display (cons type side)
`((margin ,(intern (format "%s-margin" side))) (propertize
,(propertize char 'face " " 'display
(intern (format "diff-hl-margin-%s" type))))))))) `((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 () (defun diff-hl-margin-ensure-visible ()
(let ((width-var (intern (format "%s-margin-width" diff-hl-side)))) (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))))) (diff-hl-margin-spec-cache)))))
(overlay-put ovl 'before-string spec))) (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) (provide 'diff-hl-margin)
;;; diff-hl-margin.el ends here ;;; 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 -*- ;; -*- no-byte-compile: t; lexical-binding: nil -*-
(define-package "diff-hl" "20250710.145" (define-package "diff-hl" "20251125.238"
"Highlight uncommitted changes using VC." "Highlight uncommitted changes using VC."
'((cl-lib "0.2") '((cl-lib "0.2")
(emacs "26.1")) (emacs "26.1"))
:url "https://github.com/dgutov/diff-hl" :url "https://github.com/dgutov/diff-hl"
:commit "08243a6e0b681c34eb4e4abf1d1c4c1b251ce91e" :commit "8dc486f568afa08dcf9932f4045677df6f5a23f8"
:revdesc "08243a6e0b68" :revdesc "8dc486f568af"
:keywords '("vc" "diff") :keywords '("vc" "diff")
:authors '(("Dmitry Gutov" . "dmitry@gutov.dev")) :authors '(("Dmitry Gutov" . "dmitry@gutov.dev"))
:maintainers '(("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: ;;; Commentary:
;; `diff-hl-show-hunk' shows a popup with the modification hunk at point. ;; `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 ;; `diff-hl-show-hunk-function' points to the backend used to show the hunk.
;; hunk. Its default value is `diff-hl-show-hunk-inline-popup', that ;; Its default value is `diff-hl-show-hunk-inline', that shows diffs inline
;; shows diffs inline using overlay. There is another built-in backend: ;; using overlay. There is another built-in backend:
;; `diff-hl-show-hunk-posframe' (based on posframe). ;; `diff-hl-show-hunk-posframe' (based on posframe).
;; ;;
;; `diff-hl-show-hunk-mouse-mode' adds interaction on clicking in the ;; `diff-hl-show-hunk-mouse-mode' adds interaction on clicking in the
@@ -36,9 +36,31 @@
;;; Code: ;;; Code:
(require 'diff-hl-inline-popup)
(require 'diff-hl) (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 (defvar diff-hl-show-hunk-mouse-mode-map
(let ((map (make-sparse-keymap))) (let ((map (make-sparse-keymap)))
(define-key map (kbd "<left-margin> <mouse-1>") 'diff-hl-show-hunk--click) (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 (defvar diff-hl-show-hunk--original-overlay nil
"Copy of the diff-hl hunk overlay.") "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-boundary "^@@.*@@")
(defconst diff-hl-show-hunk--no-lines-removed-message (list "<<no lines removed>>")) (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 (defvar diff-hl-show-hunk--hide-function nil
"Function to call to close the shown hunk.") "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) (defun diff-hl-show-hunk-ignorable-command-p (command)
"Decide if COMMAND is a command allowed while showing the current hunk." "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 () (defun diff-hl-show-hunk--compute-diffs ()
"Compute diffs using functions of diff-hl. "Compute diffs using functions of diff-hl.
@@ -136,7 +134,10 @@ buffer."
(line (line-number-at-pos)) (line (line-number-at-pos))
(dest-buffer diff-hl-show-hunk-diff-buffer-name)) (dest-buffer diff-hl-show-hunk-diff-buffer-name))
(with-current-buffer buffer (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) (switch-to-buffer dest-buffer)
(diff-hl-diff-skip-to line) (diff-hl-diff-skip-to line)
(setq vc-sentinel-movepoint (point))) (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) (define-key map (kbd "S") #'diff-hl-show-hunk-stage-hunk)
map)) 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 () (defun diff-hl-show-hunk-copy-original-text ()
"Extracts all the lines from BUFFER starting with '-' to the kill ring." "Extracts all the lines from BUFFER starting with '-' to the kill ring."
(interactive) (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 -*- ;; -*- no-byte-compile: t; lexical-binding: nil -*-
(define-package "emacsql" "20250601.1009" (define-package "emacsql" "20251116.1655"
"High-level SQL database front-end." "High-level SQL database front-end."
'((emacs "26.1")) '((emacs "26.1"))
:url "https://github.com/magit/emacsql" :url "https://github.com/magit/emacsql"
:commit "ced062890061b6e4fbe4d00c0617f7ff84fff25c" :commit "e1908de2cf2c7b77798ef6645d514dded1d7f8a4"
:revdesc "ced062890061" :revdesc "e1908de2cf2c"
:authors '(("Christopher Wellons" . "wellons@nullprogram.com")) :authors '(("Christopher Wellons" . "wellons@nullprogram.com"))
:maintainers '(("Jonas Bernoulli" . "emacs.emacsql@jonas.bernoulli.dev"))) :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)) (and (oref connection handle) t))
(cl-defmethod emacsql-close ((connection emacsql-sqlite-builtin-connection)) (cl-defmethod emacsql-close ((connection emacsql-sqlite-builtin-connection))
(sqlite-close (oref connection handle)) (when (oref connection handle)
(oset connection handle nil)) (sqlite-close (oref connection handle))
(oset connection handle nil)))
(cl-defmethod emacsql-send-message (cl-defmethod emacsql-send-message
((connection emacsql-sqlite-builtin-connection) 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)) (and (oref connection handle) t))
(cl-defmethod emacsql-close ((connection emacsql-sqlite-module-connection)) (cl-defmethod emacsql-close ((connection emacsql-sqlite-module-connection))
(sqlite3-close (oref connection handle)) (when (oref connection handle)
(oset connection handle nil)) (sqlite3-close (oref connection handle))
(oset connection handle nil)))
(cl-defmethod emacsql-send-message (cl-defmethod emacsql-send-message
((connection emacsql-sqlite-module-connection) 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> ;; Maintainer: Jonas Bernoulli <emacs.emacsql@jonas.bernoulli.dev>
;; Homepage: https://github.com/magit/emacsql ;; Homepage: https://github.com/magit/emacsql
;; Package-Version: 20250601.1009 ;; Package-Version: 20251116.1655
;; Package-Revision: ced062890061 ;; Package-Revision: e1908de2cf2c
;; Package-Requires: ((emacs "26.1")) ;; Package-Requires: ((emacs "26.1"))
;; SPDX-License-Identifier: Unlicense ;; SPDX-License-Identifier: Unlicense
@@ -19,6 +19,11 @@
;; PostgreSQL and MySQL are also supported, but use of these connectors ;; PostgreSQL and MySQL are also supported, but use of these connectors
;; is not recommended. ;; 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. ;; See README.md for much more complete documentation.
;;; Code: ;;; Code:
@@ -33,7 +38,7 @@
"The EmacSQL SQL database front-end." "The EmacSQL SQL database front-end."
:group 'comm) :group 'comm)
(defconst emacsql-version "4.3.1") (defconst emacsql-version "4.3.3")
(defvar emacsql-global-timeout 30 (defvar emacsql-global-timeout 30
"Maximum number of seconds to wait before bailing out on a SQL command. "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) :type '(repeat string)
:group 'ess :group 'ess
:package-version '(ess . "25.01.1")) :package-version '(ess . "25.01.1"))
(defvar ess-S-assign) (defvar ess-S-assign)
(make-obsolete-variable 'ess-S-assign 'ess-assign-list "ESS 18.10") (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; -*- ;;; 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> ;; Author: David Smith <dsmith@stats.adelaide.edu.au>
;; Created: 7 Jan 1994 ;; 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-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 "\C-d" #'delete-char) ; EOF no good in S
(define-key map "\t" #'completion-at-point) (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 "\C-c\C-k" #'ess-request-a-process)
(define-key map "," #'ess-smart-comma) (define-key map "," #'ess-smart-comma)
(define-key map "\C-c\C-d" 'ess-doc-map) (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) (defun ess--inject-code-from-file (file &optional chunked)
"Load code from FILE into process. "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." bol) and load each chunk separately."
;; This is different from ess-load-file as it works by directly loading the ;; This is different from ess-load-file as it works by directly loading the
;; string into the process and thus works on remotes. ;; 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 -*- ;; -*- no-byte-compile: t; lexical-binding: nil -*-
(define-package "ess" "20250606.831" (define-package "ess" "20251015.1619"
"Emacs Speaks Statistics." "Emacs Speaks Statistics."
'((emacs "25.1")) '((emacs "25.1"))
:url "https://ess.r-project.org/" :url "https://ess.r-project.org/"
:commit "cd85d1e1f0e897b409a948a3a4afdaffe032812e" :commit "a7d685bd9a3dbc8540edf86318012a0a0528e49e"
:revdesc "cd85d1e1f0e8" :revdesc "a7d685bd9a3d"
:authors '(("David Smith" . "dsmith@stats.adelaide.edu.au") :authors '(("David Smith" . "dsmith@stats.adelaide.edu.au")
("A.J. Rossini" . "blindglobe@gmail.com") ("A.J. Rossini" . "blindglobe@gmail.com")
("Richard M. Heiberger" . "rmh@temple.edu") ("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 ;; 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 ;; syntax checking. This file adds support for this in ess-r-mode by
;; relying on the lintr package, available on CRAN and currently ;; 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: ;;; 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--flymake-proc nil)
(defvar-local ess-r--lintr-file 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 (defvar ess-r--flymake-def-linter
(replace-regexp-in-string (replace-regexp-in-string
"[\n\t ]+" " " "[\n\t ]+" " "
"esslint <- function(str, ...) { "esslint <- function(str, ...) {
if (!suppressWarnings(require(lintr, quietly=T))) { if (!suppressWarnings(requireNamespace('lintr', quietly=TRUE))) {
cat('@@error: @@`lintr` package not installed') cat('@@error: @@`lintr` package not installed')
} else if (packageVersion('lintr') <= '3.0.0') {
cat('@@error: @@Need `lintr` version > v3.0.0')
} else { } else {
if (packageVersion('lintr') <= '3.0.0') { tryCatch(lintr::lint(text=str, ..., parse_settings=TRUE),
cat('@@error: @@Need `lintr` version > v3.0.0') error = function(e) {
} else { cat('@@warning: @@', conditionMessage(e))
tryCatch(lintr::lint(commandArgs(TRUE), ...), })
error = function(e) {
cat('@@warning: @@', conditionMessage(e))
})
}
} }
};")) };"))
(defun ess-r--find-lintr-file () (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 Check first the current directory, then the project root, then
the package root, then the user's home directory. Return nil if the package root, then the user's home directory. Return nil if
we couldn't find a .lintr file." 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; -*- ;;; 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 ;; Author: A.J. Rossini
;; Created: 12 Jun 1997 ;; Created: 12 Jun 1997
;; Maintainer: ESS-core <ESS-core@r-project.org> ;; Maintainer: ESS-core <ESS-core@r-project.org>
@@ -264,7 +264,7 @@ value by using `ess-r-runners-reset'."
(defvar ess-r-mode-map (defvar ess-r-mode-map
(let ((map (make-sparse-keymap))) (let ((map (make-sparse-keymap)))
(define-key map (kbd "C-c C-=") #'ess-cycle-assign) (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) (define-key map (kbd "C-c C-.") 'ess-rutils-map)
map)) map))
@@ -992,7 +992,7 @@ as `ess-r-created-runners' upon ESS initialization."
(message "Recreated %d R versions known to ESS: %s" (message "Recreated %d R versions known to ESS: %s"
(length versions) versions)) (length versions) versions))
(if ess-microsoft-p (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)) (mapc (lambda (v) (ess-define-runner v "R")) versions))
;; Add to menu ;; Add to menu
(when ess-r-created-runners (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 Send the contents of the etc/ESSR/R directory to the remote
process through the process connection file by file. Then, process through the process connection file by file. Then,
collect all the objects into an ESSR environment and attach to 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." separators and send chunk by chunk."
(ess-command (format ".ess.ESSRversion <<- '%s'\n" essr-version)) (ess-command (format ".ess.ESSRversion <<- '%s'\n" essr-version))
(with-temp-message "Loading ESSR into remote ..." (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; -*- ;; 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> ;; Author: KH <Kurt.Hornik@ci.tuwien.ac.at>
;; Created: 25 July 1997 ;; Created: 25 July 1997
;; Maintainer: ESS-core <ESS-core@r-project.org> ;; Maintainer: ESS-core <ESS-core@r-project.org>
@@ -48,6 +48,7 @@
("`al" "\\alias" nil :system t) ("`al" "\\alias" nil :system t)
("`au" "\\author" nil :system t) ("`au" "\\author" nil :system t)
("`bf" "\\bold" nil :system t) ("`bf" "\\bold" nil :system t)
;; not (yet) "bibcitep" "bibcitet" "bibshow" "bibinfo"
("`co" "\\code" nil :system t) ("`co" "\\code" nil :system t)
("`de" "\\describe" nil :system t) ("`de" "\\describe" nil :system t)
("`dn" "\\description" nil :system t) ("`dn" "\\description" nil :system t)
@@ -62,6 +63,7 @@
("`kw" "\\keyword" nil :system t) ("`kw" "\\keyword" nil :system t)
("`li" "\\link" nil :system t) ("`li" "\\link" nil :system t)
("`me" "\\method" nil :system t) ("`me" "\\method" nil :system t)
("`ma" "\\manual" nil :system t)
("`na" "\\name" nil :system t) ("`na" "\\name" nil :system t)
("`no" "\\note" nil :system t) ("`no" "\\note" nil :system t)
("`re" "\\references" nil :system t) ("`re" "\\references" nil :system t)
@@ -122,7 +124,7 @@ All Rd mode abbrevs start with a grave accent (`)."
"tabular" "title" "usage" "tabular" "title" "usage"
"value")) "value"))
(defvar Rd-keywords (defvar Rd-keywords ; to be highlighted in Rd-mode
'( '(
;; the next two lines: only valid in R <= 2.8.1 ;; the next two lines: only valid in R <= 2.8.1
;; commented out on 2011-01-14 for ESS version 5.13: ;; 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" "href"
"ifelse" "if" "ifelse" "if"
"item" "kbd" "ldots" "linkS4class" "link" "method" "item" "kbd" "ldots" "linkS4class" "link" "method"
"manual"
"newcommand" "option" "out" "newcommand" "option" "out"
"pkg" "sQuote" "renewcommand" "pkg" "sQuote" "renewcommand"
"samp" "strong" "tab" "url" "var" "verb" "samp" "strong" "tab" "url" "var" "verb"
;; System macros (from <R>/share/Rd/macros/system.Rd ): ;; System macros (from <R>/share/Rd/macros/system.Rd ):
"bibcitep" "bibcitet" "bibshow" "bibinfo"
"CRANpkg" "PR" "sspace" "doi" "CRANpkg" "PR" "sspace" "doi"
"I" ; should we?
"LaTeX" "LaTeX"
"proglang" "proglang"
"packageTitle" "packageDescription" "packageAuthor" "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; -*- ;; 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 ;; Author: Vitalie Spinu
;; Maintainer: Vitalie Spinu ;; Maintainer: Vitalie Spinu
;; Created: Oct 14 14:15:22 2010 ;; 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) (setq-local compilation-error-regexp-alist ess-error-regexp-alist)
(let (compilation-mode-font-lock-keywords) (let (compilation-mode-font-lock-keywords)
(compilation-setup t)) (compilation-setup t))
(setq next-error-function 'ess-tracebug-next-error-function) (setq next-error-function #'ess-tracebug-next-error-function)
;; new locals ;; new locals
(make-local-variable 'ess--tb-last-input) (make-local-variable 'ess--tb-last-input)
(make-local-variable 'ess--tb-last-input-overlay) (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) (defun ess-mpi-handle-messages (buf)
"Handle all mpi messages in BUF and delete them. "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 type of the messages on which handlers in `ess-mpi-handlers' are
dispatched. And FIELDs are strings. Return :incomplete if BUF dispatched, \\^C are ASCII control chars, and FIELDs are strings.
ends with an incomplete message." Return `:incomplete' if BUF ends with an incomplete message."
(let ((obuf (current-buffer)) (let ((obuf (current-buffer))
(out nil)) (out nil))
(with-current-buffer buf (with-current-buffer buf
@@ -1992,6 +1992,9 @@ Each sublist has five elements:
doesn't apply to current context." doesn't apply to current context."
:group 'ess-debug :group 'ess-debug
:type '(alist :key-type symbol :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))) :value-type (group string string symbol face)))
(defcustom ess-bp-inactive-spec (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 ;; `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 ;; the R expression is meaningless here." ;;fixme: second element is missing make it nil for consistency with all other specs
:group 'ess-debug :group 'ess-debug
:type 'list) :type '(alist :key-type symbol
:value-type (group string string symbol face)))
(defcustom ess-bp-conditional-spec (defcustom ess-bp-conditional-spec
'(conditional "browser(expr={%s})" "CB[ %s ]>\n" question-mark ess-bp-fringe-browser-face) '(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 expression to be replaced instead of %s in the second and third
elements of the specifications." elements of the specifications."
:group 'ess-debug :group 'ess-debug
:type 'list) :type '(alist :key-type symbol
:value-type (group string string symbol face)))
(defcustom ess-bp-logger-spec (defcustom ess-bp-logger-spec
'(logger ".ess_log_eval('%s')" "L[ \"%s\" ]>\n" hollow-square ess-bp-fringe-logger-face) '(logger ".ess_log_eval('%s')" "L[ \"%s\" ]>\n" hollow-square ess-bp-fringe-logger-face)
"List giving the loggers specifications. "List giving the loggers specifications.
List format is identical to that of `ess-bp-type-spec-alist'." List format is identical to that of `ess-bp-type-spec-alist'."
:group 'ess-debug :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) (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 (defun ess-bp-next nil
"Goto next breakpoint." "Goto next breakpoint."
(interactive) (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 (save-excursion
(goto-char bp-pos) (goto-char bp-pos)
(when (get-text-property (1- (point)) 'ess-bp) (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 (defun ess-bp-previous nil
"Goto previous breakpoint." "Goto previous breakpoint."
(interactive) (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) (goto-char (or (previous-single-property-change bp-pos 'ess-bp)
bp-pos)) bp-pos))
(message "No breakpoints before the point found"))) (message "No breakpoints before the point found")))
@@ -2820,7 +2826,10 @@ for signature and trace it with browser tracer."
"*ALL*")) "*ALL*"))
(setq fun (ess-completing-read "Undebug" debugged nil t nil nil def-val)) (setq fun (ess-completing-read "Undebug" debugged nil t nil nil def-val))
(if (equal fun "*ALL*" ) (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)) (ess-command (format ".ess_dbg_UntraceOrUndebug(\"%s\")\n" fun) tbuffer))
(with-current-buffer tbuffer (with-current-buffer tbuffer
(if (= (point-max) 1) ;; not reliable TODO: (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; -*- ;;; 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> ;; Author: David Smith <dsmith@stats.adelaide.edu.au>
;; A.J. Rossini <blindglobe@gmail.com> ;; A.J. Rossini <blindglobe@gmail.com>
@@ -17,8 +17,8 @@
;; ;;
;; Maintainer: ESS Core Team <ESS-core@r-project.org> ;; Maintainer: ESS Core Team <ESS-core@r-project.org>
;; Created: 7 Jan 1994 ;; Created: 7 Jan 1994
;; Package-Version: 20250606.831 ;; Package-Version: 20251015.1619
;; Package-Revision: cd85d1e1f0e8 ;; Package-Revision: a7d685bd9a3d
;; URL: https://ess.r-project.org/ ;; URL: https://ess.r-project.org/
;; Package-Requires: ((emacs "25.1")) ;; Package-Requires: ((emacs "25.1"))
;; ESSR-Version: 1.8 ;; ESSR-Version: 1.8
@@ -129,7 +129,7 @@ Is set by \\[ess-version-string].")
(interactive) (interactive)
(let ((reporter-prompt-for-summary-p 't)) (let ((reporter-prompt-for-summary-p 't))
(reporter-submit-bug-report (reporter-submit-bug-report
"ess-bugs@r-project.org" "ess-help@r-project.org"
(concat "ess-mode " (ess-version-string)) (concat "ess-mode " (ess-version-string))
(list 'ess-language (list 'ess-language
'ess-dialect 'ess-dialect
@@ -151,10 +151,12 @@ Is set by \\[ess-version-string].")
;;(goto-char (point-max)) ;;(goto-char (point-max))
(rfc822-goto-eoh) (rfc822-goto-eoh)
(forward-line 1) (forward-line 1)
(insert "\n\n-------------------------------------------------------\n") (insert "\n\n-------------------------------------------------------------\n")
(insert "This bug report will be sent to the ESS bugs email list\n") (insert "This bug report will be sent to the ESS _help_ email list\n")
(insert "Press C-c C-c when you are ready to send your message.\n") (insert ">>> _INSTEAD_ we strongly recommend you open an issue for this\n")
(insert "-------------------------------------------------------\n\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 (insert (with-current-buffer ess-dribble-buffer
(goto-char (point-max)) (goto-char (point-max))
(forward-line -100) (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 INFO-DIR-SECTION Emacs
START-INFO-DIR-ENTRY 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 suggest the related polymodes including poly-noweb, poly-markdown
and poly-R (installed in that order). The package polymode itself, and poly-R (installed in that order). The package polymode itself,
as well as the polymodes packages, are all on MELPA rather than 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 archives as follows. ‘(add-to-list 'package-archives
'("melpa-stable" . "https://stable.melpa.org/packages/"))’ for ‘M-x '("melpa-stable" . "https://stable.melpa.org/packages/"))’ for ‘M-x
package-install’ package-install’
@@ -2896,7 +2896,6 @@ are available:
M-U . Up frame . `ess-debug-command-up' M-U . Up frame . `ess-debug-command-up'
M-Q . Quit debugging . `ess-debug-command-quit' M-Q . Quit debugging . `ess-debug-command-quit'
These are all the tracebug commands defined in ‘ess-dev-map’ (‘C-c These are all the tracebug commands defined in ‘ess-dev-map’ (‘C-c
C-t ?’ to show this table): C-t ?’ to show this table):
@@ -2933,7 +2932,6 @@ C-t ?’ to show this table):
? . Show this help . `ess-tracebug-show-help' ? . Show this help . `ess-tracebug-show-help'
To configure how electric watch window splits the display see To configure how electric watch window splits the display see
‘ess-watch-width-threshold’ and ‘ess-watch-height-threshold’ variables. ‘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 ## myfile.Rout. With this suffix, the file will be opened in
## ess-transcript. ## ess-transcript.
 
File: ess.info, Node: ESS for SAS, Next: ESS for BUGS, Prev: ESS for R, Up: Top 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 16.2 Reporting Bugs
=================== ===================
Please send bug reports, suggestions etc. to <ESS-bugs@r-project.org>, Please post bug reports, suggestions etc. on our github issue tracker
or post them on our github issue tracker (https://github.com/emacs-ess/ESS/issues); if not possible, e-mail them
(https://github.com/emacs-ess/ESS/issues) 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’ ‘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 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 "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, to the list may be mailed to <ess-help@r-project.org>. Rest assured,
this is a fairly low-volume mailing list. this is a fairly low-volume mailing list.
@@ -5052,113 +5049,112 @@ Concept Index
* X Windows: X11. (line 6) * X Windows: X11. (line 6)
* xref: Xref. (line 6) * xref: Xref. (line 6)
 
Tag Table: Tag Table:
Node: Top270 Node: Top268
Node: Introduction2908 Node: Introduction2906
Node: Features5694 Node: Features5692
Node: Current Features6520 Node: Current Features6518
Node: New features10067 Node: New features10065
Node: Credits37886 Node: Credits37885
Node: Manual41545 Node: Manual41544
Node: Installation44255 Node: Installation44254
Node: Installing from a third-party repository45192 Node: Installing from a third-party repository45191
Node: Installing from source46139 Node: Installing from source46138
Node: Activating and Loading ESS47763 Node: Activating and Loading ESS47762
Node: Check Installation48845 Node: Check Installation48844
Node: Interactive ESS49069 Node: Interactive ESS49068
Node: Starting up49914 Node: Starting up49913
Node: Multiple ESS processes50674 Node: Multiple ESS processes50673
Node: ESS processes on Remote Computers51787 Node: ESS processes on Remote Computers51786
Node: Customizing startup56014 Node: Customizing startup56013
Node: Controlling buffer display58996 Node: Controlling buffer display58995
Node: Entering commands61633 Node: Entering commands61632
Node: Command-line editing62795 Node: Command-line editing62794
Node: Transcript64060 Node: Transcript64059
Node: Last command65857 Node: Last command65856
Node: Process buffer motion67315 Node: Process buffer motion67314
Node: Transcript resubmit68858 Node: Transcript resubmit68857
Node: Saving transcripts70855 Node: Saving transcripts70854
Node: Command History72689 Node: Command History72688
Node: Saving History76190 Node: Saving History76189
Node: History expansion76971 Node: History expansion76970
Node: Hot keys80362 Node: Hot keys80361
Node: Statistical Process running in ESS?84532 Node: Statistical Process running in ESS?84531
Node: Emacsclient85879 Node: Emacsclient85878
Node: Other86699 Node: Other86698
Node: Evaluating code87742 Node: Evaluating code87741
Node: Transcript Mode91674 Node: Transcript Mode91673
Node: Resubmit92847 Node: Resubmit92846
Node: Clean93922 Node: Clean93921
Node: Editing objects94922 Node: Editing objects94921
Node: Edit buffer96040 Node: Edit buffer96039
Node: Loading98130 Node: Loading98129
Node: Error Checking99185 Node: Error Checking99184
Node: Indenting100258 Node: Indenting100257
Node: Styles103410 Node: Styles103409
Node: Other edit buffer commands105912 Node: Other edit buffer commands105911
Node: Source Files107624 Node: Source Files107623
Node: Source Directories112340 Node: Source Directories112339
Node: Help115549 Node: Help115548
Node: Completion120251 Node: Completion120250
Node: Object names120466 Node: Object names120465
Node: Function arguments123180 Node: Function arguments123179
Node: Minibuffer completion124159 Node: Minibuffer completion124158
Node: Company124657 Node: Company124656
Node: Icicles125056 Node: Icicles125055
Node: Developing with ESS126432 Node: Developing with ESS126431
Node: ESS tracebug126878 Node: ESS tracebug126877
Node: Getting started with tracebug129937 Node: Getting started with tracebug129934
Node: Editing documentation132223 Node: Editing documentation132220
Node: R documentation files132775 Node: R documentation files132772
Node: roxygen2136590 Node: roxygen2136587
Node: Namespaced Evaluation141113 Node: Namespaced Evaluation141110
Node: Extras143127 Node: Extras143124
Node: ESS ElDoc144151 Node: ESS ElDoc144148
Node: ESS Flymake145731 Node: ESS Flymake145728
Node: Handy commands146861 Node: Handy commands146858
Node: Highlighting148138 Node: Highlighting148135
Node: Parens149189 Node: Parens149186
Node: Graphics149665 Node: Graphics149662
Node: printer150336 Node: printer150333
Node: X11151108 Node: X11151105
Node: winjava151447 Node: winjava151444
Node: Imenu151859 Node: Imenu151856
Node: Toolbar152714 Node: Toolbar152711
Node: Xref153122 Node: Xref153119
Node: Rdired153450 Node: Rdired153447
Node: Package listing154529 Node: Package listing154526
Node: Org155977 Node: Org155974
Node: Sweave and AUCTeX156931 Node: Sweave and AUCTeX156928
Node: ESS for R159563 Node: ESS for R159560
Node: ESS(R)--Editing files159863 Node: ESS(R)--Editing files159860
Node: iESS(R)--Inferior ESS processes160368 Node: iESS(R)--Inferior ESS processes160365
Node: Philosophies for using ESS(R)163087 Node: Philosophies for using ESS(R)163084
Node: Example ESS usage164014 Node: Example ESS usage164011
Node: ESS for SAS165419 Node: ESS for SAS165415
Node: ESS(SAS)--Design philosophy166146 Node: ESS(SAS)--Design philosophy166142
Node: ESS(SAS)--Editing files167083 Node: ESS(SAS)--Editing files167079
Node: ESS(SAS)--TAB key169027 Node: ESS(SAS)--TAB key169023
Node: ESS(SAS)--Batch SAS processes170441 Node: ESS(SAS)--Batch SAS processes170437
Node: ESS(SAS)--Function keys for batch processing175661 Node: ESS(SAS)--Function keys for batch processing175657
Node: iESS(SAS)--Interactive SAS processes185568 Node: iESS(SAS)--Interactive SAS processes185564
Node: iESS(SAS)--Common problems189510 Node: iESS(SAS)--Common problems189506
Node: ESS(SAS)--Graphics191124 Node: ESS(SAS)--Graphics191120
Node: ESS(SAS)--Windows191923 Node: ESS(SAS)--Windows191919
Node: ESS for BUGS192507 Node: ESS for BUGS192503
Node: ESS for JAGS194319 Node: ESS for JAGS194315
Node: Mailing lists/bug reports197815 Node: Mailing lists/bug reports197811
Node: Bugs198079 Node: Bugs198075
Node: Reporting Bugs199755 Node: Reporting Bugs199751
Node: Mailing Lists200652 Node: Mailing Lists200670
Node: Help with Emacs201389 Node: Help with Emacs201408
Node: Customization201925 Node: Customization201944
Node: Indices202703 Node: Indices202722
Node: Key index202878 Node: Key index202897
Node: Function and program index208010 Node: Function and program index208029
Node: Variable index217430 Node: Variable index217449
Node: Concept index220991 Node: Concept index221010
 
End Tag Table End Tag Table
lisp/flycheck/flycheck-pkg.el
+5 -4
View File
@@ -1,10 +1,11 @@
;; -*- no-byte-compile: t; lexical-binding: nil -*- ;; -*- no-byte-compile: t; lexical-binding: nil -*-
(define-package "flycheck" "20250527.907" (define-package "flycheck" "20251119.1203"
"On-the-fly syntax checking." "On-the-fly syntax checking."
'((emacs "27.1")) '((emacs "27.1")
(seq "2.24"))
:url "https://www.flycheck.org" :url "https://www.flycheck.org"
:commit "a4d782e7af12e20037c0cecf0d4386cd2676c085" :commit "1eafe2911d50c9f58efce81ff8abea59495e1ff3"
:revdesc "a4d782e7af12" :revdesc "1eafe2911d50"
:keywords '("convenience" "languages" "tools") :keywords '("convenience" "languages" "tools")
:authors '(("Sebastian Wiesner" . "swiesner@lunaryorn.com")) :authors '(("Sebastian Wiesner" . "swiesner@lunaryorn.com"))
:maintainers '(("Clément Pit-Claudel" . "clement.pitclaudel@live.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> ;; Bozhidar Batsov <bozhidar@batsov.dev>
;; URL: https://www.flycheck.org ;; URL: https://www.flycheck.org
;; Keywords: convenience, languages, tools ;; Keywords: convenience, languages, tools
;; Package-Version: 20250527.907 ;; Package-Version: 20251119.1203
;; Package-Revision: a4d782e7af12 ;; Package-Revision: 1eafe2911d50
;; Package-Requires: ((emacs "27.1")) ;; Package-Requires: ((emacs "27.1") (seq "2.24"))
;; This file is not part of GNU Emacs. ;; 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 (flycheck-def-config-file-var flycheck-python-ruff-config python-ruff
'("pyproject.toml" "ruff.toml" ".ruff.toml")) '("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 (flycheck-define-checker python-ruff
"A Python syntax and style checker using Ruff. "A Python syntax and style checker using Ruff.
@@ -10907,14 +10916,16 @@ See URL `https://docs.astral.sh/ruff/'."
:error-patterns :error-patterns
((error line-start ((error line-start
(or "-" (file-name)) ":" line ":" (optional column ":") " " (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)) (message (one-or-more not-newline))
line-end) line-end)
(warning line-start (warning line-start
(or "-" (file-name)) ":" line ":" (optional column ":") " " (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)) (message (one-or-more not-newline))
line-end)) line-end))
:error-explainer flycheck-python-ruff-explainer
:working-directory flycheck-python-find-project-root :working-directory flycheck-python-find-project-root
:modes (python-mode python-ts-mode) :modes (python-mode python-ts-mode)
:next-checkers ((warning . python-mypy))) :next-checkers ((warning . python-mypy)))
@@ -12502,13 +12513,25 @@ or added as a shellcheck directive before the source command:
:safe #'booleanp :safe #'booleanp
:package-version '(flycheck . "31")) :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 (flycheck-define-checker sh-shellcheck
"A shell script syntax and style checker using Shellcheck. "A shell script syntax and style checker using Shellcheck.
See URL `https://github.com/koalaman/shellcheck/'." See URL `https://github.com/koalaman/shellcheck/'."
:command ("shellcheck" :command ("shellcheck"
"--format" "checkstyle" "--format" "checkstyle"
"--shell" (eval (symbol-name sh-shell)) (eval
(unless flycheck-shellcheck-infer-shell
(list "--shell" (symbol-name sh-shell))))
(option-flag "--external-sources" (option-flag "--external-sources"
flycheck-shellcheck-follow-sources) flycheck-shellcheck-follow-sources)
(option "--exclude" flycheck-shellcheck-excluded-warnings list (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. ;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License ;; 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: ;;; Commentary:
@@ -84,7 +84,7 @@
;; ;;
;; The parsing machine and compiler are partially based on the ;; The parsing machine and compiler are partially based on the
;; description in Medeiros and Ierusalimschy 2008, "A Parsing Machine ;; 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 ;; The pattern-matching language
;; ============================= ;; =============================
lisp/gnuplot/gnuplot-gui.el
+1 -1
View File
@@ -17,7 +17,7 @@
;; GNU General Public License for more details. ;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License ;; 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: ;;; Commentary:
lisp/gnuplot/gnuplot-pkg.el
+3 -3
View File
@@ -1,11 +1,11 @@
;; -*- no-byte-compile: t; lexical-binding: nil -*- ;; -*- no-byte-compile: t; lexical-binding: nil -*-
(define-package "gnuplot" "20250613.1223" (define-package "gnuplot" "20250724.1531"
"Major-mode and interactive frontend for gnuplot." "Major-mode and interactive frontend for gnuplot."
'((emacs "28.1") '((emacs "28.1")
(compat "30")) (compat "30"))
:url "https://github.com/emacs-gnuplot/gnuplot" :url "https://github.com/emacs-gnuplot/gnuplot"
:commit "f10d42221856e86c57dd5cc7400c078c021ba710" :commit "43e9674b869475b1c2a32f045c167673eb2faae0"
:revdesc "f10d42221856" :revdesc "43e9674b8694"
:keywords '("data" "gnuplot" "plotting") :keywords '("data" "gnuplot" "plotting")
:maintainers '(("Maxime Tréca" . "maxime@gmail.com") :maintainers '(("Maxime Tréca" . "maxime@gmail.com")
("Daniel Mendler" . "mail@daniel-mendler.de"))) ("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 ;; Author: Jon Oddie, Bruce Ravel, Phil Type
;; Maintainer: Maxime Tréca <maxime@gmail.com>, Daniel Mendler <mail@daniel-mendler.de> ;; Maintainer: Maxime Tréca <maxime@gmail.com>, Daniel Mendler <mail@daniel-mendler.de>
;; Created: 1998 ;; Created: 1998
;; Package-Version: 20250613.1223 ;; Package-Version: 20250724.1531
;; Package-Revision: f10d42221856 ;; Package-Revision: 43e9674b8694
;; Keywords: data gnuplot plotting ;; Keywords: data gnuplot plotting
;; URL: https://github.com/emacs-gnuplot/gnuplot ;; URL: https://github.com/emacs-gnuplot/gnuplot
;; Package-Requires: ((emacs "28.1") (compat "30")) ;; Package-Requires: ((emacs "28.1") (compat "30"))
@@ -24,7 +24,7 @@
;; GNU General Public License for more details. ;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License ;; 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: ;;; 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 -*- ;; -*- no-byte-compile: t; lexical-binding: nil -*-
(define-package "htmlize" "20250704.1928" (define-package "htmlize" "20250724.1703"
"Convert buffer text and decorations to HTML." "Convert buffer text and decorations to HTML."
'((emacs "26.1")) '((emacs "26.1"))
:url "https://github.com/emacsorphanage/htmlize" :url "https://github.com/emacsorphanage/htmlize"
:commit "bf759aa3b2c4099a4252dccdc1db361fbb13a520" :commit "c9a8196a59973fabb3763b28069af9a4822a5260"
:revdesc "bf759aa3b2c4" :revdesc "c9a8196a5997"
:keywords '("hypermedia" "extensions") :keywords '("hypermedia" "extensions")
:authors '(("Hrvoje Niksic" . "hniksic@gmail.com")) :authors '(("Hrvoje Niksic" . "hniksic@gmail.com"))
:maintainers '(("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> ;; Author: Hrvoje Niksic <hniksic@gmail.com>
;; Homepage: https://github.com/emacsorphanage/htmlize ;; Homepage: https://github.com/emacsorphanage/htmlize
;; Keywords: hypermedia, extensions ;; Keywords: hypermedia, extensions
;; Package-Version: 20250704.1928 ;; Package-Version: 20250724.1703
;; Package-Revision: bf759aa3b2c4 ;; Package-Revision: c9a8196a5997
;; Package-Requires: ((emacs "26.1")) ;; Package-Requires: ((emacs "26.1"))
;; SPDX-License-Identifier: GPL-3.0-or-later ;; SPDX-License-Identifier: GPL-3.0-or-later
@@ -76,7 +76,7 @@
(require 'cl-lib) (require 'cl-lib)
(defconst htmlize-version "1.58") (defconst htmlize-version "1.59")
(defgroup htmlize nil (defgroup htmlize nil
"Convert buffer text and faces to HTML." "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 ;; overlays that specify the `face' property, even when they
;; contain smaller text properties that also specify `face'. ;; contain smaller text properties that also specify `face'.
;; Emacs display engine merges those faces, and so must we. ;; Emacs display engine merges those faces, and so must we.
(or limit (unless limit
(setq limit (point-max))) (setq limit (point-max)))
(let ((next-prop (next-single-property-change pos 'face nil limit)) (let ((next-prop (next-single-property-change pos 'face nil limit))
(overlay-faces (htmlize-overlay-faces-at pos))) (overlay-faces (htmlize-overlay-faces-at pos)))
(while (progn (while (progn
@@ -681,9 +681,9 @@ list."
(push (htmlize-get-text-with-display pos next-change) (push (htmlize-get-text-with-display pos next-change)
visible-list)) visible-list))
((and (eq show 'ellipsis) ((and (eq show 'ellipsis)
(not (eq last-show 'ellipsis)) (not (eq last-show 'ellipsis)))
;; Conflate successive ellipses. ;; Conflate successive ellipses.
(push htmlize-ellipsis visible-list)))) (push htmlize-ellipsis visible-list)))
(setq pos next-change last-show show)) (setq pos next-change last-show show))
(htmlize-concat (nreverse visible-list)))) (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) ;; specifying any color. Hence (htmlize-color-to-rgb nil)
;; returns nil. ;; returns nil.
) )
((string-match "\\`#" color) ((string-match "\\`#[0-9a-fA-F]\\{6\\}" color)
;; The color is already in #rrggbb format. ;; The color is already in #rrggbb format.
(setq rgb-string color)) (setq rgb-string color))
((and htmlize-use-rgb-txt ((and htmlize-use-rgb-txt
@@ -982,7 +982,7 @@ If no rgb.txt file is found, return nil."
foreground ; foreground color, #rrggbb foreground ; foreground color, #rrggbb
background ; background color, #rrggbb background ; background color, #rrggbb
size ; size size ; size
boldp ; whether face is bold boldp ; whether face is bold
italicp ; whether face is italic italicp ; whether face is italic
underlinep ; whether face is underlined underlinep ; whether face is underlined
overlinep ; whether face is overlined 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)) (def (cond ((stringp raw-def) (list :foreground raw-def))
((listp raw-def) raw-def) ((listp raw-def) raw-def)
(t (t
(error (format (concat "face override must be an " (error "Face override must be %s, got %S"
"attribute list or string, got %s") "an attribute list or string" raw-def)))))
raw-def))))))
(and def (and def
(htmlize-attrlist-to-fstruct def (symbol-name face))))) (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)))) (let ((sym (intern (format "htmlize-%s-%s" htmlize-output-type method))))
(indirect-function (if (fboundp sym) (indirect-function (if (fboundp sym)
sym sym
(let ((default (intern (concat "htmlize-default-" (let ((default (intern (format "htmlize-default-%s"
(symbol-name method))))) method))))
(if (fboundp default) (if (fboundp default)
default default
'ignore)))))) 'ignore))))))
lisp/ivy/ivy-pkg.el
+3 -3
View File
@@ -1,10 +1,10 @@
;; -*- no-byte-compile: t; lexical-binding: nil -*- ;; -*- no-byte-compile: t; lexical-binding: nil -*-
(define-package "ivy" "20250417.1209" (define-package "ivy" "20251123.1023"
"Incremental Vertical completYon." "Incremental Vertical completYon."
'((emacs "24.5")) '((emacs "24.5"))
:url "https://github.com/abo-abo/swiper" :url "https://github.com/abo-abo/swiper"
:commit "2529a23f9f510a94efa6c088bd14217aa764dafb" :commit "ec9421340c88ebe08f05680e22308ed57ed68a3d"
:revdesc "2529a23f9f51" :revdesc "ec9421340c88"
:keywords '("matching") :keywords '("matching")
:authors '(("Oleh Krehel" . "ohwoeowho@gmail.com")) :authors '(("Oleh Krehel" . "ohwoeowho@gmail.com"))
:maintainers '(("Basil L. Contovounesios" . "basil@contovou.net"))) :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> ;; Author: Oleh Krehel <ohwoeowho@gmail.com>
;; Maintainer: Basil L. Contovounesios <basil@contovou.net> ;; Maintainer: Basil L. Contovounesios <basil@contovou.net>
;; URL: https://github.com/abo-abo/swiper ;; URL: https://github.com/abo-abo/swiper
;; Package-Version: 20250417.1209 ;; Package-Version: 20251123.1023
;; Package-Revision: 2529a23f9f51 ;; Package-Revision: ec9421340c88
;; Package-Requires: ((emacs "24.5")) ;; Package-Requires: ((emacs "24.5"))
;; Keywords: matching ;; Keywords: matching
@@ -3171,11 +3171,11 @@ parts beyond their respective faces `ivy-confirm-face' and
`ivy-match-required-face'." `ivy-match-required-face'."
(dolist (pair '(("confirm" . ivy-confirm-face) (dolist (pair '(("confirm" . ivy-confirm-face)
("match required" . ivy-match-required-face))) ("match required" . ivy-match-required-face)))
(let ((i (string-match-p (car pair) prompt))) (let* ((beg (ivy--string-search (car pair) prompt))
(when i (end (and beg (+ beg (length (car pair))))))
(add-text-properties i (+ i (length (car pair))) (when beg
`(face ,(cdr pair) ,@props) (add-face-text-property beg end (cdr pair) nil prompt)
prompt)))) (add-text-properties beg end props prompt))))
prompt) prompt)
(defun ivy-prompt () (defun ivy-prompt ()
@@ -3215,6 +3215,25 @@ parts beyond their respective faces `ivy-confirm-face' and
(when line (push line lines))) (when line (push line lines)))
(string-join (nreverse lines) "\n")))) (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 () (defun ivy--insert-prompt ()
"Update the prompt according to `ivy--prompt'." "Update the prompt according to `ivy--prompt'."
(when (setq ivy--prompt (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 head ivy--prompt)
(setq tail "")) (setq tail ""))
(let ((inhibit-read-only t) (let ((inhibit-read-only t)
(std-props '(front-sticky t rear-nonsticky t field t read-only t))
(n-str (n-str
(concat (concat
(and (bound-and-true-p minibuffer-depth-indicate-mode) (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 (when ivy-add-newline-after-prompt
(setq n-str (concat n-str "\n"))) (setq n-str (concat n-str "\n")))
(setq n-str (ivy--break-lines n-str (window-width))) (setq n-str (ivy--break-lines n-str (window-width)))
(set-text-properties 0 (length n-str) (insert (ivy--propertize-prompt 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))
;; Mark prompt as selected if the user moves there or it is the only ;; 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 ;; option left. Since the user input stays put, we have to manually
;; remove the face as well. ;; 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 Ivy manual, version 0.15.1
@@ -118,7 +118,6 @@ API
* Example - counsel-locate:: * Example - counsel-locate::
* Example - ivy-read-with-extra-properties:: * Example - ivy-read-with-extra-properties::
 
File: ivy.info, Node: Introduction, Next: Installation, Prev: Top, Up: Top 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. * w: Hydra in the minibuffer.
(line 55) (line 55)
 
Tag Table: Tag Table:
Node: Top1192 Node: Top1190
Node: Introduction3101 Node: Introduction3098
Node: Installation5616 Node: Installation5613
Node: Installing from Emacs Package Manager5988 Node: Installing from Emacs Package Manager5985
Node: Installing from the Git repository7235 Node: Installing from the Git repository7232
Node: Getting started8062 Node: Getting started8059
Node: Basic customization8369 Node: Basic customization8366
Node: Key bindings8969 Node: Key bindings8966
Node: Global key bindings9161 Node: Global key bindings9158
Node: Minibuffer key bindings11582 Node: Minibuffer key bindings11579
Node: Key bindings for navigation12814 Node: Key bindings for navigation12811
Node: Key bindings for single selection action then exit minibuffer14021 Node: Key bindings for single selection action then exit minibuffer14018
Node: Key bindings for multiple selections and actions keep minibuffer open16704 Node: Key bindings for multiple selections and actions keep minibuffer open16701
Node: Key bindings that alter the minibuffer input19326 Node: Key bindings that alter the minibuffer input19323
Node: Other key bindings21275 Node: Other key bindings21272
Node: Hydra in the minibuffer21653 Node: Hydra in the minibuffer21650
Node: Saving the current completion session to a buffer24071 Node: Saving the current completion session to a buffer24068
Node: Completion Styles25483 Node: Completion Styles25480
Node: ivy--regex-plus27246 Node: ivy--regex-plus27243
Node: ivy--regex-ignore-order28733 Node: ivy--regex-ignore-order28730
Node: ivy--regex-fuzzy29099 Node: ivy--regex-fuzzy29096
Node: Customization29590 Node: Customization29587
Node: Faces29776 Node: Faces29773
Node: Defcustoms32214 Node: Defcustoms32211
Node: Actions33554 Node: Actions33551
Node: What are actions?33880 Node: What are actions?33877
Node: How can different actions be called?34698 Node: How can different actions be called?34695
Node: How to modify the actions list?35265 Node: How to modify the actions list?35262
Node: Example - add two actions to each command35925 Node: Example - add two actions to each command35922
Node: How to undo adding the two actions36885 Node: How to undo adding the two actions36882
Node: How to add actions to a specific command37339 Node: How to add actions to a specific command37336
Node: Example - define a new command with several actions37755 Node: Example - define a new command with several actions37752
Node: Test the above function with ivy-occur38692 Node: Test the above function with ivy-occur38689
Node: Packages39536 Node: Packages39533
Node: Commands40504 Node: Commands40501
Node: File Name Completion40689 Node: File Name Completion40686
Node: Using TRAMP42698 Node: Using TRAMP42695
Node: Buffer Name Completion44195 Node: Buffer Name Completion44192
Node: Counsel commands44823 Node: Counsel commands44820
Node: API45470 Node: API45467
Node: Required arguments for ivy-read46048 Node: Required arguments for ivy-read46045
Node: Optional arguments for ivy-read46567 Node: Optional arguments for ivy-read46564
Node: Example - counsel-describe-function50015 Node: Example - counsel-describe-function50012
Node: Example - counsel-locate52960 Node: Example - counsel-locate52957
Node: Example - ivy-read-with-extra-properties56805 Node: Example - ivy-read-with-extra-properties56802
Node: Variable Index58091 Node: Variable Index58088
Node: Keystroke Index65215 Node: Keystroke Index65212
 
End Tag Table End Tag Table
 
Local Variables: Local Variables:
coding: utf-8 coding: utf-8
Info-documentlanguage: en
End: End:
lisp/ledger-mode/ledger-mode-pkg.el
+4 -4
View File
@@ -1,7 +1,7 @@
;; -*- no-byte-compile: t; lexical-binding: nil -*- ;; -*- 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." "Helper code for use with the \"ledger\" command-line tool."
'((emacs "25.1")) '((emacs "26.1"))
:url "https://github.com/ledger/ledger-mode" :url "https://github.com/ledger/ledger-mode"
:commit "d9b664820176bf294fbca5ee99c91920862cf37d" :commit "e9bb645e8f05cf7ad0819b0450db7e84c9ed3f41"
:revdesc "d9b664820176") :revdesc "e9bb645e8f05")
lisp/ledger-mode/ledger-mode.el
+9 -5
View File
@@ -4,9 +4,9 @@
;; This file is not part of GNU Emacs. ;; This file is not part of GNU Emacs.
;; Package-Version: 20250317.529 ;; Package-Version: 20250821.1439
;; Package-Revision: d9b664820176 ;; Package-Revision: e9bb645e8f05
;; Package-Requires: ((emacs "25.1")) ;; Package-Requires: ((emacs "26.1"))
;; This is free software; you can redistribute it and/or modify it under ;; 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 ;; the terms of the GNU General Public License as published by the Free
@@ -101,7 +101,7 @@
(defun ledger-read-payee-with-prompt (prompt) (defun ledger-read-payee-with-prompt (prompt)
"Read a payee from the minibuffer with PROMPT." "Read a payee from the minibuffer with PROMPT."
(ledger-completing-read-with-default prompt (ledger-completing-read-with-default prompt
(when-let ((payee (ledger-xact-payee))) (when-let* ((payee (ledger-xact-payee)))
(regexp-quote payee)) (regexp-quote payee))
(ledger-payees-list))) (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 'before-revert-hook 'ledger-highlight--before-revert nil t)
(add-hook 'after-revert-hook 'ledger-highlight-xact-under-point 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) (ledger-init-load-init-file)
(setq-local comment-start ";") (setq-local comment-start ";")
(setq-local indent-line-function #'ledger-indent-line) (setq-local indent-line-function #'ledger-indent-line)
(setq-local indent-region-function 'ledger-post-align-postings) (setq-local indent-region-function 'ledger-post-align-postings)
(setq-local beginning-of-defun-function #'ledger-navigate-beginning-of-xact) (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 ;;;###autoload
(add-to-list 'auto-mode-alist '("\\.ledger\\'" . ledger-mode)) (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. ledger-mode.texi.
Copyright © 2013, Craig Earls. All rights reserved. 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 suggested customization is to include something like the following in
your Emacs configuration: your Emacs configuration:
(eval-after-load 'ledger-mode (with-eval-after-load 'ledger-mode
(progn ;; org-cycle allows completion to work whereas outline-toggle-children does not
;; org-cycle allows completion to work whereas outline-toggle-children does not (define-key ledger-mode-map (kbd "TAB") #'org-cycle)
(define-key ledger-mode-map (kbd "TAB") #'org-cycle) (add-hook 'ledger-mode-hook #'outline-minor-mode)
(add-hook 'ledger-mode-hook #'outline-minor-mode) (font-lock-add-keywords 'ledger-mode outline-font-lock-keywords))
(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 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) * TAB: Adding Transactions. (line 6)
* y: Editing Amounts. (line 6) * y: Editing Amounts. (line 6)
 
Tag Table: Tag Table:
Node: Top1740 Node: Top1738
Node: Introduction to Ledger-mode2551 Node: Introduction to Ledger-mode2549
Node: Quick Installation2780 Node: Quick Installation2778
Node: Menus3712 Node: Menus3710
Node: Quick Demo4027 Node: Quick Demo4025
Node: Quick Add4457 Node: Quick Add4455
Node: Reconciliation5555 Node: Reconciliation5553
Node: Reports7239 Node: Reports7237
Node: Narrowing8269 Node: Narrowing8267
Node: The Ledger Buffer8853 Node: The Ledger Buffer8851
Node: Navigating Transactions9259 Node: Navigating Transactions9257
Node: Adding Transactions9819 Node: Adding Transactions9817
Node: Setting a Transactions Effective Date11316 Node: Setting a Transactions Effective Date11314
Node: Quick Balance Display12216 Node: Quick Balance Display12214
Node: Copying Transactions12748 Node: Copying Transactions12746
Node: Editing Amounts13350 Node: Editing Amounts13348
Node: Marking Transactions14421 Node: Marking Transactions14419
Node: Formatting Transactions16114 Node: Formatting Transactions16112
Node: Deleting Transactions16712 Node: Deleting Transactions16710
Node: Sorting Transactions17152 Node: Sorting Transactions17150
Node: Narrowing Transactions18700 Node: Narrowing Transactions18698
Node: The Reconcile Buffer20544 Node: The Reconcile Buffer20542
Node: Basics of Reconciliation21009 Node: Basics of Reconciliation21007
Node: Starting a Reconciliation21956 Node: Starting a Reconciliation21954
Node: Mark Transactions Pending23805 Node: Mark Transactions Pending23803
Node: Edit Transactions During Reconciliation24474 Node: Edit Transactions During Reconciliation24472
Node: Finalize Reconciliation25117 Node: Finalize Reconciliation25115
Node: Adding and Deleting Transactions during Reconciliation25774 Node: Adding and Deleting Transactions during Reconciliation25772
Node: Changing Reconciliation Account26358 Node: Changing Reconciliation Account26356
Node: Changing Reconciliation Target26908 Node: Changing Reconciliation Target26906
Node: The Report Buffer27226 Node: The Report Buffer27224
Node: Running Basic Reports27484 Node: Running Basic Reports27482
Node: Adding and Editing Reports28917 Node: Adding and Editing Reports28915
Node: Expansion Formats30302 Node: Expansion Formats30300
Node: Make Report Transactions Active31943 Node: Make Report Transactions Active31941
Node: Reversing Report Order32648 Node: Reversing Report Order32646
Node: Scheduling Transactions33341 Node: Scheduling Transactions33339
Node: Specifying Upcoming Transactions34195 Node: Specifying Upcoming Transactions34193
Node: Transactions that occur on specific dates34767 Node: Transactions that occur on specific dates34765
Node: Transactions that occur on specific days35808 Node: Transactions that occur on specific days35806
Node: Customizing Ledger-mode36937 Node: Customizing Ledger-mode36935
Node: Ledger-mode Customization37201 Node: Ledger-mode Customization37199
Node: Customization Variables37886 Node: Customization Variables37884
Node: Ledger Customization Group38366 Node: Ledger Customization Group38364
Node: Ledger Reconcile Customization Group39006 Node: Ledger Reconcile Customization Group39004
Node: Ledger Report Customization Group41933 Node: Ledger Report Customization Group41931
Node: Ledger Faces Customization Group42652 Node: Ledger Faces Customization Group42650
Node: Ledger Post Customization Group44399 Node: Ledger Post Customization Group44397
Node: Ledger Exec Customization Group45226 Node: Ledger Exec Customization Group45224
Node: Ledger Test Customization Group45723 Node: Ledger Test Customization Group45721
Node: Ledger Texi Customization Group46125 Node: Ledger Texi Customization Group46123
Node: Generating Ledger Regression Tests46617 Node: Generating Ledger Regression Tests46615
Node: Embedding Example results in Ledger Documentation46880 Node: Embedding Example results in Ledger Documentation46878
Node: Hacking Ledger-mode47169 Node: Hacking Ledger-mode47167
Node: Use org-like outlines47394 Node: Use org-like outlines47392
Node: Concept Index48059 Node: Concept Index48039
Node: Command & Variable Index53575 Node: Command & Variable Index53555
Node: Keystroke Index61685 Node: Keystroke Index61665
 
End Tag Table 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." "Make an overlay for an invisible portion of the buffer, from BEG to END."
(let ((ovl (make-overlay beg end))) (let ((ovl (make-overlay beg end)))
(overlay-put ovl ledger-occur-overlay-property-name t) (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) (defun ledger-occur-create-overlays (ovl-bounds)
"Create the overlays for the visible transactions. "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 ;; Search loop
(while (not (eobp)) (while (not (eobp))
;; if something found ;; if something found
(when-let ((endpoint (re-search-forward regex nil 'end)) (when-let* ((endpoint (re-search-forward regex nil 'end))
(bounds (ledger-navigate-find-element-extents endpoint))) (bounds (ledger-navigate-find-element-extents endpoint)))
(push bounds lines) (push bounds lines)
;; move to the end of the xact, no need to search inside it more ;; move to the end of the xact, no need to search inside it more
(goto-char (cadr bounds)))) (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 (cl-loop
while (re-search-forward ledger-post-line-regexp end t) while (re-search-forward ledger-post-line-regexp end t)
for account-end = (match-end ledger-regex-post-line-group-account) 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)) (unless (string-empty-p (string-trim amount-string))
amount-string)) amount-string))
if (not 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. "Display the cleared-or-pending balance.
And calculate the target-delta of the account being reconciled." And calculate the target-delta of the account being reconciled."
(interactive) (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 (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 (progn
(setq ledger-reconcile-last-balance-equals-target (zerop (car diff))) (setq ledger-reconcile-last-balance-equals-target (zerop (car diff)))
(format-message "Cleared and Pending balance: %s, Difference from target: %s" (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) ;; 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 (with-temp-buffer
(save-excursion (insert report-cmd)) (save-excursion (insert report-cmd))
(while (re-search-forward "%(\\([^)]*\\))" nil t) (while (re-search-forward "%(\\([^)]*\\))" nil t)
(when-let ((specifier (match-string 1)) (when-let* ((specifier (match-string 1))
(f (cdr (assoc specifier ledger-report-format-specifiers)))) (f (cdr (assoc specifier ledger-report-format-specifiers))))
(let* ((arg (save-match-data (let* ((arg (save-match-data
(with-current-buffer ledger-buf (with-current-buffer ledger-buf
(funcall f)))) (funcall f))))
@@ -442,7 +442,7 @@ called in the ledger buffer for which the report is being run."
(string-join arg " ") (string-join arg " ")
(shell-quote-argument arg))))) (shell-quote-argument arg)))))
(replace-match quoted 'fixedcase 'literal)))) (replace-match quoted 'fixedcase 'literal))))
(buffer-string)))) (buffer-string))))
(defun ledger-report--cmd-needs-links-p (cmd) (defun ledger-report--cmd-needs-links-p (cmd)
"Check links should be added to the report produced by CMD." "Check links should be added to the report produced by CMD."
@@ -553,12 +553,14 @@ specific posting at point instead."
(interactive) (interactive)
(let* ((prop (get-text-property (point) 'ledger-source)) (let* ((prop (get-text-property (point) 'ledger-source))
(file (car prop)) (file (car prop))
(line (cdr prop))) (xact-position (cdr prop)))
(when (and file line) (when (and file xact-position)
(find-file-other-window file) (find-file-other-window file)
(widen) (widen)
(goto-char (point-min)) (if (markerp xact-position)
(forward-line (1- line)) (goto-char xact-position)
(progn (goto-char (point-min))
(forward-line (1- xact-position))))
(when ledger-report-links-beginning-of-xact (when ledger-report-links-beginning-of-xact
(ledger-navigate-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) (when (string-empty-p ledger-report-name)
(setq ledger-report-name (ledger-report-read-new-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'? " (cond ((y-or-n-p (format "Overwrite existing report named '%s'? "
ledger-report-name)) ledger-report-name))
(if (string-equal (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 (cond ((zerop count) ;; Return true if day-of-week matches
`(eq (nth 6 (decode-time date)) ,day-of-week)) `(eq (nth 6 (decode-time date)) ,day-of-week))
((> count 0) ;; Positive count ((> count 0) ;; Positive count
(let ((decoded (cl-gensym))) (let ((decoded (gensym)))
`(let ((,decoded (decode-time date))) `(let ((,decoded (decode-time date)))
(and (eq (nth 6 ,decoded) ,day-of-week) (and (eq (nth 6 ,decoded) ,day-of-week)
(<= ,(* (1- count) 7) (<= ,(* (1- count) 7)
(nth 3 ,decoded) (nth 3 ,decoded)
,(* count 7)))))) ,(* count 7))))))
((< count 0) ((< count 0)
(let ((days-in-month (cl-gensym)) (let ((days-in-month (gensym))
(decoded (cl-gensym))) (decoded (gensym)))
`(let* ((,decoded (decode-time date)) `(let* ((,decoded (decode-time date))
(,days-in-month (ledger-schedule-days-in-month (,days-in-month (ledger-schedule-days-in-month
(nth 4 ,decoded) (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) (defun ledger-schedule-constrain-date-range (month1 day1 month2 day2)
"Return a form of DATE that is true if DATE falls between two dates. "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." The dates are given by the pairs MONTH1 DAY1 and MONTH2 DAY2."
(let ((decoded (cl-gensym)) (let ((decoded (gensym))
(target-month (cl-gensym)) (target-month (gensym))
(target-day (cl-gensym))) (target-day (gensym)))
`(let* ((,decoded (decode-time date)) `(let* ((,decoded (decode-time date))
(,target-month (nth 4 decoded)) (,target-month (nth 4 decoded))
(,target-day (nth 3 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 () (defun ledger-xact-payee ()
"Return the payee of the transaction containing point or nil." "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))) (ledger-context-field-value xact-context 'payee)))
(defun ledger-xact-date () (defun ledger-xact-date ()
"Return the date of the transaction containing point or nil." "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))) (ledger-context-field-value xact-context 'date)))
(defun ledger-xact-find-slot (moment) (defun ledger-xact-find-slot (moment)
@@ -117,7 +117,7 @@ MOMENT is an encoded date"
(current-year (nth 5 (decode-time now)))) (current-year (nth 5 (decode-time now))))
(while (not (eobp)) (while (not (eobp))
(when (looking-at ledger-iterate-regexp) (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 (setq current-year (string-to-number year)) ;a Y directive was found
(let ((start (match-beginning 0)) (let ((start (match-beginning 0))
(year (match-string (+ ledger-regex-iterate-group-actual-date 1))) (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 -*- ;; -*- no-byte-compile: t; lexical-binding: nil -*-
(define-package "llama" "20250701.1529" (define-package "llama" "20251101.2002"
"Compact syntax for short lambda." "Compact syntax for short lambda."
'((emacs "26.1") '((emacs "26.1")
(compat "30.1")) (compat "30.1"))
:url "https://github.com/tarsius/llama" :url "https://github.com/tarsius/llama"
:commit "0cc2daffded18eea7f00a318cfa3e216977ffe50" :commit "e4803de8ab85991b6a944430bb4f543ea338636d"
:revdesc "0cc2daffded1" :revdesc "e4803de8ab85"
:keywords '("extensions")) :keywords '("extensions"))
lisp/llama/llama.el
+6 -7
View File
@@ -6,9 +6,11 @@
;; Homepage: https://github.com/tarsius/llama ;; Homepage: https://github.com/tarsius/llama
;; Keywords: extensions ;; Keywords: extensions
;; Package-Version: 20250701.1529 ;; Package-Version: 20251101.2002
;; Package-Revision: 0cc2daffded1 ;; Package-Revision: e4803de8ab85
;; Package-Requires: ((emacs "26.1") (compat "30.1")) ;; Package-Requires: (
;; (emacs "26.1")
;; (compat "30.1"))
;; SPDX-License-Identifier: GPL-3.0-or-later ;; 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 (prog1 t
(save-excursion (save-excursion
(goto-char (match-beginning 0)) (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 (expr (ignore-errors
(read-positioning-symbols (current-buffer))))) (read-positioning-symbols (current-buffer)))))
(put-text-property (match-beginning 0) (point) (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 () (defun llama--add-font-lock-keywords ()
(font-lock-add-keywords nil llama-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) (defun lisp--el-match-keyword@llama (limit)
"Highlight symbols following \"(##\" the same as if they followed \"(\"." "Highlight symbols following \"(##\" the same as if they followed \"(\"."
(catch 'found (catch 'found
lisp/magit-section/magit-section-pkg.el
+8 -7
View File
@@ -1,13 +1,14 @@
;; -*- no-byte-compile: t; lexical-binding: nil -*- ;; -*- no-byte-compile: t; lexical-binding: nil -*-
(define-package "magit-section" "20250704.2300" (define-package "magit-section" "20251108.1923"
"Sections for read-only buffers." "Sections for read-only buffers."
'((emacs "27.1") '((emacs "28.1")
(compat "30.1") (compat "30.1")
(llama "1.0.0") (cond-let "0.1")
(seq "2.24")) (llama "1.0")
(seq "2.24"))
:url "https://github.com/magit/magit" :url "https://github.com/magit/magit"
:commit "5b820a1d1e94649e0f218362286d520d9f29ac2c" :commit "2d8f43e68125d9f7cf97ba182a5d266fe1a52c67"
:revdesc "5b820a1d1e94" :revdesc "2d8f43e68125"
:keywords '("tools") :keywords '("tools")
:authors '(("Jonas Bernoulli" . "emacs.magit@jonas.bernoulli.dev")) :authors '(("Jonas Bernoulli" . "emacs.magit@jonas.bernoulli.dev"))
:maintainers '(("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 ;; Homepage: https://github.com/magit/magit
;; Keywords: tools ;; Keywords: tools
;; Package-Version: 20250704.2300 ;; Package-Version: 20251108.1923
;; Package-Revision: 5b820a1d1e94 ;; Package-Revision: 2d8f43e68125
;; Package-Requires: ( ;; Package-Requires: (
;; (emacs "27.1") ;; (emacs "28.1")
;; (compat "30.1") ;; (compat "30.1")
;; (llama "1.0.0") ;; (cond-let "0.1")
;; (seq "2.24")) ;; (llama "1.0")
;; (seq "2.24"))
;; SPDX-License-Identifier: GPL-3.0-or-later ;; SPDX-License-Identifier: GPL-3.0-or-later
@@ -45,8 +46,9 @@
(require 'cl-lib) (require 'cl-lib)
(require 'compat) (require 'compat)
(require 'cond-let)
(require 'eieio) (require 'eieio)
(require 'llama) (require 'llama) ; For (##these ...) see M-x describe-function RET # # RET.
(require 'subr-x) (require 'subr-x)
;; For older Emacs releases we depend on an updated `seq' release from GNU ;; 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 (define-obsolete-variable-alias 'magit-keep-region-overlay
'magit-section-keep-region-overlay "Magit-Section 4.0.0") '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 ;;; Hooks
(defvar magit-section-movement-hook nil (defvar magit-section-movement-hook nil
@@ -192,15 +197,17 @@ entries of this alist."
(const show) (const show)
function))) function)))
(defcustom magit-section-visibility-indicator (defcustom magit-section-visibility-indicators
(if (window-system) `((magit-fringe-bitmap> . magit-fringe-bitmapv)
'(magit-fringe-bitmap> . magit-fringe-bitmapv) (,(if (char-displayable-p ?…) "…" "...") . t))
(cons (if (char-displayable-p ?…) "…" "...")
t))
"Whether and how to indicate that a section can be expanded/collapsed. "Whether and how to indicate that a section can be expanded/collapsed.
If nil, then don't show any indicators. If nil, then don't show any indicators. Otherwise the value has to
Otherwise the value has to have one of these two forms: 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) \(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 To provide extra padding around the indicator, set
`left-fringe-width' in `magit-mode-hook'. `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) \(STRING . BOOLEAN)
In this case STRING (usually an ellipsis) is shown at the end 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." doing so is kinda ugly."
:package-version '(magit-section . "3.0.0") :package-version '(magit-section . "3.0.0")
:group 'magit-section :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" (cons :tag "Use +- fringe indicators"
(const magit-fringe-bitmap+) :format "%{%t%}%v\n"
(const magit-fringe-bitmap-)) (const :format " " magit-fringe-bitmap+)
(const :format " " magit-fringe-bitmap-))
(cons :tag "Use >v fringe indicators" (cons :tag "Use >v fringe indicators"
(const magit-fringe-bitmap>) :format "%{%t%}%v\n"
(const magit-fringe-bitmapv)) (const :format " " magit-fringe-bitmap>)
(cons :tag "Use bold >v fringe indicators)" (const :format " " magit-fringe-bitmapv))
(const magit-fringe-bitmap-bold>) (cons :tag "Use bold >v fringe indicators"
(const magit-fringe-bitmap-boldv)) :format "%{%t%}%v\n"
(const :format " " magit-fringe-bitmap-bold>)
(const :format " " magit-fringe-bitmap-boldv))
(cons :tag "Use custom fringe indicators" (cons :tag "Use custom fringe indicators"
(variable :tag "Expandable bitmap variable") (variable :tag "Expandable bitmap variable")
(variable :tag "Collapsible 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" (cons :tag "Use ellipses at end of headings"
(string :tag "Ellipsis" "…") (string :tag "Ellipsis" "…")
(choice :tag "Use face kludge" (choice :tag "Use face kludge"
(const :tag "Yes (potentially slow)" t) (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 (defcustom magit-section-keep-region-overlay nil
"Whether to keep the region overlay when there is a valid selection. "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 :group 'magit-section
:type 'boolean) :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 ;;; Variables
(defvar-local magit-section-preserve-visibility t) (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." "Face used for child counts at the end of some section headings."
:group 'magit-section-faces) :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 ;;; Classes
(defvar magit--current-section-hook nil (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 (defvar-keymap magit-section-heading-map
:doc "Keymap used in the heading line of all expandable sections. :doc "Keymap used in the heading line of all expandable sections.
This keymap is used in addition to the section-specific keymap, if any." This keymap is used in addition to the section-specific keymap, if any."
"<double-down-mouse-1>" #'ignore "<double-down-mouse-1>" #'ignore
"<double-mouse-1>" #'magit-mouse-toggle-section "<double-mouse-1>" #'magit-mouse-toggle-section
"<double-mouse-2>" #'magit-mouse-toggle-section) "<double-mouse-2>" #'magit-mouse-toggle-section
"<left-margin> <mouse-1>" #'magit-mouse-toggle-section)
(defvar magit-section-mode-map (defvar-keymap magit-section-mode-map
(let ((map (make-keymap))) :doc "Parent keymap for keymaps of modes derived from `magit-section-mode'."
(suppress-keymap map t) :full t
(when (and magit-section-show-context-menu-for-emacs<28 :suppress t
(< emacs-major-version 28)) "<left-fringe> <mouse-1>" #'magit-mouse-toggle-section
(keymap-set map "<mouse-3>" nil) "<left-fringe> <mouse-2>" #'magit-mouse-toggle-section
(keymap-set "TAB" #'magit-section-toggle
map "<down-mouse-3>" "C-c TAB" #'magit-section-cycle
`( menu-item "" ,(make-sparse-keymap) "C-<tab>" #'magit-section-cycle
:filter ,(lambda (_) "M-<tab>" #'magit-section-cycle
(let ((menu (make-sparse-keymap))) ;; <backtab> is the most portable binding for Shift+Tab.
(if (fboundp 'context-menu-local) "<backtab>" #'magit-section-cycle-global
(context-menu-local menu last-input-event) "^" #'magit-section-up
(magit--context-menu-local menu last-input-event)) "p" #'magit-section-backward
(magit-section-context-menu menu last-input-event) "n" #'magit-section-forward
menu))))) "M-p" #'magit-section-backward-sibling
(keymap-set map "<left-fringe> <mouse-1>" #'magit-mouse-toggle-section) "M-n" #'magit-section-forward-sibling
(keymap-set map "<left-fringe> <mouse-2>" #'magit-mouse-toggle-section) "1" #'magit-section-show-level-1
(keymap-set map "TAB" #'magit-section-toggle) "2" #'magit-section-show-level-2
(keymap-set map "C-c TAB" #'magit-section-cycle) "3" #'magit-section-show-level-3
(keymap-set map "C-<tab>" #'magit-section-cycle) "4" #'magit-section-show-level-4
(keymap-set map "M-<tab>" #'magit-section-cycle) "M-1" #'magit-section-show-level-1-all
;; <backtab> is the most portable binding for Shift+Tab. "M-2" #'magit-section-show-level-2-all
(keymap-set map "<backtab>" #'magit-section-cycle-global) "M-3" #'magit-section-show-level-3-all
(keymap-set map "^" #'magit-section-up) "M-4" #'magit-section-show-level-4-all)
(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'.")
(define-derived-mode magit-section-mode special-mode "Magit-Sections" (define-derived-mode magit-section-mode special-mode "Magit-Sections"
"Parent major mode from which major modes with Magit-like sections inherit. "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) (buffer-disable-undo)
(setq truncate-lines t) (setq truncate-lines t)
(setq buffer-read-only t) (setq buffer-read-only t)
(setq-local line-move-visual t) ; see #1771 (setq-local line-move-visual t) ; See #1771.
;; Turn off syntactic font locking, but not by setting ;; Turn off syntactic font locking. See #5420.
;; `font-lock-defaults' because that would enable font locking, and (setq-local font-lock-defaults '(nil t))
;; not all magit plugins may be ready for that (see #3950).
(setq-local font-lock-syntactic-face-function #'ignore)
(setq show-trailing-whitespace nil) (setq show-trailing-whitespace nil)
(setq-local symbol-overlay-inhibit-map t) (setq-local symbol-overlay-inhibit-map t)
(setq list-buffers-directory (abbreviate-file-name default-directory)) (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)...)." The return value has the form ((TYPE . VALUE)...)."
(cons (cons (oref section type) (cons (cons (oref section type)
(magit-section-ident-value section)) (magit-section-ident-value section))
(and-let* ((parent (oref section parent))) (and$ (oref section parent)
(magit-section-ident parent)))) (magit-section-ident $))))
(defun magit-section-equal (a b) (defun magit-section-equal (a b)
"Return t if A an B are the same section." "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 If optional RAW is non-nil, return a list of section objects, beginning
with SECTION, otherwise return a list of section types." with SECTION, otherwise return a list of section types."
(cons (if raw section (oref section type)) (cons (if raw section (oref section type))
(and-let* ((parent (oref section parent))) (and$ (oref section parent)
(magit-section-lineage parent raw)))) (magit-section-lineage $ raw))))
(defvar-local magit-insert-section--current nil "For internal use only.") (defvar-local magit-insert-section--current nil "For internal use only.")
(defvar-local magit-insert-section--parent 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 `(menu-item
,(if (oref section hidden) "Expand section" "Collapse section") ,(if (oref section hidden) "Expand section" "Collapse section")
magit-section-toggle)) magit-section-toggle))
(when-let (((not (oref section hidden))) (when-let* ((_(not (oref section hidden)))
(children (oref section children))) (children (oref section children))
(when (seq-some #'magit-section-content-p children) (_(seq-some #'magit-section-content-p children)))
(when (seq-some (##oref % hidden) children) (when (seq-some (##oref % hidden) children)
(keymap-set-after menu "<magit-section-show-children>" (keymap-set-after menu "<magit-section-show-children>"
`(menu-item "Expand children" `(menu-item "Expand children"
magit-section-show-children))) magit-section-show-children)))
(when (seq-some (##not (oref % hidden)) children) (when (seq-some (##not (oref % hidden)) children)
(keymap-set-after menu "<magit-section-hide-children>" (keymap-set-after menu "<magit-section-hide-children>"
`(menu-item "Collapse children" `(menu-item "Collapse children"
magit-section-hide-children))))) magit-section-hide-children))))
(keymap-set-after menu "<separator-magit-1>" menu-bar-separator)) (keymap-set-after menu "<separator-magit-1>" menu-bar-separator))
(keymap-set-after menu "<magit-describe-section>" (keymap-set-after menu "<magit-describe-section>"
`(menu-item "Describe section" 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) (when (consp binding)
(define-key-after menu (vector key) (define-key-after menu (vector key)
(copy-sequence binding)))) (copy-sequence binding))))
(if (fboundp 'menu-bar-keymap) (menu-bar-keymap map))))
(menu-bar-keymap map)
(magit--menu-bar-keymap map)))))
menu) menu)
(defun magit-menu-item (desc def &optional props) (defun magit-menu-item (desc def &optional props)
@@ -687,11 +707,11 @@ See `magit-menu-format-desc'."
(or (ignore-errors (or (ignore-errors
(save-excursion (save-excursion
(goto-char (magit-menu-position)) (goto-char (magit-menu-position))
(and-let* ((key (cl-find-if-not (and-let ((key (cl-find-if-not
(lambda (key) (lambda (key)
(string-match-p "\\`<[0-9]+>\\'" (string-match-p "\\`<[0-9]+>\\'"
(key-description key))) (key-description key)))
(where-is-internal def)))) (where-is-internal def))))
(key-description key)))) (key-description key))))
"")) ""))
@@ -705,14 +725,15 @@ then return nil."
(defun magit-menu-highlight-point-section () (defun magit-menu-highlight-point-section ()
(setq magit-section-highlight-force-update t) (setq magit-section-highlight-force-update t)
(if (eq (current-buffer) magit--context-menu-buffer) (cond-let
(setq magit--context-menu-section nil) ((eq (current-buffer) magit--context-menu-buffer)
(if-let ((window (get-buffer-window magit--context-menu-buffer))) (setq magit--context-menu-section nil))
(with-selected-window window ([window (get-buffer-window magit--context-menu-buffer)]
(setq magit--context-menu-section nil) (with-selected-window window
(magit-section-update-highlight)) (setq magit--context-menu-section nil)
(with-current-buffer magit--context-menu-buffer (magit-section-update-highlight)))
(setq magit--context-menu-section nil)))) ((with-current-buffer magit--context-menu-buffer
(setq magit--context-menu-section nil))))
(setq magit--context-menu-buffer nil)) (setq magit--context-menu-buffer nil))
(defvar magit--plural-append-es '(branch)) (defvar magit--plural-append-es '(branch))
@@ -758,28 +779,6 @@ The following %-specs are allowed:
(?M . ,(or multiple value)) (?M . ,(or multiple value))
(?x . ,(format "%s" magit-menu-common-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) (define-advice context-menu-region (:around (fn menu click) magit-section-mode)
"Disable in `magit-section-mode' buffers." "Disable in `magit-section-mode' buffers."
(if (derived-mode-p 'magit-section-mode) (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. "Move to the beginning of the next sibling section.
If there is no next sibling section, then move to the parent." If there is no next sibling section, then move to the parent."
(interactive) (interactive)
(let ((current (magit-current-section))) (cond-let
(if (oref current parent) [[current (magit-current-section)]]
(if-let ((next (car (magit-section-siblings current 'next)))) ((not (oref current parent))
(magit-section-goto next) (magit-section-goto 1))
(magit-section-forward)) ([next (car (magit-section-siblings current 'next))]
(magit-section-goto 1)))) (magit-section-goto next))
((magit-section-forward))))
(defun magit-section-backward-sibling () (defun magit-section-backward-sibling ()
"Move to the beginning of the previous sibling section. "Move to the beginning of the previous sibling section.
If there is no previous sibling section, then move to the parent." If there is no previous sibling section, then move to the parent."
(interactive) (interactive)
(let ((current (magit-current-section))) (cond-let
(if (oref current parent) [[current (magit-current-section)]]
(if-let ((previous (car (magit-section-siblings current 'prev)))) ((not (oref current parent))
(magit-section-goto previous) (magit-section-goto -1))
(magit-section-backward)) ([previous (car (magit-section-siblings current 'prev))]
(magit-section-goto -1)))) (magit-section-goto previous))
((magit-section-backward))))
(defun magit-mouse-set-point (event &optional promote-to-region) (defun magit-mouse-set-point (event &optional promote-to-region)
"Like `mouse-set-point' but also call `magit-section-movement-hook'." "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 (defmacro magit-define-section-jumper
(name heading type &optional value inserter &rest properties) (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. Together TYPE and VALUE identify the section.
HEADING is the displayed heading of the section." HEADING is the displayed heading of the section."
(declare (indent defun)) (declare (indent defun))
@@ -909,19 +910,23 @@ With a prefix argument also expand it." heading)
(list :description heading)) (list :description heading))
,@(and inserter ,@(and inserter
`(:if (##memq ',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 :inapt-if-not (##magit-get-section
(cons (cons ',type ,value) (cons (cons ',type ,value)
(magit-section-ident magit-root-section))) (magit-section-ident magit-root-section)))
(interactive "P") (interactive "P")
(if-let ((section (magit-get-section (cond-let
(cons (cons ',type ,value) ([section (magit-get-section
(magit-section-ident magit-root-section))))) (cons (cons ',type ,value)
(progn (goto-char (oref section start)) (magit-section-ident magit-root-section)))]
(when expand (goto-char (oref section start))
(with-local-quit (magit-section-show section)) (when expand
(recenter 0))) (with-local-quit (magit-section-show section))
(message ,(format "Section \"%s\" wasn't found" heading))))) (recenter 0)))
((message ,(format "Section \"%s\" wasn't found" heading))))))
;;;; Visibility ;;;; 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 `tab-bar-mode' does not use a mode map but instead manipulates the
global map, this involves advising `tab-bar--define-keys'." global map, this involves advising `tab-bar--define-keys'."
(interactive (list (magit-current-section))) (interactive (list (magit-current-section)))
(cond (cond-let
((and (equal (this-command-keys) [C-tab]) ((and (equal (this-command-keys) [C-tab])
(eq (global-key-binding [C-tab]) 'tab-next) (eq (global-key-binding [C-tab]) 'tab-next)
(fboundp 'tab-bar-switch-to-next-tab)) (fboundp 'tab-bar-switch-to-next-tab))
(tab-bar-switch-to-next-tab current-prefix-arg)) (tab-bar-switch-to-next-tab current-prefix-arg))
((eq section magit-root-section) ((eq section magit-root-section)
(magit-section-cycle-global)) (magit-section-cycle-global))
((oref section hidden) ((oref section hidden)
(magit-section-show section) (magit-section-show section)
(magit-section-hide-children section)) (magit-section-hide-children section))
((let ((children (oref section children))) [[children (oref section children)]]
(cond ((and (seq-some (##oref % hidden) children) ((and (seq-some (##oref % hidden) children)
(seq-some (##oref % children) children)) (seq-some (##oref % children) children))
(magit-section-show-headings section)) (magit-section-show-headings section))
((seq-some #'magit-section-hidden-body children) ((seq-some #'magit-section-hidden-body children)
(magit-section-show-children section)) (magit-section-show-children section))
((magit-section-hide section))))))) ((magit-section-hide section))))
(defun magit-section-cycle-global () (defun magit-section-cycle-global ()
"Cycle visibility of all sections in the current buffer." "Cycle visibility of all sections in the current buffer."
(interactive) (interactive)
(let ((children (oref magit-root-section children))) (cond-let
(cond ((and (seq-some (##oref % hidden) children) [[children (oref magit-root-section children)]]
(seq-some (##oref % children) children)) ((and (seq-some (##oref % hidden) children)
(magit-section-show-headings magit-root-section)) (seq-some (##oref % children) children))
((seq-some #'magit-section-hidden-body children) (magit-section-show-headings magit-root-section))
(magit-section-show-children magit-root-section)) ((seq-some #'magit-section-hidden-body children)
(t (magit-section-show-children magit-root-section))
(mapc #'magit-section-hide children))))) ((mapc #'magit-section-hide children))))
(defun magit-section-hidden (section) (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) (or (oref section hidden)
(and-let* ((parent (oref section parent))) (and$ (oref section parent)
(magit-section-hidden parent)))) (magit-section-hidden $))))
(defun magit-section-hidden-body (section &optional pred) (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))) (if-let ((children (oref section children)))
(funcall (or pred #'seq-some) #'magit-section-hidden-body children) (funcall (or pred #'seq-some) #'magit-section-hidden-body children)
(and (oref section content) (and (oref section content)
(oref section hidden)))) (oref section hidden))))
(defalias 'magit-section-invisible-p #'magit-section-hidden)
(defun magit-section-content-p (section) (defun 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."
(with-slots (content end washer) section (with-slots (content end washer) section
(and content (or (not (= content end)) washer)))) (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) (defun magit-section-show-level (level)
"Show surrounding sections up to LEVEL. "Show surrounding sections up to LEVEL.
Likewise hide sections at higher levels. If the region selects multiple Likewise hide sections at higher levels. If the region selects multiple
@@ -1163,12 +1167,15 @@ silently ignored."
;;;; Auxiliary ;;;; Auxiliary
(defun magit-describe-section-briefly (section &optional ident interactive) (defun magit-describe-section-briefly (&optional section ident interactive)
"Show information about the section at point. "Show information about SECTION or the section at point.
With a prefix argument show the section identity instead of the With a prefix argument show the section identity instead of the
section lineage. This command is intended for debugging purposes. 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)) (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>" (let ((str (format "#<%s %S %S %s-%s%s>"
(eieio-object-class section) (eieio-object-class section)
(let ((val (oref section value))) (let ((val (oref section value)))
@@ -1177,19 +1184,18 @@ section lineage. This command is intended for debugging purposes.
((and (eieio-object-p val) ((and (eieio-object-p val)
(fboundp 'cl-prin1-to-string)) (fboundp 'cl-prin1-to-string))
(cl-prin1-to-string val)) (cl-prin1-to-string val))
(t (val)))
val)))
(if ident (if ident
(magit-section-ident section) (magit-section-ident section)
(apply #'vector (magit-section-lineage section))) (apply #'vector (magit-section-lineage section)))
(and-let* ((m (oref section start))) (and$ (oref section start)
(if (markerp m) (marker-position m) m)) (if (markerp $) (marker-position $) $))
(if-let ((m (oref section content))) (if-let ((m (oref section content)))
(format "[%s-]" (format "[%s-]"
(if (markerp m) (marker-position m) m)) (if (markerp m) (marker-position m) m))
"") "")
(and-let* ((m (oref section end))) (and$ (oref section end)
(if (markerp m) (marker-position m) m))))) (if (markerp $) (marker-position $) $)))))
(when interactive (when interactive
(message "%s" str)) (message "%s" str))
str)) str))
@@ -1287,17 +1293,18 @@ of course you want to be that precise."
(defun magit-section-match-2 (condition section) (defun magit-section-match-2 (condition section)
(if (eq (car condition) '*) (if (eq (car condition) '*)
(or (magit-section-match-2 (cdr condition) section) (or (magit-section-match-2 (cdr condition) section)
(and-let* ((parent (oref section parent))) (and$ (oref section parent)
(magit-section-match-2 condition parent))) (magit-section-match-2 condition $)))
(and (let ((c (car condition))) (and (cond-let
(if (class-p c) [[c (car condition)]]
(cl-typep section c) ((class-p c)
(if-let ((class (cdr (assq c magit--section-type-alist)))) (cl-typep section c))
(cl-typep section class) ([class (cdr (assq c magit--section-type-alist))]
(eq (oref section type) c)))) (cl-typep section class))
((eq (oref section type) c)))
(or (not (setq condition (cdr condition))) (or (not (setq condition (cdr condition)))
(and-let* ((parent (oref section parent))) (and$ (oref section parent)
(magit-section-match-2 condition parent)))))) (magit-section-match-2 condition $))))))
(defun magit-section-value-if (condition &optional section) (defun magit-section-value-if (condition &optional section)
"If the section at point matches CONDITION, then return its value. "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. nil.
See `magit-section-match' for the forms CONDITION can take." See `magit-section-match' for the forms CONDITION can take."
(and-let* ((section (or section (magit-current-section)))) (and$ (or section (magit-current-section))
(and (magit-section-match condition section) (and (magit-section-match condition $)
(oref section value)))) (oref $ value))))
(defmacro magit-section-case (&rest clauses) (defmacro magit-section-case (&rest clauses)
"Choose among clauses on the type of the section at point. "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." at point."
(declare (indent 0) (declare (indent 0)
(debug (&rest (sexp body)))) (debug (&rest (sexp body))))
`(let* ((it (magit-current-section))) `(let ((it (magit-current-section)))
(cond ,@(mapcar (lambda (clause) (cond ,@(mapcar (lambda (clause)
`(,(or (eq (car clause) t) `(,(or (eq (car clause) t)
`(and it `(and it
@@ -1614,8 +1621,8 @@ is explicitly expanded."
(defun magit-section--set-section-properties (section) (defun magit-section--set-section-properties (section)
(pcase-let* (((eieio start end children keymap) section) (pcase-let* (((eieio start end children keymap) section)
(props `( magit-section ,section (props `( magit-section ,section
,@(and-let* ((map (symbol-value keymap))) ,@(and$ (symbol-value keymap)
(list 'keymap map))))) (list 'keymap $)))))
(if children (if children
(save-excursion (save-excursion
(goto-char start) (goto-char start)
@@ -1814,8 +1821,8 @@ evaluated its BODY. Admittedly that's a bit of a hack."
(and as-child (and as-child
(oref section heading-highlight-face)) (oref section heading-highlight-face))
(slot-boundp section 'painted) (slot-boundp section 'painted)
(and-let* ((children (oref section children))) (and$ (oref section children)
(magit-section-selective-highlight-p (car children) t)))) (magit-section-selective-highlight-p (car $) t))))
;;; Paint ;;; Paint
@@ -1910,7 +1917,7 @@ to nil." (bound-and-true-p long-line-threshold)) :warning)))))
(defun magit-section-goto-successor--same (section line char) (defun magit-section-goto-successor--same (section line char)
(let ((ident (magit-section-ident section))) (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))) (let ((start (oref found start)))
(goto-char start) (goto-char start)
(unless (eq found magit-root-section) (unless (eq found magit-root-section)
@@ -1922,25 +1929,25 @@ to nil." (bound-and-true-p long-line-threshold)) :warning)))))
t)))) t))))
(defun magit-section-goto-successor--related (section) (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) (goto-char (if (eq (oref found type) 'button)
(point-min) (point-min)
(oref found start))))) (oref found start)))))
(defun magit-section-goto-successor--related-1 (section) (defun magit-section-goto-successor--related-1 (section)
(or (and-let* ((alt (pcase (oref section type) (or (and$ (pcase (oref section type)
('staged 'unstaged) ('staged 'unstaged)
('unstaged 'staged) ('unstaged 'staged)
('unpushed 'unpulled) ('unpushed 'unpulled)
('unpulled 'unpushed)))) ('unpulled 'unpushed))
(magit-get-section `((,alt) (status)))) (magit-get-section `((,$) (status))))
(and-let* ((next (car (magit-section-siblings section 'next)))) (and$ (magit-section-siblings section 'next)
(magit-get-section (magit-section-ident next))) (magit-get-section (magit-section-ident (car $))))
(and-let* ((prev (car (magit-section-siblings section 'prev)))) (and$ (magit-section-siblings section 'prev)
(magit-get-section (magit-section-ident prev))) (magit-get-section (magit-section-ident (car $))))
(and-let* ((parent (oref section parent))) (and$ (oref section parent)
(or (magit-get-section (magit-section-ident parent)) (or (magit-get-section (magit-section-ident $))
(magit-section-goto-successor--related-1 parent))))) (magit-section-goto-successor--related-1 $)))))
;;; Region ;;; Region
@@ -1997,37 +2004,52 @@ When `magit-section-preserve-visibility' is nil, return nil."
magit-section-cache-visibility)) magit-section-cache-visibility))
(magit-section-cache-visibility section))) (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) (defun magit-section-maybe-update-visibility-indicator (section)
(when (and magit-section-visibility-indicator (when-let* ((indicator (magit-section-visibility-indicator))
(magit-section-content-p section)) (_(magit-section-content-p section)))
(let* ((beg (oref section start)) (let* ((beg (oref section start))
(eoh (magit--eol-position beg))) (eoh (magit--eol-position beg))
(cond (kind (cl-typecase (car indicator)
((symbolp (car-safe magit-section-visibility-indicator)) (symbol 'fringe)
(let ((ov (magit--overlay-at beg 'magit-vis-indicator 'fringe))) (character 'margin)
(unless ov (string 'ellipsis)))
(setq ov (make-overlay beg eoh nil t)) (indicator (if (or (oref section hidden)
(overlay-put ov 'evaporate t) (eq kind 'ellipsis))
(overlay-put ov 'magit-vis-indicator 'fringe)) (car indicator)
(overlay-put (cdr indicator))))
ov 'before-string (pcase kind
(propertize "fringe" 'display ((or 'fringe 'margin)
(list 'left-fringe (let ((ov (magit--overlay-at beg 'magit-vis-indicator kind)))
(if (oref section hidden) (unless ov
(car magit-section-visibility-indicator) (setq ov (make-overlay beg eoh nil t))
(cdr magit-section-visibility-indicator)) (overlay-put ov 'evaporate t)
'fringe))))) (overlay-put ov 'magit-vis-indicator kind))
((stringp (car-safe magit-section-visibility-indicator)) (overlay-put
(let ((ov (magit--overlay-at (1- eoh) 'magit-vis-indicator 'eoh))) ov 'before-string
(cond ((oref section hidden) (pcase kind
(unless ov ('fringe
(setq ov (make-overlay (1- eoh) eoh)) (propertize "fringe" 'display
(overlay-put ov 'evaporate t) `(left-fringe ,indicator fringe)))
(overlay-put ov 'magit-vis-indicator 'eoh)) ('margin
(overlay-put ov 'after-string (propertize "margin" 'display
(car magit-section-visibility-indicator))) `((margin left-margin)
(ov ,(propertize (string indicator)
(delete-overlay ov))))))))) '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) (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 ;; This is needed because we hide the body instead of "the body
;; except the final newline and additionally the newline before ;; except the final newline and additionally the newline before
;; the body"; otherwise we could use `buffer-invisibility-spec'. ;; 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 (let* ((sections (append magit--ellipses-sections
(setq magit--ellipses-sections (setq magit--ellipses-sections
(or (magit-region-sections) (or (magit-region-sections)
@@ -2057,7 +2080,7 @@ When `magit-section-preserve-visibility' is nil, return nil."
(overlay-put (overlay-put
ov 'after-string ov 'after-string
(propertize (propertize
(car magit-section-visibility-indicator) 'font-lock-face indicator 'font-lock-face
(let ((pos (overlay-start ov))) (let ((pos (overlay-start ov)))
(delq nil (nconc (mapcar (##overlay-get % 'font-lock-face) (delq nil (nconc (mapcar (##overlay-get % 'font-lock-face)
(overlays-at pos)) (overlays-at pos))
@@ -2065,7 +2088,7 @@ When `magit-section-preserve-visibility' is nil, return nil."
pos 'font-lock-face)))))))))))) pos 'font-lock-face))))))))))))
(defun magit-section-maybe-remove-visibility-indicator (section) (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 content)
(oref section end))) (oref section end)))
(dolist (o (overlays-in (oref section start) (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))) (let ((section (magit-current-section)))
(while section (while section
(let ((content (oref section content))) (let ((content (oref section content)))
(if (and (magit-section-invisible-p section) (cond ((and (magit-section-hidden section)
(<= (or content (oref section start)) (<= (or content (oref section start))
beg beg
(oref section end))) (oref section end)))
(progn (when content
(when content (magit-section-show section)
(magit-section-show section) (push section magit-section--opened-sections))
(push section magit-section--opened-sections)) (setq section (oref section parent)))
(setq section (oref section parent))) ((setq section nil)))))))
(setq section nil))))))
(or (eq search-invisible t) (or (eq search-invisible t)
(not (isearch-range-invisible beg end)))) (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)) (setq magit-section--opened-sections nil))
(funcall fn))) (funcall fn)))
(defun magit-section-reveal (section)
(while section
(when (oref section hidden)
(magit-section-show section))
(setq section (oref section parent))))
;;; Utilities ;;; Utilities
(cl-defun magit-section-selected-p (section &optional (selection nil sselection)) (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 (memq section (if sselection
selection selection
(setq selection (magit-region-sections)))) (setq selection (magit-region-sections))))
(and-let* ((parent (oref section parent))) (and$ (oref section parent)
(magit-section-selected-p parent selection))))) (magit-section-selected-p $ selection)))))
(defun magit-section-parent-value (section) (defun magit-section-parent-value (section)
(and-let* ((parent (oref section parent))) (and$ (oref section parent)
(oref parent value))) (oref $ value)))
(defun magit-section-siblings (section &optional direction) (defun magit-section-siblings (section &optional direction)
"Return a list of the sibling sections of SECTION. "Return a list of the sibling sections of SECTION.
@@ -2348,7 +2376,7 @@ Configuration'."
(message " %-50s %f %s" entry time (message " %-50s %f %s" entry time
(cond ((> time 0.03) "!!") (cond ((> time 0.03) "!!")
((> time 0.01) "!") ((> time 0.01) "!")
(t "")))) (""))))
(apply entry args))))))) (apply entry args)))))))
(cl-defun magit--overlay-at (pos prop &optional (val nil sval) testfn) (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 (defun magit--add-face-text-property ( beg end face
&optional append object adopt-face) &optional append object adopt-face)
"Like `add-face-text-property' but for `font-lock-face'. "Like `add-face-text-property' but for `font-lock-face'.
If optional ADOPT-FACE, the replace `face' with `font-lock-face' If optional ADOPT-FACE, then replace `face' with `font-lock-face'
first. This is a hack, which is likely to be remove again." first. The latter is a hack, which is likely to be removed again."
(when (stringp object) (when (stringp object)
(unless beg (setq beg 0)) (unless beg (setq beg 0))
(unless end (setq end (length object)))) (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) (cdr magit--imenu-group-types)
section)) section))
(magit-section-match 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) `((,(magit--imenu-index-name section)
,@(mapcar (##cons (magit--imenu-index-name %) ,@(mapcar (##cons (magit--imenu-index-name %)
(oref % start)) (oref % start))
@@ -2485,7 +2513,7 @@ This is like moving to POS and then calling `pos-eol'."
(oref section value))) (oref section value)))
((string-match " ([0-9]+)\\'" heading) ((string-match " ([0-9]+)\\'" heading)
(substring heading 0 (match-beginning 0))) (substring heading 0 (match-beginning 0)))
(t heading))))) (heading)))))
(defun magit--imenu-goto-function (_name position &rest _rest) (defun magit--imenu-goto-function (_name position &rest _rest)
"Go to the section at POSITION. "Go to the section at POSITION.
@@ -2644,4 +2672,15 @@ with the variables' values as arguments, which were recorded by
;;; _ ;;; _
(provide 'magit-section) (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 ;;; 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. magit-section.texi.
Copyright (C) 2015-2025 Jonas Bernoulli 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 and user options see *note (magit)Sections::. This manual documents how
you can use sections in your own packages. 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 Copyright (C) 2015-2025 Jonas Bernoulli
<emacs.magit@jonas.bernoulli.dev> <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 appropriate package prefix. This works due to some undocumented
kludges, which are not available to other packages. kludges, which are not available to other packages.
When optional HIDE is non-nil collapse the section body by default, When optional HIDE is non-‘nil’ collapse the section body by
i.e., when first creating the section, but not when refreshing the default, i.e., when first creating the section, but not when
buffer. Else expand it by default. This can be overwritten using refreshing the buffer. Else expand it by default. This can be
‘magit-section-set-visibility-hook’. When a section is recreated overwritten using ‘magit-section-set-visibility-hook’. When a
during a refresh, then the visibility of predecessor is inherited section is recreated during a refresh, then the visibility of
and HIDE is ignored (but the hook is still honored). 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 BODY is any number of forms that actually insert the section's
heading and body. Optional NAME, if specified, has to be a symbol, 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 at ‘point’. The section should only contain a single line when
this function is used like this. this function is used like this.
When called with arguments ARGS, which have to be strings, or nil, When called with arguments ARGS, which have to be strings, or
then insert those strings at point. The section should not contain ‘nil’, then insert those strings at point. The section should not
any text before this happens and afterwards it should again only contain any text before this happens and afterwards it should again
contain a single line. If the ‘face’ property is set anywhere only contain a single line. If the ‘face’ property is set anywhere
inside any of these strings, then insert all of them unchanged. inside any of these strings, then insert all of them unchanged.
Otherwise use the 'magit-section-heading' face for all inserted Otherwise use the 'magit-section-heading' face for all inserted
text. 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 The ‘content’ property of the section object is the end of the
heading (which lasts from ‘start’ to ‘content’) and the beginning heading (which lasts from ‘start’ to ‘content’) and the beginning
of the the body (which lasts from ‘content’ to ‘end’). If the 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 value of ‘content’ is ‘nil’, then the section has no heading and
body cannot be collapsed. If a section does have a heading, then its body cannot be collapsed. If a section does have a heading,
its height must be exactly one line, including a trailing newline then its height must be exactly one line, including a trailing
character. This isn't enforced, you are responsible for getting it newline character. This isn't enforced, you are responsible for
right. The only exception is that this function does insert a getting it right. The only exception is that this function does
newline character if necessary. insert a newline character if necessary.
If provided, optional CHILD-COUNT must evaluate to an integer or If provided, optional CHILD-COUNT must evaluate to an integer or
boolean. If t, then the count is determined once the children have boolean. If ‘t’, then the count is determined once the children
been inserted, using ‘magit-insert-child-count’ (which see). For have been inserted, using ‘magit-insert-child-count’ (which see).
historic reasons, if the heading ends with ":", the count is For historic reasons, if the heading ends with ":", the count is
substituted for that, at this time as well. If 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 -- Macro: magit-insert-section-body &rest body
Use BODY to insert the section body, once the section is expanded. 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 -- Function: magit-get-section ident &optional root
Return the section identified by IDENT. IDENT has to be a list as 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 then search in that section tree instead of in the one whose root
‘magit-root-section’ is. ‘magit-root-section’ is.
-- Function: magit-section-lineage section &optional raw -- Function: magit-section-lineage section &optional raw
Return the lineage of SECTION. If optional RAW is non-nil, return Return the lineage of SECTION. If optional RAW is non-‘nil’,
a list of section objects, beginning with SECTION, otherwise return return a list of section objects, beginning with SECTION, otherwise
a list of section types. return a list of section types.
-- Function: magit-section-content-p section -- 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 The next two functions are replacements for the Emacs functions that
have the same name except for the ‘magit-’ prefix. Like 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 -- Function: magit-section-match condition &optional (section
(magit-current-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 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: 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 -- Function: magit-section-value-if condition &optional section
If the section at point matches CONDITION, then return its value. If the section at point matches CONDITION, then return its value.
If optional SECTION is non-nil then test whether that matches If optional SECTION is non-‘nil’ then test whether that matches
instead. If there is no section at point and SECTION is nil, then instead. If there is no section at point and SECTION is ‘nil’,
return nil. If the section does not match, then return nil. then return ‘nil’. If the section does not match, then return
‘nil’.
See ‘magit-section-match’ for the forms CONDITION can take. 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 first match are evaluated sequentially and the value of the last
form is returned. Inside BODY the symbol ‘it’ is bound to the 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 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. 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 matches if no other CONDITION match, even if there is no section at
point. point.
 
Tag Table: Tag Table:
Node: Top810 Node: Top808
Node: Introduction2111 Node: Introduction2109
Node: Creating Sections2881 Node: Creating Sections2879
Node: Core Functions7786 Node: Core Functions7818
Node: Matching Functions10938 Node: Matching Functions10993
 
End Tag Table End Tag Table
 
Local Variables: Local Variables:
coding: utf-8 coding: utf-8
Info-documentlanguage: en
End: End:
lisp/magit/AUTHORS.md
+3 -1
View File
@@ -1,5 +1,5 @@
The following people have contributed to Magit. 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 Authors
------- -------
@@ -238,6 +238,7 @@ All Contributors
- Lluís Vilanova - Lluís Vilanova
- Loic Dachary - Loic Dachary
- Louis Roché - Louis Roché
- Lucius Chen
- Luís Oliveira - Luís Oliveira
- Luke Amdor - Luke Amdor
- Magnar Sveen - Magnar Sveen
@@ -411,6 +412,7 @@ All Contributors
- Wouter Bolsterlee - Wouter Bolsterlee
- X4lldux - X4lldux
- Xavier Noria - Xavier Noria
- Xavier Young
- Xu Chunyang - Xu Chunyang
- Yann Herklotz - Yann Herklotz
- Yann Hodique - Yann Hodique
lisp/magit/git-commit.el
+44 -33
View File
@@ -235,7 +235,7 @@ Also see `magit-post-commit-hook'."
:type 'hook :type 'hook
:get #'magit-hook-custom-get) :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. "Time in seconds to wait for git to create a commit.
The hook `git-commit-post-finish-hook' (which see) is run only 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 (not (file-accessible-directory-p
(file-name-directory buffer-file-name))) (file-name-directory buffer-file-name)))
(magit-expand-git-file-name (substring buffer-file-name 2)))) (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)) (inhibit-read-only t))
(insert-file-contents file t) (insert-file-contents file t)
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 (add-hook 'with-editor-post-finish-hook
(apply-partially #'git-commit-run-post-finish-hook (apply-partially #'git-commit-run-post-finish-hook
(magit-rev-parse "HEAD")) (magit-rev-parse "HEAD"))
nil t) nil t))
(when (fboundp 'magit-wip-maybe-add-commit-hook)
(magit-wip-maybe-add-commit-hook)))
(setq with-editor-cancel-message (setq with-editor-cancel-message
#'git-commit-cancel-message) #'git-commit-cancel-message)
(git-commit-setup-font-lock) (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) (defun git-commit-run-post-finish-hook (previous)
(when git-commit-post-finish-hook (when git-commit-post-finish-hook
(cl-block nil (if (with-timeout (git-commit-post-finish-hook-timeout)
(let ((break (time-add (current-time) (while (equal (magit-rev-parse "HEAD") previous)
(seconds-to-time (sit-for 0.01))
git-commit-post-finish-hook-timeout)))) t)
(while (equal (magit-rev-parse "HEAD") previous) (run-hooks 'git-commit-post-finish-hook)
(if (time-less-p (current-time) break) (message "No commit created after %s second. Not running %s."
(sit-for 0.01) git-commit-post-finish-hook-timeout
(message "No commit created after 1 second. Not running %s." 'git-commit-post-finish-hook))))
'git-commit-post-finish-hook)
(cl-return))))
(run-hooks 'git-commit-post-finish-hook))))
(define-minor-mode git-commit-mode (define-minor-mode git-commit-mode
"Auxiliary minor mode used when editing Git commit messages. "Auxiliary minor mode used when editing Git commit messages.
@@ -721,15 +716,15 @@ conventions are checked."
(save-excursion (save-excursion
(goto-char (point-min)) (goto-char (point-min))
(re-search-forward (git-commit-summary-regexp) nil t) (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. t ; Just try; we don't know whether --allow-empty-message was used.
(and (or (not (memq 'overlong-summary-line (and (or (not (memq 'overlong-summary-line
git-commit-style-convention-checks)) git-commit-style-convention-checks))
(equal (match-string 2) "") (equal (match-str 2) "")
(y-or-n-p "Summary line is too long. Commit anyway? ")) (y-or-n-p "Summary line is too long. Commit anyway? "))
(or (not (memq 'non-empty-second-line (or (not (memq 'non-empty-second-line
git-commit-style-convention-checks)) git-commit-style-convention-checks))
(not (match-string 3)) (not (match-str 3))
(y-or-n-p "Second line is not empty. Commit anyway? "))))))) (y-or-n-p "Second line is not empty. Commit anyway? ")))))))
(defun git-commit-cancel-message () (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 ;; non-empty and newly written comment, because otherwise
;; it would be irreversibly lost. ;; it would be irreversibly lost.
(when-let* ((message (git-commit-buffer-message)) (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) (ring-insert log-edit-comment-ring message)
(cl-incf arg) (cl-incf arg)
(setq len (ring-length log-edit-comment-ring))) (setq len (ring-length log-edit-comment-ring)))
@@ -799,16 +794,16 @@ Save current message first."
(defun git-commit-save-message () (defun git-commit-save-message ()
"Save current message to `log-edit-comment-ring'." "Save current message to `log-edit-comment-ring'."
(interactive) (interactive)
(if-let ((message (git-commit-buffer-message))) (cond-let
(progn ([message (git-commit-buffer-message)]
(when-let ((index (ring-member log-edit-comment-ring message))) (when-let ((index (ring-member log-edit-comment-ring message)))
(ring-remove log-edit-comment-ring index)) (ring-remove log-edit-comment-ring index))
(ring-insert log-edit-comment-ring message) (ring-insert log-edit-comment-ring message)
(when git-commit-use-local-message-ring (when git-commit-use-local-message-ring
(magit-repository-local-set 'log-edit-comment-ring (magit-repository-local-set 'log-edit-comment-ring
log-edit-comment-ring)) log-edit-comment-ring))
(message "Message saved")) (message "Message saved"))
(message "Only whitespace and/or comments; message not saved"))) ((message "Only whitespace and/or comments; message not saved"))))
(defun git-commit-prepare-message-ring () (defun git-commit-prepare-message-ring ()
(make-local-variable 'log-edit-comment-ring-index) (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 (sort (delete-dups
(magit-git-lines "log" "-n9999" "--format=%aN <%ae>")) (magit-git-lines "log" "-n9999" "--format=%aN <%ae>"))
#'string<) #'string<)
nil nil nil 'git-commit-read-ident-history))) nil 'any nil 'git-commit-read-ident-history)))
(save-match-data (save-match-data
(if (string-match "\\`\\([^<]+\\) *<\\([^>]+\\)>\\'" str) (if (string-match "\\`\\([^<]+\\) *<\\([^>]+\\)>\\'" str)
(list (save-match-data (string-trim (match-string 1 str))) (list (save-match-data (string-trim (match-str 1 str)))
(string-trim (match-string 2 str))) (string-trim (match-str 2 str)))
(user-error "Invalid input"))))) (user-error "Invalid input")))))
(defun git-commit--insert-ident-trailer (trailer name email) (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))))) (delete-region (point) (point-max)))))
(let ((diff-default-read-only nil)) (let ((diff-default-read-only nil))
(diff-mode)) (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) (let ((font-lock-verbose nil)
(font-lock-support-mode nil)) (font-lock-support-mode nil))
(font-lock-ensure)) (font-lock-ensure))
@@ -1221,4 +1221,15 @@ Elisp doc-strings, including this one. Unlike in doc-strings,
"git-commit 4.0.0") "git-commit 4.0.0")
(provide 'git-commit) (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 ;;; 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." BATCH also ignores commented lines."
(save-excursion (save-excursion
(goto-char (line-beginning-position)) (goto-char (line-beginning-position))
(if-let ((re-start (if batch (cond-let*
"^" ([re-start (if batch
(format "^\\(?99:%s\\)? *" "^"
(regexp-quote comment-start)))) (format "^\\(?99:%s\\)? *" (regexp-quote comment-start)))]
(type (seq-some (pcase-lambda (`(,type . ,re)) [type (seq-some (pcase-lambda (`(,type . ,re))
(let ((case-fold-search nil)) (let ((case-fold-search nil))
(and (looking-at (concat re-start re)) type))) (and (looking-at (concat re-start re)) type)))
git-rebase-line-regexps))) git-rebase-line-regexps)]
(git-rebase-action (git-rebase-action
:action-type type :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)) (or (cdr (assoc action git-rebase-short-options))
action)) action))
:action-options (match-string-no-properties 2) :action-options (match-str 2)
:target (match-string-no-properties 3) :target (match-str 3)
:trailer (match-string-no-properties 5) :trailer (match-str 5)
:comment-p (and (match-string 99) t)) :comment-p (and (match-str 99) t)))
(and (not batch) ((not batch)
;; Use empty object rather than nil to ease handling. ;; Use empty object rather than nil to ease handling.
(git-rebase-action))))) (git-rebase-action)))))
(defun git-rebase-set-action (action) (defun git-rebase-set-action (action)
"Set action of commit line to ACTION. "Set action of commit line to ACTION.
@@ -412,15 +412,13 @@ of its action type."
(delete-region beg (+ beg 2)) (delete-region beg (+ beg 2))
(insert comment-start " "))) (insert comment-start " ")))
(forward-line)) (forward-line))
(t ;; In the case of --rebase-merges, commit lines may have
;; In the case of --rebase-merges, commit lines may have ;; other lines with other action types, empty lines, and
;; other lines with other action types, empty lines, and ;; "Branch" comments interspersed. Move along.
;; "Branch" comments interspersed. Move along. ((forward-line)))))
(forward-line))))) (goto-char (cond (git-rebase-auto-advance end-marker)
(goto-char (pt-below-p (1- end-marker))
(if git-rebase-auto-advance (beg)))
end-marker
(if pt-below-p (1- end-marker) beg)))
(goto-char (line-beginning-position)))) (goto-char (line-beginning-position))))
(_ (ding)))) (_ (ding))))
@@ -591,7 +589,7 @@ remove the label on the current line, if any."
(save-excursion (save-excursion
(goto-char (point-min)) (goto-char (point-min))
(while (re-search-forward "^\\(?:l\\|label\\) \\([^ \n]+\\)" nil t) (while (re-search-forward "^\\(?:l\\|label\\) \\([^ \n]+\\)" nil t)
(push (match-string-no-properties 1) labels))) (push (match-str 1) labels)))
(nreverse labels))) (nreverse labels)))
(defun git-rebase-reset (arg) (defun git-rebase-reset (arg)
@@ -871,11 +869,11 @@ except for the \"pick\" command."
(line (concat git-rebase-comment-re "\\(?:\\( \\.? *\\)\\|" (line (concat git-rebase-comment-re "\\(?:\\( \\.? *\\)\\|"
"\\( +\\)\\([^\n,],\\) \\([^\n ]+\\) \\)"))) "\\( +\\)\\([^\n,],\\) \\([^\n ]+\\) \\)")))
(while (re-search-forward line nil t) (while (re-search-forward line nil t)
(if (match-string 1) (if (match-str 1)
(if (assq cmd git-rebase-fixup-descriptions) (if (assq cmd git-rebase-fixup-descriptions)
(delete-line) (delete-line)
(replace-match (make-string 10 ?\s) t t nil 1)) (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 (cond
((not (fboundp cmd)) ((not (fboundp cmd))
(delete-line)) (delete-line))
@@ -944,4 +942,15 @@ is used as a value for `imenu-extract-index-name-function'."
;;; _ ;;; _
(provide 'git-rebase) (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 ;;; git-rebase.el ends here
lisp/magit/magit-apply.el
+53 -57
View File
@@ -33,6 +33,7 @@
(require 'magit-diff) (require 'magit-diff)
(require 'magit-wip) (require 'magit-wip)
(require 'dired)
(require 'transient) ; See #3732. (require 'transient) ; See #3732.
;; For `magit-apply' ;; 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 @@\"." adjusted as \"@@ -10,6 +10,7 @@\" and \"@@ -18,6 +19,7 @@\"."
(let* ((first-hunk (car hunks)) (let* ((first-hunk (car hunks))
(offset (if (string-match diff-hunk-header-re-unified first-hunk) (offset (if (string-match diff-hunk-header-re-unified first-hunk)
(- (string-to-number (match-string 3 first-hunk)) (- (string-to-number (match-str 3 first-hunk))
(string-to-number (match-string 1 first-hunk))) (string-to-number (match-str 1 first-hunk)))
(error "Header hunks have to be applied individually")))) (error "Header hunks have to be applied individually"))))
(if (= offset 0) (if (= offset 0)
hunks hunks
(mapcar (lambda (hunk) (mapcar (lambda (hunk)
(if (string-match diff-hunk-header-re-unified hunk) (if (string-match diff-hunk-header-re-unified hunk)
(replace-match (number-to-string (replace-match (number-to-string
(- (string-to-number (match-string 3 hunk)) (- (string-to-number (match-str 3 hunk))
offset)) offset))
t t hunk 3) t t hunk 3)
(error "Hunk does not have expected header"))) (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))) (mapcar (##oref % value) section:s)))
(command (symbol-name this-command)) (command (symbol-name this-command))
(command (if (and command (string-match "^magit-\\([^-]+\\)" command)) (command (if (and command (string-match "^magit-\\([^-]+\\)" command))
(match-string 1 command) (match-str 1 command)
"apply")) "apply"))
(context (magit-diff-get-context)) (context (magit-diff-get-context))
(ignore-context (magit-diff-ignore-any-space-p))) (ignore-context (magit-diff-ignore-any-space-p)))
(unless (magit-diff-context-p) (unless (magit-diff-context-p)
(user-error "Not enough context to apply patch. Increase the context")) (user-error "Not enough context to apply patch. Increase the context"))
(when (and magit-wip-before-change-mode (not magit-inhibit-refresh)) (unless magit-inhibit-refresh
(magit-wip-commit-before-change files (concat " before " command))) (magit-run-before-change-functions files command))
(with-temp-buffer (with-temp-buffer
(insert patch) (insert patch)
(let ((magit-inhibit-refresh t)) (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)) (if ignore-context "-C0" (format "-C%s" context))
"--ignore-space-change" "-"))) "--ignore-space-change" "-")))
(unless magit-inhibit-refresh (unless magit-inhibit-refresh
(when magit-wip-after-apply-mode (magit-run-after-apply-functions files command)
(magit-wip-commit-after-apply files (concat " after " command)))
(magit-refresh)))) (magit-refresh))))
(defun magit-apply--get-selection () (defun magit-apply--get-selection ()
@@ -338,11 +338,11 @@ ignored) files."
(magit-stage-1 (if all "--all" "-u") magit-buffer-diff-files))) (magit-stage-1 (if all "--all" "-u") magit-buffer-diff-files)))
(defun magit-stage-1 (arg &optional 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) ".")) (magit-run-git "add" arg (if files (cons "--" files) "."))
(when magit-auto-revert-mode (when magit-auto-revert-mode
(mapc #'magit-turn-on-auto-revert-mode-if-desired files)) (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) (defun magit-stage-untracked (&optional intent)
(let* ((section (magit-current-section)) (let* ((section (magit-current-section))
@@ -356,7 +356,7 @@ ignored) files."
(magit-git-repo-p file t)) (magit-git-repo-p file t))
(push file repos) (push file repos)
(push file plain))) (push file plain)))
(magit-wip-commit-before-change files " before stage") (magit-run-before-change-functions files "stage")
(when plain (when plain
(magit-run-git "add" (and intent "--intent-to-add") (magit-run-git "add" (and intent "--intent-to-add")
"--" plain) "--" plain)
@@ -388,7 +388,7 @@ ignored) files."
(expand-file-name ".gitmodules" topdir)) (expand-file-name ".gitmodules" topdir))
(let ((default-directory borg-user-emacs-directory)) (let ((default-directory borg-user-emacs-directory))
(borg--maybe-absorb-gitdir package))))))))) (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 (defvar magit-post-stage-hook-commands
(list #'magit-stage (list #'magit-stage
@@ -396,6 +396,7 @@ ignored) files."
#'magit-stage-modified #'magit-stage-modified
'magit-file-stage)) 'magit-file-stage))
;;;###autoload
(defun magit-run-post-stage-hook () (defun magit-run-post-stage-hook ()
(when (memq this-command magit-post-stage-hook-commands) (when (memq this-command magit-post-stage-hook-commands)
(magit-run-hook-with-benchmark 'magit-post-stage-hook))) (magit-run-hook-with-benchmark 'magit-post-stage-hook)))
@@ -442,15 +443,15 @@ ignored) files."
(magit-unstage-1 files))) (magit-unstage-1 files)))
(defun 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) (if (magit-no-commit-p)
(magit-run-git "rm" "--cached" "--" files) (magit-run-git "rm" "--cached" "--" files)
(magit-run-git "reset" "HEAD" "--" 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) (defun magit-unstage-intent (files)
(if-let ((staged (magit-staged-files)) (if-let* ((staged (magit-staged-files))
(intent (seq-filter (##member % staged) files))) (intent (seq-filter (##member % staged) files)))
(magit-unstage-1 intent) (magit-unstage-1 intent)
(user-error "Already unstaged"))) (user-error "Already unstaged")))
@@ -463,9 +464,9 @@ ignored) files."
(when (or (magit-anything-unstaged-p) (when (or (magit-anything-unstaged-p)
(magit-untracked-files)) (magit-untracked-files))
(magit-confirm 'unstage-all-changes)) (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-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 (defvar magit-post-unstage-hook-commands
(list #'magit-unstage (list #'magit-unstage
@@ -473,6 +474,7 @@ ignored) files."
#'magit-unstage-all #'magit-unstage-all
'magit-file-unstage)) 'magit-file-unstage))
;;;###autoload
(defun magit-run-post-unstage-hook () (defun magit-run-post-unstage-hook ()
(when (memq this-command magit-post-unstage-hook-commands) (when (memq this-command magit-post-unstage-hook-commands)
(magit-run-hook-with-benchmark 'magit-post-unstage-hook))) (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)) ('(?U ?U) (magit-smerge-keep-current))
(_ (magit-discard-apply section #'magit-apply-hunk))))) (_ (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) (defun magit-discard-hunks (sections)
(magit-confirm 'discard (magit-confirm 'discard
(list "Discard %d hunks from %s" (list "Discard %d hunks from %s"
(length sections) (length sections)
(magit-section-parent-value (car 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) (defun magit-discard-apply (section:s apply)
(let ((section (car sections))) (let ((primus (if (atom section:s) section:s (car section:s))))
(if (eq (magit-diff-type section) 'unstaged) (cond ((eq (magit-diff-type primus) 'unstaged)
(funcall apply sections "--reverse") (funcall apply section:s "--reverse"))
(if (magit-anything-unstaged-p ((magit-anything-unstaged-p
nil (if (magit-file-section-p section) nil (if (magit-file-section-p primus)
(oref section value) (oref primus value)
(magit-section-parent-value section))) (magit-section-parent-value primus)))
(progn (let ((magit-inhibit-refresh t)) (let ((magit-inhibit-refresh t))
(funcall apply sections "--reverse" "--cached") (funcall apply section:s "--reverse" "--cached")
(funcall apply sections "--reverse" "--reject")) (funcall apply section:s "--reverse" "--reject"))
(magit-refresh)) (magit-refresh))
(funcall apply sections "--reverse" "--index"))))) ((funcall apply section:s "--reverse" "--index")))))
(defun magit-discard-file (section) (defun magit-discard-file (section)
(magit-discard-files (list 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))))) (`(?X ?R ,(or ? ?M ?D)) (push file rename)))))
(unwind-protect (unwind-protect
(let ((magit-inhibit-refresh t)) (let ((magit-inhibit-refresh t))
(magit-wip-commit-before-change files " before discard") (magit-run-before-change-functions files "discard")
(when resolve (when resolve
(magit-discard-files--resolve (nreverse resolve))) (magit-discard-files--resolve (nreverse resolve)))
(when resurrect (when resurrect
@@ -595,7 +584,7 @@ of a side, then keep that side without prompting."
(when (or discard discard-new) (when (or discard discard-new)
(magit-discard-files--discard (nreverse discard) (magit-discard-files--discard (nreverse discard)
(nreverse discard-new))) (nreverse discard-new)))
(magit-wip-commit-after-apply files " after discard")) (magit-run-after-apply-functions files "discard"))
(magit-refresh)))) (magit-refresh))))
(defun magit-discard-files--resolve (files) (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))) (?M (let ((temp (magit-git-string "checkout-index" "--temp" file)))
(string-match (string-match
(format "\\(.+?\\)\t%s" (regexp-quote file)) temp) (format "\\(.+?\\)\t%s" (regexp-quote file)) temp)
(rename-file (match-string 1 temp) (rename-file (match-str 1 temp)
(setq temp (concat file ".~{index}~"))) (setq temp (concat file ".~{index}~")))
(delete-file temp t)) (delete-file temp t))
(magit-call-git "rm" "--cached" "--force" "--" file)) (magit-call-git "rm" "--cached" "--force" "--" file))
@@ -675,10 +664,8 @@ of a side, then keep that side without prompting."
(setq sections (setq sections
(seq-remove (##member (oref % value) binaries) (seq-remove (##member (oref % value) binaries)
sections))) sections)))
(cond ((length= sections 1) (when sections
(magit-discard-apply (car sections) 'magit-apply-diff)) (magit-discard-apply sections #'magit-apply-diffs))
(sections
(magit-discard-apply-n sections #'magit-apply-diffs)))
(when binaries (when binaries
(let ((modified (magit-unstaged-files t))) (let ((modified (magit-unstaged-files t)))
(setq binaries (magit--separate (##member % modified) binaries))) (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) magit-buffer-range)
((derived-mode-p 'magit-diff-mode) ((derived-mode-p 'magit-diff-mode)
magit-buffer-range) magit-buffer-range)
(t ("--cached")))))
"--cached")))))
(magit--separate (##member (oref % value) bs) (magit--separate (##member (oref % value) bs)
sections)))) sections))))
(magit-confirm-files 'reverse (mapcar (##oref % value) 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) (defun magit-call-smerge (fn)
(pcase-let* ((file (magit-file-at-point t t)) (pcase-let* ((file (magit-file-at-point t t))
(keep (get-file-buffer file)) (keep (get-file-buffer file))
(`(,buf ,pos) (`(,buf ,pos) (magit-diff-visit-file--noselect))
(let ((magit-diff-visit-jump-to-change nil)) (keep (eq keep buf)))
(magit-diff-visit-file--noselect file))))
(with-current-buffer buf (with-current-buffer buf
(save-excursion (save-excursion
(save-restriction (save-restriction
@@ -831,4 +816,15 @@ a separate commit. A typical workflow would be:
;;; _ ;;; _
(provide 'magit-apply) (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 ;;; 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 ;;; 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) (defun magit-turn-on-auto-revert-mode-if-desired (&optional file)
(cond (file (cond (file
(when-let ((buffer (find-buffer-visiting 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") :link '(info-link "(magit)Automatic Reverting of File-Visiting Buffers")
:group 'magit-auto-revert :group 'magit-auto-revert
:group 'magit-essentials :group 'magit-essentials
;; - When `global-auto-revert-mode' is enabled, then this mode is :init-value (not (or global-auto-revert-mode noninteractive))
;; redundant. :initialize #'magit-custom-initialize-after-init)
;; - In all other cases enable the mode because if buffers are not
;; automatically reverted that would make many very common tasks (defun magit-auto-revert-mode--disable ()
;; much more cumbersome. "When enabling `global-auto-revert-mode', disable `magit-auto-revert-mode'."
:init-value (not (or global-auto-revert-mode (when (and global-auto-revert-mode
noninteractive))) (bound-and-true-p magit-auto-revert-mode))
;; - Unfortunately `:init-value t' only sets the value of the mode (magit-auto-revert-mode -1)))
;; 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 (add-hook 'global-auto-revert-mode-hook #'magit-auto-revert-mode--disable)
;; 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))
(put 'magit-auto-revert-mode 'function-documentation (put 'magit-auto-revert-mode 'function-documentation
"Toggle Magit Auto Revert mode. "Toggle Magit Auto Revert mode.
If called interactively, enable Magit Auto Revert mode if ARG is If called interactively, enable Magit Auto Revert mode if ARG is
positive, and disable it if ARG is zero or negative. If called 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 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 by calling the respective mode function, the reason being that
changing the state of a mode involves more than merely toggling changing the state of a mode involves more than merely toggling
a single switch, so setting the mode variable is not enough. 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 () (defun magit-auto-revert-buffers ()
(when (and magit-auto-revert-immediately (when (and magit-auto-revert-immediately
(or global-auto-revert-mode (or global-auto-revert-mode
@@ -268,4 +263,15 @@ defaults to nil) for any BUFFER."
;;; _ ;;; _
(provide 'magit-autorevert) (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 ;;; magit-autorevert.el ends here
lisp/magit/magit-base.el
+85 -83
View File
@@ -33,13 +33,14 @@
;;; Code: ;;; Code:
;; Also update EMACS_VERSION in "default.mk". ;; 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") (defconst magit--minimal-git "2.25.0")
(require 'cl-lib) (require 'cl-lib)
(require 'compat) (require 'compat)
(require 'cond-let)
(require 'eieio) (require 'eieio)
(require 'llama) (require 'llama) ; For (##these ...) see M-x describe-function RET # # RET.
(require 'subr-x) (require 'subr-x)
;; For older Emacs releases we depend on an updated `seq' release from ;; 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 for confirmation for any of these actions, you are still better
of adding all of the respective symbols individually. of adding all of the respective symbols individually.
When `magit-wip-before-change-mode' is enabled then these actions When `magit-wip-mode' is enabled then these actions can fairly
can fairly easily be undone: `discard', `reverse', easily be undone: `discard', `reverse', `stage-all-changes', and
`stage-all-changes', and `unstage-all-changes'. If and only if `unstage-all-changes'. If and only if this mode is enabled, then
this mode is enabled, then `safe-with-wip' has the same effect `safe-with-wip' has the same effect as adding all of these symbols
as adding all of these symbols individually." individually."
:package-version '(magit . "2.1.0") :package-version '(magit . "2.1.0")
:group 'magit-essentials :group 'magit-essentials
:group 'magit-commands :group 'magit-commands
@@ -425,7 +426,7 @@ the ellipsis definition. Currently the only acceptable values
for WHERE are `margin' or t (representing the default). for WHERE are `margin' or t (representing the default).
Whether collapsed sections are indicated using ellipsis is 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") :package-version '(magit . "4.0.0")
:group 'magit-miscellaneous :group 'magit-miscellaneous
:type '(repeat (list (symbol :tag "Where") :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) (defclass magit-hunk-section (magit-diff-section)
((keymap :initform 'magit-hunk-section-map) ((keymap :initform 'magit-hunk-section-map)
(painted :initform nil) (painted :initform nil)
(fontified :initform nil) ;TODO
(refined :initform nil) (refined :initform nil)
(combined :initform nil :initarg :combined) (combined :initform nil :initarg :combined)
(from-range :initform nil :initarg :from-range) (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, - If REQUIRE-MATCH is nil and the user exits without a choice,
then nil is returned instead of an empty string. 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 - If REQUIRE-MATCH is non-nil and the user exits without a
choice, `user-error' is raised. 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 `minibuffer-default-prompt-format' and depending on
`magit-completing-read-default-prompt-predicate'." `magit-completing-read-default-prompt-predicate'."
(setq magit-completing-read--silent-default nil) (setq magit-completing-read--silent-default nil)
(if-let ((dwim (and def (if-let ((_ def)
(nth 2 (seq-find (pcase-lambda (`(,cmd ,re ,_)) (dwim (seq-some (pcase-lambda (`(,cmd ,re ,dwim))
(and (eq this-command cmd) (and (eq cmd this-command)
(or (not re) (or (not re)
(string-match-p re prompt)))) (string-match-p re prompt))
magit-dwim-selection))))) dwim))
magit-dwim-selection)))
(if (eq dwim 'ask) (if (eq dwim 'ask)
(if (y-or-n-p (format "%s %s? " prompt def)) (if (y-or-n-p (format "%s %s? " prompt def))
def def
@@ -613,7 +620,8 @@ acts similarly to `completing-read', except for the following:
(reply (funcall magit-completing-read-function (reply (funcall magit-completing-read-function
(magit--format-prompt prompt def) (magit--format-prompt prompt def)
collection predicate collection predicate
require-match initial-input hist def))) (if (eq require-match 'any) nil require-match)
initial-input hist def)))
(setq this-command command) (setq this-command command)
;; Note: Avoid `string=' to support `helm-comp-read-use-marked'. ;; Note: Avoid `string=' to support `helm-comp-read-use-marked'.
(if (equal reply "") (if (equal reply "")
@@ -681,6 +689,14 @@ third-party completion frameworks."
(equal omit-nulls t)) (equal omit-nulls t))
(setq input string)) (setq input string))
(funcall split-string string separators omit-nulls trim))) (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 ;; Prevent `BUILT-IN' completion from messing up our existing
;; order of the completion candidates. aa5f098ab ;; order of the completion candidates. aa5f098ab
(table (magit--completion-table table)) (table (magit--completion-table table))
@@ -696,8 +712,12 @@ third-party completion frameworks."
;; And now, the moment we have all been waiting for... ;; And now, the moment we have all been waiting for...
(values (completing-read-multiple (values (completing-read-multiple
(magit--format-prompt prompt def) (magit--format-prompt prompt def)
table predicate require-match initial-input table predicate
hist def inherit-input-method))) (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))) (if no-split input values)))
(defvar-keymap magit-minibuffer-local-ns-map (defvar-keymap magit-minibuffer-local-ns-map
@@ -748,7 +768,7 @@ This is similar to `read-string', but
(user-error "Need non-empty input")) (user-error "Need non-empty input"))
((and no-whitespace (string-match-p "[\s\t\n]" val)) ((and no-whitespace (string-match-p "[\s\t\n]" val))
(user-error "Input contains whitespace")) (user-error "Input contains whitespace"))
(t val)))) (val))))
(defun magit-read-string-ns ( prompt &optional initial-input history (defun magit-read-string-ns ( prompt &optional initial-input history
default-value inherit-input-method) default-value inherit-input-method)
@@ -779,7 +799,7 @@ ACTION is a member of option `magit-slow-confirm'."
(y-or-n-p prompt))) (y-or-n-p prompt)))
(defvar magit--no-confirm-alist (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))) discard reverse stage-all-changes unstage-all-changes)))
(cl-defun magit-confirm ( action &optional prompt prompt-n noabort (cl-defun magit-confirm ( action &optional prompt prompt-n noabort
@@ -860,13 +880,14 @@ See info node `(magit)Debugging Tools' for more information."
,@(mapcan ,@(mapcan
(##list "-L" %) (##list "-L" %)
(delete-dups (delete-dups
(mapcan (seq-keep
(lambda (lib) (lambda (lib)
(if-let ((path (locate-library lib))) (if-let ((path (locate-library lib)))
(list (file-name-directory path)) (file-name-directory path)
(error "Cannot find mandatory dependency %s" lib))) (error "Cannot find mandatory dependency %s" lib)))
'(;; Like `LOAD_PATH' in `default.mk'. '(;; Like `LOAD_PATH' in `default.mk'.
"compat" "compat"
"cond-let"
"llama" "llama"
"seq" "seq"
"transient" "transient"
@@ -887,21 +908,20 @@ See info node `(magit)Debugging Tools' for more information."
(defmacro magit-bind-match-strings (varlist string &rest body) (defmacro magit-bind-match-strings (varlist string &rest body)
"Bind variables to submatches according to VARLIST then evaluate BODY. "Bind variables to submatches according to VARLIST then evaluate BODY.
Bind the symbols in VARLIST to submatches of the current match Bind the symbols in VARLIST to submatches of the current match data,
data, starting with 1 and incrementing by 1 for each symbol. If starting with 1 and incrementing by 1 for each symbol. If the last
the last match was against a string, then that has to be provided match was against a string, then that has to be provided as STRING."
as STRING."
(declare (indent 2) (debug (listp form body))) (declare (indent 2) (debug (listp form body)))
(let ((s (gensym "string")) (let ((s (gensym "string"))
(i 0)) (i 0))
`(let ((,s ,string)) `(let* ((,s ,string)
(let ,(save-match-data ,@(save-match-data
(mapcan (lambda (sym) (seq-keep (lambda (sym)
(cl-incf i) (cl-incf i)
(and (not (eq (aref (symbol-name sym) 0) ?_)) (and (not (eq (aref (symbol-name sym) 0) ?_))
(list (list sym (list 'match-string i s))))) `(,sym (match-str ,i ,s))))
varlist)) varlist)))
,@body)))) ,@body)))
(defun magit-delete-line () (defun magit-delete-line ()
"Delete the rest of the current 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)) (delete-char 1))
;; Valid format spec. ;; Valid format spec.
((looking-at "\\([-0-9.]*\\)\\([a-zA-Z]\\)") ((looking-at "\\([-0-9.]*\\)\\([a-zA-Z]\\)")
(let* ((num (match-string 1)) (let* ((num (match-str 1))
(spec (string-to-char (match-string 2))) (spec (string-to-char (match-str 2)))
(val (assq spec specification))) (val (assq spec specification)))
(unless val (unless val
(error "Invalid format character: `%%%c'" spec)) (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 the percent sign.
(delete-region (1- (match-beginning 0)) (match-beginning 0))))) (delete-region (1- (match-beginning 0)) (match-beginning 0)))))
;; Signal an error on bogus format strings. ;; Signal an error on bogus format strings.
(t ((error "Invalid format string"))))
(error "Invalid format string"))))
(buffer-string))) (buffer-string)))
;;; Missing from Emacs ;;; 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) (defun magit--separate (pred list)
"Separate elements of LIST that do and don't satisfy PRED. "Separate elements of LIST that do and don't satisfy PRED.
Return a list of two lists; the first containing the elements that 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 ;;;###autoload
(define-advice Info-follow-nearest-node (:around (fn &optional fork) gitman) (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 (let ((node (Info-get-token
(point) "\\*note[ \n\t]+" (point) "\\*note[ \n\t]+"
"\\*note[ \n\t]+\\([^:]*\\):\\(:\\|[ \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 (pcase magit-view-git-manual-method
('info (funcall fn fork)) ('info (funcall fn fork))
('man (require 'man) ('man (require 'man)
(man (match-string 1 node))) (man (match-str 1 node)))
('woman (require 'woman) ('woman (require 'woman)
(woman (match-string 1 node))) (woman (match-str 1 node)))
(_ (user-error "Invalid value for `magit-view-git-manual-method'"))) (_ (user-error "Invalid value for `magit-view-git-manual-method'")))
(funcall fn fork)))) (funcall fn fork))))
@@ -1134,7 +1125,7 @@ See <https://github.com/raxod502/straight.el/issues/520>."
(build (pcase manager (build (pcase manager
('straight (bound-and-true-p straight-build-dir)) ('straight (bound-and-true-p straight-build-dir))
('elpaca (bound-and-true-p elpaca-builds-directory)))) ('elpaca (bound-and-true-p elpaca-builds-directory))))
((string-prefix-p build filename)) (_(string-prefix-p build filename))
(repo (pcase manager (repo (pcase manager
('straight ('straight
(and (bound-and-true-p straight-base-dir) (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) (defun magit--ellipsis (&optional where)
"Build an ellipsis always as string, depending on WHERE." "Build an ellipsis always as string, depending on WHERE."
(if (stringp magit-ellipsis) (cond-let
magit-ellipsis ((stringp magit-ellipsis)
(if-let ((pair (car (or magit-ellipsis)
(alist-get (or where t) magit-ellipsis) ([pair (car (or (alist-get (or where t) magit-ellipsis)
(alist-get t magit-ellipsis))))) (alist-get t magit-ellipsis)))]
(pcase-let ((`(,fancy . ,universal) pair)) (pcase-let* ((`(,fancy . ,universal) pair)
(let ((ellipsis (if (and fancy (char-displayable-p fancy)) (ellipsis (if (and fancy (char-displayable-p fancy))
fancy fancy
universal))) universal)))
(if (characterp ellipsis) (if (characterp ellipsis)
(char-to-string ellipsis) (char-to-string ellipsis)
ellipsis))) ellipsis)))
(user-error "Variable magit-ellipsis is invalid")))) ((user-error "Variable magit-ellipsis is invalid"))))
(defun magit--ext-regexp-quote (string) (defun magit--ext-regexp-quote (string)
"Like `reqexp-quote', but for Extended Regular Expressions." "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) (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 ;;; magit-base.el ends here
lisp/magit/magit-bisect.el
+14 -3
View File
@@ -53,7 +53,7 @@
;;; Commands ;;; Commands
;;;###autoload (autoload 'magit-bisect "magit-bisect" nil t) ;;;###autoload(autoload 'magit-bisect "magit-bisect" nil t)
(transient-define-prefix magit-bisect () (transient-define-prefix magit-bisect ()
"Narrow in on the commit that introduced a bug." "Narrow in on the commit that introduced a bug."
:man-page "git-bisect" :man-page "git-bisect"
@@ -258,7 +258,7 @@ bisect run'."
(pop lines)) (pop lines))
(seq-find (##string-match done-re %) lines)))) (seq-find (##string-match done-re %) lines))))
(magit-insert-section ((eval (if bad-line 'commit 'bisect-output)) (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 (magit-insert-heading
(propertize (or bad-line (pop lines)) (propertize (or bad-line (pop lines))
'font-lock-face 'magit-section-heading)) 'font-lock-face 'magit-section-heading))
@@ -291,7 +291,7 @@ bisect run'."
(while (progn (setq beg (point-marker)) (while (progn (setq beg (point-marker))
(re-search-forward (re-search-forward
"^\\(\\(?:git bisect\\|# status:\\) [^\n]+\n\\)" nil t)) "^\\(\\(?: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-delete-match)
(magit-bind-match-strings (heading) nil (magit-bind-match-strings (heading) nil
(magit-delete-match) (magit-delete-match)
@@ -315,4 +315,15 @@ bisect run'."
;;; _ ;;; _
(provide 'magit-bisect) (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 ;;; 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)))" (margin-body-face . (magit-blame-dimmed)))"
:package-version '(magit . "2.13.0") :package-version '(magit . "2.13.0")
:group 'magit-blame :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 (defcustom magit-blame-echo-style 'lines
"The blame visualization style used by `magit-blame-echo'. "The blame visualization style used by `magit-blame-echo'.
@@ -265,21 +266,22 @@ Also see option `magit-blame-styles'."
(magit-file-relative-name (magit-file-relative-name
nil (not magit-buffer-file-name)))) nil (not magit-buffer-file-name))))
(line (format "%d,+1" (line-number-at-pos)))) (line (format "%d,+1" (line-number-at-pos))))
(cond (file (with-temp-buffer (cond (file
(magit-with-toplevel (with-temp-buffer
(magit-git-insert (magit-with-toplevel
"blame" "--porcelain" (magit-git-insert
(if (memq magit-blame-type '(final removal)) "blame" "--porcelain"
(cons "--reverse" (magit-blame-arguments)) (if (memq magit-blame-type '(final removal))
(magit-blame-arguments)) (cons "--reverse" (magit-blame-arguments))
"-L" line rev "--" file) (magit-blame-arguments))
(goto-char (point-min)) "-L" line rev "--" file)
(if (eobp) (goto-char (point-min))
(unless noerror (cond ((not (eobp))
(error "Cannot get blame chunk at eob")) (car (magit-blame--parse-chunk type)))
(car (magit-blame--parse-chunk type)))))) ((not noerror)
(noerror nil) (error "Cannot get blame chunk at eob"))))))
((error "Buffer does not visit a tracked file"))))))) ((not noerror)
(error "Buffer does not visit a tracked file")))))))
(defun magit-blame-chunk-at (pos) (defun magit-blame-chunk-at (pos)
(seq-some (##overlay-get % 'magit-blame-chunk) (seq-some (##overlay-get % 'magit-blame-chunk)
@@ -326,12 +328,6 @@ in `magit-blame-read-only-mode-map' instead."
:lighter magit-blame-mode-lighter :lighter magit-blame-mode-lighter
:interactive nil :interactive nil
(cond (magit-blame-mode (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 'after-save-hook #'magit-blame--refresh t t)
(add-hook 'post-command-hook #'magit-blame-goto-chunk-hook 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) (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)) (magit-blame-mode 1))
(message "Blaming...") (message "Blaming...")
(magit-blame-run-process (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)) (magit-file-relative-name nil (not magit-buffer-file-name))
(if (memq magit-blame-type '(final removal)) (if (memq magit-blame-type '(final removal))
(cons "--reverse" args) (cons "--reverse" args)
@@ -464,10 +461,10 @@ modes is toggled, then this mode also gets toggled automatically.
(message "Blaming...done")) (message "Blaming...done"))
(magit-blame-assert-buffer process) (magit-blame-assert-buffer process)
(with-current-buffer (process-get process 'command-buf) (with-current-buffer (process-get process 'command-buf)
(if magit-blame-mode (cond (magit-blame-mode
(progn (magit-blame-mode -1) (magit-blame-mode -1)
(message "Blaming...failed")) (message "Blaming...failed"))
(message "Blaming...aborted")))) ((message "Blaming...aborted")))))
(kill-local-variable 'magit-blame-process)))) (kill-local-variable 'magit-blame-process))))
(defun magit-blame-process-filter (process string) (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)))) (buffer-substring-no-properties (point) (line-end-position))))
(with-slots (orig-rev orig-file prev-rev prev-file) (with-slots (orig-rev orig-file prev-rev prev-file)
(setq chunk (magit-blame-chunk (setq chunk (magit-blame-chunk
:orig-rev (match-string 1) :orig-rev (match-str 1)
:orig-line (string-to-number (match-string 2)) :orig-line (string-to-number (match-str 2))
:final-line (string-to-number (match-string 3)) :final-line (string-to-number (match-str 3))
:num-lines (string-to-number (match-string 4)))) :num-lines (string-to-number (match-str 4))))
(forward-line) (forward-line)
(let (done) (let (done)
(while (not done) (while (not done)
(cond ((looking-at "^filename \\(.+\\)") (cond ((looking-at "^filename \\(.+\\)")
(setq done t) (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,\\}\\) \\(.+\\)") ((looking-at "^previous \\(.\\{40,\\}\\) \\(.+\\)")
(setf prev-rev (match-string 1)) (setf prev-rev (match-str 1))
(setf prev-file (magit-decode-git-path (match-string 2)))) (setf prev-file (magit-decode-git-path (match-str 2))))
((looking-at "^\\([^ ]+\\) \\(.+\\)") ((looking-at "^\\([^ ]+\\) \\(.+\\)")
(push (cons (match-string 1) (push (cons (match-str 1)
(match-string 2)) (match-str 2))
revinfo))) revinfo)))
(forward-line))) (forward-line)))
(when (and (eq type 'removal) prev-rev) (when (and (eq type 'removal) prev-rev)
@@ -753,18 +750,18 @@ modes is toggled, then this mode also gets toggled automatically.
(delete-overlay ov))))) (delete-overlay ov)))))
(defun magit-blame-maybe-show-message () (defun magit-blame-maybe-show-message ()
(when (magit-blame--style-get 'show-message) (cond-let
(if-let ((msg (cdr (assoc "summary" ((not (magit-blame--style-get 'show-message)))
(gethash (oref (magit-current-blame-chunk) ([msg (cdr (assoc "summary"
orig-rev) (gethash (oref (magit-current-blame-chunk) orig-rev)
magit-blame-cache))))) magit-blame-cache)))]
(progn (set-text-properties 0 (length msg) nil msg) (set-text-properties 0 (length msg) nil msg)
(magit-msg "%S" msg)) (magit-msg "%S" msg))
(magit-msg "Commit data not available yet. Still blaming.")))) ((magit-msg "Commit data not available yet. Still blaming."))))
;;; Commands ;;; 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) (transient-define-suffix magit-blame-echo (args)
"For each line show the revision in which it was added. "For each line show the revision in which it was added.
Show the information about the chunk at point in the echo area 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) (read-only-mode -1)
(magit-blame--update-overlays))) (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) (transient-define-suffix magit-blame-addition (args)
"For each line show the revision in which it was added." "For each line show the revision in which it was added."
(interactive (list (magit-blame-arguments))) (interactive (list (magit-blame-arguments)))
@@ -796,7 +793,7 @@ not turn on `read-only-mode'."
(magit-blame--pre-blame-setup 'addition) (magit-blame--pre-blame-setup 'addition)
(magit-blame--run args)) (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) (transient-define-suffix magit-blame-removal (args)
"For each line show the revision in which it was removed." "For each line show the revision in which it was removed."
:if-nil 'buffer-file-name :if-nil 'buffer-file-name
@@ -807,7 +804,7 @@ not turn on `read-only-mode'."
(magit-blame--pre-blame-setup 'removal) (magit-blame--pre-blame-setup 'removal)
(magit-blame--run args)) (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) (transient-define-suffix magit-blame-reverse (args)
"For each line show the last revision in which it still exists." "For each line show the last revision in which it still exists."
:if-nil 'buffer-file-name :if-nil 'buffer-file-name
@@ -907,8 +904,9 @@ then also kill the buffer."
#'previous-single-char-property-change #'previous-single-char-property-change
#'next-single-char-property-change) #'next-single-char-property-change)
pos 'magit-blame-chunk))) pos 'magit-blame-chunk)))
(when-let ((o (magit-blame--overlay-at pos)) (when-let
((equal (oref (magit-blame-chunk-at pos) orig-rev) rev))) ((o (magit-blame--overlay-at pos))
(_(equal (oref (magit-blame-chunk-at pos) orig-rev) rev)))
(setq ov o)))) (setq ov o))))
(if ov (if ov
(goto-char (overlay-start ov)) (goto-char (overlay-start ov))
@@ -943,7 +941,7 @@ instead of the hash, like `kill-ring-save' would."
;;; Popup ;;; Popup
;;;###autoload (autoload 'magit-blame "magit-blame" nil t) ;;;###autoload(autoload 'magit-blame "magit-blame" nil t)
(transient-define-prefix magit-blame () (transient-define-prefix magit-blame ()
"Show the commits that added or removed lines in the visited file." "Show the commits that added or removed lines in the visited file."
:man-page "git-blame" :man-page "git-blame"
@@ -1002,4 +1000,15 @@ instead of the hash, like `kill-ring-save' would."
;;; _ ;;; _
(provide 'magit-blame) (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 ;;; magit-blame.el ends here
lisp/magit/magit-bookmark.el
+11
View File
@@ -156,4 +156,15 @@
;;; _ ;;; _
(provide 'magit-bookmark) (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 ;;; 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 ;;; Commands
;;;###autoload (autoload 'magit-branch "magit" nil t) ;;;###autoload(autoload 'magit-branch "magit" nil t)
(transient-define-prefix magit-branch (branch) (transient-define-prefix magit-branch (branch)
"Add, configure or remove a branch." "Add, configure or remove a branch."
:man-page "git-branch" :man-page "git-branch"
@@ -263,12 +263,12 @@ changes.
(interactive (list (magit-read-other-branch-or-commit "Checkout") (interactive (list (magit-read-other-branch-or-commit "Checkout")
(magit-branch-arguments))) (magit-branch-arguments)))
(when (string-match "\\`heads/\\(.+\\)" commit) (when (string-match "\\`heads/\\(.+\\)" commit)
(setq commit (match-string 1 commit))) (setq commit (match-str 1 commit)))
(magit-run-git-async "checkout" args commit)) (magit-run-git-async "checkout" args commit))
(defun magit--checkout (rev &optional args) (defun magit--checkout (rev &optional args)
(when (string-match "\\`heads/\\(.+\\)" rev) (when (string-match "\\`heads/\\(.+\\)" rev)
(setq rev (match-string 1 rev))) (setq rev (match-str 1 rev)))
(magit-call-git "checkout" args rev)) (magit-call-git "checkout" args rev))
;;;###autoload ;;;###autoload
@@ -319,7 +319,7 @@ does."
(and (not (magit-commit-p arg)) (and (not (magit-commit-p arg))
(magit-read-starting-point "Create and checkout branch" arg))))) (magit-read-starting-point "Create and checkout branch" arg)))))
(when (string-match "\\`heads/\\(.+\\)" arg) (when (string-match "\\`heads/\\(.+\\)" arg)
(setq arg (match-string 1 arg))) (setq arg (match-str 1 arg)))
(if start-point (if start-point
(with-suppressed-warnings ((interactive-only magit-branch-and-checkout)) (with-suppressed-warnings ((interactive-only magit-branch-and-checkout))
(magit-branch-and-checkout arg start-point)) (magit-branch-and-checkout arg start-point))
@@ -374,8 +374,7 @@ when using `magit-branch-and-checkout'."
choice)) choice))
((member choice local) ((member choice local)
(list choice)) (list choice))
(t ((list choice (magit-read-starting-point "Create" choice))))))
(list choice (magit-read-starting-point "Create" choice))))))
(cond (cond
((not start-point) ((not start-point)
(magit--checkout branch (magit-branch-arguments)) (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)) (magit-anything-modified-p))
(message "Staying on HEAD due to uncommitted changes") (message "Staying on HEAD due to uncommitted changes")
(setq checkout t)) (setq checkout t))
(if-let ((current (magit-get-current-branch))) (cond-let
(let ((tracked (magit-get-upstream-branch current)) ([current (magit-get-current-branch)]
base) (let ((tracked (magit-get-upstream-branch current))
(when from base)
(unless (magit-rev-ancestor-p from current) (when from
(user-error "Cannot spin off %s. %s is not reachable from %s" (unless (magit-rev-ancestor-p from current)
branch from current)) (user-error "Cannot spin off %s. %s is not reachable from %s"
(when (and tracked branch from current))
(magit-rev-ancestor-p from tracked)) (when (and tracked
(user-error "Cannot spin off %s. %s is ancestor of upstream %s" (magit-rev-ancestor-p from tracked))
branch from tracked))) (user-error "Cannot spin off %s. %s is ancestor of upstream %s"
(let ((magit-process-raise-error t)) branch from tracked)))
(if checkout (let ((magit-process-raise-error t))
(magit-call-git "checkout" "-b" branch current) (if checkout
(magit-call-git "branch" branch current))) (magit-call-git "checkout" "-b" branch current)
(when-let ((upstream (magit-get-indirect-upstream-branch current))) (magit-call-git "branch" branch current)))
(magit-call-git "branch" "--set-upstream-to" upstream branch)) (when-let ((upstream (magit-get-indirect-upstream-branch current)))
(when (and tracked (magit-call-git "branch" "--set-upstream-to" upstream branch))
(setq base (when (and tracked
(if from (setq base
(concat from "^") (if from
(magit-git-string "merge-base" current tracked))) (concat from "^")
(not (magit-rev-eq base current))) (magit-git-string "merge-base" current tracked)))
(if checkout (not (magit-rev-eq base current)))
(magit-call-git "update-ref" "-m" (if checkout
(format "reset: moving to %s" base) (magit-call-git "update-ref" "-m"
(concat "refs/heads/" current) base) (format "reset: moving to %s" base)
(magit-call-git "reset" "--hard" base)))) (concat "refs/heads/" current) base)
(if checkout (magit-call-git "reset" "--hard" base)))))
(magit-call-git "checkout" "-b" branch) (checkout
(magit-call-git "branch" branch))) (magit-call-git "checkout" "-b" branch))
((magit-call-git "branch" branch)))
(magit-refresh)) (magit-refresh))
;;;###autoload ;;;###autoload
@@ -595,16 +595,16 @@ prompt is confusing."
(setq branches (setq branches
(list (magit-read-branch-prefer-other (list (magit-read-branch-prefer-other
(if force "Force delete branch" "Delete branch"))))) (if force "Force delete branch" "Delete branch")))))
(when-let (((not force)) (cond-let
(unmerged (seq-remove #'magit-branch-merged-p branches))) (force)
(if (magit-confirm 'delete-unmerged-branch [[unmerged (seq-remove #'magit-branch-merged-p branches)]]
"Delete unmerged branch %s" ((magit-confirm 'delete-unmerged-branch
"Delete %d unmerged branches" "Delete unmerged branch %s"
'noabort unmerged) "Delete %d unmerged branches"
(setq force branches) 'noabort unmerged)
(or (setq branches (setq force branches))
(cl-set-difference branches unmerged :test #'equal)) ((setq branches (cl-set-difference branches unmerged :test #'equal)))
(user-error "Abort")))) ((user-error "Abort")))
(list branches force))) (list branches force)))
(let ((refs (mapcar #'magit-ref-fullname branches))) (let ((refs (mapcar #'magit-ref-fullname branches)))
;; If a member of refs is nil, that means that ;; 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))) (format "%s is" (seq-find #'magit-ref-ambiguous-p branches)))
((= len (length refs)) ((= len (length refs))
(format "These %s names are" len)) (format "These %s names are" len))
(t ((format "%s of these names are" len))))))
(format "%s of these names are" len))))))
(cond (cond
((string-match "^refs/remotes/\\([^/]+\\)" (car refs)) ((string-match "^refs/remotes/\\([^/]+\\)" (car refs))
(let* ((remote (match-string 1 (car refs))) (let* ((remote (match-str 1 (car refs)))
(offset (1+ (length remote)))) (offset (1+ (length remote))))
(cond (cond
((magit-confirm 'delete-branch-on-remote ((magit-confirm 'delete-branch-on-remote
@@ -728,25 +727,24 @@ prompt is confusing."
(magit-set nil "branch" branch "pushRemote")) (magit-set nil "branch" branch "pushRemote"))
(defun magit-delete-remote-branch-sentinel (remote refs process event) (defun magit-delete-remote-branch-sentinel (remote refs process event)
(when (memq (process-status process) '(exit signal)) (cond-let*
(if (= (process-exit-status process) 1) ((not (memq (process-status process) '(exit signal))))
(if-let ((on-remote (mapcar (##concat "refs/remotes/" remote "/" %) ([_(= (process-exit-status process) 1)]
(magit-remote-list-branches remote))) [on-remote (mapcar (##concat "refs/remotes/" remote "/" %)
(rest (seq-filter (##and (not (member % on-remote)) (magit-remote-list-branches remote))]
(magit-ref-exists-p %)) [rest (seq-filter (##and (not (member % on-remote))
refs))) (magit-ref-exists-p %))
(progn refs)]
(process-put process 'inhibit-refresh t) (process-put process 'inhibit-refresh t)
(magit-process-sentinel process event) (magit-process-sentinel process event)
(setq magit-this-error nil) (setq magit-this-error nil)
(message "Some remote branches no longer exist. %s" (message "Some remote branches no longer exist. %s"
"Deleting just the local tracking refs instead...") "Deleting just the local tracking refs instead...")
(dolist (ref rest) (dolist (ref rest)
(magit-call-git "update-ref" "-d" ref)) (magit-call-git "update-ref" "-d" ref))
(magit-refresh) (magit-refresh)
(message "Deleting local remote-tracking refs...done")) (message "Deleting local remote-tracking refs...done"))
(magit-process-sentinel process event)) ((magit-process-sentinel process event))))
(magit-process-sentinel process event))))
;;;###autoload ;;;###autoload
(defun magit-branch-rename (old new &optional force) (defun magit-branch-rename (old new &optional force)
@@ -766,7 +764,7 @@ the remote."
nil 'magit-revision-history) nil 'magit-revision-history)
current-prefix-arg))) current-prefix-arg)))
(when (string-match "\\`heads/\\(.+\\)" old) (when (string-match "\\`heads/\\(.+\\)" old)
(setq old (match-string 1 old))) (setq old (match-str 1 old)))
(when (equal old new) (when (equal old new)
(user-error "Old and new branch names are the same")) (user-error "Old and new branch names are the same"))
(magit-call-git "branch" (if force "-M" "-m") old new) (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)) (or (not (eq magit-branch-rename-push-target 'forge-only))
(and (require (quote forge) nil t) (and (require (quote forge) nil t)
(fboundp 'forge--split-forge-url) (fboundp 'forge--split-forge-url)
(and-let* ((url (magit-git-string (and$ (magit-git-string "remote" "get-url" remote)
"remote" "get-url" remote))) (forge--split-forge-url $)))))
(forge--split-forge-url url)))))
(let ((old-target (magit-get-push-branch old t)) (let ((old-target (magit-get-push-branch old t))
(new-target (magit-get-push-branch new t)) (new-target (magit-get-push-branch new t))
(remote (magit-get-push-remote new))) (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 Rename \"refs/shelved/BRANCH\" to \"refs/heads/BRANCH\". If BRANCH
is prefixed with \"YYYY-MM-DD\", then drop that part of the name. is prefixed with \"YYYY-MM-DD\", then drop that part of the name.
Also rename the respective reflog file." Also rename the respective reflog file."
(interactive (interactive (list (magit-read-shelved-branch "Unshelve branch")))
(list (magit-completing-read
"Unshelve branch"
(mapcar (##substring % 8)
(nreverse (magit-list-refnames "refs/shelved")))
nil t)))
(let ((old (concat "refs/shelved/" branch)) (let ((old (concat "refs/shelved/" branch))
(new (concat "refs/heads/" (new (concat "refs/heads/"
(if (string-match-p (if (string-match-p
@@ -856,7 +848,7 @@ Also rename the respective reflog file."
;;; Configure ;;; 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) (transient-define-prefix magit-branch-configure (branch)
"Configure a branch." "Configure a branch."
:man-page "git-branch" :man-page "git-branch"
@@ -979,4 +971,15 @@ Also rename the respective reflog file."
;;; _ ;;; _
(provide 'magit-branch) (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 ;;; magit-branch.el ends here
lisp/magit/magit-bundle.el
+14 -3
View File
@@ -33,7 +33,7 @@
;;; Commands ;;; Commands
;;;###autoload (autoload 'magit-bundle "magit-bundle" nil t) ;;;###autoload(autoload 'magit-bundle "magit-bundle" nil t)
(transient-define-prefix magit-bundle () (transient-define-prefix magit-bundle ()
"Create or verify Git bundles." "Create or verify Git bundles."
:man-page "git-bundle" :man-page "git-bundle"
@@ -42,7 +42,7 @@
("v" "verify" magit-bundle-verify) ("v" "verify" magit-bundle-verify)
("l" "list-heads" magit-bundle-list-heads)]) ("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) (transient-define-prefix magit-bundle-create (&optional file refs args)
"Create a bundle." "Create a bundle."
:man-page "git-bundle" :man-page "git-bundle"
@@ -99,7 +99,7 @@
;;;###autoload ;;;###autoload
(defun magit-bundle-update-tracked (tag) (defun magit-bundle-update-tracked (tag)
"Update a bundle that is being tracked using 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 (msg)
(let-alist (magit--with-temp-process-buffer (let-alist (magit--with-temp-process-buffer
(save-excursion (save-excursion
@@ -136,4 +136,15 @@
;;; _ ;;; _
(provide 'magit-bundle) (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 ;;; 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 ;;; Commands
;;;###autoload (autoload 'magit-clone "magit-clone" nil t) ;;;###autoload(autoload 'magit-clone "magit-clone" nil t)
(transient-define-prefix magit-clone (&optional transient) (transient-define-prefix magit-clone (&optional transient)
"Clone a repository." "Clone a repository."
:man-page "git-clone" :man-page "git-clone"
@@ -314,13 +314,13 @@ Then show the status buffer for the new repository."
(defun magit-clone--url-to-name (url) (defun magit-clone--url-to-name (url)
(and (string-match "\\([^/:]+?\\)\\(/?\\.git\\)?$" url) (and (string-match "\\([^/:]+?\\)\\(/?\\.git\\)?$" url)
(match-string 1 url))) (match-str 1 url)))
(defun magit-clone--name-to-url (name) (defun magit-clone--name-to-url (name)
(or (seq-some (or (seq-some
(pcase-lambda (`(,re ,host ,user)) (pcase-lambda (`(,re ,host ,user))
(and (string-match re name) (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--format-url host user repo))))
magit-clone-name-alist) magit-clone-name-alist)
(user-error "Not an url and no matching entry in `%s'" (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 (format-spec
url-format url-format
`((?h . ,host) `((?h . ,host)
(?n . ,(if (string-search "/" repo) (?n . ,(cond
repo ((string-search "/" repo) repo)
(if (string-search "." user) ((string-search "." user)
(if-let ((user (magit-get user))) (if-let ((user (magit-get user)))
(concat user "/" repo) (concat user "/" repo)
(user-error "Set %S or specify owner explicitly" user)) (user-error "Set %S or specify owner explicitly" user)))
(concat user "/" repo)))))) ((concat user "/" repo))))))
(user-error (user-error
"Bogus `magit-clone-url-format' (bad type or missing default)"))) "Bogus `magit-clone-url-format' (bad type or missing default)")))
;;; _ ;;; _
(provide 'magit-clone) (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 ;;; 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 ;;; Popup
;;;###autoload (autoload 'magit-commit "magit-commit" nil t) ;;;###autoload(autoload 'magit-commit "magit-commit" nil t)
(transient-define-prefix magit-commit () (transient-define-prefix magit-commit ()
"Create a new commit or replace an existing commit." "Create a new commit or replace an existing commit."
:info-manual "(magit)Initiating a Commit" :info-manual "(magit)Initiating a Commit"
@@ -539,7 +539,7 @@ is updated:
(magit-commit-absorb-modules 'run commit)) (magit-commit-absorb-modules 'run commit))
nil nil nil nil 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) (transient-define-prefix magit-commit-absorb (phase commit args)
"Spread staged changes across recent commits. "Spread staged changes across recent commits.
With a prefix argument use a transient command to select infix 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 (when commit
(setq commit (magit-rebase-interactive-assert commit t))) (setq commit (magit-rebase-interactive-assert commit t)))
(if (and commit (eq phase 'run)) (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 (magit-log-select
(lambda (commit) (lambda (commit)
(with-no-warnings ; about non-interactive use (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) (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) (transient-define-prefix magit-commit-autofixup (phase commit args)
"Spread staged or unstaged changes across recent commits. "Spread staged or unstaged changes across recent commits.
@@ -614,7 +614,7 @@ an alternative implementation."
(when commit (when commit
(setq commit (magit-rebase-interactive-assert commit t))) (setq commit (magit-rebase-interactive-assert commit t)))
(if (and commit (eq phase 'run)) (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 (magit-log-select
(lambda (commit) (lambda (commit)
(with-no-warnings ; about non-interactive use (with-no-warnings ; about non-interactive use
@@ -646,6 +646,7 @@ an alternative implementation."
#'magit-commit-instant-fixup #'magit-commit-instant-fixup
#'magit-commit-instant-squash)) #'magit-commit-instant-squash))
;;;###autoload
(defun magit-run-post-commit-hook () (defun magit-run-post-commit-hook ()
(when (and (not this-command) (when (and (not this-command)
(memq last-command magit-post-commit-hook-commands)) (memq last-command magit-post-commit-hook-commands))
@@ -707,8 +708,8 @@ an alternative implementation."
(cond (cond
((not ((not
(and (eq this-command 'magit-diff-while-committing) (and (eq this-command 'magit-diff-while-committing)
(and-let* ((buf (magit-get-mode-buffer (and-let ((buf (magit-get-mode-buffer
'magit-diff-mode nil 'selected))) 'magit-diff-mode nil 'selected)))
(and (equal rev (buffer-local-value 'magit-buffer-range buf)) (and (equal rev (buffer-local-value 'magit-buffer-range buf))
(equal arg (buffer-local-value 'magit-buffer-typearg buf))))))) (equal arg (buffer-local-value 'magit-buffer-typearg buf)))))))
((eq command 'magit-commit-amend) ((eq command 'magit-commit-amend)
@@ -784,7 +785,7 @@ actually insert the entry."
(narrow-to-region (point-min) (point)) (narrow-to-region (point-min) (point))
(cond ((re-search-backward (format "* %s\\(?: (\\([^)]+\\))\\)?: " file) (cond ((re-search-backward (format "* %s\\(?: (\\([^)]+\\))\\)?: " file)
nil t) nil t)
(when (equal (match-string 1) defun) (when (equal (match-str 1) defun)
(setq defun nil)) (setq defun nil))
(re-search-forward ": ")) (re-search-forward ": "))
(t (t
@@ -813,4 +814,15 @@ actually insert the entry."
;;; _ ;;; _
(provide 'magit-commit) (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 ;;; 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) (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 ;;; 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 'magit)
(require 'dired)
;; For `magit-do-async-shell-command'. ;; For `magit-do-async-shell-command'.
(declare-function dired-read-shell-command "dired-aux" (prompt arg files)) (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'." is no file at point, then instead visit `default-directory'."
(interactive "P") (interactive "P")
(dired-jump other-window (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) (expand-file-name (if (file-directory-p file)
(file-name-as-directory file) (file-name-as-directory file)
file))))) file)))))
@@ -106,4 +110,15 @@ Interactively, open the file at point."
;;; _ ;;; _
(provide 'magit-dired) (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 ;;; 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) (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 () (transient-define-prefix magit-ediff ()
"Show differences using the Ediff package." "Show differences using the Ediff package."
:info-manual "(ediff)" :info-manual "(ediff)"
@@ -266,21 +266,21 @@ and alternative commands."
(goto-char (point-min)) (goto-char (point-min))
(unless (re-search-forward "^<<<<<<< " nil t) (unless (re-search-forward "^<<<<<<< " nil t)
(magit-stage-files (list file))))))))) (magit-stage-files (list file)))))))))
(if fileC (cond (fileC
(magit-ediff-buffers (magit-ediff-buffers
((magit-get-revision-buffer revA fileA) ((magit-get-revision-buffer revA fileA)
(magit-find-file-noselect revA fileA)) (magit-find-file-noselect revA fileA))
((magit-get-revision-buffer revB fileB) ((magit-get-revision-buffer revB fileB)
(magit-find-file-noselect revB fileB)) (magit-find-file-noselect revB fileB))
((magit-get-revision-buffer revC fileC) ((magit-get-revision-buffer revC fileC)
(magit-find-file-noselect revC fileC)) (magit-find-file-noselect revC fileC))
setup quit file) setup quit file))
(magit-ediff-buffers ((magit-ediff-buffers
((magit-get-revision-buffer revA fileA) ((magit-get-revision-buffer revA fileA)
(magit-find-file-noselect revA fileA)) (magit-find-file-noselect revA fileA))
((magit-get-revision-buffer revB fileB) ((magit-get-revision-buffer revB fileB)
(magit-find-file-noselect revB fileB)) (magit-find-file-noselect revB fileB))
nil setup quit file)))))) nil setup quit file)))))))
;;;###autoload ;;;###autoload
(defun magit-ediff-resolve-rest (file) (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))) (bufC* (or bufC (find-file-noselect file)))
(coding-system-for-read (coding-system-for-read
(buffer-local-value 'buffer-file-coding-system bufC*)) (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))) (bufB* (magit-find-file-index-noselect file t)))
(with-current-buffer bufB* (setq buffer-read-only nil)) (with-current-buffer bufB* (setq buffer-read-only nil))
(magit-ediff-buffers (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)) (magit-ediff-show-stash revB))
(file (file
(funcall command file)) (funcall command file))
(t ((call-interactively command)))))))
(call-interactively command)))))))
;;;###autoload ;;;###autoload
(defun magit-ediff-show-staged (file) (defun magit-ediff-show-staged (file)
@@ -602,4 +601,15 @@ stash that were staged."
;;; _ ;;; _
(provide 'magit-ediff) (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 ;;; magit-ediff.el ends here
lisp/magit/magit-extras.el
+108 -105
View File
@@ -42,7 +42,7 @@
;;; Git Tools ;;; Git Tools
;;;; Git-Mergetool ;;;; 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) (transient-define-prefix magit-git-mergetool (file args &optional transient)
"Resolve conflicts in FILE using \"git mergetool --gui\". "Resolve conflicts in FILE using \"git mergetool --gui\".
With a prefix argument allow changing ARGS using a transient 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 (with-eval-after-load 'project
(when (and magit-bind-magit-project-status (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. ;; Only modify if it hasn't already been modified.
(equal project-switch-commands (equal project-switch-commands
(eval (car (get 'project-switch-commands 'standard-value)) (eval (car (get 'project-switch-commands 'standard-value))
@@ -282,7 +279,7 @@ with two prefix arguments remove ignored files only.
(1 "untracked") (1 "untracked")
(4 "untracked and ignored") (4 "untracked and ignored")
(_ "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"))))) (magit-run-git "clean" "-f" "-d" (pcase arg (4 "-x") (16 "-X")))))
(put 'magit-clean 'disabled t) (put 'magit-clean 'disabled t)
@@ -335,10 +332,7 @@ a position in a file-visiting buffer."
(prompt-for-change-log-name))) (prompt-for-change-log-name)))
(pcase-let ((`(,buf ,pos) (magit-diff-visit-file--noselect))) (pcase-let ((`(,buf ,pos) (magit-diff-visit-file--noselect)))
(magit--with-temp-position buf pos (magit--with-temp-position buf pos
(let ((add-log-buffer-file-name-function (let ((add-log-buffer-file-name-function #'magit-buffer-file-name))
(lambda ()
(or magit-buffer-file-name
(buffer-file-name)))))
(add-change-log-entry whoami file-name other-window))))) (add-change-log-entry whoami file-name other-window)))))
;;;###autoload ;;;###autoload
@@ -396,7 +390,7 @@ points at it) otherwise."
(put 'magit-edit-line-commit 'disabled t) (put 'magit-edit-line-commit 'disabled t)
;;;###autoload ;;;###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. "From a hunk, edit the respective commit and visit the file.
First visit the file being modified by the hunk at the correct 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 Neither the blob nor the file buffer are killed when finishing
the rebase. If that is undesirable, then it might be better to the rebase. If that is undesirable, then it might be better to
use `magit-rebase-edit-commit' instead of this command." 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)) (let ((magit-diff-visit-previous-blob nil))
(with-current-buffer (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)))) (magit-edit-line-commit))))
(put 'magit-diff-edit-hunk-commit 'disabled t) (put 'magit-diff-edit-hunk-commit 'disabled t)
@@ -609,47 +603,45 @@ the minibuffer too."
default-directory)) default-directory))
(push (caar magit-revision-stack) magit-revision-history) (push (caar magit-revision-stack) magit-revision-history)
(pop magit-revision-stack))) (pop magit-revision-stack)))
(if rev (unless rev
(pcase-let ((`(,pnt-format ,eob-format ,idx-format) (user-error "Revision stack is empty"))
magit-pop-revision-stack-format)) (pcase-let ((`(,pnt-format ,eob-format ,idx-format)
(let ((default-directory toplevel) magit-pop-revision-stack-format))
(idx (and idx-format (let ((default-directory toplevel)
(save-excursion (idx (and idx-format
(if (re-search-backward idx-format nil t) (if (save-excursion
(number-to-string (re-search-backward idx-format nil t))
(1+ (string-to-number (match-string 1)))) (number-to-string (1+ (string-to-number (match-str 1))))
"1")))) "1")))
pnt-args eob-args) (pnt-args nil)
(when (listp pnt-format) (eob-args nil))
(setq pnt-args (cdr pnt-format)) (when (listp pnt-format)
(setq pnt-format (car pnt-format))) (setq pnt-args (cdr pnt-format))
(when (listp eob-format) (setq pnt-format (car pnt-format)))
(setq eob-args (cdr eob-format)) (when (listp eob-format)
(setq eob-format (car eob-format))) (setq eob-args (cdr eob-format))
(when pnt-format (setq eob-format (car eob-format)))
(when idx-format (when pnt-format
(setq pnt-format (when idx-format
(string-replace "%N" idx pnt-format))) (setq pnt-format (string-replace "%N" idx pnt-format)))
(magit-rev-insert-format pnt-format rev pnt-args) (magit-rev-insert-format pnt-format rev pnt-args)
(delete-char -1)) (delete-char -1))
(when eob-format (when eob-format
(when idx-format (when idx-format
(setq eob-format (setq eob-format (string-replace "%N" idx eob-format)))
(string-replace "%N" idx eob-format))) (save-excursion
(save-excursion (goto-char (point-max))
(goto-char (point-max)) (skip-syntax-backward ">-")
(skip-syntax-backward ">-") (beginning-of-line)
(beginning-of-line) (if (and comment-start (looking-at comment-start))
(if (and comment-start (looking-at comment-start)) (while (looking-at comment-start)
(while (looking-at comment-start) (forward-line -1))
(forward-line -1)) (forward-line)
(forward-line) (unless (= (current-column) 0)
(unless (= (current-column) 0) (insert ?\n)))
(insert ?\n))) (insert ?\n)
(insert ?\n) (magit-rev-insert-format eob-format rev eob-args)
(magit-rev-insert-format eob-format rev eob-args) (delete-char -1))))))
(delete-char -1)))))
(user-error "Revision stack is empty")))
;;;###autoload ;;;###autoload
(defun magit-copy-section-value (arg) (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 the added or removed lines, depending on the sign of the prefix
argument." argument."
(interactive "P") (interactive "P")
(cond (cond-let*
((and arg ((and arg
(magit-section-internal-region-p) (magit-section-internal-region-p)
(magit-section-match 'hunk)) (magit-section-match 'hunk))
(kill-new (kill-new
(thread-last (buffer-substring-no-properties (thread-last (buffer-substring-no-properties
(region-beginning) (region-beginning)
(region-end)) (region-end))
(replace-regexp-in-string (replace-regexp-in-string
(format "^\\%c.*\n?" (if (< (prefix-numeric-value arg) 0) ?+ ?-)) (format "^\\%c.*\n?" (if (< (prefix-numeric-value arg) 0) ?+ ?-))
"") "")
(replace-regexp-in-string "^[ +-]" ""))) (replace-regexp-in-string "^[ +-]" "")))
(deactivate-mark)) (deactivate-mark))
((use-region-p) ((use-region-p)
(call-interactively #'copy-region-as-kill)) (call-interactively #'copy-region-as-kill))
(t ([section (magit-current-section)]
(when-let* ((section (magit-current-section)) [value (oref section value)]
(value (oref section value))) (magit-section-case
(magit-section-case ((branch commit module-commit tag)
((branch commit module-commit tag) (let ((default-directory default-directory) ref)
(let ((default-directory default-directory) ref) (magit-section-case
(magit-section-case ((branch tag)
((branch tag) (setq ref value))
(setq ref value)) (module-commit
(module-commit (setq default-directory
(setq default-directory (file-name-as-directory
(file-name-as-directory (expand-file-name (magit-section-parent-value section)
(expand-file-name (magit-section-parent-value section) (magit-toplevel))))))
(magit-toplevel)))))) (setq value (magit-rev-parse
(setq value (magit-rev-parse (and magit-copy-revision-abbreviated "--short")
(and magit-copy-revision-abbreviated "--short") value))
value)) (push (list value default-directory) magit-revision-stack)
(push (list value default-directory) magit-revision-stack) (kill-new (message "%s" (or (and current-prefix-arg ref)
(kill-new (message "%s" (or (and current-prefix-arg ref) value)))))
value))))) (t (kill-new (message "%s" value)))))))
(t (kill-new (message "%s" value))))))))
;;;###autoload ;;;###autoload
(defun magit-copy-buffer-revision () (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 abbreviated revision to the `kill-ring' and the
`magit-revision-stack'." `magit-revision-stack'."
(interactive) (interactive)
(if (use-region-p) (cond-let*
(call-interactively #'copy-region-as-kill) ((use-region-p)
(when-let ((rev (or magit-buffer-revision (call-interactively #'copy-region-as-kill))
(cl-case major-mode ([rev (or magit-buffer-revision
(magit-diff-mode (cl-case major-mode
(if (string-match "\\.\\.\\.?\\(.+\\)" (magit-diff-mode
magit-buffer-range) (if (string-match "\\.\\.\\.?\\(.+\\)"
(match-string 1 magit-buffer-range) magit-buffer-range)
magit-buffer-range)) (match-str 1 magit-buffer-range)
(magit-status-mode "HEAD"))))) magit-buffer-range))
(when (magit-commit-p rev) (magit-status-mode "HEAD")))]
(setq rev (magit-rev-parse [_(magit-commit-p rev)]
(and magit-copy-revision-abbreviated "--short") (setq rev (magit-rev-parse
rev)) (and magit-copy-revision-abbreviated "--short")
(push (list rev default-directory) magit-revision-stack) rev))
(kill-new (message "%s" rev)))))) (push (list rev default-directory) magit-revision-stack)
(kill-new (message "%s" rev)))))
;;; Buffer Switching ;;; Buffer Switching
@@ -835,4 +827,15 @@ In Magit diffs, also skip over - and + at the beginning of the line."
;;; _ ;;; _
(provide 'magit-extras) (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 ;;; magit-extras.el ends here
lisp/magit/magit-fetch.el
+16 -6
View File
@@ -30,7 +30,7 @@
;;; Commands ;;; Commands
;;;###autoload (autoload 'magit-fetch "magit-fetch" nil t) ;;;###autoload(autoload 'magit-fetch "magit-fetch" nil t)
(transient-define-prefix magit-fetch () (transient-define-prefix magit-fetch ()
"Fetch from another repository." "Fetch from another repository."
:man-page "git-fetch" :man-page "git-fetch"
@@ -58,7 +58,7 @@
(run-hooks 'magit-credential-hook) (run-hooks 'magit-credential-hook)
(magit-run-git-async "fetch" remote args)) (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) (transient-define-suffix magit-fetch-from-pushremote (args)
"Fetch from the current push-remote. "Fetch from the current push-remote.
@@ -84,10 +84,9 @@ push-remote."
((member remote (magit-list-remotes)) remote) ((member remote (magit-list-remotes)) remote)
(remote (remote
(format "%s, replacing invalid" v)) (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) (transient-define-suffix magit-fetch-from-upstream (remote args)
"Fetch from the \"current\" remote, usually the upstream. "Fetch from the \"current\" remote, usually the upstream.
@@ -156,7 +155,7 @@ removed on the respective remote."
(run-hooks 'magit-credential-hook) (run-hooks 'magit-credential-hook)
(magit-run-git-async "remote" "update")) (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) (transient-define-prefix magit-fetch-modules (&optional transient args)
"Fetch all populated submodules. "Fetch all populated submodules.
@@ -183,4 +182,15 @@ with a prefix argument."
;;; _ ;;; _
(provide 'magit-fetch) (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 ;;; 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) (defun magit-find-file-read-args (prompt)
(let ((pseudo-revs '("{worktree}" "{index}"))) (let ((pseudo-revs '("{worktree}" "{index}")))
(if-let ((rev (magit-completing-read "Find file from revision" (let ((rev (magit-completing-read "Find file from revision"
(append pseudo-revs (append pseudo-revs
(magit-list-refnames nil t)) (magit-list-refnames nil t))
nil nil nil 'magit-revision-history nil 'any nil 'magit-revision-history
(or (magit-branch-or-commit-at-point) (or (magit-branch-or-commit-at-point)
(magit-get-current-branch))))) (magit-get-current-branch)))))
(list rev (magit-read-file-from-rev (if (member rev pseudo-revs) (list rev
"HEAD" (magit-read-file-from-rev (if (member rev pseudo-revs) "HEAD" rev)
rev) prompt)))))
prompt))
(user-error "Nothing selected"))))
(defun magit-find-file--internal (rev file fn) (defun magit-find-file--internal (rev file fn)
(let ((buf (magit-find-file-noselect rev file)) (let ((buf (magit-find-file-noselect rev file))
@@ -96,8 +94,7 @@ the line and column corresponding to that location."
(magit-buffer-revision (magit-buffer-revision
(setq line (magit-diff-visit--offset (setq line (magit-diff-visit--offset
file (concat magit-buffer-revision ".." rev) line))) 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) (funcall fn buf)
(when line (when line
(with-current-buffer buf (with-current-buffer buf
@@ -107,39 +104,35 @@ the line and column corresponding to that location."
(move-to-column col))) (move-to-column col)))
buf)) 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. "Read FILE from REV into a buffer and return the buffer.
REV is a revision or one of \"{worktree}\" or \"{index}\". REV is a revision or one of \"{worktree}\" or \"{index}\". FILE must
FILE must be relative to the top directory of the repository." be relative to the top directory of the repository. Non-nil REVERT
(magit-find-file-noselect-1 rev file)) means to revert the buffer. If `ask-revert', then only after asking.
A non-nil value for REVERT is ignored if REV is \"{worktree}\"."
(defun magit-find-file-noselect-1 (rev file &optional revert) (let* ((topdir (magit-toplevel))
"Read FILE from REV into a buffer and return the buffer. (absolute (file-name-absolute-p file))
REV is a revision or one of \"{worktree}\" or \"{index}\". (file-abs (if absolute file (expand-file-name file topdir)))
FILE must be relative to the top directory of the repository. (file-rel (if absolute (file-relative-name file topdir) file))
Non-nil REVERT means to revert the buffer. If `ask-revert', (defdir (file-name-directory file-abs))
then only after asking. A non-nil value for REVERT is ignored if REV is (rev (magit--abbrev-if-hash rev)))
\"{worktree}\"." (if (equal rev "{worktree}")
(if (equal rev "{worktree}") (let ((revert-without-query
(find-file-noselect (expand-file-name file (magit-toplevel))) (if (and$ (find-buffer-visiting file-abs)
(let ((topdir (magit-toplevel))) (buffer-local-value 'auto-revert-mode $))
(when (file-name-absolute-p file) (cons "." revert-without-query)
(setq file (file-relative-name file topdir))) revert-without-query)))
(with-current-buffer (magit-get-revision-buffer-create rev file) (find-file-noselect file-abs))
(with-current-buffer (magit-get-revision-buffer-create rev file-rel)
(when (or (not magit-buffer-file-name) (when (or (not magit-buffer-file-name)
(if (eq revert 'ask-revert) (if (eq revert 'ask-revert)
(y-or-n-p (format "%s already exists; revert it? " (y-or-n-p (format "%s already exists; revert it? "
(buffer-name)))) (buffer-name))))
revert) revert)
(setq magit-buffer-revision (setq magit-buffer-revision rev)
(if (equal rev "{index}")
"{index}"
(magit-rev-format "%H" rev)))
(setq magit-buffer-refname rev) (setq magit-buffer-refname rev)
(setq magit-buffer-file-name (expand-file-name file topdir)) (setq magit-buffer-file-name file-abs)
(setq default-directory (setq default-directory (if (file-exists-p defdir) defdir topdir))
(let ((dir (file-name-directory magit-buffer-file-name)))
(if (file-exists-p dir) dir topdir)))
(setq-local revert-buffer-function #'magit-revert-rev-file-buffer) (setq-local revert-buffer-function #'magit-revert-rev-file-buffer)
(revert-buffer t t) (revert-buffer t t)
(run-hooks (if (equal rev "{index}") (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 global-diff-hl-mode-enable-in-buffers ; Emacs < 30
eglot--maybe-activate-editing-mode) eglot--maybe-activate-editing-mode)
#'eq))) #'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) (setq buffer-read-only t)
(set-buffer-modified-p nil) (set-buffer-modified-p nil)
(goto-char (point-min)))) (goto-char (point-min))))
@@ -196,11 +192,12 @@ See also https://github.com/doomemacs/doomemacs/pull/6309."
;;; Find Index ;;; Find Index
(defvar magit-find-index-hook nil) (defvar magit-find-index-hook nil)
(add-hook 'magit-find-index-hook #'magit-blob-mode)
(defun magit-find-file-index-noselect (file &optional revert) (defun magit-find-file-index-noselect (file &optional revert)
"Read FILE from the index into a buffer and return the buffer. "Read FILE from the index into a buffer and return the buffer.
FILE must to be relative to the top directory of the repository." 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 () (defun magit-update-index ()
"Update the index with the contents of the current buffer. "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 (let ((index (make-temp-name
(expand-file-name "magit-update-index-" (magit-gitdir)))) (expand-file-name "magit-update-index-" (magit-gitdir))))
(buffer (current-buffer))) (buffer (current-buffer)))
(when magit-wip-before-change-mode (magit-run-before-change-functions file "un-/stage")
(magit-wip-commit-before-change (list file) " before un-/stage"))
(unwind-protect (unwind-protect
(progn (progn
(let ((coding-system-for-write buffer-file-coding-system)) (let ((coding-system-for-write buffer-file-coding-system))
@@ -232,8 +228,7 @@ is done using `magit-find-index-noselect'."
file))) file)))
(ignore-errors (delete-file index))) (ignore-errors (delete-file index)))
(set-buffer-modified-p nil) (set-buffer-modified-p nil)
(when magit-wip-after-apply-mode (magit-run-after-apply-functions file "un-/stage"))
(magit-wip-commit-after-apply (list file) " after un-/stage")))
(message "Abort"))) (message "Abort")))
(when-let ((buffer (magit-get-mode-buffer 'magit-status-mode))) (when-let ((buffer (magit-get-mode-buffer 'magit-status-mode)))
(with-current-buffer buffer (with-current-buffer buffer
@@ -292,7 +287,7 @@ directory, while reading the FILENAME."
;;; File Dispatch ;;; File Dispatch
;;;###autoload (autoload 'magit-file-dispatch "magit" nil t) ;;;###autoload(autoload 'magit-file-dispatch "magit" nil t)
(transient-define-prefix magit-file-dispatch () (transient-define-prefix magit-file-dispatch ()
"Invoke a Magit command that acts on the visited file. "Invoke a Magit command that acts on the visited file.
When invoked outside a file-visiting buffer, then fall back When invoked outside a file-visiting buffer, then fall back
@@ -355,7 +350,7 @@ to `magit-dispatch'."
"b" #'magit-blame-addition "b" #'magit-blame-addition
"r" #'magit-blame-removal "r" #'magit-blame-removal
"f" #'magit-blame-reverse "f" #'magit-blame-reverse
"q" #'magit-kill-this-buffer) "q" #'magit-bury-or-kill-buffer)
(define-minor-mode magit-blob-mode (define-minor-mode magit-blob-mode
"Enable some Magit features in blob-visiting buffers. "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}" \n\\{magit-blob-mode-map}"
:package-version '(magit . "2.3.0")) :package-version '(magit . "2.3.0"))
(defun magit-blob-next () (defun magit-bury-buffer (&optional kill-buffer)
"Visit the next blob which modified the current file." "Bury the current buffer, or with a prefix argument kill it."
(interactive) (interactive "P")
(if magit-buffer-file-name (if kill-buffer (kill-buffer) (bury-buffer)))
(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-blob-previous () (defun magit-bury-or-kill-buffer (&optional bury-buffer)
"Visit the previous blob which modified the current file." "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) (interactive)
(if-let ((file (or magit-buffer-file-name (kill-buffer))
(buffer-file-name (buffer-base-buffer)))))
(if-let ((ancestor (magit-blob-ancestor magit-buffer-revision file))) (transient-define-suffix magit-blob-previous ()
(magit-blob-visit ancestor) "Visit the previous blob which modified the current file."
(user-error "You have reached the beginning of time")) :inapt-if-not (##and$ (magit-buffer-file-name)
(user-error "Buffer isn't visiting a file or blob"))) (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 ;;;###autoload
(defun magit-blob-visit-file () (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) (magit-find-file--internal "{worktree}" file #'pop-to-buffer-same-window)
(user-error "Not visiting a blob"))) (user-error "Not visiting a blob")))
(defun magit-blob-visit (blob-or-file) (defun magit-blob-visit (rev file)
(if (stringp blob-or-file) (magit-find-file rev file)
(find-file blob-or-file) (unless (member rev '("{worktree}" "{index}"))
(pcase-let ((`(,rev ,file) blob-or-file)) (apply #'message "%s (%s %s ago)"
(magit-find-file rev file) (magit-rev-format "%s" rev)
(apply #'message "%s (%s %s ago)" (magit--age (magit-rev-format "%ct" rev)))))
(magit-rev-format "%s" rev)
(magit--age (magit-rev-format "%ct" rev))))))
(defun magit-blob-ancestor (rev file) (defun magit-blob-ancestor (rev file)
(let ((lines (magit-with-toplevel (pcase rev
(magit-git-lines "log" "-2" "--format=%H" "--name-only" ((and "{worktree}" (guard (magit-anything-staged-p nil file)))
"--follow" (or rev "HEAD") "--" file)))) (list "{index}" file))
(if rev (cddr lines) (butlast lines 2)))) ((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) (defun magit-blob-successor (rev file)
(let ((lines (magit-with-toplevel (pcase rev
(magit-git-lines "log" "--format=%H" "--name-only" "--follow" ("{worktree}" nil)
"HEAD" "--" file)))) ("{index}" (list "{worktree}" file))
(catch 'found (_ (let ((lines (magit-with-toplevel
(while lines (magit-git-lines "log" "--format=%h" "--name-only"
(if (equal (nth 2 lines) rev) "--follow" "HEAD" "--" file))))
(throw 'found (list (nth 0 lines) (nth 1 lines))) (catch 'found
(setq lines (nthcdr 2 lines))))))) (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 ;;; 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 (define-obsolete-function-alias 'magit-unstage-buffer-file
'magit-file-unstage "Magit 4.3.2") '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) (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 ;;; 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 ;;; Transient
;;;###autoload (autoload 'magit-gitignore "magit-gitignore" nil t) ;;;###autoload(autoload 'magit-gitignore "magit-gitignore" nil t)
(transient-define-prefix magit-gitignore () (transient-define-prefix magit-gitignore ()
"Instruct Git to ignore a file or pattern." "Instruct Git to ignore a file or pattern."
:man-page "gitignore" :man-page "gitignore"
@@ -118,9 +118,9 @@ Rules that are defined in that file affect all local repositories."
(mapcan (mapcan
(lambda (file) (lambda (file)
(cons (concat "/" file) (cons (concat "/" file)
(and-let* ((ext (file-name-extension file))) (and$ (file-name-extension file)
(list (concat "/" (file-name-directory file) "*." ext) (list (concat "/" (file-name-directory file) "*." $)
(concat "*." ext))))) (concat "*." $)))))
(sort (nconc (sort (nconc
(magit-untracked-files nil base) (magit-untracked-files nil base)
;; The untracked section of the status buffer lists ;; 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) (unless (member default choices)
(setq default nil)))) (setq default nil))))
(magit-completing-read "File or pattern to ignore" (magit-completing-read "File or pattern to ignore"
choices nil nil nil nil default))) choices nil 'any nil nil default)))
;;; Skip Worktree Commands ;;; Skip Worktree Commands
@@ -192,4 +192,15 @@ Rules that are defined in that file affect all local repositories."
;;; _ ;;; _
(provide 'magit-gitignore) (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 ;;; magit-gitignore.el ends here
lisp/magit/magit-log.el
+288 -219
View File
@@ -31,8 +31,7 @@
(require 'magit-core) (require 'magit-core)
(require 'magit-diff) (require 'magit-diff)
(declare-function magit--any-wip-mode-enabled-p "magit-wip" ()) (declare-function magit-blob-visit "magit-files" (rev file))
(declare-function magit-blob-visit "magit-files" (blob-or-file))
(declare-function magit-cherry-apply "magit-sequence" (commit &optional args)) (declare-function magit-cherry-apply "magit-sequence" (commit &optional args))
(declare-function magit-insert-head-branch-header "magit-status" (declare-function magit-insert-head-branch-header "magit-status"
(&optional branch)) (&optional branch))
@@ -48,9 +47,10 @@
(defvar magit-refs-focus-column-width) (defvar magit-refs-focus-column-width)
(defvar magit-refs-margin) (defvar magit-refs-margin)
(defvar magit-refs-show-commit-count) (defvar magit-refs-show-commit-count)
(defvar magit-buffer-margin) (defvar magit--right-margin-config)
(defvar magit-status-margin) (defvar magit-status-margin)
(defvar magit-status-sections-hook) (defvar magit-status-sections-hook)
(defvar magit-status-use-buffer-arguments)
(require 'ansi-color) (require 'ansi-color)
(require 'crm) (require 'crm)
@@ -170,6 +170,23 @@ want to use the same functions for both hooks."
:options (list #'magit-highlight-squash-markers :options (list #'magit-highlight-squash-markers
#'magit-highlight-bracket-keywords)) #'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 (defcustom magit-log-header-line-function #'magit-log-header-line-sentence
"Function used to generate text shown in header line of log buffers." "Function used to generate text shown in header line of log buffers."
:package-version '(magit . "2.12.0") :package-version '(magit . "2.12.0")
@@ -370,11 +387,15 @@ commits before and half after."
;;;; Prefix Methods ;;;; 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)) (cl-defmethod transient-init-value ((obj magit-log-prefix))
(pcase-let ((`(,args ,files) (pcase-let ((`(,args ,files)
(magit-log--get-value 'magit-log-mode (magit-log--get-value 'magit-log-mode 'prefix)))
magit-prefix-use-buffer-arguments))) (when-let ((_(not (eq transient-current-command 'magit-dispatch)))
(when-let (((not (eq transient-current-command 'magit-dispatch)))
(file (magit-file-relative-name))) (file (magit-file-relative-name)))
(setq files (list file))) (setq files (list file)))
(oset obj value (if files `(("--" ,@files) ,@args) args)))) (oset obj value (if files `(("--" ,@files) ,@args) args))))
@@ -396,40 +417,38 @@ commits before and half after."
(defun magit-log-arguments (&optional mode) (defun magit-log-arguments (&optional mode)
"Return the current log arguments." "Return the current log arguments."
(if (memq transient-current-command '(magit-log magit-log-refresh)) (if (memq transient-current-command '(magit-log magit-log-refresh))
(magit--transient-args-and-files) (transient-args transient-current-command)
(magit-log--get-value (or mode 'magit-log-mode)))) (magit-log--get-value (or mode 'magit-log-mode) 'direct)))
(defun magit-log--get-value (mode &optional use-buffer-args) (defun magit-log--get-value (mode &optional use-buffer-args)
(unless use-buffer-args (setq use-buffer-args
(setq use-buffer-args magit-direct-use-buffer-arguments)) (pcase-exhaustive use-buffer-args
(let (args files) ('prefix magit-prefix-use-buffer-arguments)
(cond ('status magit-status-use-buffer-arguments)
((and (memq use-buffer-args '(always selected current)) ('direct magit-direct-use-buffer-arguments)
(eq major-mode mode)) ('nil magit-direct-use-buffer-arguments)
(setq args magit-buffer-log-args) ((or 'always 'selected 'current 'never)
(setq files magit-buffer-log-files)) use-buffer-args)))
((when-let (((memq use-buffer-args '(always selected))) (cond-let
(buffer (magit-get-mode-buffer ((and (memq use-buffer-args '(always selected current))
mode nil (eq major-mode mode))
(eq use-buffer-args 'selected)))) (list magit-buffer-log-args
(setq args (buffer-local-value 'magit-buffer-log-args buffer)) magit-buffer-log-files))
(setq files (buffer-local-value 'magit-buffer-log-files buffer)) ([_(memq use-buffer-args '(always selected))]
t)) [buffer (magit-get-mode-buffer mode nil (eq use-buffer-args 'selected))]
((plist-member (symbol-plist mode) 'magit-log-current-arguments) (list (buffer-local-value 'magit-buffer-log-args buffer)
(setq args (get mode 'magit-log-current-arguments))) (buffer-local-value 'magit-buffer-log-files buffer)))
((when-let ((elt (assq (intern (format "magit-log:%s" mode)) ((plist-member (symbol-plist mode) 'magit-log-current-arguments)
transient-values))) (list (get mode 'magit-log-current-arguments) nil))
(setq args (cdr elt)) ([elt (assq (intern (format "magit-log:%s" mode)) transient-values)]
t)) (list (cdr elt) nil))
(t ((list (get mode 'magit-log-default-arguments) nil))))
(setq args (get mode 'magit-log-default-arguments))))
(list args files)))
(defun magit-log--set-value (obj &optional save) (defun magit-log--set-value (obj &optional save)
(pcase-let* ((obj (oref obj prototype)) (pcase-let* ((obj (oref obj prototype))
(mode (or (oref obj major-mode) major-mode)) (mode (or (oref obj major-mode) major-mode))
(key (intern (format "magit-log:%s" 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) (put mode 'magit-log-current-arguments args)
(when save (when save
(setf (alist-get key transient-values) args) (setf (alist-get key transient-values) args)
@@ -494,7 +513,7 @@ commits before and half after."
(eq major-mode 'magit-log-mode) (eq major-mode 'magit-log-mode)
t)) t))
;;;###autoload (autoload 'magit-log "magit-log" nil t) ;;;###autoload(autoload 'magit-log "magit-log" nil t)
(transient-define-prefix magit-log () (transient-define-prefix magit-log ()
"Show a commit or reference log." "Show a commit or reference log."
:man-page "git-log" :man-page "git-log"
@@ -516,14 +535,14 @@ commits before and half after."
("r" "current" magit-reflog-current) ("r" "current" magit-reflog-current)
("O" "other" magit-reflog-other) ("O" "other" magit-reflog-other)
("H" "HEAD" magit-reflog-head)] ("H" "HEAD" magit-reflog-head)]
[:if magit--any-wip-mode-enabled-p [:if-mode magit-wip-mode
:description "Wiplog" :description "Wiplog"
("i" "index" magit-wip-log-index) ("i" "index" magit-wip-log-index)
("w" "worktree" magit-wip-log-worktree)] ("w" "worktree" magit-wip-log-worktree)]
["Other" ["Other"
("s" "shortlog" magit-shortlog)]]) ("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 () (transient-define-prefix magit-log-refresh ()
"Change the arguments used for the log(s) in the current buffer." "Change the arguments used for the log(s) in the current buffer."
:man-page "git-log" :man-page "git-log"
@@ -639,13 +658,13 @@ commits before and half after."
"SPC" #'self-insert-command) "SPC" #'self-insert-command)
(defun magit-log-read-revs (&optional use-current) (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 "\\(\\.\\.\\.?\\|[, ]\\)") (let ((crm-separator "\\(\\.\\.\\.?\\|[, ]\\)")
(crm-local-completion-map magit-log-read-revs-map)) (crm-local-completion-map magit-log-read-revs-map))
(split-string (magit-completing-read-multiple (split-string (magit-completing-read-multiple
"Log rev,s: " "Log rev,s: "
(magit-list-refnames nil t) (magit-list-refnames nil t)
nil nil nil 'magit-revision-history nil 'any nil 'magit-revision-history
(or (magit-branch-or-commit-at-point) (or (magit-branch-or-commit-at-point)
(and (not use-current) (and (not use-current)
(magit-get-previous-branch))) (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." "Read a string from the user to pass as parameter to OPTION."
(magit-read-string (format "Type a pattern to pass to %s" 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) (transient-define-suffix magit-log-current (&optional args files)
"Show log for the current branch, or `HEAD' if no branch is checked out." "Show log for the current branch, or `HEAD' if no branch is checked out."
:description (##if (magit-get-current-branch) "current" "HEAD") :description (##if (magit-get-current-branch) "current" "HEAD")
@@ -722,18 +741,18 @@ completion candidates."
;;;###autoload ;;;###autoload
(defun magit-log-matching-branches (pattern &optional args files) (defun magit-log-matching-branches (pattern &optional args files)
"Show log for all branches matching PATTERN and `HEAD'." "Show log for all branches matching PATTERN and `HEAD'."
(interactive (cons (magit-log-read-pattern "--branches") (magit-log-arguments))) (interactive (cons (magit-log-read-pattern "--branches")
(magit-log-setup-buffer (magit-log-arguments)))
(list "HEAD" (format "--branches=%s" pattern)) (magit-log-setup-buffer (list "HEAD" (format "--branches=%s" pattern))
args files)) args files))
;;;###autoload ;;;###autoload
(defun magit-log-matching-tags (pattern &optional args files) (defun magit-log-matching-tags (pattern &optional args files)
"Show log for all tags matching PATTERN and `HEAD'." "Show log for all tags matching PATTERN and `HEAD'."
(interactive (cons (magit-log-read-pattern "--tags") (magit-log-arguments))) (interactive (cons (magit-log-read-pattern "--tags")
(magit-log-setup-buffer (magit-log-arguments)))
(list "HEAD" (format "--tags=%s" pattern)) (magit-log-setup-buffer (list "HEAD" (format "--tags=%s" pattern))
args files)) args files))
;;;###autoload ;;;###autoload
(defun magit-log-all-branches (&optional args files) (defun magit-log-all-branches (&optional args files)
@@ -748,10 +767,7 @@ completion candidates."
(defun magit-log-all (&optional args files) (defun magit-log-all (&optional args files)
"Show log for all references and `HEAD'." "Show log for all references and `HEAD'."
(interactive (magit-log-arguments)) (interactive (magit-log-arguments))
(magit-log-setup-buffer (if (magit-get-current-branch) (magit-log-setup-buffer (list "--all") args files))
(list "--all")
(list "HEAD" "--all"))
args files))
;;;###autoload ;;;###autoload
(defun magit-log-buffer-file (&optional follow beg end) (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" (user-error "Could not find when %s was merged into %s: %s"
commit branch m))))) 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 ;;;; Limit Commands
(defun magit-log-toggle-commit-limit () (defun magit-log-toggle-commit-limit ()
@@ -887,7 +910,7 @@ limit. Otherwise set it to 256."
(defun magit-log-set-commit-limit (fn) (defun magit-log-set-commit-limit (fn)
(let* ((val magit-buffer-log-args) (let* ((val magit-buffer-log-args)
(arg (seq-find (##string-match "^-n\\([0-9]+\\)?$" %) val)) (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))) (num (if num (funcall fn num 2) 256)))
(setq val (remove arg val)) (setq val (remove arg val))
(setq magit-buffer-log-args (setq magit-buffer-log-args
@@ -897,9 +920,9 @@ limit. Otherwise set it to 256."
(magit-refresh)) (magit-refresh))
(defun magit-log-get-commit-limit (&optional args) (defun magit-log-get-commit-limit (&optional args)
(and-let* ((str (seq-find (##string-match "^-n\\([0-9]+\\)?$" %) (and$ (seq-find (##string-match "^-n\\([0-9]+\\)?$" %)
(or args magit-buffer-log-args)))) (or args magit-buffer-log-args))
(string-to-number (match-string 1 str)))) (string-to-number (match-str 1 $))))
;;;; Mode Commands ;;;; 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 prefix argument instead bury the revision buffer, provided it
is displayed in the current frame." is displayed in the current frame."
(interactive "p") (interactive "p")
(if (< arg 0) (cond-let*
(let* ((buf (magit-get-mode-buffer 'magit-revision-mode)) ((>= arg 0)
(win (and buf (get-buffer-window buf (selected-frame))))) (magit-mode-bury-buffer (> arg 1)))
(if win ([buf (magit-get-mode-buffer 'magit-revision-mode)]
(with-selected-window win [win (get-buffer-window buf (selected-frame))]
(with-current-buffer buf (with-selected-window win
(magit-mode-bury-buffer (> (abs arg) 1)))) (with-current-buffer buf
(user-error "No revision buffer in this frame"))) (magit-mode-bury-buffer (> (abs arg) 1)))))
(magit-mode-bury-buffer (> arg 1)))) ((user-error "No revision buffer in this frame"))))
;;;###autoload ;;;###autoload
(defun magit-log-move-to-parent (&optional n) (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 If invoked outside any log buffer, then display the log buffer
of the current repository first; creating it if necessary." of the current repository first; creating it if necessary."
(interactive (interactive
(list (or (magit-completing-read (list (magit-completing-read
"In log, jump to" "In log, jump to"
(magit-list-refnames nil t) (magit-list-refnames nil t)
nil nil nil 'magit-revision-history nil 'any nil 'magit-revision-history
(or (and-let* ((rev (magit-commit-at-point))) (or (and$ (magit-commit-at-point)
(magit-rev-fixup-target rev)) (magit-rev-fixup-target $))
(magit-get-current-branch))) (magit-get-current-branch)))))
(user-error "Nothing selected"))))
(with-current-buffer (with-current-buffer
(cond ((derived-mode-p 'magit-log-mode) (cond ((derived-mode-p 'magit-log-mode)
(current-buffer)) (current-buffer))
((and-let* ((buf (magit-get-mode-buffer 'magit-log-mode))) ((and$ (magit-get-mode-buffer 'magit-log-mode)
(pop-to-buffer-same-window buf))) (pop-to-buffer-same-window $)))
(t ((apply #'magit-log-all-branches (magit-log-arguments))))
(apply #'magit-log-all-branches (magit-log-arguments))))
(unless (magit-log-goto-commit-section (magit-rev-abbrev commit)) (unless (magit-log-goto-commit-section (magit-rev-abbrev commit))
(user-error "%s isn't visible in the current log buffer" commit)))) (user-error "%s isn't visible in the current log buffer" commit))))
;;;; Shortlog Commands ;;;; Shortlog Commands
;;;###autoload (autoload 'magit-shortlog "magit-log" nil t) ;;;###autoload(autoload 'magit-shortlog "magit-log" nil t)
(transient-define-prefix magit-shortlog () (transient-define-prefix magit-shortlog ()
"Show a history summary." "Show a history summary."
:man-page "git-shortlog" :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")) (declare (obsolete magit--insert-log "Magit 4.0.0"))
(magit--insert-log nil revs args files)) (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) (defun magit--insert-log (keep-error revs &optional args files)
"Insert a log section. "Insert a log section.
Do not add this to a hook variable." 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))) (remove "--literal-pathspecs" magit-git-global-arguments)))
(magit--git-wash (apply-partially #'magit-log-wash-log 'log) keep-error (magit--git-wash (apply-partially #'magit-log-wash-log 'log) keep-error
"log" "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) (if (and (member "--left-right" args)
(not (member "--graph" args))) (not (member "--graph" args)))
"%m " "%m "
@@ -1235,6 +1269,13 @@ Do not add this to a hook variable."
"") "")
("%G?")))) ("%G?"))))
(if magit-log-margin-show-committer-date "%ct" "%at") (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 "++header" args)
(if (member "--graph" (setq args (remove "++header" args))) (if (member "--graph" (setq args (remove "++header" args)))
(concat "\n" magit-log-revision-headers-format "\n") (concat "\n" magit-log-revision-headers-format "\n")
@@ -1243,7 +1284,7 @@ Do not add this to a hook variable."
(progn (progn
(when-let ((order (seq-find (##string-match "^\\+\\+order=\\(.+\\)$" %) (when-let ((order (seq-find (##string-match "^\\+\\+order=\\(.+\\)$" %)
args))) args)))
(setq args (cons (format "--%s-order" (match-string 1 order)) (setq args (cons (format "--%s-order" (match-str 1 order))
(remove order args)))) (remove order args))))
(when (member "--decorate" args) (when (member "--decorate" args)
(setq args (cons "--decorate=full" (remove "--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) :parent magit-commit-section-map)
(defconst magit-log-heading-re (defconst magit-log-heading-re
;; Note: A form feed instead of a null byte is used as the delimiter ;; Use a form feed instead of a null byte as the delimiter because using
;; because using the latter interferes with the graph prefix when ;; the latter interferes with the graph prefix when ++header is used.
;; ++header is used.
(concat "^" (concat "^"
"\\(?4:[-_/|\\*o<>. ]*\\)" ; graph "\\(?4:[-_/|\\*o<>. ]*\\)" ; graph
"\\(?1:[0-9a-fA-F]+\\)? " ; hash "\\(?1:[0-9a-fA-F]+\\)? " ; hash
"\\(?3:[^ \n]+\\)? " ; refs "\\(?3:[^ \n]+\\)? " ; refs
"\\(?7:[BGUXYREN]\\)? " ; gpg "\\(?7:[BGUXYREN]\\)? " ; gpg
"\\(?5:[^ \n]*\\) " ; author "\\(?5:[^ \n]*\\) " ; author
;; Note: Date is optional because, prior to Git v2.19.0, ;; Prior to Git v2.19.0, "git rebase -i --root" corrupted the
;; `git rebase -i --root` corrupts the root's author date. ;; 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 "\\(?6:[^ \n]*\\) " ; date
"\\(?12:[^ \n]+\\)? " ; trailers
"\\(?2:.*\\)$")) ; msg "\\(?2:.*\\)$")) ; msg
(defconst magit-log-cherry-re (defconst magit-log-cherry-re
@@ -1376,129 +1419,145 @@ Do not add this to a hook variable."
('stash magit-log-stash-re) ('stash magit-log-stash-re)
('bisect-vis magit-log-bisect-vis-re) ('bisect-vis magit-log-bisect-vis-re)
('bisect-log magit-log-bisect-log-re))) ('bisect-log magit-log-bisect-log-re)))
(magit-bind-match-strings (let* ((hash (match-str 1))
(hash msg refs graph author date gpg cherry _ refsub side) nil (msg (match-str 2))
(setq msg (substring-no-properties msg)) (refs (match-str 3))
(when refs (refs (and refs (magit-format-ref-labels refs)))
(setq refs (substring-no-properties refs))) (graph (match-string 4))
(let ((align (or (eq style 'cherry) (author (match-str 5))
(not (member "--stat" magit-buffer-log-args)))) (date (match-str 6))
(non-graph-re (if (eq style 'bisect-vis) (gpg (match-str 7))
magit-log-bisect-vis-re (cherry (match-str 8))
magit-log-heading-re))) (refsub (match-str 10))
(magit-delete-line) (side (match-str 11))
;; If the reflog entries have been pruned, the output of `git (trailers (match-str 12))
;; reflog show' includes a partial line that refers to the hash (trailers (and trailers
;; of the youngest expired reflog entry. (funcall (car magit-log-trailer-labels)
(when (and (eq style 'reflog) (not date)) (mapcar (##split-string % "")
(cl-return-from magit-log-wash-rev t)) (split-string trailers "")))))
(magit-insert-section (align (or (eq style 'cherry)
((eval (pcase style (not (member "--stat" magit-buffer-log-args))))
('stash 'stash) (non-graph-re (if (eq style 'bisect-vis)
('module 'module-commit) magit-log-bisect-vis-re
(_ 'commit))) magit-log-heading-re)))
hash) (magit-delete-line)
(setq hash (propertize (if (eq style 'bisect-log) ;; If the reflog entries have been pruned, the output of `git
(magit-rev-parse "--short" hash) ;; reflog show' includes a partial line that refers to the hash
hash) ;; of the youngest expired reflog entry.
'font-lock-face (when (and (eq style 'reflog) (not date))
(pcase (and gpg (aref gpg 0)) (cl-return-from magit-log-wash-rev t))
(?G 'magit-signature-good) (magit-insert-section
(?B 'magit-signature-bad) ((eval (pcase style
(?U 'magit-signature-untrusted) ('stash 'stash)
(?X 'magit-signature-expired) ('module 'module-commit)
(?Y 'magit-signature-expired-key) (_ 'commit)))
(?R 'magit-signature-revoked) hash)
(?E 'magit-signature-error) (setq hash (propertize (if (eq style 'bisect-log)
(?N 'magit-hash) (magit-rev-parse "--short" hash)
(_ 'magit-hash)))) hash)
(when cherry 'font-lock-face
(when (and (derived-mode-p 'magit-refs-mode) (pcase (and gpg (aref gpg 0))
magit-refs-show-commit-count) (?G 'magit-signature-good)
(insert (make-string (1- magit-refs-focus-column-width) ?\s))) (?B 'magit-signature-bad)
(insert (propertize cherry 'font-lock-face (?U 'magit-signature-untrusted)
(if (string= cherry "-") (?X 'magit-signature-expired)
'magit-cherry-equivalent (?Y 'magit-signature-expired-key)
'magit-cherry-unmatched))) (?R 'magit-signature-revoked)
(insert ?\s)) (?E 'magit-signature-error)
(when side (?N 'magit-hash)
(insert (propertize side 'font-lock-face (_ 'magit-hash))))
(if (string= side "<") (when cherry
'magit-cherry-equivalent (when (and (derived-mode-p 'magit-refs-mode)
'magit-cherry-unmatched))) magit-refs-show-commit-count)
(insert ?\s)) (insert (make-string (1- magit-refs-focus-column-width) ?\s)))
(when align (insert (propertize cherry 'font-lock-face
(insert hash ?\s)) (if (string= cherry "-")
(when graph 'magit-cherry-equivalent
(insert graph)) 'magit-cherry-unmatched)))
(unless align (insert ?\s))
(insert hash ?\s)) (when side
(when (and refs (not magit-log-show-refname-after-summary)) (insert (propertize side 'font-lock-face
(insert (magit-format-ref-labels refs) ?\s)) (if (string= side "<")
(when (eq style 'reflog) 'magit-cherry-equivalent
(insert (format "%-2s " (1- magit-log-count))) 'magit-cherry-unmatched)))
(when refsub (insert ?\s))
(insert (magit-reflog-format-subject (when align
(substring refsub 0 (insert hash ?\s))
(if (string-search ":" refsub) -2 -1)))))) (when graph
(insert (magit-log--wash-summary msg)) (insert graph))
(when (and refs magit-log-show-refname-after-summary) (unless align
(insert ?\s) (insert hash ?\s))
(insert (magit-format-ref-labels refs))) (unless magit-log-show-refname-after-summary
(insert ?\n) (when refs
(when (memq style '(log reflog stash)) (insert refs ?\s))
(goto-char (line-beginning-position)) (when trailers
(when (and refsub (insert trailers ?\s)))
(string-match "\\`\\([^ ]\\) \\+\\(..\\)\\(..\\)" date)) (when (eq style 'reflog)
(setq date (+ (string-to-number (match-string 1 date)) (insert (format "%-2s " (1- magit-log-count)))
(* (string-to-number (match-string 2 date)) 60 60) (when refsub
(* (string-to-number (match-string 3 date)) 60)))) (insert (magit-reflog-format-subject
(magit-log-format-margin hash author date)) (substring refsub 0
(when (and (eq style 'cherry) (if (string-search ":" refsub) -2 -1))))))
(magit-buffer-margin-p)) (insert (magit-log--wash-summary msg))
(apply #'magit-log-format-margin hash (when magit-log-show-refname-after-summary
(split-string (magit-rev-format "%aN%x00%ct" hash) "\0"))) (when refs
(when (and graph (insert ?\s refs))
(not (eobp)) (when trailers
(not (looking-at non-graph-re))) (insert ?\s trailers)))
(when (looking-at "") (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) (magit-insert-heading)
(delete-char 1) (re-search-forward "")
(magit-insert-section (commit-header) (delete-char -1)
(forward-line) (forward-char)
(magit-insert-heading) (insert ?\n))
(re-search-forward "") (delete-char 1))
(delete-char -1) (if (looking-at "^\\(---\\|\n\s\\|\ndiff\\)")
(forward-char) (let ((limit (save-excursion
(insert ?\n)) (and (re-search-forward non-graph-re nil t)
(delete-char 1)) (match-beginning 0)))))
(if (looking-at "^\\(---\\|\n\s\\|\ndiff\\)") (unless (oref magit-insert-section--current content)
(let ((limit (save-excursion (magit-insert-heading))
(and (re-search-forward non-graph-re nil t) (delete-char (if (looking-at "\n") 1 4))
(match-beginning 0))))) (magit-diff-wash-diffs (list "--stat") limit))
(unless (oref magit-insert-section--current content) (when align
(magit-insert-heading)) (setq align (make-string (1+ abbrev) ? )))
(delete-char (if (looking-at "\n") 1 4)) (when (and (not (eobp)) (not (looking-at non-graph-re)))
(magit-diff-wash-diffs (list "--stat") limit))
(when align (when align
(setq align (make-string (1+ abbrev) ? ))) (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 (when align
(setq align (make-string (1+ abbrev) ? ))) (save-excursion (insert align)))
(while (and (not (eobp)) (not (looking-at non-graph-re))) (forward-line)
(when align (magit-make-margin-overlay))
(save-excursion (insert align))) ;; When `--format' is used and its value isn't one of the
(forward-line) ;; predefined formats, then `git-log' does not insert a
(magit-make-margin-overlay)) ;; separator line.
;; When `--format' is used and its value isn't one of the (save-excursion
;; predefined formats, then `git-log' does not insert a (forward-line -1)
;; separator line. (looking-at "[-_/|\\*o<>. ]*"))
(save-excursion (setq graph (match-string 0))
(forward-line -1) (unless (string-match-p "[/\\.]" graph)
(looking-at "[-_/|\\*o<>. ]*")) (insert graph ?\n)))))))
(setq graph (match-string 0))
(unless (string-match-p "[/\\.]" graph)
(insert graph ?\n))))))))
t) t)
(defun magit-log--wash-summary (summary) (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-selected-window (get-buffer-window buf)
(with-current-buffer buf (with-current-buffer buf
(save-excursion (save-excursion
(magit-blob-visit (list (magit-rev-parse rev) (magit-blob-visit (magit-rev-parse rev)
(magit-file-relative-name (magit-file-relative-name
magit-buffer-file-name))))))))))))) magit-buffer-file-name))))))))))))
(defun magit-log-goto-commit-section (rev) (defun magit-log-goto-commit-section (rev)
(let ((abbrev (magit-rev-format "%h" rev))) (let ((abbrev (magit-rev-format "%h" rev)))
@@ -1611,18 +1670,18 @@ The shortstat style is experimental and rather slow."
(interactive) (interactive)
(setq magit-log-margin-show-shortstat (setq magit-log-margin-show-shortstat
(not 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) (defun magit-log-format-margin (rev author date)
(when (magit-margin-option) (when (magit--right-margin-option)
(if magit-log-margin-show-shortstat (if magit-log-margin-show-shortstat
(magit-log-format-shortstat-margin rev) (magit-log-format-shortstat-margin rev)
(magit-log-format-author-margin author date)))) (magit-log-format-author-margin author date))))
(defun magit-log-format-author-margin (author date) (defun magit-log-format-author-margin (author date)
(pcase-let ((`(,_ ,style ,width ,details ,details-width) (pcase-let ((`(,_ ,style ,width ,details ,details-width)
(or magit-buffer-margin (or magit--right-margin-config
(symbol-value (magit-margin-option)) (symbol-value (magit--right-margin-option))
(error "No margin format specified for %s" major-mode)))) (error "No margin format specified for %s" major-mode))))
(magit-make-margin-overlay (magit-make-margin-overlay
(concat (and details (concat (and details
@@ -1745,15 +1804,14 @@ Type \\[magit-log-select-quit] to abort without selecting a commit."
(magit-log-select-setup-buffer (magit-log-select-setup-buffer
(or branch (magit-get-current-branch) "HEAD") (or branch (magit-get-current-branch) "HEAD")
(append args (append args
(car (magit-log--get-value 'magit-log-select-mode (car (magit-log--get-value 'magit-log-select-mode 'direct))))
magit-direct-use-buffer-arguments))))
(if initial (if initial
(magit-log-goto-commit-section initial) (magit-log-goto-commit-section initial)
(while-let ((rev (magit-section-value-if 'commit)) (while-let* ((rev (magit-section-value-if 'commit))
((string-match-p "\\`\\(squash!\\|fixup!\\|amend!\\)" (_(string-match-p "\\`\\(squash!\\|fixup!\\|amend!\\)"
(magit-rev-format "%s" rev))) (magit-rev-format "%s" rev)))
(section (magit-current-section)) (section (magit-current-section))
(next (car (magit-section-siblings section 'next)))) (next (car (magit-section-siblings section 'next))))
(magit-section-goto next))) (magit-section-goto next)))
(setq magit-log-select-pick-function pick) (setq magit-log-select-pick-function pick)
(setq magit-log-select-quit-function quit) (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." "Insert commits that haven't been pulled from the push-remote yet."
(when-let* ((target (magit-get-push-branch)) (when-let* ((target (magit-get-push-branch))
(range (concat ".." target)) (range (concat ".." target))
((magit--insert-pushremote-log-p))) (_(magit--insert-pushremote-log-p)))
(magit-insert-section (unpulled range t) (magit-insert-section (unpulled range t)
(magit-insert-heading (magit-insert-heading
(format (propertize "Unpulled from %s." (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." "Insert commits that haven't been pushed to the push-remote yet."
(when-let* ((target (magit-get-push-branch)) (when-let* ((target (magit-get-push-branch))
(range (concat target "..")) (range (concat target ".."))
((magit--insert-pushremote-log-p))) (_(magit--insert-pushremote-log-p)))
(magit-insert-section (unpushed range t) (magit-insert-section (unpushed range t)
(magit-insert-heading (magit-insert-heading
(format (propertize "Unpushed to %s." (format (propertize "Unpushed to %s."
@@ -2050,4 +2108,15 @@ all others with \"-\"."
;;; _ ;;; _
(provide 'magit-log) (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 ;;; 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") :link '(info-link "(magit)Log Margin")
:group 'magit-log) :group 'magit-log)
(defvar-local magit-buffer-margin nil) ;;; Settings
(put 'magit-buffer-margin 'permanent-local t)
(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 ;;; Commands
(transient-define-prefix magit-margin-settings () (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" :info-manual "(magit) Log Margin"
["Margin" ["Margin"
(magit-toggle-margin) (magit-toggle-margin)
@@ -68,96 +83,89 @@ does not carry to other options."
(magit-refs-set-show-commit-count)]) (magit-refs-set-show-commit-count)])
(transient-define-suffix magit-toggle-margin () (transient-define-suffix magit-toggle-margin ()
"Show or hide the Magit margin." "Show or hide the right margin."
:description "Toggle visibility" :description "Toggle visibility"
:key "L" :key "L"
:transient t :transient t
(interactive) (interactive)
(unless (magit-margin-option) (unless (magit--right-margin-option)
(user-error "Magit margin isn't supported in this buffer")) (user-error "Magit margin isn't supported in this buffer"))
(setcar magit-buffer-margin (not (magit-buffer-margin-p))) (setcar magit--right-margin-config (not (magit--right-margin-active)))
(magit-set-buffer-margin)) (magit-set-buffer-margins))
(defvar magit-margin-default-time-format nil (defvar magit-margin-default-time-format nil
"See https://github.com/magit/magit/pull/4605.") "See https://github.com/magit/magit/pull/4605.")
(transient-define-suffix magit-cycle-margin-style () (transient-define-suffix magit-cycle-margin-style ()
"Cycle style used for the Magit margin." "Cycle style used for the right margin."
:description "Cycle style" :description "Cycle style"
:key "l" :key "l"
:transient t :transient t
(interactive) (interactive)
(unless (magit-margin-option) (unless (magit--right-margin-option)
(user-error "Magit margin isn't supported in this buffer")) (user-error "Magit margin isn't supported in this buffer"))
;; This is only suitable for commit margins (there are not others). ;; This is only suitable for commit margins (there are not others).
(setf (cadr magit-buffer-margin) (setf (cadr magit--right-margin-config)
(pcase (cadr magit-buffer-margin) (pcase (cadr magit--right-margin-config)
('age 'age-abbreviated) ('age 'age-abbreviated)
('age-abbreviated ('age-abbreviated
(let ((default (or magit-margin-default-time-format (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 "))) (if (stringp default) default "%Y-%m-%d %H:%M ")))
(_ 'age))) (_ 'age)))
(magit-set-buffer-margin nil t)) (magit-set-buffer-margins nil t))
(transient-define-suffix magit-toggle-margin-details () (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" :description "Toggle details"
:key "d" :key "d"
:transient t :transient t
(interactive) (interactive)
(unless (magit-margin-option) (unless (magit--right-margin-option)
(user-error "Magit margin isn't supported in this buffer")) (user-error "Magit margin isn't supported in this buffer"))
(setf (nth 3 magit-buffer-margin) (setf (nth 3 magit--right-margin-config)
(not (nth 3 magit-buffer-margin))) (not (nth 3 magit--right-margin-config)))
(magit-set-buffer-margin nil t)) (magit-set-buffer-margins nil t))
;;; Core ;;; Core
(defun magit-buffer-margin-p () (defun magit-set-buffer-margins (&optional reset-right refresh-right)
(car magit-buffer-margin)) (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 () (defun magit-set-window-margins (&optional window)
(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)
(when (or window (setq window (get-buffer-window))) (when (or window (setq window (get-buffer-window)))
(with-selected-window window (with-selected-window window
(set-window-margins (set-window-margins
nil (car (window-margins)) nil
(and (magit-buffer-margin-p) (if (characterp (car (magit-section-visibility-indicator)))
(nth 2 magit-buffer-margin)))))) 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)) (cl-defun magit-make-margin-overlay (&optional string (previous-line nil sline))
"Display STRING in the margin of the previous (or current) line. "Display STRING in the margin of the previous (or current) line.
@@ -180,7 +188,7 @@ line is affected."
[remote branchbuf] [remote branchbuf]
[shelved branchbuf] [shelved branchbuf]
[tags branchbuf] [tags branchbuf]
topics issues pullreqs)) topics discussions issues pullreqs))
(defun magit-maybe-make-margin-overlay () (defun magit-maybe-make-margin-overlay ()
(when (magit-section-match magit-margin-overlay-conditions (when (magit-section-match magit-margin-overlay-conditions
@@ -195,7 +203,7 @@ line is affected."
(dolist (buffer (buffer-list)) (dolist (buffer (buffer-list))
(with-current-buffer buffer (with-current-buffer buffer
(when (eq major-mode mode) (when (eq major-mode mode)
(magit-set-buffer-margin t) (magit-set-buffer-margins t)
(magit-refresh)))) (magit-refresh))))
(message "Updating margins in %s buffers...done" mode)) (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.") English.")
(defun magit--age (date &optional abbreviate) (defun magit--age (date &optional abbreviate)
(cl-labels ((fn (age spec) (named-let calc ((age (abs (- (float-time)
(pcase-let ((`(,char ,unit ,units ,weight) (car spec))) (if (stringp date)
(let ((cnt (round (/ age weight 1.0)))) (string-to-number date)
(if (or (not (cdr spec)) date))))
(>= (/ age weight) 1)) (spec magit--age-spec))
(list cnt (cond (abbreviate char) (pcase-let* ((`((,char ,unit ,units ,weight) . ,spec) spec)
((= cnt 1) unit) (cnt (round (/ age weight 1.0))))
(t units))) (if (or (not spec)
(fn age (cdr spec))))))) (>= (/ age weight) 1))
(fn (abs (- (float-time) (list cnt (cond (abbreviate char)
(if (stringp date) ((= cnt 1) unit)
(string-to-number date) (units)))
date))) (calc age spec)))))
magit--age-spec)))
;;; _ ;;; _
(provide 'magit-margin) (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 ;;; magit-margin.el ends here
lisp/magit/magit-merge.el
+29 -19
View File
@@ -33,7 +33,7 @@
;;; Commands ;;; Commands
;;;###autoload (autoload 'magit-merge "magit" nil t) ;;;###autoload(autoload 'magit-merge "magit" nil t)
(transient-define-prefix magit-merge () (transient-define-prefix magit-merge ()
"Merge branches." "Merge branches."
:man-page "git-merge" :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? " (format "Do you really want to merge `%s' into another branch? "
branch)) branch))
(user-error "Abort"))) (user-error "Abort")))
(if-let ((target (magit-get-push-branch branch t))) (cond-let
(progn ([target (magit-get-push-branch branch t)]
(magit-git-push branch target (list "--force-with-lease")) (magit-git-push branch target (list "--force-with-lease"))
(set-process-sentinel (set-process-sentinel
magit-this-process magit-this-process
(lambda (process event) (lambda (process event)
(when (memq (process-status process) '(exit signal)) (when (memq (process-status process) '(exit signal))
(if (not (zerop (process-exit-status process))) (if (not (zerop (process-exit-status process)))
(magit-process-sentinel process event) (magit-process-sentinel process event)
(process-put process 'inhibit-refresh t) (process-put process 'inhibit-refresh t)
(magit-process-sentinel process event) (magit-process-sentinel process event)
(magit--merge-absorb-1 branch args)) (magit--merge-absorb-1 branch args))
(when message (when message
(message message)))))) (message message))))))
(magit--merge-absorb-1 branch args))) ((magit--merge-absorb-1 branch args))))
(defun magit--merge-absorb-1 (branch args) (defun magit--merge-absorb-1 (branch args)
(if-let ((pr (magit-get "branch" branch "pullRequest"))) (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." "During a conflict checkout and stage side, or restore conflict."
(interactive (interactive
(let ((file (magit-completing-read "Checkout file" (let ((file (magit-completing-read "Checkout file"
(magit-tracked-files) nil nil nil (magit-tracked-files) nil 'any nil
'magit-read-file-hist 'magit-read-file-hist
(magit-current-file)))) (magit-current-file))))
(cond ((member file (magit-unmerged-files)) (cond ((member file (magit-unmerged-files))
(list file (magit-checkout-read-stage file))) (list file (magit-checkout-read-stage file)))
((yes-or-no-p (format "Restore conflicts in %s? " file)) ((yes-or-no-p (format "Restore conflicts in %s? " file))
(list file "--merge")) (list file "--merge"))
(t ((user-error "Quit")))))
(user-error "Quit")))))
(pcase (cons arg (cddr (car (magit-file-status file)))) (pcase (cons arg (cddr (car (magit-file-status file))))
((or `("--ours" ?D ,_) ((or `("--ours" ?D ,_)
'("--ours" ?U ?A) '("--ours" ?U ?A)
@@ -312,4 +311,15 @@ If no merge is in progress, do nothing."
;;; _ ;;; _
(provide 'magit-merge) (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 ;;; magit-merge.el ends here
lisp/magit/magit-mode.el
+206 -155
View File
@@ -47,24 +47,22 @@
(declare-function elp-restore-all "elp" ()) (declare-function elp-restore-all "elp" ())
(defvar magit--wip-inhibit-autosave) (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-get-ref "magit-wip" ())
(declare-function magit-wip-commit-worktree "magit-wip" (ref files msg)) (declare-function magit-wip-commit-worktree "magit-wip" (ref files msg))
;;; Options ;;; Options
(defcustom magit-mode-hook (defcustom magit-mode-hook nil
(list #'magit-load-config-extensions)
"Hook run when entering a mode derived from Magit mode." "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 :group 'magit-modes
:type 'hook :type 'hook
:options (list #'magit-load-config-extensions :options (list #'bug-reference-mode))
#'bug-reference-mode))
(defcustom magit-setup-buffer-hook (defcustom magit-setup-buffer-hook
(list #'magit-maybe-save-repository-buffers (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'. "Hook run by `magit-setup-buffer'.
This is run right after displaying the buffer and right before 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 :group 'magit-modes
:type 'hook :type 'hook
:options (list #'magit-maybe-save-repository-buffers :options (list #'magit-maybe-save-repository-buffers
'magit-set-buffer-margin)) 'magit-set-buffer-margins))
(defcustom magit-pre-refresh-hook (defcustom magit-pre-refresh-hook
(list #'magit-maybe-save-repository-buffers) (list #'magit-maybe-save-repository-buffers)
@@ -95,6 +93,7 @@ inside your function."
(defcustom magit-post-refresh-hook (defcustom magit-post-refresh-hook
;; Do not function-quote to avoid circular dependencies. ;; Do not function-quote to avoid circular dependencies.
;; Functions added here have to be autoloaded.
'(magit-auto-revert-buffers '(magit-auto-revert-buffers
magit-run-post-commit-hook magit-run-post-commit-hook
magit-run-post-stage-hook magit-run-post-stage-hook
@@ -425,6 +424,7 @@ recommended value."
"C-c C-w" 'magit-copy-thing "C-c C-w" 'magit-copy-thing
"C-w" 'magit-copy-section-value "C-w" 'magit-copy-section-value
"M-w" 'magit-copy-buffer-revision "M-w" 'magit-copy-buffer-revision
"<remap> <mouse-set-point>" 'magit-mouse-set-point
"<remap> <back-to-indentation>" 'magit-back-to-indentation "<remap> <back-to-indentation>" 'magit-back-to-indentation
"<remap> <previous-line>" 'magit-previous-line "<remap> <previous-line>" 'magit-previous-line
"<remap> <next-line>" 'magit-next-line "<remap> <next-line>" 'magit-next-line
@@ -435,52 +435,52 @@ recommended value."
"This is a placeholder command, which signals an error if called. "This is a placeholder command, which signals an error if called.
Where applicable, other keymaps remap this command to another, Where applicable, other keymaps remap this command to another,
which actually deletes the thing at point." which actually deletes the thing at point."
(declare (completion ignore))
(interactive) (interactive)
(user-error "There is no thing at point that could be deleted")) (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 () (defun magit-visit-thing ()
"This is a placeholder command, which may signal an error if called. "This is a placeholder command, which may signal an error if called.
Where applicable, other keymaps remap this command to another, Where applicable, other keymaps remap this command to another,
which actually visits the thing at point." which actually visits the thing at point."
(declare (completion ignore))
(interactive) (interactive)
(if (eq transient-current-command 'magit-dispatch) (cond-let
(call-interactively (key-binding (this-command-keys))) ((eq transient-current-command 'magit-dispatch)
(if-let ((url (thing-at-point 'url t))) (call-interactively (key-binding (this-command-keys))))
(browse-url url) ([url (thing-at-point 'url t)]
(user-error "There is no thing at point that could be visited")))) (browse-url url))
(put 'magit-visit-thing 'completion-predicate #'ignore) ((user-error "There is no thing at point that could be visited"))))
(defun magit-edit-thing () (defun magit-edit-thing ()
"This is a placeholder command, which may signal an error if called. "This is a placeholder command, which may signal an error if called.
Where applicable, other keymaps remap this command to another, Where applicable, other keymaps remap this command to another,
which actually lets you edit the thing at point, likely in another which actually lets you edit the thing at point, likely in another
buffer." buffer."
(declare (completion ignore))
(interactive) (interactive)
(if (eq transient-current-command 'magit-dispatch) (if (eq transient-current-command 'magit-dispatch)
(call-interactively (key-binding (this-command-keys))) (call-interactively (key-binding (this-command-keys)))
(user-error "There is no thing at point that could be edited"))) (user-error "There is no thing at point that could be edited")))
(put 'magit-edit-thing 'completion-predicate #'ignore)
(defun magit-browse-thing () (defun magit-browse-thing ()
"This is a placeholder command, which may signal an error if called. "This is a placeholder command, which may signal an error if called.
Where applicable, other keymaps remap this command to another, Where applicable, other keymaps remap this command to another,
which actually visits thing at point using `browse-url'." which actually visits thing at point using `browse-url'."
(declare (completion ignore))
(interactive) (interactive)
(if-let ((url (thing-at-point 'url t))) (if-let ((url (thing-at-point 'url t)))
(browse-url url) (browse-url url)
(user-error "There is no thing at point that could be browsed"))) (user-error "There is no thing at point that could be browsed")))
(put 'magit-browse-thing 'completion-predicate #'ignore)
(defun magit-copy-thing () (defun magit-copy-thing ()
"This is a placeholder command, which signals an error if called. "This is a placeholder command, which signals an error if called.
Where applicable, other keymaps remap this command to another, Where applicable, other keymaps remap this command to another,
which actually copies some representation of the thing at point which actually copies some representation of the thing at point
to the kill ring." to the kill ring."
(declare (completion ignore))
(interactive) (interactive)
(user-error "There is no thing at point that we know how to copy")) (user-error "There is no thing at point that we know how to copy"))
(put 'magit-copy-thing 'completion-predicate #'ignore)
;;;###autoload ;;;###autoload
(defun magit-info () (defun magit-info ()
@@ -554,13 +554,6 @@ to the kill ring."
;;; Mode ;;; 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" (define-derived-mode magit-mode magit-section-mode "Magit"
"Parent major mode from which Magit major modes inherit. "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. ;; function does not reinstate this.
(put 'magit-buffer-diff-files-suspended 'permanent-local t) (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 () (cl-defgeneric magit-buffer-value ()
"Return the value of the current buffer. "Return the value of the current buffer.
The \"value\" identifies what is being displayed in the 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 ;;; Setup Buffer
(defmacro magit-setup-buffer (mode &optional locked &rest bindings) (defmacro magit-setup-buffer (mode &optional locked &rest args)
(declare (indent 2)) "\n\n(fn MODE &optional LOCKED &key BUFFER DIRECTORY \
`(magit-setup-buffer-internal INITIAL-SECTION SELECT-SECTION &rest BINDINGS)"
,mode ,locked (declare (indent 2)
,(cons 'list (mapcar (pcase-lambda (`(,var ,form)) (debug (form [&optional locked]
`(list ',var ,form)) [&rest keywordp form]
bindings)))) [&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 (cl-defun magit-setup-buffer-internal
&optional buffer-or-name directory) ( mode locked bindings
&key buffer directory initial-section select-section)
(let* ((value (and locked (let* ((value (and locked
(with-temp-buffer (with-temp-buffer
(pcase-dolist (`(,var ,val) bindings) (pcase-dolist (`(,var ,val) bindings)
(set (make-local-variable var) val)) (set (make-local-variable var) val))
(let ((major-mode mode)) (let ((major-mode mode))
(magit-buffer-value))))) (magit-buffer-value)))))
(buffer (if buffer-or-name (buffer (if buffer
(get-buffer-create buffer-or-name) (get-buffer-create buffer)
(magit-get-mode-buffer mode value))) (magit-get-mode-buffer mode value)))
(section (and buffer (magit-current-section))) (section (and buffer (magit-current-section)))
(created (not buffer))) (created (not buffer)))
@@ -662,7 +681,9 @@ The buffer's major-mode should derive from `magit-section-mode'."
(magit-display-buffer buffer) (magit-display-buffer buffer)
(with-current-buffer buffer (with-current-buffer buffer
(run-hooks 'magit-setup-buffer-hook) (run-hooks 'magit-setup-buffer-hook)
(magit-refresh-buffer created) (magit-refresh-buffer created
:initial-section initial-section
:select-section select-section)
(when created (when created
(run-hooks 'magit-post-create-buffer-hook))) (run-hooks 'magit-post-create-buffer-hook)))
buffer)) buffer))
@@ -689,8 +710,8 @@ and `magit-post-display-buffer-hook'."
(let ((window (funcall (or display-function magit-display-buffer-function) (let ((window (funcall (or display-function magit-display-buffer-function)
buffer))) buffer)))
(unless magit-display-buffer-noselect (unless magit-display-buffer-noselect
(let* ((old-frame (selected-frame)) (let ((old-frame (selected-frame))
(new-frame (window-frame window))) (new-frame (window-frame window)))
(select-window window) (select-window window)
(unless (eq old-frame new-frame) (unless (eq old-frame new-frame)
(select-frame-set-input-focus 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 ((with-current-buffer buffer
(derived-mode-p 'magit-diff-mode 'magit-process-mode)) (derived-mode-p 'magit-diff-mode 'magit-process-mode))
'(magit--display-buffer-topleft)) '(magit--display-buffer-topleft))
(t ('(display-buffer-same-window)))))
'(display-buffer-same-window)))))
(defun magit--display-buffer-fullcolumn (buffer alist) (defun magit--display-buffer-fullcolumn (buffer alist)
(when-let ((window (or (display-buffer-reuse-window 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 ((with-current-buffer buffer
(derived-mode-p 'magit-process-mode)) (derived-mode-p 'magit-process-mode))
nil) nil)
(t ('(magit--display-buffer-fullcolumn)))))
'(magit--display-buffer-fullcolumn)))))
(defun magit-maybe-set-dedicated () (defun magit-maybe-set-dedicated ()
"Mark the selected window as dedicated if appropriate. "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 repository, then the former buffer is instead deleted and the
latter is displayed in its place." latter is displayed in its place."
(interactive) (interactive)
(if magit-buffer-locked-p (cond-let
(if-let ((unlocked (magit-get-mode-buffer major-mode))) (magit-buffer-locked-p
(let ((locked (current-buffer))) (if-let ((unlocked (magit-get-mode-buffer major-mode)))
(switch-to-buffer unlocked nil t) (let ((locked (current-buffer)))
(kill-buffer locked)) (switch-to-buffer unlocked nil t)
(setq magit-buffer-locked-p nil) (kill-buffer locked))
(let ((name (funcall magit-generate-buffer-name-function major-mode)) (setq magit-buffer-locked-p nil)
(buffer (current-buffer)) (let ((name (funcall magit-generate-buffer-name-function major-mode))
(mode major-mode)) (buffer (current-buffer))
(rename-buffer (generate-new-buffer-name name)) (mode major-mode))
(with-temp-buffer (rename-buffer (generate-new-buffer-name name))
(magit--maybe-uniquify-buffer-names buffer name mode)))) (with-temp-buffer
(if-let ((value (magit-buffer-value))) (magit--maybe-uniquify-buffer-names buffer name mode)))))
(if-let ((locked (magit-get-mode-buffer major-mode value))) ([value (magit-buffer-value)]
(let ((unlocked (current-buffer))) (if-let ((locked (magit-get-mode-buffer major-mode value)))
(switch-to-buffer locked nil t) (let ((unlocked (current-buffer)))
(kill-buffer unlocked)) (switch-to-buffer locked nil t)
(setq magit-buffer-locked-p t) (kill-buffer unlocked))
(let ((name (funcall magit-generate-buffer-name-function (setq magit-buffer-locked-p t)
major-mode value)) (let ((name (funcall magit-generate-buffer-name-function
(buffer (current-buffer)) major-mode value))
(mode major-mode)) (buffer (current-buffer))
(rename-buffer (generate-new-buffer-name name)) (mode major-mode))
(with-temp-buffer (rename-buffer (generate-new-buffer-name name))
(magit--maybe-uniquify-buffer-names buffer name mode)))) (with-temp-buffer
(user-error "Buffer has no value it could be locked to")))) (magit--maybe-uniquify-buffer-names buffer name mode)))))
((user-error "Buffer has no value it could be locked to"))))
;;; Bury Buffer ;;; 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-local magit--refresh-start-time nil)
(defvar magit--initial-section-hook nil) (cl-defun magit-refresh-buffer ( &optional created
&key initial-section select-section)
(defun magit-refresh-buffer (&optional created) "Refresh the current Magit buffer.
"Refresh the current Magit buffer." The arguments are for internal use."
(interactive) (interactive)
(when-let ((refresh (magit--refresh-buffer-function))) (when-let ((refresh (magit--refresh-buffer-function)))
(let ((magit--refreshing-buffer-p t) (let ((magit--refreshing-buffer-p t)
@@ -1080,8 +1100,8 @@ Run hooks `magit-pre-refresh-hook' and `magit-post-refresh-hook'."
(cond (cond
(created (created
(funcall refresh) (funcall refresh)
(run-hooks 'magit--initial-section-hook) (cond (initial-section (funcall initial-section))
(setq-local magit--initial-section-hook nil)) (select-section (funcall select-section))))
(t (t
(deactivate-mark) (deactivate-mark)
(setq magit-section-pre-command-section nil) (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) (setq magit-section-focused-sections nil)
(let ((positions (magit--refresh-buffer-get-positions))) (let ((positions (magit--refresh-buffer-get-positions)))
(funcall refresh) (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)) (let ((magit-section-cache-visibility nil))
(magit-section-show magit-root-section)) (magit-section-show magit-root-section))
(run-hooks 'magit-refresh-buffer-hook) (run-hooks 'magit-refresh-buffer-hook)
@@ -1117,17 +1138,20 @@ Run hooks `magit-pre-refresh-hook' and `magit-post-refresh-hook'."
(lambda (window) (lambda (window)
(with-selected-window window (with-selected-window window
(with-current-buffer buffer (with-current-buffer buffer
(and-let* ((section (magit-section-at))) (and-let ((section (magit-section-at)))
`((,window `((,window
,section ,section
,@(magit-section-get-relative-position 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 (list ws
(car (magit-section-get-relative-position ws)) (car (magit-section-get-relative-position ws))
(window-start))))))))) (window-start)))))))))
(get-buffer-window-list buffer nil t))) ;; For hunks we run `magit-section-movement-hook' (once for
(and-let* ((section (magit-section-at))) ;; each window displaying the buffer). The selected window
`((nil ,section ,@(magit-section-get-relative-position section)))))) ;; 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) (defun magit--refresh-buffer-set-positions (positions)
(pcase-dolist (pcase-dolist
@@ -1136,18 +1160,26 @@ Run hooks `magit-pre-refresh-hook' and `magit-post-refresh-hook'."
(if window (if window
(with-selected-window window (with-selected-window window
(magit-section-goto-successor section line char) (magit-section-goto-successor section line char)
(cond (cond-let
((or (not window-start) ((derived-mode-p 'magit-log-mode))
(> window-start (point)))) ((or (not window-start)
((magit-section-equal ws-section (magit-section-at window-start)) (> window-start (point))))
(set-window-start window window-start t)) ((magit-section-equal ws-section (magit-section-at window-start))
((not (derived-mode-p 'magit-log-mode)) (set-window-start window window-start t))
(when-let ((pos (save-excursion ([pos (save-excursion
(and (magit-section-goto-successor--same (and (magit-section-goto-successor--same
ws-section ws-line 0) ws-section ws-line 0)
(point))))) (point)))]
(set-window-start window pos t))))) (set-window-start window pos t))))
(magit-section-goto-successor section line char)))) ;; 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) (defun magit-revert-buffer (_ignore-auto _noconfirm)
"Wrapper around `magit-refresh-buffer' suitable as `revert-buffer-function'." "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. contents from scratch, which can be slow in large repositories.
If you are not satisfied with Magit's performance, then you If you are not satisfied with Magit's performance, then you
should obviously not add this function to that hook." should obviously not add this function to that hook."
(when-let (((and (not magit-inhibit-refresh) (when-let ((_(not magit-inhibit-refresh))
(magit-inside-worktree-p t))) (_(magit-inside-worktree-p t))
(buf (ignore-errors (magit-get-mode-buffer 'magit-status-mode)))) (buf (ignore-errors (magit-get-mode-buffer 'magit-status-mode))))
(cl-pushnew buf magit-after-save-refresh-buffers) (cl-pushnew buf magit-after-save-refresh-buffers)
(add-hook 'post-command-hook #'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-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) (defun magit-save-repository-buffers (&optional arg)
"Save file-visiting buffers belonging to the current repository. "Save file-visiting buffers belonging to the current repository.
After any buffer where `buffer-save-without-query' is non-nil After any buffer where `buffer-save-without-query' is non-nil
is saved without asking, the user is asked about each modified 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." argument (the prefix) non-nil means save all with no questions."
(interactive "P") (interactive "P")
(when-let ((topdir (magit-rev-parse-safe "--show-toplevel"))) (when-let ((topdir (magit-rev-parse-safe "--show-toplevel")))
(let ((remote (file-remote-p default-directory)) (let ((save-some-buffers-action-alist
(save-some-buffers-action-alist
`((?Y ,(##with-current-buffer % `((?Y ,(##with-current-buffer %
(setq buffer-save-without-query t) (setq buffer-save-without-query t)
(save-buffer)) (save-buffer))
@@ -1256,53 +1323,26 @@ argument (the prefix) non-nil means save all with no questions."
(setq magit-inhibit-refresh-save t)) (setq magit-inhibit-refresh-save t))
"to skip the current buffer and remember choice") "to skip the current buffer and remember choice")
,@save-some-buffers-action-alist)) ,@save-some-buffers-action-alist))
(topdirs nil) ;; Create a single wip commit for all saved files.
(unwiped nil) (magit--wip-inhibit-autosave t)
(magit--wip-inhibit-autosave t)) (saved nil))
(unwind-protect (unwind-protect
(save-some-buffers (save-some-buffers
arg arg
(lambda () (lambda ()
;; If the current file is modified and resides inside (and (funcall magit-save-repository-buffers-predicate topdir)
;; a repository, and a let-binding is in effect, which (prog1 t
;; places us in another repository, then this binding (when magit-wip-mode
;; is needed to prevent that file from being saved. (push (expand-file-name buffer-file-name) saved))))))
(and-let* ((default-directory (when saved
(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
(let ((default-directory topdir)) (let ((default-directory topdir))
(magit-wip-commit-worktree (magit-wip-commit-worktree
(magit-wip-get-ref) (magit-wip-get-ref)
unwiped saved
(if (cdr unwiped) (if (cdr saved)
(format "autosave %s files after save" (length unwiped)) (format "autosave %s files after save" (length saved))
(format "autosave %s after save" (format "autosave %s after save"
(file-relative-name (car unwiped))))))))))) (file-relative-name (car saved)))))))))))
;;; Restore Window Configuration ;;; 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 Later, when the buffer is buried, it may be restored by
`magit-restore-window-configuration'." `magit-restore-window-configuration'."
(if magit-inhibit-save-previous-winconf (cond (magit-inhibit-save-previous-winconf
(when (eq magit-inhibit-save-previous-winconf 'unset) (when (eq magit-inhibit-save-previous-winconf 'unset)
(setq magit-previous-window-configuration nil)) (setq magit-previous-window-configuration nil)))
(unless (get-buffer-window (current-buffer) (selected-frame)) ((not (get-buffer-window (current-buffer) (selected-frame)))
(setq magit-previous-window-configuration (setq magit-previous-window-configuration
(current-window-configuration))))) (current-window-configuration)))))
(defun magit-restore-window-configuration (&optional kill-buffer) (defun magit-restore-window-configuration (&optional kill-buffer)
"Bury or kill the current buffer and restore previous window configuration." "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'. The KEY is matched using `equal'.
Unless specified, REPOSITORY is the current buffer's repository." Unless specified, REPOSITORY is the current buffer's repository."
(and-let* ((cache (assoc (or repository (and-let ((cache (assoc (or repository
(magit-repository-local-repository)) (magit-repository-local-repository))
magit-repository-local-cache))) magit-repository-local-cache)))
(assoc key (cdr cache)))) (assoc key (cdr cache))))
(defun magit-repository-local-get (key &optional default repository) (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. Unless specified, REPOSITORY is the current buffer's repository.
If REPOSITORY is `all', then delete the value for KEY for all If REPOSITORY is `all', then delete the value for KEY for all
repositories." repositories."
(if (eq repository 'all) (cond-let
(dolist (cache magit-repository-local-cache) ((eq repository 'all)
(setf cache (compat-call assoc-delete-all key cache))) (dolist (cache magit-repository-local-cache)
(when-let ((cache (assoc (or repository (setf cache (compat-call assoc-delete-all key cache))))
(magit-repository-local-repository)) ([cache (assoc (or repository (magit-repository-local-repository))
magit-repository-local-cache))) magit-repository-local-cache)]
(setf cache (compat-call assoc-delete-all key cache))))) (setf cache (compat-call assoc-delete-all key cache)))))
(defmacro magit--with-repository-local-cache (key &rest body) (defmacro magit--with-repository-local-cache (key &rest body)
(declare (indent 1) (debug (form 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 returned value has the form (BEGINNING-LINE END-LINE). If
the region end at the beginning of a line, do not include that the region end at the beginning of a line, do not include that
line. Avoid including the line after the end of the file." 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) (region-active-p)
(not (= (region-beginning) (region-end) (1+ (buffer-size)))) (not (= (region-beginning) (region-end) (1+ (buffer-size))))
(let ((beg (region-beginning)) (let ((beg (region-beginning))
@@ -1569,4 +1609,15 @@ line. Avoid including the line after the end of the file."
;;; _ ;;; _
(provide 'magit-mode) (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 ;;; magit-mode.el ends here

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